From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 11 Apr 1991 03:15:44 +0000 (+0000)
Subject: When drawing a new line over an old one that is known to be blank,
X-Git-Tag: 20090517-FFI~10766
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8df30f6df5b92d7c9626ccb325771e3165bac596;p=mit-scheme.git

When drawing a new line over an old one that is known to be blank,
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.
---

diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index e82d499e8..03995013f 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -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))
 
diff --git a/v7/src/edwin/screen.scm b/v7/src/edwin/screen.scm
index dd0836e3d..1f56f22ee 100644
--- a/v7/src/edwin/screen.scm
+++ b/v7/src/edwin/screen.scm
@@ -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
 ;;;
@@ -688,58 +688,6 @@
 	      (vector-set! new-hl y chy)
 	      (boolean-vector-set! new-hl-enable y false))
 	    (boolean-vector-set! current-hl-enable y false))))))
-
-(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))
@@ -766,9 +714,81 @@
     (if (fix:< xe x-size)
 	(terminal-clear-line screen xe y x-size))))
 
+(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))))))
+
 (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)