;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-
;;; Written 02/09/89 15:09:07 by GRENINGER,
;;; Reason: Keep an mX lashup from thinking all its windows were mX windows.
;;; while running on MX23 from band TEST
;;; With SYSTEM 5.27, GC 5.4, VIRTUAL-MEMORY 5.5, MICRONET 5.6, MICRONET-COMM 5.13,
;;;  DISK-IO 5.9, BASIC-PATHNAME 5.4, MAC-PATHNAME 5.1, NETWORK-SUPPORT-COLD 5.1,
;;;  BASIC-NAMESPACE 5.8, BASIC-FILE 5.5, RPC 5.6, NFS 5.16, EH 5.3, MAKE-SYSTEM 5.3,
;;;  MEMORY-AUX 5.1, MACTOOLBOX 1.35, COMPILER 5.3, Inconsistent TV 5.25, NVRAM 5.1,
;;;  UCL 5.0, INPUT-EDITOR 5.0, METER 5.1, ZWEI 5.12, DEBUG-TOOLS 5.1, Inconsistent WINDOW-MX 5.34,
;;;  PRINTER 5.12, MAC-PRINTER-TYPES 5.4, Experimental NETWORK-PATHNAME 5.1, NETWORK-NAMESPACE 5.0,
;;;  DATALINK 5.7, CHAOSNET 5.6, Experimental NETWORK-SUPPORT 5.1, Experimental NETWORK-SERVICE 5.1,
;;;  DATALINK-DISPLAYS 5.0, NAMESPACE-EDITOR 5.1, IP 3.41, NFS-SERVER 5.3, PRINTER-TYPES 5.5,
;;;  IMAGEN 5.3, MAIL-DAEMON 5.6, MAIL-READER 5.6, TELNET 5.2, VT100 5.1, STREAMER-TAPE 5.7,
;;;  DECNET 1.49, VISIDOC 5.4, PROFILE 5.1, DISK-LABEL 5.1, Experimental MX-SERIAL 1.1,
;;;   microcode 96, Band Name: NB22+1/8 patches

#!C
; From file SHEET.LISP#> WINDOW; SYS:
#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; SHEET.#"


