;; the buffer since we want to save the input to be yanked back.
  (:CLEAR-INPUT ()
    (COND (RUBOUT-HANDLER
	    (SETF (FILL-POINTER) 0)
	    (SETF (SCAN-POINTER) 0)
	    (SETF (TYPEIN-POINTER) 0)))
    (SETQ ES-UNTYI-CHAR NIL)
    (FUNCALL ES-CONSOLE-STREAM ':CLEAR-INPUT))

  ;; The first argument for this operation is an alist of options
  ;; or NIL.  The options currently supported are :FULL-RUBOUT, :PROMPT,
  ;; :REPROMPT and :PASS-THROUGH.

  (:RUBOUT-HANDLER (OPTIONS READ-FUNCTION &REST ARGS TEMP)
    ;; Save whatever the previous input was by cycling through the kill ring.
    ;; If the previous input was the empty string, as in exiting via the :FULL-RUBOUT
    ;; option, don't bother.
    (COND ((NOT (ZEROP (FILL-POINTER)))
	   (SETQ ES-KILL-RING (CIRCULAR-LIST-LAST ES-KILL-RING))
	   (SETQ ES-BUFFER (CAR ES-KILL-RING))))
    ;; Empty the rubout handler buffer of the new buffer.
    (SETF (FILL-POINTER) 0)
    (SETF (TYPEIN-POINTER) 0)

    ;; Prompt if desired.
    (SETQ TEMP (ASSQ ':PROMPT OPTIONS))
    (IF TEMP (FUNCALL (CADR TEMP) #'EDITOR-STREAM NIL))
    ;; Record the position on the screen at which the handler was entered.
    (IF (MEMQ ':READ-CURSORPOS ES-WHICH-OPERATIONS)
	(MULTIPLE-VALUE (ES-X-ORIGIN ES-Y-ORIGIN)
	  (FUNCALL ES-CONSOLE-STREAM ':READ-CURSORPOS)))

    ;; Absorb and echo the untyi'ed char.  We don't need to do this while inside
    ;; the rubout handler since characters get echoed there.  This code runs when
    ;; READ is called from inside the error handler, for instance.
    ;; This is kind of a crock since the rubout handler should decide what to do
    ;; with the character.
    (COND (ES-UNTYI-CHAR (ARRAY-PUSH ES-BUFFER ES-UNTYI-CHAR)
			 (FUNCALL ES-CONSOLE-STREAM ':TYO (LDB %%KBD-CHAR ES-UNTYI-CHAR))
			 (SETQ ES-UNTYI-CHAR NIL)))

    ;; These two specials used for communication up and down the stack.
    ;; First says we're inside the rubout handler, and the second passes
    ;; options down to the editor function.  These specials could be flushed if this
    ;; state information were kept in the stream, but it would have to be explicitly
    ;; turned on and off when a specific stack frame was entered and exited.
    (DO ((RUBOUT-HANDLER T)
	 (TV-MAKE-STREAM-RUBOUT-HANDLER-OPTIONS OPTIONS))
	(NIL)
      ;; Loop until normal (non-throw) exit, which will pass by the CATCH and DO.
      ;; Each time we enter this loop (after the first time), we are preparing for
      ;; a re-scan of the input string, so reset the scan pointer.
      (SETF (SCAN-POINTER) 0)
      (*CATCH 'RUBOUT-HANDLER
	      (PROGN
		(ERRSET
		  ;; APPLY is more efficient than LEXPR-FUNCALL if the read
		  ;; function takes a &rest argument.
		  (MULTIPLE-VALUE-RETURN (APPLY READ-FUNCTION ARGS)))
		;; On read error, reprint contents of buffer so user can rub out ok.
		;; The ERRSET lets the error message get printed.
		(IF (MEMQ ':READ-CURSORPOS ES-WHICH-OPERATIONS)
		    (MULTIPLE-VALUE (ES-X-ORIGIN ES-Y-ORIGIN)
		      (FUNCALL ES-CONSOLE-STREAM ':READ-CURSORPOS)))
		(FUNCALL ES-CONSOLE-STREAM ':STRING-OUT ES-BUFFER)
		;; If the user makes an error during read-time, swallow
		;; all input until a rubout (or some editing character)
		;; is typed.  When the edit is complete, we will
		;; throw back out of here.  This should be changed to stop
		;; echoing until the edit is done.
		(DO () (NIL)
		  (EDITOR-STREAM ':TYI))))
      ;; When a rubout or other editing operation is done, throws back to the
      ;; catch to reread the input.  But if the :FULL-RUBOUT option was specified
      ;; and everything was rubbed out, we return NIL and the specified value.
      (IF (AND (ZEROP (FILL-POINTER))
	       (SETQ TEMP (ASSQ ':FULL-RUBOUT OPTIONS)))
	  (RETURN NIL (CADR TEMP)))
      )))

;; Returns the "last" element in a circular list, i.e. the cons pointing to the cons we
;; are holding on to.

(DEFUN CIRCULAR-LIST-LAST (LIST)
  (DO ((L (CDR LIST) (CDR L))
       (PREV LIST L))
      ((EQ LIST L) PREV)))

;; (DEFUN CIRCULAR-LIST-LENGTH (LIST)
;;   (IF (NULL LIST) 0
;;       (DO ((L (CDR LIST) (CDR L))
;; 	   (I 1 (1+ I)))
;; 	  ((EQ LIST L) I))))

;; Forward all other operations to the underlying stream rather than
;; STREAM-DEFAULT-HANDLER.  Again, we really need a handle on SELF.

(DEFUN EDITOR-STREAM-DEFAULT-HANDLER (&REST REST)
  (LEXPR-FUNCALL ES-CONSOLE-STREAM REST))