performace improvements for the terminal emulator. Now feels like a

4800 bps modem connection (before: 1200-2400 bps).

scheme/console.scm

@@ -60,9 +60,11 @@
 		  (lp paint?))))))))))
 
 (define (pause-console-output console)
+  (debug-message "pause-console-output")
   (send (console-pause-channel console) 'ignore))
 
 (define (resume-console-output console)
+  (debug-message "resume-console-output")
   (send (console-resume-channel console) 'ignore))
 
 (define (view-console console)

scheme/termbuf.scm

@@ -1,10 +1,6 @@
-;; turn off debugging for the moment
-(define debug-message
-  (lambda args #f))
-
 (define-record-type terminal-buffer :terminal-buffer
   (really-make-terminal-buffer width height view-index
-			       x y buffer repaint?
+			       x y buffer paint-fun
 			       esc-code)
   terminal-buffer?
   (width terminal-buffer-width)
@@ -14,7 +10,7 @@
   (x terminal-buffer-x set-terminal-buffer-x!)
   (y terminal-buffer-y set-terminal-buffer-y!)
   (buffer terminal-buffer-buffer set-terminal-buffer-buffer!)
-  (repaint? terminal-buffer-repaint? set-terminal-buffer-repaint?!)
+  (paint-fun terminal-buffer-paint-fun set-terminal-buffer-paint-fun!)
   (esc-code terminal-buffer-esc-code set-terminal-buffer-esc-code!))
 
 (define-record-discloser :terminal-buffer
@@ -24,7 +20,6 @@
       (height ,(terminal-buffer-height tb))
       (x ,(terminal-buffer-x tb))
       (y ,(terminal-buffer-y tb))
-      (repaint? ,(terminal-buffer-repaint? tb))
       (esc-code ,(map char->ascii (string->list (terminal-buffer-esc-code tb)))))))
 
 (define (make-terminal-buffer width height)
@@ -32,8 +27,10 @@
 		 (lambda (ignore)
 		   (make-empty-line width))
 		 (iota height))))
-    (really-make-terminal-buffer width height buffer
+    (really-make-terminal-buffer 
-				 0 0 buffer #f "")))
+     width height buffer 0 0 buffer 
+     curses-paint-terminal-buffer/complete
+     "")))
 
 (define (line-at-cursor-position termbuf)
   (list-ref (terminal-buffer-view-index termbuf)
@@ -51,18 +48,15 @@
      (- (terminal-buffer-height termbuf) 1)))
 
 (define (append-empty-line termbuf)
-  (debug-message "append-empty-line")
   (append! (terminal-buffer-buffer termbuf) 
 	   (list (make-empty-line (terminal-buffer-width termbuf)))))
 
 (define (goto-next-line termbuf)
-  (debug-message "goto-next-line")
   (set-terminal-buffer-y!
    termbuf (+ (terminal-buffer-y termbuf) 1))
   (maybe-scroll-terminal-buffer termbuf))
 
 (define (move-cursor termbuf x-offset y-offset)
-  (debug-message "move-cursor " termbuf " " x-offset " " y-offset)
   (let ((new-x (+ (terminal-buffer-x termbuf) x-offset))
 	(new-y (+ (terminal-buffer-y termbuf) y-offset)))
     
@@ -87,10 +81,10 @@
 (define (scroll-view-index-down termbuf)
   (set-terminal-buffer-view-index!
    termbuf (cdr (terminal-buffer-view-index termbuf)))
-  (set-terminal-buffer-repaint?! termbuf #t))
+  (set-terminal-buffer-paint-fun!
+   termbuf paint-complete-buffer))
 
 (define (maybe-scroll-terminal-buffer termbuf)
-  (debug-message "maybe-scroll-terminal-buffer")
   (and (>= (terminal-buffer-y termbuf)
 	   (terminal-buffer-height termbuf))
        (begin
@@ -100,23 +94,22 @@
 	  (- (terminal-buffer-y termbuf) 1)))))
 
 (define (goto-beginning-of-line termbuf)
-  (debug-message "goto-beginning-of-line")
   (set-terminal-buffer-x! termbuf 0))
 
 (define (terminal-buffer-add-char termbuf char)
-  (debug-message "add-char " termbuf " '" char "' " 
-		 (char->ascii char))
   (cond
    ((not (string=? "" (terminal-buffer-esc-code termbuf)))
     (read-escape-code termbuf char))
    ((char=? char (ascii->char 27))
     (set-terminal-buffer-esc-code! termbuf (string char)))
    ((char=? char (ascii->char 13))
-    (goto-beginning-of-line termbuf))
+    (goto-beginning-of-line termbuf)
+    (set-terminal-buffer-paint-fun! termbuf position-cursor))
    ((char=? char #\newline)
     (if (cursor-on-last-line? termbuf)
 	(append-empty-line termbuf))
-    (goto-next-line termbuf))
+    (goto-next-line termbuf)
+    (set-terminal-buffer-paint-fun! termbuf position-cursor))
    ((char-set-contains? char-set:printing char)
     (add-normal-char termbuf char))))
 
@@ -126,21 +119,16 @@
     (append-empty-line termbuf)
     (goto-next-line termbuf)
     (goto-beginning-of-line termbuf)
-    (insert-char termbuf char))
+    (insert-char termbuf char)
+    (set-terminal-buffer-paint-fun!
+     termbuf paint-complete-buffer))
    (else
     (insert-char termbuf char)
-    (goto-next-char termbuf)))
+    (goto-next-char termbuf)
-  (debug-message "add-normal-char "
+    (set-terminal-buffer-paint-fun!
-		 (string-length (line-at-cursor-position termbuf))
+     termbuf paint-single-char))))
-		 "'" (line-at-cursor-position termbuf) "'"))
 
