From: Brian A. LaMacchia Date: Mon, 5 Aug 1991 16:40:11 +0000 (+0000) Subject: Initial revision X-Git-Tag: 20090517-FFI~10410 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=47576bd860ad1c69d1db1fdd705a1b810435a3f8;p=mit-scheme.git Initial revision --- diff --git a/v7/src/edwin/rmailsrt.scm b/v7/src/edwin/rmailsrt.scm new file mode 100644 index 000000000..3270ff834 --- /dev/null +++ b/v7/src/edwin/rmailsrt.scm @@ -0,0 +1,287 @@ +;;; -*-Scheme-*- +;;; +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/rmailsrt.scm,v 1.1 1991/08/05 16:40:11 bal Exp $ +;;; +;;; Copyright (c) 1991 Massachusetts Institute of Technology +;;; +;;; This material was developed by the Scheme project at the +;;; Massachusetts Institute of Technology, Department of +;;; Electrical Engineering and Computer Science. Permission to +;;; copy this software, to redistribute it, and to use it for any +;;; purpose is granted, subject to the following restrictions and +;;; understandings. +;;; +;;; 1. Any copy made of this software must include this copyright +;;; notice in full. +;;; +;;; 2. Users of this software agree to make their best efforts (a) +;;; to return to the MIT Scheme project any improvements or +;;; extensions that they make, so that these may be included in +;;; future releases; and (b) to inform MIT of noteworthy uses of +;;; this software. +;;; +;;; 3. All materials developed as a consequence of the use of this +;;; software shall duly acknowledge such use, in accordance with +;;; the usual standards of acknowledging credit in academic +;;; research. +;;; +;;; 4. MIT has made no warrantee or representation that the +;;; operation of this software will be error-free, and MIT is +;;; under no obligation to provide any services, by way of +;;; maintenance, update, or otherwise. +;;; +;;; 5. In conjunction with products arising from the use of this +;;; material, there shall be no use of the name of the +;;; Massachusetts Institute of Technology nor of any adaptation +;;; thereof in any advertising, promotional, or sales literature +;;; without prior written consent from MIT in each case. +;;; +;;; NOTE: Parts of this program (Edwin) were created by translation +;;; from corresponding parts of GNU Emacs. Users should be aware that +;;; the GNU GENERAL PUBLIC LICENSE may apply to these parts. A copy +;;; of that license should have been included along with this file. +;;; + +;;;; RMAIL Sorting Utilities + +(declare (usual-integrations)) + +;; GNUS compatible key bindings. +(define-key 'rmail (list #\C-c #\C-s #\C-d) 'rmail-sort-by-date) +(define-key 'rmail (list #\C-c #\C-s #\C-s) 'rmail-sort-by-subject) +(define-key 'rmail (list #\C-c #\C-s #\C-a) 'rmail-sort-by-author) +(define-key 'rmail (list #\C-c #\C-s #\C-r) 'rmail-sort-by-recipient) +(define-key 'rmail (list #\C-c #\C-s #\C-l) 'rmail-sort-by-size-lines) + +(define-command rmail-sort-by-date + "Sort messages of current Rmail file by date. +If prefix argument REVERSE is non-nil, sort them in reverse order." + "P" + (lambda (reverse) + (rmail-sort-messages + reverse + (lambda (memo) + (fetch-first-field "date" + (msg-memo/start memo) + (msg-memo/end memo))) + (lambda (x y) + (stringvector (reverse (vector->list sort-vect))))) + (sort! sort-vect + (lambda (x y) + (cmpfunc (car x) (car y)))) + (message "Reordering buffer...") + (set-buffer-writeable! (current-buffer)) + (kill-string + (msg-memo/start (msg-memo/first (current-msg-memo))) + (msg-memo/end (msg-memo/last (current-msg-memo)))) + (let loop ((n 0) + (previous false) + (the-memo (caddr (vector-ref sort-vect 0))) + (next (if (>= nummsg 2) + (caddr (vector-ref sort-vect 1)) + false))) + (set-msg-memo/previous! the-memo previous) + (set-msg-memo/next! the-memo next) + (if (< n nummsg) + (begin + (insert-string (cadr (vector-ref sort-vect n))) + (if (= 9 (modulo n 10)) + (message "reordering buffer..." (1+ n))) + (loop (1+ n) the-memo next + (if (< (1+ n) nummsg) + (caddr (vector-ref sort-vect (1+ n))) + false))) + (insert-string (cadr (vector-ref sort-vect n))))) + (set-buffer-read-only! (current-buffer)) + (set-buffer-msg-memo! (current-buffer) false) + (memoize-buffer (current-buffer)) + (show-message (current-buffer) current-msg-num)))) + +;; Copy of the function gnus-comparable-date in gnus.el + +(define rmail-sortable-date-string + (lambda (date) + (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3") + ("APR" . " 4")("MAY" . " 5")("JUN" . " 6") + ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9") + ("OCT" . "10")("NOV" . "11")("DEC" . "12"))) + (date (or date ""))) + ;; Can understand the following styles: + ;; (1) 14 Apr 89 03:20:12 GMT + ;; (2) Fri, 17 Mar 89 4:01:33 GMT + ;; + ;; added [ ]+ to the regexp to handle date string put out + ;; by hx.lcs.mit.edu (they use 2 spaces instead of 1) + (if (re-match-string-forward + (re-compile-pattern + ".*\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\)[ ]+\\([0-9:]+\\)" true) + true false date) + (string-append + ;; Year + (let ((year (string->number (substring date (re-match-start-index 3) (re-match-end-index 3))))) + (let ((y1 (modulo year 100))) + (string-pad-left (number->string y1) 2))) + ;; Month + (cdr + (assoc + (string-upcase (substring (substring date (re-match-start-index 2) (re-match-end-index 2)) 0 3)) month)) + ;; Day + (let ((day (substring date (re-match-start-index 1) (re-match-end-index 1)))) + (string-pad-left day 2)) + ;; Time + (substring date (re-match-start-index 4) (re-match-end-index 4))) + ;; Cannot understand DATE string. + date)))) + +(define mail-string-delete + (lambda (string start end) + (string-append + (string-head string start) + (string-tail string end)))) + +(define mail-strip-quoted-names + (lambda (address) + (let ((pos) + (address address)) + (if (re-match-string-forward (re-compile-pattern "\\`[ \t\n]*" true) + true false address) + (set! address (string-tail address (re-match-end-index 0)))) + ;; strip surrounding whitespace + (if (re-match-string-forward (re-compile-pattern "[ \t\n]*\\'" true) + true false address) + (set! address (string-head address (re-match-start-index 0)))) + (let loop () + (let ((the-pattern + (re-compile-pattern + "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)" true))) + (set! pos (re-match-string-forward the-pattern true false address)) + (if pos + (begin + (set! address (mail-string-address + address pos + (re-match-end-index 0))) + (loop))))) + ;; strip `quoted' names (This is supposed to hack `"Foo Bar" ') + (let loop ((the-pos 0)) + (let ((the-pattern + (re-compile-pattern + "[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*" + true))) + (set! pos (re-match-substring-forward the-pattern true false address + the-pos (string-length address))) + (if pos + (if (and (> (string-length address) (re-match-end-index 0)) + (char=? (string-ref address (re-match-end-index 0)) #\@)) + (loop pos) + (begin + (set! address + (mail-string-delete address + the-pos (re-match-end-index 0))) + (loop the-pos)))))) + ;; Retain only part of address in <> delims, if there is such a thing. + (let loop () + (let ((the-pattern + (re-compile-pattern + "\\(,\\|\\`\\)[^,]*<\\([^>,]*>\\)" + true))) + (set! pos (re-match-string-forward the-pattern true false address)) + (if pos + (let ((junk-beg (re-match-end-index 1)) + (junk-end (re-match-start-index 2)) + (close (re-match-end-index 0))) + (set! address (mail-string-delete address (-1+ close) close)) + (set! address (mail-string-delete address junk-beg junk-end)) + (loop))))) + address))) + + diff --git a/v7/src/edwin/rmailsum.scm b/v7/src/edwin/rmailsum.scm new file mode 100644 index 000000000..c3be4f86c --- /dev/null +++ b/v7/src/edwin/rmailsum.scm @@ -0,0 +1,455 @@ +;;; -*-Scheme-*- +;;; +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/rmailsum.scm,v 1.1 1991/08/05 16:39:45 bal Exp $ +;;; +;;; Copyright (c) 1991 Massachusetts Institute of Technology +;;; +;;; This material was developed by the Scheme project at the +;;; Massachusetts Institute of Technology, Department of +;;; Electrical Engineering and Computer Science. Permission to +;;; copy this software, to redistribute it, and to use it for any +;;; purpose is granted, subject to the following restrictions and +;;; understandings. +;;; +;;; 1. Any copy made of this software must include this copyright +;;; notice in full. +;;; +;;; 2. Users of this software agree to make their best efforts (a) +;;; to return to the MIT Scheme project any improvements or +;;; extensions that they make, so that these may be included in +;;; future releases; and (b) to inform MIT of noteworthy uses of +;;; this software. +;;; +;;; 3. All materials developed as a consequence of the use of this +;;; software shall duly acknowledge such use, in accordance with +;;; the usual standards of acknowledging credit in academic +;;; research. +;;; +;;; 4. MIT has made no warrantee or representation that the +;;; operation of this software will be error-free, and MIT is +;;; under no obligation to provide any services, by way of +;;; maintenance, update, or otherwise. +;;; +;;; 5. In conjunction with products arising from the use of this +;;; material, there shall be no use of the name of the +;;; Massachusetts Institute of Technology nor of any adaptation +;;; thereof in any advertising, promotional, or sales literature +;;; without prior written consent from MIT in each case. +;;; +;;; NOTE: Parts of this program (Edwin) were created by translation +;;; from corresponding parts of GNU Emacs. Users should be aware that +;;; the GNU GENERAL PUBLIC LICENSE may apply to these parts. A copy +;;; of that license should have been included along with this file. +;;; + +;;;; RMAIL Summary Mode + +(declare (usual-integrations)) + +(define rmail-summary-buffer false) + +(define-variable rmail-last-multi-labels + "" + "" + list-of-strings?) + +(define-command rmail-summary + "Display a summary of all messages, one line per message." + '() + (lambda () + (rmail-new-summary "All" false))) + +;;;(define rmail-summary-by-labels +;;; "Display a summary of all messages with one or more LABELS. +;;; LABELS should be a string containing the desired labels, separated by commas." +;;; "sLabels to summarize by: " +;;; (lambda (labels) +;;; (if (string=? labels "") +;;; (set! labels (or rmail-last-multi-labels +;;; (error "No label specified")))) +;;; (set! rmail-last-multi-labels labels) +;;; (rmail-new-summary (string-append "labels " labels) +;;; rmail-message-labels? +;;; (string-append ", \\(" (mail-comma-list-regexp labels) "\\),")))) +;;; +;;; (define rmail-summary-by-recipients +;;; "Display a summary of all messages with the given RECIPIENTS. +;;; Normally checks the To, From and Cc fields of headers; +;;; but if PRIMARY-ONLY is non-nil (prefix arg given), +;;; only look in the To and From fields. +;;; RECIPIENTS is a string of names separated by commas." +;;; (interactive "sRecipients to summarize by: \nP") +;;; (lambda (recipients primary-only) +;;; (rmail-new-summary +;;; (string-append "recipients " recipients) +;;; rmail-message-recipients? +;;; (mail-comma-list-regexp recipients) primary-only))) +;;; +;;; ***HERE*** +;;; (define (rmail-message-recipients? msg recipients primary-only) +;;; (let ((the-current-point (current-point))) +;;; (set +;;; (goto-char (rmail-msgbeg msg)) +;;; (search-forward "\n*** EOOH ***\n") +;;; (narrow-to-region (point) (progn (search-forward "\n\n") (point))) +;;; (or (string-match recipients (or (mail-fetch-field "To") "")) +;;; (string-match recipients (or (mail-fetch-field "From") "")) +;;; (if (not primary-only) +;;; (string-match recipients (or (mail-fetch-field "Cc") "")))))) + +(define rmail-new-summary + (lambda (description function . args) + (message "Computing summary lines...") + (if (not rmail-summary-buffer) + (set! rmail-summary-buffer + (temporary-buffer (string-append (buffer-name (current-buffer)) "-summary")))) + (let ((summary-msgs ()) + (new-summary-line-count 0)) + (let loop ((the-memo (msg-memo/first (current-msg-memo)))) + (let ((next-memo (msg-memo/next the-memo))) + (if (or (not function) + (apply function (cons the-memo args))) + (set! summary-msgs + (cons (rmail-make-summary-line the-memo) + summary-msgs))) + (if next-memo + (loop next-memo)))) + (select-buffer rmail-summary-buffer) + (set-buffer-writeable! (current-buffer)) + (set-current-point! (buffer-start (current-buffer))) + (kill-string (buffer-start (current-buffer)) + (buffer-end (current-buffer))) + (let loop ((the-summary-list (reverse summary-msgs))) + (if (not (null? the-summary-list)) + (begin + (insert-string (car the-summary-list)) + (loop (cdr the-summary-list))))) +;;; (subst-char-in-region 1 2 ?\( ?\ ) + (set-buffer-read-only! (current-buffer)) + (set-current-point! (buffer-start (current-buffer)))) +; (rmail-summary-mode) +; ((ref-command make-local-variable) 'minor-mode-alist) +; (set-variable! minor-mode-alist (list ": " description)) +; (rmail-summary-goto-msg mesg true) + (message "Computing summary lines...done"))) + +(define (rmail-make-summary-line memo) + (let ((new-summary-line-count 0)) + (let ((line (or (vector-ref rmail-summary-vector (-1+ (msg-memo/number memo))) + (begin + (set! new-summary-line-count + (1+ new-summary-line-count)) + (if (= 0 (modulo new-summary-line-count 10)) + (message "Computing summary lines..." + new-summary-line-count)) + (rmail-make-summary-line-1 memo) + (vector-ref rmail-summary-vector (-1+ (msg-memo/number memo))) + )))) + ;; Fix up the part of the summary that says "deleted" or "unseen". + (string-set! line 4 + (if (msg-memo/deleted? memo) #\D + (if (char=? #\0 (string-ref (extract-string (msg-memo/start memo) + (msg-memo/end memo)) + 2)) + #\- #\space))) + line))) + +(define (rmail-make-summary-line-1 memo) + (with-buffer-open + (current-buffer) + (lambda () + (let ((old-point (current-point)) + (start (msg-memo/start memo)) + (end (msg-memo/end memo))) + (let ((lim + (begin + (set-current-point! start) + ((ref-command next-line) 2) + (current-point))) + (pos) + (labels + (begin + (set-current-point! start) + (move-thing mark+ 3) + (if (and (search-forward ",," start end) + (line-end? (current-point))) + (let ((point (current-point))) + (string-append + "{" + (extract-string point (line-end point 0)) + "} ")) + ""))) + (line + (begin + (set-current-point! start) + ((ref-command next-line) 1) + (let ((point (current-point))) + (if (string-prefix? + "Summary-line: " + (extract-string point (line-end point 0))) + (begin + (string-tail (extract-string point + (begin + ((ref-command next-line) 1) + (current-point))) + 14)) + false))))) + ;; If we didn't get a valid status line from the message, + ;; make a new one and put it in the message. + (or line + (let ((inner-begin + (let ((foo (search-forward "\n*** EOOH ***\n" start end))) + (if foo + foo + (begin + ((ref-command next-line) 1) + (current-point)))))) + (set! line (rmail-make-basic-summary-line inner-begin)) + (insert-string (string-append "Summary-line: " line) + (line-start start 2)))) + (set! pos (string-find-next-char line #\#)) + (let ((num (msg-memo/number memo))) + (vector-set! rmail-summary-vector (-1+ num) + (string-append + (string-pad-left (number->string num) 4) + " " + (string-head line pos) + labels + (string-tail line (1+ pos)))))) + (set-current-point! old-point))))) + +(define (rmail-make-basic-summary-line the-begin) + (string-append + (let ((the-mark + (re-search-forward "^Date:" the-begin (group-end the-begin)))) + (if (not the-mark) + " " + (let ((the-end-of-line (line-end the-mark 0))) + (cond + ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)" the-mark the-end-of-line) + (string-append + (string-pad-left (extract-string (re-match-start 2) (re-match-end 2)) 2) + "-" + (extract-string (re-match-start 4) (re-match-end 4)))) + ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)" the-mark the-end-of-line) + (string-append + (string-pad-left (extract-string (re-match-start 4) (re-match-end 4)) 2) + "-" + (extract-string (re-match-start 2) (re-match-end 2)))) + (else + "??????"))))) + " " + (let ((the-mark + (re-search-forward "^From:[ \t]*" the-begin (group-end the-begin)))) + (if (not the-mark) + " " + (let* ((from + (mail-strip-quoted-names + (extract-string + the-mark + (skip-chars-backward " \t" (line-end the-mark 0))))) + (len (string-length from)) + (mch (string-find-next-char-in-set from (char-set #\@ #\%)))) + (substring + (string-append + (if (or (not mch) (<= len 25)) + (string-tail from (max 0 (- len 25))) + (let ((lo + (cond ((< (- mch 9) 0) 0) + ((< len (+ mch 16)) + (- len 25)) + (else + (- mch 9))))) + (substring from lo (min len (+ lo 25))))) + " ") + 0 25)))) + " #" + (let ((the-mark + (re-search-forward "^Subject:" the-begin (group-end the-begin)))) + (if the-mark + (let ((the-start (skip-chars-forward " \t" the-mark))) + (extract-string the-start (line-end the-start 0))) + (let ((the-start (re-search-forward "[\n][\n]+" the-begin (group-end the-begin)))) + (extract-string the-start (line-end the-start 0))))) + "\n")) + +(defun rmail-summary-next-all (&optional number) + (interactive "p") + (forward-line (if number number 1)) + (rmail-summary-goto-msg)) + +(defun rmail-summary-previous-all (&optional number) + (interactive "p") + (forward-line (- (if number number 1))) + (rmail-summary-goto-msg)) + +(defun rmail-summary-next-msg (&optional number) + (interactive "p") + (forward-line 0) + (and (> number 0) (forward-line 1)) + (let ((count (if (< number 0) (- number) number)) + (search (if (> number 0) 're-search-forward 're-search-backward)) + end) + (while (and (> count 0) (funcall search "^.....[^D]" nil t)) + (setq count (1- count))) + (rmail-summary-goto-msg))) + +(defun rmail-summary-previous-msg (&optional number) + (interactive "p") + (rmail-summary-next-msg (- (if number number 1)))) + +(defun rmail-summary-delete-forward () + (interactive) + (let (end) + (rmail-summary-goto-msg) + (pop-to-buffer rmail-buffer) + (rmail-delete-message) + (pop-to-buffer rmail-summary-buffer) + (let ((buffer-read-only nil)) + (skip-chars-forward " ") + (skip-chars-forward "[0-9]") + (delete-char 1) + (insert "D")) + (rmail-summary-next-msg 1))) + +(defun rmail-summary-undelete () + (interactive) + (let ((buffer-read-only nil)) + (end-of-line) + (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t) + (replace-match "\\1 ") + (rmail-summary-goto-msg) + (pop-to-buffer rmail-buffer) + (and (rmail-message-deleted-p rmail-current-message) + (rmail-undelete-previous-message)) + (pop-to-buffer rmail-summary-buffer)) + (t + (rmail-summary-goto-msg))))) + +;; Rmail Summary mode is suitable only for specially formatted data. +(put 'rmail-summary-mode 'mode-class 'special) + +(defun rmail-summary-mode () + "Major mode in effect in Rmail summary buffer. +A subset of the Rmail mode commands are supported in this mode. +As commands are issued in the summary buffer the corresponding +mail message is displayed in the rmail buffer. + +n Move to next undeleted message, or arg messages. +p Move to previous undeleted message, or arg messages. +C-n Move to next, or forward arg messages. +C-p Move to previous, or previous arg messages. +j Jump to the message at the cursor location. +d Delete the message at the cursor location and move to next message. +u Undelete this or previous deleted message. +q Quit Rmail. +x Exit and kill the summary window. +space Scroll message in other window forward. +delete Scroll message backward. + +Entering this mode calls value of hook variable rmail-summary-mode-hook." + (interactive) + (kill-all-local-variables) + (make-local-variable 'rmail-buffer) + (make-local-variable 'rmail-total-messages) + (setq major-mode 'rmail-summary-mode) + (setq mode-name "RMAIL Summary") + (use-local-map rmail-summary-mode-map) + (setq truncate-lines t) + (setq buffer-read-only t) + (set-syntax-table text-mode-syntax-table) + (run-hooks 'rmail-summary-mode-hook)) + +(defun rmail-summary-goto-msg (&optional n nowarn) + (interactive "P") + (if (consp n) (setq n (prefix-numeric-value n))) + (if (eobp) (forward-line -1)) + (beginning-of-line) + (let ((buf rmail-buffer) + (cur (point)) + (curmsg (string-to-int + (buffer-substring (point) + (min (point-max) (+ 5 (point))))))) + (if (not n) + (setq n curmsg) + (if (< n 1) + (progn (message "No preceding message") + (setq n 1))) + (if (> n rmail-total-messages) + (progn (message "No following message") + (goto-char (point-max)) + (rmail-summary-goto-msg))) + (goto-char (point-min)) + (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t)) + (progn (or nowarn (message "Message %d not found" n)) + (setq n curmsg) + (goto-char cur)))) + (beginning-of-line) + (skip-chars-forward " ") + (skip-chars-forward "0-9") + (save-excursion (if (= (following-char) ?-) + (let ((buffer-read-only nil)) + (delete-char 1) + (insert " ")))) + (beginning-of-line) + (pop-to-buffer buf) + (rmail-show-message n) + (pop-to-buffer rmail-summary-buffer))) + +(defvar rmail-summary-mode-map nil) + +(if rmail-summary-mode-map + nil + (setq rmail-summary-mode-map (make-keymap)) + (suppress-keymap rmail-summary-mode-map) + (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg) + (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg) + (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg) + (define-key rmail-summary-mode-map "\C-n" 'rmail-summary-next-all) + (define-key rmail-summary-mode-map "\C-p" 'rmail-summary-previous-all) + (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up) + (define-key rmail-summary-mode-map "q" 'rmail-summary-quit) + (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete) + (define-key rmail-summary-mode-map "x" 'rmail-summary-exit) + (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down) + (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward)) + +(defun rmail-summary-scroll-msg-up (&optional dist) + "Scroll other window forward." + (interactive "P") + (let ((window (selected-window)) + (new-window (display-buffer rmail-buffer))) + (unwind-protect + (progn + (select-window new-window) + (scroll-up dist)) + (select-window window)))) + +(defun rmail-summary-scroll-msg-down (&optional dist) + "Scroll other window backward." + (interactive "P") + (let ((window (selected-window)) + (new-window (display-buffer rmail-buffer))) + (unwind-protect + (progn + (select-window new-window) + (scroll-down dist)) + (select-window window)))) + +(defun rmail-summary-quit () + "Quit out of rmail and rmail summary." + (interactive) + (rmail-summary-exit) + (rmail-quit)) + +(defun rmail-summary-exit () + "Exit rmail summary, remaining within rmail." + (interactive) + (bury-buffer (current-buffer)) + (if (get-buffer-window rmail-buffer) + ;; Select the window with rmail in it, then delete this window. + (select-window (prog1 + (get-buffer-window rmail-buffer) + (delete-window (selected-window)))) + ;; Switch to the rmail buffer in this window. + (switch-to-buffer rmail-buffer)))