Eliminate references to SELECT-BUFFER-IN-WINDOW.
authorChris Hanson <org/chris-hanson/cph>
Thu, 26 Oct 2000 04:19:14 +0000 (04:19 +0000)
committerChris Hanson <org/chris-hanson/cph>
Thu, 26 Oct 2000 04:19:14 +0000 (04:19 +0000)
v7/src/edwin/buffrm.scm
v7/src/edwin/bufmnu.scm
v7/src/edwin/debug.scm
v7/src/edwin/snr.scm
v7/src/edwin/vc.scm

index 7a388bc5b0701a610734b26d9138f48292d545f0..88fd63af6f49315576bfdb3bb7eb6ad981c6f1eb 100644 (file)
@@ -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))))
 \f
 (define-integrable (frame-text-inferior frame)
   (with-instance-variables buffer-frame frame ()
          (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)
index 3c23dc8c543a978a34164d2ae2bf03271180a389..2b5aeaaf5cd6b894af339e080bf47590b7a14615 100644 (file)
@@ -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)))
index fb02e1eaf81e1bf86c5ff4159f13ef98799c1025..b6988ad32af8faffb272a216ce4aedab00c6343f 100644 (file)
@@ -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)))))
index 3f5d319623ea5247c12db68f151687b14070c879..5dc10c5c423e83e3f20281ee67103d1f2e1950ff 100644 (file)
@@ -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)))))
 \f
 (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))))))
 \f
 ;;;; 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"))
 \f
 (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)))
index 146cbcb59081177f3f2b5a82f7aebbae0dd87614..6e9dc0c7ccc8a39894514a9777064c7e511c276e 100644 (file)
@@ -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))