When drawing a new line over an old one that is known to be blank,
authorChris Hanson <org/chris-hanson/cph>
Thu, 11 Apr 1991 03:15:44 +0000 (03:15 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 11 Apr 1991 03:15:44 +0000 (03:15 +0000)
don't draw either leading or trailing spaces; previously was drawing
leading spaces in this case.  Also implement procedure to estimate the
cost of drawing a specific screen line, for use in scrolling
optimization.

v7/src/edwin/edwin.pkg
v7/src/edwin/screen.scm

index e82d499e880fad5bce7e76011524b5f885234490..03995013f4fc2fc8900eeb98180bbe74124000d7 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.27 1991/04/01 10:07:04 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.28 1991/04/11 03:15:44 cph Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -223,6 +223,7 @@ MIT in each case. |#
          screen-exit!
          screen-get-output-line
          screen-in-update?
+         screen-line-draw-cost
          screen-modeline-event!
          screen-move-cursor
          screen-needs-update?
@@ -635,6 +636,7 @@ MIT in each case. |#
   (files "dired")
   (parent (edwin))
   (export (edwin)
+         edwin-variable$dired-listing-switches
          edwin-variable$list-directory-unpacked
          make-dired-buffer))
 
index dd0836e3d212e1db0aabe77f2d0a6502432a5877..1f56f22ee5e47838513861936a2f5b9914637f4b 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.91 1991/04/01 10:07:48 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.92 1991/04/11 03:15:12 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-91 Massachusetts Institute of Technology
 ;;;
              (vector-set! new-hl y chy)
              (boolean-vector-set! new-hl-enable y false))
            (boolean-vector-set! current-hl-enable y false))))))
-\f
-(define (update-line-no-highlight screen y oline nline)
-  (let ((x-size (screen-x-size screen)))
-    (let ((olen (substring-non-space-end oline 0 x-size))
-         (nlen (substring-non-space-end nline 0 x-size)))
-      (let ((len (fix:min olen nlen)))
-       (let find-mismatch ((x 0))
-         (cond ((fix:= x len)
-                (if (fix:< x nlen)
-                    (terminal-output-substring screen x y
-                                               nline x nlen false)))
-               ((fix:= (vector-8b-ref oline x)
-                       (vector-8b-ref nline x))
-                (find-mismatch (fix:+ x 1)))
-               (else
-                (let find-match ((x* (fix:+ x 1)))
-                  (cond ((fix:= x* len)
-                         (terminal-output-substring screen x y
-                                                    nline x nlen false))
-                        ((not (fix:= (vector-8b-ref oline x*)
-                                     (vector-8b-ref nline x*)))
-                         (find-match (fix:+ x* 1)))
-                        (else
-                         ;; Ignore matches of 4 characters or less.
-                         ;; The overhead of moving the cursor and
-                         ;; drawing the characters is too much except
-                         ;; for very slow terminals.
-                         (let find-end-match ((x** (fix:+ x* 1)))
-                           (cond ((fix:= x** len)
-                                  (if (fix:< (fix:- x** x*) 5)
-                                      (terminal-output-substring screen x y
-                                                                 nline x nlen
-                                                                 false)
-                                      (begin
-                                        (terminal-output-substring screen x y
-                                                                   nline x x*
-                                                                   false)
-                                        (if (fix:< x** nlen)
-                                            (terminal-output-substring
-                                             screen x** y
-                                             nline x** nlen false)))))
-                                 ((fix:= (vector-8b-ref oline x**)
-                                         (vector-8b-ref nline x**))
-                                  (find-end-match (fix:+ x** 1)))
-                                 ((fix:< (fix:- x** x*) 5)
-                                  (find-match x**))
-                                 (else
-                                  (terminal-output-substring screen x y
-                                                             nline x x* false)
-                                  (find-mismatch x**)))))))))))
-      (if (fix:< nlen olen)
-         (terminal-clear-line screen nlen y olen)))))
 
 (define (update-line-ignore-current screen y nline highlight x-size)
   (cond ((not (boolean-subvector-uniform? highlight 0 x-size))
     (if (fix:< xe x-size)
        (terminal-clear-line screen xe y x-size))))
 \f
+(define (update-line-no-highlight screen y oline nline)
+  (let ((x-size (screen-x-size screen)))
+    (let ((olen (substring-non-space-end oline 0 x-size))
+         (nlen (substring-non-space-end nline 0 x-size)))
+      (cond ((fix:= 0 olen)
+            (let ((nstart (substring-non-space-start nline 0 nlen)))
+              (if (fix:< nstart nlen)
+                  (terminal-output-substring screen nstart y
+                                             nline nstart nlen false))))
+           ((fix:= 0 nlen)
+            (terminal-clear-line screen nlen y olen))
+           (else
+            (let ((len (fix:min olen nlen)))
+              (let find-mismatch ((x 0))
+                (cond ((fix:= x len)
+                       (if (fix:< x nlen)
+                           (terminal-output-substring screen x y
+                                                      nline x nlen false)))
+                      ((fix:= (vector-8b-ref oline x)
+                              (vector-8b-ref nline x))
+                       (find-mismatch (fix:+ x 1)))
+                      (else
+                       (let find-match ((x* (fix:+ x 1)))
+                         (cond ((fix:= x* len)
+                                (terminal-output-substring
+                                 screen x y nline x nlen false))
+                               ((not (fix:= (vector-8b-ref oline x*)
+                                            (vector-8b-ref nline x*)))
+                                (find-match (fix:+ x* 1)))
+                               (else
+                                ;; Ignore matches of 4 characters or less.
+                                ;; The overhead of moving the cursor and
+                                ;; drawing the characters is too much except
+                                ;; for very slow terminals.
+                                (let find-end-match ((x** (fix:+ x* 1)))
+                                  (cond ((fix:= x** len)
+                                         (if (fix:< (fix:- x** x*) 5)
+                                             (terminal-output-substring
+                                              screen x y nline x nlen false)
+                                             (begin
+                                               (terminal-output-substring
+                                                screen x y nline x x* false)
+                                               (if (fix:< x** nlen)
+                                                   (terminal-output-substring
+                                                    screen x** y
+                                                    nline x** nlen false)))))
+                                        ((fix:= (vector-8b-ref oline x**)
+                                                (vector-8b-ref nline x**))
+                                         (find-end-match (fix:+ x** 1)))
+                                        ((fix:< (fix:- x** x*) 5)
+                                         (find-match x**))
+                                        (else
+                                         (terminal-output-substring
+                                          screen x y nline x x* false)
+                                         (find-mismatch x**)))))))))))
+            (if (fix:< nlen olen)
+                (terminal-clear-line screen nlen y olen)))))))
+
+(define (screen-line-draw-cost screen y)
+  (let ((line (vector-ref (matrix-contents (screen-current-matrix screen)) y)))
+    (let ((end (substring-non-space-end line 0 (string-length line))))
+      (if (fix:= 0 end)
+         0
+         (fix:- end (substring-non-space-start line 0 end))))))
+\f
 (define-integrable (fix:min x y) (if (fix:< x y) x y))
 (define-integrable (fix:max x y) (if (fix:> x y) x y))
 
+(define-integrable (substring-non-space-start string start end)
+  (do ((index start (fix:+ index 1)))
+      ((or (fix:= end index)
+          (not (fix:= (vector-8b-ref string index)
+                      (char->integer #\space))))
+       index)))
+
 (define-integrable (substring-non-space-end string start end)
   (do ((index end (fix:- index 1)))
       ((or (fix:= start index)