;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 123.231
;;; Reason:
;;;  Fix zwei:editor-stream-mixin to make it's Interval be a zwei:file-buffer
;;;  with an appropriate name.  Fix (tcpa:print-stream-to-imagen) to not bomb
;;;  out if the stream doesn't have a :truename.
;;; Written 11-Apr-88 14:34:32 by pld at site Gigamos Cambridge
;;; while running on Jack Flanders from band 1
;;; with Experimental System 123.229, Experimental Local-File 73.4, Experimental FILE-Server 22.2, Experimental Unix-Interface 11.0, Experimental KERMIT 34.3, Experimental ZMail 71.0, Experimental Lambda-Diag 15.0, Experimental Tape 22.0, microcode 1755, SDU Boot Tape 3.14, SDU ROM 8.



; From modified file DJ: L.ZWEI; STREAM.LISP#181 at 11-Apr-88 14:34:45
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; STREAM  "


(defmethod (editor-stream-mixin :before :init) (ignore)
  ;;When the Interval is created, make it a zwei:file-buffer
  (setq interval 'file-buffer))

))

; From modified file DJ: L.ZWEI; STREAM.LISP#181 at 11-Apr-88 14:34:46
#8R ZWEI#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; STREAM  "


(DEFMETHOD (EDITOR-STREAM-MIXIN :AFTER :INIT) (INIT-PLIST)
  (SETQ *STREAM-INPUT-HISTORY* (MAKE-HISTORY (STRING-APPEND "input history of "
							    (SEND *STREAM-SHEET* ':NAME))))
  (SETQ TV:IO-BUFFER (SEND *STREAM-SHEET* ':IO-BUFFER))
  (SETQ *STREAM-BLINKER* (WINDOW-POINT-BLINKER *STREAM-SHEET*))
  (AND (GET INIT-PLIST ':IBEAM-BLINKER-P)
       (LET ((BLINKER (TV:MAKE-BLINKER *STREAM-SHEET* 'STREAM-IBEAM-BLINKER
				       ':EDITOR-STREAM SELF ':VISIBILITY NIL )))
	 (SETF (WINDOW-SPECIAL-BLINKER-LIST *STREAM-SHEET*)
	       (DELQ (ASSQ 'STREAM-BLINK-IBEAM (WINDOW-SPECIAL-BLINKER-LIST *STREAM-SHEET*))
		     (WINDOW-SPECIAL-BLINKER-LIST *STREAM-SHEET*)))
	 (PUSH `(STREAM-BLINK-IBEAM . ,BLINKER)
	       (WINDOW-SPECIAL-BLINKER-LIST *STREAM-SHEET*))))
  (let ((name (tv:sheet-name *stream-sheet*)))
    (setf (symeval-in-instance interval 'name) name)
    (setf (symeval-in-instance interval 'pathname) (make-pathname :host si:local-host :name (string-upcase name))))
  (SYS:%USING-BINDING-INSTANCES (CLOSURE-BINDINGS EDITOR-CLOSURE))
  (SETQ *EDITOR-STREAM* SELF
	*WINDOW* *STREAM-SHEET*
	*EDITOR-STREAM-START-BP* *STREAM-START-BP*)
  (PUSH 'STREAM-PRE-COMMAND-HOOK *COMMAND-HOOK*)
  (PUSH 'STREAM-COMMAND-HOOK *POST-COMMAND-HOOK*))

))

; From modified file DJ: L.NETWORK.IP-TCP.USER; IMAGEN.LISP#73 at 11-Apr-88 14:39:15
#10R TCP-APPLICATION#: #!:CL
(COMPILER-LET ((*PACKAGE* (GLOBAL:PKG-FIND-PACKAGE "TCP-APPLICATION")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; IP-TCP; USER; IMAGEN  "

(defun print-stream-to-imagen (file-stream address &optional options)
  (check-type address string)
  (with-open-file (tcp-stream (string-append "TCP-HOST:"
					     address
					     ".IMAGEN")
			      :direction :output
			      :output-buffers *imagen-writes-out*
			      :keyword "Imagen Printer")
    (let* ((format (getf options :format :text))
	   (copies (getf options :copies *imagen-default-copies*))
	   (form-length (getf options :form-length *imagen-default-form-length*))
	   (form-width (getf options :form-width *imagen-default-form-width*))
	   (line-wrapping (getf options :line-wrapping *imagen-default-line-wrapping*))
	   (forms-per-page (getf options :forms-per-page *imagen-default-forms-per-page*))
	   ;;forms-per-page = 1, form-width = 80  --> normal PORTRAIT
	   ;;forms-per-page = 1, form-width = 132 --> normal LANDSCAPE
	   ;;forms-per-page = 2, form-width = 80  --> two pages per page, side by side, LANDSCAPE
	   ;;forms-per-page = 2, form-width = 132 --> two pages per page, one above other, PORTRAIT
	   (left-margin (getf options :left-margin *imagen-default-left-margin*))
	   (line-numbers (getf options :line-numbers *imagen-default-line-numbers*))
	   (truename (global:send-if-handles file-stream :truename))
	   (name (if truename
		     (send truename :string-for-editor)
		   "Unnamed Stream"))
	   (spool-date (time:print-current-time nil :dd-mmm-yyyy))
	   (file-date (getf options :file-date spool-date))
	   (page-headings (getf options :page-headings *imagen-default-page-headings*))
	   (page-list (getf options :page-list))
	   (stream nil))
      (setq stream (ftp:make-ascii-translating-output-stream tcp-stream nil))
      (format stream
	      "@document(language ~A,jamresistance on,host ~S~
,jobheader on,name ~S,spooldate ~S,owner ~S~:[~*~;,copies ~D,pagecollation on~],pagereversal on~
,formlength ~D,formwidth ~D,formsperpage ~D,leftmargin ~D)"
	      (case format
		(:impress "Impress")
		(:tek "Tektronix")
		(otherwise "Printer"))
	      (send si:local-host :name)	;Local host
	      name	;Name for Job Header and Page Header
	      spool-date	;Date for Job Header
	      (string si:user-id)	;Owner for Job Header
	      (> copies 1)	;Conditional for multiple-copy options
	      copies	;Number of copies
	      form-length	;lines per logical page
	      form-width	;columns per logical page
	      forms-per-page	;logical pages per physical pages
	      left-margin	;blank columns at left edge of each logical page
	      )
      (ecase format
	((:text nil)
	 (global:stream-copy-until-eof file-stream
				       (make-paginating-stream tcp-stream
							       (and page-headings (list name t file-date))
							       (if page-headings 2 0)
							       line-numbers
							       form-length
							       form-width
							       line-wrapping
							       left-margin
							       t
							       page-list)))
	(:ascii
	 (global:stream-copy-until-eof file-stream stream))
	((:impress :tek)
	 (global:stream-copy-until-eof file-stream tcp-stream))))))

))