Optimize editor newline command

This may be the wrong place for this optimization, but I don't have
the luxury of having time to do things right. Hell, the editor is all
in one big file, does it look like I have time to spare for quality?

wip-duuqnd/editor/editor.lisp

@@ -11,6 +11,9 @@
 (require '#:sb-posix)
 
 (defvar *eio*)
+(defparameter *slow-mode-p* nil
+  "Slows down the sending of characters to the terminal to simulate the slow
+serial connection the editor normally runs under.")
 
 (defclass hybrid-stream (fundamental-stream)
   ((%input-stream :accessor input-stream :initarg :input-stream)
@@ -29,7 +32,10 @@
   (sb-posix:file-descriptor (output-stream stream)))
 
 (defmethod stream-write-byte ((stream hybrid-stream) integer)
-  (write-byte integer (output-stream stream)))
+  (write-byte integer (output-stream stream))
+  (when *slow-mode-p*
+    (force-output stream)
+    (sleep 10/9600)))
 
 (defmethod stream-write-char ((stream hybrid-stream) character)
   (if (char= character #\Newline)
@@ -139,6 +145,18 @@
   (write-char #\K *eio*)
   (force-output *eio*))
 
+(defun set-scrolling-region (&optional top bottom)
+  (assert (or (and (typep top 'integer) (typep bottom 'integer))
+              (and (null top) (null bottom))))
+  (cond ((and top bottom)
+         ;; Set the region
+         (write-byte #x1B *eio*)
+         (format *eio* "[~D;~Dr" top bottom))
+        (t
+         ;; Reset the region to fullscreen
+         (write-byte #x1B *eio*)
+         (format *eio* "[1;24r"))))
+
 (defun scroll-screen-down (&optional (amount 1))
   (write-byte #x1B *eio*)
   (write-char #\[ *eio*)
@@ -151,6 +169,22 @@
   (format *eio* "~D" amount)
   (write-char #\S *eio*))
 
+(defun hide-cursor ()
+  (write-byte #x1B *eio*)
+  (write-string "[?25l" *eio*))
+
+(defun show-cursor ()
+  (write-byte #x1B *eio*)
+  (write-string "[?25h" *eio*))
+
+(defun invert-text ()
+  (write-byte #x1B *eio*)
+  (write-string "[7m" *eio*))
+
+(defun reset-text-attributes ()
+  (write-byte #x1B *eio*)
+  (write-string "[m" *eio*))
+
 (defparameter +screen-width+ 80)
 
 
@@ -281,7 +315,9 @@
            (incf (fill-pointer (line-content line)))
            (replace (line-content line) to-shove
                     :start1 (1+ column))
-           (setf (char (line-content line) column) character)))))
+           (setf (char (line-content line) column) character))))
+  (when (line-in-view line (current-view *editor*))
+    (redisplay-line line :start column)))
 
 (defmethod delete-character-in-line ((line line) column)
   (unless (< column (fill-pointer (line-content line)))
@@ -331,23 +367,27 @@
                  (cursor-column (cursor *editor*)) start)
            (update-buffer-cursor (current-buffer *editor*))))))
 
-(defmethod redisplay-line ((line line))
+(defmethod redisplay-line ((line line) &key (start 0))
   ;; TODO: save the cursor position
   (with-editor-accessors *editor* (:current-line current
                                    :current-buffer buffer)
-    (move-cursor (view-line-number (buffer-view buffer) line) 0)
+    (cond
-    (write-char #\Return *eio*)
+      ((= start (1- (line-length line)))
-    (write-byte #x1B *eio*)
+       (let ((char-pos (1- (fill-pointer (line-content line)))))
-    (write-char #\[ *eio*)
+         (move-cursor (view-line-number (buffer-view buffer) line) char-pos)
-    (write-char #\K *eio*)
+         (write-char (aref (line-content line) char-pos) *eio*)
-    (write-string (line-content line) *eio*)
+         (update-buffer-cursor buffer)))
-    (update-buffer-cursor buffer))
+      (t
+       (hide-cursor)
+       (move-cursor (view-line-number (buffer-view buffer) line) start)
+       (write-byte #x1B *eio*)
+       (write-char #\[ *eio*)
+       (write-char #\K *eio*)
+       (write-string (line-content line) *eio* :start start)
+       (update-buffer-cursor buffer)
+       (show-cursor))))
   (force-output *eio*))
 
-(defun save-cursor ())
-
-(defun restore-cursor ())
-
 
 
 (defclass buffer ()
@@ -403,17 +443,30 @@ Additionally ensures correct line numbers on the way, as a bonus."
           (line-number (cursor-line *editor*))
           (cursor-column *editor*)))
 
-(defun redisplay-status-line ()
+(defparameter *status-line-position* 24
-  (move-cursor 24 0)
+  "The line at which the status line should be drawn.")
-  (write-byte #x1B *eio*)
+(defvar *old-status-line-string* nil)
-  (write-char #\[ *eio*)
+
-  (write-char #\7 *eio*)
+(defun redisplay-status-line (&key completely-p)
-  (write-char #\m *eio*)
+  (when completely-p
-  (write-string (status-line-string) *eio*)
+    (setf *old-status-line-string* nil))
-  (write-byte #x1B *eio*)
+  (when (null *old-status-line-string*)
-  (write-char #\[ *eio*)
+    (setf *old-status-line-string* (status-line-string)))
-  (write-char #\m *eio*)
+  (let* ((new-status (status-line-string))
-  (update-buffer-cursor (current-buffer *editor*)))
+         (old-status *old-status-line-string*)
+         (difference-start (or (mismatch new-status old-status) 0))
+         (difference-end (or (mismatch new-status old-status :from-end t) nil)))
+    (hide-cursor)
+    (move-cursor *status-line-position* difference-start)
+    (invert-text)
+    (write-string (subseq (status-line-string)
+                          difference-start
+                          difference-end)
+                  *eio*)
+    (reset-text-attributes)
+    (update-buffer-cursor (current-buffer *editor*))
+    (setf *old-status-line-string* new-status)
+    (show-cursor)))
 
 
 
@@ -451,6 +504,9 @@ Additionally ensures correct line numbers on the way, as a bonus."
         :when (eql line view-line)
           :return number))
 
+(defmethod line-in-view ((line line) (view buffer-view))
+  (not (null (view-line-number view line))))
+
 (defmethod redisplay-view ((view buffer-view))
   (clear-screen)
   (do-view-lines (line number) view
@@ -485,7 +541,7 @@ Additionally ensures correct line numbers on the way, as a bonus."
         (bottom-line view) (next-line (bottom-line view)))
   (unless (null (bottom-line view))
     (redisplay-view-from-line view (bottom-line view)))
-  (redisplay-status-line))
+  (redisplay-status-line :completely-p t))
 
 (defmethod scroll-view-up ((view buffer-view))
   (scroll-screen-down 1) ; view goes up, screen contents go down
@@ -495,7 +551,7 @@ Additionally ensures correct line numbers on the way, as a bonus."
         (bottom-line view)
         (prev-line (bottom-line view)))
   (redisplay-line (top-line view))
-  (redisplay-status-line))
+  (redisplay-status-line :completely-p t))
 
 (defmethod current-view ((obj editor))
   (buffer-view (current-buffer obj)))
@@ -513,8 +569,7 @@ Additionally ensures correct line numbers on the way, as a bonus."
         (progn
           (insert-character-into-line line column char)
           (incf column))
-        (feep))
+        (feep))))
-    (redisplay-line line)))
 
 (defun com-forward-delete ()
   ;; TODO: Check for end of line
@@ -537,11 +592,22 @@ Additionally ensures correct line numbers on the way, as a bonus."
 (defun com-newline ()
   (with-editor-accessors *editor* (:current-column column
                                    :current-line line)
-    (ensure-correct-line-number (new-line-at line column))
+    (let* ((old-line line)
-    (redisplay-view-from-line (current-view *editor*) line)
+           (new-line (new-line-at line column))
-    (com-next-line)
+           (in-view-p (line-in-view new-line (current-view *editor*))))
-    (com-beginning-of-line)
+      (ensure-correct-line-number new-line)
-    (redisplay-line line)))
+      (com-next-line)
+      (com-beginning-of-line)
+      (when in-view-p
+        (set-scrolling-region (view-line-number (current-view *editor*)
+                                                new-line)
+                              (1- *status-line-position*))
+        (scroll-screen-down)
+        (set-scrolling-region))
+      (when (line-in-view old-line (current-view *editor*))
+        (redisplay-line old-line :start column))
+      (when in-view-p
+        (redisplay-line new-line)))))
 
 (defun com-beginning-of-line ()
   (with-editor-accessors *editor* (:current-column column
@@ -611,7 +677,8 @@ Additionally ensures correct line numbers on the way, as a bonus."
   (redisplay-view (buffer-view (current-buffer *editor*))))
 
 (defun com-refresh-screen ()
-  (redisplay-view (buffer-view (current-buffer *editor*))))
+  (redisplay-view (buffer-view (current-buffer *editor*)))
+  (redisplay-status-line :completely-p t))