(DEFMETHOD (SHEET :INIT)
           (INIT-PLIST
            &AUX BOTTOM RIGHT SAVE-BITS (VSP 2) (MORE-P T)
            (CHARACTER-WIDTH NIL) (CHARACTER-HEIGHT NIL)
            (REVERSE-VIDEO-P NIL) (INTEGRAL-P NIL)
            (BLINKER-P T) (BLINK-FL 'RECTANGULAR-BLINKER)
            (DESELECTED-VISIBILITY :ON))
  ;; Process options
  (DOPLIST ((CAR INIT-PLIST) VAL OP)
    (CASE OP
      ((:LEFT :X) (SETQ X-OFFSET VAL))
      ((:TOP  :Y) (SETQ Y-OFFSET VAL))
      (:POSITION  (SETQ X-OFFSET (FIRST  VAL)
			Y-OFFSET (SECOND VAL)))
      (:RIGHT     (SETQ RIGHT    VAL))
      (:BOTTOM    (SETQ BOTTOM   VAL))
      (:SIZE  (AND VAL (SETQ WIDTH    (FIRST  VAL)
			     HEIGHT   (SECOND VAL))))
      (:EDGES (AND VAL (SETQ X-OFFSET (FIRST  VAL)
			     Y-OFFSET (SECOND VAL)
			     RIGHT    (THIRD  VAL)
			     BOTTOM   (FOURTH VAL)
			     ;; Override any specified height,
			     ;; probably from default plist.
			     HEIGHT NIL WIDTH NIL))
	      (UNLESS (> RIGHT X-OFFSET)
		(FERROR
		  NIL
		  "Specified edges give width ~S"  (- RIGHT  X-OFFSET)))
	      (UNLESS (> BOTTOM Y-OFFSET)
		(FERROR
		  NIL
		  "Specified edges give height ~S" (- BOTTOM Y-OFFSET))))
      (:CHARACTER-WIDTH               (SETQ CHARACTER-WIDTH       VAL))
      (:CHARACTER-HEIGHT              (SETQ CHARACTER-HEIGHT      VAL))
      (:BLINKER-P                     (SETQ BLINKER-P             VAL))
      (:REVERSE-VIDEO-P               (SETQ REVERSE-VIDEO-P       VAL))
      (:MORE-P                        (SETQ MORE-P                VAL))
      (:VSP                           (SETQ VSP                   VAL))
      (:BLINKER-FLAVOR                (SETQ BLINK-FL              VAL))
      (:BLINKER-DESELECTED-VISIBILITY (SETQ DESELECTED-VISIBILITY VAL))
      (:INTEGRAL-P                    (SETQ INTEGRAL-P            VAL))
      (:SAVE-BITS                     (SETQ SAVE-BITS             VAL))
      (:RIGHT-MARGIN-CHARACTER-FLAG     (SETF (SHEET-RIGHT-MARGIN-CHARACTER-FLAG)     VAL))
      (:BACKSPACE-NOT-OVERPRINTING-FLAG (SETF (SHEET-BACKSPACE-NOT-OVERPRINTING-FLAG) VAL))
      (:CR-NOT-NEWLINE-FLAG             (SETF (SHEET-CR-NOT-NEWLINE-FLAG)             VAL))
      (:TRUNCATE-LINE-OUT-FLAG          (SETF (SHEET-TRUNCATE-LINE-OUT-FLAG)          VAL))
      ;; Set keypad-enable to 0 if val is either NIL or is 0.  Otherwise set to 1.
      (:KEYPAD-ENABLE (SETF (SHEET-KEYPAD-ENABLE) (IF (FIXNUMP VAL)
						      (IF (= VAL 0) 0 1)
						      ;;ELSE
						      (IF VAL 1 0))))
      (:TAB-NCHARS                      (SETF (SHEET-TAB-NCHARS)                      VAL))
      (:DEEXPOSED-TYPEIN-ACTION       (SEND SELF :SET-DEEXPOSED-TYPEIN-ACTION VAL))
      ))
  (SHEET-DEDUCE-AND-SET-SIZES
    RIGHT BOTTOM VSP INTEGRAL-P CHARACTER-WIDTH CHARACTER-HEIGHT)
  (COND ((OR (EQ SAVE-BITS 'T) BIT-ARRAY)
	 (LET ((DIMS (LIST (TRUNCATE
                             (* 32.
                                (SETQ LOCATIONS-PER-LINE
                                      (SHEET-LOCATIONS-PER-LINE SUPERIOR)))
                             (SCREEN-BITS-PER-PIXEL (SHEET-GET-SCREEN SELF)))
			   HEIGHT))
	       (ARRAY-TYPE (SHEET-ARRAY-TYPE (OR SUPERIOR SELF))))
	   (SETQ BIT-ARRAY
		 (IF BIT-ARRAY
		     (GROW-BIT-ARRAY BIT-ARRAY (CAR DIMS) (CADR DIMS) WIDTH)
		     ;;ELSE
		     (MAKE-ARRAY `(,(CADR DIMS) ,(CAR DIMS)) :TYPE ARRAY-TYPE)))
           ;; Use a portion of the superior's screen array.
	   (SETQ SCREEN-ARRAY (MAKE-ARRAY `(,(CADR DIMS) ,(CAR DIMS))
					  :TYPE ARRAY-TYPE
					  :DISPLACED-TO BIT-ARRAY
					  :DISPLACED-INDEX-OFFSET 0))))
	((EQ SAVE-BITS :DELAYED)
	 (SETF (SHEET-FORCE-SAVE-BITS) 1)))
  (SETQ MORE-VPOS (AND MORE-P (SHEET-DEDUCE-MORE-VPOS SELF)))
  (COND (SUPERIOR
	 (OR BIT-ARRAY
	     (LET ((ARRAY (SHEET-SUPERIOR-SCREEN-ARRAY)))
	       (SETQ OLD-SCREEN-ARRAY
		     (MAKE-ARRAY
		       `(,HEIGHT ,(ARRAY-DIMENSION ARRAY 1))
		       :TYPE (ARRAY-TYPE ARRAY)
		       :DISPLACED-TO ARRAY
		       :DISPLACED-INDEX-OFFSET
		       (+ X-OFFSET (* Y-OFFSET (ARRAY-DIMENSION ARRAY 1)))))
	       (SETQ LOCATIONS-PER-LINE (SHEET-LOCATIONS-PER-LINE SUPERIOR))))
	 (AND BLINKER-P
	      (APPLY #'MAKE-BLINKER SELF BLINK-FL
		     :FOLLOW-P T
		     :DESELECTED-VISIBILITY DESELECTED-VISIBILITY
		     (AND (CONSP BLINKER-P) BLINKER-P)))))
  (when (mac-screen-p (sheet-get-screen self))
    ;;  Just mark the window as being a deactivated Mac window.  Window id and such
       ;;  will get allocated when it gets activated.  Must also add its bit array to the mX's
       ;;  *undisplaced-Mac-window-arrays* list.
    (SETF window-id t)
    (remember-bit-array self))
  (SETF (SHEET-OUTPUT-HOLD-FLAG) 1)
  
;;;>>> changed char and erase aluf
  (OR (VARIABLE-BOUNDP CHAR-ALUF)
      (if (color-system-p self)
	  (SETQ CHAR-ALUF  ALU-TRANSP)
	  (setq char-aluf  (IF reverse-video-p alu-back alu-transp))
	  ))
  (OR (VARIABLE-BOUNDP ERASE-ALUF)
      (if (color-system-p self)
	  (SETQ ERASE-ALUF ALU-BACK)
	  (setq erase-aluf (IF reverse-video-p alu-transp alu-back))
	  ))
;;; new code added to support color reverse video:
  (SETQ color-reverse-video-state reverse-video-p)
;;; now flip the colors if reverse-video is true. NOTE - check the instance variable, not the AUX variable, since the
;;; instance variable is inittable.
  
  (WHEN (AND color-reverse-video-state (color-system-p self))
    (SEND self :complement-bow-mode)
    )
  
;; Setup the color map based on who and what we are.
  (UNLESS color-map  ;; If one already specified, don't change it.
    (IF (TYPEP self 'screen)  ;; If we're a screen, we have our own copy.
	;; Note: Doing a create-color-map here will give screens a color map with the Window System
	;; version number, not the System version number (as is for *default-color-map*).  See MAP.LISP
	(SETQ color-map (create-color-map)) ;; or (copy-color-map *default-color-map*))
	(IF (NULL superior)  ;; If no superior, which may never be the case??, get a copy from somewhere.
	    (SETQ color-map (copy-color-map (OR (AND default-screen (sheet-color-map default-screen))
						*default-color-map*)))
	    ;; If our superior is a screen, make a copy of its map for us to use.  This is the case for TOP
	    ;; level windows (like the ZMACS frame or the Listener) .
	    (IF (TYPEP (sheet-superior self) 'screen)
		(SETQ color-map (copy-color-map (sheet-color-map superior)))
		;; Otherwise, we always want to get