;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.66
;;; Reason:
;;;  Remove ancient leftover debugging code from screendump code.
;;; Written 24-Aug-88 16:01:32 by smh (Steve Haflich) at site Gigamos Cambridge
;;; while running on Harpo from band 3
;;; with Don't-dump-a-band! Inconsistent (unreleased patches loaded) System 126.66, ZWEI 125.19, ZMail 73.2, Local-File 75.2, File-Server 24.1, Unix-Interface 13.0, Tape 24.2, Lambda-Diag 17.0, microcode 1762, SDU Boot Tape 3.12, SDU ROM 102, kold 4aug88.



; From modified file DJ: L.WINDOW; BASSTR.LISP#417 at 24-Aug-88 16:02:30
#8R TV#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; BASSTR  "


(DEFUN KBD-ESC-Q (ARG &AUX (PRINTER (OR SI:*DEFAULT-BIT-ARRAY-PRINTER* SI:*DEFAULT-PRINTER*)))
  (IF (STRINGP PRINTER)
      (SETQ PRINTER (SI:EXPAND-PRINTER-NAME PRINTER)))
  (IF (GET (IF (CONSP PRINTER) (CAR PRINTER) PRINTER) 'SI:PRINT-BIT-ARRAY)
      (USING-RESOURCE (ARRAY HARDCOPY-BIT-ARRAY-RESOURCE)
	(MULTIPLE-VALUE-BIND (NIL WIDTH HEIGHT)
	    (SNAPSHOT-SCREEN (SELECTQ ARG
			       (1 SELECTED-WINDOW)
			       (0 DEFAULT-SCREEN)
			       (4 (DO ((WINDOW SELECTED-WINDOW (SEND WINDOW :SUPERIOR)))
				      ((OR (NULL WINDOW) (TYPEP WINDOW 'BASIC-FRAME))
				       (OR WINDOW
					   (RETURN-FROM KBD-ESC-Q
					     (TV:NOTIFY NIL "Window or superior not a frame"))))))
			       (OTHERWISE
				(main-screen-and-who-line)))
			     ARRAY (if (not (or (equal arg 0) (equal arg 1) (equal arg 4)))
				       (+ main-screen-width
					  (if (and (boundp 'fancy-landscape) fancy-landscape)
					      control-panel-width
					    0))))
	  (BEEP)
	  (let ((left 0)
		(top 0)
		(right width)
		(bottom height))
	    (when (eq arg 3)
	      (let ((h (if (atom *terminal-3-q-margin*) *terminal-3-q-margin*
			 (car *terminal-3-q-margin*)))
		    (v (if (atom *terminal-3-q-margin*) *terminal-3-q-margin*
			 (cadr *terminal-3-q-margin*))))
		(setq left h right (- right h)
		      top v bottom (- bottom v))))
	    (HARDCOPY-BIT-ARRAY ARRAY left top right bottom ':PRINTER PRINTER))))
    (TV:NOTIFY NIL "I don't know a printer that can hardcopy the screen")))

))

; From modified file DJ: L.WINDOW; BASSTR.LISP#417 at 24-Aug-88 16:02:32
#8R TV#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TV")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: WINDOW; BASSTR  "


(DEFUN SNAPSHOT-SCREEN (FROM-ARRAY TO-ARRAY &OPTIONAL WIDTH HEIGHT)
  ;; (set 'w width) ; Why was this here?  -smh 24aug88
  (WITHOUT-INTERRUPTS
    (COND ((ARRAYP FROM-ARRAY)
	   (OR WIDTH (SETQ WIDTH (PIXEL-ARRAY-WIDTH FROM-ARRAY)))
	   (OR HEIGHT (SETQ HEIGHT (PIXEL-ARRAY-HEIGHT FROM-ARRAY))))
	  (T
	   (OR WIDTH (SETQ WIDTH (SHEET-WIDTH FROM-ARRAY)))
	   (OR HEIGHT (SETQ HEIGHT (SHEET-HEIGHT FROM-ARRAY)))
	   (SETQ FROM-ARRAY (OR (SHEET-SCREEN-ARRAY FROM-ARRAY)
				(FERROR "Window ~S does not have an array" FROM-ARRAY)))))
    (WHO-LINE-UPDATE)
    (BITBLT ALU-SETZ (PIXEL-ARRAY-WIDTH TO-ARRAY) (PIXEL-ARRAY-HEIGHT TO-ARRAY)
	    TO-ARRAY 0 0 TO-ARRAY 0 0)
    (BITBLT ALU-SETA WIDTH HEIGHT FROM-ARRAY 0 0 TO-ARRAY 0 0))
  (VALUES TO-ARRAY WIDTH HEIGHT))

))