;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-
;;; Written 11/29/88 12:58:06 by GRENINGER,
;;; Reason: o Allow (sheet :init) to create a window wider than its superior.
;;; o Make grow-bit-array always create an array of the specified size.
;;; o Rationalize calling sequence, documentation, internal workings, and
;;;   callers of grow-bit-array so all agree.
;;; while running on MX23 from band TEST
;;; With SYSTEM 5.19, GC 5.3, VIRTUAL-MEMORY 5.5, MICRONET 5.5, MICRONET-COMM 5.13,
;;;  DISK-IO 5.9, BASIC-PATHNAME 5.2, MAC-PATHNAME 5.0, NETWORK-SUPPORT-COLD 5.1,
;;;  BASIC-NAMESPACE 5.6, BASIC-FILE 5.3, RPC 5.4, NFS 5.10, EH 5.3, MAKE-SYSTEM 5.2,
;;;  MEMORY-AUX 5.1, MACTOOLBOX 1.26, COMPILER 5.1, TV 5.21, NVRAM 5.1, UCL 5.0, INPUT-EDITOR 5.0,
;;;  METER 5.0, ZWEI 5.9, DEBUG-TOOLS 5.1, WINDOW-MX 5.30, PRINTER 5.11, MAC-PRINTER-TYPES 5.4,
;;;  NETWORK-PATHNAME 5.0, NETWORK-NAMESPACE 5.0, DATALINK 5.7, CHAOSNET 5.6, NETWORK-SUPPORT 5.0,
;;;  NETWORK-SERVICE 5.0, DATALINK-DISPLAYS 5.0, NAMESPACE-EDITOR 5.1, IP 3.33, NFS-SERVER 5.3,
;;;  PRINTER-TYPES 5.2, IMAGEN 5.1, MAIL-DAEMON 5.1, MAIL-READER 5.3, TELNET 5.1,
;;;  VT100 5.0, STREAMER-TAPE 5.6, DECNET 1.45, VISIDOC 5.4, PROFILE 5.1, DISK-LABEL 5.1,
;;;   microcode 96, Band Name: microExplorer Network (11/22)

#!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)
	  ;; Handle the possibility of creating the window wider than its screen.  So
	  ;; long as the window is never activated & exposed, this causes no problems.
	  ;; The w:cache-window requires this capability. 11/28/88 LG	 
	 (LET* ((our-screen (sheet-get-screen self))
		(pixels-per-location (FLOOR 32. (screen-bits-per-pixel our-screen)))
		(screen-width (* pixels-per-location (sheet-locations-per-line our-screen)))
		(width-to-use (MAX (* pixels-per-location (CEILING width pixels-per-location)) screen-width))
		(locations-per-line-to-use (FLOOR width-to-use pixels-per-location)))
	   (SETF locations-per-line locations-per-line-to-use)
	   (WITH-STACK-LIST (dims height width-to-use)
	     (LET ((array-type (sheet-array-type self)))	   
	       (SETF bit-array
		     (IF bit-array
			 (grow-bit-array bit-array width height (SECOND dims))
		         ;; else...
		       (MAKE-ARRAY dims :type array-type)))
	       (SETQ screen-array (MAKE-ARRAY 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)))
  (WHEN superior
    (UNLESS 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))))
    (WHEN blinker-p
      (APPLY #'make-blinker self blink-fl
	     :follow-p t
	     :deselected-visibility deselected-visibility
	     (AND (CONSP blinker-p) blinker-p))))
  (WHEN (mac-system-p)
    ;;  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 a pointer to our superior's map.
		(SETQ color-map (sheet-color-map superior))))))
;; This is how it was being done for Release 3.2.  The problem was each TOP level window (like the ZMACS
;; frame or the Listener) was getting a pointer to the screen's (mouse-sheet's) color map instead of a COPY
;; of it.  02/21/88 KJF
;;;;; >>> set up to make a color map on the superior screen, and copy it down to everyone else
;;  (UNLESS color-map
;;        (if (null superior)
;;          (SETQ color-map (copy-color-map (OR (AND tv:mouse-sheet (sheet-color-map tv:mouse-sheet))
;;						*default-color-map*)))
;;          ; else
;;          (setq color-map (sheet-color-map superior))
;;        )
;;  )
  (SEND self :update-time-stamp)
  self)

))

