From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 14 Aug 1989 10:23:44 +0000 (+0000)
Subject: Move some of the window-control variables to the files in which they
X-Git-Tag: 20090517-FFI~11828
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c0d1663ebe0c2f138b8f6447c91f2eace2023bb3;p=mit-scheme.git

Move some of the window-control variables to the files in which they
are used.  Rename `cursor-centering-threshold' to `scroll-step' for
compatibility with Emacs.  Delete the disfunctional command
`toggle-screen-video'.
---

diff --git a/v7/src/edwin/bufwin.scm b/v7/src/edwin/bufwin.scm
index 62cc6a0e8..d37fc8484 100644
--- a/v7/src/edwin/bufwin.scm
+++ b/v7/src/edwin/bufwin.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwin.scm,v 1.282 1989/08/14 09:22:03 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwin.scm,v 1.283 1989/08/14 10:23:32 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -111,12 +111,20 @@
       (%window-setup-truncate-lines! window false)
       (%window-force-redraw! window (and old-y (%window-cursor-y window))))))
 
+(define-method buffer-window :set-size!
+  set-buffer-window-size!)
+
+(define-method buffer-window (:set-x-size! window x)
+  (set-buffer-window-size! window x y-size))
+
+(define-method buffer-window (:set-y-size! window y)
+  (set-buffer-window-size! window x-size y))
+
 (define (%window-setup-truncate-lines! window redraw-type)
   (with-instance-variables buffer-window window ()
     (if (not (within-editor?))
 	(begin
-	  (set! truncate-lines?
-		(variable-value (ref-variable-object truncate-lines)))
+	  (set! truncate-lines? (ref-variable truncate-lines))
 	  unspecific)
 	(let ((new-truncate-lines?
 	       (or (and (variable-local-value
@@ -132,14 +140,30 @@
 		(if (and redraw-type (not force-redraw?))
 		    (%window-force-redraw! window redraw-type))))))))
 
-(define-method buffer-window :set-size!
-  set-buffer-window-size!)
-
-(define-method buffer-window (:set-x-size! window x)
-  (set-buffer-window-size! window x y-size))
-
-(define-method buffer-window (:set-y-size! window y)
-  (set-buffer-window-size! window x-size y))
+(define-variable-per-buffer truncate-lines
+  "*True means do not display continuation lines;
+give each line of text one screen line.
+Automatically becomes local when set in any fashion.
+
+Note that this is overridden by the variable
+truncate-partial-width-windows if that variable is true
+and this buffer is not full-screen width."
+  false)
+
+(define-variable truncate-partial-width-windows
+  "*True means truncate lines in all windows less than full screen wide."
+  true)
+
+(let ((setup-truncate-lines!
+       (lambda (variable)
+	 variable			;ignore
+	 (for-each window-setup-truncate-lines! (all-windows)))))
+  (add-variable-assignment-daemon!
+   (ref-variable-object truncate-lines)
+   setup-truncate-lines!)
+  (add-variable-assignment-daemon!
+   (ref-variable-object truncate-partial-width-windows)
+   setup-truncate-lines!))
 
 ;;;; Group Operations
 
@@ -445,7 +469,7 @@
 
 (define (maybe-recenter! window)
   (with-instance-variables buffer-window window ()
-    (let ((threshold (ref-variable cursor-centering-threshold))
+    (let ((threshold (ref-variable scroll-step))
 	  (recenter!
 	   (lambda ()
 	     (%window-redraw! window (%window-y-center window)))))
@@ -475,6 +499,12 @@
 			    (fix:-1+ (window-y-size window))))
 		    (recenter!))))))))
 
+(define-variable scroll-step
+  "*The number of lines to try scrolling a window by when point moves out.
+If that fails to bring point back on screen, point is centered instead.
+If this is zero, point is always centered after it moves off screen."
+  0)
+
 (define (%window-force-redraw! window redraw-type)
   (with-instance-variables buffer-window window ()
     (set! force-redraw? (or redraw-type 'CENTER))
@@ -613,13 +643,15 @@
 (define (%window-y-center window)
   (with-instance-variables buffer-window window ()
     (let ((result
-	   (let ((qr
-		  (integer-divide
-		   (* y-size (ref-variable cursor-centering-point))
-		   100)))
-	     (if (fix:< (integer-divide-remainder qr) 50)
-		 (integer-divide-quotient qr)
-		 (fix:1+ (integer-divide-quotient qr))))))
+	   (integer-round
+	    (* y-size
+	       (inexact->exact (round (ref-variable cursor-centering-point))))
+	    100)))
       (cond ((fix:< result 0) 0)
 	    ((fix:< result y-size) result)
-	    (else (fix:-1+ y-size))))))
\ No newline at end of file
+	    (else (fix:-1+ y-size))))))
+
+(define-variable cursor-centering-point
+  "The distance from the top of the window at which to center the point.
+This number is a percentage, where 0 is the window's top and 100 the bottom."
+  50)
\ No newline at end of file
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 448c76bd9..ddb41b636 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.13 1989/08/14 09:48:37 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.14 1989/08/14 10:23:37 cph Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -282,6 +282,11 @@ MIT in each case. |#
 	  editor-frame-typein-window
 	  editor-frame-window0
 	  editor-frame-windows
+	  edwin-variable$cursor-centering-point
+	  edwin-variable$mode-line-inverse-video
+	  edwin-variable$scroll-step
+	  edwin-variable$truncate-lines
+	  edwin-variable$truncate-partial-width-windows
 	  initialize-buttons!
 	  make-editor-frame
 	  set-window-point!
diff --git a/v7/src/edwin/modwin.scm b/v7/src/edwin/modwin.scm
index d179a3cfb..5cd731c79 100644
--- a/v7/src/edwin/modwin.scm
+++ b/v7/src/edwin/modwin.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modwin.scm,v 1.31 1989/08/11 11:30:36 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modwin.scm,v 1.32 1989/08/14 10:23:41 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -69,7 +69,12 @@
 	     (window-buffer superior)
 	     (ref-variable-object mode-line-inverse-video))
 	    (with-inverse-video! screen thunk)
-	    (thunk))))  true)
+	    (thunk))))
+  true)
+
+(define-variable mode-line-inverse-video
+  "*True means use inverse video, or other suitable display mode, for the mode line."
+  true)
 
 (define (with-inverse-video! screen thunk)
   (let ((old-inverse? (screen-inverse-video! screen false))
diff --git a/v7/src/edwin/wincom.scm b/v7/src/edwin/wincom.scm
index da5fbce8b..5059040e1 100644
--- a/v7/src/edwin/wincom.scm
+++ b/v7/src/edwin/wincom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/wincom.scm,v 1.95 1989/08/11 11:50:52 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/wincom.scm,v 1.96 1989/08/14 10:23:44 cph Exp $
 ;;;
 ;;;	Copyright (c) 1987, 1989 Massachusetts Institute of Technology
 ;;;
@@ -46,16 +46,6 @@
 
 (declare (usual-integrations))
 
-(define-variable cursor-centering-point
-  "The distance from the top of the window at which to center the point.
-This number is a percentage, where 0 is the window's top and 100 the bottom."
-  50)
-
-(define-variable cursor-centering-threshold
-  "If point moves offscreen by more than this many lines, recenter.
-Otherwise, the screen is scrolled to put point at the edge it moved over."
-  0)
-
 (define-variable window-minimum-width
   "Delete any window less than this wide.
 Do not set this variable below 2."
@@ -71,10 +61,6 @@ Do not set this variable below 1."
   "*Number of lines of continuity when scrolling by screenfuls."
   2)
 
-(define-variable mode-line-inverse-video
-  "*True means use inverse video, or other suitable display mode, for the mode line."
-  true)
-
 (define-variable pop-up-windows
   "True enables the use of pop-up windows."
   true)
@@ -88,31 +74,6 @@ Do not set this variable below 1."
 If there is only one window, it is split regardless of this value."
   500)
 
-(define-variable-per-buffer truncate-lines
-  "*True means do not display continuation lines;
-give each line of text one screen line.
-Automatically becomes local when set in any fashion.
-
-Note that this is overridden by the variable
-truncate-partial-width-windows if that variable is true
-and this buffer is not full-screen width."
-  false)
-
-(define-variable truncate-partial-width-windows
-  "*True means truncate lines in all windows less than full screen wide."
-  true)
-
-(let ((setup-truncate-lines!
-       (lambda (variable)
-	 variable			;ignore
-	 (for-each window-setup-truncate-lines! (all-windows)))))
-  (add-variable-assignment-daemon!
-   (ref-variable-object truncate-lines)
-   setup-truncate-lines!)
-  (add-variable-assignment-daemon!
-   (ref-variable-object truncate-partial-width-windows)
-   setup-truncate-lines!))
-
 (define-command redraw-display
   "Redraws the entire display from scratch."
   ()
@@ -132,12 +93,9 @@ negative args count from the bottom."
 	  (begin
 	    (window-redraw! window false)
 	    (update-screens! true))
-	  (window-scroll-y-absolute! window
-				     (let ((size (window-y-size window)))
-				       (let ((n (remainder argument size)))
-					 (if (negative? n)
-					     (+ n size)
-					     n))))))))
+	  (window-scroll-y-absolute!
+	   window
+	   (modulo argument (window-y-size window)))))))
 
 (define-command move-to-window-line
   "Position point relative to window.
@@ -152,11 +110,7 @@ negative means relative to bottom of window."
 		  window 0
 		  (if (not argument)
 		      (window-y-center window)
-		      (let ((y-size (window-y-size window)))
-			(let ((n (remainder argument y-size)))
-			  (if (negative? n)
-			      (+ n y-size)
-			      n)))))
+		      (modulo argument (window-y-size window))))
 		 (window-coordinates->mark
 		  window 0
 		  (window-mark->y window
@@ -205,6 +159,25 @@ Just minus as an argument moves down full screen."
       (scroll-window window
 		     (multi-scroll-window-argument window argument -1)))))
 
+(define-command scroll-other-window
+  "Scroll text of next window up ARG lines, or near full screen if no arg."
+  "P"
+  (lambda (argument)
+    (let ((window (other-window-interactive 1)))
+      (scroll-window window
+		     (standard-scroll-window-argument window argument 1)))))
+
+(define-command scroll-other-window-several-screens
+  "Scroll other window up several screenfuls.
+Specify the number as a numeric argument, negative for down.
+The default is one screenful up.  Just minus as an argument
+means scroll one screenful down."
+  "P"
+  (lambda (argument)
+    (let ((window (other-window-interactive 1)))
+      (scroll-window window
+		     (multi-scroll-window-argument window argument 1)))))
+
 (define (scroll-window window n #!optional limit)
   (if (if (negative? n)
 	  (= (window-start-index window)
@@ -231,26 +204,9 @@ Just minus as an argument moves down full screen."
        (cond ((not argument) quantum)
 	     ((command-argument-negative-only?) (- quantum))
 	     (else (* argument quantum))))))
-
-(define-command toggle-screen-video
-  "Toggle the screen's use of inverse video.
-With a positive argument, inverse video is forced.
-With a negative argument, normal video is forced."
-  "P"
-  (lambda (argument)
-    (screen-inverse-video!
-     (current-screen)
-     (if (not argument)
-	 (screen-inverse-video! (current-screen) false)
-	 (positive? argument)))
-    (update-screens! true)))
 
 (define-command what-cursor-position
-  "Print various things about where cursor is.
-Print the X position, the Y position,
-the ASCII code for the following character,
-point absolutely and as a percentage of the total file size,
-and the virtual boundaries, if any."
+  "Print info on cursor position (on screen and within buffer)."
   ()
   (lambda ()
     (let ((buffer (current-buffer))
@@ -271,7 +227,7 @@ and the virtual boundaries, if any."
 		 "("
 		 (write-to-string (if (zero? total)
 				      0
-				      (round (* 100 (/ position total)))))
+				      (integer-round (* 100 position) total)))
 		 "%) "
 		 (let ((group (mark-group point)))
 		   (let ((start (group-start-index group))
@@ -359,25 +315,6 @@ ARG lines.  No arg means split equally."
   (if (typein-window? (current-window))
       (editor-error "Not implemented for typein window")))
 
-(define-command scroll-other-window
-  "Scroll text of next window up ARG lines, or near full screen if no arg."
-  "P"
-  (lambda (argument)
-    (let ((window (other-window-interactive 1)))
-      (scroll-window window
-		     (standard-scroll-window-argument window argument 1)))))
-
-(define-command scroll-other-window-several-screens
-  "Scroll other window up several screenfuls.
-Specify the number as a numeric argument, negative for down.
-The default is one screenful up.  Just minus as an argument
-means scroll one screenful down."
-  "P"
-  (lambda (argument)
-    (let ((window (other-window-interactive 1)))
-      (scroll-window window
-		     (multi-scroll-window-argument window argument 1)))))
-
 ;;;; Pop-up Buffers
 
 (define-command kill-pop-up-buffer
@@ -398,8 +335,9 @@ Also kills any pop up window it may have created."
   (let ((window (object-unhash *previous-popped-up-window*)))
     (if (and window (window-visible? window))
 	(begin
-	 (set! *previous-popped-up-window* (object-hash false))
-	 (window-delete! window))))  (let ((buffer (object-unhash *previous-popped-up-buffer*)))
+	  (set! *previous-popped-up-window* (object-hash false))
+	  (window-delete! window))))
+  (let ((buffer (object-unhash *previous-popped-up-buffer*)))
     (cond ((and buffer (buffer-alive? buffer))
 	   (set! *previous-popped-up-buffer* (object-hash false))
 	   (kill-buffer-interactive buffer))