-(define (curses-paint-terminal-buffer termbuf win)
+(define (paint-complete-buffer termbuf win)
-  (if (terminal-buffer-repaint? termbuf)
-      (clear/repaint-buffer termbuf win)
-      (paint-single-line termbuf win)))
-
-(define (clear/repaint-buffer termbuf win)
-  (debug-message "clear/repaint-buffer")
   (wclear win)
   (let lp ((i (terminal-buffer-height termbuf))
 	   (lines (terminal-buffer-view-index termbuf))
@@ -148,21 +136,31 @@
     (if (zero? i)
 	'blorf
 	(begin
-	  (debug-message y ": '" (car lines) "'")
 	  (mvwaddstr win y 0 (car lines))
 	  (lp (- i 1) (cdr lines) (+ y 1)))))
   (position-cursor termbuf win))
 
-(define curses-paint-terminal-buffer/complete 
-  clear/repaint-buffer)
-
 (define (paint-single-line termbuf win)
-  (debug-message "paint-single-line " termbuf)
   (wmove win (terminal-buffer-y termbuf) 0)
   (wclrtoeol win)
   (waddstr win (line-at-cursor-position termbuf))
   (position-cursor termbuf win))
 
+(define (paint-single-char termbuf win)
+  (let ((x (if (zero? (terminal-buffer-x termbuf))
+	       (terminal-buffer-x termbuf)
+	       (- (terminal-buffer-x termbuf) 1))))
+    (waddch win 
+;	      (terminal-buffer-y termbuf)
+;	      x
+	      (string-ref (line-at-cursor-position termbuf) x))))
+
+(define (curses-paint-terminal-buffer termbuf win)
+  ((terminal-buffer-paint-fun termbuf) termbuf win))
+
+(define curses-paint-terminal-buffer/complete 
+  paint-complete-buffer)
+
 (define (position-cursor termbuf win)
   (wmove win 
 	 (terminal-buffer-y termbuf)
@@ -178,7 +176,6 @@
    termbuf (+ 1 (terminal-buffer-x termbuf))))
 
 (define (read-escape-code termbuf char)
-  (debug-message "read-escape-code " (char->ascii char) " " termbuf)
   (let ((code (string-append
 	       (terminal-buffer-esc-code termbuf)
 	       (string char))))
@@ -198,7 +195,6 @@
       (set-terminal-buffer-esc-code! termbuf code)))))
 
 (define (recognize-cursor-movement partial-code)
-  (debug-message "recognize-cursor-movement " partial-code)
   (if-match
    (regexp-search (rx (: ,(ascii->char 27) 
 			 #\[ (submatch digit) (submatch ("ABCD"))
@@ -218,7 +214,6 @@
    #f))
 
 (define (recognize-simple-cursor-movement partial-code)
-  (debug-message "recognize-simple-cursor-movement ")
   (if-match
    (regexp-search (rx (: ,(ascii->char 27) (? #\[) (? #\O) (submatch ("ABCD")) eos))
 		  partial-code)