[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Character Styles



    Date: Sun, 11 Feb 90 15:32:40 +0200
    From: luria%TECHSEL.BITNET@cunyvm.cuny.edu (Marc Luria)

    How do I change the default character styles for various windows?
    For example, say I want the terminal window to be fix.roman.large,
    and the editor window to be dutch.roman.very-large.  In addition, in Zmacs could
    I have different defaults for different file types, i.e. text, lisp, etc.
    I know how to change these thing by using attributes on the system
    menu, but don't how to say "make all existing windows and any new ones,
    use a particular default character style"
    While I'm at it, I'd also like to change the deexposed typeout action, to let it
    happen.

    luria@techsel.bitnet

Here is some of the code I use to do this; you probably want variations on
this theme. I only deleted from the included files functions that were
obviously irrelevant, so consider this an overly verbose answer to your
request. Note that while it tries hard to affect Zmail, it doesn't work for
messages received, only sent, unfortunately. Note that the following get
loaded into a private world save, and don't really expect to be loaded >
once.


;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10; Vsp: 1; -*-

(DEFCONSTANT MY-FILL-GOAL 76)			      ;# columns fill
;; the following two are *minimum* fill goals...
(DEFCONSTANT MY-TEX-FILL-GOAL 110)
(DEFCONSTANT MY-LISP-FILL-GOAL 130)
1(DEFPARAMETER MY-LISP-FONT '(:FIX :CONDENSED :SMALL))
0(DEFPARAMETER MY-TEXT-FONT '(:FIX :CONDENSED :NORMAL))
(DEFPARAMETER MY-TEXT-STYLE (SI:INTERN-CHARACTER-STYLE :FIX :CONDENSED :NORMAL))
(DEFPARAMETER MY-TEX-FONT '(:FIX :CONDENSED :NORMAL))
(DEFPARAMETER MY-MAIL-FONT '(:FIX :CONDENSED :NORMAL))
(DEFPARAMETER MY-WHOLINE-FONT '(:FIX :EXTRA-CONDENSED :SMALL))
(DEFPARAMETER MY-WHOLINE-STYLE (SI:INTERN-CHARACTER-STYLE :FIX :EXTRA-CONDENSED :SMALL))
(DEFPARAMETER MY-NVT-STYLE (SI:INTERN-CHARACTER-STYLE :FIX :EXTRA-CONDENSED :SMALL))
(DEFPARAMETER MY-NVT-FONT '(:FIX :EXTRA-CONDENSED :SMALL))

(DEFPARAMETER *SOURCE-FILL-PIXELS*
	      (MAX (* MY-LISP-FILL-GOAL (ZWEI:FONT-SPACE-WIDTH (SI:GET-FONT SI:*B&W-SCREEN*
									    SI:*STANDARD-CHARACTER-SET*
									    MY-LISP-FONT)))
		   (* MY-TEX-FILL-GOAL (ZWEI:FONT-SPACE-WIDTH (SI:GET-FONT SI:*B&W-SCREEN*
									   SI:*STANDARD-CHARACTER-SET*
									   MY-TEX-FONT)))))


;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10; Vsp: 1; Patch-File: Yes -*-

(defun bash-window (window)
  (SEND window :SET-DEFAULT-CHARACTER-STYLE MY-TEXT-FONT)
  (SEND window :SET-VSP 1)
  (send-IF-HANDLES WINDOW :set-margin-components '((dw:margin-borders :thickness 1)
						   (dw:margin-scroll-bar :elevator-thickness 4)))
  (IF (TYPEP WINDOW 'ZWEI:ZMAIL-WINDOW)
      (SEND WINDOW :SET-MARGIN-COMPONENTS '((dw:margin-borders :thickness 1)
					    (dw:margin-scroll-bar :elevator-thickness 4)
					    (dw:margin-label :style (:sans-serif :italic :SMALL)
							     :margin :bottom))))
  (MAPC #'(LAMBDA (Y)
	    (COND ((NOT (TYPEP Y 'ZWEI:ZMAIL-MAIN-COMMAND-MENU-PANE))
		   (bash-window y))))
	(TV:SHEET-INFERIORS window)))		;recursive


;;; Keep scroll bars from being so noticeable
(setf (flavor:flavor-default-init-get 'dw:margin-scroll-bar :elevator-thickness) 4)

(DEFUN DO-MY-PRIVATE-REPEATABLE-INITIALIZATIONS ()
  ;; redo telnet windows
  (TV:SET-DEFAULT-WINDOW-SIZE 'TELNET:NVT-WINDOW TV:MAIN-SCREEN T
			      :WIDTH (* 82. (ZL:FONT-CHAR-WIDTH (SI:GET-FONT SI:*B&W-SCREEN*
									      SI:*STANDARD-CHARACTER-SET*
									      MY-NVT-FONT)))	
			      :HEIGHT (SEND TV:MAIN-SCREEN :INSIDE-HEIGHT))

  (SI:DEFINE-CHARACTER-STYLE-FAMILIES SI:*B&W-SCREEN* SI:*STANDARD-CHARACTER-SET*
    '(:FAMILY :FIX (:SIZE :TINY (:FACE :CONDENSED FONTS:TINY
				       :EXTRA-CONDENSED FONTS:TINY)
			  :VERY-SMALL (:FACE :CONDENSED FONTS:TINY
					     :EXTRA-CONDENSED FONTS:TINY))))

  (si:enable-gc-progress-notes :ephemeral :foreground :dynamic :background)
  (setq tv:*show-system-internal-progress-notes* t)
  (SETQ TV:MOUSE-DOUBLE-CLICK-TIME NIL)	;speed up mouse response time
  (SETQ rsh:*RSH-HOST* (NET:PARSE-HOST "slate"))
  ;; change the ration of sizes of ephemeral areas
  (MAKE-AREA :NAME 'SYS:WORKING-STORAGE-AREA :N-LEVELS 2 :CAPACITY-RATIO 1.5 :ROOM T)

  (SETF TV:*DEFAULT-FONT* (SI:GET-FONT SI:*B&W-SCREEN* SI:*STANDARD-CHARACTER-SET* MY-TEXT-FONT)
	TV:*DEFAULT-STYLE* MY-TEXT-STYLE)
  (SEND TV:MAIN-SCREEN :SET-DEFAULT-CHARACTER-STYLE TV:*DEFAULT-STYLE*)
  (SEND TV:MAIN-SCREEN :SET-DEFAULT-STYLE TV:*DEFAULT-STYLE*)

  ;;reset existing windows

    (TV:SET-WHO-LINE-CONTROL-VARIABLES 'TV:*NUMBER-OF-WHOLINE-DOCUMENTATION-LINES* 1
				     'TV:*WHOLINE-DOCUMENTATION-REVERSE-VIDEO-P* NIL
				     'tv:*wholine-documentation-character-style*
				         2(0si:parse-character-style MY-WHOLINE-FONT2)
0				     'TV:*WHOLINE-CLOCK-FORMAT*
				         :DOW-HH-MM-AM	;:dow-hh-mm-ss, :month-day-year :dow-hh-mm-am
				     'TV:*SHOW-CURRENT-PROCESS-IN-WHOLINE* T
				     'TV:*WHOLINE-FILE-STATE-CHARACTER-STYLE*
				         (SI:PARSE-CHARACTER-STYLE MY-WHOLINE-FONT))

  (SETF cp::*scroll-one-screenful-number-of-lines-left* 2
	tv:*wholine-documentation-border-p* nil

        dw::*listener-margin-components* '((dw:margin-ragged-borders)
					   (dw:margin-scroll-bar :elevator-thickness 4
								 :history-noun "history"
								 :visibility :if-needed)
					   (dw:margin-label :style (:sans-serif :italic :SMALL)
							    :margin :bottom)
					   (dw:margin-scroll-bar :margin :bottom
								 :elevator-thickness 4
								 :history-noun "history"
								 :visibility :if-needed)
					   (dw:margin-white-borders)))

  (SEND TV:WHO-LINE-SCREEN :SET-DEFAULT-CHARACTER-STYLE MY-WHOLINE-STYLE)
  (SEND TV:WHO-LINE-SCREEN :SET-VSP 1)
  ;; expand the main screen
;     (SEND TV:MAIN-SCREEN :CHANGE-OF-SIZE-OR-MARGINS :LEFT-MARGIN-SIZE 45 :TOP-MARGIN-SIZE 20)
;     (SEND TV:WHO-LINE-SCREEN :CHANGE-OF-SIZE-OR-MARGINS :BOTTOM-MARGIN-SIZE 0)
    (SEND TV:MAIN-SCREEN :REFRESH)
    (TV:WHO-LINE-SETUP TV:WHO-LINE-SCREEN T)

  ;; make sure...
  (MAPC #'(LAMBDA (X)
	    (UNLESS (EQL (SEND X :HEIGHT) 3)	  ;leave the display line alone.
	      (send x :set-default-character-style MY-WHOLINE-STYLE)
	      (SEND X :EXPOSE)))
	(TV:SHEET-INFERIORS TV:WHO-LINE-SCREEN))
  (SEND TV:WHO-LINE-SCREEN :REFRESH)
  
  (MAPC #'(LAMBDA (X)
	    (COND
	      ((TYPEP X 'TELNET:NVT-WINDOW)
	       (SEND X :SET-DEFAULT-CHARACTER-STYLE MY-NVT-STYLE)
	       (SEND X :SET-VSP 1)
	       (send x :set-margin-components '((dw:margin-borders :thickness 1)
						(dw:margin-scroll-bar :elevator-thickness 4)
						(dw:margin-label :margin :bottom :style 3(0:SANS-SERIF3 0:ITALIC 3:small)0)
						(dw:margin-white-borders )))

	       (send x :set-deexposed-typeout-action :permit)
	       )
	      ((TYPEP X 'DW::DYNAMIC-LISP-LISTENER)
	       ;	     (SEND X :SET-TYPEIN-CHARACTER-STYLE '(NIL :BOLD-EXTENDED NIL))
	       (SEND X :SET-DEFAULT-CHARACTER-STYLE MY-LISP-FONT)
	       (SEND X :SET-VSP 1)
	       (send x :set-margin-components '((dw:margin-borders :thickness 1)
						(dw:margin-scroll-bar :elevator-thickness 4)
						(dw:margin-label :margin :bottom :style (:sans-serif :italic :small))
						(dw:margin-scroll-bar :margin :bottom :elevator-thickness 4)
						(dw:margin-white-borders)))
								      
	       (send x :set-more-p nil)
	       (send x :set-deexposed-typeout-action :permit)
	       )
	      ((TYPEP X 'ZWEI:ZMACS-FRAME)
	       ;; get the minibuffer
	       (MAPC #'(LAMBDA (Y)
			 (SEND Y :SET-DEFAULT-CHARACTER-STYLE MY-TEXT-FONT)
			 (SEND Y :SET-VSP 1)
			 (send-IF-HANDLES Y :set-margin-components '((dw:margin-borders :thickness 1)
								     (dw:margin-scroll-bar :elevator-thickness 4)))
			 (MAPC #'(LAMBDA (Z)
				   (SEND Z :SET-DEFAULT-CHARACTER-STYLE MY-TEXT-FONT)
				   (SEND Z :SET-VSP 1)
				   (send-IF-HANDLES Y :set-margin-components '((dw:margin-borders :thickness 1)
									       (dw:margin-scroll-bar :elevator-thickness 4))))
			       (TV:SHEET-INFERIORS Y)))
		     (TV:SHEET-INFERIORS X)))
	       ))
	(TV:SHEET-INFERIORS TV:MAIN-SCREEN))
  
  (tv:white-on-black)
  (SI:SET-AUTO-REPEAT-P #\SQUARE NIL)
  (SI:SET-AUTO-REPEAT-P #\TRIANGLE NIL)
  (SETF (SYS:CONSOLE-VOLUME) 26/31)
  (PUSHNEW :HOME-ADDRESS NETI:*FINGER-FIELDS-TO-SUPPRESS-FOR-UNTRUSTED-HOSTS*)
  (PUSHNEW :HOME-PHONE NETI:*FINGER-FIELDS-TO-SUPPRESS-FOR-UNTRUSTED-HOSTS*)

  (TV:SET-SCREEN-BACKGROUND-GRAY TV:25%-GRAY)
  (TV:SET-SCREEN-DEEXPOSED-GRAY TV:5.5%-GRAY)

  ;;force some facilities to load, actually turn back on in lispm-init.
  (facilities:update-facilities)  ;lag
  (flet ((en-fac (x)
	   (si:enable-facility x)))
    (en-fac :screen-spy)
    (ADVISE TV:SCREEN-SPY :AFTER RESYNC-THERMOMETER NIL (HACKS::THERMOMETER-ON))
    (en-fac :debugger-hacks)
    (en-fac :remind)
;    (en-fac :who-line-interesting-windows) something broken...
    ;; this one has to be done in lispm-init to start the process.
;    (en-fac :zmacs-checkpoint)
    (en-fac :reap-system)
    (en-fac :stars)
    )

  (SETQ SI:GC-REPORT-STREAM
	(ZWEI:OPEN-EDITOR-STREAM :BUFFER-NAME "*GC-Reports*" :CREATE-P T :NO-REDISPLAY NIL))
  (SETQ SI:GC-WARNINGS-ENABLE T)
  (SETQ SI:GC-REPORTS-ENABLE T)
  (SETQ SI:GC-EPHEMERAL-REPORTS-ENABLE T)
  (SETQ SI:GC-AREA-RECLAIM-REPORT T)
  (SETQ SI:GC-FLIP-RATIO 0.90)	;don't bother me until we are getting troubled
  (SETQ SI:GC-FLIP-MINIMUM-RATIO 0.80)	;assume 20% is garbage.
  (SETQ SI:GC-RECLAIM-IMMEDIATELY NIL)
  (SETQ SI:GC-RECLAIM-EPHEMERAL-IMMEDIATELY NIL)
  (SETQ SI:GC-RECLAIM-IMMEDIATELY-IF-NECESSARY NIL)	;if we're getting worried, turn off gc.
;  (SETQ SI:SCAVENGE-COPYSPACE-PREFETCH 12)		;default 9
;  (SETQ SI:SCAVENGE-OLDSPACE-PREFETCH 8)		;default 5
;  (SETQ SI:SCAVENGE-MAX-LOOKAHEAD 4096.)		;default 2048.
;  (SETQ SI:SCAVENGE-ESRT-PREFETCH 20.)			;default 15.
;  (SETQ SI:SCAVENGE-WORK-PER-WHACK (* 4 SYS:PAGE-SIZE))	;default (* 4 page-size)
;  (SETQ SI:SCAVENGE-MICROSECONDS-PER-WHACK 50000.)	;default 500000.
;  (SETQ SI:SCAVENGE-POSTPURGE-ENABLE NIL)		;default nil
;  (SETQ SI:SCAVENGE-REGION-SWITCH-DELAY 200)		;default 200

  (setup-miller-keyboard) ;do it now...
  
  (NET:REMOTE-LOGIN-ON :PASSWD-U)				 ;so I can log in from home w/o screwing
  
  (SETF dbg:*default-backtrace-depth* 15			 ;print most frames in bug report
	dbg:*defer-package-dwim* t				 ;damned debuger is slow enough already
	dbg:*disable-menu-proceeding* t
	si:*whostate-awaiting-user-input* "Tyi"			 ;as god intended it.
	tv:*screen-hardcopy-announcement* :flash		 ;Keep me informed....
	tv:unexpected-select-delay 30.			 ;half-sec -- NIL means always need abort.
	tv:*typeout-window-border-enable* nil)
  (SETQ SI:*KBD-AUTO-REPEAT-ENABLED-P* T)
  (SETQ TV:*DIM-SCREEN-AFTER-N-MINUTES-IDLE* 25)
  (SETQ TV:*SCREEN-DIMNESS-PERCENT* 20)
  (SETQ SI:*cp-prompt* 'SI:ARROW-PROMPT)
  (SETQ CP:*DISPATCH-MODE* :FORM-PREFERRED)
  (ZL:SETQ-STANDARD-VALUE CL:*PRINT-LENGTH* 30)	  ;don't really want too much
						  ;while debugging and such.
  (ZL:SETQ-STANDARD-VALUE CL:*PRINT-LEVEL* 6)
  
  #||
  *** HACKISH THINGS
  ||#
  
;  (LHACKS:TURN-OFF-NOTIFICATIONS)				 ;turn off notifications - N window only
;  (LHACKS:TURN-ON-NOTIFICATIONS)				 ;turn them back on, but now will pop-up.
  
  (SETQ SI:*TYPEOUT-DEFAULT* :INSERT)			 ;defaults to :overwrite [RN 6.0 p61]
  
  (SETQ ZWEI:*HANG-BACKGROUND-PROCESS-WHEN-DEEXPOSED* NIL)	 ; allow zmail to do stuff when we
								 ; do something else...
  (SETQ TV:SCREEN-MANAGE-UPDATE-PERMITTED-WINDOWS 600.)		 ; allow partially exposed windows
								 ; to get updated

  ;; note the following only really *do* something once, but it isn't dangerous to do them >1ce, so put them here in case
  ;; they change...
  ;; get useless items out of system menu
  (setf tv:*system-menu-programs-column*
	(sort (remove-if #'(lambda (entry)
			     (member (car entry) '( "lisp" "edit" "mail" "Macsyma" "Font Edit"
						   "flavor examiner" "Document Examiner" "Namespace Editor"
						   "Rhetorical" "Inspect" "Illustrate" 
						   "emergency break" "DVI Previewer" "Inspector"
						   "Layout Designer" "Frame-Up")
				     :test #'string-equal))
			 tv:*system-menu-programs-column*)
	      #'string-lessp :key #'car)) 
  (bash-window zwei:*zmail-window*)		;reset vsp etc.
    
  (tv:add-function-key #\> '(tv:mouse-initialize) "Reset mouse")
  (TV:ADD-FUNCTION-KEY #\g '(TOGGLE-GC-STATE) "Display GC state. An argument of 0 turns Dynamic GC off, 1 turns it on.")
  (TV:ADD-FUNCTION-KEY #\SPACE '(DO-MY-PRIVATE-REPEATABLE-INITIALIZATIONS) "Do Brad's private repeatable inits")
  (tv:add-function-key #\< '(SETQ SI:KBD-NEW-TABLE (SI:KBD-MAKE-NEW-TABLE)) "Reset Keyboard")
  (TV:ADD-FUNCTION-KEY #\c-< '(SETUP-MILLER-KEYBOARD) "Setup Keyboard My Way")
  (TV:ADD-SELECT-KEY '#\Triangle '(DW::FIND-PROGRAM-WINDOW-FOR-SELECT-KEY 'DW::PRESENTATION-INSPECTOR TV:ALWAYS-MAKE-NEW)
		     "Presentation Inspector" T)
  (TV:ADD-SELECT-KEY '#\F 'fed::fed-GREAT-FRAME "Font Editor" T T)
  )

(DEFUN DO-MY-PRIVATE-ONCE-ONLY-INITIALIZATIONS ()
  (lhacks::background-load-patches)		;bring things up to date
  
; (LOAD "acorn:>miller>hacks>setup-printer")	;for my anadex

  ;; make it depend on my font sizes.
  (TV:SET-DEFAULT-WINDOW-SIZE 'ZWEI:ZMAIL-FRAME TV:MAIN-SCREEN T
			      :WIDTH (* (+ MY-FILL-GOAL 30)	;extra room for foreign mail
					 (ZL:FONT-CHAR-WIDTH
					   (SI:GET-FONT SI:*B&W-SCREEN*
							SI:*STANDARD-CHARACTER-SET*
							MY-TEXT-FONT)))	; system default -- need to find
			      ; out how to set
			      :RIGHT (TV:SHEET-INSIDE-RIGHT TV:MAIN-SCREEN)
			      )

  (TV:SET-DEFAULT-WINDOW-SIZE
    'ZWEI:ZMACS-FRAME TV:MAIN-SCREEN T
    :WIDTH (MAX (* (+ MY-TEX-FILL-GOAL 5)
		   (ZL:FONT-CHAR-WIDTH (SI:GET-FONT SI:*B&W-SCREEN* SI:*STANDARD-CHARACTER-SET* MY-TEX-FONT)))
		(* (+ MY-LISP-FILL-GOAL 5)
		   (ZL:FONT-CHAR-WIDTH (SI:GET-FONT SI:*B&W-SCREEN* SI:*STANDARD-CHARACTER-SET* MY-LISP-FONT)))
		(* (+ MY-FILL-GOAL 5)
		   (ZL:FONT-CHAR-WIDTH (SI:GET-FONT SI:*B&W-SCREEN* SI:*STANDARD-CHARACTER-SET* MY-TEXT-FONT)))))

  (ADD-INITIALIZATION "Setup my keyboard" '(SETUP-MILLER-KEYBOARD) '(:WARM))
  )

(DEFUN SETUP-MILLER-KEYBOARD ()
  "Fiddle with keyboard bindings"
  ;; set up the keyboard s.t. where : used to be becomes +/=
  ;; ~/` moves over to where back-space was
  ;; {/\ moves to where +/= was
  ;; }/| moves to where ~/` was
  ;; : moves to where {/\ was
  ;; and backspace moves to where }/| was...

  ;;  NOTE: POSN is:
	; 0 unshifted
	; 1 shift
	; 2 symbol
	; 3 shift symbol

  ;; see lfepio.lisp (KBD-MAKE-NEW-TABLE)

	 (FLET ((CHANGE-CHAR (CHAR SHIFT POSN)
		  (ZL:ASET (CHAR-CODE CHAR) SI:KBD-NEW-TABLE SHIFT POSN)))
	   
	   (CHANGE-CHAR #\= 0 64)
	   (CHANGE-CHAR #\+ 1 64)
	   (CHANGE-CHAR #\ 2 64)
	   (CHANGE-CHAR #\
 3 64)
	   
	   (CHANGE-CHAR #\` 0 63)
	   (CHANGE-CHAR #\~ 1 63)
	   (CHANGE-CHAR #\ 2 63)
	   (CHANGE-CHAR (CODE-CHAR #XC000) 3 63)
	   
	   (CHANGE-CHAR #\\ 0 70)
	   (CHANGE-CHAR #\{ 1 70)
	   (CHANGE-CHAR (CODE-CHAR #XC000) 2 70)
	   (CHANGE-CHAR (CODE-CHAR #XC000) 3 70)
	   
	   (CHANGE-CHAR #\| 0 78)
	   (CHANGE-CHAR #\} 1 78)
	   (CHANGE-CHAR (CODE-CHAR #XC000) 2 78)
	   (CHANGE-CHAR (CODE-CHAR #XC000) 3 78)
	   
	   (CHANGE-CHAR #\: 0 71)
	   (CHANGE-CHAR #\: 1 71)
	   (CHANGE-CHAR #\ 2 71)
	   (CHANGE-CHAR #\ 3 71)
	   
	   (CHANGE-CHAR #\BACKSPACE 0 79)
	   (CHANGE-CHAR #\BACKSPACE 1 79)
	   (CHANGE-CHAR #\BACKSPACE 2 79)
	   (CHANGE-CHAR #\BACKSPACE 3 79)))


;; give select a high priority

TV:
(DEFUN KBD-SYS (&AUX CH)
  (LET-GLOBALLY ((WHO-LINE-PROCESS CURRENT-PROCESS))
    (WHO-LINE-RUN-STATE-UPDATE)			;Necessary to make above take effect
    (SETQ CH (CHAR-UPCASE (KBD-GET-SOFTWARE-CHAR '#,(FORMAT NIL "~:C:" #\SELECT)))))
  (WHO-LINE-RUN-STATE-UPDATE)			;Switch LAST-WHO-LINE-PROCESS back
  ;; Anything typed before the System belongs to the currently selected window
  ;; Anything typed after this belongs to the new window we are going to get to.
  (WITHOUT-INTERRUPTS
    (AND (KBD-GET-IO-BUFFER)
	 (KBD-SNARF-INPUT SELECTED-IO-BUFFER T)))
  (SETQ KBD-ESC-TIME (TIME))
  (PROCESS-RUN-FUNCTION '(:NAME #,(FORMAT NIL "~:C Key" #\SELECT) :PRIORITY 5)
			#'KBD-SYS-1 CH))

(DEFUN TOGGLE-GC-STATE (&OPTIONAL (ARG NIL))
  "Display GC state. An argument of 0 turns it off, 1 turns it on."
  (COND
    ((NULL ARG)
     (LET ((MESSAGE (CONCATENATE 'STRING (with-output-to-string (stream) (si:gc-status stream))
				 (FORMAT NIL "~%Press Any Key to Continue."))))

     (USING-RESOURCE (POP-UP-MESSAGE-WINDOW tv::POP-UP-TEXT-WINDOW-WITHOUT-MORE TV:MOUSE-SHEET)
       (SEND POP-UP-MESSAGE-WINDOW :CLEAR-INPUT)
       (SEND POP-UP-MESSAGE-WINDOW :SET-LABEL "GC Status")
       (SEND POP-UP-MESSAGE-WINDOW :SET-DEFAULT-CHARACTER-STYLE MY-TEXT-FONT)
       (SEND POP-UP-MESSAGE-WINDOW :SET-VSP 1)
       (SEND POP-UP-MESSAGE-WINDOW :SET-SIZE-IN-CHARACTERS MESSAGE MESSAGE)
       (tv::EXPOSE-WINDOW-NEAR POP-UP-MESSAGE-WINDOW '(:MOUSE) NIL)
       (tv::WINDOW-CALL (POP-UP-MESSAGE-WINDOW :DEACTIVATE)
	 (SEND POP-UP-MESSAGE-WINDOW :STRING-OUT MESSAGE)
	 (SEND POP-UP-MESSAGE-WINDOW :ANY-TYI)))))
    ((ZEROP ARG)
     (SI:GC-ON :DYNAMIC NIL))
    (T
     (SI:GC-ON :DYNAMIC T))))

(ADD-INITIALIZATION "Private Initializations"
		    '(PROGN
		       (DO-MY-PRIVATE-REPEATABLE-INITIALIZATIONS)
		       (DO-MY-PRIVATE-ONCE-ONLY-INITIALIZATIONS))
		    '(:ONCE))

(ADD-INITIALIZATION "Inits while logging in"
		    '(DO-MY-PRIVATE-REPEATABLE-INITIALIZATIONS)
		    '(:LOGIN))


(ADD-INITIALIZATION "Inits while booting up"
		    '(DO-MY-PRIVATE-REPEATABLE-INITIALIZATIONS)
		    '(:WARM))

(ADD-INITIALIZATION "Bigger screen on 20s"
		    '(COND
		       ((EQ (SI:MACHINE-MODEL) :|3620|)
			(SETQ TV::*SCREEN-LEFT-OFFSET* -20)
			(SETQ TV::*SCREEN-TOP-OFFSET* -3)	;leave room for marginal notes on top
			(SETQ TV::*SCREEN-RIGHT-OFFSET* 10)
			;(TV:INITIALIZE-ONE-SCREEN TV:MAIN-SCREEN TV:*SLB-MAIN-CONSOLE* T)
			))
		    '(:SYSTEM))

;; make sure the above initialization appears b4 the winodw creation.

;; SURGERY!
(LHACKS:REORDER-INITIALIZATION-LIST :SYSTEM "Bigger screen on 20s" "Window Initialize")