;; Below are two editor functions which form a part of the editor stream.
;; The first is a simple display editor which is a partial emacs, and the
;; second is a printing terminal rubout handler for use via supdup.

;; These functions get called whenever a :TYI message is sent to the stream
;; and we are inside the rubout handler.  If the user types a normal
;; character it is echoed, put in the buffer, and returned.  If the user
;; types a rubout, or any other editing character, any number of editing
;; commands are processed by modifying the buffer, then, when the first
;; non-editing character is typed, a throw is done back to the top level of
;; the read function and the buffered input will be re-scanned.  The
;; character must be typed at the end of the line in order for the throw to
;; take place.  This may be a bug. 

(DEFVAR DISPLAY-EDITOR-COMMAND-ALIST NIL)

(DEFUN DISPLAY-EDITOR
       (STREAM &AUX CH CH-CHAR CH-CONTROL-META COMMAND
	       (OPTIONS TV-MAKE-STREAM-RUBOUT-HANDLER-OPTIONS)
	       (RUBBED-OUT-SOME NIL)
	       (PASS-THROUGH (CDR (ASSQ ':PASS-THROUGH OPTIONS)))
	       (NUMERIC-ARG NIL))
  ;; Read characters.  If an ordinary character typed and nothing rubbed out,
  ;; return immediately.  Otherwise, let all editing operations complete
  ;; before returning. 
  ;; This {{#/
}} is correct, but is it needed?
  (SETF (TYPEIN-POINTER) (FILL-POINTER))
  (*CATCH
    'RETURN-CHARACTER
    (DO () (NIL)
      ;; Read a character from the underlying stream.  This is a kludge for
      ;; speed to avoid making two function calls -- one back to the editor
      ;; stream and then one to the console stream.
      ;; Really should be:
      ;; (LET ((RUBOUT-HANDLER NIL)) (FUNCALL STREAM ':TYI))
      ;; or better (FUNCALL STREAM ':RAW-TYI) which would bypass the rubout handler.
      (SETQ CH (FUNCALL ES-CONSOLE-STREAM ':TYI))
      (SETQ CH-CHAR (LDB %%KBD-CHAR CH))
      (SETQ CH-CONTROL-META (LDB %%KBD-CONTROL-META CH))
      (SETQ COMMAND (ASSQ (CHAR-UPCASE CH) DISPLAY-EDITOR-COMMAND-ALIST))
      
      (COND
	;; Don't touch this character
	((MEMQ CH PASS-THROUGH)
	 (DE-INSERT-CHAR STREAM CH 1 RUBBED-OUT-SOME)
	 (SETQ RUBBED-OUT-SOME T))
	;; A stream editor character of some sort.  The RUBBED-OUT-SOME bit can
	;; only be cleared by entering this function again.  The stream editor
	;; editor function is passed the stream and a numeric argument.
	(COMMAND
	  (SETQ RUBBED-OUT-SOME
		(OR (FUNCALL (CDR COMMAND) STREAM (OR NUMERIC-ARG 1)) RUBBED-OUT-SOME))
	  (SETQ NUMERIC-ARG NIL))
	
	;;Handle control-number, control-u, and control-minus specially.
	((AND (NOT (ZEROP CH-CONTROL-META))
	      ({{#/}} CH-CHAR #/0)
	      ({{#/}} CH-CHAR #/9))
	 (SETQ CH-CHAR (- CH-CHAR #/0))
	 (SETQ NUMERIC-ARG (+ (* (OR NUMERIC-ARG 0) 10.) CH-CHAR)))
	((= (CHAR-UPCASE CH) #{{#/}}/U)
	 (SETQ NUMERIC-ARG (* (OR NUMERIC-ARG 1) 4)))
	
	;; Some other random control character -- beep and ignore
	((NOT (ZEROP CH-CONTROL-META))
	 (FUNCALL STREAM ':BEEP)
	 (SETQ NUMERIC-ARG NIL))
	
	;; Self-inserting character.  Set RUBBED-OUT-SOME since if we return,
	;; we were typing in the middle of the line.  Typing at the end of the
	;; line throws to RETURN-CHARACTER.
	(T (DE-INSERT-CHAR STREAM CH (OR NUMERIC-ARG 1) RUBBED-OUT-SOME)
	   (SETQ NUMERIC-ARG NIL)
	   (SETQ RUBBED-OUT-SOME T))))))

;; A self-inserting character.  A character gets here by being non-control-meta
;; and not having an editing command associated with it.  Or it can get here
;; via the :PASS-THROUGH option.  If a control-meta character gets here, it is
;; echoed as one, but loses its control-meta bits in the buffer.  Also, inserting
;; a character with bucky bits on doesn't currently work since TV-CHAR-WIDTH returns
;; 0 as the width, and TV-TYO can't print it.

(DEFUN DE-INSERT-CHAR (STREAM CH N RUBBED-OUT-SOME &AUX STRING)
  (SETQ STRING (MAKE-ARRAY NIL 'ART-16B N))
  (DOTIMES (I N) (ASET CH STRING I))
  (UNWIND-PROTECT (DE-INSERT-STRING STREAM STRING 0 N RUBBED-OUT-SOME)
		  (RETURN-ARRAY STRING)))

;; Insert a string into the buffer and print it on the screen.  The string
;; is inserted at the current cursor position, and the cursor is left after the string.

(DEFUN DE-INSERT-STRING (STREAM STRING BEGIN END RUBBED-OUT-SOME
				&AUX (WIDTH (- END BEGIN))
				     (TYPEIN-POINTER (TYPEIN-POINTER))
				     (FILL-POINTER   (FILL-POINTER)))
  ;; Increase the size of of the typein buffer, if necessary.
  (IF (= FILL-POINTER (ARRAY-LENGTH ES-BUFFER))
      (ADJUST-ARRAY-SIZE ES-BUFFER (+ (* 2 FILL-POINTER) WIDTH)))
  ;; Make room for the characters to be inserted.  Be sure to increment the fill