;;; -*- Mode:LISP; Package:USER; Readtable:COMMON-LISP; Base:10 -*- ;;; All files contained in this directory are copyright ;;; (c) GigaMos Systems, Inc. 1988 ;;; All Rights Reserved ;;; Inquiries concerning copyright release or licensing should be directed ;;; to GigaMos Legal Affairs at the following address: ;;; GigaMos Systems, Inc. ;;; 650 Suffolk St. ;;; Lowell, Massachusetts 01854 ;;; Phone: (617) 458-9100 ;;; This file is executed when the user invokes: ;;; (tape:install-distribution-tape) ;;; (tape:distribution-installation-forms (send terminal-io :send-if-handles :clear-window) (format t "~&~ ******************************************************~%~ ** THIS IS THE 4.0 OPTIONS SOURCE DISTRIBUTION TAPE **~%~ ** FOR LMI RELEASE 4.0 **~%~ ** All files contained in this tape are copyright **~%~ ** (c) GigaMos Systems, Inc. 1988 **~%~ ** All Rights Reserved **~%~ ** Inquiries concerning copyright release or **~%~ ** licensing should be directed to GigaMos Legal **~%~ ** Affairs at the following address: **~%~ ** GigaMos Systems, Inc. **~%~ ** 650 Suffolk St. **~%~ ** Lowell, Massachusetts 01854 **~%~ ** Phone: (617) 458-9100 **~%~ ******************************************************~%") (cond ((not (y-or-n-p "~&Is 4.0 OPTIONS the product you wanted to install?")) ;; make sure the user is installing the product he thought he ;; was going to install. (format t "~&~ *****************************~%~ ** INSTALLATION ABORTING **~%~ *****************************~%") (tape:rewind)) ((or (not (eq 123 (si:get-system-version)))) ;;(not (eq 4 (si:get-system-version 'system-revision-level)))) (beep) (format t "~&~ ******************************************************~%~ ** ERROR: **~%~ ** This machine is running an incorrect **~%~ ** Lambda system version for installing this tape. **~%~ ** INSTALLATION ABORTING **~%~ ******************************************************~%") (beep) (tape:rewind)) ; ((or (not (typep terminal-io 'tv:lisp-listener)) ; (not (eq si:initial-process ; (send terminal-io :process))) ; (not (eq current-process si:initial-process))) ; (beep) ; (format t ;;; check that we are called from initial process lisp listener ;;; also could check that warm boot has been done, or other ;;; damage. This is needed because we are going to do a disk-save. ; "~&~ ;*************************************************~%~ ;* ERROR: (TAPE:INSTALL-DISTRIBUTION-TAPE) *~%~ ;* not called from Lisp Listener 1, or listener *~%~ ;* state inconsistent. Installation is aborting. *~%~ ;*************************************************~%") ; (tape:rewind) ; (beep)) ('else ;;Do the installation (block nil (tagbody start-install-options (let((options '((CUSTOMER-SITE () "Sample customer site file directory" "Restore the CUSTOMER-SITE directory if... 1) you haven't previously installed your Lambda(s), or 2) you haven't performed custom network configuration [\"site files\"] before, or 3) you plan to load some of the software options (listed below with ****). This directory contains example site files; they can also be used as the default site files if you have systems named LAMBDA-A, LAMBDA-B, etc.") (DEMOS (MAKE-SYSTEM 'DEMOS :NO-RELOAD-SYSTEM-DECLARATION) "Miscellaneous demo programs" "Restore the DEMOS directory if... you want to review programs that illustrate Lambda programming techniques.") (EXAMPLES () "Example programs" "Restore the EXAMPLES directory if... you want to review programs that illustrate Lambda programming techniques.") (FONTS () "Window system font directory" "Restore the font directory if... you want to make all the window fonts available. [NOTE: Some fonts are not pre-loaded in the LISP world, and must be retrieved from the SYS HOST before they can be used.]") (GATEWAY (MAKE-SYSTEM 'GATEWAY :NOCONFIRM) "On-Line Documentation Manager" "Restore and load ODM (****) if... 1) you want to develop your own on-line manual, or 2) to access the on-line LISP Machine Manual.") ((LASER1+ HARDCOPY TIGER LASER) (MAKE-SYSTEM 'LASER1+ :NOCONFIRM) "Laser1+ printer driver" "Restore and load Laser1+ (****) if... you use the HP LaserJet-Plus printer attached to a Lambda.") ((MEDIUM-RESOLUTION-COLOR VIDEO-DEVICE) (MAKE-SYSTEM 'MEDIUM-RESOLUTION-COLOR :NOCONFIRM) "Medium-Res Color system" "Restore and load the MEDIUM-RESOLUTION-COLOR system (****) if... your Lambda system includes the ??? Systech color graphics monitor.") ((MICROCODE UBIN) () "Microcode directory" "Restore the UBIN directory if you want to... keep a file copy of the 4.0 microcode. [NOTE: the microcode file can be used later to restore a microcode partition.]") (OBJECTLISP (MAKE-SYSTEM 'OBJECTLISP :NOCONFIRM) "ObjectLISP object-oriented programming language" "Restore and load the OBJECTLISP system (****) if... you have developed, or plan to develop, programs using the ObjectLISP language.") ((TIGER HARDCOPY) () "Tiger printer software sources" "Restore and load TIGER if... you plan to develop your own custom printer driver. The existing drivers provide example code for you to adapt.") ((WINDOW-MAKER WINDOW) (MAKE-SYSTEM 'WINDOW-MAKER :NOCONFIRM) "Window program generator" "Restore and load the WINDOW-MAKER system (****) if... you want to run the Window-Maker, which is a utility for generating full-screen window-handling code.") (ZWEI () "Zwei miscellany [word dictionary and TEACH-ZMACS]" "Restore miscellaneous Zwei sources, including: 1) the spelling checker word dictionary 2) the TEACH-ZMACS file, which you can use to review the ZMacs editor commands [run the ZMacs command Meta-X Teach ZMacs]"))) (selected nil) (aborted nil) (selected-something-p nil) (commands-to-eval nil) (directories-to-restore nil)) (labels((optname(option) (if (atom (first option)) (first option) (first(first option)))) (optdir(option) (if (atom (first option)) (ncons(first option)) (rest(first option)))) (optdo(option) (second option)) (opttext(option) (third option)) (optwhen(option) (fourth option))) (format t "~% There are multiple software options included in this distribution. You will be presented with a menu with which to choose which options, if any, you are interested in restoring [and optionally, loading]. The available options are:") (mapcar #'(lambda(option) (format t "~% ~35a - ~a" (optname option) (opttext option))) options) (when (y-or-n-p "Do you want an explanation of each option?") (mapcar #'(lambda(option) (format t "~2%~a: ~a" (optname option) (opttext option)) (format t "~%~a~&" (optwhen option))) options) (format t "~%Type a character to proceed:") (read-char)) (format t "~% Now make your selections with the following menu. Use the mouse to click the boxes under the columns to indicate whether you want the option restored and, optionally, loaded.") (multiple-value-setq(selected aborted) (tv:multiple-choose "4.0 Software Options" (loop for option in options as name = (optname option) ; as label = (opttext option) collect (list name (format nil "~:(~a~)" name) (if (optdo option) '(restore load) '(restore)))) `((restore "Restore files" nil nil nil t) (load "Load into world" t nil nil nil)))) (loop for choice in selected ;;Set flag - something to do?? (setq selected-something-p (or selected-something-p (or (cdr choice))))) (unless (cond (aborted (format t "~%You aborted out of the choice menu... ")) ((or (null selected) (null selected-something-p)) (format t "~%You didn't select any options... ")) (t t)) (beep) (if (y-or-n-p "Do you really want to quit?") (return nil) (go start-install-options))) ;;If they want MEDIUM-RES, they need DEMOS (let((medium-res (cdr(assoc 'medium-resolution-color selected))) (demos (assoc 'demos selected))) (when medium-res (setq demos (or demos (car(push (ncons 'demos) selected)))) (unless (cdr demos) (format t "~% **Note: you selected Medium-Resolution-Color, which requires the DEMOS system.")) (rplacd (last demos) (copy-list medium-res)))) ;;If they want any systems to MAKE-SYSTEM, they need CUSTOMER-SITE (let((systems (count-if #'(lambda(choice) (member 'load (cdr choice))) selected)) (sitefiles (assoc 'customer-site selected))) (when (plusp systems) (setq sitefiles (or sitefiles (car (push (ncons 'customer-site) selected)))) (unless (cdr sitefiles) (format t "~% **Note: you selected some system~p requiring the CUSTOMER-SITE files." systems)) (rplacd (last sitefiles) (ncons 'restore)))) ;;Review options, setup todo lists (loop for choice in selected as choicename = (car choice) as restore = (member 'restore (cdr choice)) as load = (member 'load (cdr choice)) as option = (find choicename options :key #'optname) when (null option) (warn "Bug in options installation - skipping choice ~s" choice) when option as optname = (optname option) as optdir = (optdir option) as optdo = (optdo option) do (when (and restore optdir) (push optdir directories-to-restore)) (when (and load optdo) (push optdo commands-to-eval)) (when (or restore load) (format t "~%For ~a: " optname) (format t "~@[restore ~s~]~@[~* + ~]~@[load via ~s~]" (and restore optdir) (and restore load) (and load optdo)))) (when (yes-or-no-p "~2%Proceed to restore/load as above?") (when directories-to-restore (pprint directories-to-restore) (tape:restore-files :match #'(lambda(flist &aux (path (car flist))) (labels((directory-under-p (got want) (cond ((null want) t) ((null got) nil) ((equal (car got)(car want)) (directory-under-p (cdr got) (cdr want)))))) (member (prog(dir) (setq dir (send path :directory)) (if (atom dir) (setq dir (ncons dir))) (return dir)) directories-to-restore :test #'directory-under-p))) :overwrite :query)) selected))))))))