;;; -*-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
;;;
(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)))
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
;;;; 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))
(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
(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)
;;; -*-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
;;;
"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))))))
"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)))))
(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)))
(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))
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)
(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))
(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)
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)
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)
(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))
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
(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
()
(lambda ()
(select-buffer
- (let ((buffer (current-buffer)))
+ (let ((buffer (selected-buffer)))
(cond ((news-article-buffer? buffer)
buffer)
((news-group-buffer? buffer)
"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)
"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)
"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)
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))
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))))
(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
(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))
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)))
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))
()
(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
"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" "")
select-buffer-other-window))
(insert-region (buffer-start article-buffer)
(buffer-end article-buffer)
- (buffer-end (current-buffer))))))
+ (buffer-end (selected-buffer))))))
\f
;;;; Posting
(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
()
(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)
(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."
(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
(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)))