;;; -*-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
;;;
(%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
(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!))
\f
;;;; Group Operations
(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)))))
(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))
(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
;;; -*-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
;;;
(declare (usual-integrations))
\f
-(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."
"*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)
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!))
-\f
(define-command redraw-display
"Redraws the entire display from scratch."
()
(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.
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
(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)))))
+\f
(define (scroll-window window n #!optional limit)
(if (if (negative? n)
(= (window-start-index window)
(cond ((not argument) quantum)
((command-argument-negative-only?) (- quantum))
(else (* argument quantum))))))
-\f
-(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))
"("
(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))
(if (typein-window? (current-window))
(editor-error "Not implemented for typein window")))
\f
-(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)))))
-\f
;;;; Pop-up Buffers
(define-command kill-pop-up-buffer
(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))
projects / mit-scheme.git / commitdiff