;; pointer first so that we don't reference outside the active part of the string. (INCREMENT FILL-POINTER WIDTH) (INCREMENT TYPEIN-POINTER WIDTH) (SETF (FILL-POINTER) FILL-POINTER) (SETF (TYPEIN-POINTER) TYPEIN-POINTER) (COPY-VECTOR-SEGMENT (- FILL-POINTER TYPEIN-POINTER) ES-BUFFER (- TYPEIN-POINTER WIDTH) ES-BUFFER TYPEIN-POINTER) ;; Now copy the string in. (COPY-VECTOR-SEGMENT WIDTH STRING BEGIN ES-BUFFER (- TYPEIN-POINTER WIDTH)) ;; Update the screen. (COND ;; If the string is being inserted at the end of the line, then we will return ;; from the rubout handler. If the input buffer has been edited, then we will ;; rescan. If not, we return the first character of the string and leave the ;; scan pointer pointing at the second character, thus avoiding a rescan. ;; Also, updating the display is easier in this case since we don't have to hack ;; insert chars. This is the case for normal typein -- the scan pointer will ;; keep up with the typein pointer. ;; I think we need an option so that yanks at the end of the line don't throw ;; but remain in the editor. ((= TYPEIN-POINTER FILL-POINTER) (FUNCALL STREAM ':STRING-OUT STRING BEGIN END) (COND (RUBBED-OUT-SOME (*THROW 'RUBOUT-HANDLER T)) (T (INCREMENT (SCAN-POINTER)) (*THROW 'RETURN-CHARACTER (AREF STRING BEGIN))))) ;; If typing in the middle of the line, we just insert the text and don't bother ;; rescanning. That's only done when text appears at the end of the line to keep ;; the transcript from being confusing. This may be the wrong thing. ;; No need to update the scan pointer in this case since we're going to throw back ;; to the rubout handler. ((MEMQ ':INSERT-STRING ES-WHICH-OPERATIONS) (FUNCALL STREAM ':INSERT-STRING STRING BEGIN END)) ;; If the console can't insert chars, simulate it vt52 style. (T (FUNCALL STREAM ':CLEAR-EOL) (FUNCALL STREAM ':STRING-OUT STRING BEGIN END) (FUNCALL STREAM ':STRING-OUT ES-BUFFER TYPEIN-POINTER) (DE-CURSOR-MOTION STREAM TYPEIN-POINTER))) ;; If we didn't throw out, then the input has been modified. Back to the editor. T) ;; Display Editor Commands (DEFMACRO DEF-DE-COMMAND ((NAME . CHARS) ARGS . BODY) `(PROGN 'COMPILE ,@(MAPCAR #'(LAMBDA (CHAR) `(PUSH '(,CHAR . ,NAME) DISPLAY-EDITOR-COMMAND-ALIST)) CHARS) (DEFUN ,NAME ,ARGS . ,BODY))) ;; Moves the cursor to a given position on the screen only. Does no ;; bounds checking. If the index into the buffer corresponding with the ;; screen cursor position is known, and it is before the position we want to ;; go to, then this will run faster. (DEFUN DE-CURSOR-MOTION (STREAM POSITION &OPTIONAL CURRENT-POSITION) (IF (AND CURRENT-POSITION ({{#/}} POSITION CURRENT-POSITION)) (FUNCALL STREAM ':CURSOR-MOTION NIL NIL ES-BUFFER CURRENT-POSITION POSITION) (FUNCALL STREAM ':CURSOR-MOTION ES-X-ORIGIN ES-Y-ORIGIN ES-BUFFER 0 POSITION))) ;; Moves the cursor on the screen and in the buffer. Checks appropriately. (DEFUN DE-SET-POSITION (STREAM POSITION) (SETQ POSITION (MIN (MAX POSITION 0) (FILL-POINTER))) (DE-CURSOR-MOTION STREAM POSITION (TYPEIN-POINTER)) (SETF (TYPEIN-POINTER) POSITION) NIL) ;; Reprinting Input (DEFUN DE-REPRINT-INPUT (STREAM CHAR &AUX PROMPT) (SETQ PROMPT (OR (ASSQ ':REPROMPT TV-MAKE-STREAM-RUBOUT-HANDLER-OPTIONS) (ASSQ ':PROMPT TV-MAKE-STREAM-RUBOUT-HANDLER-OPTIONS))) (IF PROMPT (FUNCALL (CADR PROMPT) STREAM CHAR)) (MULTIPLE-VALUE (ES-X-ORIGIN ES-Y-ORIGIN) (FUNCALL STREAM ':READ-CURSORPOS)) (FUNCALL STREAM ':STRING-OUT ES-BUFFER) (DE-CURSOR-MOTION STREAM (TYPEIN-POINTER)) NIL) ;; FORM clears and redisplays input. Cursor is left where it was before. (DEF-DE-COMMAND (DE-FORM #\FORM #{{#/}}/L) (STREAM &OPTIONAL IGNORE) (FUNCALL STREAM ':CLEAR-SCREEN) (DE-REPRINT-INPUT STREAM #\FORM)) ;; VT reprints input on next line. Cursor is left at the end of the typein line . (DEF-DE-COMMAND (DE-VT #\VT) (STREAM &OPTIONAL IGNORE) (DE-END-OF-BUFFER STREAM) (FUNCALL STREAM ':LINE-OUT "{{#/}}") (DE-REPRINT-INPUT STREAM #\VT)) ;; Moving Around ;; Returns the position of the first newline appearing after POS. (DEFUN DE-SEARCH-FORWARD-NEWLINE (POS) (DO ((FILL-POINTER (FILL-POINTER)) (I POS (1+ I))) ((OR (= I FILL-POINTER) (= (AREF ES-BUFFER I) #\RETURN)) FILL-POINTER)))