;;; -*- Mode:Common-Lisp; Package:PROFILE; Fonts:(COURIER HL12B HL12BI); Base:10 -*- ;;; 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) 1984- 1989 Texas Instruments Incorporated. All Rights Reserved. ;;; ;;; 5/08/89 JLM Removed w::add-to-system-menu-column call for profile it is now done in SAM ;1;; Window interface for the profile utility* ;(DEFPARAMETER *profile-frame* () "1Entire Profile2 *Frame*") ;;added for Profile 3.2 9/87 slm See COLOR VARIABLES in VARIABLES.LISP for example (DEFVAR *profile-restore-p* nil "Set to T whenever variables are being updated by a \"RESTORE\" command. Intended to be used by functions in the :SET-EFFECT to indicate when and when NOT to ask for user input.") (DEFPARAMETER *profile-help-documentation* " PROFILE HELP The Profile utility provides an interface to the customization of many of the important variables and features on the Explorer. There are three windows in the Profile display. The large top window 2 *(the one where this message is presented) displays the current selection of variables in the form of a choose-variable-values menu. These variables are changed by clicking Mouse-Left. The small menu beneath the top window is entitled \"Actions\". This window provides the following commands: STORE OPTIONS -- Stores the changed variables in an initialization file that can be loaded. RESTORE SYSTEM DEFAULTS -- Undo all of the user modifications to the variables. RESTORE USER DEFAULTS -- Restore all user variables from the initialization file. EXIT -- Exits the Profile utility. The bottom menu is entitled \"Variables currently displayed\". A specific class of variables can be selected (click Mouse-Left) from this window and be displayed in the top window. ") ;1;;* ;1;; FLAVOR DEFINITIONS* ;1;; * (DEFFLAVOR profile-menu-pane () (1;w:borders-mixin* 1 ;w:top-box-label-mixin* w:menu) 1 ;w:command-menu-pane* 1 ;w:menu-highlighting-mixin)* :settable-instance-variables (:documentation :combination "2Menu panes for the profile display.*") (:default-init-plist :command-menu t)) (DEFMETHOD (profile-menu-pane :execute-menu-item) (menu-item) "2Executes the specifed MENU-ITEM.*" (DECLARE (VALUES exit-command-loop-p)) (CONDITION-CASE (error-condition) (LET ((dont-exit-command-loop nil)) (CASE (SEND SELF :execute menu-item) (1:abort* :abort) (1:exit* :exit) (1:build* (BEEP) dont-exit-command-loop) (1:store-options* (CONDITION-BIND ((fs::directory-not-found-error (function (lambda (condition) (IF (ERRORP (fs:create-directory (SEND condition :PATHNAME) :error () :recursive t)) () ;1Couldn't handle it* (VALUES :retry-file-operation)))))) (write-init-file)) dont-exit-command-loop) (1:restore-system-defaults* (let ((*profile-restore-p* t)) (revert-profile-variables ()) ;;Done by revert (perform-required-actions) ;;;; A refresh is NOT sufficient to make the displayed items ;;;; show their updated values, particularly when the value is changed ;;;; through a :SET-EFFECT. We HAVE to set the current variable ;;;; class instead. 9/14/87 slm; for Profile 3.2 ;;;; (SEND (SEND w:superior :cvv-pane) :refresh) (send *profile-frame* :set-current-variable-class (send *profile-frame* :current-variable-class))) dont-exit-command-loop) (1:restore-user-defaults* (let ((*profile-restore-p* t)) (revert-profile-variables () ()) (restore-init-file-changes) ;;;; Again, a refresh is NOT sufficient to make the displayed items ;;;; show their updated values, particularly when the value is changed ;;;; through a :SET-EFFECT. We HAVE to set the current variable ;;;; class instead. 9/14/87 slm; for Profile 3.2 ;;;; (SEND (SEND w:superior :cvv-pane) :refresh) (send *profile-frame* :set-current-variable-class (send *profile-frame* :current-variable-class))) dont-exit-command-loop))) (ERROR error-condition))) (DEFFLAVOR profile-cvv-pane () (w:choose-variable-values-pane)) (DEFMETHOD (profile-cvv-pane :redisplay-variable-if-present) (variable) "2Checks to see if the variable is a valid variable in the current window. If so, the variable is redisplayed.*" (WHEN (ASSOC variable (LISTARRAY tv:items) :TEST #'EQ) (SEND self :redisplay-variable variable))) ;(DEFVAR last-refresh-time (TIME)) ;(DEFVAR number-of-refreshes 0) ;(DEFMETHOD (profile-cvv-pane :before :refresh) (&rest IGNORE) ; (LET ((current-time (TIME))) ; (IF (> (TIME-DIFFERENCE current-time last-refresh-time) 300) ; (SETQ last-refresh-time current-time ; number-of-refreshes 1) ; (INCF number-of-refreshes) ; (WHEN (>= number-of-refreshes 2) ; (SEND w:superior :deexpose) ; (SEND w:.current-window. :select nil) ; (BREAK) ; (SETQ last-refresh-time current-time)))) ; ) (DEFFLAVOR1 profile-frame 3 ** ((selection-menu-pane nil) (action-menu-pane nil) (cvv-pane nil) (current-variable-class '*important-variables*)) 3 * (w:inferiors-not-in-select-menu-mixin w:process-mixin ;1Process-Mixin should come before Select-Mixin (See doc for P-M)* 1 ;;W:window replaces explicit mixin flavors w:select-mixin, w:borders-mixin, w:label-mixin,* 1 ;;and w:stream-mixin* 1 ;w:select-mixin* 1 ;w:borders-mixin* 1 ;w:label-mixin* w:essential-mouse w:window-with-typeout-mixin 1 ;w:stream-mixin* w:window w:bordered-constraint-frame-with-shared-io-buffer) :gettable-instance-variables ;(:settable-instance-variables current-variable-class) (:method-combination (:case :base-flavor-last :execute-blip)) (:default-init-plist :save-bits :delayed ;Don't create a bit-save array until we need it ;1;Process initialization is done in :AFTER :INIT method* ) (:documentation "2The main frame in which all profile display occurs.*") ) (DEFPARAMETER *action-menu-item-list* '(("1Store Options*" :value :store-options :documentation "Store current options in an initialization file so that your changes can be restored next time you login.") ("1Restore System Defaults*" :value :restore-system-defaults :documentation "Restore System defaults to original values.") ("1Restore User Defaults*" :value :restore-user-defaults :documentation "Restore all profile variables to their original values after the initialization file was loaded (at login using PROFILE-SETQ).") ("1Exit*" :value :exit :documentation "Exit the profile utility." :font fonts:HL12B)) "2The menu item list for the action menu in the profile utility.*") ;1;Font Changes (to CPTFONT) in Profile 2.2 -dlc* (DEFMETHOD 1 (PROFILE-FRAME :BEFORE :INIT)* (IGNORE) "2Set panes and constraints.*" (SETQ tv:PANES `((selection-menu-pane profile-menu-pane :label (:font ,fonts:hl12i :string " Variables currently displayed:") :default-font ,fonts:hl12 :command-menu t :permanent t :highlighted-items '(*important-variables*) :borders (1 2 0 2) :item-list ,(LOOP for CLASS in *variable-classes* collect (LIST (class-name CLASS) :value (class-variable CLASS) :documentation (class-documentation CLASS)))) (action-menu-pane profile-menu-pane :label (:font ,fonts:hl12i :string " Actions") :default-font ,fonts:hl12 :command-menu t :permanent t :borders (0 2 1 2) :item-list ,*action-menu-item-list*) (cvv-pane profile-cvv-pane :variables ,(make-cvv-variable-list *important-variables*) ;1;The following three fonts changed to CPTFONT in Profile 2.2 as* ;1; a workaround to the inability of the Input Editor to handle anything else -DLC* :name-font fonts:cptfont :value-font fonts:cptfont :string-font fonts:cptfont :function cvv-constraint-function ;1;;use the Lisp Listener's stack group -Profile 2.2* :stack-group ,(send (SEND w:initial-lisp-listener :process) :stack-group) :label nil :value-tab 350 ;1Changed from 300 in Profile 2.2* :margin-scroll-regions ((:top "Top of Variables for this Class" "More Variables Above") (:bottom "Bottom of Variables for this Class" "More Variables Below")) :margin-choices nil))) (SETQ tv:constraints (IF tv::*landscape-monitor* '((main (cvv-pane action-menu-pane selection-menu-pane) ((action-menu-pane :ask :pane-size)) ((selection-menu-pane :ask :pane-size)) ((cvv-pane :even)))) '((main (cvv-pane menus) ((menus :horizontal (12 :lines selection-menu-pane) (action-menu-pane selection-menu-pane) ((action-menu-pane 12 :characters)) ((selection-menu-pane :even)))) ((cvv-pane :even)))))) 3 *)3 * (DEFMETHOD (profile-frame :after :init) (&rest IGNORE) 2"Sets up the various panes."* (SETQ selection-menu-pane (SEND SELF :get-pane 'selection-menu-pane) action-menu-pane (SEND SELF :get-pane 'action-menu-pane) cvv-pane (SEND SELF :get-pane 'cvv-pane)) ;;Color support added for 3.2 by SLM. Code read PMH and KJF. (send action-menu-pane :set-background-color w:25%-gray-color) (send action-menu-pane :set-label-background w:50%-gray-color) (send selection-menu-pane :set-background-color w:25%-gray-color) (send selection-menu-pane :set-label-background w:50%-gray-color) (send selection-menu-pane :set-highlighting-color w:green) (WHEN (NULL w:typeout-window) (SETQ w:typeout-window (tv:make-window 'w:typeout-window :deexposed-typeout-action '(:expose-for-typeout) :font-map '(fonts:tr12 fonts:tr12i fonts:tr12b fonts:tr12bi) :io-buffer w:io-buffer :superior self))) (SETQ tv:process (MAKE-PROCESS w:name :special-pdl-size 4000. :regular-pdl-size 4000)) (PROCESS-PRESET tv:process self :command-loop) (SEND tv:process :run-reason self) (SEND selection-menu-pane :add-highlighted-value '*important-variables*) )3 * (DEFMETHOD (profile-frame :before :select) (&rest ignore) "2Sets the global variables when this window is selected.*" (SETQ *profile-frame* self) )3 * (DEFMETHOD (profile-frame :set-current-variable-class) (CLASS) "2CLASS must be a variable (symbol) or a keyword representing a variable class.*" (WHEN (KEYWORDP CLASS) (SETF CLASS (CLASS-KEYWORD-TO-VARIABLE CLASS))) (UNLESS (NULL CLASS) (SETF current-variable-class CLASS) (w:with-sheet-deexposed (self) (SEND selection-menu-pane :set-highlighted-values (LIST CLASS)) (SEND cvv-pane :set-variables (make-cvv-variable-list (SYMBOL-VALUE CLASS)) t)))) (DEFMETHOD (profile-frame :case :execute-blip :menu) (blip) "2Executes the blip from one of the menus.*" (DECLARE (SPECIAL exit-p)) (LET ((window (FOURTH blip)) (menu-item (SECOND blip))) (SELECT window (selection-menu-pane (SEND SELF :set-current-variable-class (SEND window :execute menu-item))) (action-menu-pane (SETQ exit-p (SEND window :execute-menu-item menu-item)))))) (DEFMETHOD (profile-frame :case :execute-blip :variable-choice) (blip) "2Handles the :variable-choice blip.*" (w:choose-variable-values-process-message cvv-pane blip) (SEND self :select)) ;1;;Removed call to BEEP if a legal Mouse-Blip wasn't present - Profile 2.6* (DEFMETHOD (profile-frame :case :execute-blip :mouse-button) (blip) "2Handles the :mouse-button blip. Used for bringing up the system menu.*" (IF (CHAR-EQUAL #\mouse-r (SECOND blip)) (w:mouse-call-system-menu) )) (DEFMETHOD (profile-frame :execute-blip) (blip) "2The :CASE methods should handle all defined blips. If this primary method is called, then the blip is undefined.*" (DECLARE (IGNORE blip)) (BEEP)) (DEFMETHOD (profile-frame :execute-character-input) (character) "2Handles the input CHARACTER.*" (DECLARE (SPECIAL exit-p)) (CASE CHARACTER (#\end (SETQ exit-p :end-key)) (#\break (SEND *terminal-io* :expose-for-typeout) (SEND *terminal-io* :select) (LET () (BREAK "Profile" ())) (SEND SELF :set-configuration (SEND self :configuration)) (SEND *terminal-io* :make-complete)) (#\help (VIEW-DOCUMENTATION *profile-help-documentation*)) (#\page (SEND cvv-pane :refresh)))) (DEFMETHOD (profile-frame :3command-loop*) () "2The command loop to process menu selection inputs.*" (LET ((*terminal-io* (SEND self :typeout-window)) (exit-p nil) (just-entered-command-loop-p t) (w:kbd-intercepted-characters (REMOVE (ASSOC (char-code #\break) w:kbd-intercepted-characters :TEST #'EQ) (THE LIST w:kbd-intercepted-characters) :TEST #'EQUAL))) (DECLARE (SPECIAL exit-p)) (LOOP (ERROR-RESTART ((system:abort ERROR) "Profile Top Level.") ;1;A kludge to prevent CVV pane from flashing when the window is first created* (IF just-entered-command-loop-p (SETQ just-entered-command-loop-p ()) (SEND cvv-pane :refresh)) (SETQ exit-p ()) (LOOP until exit-p when (SEND *terminal-io* :incomplete-p) do (SEND *terminal-io* :make-complete) and do (SEND self :set-configuration (SEND self :configuration)) for command = (SEND SELF :read-any) when (CONSP command) do (SEND self :execute-blip (FIRST command) command) else do (SEND self :execute-character-input command) when (ERRORP exit-p) ;1error-p is really an error condition* do (w:notify () (SEND exit-p :report-string)) (SETF exit-p ()) finally (RETURN exit-p)) (w:deselect-and-maybe-bury-window self))))) (COMPILE-FLAVOR-METHODS profile-menu-pane profile-frame) (DEFUN make-cvv-variable-list (variables) "2Given a list of variables, returns a list of cvv items for those variables.*" (LOOP for var in variables collect (make-cvv-item var))) (DEFUN PROFILE (&OPTIONAL ARG) "2This is the user-callable function that selects the profile utility.*" (DECLARE (IGNORE arg)) (w:select-or-create-window-of-flavor 'profile-frame) (tv:await-window-exposure) (VALUES)) ;1;No returned value* ;1;Maybe later. This might be a good thing to put in your login init file.* ;(w:add-terminal-key #\R 'PROFILE "2User profile utility.*") ; "2User profile utility.*") ;1;Not Really... What we want to do is add this to the SYSTEM key menu! --9/86 slm* ;(w:add-system-key #\R 'PROFILE-FRAME 2"Profile utility - View/change system customization variables."* '(PROFILE)) ;1;;Changed to :USER-AIDS in Profile 2.2 -dlc* ;(w::add-to-system-menu-column ; :user-aids "Profile" ; '(w:select-or-create-window-of-flavor 'profile-frame) ; "2Enter the User Profile facility, to modify working Explorer environment.*") ;1;;Do eval of all arguments after cvv-type -Profile 2.2 -dlc* (DEFUN make-cvv-item (variable) (WHEN (GET variable 'get-value) (SET variable (variable-current-value variable))) (LIST* variable (variable-name variable) :documentation (variable-documentation variable) (LET ((type (variable-type variable))) (IF (NOT (CONSP type)) (LIST type) (CONS (FIRST TYPE) (MAPCAR 'EVAL (REST type))))))) ;1;EVAL all items, not just SECOND -Profile 2.2* (DEFUN initialize-profile () "2Initializes the Profile windows and such.*" ;1;First destroy any existing Profile windows* (LOOP for window-to-die = (w:find-window-of-flavor 'profile-frame) until (NULL window-to-die) do (SEND window-to-die :kill)) (REMPROP 'profile-frame 'w::unnamed-window-instance-count) (SETQ *profile-frame* ())) ;1;Don't create windows in advance*(MAKE-INSTANCE 'profile-frame :activate-p t))) (initialize-profile)