;;; -*- Mode:LISP; Package:SI; Readtable:CL; Base:10 -*-
;;; Printer type :UNIX-CHAOS-EVAL-PRINTER
;;; The printer spec (:unix-chaos-eval-printer host . options)
;;;   Options:
;;;    :PRINT, defaults to "/usr/bin/lpr", format string takes the filename
;;;    :STATUS, is the command string to get status; if not supplied, you can't
;;;      get the status
;;;
;;; Useful options:
;;; System V Unix Imagen software
;;;  :PRINT "/usr/imagen/imprint -h '~A' -L -l60 2>/tmp/ierror" :STATUS "/usr/imagen/ipq"
;;; 4.2bsd Imagen software, using printer called im1
;;;  :PRINT "/usr/local/bin/imprint -h '~A' -L -l60 2>/tmp/ierror" :STATUS "/usr/ucb/lpq"
;;; 4.2bsd, using standard software
;;;  :PRINT "/usr/ucb/lpr -J '~A'" :STATUS "/ucb/ucb/lpq"
;;; System V, using standard software
;;;  :PRINT "/usr/bin/lpr"

(defun check-for-text-type (format)
  (unless (eq format :text)
    (ferror "Only ~S format is supported by this software, not ~S." :text FORMAT)))

(defun check-unix-printer-spec (printer)
  (unless (and (consp printer)
	       (cdr printer))
    (ferror "You can't use just ~S as a Unix printer spec." printer)))

(defun (:property :unix-chaos-eval-printer print-file) (printer file-name &rest args)
  (with-open-file-case (file-stream file-name :direction :input)
    (fs:file-error
     (format *error-output* "~&Error in opening file: ")
     (send file-stream :report *error-output*))
    (:no-error (apply #'unix-chaos-eval-print-stream printer file-stream
		      :file-name (send file-stream :truename)
		      args))))

(defprop :unix-chaos-eval-printer unix-chaos-eval-print-stream print-stream)

(defconst unix-chaos-eval-printer-rfc-string
	  "EVAL /usr/imagen/imprint -L -h -n \"~a\" 1>/dev/null 2>/dev/null")

(defun unix-chaosnet-eval-stream (printer eval-arg-string &rest options)
  (apply #'chaos:open-stream (second printer) (string-append "EVAL " eval-arg-string)
	 options))

(defun unix-chaos-eval-print-stream (printer from-stream
				     &key (format :text) (file-name "Stream Output") &allow-other-keys)
  (check-for-text-type format)
  (check-unix-printer-spec printer)
  (with-open-stream-case (stream (unix-chaosnet-eval-stream printer
							    (format nil (or (get (cdr printer) :print)
									    "/usr/bin/lpr")
								    file-name)
							    :direction :output))
    (error
     (format *error-output* "~&Error: ")
     (send stream :report *error-output*))
    (:no-error
     (do ((c (read-char from-stream nil) (read-char from-stream nil)))
	 ((null c))
       (case c
	 (#\epsilon (read-char from-stream)) ; skip font speficier
	 (#\newline (send stream :tyo #o12))
	 (#\tab (send stream :tyo #o11))
	 (#\overstrike (send stream :tyo #o10))
	 (#\page (send stream :tyo #o14))
	 (t (send stream :tyo c)))))))

(defun copy-from-unix-stream-until-eof (from-stream to-stream)
  (do ((c (read-char from-stream nil) (read-char from-stream nil)))
      ((null c))
    (case c
      (#\newline (send to-stream :tyo #o12))
      (#\line (send to-stream :tyo #\newline))
      (t (send to-stream :tyo c)))))

(defun get-unix-chaos-eval-printer-status (printer &optional (report-stream *standard-output*))
  (check-unix-printer-spec printer)
  (fresh-line report-stream)
  (let ((contact (get (cdr printer) :status)))
    (if contact
	(with-open-stream-case (stream (unix-chaosnet-eval-stream printer contact
								  :ascii-translation t :direction :input))
	  (error
	   (format *error-output* "Error: ")
	   (send stream :report *error-output*))
	  (:no-error
	   (copy-from-unix-stream-until-eof stream report-stream)))
      (format *error-output* "~&Cannot get status of this printer."))))

(setf (get :unix-chaos-eval-printer print-status) 'get-unix-chaos-eval-printer-status)

;;; Yet another workaround.  :TYPE is the real of printer at the other end.
;;; :PRINT is just a command, not a FORMAT string.

(defun queue-via-unix-eval (printer operation args)
  (let ((handler (get (getf printer :type) 'use-supplied-stream)))
    (unless handler
      (error "Can't do ~S on ~A." operation printer))
    (let ((stream nil))
      (unwind-protect
	  (progn
	    (setq stream (unix-chaosnet-eval-stream printer (or (get (cdr printer) :print) "/usr/bin/lpr")
						    :direction :output))
	    (apply handler stream operation args))
	(close stream :abort t)))))

(defun (:queue-via-unix si:print-stream) (printer &rest args)
  (check-unix-printer-spec printer)
  (queue-via-unix-eval printer :print-stream args))

(defun (:queue-via-unix si:print-file) (printer &rest args)
  (check-unix-printer-spec printer)
  (queue-via-unix-eval printer :print-file args))

(defun (:queue-via-unix si:print-bit-array) (printer &rest args)
  (check-unix-printer-spec printer)
  (queue-via-unix-eval printer :print-bit-array args))

(setf (get :queue-via-unix 'print-status) 'get-unix-chaos-eval-printer-status)