Scheme. This is bound to C-x c in fundamental mode.
* Change `unmap-alias-char' to leave the following characters
unchanged: tab, linefeed, page, return, altmode. This compensates for
the previous change to `ascii-controlified?'.
* Implement `editor-frame-windows' which returns all of the
buffer-frames which are inferiors of an editor-frame.
* Implement `all-screens', `all-editor-frames', and `all-windows',
which return lists of all of the respective objects.
* The procedure `(window-redraw! window redraw-type)' has been
changed. Now, it delays the actual work until update time, and
`redraw-type' can be one of:
value meaning
----- -------
'START preserve the start position of the window
'POINT preserve the point position of the window
'BUFFER-CURSOR-Y move point to last known position, or recenter
y move point to the y'th row
other center the point vertically in the window
* Implementation of `truncate-lines' functionality. The following
changes are in support of this:
* Implementation of editor variable "assignment daemons" which allow
some arbitrary code to be executed whenever a specific variable is
assigned.
* Significant overhaul of local-variable binding:
** Implementation of "per-buffer" variables; that is, variables which
become buffer-local whenever they are set. The new special form
`define-variable-per-buffer' supports this functionality. The
following variables are defined as "per-buffer":
fill-column
left-margin
tab-width
case-fold-search
truncate-lines
** Implementation of new operations to access the local and default
value of a variable:
(variable-local-value? buffer variable)
(variable-local-value buffer variable)
(set-variable-local-value! buffer variable value)
(variable-default-value variable)
(set-variable-default-value! variable value)
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.101 1989/08/07 08:44:14 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.102 1989/08/08 10:05:18 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(set! edwin-finalization
(lambda ()
(set! edwin-finalization false)
- (%exit))) ((ref-command suspend-edwin))))
+ (%exit)))
+ ((ref-command suspend-edwin))))
+
+(define-command save-buffers-kill-edwin
+ "Offer to save each buffer, then kill Edwin, returning to Scheme.
+With prefix arg, silently save all file-visiting buffers, then kill."
+ "P"
+ (lambda (no-confirmation?)
+ (save-some-buffers no-confirmation?)
+ (set! edwin-finalization
+ (lambda ()
+ (set! edwin-finalization false)
+ (reset-editor)))
+ ((ref-command suspend-edwin))))
(define-command exit-recursive-edit
"Exit normally from a subsystem of a level of editing."
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.130 1989/04/28 22:47:15 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.131 1989/08/08 10:05:22 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(lambda ()
(let ((buffer (current-buffer))
(old-value (variable-value variable)))
- (set-variable-value! variable new-value)
+ (%set-variable-value! variable new-value)
+ (invoke-variable-assignment-daemons! variable)
(let ((bindings (buffer-local-bindings buffer)))
(let ((binding (assq variable bindings)))
(if (not binding)
(let ((binding (assq variable bindings)))
(if binding
(begin
- (set-variable-value! variable (cdr binding))
+ (%set-variable-value! variable (cdr binding))
+ (invoke-variable-assignment-daemons! variable)
(vector-set! buffer
buffer-index:local-bindings
(delq! binding bindings)))))))
(lambda ()
(let ((buffer (current-buffer)))
(for-each (lambda (binding)
- (set-variable-value! (car binding) (cdr binding)))
+ (let ((variable (car binding)))
+ (%set-variable-value! variable (cdr binding))
+ (invoke-variable-assignment-daemons! variable)))
(buffer-local-bindings buffer))
(vector-set! buffer buffer-index:local-bindings '()))
unspecific)))
-(define (%wind-local-bindings! buffer)
- ;; Assumes that interrupts are disabled and that BUFFER is selected.
- (for-each (lambda (binding)
- (let ((variable (car binding)))
- (let ((old-value (variable-value variable)))
- (set-variable-value! variable (cdr binding))
- (set-cdr! binding old-value)))
+(define (change-local-bindings! old-buffer new-buffer select-buffer!)
+ ;; Assumes that interrupts are disabled and that OLD-BUFFER is selected.
+ (let ((variables '()))
+ (for-each (lambda (binding)
+ (let ((variable (car binding)))
+ (let ((old-value (variable-value variable)))
+ (%set-variable-value! variable (cdr binding))
+ (set-cdr! binding old-value))
+ (if (not (null? (variable-assignment-daemons variable)))
+ (begin
+ (set! variables (cons variable variables))
+ unspecific))))
+ (buffer-local-bindings old-buffer))
+ (select-buffer!)
+ (for-each (lambda (binding)
+ (let ((variable (car binding)))
+ (let ((old-value (variable-value variable)))
+ (%set-variable-value! variable (cdr binding))
+ (set-cdr! binding old-value))
+ (if (and (not (null? (variable-assignment-daemons variable)))
+ (not (memq variable variables)))
+ (begin
+ (set! variables (cons variable variables))
+ unspecific))))
+ (buffer-local-bindings new-buffer))
+ (perform-buffer-initializations! new-buffer)
+ (if (not (null? variables))
+ (for-each invoke-variable-assignment-daemons! variables))))
+\f
+(define (variable-local-value buffer variable)
+ (let ((buffer* (current-buffer))
+ (in-cell
+ (lambda ()
+ (variable-value variable))))
+ (if (eq? buffer buffer*)
+ (in-cell)
+ (let ((binding (assq variable (buffer-local-bindings buffer))))
+ (cond (binding
+ (cdr binding))
+ ((variable-buffer-local? variable)
+ (let ((binding
+ (assq variable (buffer-local-bindings buffer*))))
+ (if binding
+ (cdr binding)
+ (in-cell))))
+ (else
+ (in-cell)))))))
+
+(define (set-variable-local-value! buffer variable value)
+ (if (eq? buffer (current-buffer))
+ (set-variable-value! variable value)
+ (let ((binding (assq variable (buffer-local-bindings buffer))))
+ (if binding
+ (begin
+ (set-cdr! binding value)
unspecific)
- (buffer-local-bindings buffer)))\f
+ (set-variable-value! variable value)))))
+
+(define (variable-local-value? buffer variable)
+ (assq variable (buffer-local-bindings buffer)))
+
+(define (variable-default-value variable)
+ (let ((binding (assq variable (buffer-local-bindings (current-buffer)))))
+ (if binding
+ (cdr binding)
+ (variable-value variable))))
+
+(define (set-variable-default-value! variable value)
+ (let ((binding (assq variable (buffer-local-bindings (current-buffer)))))
+ (if binding
+ (begin
+ (set-cdr! binding value)
+ unspecific)
+ (without-interrupts
+ (lambda ()
+ (%set-variable-value! variable value)
+ (invoke-variable-assignment-daemons! variable))))))
+\f
;;;; Modes
(define-integrable (buffer-major-mode buffer)
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.32 1989/04/28 22:47:21 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.33 1989/08/08 10:05:25 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(define (make-buffer-frame superior new-buffer modeline?)
(let ((frame (=> superior :make-inferior buffer-frame)))
- (initial-buffer! (frame-text-inferior frame) new-buffer)
+ (let ((window (frame-text-inferior frame)))
+ (initial-buffer! window new-buffer)
+ (%window-setup-truncate-lines! window false))
(initial-modeline! frame modeline?)
frame))
(let ((window (frame-text-inferior frame)))
(%set-window-point! window (clip-mark-to-display window point))))
-(define (window-redraw! frame #!optional preserve-point?)
- (let ((window (frame-text-inferior frame)))
- (%window-redraw! window
- (if (and (not (default-object? preserve-point?))
- preserve-point?)
- (%window-point-y window)
- (%window-y-center window)))))
+(define (window-redraw! frame redraw-type)
+ (%window-force-redraw! (frame-text-inferior frame) redraw-type))
-(define-integrable (window-redraw-preserving-point! window)
- (window-redraw! window true))
+(define (window-redraw-preserving-point! frame)
+ (let ((window (frame-text-inferior frame)))
+ (%window-force-redraw! window (%window-point-y window))))
(define-integrable (window-needs-redisplay? frame)
(with-instance-variables buffer-frame frame ()
(define (window-coordinates->mark frame x y)
(let ((window (frame-text-inferior frame)))
(maybe-recompute-image! window)
- (%window-coordinates->mark window x y)))
\ No newline at end of file
+ (%window-coordinates->mark window x y)))
+
+(define (window-setup-truncate-lines! frame)
+ (%window-setup-truncate-lines! (frame-text-inferior frame) 'START))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwin.scm,v 1.279 1989/04/28 22:47:54 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwin.scm,v 1.280 1989/08/08 10:05:29 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
start-clip-mark end-clip-mark
saved-screen saved-x-start saved-y-start
saved-xl saved-xu saved-yl saved-yu
- override-inferior))
+ override-inferior truncate-lines? force-redraw?))
(define-method buffer-window (:initialize! window window*)
(usual=> window :initialize! window*)
(set! changes-daemon (make-changes-daemon window))
(set! clip-daemon (make-clip-daemon window))
(set! override-inferior false)
+ (set! force-redraw? 'BUFFER-CURSOR-Y)
unspecific)
(define-method buffer-window (:kill! window)
(define (set-buffer-window-size! window x y)
(with-instance-variables buffer-window window (x y)
(set! saved-screen false)
- (%window-redraw! window
- (let ((old-y y-size))
- (usual=> window :set-size! x y)
- ;; Preserve point y unless it is offscreen now.
- (or (and old-y
- (let ((y (inferior-y-start cursor-inferior)))
- (and (< y y-size) y)))
- (let ((y (buffer-cursor-y buffer)))
- (and y (< y y-size) y)))))))
+ (let ((old-y y-size))
+ (usual=> window :set-size! x y)
+ ;; Preserve point y unless it is offscreen now.
+ (%window-setup-truncate-lines! window false)
+ (%window-force-redraw!
+ window
+ (or (and old-y
+ (let ((y (inferior-y-start cursor-inferior)))
+ (and (< y y-size) y)))
+ (%window-buffer-cursor-y window))))))
+
+(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)))
+ unspecific)
+ (let ((new-truncate-lines?
+ (or (and (variable-local-value
+ buffer
+ (ref-variable-object truncate-partial-width-windows))
+ (window-has-horizontal-neighbor? superior))
+ (variable-local-value
+ buffer
+ (ref-variable-object truncate-lines)))))
+ (if (not (boolean=? truncate-lines? new-truncate-lines?))
+ (begin
+ (set! truncate-lines? new-truncate-lines?)
+ (if (and redraw-type (not force-redraw?))
+ (%window-force-redraw! window redraw-type))))))))
(define-method buffer-window :set-size!
set-buffer-window-size!)
(delete-window-buffer! window)
(initial-buffer! window new-buffer)
(window-modeline-event! superior 'NEW-BUFFER)
- (%window-redraw! window
- (let ((y (buffer-cursor-y buffer)))
- (and y (< y y-size) y)))))
+ (%window-force-redraw! window (%window-buffer-cursor-y window))))
+
+(define (%window-buffer-cursor-y window)
+ (with-instance-variables buffer-window window (new-buffer)
+ (let ((y (buffer-cursor-y buffer)))
+ (and y (< y y-size) y))))
(define (initial-buffer! window new-buffer)
(with-instance-variables buffer-window window (new-buffer)
(list override-inferior cursor-inferior blank-inferior))
(set-inferior-start! override-inferior 0 0)))
(let ((override-window (inferior-window override-inferior)))
- (set-line-window-string! override-window message)
+ (set-line-window-string! override-window message truncate-lines?)
(set-inferior-position!
cursor-inferior
(string-base:index->coordinates override-window
(let ((inferior (make-inferior window line-window)))
(set-line-window-string! (inferior-window inferior)
(group-extract-string (buffer-group buffer)
- start end))
+ start end)
+ truncate-lines?)
inferior)))
(define-integrable (first-line-inferior window)
(define (maybe-recenter! window)
(with-instance-variables buffer-window window ()
- (let ((threshold (ref-variable cursor-centering-threshold)))
+ (let ((threshold (ref-variable cursor-centering-threshold))
+ (recenter!
+ (lambda ()
+ (%window-redraw! window (%window-y-center window)))))
(if (zero? threshold)
- (%window-redraw! window (%window-y-center window))
+ (recenter!)
(if (< (mark-index point) (mark-index start-mark))
(let ((limit
(%window-coordinates->index window 0 (- threshold))))
- (if (or (not limit)
- (>= (mark-index point) limit))
+ (if (or (not limit) (>= (mark-index point) limit))
(%window-scroll-y-relative! window
(%window-point-y window))
- (%window-redraw! window (%window-y-center window))))
+ (recenter!)))
(let ((limit
(%window-coordinates->index window
0
(+ (window-y-size window)
threshold))))
- (if (or (not limit)
- (< (mark-index point) limit))
+ (if (or (not limit) (< (mark-index point) limit))
(%window-scroll-y-relative!
window
(- (%window-point-y window) (-1+ (window-y-size window))))
- (%window-redraw! window (%window-y-center window)))))))))
+ (recenter!))))))))
+
+(define (%window-force-redraw! window redraw-type)
+ (with-instance-variables buffer-window window ()
+ (set! force-redraw? (or redraw-type 'CENTER))
+ (setup-redisplay-flags! redisplay-flags)))
+\f
+(define (%window-redraw-preserving-start! window)
+ (with-instance-variables buffer-window window ()
+ (let ((group (mark-group start-mark))
+ (start-line (mark-index start-line-mark)))
+ (let ((start (if truncate-lines? start-line (mark-index start-mark)))
+ (end (line-end-index group start-line)))
+ (let ((inferior (make-line-inferior window start-line end)))
+ (set-inferior-start!
+ inferior
+ 0
+ (- (string-base:index->y (inferior-window inferior)
+ (- start start-line))))
+ (set-line-inferiors!
+ window
+ (cons inferior (fill-bottom window (inferior-y-end inferior) end))
+ start)))))
+ (everything-changed! window maybe-recenter!))
(define (%window-redraw! window y)
(with-instance-variables buffer-window window (y)
(begin
(if (or (< y 0) (>= y y-size))
(error "Attempt to scroll point off window" y))
- y)))
- (everything-changed! window
- (lambda (w)
- (error "%WINDOW-REDRAW! left point offscreen -- get a wizard" w)))))
+ y))))
+ (everything-changed! window
+ (lambda (w)
+ (error "%WINDOW-REDRAW! left point offscreen -- get a wizard" w))))
(define (redraw-screen! window y)
(with-instance-variables buffer-window window (y)
(set! start-changes-mark false)
(set! end-changes-mark false)
(set! start-clip-mark false)
- (set! end-clip-mark false) unspecific))
+ (set! end-clip-mark false)
+ (set! force-redraw? false)
+ unspecific))
(define (start-mark-changed! window)
(with-instance-variables buffer-window window ()
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwiu.scm,v 1.9 1989/04/28 22:48:00 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwiu.scm,v 1.10 1989/08/08 10:05:33 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(define (%recompute-image! window)
(with-instance-variables buffer-window window ()
- (let ((group (mark-group start-mark))
- (start-line (mark-index start-line-mark))
- (start (mark-index start-mark))
- (end (mark-index end-mark))
- (point-index (mark-index point)))
- (if start-clip-mark
- (let ((new-clip-start (group-start-index group))
- (new-clip-end (group-end-index group)))
- (cond ((< point-index new-clip-start)
- (%set-buffer-point! buffer (group-display-start group))
- (set! point (buffer-point buffer)))
- ((> point-index new-clip-end)
- (%set-buffer-point! buffer (group-display-end group))
- (set! point (buffer-point buffer))))
- (cond ((> new-clip-start start-line)
- (%window-redraw! window false))
- ((or (< new-clip-end end)
- (and (< new-clip-start start-line)
- (= start-line (mark-index start-clip-mark)))
- (and (> new-clip-end end)
- (= end (mark-index end-clip-mark))))
- (%window-redraw! window
- (and (not start-changes-mark)
- (>= point-index start)
- (<= point-index end)
- (%window-point-y window))))
- (else
- (set! start-clip-mark false)
- (set! end-clip-mark false)))))
- (if start-changes-mark
- (let ((start-changes (mark-index start-changes-mark))
- (end-changes (mark-index end-changes-mark)))
- (if (and (>= end-changes start-line)
- (<= start-changes end))
- (if (<= start-changes start)
- (if (< end-changes end)
- (recompute-image!:top-changed window)
- (%window-redraw! window false))
- (if (>= end-changes end)
- (recompute-image!:bottom-changed window)
- (recompute-image!:middle-changed window)))
- (begin
- (set! start-changes-mark false)
- (set! end-changes-mark false))))))
- (if point-moved?
- (update-cursor! window maybe-recenter!))))
+ (cond ((eq? 'START force-redraw?)
+ (%window-redraw-preserving-start! window))
+ ((eq? 'POINT force-redraw?)
+ (%window-redraw! window (%window-point-y window)))
+ ((eq? 'BUFFER-CURSOR-Y force-redraw?)
+ (%window-redraw! window (%window-buffer-cursor-y window)))
+ ((and (integer? force-redraw?)
+ (not (negative? force-redraw?))
+ (< force-redraw? y-size))
+ (%window-redraw! window force-redraw?))
+ (force-redraw?
+ (%window-redraw! window (%window-y-center window)))
+ (else
+ (let ((group (mark-group start-mark))
+ (start-line (mark-index start-line-mark))
+ (start (mark-index start-mark))
+ (end (mark-index end-mark))
+ (point-index (mark-index point)))
+ (if start-clip-mark
+ (let ((new-clip-start (group-start-index group))
+ (new-clip-end (group-end-index group)))
+ (cond ((< point-index new-clip-start)
+ (%set-buffer-point! buffer
+ (group-display-start group))
+ (set! point (buffer-point buffer)))
+ ((> point-index new-clip-end)
+ (%set-buffer-point! buffer (group-display-end group))
+ (set! point (buffer-point buffer))))
+ (cond ((> new-clip-start start-line)
+ (%window-redraw! window false))
+ ((or (< new-clip-end end)
+ (and (< new-clip-start start-line)
+ (= start-line (mark-index start-clip-mark)))
+ (and (> new-clip-end end)
+ (= end (mark-index end-clip-mark))))
+ (%window-redraw! window
+ (and (not start-changes-mark)
+ (>= point-index start)
+ (<= point-index end)
+ (%window-point-y window))))
+ (else
+ (set! start-clip-mark false)
+ (set! end-clip-mark false)))))
+ (if start-changes-mark
+ (let ((start-changes (mark-index start-changes-mark))
+ (end-changes (mark-index end-changes-mark)))
+ (if (and (>= end-changes start-line)
+ (<= start-changes end))
+ (if (<= start-changes start)
+ (if (< end-changes end)
+ (recompute-image!:top-changed window)
+ (%window-redraw! window false))
+ (if (>= end-changes end)
+ (recompute-image!:bottom-changed window)
+ (recompute-image!:middle-changed window)))
+ (begin
+ (set! start-changes-mark false) (set! end-changes-mark false))))))
+ (if point-moved?
+ (update-cursor! window maybe-recenter!))))))
\f
(define (recompute-image!:top-changed window)
(with-instance-variables buffer-window window ()
(let ((start-index (line-start-index group index)))
(set-line-window-string!
(inferior-window (car inferiors))
- (group-extract-string group start-index (line-end-index group index)))
+ (group-extract-string group start-index (line-end-index group index))
+ truncate-lines?)
(fill-top! window inferiors start-index true)))
(everything-changed! window maybe-recenter!)))
(let ((end-index (line-end-index group index)))
(set-line-window-string!
(inferior-window (car inferiors))
- (group-extract-string group (line-start-index group index) end-index))
+ (group-extract-string group (line-start-index group index) end-index)
+ truncate-lines?)
(set-cdr! inferiors
(fill-bottom window
(inferior-y-end (car inferiors))
(let ((y-end (inferior-y-end (car start-inferiors))))
(set-line-window-string!
(inferior-window (car start-inferiors))
- (group-extract-string group start-start start-end))
+ (group-extract-string group start-start start-end)
+ truncate-lines?)
(let ((y-end* (inferior-y-end (car start-inferiors))))
(if (= y-end y-end*)
(maybe-marks-changed! window start-inferiors y-end*)
;; several, so we need to insert a bunch of new lines.
(begin
(set-line-window-string! (inferior-window (car start-inferiors))
- (group-extract-string group start-start start-end))
+ (group-extract-string group start-start start-end)
+ truncate-lines?)
(set-cdr! start-inferiors
(if (null? (cdr start-inferiors))
(fill-bottom window
;; We must scroll the bottom of the screen up to fill in.
(begin
(set-line-window-string! (inferior-window (car start-inferiors))
- (group-extract-string group start-start start-end))
+ (group-extract-string group start-start start-end)
+ truncate-lines?)
(set-cdr! start-inferiors
(if (null? (cdr end-inferiors))
(fill-bottom window
(begin
(set-line-window-string!
(inferior-window (car start-inferiors))
- (group-extract-string group start-start start-end))
+ (group-extract-string group start-start start-end)
+ truncate-lines?)
(let ((old-y-end (inferior-y-end (car end-inferiors))))
(set-line-window-string! (inferior-window (car end-inferiors))
- (group-extract-string group end-start end-end)) (let ((y-end (inferior-y-end (car end-inferiors)))
+ (group-extract-string group end-start end-end)
+ truncate-lines?)
+ (let ((y-end (inferior-y-end (car end-inferiors)))
(tail (cdr end-inferiors)))
(cond ((> y-end old-y-end)
(set-cdr! end-inferiors (scroll-lines-down! window tail y-end)))
;;; -*-Scheme-*-
;;;
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwmc.scm,v 1.5 1989/08/08 10:05:36 cph Exp $
+;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
;;; This material was developed by the Scheme project at the
(done start columns y-start)
(search-downwards (1+ end)
(+ y-start
- (column->y-size columns x-size)))))))
+ (column->y-size columns
+ x-size
+ truncate-lines?)))))))
(define-integrable (done start columns y-start)
(let ((xy
(column->coordinates columns
x-size
+ truncate-lines?
(group-column-length group
start
index
(search-downwards end y-end)))))))
(define-integrable (y-delta start end)
- (column->y-size (group-column-length group start end 0) x-size))
+ (column->y-size (group-column-length group start end 0)
+ x-size
+ truncate-lines?))
+
+ (define (done start end y-start)
+ (let ((column-size (group-column-length group start end 0)))
+ (if (and truncate-lines? (= x (-1+ x-size)))
+ column-size
+ (group-column->index group start end 0
+ (min (coordinates->column x
+ (- y y-start)
+ x-size)
+ column-size)))))
- (define-integrable (done start end y-start)
- (group-column->index group start end 0
- (coordinates->column x (- y y-start) x-size)))
(let ((start (inferior-y-start (first-line-inferior window)))
(end (inferior-y-end last-line-inferior)))
(cond ((< y start)
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/calias.scm,v 1.6 1989/08/07 08:44:17 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/calias.scm,v 1.7 1989/08/08 10:05:40 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(else char))))
(define (unmap-alias-char char)
- (if (and (ascii-controlified? char) (even? (quotient (char-bits char) 2)))
+ (if (and (ascii-controlified? char)
+ (let ((code (char-code char)))
+ (not (or (= code #x09) ;tab
+ (= code #x0A) ;linefeed
+ (= code #x0C) ;page
+ (= code #x0D) ;return
+ (= code #x1B) ;altmode
+ )))
+ (even? (quotient (char-bits char) 2)))
(unmap-alias-char
(make-char (let ((code (char-code char)))
(+ code (if (<= #x01 code #x1A) #x60 #x40)))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comman.scm,v 1.58 1989/04/28 22:48:38 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comman.scm,v 1.59 1989/08/08 10:05:43 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(define-named-structure "Variable"
name
description
- value)
-
+ value
+ assignment-daemons
+ buffer-local?)
(define (variable-name-string variable)
(editor-name/internal->external (symbol->string (variable-name variable))))
(vector-set! variable variable-index:name name)
(vector-set! variable variable-index:description description)
(vector-set! variable variable-index:value value)
+ (vector-set! variable variable-index:assignment-daemons '())
+ (vector-set! variable variable-index:buffer-local? false)
variable))
+(define-integrable (make-variable-buffer-local! variable)
+ (vector-set! variable variable-index:buffer-local? true)
+ unspecific)
+
+(define (add-variable-assignment-daemon! variable daemon)
+ (let ((daemons (variable-assignment-daemons variable)))
+ (if (not (memq daemon daemons))
+ (begin
+ (vector-set! variable
+ variable-index:assignment-daemons
+ (cons daemon daemons))
+ unspecific))))
+
+(define (invoke-variable-assignment-daemons! variable)
+ (for-each (lambda (daemon) (daemon variable))
+ (variable-assignment-daemons variable)))
+
(define editor-variables
(make-string-table 50))
(let ((name (canonicalize-name name)))
(or (string-table-get editor-variables (symbol->string name))
(make-variable name "" false))))
-(define-integrable (set-variable-value! variable value) (vector-set! variable variable-index:value value)
+(define (set-variable-value! variable value)
+ (if (variable-buffer-local? variable)
+ (make-local-binding! variable value)
+ (without-interrupts
+ (lambda ()
+ (%set-variable-value! variable value)
+ (invoke-variable-assignment-daemons! variable)))))
+
+(define-integrable (%set-variable-value! variable value)
+ (vector-set! variable variable-index:value value)
unspecific)
(define (with-variable-value! variable new-value thunk)
(let ((old-value))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.76 1989/08/07 08:44:21 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.77 1989/08/08 10:05:47 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
((eq? procedure (ref-command backward-char))
(if (and (not (group-start? point))
(char-graphic? (mark-left-char point))
- (positive? point-x)) (window-direct-output-backward-char! window)
+ (positive? point-x)
+ (< point-x (-1+ (window-x-size window))))
+ (window-direct-output-backward-char! window)
(normal)))
(else
(if (not (typein-window? window))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.83 1989/04/28 22:49:03 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.84 1989/08/08 10:05:50 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(define (select-window window)
(without-interrupts
(lambda ()
- (let ((frame (current-editor-frame)))
- (%wind-local-bindings!
- (window-buffer (editor-frame-selected-window frame)))
- (editor-frame-select-window! frame window))
- (let ((buffer (window-buffer window)))
- (%wind-local-bindings! buffer)
- (perform-buffer-initializations! buffer)
+ (let ((frame (current-editor-frame))
+ (buffer (window-buffer window)))
+ (change-local-bindings!
+ (window-buffer (editor-frame-selected-window frame))
+ buffer
+ (lambda ()
+ (editor-frame-select-window! frame window)))
(bufferset-select-buffer! (current-bufferset) buffer)))))
(define-integrable (select-cursor window)
(lambda ()
(if (current-window? window)
(begin
- (%wind-local-bindings! (window-buffer window))
- (%set-window-buffer! window buffer)
- (%wind-local-bindings! buffer)
- (perform-buffer-initializations! buffer) (if record? (bufferset-select-buffer! (current-bufferset) buffer)))
+ (change-local-bindings!
+ (window-buffer window)
+ buffer
+ (lambda () (%set-window-buffer! window buffer)))
+ (if record? (bufferset-select-buffer! (current-bufferset) buffer)))
(%set-window-buffer! window buffer)))))
(define (with-selected-buffer buffer thunk)
(let ((old-buffer))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.188 1989/08/07 08:44:38 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.189 1989/08/08 10:05:54 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(recursive-edit-continuation false)
(recursive-edit-level 0))
(thunk)))
+(define (within-editor?)
+ (not (unassigned? current-editor)))
(define (enter-recursive-edit)
(let ((value
(call-with-current-continuation
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtfrm.scm,v 1.77 1989/06/21 10:35:31 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtfrm.scm,v 1.78 1989/08/08 10:05:57 cph Exp $
;;;
;;; Copyright (c) 1985, 1989 Massachusetts Institute of Technology
;;;
(define-integrable (editor-frame-screen window)
(with-instance-variables editor-frame window ()
screen))
+(define (editor-frame-windows window)
+ (cons (editor-frame-typein-window window)
+ (let ((start (editor-frame-window0 window)))
+ (cons start
+ (let loop ((window (window1+ start)))
+ (if (eq? window start)
+ '()
+ (cons window (loop (window1+ window)))))))))
+
(define (editor-frame-select-window! window window*)
(with-instance-variables editor-frame window (window*)
(if (not (buffer-frame? window*))
(define-integrable (current-screen)
(editor-screen current-editor))
+(define-integrable (all-screens)
+ (list (current-screen)))
(define-integrable (current-editor-frame)
(editor-frame-window current-editor))
+
+(define-integrable (all-editor-frames)
+ (list (current-editor-frame)))
+
+(define-integrable (all-windows)
+ #|(append-map editor-frame-windows (all-editor-frames))|#
+ (editor-frame-windows (current-editor-frame)))
(define-integrable (current-bufferset)
(editor-bufferset current-editor))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.7 1989/08/07 08:44:45 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.8 1989/08/08 10:06:04 cph Exp $
Copyright (c) 1989 Massachusetts Institute of Technology
editor-frame-selected-window
editor-frame-typein-window
editor-frame-window0
+ editor-frame-windows
edwin-discard-state!
edwin-display
edwin-editor
window-scroll-y-relative!
window-select-time
window-set-override-message!
+ window-setup-truncate-lines!
window-start-mark
window-y-center
with-editor-interrupts
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fill.scm,v 1.44 1989/04/28 22:49:55 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/fill.scm,v 1.45 1989/08/08 10:06:07 cph Rel $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
(lambda (region)
(fill-region region)))
-(define-variable fill-column
- "Controls where \\[fill-paragraph] and auto-fill mode put the right margin."
+(define-variable-per-buffer fill-column
+ "*Column beyond which automatic line-wrapping should happen.
+Automatically becomes local when set in any fashion."
70)
(define-command set-fill-column
(and (> (mark-column point) (ref-variable fill-column))
(line-end? (horizontal-space-end point))))
-(define-variable left-margin
- "The number of columns to indent each line." 0)
+(define-variable-per-buffer left-margin
+ "*Column for the default indent-line-function to indent to.
+Linefeed indents to this column in Fundamental mode.
+Automatically becomes local when set in any fashion."
+ 0)
(define (center-line mark)
(let ((mark (mark-permanent! mark)))
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/lincom.scm,v 1.103 1989/04/28 22:50:51 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/lincom.scm,v 1.104 1989/08/08 10:06:12 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
"\\[delete-indentation] won't insert a space to the left of these."
(char-set #\)))
\f
-(define-variable tab-width
- "Distance between tab stops (for display of tab characters), in columns." 8)
+(define-variable-per-buffer tab-width
+ "Distance between tab stops (for display of tab characters), in columns.
+Automatically becomes local when set in any fashion."
+ 8)
(define-variable indent-tabs-mode
"If false, do not use tabs for indentation or horizontal spacing."
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/macros.scm,v 1.47 1989/06/19 22:46:06 markf Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/macros.scm,v 1.48 1989/08/08 10:06:18 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
',description
,(if (default-object? value) '#F value)))
',name))))
+
+(syntax-table-define edwin-syntax-table 'DEFINE-VARIABLE-PER-BUFFER
+ (lambda (name description #!optional value)
+ (let ((name (canonicalize-name name)))
+ (let ((scheme-name (variable-name->scheme-name name)))
+ `(BEGIN
+ (DEFINE ,scheme-name
+ (MAKE-VARIABLE ',name
+ ',description
+ ,(if (default-object? value) '#F value)))
+ (MAKE-VARIABLE-BUFFER-LOCAL! ,scheme-name)
+ ',name)))))
+
(syntax-table-define edwin-syntax-table 'REF-VARIABLE-OBJECT
(lambda (name)
(variable-name->scheme-name (canonicalize-name name))))
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.12 1989/08/07 08:44:59 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.13 1989/08/08 10:06:22 cph Exp $
Copyright (c) 1989 Massachusetts Institute of Technology
(declare (usual-integrations))
(package/system-loader "edwin" '() 'QUERY)
-(add-system! (make-system "Edwin" 3 12 '()))
\ No newline at end of file
+(add-system! (make-system "Edwin" 3 13 '()))
\ No newline at end of file
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.118 1989/08/07 08:45:08 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.119 1989/08/08 10:06:25 cph Exp $
;;;
;;; Copyright (c) 1985, 1989 Massachusetts Institute of Technology
;;;
(define-key 'fundamental '(#\c-x #\[) 'backward-page)
(define-key 'fundamental '(#\c-x #\]) 'forward-page)
(define-key 'fundamental '(#\c-x #\^) 'enlarge-window)
-(define-key 'fundamental '(#\c-x #\b) 'switch-to-buffer)(define-key 'fundamental '(#\c-x #\d) 'dired)
+(define-key 'fundamental '(#\c-x #\b) 'switch-to-buffer)
+(define-key 'fundamental '(#\c-x #\c) 'save-buffers-kill-edwin)
+(define-key 'fundamental '(#\c-x #\d) 'dired)
(define-key 'fundamental '(#\c-x #\e) 'call-last-kbd-macro)
(define-key 'fundamental '(#\c-x #\f) 'set-fill-column)
(define-key 'fundamental '(#\c-x #\g) 'insert-register)
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sercom.scm,v 1.54 1989/04/28 22:53:17 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/sercom.scm,v 1.55 1989/08/08 10:06:29 cph Rel $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
\f
;;;; Variables
-(define-variable case-fold-search
- "*True if searches should ignore case." true)
+(define-variable-per-buffer case-fold-search
+ "*True if searches should ignore case.
+Automatically becomes local when set in any fashion."
+ true)
(define-variable search-last-string
"Last string search for by a non-regexp search command.
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/utlwin.scm,v 1.51 1989/04/28 22:54:27 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/utlwin.scm,v 1.52 1989/08/08 10:06:32 cph Exp $
;;;
;;; Copyright (c) 1986, 1989 Massachusetts Institute of Technology
;;;
;;; from which methods can be built.
(define-class string-base vanilla-window
- (image representation))
+ (image representation truncate-lines?))
(define-method string-base (:update-display! window screen x-start y-start
xl xu yl yu display-style)
#|
(subscreen-clear! screen
(+ x-start xl) (+ x-start xu)
- (+ y-start yl) (+ y-start yu))|#
+ (+ y-start yl) (+ y-start yu))
+|#
)
((< yl yu)
(let ((start (cdr representation))
(let ((x-start (+ x-start end)))
(subscreen-clear! screen
(+ x-start xl) (+ x-start xu)
- ayl ayu))))|#
+ ayl ayu))))
+|#
))))
(else
(screen-write-substrings! screen (+ x-start xl) (+ y-start yl)
representation xl xu yl yu)))
true)
\f
-(define (string-base:set-size-given-x! window x)
- (with-instance-variables string-base window (x)
+(define (string-base:set-size-given-x! window x *truncate-lines?)
+ (with-instance-variables string-base window (x *truncate-lines?)
+ (set! truncate-lines? *truncate-lines?)
(set! x-size x)
(set! y-size (string-base:desired-y-size window x))
(string-base:refresh! window)))
-(define (string-base:set-size-given-y! window y)
- (with-instance-variables string-base window (y)
+(define (string-base:set-size-given-y! window y *truncate-lines?)
+ (with-instance-variables string-base window (y *truncate-lines?)
+ (set! truncate-lines? *truncate-lines?)
(set! x-size (string-base:desired-x-size window y))
(set! y-size y)
(string-base:refresh! window)))
-(define-integrable (string-base:desired-x-size window y-size)
+(define (string-base:desired-x-size window y-size)
(with-instance-variables string-base window (y-size)
- (column->x-size (image-column-size image) y-size)))
+ (column->x-size (image-column-size image) y-size truncate-lines?)))
-(define-integrable (string-base:desired-y-size window x-size)
+(define (string-base:desired-y-size window x-size)
(with-instance-variables string-base window (x-size)
- (column->y-size (image-column-size image) x-size)))
+ (column->y-size (image-column-size image) x-size truncate-lines?)))
(define (string-base:index->coordinates window index)
(with-instance-variables string-base window (index)
(column->coordinates (image-column-size image)
x-size
+ truncate-lines?
(image-index->column image index))))
(define (string-base:index->x window index)
(with-instance-variables string-base window (index)
(column->x (image-column-size image)
x-size
+ truncate-lines?
(image-index->column image index))))
(define (string-base:index->y window index)
(with-instance-variables string-base window (index)
(column->y (image-column-size image)
x-size
+ truncate-lines?
(image-index->column image index))))
(define (string-base:coordinates->index window x y)
(with-instance-variables string-base window (x y)
(image-column->index image
- (min (coordinates->column x y x-size)
- (image-column-size image)))))
+ (let ((column-size (image-column-size image)))
+ (if (and truncate-lines? (= x (-1+ x-size)))
+ column-size
+ (min (coordinates->column x y x-size)
+ column-size))))))
\f
-(define (column->x-size column-size y-size)
+(define (column->x-size column-size y-size truncate-lines?)
;; Assume Y-SIZE > 0.
- (let ((qr (integer-divide column-size y-size)))
- (if (zero? (integer-divide-remainder qr))
- (integer-divide-quotient qr)
- (1+ (integer-divide-quotient qr)))))
+ (if truncate-lines?
+ column-size
+ (let ((qr (integer-divide column-size y-size)))
+ (if (zero? (integer-divide-remainder qr))
+ (integer-divide-quotient qr)
+ (1+ (integer-divide-quotient qr))))))
-(define (column->y-size column-size x-size)
+(define (column->y-size column-size x-size truncate-lines?)
;; Assume X-SIZE > 1.
- (if (zero? column-size)
+ (if (or truncate-lines? (zero? column-size))
1
(let ((qr (integer-divide column-size (-1+ x-size))))
(if (zero? (integer-divide-remainder qr))
(integer-divide-quotient qr)
(1+ (integer-divide-quotient qr))))))
-(define (column->coordinates column-size x-size column)
+(define (column->coordinates column-size x-size truncate-lines? column)
(let ((-1+x-size (-1+ x-size)))
- (if (< column -1+x-size)
- (cons column 0)
- (let ((qr (integer-divide column -1+x-size)))
- (if (and (zero? (integer-divide-remainder qr))
- (= column column-size))
- (cons -1+x-size
- (-1+ (integer-divide-quotient qr)))
- (cons (integer-divide-remainder qr)
- (integer-divide-quotient qr)))))))
-
-(define (column->x column-size x-size column)
+ (cond ((< column -1+x-size)
+ (cons column 0))
+ (truncate-lines?
+ (cons -1+x-size 0))
+ (else
+ (let ((qr (integer-divide column -1+x-size)))
+ (if (and (zero? (integer-divide-remainder qr))
+ (= column column-size))
+ (cons -1+x-size
+ (-1+ (integer-divide-quotient qr)))
+ (cons (integer-divide-remainder qr)
+ (integer-divide-quotient qr))))))))
+
+(define (column->x column-size x-size truncate-lines? column)
(let ((-1+x-size (-1+ x-size)))
- (if (< column -1+x-size)
- column
- (let ((r (remainder column -1+x-size)))
- (if (and (zero? r) (= column column-size))
- -1+x-size
- r)))))
-
-(define (column->y column-size x-size column)
- (let ((-1+x-size (-1+ x-size)))
- (if (< column -1+x-size)
- 0
- (let ((qr (integer-divide column -1+x-size)))
- (if (and (zero? (integer-divide-remainder qr))
- (= column column-size))
- (-1+ (integer-divide-quotient qr))
- (integer-divide-quotient qr))))))
+ (cond ((< column -1+x-size)
+ column)
+ (truncate-lines?
+ -1+x-size)
+ (else
+ (let ((r (remainder column -1+x-size)))
+ (if (and (zero? r) (= column column-size))
+ -1+x-size
+ r))))))
+
+(define (column->y column-size x-size truncate-lines? column)
+ (if truncate-lines?
+ 0
+ (let ((-1+x-size (-1+ x-size)))
+ (if (< column -1+x-size)
+ 0
+ (let ((qr (integer-divide column -1+x-size)))
+ (if (and (zero? (integer-divide-remainder qr))
+ (= column column-size))
+ (-1+ (integer-divide-quotient qr))
+ (integer-divide-quotient qr)))))))
(define-integrable (coordinates->column x y x-size)
(+ x (* y (-1+ x-size))))
(define (string-base:refresh! window)
(with-instance-variables string-base window ()
- (let ((string (image-representation image)))
- (let ((column-size (string-length string)))
- (if (< column-size x-size)
- (let ((start
- (string-find-next-char-in-set string char-set:not-space)))
- (if (not (and (pair? representation)
- (string=? (car representation) string)
- (eqv? (cdr representation) start)))
- (begin (set! representation (cons string start))
- (setup-redisplay-flags! redisplay-flags))))
- (let ((rep (make-vector y-size '()))
- (x-max (-1+ x-size)))
- (define (loop start y)
- (let ((s (string-allocate x-size))
- (end (+ start x-max)))
- (vector-set! rep y s)
- (cond ((<= column-size end)
+ (define (one-liner string)
+ (let ((start
+ (string-find-next-char-in-set string char-set:not-space)))
+ (if (not (and (pair? representation)
+ (string=? (car representation) string)
+ (eqv? (cdr representation) start)))
+ (begin
+ (set! representation (cons string start))
+ (setup-redisplay-flags! redisplay-flags)))))
+ (let* ((string (image-representation image))
+ (column-size (string-length string)))
+ (cond ((< column-size x-size)
+ (one-liner string))
+ (truncate-lines?
+ (one-liner
+ (let ((s (string-allocate x-size))
+ (x-max (-1+ x-size)))
+ (substring-move-right! string 0 x-max s 0)
+ (string-set! s x-max #\$)
+ s)))
+ (else
+ (let ((rep (make-vector y-size '()))
+ (x-max (-1+ x-size)))
+ (let loop ((start 0) (y 0))
+ (let ((s (string-allocate x-size))
+ (end (+ start x-max)))
+ (vector-set! rep y s)
+ (if (<= column-size end)
+ (begin
(substring-move-right! string start column-size s 0)
- (substring-fill! s (- column-size start) x-size
+ (substring-fill! s
+ (- column-size start)
+ x-size
#\space))
- (else
+ (begin
(substring-move-right! string start end s 0)
(string-set! s x-max #\\)
(loop end (1+ y))))))
- (loop 0 0)
- (set! representation rep)
- (setup-redisplay-flags! redisplay-flags)))))))\f
+ (set! representation rep)
+ (setup-redisplay-flags! redisplay-flags)))))))
+\f
;;;; Blank Window
(define-class blank-window vanilla-window
;;; -*-Scheme-*-
;;;
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/wincom.scm,v 1.93 1989/04/28 22:54:32 cph Rel $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/wincom.scm,v 1.94 1989/08/08 10:06:36 cph Exp $
;;;
;;; Copyright (c) 1987, 1989 Massachusetts Institute of Technology
;;;
"Pop-up windows would prefer to split the largest window if this large.
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."
(define (largest-window)
(let ((start (window0)))
- (define (loop window largest largest-area)
+ (let loop
+ ((window (window1+ start))
+ (largest start)
+ (largest-area (* (window-x-size start) (window-y-size start))))
(if (eq? window start)
largest
(let ((area (* (window-x-size window) (window-y-size window))))
(if (> area largest-area)
(loop (window1+ window) window area)
- (loop (window1+ window) largest largest-area)))))
- (loop (window1+ start)
- start
- (* (window-x-size start) (window-y-size start)))))
+ (loop (window1+ window) largest largest-area)))))))
(define (lru-window)
(let ((start (window0)))
(search-full-width (window1+ start) false false)))
(define (delete-other-windows start)
- (define (loop window)
+ (let loop ((window (window1+ start)))
(if (not (eq? window start))
- (begin (window-delete! window)
- (loop (window1+ window)))))
- (loop (window1+ start)))
\ No newline at end of file
+ (begin
+ (window-delete! window)
+ (loop (window1+ window))))))
\ No newline at end of file
projects / mit-scheme.git / commitdiff