;;; -*- Mode:Common-Lisp; Package:PROFILE; Base:10; Fonts:(CPTFONT HL12B HL12I) -*- ;;; RESTRICTED RIGHTS LEGEND ;;;Use, duplication, or disclosure by the Government is subject to ;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in ;;;Technical Data and Computer Software clause at 52.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED. ;;; P.O. BOX 2909 ;;; AUSTIN, TEXAS 78769 ;;; MS 2151 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. All rights reserved. ;1;;;; SYSTEM ACCESS MENU* ;1;; This code adds the variable W*:1*SYSTEM-KEYS* to the IMPORTANT VARIABLES* ;1;; column of PROFILE. If selected, the System Access Menu is brought up. It provides a list* ;1;; of software systems and their current system-key assignments. From this menu, the user * ;1;; can find additional systems on SYS:SITE; or in his environment, and then edit the SYSTEM * ;1;; key assignments or System Menu column assignments for any of these systems. All of this* ;1;; can then be stored in the user's login.init file through Profile.* ;;; 05/08/89 jlm Added code to set SYSTEM-MADE-P for profile system ;;; 04/11/89 JLM Commented out first definition of EDIT-KEY to avoid duplicate definition warning ;;; 3/31/89 las - issued :assign-defaults for profile system key #\U ;1;; System Access Menu* (DEFVAR *ACCESS-SPECS-BUF* NIL "2A globally accessible buffer which is used to hold a COPY of W*:2*SYSTEM- ACCESS-SPECS*, so that it can be edited freely and then, via W:SET- SYSTEM-ACCESS-SPECS, be set back into W*:2*SYSTEM-ACCESS-SPECS*.*") ;1;; This is a general-scroll window with mouse-sensitive items.* ;1;; It has a boxed title at the top, margin-choices at the bottom,* ;1;; scroll bars, and a shadowed border to set it apart from the* ;1;; window below it.* (DEFFLAVOR SAM-WINDOW-FLAVOR () (W:SCROLL-MOUSE-MIXIN W:SHADOW-BORDERS-MIXIN W:BORDERS-MIXIN W:TOP-BOX-LABEL-MIXIN W:MARGIN-CHOICE-MIXIN W:BASIC-SCROLL-WINDOW W:SCROLL-BAR-MIXIN W:WINDOW)) (COMPILE-FLAVOR-METHODS SAM-WINDOW-FLAVOR) (DEFUN MAKE-SAM-WINDOW () "2Makes the general-scroll window for the System Access Menu.*" (MAKE-INSTANCE 'SAM-WINDOW-FLAVOR :LABEL '(:CENTERED :STRING "SYSTEM ACCESS MENU") :LEFT 25 :TOP 25 :BORDERS 3 :CHARACTER-WIDTH 61 :CHARACTER-HEIGHT 30 :MARGIN-CHOICES '(("Abort" NIL (LAMBDA (&REST IGNORE) (SEND SELF :FORCE-KBD-INPUT #\ABORT)) NIL NIL :DOCUMENTATION (:MOUSE-ANY "Exit and abort all changes")) ("Do It" NIL (LAMBDA (&REST IGNORE) (SEND SELF :FORCE-KBD-INPUT #\END)) NIL NIL :DOCUMENTATION (:MOUSE-ANY "Exit and activate changes")) ("Search" NIL (LAMBDA (&REST IGNORE) (SEND SELF :FORCE-KBD-INPUT (IF (W:MOUSE-CONFIRM "Do you want to activate any previous changes?" (FORMAT NIL "Click mouse or press ” to `Do It'.~%~ Move off window or press to `Abort'.")) :DO-IT-UPDATE :ABORT-UPDATE))) NIL NIL :DOCUMENTATION (:MOUSE-ANY "Exit, search for other systems, update list of systems, and return"))) :DISPLAY-ITEM (MAKE-SAM-ROOT))) (DEFUN SYSTEM-ACCESS-MENU (&rest ignore) "2Provides a menu of software systems and their accessibility. It allows the user to edit print-name, System Menu column, and SYSTEM key for each system.*" (SETQ *ACCESS-SPECS-BUF* (COPY-TREE (STABLE-SORT (COPY-LIST w:*system-keys*) #'ALPHALESSP :key #'car))) (CASE (SYSTEM-ACCESS-MENU-HANDLER) (:ABORT (SETQ *ACCESS-SPECS-BUF* NIL) W:*SYSTEM-KEYS*) (:DO-IT (when *ACCESS-SPECS-BUF* (dolist (sys-key (reverse *access-specs-buf*)) (w:remove-system-access-spec (tv:system-key-system sys-key)) (APPLY #'w:ADD-SYSTEM-KEY sys-key)) (SETQ *ACCESS-SPECS-BUF* NIL)) w:*system-keys*) (:ABORT-UPDATE (W:UPDATE-SYSTEM-ACCESS-SPECS) (SYSTEM-ACCESS-MENU)) (:DO-IT-UPDATE (when *ACCESS-SPECS-BUF* (dolist (sys-key (reverse *access-specs-buf*)) (w:remove-system-access-spec (tv:system-key-system sys-key)) (APPLY #'w:ADD-SYSTEM-KEY sys-key)) (SETQ *ACCESS-SPECS-BUF* NIL)) *ACCESS-SPECS-BUF* (W:UPDATE-SYSTEM-ACCESS-SPECS) (SYSTEM-ACCESS-MENU)) ) (values)) (DEFUN SYSTEM-ACCESS-MENU-HANDLER () "2Handles the menu for the function PROFILE:SYSTEM-ACCESS-MENU.*" (LET ((W:KBD-INTERCEPTED-CHARACTERS (COPY-TREE W:KBD-INTERCEPTED-CHARACTERS)) (sam-window (MAKE-SAM-WINDOW))) ;; las 8-18-88 (SETF (second (ASSOC #\BREAK W:KBD-INTERCEPTED-CHARACTERS)) #'(LAMBDA (CHAR) (VALUES CHAR NIL))) (SETF (second (ASSOC #\ABORT W:KBD-INTERCEPTED-CHARACTERS)) #'(LAMBDA (CHAR) (VALUES CHAR NIL))) (UNWIND-PROTECT (W:WINDOW-CALL (SAM-WINDOW :DEACTIVATE) (DO* ((INPUT (W:READ-ANY SAM-WINDOW) (W:READ-ANY SAM-WINDOW))) ((MEMBER INPUT '(NIL #\ABORT #\END :ABORT-UPDATE :DO-IT-UPDATE)) (CASE INPUT ((NIL #\ABORT) :ABORT) (#\END :DO-IT) (:ABORT-UPDATE :ABORT-UPDATE) (:DO-IT-UPDATE :DO-IT-UPDATE) )) (WHEN (AND (CONSP INPUT) (MEMBER (car input) '(:EDIT-NAME :EDIT-COLUMN :EDIT-KEY))) (let ((s-a-spec (THIRD (SECOND INPUT))) (window (THIRD INPUT)) (click (FOURTH INPUT))) (CASE (CAR INPUT) (:EDIT-NAME (EDIT-NAME s-a-spec window click)) (:EDIT-COLUMN (EDIT-COLUMN s-a-spec window click)) (:EDIT-KEY (EDIT-KEY s-a-spec window click))))) )) (SEND SAM-WINDOW :SET-DISPLAY-ITEM NIL)) )) (DEFUN MAKE-SAM-ROOT () "2Builds the contents of the PROFILE*:2SAM-WINDOW for the System Access Menu, from the current value of PROFILE*:2*ACCESS-SPECS-BUF*.*" (APPEND (LIST NIL (W:SCROLL-PARSE-ITEM '(:STRING "" 61)) (W:SCROLL-PARSE-ITEM '(:STRING " " 1) '(:STRING "SYSTEM" 18) '(:STRING "PRINT NAME" 18) '(:STRING "MENU COLUMN" 13) '(:STRING "SYSTEM-KEY" 11)) (W:SCROLL-PARSE-ITEM '(:STRING " " 1) '(:STRING "----------------" 18) '(:STRING "----------------" 18) '(:STRING "-----------" 13) '(:STRING "----------" 11))) (MAPCAR #'S-A-SPEC->SCROLL-ITEM *ACCESS-SPECS-BUF*) )) (DEFUN S-A-SPEC->SCROLL-ITEM (S-A-SPEC) "2Converts an item of PROFILE*:2*ACCESS-SPECS-BUF* (one access spec) to a general-scroll window item for the System Access Menu. Called by PROFILE*:2MAKE-SAM-ROOT.*" (W:SCROLL-PARSE-ITEM '(:STRING " " 1) `(:STRING ,(SYMBOL-NAME (TV:SYSTEM-KEY-SYSTEM S-A-SPEC)) 16) '(:STRING " " 2) `(:MOUSE (:EDIT-NAME :ARG ,S-A-SPEC :DOCUMENTATION (:MOUSE-L-1 "Edit the name" :MOUSE-R-1 "Assign the system's default print-name" :DOCUMENTATION "The name used in the System Menu and in SYSTEM-HELP")) :FUNCTION (LAMBDA (ARG-LIST) (IF (STRING= "" (TV:SYSTEM-KEY-SYSTEM ARG-LIST)) " " (TV:SYSTEM-KEY-PRINT-NAME ARG-LIST))) ,(LIST S-A-SPEC) 16) '(:STRING " " 2) `(:MOUSE (:EDIT-COLUMN :ARG ,S-A-SPEC :DOCUMENTATION (:MOUSE-L-1 "Choose a different column" :MOUSE-R-1 "Assign the system's default menu column" :DOCUMENTATION "The column in which this system will appear on the System Menu")) :FUNCTION TV:SYSTEM-KEY-COLUMN ,(LIST S-A-SPEC) 11) '(:STRING " " 2) `(:MOUSE (:EDIT-KEY :ARG ,S-A-SPEC :DOCUMENTATION (:MOUSE-L-1 "Enter a new key" :MOUSE-R-1 "Assign the system's default SYSTEM key" :DOCUMENTATION "The SYSTEM key that will access the system")) :FUNCTION TV:SYSTEM-KEY-CHAR ,(LIST S-A-SPEC) 10 ("~:[~:*~A~;~:*~C~]") ) )) (DEFUN VERIFY-THAT-SYSTEM-IS-LOADED (S-A-SPEC &AUX SYSTEM) "2If the system corresponding to S-A-SPEC is loaded (the Defsystem), then S-A-SPEC is returned. If not, it asks if the user if he would like to load it. If so, it tries to load the defsystem. If it fails, it will notify the user and return NIL; otherwise, it will check to see if the print- name of S-A-SPEC is '', in which case it sets the print-name to the system's default, and then returns the new S-A-SPEC.*" (IF (SETQ SYSTEM (SYS:FIND-SYSTEM-NAMED (TV:SYSTEM-KEY-SYSTEM S-A-SPEC) T T)) S-A-SPEC (WHEN (and (TV:SYSTEM-KEY-SYSTEM S-A-SPEC) (W:MOUSE-CONFIRM "This system definition has not been loaded" (FORMAT NIL "Click mouse or press ” to load defsystem.~%~ (This will NOT make the system.)~%~ Move mouse or press to abort."))) (IF (SETQ SYSTEM (SYS:FIND-SYSTEM-NAMED (TV:SYSTEM-KEY-SYSTEM S-A-SPEC) T)) (PROGN (WHEN (STRING= "" (TV:SYSTEM-KEY-PRINT-NAME S-A-SPEC)) (SETF (TV:SYSTEM-KEY-PRINT-NAME S-A-SPEC) (SYS:SYSTEM-NAME SYSTEM))) S-A-SPEC) (PROGN (W:NOTIFY NIL "The system definition could not be loaded") NIL))))) (DEFUN EDIT-NAME (S-A-SPEC WINDOW CLICK) "2Called when user of Systems Access Menu clicks on a print-name. If click is #\MOUSE-L-1 then this function puts up a window and allows the user to edit the name. If click is #MOUSE-R-1 then name is set to the default for the SYSTEM specified in S-A-SPEC. Note that the name can only be 16 characters long.*" (condition-case nil (WHEN (MEMBER CLICK '(#\MOUSE-L-1 #\MOUSE-R-1)) (WHEN (SETQ S-A-SPEC (VERIFY-THAT-SYSTEM-IS-LOADED S-A-SPEC)) (SETF (TV:SYSTEM-KEY-PRINT-NAME S-A-SPEC) (CASE CLICK (#\MOUSE-L-1 (GET-NEW-NAME (TV:SYSTEM-KEY-print-Name S-A-SPEC))) (#\MOUSE-R-1 (SUBSEQ (GETF (SYS:GET-SYSTEM-ACCESS-LIST (TV:SYSTEM-KEY-SYSTEM S-A-SPEC)) :NAME) 0 16)) ))) (SEND WINDOW :REDISPLAY NIL T)))) (DEFUN get-new-name (old-name) (LET ((new-name old-name)) (DECLARE (SPECIAL new-name)) (w:choose-variable-values '((new-name "System Name" :string)) :label "A 16 character system name") new-name)) (DEFUN EDIT-COLUMN (S-A-SPEC WINDOW CLICK) "2Called when user of Systems Access Menu clicks on a system menu column assignment. If CLICK is #\MOUSE-L-1, it brings up a menu of possible System Menu columns from which the user can accept a new column. If CLICK is #\MOUSE-R-1, column is set to the system's default menu column.*" (WHEN (MEMBER CLICK '(#\MOUSE-L-1 #\MOUSE-R-1)) (WHEN (SETQ S-A-SPEC (VERIFY-THAT-SYSTEM-IS-LOADED S-A-SPEC)) (SETF (TV:SYSTEM-KEY-COLUMN S-A-SPEC) (CASE CLICK (#\MOUSE-L-1 (GET-NEW-COLUMN (TV:SYSTEM-KEY-COLUMN S-A-SPEC))) (#\MOUSE-R-1 (GETF (SYS:GET-SYSTEM-ACCESS-LIST (TV:SYSTEM-KEY-SYSTEM S-A-SPEC)) :DEFAULT-MENU-COLUMN))) )) (SEND WINDOW :REDISPLAY nil t))) (DEFUN GET-NEW-COLUMN (OLD-COLUMN) "2Allows the user to choose from a menu of the possible System Menu columns.*" (LET ((ITEM-LIST '(("USER AIDS" . :USER-AIDS) ("PROGRAMS" . :PROGRAMS) ("DEBUG TOOLS" . :DEBUG) ("NONE" . :NONE)))) (OR (W:MENU-CHOOSE ITEM-LIST :LABEL "Choose a column:" :DEFAULT-ITEM (FIND OLD-COLUMN ITEM-LIST :TEST #'EQL :KEY #'CDR)) OLD-COLUMN))) ;(DEFUN EDIT-KEY (S-A-SPEC WINDOW CLICK) ; jlm 4/11/89 ; "2Called when user of System Access Menu clicks on a system-key * ;2 assignment. If CLICK is #\MOUSE-L-1, it prompts the user for a* ;2 new key assignment; if CLICK is #\MOUSE-R-1, it uses the default* ;2 system key from the system's defsystem. In either case it does not* ;2 allow duplicate assignments or CONTROL char's.*" ; (condition-case nil ; (WHEN (MEMBER CLICK '(#\MOUSE-L-1 #\MOUSE-R-1)) ; (WHEN (SETQ S-A-SPEC ; (VERIFY-THAT-SYSTEM-IS-LOADED S-A-SPEC)) ; (LET* ((OLD-KEY (TV:SYSTEM-KEY-CHAR S-A-SPEC)) ; (NEW-KEY (CASE CLICK ; (#\MOUSE-L-1 (GET-NEW-KEY OLD-KEY)) ; (#\MOUSE-R-1 (GETF (SYS:GET-SYSTEM-ACCESS-LIST (TV:SYSTEM-KEY-SYSTEM S-A-SPEC)) ; :DEFAULT-SYSTEM-KEY)) ))) ; (WHEN (NOT (EQL OLD-KEY NEW-KEY)) ; (IF (NOT NEW-KEY) ; (SETF (TV:SYSTEM-KEY-CHAR S-A-SPEC) NIL) ; (COND ; ((EQUAL NEW-KEY #\?) ; (W:MOUSE-CONFIRM ; "The '?' is used to get the System Help screen" ; "Click or move off box to remove.")) ;;;; ((FIND NEW-KEY *ACCESS-SPECS-BUF* ;;;; :TEST #'EQL :KEY #'FIRST) ;;;; (W:MOUSE-CONFIRM ;;;; (FORMAT NIL "The key ~C is already used!" NEW-KEY) ;;;; "Click or move off box to remove.")) ; (T ; (SETF (TV:SYSTEM-KEY-CHAR S-A-SPEC) NEW-KEY)) ))))) ; (SEND WINDOW :REDISPLAY) ))) (DEFUN EDIT-KEY (S-A-SPEC WINDOW CLICK) "2Called when user of System Access Menu clicks on a system-key assignment. If CLICK is #\MOUSE-L-1, it prompts the user for a new key assignment; if CLICK is #\MOUSE-R-1, it uses the default system key from the system's defsystem. In either case it does not allow duplicate assignments or CONTROL char's.*" (LET ((W:*OBSOLETE-SYSTEM-KEYS* nil)) (dolist (x w:*system-keys*) (let ((sys-name (second x))) (when (or (listp sys-name) (typep sys-name 'tv:essential-window) (null sys-name) (member 'SYS:FLAVOR (plist sys-name))) (push x W:*obsolete-system-keys* )))) (WHEN (MEMBER CLICK '(#\MOUSE-L-1 #\MOUSE-R-1)) (WHEN (SETQ S-A-SPEC (VERIFY-THAT-SYSTEM-IS-LOADED S-A-SPEC)) (LET* ((OLD-KEY (FIRST S-A-SPEC)) (NEW-KEY (CASE CLICK (#\MOUSE-L-1 (GET-NEW-KEY OLD-KEY)) (#\MOUSE-R-1 (GETF (SYS:GET-SYSTEM-ACCESS-LIST (SECOND S-A-SPEC)) :DEFAULT-SYSTEM-KEY)) ))) (WHEN (NOT (EQL OLD-KEY NEW-KEY)) (IF (NOT NEW-KEY) (SETF (FIRST S-A-SPEC) NIL) (COND ((EQUAL NEW-KEY #\?) (W:MOUSE-CONFIRM "The '?' is used to get the System Help screen" "Click or move off box to remove.")) ;; ((FIND NEW-KEY *ACCESS-SPECS-BUF* ;; :TEST #'EQL :KEY #'FIRST) ;; (W:MOUSE-CONFIRM ;; (FORMAT NIL "The key ~C is already used!" NEW-KEY) ;; "Click or move off box to remove.")) ((ASSOC NEW-KEY W:*OBSOLETE-SYSTEM-KEYS*) (WHEN (W:MOUSE-CONFIRM "This key will override an assignment made with the old-style add-to-system-key" (FORMAT NIL "Click mouse or press ” to override previous assignment.~%~ Move off window or press to abort assignment.") FONTS:HL12B FONTS:HL12 600) (SETF (FIRST S-A-SPEC) NEW-KEY))) (T (SETF (FIRST S-A-SPEC) NEW-KEY)) ))))) (SEND WINDOW :REDISPLAY) ))) (DEFUN GET-NEW-KEY (OLD-KEY) "2Pops up a window which prompts the user for a character to be used as a System key assignment. It does not allow CONTROL characters or already assigned characters.*" (LET ((new-key old-key)) (DECLARE (SPECIAL new-key)) (setf new-key (w:pop-up-prompt-and-read :character '(:mouse) 32 "Enter a one character system key ~% ~c " old-key)) (if (eql new-key #\abort) (error nil)) (if (eql new-key #\return) (setf new-key nil)) (IF NEW-KEY (IF (EQL NEW-KEY #\SPACE) #\SPACE (CHAR-UPCASE NEW-KEY)) NEW-KEY))) (tv:remove-system-key #\L) (SYS:SET-SYSTEM-ACCESS-LIST 'LISP-LISTENER :NAME "Lisp Listener" :DOCUMENTATION "Evaluate Lisp forms" :DEFAULT-MENU-COLUMN :PROGRAMS :DEFAULT-SYSTEM-KEY #\L :INSTANCE-TYPE :FLAVOR :INSTANCE-FINDER 'W:LISTENER-MIXIN :INSTANCE-CREATOR 'W:LISP-LISTENER) (W:MODIFY-SYSTEM-ACCESS-SPEC 'LISP-LISTENER :ASSIGN-DEFAULTS) (SETF (SYS:SYSTEM-MADE-P 'LISP-LISTENER) T) (when (and (si:find-package "PRINTER") (fboundp 'printer:system-menu-printer-selection)) (SYS:SET-SYSTEM-ACCESS-LIST 'HARD-COPY-MENU :NAME "Hard Copy Menu" :DOCUMENTATION "Print a file or screen image on a selectable printer device" :DEFAULT-MENU-COLUMN :PROGRAMS :DEFAULT-SYSTEM-KEY #\H :INSTANCE-TYPE :EVAL :INSTANCE-FINDER '(PRINTER:SYSTEM-MENU-PRINTER-SELECTION) :INSTANCE-CREATOR t) (W:MODIFY-SYSTEM-ACCESS-SPEC 'HARD-COPY-MENU :ASSIGN-DEFAULTS) (SETF (SYS:SYSTEM-MADE-P 'HARD-COPY-MENU) T)) (when (and (si:find-package "NET") (fboundp 'net:control-menu)) (SYS:SET-SYSTEM-ACCESS-LIST 'NETWORK :NAME "Network" :DOCUMENTATION "Menu of items to control or examine the network" :DEFAULT-MENU-COLUMN :DEBUG :INSTANCE-TYPE :EVAL :INSTANCE-FINDER '(NET:CONTROL-MENU NET:CONTROL-MENU "Network Operations") :INSTANCE-CREATOR t) (W:MODIFY-SYSTEM-ACCESS-SPEC 'NETWORK :ASSIGN-DEFAULTS) (SETF (SYS:SYSTEM-MADE-P 'NETWORK) T)) (when (symbol-plist 'tv:flavor-inspector) (SYS:SET-SYSTEM-ACCESS-LIST 'FLAVOR-INSPECTOR :NAME "Flavor Inspector" :DOCUMENTATION "Browse through flavor structures" :DEFAULT-MENU-COLUMN :DEBUG :INSTANCE-TYPE :FLAVOR :INSTANCE-FINDER 'tv:FLAVOR-INSPECTOR :INSTANCE-CREATOR T) (W:MODIFY-SYSTEM-ACCESS-SPEC 'FLAVOR-INSPECTOR :ASSIGN-DEFAULTS) (SETF (SYS:SYSTEM-MADE-P 'FLAVOR-INSPECTOR) T)) (when (symbol-plist 'tv:inspect-frame) (SYS:SET-SYSTEM-ACCESS-LIST 'INSPECTOR :NAME "Inspector" :DOCUMENTATION "Browse through data structures" :DEFAULT-MENU-COLUMN :DEBUG :DEFAULT-SYSTEM-KEY #\I :INSTANCE-TYPE :FLAVOR :INSTANCE-FINDER 'tv:INSPECT-FRAME :INSTANCE-CREATOR T) (W:MODIFY-SYSTEM-ACCESS-SPEC 'INSPECTOR :ASSIGN-DEFAULTS) (SETF (SYS:SYSTEM-MADE-P 'INSPECTOR) T)) (when (symbol-plist 'tv:peek-frame) (SYS:SET-SYSTEM-ACCESS-LIST 'PEEK :NAME "Peek" :DOCUMENTATION "Display system activities and their current states" :DEFAULT-MENU-COLUMN :DEBUG :DEFAULT-SYSTEM-KEY #\P :INSTANCE-TYPE :FLAVOR :INSTANCE-FINDER 'tv:PEEK-FRAME :INSTANCE-CREATOR T) (W:MODIFY-SYSTEM-ACCESS-SPEC 'PEEK :ASSIGN-DEFAULTS) (SETF (SYS:SYSTEM-MADE-P 'PEEK) T)) (when (fboundp 'tv:trace-via-menus) (SYS:SET-SYSTEM-ACCESS-LIST 'TRACE :NAME "Trace" :DOCUMENTATION "Trace a function, with option selectable from a menu" :DEFAULT-MENU-COLUMN :DEBUG :INSTANCE-TYPE :EVAL :INSTANCE-FINDER '(TV:TRACE-VIA-MENUS) :INSTANCE-CREATOR t) (W:MODIFY-SYSTEM-ACCESS-SPEC 'TRACE :ASSIGN-DEFAULTS) (SETF (SYS:SYSTEM-MADE-P 'TRACE) T)) (W:MODIFY-SYSTEM-ACCESS-SPEC 'PROFILE :ASSIGN-DEFAULTS) (SETF (SYS:SYSTEM-MADE-P 'PROFILE) T) ;jlm 5/08/89 ;;; ******patch only ;;(when (symbol-plist 'profile:profile-frame) ;; (W:DELETE-FROM-SYSTEM-MENU-COLUMN :USER-AIDS "Profile") ;; (SYS:SET-SYSTEM-ACCESS-LIST 'PROFILE ;; :NAME "User Profile" ;; :DOCUMENTATION "Enter facility to modify working Explorer environment" ;; :DEFAULT-MENU-COLUMN :USER-AIDS ;; :DEFAULT-SYSTEM-KEY #\U ;; :INSTANCE-TYPE :FLAVOR ;; :INSTANCE-FINDER 'PROFILE:PROFILE-FRAME ;; :INSTANCE-CREATOR T) ;; (W:MODIFY-SYSTEM-ACCESS-SPEC 'PROFILE ;; :ASSIGN-DEFAULTS) ;; (SETF (SYS:SYSTEM-MADE-P 'PROFILE) T)) ;;(when (and (si:find-package "SUGG") (fboundp 'sugg:system-menu-toggle-suggestions-menus)) ;; (SYS:SET-SYSTEM-ACCESS-LIST 'suggestions ;; :NAME "Suggestions" ;; :DOCUMENTATION "Turn suggestions menus on or off" ;; :DEFAULT-MENU-COLUMN :USER-AIDS ;; :DEFAULT-SYSTEM-KEY #\S ;; :INSTANCE-TYPE :EVAL ;; :INSTANCE-FINDER '(SUGG:SYSTEM-MENU-TOGGLE-SUGGESTIONS-MENUS) ;; :INSTANCE-CREATOR NIL) ;; (W:MODIFY-SYSTEM-ACCESS-SPEC 'suggestions ;; :ASSIGN-DEFAULTS) ;; (SETF (SYS:SYSTEM-MADE-P 'SUGGESTIONS) T)) ;;(when (and (si:find-package "MT") (symbol-plist 'mt:backup-frame)) ;; (SYS:SET-SYSTEM-ACCESS-LIST 'MAGTAPE-BACKUP ;; :NAME "Tape Backup" ;; :DOCUMENTATION "Backup or restore files and directories to or from magnetic tape" ;; :DEFAULT-MENU-COLUMN :PROGRAMS ;; :DEFAULT-SYSTEM-KEY #\B ;; :INSTANCE-TYPE :FLAVOR ;; :INSTANCE-FINDER 'MT:BACKUP-FRAME ;; :INSTANCE-CREATOR T) ;; (W:MODIFY-SYSTEM-ACCESS-SPEC 'MAGTAPE-BACKUP ;; :ASSIGN-DEFAULTS) ;; (SETF (SYS:SYSTEM-MADE-P 'MAGTAPE-BACKUP) T)) ;;(when (symbol-plist 'zwei:converse-frame) ;; (SYS:SET-SYSTEM-ACCESS-LIST 'converse ;; :NAME "Converse" ;; :DOCUMENTATION "Send or receive messages from another Explorer monitor" ;; :DEFAULT-MENU-COLUMN :PROGRAMS ;; :DEFAULT-SYSTEM-KEY #\C ;; :INSTANCE-TYPE :FLAVOR ;; :INSTANCE-FINDER 'ZWEI:CONVERSE-FRAME ;; :INSTANCE-CREATOR T) ;; (W:MODIFY-SYSTEM-ACCESS-SPEC 'converse ;; :ASSIGN-DEFAULTS) ;; (SETF (SYS:SYSTEM-MADE-P 'CONVERSE) T)) ;;(when (and (si:find-package "FED") (symbol-plist 'fed:fed-frame)) ;; (SYS:SET-SYSTEM-ACCESS-LIST 'FONT-EDITOR ;; :NAME "Font Editor" ;; :DOCUMENTATION "Create new fonts or modify existing fonts" ;; :DEFAULT-MENU-COLUMN :PROGRAMS ;; :DEFAULT-SYSTEM-KEY #\F ;; :INSTANCE-TYPE :FLAVOR ;; :INSTANCE-FINDER 'FED:FED-FRAME ;; :INSTANCE-CREATOR '(FED:FED)) ;; (W:MODIFY-SYSTEM-ACCESS-SPEC 'FONT-EDITOR ;; :ASSIGN-DEFAULTS) ;; (SETF (SYS:SYSTEM-MADE-P 'FONT-EDITOR) T)) ;;(when (fboundp 'zwei:read-mail) ;; (w:delete-from-system-menu-column :PROGRAMS "Mail-Reader") ;; (SYS:SET-SYSTEM-ACCESS-LIST 'MAIL-READER ;; :NAME "Mail Reader" ;; :DOCUMENTATION "Manage electronic mail messages" ;; :DEFAULT-MENU-COLUMN :PROGRAMS ;; :DEFAULT-SYSTEM-KEY #\M ;; :INSTANCE-TYPE :EVAL ;; :INSTANCE-FINDER '(ZWEI:READ-MAIL) ;; :INSTANCE-CREATOR NIL) ;; (W:MODIFY-SYSTEM-ACCESS-SPEC 'MAIL-READER ;; :ASSIGN-DEFAULTS) ;; (SETF (SYS:SYSTEM-MADE-P 'MAIL-READER) T)) ;;(when (and (si:find-package "NSE") (fboundp 'user:top-level-edit-namespace)) ;; (SYS:SET-SYSTEM-ACCESS-LIST 'namespace-editor ;; :NAME "Namespace Editor" ;; :DOCUMENTATION "View and/or edit an existing namespace, or create a new one" ;; :DEFAULT-MENU-COLUMN :PROGRAMS ;; :INSTANCE-TYPE :EVAL ;; :INSTANCE-FINDER '(USER:TOP-LEVEL-EDIT-NAMESPACE :SELECT T) ;; :INSTANCE-CREATOR NIL) ;; (W:MODIFY-SYSTEM-ACCESS-SPEC 'namespace-editor ;; :ASSIGN-DEFAULTS) ;; (SETF (SYS:SYSTEM-MADE-P 'NAMESPACE-EDITOR) T)) ;;(when (symbol-plist 'telnet) ;; (SYS:SET-SYSTEM-ACCESS-LIST 'telnet ;; :NAME "Telnet" ;; :DOCUMENTATION "Log in to another machine using the Telnet protocol" ;; :DEFAULT-MENU-COLUMN :PROGRAMS ;; :DEFAULT-SYSTEM-KEY #\T ;; :INSTANCE-TYPE :FLAVOR ;; :INSTANCE-FINDER 'TELNET ;; :INSTANCE-CREATOR T) ;; (W:MODIFY-SYSTEM-ACCESS-SPEC 'telnet ;; :ASSIGN-DEFAULTS) ;; (SETF (SYS:SYSTEM-MADE-P 'TELNET) T)) ;;(when (and (si:find-package "TELNET") (symbol-plist 'telnet:vt100-frame)) ;; (SYS:SET-SYSTEM-ACCESS-LIST 'VT100 ;; :NAME "VT100 Emulator" ;; :DOCUMENTATION "Emulate operation of a VT100 terminal" ;; :DEFAULT-MENU-COLUMN :PROGRAMS ;; :DEFAULT-SYSTEM-KEY #\V ;; :INSTANCE-TYPE :FLAVOR ;; :INSTANCE-FINDER 'TELNET:VT100-FRAME ;; :INSTANCE-CREATOR T) ;; (W:MODIFY-SYSTEM-ACCESS-SPEC 'VT100 ;; :ASSIGN-DEFAULTS) ;; (SETF (SYS:SYSTEM-MADE-P 'VT100) T)) ;;(when (symbol-plist 'zwei:zmacs-frame) ;; (SYS:SET-SYSTEM-ACCESS-LIST 'ZWEI ;; :NAME "Zmacs Editor" ;; :DOCUMENTATION "Editor for editing text or writing programs" ;; :DEFAULT-MENU-COLUMN :PROGRAMS ;; :DEFAULT-SYSTEM-KEY #\E ;; :INSTANCE-TYPE :FLAVOR ;; :INSTANCE-FINDER 'ZWEI:ZMACS-FRAME ;; :INSTANCE-CREATOR T) ;; (W:MODIFY-SYSTEM-ACCESS-SPEC 'ZWEI ;; :ASSIGN-DEFAULTS) ;; (SETF (SYS:SYSTEM-MADE-P 'ZWEI) T))