LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032673. :SYSTEM-TYPE :LOGICAL :VERSION 2. :TYPE "LISP" :NAME "GULF-COAST-PATCHES" :DIRECTORY ("REL3-PUBLIC" "PUBLIC" "GULF-COAST") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2756828091. :AUTHOR "REL3" :LENGTH-IN-BYTES 6761. :LENGTH-IN-BLOCKS 7. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          ;;; -*- Mode:Common-Lisp; Package:(GC :size 200); Fonts:(CPTFONT TR12B TR12BI); Base:10; Patch-file:T -*-;;;********************************************************************************;;;                              GULF Coast patches for main system;;;********************************************************************************tv:(DEFUN tv:KBD-SYS-1 (CH &AUX E W SW MAKENEW FLAVOR-OR-WINDOW SW-ALIAS gulf-coast-mode)  (SETQ MAKENEW (LDB-TEST %%KBD-CONTROL CH)CH (LDB %%KBD-CHAR CH))  (COND ((OR (= CH (char-int #\?)) (= CH (char-int #\HELP))) (USING-RESOURCE (WINDOW POP-UP-FINGER-WINDOW)   (SETF (SHEET-TRUNCATE-LINE-OUT-FLAG WINDOW) 0)   (FUNCALL WINDOW ':SET-LABEL "Keyboard system commands")   (WINDOW-CALL (WINDOW :DEACTIVATE)     (FORMAT WINDOW     "Press ~:@C and one of the following characters to create the first ~%~                      instance of or select the most recently used window for the corresponding ~%~                      program.~2%" #\SYSTEM)     (FORMAT WINDOW     "Press ~:@C CTRL and one of the following characters to create a new ~%~                      window for the corresponding program.~2%" #\SYSTEM)     (FORMAT WINDOW     "Press ~:@C to do nothing if you pressed ~:@C by accident.~2%" #\RUBOUT #\SYSTEM)     (LET ((LIST (SORTCAR (COPY-LIST *SYSTEM-KEYS*) #'ALPHALESSP)) (TEM (char-int #\?)))       (DOLIST (X LIST) (OR (CHAR-EQUAL TEM (SETQ TEM (CAR X)))     (FORMAT WINDOW "~&~C~8T~A" TEM (CADDR X)))))      (FORMAT WINDOW "~2&~A" *REMOVE-TYPEOUT-STANDARD-MESSAGE*)     ;; Let kbd process proceed before we TYI.     (SETQ KBD-TERMINAL-TIME NIL)     (FUNCALL WINDOW ':TYI))))((SETQ E (ASSoc CH *SYSTEM-KEYS* :test #'CHAR=)) ;; Find the most recently selected window of the desired type. ;; If it is the same type as the selected window, make that the ;; least recently selected so as to achieve the cycling-through effect. ;; Otherwise the currently selected window becomes the most recently ;; selected as usual, and TERM S will return to it. ;; In any case, we must fake out :MOUSE-SELECT's typeahead action since ;; that has already been properly taken care of and we don't want to snarf ;; any characters already typed after the [SYSTEM] command. (SETQ FLAVOR-OR-WINDOW       (COND ((LISTP (SECOND E)) (EVAL (SECOND E)))     (T (SECOND E)))) (DELAYING-SCREEN-MANAGEMENT;Inhibit auto selection   (SETQ SW SELECTED-WINDOW)   (WHEN SW (SETQ SW-ALIAS (SEND SW ':ALIAS-FOR-SELECTED-WINDOWS)))   (setq gulf-coast-mode (let* ((flavor-definition (and (symbolp FLAVOR-OR-WINDOW)       (get FLAVOR-OR-WINDOW 'si:flavor)))        (type-of-GC-background  (and flavor-definition       (member 'gc:gulf-coast        (si:flavor-depends-on-all flavor-definition)))))   (and (not type-of-GC-background) ;;ALL GULF-COAST backgrounds at top level(gc:find-gulf-coast-background tv:selected-window))))   (COND ((TYPEP FLAVOR-OR-WINDOW 'ESSENTIAL-WINDOW)  ;; If the *SYSTEM-KEYS* list has a specific window indicated, use that.  (AND SW (FUNCALL SW ':DESELECT NIL))  (FUNCALL FLAVOR-OR-WINDOW ':MOUSE-SELECT)) ;; NIL means he already did whatever he wanted. ((NULL FLAVOR-OR-WINDOW) NIL) ((AND (NOT MAKENEW)       (SETQ W (FIND-WINDOW-OF-FLAVOR FLAVOR-OR-WINDOW)))  ;; Cycle through other windows of this flavor.  (WHEN SW ;;restore both last window and last background to previous-selected array    (let ((last-background (gc:find-gulf-coast-background sw)))      (and last-background   (tv:add-to-previously-selected-windows      last-background      (if (typep (gc:find-gulf-coast-background w) (typep last-background)) ':end))))    (FUNCALL SW ':DESELECT     (IF (TYPEP SW-ALIAS FLAVOR-OR-WINDOW) ':END)))  ;;if GULF-COAST background where type-out is selected, place GC background at end  (if (send w :send-if-handles :gulf-coast-p)      (tv:add-to-previously-selected-windows w :at-end))  (FUNCALL W ':MOUSE-SELECT)) ((AND (NOT MAKENEW) SW       (TYPEP SW-ALIAS FLAVOR-OR-WINDOW))  ;; There is only one window of this flavor, and this is it.  (BEEP)) ((NULL (FOURTH E)) (BEEP));Cannot create ((Not (consp (FOURTH E)))  ;; Create a new window of this flavor.  ;; We create on the default screen.  (AND SW (FUNCALL SW ':DESELECT   (IF (TYPEP SW-ALIAS FLAVOR-OR-WINDOW)       ':END)))  (let ((flavor-type (IF (EQ (FOURTH E) T) FLAVOR-OR-WINDOW (FOURTH E))))    (if gulf-coast-mode(let ((result (gc:create-window-with-mouseFLAVOR-type 'mouse:gulf-coast-background gulf-coast-mode)))  (and result (FUNCALL result ':MOUSE-SELECT)))(FUNCALL (MAKE-WINDOW flavor-type ':SUPERIOR DEFAULT-SCREEN) ':MOUSE-SELECT)))) (T (if gulf-coast-mode(let ((default-screen gulf-coast-mode))  (EVAL (FOURTH E)))(EVAL (FOURTH E)))))))((NOT (= CH (char-int #\RUBOUT))) (BEEP)))  (SETQ KBD-TERMINAL-TIME NIL))tv:(DEFUN FIND-WINDOW-OF-FLAVOR (FLAVOR)  "Find a previously selected window whose flavor includes FLAVOR."  (DOTIMES (I (ARRAY-LENGTH PREVIOUSLY-SELECTED-WINDOWS))    (LET ((W (AREF PREVIOUSLY-SELECTED-WINDOWS I)))     (WHEN W       (AND W (TYPEP W FLAVOR) (FUNCALL W ':NAME-FOR-SELECTION)    (RETURN W))       (or (send w :send-if-handles :gulf-coast-p)   (LET ((WSS (SEND W ':SELECTION-SUBSTITUTE)))     (AND WSS (TYPEP WSS FLAVOR) (FUNCALL WSS ':NAME-FOR-SELECTION)  (RETURN WSS))))))))ucl:(DEFMETHOD (BASIC-COMMAND-LOOP :lookup-keys) (key-sequence &AUX command)  "Looks through the active command tables looking for a command claiming the keystroke sequenceKEY-SEQUENCE.  Returns NIL or the found UCL:COMMAND and its command table or a flag:FETCH-MORE-KEYS indicating the user needs to type more keys."  (looping-through-command-tables NIL    ;;When a ucl:command is found, return it.  Otherwise return nil.    (WHEN (SETQ command (SEND command-table :lookup-keys key-sequence))      (RETURN command command-table))    (and (null groups) (null group) (when (multiple-value-setq (command command-table) (find-ucl-command-in-hierarchy key-sequence self))   (RETURN command command-table)))));;this is a helper function for aboveucl:(defun find-ucl-command-in-hierarchy (key-sequence current &aux command command-table)  (loop for superior = (send current :send-if-handles :superior)for table = (and superior (send superior :send-if-handles :active-command-tables))when (null superior)do (return nil)else do (setq current superior)when  (and superior table)do (WHEN (multiple-value-setq (command command-table)   (send superior :lookup-keys key-sequence))     (RETURN command command-table))))make-window flavor-name                                  ':superior gulf-coast-background ':edges tem))) (SEND window :send-if-handles :set-current-application       (SEND gulf-coast-background :current-application)) (send window :besure-inside-superior) (funcall window ':select) window)))(defun decode-mouse-method (button)  (case (int-char button)    (#\mouse-L-1 :mouse-L-1)    (#\mouse-