(FUNCALL STREAM ':TYO CH) (FUNCALL STREAM ':FRESH-LINE) (SETQ PROMPT (OR (ASSQ ':REPROMPT OPTIONS) (ASSQ ':PROMPT OPTIONS))) (IF PROMPT (FUNCALL PROMPT STREAM CH)) (FUNCALL STREAM ':STRING-OUT ES-BUFFER)) ;; Echo characters backwards Unix style. ((= CH #\RUBOUT) (MULTIPLE-VALUE (RUBBED-OUT-SOME DOING-RUBOUT) (PRINTING-EDITOR-RUBOUT-CHAR STREAM OPTIONS RUBBED-OUT-SOME DOING-RUBOUT))) ;; Control-W flushes word. ((MEMQ CH '(#{{#/}}/w #{{#/}}/W)) (COND ((NOT (ZEROP (FILL-POINTER))) ;; First flush whitespace. (DO () ((OR (ZEROP (FILL-POINTER)) (DE-ALPHABETIC? (AREF ES-BUFFER (1- (FILL-POINTER)))))) (MULTIPLE-VALUE (RUBBED-OUT-SOME DOING-RUBOUT) (PRINTING-EDITOR-RUBOUT-CHAR STREAM OPTIONS RUBBED-OUT-SOME DOING-RUBOUT))) ;; Then flush alphabetics. (DO () ((OR (ZEROP (FILL-POINTER)) (NOT (DE-ALPHABETIC? (AREF ES-BUFFER (1- (FILL-POINTER))))))) (MULTIPLE-VALUE (RUBBED-OUT-SOME DOING-RUBOUT) (PRINTING-EDITOR-RUBOUT-CHAR STREAM OPTIONS RUBBED-OUT-SOME DOING-RUBOUT)))) (DOING-RUBOUT (FUNCALL STREAM ':LINE-OUT "]") (SETQ DOING-RUBOUT NIL)))) ;; Flush random control characters. ((NOT (ZEROP (LDB %%KBD-CONTROL-META CH))) (FUNCALL STREAM ':BEEP)) (T (PRINTING-EDITOR-INSERT-CHAR STREAM CH RUBBED-OUT-SOME DOING-RUBOUT)))))) (DEFUN PRINTING-EDITOR-RUBOUT-CHAR (STREAM OPTIONS RUBBED-OUT-SOME DOING-RUBOUT &AUX CH) (COND ((NOT (ZEROP (FILL-POINTER))) (SETQ RUBBED-OUT-SOME T) (SETQ CH (ARRAY-POP ES-BUFFER)) ;; If we're already rubbing out, then echo character. ;; If we're not rubbing out and the character is a space, then backspace. ;; If this is our first rubout, print "[" and echo. (COND (DOING-RUBOUT (FUNCALL STREAM ':TYO CH)) ((= CH #\SPACE) (FUNCALL STREAM ':TYO #\BS)) (T (SETQ DOING-RUBOUT T) (FUNCALL STREAM ':TYO #/[) (FUNCALL STREAM ':TYO CH))) ;; Rubbed out everything, and :FULL-RUBOUT option active, so throw. (IF (AND (ZEROP (FILL-POINTER)) (ASSQ ':FULL-RUBOUT OPTIONS)) (*THROW 'RUBOUT-HANDLER T)) (MVRETURN RUBBED-OUT-SOME DOING-RUBOUT)) ;; Nothing left in the input buffer. If we were rubbing out, close the ;; rubout and go to the next line. (DOING-RUBOUT (FUNCALL STREAM ':LINE-OUT "]") (MVRETURN RUBBED-OUT-SOME NIL)))) ;; This is only called when typing at the end of the line. There is no ;; such thing as typing in the middle of the line here. (DEFUN PRINTING-EDITOR-INSERT-CHAR (STREAM CH RUBBED-OUT-SOME DOING-RUBOUT) (IF DOING-RUBOUT (FUNCALL STREAM ':TYO #/])) (FUNCALL STREAM ':TYO CH) (ARRAY-PUSH-EXTEND ES-BUFFER CH) (INCREMENT (SCAN-POINTER)) (IF RUBBED-OUT-SOME (*THROW 'RUBOUT-HANDLER T) (*THROW 'RETURN-CHARACTER CH))) #+DEBUG (PROGN 'COMPILE ;; These functions for debugging the editor stream. ;; Random "read" functions which test various aspects of the stream. (DEFUN READ-10-CHARS (&OPTIONAL (STREAM STANDARD-INPUT) EOF-OPTION &AUX RESULT) (IF (AND (NOT RUBOUT-HANDLER) (MEMQ ':RUBOUT-HANDLER (FUNCALL STREAM ':WHICH-OPERATIONS))) ;; If the :FULL-RUBOUT option is activated, this will return NIL. ;; Keep looping until a string is returned. (DO () (NIL) (SETQ RESULT (FUNCALL STREAM ':RUBOUT-HANDLER '((:FULL-RUBOUT T) (:PROMPT ES-DEBUG-PROMPT) (:REPROMPT ES-DEBUG-REPROMPT)) #'READ-10-CHARS STREAM EOF-OPTION)) (IF RESULT (RETURN RESULT)) (ES-DEBUG-FULL-RUBOUT STREAM)) (LET ((CHARS (MAKE-ARRAY NIL ART-STRING 10.))) (DOTIMES (I 10.) (ASET (FUNCALL STREAM ':TYI EOF-OPTION) CHARS I)) CHARS))) ;; A study in compensating for missing capabilities -- :INSERT-CHAR ;; [1] Let the receiving end (console stream) worry about it, press file style. ;; It would have to maintain a complete screen image. ;; [2] The editor stream can handle some cases. This would only work during ;; interactive typein. ;; [3] Let the toplevel program handle it. It most likely has the screen image ;; buffered in another form. But now, everybody has to worry about the missing ;; capability, although some programs will have better ideas about how to