Switch to recommended form of GPLv3 permissions notice.
[bpt/emacs.git] / lisp / mail / rmailsum.el
CommitLineData
76550a57 1;;; rmailsum.el --- make summary buffers for the mail reader
aae56ea7 2
e84b4b86 3;; Copyright (C) 1985, 1993, 1994, 1995, 1996, 2000, 2001, 2002, 2003,
2f043267 4;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
9750e079 5
e5167999 6;; Maintainer: FSF
d7b4d18f 7;; Keywords: mail
e5167999 8
4d4d11cc
JB
9;; This file is part of GNU Emacs.
10
b1fc2b50 11;; GNU Emacs is free software: you can redistribute it and/or modify
4d4d11cc 12;; it under the terms of the GNU General Public License as published by
b1fc2b50
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
4d4d11cc
JB
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
b1fc2b50 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
4d4d11cc 23
aae56ea7
ER
24;;; Commentary:
25
d41d75fb
RS
26;; Extended by Bob Weiner of Motorola
27;; Provided all commands from rmail-mode in rmail-summary-mode and made key
28;; bindings in both modes wholly compatible.
29
aae56ea7
ER
30;;; Code:
31
6b9e6358
JB
32(defvar msgnum)
33
6e626f7e
RS
34;; For rmail-select-summary
35(require 'rmail)
36
be2e861f 37;;;###autoload
0a01a04e
RS
38(defcustom rmail-summary-scroll-between-messages t
39 "*Non-nil means Rmail summary scroll commands move between messages."
40 :type 'boolean
41 :group 'rmail-summary)
be2e861f 42
ea7bddc4 43;;;###autoload
0a01a04e 44(defcustom rmail-summary-line-count-flag t
689421a9 45 "*Non-nil means Rmail summary should show the number of lines in each message."
0a01a04e
RS
46 :type 'boolean
47 :group 'rmail-summary)
ea7bddc4 48
1a6bc985 49(defvar rmail-summary-font-lock-keywords
70d2f115
EZ
50 '(("^.....D.*" . font-lock-string-face) ; Deleted.
51 ("^.....-.*" . font-lock-type-face) ; Unread.
1a6bc985 52 ;; Neither of the below will be highlighted if either of the above are:
70d2f115 53 ("^.....[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date.
d8562b03 54 ("{ \\([^\n}]+\\) }" 1 font-lock-comment-face)) ; Labels.
1a6bc985
RS
55 "Additional expressions to highlight in Rmail Summary mode.")
56
25774ab4
RS
57(defvar rmail-summary-redo
58 "(FUNCTION . ARGS) to regenerate this Rmail summary buffer.")
59
60(defvar rmail-summary-overlay nil)
61(put 'rmail-summary-overlay 'permanent-local t)
62
63(defvar rmail-summary-mode-map nil)
64
d41d75fb 65;; Entry points for making a summary buffer.
4d4d11cc 66
d41d75fb
RS
67;; Regenerate the contents of the summary
68;; using the same selection criterion as last time.
69;; M-x revert-buffer in a summary buffer calls this function.
70(defun rmail-update-summary (&rest ignore)
71 (apply (car rmail-summary-redo) (cdr rmail-summary-redo)))
4d4d11cc 72
d2288651 73;;;###autoload
4d4d11cc
JB
74(defun rmail-summary ()
75 "Display a summary of all messages, one line per message."
76 (interactive)
d41d75fb 77 (rmail-new-summary "All" '(rmail-summary) nil))
4d4d11cc 78
d2288651 79;;;###autoload
4d4d11cc
JB
80(defun rmail-summary-by-labels (labels)
81 "Display a summary of all messages with one or more LABELS.
82LABELS should be a string containing the desired labels, separated by commas."
83 (interactive "sLabels to summarize by: ")
84 (if (string= labels "")
85 (setq labels (or rmail-last-multi-labels
86 (error "No label specified"))))
87 (setq rmail-last-multi-labels labels)
88 (rmail-new-summary (concat "labels " labels)
d41d75fb 89 (list 'rmail-summary-by-labels labels)
4d4d11cc
JB
90 'rmail-message-labels-p
91 (concat ", \\(" (mail-comma-list-regexp labels) "\\),")))
92
d2288651 93;;;###autoload
4d4d11cc
JB
94(defun rmail-summary-by-recipients (recipients &optional primary-only)
95 "Display a summary of all messages with the given RECIPIENTS.
96Normally checks the To, From and Cc fields of headers;
97but if PRIMARY-ONLY is non-nil (prefix arg given),
98 only look in the To and From fields.
d41d75fb 99RECIPIENTS is a string of regexps separated by commas."
4d4d11cc
JB
100 (interactive "sRecipients to summarize by: \nP")
101 (rmail-new-summary
102 (concat "recipients " recipients)
d41d75fb 103 (list 'rmail-summary-by-recipients recipients primary-only)
4d4d11cc
JB
104 'rmail-message-recipients-p
105 (mail-comma-list-regexp recipients) primary-only))
106
d2288651 107;;;###autoload
4d4d11cc
JB
108(defun rmail-summary-by-regexp (regexp)
109 "Display a summary of all messages according to regexp REGEXP.
110If the regular expression is found in the header of the message
111\(including in the date and other lines, as well as the subject line),
112Emacs will list the header line in the RMAIL-summary."
113 (interactive "sRegexp to summarize by: ")
114 (if (string= regexp "")
115 (setq regexp (or rmail-last-regexp
55535639 116 (error "No regexp specified"))))
4d4d11cc
JB
117 (setq rmail-last-regexp regexp)
118 (rmail-new-summary (concat "regexp " regexp)
d41d75fb 119 (list 'rmail-summary-by-regexp regexp)
4d4d11cc
JB
120 'rmail-message-regexp-p
121 regexp))
122
d41d75fb
RS
123;; rmail-summary-by-topic
124;; 1989 R.A. Schnitzler
125
d2288651 126;;;###autoload
d41d75fb
RS
127(defun rmail-summary-by-topic (subject &optional whole-message)
128 "Display a summary of all messages with the given SUBJECT.
129Normally checks the Subject field of headers;
a1506d29 130but if WHOLE-MESSAGE is non-nil (prefix arg given),
d41d75fb
RS
131 look in the whole message.
132SUBJECT is a string of regexps separated by commas."
7d897818
AS
133 (interactive
134 (let* ((subject (with-current-buffer rmail-buffer
135 (rmail-current-subject)))
136 (subject-re (with-current-buffer rmail-buffer
137 (rmail-current-subject-regexp)))
138 (prompt (concat "Topics to summarize by (regexp"
139 (if subject ", default current subject" "")
140 "): ")))
141 (list (read-string prompt nil nil subject) current-prefix-arg)))
d41d75fb
RS
142 (rmail-new-summary
143 (concat "about " subject)
144 (list 'rmail-summary-by-topic subject whole-message)
145 'rmail-message-subject-p
146 (mail-comma-list-regexp subject) whole-message))
147
148(defun rmail-message-subject-p (msg subject &optional whole-message)
149 (save-restriction
150 (goto-char (rmail-msgbeg msg))
10a0a250 151 (search-forward "\n*** EOOH ***\n" (rmail-msgend msg) 'move)
d41d75fb
RS
152 (narrow-to-region
153 (point)
e90b6d92 154 (progn (search-forward (if whole-message "\^_" "\n\n")) (point)))
d41d75fb
RS
155 (goto-char (point-min))
156 (if whole-message (re-search-forward subject nil t)
4c1832e9
GM
157 (string-match subject (let ((subj (mail-fetch-field "Subject")))
158 (if subj
159 (funcall rmail-summary-line-decoder subj)
160 ""))))))
cad1e93b 161
d2288651 162;;;###autoload
cad1e93b
RS
163(defun rmail-summary-by-senders (senders)
164 "Display a summary of all messages with the given SENDERS.
165SENDERS is a string of names separated by commas."
166 (interactive "sSenders to summarize by: ")
167 (rmail-new-summary
168 (concat "senders " senders)
84fa8eb5 169 (list 'rmail-summary-by-senders senders)
cad1e93b
RS
170 'rmail-message-senders-p
171 (mail-comma-list-regexp senders)))
172
173(defun rmail-message-senders-p (msg senders)
174 (save-restriction
175 (goto-char (rmail-msgbeg msg))
176 (search-forward "\n*** EOOH ***\n")
177 (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
178 (string-match senders (or (mail-fetch-field "From") ""))))
4d4d11cc 179\f
d41d75fb
RS
180;; General making of a summary buffer.
181
182(defvar rmail-summary-symbol-number 0)
183
25774ab4
RS
184(defvar rmail-new-summary-line-count)
185
d41d75fb 186(defun rmail-new-summary (description redo-form function &rest args)
4d4d11cc
JB
187 "Create a summary of selected messages.
188DESCRIPTION makes part of the mode line of the summary buffer.
189For each message, FUNCTION is applied to the message number and ARGS...
190and if the result is non-nil, that message is included.
191nil for FUNCTION means all messages."
192 (message "Computing summary lines...")
d41d75fb
RS
193 (let (sumbuf mesg was-in-summary)
194 (save-excursion
195 ;; Go to the Rmail buffer.
196 (if (eq major-mode 'rmail-summary-mode)
67f2e119
GM
197 (setq was-in-summary t))
198 (set-buffer rmail-buffer)
d41d75fb 199 ;; Find its summary buffer, or make one.
deb5848d
RS
200 (setq sumbuf
201 (if (and rmail-summary-buffer
202 (buffer-name rmail-summary-buffer))
203 rmail-summary-buffer
204 (generate-new-buffer (concat (buffer-name) "-summary"))))
d41d75fb 205 (setq mesg rmail-current-message)
d41d75fb
RS
206 ;; Filter the messages; make or get their summary lines.
207 (let ((summary-msgs ())
25774ab4 208 (rmail-new-summary-line-count 0))
d41d75fb 209 (let ((msgnum 1)
36f41915
KH
210 (buffer-read-only nil)
211 (old-min (point-min-marker))
212 (old-max (point-max-marker)))
213 ;; Can't use save-restriction here; that doesn't work if we
214 ;; plan to modify text outside the original restriction.
215 (save-excursion
216 (widen)
217 (goto-char (point-min))
218 (while (>= rmail-total-messages msgnum)
219 (if (or (null function)
220 (apply function (cons msgnum args)))
221 (setq summary-msgs
222 (cons (cons msgnum (rmail-make-summary-line msgnum))
223 summary-msgs)))
224 (setq msgnum (1+ msgnum)))
225 (setq summary-msgs (nreverse summary-msgs)))
226 (narrow-to-region old-min old-max))
deb5848d
RS
227 ;; Temporarily, while summary buffer is unfinished,
228 ;; we "don't have" a summary.
229 (setq rmail-summary-buffer nil)
67f2e119
GM
230 (if rmail-enable-mime
231 (with-current-buffer rmail-view-buffer
232 (setq rmail-summary-buffer nil)))
deb5848d
RS
233 (save-excursion
234 (let ((rbuf (current-buffer))
db56d71e 235 (vbuf rmail-view-buffer)
deb5848d
RS
236 (total rmail-total-messages))
237 (set-buffer sumbuf)
238 ;; Set up the summary buffer's contents.
239 (let ((buffer-read-only nil))
240 (erase-buffer)
241 (while summary-msgs
242 (princ (cdr (car summary-msgs)) sumbuf)
243 (setq summary-msgs (cdr summary-msgs)))
244 (goto-char (point-min)))
245 ;; Set up the rest of its state and local variables.
246 (setq buffer-read-only t)
247 (rmail-summary-mode)
248 (make-local-variable 'minor-mode-alist)
73d8f1de 249 (setq minor-mode-alist (list (list t (concat ": " description))))
deb5848d 250 (setq rmail-buffer rbuf
db56d71e 251 rmail-view-buffer vbuf
deb5848d
RS
252 rmail-summary-redo redo-form
253 rmail-total-messages total))))
254 (setq rmail-summary-buffer sumbuf))
d41d75fb
RS
255 ;; Now display the summary buffer and go to the right place in it.
256 (or was-in-summary
6e626f7e
RS
257 (progn
258 (if (and (one-window-p)
259 pop-up-windows (not pop-up-frames))
260 ;; If there is just one window, put the summary on the top.
261 (progn
262 (split-window (selected-window) rmail-summary-window-size)
263 (select-window (next-window (frame-first-window)))
264 (pop-to-buffer sumbuf)
265 ;; If pop-to-buffer did not use that window, delete that
266 ;; window. (This can happen if it uses another frame.)
267 (if (not (eq sumbuf (window-buffer (frame-first-window))))
268 (delete-other-windows)))
269 (pop-to-buffer sumbuf))
270 (set-buffer rmail-buffer)
271 ;; This is how rmail makes the summary buffer reappear.
272 ;; We do this here to make the window the proper size.
273 (rmail-select-summary nil)
274 (set-buffer rmail-summary-buffer)))
d41d75fb 275 (rmail-summary-goto-msg mesg t t)
88aabab3 276 (rmail-summary-construct-io-menu)
d41d75fb
RS
277 (message "Computing summary lines...done")))
278\f
279;; Low levels of generating a summary.
4d4d11cc
JB
280
281(defun rmail-make-summary-line (msg)
282 (let ((line (or (aref rmail-summary-vector (1- msg))
283 (progn
25774ab4
RS
284 (setq rmail-new-summary-line-count
285 (1+ rmail-new-summary-line-count))
286 (if (zerop (% rmail-new-summary-line-count 10))
4d4d11cc 287 (message "Computing summary lines...%d"
25774ab4 288 rmail-new-summary-line-count))
7d7d10b8
RS
289 (rmail-make-summary-line-1 msg))))
290 delpos)
4d4d11cc 291 ;; Fix up the part of the summary that says "deleted" or "unseen".
7d7d10b8
RS
292 (string-match "[0-9]+" line)
293 (aset line (match-end 0)
294 (if (rmail-message-deleted-p msg) ?D
4d4d11cc 295 (if (= ?0 (char-after (+ 3 (rmail-msgbeg msg))))
7d7d10b8 296 ?- ?\s)))
4d4d11cc
JB
297 line))
298
db56d71e 299;;;###autoload
0a01a04e 300(defcustom rmail-summary-line-decoder (function identity)
db56d71e
KH
301 "*Function to decode summary-line.
302
0a01a04e
RS
303By default, `identity' is set."
304 :type 'function
305 :group 'rmail-summary)
db56d71e 306
4d4d11cc
JB
307(defun rmail-make-summary-line-1 (msg)
308 (goto-char (rmail-msgbeg msg))
309 (let* ((lim (save-excursion (forward-line 2) (point)))
310 pos
311 (labels
312 (progn
313 (forward-char 3)
314 (concat
315; (if (save-excursion (re-search-forward ",answered," lim t))
316; "*" "")
317; (if (save-excursion (re-search-forward ",filed," lim t))
318; "!" "")
319 (if (progn (search-forward ",,") (eolp))
320 ""
321 (concat "{"
322 (buffer-substring (point)
d8562b03
RS
323 (progn (end-of-line)
324 (backward-char)
325 (if (looking-at ",")
326 (point)
327 (1+ (point)))))
328 " } ")))))
4d4d11cc
JB
329 (line
330 (progn
331 (forward-line 1)
332 (if (looking-at "Summary-line: ")
333 (progn
334 (goto-char (match-end 0))
9b452786
RS
335 (buffer-substring (point)
336 (progn (forward-line 1) (point))))))))
4d4d11cc
JB
337 ;; Obsolete status lines lacking a # should be flushed.
338 (and line
339 (not (string-match "#" line))
340 (progn
341 (delete-region (point)
342 (progn (forward-line -1) (point)))
343 (setq line nil)))
344 ;; If we didn't get a valid status line from the message,
345 ;; make a new one and put it in the message.
346 (or line
347 (let* ((case-fold-search t)
348 (next (rmail-msgend msg))
349 (beg (if (progn (goto-char (rmail-msgbeg msg))
350 (search-forward "\n*** EOOH ***\n" next t))
351 (point)
352 (forward-line 1)
353 (point)))
354 (end (progn (search-forward "\n\n" nil t) (point))))
355 (save-restriction
356 (narrow-to-region beg end)
357 (goto-char beg)
358 (setq line (rmail-make-basic-summary-line)))
359 (goto-char (rmail-msgbeg msg))
360 (forward-line 2)
361 (insert "Summary-line: " line)))
362 (setq pos (string-match "#" line))
363 (aset rmail-summary-vector (1- msg)
db56d71e 364 (funcall rmail-summary-line-decoder
7271daf7 365 (concat (format "%5d " msg)
db56d71e
KH
366 (substring line 0 pos)
367 labels
368 (substring line (1+ pos)))))
369 ))
4d4d11cc 370
36c5e617
GM
371;;;###autoload
372(defcustom rmail-user-mail-address-regexp nil
373 "*Regexp matching user mail addresses.
374If non-nil, this variable is used to identify the correspondent
375when receiving new mail. If it matches the address of the sender,
376the recipient is taken as correspondent of a mail.
377If nil \(default value\), your `user-login-name' and `user-mail-address'
378are used to exclude yourself as correspondent.
379
380Usually you don't have to set this variable, except if you collect mails
381sent by you under different user names.
e91053e8 382Then it should be a regexp matching your mail addresses.
36c5e617
GM
383
384Setting this variable has an effect only before reading a mail."
385 :type '(choice (const :tag "None" nil) regexp)
386 :group 'rmail-retrieve
387 :version "21.1")
388
4d4d11cc
JB
389(defun rmail-make-basic-summary-line ()
390 (goto-char (point-min))
391 (concat (save-excursion
392 (if (not (re-search-forward "^Date:" nil t))
393 " "
394 (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)"
395 (save-excursion (end-of-line) (point)) t)
396 (format "%2d-%3s"
027a4b6b
JB
397 (string-to-number (buffer-substring
398 (match-beginning 2)
399 (match-end 2)))
4d4d11cc
JB
400 (buffer-substring
401 (match-beginning 4) (match-end 4))))
402 ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)"
403 (save-excursion (end-of-line) (point)) t)
404 (format "%2d-%3s"
027a4b6b
JB
405 (string-to-number (buffer-substring
406 (match-beginning 4)
407 (match-end 4)))
4d4d11cc
JB
408 (buffer-substring
409 (match-beginning 2) (match-end 2))))
15065a0f
MB
410 ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)"
411 (save-excursion (end-of-line) (point)) t)
412 (format "%2s%2s%2s"
413 (buffer-substring
414 (match-beginning 2) (match-end 2))
415 (buffer-substring
416 (match-beginning 3) (match-end 3))
417 (buffer-substring
418 (match-beginning 4) (match-end 4))))
4d4d11cc
JB
419 (t "??????"))))
420 " "
421 (save-excursion
71f46c95
RS
422 (let* ((from (and (re-search-forward "^From:[ \t]*" nil t)
423 (mail-strip-quoted-names
424 (buffer-substring
425 (1- (point))
426 ;; Get all the lines of the From field
427 ;; so that we get a whole comment if there is one,
428 ;; so that mail-strip-quoted-names can discard it.
429 (let ((opoint (point)))
430 (while (progn (forward-line 1)
431 (looking-at "[ \t]")))
432 ;; Back up over newline, then trailing spaces or tabs
433 (forward-char -1)
434 (skip-chars-backward " \t")
435 (point))))))
436 len mch lo)
437 (if (or (null from)
438 (string-match
439 (or rmail-user-mail-address-regexp
440 (concat "^\\("
441 (regexp-quote (user-login-name))
442 "\\($\\|@\\)\\|"
443 (regexp-quote
444 ;; Don't lose if run from init file
445 ;; where user-mail-address is not
446 ;; set yet.
447 (or user-mail-address
448 (concat (user-login-name) "@"
449 (or mail-host-address
450 (system-name)))))
451 "\\>\\)"))
452 from))
453 ;; No From field, or it's this user.
454 (save-excursion
455 (goto-char (point-min))
456 (if (not (re-search-forward "^To:[ \t]*" nil t))
457 nil
458 (setq from
459 (concat "to: "
460 (mail-strip-quoted-names
461 (buffer-substring
462 (point)
463 (progn (end-of-line)
464 (skip-chars-backward " \t")
465 (point)))))))))
466 (if (null from)
467 " "
4d4d11cc
JB
468 (setq len (length from))
469 (setq mch (string-match "[@%]" from))
470 (format "%25s"
471 (if (or (not mch) (<= len 25))
472 (substring from (max 0 (- len 25)))
473 (substring from
95412165
RS
474 (setq lo (cond ((< (- mch 14) 0) 0)
475 ((< len (+ mch 11))
4d4d11cc 476 (- len 25))
95412165 477 (t (- mch 14))))
4d4d11cc 478 (min len (+ lo 25))))))))
4f21aa66 479 (if rmail-summary-line-count-flag
ea7bddc4
RS
480 (save-excursion
481 (save-restriction
482 (widen)
483 (let ((beg (rmail-msgbeg msgnum))
484 (end (rmail-msgend msgnum))
485 lines)
486 (save-excursion
487 (goto-char beg)
488 ;; Count only lines in the reformatted header,
489 ;; if we have reformatted it.
490 (search-forward "\n*** EOOH ***\n" end t)
491 (setq lines (count-lines (point) end)))
492 (format (cond
493 ((<= lines 9) " [%d]")
494 ((<= lines 99) " [%d]")
495 ((<= lines 999) " [%3d]")
496 (t "[%d]"))
497 lines))))
498 " ")
972a769b 499 " #" ;The # is part of the format.
4d4d11cc
JB
500 (if (re-search-forward "^Subject:" nil t)
501 (progn (skip-chars-forward " \t")
502 (buffer-substring (point)
503 (progn (end-of-line)
504 (point))))
505 (re-search-forward "[\n][\n]+" nil t)
506 (buffer-substring (point) (progn (end-of-line) (point))))
507 "\n"))
d41d75fb
RS
508\f
509;; Simple motion in a summary buffer.
4d4d11cc
JB
510
511(defun rmail-summary-next-all (&optional number)
512 (interactive "p")
bb694792 513 (forward-line (if number number 1))
cc101382
RS
514 ;; It doesn't look nice to move forward past the last message line.
515 (and (eobp) (> number 0)
516 (forward-line -1))
bb694792 517 (display-buffer rmail-buffer))
4d4d11cc
JB
518
519(defun rmail-summary-previous-all (&optional number)
520 (interactive "p")
bb694792 521 (forward-line (- (if number number 1)))
cc101382
RS
522 ;; It doesn't look nice to move forward past the last message line.
523 (and (eobp) (< number 0)
524 (forward-line -1))
bb694792 525 (display-buffer rmail-buffer))
4d4d11cc
JB
526
527(defun rmail-summary-next-msg (&optional number)
d41d75fb
RS
528 "Display next non-deleted msg from rmail file.
529With optional prefix argument NUMBER, moves forward this number of non-deleted
530messages, or backward if NUMBER is negative."
4d4d11cc
JB
531 (interactive "p")
532 (forward-line 0)
b37767e7 533 (and (> number 0) (end-of-line))
4d4d11cc
JB
534 (let ((count (if (< number 0) (- number) number))
535 (search (if (> number 0) 're-search-forward 're-search-backward))
d41d75fb
RS
536 (non-del-msg-found nil))
537 (while (and (> count 0) (setq non-del-msg-found
710cb0d0 538 (or (funcall search "^.....[^D]" nil t)
d41d75fb 539 non-del-msg-found)))
bb694792 540 (setq count (1- count))))
b37767e7 541 (beginning-of-line)
689421a9 542 (display-buffer rmail-view-buffer))
4d4d11cc
JB
543
544(defun rmail-summary-previous-msg (&optional number)
689421a9
JPW
545 "Display previous non-deleted msg from rmail file.
546With optional prefix argument NUMBER, moves backward this number of
547non-deleted messages."
4d4d11cc
JB
548 (interactive "p")
549 (rmail-summary-next-msg (- (if number number 1))))
550
d41d75fb 551(defun rmail-summary-next-labeled-message (n labels)
689421a9 552 "Show next message with LABELS. Defaults to last labels used.
d41d75fb
RS
553With prefix argument N moves forward N messages with these labels."
554 (interactive "p\nsMove to next msg with labels: ")
d69006df
KH
555 (let (msg)
556 (save-excursion
557 (set-buffer rmail-buffer)
558 (rmail-next-labeled-message n labels)
559 (setq msg rmail-current-message))
560 (rmail-summary-goto-msg msg)))
d41d75fb
RS
561
562(defun rmail-summary-previous-labeled-message (n labels)
689421a9 563 "Show previous message with LABELS. Defaults to last labels used.
d41d75fb
RS
564With prefix argument N moves backward N messages with these labels."
565 (interactive "p\nsMove to previous msg with labels: ")
d69006df
KH
566 (let (msg)
567 (save-excursion
568 (set-buffer rmail-buffer)
569 (rmail-previous-labeled-message n labels)
570 (setq msg rmail-current-message))
571 (rmail-summary-goto-msg msg)))
71d97b56
RS
572
573(defun rmail-summary-next-same-subject (n)
574 "Go to the next message in the summary having the same subject.
575With prefix argument N, do this N times.
576If N is negative, go backwards."
577 (interactive "p")
7d897818
AS
578 (let ((forward (> n 0))
579 search-regexp i found)
580 (with-current-buffer rmail-buffer
581 (setq search-regexp (rmail-current-subject-regexp)
582 i rmail-current-message))
71d97b56
RS
583 (save-excursion
584 (while (and (/= n 0)
585 (if forward
586 (not (eobp))
587 (not (bobp))))
588 (let (done)
589 (while (and (not done)
590 (if forward
591 (not (eobp))
592 (not (bobp))))
593 ;; Advance thru summary.
594 (forward-line (if forward 1 -1))
595 ;; Get msg number of this line.
027a4b6b 596 (setq i (string-to-number
71d97b56 597 (buffer-substring (point)
7271daf7 598 (min (point-max) (+ 6 (point))))))
71d97b56
RS
599 ;; See if that msg has desired subject.
600 (save-excursion
601 (set-buffer rmail-buffer)
602 (save-restriction
603 (widen)
604 (goto-char (rmail-msgbeg i))
605 (search-forward "\n*** EOOH ***\n")
606 (let ((beg (point)) end)
607 (search-forward "\n\n")
608 (setq end (point))
609 (goto-char beg)
610 (setq done (re-search-forward search-regexp end t))))))
611 (if done (setq found i)))
612 (setq n (if forward (1- n) (1+ n)))))
613 (if found
614 (rmail-summary-goto-msg found)
615 (error "No %s message with same subject"
616 (if forward "following" "previous")))))
617
618(defun rmail-summary-previous-same-subject (n)
619 "Go to the previous message in the summary having the same subject.
620With prefix argument N, do this N times.
621If N is negative, go forwards instead."
622 (interactive "p")
623 (rmail-summary-next-same-subject (- n)))
d41d75fb
RS
624\f
625;; Delete and undelete summary commands.
626
93cba994 627(defun rmail-summary-delete-forward (&optional count)
d41d75fb
RS
628 "Delete this message and move to next nondeleted one.
629Deleted messages stay in the file until the \\[rmail-expunge] command is given.
93cba994
RS
630A prefix argument serves as a repeat count;
631a negative argument means to delete and move backward."
632 (interactive "p")
ecb4dd9a 633 (unless (numberp count) (setq count 1))
93cba994
RS
634 (let (end del-msg
635 (backward (< count 0)))
636 (while (/= count 0)
637 (rmail-summary-goto-msg)
638 (with-current-buffer rmail-buffer
639 (rmail-delete-message)
640 (setq del-msg rmail-current-message))
92a38267
RS
641 (rmail-summary-mark-deleted del-msg)
642 (while (and (not (if backward (bobp) (eobp)))
94eeb96a 643 (save-excursion (beginning-of-line)
7434015f 644 (looking-at " *[0-9]+D")))
cdbea8ca
RS
645 (forward-line (if backward -1 1)))
646 ;; It looks ugly to move to the empty line at end of buffer.
647 (and (eobp) (not backward)
93cba994
RS
648 (forward-line -1))
649 (setq count
650 (if (> count 0) (1- count) (1+ count))))))
4d4d11cc 651
93cba994 652(defun rmail-summary-delete-backward (&optional count)
d41d75fb 653 "Delete this message and move to previous nondeleted one.
93cba994
RS
654Deleted messages stay in the file until the \\[rmail-expunge] command is given.
655A prefix argument serves as a repeat count;
656a negative argument means to delete and move forward."
657 (interactive "p")
658 (rmail-summary-delete-forward (- count)))
4d4d11cc 659
d41d75fb 660(defun rmail-summary-mark-deleted (&optional n undel)
85bd1ac6 661 ;; Since third arg is t, this only alters the summary, not the Rmail buf.
fedc33f7
RS
662 (and n (rmail-summary-goto-msg n t t))
663 (or (eobp)
4fb6f90f 664 (not (overlay-get rmail-summary-overlay 'face))
fedc33f7
RS
665 (let ((buffer-read-only nil))
666 (skip-chars-forward " ")
667 (skip-chars-forward "[0-9]")
668 (if undel
669 (if (looking-at "D")
670 (progn (delete-char 1) (insert " ")))
671 (delete-char 1)
672 (insert "D"))))
d41d75fb
RS
673 (beginning-of-line))
674
675(defun rmail-summary-mark-undeleted (n)
676 (rmail-summary-mark-deleted n t))
677
678(defun rmail-summary-deleted-p (&optional n)
679 (save-excursion
680 (and n (rmail-summary-goto-msg n nil t))
681 (skip-chars-forward " ")
682 (skip-chars-forward "[0-9]")
683 (looking-at "D")))
4d4d11cc 684
d41d75fb
RS
685(defun rmail-summary-undelete (&optional arg)
686 "Undelete current message.
687Optional prefix ARG means undelete ARG previous messages."
688 (interactive "p")
689 (if (/= arg 1)
690 (rmail-summary-undelete-many arg)
5ed1243c
RS
691 (let ((buffer-read-only nil)
692 (opoint (point)))
d41d75fb
RS
693 (end-of-line)
694 (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t)
695 (replace-match "\\1 ")
696 (rmail-summary-goto-msg)
67f2e119
GM
697 (if rmail-enable-mime
698 (set-buffer rmail-buffer)
699 (pop-to-buffer rmail-buffer))
d41d75fb
RS
700 (and (rmail-message-deleted-p rmail-current-message)
701 (rmail-undelete-previous-message))
67f2e119
GM
702 (if rmail-enable-mime
703 (pop-to-buffer rmail-view-buffer))
5ed1243c
RS
704 (pop-to-buffer rmail-summary-buffer))
705 (t (goto-char opoint))))))
d41d75fb
RS
706
707(defun rmail-summary-undelete-many (&optional n)
708 "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs."
709 (interactive "P")
710 (save-excursion
711 (set-buffer rmail-buffer)
712 (let* ((init-msg (if n rmail-current-message rmail-total-messages))
713 (rmail-current-message init-msg)
714 (n (or n rmail-total-messages))
715 (msgs-undeled 0))
716 (while (and (> rmail-current-message 0)
717 (< msgs-undeled n))
718 (if (rmail-message-deleted-p rmail-current-message)
719 (progn (rmail-set-attribute "deleted" nil)
720 (setq msgs-undeled (1+ msgs-undeled))))
721 (setq rmail-current-message (1- rmail-current-message)))
722 (set-buffer rmail-summary-buffer)
723 (setq rmail-current-message init-msg msgs-undeled 0)
724 (while (and (> rmail-current-message 0)
725 (< msgs-undeled n))
726 (if (rmail-summary-deleted-p rmail-current-message)
727 (progn (rmail-summary-mark-undeleted rmail-current-message)
728 (setq msgs-undeled (1+ msgs-undeled))))
729 (setq rmail-current-message (1- rmail-current-message))))
730 (rmail-summary-goto-msg)))
731\f
4d4d11cc
JB
732;; Rmail Summary mode is suitable only for specially formatted data.
733(put 'rmail-summary-mode 'mode-class 'special)
734
735(defun rmail-summary-mode ()
d41d75fb
RS
736 "Rmail Summary Mode is invoked from Rmail Mode by using \\<rmail-mode-map>\\[rmail-summary].
737As commands are issued in the summary buffer, they are applied to the
738corresponding mail messages in the rmail buffer.
739
740All normal editing commands are turned off.
9cd78473
RS
741Instead, nearly all the Rmail mode commands are available,
742though many of them move only among the messages in the summary.
d41d75fb 743
9cd78473
RS
744These additional commands exist:
745
746\\[rmail-summary-undelete-many] Undelete all or prefix arg deleted messages.
747\\[rmail-summary-wipe] Delete the summary and go to the Rmail buffer.
748
749Commands for sorting the summary:
750
751\\[rmail-summary-sort-by-date] Sort by date.
752\\[rmail-summary-sort-by-subject] Sort by subject.
753\\[rmail-summary-sort-by-author] Sort by author.
754\\[rmail-summary-sort-by-recipient] Sort by recipient.
755\\[rmail-summary-sort-by-correspondent] Sort by correspondent.
ebdf372b 756\\[rmail-summary-sort-by-lines] Sort by lines.
e15dbc43 757\\[rmail-summary-sort-by-labels] Sort by labels."
4d4d11cc
JB
758 (interactive)
759 (kill-all-local-variables)
4d4d11cc
JB
760 (setq major-mode 'rmail-summary-mode)
761 (setq mode-name "RMAIL Summary")
4d4d11cc
JB
762 (setq truncate-lines t)
763 (setq buffer-read-only t)
764 (set-syntax-table text-mode-syntax-table)
d41d75fb 765 (make-local-variable 'rmail-buffer)
db56d71e 766 (make-local-variable 'rmail-view-buffer)
d41d75fb
RS
767 (make-local-variable 'rmail-total-messages)
768 (make-local-variable 'rmail-current-message)
769 (setq rmail-current-message nil)
770 (make-local-variable 'rmail-summary-redo)
771 (setq rmail-summary-redo nil)
772 (make-local-variable 'revert-buffer-function)
d16df573
SM
773 (make-local-variable 'font-lock-defaults)
774 (setq font-lock-defaults '(rmail-summary-font-lock-keywords t))
0732dfa5 775 (rmail-summary-enable)
46b24850 776 (run-mode-hooks 'rmail-summary-mode-hook))
4d4d11cc 777
0732dfa5
KH
778;; Summary features need to be disabled during edit mode.
779(defun rmail-summary-disable ()
56b25713 780 (use-local-map text-mode-map)
c28baa2a 781 (remove-hook 'post-command-hook 'rmail-summary-rmail-update t)
56b25713 782 (setq revert-buffer-function nil))
0732dfa5
KH
783
784(defun rmail-summary-enable ()
56b25713 785 (use-local-map rmail-summary-mode-map)
c28baa2a 786 (add-hook 'post-command-hook 'rmail-summary-rmail-update nil t)
56b25713 787 (setq revert-buffer-function 'rmail-update-summary))
0732dfa5 788
5be36e20
RS
789(defvar rmail-summary-put-back-unseen nil
790 "Used for communicating between calls to `rmail-summary-rmail-update'.
791If it moves to a message within an Incremental Search, and removes
792the `unseen' attribute from that message, it sets this flag
793so that if the next motion between messages is in the same Incremental
794Search, the `unseen' attribute is restored.")
795
bb694792
RS
796;; Show in Rmail the message described by the summary line that point is on,
797;; but only if the Rmail buffer is already visible.
d41d75fb
RS
798;; This is a post-command-hook in summary buffers.
799(defun rmail-summary-rmail-update ()
10e09db4
KH
800 (let (buffer-read-only)
801 (save-excursion
802 ;; If at end of buffer, pretend we are on the last text line.
803 (if (eobp)
804 (forward-line -1))
805 (beginning-of-line)
806 (skip-chars-forward " ")
027a4b6b
JB
807 (let ((msg-num (string-to-number (buffer-substring
808 (point)
809 (progn (skip-chars-forward "0-9")
810 (point))))))
5be36e20
RS
811 ;; Always leave `unseen' removed
812 ;; if we get out of isearch mode.
813 ;; Don't let a subsequent isearch restore that `unseen'.
814 (if (not isearch-mode)
815 (setq rmail-summary-put-back-unseen nil))
816
10e09db4 817 (or (eq rmail-current-message msg-num)
8efaaf11 818 (let ((window (get-buffer-window rmail-view-buffer t))
10e09db4 819 (owin (selected-window)))
5be36e20
RS
820 (if isearch-mode
821 (save-excursion
822 (set-buffer rmail-buffer)
823 ;; If we first saw the previous message in this search,
824 ;; and we have gone to a different message while searching,
825 ;; put back `unseen' on the former one.
1dbd9103 826 (if rmail-summary-put-back-unseen
c9aa3ef8
KH
827 (rmail-set-attribute "unseen" t
828 rmail-current-message))
5be36e20
RS
829 ;; Arrange to do that later, for the new current message,
830 ;; if it still has `unseen'.
831 (setq rmail-summary-put-back-unseen
832 (rmail-message-labels-p msg-num ", ?\\(unseen\\),")))
833 (setq rmail-summary-put-back-unseen nil))
834
835 ;; Go to the desired message.
10e09db4 836 (setq rmail-current-message msg-num)
5be36e20
RS
837
838 ;; Update the summary to show the message has been seen.
10e09db4
KH
839 (if (= (following-char) ?-)
840 (progn
841 (delete-char 1)
842 (insert " ")))
5be36e20 843
10e09db4
KH
844 (if window
845 ;; Using save-window-excursion would cause the new value
980d43b6
RS
846 ;; of point to get lost.
847 (unwind-protect
848 (progn
849 (select-window window)
bc454f08 850 (rmail-show-message msg-num t))
10e09db4 851 (select-window owin))
dca46072
RS
852 (if (buffer-name rmail-buffer)
853 (save-excursion
854 (set-buffer rmail-buffer)
4fb6f90f
RS
855 (rmail-show-message msg-num t))))))
856 (rmail-summary-update-highlight nil)))))
f1c5dbb9
GM
857
858(defun rmail-summary-save-buffer ()
859 "Save the buffer associated with this RMAIL summary."
860 (interactive)
861 (save-window-excursion
862 (save-excursion
863 (switch-to-buffer rmail-buffer)
864 (save-buffer))))
865
d41d75fb 866\f
d41d75fb
RS
867(if rmail-summary-mode-map
868 nil
869 (setq rmail-summary-mode-map (make-keymap))
870 (suppress-keymap rmail-summary-mode-map)
4ab455e6
RS
871
872 (define-key rmail-summary-mode-map [mouse-2] 'rmail-summary-mouse-goto-message)
d41d75fb 873 (define-key rmail-summary-mode-map "a" 'rmail-summary-add-label)
00f3d57d 874 (define-key rmail-summary-mode-map "b" 'rmail-summary-bury)
d41d75fb
RS
875 (define-key rmail-summary-mode-map "c" 'rmail-summary-continue)
876 (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward)
877 (define-key rmail-summary-mode-map "\C-d" 'rmail-summary-delete-backward)
878 (define-key rmail-summary-mode-map "e" 'rmail-summary-edit-current-message)
879 (define-key rmail-summary-mode-map "f" 'rmail-summary-forward)
880 (define-key rmail-summary-mode-map "g" 'rmail-summary-get-new-mail)
881 (define-key rmail-summary-mode-map "h" 'rmail-summary)
882 (define-key rmail-summary-mode-map "i" 'rmail-summary-input)
883 (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg)
6d6c336c 884 (define-key rmail-summary-mode-map "\C-m" 'rmail-summary-goto-msg)
d41d75fb
RS
885 (define-key rmail-summary-mode-map "k" 'rmail-summary-kill-label)
886 (define-key rmail-summary-mode-map "l" 'rmail-summary-by-labels)
887 (define-key rmail-summary-mode-map "\e\C-h" 'rmail-summary)
888 (define-key rmail-summary-mode-map "\e\C-l" 'rmail-summary-by-labels)
889 (define-key rmail-summary-mode-map "\e\C-r" 'rmail-summary-by-recipients)
890 (define-key rmail-summary-mode-map "\e\C-s" 'rmail-summary-by-regexp)
891 (define-key rmail-summary-mode-map "\e\C-t" 'rmail-summary-by-topic)
892 (define-key rmail-summary-mode-map "m" 'rmail-summary-mail)
893 (define-key rmail-summary-mode-map "\M-m" 'rmail-summary-retry-failure)
894 (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
d41d75fb
RS
895 (define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all)
896 (define-key rmail-summary-mode-map "\e\C-n" 'rmail-summary-next-labeled-message)
897 (define-key rmail-summary-mode-map "o" 'rmail-summary-output-to-rmail-file)
898 (define-key rmail-summary-mode-map "\C-o" 'rmail-summary-output)
899 (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
d41d75fb
RS
900 (define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all)
901 (define-key rmail-summary-mode-map "\e\C-p" 'rmail-summary-previous-labeled-message)
902 (define-key rmail-summary-mode-map "q" 'rmail-summary-quit)
d5bafc55 903 (define-key rmail-summary-mode-map "Q" 'rmail-summary-wipe)
d41d75fb
RS
904 (define-key rmail-summary-mode-map "r" 'rmail-summary-reply)
905 (define-key rmail-summary-mode-map "s" 'rmail-summary-expunge-and-save)
906 (define-key rmail-summary-mode-map "\es" 'rmail-summary-search)
907 (define-key rmail-summary-mode-map "t" 'rmail-summary-toggle-header)
908 (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete)
909 (define-key rmail-summary-mode-map "\M-u" 'rmail-summary-undelete-many)
d41d75fb 910 (define-key rmail-summary-mode-map "x" 'rmail-summary-expunge)
d5bafc55 911 (define-key rmail-summary-mode-map "w" 'rmail-summary-output-body)
d41d75fb 912 (define-key rmail-summary-mode-map "." 'rmail-summary-beginning-of-message)
234d828a 913 (define-key rmail-summary-mode-map "/" 'rmail-summary-end-of-message)
d41d75fb
RS
914 (define-key rmail-summary-mode-map "<" 'rmail-summary-first-message)
915 (define-key rmail-summary-mode-map ">" 'rmail-summary-last-message)
916 (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up)
917 (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down)
918 (define-key rmail-summary-mode-map "?" 'describe-mode)
71d97b56
RS
919 (define-key rmail-summary-mode-map "\C-c\C-n" 'rmail-summary-next-same-subject)
920 (define-key rmail-summary-mode-map "\C-c\C-p" 'rmail-summary-previous-same-subject)
e45fce03
RS
921 (define-key rmail-summary-mode-map "\C-c\C-s\C-d"
922 'rmail-summary-sort-by-date)
923 (define-key rmail-summary-mode-map "\C-c\C-s\C-s"
924 'rmail-summary-sort-by-subject)
925 (define-key rmail-summary-mode-map "\C-c\C-s\C-a"
926 'rmail-summary-sort-by-author)
927 (define-key rmail-summary-mode-map "\C-c\C-s\C-r"
928 'rmail-summary-sort-by-recipient)
929 (define-key rmail-summary-mode-map "\C-c\C-s\C-c"
930 'rmail-summary-sort-by-correspondent)
931 (define-key rmail-summary-mode-map "\C-c\C-s\C-l"
932 'rmail-summary-sort-by-lines)
ebdf372b 933 (define-key rmail-summary-mode-map "\C-c\C-s\C-k"
e15dbc43 934 'rmail-summary-sort-by-labels)
f1c5dbb9 935 (define-key rmail-summary-mode-map "\C-x\C-s" 'rmail-summary-save-buffer)
d41d75fb
RS
936 )
937\f
e7a00c25
RS
938;;; Menu bar bindings.
939
940(define-key rmail-summary-mode-map [menu-bar] (make-sparse-keymap))
941
942(define-key rmail-summary-mode-map [menu-bar classify]
943 (cons "Classify" (make-sparse-keymap "Classify")))
944
dca46072
RS
945(define-key rmail-summary-mode-map [menu-bar classify output-menu]
946 '("Output (Rmail Menu)..." . rmail-summary-output-menu))
947
948(define-key rmail-summary-mode-map [menu-bar classify input-menu]
0e520d74 949 '("Input Rmail File (menu)..." . rmail-input-menu))
dca46072 950
aa138cb4
RS
951(define-key rmail-summary-mode-map [menu-bar classify input-menu]
952 '(nil))
953
954(define-key rmail-summary-mode-map [menu-bar classify output-menu]
955 '(nil))
956
d5bafc55
RS
957(define-key rmail-summary-mode-map [menu-bar classify output-body]
958 '("Output (body)..." . rmail-summary-output-body))
959
e7a00c25 960(define-key rmail-summary-mode-map [menu-bar classify output-inbox]
29e6129e 961 '("Output (inbox)..." . rmail-summary-output))
e7a00c25
RS
962
963(define-key rmail-summary-mode-map [menu-bar classify output]
29e6129e 964 '("Output (Rmail)..." . rmail-summary-output-to-rmail-file))
e7a00c25
RS
965
966(define-key rmail-summary-mode-map [menu-bar classify kill-label]
29e6129e 967 '("Kill Label..." . rmail-summary-kill-label))
e7a00c25
RS
968
969(define-key rmail-summary-mode-map [menu-bar classify add-label]
29e6129e 970 '("Add Label..." . rmail-summary-add-label))
e7a00c25
RS
971
972(define-key rmail-summary-mode-map [menu-bar summary]
973 (cons "Summary" (make-sparse-keymap "Summary")))
974
c1046d18
RS
975(define-key rmail-summary-mode-map [menu-bar summary senders]
976 '("By Senders..." . rmail-summary-by-senders))
977
e7a00c25 978(define-key rmail-summary-mode-map [menu-bar summary labels]
29e6129e 979 '("By Labels..." . rmail-summary-by-labels))
e7a00c25
RS
980
981(define-key rmail-summary-mode-map [menu-bar summary recipients]
29e6129e 982 '("By Recipients..." . rmail-summary-by-recipients))
e7a00c25
RS
983
984(define-key rmail-summary-mode-map [menu-bar summary topic]
29e6129e 985 '("By Topic..." . rmail-summary-by-topic))
e7a00c25
RS
986
987(define-key rmail-summary-mode-map [menu-bar summary regexp]
29e6129e 988 '("By Regexp..." . rmail-summary-by-regexp))
e7a00c25
RS
989
990(define-key rmail-summary-mode-map [menu-bar summary all]
991 '("All" . rmail-summary))
992
993(define-key rmail-summary-mode-map [menu-bar mail]
994 (cons "Mail" (make-sparse-keymap "Mail")))
995
e76bca6c 996(define-key rmail-summary-mode-map [menu-bar mail rmail-summary-get-new-mail]
b0d3522a
RS
997 '("Get New Mail" . rmail-summary-get-new-mail))
998
c0d133a6 999(define-key rmail-summary-mode-map [menu-bar mail lambda]
b0d3522a 1000 '("----"))
aba6cc35 1001
e7a00c25
RS
1002(define-key rmail-summary-mode-map [menu-bar mail continue]
1003 '("Continue" . rmail-summary-continue))
1004
b0d3522a 1005(define-key rmail-summary-mode-map [menu-bar mail resend]
4986bd38 1006 '("Re-send..." . rmail-summary-resend))
b0d3522a 1007
e7a00c25
RS
1008(define-key rmail-summary-mode-map [menu-bar mail forward]
1009 '("Forward" . rmail-summary-forward))
1010
1011(define-key rmail-summary-mode-map [menu-bar mail retry]
1012 '("Retry" . rmail-summary-retry-failure))
1013
1014(define-key rmail-summary-mode-map [menu-bar mail reply]
1015 '("Reply" . rmail-summary-reply))
1016
1017(define-key rmail-summary-mode-map [menu-bar mail mail]
1018 '("Mail" . rmail-summary-mail))
1019
1020(define-key rmail-summary-mode-map [menu-bar delete]
1021 (cons "Delete" (make-sparse-keymap "Delete")))
1022
1023(define-key rmail-summary-mode-map [menu-bar delete expunge/save]
1024 '("Expunge/Save" . rmail-summary-expunge-and-save))
1025
1026(define-key rmail-summary-mode-map [menu-bar delete expunge]
1027 '("Expunge" . rmail-summary-expunge))
1028
1029(define-key rmail-summary-mode-map [menu-bar delete undelete]
1030 '("Undelete" . rmail-summary-undelete))
1031
1032(define-key rmail-summary-mode-map [menu-bar delete delete]
1033 '("Delete" . rmail-summary-delete-forward))
1034
1035(define-key rmail-summary-mode-map [menu-bar move]
1036 (cons "Move" (make-sparse-keymap "Move")))
1037
1038(define-key rmail-summary-mode-map [menu-bar move search-back]
29e6129e 1039 '("Search Back..." . rmail-summary-search-backward))
e7a00c25
RS
1040
1041(define-key rmail-summary-mode-map [menu-bar move search]
29e6129e 1042 '("Search..." . rmail-summary-search))
e7a00c25
RS
1043
1044(define-key rmail-summary-mode-map [menu-bar move previous]
1045 '("Previous Nondeleted" . rmail-summary-previous-msg))
1046
1047(define-key rmail-summary-mode-map [menu-bar move next]
1048 '("Next Nondeleted" . rmail-summary-next-msg))
1049
1050(define-key rmail-summary-mode-map [menu-bar move last]
1051 '("Last" . rmail-summary-last-message))
1052
1053(define-key rmail-summary-mode-map [menu-bar move first]
1054 '("First" . rmail-summary-first-message))
1055
1056(define-key rmail-summary-mode-map [menu-bar move previous]
1057 '("Previous" . rmail-summary-previous-all))
1058
1059(define-key rmail-summary-mode-map [menu-bar move next]
1060 '("Next" . rmail-summary-next-all))
1061\f
4ab455e6
RS
1062(defun rmail-summary-mouse-goto-message (event)
1063 "Select the message whose summary line you click on."
1064 (interactive "@e")
1065 (goto-char (posn-point (event-end event)))
1066 (rmail-summary-goto-msg))
85bd1ac6 1067
d41d75fb 1068(defun rmail-summary-goto-msg (&optional n nowarn skip-rmail)
4ab455e6
RS
1069 "Go to message N in the summary buffer and the Rmail buffer.
1070If N is nil, use the message corresponding to point in the summary
1071and move to that message in the Rmail buffer.
1072
1073If NOWARN, don't say anything if N is out of range.
1074If SKIP-RMAIL, don't do anything to the Rmail buffer."
4d4d11cc
JB
1075 (interactive "P")
1076 (if (consp n) (setq n (prefix-numeric-value n)))
1077 (if (eobp) (forward-line -1))
1078 (beginning-of-line)
132ad564
RS
1079 (let* ((obuf (current-buffer))
1080 (buf rmail-buffer)
1081 (cur (point))
1082 message-not-found
027a4b6b 1083 (curmsg (string-to-number
132ad564 1084 (buffer-substring (point)
7271daf7 1085 (min (point-max) (+ 6 (point))))))
132ad564 1086 (total (save-excursion (set-buffer buf) rmail-total-messages)))
4197af8a
RS
1087 ;; If message number N was specified, find that message's line
1088 ;; or set message-not-found.
1089 ;; If N wasn't specified or that message can't be found.
1090 ;; set N by default.
4d4d11cc
JB
1091 (if (not n)
1092 (setq n curmsg)
1093 (if (< n 1)
1094 (progn (message "No preceding message")
1095 (setq n 1)))
867bae0b
EZ
1096 (if (and (> n total)
1097 (> total 0))
4d4d11cc
JB
1098 (progn (message "No following message")
1099 (goto-char (point-max))
85bd1ac6 1100 (rmail-summary-goto-msg nil nowarn skip-rmail)))
4d4d11cc 1101 (goto-char (point-min))
7271daf7 1102 (if (not (re-search-forward (format "^%5d[^0-9]" n) nil t))
4d4d11cc
JB
1103 (progn (or nowarn (message "Message %d not found" n))
1104 (setq n curmsg)
4197af8a 1105 (setq message-not-found t)
4d4d11cc
JB
1106 (goto-char cur))))
1107 (beginning-of-line)
1108 (skip-chars-forward " ")
1109 (skip-chars-forward "0-9")
1110 (save-excursion (if (= (following-char) ?-)
1111 (let ((buffer-read-only nil))
1112 (delete-char 1)
1113 (insert " "))))
4fb6f90f 1114 (rmail-summary-update-highlight message-not-found)
4d4d11cc 1115 (beginning-of-line)
d41d75fb
RS
1116 (if skip-rmail
1117 nil
857ff384
RS
1118 (let ((selwin (selected-window)))
1119 (unwind-protect
1120 (progn (pop-to-buffer buf)
1121 (rmail-show-message n))
c7b5ca27
RS
1122 (select-window selwin)
1123 ;; The actions above can alter the current buffer. Preserve it.
1124 (set-buffer obuf))))))
4fb6f90f
RS
1125
1126;; Update the highlighted line in an rmail summary buffer.
1127;; That should be current. We highlight the line point is on.
1128;; If NOT-FOUND is non-nil, we turn off highlighting.
1129(defun rmail-summary-update-highlight (not-found)
1130 ;; Make sure we have an overlay to use.
1131 (or rmail-summary-overlay
1132 (progn
1133 (make-local-variable 'rmail-summary-overlay)
1134 (setq rmail-summary-overlay (make-overlay (point) (point)))))
1135 ;; If this message is in the summary, use the overlay to highlight it.
1136 ;; Otherwise, don't highlight anything.
1137 (if not-found
1138 (overlay-put rmail-summary-overlay 'face nil)
1139 (move-overlay rmail-summary-overlay
1140 (save-excursion (beginning-of-line)
1141 (skip-chars-forward " ")
1142 (point))
1143 (save-excursion (end-of-line) (point)))
1144 (overlay-put rmail-summary-overlay 'face 'highlight)))
d41d75fb 1145\f
4d4d11cc 1146(defun rmail-summary-scroll-msg-up (&optional dist)
3753ab6f
RS
1147 "Scroll the Rmail window forward.
1148If the Rmail window is displaying the end of a message,
1149advance to the next message."
4d4d11cc 1150 (interactive "P")
3753ab6f
RS
1151 (if (eq dist '-)
1152 (rmail-summary-scroll-msg-down nil)
db56d71e 1153 (let ((rmail-buffer-window (get-buffer-window rmail-view-buffer)))
3753ab6f
RS
1154 (if rmail-buffer-window
1155 (if (let ((rmail-summary-window (selected-window)))
1156 (select-window rmail-buffer-window)
1157 (prog1
1158 ;; Is EOB visible in the buffer?
1159 (save-excursion
1160 (let ((ht (window-height (selected-window))))
1161 (move-to-window-line (- ht 2))
1162 (end-of-line)
1163 (eobp)))
1164 (select-window rmail-summary-window)))
be2e861f
RS
1165 (if (not rmail-summary-scroll-between-messages)
1166 (error "End of buffer")
1167 (rmail-summary-next-msg (or dist 1)))
db56d71e 1168 (let ((other-window-scroll-buffer rmail-view-buffer))
3753ab6f 1169 (scroll-other-window dist)))
37eb1878
RS
1170 ;; If it isn't visible at all, show the beginning.
1171 (rmail-summary-beginning-of-message)))))
4d4d11cc
JB
1172
1173(defun rmail-summary-scroll-msg-down (&optional dist)
3753ab6f 1174 "Scroll the Rmail window backward.
37eb1878
RS
1175If the Rmail window is now displaying the beginning of a message,
1176move to the previous message."
4d4d11cc 1177 (interactive "P")
3753ab6f
RS
1178 (if (eq dist '-)
1179 (rmail-summary-scroll-msg-up nil)
67f2e119 1180 (let ((rmail-buffer-window (get-buffer-window rmail-view-buffer)))
3753ab6f
RS
1181 (if rmail-buffer-window
1182 (if (let ((rmail-summary-window (selected-window)))
1183 (select-window rmail-buffer-window)
1184 (prog1
1185 ;; Is BOB visible in the buffer?
1186 (save-excursion
1187 (move-to-window-line 0)
1188 (beginning-of-line)
1189 (bobp))
1190 (select-window rmail-summary-window)))
be2e861f
RS
1191 (if (not rmail-summary-scroll-between-messages)
1192 (error "Beginning of buffer")
1193 (rmail-summary-previous-msg (or dist 1)))
67f2e119 1194 (let ((other-window-scroll-buffer rmail-view-buffer))
3753ab6f 1195 (scroll-other-window-down dist)))
37eb1878
RS
1196 ;; If it isn't visible at all, show the beginning.
1197 (rmail-summary-beginning-of-message)))))
d41d75fb
RS
1198
1199(defun rmail-summary-beginning-of-message ()
1200 "Show current message from the beginning."
1201 (interactive)
234d828a
EZ
1202 (rmail-summary-show-message 'BEG))
1203
1204(defun rmail-summary-end-of-message ()
1205 "Show bottom of current message."
1206 (interactive)
1207 (rmail-summary-show-message 'END))
1208
1209(defun rmail-summary-show-message (where)
1210 "Show current mail message.
1211Position it according to WHERE which can be BEG or END"
37eb1878
RS
1212 (if (and (one-window-p) (not pop-up-frames))
1213 ;; If there is just one window, put the summary on the top.
67f2e119 1214 (let ((buffer rmail-view-buffer))
37eb1878
RS
1215 (split-window (selected-window) rmail-summary-window-size)
1216 (select-window (frame-first-window))
67f2e119 1217 (pop-to-buffer rmail-view-buffer)
37eb1878
RS
1218 ;; If pop-to-buffer did not use that window, delete that
1219 ;; window. (This can happen if it uses another frame.)
1220 (or (eq buffer (window-buffer (next-window (frame-first-window))))
1221 (delete-other-windows)))
67f2e119 1222 (pop-to-buffer rmail-view-buffer))
234d828a
EZ
1223 (cond
1224 ((eq where 'BEG)
1225 (goto-char (point-min))
1226 (search-forward "\n\n"))
1227 ((eq where 'END)
1228 (goto-char (point-max))
1229 (recenter (1- (window-height))))
1230 )
d41d75fb 1231 (pop-to-buffer rmail-summary-buffer))
4d4d11cc 1232
00f3d57d
RS
1233(defun rmail-summary-bury ()
1234 "Bury the Rmail buffer and the Rmail summary buffer."
1235 (interactive)
1236 (let ((buffer-to-bury (current-buffer)))
1237 (let (window)
1238 (while (setq window (get-buffer-window rmail-buffer))
1239 (set-window-buffer window (other-buffer rmail-buffer)))
1240 (bury-buffer rmail-buffer))
1241 (switch-to-buffer (other-buffer buffer-to-bury))
1242 (bury-buffer buffer-to-bury)))
1243
4d4d11cc 1244(defun rmail-summary-quit ()
d41d75fb 1245 "Quit out of Rmail and Rmail summary."
4d4d11cc 1246 (interactive)
d41d75fb 1247 (rmail-summary-wipe)
4d4d11cc
JB
1248 (rmail-quit))
1249
d41d75fb
RS
1250(defun rmail-summary-wipe ()
1251 "Kill and wipe away Rmail summary, remaining within Rmail."
4d4d11cc 1252 (interactive)
d41d75fb 1253 (save-excursion (set-buffer rmail-buffer) (setq rmail-summary-buffer nil))
67f2e119 1254 (let ((local-rmail-buffer rmail-view-buffer))
d41d75fb
RS
1255 (kill-buffer (current-buffer))
1256 ;; Delete window if not only one.
1257 (if (not (eq (selected-window) (next-window nil 'no-minibuf)))
1258 (delete-window))
9cd78473
RS
1259 ;; Switch windows to the rmail buffer, or switch to it in this window.
1260 (pop-to-buffer local-rmail-buffer)))
d41d75fb
RS
1261
1262(defun rmail-summary-expunge ()
1263 "Actually erase all deleted messages and recompute summary headers."
1264 (interactive)
1265 (save-excursion
1266 (set-buffer rmail-buffer)
09cefa66 1267 (when (rmail-expunge-confirmed)
d2bf5afe 1268 (rmail-only-expunge)))
d41d75fb
RS
1269 (rmail-update-summary))
1270
1271(defun rmail-summary-expunge-and-save ()
1272 "Expunge and save RMAIL file."
1273 (interactive)
1274 (save-excursion
1275 (set-buffer rmail-buffer)
09cefa66 1276 (when (rmail-expunge-confirmed)
d2bf5afe 1277 (rmail-only-expunge)))
b37767e7
RS
1278 (rmail-update-summary)
1279 (save-excursion
980d43b6 1280 (set-buffer rmail-buffer)
ccc341de
KH
1281 (save-buffer))
1282 (set-buffer-modified-p nil))
d41d75fb 1283
3198a3d5
RS
1284(defun rmail-summary-get-new-mail (&optional file-name)
1285 "Get new mail and recompute summary headers.
1286
1287Optionally you can specify the file to get new mail from. In this case,
1288the file of new mail is not changed or deleted. Noninteractively, you can
1289pass the inbox file name as an argument. Interactively, a prefix
1290argument says to read a file name and use that file as the inbox."
1291 (interactive
1292 (list (if current-prefix-arg
1293 (read-file-name "Get new mail from file: "))))
b37767e7
RS
1294 (let (msg)
1295 (save-excursion
1296 (set-buffer rmail-buffer)
3198a3d5 1297 (rmail-get-new-mail file-name)
b37767e7
RS
1298 ;; Get the proper new message number.
1299 (setq msg rmail-current-message))
1300 ;; Make sure that message is displayed.
8d908f84
RS
1301 (or (zerop msg)
1302 (rmail-summary-goto-msg msg))))
d41d75fb
RS
1303
1304(defun rmail-summary-input (filename)
1305 "Run Rmail on file FILENAME."
1306 (interactive "FRun rmail on RMAIL file: ")
b37767e7
RS
1307 ;; We switch windows here, then display the other Rmail file there.
1308 (pop-to-buffer rmail-buffer)
1309 (rmail filename))
d41d75fb
RS
1310
1311(defun rmail-summary-first-message ()
1312 "Show first message in Rmail file from summary buffer."
1313 (interactive)
25774ab4
RS
1314 (with-no-warnings
1315 (beginning-of-buffer)))
d41d75fb
RS
1316
1317(defun rmail-summary-last-message ()
1318 "Show last message in Rmail file from summary buffer."
1319 (interactive)
25774ab4
RS
1320 (with-no-warnings
1321 (end-of-buffer))
d41d75fb
RS
1322 (forward-line -1))
1323
73e72da4
DN
1324(declare-function rmail-abort-edit "rmailedit" ())
1325(declare-function rmail-cease-edit "rmailedit"())
1326(declare-function rmail-set-label "rmailkwd" (l state &optional n))
1327(declare-function rmail-output-read-file-name "rmailout" ())
1328(declare-function rmail-output-read-rmail-file-name "rmailout" ())
1329(declare-function mail-send-and-exit "sendmail" (&optional arg))
1330
d41d75fb
RS
1331(defvar rmail-summary-edit-map nil)
1332(if rmail-summary-edit-map
1333 nil
1334 (setq rmail-summary-edit-map
ae06ea79 1335 (nconc (make-sparse-keymap) text-mode-map))
d41d75fb
RS
1336 (define-key rmail-summary-edit-map "\C-c\C-c" 'rmail-cease-edit)
1337 (define-key rmail-summary-edit-map "\C-c\C-]" 'rmail-abort-edit))
1338
1339(defun rmail-summary-edit-current-message ()
1340 "Edit the contents of this message."
1341 (interactive)
1342 (pop-to-buffer rmail-buffer)
1343 (rmail-edit-current-message)
1344 (use-local-map rmail-summary-edit-map))
1345
1346(defun rmail-summary-cease-edit ()
1347 "Finish editing message, then go back to Rmail summary buffer."
1348 (interactive)
1349 (rmail-cease-edit)
1350 (pop-to-buffer rmail-summary-buffer))
1351
1352(defun rmail-summary-abort-edit ()
1353 "Abort edit of current message; restore original contents.
1354Go back to summary buffer."
1355 (interactive)
1356 (rmail-abort-edit)
1357 (pop-to-buffer rmail-summary-buffer))
1358
e7a00c25
RS
1359(defun rmail-summary-search-backward (regexp &optional n)
1360 "Show message containing next match for REGEXP.
1361Prefix argument gives repeat count; negative argument means search
1362backwards (through earlier messages).
1363Interactively, empty argument means use same regexp used last time."
1364 (interactive
1365 (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
1366 (prompt
5b76833f 1367 (concat (if reversep "Reverse " "") "Rmail search (regexp"))
e7a00c25 1368 regexp)
5b76833f
RF
1369 (setq prompt
1370 (concat prompt
1371 (if rmail-search-last-regexp
1372 (concat ", default "
1373 rmail-search-last-regexp "): ")
1374 "): ")))
e7a00c25
RS
1375 (setq regexp (read-string prompt))
1376 (cond ((not (equal regexp ""))
1377 (setq rmail-search-last-regexp regexp))
1378 ((not rmail-search-last-regexp)
1379 (error "No previous Rmail search string")))
1380 (list rmail-search-last-regexp
1381 (prefix-numeric-value current-prefix-arg))))
1382 ;; Don't use save-excursion because that prevents point from moving
1383 ;; properly in the summary buffer.
1384 (let ((buffer (current-buffer)))
1385 (unwind-protect
1386 (progn
1387 (set-buffer rmail-buffer)
1388 (rmail-search regexp (- n)))
1389 (set-buffer buffer))))
1390
d41d75fb
RS
1391(defun rmail-summary-search (regexp &optional n)
1392 "Show message containing next match for REGEXP.
1393Prefix argument gives repeat count; negative argument means search
1394backwards (through earlier messages).
1395Interactively, empty argument means use same regexp used last time."
1396 (interactive
1397 (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
1398 (prompt
5b76833f 1399 (concat (if reversep "Reverse " "") "Rmail search (regexp"))
d41d75fb 1400 regexp)
5b76833f
RF
1401 (setq prompt
1402 (concat prompt
1403 (if rmail-search-last-regexp
1404 (concat ", default "
1405 rmail-search-last-regexp "): ")
1406 "): ")))
d41d75fb
RS
1407 (setq regexp (read-string prompt))
1408 (cond ((not (equal regexp ""))
1409 (setq rmail-search-last-regexp regexp))
1410 ((not rmail-search-last-regexp)
1411 (error "No previous Rmail search string")))
1412 (list rmail-search-last-regexp
1413 (prefix-numeric-value current-prefix-arg))))
e7a00c25
RS
1414 ;; Don't use save-excursion because that prevents point from moving
1415 ;; properly in the summary buffer.
1416 (let ((buffer (current-buffer)))
1417 (unwind-protect
1418 (progn
1419 (set-buffer rmail-buffer)
1420 (rmail-search regexp n))
1421 (set-buffer buffer))))
d41d75fb
RS
1422
1423(defun rmail-summary-toggle-header ()
1424 "Show original message header if pruned header currently shown, or vice versa."
1425 (interactive)
67f2e119 1426 (save-window-excursion
d41d75fb 1427 (set-buffer rmail-buffer)
387f203c
RS
1428 (rmail-toggle-header))
1429 ;; Inside save-excursion, some changes to point in the RMAIL buffer are lost.
1430 ;; Set point to point-min in the RMAIL buffer, if it is visible.
67f2e119 1431 (let ((window (get-buffer-window rmail-view-buffer)))
387f203c
RS
1432 (if window
1433 ;; Using save-window-excursion would lose the new value of point.
1434 (let ((owin (selected-window)))
1435 (unwind-protect
1436 (progn
1437 (select-window window)
1438 (goto-char (point-min)))
1439 (select-window owin))))))
1440
d41d75fb
RS
1441
1442(defun rmail-summary-add-label (label)
1443 "Add LABEL to labels associated with current Rmail message.
1444Completion is performed over known labels when reading."
980d43b6
RS
1445 (interactive (list (save-excursion
1446 (set-buffer rmail-buffer)
1447 (rmail-read-label "Add label"))))
d41d75fb
RS
1448 (save-excursion
1449 (set-buffer rmail-buffer)
1450 (rmail-add-label label)))
1451
1452(defun rmail-summary-kill-label (label)
1453 "Remove LABEL from labels associated with current Rmail message.
1454Completion is performed over known labels when reading."
980d43b6
RS
1455 (interactive (list (save-excursion
1456 (set-buffer rmail-buffer)
1457 (rmail-read-label "Kill label"))))
d41d75fb
RS
1458 (save-excursion
1459 (set-buffer rmail-buffer)
1460 (rmail-set-label label nil)))
1461\f
1462;;;; *** Rmail Summary Mailing Commands ***
1463
58285c3b 1464(defun rmail-summary-override-mail-send-and-exit ()
689421a9 1465 "Replace bindings to `mail-send-and-exit' with `rmail-summary-send-and-exit'."
58285c3b
GM
1466 (use-local-map (copy-keymap (current-local-map)))
1467 (dolist (key (where-is-internal 'mail-send-and-exit))
1468 (define-key (current-local-map) key 'rmail-summary-send-and-exit)))
1469
d41d75fb
RS
1470(defun rmail-summary-mail ()
1471 "Send mail in another window.
1472While composing the message, use \\[mail-yank-original] to yank the
1473original message into it."
1474 (interactive)
4c11ca80
RS
1475 (let ((window (get-buffer-window rmail-buffer)))
1476 (if window
1477 (select-window window)
1478 (set-buffer rmail-buffer)))
1479 (rmail-start-mail nil nil nil nil nil (current-buffer))
58285c3b 1480 (rmail-summary-override-mail-send-and-exit))
d41d75fb
RS
1481
1482(defun rmail-summary-continue ()
1483 "Continue composing outgoing message previously being composed."
1484 (interactive)
4c11ca80
RS
1485 (let ((window (get-buffer-window rmail-buffer)))
1486 (if window
1487 (select-window window)
1488 (set-buffer rmail-buffer)))
db1d3cf7 1489 (rmail-start-mail t))
d41d75fb
RS
1490
1491(defun rmail-summary-reply (just-sender)
1492 "Reply to the current message.
1493Normally include CC: to all other recipients of original message;
db1d3cf7
KH
1494prefix argument means ignore them. While composing the reply,
1495use \\[mail-yank-original] to yank the original message into it."
d41d75fb 1496 (interactive "P")
67f2e119 1497 (let ((window (get-buffer-window rmail-view-buffer)))
4c11ca80
RS
1498 (if window
1499 (select-window window)
67f2e119 1500 (set-buffer rmail-view-buffer)))
db1d3cf7 1501 (rmail-reply just-sender)
58285c3b 1502 (rmail-summary-override-mail-send-and-exit))
d41d75fb
RS
1503
1504(defun rmail-summary-retry-failure ()
1505 "Edit a mail message which is based on the contents of the current message.
1506For a message rejected by the mail system, extract the interesting headers and
1507the body of the original message; otherwise copy the current message."
1508 (interactive)
4c11ca80
RS
1509 (let ((window (get-buffer-window rmail-buffer)))
1510 (if window
1511 (select-window window)
1512 (set-buffer rmail-buffer)))
db1d3cf7 1513 (rmail-retry-failure)
58285c3b 1514 (rmail-summary-override-mail-send-and-exit))
d41d75fb
RS
1515
1516(defun rmail-summary-send-and-exit ()
1517 "Send mail reply and return to summary buffer."
1518 (interactive)
1519 (mail-send-and-exit t))
1520
18e90c58
RS
1521(defun rmail-summary-forward (resend)
1522 "Forward the current message to another user.
1523With prefix argument, \"resend\" the message instead of forwarding it;
1524see the documentation of `rmail-resend'."
1525 (interactive "P")
d41d75fb 1526 (save-excursion
4c11ca80
RS
1527 (let ((window (get-buffer-window rmail-buffer)))
1528 (if window
1529 (select-window window)
1530 (set-buffer rmail-buffer)))
18e90c58 1531 (rmail-forward resend)
58285c3b 1532 (rmail-summary-override-mail-send-and-exit)))
4986bd38
RS
1533
1534(defun rmail-summary-resend ()
689421a9 1535 "Resend current message using `rmail-resend'."
4986bd38
RS
1536 (interactive)
1537 (save-excursion
4c11ca80
RS
1538 (let ((window (get-buffer-window rmail-buffer)))
1539 (if window
1540 (select-window window)
1541 (set-buffer rmail-buffer)))
4986bd38 1542 (call-interactively 'rmail-resend)))
d41d75fb
RS
1543\f
1544;; Summary output commands.
1545
48afa9cd 1546(defun rmail-summary-output-to-rmail-file (&optional file-name n)
d41d75fb
RS
1547 "Append the current message to an Rmail file named FILE-NAME.
1548If the file does not exist, ask if it should be created.
1549If file is being visited, the message is appended to the Emacs
05422245
KH
1550buffer visiting that file.
1551
1552A prefix argument N says to output N consecutive messages
1553starting with the current one. Deleted messages are skipped and don't count."
f9e3db55
RS
1554 (interactive
1555 (progn (require 'rmailout)
1556 (list (rmail-output-read-rmail-file-name)
1557 (prefix-numeric-value current-prefix-arg))))
f256f63e 1558 (let ((i 0) prev-msg)
a1506d29 1559 (while
f256f63e
KH
1560 (and (< i n)
1561 (progn (rmail-summary-goto-msg)
1562 (not (eq prev-msg
1563 (setq prev-msg
a1506d29 1564 (with-current-buffer rmail-buffer
f256f63e 1565 rmail-current-message))))))
f9e3db55 1566 (setq i (1+ i))
f9e3db55
RS
1567 (with-current-buffer rmail-buffer
1568 (let ((rmail-delete-after-output nil))
1569 (rmail-output-to-rmail-file file-name 1)))
1570 (if rmail-delete-after-output
1571 (rmail-summary-delete-forward nil)
1572 (if (< i n)
1573 (rmail-summary-next-msg 1))))))
1574
1575(defun rmail-summary-output (&optional file-name n)
1576 "Append this message to Unix mail file named FILE-NAME.
1577
1578A prefix argument N says to output N consecutive messages
1579starting with the current one. Deleted messages are skipped and don't count."
1580 (interactive
1581 (progn (require 'rmailout)
1582 (list (rmail-output-read-file-name)
1583 (prefix-numeric-value current-prefix-arg))))
5a7a27be
RS
1584 (let ((i 0) prev-msg)
1585 (while
1586 (and (< i n)
1587 (progn (rmail-summary-goto-msg)
1588 (not (eq prev-msg
1589 (setq prev-msg
1590 (with-current-buffer rmail-buffer
1591 rmail-current-message))))))
f9e3db55
RS
1592 (setq i (1+ i))
1593 (with-current-buffer rmail-buffer
1594 (let ((rmail-delete-after-output nil))
1595 (rmail-output file-name 1)))
1596 (if rmail-delete-after-output
1597 (rmail-summary-delete-forward nil)
1598 (if (< i n)
1599 (rmail-summary-next-msg 1))))))
d41d75fb 1600
dca46072
RS
1601(defun rmail-summary-output-menu ()
1602 "Output current message to another Rmail file, chosen with a menu.
1603Also set the default for subsequent \\[rmail-output-to-rmail-file] commands.
1604The variables `rmail-secondary-file-directory' and
1605`rmail-secondary-file-regexp' control which files are offered in the menu."
1606 (interactive)
1607 (save-excursion
1608 (set-buffer rmail-buffer)
1609 (let ((rmail-delete-after-output nil))
1610 (call-interactively 'rmail-output-menu)))
1611 (if rmail-delete-after-output
1612 (rmail-summary-delete-forward nil)))
1613
aa138cb4
RS
1614(defun rmail-summary-construct-io-menu ()
1615 (let ((files (rmail-find-all-files rmail-secondary-file-directory)))
cb4903bc 1616 (if files
aa138cb4
RS
1617 (progn
1618 (define-key rmail-summary-mode-map [menu-bar classify input-menu]
a1506d29
JB
1619 (cons "Input Rmail File"
1620 (rmail-list-to-menu "Input Rmail File"
cb4903bc 1621 files
aa138cb4
RS
1622 'rmail-summary-input)))
1623 (define-key rmail-summary-mode-map [menu-bar classify output-menu]
a1506d29
JB
1624 (cons "Output Rmail File"
1625 (rmail-list-to-menu "Output Rmail File"
cb4903bc
RS
1626 files
1627 'rmail-summary-output-to-rmail-file))))
1628 (define-key rmail-summary-mode-map [menu-bar classify input-menu]
1629 '("Input Rmail File" . rmail-disable-menu))
1630 (define-key rmail-summary-mode-map [menu-bar classify output-menu]
1631 '("Output Rmail File" . rmail-disable-menu)))))
aa138cb4 1632
d5bafc55
RS
1633(defun rmail-summary-output-body (&optional file-name)
1634 "Write this message body to the file FILE-NAME.
1635FILE-NAME defaults, interactively, from the Subject field of the message."
1636 (interactive)
1637 (save-excursion
1638 (set-buffer rmail-buffer)
1639 (let ((rmail-delete-after-output nil))
1640 (if file-name
1641 (rmail-output-body-to-file file-name)
1642 (call-interactively 'rmail-output-body-to-file))))
1643 (if rmail-delete-after-output
1644 (rmail-summary-delete-forward nil)))
e45fce03
RS
1645\f
1646;; Sorting messages in Rmail Summary buffer.
1647
1648(defun rmail-summary-sort-by-date (reverse)
1649 "Sort messages of current Rmail summary by date.
1650If prefix argument REVERSE is non-nil, sort them in reverse order."
1651 (interactive "P")
1652 (rmail-sort-from-summary (function rmail-sort-by-date) reverse))
1653
1654(defun rmail-summary-sort-by-subject (reverse)
1655 "Sort messages of current Rmail summary by subject.
1656If prefix argument REVERSE is non-nil, sort them in reverse order."
1657 (interactive "P")
1658 (rmail-sort-from-summary (function rmail-sort-by-subject) reverse))
1659
1660(defun rmail-summary-sort-by-author (reverse)
1661 "Sort messages of current Rmail summary by author.
1662If prefix argument REVERSE is non-nil, sort them in reverse order."
1663 (interactive "P")
1664 (rmail-sort-from-summary (function rmail-sort-by-author) reverse))
1665
1666(defun rmail-summary-sort-by-recipient (reverse)
1667 "Sort messages of current Rmail summary by recipient.
1668If prefix argument REVERSE is non-nil, sort them in reverse order."
1669 (interactive "P")
1670 (rmail-sort-from-summary (function rmail-sort-by-recipient) reverse))
1671
1672(defun rmail-summary-sort-by-correspondent (reverse)
1673 "Sort messages of current Rmail summary by other correspondent.
1674If prefix argument REVERSE is non-nil, sort them in reverse order."
1675 (interactive "P")
1676 (rmail-sort-from-summary (function rmail-sort-by-correspondent) reverse))
1677
1678(defun rmail-summary-sort-by-lines (reverse)
1679 "Sort messages of current Rmail summary by lines of the message.
1680If prefix argument REVERSE is non-nil, sort them in reverse order."
1681 (interactive "P")
1682 (rmail-sort-from-summary (function rmail-sort-by-lines) reverse))
1683
e15dbc43
GM
1684(defun rmail-summary-sort-by-labels (reverse labels)
1685 "Sort messages of current Rmail summary by labels.
ebdf372b
KH
1686If prefix argument REVERSE is non-nil, sort them in reverse order.
1687KEYWORDS is a comma-separated list of labels."
1688 (interactive "P\nsSort by labels: ")
1689 (rmail-sort-from-summary
1690 (function (lambda (reverse)
e15dbc43 1691 (rmail-sort-by-labels reverse labels)))
ebdf372b
KH
1692 reverse))
1693
e45fce03
RS
1694(defun rmail-sort-from-summary (sortfun reverse)
1695 "Sort Rmail messages from Summary buffer and update it after sorting."
1696 (require 'rmailsort)
2a527e48
KH
1697 (let ((selwin (selected-window)))
1698 (unwind-protect
1699 (progn (pop-to-buffer rmail-buffer)
1700 (funcall sortfun reverse))
1701 (select-window selwin))))
c88ab9ce 1702
020c9ca5
DL
1703(provide 'rmailsum)
1704
cbee283d 1705;; arch-tag: 556079ee-75c1-47f5-9884-2e0a0bc6c5a1
c88ab9ce 1706;;; rmailsum.el ends here