#!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 :change-of-size-or-margins)
           (&rest options
            &aux top bottom left right
            new-height new-width old-x old-y
            (old-top-margin-size  top-margin-size)
            (old-left-margin-size left-margin-size)
            delta-top-margin
            delta-left-margin
            (integral-p nil)
            (old-inside-width  (sheet-inside-width))
            (old-inside-height (sheet-inside-height))
            (old-width width)
            (old-height height))
  "Change some sheet parameters."
  (OR superior (NOT exposed-p)
      (FERROR
         nil
         "Cannot change size or margins of an exposed window with no superior"))
  (sheet-force-access (self)
    (erase-margins))
  (SETQ old-x (- cursor-x left-margin-size)
	old-y (- cursor-y top-margin-size))
  ;; Process options
  (doplist (options val op)
    (CASE op
      ((:top :y)           (SETQ top                val))
      (:bottom             (SETQ bottom             val))
      ((:left :x)          (SETQ left               val))
      (:right              (SETQ right              val))
      (:width              (SETQ new-width          val))
      (:height             (SETQ new-height         val))
      (:top-margin-size    (SETQ top-margin-size    val))
      (:bottom-margin-size (SETQ bottom-margin-size val))
      (:left-margin-size   (SETQ left-margin-size   val))
      (:right-margin-size  (SETQ right-margin-size  val))
      (:integral-p         (SETQ integral-p         val))
      (otherwise (FERROR nil "~S is not a recognized option" op))))
  (SETQ x-offset (OR left (IF right
                              (- right (OR new-width width))
                            ;;ELSE
                            x-offset)))
  (SETQ y-offset (OR top (IF bottom
                             (- bottom (OR new-height height))
                           ;;ELSE
                           y-offset)))
  (SETQ new-width  (OR new-width  (IF right  (- right  left) width)))
  (SETQ new-height (OR new-height (IF bottom (- bottom top)  height)))
  (SETQ width new-width height new-height)

  ;; We need to deexpose all of our inferiors that won't fit anymore.
  (DOLIST (i exposed-inferiors)
    (OR (sheet-within-p i (sheet-inside-left) (sheet-inside-top)
			(sheet-inside-right) (sheet-inside-bottom))
	(FUNCALL i :deexpose)))

  (WITHOUT-INTERRUPTS
    (sheet-force-access (self t)
      (MAPC #'open-blinker blinker-list))
    (sheet-deduce-and-set-sizes right bottom (SEND self :vsp) integral-p)
    (SETQ cursor-x
	  (MIN (+ left-margin-size old-x)
               (- width right-margin-size char-width)))
    (SETQ cursor-y
	  (MIN (+ top-margin-size old-y)
               (- height bottom-margin-size line-height)))
    (DOLIST (bl blinker-list)
      (COND ((NULL (blinker-x-pos bl)))
	    ((>= (blinker-x-pos bl)   (sheet-inside-right))
	     (SETF (blinker-x-pos bl) (sheet-inside-left)))) ; Wrap blinker around
      (COND ((NULL (blinker-y-pos bl)))
	    ((>= (blinker-y-pos bl)   (sheet-inside-bottom))
	     (SETF (blinker-y-pos bl) (sheet-inside-top)))))
    (WHEN superior  ;; A screen will have NIL for superior.  02/15/88 KJF
      ;; Don't let locations-per-line change without changing sheet's arrays also, if needed.
      ;; This handles cases of color/monochrome inconsistencies.
      ;; On microExplorer, locations-per-line may be arbitrary, but arrays will always be
      ;; the same (1 bit, until color on mExp. is available).  So for now, on mExp., we only
      ;; need to make sure locations-per-line matches superior.  04/22/88 KJF.
      (IF (mac-window-p self)
	  (SETF locations-per-line (sheet-locations-per-line superior)) ;; If superior is nil, we break.  KJF
	  ;; :sheet-legal-for-superior determines if any conversion needs to take place.
	  ;; That is, if one is color and one is monochrome, a conversion may occur.
	  ;; :sheet-legal-for-superior can convert in both directions.  It looks at:
	  ;; *convert-color-sheet-to-monochrome*  04/22/88 KJF
	  (SEND self :sheet-legal-for-superior)))
    (WHEN bit-array
      ;; Handle the possibility of growing the window wider than its screen.  So
      ;; long as the window is never activated & exposed, this causes no problems.
      ;; Visidoc requires this capability. 11/11/88 LG
      (LET* ((our-screen (sheet-get-screen self))
	     (pixels-per-location (FLOOR 32. (screen-bits-per-pixel our-screen)))
	     (screen-width (* pixels-per-location (sheet-locations-per-line our-screen)))
	     (width-to-use (MAX (* pixels-per-location (CEILING width pixels-per-location)) screen-width))
	     (locations-per-line-to-use (FLOOR width-to-use pixels-per-location)))
	(WHEN (> width-to-use screen-width)
	  (SETF locations-per-line locations-per-line-to-use))
	(SETQ bit-array
	      (grow-bit-array
		bit-array
		width
		height width-to-use
		old-height old-width))))

    (COND (superior
	   ;;if we have a bit-array, SCREEN-ARRAY indirects to it, else
           ;; OLD-SCREEN-ARRAY indirects into our superior.
	   (LET ((ARRAY (OR screen-array old-screen-array))
		 (indirect-to (OR (AND (NOT exposed-p) bit-array)
				  (sheet-superior-screen-array))))
	     (WHEN (AND array indirect-to)
	     (redirect-array
	       array (ARRAY-ELEMENT-TYPE indirect-to)
	       (ARRAY-DIMENSION indirect-to 1) height
	       indirect-to
	       (IF (AND bit-array (NOT exposed-p)) 0
		   (+ x-offset (* y-offset (ARRAY-DIMENSION indirect-to 1)))))
	     (IF (OR bit-array exposed-p)
		 (SETQ screen-array array
		       old-screen-array nil)
               ;;ELSE
               (SETQ old-screen-array array
                     screen-array nil))
	     (WHEN (mac-window-p self)
	       (send-adjust-bit-array-maybe self t)
	       (redirect-drawing-of-window-and-inferiors self))
	     ;; If the size of the top and/or left margin changed, move
             ;; the inside bits around.
	     (SETQ delta-top-margin (- top-margin-size old-top-margin-size)
		   delta-left-margin (- left-margin-size old-left-margin-size))
	     (COND ((AND (ZEROP delta-top-margin)
                         (ZEROP delta-left-margin)))
                   ;; Don't BITBLT some other guy's bits!!
		   ((NULL screen-array))
		   (t
                    ;; This should be BITBLT-WITH-FAST-PAGING, sometimes
                    ;; it is not paged in.
		    (OR exposed-p
                        (page-in-pixel-array bit-array nil (LIST width height)))
		    (BITBLT alu-seta
                            (IF (PLUSP delta-left-margin)
                                (- (sheet-inside-width))
                              ;;ELSE
                              (sheet-inside-width))
			    (IF (PLUSP delta-top-margin)
                                (- (sheet-inside-height))
                              ;;ELSE
                              (sheet-inside-height))
			    array old-left-margin-size old-top-margin-size
			    array left-margin-size top-margin-size)
		    ;; If margins got smaller, may be space to clear out
                    ;; on bottom and right.
		    (AND (MINUSP delta-left-margin)
			 (BITBLT erase-aluf
                                 (- delta-left-margin)
                                 (sheet-inside-height)
				 array
                                 (+ (sheet-inside-right) delta-left-margin)
				 (sheet-inside-top)
				 array
                                 (+ (sheet-inside-right) delta-left-margin)
				 (sheet-inside-top)))
		    (AND (MINUSP delta-top-margin)
			 (BITBLT erase-aluf
                                 (sheet-inside-width)
                                 (- delta-top-margin)
				 array
                                 (sheet-inside-left)
				 (+ (sheet-inside-bottom) delta-top-margin)
				 array
                                 (sheet-inside-left)
				 (+ (sheet-inside-bottom) delta-top-margin)))))
	     (sheet-force-access (self)
	       (erase-margins)))
	     (AND temporary-bit-array (NEQ temporary-bit-array t)
		  (SETQ temporary-bit-array (grow-bit-array
					      temporary-bit-array width
					      height width nil nil nil))))))
    (SEND self :update-time-stamp)
    (OR (NOT (= old-inside-width  (sheet-inside-width)))
	(NOT (= old-inside-height (sheet-inside-height))))))

))

