(SETQ STRING (STRING-NREVERSE STRING)) (DE-INSERT-STRING STREAM STRING 0 2 T)) ;; Kill Ring Commands ;; This doesn't really yank things killed, only previous complete lines typed ;; or the current line. C-0 C-Y yanks the current line, C-1 C-Y yanks the previous ;; thing typed. Everything but the last character is brought back, since that ;; is generally the character which triggers the return of the read function. ;; E.g. ) in reading a list, space in reading a symbol, cr in readline, control-c ;; in qsend. This way, we will be asked for more input rather than having ;; the read function return for us. Alternately, we could force the editor ;; to retain control and yank back the complete line. ;; We pass in T for RUBBED-OUT-SOME since it isn't currently given ;; to us. So, we always rescan when yanking at the end of the line. (DEF-DE-COMMAND (DE-YANK #{{#/}}/Y) (STREAM &OPTIONAL (N 1) &AUX (YANKED (NTH N ES-KILL-RING))) (DE-INSERT-STRING STREAM YANKED 0 (MAX 0 (1- (STRING-LENGTH YANKED))) T)) ;; Move the thing at the top of the kill ring to the bottom of the kill ring (DEFUN DE-POP-KILL-RING () (SETF (FIRST ES-KILL-RING) (SECOND ES-KILL-RING)) (SETF (SECOND ES-KILL-RING) ES-BUFFER) (POP ES-KILL-RING)) ;; If previous command was a Yank or a Yank-Pop, then remove what was placed there ;; by the command, yank in the top thing on the ring, and cycle the ring forward. ;; Otherwise, treat the command like an ordinary yank, except pop the ring afterward. (DEF-DE-COMMAND (DE-YANK-POP #{{#/}}/Y) (STREAM &OPTIONAL IGNORE &AUX YANKED YANKED-LENGTH (TYPEIN-POINTER (TYPEIN-POINTER))) (PROG () ;; First see if it was a Yank-Pop. (SETQ YANKED (CAR (CIRCULAR-LIST-LAST ES-KILL-RING))) (SETQ YANKED-LENGTH (1- (STRING-LENGTH YANKED))) (IF (AND ({{#/}} TYPEIN-POINTER YANKED-LENGTH) (STRING-EQUAL ES-BUFFER YANKED (- TYPEIN-POINTER YANKED-LENGTH) 0 TYPEIN-POINTER YANKED-LENGTH)) (RETURN)) ;; Then check for an ordinary yank. If it matches, then pop it off ;; the ring so that we'll get the next thing. (SETQ YANKED (SECOND ES-KILL-RING)) (SETQ YANKED-LENGTH (1- (STRING-LENGTH YANKED))) (COND ((AND ({{#/}} TYPEIN-POINTER YANKED-LENGTH) (STRING-EQUAL ES-BUFFER YANKED (- TYPEIN-POINTER YANKED-LENGTH) 0 TYPEIN-POINTER YANKED-LENGTH)) (DE-POP-KILL-RING) (RETURN))) ;; No match. (SETQ YANKED NIL)) ;; The previous command was a yank of some type. Delete the yanked screen from ;; the screen and the buffer. (IF YANKED (DE-DELETE-STRING STREAM (- TYPEIN-POINTER YANKED-LENGTH) TYPEIN-POINTER)) ;; Yank the thing at the top of the kill ring, and pop the kill ring (DE-YANK STREAM 1) (DE-POP-KILL-RING)) #+DEBUG (DEF-DE-COMMAND (DE-DEBUG #\HELP) (STREAM &OPTIONAL IGNORE) (FORMAT STREAM "~%[Fill pointer = ~D Typein pointer = ~D]~%" (FILL-POINTER) (TYPEIN-POINTER)) (DE-REPRINT-INPUT STREAM #\HELP)) ;; Now a printing (heh, heh) terminal editor. For poor souls coming via supdup ;; and for purposes of comparison. (DEFUN PRINTING-EDITOR (STREAM &AUX CH PROMPT (OPTIONS TV-MAKE-STREAM-RUBOUT-HANDLER-OPTIONS) (RUBBED-OUT-SOME NIL) (DOING-RUBOUT NIL) (PASS-THROUGH (CDR (ASSQ ':PASS-THROUGH OPTIONS)))) (*CATCH 'RETURN-CHARACTER (DO () (NIL) (SETQ CH (FUNCALL ES-CONSOLE-STREAM ':TYI)) (COND ((MEMQ CH PASS-THROUGH) (PRINTING-EDITOR-INSERT-CHAR STREAM CH RUBBED-OUT-SOME DOING-RUBOUT)) ;; Control-D and Control-U kill the current line, ITS and Twenex style. ;; If nothing in the buffer, don't do anything. ((MEMQ CH '(#{{#/}}/d #{{#/}}/D #{{#/}}/u #{{#/}}/U)) (COND ((NOT (ZEROP (FILL-POINTER))) (SETF (FILL-POINTER) 0) (SETQ RUBBED-OUT-SOME T) (COND (DOING-RUBOUT (FUNCALL STREAM ':TYO #/]) (SETQ DOING-RUBOUT NIL))) (FUNCALL STREAM ':LINE-OUT " XXX") (SETQ PROMPT (OR (ASSQ ':REPROMPT OPTIONS) (ASSQ ':PROMPT OPTIONS))) (IF PROMPT (FUNCALL PROMPT STREAM CH)) (IF (ASSQ ':FULL-RUBOUT OPTIONS) (*THROW 'RUBOUT-HANDLER T))))) ;; Control-K or Control-L echo themselves and then reprint the current ;; line, prompting if necessary. ((MEMQ CH '(#\VT #\FORM #{{#/}}/k #{{#/}}/K #{{#/}}/l #{{#/}}/L))