From a49d171c434f24b6aa14fe6d0b41be6bf3c34014 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 26 Oct 2000 04:19:14 +0000 Subject: [PATCH] Eliminate references to SELECT-BUFFER-IN-WINDOW. --- v7/src/edwin/buffrm.scm | 48 +++++++++++++++--------------- v7/src/edwin/bufmnu.scm | 4 +-- v7/src/edwin/debug.scm | 4 +-- v7/src/edwin/snr.scm | 65 ++++++++++++++++++++--------------------- v7/src/edwin/vc.scm | 4 +-- 5 files changed, 62 insertions(+), 63 deletions(-) diff --git a/v7/src/edwin/buffrm.scm b/v7/src/edwin/buffrm.scm index 7a388bc5b..88fd63af6 100644 --- a/v7/src/edwin/buffrm.scm +++ b/v7/src/edwin/buffrm.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: buffrm.scm,v 1.57 2000/01/16 13:23:42 cph Exp $ +;;; $Id: buffrm.scm,v 1.58 2000/10/26 04:18:59 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology ;;; @@ -87,7 +87,7 @@ (set! inferiors (append! (delq! modeline-inferior inferiors) (list modeline-inferior)))) - (set! modeline-inferior false)))) + (set! modeline-inferior #f)))) (define-integrable (frame-text-inferior frame) (with-instance-variables buffer-frame frame () @@ -120,7 +120,7 @@ (set! x (- x (inferior-x-size border-inferior))) (set-inferior-start! border-inferior x 0) (set-inferior-y-size! border-inferior y)) - (set-inferior-start! border-inferior false false)) + (set-inferior-start! border-inferior #f #f)) (set-inferior-start! text-inferior 0 0) (set-inferior-size! text-inferior x y))) @@ -292,12 +292,12 @@ 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 + #f boolean?) (define-variable truncate-partial-width-windows "True means truncate lines in all windows less than full screen wide." - true + #t boolean?) (define-variable-per-buffer tab-width @@ -347,24 +347,24 @@ Automatically becomes local when set in any fashion." ;;;; Window Configurations (define-structure (window-configuration (conc-name window-configuration/)) - (screen-x-size false read-only true) - (screen-y-size false read-only true) - (root-window false read-only true) - (root-x-size false read-only true) - (root-y-size false read-only true) - (selected-window false read-only true) - (cursor-window false read-only true) - (minibuffer-scroll-window false read-only true)) + (screen-x-size #f read-only #t) + (screen-y-size #f read-only #t) + (root-window #f read-only #t) + (root-x-size #f read-only #t) + (root-y-size #f read-only #t) + (selected-window #f read-only #t) + (cursor-window #f read-only #t) + (minibuffer-scroll-window #f read-only #t)) (define-structure (saved-combination (conc-name saved-combination/)) - (vertical? false read-only true) - (children false read-only true)) + (vertical? #f read-only #t) + (children #f read-only #t)) (define-structure (saved-window (conc-name saved-window/)) - (buffer false read-only true) - (point false read-only true) - (mark false read-only true) - (start-mark false read-only true)) + (buffer #f read-only #t) + (point #f read-only #t) + (mark #f read-only #t) + (start-mark #f read-only #t)) (define (guarantee-window-configuration object procedure) (if (not (window-configuration? object)) @@ -396,7 +396,7 @@ Automatically becomes local when set in any fashion." (mark-left-inserting-copy (window-point window)) (let ((ring (buffer-mark-ring buffer))) (if (ring-empty? ring) - false + #f (mark-right-inserting-copy (ring-ref ring 0)))) (mark-right-inserting-copy @@ -465,20 +465,20 @@ Automatically becomes local when set in any fashion." (begin (%set-buffer-point! buffer (saved-window/point saved-window)) - (select-buffer-in-window buffer window false) + (select-buffer-no-record buffer window) (let ((mark (saved-window/mark saved-window))) (if mark (push-buffer-mark! buffer mark))) (set-window-start-mark! window (saved-window/start-mark saved-window) - true)) + #t)) (set! need-buffers (cons window need-buffers))) (set! converted-windows (cons (cons saved-window window) converted-windows))))) (for-each (lambda (window) - (let ((buffer (other-buffer false))) + (let ((buffer (other-buffer #f))) (if buffer - (select-buffer-in-window buffer window false)))) + (select-buffer-no-record buffer window)))) need-buffers) (let ((convert-window (lambda (saved-window) diff --git a/v7/src/edwin/bufmnu.scm b/v7/src/edwin/bufmnu.scm index 3c23dc8c5..2b5aeaaf5 100644 --- a/v7/src/edwin/bufmnu.scm +++ b/v7/src/edwin/bufmnu.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: bufmnu.scm,v 1.130 2000/07/28 15:15:30 cph Exp $ +;;; $Id: bufmnu.scm,v 1.131 2000/10/26 04:19:02 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology ;;; @@ -207,7 +207,7 @@ You can mark buffers with the \\[buffer-menu-mark] command." (let ((new (window-split-vertically! window height))) (if new (begin - (select-buffer-in-window (car buffers) new #t) + (select-buffer (car buffers) new) (loop new (cdr buffers)))))) (loop window others)))))) (clear-message))) diff --git a/v7/src/edwin/debug.scm b/v7/src/edwin/debug.scm index fb02e1eaf..b6988ad32 100644 --- a/v7/src/edwin/debug.scm +++ b/v7/src/edwin/debug.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: debug.scm,v 1.51 2000/07/28 15:15:31 cph Exp $ +;;; $Id: debug.scm,v 1.52 2000/10/26 04:19:05 cph Exp $ ;;; ;;; Copyright (c) 1992-2000 Massachusetts Institute of Technology ;;; @@ -983,7 +983,7 @@ The buffer below describes the current subproblem or reduction. (let ((screen (make-debug-screen buffer))) (if screen (let ((window (screen-window0 screen))) - (select-buffer-in-window buffer window #t) + (select-buffer buffer window) (select-window window)) (select-buffer buffer)))) ((ref-command browser-select-line))))) diff --git a/v7/src/edwin/snr.scm b/v7/src/edwin/snr.scm index 3f5d31962..5dc10c5c4 100644 --- a/v7/src/edwin/snr.scm +++ b/v7/src/edwin/snr.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: snr.scm,v 1.58 2000/06/12 01:38:17 cph Exp $ +;;; $Id: snr.scm,v 1.59 2000/10/26 04:19:09 cph Exp $ ;;; ;;; Copyright (c) 1995-2000 Massachusetts Institute of Technology ;;; @@ -318,7 +318,7 @@ Only one News reader may be open per server; if a previous News reader "Kill the current buffer." () (lambda () - (let ((buffer (current-buffer))) + (let ((buffer (selected-buffer))) (let ((parent (buffer-tree:parent buffer #f))) (kill-buffer buffer) (if parent (select-buffer parent)))))) @@ -333,7 +333,7 @@ Only one News reader may be open per server; if a previous News reader "Toggle between online and offline states." () (lambda () - (let ((connection (buffer-nntp-connection (current-buffer)))) + (let ((connection (buffer-nntp-connection (selected-buffer)))) (if (nntp-connection:closed? connection) (nntp-connection:reopen connection) (nntp-connection:close connection))))) @@ -424,7 +424,7 @@ Only one News reader may be open per server; if a previous News reader (news-server-buffer buffer error?))))) (define (current-news-server-buffer error?) - (news-server-buffer (current-buffer) error?)) + (news-server-buffer (selected-buffer) error?)) (define (news-server-buffer:connection buffer) (let ((connection (buffer-get buffer 'NNTP-CONNECTION #f))) @@ -762,7 +762,7 @@ With negative argument -N, show the N oldest unread articles." (let ((buffer (or (find-news-group-buffer buffer group) (make-news-group-buffer buffer group argument))) - (key (news-groups-buffer:key (current-buffer)))) + (key (news-groups-buffer:key (selected-buffer)))) (if (and key (not (buffer-get buffer 'SELECTED-FROM #f))) (buffer-put! buffer 'SELECTED-FROM key)) (select-buffer buffer)) @@ -799,7 +799,7 @@ With prefix argument, updates the next several News groups." This command has no effect in the all-groups buffer." () (lambda () - (let ((buffer (current-buffer))) + (let ((buffer (selected-buffer))) (if (news-server-buffer? buffer) (begin (for-each-vector-element (news-server-buffer:groups buffer) @@ -1144,7 +1144,7 @@ This shows News groups that have been created since the last time that (let ((group (news-group-buffer:group buffer))) (update-news-groups-buffers buffer group) (write-ignored-subjects-file group buffer) - (if (and (current-buffer? buffer) + (if (and (selected-buffer? buffer) (eq? (buffer-get buffer 'SELECTED-FROM #f) 'SERVER)) (let ((buffer (news-server-buffer buffer #t))) (if (eq? group (region-get (buffer-point buffer) 'NEWS-GROUP #f)) @@ -1542,7 +1542,7 @@ This shows News groups that have been created since the last time that (buffer-tree:parent (window-buffer article-window) #t))) (buffer-put! group-buffer 'CONTEXT-WINDOW (weak-cons context-window #f)) - (select-buffer-in-window group-buffer context-window #t) + (select-buffer group-buffer context-window) (center-news-article-context context-window))))) (define (news-group-buffer:delete-context-window group-buffer window) @@ -1714,7 +1714,7 @@ This mode's commands include: With prefix argument, moves down several headers." "p" (lambda (n) - (let ((b (current-buffer)) + (let ((b (selected-buffer)) (m (current-point))) (define (next-loop h n) (if (= n 0) @@ -1790,7 +1790,7 @@ With prefix argument, moves up several articles." With prefix argument, moves down several threads." "p" (lambda (n) - (let ((b (current-buffer)) + (let ((b (selected-buffer)) (m (current-point))) (define (next-loop t n) (if (= n 0) @@ -1900,7 +1900,7 @@ With prefix argument, unmarks the previous several articles." (mark/unmark-news-header-line buffer header 'UNSEEN)) (define (header-iteration argument procedure) - (defer-marking-updates (current-buffer) + (defer-marking-updates (selected-buffer) (lambda () (iterate-on-lines (lambda (mark) (region-get mark 'NEWS-HEADER #f)) @@ -1948,7 +1948,7 @@ With prefix argument, unmarks the previous several articles." Subsequent reading of the message bodies can be done offline." () (lambda () - (let* ((buffer (current-buffer)) + (let* ((buffer (selected-buffer)) (headers (cond ((news-group-buffer? buffer) (news-group:marked-headers @@ -2027,7 +2027,7 @@ This unmarks the article indicated by point and any other articles in (mark/unmark-news-thread-lines buffer thread 'UNSEEN))))) (define (thread-iteration argument procedure) - (defer-marking-updates (current-buffer) + (defer-marking-updates (selected-buffer) (lambda () (iterate-on-lines (lambda (mark) (region-get mark 'NEWS-HEADER #f)) "news-article header" #f argument @@ -2085,7 +2085,7 @@ This unmarks the article indicated by point and any other articles in () (lambda () (select-buffer - (let ((buffer (current-buffer))) + (let ((buffer (selected-buffer))) (cond ((news-article-buffer? buffer) buffer) ((news-group-buffer? buffer) @@ -2102,7 +2102,7 @@ This unmarks the article indicated by point and any other articles in "Expand or collapse the current thread." () (lambda () - (let ((buffer (current-buffer)) + (let ((buffer (selected-buffer)) (thread (news-header:thread (current-news-header)))) (if (news-thread:expanded? thread) (news-group-buffer:collapse-thread buffer thread) @@ -2113,7 +2113,7 @@ This unmarks the article indicated by point and any other articles in "Collapse all of the threads in this News group." () (lambda () - (let ((buffer (current-buffer)) + (let ((buffer (selected-buffer)) (header (region-get (current-point) 'NEWS-HEADER #f))) (for-each-vector-element (news-group-buffer:threads buffer) (lambda (thread) @@ -2129,7 +2129,7 @@ This unmarks the article indicated by point and any other articles in "Expand all of the threads in this News group." () (lambda () - (let ((buffer (current-buffer)) + (let ((buffer (selected-buffer)) (header (region-get (current-point) 'NEWS-HEADER #f))) (for-each-vector-element (news-group-buffer:threads buffer) (lambda (thread) @@ -2146,7 +2146,7 @@ With positive argument N, show only N newest unread articles. With negative argument -N, show only N oldest unread articles." "P" (lambda (argument) - (let ((buffer (current-buffer))) + (let ((buffer (selected-buffer))) (with-buffer-open-1 buffer (lambda () (region-delete! (buffer-region buffer)) @@ -2164,7 +2164,7 @@ This command has no effect if the variable news-group-show-seen-headers is true." () (lambda () - (let ((buffer (current-buffer)) + (let ((buffer (selected-buffer)) (on-header? (region-get (current-point) 'NEWS-HEADER #f))) (if (not (ref-variable news-group-show-seen-headers buffer)) (let ((threads (vector->list (news-group-buffer:threads buffer)))) @@ -2216,7 +2216,7 @@ This kills the current buffer." (lambda () (if (prompt-for-confirmation? "Delete all articles not marked as read") (begin - (let ((buffer (current-buffer))) + (let ((buffer (selected-buffer))) (for-each-vector-element (news-group-buffer:threads buffer) (lambda (thread) (news-thread:for-each-real-header thread @@ -2547,7 +2547,7 @@ Kill the current buffer in either case." (action buffer (news-header:thread header)))))) (define (news-article-header-action-command select-next action) - (let ((buffer (current-buffer))) + (let ((buffer (selected-buffer))) (let ((group-buffer (buffer-tree:parent buffer #t)) (header (news-article-buffer:header buffer))) (if action (action group-buffer header)) @@ -2576,7 +2576,7 @@ Normally, the header lines specified in the variable rmail-ignored-headers are not shown; this command shows them, or hides them if they are shown." () (lambda () - (let ((buffer (current-buffer))) + (let ((buffer (selected-buffer))) (with-buffer-open-1 buffer (lambda () (let ((header (news-article-buffer:header buffer))) @@ -2617,8 +2617,7 @@ This is a small window showing a few lines around the subject line of the context-lines)) ((not (eq? group-buffer (window-buffer context-window))) - (select-buffer-in-window group-buffer context-window - #f) + (select-buffer group-buffer context-window) (set-height)) (argument (set-height)) @@ -2708,7 +2707,7 @@ While composing the reply, use \\[mail-yank-original] to yank the () (lambda () (guarantee-rmail-variables-initialized) - (let ((article-buffer (current-buffer))) + (let ((article-buffer (selected-buffer))) (if (and (not (news-article-buffer:followup-to-poster? article-buffer)) (prompt-for-confirmation? "Post a follow-up article")) (make-news-reply-buffer @@ -2741,7 +2740,7 @@ While composing the reply, use \\[mail-yank-original] to yank the "Forward the current News article to another user by email." () (lambda () - (let ((article-buffer (current-buffer))) + (let ((article-buffer (selected-buffer))) (make-mail-buffer (let ((header (news-article-buffer:header article-buffer))) `(("To" "") @@ -2762,7 +2761,7 @@ While composing the reply, use \\[mail-yank-original] to yank the select-buffer-other-window)) (insert-region (buffer-start article-buffer) (buffer-end article-buffer) - (buffer-end (current-buffer)))))) + (buffer-end (selected-buffer)))))) ;;;; Posting @@ -2787,8 +2786,8 @@ Once editing the article, type \\[describe-mode] to get a list of commands." (news-server-buffer:server buffer)))) (group (or (region-get (current-point) 'NEWS-GROUP #f) - (buffer-get (current-buffer) 'NEWS-GROUP #f) - (let ((header (buffer-get (current-buffer) 'NEWS-header #f))) + (buffer-get (selected-buffer) 'NEWS-GROUP #f) + (let ((header (buffer-get (selected-buffer) 'NEWS-header #f))) (and header (news-header:group header)))))) (let ((buffer @@ -2817,7 +2816,7 @@ While composing the follow-up, use \\[mail-yank-original] to yank the () (lambda () (guarantee-rmail-variables-initialized) - (let ((article-buffer (current-buffer))) + (let ((article-buffer (selected-buffer))) (if (news-article-buffer:followup-to-poster? article-buffer) (make-mail-buffer (news-article-buffer:rfc822-reply-headers article-buffer) @@ -2906,7 +2905,7 @@ C-c C-q mail-fill-yanked-message (fill what was yanked)." (define-key 'compose-news '(#\c-c #\c-f #\c-n) 'news-move-to-newsgroups) (define ((field-mover field)) - (set-current-point! (mail-position-on-field (current-buffer) field))) + (set-current-point! (mail-position-on-field (selected-buffer) field))) (define-command news-move-to-newsgroups "Move point to end of Newsgroups: field." @@ -2934,7 +2933,7 @@ C-c C-q mail-fill-yanked-message (fill what was yanked)." (field-mover "Summary")) (define (news-post-it) - (let ((article-buffer (current-buffer))) + (let ((article-buffer (selected-buffer))) (let ((temp-buffer (prepare-mail-buffer-for-sending article-buffer @@ -3485,7 +3484,7 @@ With prefix arg, replaces the file with the list information." (start-property-iteration get-item adjective predicate argument)) (lambda (item n) (cond (item - (let ((buffer (current-buffer))) + (let ((buffer (selected-buffer))) (cond ((> n 0) (let loop ((item (first-item item)) (n n)) (let ((next (next-item buffer item))) diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm index 146cbcb59..6e9dc0c7c 100644 --- a/v7/src/edwin/vc.scm +++ b/v7/src/edwin/vc.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: vc.scm,v 1.73 2000/10/01 01:29:46 cph Exp $ +;;; $Id: vc.scm,v 1.74 2000/10/26 04:19:14 cph Exp $ ;;; ;;; Copyright (c) 1994-2000 Massachusetts Institute of Technology ;;; @@ -1086,7 +1086,7 @@ There is a special command, `*l', to mark all files currently locked. (select-window window)) (if (and buffer (buffer-alive? buffer)) (if (and window (window-live? window)) - (select-buffer-in-window buffer window #f) + (select-buffer-no-record buffer window) (select-buffer buffer)))) ;; Do the log operation. (finish-entry comment)) -- 2.25.1