#!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 :set-superior) (new-superior &aux active-p)
  "Make NEW-SUPERIOR the superior of self.  Type of sheets are compared to
see if they match.  That is, if one is color and one is monochrome, then some
conversion may take place."
  (OR (EQ new-superior superior)
      (delaying-screen-management
	(AND exposed-p (SEND self :deexpose))
	(WITHOUT-INTERRUPTS
	  (COND ((SETQ active-p (MEMBER self (sheet-inferiors superior) :test #'EQ))
                 ;; Remove us from our old superior's list of inferiors.
		 (SETF (sheet-inferiors superior)
                       (DELETE self (THE list (sheet-inferiors superior)) :test #'EQ))
		 (FUNCALL superior :order-inferiors)
		 (screen-area-has-changed self)))
	  ;; If moving window from one screen to another, remove window from the screens
	  ;; copy of previously-selected-windows.  04/23/88 KJF
	  ;; Only bother doing this if screen was created in normal way.  That is, using
	  ;; tv:make-a-screen or tv:create-color-screen.  04/26/88 KJF
	  (WHEN (explorer-screen-p (sheet-get-screen self))
	    (UNLESS (EQ (sheet-get-screen new-superior) (sheet-get-screen self))
	      (remove-from-screens-previously-selected-windows self)))
	  (SETQ superior new-superior)
	  ;; Don't let locations-per-line change without changing sheet's arrays also, if needed.
	  ;; This handles cases of color/monochrome inconsistencies.
	  ;; On microExplorer, locations-per-line may be arbitrary, but arrays will always be
	  ;; the same (1 bit, until color on mExp. is available).  So for now, on mExp., we only
	  ;; need to make sure locations-per-line matches new superior.  04/22/88 KJF.
	  (IF (mac-window-p self)
	      (SETF locations-per-line (sheet-locations-per-line new-superior))
	      ;; :sheet-legal-for-superior determines if any conversion needs to take place.
	      ;; That is, if one is color and one is monochrome, a conversion may occur.
	      ;; :sheet-legal-for-superior can convert in both directions.  It looks at:
	      ;; *convert-color-sheet-to-monochrome*  04/22/88 KJF
	      (SEND self :sheet-legal-for-superior))
	  ;; Old code.  :sheet-legal-for-superior will set locations-per-line.
	  ;; If any conversion takes place, all inferiors will be fixed also, thus sometimes,
	  ;; (SHEET-SET-SUPERIOR-PARAMS SELF LOCATIONS-PER-LINE) will be redundant.
	  ;; 04/22/88 KJF
;;		LOCATIONS-PER-LINE (SHEET-LOCATIONS-PER-LINE NEW-SUPERIOR))
	  (sheet-set-superior-params self locations-per-line)
	  (LET* ((pixels-per-location (TRUNCATE 32. (screen-bits-per-pixel (sheet-get-screen self))))
		 (width-of-array (* pixels-per-location locations-per-line)))
	    (COND (bit-array
		   (SETQ bit-array
			 (grow-bit-array bit-array width-of-array height width))
		   (redirect-array screen-array (ARRAY-ELEMENT-TYPE screen-array)
				   width-of-array
				   height
				   bit-array 0))		 
		  (t
		   (redirect-array old-screen-array (ARRAY-ELEMENT-TYPE old-screen-array)
				   width-of-array
				   height
				   (sheet-superior-screen-array)
				   (+ x-offset (* y-offset width-of-array)))))
	    (WHEN (mac-window-p self)
	      (send-adjust-bit-array-maybe self)
	      (redirect-drawing-of-window-and-inferiors self)))
	  (COND (active-p
		 (sheet-consing
		   (SETF (sheet-inferiors new-superior)
			 (CONS self (COPY-LIST (sheet-inferiors new-superior)))))
		 (FUNCALL new-superior :order-inferiors)
		 (screen-area-has-changed self)))
	  (SEND self :update-time-stamp)))))

))

