;;; -*- Mode:Lisp; Readtable:T; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for CDI version 1.21
;;; Reason:
;;;  Print file patch.
;;; Written 21-Jul-86 12:53:42 by Gibson at site CDI Dallas
;;; while running on EXPLORER-1 from band 1
;;; with System 110.232, Lambda-Diag 7.17, Experimental Local-File 68.7, FILE-Server 18.4, Unix-Interface 9.1, ZMail 65.14, Object Lisp 3.4, Tape 6.39, Site Data Editor 3.3, Tiger 24.0, KERMIT 31.3, Gateway 4.15, TCP-Kernel 39.7, TCP-User 62.7, TCP-Server 45.5, MEDIUM-RESOLUTION-COLOR 3.4, MICRO-COMPILATION-TOOLS 3.2, System Revision Level 3.93, Experimental Window-Maker 2.0, Experimental CDI 1.20, microcode 1564, CDI Beta III.



; From file S2: >Lambda-3>HARDCOPY>TIGER>server.lisp.192 at 21-Jul-86 12:53:42
#8R TIGER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "TIGER")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: HARDCOPY; TIGER; SERVER  "

(defun tiger-file-internal ()
  (error-restart ((sys:abort error) "Return to printer specification command level.")
    (do-forever
      (process-wait "Queue Empty" #'(lambda () tiger-queue))
      ;; if remote machine then we must do the following
      ;; if it is a file, just send the file name to the tiger host
      ;; otherwise write the file somewhere, and then send this temporary
      ;; filename to the tiger host.
      (let* ((queue-object (first tiger-queue))
	     (user-id "Tiger"))			;Fool FORCE-USER-TO-LOGIN
	(multiple-value-bind (tiger-type tiger-host)
	    (figure-out-printer-type-and-host (figure-out-printer queue-object))
	  (cond ((host-equal tiger-host si:local-host)
		 (setq handshake-type
		       (or (get tiger-type 'tiger-serial-handshake-type)
			   :default))
		 (multiple-value-bind (device flavor-and-inits)
		     (serial-flavor-requirements (tq-options queue-object))
		   (WITH-OPEN-FILE (x device :flavor-and-init-options flavor-and-inits)
		     (setq serial-stream x)
		     (let ((aborted-p t))
		       (unwind-protect
			   (progn (tiger-process-immediate)
				  (setq aborted-p nil))
			 (when aborted-p
			   (handle-aborted-tiger-process-immediate)))))))
		(t (selectq (tq-type queue-object)
		     ((:file :array-file :aray-file :raw-file)
		      (cond ((stringp (tq-object queue-object))
			     (tiger-notify-user (format nil "Spooling to ~A" tiger-host)
						(tq-sender queue-object))
			     (tiger-send-it tiger-host queue-object))
			    (t (tiger-notify-user
				 (format nil "~A is not a valid tiger file queue entry."
					 queue-object)
				 (tq-sender queue-object)))))
		     (:array (tiger-array-entry queue-object t))
		     (:otherwise (tiger-notify-user
				   (format nil "Error Printing ~A, ~A is not a known type"
					   (tq-object queue-object)
					   (tq-type queue-object))
				   (tq-sender queue-object))))
		   (pop-tiger-queue))))))))
))