;;; -*- Mode:LISP; Package:USER; Base:10; Readtable:CL -*-

;;; CHAR-EOF-STREAM

;;; *** THIS IS AN EXAMPLE PROGRAM ONLY.      ***
;;; *** NO GUARANTEES OR SUPPORT ARE OFFERED. ***

;;; Generic stream and serial support for streams that denote EOF by a
;;; specific EOF character.  This is useful, e.g., for transferring
;;; files to a Lambda from a PC over serial port B.

(defflavor char-eof-stream-mixin
	 ((eof-char #\end)
	  (eof-flag nil))
	 (si:input-stream)
  (:inittable-instance-variables eof-char)
  (:settable-instance-variables eof-char)
  :gettable-instance-variables)

(defmethod (char-eof-stream-mixin :untyi)
	   (cont mt ignore ch)
  (funcall-with-mapping-table cont mt :untyi ch))

(defmethod (char-eof-stream-mixin :around :tyi)
	   (cont mt ignore &aux ch)
  (cond
    (eof-flag nil)
    ((null (setq ch (funcall-with-mapping-table cont mt :tyi))) nil)
    ((char-equal ch eof-char)
     (setq eof-flag t)
     nil)
    (t ch)))

(defmethod (char-eof-stream-mixin :close) (&rest ignore)
  (setq eof-flag t))

#| Forms for testing:

(defflavor test-stream-mixin
	 ()
	 ())

(defmethod (test-stream-mixin :tyi) ()
  (read-char))

(defflavor my-stream ()
	   (test-stream-mixin char-eof-stream-mixin))

(defun test-my-stream(&optional (eof #\end))
  (let((s (make-instance 'my-stream :eof-char eof)))
    (with-open-stream(in s)
      (stream-copy-until-eof in terminal-io))
    (describe s)))

|#

;;;Fix bug on SDU shared devices:

#-LMI
(CERROR "Compile it anyway."
	"The Serial Port code being compiled is only written for the Lambda.")
	
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; SHARED-DEVICE  "
SI:(defmethod (sdu-serial-b-shared-device :before :open) (flavor-and-init-options shared-device-pathname)
  (let((flavor (car flavor-and-init-options))
       (init-options (cdr flavor-and-init-options)))
    (when init-options
      (setf (getf init-options :shared-device) shared-device-pathname)
      (setq last-instance (apply 'make-instance flavor init-options)))))))

;;;Serial port support for char-eof streams

(defflavor sdu-serial-char-eof-stream ()
	   (char-eof-stream-mixin si:sdu-serial-stream))

(defflavor sdu-serial-ascii-char-eof-stream ()
	   (char-eof-stream-mixin si:sdu-serial-ascii-stream)
  ;;Let EOF-CHAR default to ASCII ctrl-Z (commonly used for EOF)
  (:default-init-plist :eof-char 26.))

(defflavor sdu-serial-xon-xoff-char-eof-stream ()
	   (char-eof-stream-mixin si:sdu-serial-xon-xoff-stream))

(defflavor sdu-serial-ascii-xon-xoff-char-eof-stream ()
	   (char-eof-stream-mixin si:sdu-serial-ascii-xon-xoff-stream))

(compile-flavor-methods
  sdu-serial-char-eof-stream
  sdu-serial-ascii-char-eof-stream
  sdu-serial-xon-xoff-char-eof-stream
  sdu-serial-ascii-xon-xoff-char-eof-stream)

#| EXAMPLES:

To use execute, e.g.,

(open "sdu-serial-b:"
      :flavor-and-init-options
      '(sdu-serial-xon-xoff-char-eof-stream
	 :baud-rate 1200.
	 :eof-char 26.))

More generally:

(with-open-stream(sdu (open "sdu-serial-b:"
			    :flavor-and-init-options
			    '(sdu-serial-xon-xoff-char-eof-stream
			       :baud-rate 1200.
			       :eof-char 26.)))
  (stream-copy-until-eof sdu terminal-io))


|#