;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:10; Patch-File:T -*- ;;; Patch file for System version 123.241 ;;; Reason: ;;; Split out Host:Directory; from Name.Type#Version for Imagen ;;; header page. ;;; Written 26-Apr-88 13:18:13 by pld at site Gigamos Cambridge ;;; while running on Azathoth from band 1 ;;; with Experimental System 123.240, 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.1, microcode 1755, SDU Boot Tape 3.14, SDU ROM 8, the old ones. ; From modified file DJ: L.ZWEI; HOST.LISP#5 at 26-Apr-88 13:18:14 #10R ZWEI#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "ZWEI"))) (COMPILER::PATCH-SOURCE-FILE "SYS: ZWEI; HOST  " (defmethod (ed-basic-pathname :string-for-host) () ;;Print our name with no host or directory (send self :name)) )) ; From modified file DJ: L.NETWORK.IP-TCP.USER; IMAGEN.LISP#74 at 26-Apr-88 13:19:18 #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)) (directory (when truename (send (send truename :new-pathname :name nil :type nil :version nil) :string-for-printing))) (header-name (if truename (send (send truename :new-directory nil) :string-for-host) "Unnamed Stream")) (name (if truename (send truename :string-for-printing) "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~@[,directory ~S~],name ~S~ ,jobheader on,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 directory ;Host and directory for Job Header header-name ;Name for Job 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)))))) )) ; From modified file DJ: L.NETWORK.IP-TCP.USER; IMAGEN.LISP#74 at 26-Apr-88 13:20:05 #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)) (directory (when truename (send (send truename :new-pathname :name nil :type nil :version nil) :string-for-printing))) (header-name (if truename (send (send truename :new-directory nil) :string-for-host) "Unnamed Stream")) (name (if truename (send truename :string-for-printing) "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~@[,directory ~S~],name ~S~ ,jobheader on,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 directory ;Host and directory for Job Header header-name ;Name for Job 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)))))) ))