#!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.É#É"


(DEFUN grow-bit-array (array
		       width		   ; window's width
		       height		   ; window's height
		       &optional
		       (real-width width)  ; width to make the array
		       old-height	   ; window's old height
		       old-width	   ; window's old width
		       (contents-matter t))

  "Adjust size of ARRAY for a window of size WIDTH, HEIGHT, returning the adjusted array.
REAL-WIDTH		is the actual width to make the array.
OLD-HEIGHT and OLD-WIDTH are the previous size of the window,,
CONTENTS-MATTER 	says preserve the old contents if possible."
  (IF  (AND (EQ height old-height) (EQ width old-width))
       array				   ; only possible from :change-of-size-or-margins
    ;; else...
    (LET* ((wwidth (LOGAND #o-40 (+ real-width #o37)))  ;Array's new width as even number of words.
	   (narray (MAKE-ARRAY `(,height ,wwidth)  ; New physical storage for new-size array.
			       :type (ARRAY-TYPE array)))
	   (awidth  (ARRAY-DIMENSION array 1))	   ; array width when called.
	   (aheight (ARRAY-DIMENSION array 0))	   ; array height when called.
	   (color-system (UNLESS (TYPEP array '(ARRAY bit)) t))
	   (alu-initialize (IF color-system alu-back alu-setz)))
      ;;  Tell the Mac the new size of this window...
      (WHEN (AND (mac-system-p)
		 (TYPEP self 'sheet)
		 (EQ array (tv:sheet-bit-array self)))
	(send-adjust-bit-array-maybe self contents-matter
				     old-width old-height))
      ;;  Copy the old array's contents in the new array, cleaning up the rightmost and bottom
      ;;  strips of the new array if it's the larger of the two...
      (WHEN contents-matter
	(si:page-in-array array)
	;;  First, copy the largest rectangular area that fits in both arrays... 
	(IF (mac-window-p self)
	    (si-bitblt alu-seta
		       (MIN wwidth awidth)
		       (MIN height aheight)
		       array 0 0 narray 0 0)
	  (BITBLT alu-seta
		  (MIN wwidth awidth)
		  (MIN height aheight)
		  array 0 0 narray 0 0))
	;;  Then initialize the portions of the new array not covered by this bitblt...
	(LET ((amount-new-window-is-wider-than-old (- wwidth awidth)))
	  (WHEN (PLUSP amount-new-window-is-wider-than-old)
	    (IF (mac-window-p self)
		(si-bitblt alu-initialize
			   amount-new-window-is-wider-than-old height
			   narray awidth 0
			   narray awidth 0)
	      (BITBLT alu-initialize
		      amount-new-window-is-wider-than-old height
		      narray awidth 0
		      narray awidth 0))))
	(LET ((amount-new-window-is-taller-than-old (- height aheight)))
	  (WHEN (PLUSP amount-new-window-is-taller-than-old)
	    (IF (mac-window-p self)
		(si-bitblt alu-initialize
			   wwidth amount-new-window-is-taller-than-old
			   narray 0 aheight
			   narray 0 aheight)
	      (BITBLT alu-initialize
		      wwidth amount-new-window-is-taller-than-old
		      narray 0 aheight
		      narray 0 aheight)))))
	;;  Point old array at new array, return the new one...
	(STRUCTURE-FORWARD array narray)
	(si:page-out-array array)
	narray)))

))
