;; Returns the position of the first newline appearing before POS-1.
;; Returns -1 if reached the beginning of the buffer.

(DEFUN DE-SEARCH-BACKWARD-NEWLINE (POS)
  (DO ((I (1- POS) (1- I)))
      ((OR (= I -1) (= (AREF ES-BUFFER I) #\RETURN)) I)))

(DEF-DE-COMMAND (DE-BEGINNING-OF-LINE #{{#/}}/A) (STREAM &OPTIONAL IGNORE)
  (DE-SET-POSITION STREAM (1+ (DE-SEARCH-BACKWARD-NEWLINE (TYPEIN-POINTER)))))

(DEF-DE-COMMAND (DE-END-OF-LINE #{{#/}}/E) (STREAM &OPTIONAL IGNORE)
  (DE-SET-POSITION STREAM (DE-SEARCH-FORWARD-NEWLINE (TYPEIN-POINTER))))

(DEF-DE-COMMAND (DE-BEGINNING-OF-BUFFER #{{#/}}/<) (STREAM &OPTIONAL IGNORE)
  (DE-SET-POSITION STREAM 0))

(DEF-DE-COMMAND (DE-END-OF-BUFFER #{{#/}}/>) (STREAM &OPTIONAL IGNORE)
  (DE-SET-POSITION STREAM (FILL-POINTER)))

(DEF-DE-COMMAND (DE-FORWARD-CHAR #{{#/}}/F) (STREAM &OPTIONAL (N 1))
  (DE-SET-POSITION STREAM (+ (TYPEIN-POINTER) N)))

(DEF-DE-COMMAND (DE-BACKWARD-CHAR #{{#/}}/B) (STREAM &OPTIONAL (N 1))
  (DE-SET-POSITION STREAM (- (TYPEIN-POINTER) N)))

(DEF-DE-COMMAND (DE-PREVIOUS-LINE #{{#/}}/P) (STREAM &OPTIONAL (N 1) &AUX LINE-BEGIN INDENT)
  (SETQ LINE-BEGIN (DE-SEARCH-BACKWARD-NEWLINE (TYPEIN-POINTER)))
  (SETQ INDENT (- (TYPEIN-POINTER) LINE-BEGIN))
  (DOTIMES (I N)
    (IF (= LINE-BEGIN -1) (RETURN))
    (SETQ LINE-BEGIN (DE-SEARCH-BACKWARD-NEWLINE LINE-BEGIN)))
  ;; When moving up from a long line to a short line, be sure not to go off the end.
  (DE-SET-POSITION STREAM
		   (+ LINE-BEGIN (MIN INDENT (DE-SEARCH-FORWARD-NEWLINE (1+ LINE-BEGIN))))))

(DEF-DE-COMMAND (DE-NEXT-LINE #{{#/}}/N) (STREAM &OPTIONAL (N 1) &AUX LINE-BEGIN INDENT)
  (SETQ LINE-BEGIN (DE-SEARCH-BACKWARD-NEWLINE (TYPEIN-POINTER)))
  (SETQ INDENT (- (TYPEIN-POINTER) LINE-BEGIN))
  (DOTIMES (I N)
    (COND ((= LINE-BEGIN (FILL-POINTER))
	   (SETQ LINE-BEGIN (DE-SEARCH-BACKWARD-NEWLINE LINE-BEGIN))
	   (RETURN)))
    (SETQ LINE-BEGIN (DE-SEARCH-FORWARD-NEWLINE (1+ LINE-BEGIN))))
  (DE-SET-POSITION STREAM
		   (+ LINE-BEGIN (MIN INDENT (DE-SEARCH-FORWARD-NEWLINE (1+ LINE-BEGIN))))))

;; Deleting Things

;; Deletes a buffer interval as marked by two pointers passed in.  The typein pointer
;; is left at the beginning of the interval.

(DEFUN DE-DELETE-STRING (STREAM BEGIN END &AUX WIDTH TYPEIN-POINTER
				(FILL-POINTER (FILL-POINTER)))
  (SETQ BEGIN (MAX BEGIN 0))
  (SETQ END   (MIN END FILL-POINTER))
  (SETQ WIDTH (- END BEGIN))
  (DE-SET-POSITION STREAM BEGIN)
  ;; Set this after moving the cursor to the beginning of the string.
  (SETQ TYPEIN-POINTER (TYPEIN-POINTER))
  (COND
    ;; Efficiency hack for clearing to the end of line, as in C-K and CLEAR.
    ;; Don't need to add up character widths as needed in :DELETE-STRING.
    ((= END FILL-POINTER)
     (FUNCALL STREAM ':CLEAR-EOL))
    ;; Console can delete characters.  Pass in the string to make variable width fonts win.
    ((MEMQ ':DELETE-STRING ES-WHICH-OPERATIONS)
     (FUNCALL STREAM ':DELETE-STRING ES-BUFFER BEGIN END))
    ;; Console can't delete characters.  Be sure to do a clear-eol to flush those
    ;; characters at the very end.
    (T (FUNCALL STREAM ':CLEAR-EOL)
       (FUNCALL STREAM ':STRING-OUT ES-BUFFER END)
       (DE-CURSOR-MOTION STREAM END)))
  ;; Now actually delete the characters from the buffer.  Do this before decrementing
  ;; the fill pointer so that we don't attempt to reference outside the string.
  (COPY-VECTOR-SEGMENT (- FILL-POINTER END)
		       ES-BUFFER (+ TYPEIN-POINTER WIDTH)
		       ES-BUFFER TYPEIN-POINTER)
  (SETF (FILL-POINTER) (- FILL-POINTER WIDTH))
  ;; If all typein has been deleted and the :FULL-RUBOUT option is
  ;; active, then throw now.  This will throw if the user types rubout
  ;; immediately after entering the read function.
  (IF (AND (ZEROP (FILL-POINTER))
	   (ASSQ ':FULL-RUBOUT TV-MAKE-STREAM-RUBOUT-HANDLER-OPTIONS))
      (*THROW 'RUBOUT-HANDLER T))
  ;; If it turns out that nothing was deleted, then don't bother rescanning input.
  ({{#/}} WIDTH 0))

(DEF-DE-COMMAND (DE-DELETE-CHAR #{{#/}}/D) (STREAM &OPTIONAL (N 1))
  (DE-DELETE-STRING STREAM (TYPEIN-POINTER) (+ (TYPEIN-POINTER) N)))

(DEF-DE-COMMAND (DE-RUBOUT-CHAR #\RUBOUT) (STREAM &OPTIONAL (N 1))
  (DE-DELETE-STRING STREAM (- (TYPEIN-POINTER) N) (TYPEIN-POINTER)))

;; CLEAR flushes all buffered input.  If the full rubout option is in
;; use, then we will throw out of here.  No need to prompt since the prompt still there.
(DEF-DE-COMMAND (DE-CLEAR #\CLEAR) (STREAM &OPTIONAL IGNORE)
  (DE-DELETE-STRING STREAM 0 (FILL-POINTER)))

;; If at the end of the line, change this to kill only the newline.