;;; -*- Mode:Lisp; Readtable:ZL; Package:LASER2; Base:8; Patch-File:T -*-
;;; Patch file for LMI Laser Printer II version 12.1
;;; Reason:
;;;  Make LASER2 use normal TCP gateway software:
;;;  NOTE: You show do an (UPDATE-SITE-CONFIGURATION-INFO) after this.
;;; Written 4-Apr-86 16:41:33 by JER at site LMI Cambridge
;;; while running on Natasha Nogoodnik from band 3
;;; with Experimental System 110.166, Experimental Lambda-Diag 7.3, Experimental Local-File 68.5, Experimental FILE-Server 18.2, Experimental Unix-Interface 9.1, Experimental ZMail 65.11, Experimental Object Lisp 3.1, Experimental Tape 6.33, Experimental Site Data Editor 3.3, Experimental Tiger 24.0, Experimental KERMIT 31.2, Experimental Window-Maker 1.0, Experimental Gateway 4.5, Experimental TCP-Kernel 39.5, Experimental TCP-User 62.6, Experimental TCP-Server 45.5, Experimental MEDIUM-RESOLUTION-COLOR 3.1, Experimental MICRO-COMPILATION-TOOLS 3.2, Experimental LMI Laser Printer II 12.0, microcode 1408, SDU ROM 102, Alpha III(3/25 mrc) printing.



; From modified file DJ: L.HARDCOPY.LASER2; DEFS.LISP#24 at 4-Apr-86 16:41:35
#8R LASER2#:
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LASER2")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: HARDCOPY; LASER2; DEFS  "

(defmethod (laser2-stream :after :init) (&rest ignore)
 )

))
;; *** Note: ***
;;   You may lose because the buffer's readtable (ZL) differs from that of the patch buffer.
;; *************

; From file DJ: L.HARDCOPY.LASER2; TCP.LISP#17 at 4-Apr-86 16:42:13
#8R LASER2#:
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "LASER2")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: HARDCOPY; LASER2; TCP  "

(defmethod (laser2-stream :run-server) ()
  ;; So we can open files
  (setq tcp-stream nil)
  (let ((user-id "LASER2") rmname fndname)
    (do-forever
      ;; Wait for job.
      (process-wait "No Jobs" #'(lambda (x) (send x :printer-queue)) self)
      (setq current-job (pop printer-queue))
      (unwind-protect
	  (*catch 'no-printer
	    (cond 
	      ((get-site-option :arpa-gateways)
	       (setq rmname (apply 'circular-list (get-site-option :arpa-gateways)))
	       (*catch 'open
		 (do-forever
		   (setq fndname (car rmname))
		   (setq tcp-stream (catch-error
				      (chaos:connect
					      fndname
					      (format nil "TCP ~A"
						      (string-subst-char
							#/space #\#
							(cadr (cadr current-job))))) nil))
		   (if tcp-stream (*throw 'open nil))
		   (setq rmname (cdr rmname))
		   (process-sleep 600. "No Printers Available")))
	       (setq tcp-stream (chaos:make-stream tcp-stream)))
	      (t (*throw 'no-printer t)))
	    (tv:background-notify "Now Printing ~A on ~A" (car current-job)
				  (second (second current-job)))
	    (cond
	      ((equal (car current-job) :FILE)
	       (apply self :print-file (cddr current-job)))
	      ((equal (car current-job) :STREAM)
	       (apply self :print-stream (cddr current-job)))
	      ((equal (car current-job) :ARRAY)
	       (apply self :print-bit-array (cddr (butlast current-job)))
	       (if (not (last current-job))
		   (deallocate-resource 'tv:hardcopy-bit-array-resource (caddr current-job))))))
	(if tcp-stream
	    (close tcp-stream))
	(setq tcp-stream nil))
      (setq current-job nil))))

))