;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*- ;;; Reason: Changes to cover 3-pixel high strip between who line doc ;;; window and who line status line for MMON-p systems. ;;; Reason: Changes to cover 3-pixel high strip between who line doc ;;; window and who line status line for MMON-p systems. ;;; 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 149149, M/S 2151 ;;; AUSTIN, TEXAS 78714-9149 ;;; ;;; Copyright (C) 1989 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Written 06/16/90 11:15:28 by marky, ;;; while running on LIBRA from band LODA ;;; With SYSTEM 6.38, VIRTUAL-MEMORY 6.3, EH 6.8, MAKE-SYSTEM 6.3, MICRONET 6.0, LOCAL-FILE 6.2, ;;; BASIC-PATHNAME 6.5, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.8, NETWORK-NAMESPACE 6.1, ;;; DISK-IO 6.3, DISK-LABEL 6.1, BASIC-FILE 6.13, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.2, ;;; COMPILER 6.18, TV 6.26, DATALINK 6.0, CHAOSNET 6.8, GC 6.4, MEMORY-AUX 6.0, NVRAM 6.3, ;;; SYSLOG 6.2, STREAMER-TAPE 6.6, UCL 6.0, INPUT-EDITOR 6.0, METER 6.2, ZWEI 6.22, ;;; DEBUG-TOOLS 6.5, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.7, MAC-PRINTER-TYPES 6.2, PRINTER-TYPES 6.2, ;;; IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.6, MAIL-READER 6.8, TELNET 6.1, VT100 6.0, ;;; NAMESPACE-EDITOR 6.6, PROFILE 6.3, VISIDOC 6.7, TI-CLOS 6.51, CLEH 6.5, IP 3.65, ;;; Experimental BUG 11.19, Experimental CLX 6.0, Experimental CLUE 6.0, X11M 6.30, ;;; microcode 483, Band Name: Rel 6.1 + SLE 6/12 ;;; This patch will only take effect after a disk-save. #!C ; From file WHOLIN.LISP#> WINDOW; Hotel: #10R TV#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "TV")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: WINDOW; WHOLIN.#" (DEFUN INITIALIZE-STATUS-LINE (&OPTIONAL (INITIAL-CREATION NIL)) (LET* ((CURRENT-CHARACTER-POSITION 0) (LAST-CHARACTER-POSITION 0) (STATUS-LINE-CHAR-WIDTH (FONT-CHAR-WIDTH *STATUS-LINE-STANDARD-FONT*)) (WHO-LINE-HEIGHT (SHEET-HEIGHT WHO-LINE-SCREEN)) (WHO-LINE-LINE-HEIGHT (SHEET-LINE-HEIGHT WHO-LINE-SCREEN)) ;; may 11/21/89 Start patch to cover 3 pixel high line between doc-widow and status line (gap-window-name "Vsp Gap") (who-doc-window-height ;; Below is same calc as :height arg of who-line-documentation-window ;; in WHO-LINE-SETUP's call to who-line-screen. (+ (* default-number-of-who-line-documentation-lines (+ (font-char-height *mouse-documentation-line-standard-font*) who-line-vsp)) who-line-vsp))) (let ((old-gap (find gap-window-name (SHEET-INFERIORS WHO-LINE-SCREEN) :key #'(lambda (wind) (send wind :name)) :test #'string-equal))) (when old-gap (send old-gap :deactivate)) ;; since size or colors may have changed ;; We will allocate a vsp above and below the last line, (in call to define-screen in ;; #'who-line-setup ...) but the status windows will only include the font-height and ;; the vsp gap below. The vsp gap above the status windows is covered by THIS window ;; defined BELOW : (who-line-field :flavor 'who-line-sheet :name gap-window-name :vsp 0 :background-color *default-status-background* :foreground-color *default-status-foreground* :height who-line-vsp :left 0 :right main-screen-width :top who-doc-window-height)) ;; may 11/21/89 End patch ;; 18 or 20 characters of the date and time. (SETQ LAST-CHARACTER-POSITION ;; The 12 hour clock needs 2 more characters than ;; the 24 hour version to show the AM/PM indicator. (+ 18 (IF (12-HOUR-CLOCK-P) 2. 0.))) (IF INITIAL-CREATION (SETQ NWATCH-WHO-LINE-SHEET (WHO-LINE-FIELD :FLAVOR 'WHO-LINE-SHEET :name "Nwatch" ;; added for multiple screen support. 02/17/88 KJF :VSP 0 :WHO-LINE-UPDATE-FUNCTION (IF (12-HOUR-CLOCK-P) 'NWATCH-WHO-FUNCTION-12 'NWATCH-WHO-FUNCTION-24) :background-color *default-status-background* :foreground-color *default-status-foreground* :HEIGHT WHO-LINE-LINE-HEIGHT :LEFT 0 :RIGHT (* LAST-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) :BOTTOM WHO-LINE-HEIGHT)) ;;ELSE (PROGN ;; Only update those things that can change. (SEND NWATCH-WHO-LINE-SHEET :SET-SIZE (* LAST-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) WHO-LINE-LINE-HEIGHT) (SEND NWATCH-WHO-LINE-SHEET :SET-WHO-LINE-UPDATE-FUNCTION (IF (12-HOUR-CLOCK-P) 'NWATCH-WHO-FUNCTION-12 'NWATCH-WHO-FUNCTION-24)) ;; We need to clear out the extra state so that it gets initialized ;; in the nwatch function to its proper value. (SEND NWATCH-WHO-LINE-SHEET :SET-WHO-LINE-EXTRA-STATE NIL))) (SETQ CURRENT-CHARACTER-POSITION LAST-CHARACTER-POSITION) (SETQ LAST-CHARACTER-POSITION (+ LAST-CHARACTER-POSITION 13.)) ;; 13 characters of user id or process. (IF INITIAL-CREATION (SETQ USER-ID-WHO-LINE-SHEET (WHO-LINE-FIELD :FLAVOR 'WHO-LINE-SHEET :name "User Id" ;; added for multiple screen support. 02/17/88 KJF :VSP 0 :WHO-LINE-UPDATE-FUNCTION 'WHO-LINE-USER-OR-PROCESS :background-color *default-status-background* :foreground-color *default-status-foreground* :HEIGHT WHO-LINE-LINE-HEIGHT :LEFT (* CURRENT-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) :RIGHT (* LAST-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) :BOTTOM WHO-LINE-HEIGHT)) ;;ELSE ;; Only the position can change; the size remains constant. (SEND USER-ID-WHO-LINE-SHEET :SET-POSITION (* CURRENT-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) (- WHO-LINE-HEIGHT WHO-LINE-LINE-HEIGHT))) (SETQ CURRENT-CHARACTER-POSITION LAST-CHARACTER-POSITION) (SETQ LAST-CHARACTER-POSITION (+ LAST-CHARACTER-POSITION 10.)) ;; 10 characters of package. (IF INITIAL-CREATION (SETQ CURRENT-PACKAGE-WHO-LINE-SHEET (WHO-LINE-FIELD :FLAVOR 'WHO-LINE-SHEET :name "Current Package" ;; added for multiple screen support. 02/17/88 KJF :VSP 0 :WHO-LINE-UPDATE-FUNCTION 'WHO-LINE-PACKAGE :background-color *default-status-background* :foreground-color *default-status-foreground* :HEIGHT WHO-LINE-LINE-HEIGHT :LEFT (* CURRENT-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) :RIGHT (* LAST-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) :BOTTOM WHO-LINE-HEIGHT)) ;;ELSE ;; Only the position can change; the size remains constant. (SEND CURRENT-PACKAGE-WHO-LINE-SHEET :SET-POSITION (* CURRENT-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) (- WHO-LINE-HEIGHT WHO-LINE-LINE-HEIGHT))) (SETQ CURRENT-CHARACTER-POSITION LAST-CHARACTER-POSITION) (SETQ LAST-CHARACTER-POSITION (+ LAST-CHARACTER-POSITION 21.)) ;; 21 characters of process state. (IF INITIAL-CREATION (SETQ WHO-LINE-RUN-STATE-SHEET (WHO-LINE-FIELD :FLAVOR 'WHO-LINE-SHEET :name "Run State" ;; added for multiple screen support. 02/17/88 KJF :VSP 0 :WHO-LINE-UPDATE-FUNCTION 'WHO-LINE-RUN-STATE :background-color *default-status-background* :foreground-color *default-status-foreground* :LEFT (* CURRENT-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) :RIGHT (* LAST-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) :HEIGHT WHO-LINE-LINE-HEIGHT :BOTTOM WHO-LINE-HEIGHT)) ;;ELSE ;; Only the position can change; the size remains constant. (SEND WHO-LINE-RUN-STATE-SHEET :SET-POSITION (* CURRENT-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) (- WHO-LINE-HEIGHT WHO-LINE-LINE-HEIGHT))) (SETQ CURRENT-CHARACTER-POSITION LAST-CHARACTER-POSITION) (SETQ LAST-CHARACTER-POSITION (+ LAST-CHARACTER-POSITION 36.)) ;; The remaining characters go to the file/idle/boot state. (IF INITIAL-CREATION (SETQ WHO-LINE-FILE-STATE-SHEET (WHO-LINE-FIELD :FLAVOR 'WHO-LINE-FILE-SHEET :name "File State" ;; added for multiple screen support. 02/17/88 KJF :VSP 0 :background-color *default-status-background* :foreground-color *default-status-foreground* :LEFT (* CURRENT-CHARACTER-POSITION STATUS-LINE-CHAR-WIDTH) :RIGHT MAIN-SCREEN-WIDTH :HEIGHT WHO-LINE-LINE-HEIGHT :BOTTOM WHO-LINE-HEIGHT)) ;;ELSE ;; Only t