HCoop / bpt / emacs.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Default to mboxrd in Rmail, allow mboxo as an option
[bpt/emacs.git] / lisp / mail / rmailsum.el
CommitLineData
537ab246
BG		 1;;; rmailsum.el --- make summary buffers for the mail reader
2
acaf905b 3;; Copyright (C) 1985, 1993-1996, 2000-2012 Free Software Foundation, Inc.
537ab246
BG		 4
5;; Maintainer: FSF
6;; Keywords: mail
bd78fa1d 7;; Package: rmail
537ab246
BG		 8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
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
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
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
30;;; Code:
31
97e92ffb 32;; For rmail-select-summary.
537ab246 33(require 'rmail)
d1be4ec2 34(require 'rfc2047)
537ab246 35
537ab246 36(defcustom rmail-summary-scroll-between-messages t
4b12219b
GM		 37 "Non-nil means Rmail summary scroll commands move between messages.
38That is, after `rmail-summary-scroll-msg-up' reaches the end of a
39message, it moves to the next message; and similarly for
40`rmail-summary-scroll-msg-down'."
537ab246
BG		 41 :type 'boolean
42 :group 'rmail-summary)
43
4b12219b
GM		 44;; FIXME could do with a :set function that regenerates the summary
45;; and updates rmail-summary-vector.
537ab246 46(defcustom rmail-summary-line-count-flag t
4b12219b
GM		 47 "Non-nil means Rmail summary should show the number of lines in each message.
48Setting this option to nil might speed up the generation of summaries."
537ab246
BG		 49 :type 'boolean
50 :group 'rmail-summary)
51
52(defvar rmail-summary-font-lock-keywords
53 '(("^.....D.*" . font-lock-string-face) ; Deleted.
54 ("^.....-.*" . font-lock-type-face) ; Unread.
55 ;; Neither of the below will be highlighted if either of the above are:
56 ("^.....[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date.
57 ("{ \\([^\n}]+\\) }" 1 font-lock-comment-face)) ; Labels.
58 "Additional expressions to highlight in Rmail Summary mode.")
59
97e92ffb 60(defvar rmail-summary-redo nil
537ab246
BG		 61 "(FUNCTION . ARGS) to regenerate this Rmail summary buffer.")
62
97e92ffb
GM		 63(defvar rmail-summary-overlay nil
64 "Overlay used to highlight the current message in the Rmail summary.")
537ab246
BG		 65(put 'rmail-summary-overlay 'permanent-local t)
66
b016851c
SM		 67(defvar rmail-summary-mode-map
68 (let ((map (make-keymap)))
69 (suppress-keymap map)
70 (define-key map [mouse-2] 'rmail-summary-mouse-goto-message)
71 (define-key map "a" 'rmail-summary-add-label)
72 (define-key map "b" 'rmail-summary-bury)
73 (define-key map "c" 'rmail-summary-continue)
74 (define-key map "d" 'rmail-summary-delete-forward)
75 (define-key map "\C-d" 'rmail-summary-delete-backward)
76 (define-key map "e" 'rmail-summary-edit-current-message)
77 (define-key map "f" 'rmail-summary-forward)
78 (define-key map "g" 'rmail-summary-get-new-mail)
79 (define-key map "h" 'rmail-summary)
80 (define-key map "i" 'rmail-summary-input)
81 (define-key map "j" 'rmail-summary-goto-msg)
82 (define-key map "\C-m" 'rmail-summary-goto-msg)
83 (define-key map "k" 'rmail-summary-kill-label)
84 (define-key map "l" 'rmail-summary-by-labels)
85 (define-key map "\e\C-h" 'rmail-summary)
86 (define-key map "\e\C-l" 'rmail-summary-by-labels)
87 (define-key map "\e\C-r" 'rmail-summary-by-recipients)
88 (define-key map "\e\C-s" 'rmail-summary-by-regexp)
89 ;; `f' for "from".
90 (define-key map "\e\C-f" 'rmail-summary-by-senders)
91 (define-key map "\e\C-t" 'rmail-summary-by-topic)
92 (define-key map "m" 'rmail-summary-mail)
93 (define-key map "\M-m" 'rmail-summary-retry-failure)
94 (define-key map "n" 'rmail-summary-next-msg)
95 (define-key map "\en" 'rmail-summary-next-all)
96 (define-key map "\e\C-n" 'rmail-summary-next-labeled-message)
97 (define-key map "o" 'rmail-summary-output)
98 (define-key map "\C-o" 'rmail-summary-output-as-seen)
99 (define-key map "p" 'rmail-summary-previous-msg)
100 (define-key map "\ep" 'rmail-summary-previous-all)
101 (define-key map "\e\C-p" 'rmail-summary-previous-labeled-message)
102 (define-key map "q" 'rmail-summary-quit)
103 (define-key map "Q" 'rmail-summary-wipe)
104 (define-key map "r" 'rmail-summary-reply)
105 (define-key map "s" 'rmail-summary-expunge-and-save)
106 ;; See rms's comment in rmail.el
107 ;; (define-key map "\er" 'rmail-summary-search-backward)
108 (define-key map "\es" 'rmail-summary-search)
109 (define-key map "t" 'rmail-summary-toggle-header)
110 (define-key map "u" 'rmail-summary-undelete)
111 (define-key map "\M-u" 'rmail-summary-undelete-many)
112 (define-key map "x" 'rmail-summary-expunge)
113 (define-key map "w" 'rmail-summary-output-body)
114 (define-key map "v" 'rmail-mime)
115 (define-key map "." 'rmail-summary-beginning-of-message)
116 (define-key map "/" 'rmail-summary-end-of-message)
117 (define-key map "<" 'rmail-summary-first-message)
118 (define-key map ">" 'rmail-summary-last-message)
119 (define-key map " " 'rmail-summary-scroll-msg-up)
120 (define-key map "\177" 'rmail-summary-scroll-msg-down)
121 (define-key map "?" 'describe-mode)
122 (define-key map "\C-c\C-n" 'rmail-summary-next-same-subject)
123 (define-key map "\C-c\C-p" 'rmail-summary-previous-same-subject)
124 (define-key map "\C-c\C-s\C-d" 'rmail-summary-sort-by-date)
125 (define-key map "\C-c\C-s\C-s" 'rmail-summary-sort-by-subject)
126 (define-key map "\C-c\C-s\C-a" 'rmail-summary-sort-by-author)
127 (define-key map "\C-c\C-s\C-r" 'rmail-summary-sort-by-recipient)
128 (define-key map "\C-c\C-s\C-c" 'rmail-summary-sort-by-correspondent)
129 (define-key map "\C-c\C-s\C-l" 'rmail-summary-sort-by-lines)
130 (define-key map "\C-c\C-s\C-k" 'rmail-summary-sort-by-labels)
131 (define-key map "\C-x\C-s" 'rmail-summary-save-buffer)
132
133 ;; Menu bar bindings.
134
135 (define-key map [menu-bar] (make-sparse-keymap))
136
137 (define-key map [menu-bar classify]
138 (cons "Classify" (make-sparse-keymap "Classify")))
139
140 (define-key map [menu-bar classify output-menu]
141 '("Output (Rmail Menu)..." . rmail-summary-output-menu))
142
143 (define-key map [menu-bar classify input-menu]
144 '("Input Rmail File (menu)..." . rmail-input-menu))
145
146 (define-key map [menu-bar classify input-menu]
147 '(nil))
148
149 (define-key map [menu-bar classify output-menu]
150 '(nil))
151
152 (define-key map [menu-bar classify output-body]
153 '("Output body..." . rmail-summary-output-body))
154
155 (define-key map [menu-bar classify output-inbox]
156 '("Output..." . rmail-summary-output))
157
158 (define-key map [menu-bar classify output]
159 '("Output as seen..." . rmail-summary-output-as-seen))
160
161 (define-key map [menu-bar classify kill-label]
162 '("Kill Label..." . rmail-summary-kill-label))
163
164 (define-key map [menu-bar classify add-label]
165 '("Add Label..." . rmail-summary-add-label))
166
167 (define-key map [menu-bar summary]
168 (cons "Summary" (make-sparse-keymap "Summary")))
169
170 (define-key map [menu-bar summary senders]
171 '("By Senders..." . rmail-summary-by-senders))
172
173 (define-key map [menu-bar summary labels]
174 '("By Labels..." . rmail-summary-by-labels))
175
176 (define-key map [menu-bar summary recipients]
177 '("By Recipients..." . rmail-summary-by-recipients))
178
179 (define-key map [menu-bar summary topic]
180 '("By Topic..." . rmail-summary-by-topic))
181
182 (define-key map [menu-bar summary regexp]
183 '("By Regexp..." . rmail-summary-by-regexp))
184
185 (define-key map [menu-bar summary all]
186 '("All" . rmail-summary))
187
188 (define-key map [menu-bar mail]
189 (cons "Mail" (make-sparse-keymap "Mail")))
190
191 (define-key map [menu-bar mail rmail-summary-get-new-mail]
192 '("Get New Mail" . rmail-summary-get-new-mail))
193
194 (define-key map [menu-bar mail lambda]
195 '("----"))
196
197 (define-key map [menu-bar mail continue]
198 '("Continue" . rmail-summary-continue))
199
200 (define-key map [menu-bar mail resend]
201 '("Re-send..." . rmail-summary-resend))
202
203 (define-key map [menu-bar mail forward]
204 '("Forward" . rmail-summary-forward))
205
206 (define-key map [menu-bar mail retry]
207 '("Retry" . rmail-summary-retry-failure))
208
209 (define-key map [menu-bar mail reply]
210 '("Reply" . rmail-summary-reply))
211
212 (define-key map [menu-bar mail mail]
213 '("Mail" . rmail-summary-mail))
214
215 (define-key map [menu-bar delete]
216 (cons "Delete" (make-sparse-keymap "Delete")))
217
218 (define-key map [menu-bar delete expunge/save]
219 '("Expunge/Save" . rmail-summary-expunge-and-save))
220
221 (define-key map [menu-bar delete expunge]
222 '("Expunge" . rmail-summary-expunge))
223
224 (define-key map [menu-bar delete undelete]
225 '("Undelete" . rmail-summary-undelete))
226
227 (define-key map [menu-bar delete delete]
228 '("Delete" . rmail-summary-delete-forward))
229
230 (define-key map [menu-bar move]
231 (cons "Move" (make-sparse-keymap "Move")))
232
233 (define-key map [menu-bar move search-back]
234 '("Search Back..." . rmail-summary-search-backward))
235
236 (define-key map [menu-bar move search]
237 '("Search..." . rmail-summary-search))
238
239 (define-key map [menu-bar move previous]
240 '("Previous Nondeleted" . rmail-summary-previous-msg))
241
242 (define-key map [menu-bar move next]
243 '("Next Nondeleted" . rmail-summary-next-msg))
244
245 (define-key map [menu-bar move last]
246 '("Last" . rmail-summary-last-message))
247
248 (define-key map [menu-bar move first]
249 '("First" . rmail-summary-first-message))
250
251 (define-key map [menu-bar move previous]
252 '("Previous" . rmail-summary-previous-all))
253
254 (define-key map [menu-bar move next]
255 '("Next" . rmail-summary-next-all))
256 map)
97e92ffb 257 "Keymap used in Rmail summary mode.")
537ab246
BG		 258
259;; Entry points for making a summary buffer.
260
261;; Regenerate the contents of the summary
262;; using the same selection criterion as last time.
263;; M-x revert-buffer in a summary buffer calls this function.
264(defun rmail-update-summary (&rest ignore)
265 (apply (car rmail-summary-redo) (cdr rmail-summary-redo)))
266
267;;;###autoload
268(defun rmail-summary ()
269 "Display a summary of all messages, one line per message."
270 (interactive)
40500957 271 (rmail-new-summary "All" '(rmail-summary) nil))
537ab246
BG		 272
273;;;###autoload
274(defun rmail-summary-by-labels (labels)
275 "Display a summary of all messages with one or more LABELS.
276LABELS should be a string containing the desired labels, separated by commas."
277 (interactive "sLabels to summarize by: ")
278 (if (string= labels "")
279 (setq labels (or rmail-last-multi-labels
280 (error "No label specified"))))
281 (setq rmail-last-multi-labels labels)
282 (rmail-new-summary (concat "labels " labels)
283 (list 'rmail-summary-by-labels labels)
284 'rmail-message-labels-p
bfc03247
CY		 285 (concat " \\("
286 (mail-comma-list-regexp labels)
287 "\\)\\(,\\|\\'\\)")))
537ab246 288
4b12219b
GM		 289;; FIXME "a string of regexps separated by commas" makes no sense because:
290;; i) it's pointless (you can just use \\|)
291;; ii) it's broken (you can't specify a literal comma)
292;; rmail-summary-by-topic and rmail-summary-by-senders have the same issue.
537ab246
BG		 293;;;###autoload
294(defun rmail-summary-by-recipients (recipients &optional primary-only)
295 "Display a summary of all messages with the given RECIPIENTS.
296Normally checks the To, From and Cc fields of headers;
297but if PRIMARY-ONLY is non-nil (prefix arg given),
298 only look in the To and From fields.
299RECIPIENTS is a string of regexps separated by commas."
300 (interactive "sRecipients to summarize by: \nP")
301 (rmail-new-summary
302 (concat "recipients " recipients)
303 (list 'rmail-summary-by-recipients recipients primary-only)
304 'rmail-message-recipients-p
305 (mail-comma-list-regexp recipients) primary-only))
306
307(defun rmail-message-recipients-p (msg recipients &optional primary-only)
308 (rmail-apply-in-message msg 'rmail-message-recipients-p-1
309 recipients primary-only))
310
311(defun rmail-message-recipients-p-1 (recipients &optional primary-only)
3ea5d765
GM		 312 ;; mail-fetch-field does not care where it starts from.
313 (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
537ab246
BG		 314 (or (string-match recipients (or (mail-fetch-field "To") ""))
315 (string-match recipients (or (mail-fetch-field "From") ""))
316 (if (not primary-only)
317 (string-match recipients (or (mail-fetch-field "Cc") "")))))
318
4b12219b
GM		 319;; FIXME I find this a non-obvious name for what this function does.
320;; Also, the optional WHOLE-MESSAGE argument of r-s-by-topic would
321;; seem more natural here.
537ab246
BG		 322;;;###autoload
323(defun rmail-summary-by-regexp (regexp)
324 "Display a summary of all messages according to regexp REGEXP.
325If the regular expression is found in the header of the message
326\(including in the date and other lines, as well as the subject line),
4b12219b 327Emacs will list the message in the summary."
537ab246
BG		 328 (interactive "sRegexp to summarize by: ")
329 (if (string= regexp "")
330 (setq regexp (or rmail-last-regexp
331 (error "No regexp specified"))))
332 (setq rmail-last-regexp regexp)
333 (rmail-new-summary (concat "regexp " regexp)
334 (list 'rmail-summary-by-regexp regexp)
335 'rmail-message-regexp-p
336 regexp))
337
338(defun rmail-message-regexp-p (msg regexp)
339 "Return t, if for message number MSG, regexp REGEXP matches in the header."
340 (rmail-apply-in-message msg 'rmail-message-regexp-p-1 msg regexp))
341
342(defun rmail-message-regexp-p-1 (msg regexp)
3ea5d765 343 ;; Search functions can expect to start from the beginning.
3fbc055f 344 (narrow-to-region (point) (save-excursion (search-forward "\n\n") (point)))
7fb18e9e
GM		 345 (if (and rmail-enable-mime
346 rmail-search-mime-header-function)
347 (funcall rmail-search-mime-header-function msg regexp (point))
537ab246
BG		 348 (re-search-forward regexp nil t)))
349
350;;;###autoload
351(defun rmail-summary-by-topic (subject &optional whole-message)
352 "Display a summary of all messages with the given SUBJECT.
70369cd3
GM		 353Normally checks just the Subject field of headers; but with prefix
354argument WHOLE-MESSAGE is non-nil, looks in the whole message.
537ab246
BG		 355SUBJECT is a string of regexps separated by commas."
356 (interactive
70369cd3
GM		 357 ;; We quote the default subject, because if it contains regexp
358 ;; special characters (eg "?"), it can fail to match itself. (Bug#2333)
359 (let* ((subject (regexp-quote (rmail-simplified-subject)))
537ab246
BG		 360 (prompt (concat "Topics to summarize by (regexp"
361 (if subject ", default current subject" "")
362 "): ")))
363 (list (read-string prompt nil nil subject) current-prefix-arg)))
364 (rmail-new-summary
365 (concat "about " subject)
366 (list 'rmail-summary-by-topic subject whole-message)
367 'rmail-message-subject-p
368 (mail-comma-list-regexp subject) whole-message))
369
370(defun rmail-message-subject-p (msg subject &optional whole-message)
371 (if whole-message
372 (rmail-apply-in-message msg 're-search-forward subject nil t)
373 (string-match subject (rmail-simplified-subject msg))))
374
375;;;###autoload
376(defun rmail-summary-by-senders (senders)
ac203e01
GM		 377 "Display a summary of all messages whose \"From\" field matches SENDERS.
378SENDERS is a string of regexps separated by commas."
537ab246
BG		 379 (interactive "sSenders to summarize by: ")
380 (rmail-new-summary
381 (concat "senders " senders)
382 (list 'rmail-summary-by-senders senders)
383 'rmail-message-senders-p
384 (mail-comma-list-regexp senders)))
385
386(defun rmail-message-senders-p (msg senders)
387 (string-match senders (or (rmail-get-header "From" msg) "")))
388\f
389;; General making of a summary buffer.
390
391(defvar rmail-summary-symbol-number 0)
392
393(defvar rmail-new-summary-line-count)
394
395(defun rmail-new-summary (desc redo func &rest args)
396 "Create a summary of selected messages.
397DESC makes part of the mode line of the summary buffer. REDO is form ...
398For each message, FUNC is applied to the message number and ARGS...
399and if the result is non-nil, that message is included.
400nil for FUNCTION means all messages."
401 (message "Computing summary lines...")
402 (unless rmail-buffer
403 (error "No RMAIL buffer found"))
71e027ac 404 (let (mesg was-in-summary sumbuf)
537ab246
BG		 405 (if (eq major-mode 'rmail-summary-mode)
406 (setq was-in-summary t))
407 (with-current-buffer rmail-buffer
71e027ac
GM		 408 (setq rmail-summary-buffer (rmail-new-summary-1 desc redo func args)
409 ;; r-s-b is buffer-local.
071c2340
GM		 410 sumbuf rmail-summary-buffer
411 mesg rmail-current-message))
537ab246
BG		 412 ;; Now display the summary buffer and go to the right place in it.
413 (unless was-in-summary
414 (if (and (one-window-p)
415 pop-up-windows
416 (not pop-up-frames))
417 ;; If there is just one window, put the summary on the top.
418 (progn
419 (split-window (selected-window) rmail-summary-window-size)
420 (select-window (next-window (frame-first-window)))
71e027ac 421 (rmail-pop-to-buffer sumbuf)
537ab246
BG		 422 ;; If pop-to-buffer did not use that window, delete that
423 ;; window. (This can happen if it uses another frame.)
71e027ac 424 (if (not (eq sumbuf (window-buffer (frame-first-window))))
537ab246 425 (delete-other-windows)))
71e027ac 426 (rmail-pop-to-buffer sumbuf))
537ab246
BG		 427 (set-buffer rmail-buffer)
428 ;; This is how rmail makes the summary buffer reappear.
429 ;; We do this here to make the window the proper size.
430 (rmail-select-summary nil)
52d129cd 431 (set-buffer sumbuf))
537ab246
BG		 432 (rmail-summary-goto-msg mesg t t)
433 (rmail-summary-construct-io-menu)
434 (message "Computing summary lines...done")))
435
436(defun rmail-new-summary-1 (description form function args)
437 "Filter messages to obtain summary lines.
438DESCRIPTION is added to the mode line.
439
440Return the summary buffer by invoking FUNCTION on each message
441passing the message number and ARGS...
442
443REDO is a form ...
444
445The current buffer must be a Rmail buffer either containing a
446collection of mbox formatted messages or displaying a single
447message."
448 (let ((summary-msgs ())
449 (rmail-new-summary-line-count 0)
450 (sumbuf (rmail-get-create-summary-buffer)))
451 ;; Scan the messages, getting their summary strings
452 ;; and putting the list of them in SUMMARY-MSGS.
453 (let ((msgnum 1)
454 (main-buffer (current-buffer))
455 (total rmail-total-messages)
456 (inhibit-read-only t))
457 (save-excursion
458 ;; Go where the mbox text is.
459 (if (rmail-buffers-swapped-p)
460 (set-buffer rmail-view-buffer))
461 (let ((old-min (point-min-marker))
462 (old-max (point-max-marker)))
463 (unwind-protect
464 ;; Can't use save-restriction here; that doesn't work if we
465 ;; plan to modify text outside the original restriction.
466 (save-excursion
467 (widen)
468 (goto-char (point-min))
469 (while (>= total msgnum)
470 ;; Go back to the Rmail buffer so
471 ;; so FUNCTION and rmail-get-summary can see its local vars.
472 (with-current-buffer main-buffer
473 ;; First test whether to include this message.
474 (if (or (null function)
475 (apply function msgnum args))
476 (setq summary-msgs
477 (cons (cons msgnum (rmail-get-summary msgnum))
478 summary-msgs))))
479 (setq msgnum (1+ msgnum))
480 ;; Provide a periodic User progress message.
435f0dd2
EZ		 481 (if (and (not (zerop rmail-new-summary-line-count))
482 (zerop (% rmail-new-summary-line-count 10)))
537ab246
BG		 483 (message "Computing summary lines...%d"
484 rmail-new-summary-line-count)))
485 (setq summary-msgs (nreverse summary-msgs)))
486 (narrow-to-region old-min old-max)))))
537ab246
BG		 487 ;; Temporarily, while summary buffer is unfinished,
488 ;; we "don't have" a summary.
70369cd3 489 (setq rmail-summary-buffer nil)
537ab246
BG		 490 ;; I have not a clue what this clause is doing. If you read this
491 ;; chunk of code and have a clue, then please email that clue to
492 ;; pmr@pajato.com
537ab246
BG		 493 (if rmail-enable-mime
494 (with-current-buffer rmail-buffer
495 (setq rmail-summary-buffer nil)))
537ab246
BG		 496 (save-excursion
497 (let ((rbuf (current-buffer))
498 (total rmail-total-messages))
499 (set-buffer sumbuf)
500 ;; Set up the summary buffer's contents.
501 (let ((buffer-read-only nil))
502 (erase-buffer)
503 (while summary-msgs
504 (princ (cdr (car summary-msgs)) sumbuf)
505 (setq summary-msgs (cdr summary-msgs)))
506 (goto-char (point-min)))
507 ;; Set up the rest of its state and local variables.
508 (setq buffer-read-only t)
509 (rmail-summary-mode)
510 (make-local-variable 'minor-mode-alist)
511 (setq minor-mode-alist (list (list t (concat ": " description))))
512 (setq rmail-buffer rbuf
513 rmail-summary-redo form
514 rmail-total-messages total)))
515 sumbuf))
516
517(defun rmail-get-create-summary-buffer ()
11d6c061
GM		 518 "Return the Rmail summary buffer.
519If necessary, it is created and undo is disabled."
537ab246
BG		 520 (if (and rmail-summary-buffer (buffer-name rmail-summary-buffer))
521 rmail-summary-buffer
11d6c061
GM		 522 (let ((buff (generate-new-buffer (concat (buffer-name) "-summary"))))
523 (with-current-buffer buff
524 (setq buffer-undo-list t))
525 buff)))
8d2b2df4 526
537ab246
BG		 527\f
528;; Low levels of generating a summary.
529
530(defun rmail-get-summary (msgnum)
531 "Return the summary line for message MSGNUM.
532The mbox buffer must be current when you call this function
533even if its text is swapped.
534
535If the message has a summary line already, it will be stored in
536the message as a header and simply returned, otherwise the
537summary line is created, saved in the message header, cached and
538returned.
539
540The current buffer contains the unrestricted message collection."
541 (let ((line (aref rmail-summary-vector (1- msgnum))))
542 (unless line
543 ;; Register a summary line for MSGNUM.
544 (setq rmail-new-summary-line-count (1+ rmail-new-summary-line-count)
545 line (rmail-create-summary-line msgnum))
546 ;; Cache the summary line for use during this Rmail session.
547 (aset rmail-summary-vector (1- msgnum) line))
548 line))
549
d1be4ec2 550(defcustom rmail-summary-line-decoder (function rfc2047-decode-string)
8d2b2df4 551 "Function to decode a Rmail summary line.
537ab246
BG		 552It receives the summary line for one message as a string
553and should return the decoded string.
554
d1be4ec2
KH		 555By default, it is `rfc2047-decode-string', which decodes MIME-encoded
556subject."
537ab246 557 :type 'function
d1be4ec2 558 :version "23.3"
537ab246
BG		 559 :group 'rmail-summary)
560
561(defun rmail-create-summary-line (msgnum)
562 "Return the summary line for message MSGNUM.
563Obtain the message summary from the header if it is available
564otherwise create it and store it in the message header.
565
566The mbox buffer must be current when you call this function
567even if its text is swapped."
568 (let ((beg (rmail-msgbeg msgnum))
569 (end (rmail-msgend msgnum))
570 (deleted (rmail-message-deleted-p msgnum))
3ea5d765
GM		 571 ;; Does not work (swapped?)
572;;; (unseen (rmail-message-unseen-p msgnum))
573 unseen lines)
537ab246
BG		 574 (save-excursion
575 ;; Switch to the buffer that has the whole mbox text.
576 (if (rmail-buffers-swapped-p)
577 (set-buffer rmail-view-buffer))
578 ;; Now we can compute the line count.
579 (if rmail-summary-line-count-flag
580 (setq lines (count-lines beg end)))
537ab246
BG		 581 ;; Narrow to the message header.
582 (save-excursion
8acdd748
GM		 583 (save-restriction
584 (widen)
585 (goto-char beg)
586 (if (search-forward "\n\n" end t)
587 (progn
588 (narrow-to-region beg (point))
589 ;; Replace rmail-message-unseen-p from above.
590 (goto-char beg)
591 (setq unseen (and (search-forward
592 (concat rmail-attribute-header ": ") nil t)
593 (looking-at "......U")))
594 ;; Generate a status line from the message.
595 (rmail-create-summary msgnum deleted unseen lines))
596 (rmail-error-bad-format msgnum)))))))
537ab246 597
3ea5d765
GM		 598;; FIXME this is now unused.
599;; The intention was to display in the summary something like {E}
600;; for an edited messaged, similarly for answered, etc.
601;; But that conflicts with the previous rmail usage, where
602;; any user-defined { labels } occupied this space.
603;; So whilst it would be nice to have this information in the summary,
604;; it would need to go somewhere else.
605(defun rmail-get-summary-status ()
606 "Return a coded string wrapped in curly braces denoting the status.
537ab246
BG		 607
608The current buffer must already be narrowed to the message headers for
609the message being processed."
610 (let ((status (mail-fetch-field rmail-attribute-header))
611 (index 0)
612 (result "")
613 char)
614 ;; Strip off the read/unread and the deleted attribute which are
615 ;; handled separately.
616 (setq status
617 (if status
618 (concat (substring status 0 1) (substring status 2 6))
619 ""))
620 (while (< index (length status))
621 (unless (string= "-" (setq char (substring status index (1+ index))))
622 (setq result (concat result char)))
623 (setq index (1+ index)))
624 (when (> (length result) 0)
625 (setq result (concat "{" result "}")))
626 result))
627
5c9b1aaa
GM		 628(autoload 'rmail-make-label "rmailkwd")
629
3ea5d765
GM		 630(defun rmail-get-summary-labels ()
631 "Return a string wrapped in curly braces with the current message labels.
632Returns nil if there are no labels. The current buffer must
633already be narrowed to the message headers for the message being
634processed."
635 (let ((labels (mail-fetch-field rmail-keyword-header)))
c49edcd1
GM		 636 (and labels
637 (not (string-equal labels ""))
5c9b1aaa
GM		 638 (progn
639 ;; Intern so that rmail-read-label can offer completion.
640 (mapc 'rmail-make-label (split-string labels ", "))
641 (format "{ %s } " labels)))))
3ea5d765 642
537ab246
BG		 643(defun rmail-create-summary (msgnum deleted unseen lines)
644 "Return the summary line for message MSGNUM.
645The current buffer should already be narrowed to the header for that message.
646It could be either buffer, so don't access Rmail local variables.
647DELETED is t if this message is marked deleted.
648UNSEEN is t if it is marked unseen.
649LINES is the number of lines in the message (if we should display that)
650 or else nil."
651 (goto-char (point-min))
652 (let ((line (rmail-header-summary))
653 (labels (rmail-get-summary-labels))
654 pos status prefix basic-start basic-end linecount-string)
655
656 (setq linecount-string
657 (cond
658 ((not lines) " ")
659 ((<= lines 9) (format " [%d]" lines))
660 ((<= lines 99) (format " [%d]" lines))
661 ((<= lines 999) (format " [%d]" lines))
662 ((<= lines 9999) (format " [%dk]" (/ lines 1000)))
663 ((<= lines 99999) (format " [%dk]" (/ lines 1000)))
664 (t (format "[%dk]" (/ lines 1000)))))
665
666 (setq status (cond
667 (deleted ?D)
668 (unseen ?-)
669 (t ? ))
3ea5d765 670 prefix (format "%5d%c " msgnum status)
537ab246
BG		 671 basic-start (car line)
672 basic-end (cadr line))
673 (funcall rmail-summary-line-decoder
674 (concat prefix basic-start linecount-string " "
675 labels basic-end))))
676
537ab246
BG		 677(defun rmail-header-summary ()
678 "Return a message summary based on the message headers.
679The value is a list of two strings, the first and second parts of the summary.
680
681The current buffer must already be narrowed to the message headers for
682the message being processed."
683 (goto-char (point-min))
684 (list
685 (concat (save-excursion
686 (if (not (re-search-forward "^Date:" nil t))
687 " "
8f94cbed
EZ		 688 ;; Match month names case-insensitively
689 (cond ((let ((case-fold-search t))
690 (re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)"
691 (line-end-position) t))
537ab246
BG		 692 (format "%2d-%3s"
693 (string-to-number (buffer-substring
694 (match-beginning 2)
695 (match-end 2)))
696 (buffer-substring
697 (match-beginning 4) (match-end 4))))
8f94cbed
EZ		 698 ((let ((case-fold-search t))
699 (re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)"
700 (line-end-position) t))
537ab246
BG		 701 (format "%2d-%3s"
702 (string-to-number (buffer-substring
703 (match-beginning 4)
704 (match-end 4)))
705 (buffer-substring
706 (match-beginning 2) (match-end 2))))
707 ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)"
98a9d488 708 (line-end-position) t)
537ab246
BG		 709 (format "%2s%2s%2s"
710 (buffer-substring
711 (match-beginning 2) (match-end 2))
712 (buffer-substring
713 (match-beginning 3) (match-end 3))
714 (buffer-substring
715 (match-beginning 4) (match-end 4))))
716 (t "??????"))))
717 " "
718 (save-excursion
719 (let* ((from (and (re-search-forward "^From:[ \t]*" nil t)
720 (mail-strip-quoted-names
721 (buffer-substring
722 (1- (point))
723 ;; Get all the lines of the From field
724 ;; so that we get a whole comment if there is one,
725 ;; so that mail-strip-quoted-names can discard it.
726 (let ((opoint (point)))
727 (while (progn (forward-line 1)
728 (looking-at "[ \t]")))
729 ;; Back up over newline, then trailing spaces or tabs
730 (forward-char -1)
731 (skip-chars-backward " \t")
732 (point))))))
733 len mch lo)
734 (if (or (null from)
735 (string-match
736 (or rmail-user-mail-address-regexp
737 (concat "^\\("
738 (regexp-quote (user-login-name))
739 "\\($\\|@\\)\\|"
740 (regexp-quote
741 ;; Don't lose if run from init file
742 ;; where user-mail-address is not
743 ;; set yet.
744 (or user-mail-address
745 (concat (user-login-name) "@"
746 (or mail-host-address
747 (system-name)))))
748 "\\>\\)"))
749 from))
750 ;; No From field, or it's this user.
751 (save-excursion
752 (goto-char (point-min))
753 (if (not (re-search-forward "^To:[ \t]*" nil t))
754 nil
755 (setq from
756 (concat "to: "
757 (mail-strip-quoted-names
758 (buffer-substring
759 (point)
760 (progn (end-of-line)
761 (skip-chars-backward " \t")
762 (point)))))))))
763 (if (null from)
764 " "
92a8eba5
EZ		 765 ;; We are going to return only 25 characters of the
766 ;; address, so make sure it is RFC2047 decoded before
767 ;; taking its substring. This is important when the address is not on the same line as the name, e.g.:
768 ;; To: =?UTF-8?Q?=C5=A0t=C4=9Bp=C3=A1n_?= =?UTF-8?Q?N=C4=9Bmec?=
769 ;; <stepnem@gmail.com>
770 (setq from (rfc2047-decode-string from))
537ab246
BG		 771 (setq len (length from))
772 (setq mch (string-match "[@%]" from))
773 (format "%25s"
774 (if (or (not mch) (<= len 25))
775 (substring from (max 0 (- len 25)))
776 (substring from
777 (setq lo (cond ((< (- mch 14) 0) 0)
778 ((< len (+ mch 11))
779 (- len 25))
780 (t (- mch 14))))
781 (min len (+ lo 25)))))))))
782 (concat (if (re-search-forward "^Subject:" nil t)
d1be4ec2
KH		 783 (let (pos str)
784 (skip-chars-forward " \t")
785 (setq pos (point))
786 (forward-line 1)
787 (setq str (buffer-substring pos (1- (point))))
3a989246 788 (while (looking-at "[ \t]")
d1be4ec2
KH		 789 (setq str (concat str " "
790 (buffer-substring (match-end 0)
791 (line-end-position))))
792 (forward-line 1))
793 str)
537ab246
BG		 794 (re-search-forward "[\n][\n]+" nil t)
795 (buffer-substring (point) (progn (end-of-line) (point))))
796 "\n")))
797\f
798;; Simple motion in a summary buffer.
799
800(defun rmail-summary-next-all (&optional number)
801 (interactive "p")
802 (forward-line (if number number 1))
803 ;; It doesn't look nice to move forward past the last message line.
804 (and (eobp) (> number 0)
805 (forward-line -1))
806 (display-buffer rmail-buffer))
807
808(defun rmail-summary-previous-all (&optional number)
809 (interactive "p")
810 (forward-line (- (if number number 1)))
811 ;; It doesn't look nice to move forward past the last message line.
812 (and (eobp) (< number 0)
813 (forward-line -1))
814 (display-buffer rmail-buffer))
815
816(defun rmail-summary-next-msg (&optional number)
817 "Display next non-deleted msg from rmail file.
818With optional prefix argument NUMBER, moves forward this number of non-deleted
819messages, or backward if NUMBER is negative."
820 (interactive "p")
821 (forward-line 0)
822 (and (> number 0) (end-of-line))
823 (let ((count (if (< number 0) (- number) number))
824 (search (if (> number 0) 're-search-forward 're-search-backward))
825 (non-del-msg-found nil))
826 (while (and (> count 0) (setq non-del-msg-found
827 (or (funcall search "^.....[^D]" nil t)
828 non-del-msg-found)))
829 (setq count (1- count))))
830 (beginning-of-line)
831 (display-buffer rmail-buffer))
832
833(defun rmail-summary-previous-msg (&optional number)
834 "Display previous non-deleted msg from rmail file.
835With optional prefix argument NUMBER, moves backward this number of
836non-deleted messages."
837 (interactive "p")
838 (rmail-summary-next-msg (- (if number number 1))))
839
840(defun rmail-summary-next-labeled-message (n labels)
841 "Show next message with LABELS. Defaults to last labels used.
842With prefix argument N moves forward N messages with these labels."
843 (interactive "p\nsMove to next msg with labels: ")
844 (let (msg)
937e6a56 845 (with-current-buffer rmail-buffer
537ab246
BG		 846 (rmail-next-labeled-message n labels)
847 (setq msg rmail-current-message))
848 (rmail-summary-goto-msg msg)))
849
850(defun rmail-summary-previous-labeled-message (n labels)
851 "Show previous message with LABELS. Defaults to last labels used.
852With prefix argument N moves backward N messages with these labels."
853 (interactive "p\nsMove to previous msg with labels: ")
854 (let (msg)
937e6a56 855 (with-current-buffer rmail-buffer
537ab246
BG		 856 (rmail-previous-labeled-message n labels)
857 (setq msg rmail-current-message))
858 (rmail-summary-goto-msg msg)))
859
860(defun rmail-summary-next-same-subject (n)
861 "Go to the next message in the summary having the same subject.
862With prefix argument N, do this N times.
863If N is negative, go backwards."
864 (interactive "p")
865 (let ((forward (> n 0))
866 subject i found)
867 (with-current-buffer rmail-buffer
868 (setq subject (rmail-simplified-subject)
869 i rmail-current-message))
870 (save-excursion
871 (while (and (/= n 0)
872 (if forward
873 (not (eobp))
874 (not (bobp))))
875 (let (done)
876 (while (and (not done)
877 (if forward
878 (not (eobp))
879 (not (bobp))))
880 ;; Advance thru summary.
881 (forward-line (if forward 1 -1))
882 ;; Get msg number of this line.
883 (setq i (string-to-number
884 (buffer-substring (point)
885 (min (point-max) (+ 6 (point))))))
886 (setq done (string-equal subject (rmail-simplified-subject i))))
887 (if done (setq found i)))
888 (setq n (if forward (1- n) (1+ n)))))
889 (if found
890 (rmail-summary-goto-msg found)
891 (error "No %s message with same subject"
892 (if forward "following" "previous")))))
893
894(defun rmail-summary-previous-same-subject (n)
895 "Go to the previous message in the summary having the same subject.
896With prefix argument N, do this N times.
897If N is negative, go forwards instead."
898 (interactive "p")
899 (rmail-summary-next-same-subject (- n)))
900\f
901;; Delete and undelete summary commands.
902
903(defun rmail-summary-delete-forward (&optional count)
904 "Delete this message and move to next nondeleted one.
905Deleted messages stay in the file until the \\[rmail-expunge] command is given.
906A prefix argument serves as a repeat count;
907a negative argument means to delete and move backward."
908 (interactive "p")
909 (unless (numberp count) (setq count 1))
910 (let (end del-msg
911 (backward (< count 0)))
912 (while (/= count 0)
913 (rmail-summary-goto-msg)
914 (with-current-buffer rmail-buffer
915 (rmail-delete-message)
916 (setq del-msg rmail-current-message))
917 (rmail-summary-mark-deleted del-msg)
918 (while (and (not (if backward (bobp) (eobp)))
919 (save-excursion (beginning-of-line)
920 (looking-at " *[0-9]+D")))
921 (forward-line (if backward -1 1)))
922 ;; It looks ugly to move to the empty line at end of buffer.
923 (and (eobp) (not backward)
924 (forward-line -1))
925 (setq count
926 (if (> count 0) (1- count) (1+ count))))))
927
928(defun rmail-summary-delete-backward (&optional count)
929 "Delete this message and move to previous nondeleted one.
930Deleted messages stay in the file until the \\[rmail-expunge] command is given.
931A prefix argument serves as a repeat count;
932a negative argument means to delete and move forward."
933 (interactive "p")
934 (rmail-summary-delete-forward (- count)))
935
936(defun rmail-summary-mark-deleted (&optional n undel)
937 ;; Since third arg is t, this only alters the summary, not the Rmail buf.
938 (and n (rmail-summary-goto-msg n t t))
939 (or (eobp)
940 (not (overlay-get rmail-summary-overlay 'face))
941 (let ((buffer-read-only nil))
942 (skip-chars-forward " ")
97e92ffb 943 (skip-chars-forward "0-9")
537ab246
BG		 944 (if undel
945 (if (looking-at "D")
946 (progn (delete-char 1) (insert " ")))
947 (delete-char 1)
96a07ae9
CY		 948 (insert "D"))
949 ;; Register a new summary line.
950 (with-current-buffer rmail-buffer
951 (aset rmail-summary-vector (1- n) (rmail-create-summary-line n)))))
537ab246
BG		 952 (beginning-of-line))
953
8fbbdd44
GM		 954(defun rmail-summary-update-line (n)
955 "Update the summary line for message N."
956 (when (rmail-summary-goto-msg n t t)
957 (let* ((buffer-read-only nil)
958 (start (line-beginning-position))
959 (end (line-beginning-position 2))
960 (overlays (overlays-in start end))
961 high ov)
962 (while (and (setq ov (car overlays))
963 (not (setq high (overlay-get ov 'rmail-summary))))
964 (setq overlays (cdr overlays)))
45bd6461 965 (delete-region start end)
8fbbdd44
GM		 966 (princ
967 (with-current-buffer rmail-buffer
968 (aset rmail-summary-vector (1- n) (rmail-create-summary-line n)))
969 (current-buffer))
970 (when high
971 (forward-line -1)
972 (rmail-summary-update-highlight nil)))))
973
537ab246
BG		 974(defun rmail-summary-mark-undeleted (n)
975 (rmail-summary-mark-deleted n t))
976
977(defun rmail-summary-deleted-p (&optional n)
978 (save-excursion
979 (and n (rmail-summary-goto-msg n nil t))
980 (skip-chars-forward " ")
97e92ffb 981 (skip-chars-forward "0-9")
537ab246
BG		 982 (looking-at "D")))
983
984(defun rmail-summary-undelete (&optional arg)
985 "Undelete current message.
986Optional prefix ARG means undelete ARG previous messages."
987 (interactive "p")
988 (if (/= arg 1)
989 (rmail-summary-undelete-many arg)
990 (let ((buffer-read-only nil)
991 (opoint (point)))
992 (end-of-line)
993 (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t)
994 (replace-match "\\1 ")
995 (rmail-summary-goto-msg)
996 (if rmail-enable-mime
997 (set-buffer rmail-buffer)
60f2013c 998 (rmail-pop-to-buffer rmail-buffer))
537ab246
BG		 999 (and (rmail-message-deleted-p rmail-current-message)
1000 (rmail-undelete-previous-message))
1001 (if rmail-enable-mime
60f2013c
GM		 1002 (rmail-pop-to-buffer rmail-buffer))
1003 (rmail-pop-to-buffer rmail-summary-buffer))
537ab246
BG		 1004 (t (goto-char opoint))))))
1005
1006(defun rmail-summary-undelete-many (&optional n)
1007 "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs."
1008 (interactive "P")
937e6a56 1009 (with-current-buffer rmail-buffer
537ab246
BG		 1010 (let* ((init-msg (if n rmail-current-message rmail-total-messages))
1011 (rmail-current-message init-msg)
1012 (n (or n rmail-total-messages))
1013 (msgs-undeled 0))
1014 (while (and (> rmail-current-message 0)
1015 (< msgs-undeled n))
1016 (if (rmail-message-deleted-p rmail-current-message)
8acdd748 1017 (progn (rmail-set-attribute rmail-deleted-attr-index nil)
537ab246
BG		 1018 (setq msgs-undeled (1+ msgs-undeled))))
1019 (setq rmail-current-message (1- rmail-current-message)))
1020 (set-buffer rmail-summary-buffer)
1021 (setq rmail-current-message init-msg msgs-undeled 0)
1022 (while (and (> rmail-current-message 0)
1023 (< msgs-undeled n))
1024 (if (rmail-summary-deleted-p rmail-current-message)
1025 (progn (rmail-summary-mark-undeleted rmail-current-message)
1026 (setq msgs-undeled (1+ msgs-undeled))))
1027 (setq rmail-current-message (1- rmail-current-message))))
1028 (rmail-summary-goto-msg)))
1029\f
1030;; Rmail Summary mode is suitable only for specially formatted data.
1031(put 'rmail-summary-mode 'mode-class 'special)
1032
1033(defun rmail-summary-mode ()
1034 "Rmail Summary Mode is invoked from Rmail Mode by using \\<rmail-mode-map>\\[rmail-summary].
1035As commands are issued in the summary buffer, they are applied to the
1036corresponding mail messages in the rmail buffer.
1037
1038All normal editing commands are turned off.
1039Instead, nearly all the Rmail mode commands are available,
1040though many of them move only among the messages in the summary.
1041
1042These additional commands exist:
1043
1044\\[rmail-summary-undelete-many] Undelete all or prefix arg deleted messages.
1045\\[rmail-summary-wipe] Delete the summary and go to the Rmail buffer.
1046
1047Commands for sorting the summary:
1048
1049\\[rmail-summary-sort-by-date] Sort by date.
1050\\[rmail-summary-sort-by-subject] Sort by subject.
1051\\[rmail-summary-sort-by-author] Sort by author.
1052\\[rmail-summary-sort-by-recipient] Sort by recipient.
1053\\[rmail-summary-sort-by-correspondent] Sort by correspondent.
1054\\[rmail-summary-sort-by-lines] Sort by lines.
1055\\[rmail-summary-sort-by-labels] Sort by labels."
1056 (interactive)
1057 (kill-all-local-variables)
1058 (setq major-mode 'rmail-summary-mode)
1059 (setq mode-name "RMAIL Summary")
1060 (setq truncate-lines t)
1061 (setq buffer-read-only t)
1062 (set-syntax-table text-mode-syntax-table)
1063 (make-local-variable 'rmail-buffer)
1064 (make-local-variable 'rmail-total-messages)
1065 (make-local-variable 'rmail-current-message)
1066 (setq rmail-current-message nil)
1067 (make-local-variable 'rmail-summary-redo)
1068 (setq rmail-summary-redo nil)
1069 (make-local-variable 'revert-buffer-function)
1070 (make-local-variable 'font-lock-defaults)
1071 (setq font-lock-defaults '(rmail-summary-font-lock-keywords t))
1072 (rmail-summary-enable)
1073 (run-mode-hooks 'rmail-summary-mode-hook))
1074
1075;; Summary features need to be disabled during edit mode.
1076(defun rmail-summary-disable ()
1077 (use-local-map text-mode-map)
1078 (remove-hook 'post-command-hook 'rmail-summary-rmail-update t)
1079 (setq revert-buffer-function nil))
1080
1081(defun rmail-summary-enable ()
1082 (use-local-map rmail-summary-mode-map)
1083 (add-hook 'post-command-hook 'rmail-summary-rmail-update nil t)
1084 (setq revert-buffer-function 'rmail-update-summary))
1085
36aecf22 1086(defun rmail-summary-mark-seen (n &optional nomove unseen)
97e92ffb
GM		 1087 "Remove the unseen mark from the current message, update the summary vector.
1088N is the number of the current message. Optional argument NOMOVE
36aecf22
GM		 1089non-nil means we are already at the right column. Optional argument
1090UNSEEN non-nil means mark the message as unseen."
97e92ffb
GM		 1091 (save-excursion
1092 (unless nomove
1093 (beginning-of-line)
1094 (skip-chars-forward " ")
1095 (skip-chars-forward "0-9"))
36aecf22 1096 (when (char-equal (following-char) (if unseen ?\s ?-))
97e92ffb
GM		 1097 (let ((buffer-read-only nil))
1098 (delete-char 1)
36aecf22 1099 (insert (if unseen "-" " ")))
97e92ffb
GM		 1100 (let ((line (buffer-substring-no-properties (line-beginning-position)
1101 (line-beginning-position 2))))
1102 (with-current-buffer rmail-buffer
1103 (aset rmail-summary-vector (1- n) line))))))
1104
537ab246
BG		 1105(defvar rmail-summary-put-back-unseen nil
1106 "Used for communicating between calls to `rmail-summary-rmail-update'.
1107If it moves to a message within an Incremental Search, and removes
1108the `unseen' attribute from that message, it sets this flag
1109so that if the next motion between messages is in the same Incremental
1110Search, the `unseen' attribute is restored.")
1111
1112;; Show in Rmail the message described by the summary line that point is on,
1113;; but only if the Rmail buffer is already visible.
1114;; This is a post-command-hook in summary buffers.
1115(defun rmail-summary-rmail-update ()
1116 (let (buffer-read-only)
1117 (save-excursion
1118 ;; If at end of buffer, pretend we are on the last text line.
1119 (if (eobp)
1120 (forward-line -1))
1121 (beginning-of-line)
1122 (skip-chars-forward " ")
1123 (let ((msg-num (string-to-number (buffer-substring
1124 (point)
1125 (progn (skip-chars-forward "0-9")
1126 (point))))))
1127 ;; Always leave `unseen' removed
1128 ;; if we get out of isearch mode.
1129 ;; Don't let a subsequent isearch restore that `unseen'.
1130 (if (not isearch-mode)
1131 (setq rmail-summary-put-back-unseen nil))
1132
1133 (or (eq rmail-current-message msg-num)
1134 (let ((window (get-buffer-window rmail-buffer t))
1135 (owin (selected-window)))
1136 (if isearch-mode
36aecf22 1137 (progn
537ab246
BG		 1138 ;; If we first saw the previous message in this search,
1139 ;; and we have gone to a different message while searching,
1140 ;; put back `unseen' on the former one.
36aecf22
GM		 1141 (when rmail-summary-put-back-unseen
1142 (rmail-set-attribute rmail-unseen-attr-index t
1143 rmail-current-message)
1144 (save-excursion
1145 (goto-char rmail-summary-put-back-unseen)
1146 (rmail-summary-mark-seen rmail-current-message t t)))
537ab246
BG		 1147 ;; Arrange to do that later, for the new current message,
1148 ;; if it still has `unseen'.
1149 (setq rmail-summary-put-back-unseen
36aecf22
GM		 1150 (if (rmail-message-unseen-p msg-num)
1151 (point))))
537ab246 1152 (setq rmail-summary-put-back-unseen nil))
537ab246
BG		 1153 ;; Go to the desired message.
1154 (setq rmail-current-message msg-num)
537ab246 1155 ;; Update the summary to show the message has been seen.
97e92ffb 1156 (rmail-summary-mark-seen msg-num t)
537ab246
BG		 1157 (if window
1158 ;; Using save-window-excursion would cause the new value
1159 ;; of point to get lost.
1160 (unwind-protect
1161 (progn
1162 (select-window window)
bc04f207 1163 (rmail-show-message msg-num t))
537ab246
BG		 1164 (select-window owin))
1165 (if (buffer-name rmail-buffer)
937e6a56 1166 (with-current-buffer rmail-buffer
b42b2189
CY		 1167 (rmail-show-message msg-num t))))
1168 ;; In linum mode, the message buffer must be specially
1169 ;; updated (Bug#4878).
1170 (and (fboundp 'linum-update)
1171 (buffer-name rmail-buffer)
1172 (linum-update rmail-buffer))))
537ab246
BG		 1173 (rmail-summary-update-highlight nil)))))
1174
1175(defun rmail-summary-save-buffer ()
1176 "Save the buffer associated with this RMAIL summary."
1177 (interactive)
1178 (save-window-excursion
1179 (save-excursion
1180 (switch-to-buffer rmail-buffer)
1181 (save-buffer))))
537ab246
BG		 1182\f
1183(defun rmail-summary-mouse-goto-message (event)
1184 "Select the message whose summary line you click on."
1185 (interactive "@e")
1186 (goto-char (posn-point (event-end event)))
1187 (rmail-summary-goto-msg))
1188
1189(defun rmail-summary-goto-msg (&optional n nowarn skip-rmail)
1190 "Go to message N in the summary buffer and the Rmail buffer.
1191If N is nil, use the message corresponding to point in the summary
1192and move to that message in the Rmail buffer.
1193
1194If NOWARN, don't say anything if N is out of range.
8fbbdd44
GM		 1195If SKIP-RMAIL, don't do anything to the Rmail buffer.
1196Returns non-nil if message N was found."
537ab246
BG		 1197 (interactive "P")
1198 (if (consp n) (setq n (prefix-numeric-value n)))
1199 (if (eobp) (forward-line -1))
1200 (beginning-of-line)
1201 (let* ((obuf (current-buffer))
1202 (buf rmail-buffer)
1203 (cur (point))
1204 message-not-found
1205 (curmsg (string-to-number
1206 (buffer-substring (point)
1207 (min (point-max) (+ 6 (point))))))
937e6a56 1208 (total (with-current-buffer buf rmail-total-messages)))
537ab246
BG		 1209 ;; If message number N was specified, find that message's line
1210 ;; or set message-not-found.
1211 ;; If N wasn't specified or that message can't be found.
1212 ;; set N by default.
1213 (if (not n)
1214 (setq n curmsg)
1215 (if (< n 1)
1216 (progn (message "No preceding message")
1217 (setq n 1)))
1218 (if (and (> n total)
1219 (> total 0))
1220 (progn (message "No following message")
1221 (goto-char (point-max))
1222 (rmail-summary-goto-msg nil nowarn skip-rmail)))
1223 (goto-char (point-min))
1224 (if (not (re-search-forward (format "^%5d[^0-9]" n) nil t))
1225 (progn (or nowarn (message "Message %d not found" n))
1226 (setq n curmsg)
1227 (setq message-not-found t)
1228 (goto-char cur))))
97e92ffb 1229 (rmail-summary-mark-seen n)
537ab246
BG		 1230 (rmail-summary-update-highlight message-not-found)
1231 (beginning-of-line)
97e92ffb 1232 (unless skip-rmail
537ab246
BG		 1233 (let ((selwin (selected-window)))
1234 (unwind-protect
60f2013c 1235 (progn (rmail-pop-to-buffer buf)
bc04f207 1236 (rmail-show-message n))
537ab246
BG		 1237 (select-window selwin)
1238 ;; The actions above can alter the current buffer. Preserve it.
8fbbdd44
GM		 1239 (set-buffer obuf))))
1240 (not message-not-found)))
537ab246
BG		 1241
1242;; Update the highlighted line in an rmail summary buffer.
1243;; That should be current. We highlight the line point is on.
1244;; If NOT-FOUND is non-nil, we turn off highlighting.
1245(defun rmail-summary-update-highlight (not-found)
1246 ;; Make sure we have an overlay to use.
1247 (or rmail-summary-overlay
1248 (progn
1249 (make-local-variable 'rmail-summary-overlay)
8fbbdd44
GM		 1250 (setq rmail-summary-overlay (make-overlay (point) (point)))
1251 (overlay-put rmail-summary-overlay 'rmail-summary t)))
537ab246
BG		 1252 ;; If this message is in the summary, use the overlay to highlight it.
1253 ;; Otherwise, don't highlight anything.
1254 (if not-found
1255 (overlay-put rmail-summary-overlay 'face nil)
1256 (move-overlay rmail-summary-overlay
1257 (save-excursion (beginning-of-line)
1258 (skip-chars-forward " ")
1259 (point))
8fbbdd44 1260 (line-end-position))
537ab246
BG		 1261 (overlay-put rmail-summary-overlay 'face 'highlight)))
1262\f
1263(defun rmail-summary-scroll-msg-up (&optional dist)
1264 "Scroll the Rmail window forward.
1265If the Rmail window is displaying the end of a message,
1266advance to the next message."
1267 (interactive "P")
1268 (if (eq dist '-)
1269 (rmail-summary-scroll-msg-down nil)
1270 (let ((rmail-buffer-window (get-buffer-window rmail-buffer)))
1271 (if rmail-buffer-window
1272 (if (let ((rmail-summary-window (selected-window)))
1273 (select-window rmail-buffer-window)
1274 (prog1
1275 ;; Is EOB visible in the buffer?
1276 (save-excursion
1277 (let ((ht (window-height (selected-window))))
1278 (move-to-window-line (- ht 2))
1279 (end-of-line)
1280 (eobp)))
1281 (select-window rmail-summary-window)))
1282 (if (not rmail-summary-scroll-between-messages)
1283 (error "End of buffer")
1284 (rmail-summary-next-msg (or dist 1)))
1285 (let ((other-window-scroll-buffer rmail-buffer))
1286 (scroll-other-window dist)))
1287 ;; If it isn't visible at all, show the beginning.
1288 (rmail-summary-beginning-of-message)))))
1289
1290(defun rmail-summary-scroll-msg-down (&optional dist)
1291 "Scroll the Rmail window backward.
1292If the Rmail window is now displaying the beginning of a message,
1293move to the previous message."
1294 (interactive "P")
1295 (if (eq dist '-)
1296 (rmail-summary-scroll-msg-up nil)
1297 (let ((rmail-buffer-window (get-buffer-window rmail-buffer)))
1298 (if rmail-buffer-window
1299 (if (let ((rmail-summary-window (selected-window)))
1300 (select-window rmail-buffer-window)
1301 (prog1
1302 ;; Is BOB visible in the buffer?
1303 (save-excursion
1304 (move-to-window-line 0)
1305 (beginning-of-line)
1306 (bobp))
1307 (select-window rmail-summary-window)))
1308 (if (not rmail-summary-scroll-between-messages)
1309 (error "Beginning of buffer")
1310 (rmail-summary-previous-msg (or dist 1)))
1311 (let ((other-window-scroll-buffer rmail-buffer))
1312 (scroll-other-window-down dist)))
1313 ;; If it isn't visible at all, show the beginning.
1314 (rmail-summary-beginning-of-message)))))
1315
1316(defun rmail-summary-beginning-of-message ()
1317 "Show current message from the beginning."
1318 (interactive)
1319 (rmail-summary-show-message 'BEG))
1320
1321(defun rmail-summary-end-of-message ()
1322 "Show bottom of current message."
1323 (interactive)
1324 (rmail-summary-show-message 'END))
1325
1326(defun rmail-summary-show-message (where)
1327 "Show current mail message.
1328Position it according to WHERE which can be BEG or END"
1329 (if (and (one-window-p) (not pop-up-frames))
1330 ;; If there is just one window, put the summary on the top.
1331 (let ((buffer rmail-buffer))
1332 (split-window (selected-window) rmail-summary-window-size)
1333 (select-window (frame-first-window))
60f2013c 1334 (rmail-pop-to-buffer rmail-buffer)
537ab246
BG		 1335 ;; If pop-to-buffer did not use that window, delete that
1336 ;; window. (This can happen if it uses another frame.)
1337 (or (eq buffer (window-buffer (next-window (frame-first-window))))
1338 (delete-other-windows)))
60f2013c 1339 (rmail-pop-to-buffer rmail-buffer))
537ab246
BG		 1340 (cond
1341 ((eq where 'BEG)
1342 (goto-char (point-min))
1343 (search-forward "\n\n"))
1344 ((eq where 'END)
1345 (goto-char (point-max))
1346 (recenter (1- (window-height))))
1347 )
60f2013c 1348 (rmail-pop-to-buffer rmail-summary-buffer))
537ab246
BG		 1349
1350(defun rmail-summary-bury ()
1351 "Bury the Rmail buffer and the Rmail summary buffer."
1352 (interactive)
1353 (let ((buffer-to-bury (current-buffer)))
1354 (let (window)
1355 (while (setq window (get-buffer-window rmail-buffer))
1356 (set-window-buffer window (other-buffer rmail-buffer)))
1357 (bury-buffer rmail-buffer))
1358 (switch-to-buffer (other-buffer buffer-to-bury))
1359 (bury-buffer buffer-to-bury)))
1360
1361(defun rmail-summary-quit ()
1362 "Quit out of Rmail and Rmail summary."
1363 (interactive)
1364 (rmail-summary-wipe)
1365 (rmail-quit))
1366
1367(defun rmail-summary-wipe ()
1368 "Kill and wipe away Rmail summary, remaining within Rmail."
1369 (interactive)
937e6a56 1370 (with-current-buffer rmail-buffer (setq rmail-summary-buffer nil))
537ab246
BG		 1371 (let ((local-rmail-buffer rmail-buffer))
1372 (kill-buffer (current-buffer))
1373 ;; Delete window if not only one.
1374 (if (not (eq (selected-window) (next-window nil 'no-minibuf)))
1375 (delete-window))
1376 ;; Switch windows to the rmail buffer, or switch to it in this window.
60f2013c 1377 (rmail-pop-to-buffer local-rmail-buffer)))
537ab246
BG		 1378
1379(defun rmail-summary-expunge ()
1380 "Actually erase all deleted messages and recompute summary headers."
1381 (interactive)
937e6a56 1382 (with-current-buffer rmail-buffer
537ab246
BG		 1383 (when (rmail-expunge-confirmed)
1384 (rmail-only-expunge)))
1385 (rmail-update-summary))
1386
1387(defun rmail-summary-expunge-and-save ()
1388 "Expunge and save RMAIL file."
1389 (interactive)
1390 (save-excursion
1391 (rmail-expunge-and-save))
1392 (rmail-update-summary)
1393 (set-buffer-modified-p nil))
1394
1395(defun rmail-summary-get-new-mail (&optional file-name)
1396 "Get new mail and recompute summary headers.
1397
1398Optionally you can specify the file to get new mail from. In this case,
1399the file of new mail is not changed or deleted. Noninteractively, you can
1400pass the inbox file name as an argument. Interactively, a prefix
1401argument says to read a file name and use that file as the inbox."
1402 (interactive
1403 (list (if current-prefix-arg
1404 (read-file-name "Get new mail from file: "))))
1405 (let (msg)
937e6a56 1406 (with-current-buffer rmail-buffer
537ab246
BG		 1407 (rmail-get-new-mail file-name)
1408 ;; Get the proper new message number.
1409 (setq msg rmail-current-message))
1410 ;; Make sure that message is displayed.
1411 (or (zerop msg)
1412 (rmail-summary-goto-msg msg))))
1413
1414(defun rmail-summary-input (filename)
1415 "Run Rmail on file FILENAME."
1416 (interactive "FRun rmail on RMAIL file: ")
1417 ;; We switch windows here, then display the other Rmail file there.
60f2013c 1418 (rmail-pop-to-buffer rmail-buffer)
537ab246
BG		 1419 (rmail filename))
1420
1421(defun rmail-summary-first-message ()
1422 "Show first message in Rmail file from summary buffer."
1423 (interactive)
1424 (with-no-warnings
1425 (beginning-of-buffer)))
1426
1427(defun rmail-summary-last-message ()
1428 "Show last message in Rmail file from summary buffer."
1429 (interactive)
1430 (with-no-warnings
1431 (end-of-buffer))
1432 (forward-line -1))
1433
1434(declare-function rmail-abort-edit "rmailedit" ())
1435(declare-function rmail-cease-edit "rmailedit"())
1436(declare-function rmail-set-label "rmailkwd" (l state &optional n))
1437(declare-function rmail-output-read-file-name "rmailout" ())
1438(declare-function mail-send-and-exit "sendmail" (&optional arg))
1439
1440(defvar rmail-summary-edit-map nil)
1441(if rmail-summary-edit-map
1442 nil
1443 (setq rmail-summary-edit-map
1444 (nconc (make-sparse-keymap) text-mode-map))
1445 (define-key rmail-summary-edit-map "\C-c\C-c" 'rmail-cease-edit)
1446 (define-key rmail-summary-edit-map "\C-c\C-]" 'rmail-abort-edit))
1447
1448(defun rmail-summary-edit-current-message ()
1449 "Edit the contents of this message."
1450 (interactive)
60f2013c 1451 (rmail-pop-to-buffer rmail-buffer)
537ab246
BG		 1452 (rmail-edit-current-message)
1453 (use-local-map rmail-summary-edit-map))
1454
1455(defun rmail-summary-cease-edit ()
1456 "Finish editing message, then go back to Rmail summary buffer."
1457 (interactive)
1458 (rmail-cease-edit)
60f2013c 1459 (rmail-pop-to-buffer rmail-summary-buffer))
537ab246
BG		 1460
1461(defun rmail-summary-abort-edit ()
1462 "Abort edit of current message; restore original contents.
1463Go back to summary buffer."
1464 (interactive)
1465 (rmail-abort-edit)
60f2013c 1466 (rmail-pop-to-buffer rmail-summary-buffer))
537ab246
BG		 1467
1468(defun rmail-summary-search-backward (regexp &optional n)
1469 "Show message containing next match for REGEXP.
1470Prefix argument gives repeat count; negative argument means search
1471backwards (through earlier messages).
1472Interactively, empty argument means use same regexp used last time."
1473 (interactive
1474 (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
1475 (prompt
1476 (concat (if reversep "Reverse " "") "Rmail search (regexp"))
1477 regexp)
1478 (setq prompt
1479 (concat prompt
1480 (if rmail-search-last-regexp
1481 (concat ", default "
1482 rmail-search-last-regexp "): ")
1483 "): ")))
1484 (setq regexp (read-string prompt))
1485 (cond ((not (equal regexp ""))
1486 (setq rmail-search-last-regexp regexp))
1487 ((not rmail-search-last-regexp)
1488 (error "No previous Rmail search string")))
1489 (list rmail-search-last-regexp
1490 (prefix-numeric-value current-prefix-arg))))
1491 ;; Don't use save-excursion because that prevents point from moving
1492 ;; properly in the summary buffer.
937e6a56
SM		 1493 (with-current-buffer rmail-buffer
1494 (rmail-search regexp (- n))))
537ab246
BG		 1495
1496(defun rmail-summary-search (regexp &optional n)
1497 "Show message containing next match for REGEXP.
1498Prefix argument gives repeat count; negative argument means search
1499backwards (through earlier messages).
1500Interactively, empty argument means use same regexp used last time."
1501 (interactive
1502 (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
1503 (prompt
1504 (concat (if reversep "Reverse " "") "Rmail search (regexp"))
1505 regexp)
1506 (setq prompt
1507 (concat prompt
1508 (if rmail-search-last-regexp
1509 (concat ", default "
1510 rmail-search-last-regexp "): ")
1511 "): ")))
1512 (setq regexp (read-string prompt))
1513 (cond ((not (equal regexp ""))
1514 (setq rmail-search-last-regexp regexp))
1515 ((not rmail-search-last-regexp)
1516 (error "No previous Rmail search string")))
1517 (list rmail-search-last-regexp
1518 (prefix-numeric-value current-prefix-arg))))
1519 ;; Don't use save-excursion because that prevents point from moving
1520 ;; properly in the summary buffer.
a5110f66
GM		 1521 (let ((buffer (current-buffer))
1522 (selwin (selected-window)))
537ab246
BG		 1523 (unwind-protect
1524 (progn
60f2013c 1525 (rmail-pop-to-buffer rmail-buffer)
537ab246 1526 (rmail-search regexp n))
a5110f66 1527 (select-window selwin)
537ab246
BG		 1528 (set-buffer buffer))))
1529
1530(defun rmail-summary-toggle-header ()
1531 "Show original message header if pruned header currently shown, or vice versa."
1532 (interactive)
1533 (save-window-excursion
1534 (set-buffer rmail-buffer)
1535 (rmail-toggle-header))
1536 ;; Inside save-excursion, some changes to point in the RMAIL buffer are lost.
1537 ;; Set point to point-min in the RMAIL buffer, if it is visible.
1538 (let ((window (get-buffer-window rmail-buffer)))
1539 (if window
1540 ;; Using save-window-excursion would lose the new value of point.
1541 (let ((owin (selected-window)))
1542 (unwind-protect
1543 (progn
1544 (select-window window)
1545 (goto-char (point-min)))
1546 (select-window owin))))))
1547
1548
1549(defun rmail-summary-add-label (label)
1550 "Add LABEL to labels associated with current Rmail message.
1551Completion is performed over known labels when reading."
937e6a56 1552 (interactive (list (with-current-buffer rmail-buffer
537ab246 1553 (rmail-read-label "Add label"))))
937e6a56 1554 (with-current-buffer rmail-buffer
537ab246
BG		 1555 (rmail-add-label label)))
1556
1557(defun rmail-summary-kill-label (label)
1558 "Remove LABEL from labels associated with current Rmail message.
1559Completion is performed over known labels when reading."
937e6a56 1560 (interactive (list (with-current-buffer rmail-buffer
537ab246 1561 (rmail-read-label "Kill label"))))
937e6a56 1562 (with-current-buffer rmail-buffer
537ab246
BG		 1563 (rmail-set-label label nil)))
1564\f
1565;;;; *** Rmail Summary Mailing Commands ***
1566
1567(defun rmail-summary-override-mail-send-and-exit ()
1568 "Replace bindings to `mail-send-and-exit' with `rmail-summary-send-and-exit'."
1569 (use-local-map (copy-keymap (current-local-map)))
1570 (dolist (key (where-is-internal 'mail-send-and-exit))
1571 (define-key (current-local-map) key 'rmail-summary-send-and-exit)))
1572
1573(defun rmail-summary-mail ()
1574 "Send mail in another window.
1575While composing the message, use \\[mail-yank-original] to yank the
1576original message into it."
1577 (interactive)
1578 (let ((window (get-buffer-window rmail-buffer)))
1579 (if window
1580 (select-window window)
1581 (set-buffer rmail-buffer)))
1582 (rmail-start-mail nil nil nil nil nil (current-buffer))
1583 (rmail-summary-override-mail-send-and-exit))
1584
1585(defun rmail-summary-continue ()
1586 "Continue composing outgoing message previously being composed."
1587 (interactive)
1588 (let ((window (get-buffer-window rmail-buffer)))
1589 (if window
1590 (select-window window)
1591 (set-buffer rmail-buffer)))
1592 (rmail-start-mail t))
1593
1594(defun rmail-summary-reply (just-sender)
1595 "Reply to the current message.
1596Normally include CC: to all other recipients of original message;
1597prefix argument means ignore them. While composing the reply,
1598use \\[mail-yank-original] to yank the original message into it."
1599 (interactive "P")
1600 (let ((window (get-buffer-window rmail-buffer)))
1601 (if window
1602 (select-window window)
1603 (set-buffer rmail-buffer)))
1604 (rmail-reply just-sender)
1605 (rmail-summary-override-mail-send-and-exit))
1606
1607(defun rmail-summary-retry-failure ()
1608 "Edit a mail message which is based on the contents of the current message.
1609For a message rejected by the mail system, extract the interesting headers and
1610the body of the original message; otherwise copy the current message."
1611 (interactive)
1612 (let ((window (get-buffer-window rmail-buffer)))
1613 (if window
1614 (select-window window)
1615 (set-buffer rmail-buffer)))
1616 (rmail-retry-failure)
1617 (rmail-summary-override-mail-send-and-exit))
1618
1619(defun rmail-summary-send-and-exit ()
1620 "Send mail reply and return to summary buffer."
1621 (interactive)
1622 (mail-send-and-exit t))
1623
1624(defun rmail-summary-forward (resend)
1625 "Forward the current message to another user.
1626With prefix argument, \"resend\" the message instead of forwarding it;
1627see the documentation of `rmail-resend'."
1628 (interactive "P")
1629 (save-excursion
1630 (let ((window (get-buffer-window rmail-buffer)))
1631 (if window
1632 (select-window window)
1633 (set-buffer rmail-buffer)))
1634 (rmail-forward resend)
1635 (rmail-summary-override-mail-send-and-exit)))
1636
1637(defun rmail-summary-resend ()
1638 "Resend current message using `rmail-resend'."
1639 (interactive)
1640 (save-excursion
1641 (let ((window (get-buffer-window rmail-buffer)))
1642 (if window
1643 (select-window window)
1644 (set-buffer rmail-buffer)))
1645 (call-interactively 'rmail-resend)))
1646\f
1647;; Summary output commands.
1648
1649(defun rmail-summary-output (&optional file-name n)
1650 "Append this message to mail file FILE-NAME.
1651This works with both mbox format and Babyl format files,
1652outputting in the appropriate format for each.
1653The default file name comes from `rmail-default-file',
1654which is updated to the name you use in this command.
1655
1656A prefix argument N says to output that many consecutive messages
1657from those in the summary, starting with the current one.
1658Deleted messages are skipped and don't count.
1659When called from Lisp code, N may be omitted and defaults to 1.
1660
1661This command always outputs the complete message header,
1662even the header display is currently pruned."
1663 (interactive
1664 (progn (require 'rmailout)
1665 (list (rmail-output-read-file-name)
1666 (prefix-numeric-value current-prefix-arg))))
1667 (let ((i 0) prev-msg)
1668 (while
1669 (and (< i n)
1670 (progn (rmail-summary-goto-msg)
1671 (not (eq prev-msg
1672 (setq prev-msg
1673 (with-current-buffer rmail-buffer
1674 rmail-current-message))))))
1675 (setq i (1+ i))
1676 (with-current-buffer rmail-buffer
1677 (let ((rmail-delete-after-output nil))
1678 (rmail-output file-name 1)))
1679 (if rmail-delete-after-output
1680 (rmail-summary-delete-forward nil)
1681 (if (< i n)
1682 (rmail-summary-next-msg 1))))))
1683
1684(defalias 'rmail-summary-output-to-rmail-file 'rmail-summary-output)
1685
1686(declare-function rmail-output-as-seen "rmailout"
1687 (file-name &optional count noattribute from-gnus))
1688
1689(defun rmail-summary-output-as-seen (&optional file-name n)
8f8cecb3 1690 "Append this message to mbox file named FILE-NAME.
537ab246
BG		 1691A prefix argument N says to output that many consecutive messages,
1692from the summary, starting with the current one.
1693Deleted messages are skipped and don't count.
1694When called from Lisp code, N may be omitted and defaults to 1.
1695
1696This outputs the message header as you see it (or would see it)
1697displayed in Rmail.
1698
1699The default file name comes from `rmail-default-file',
1700which is updated to the name you use in this command."
1701 (interactive
1702 (progn (require 'rmailout)
1703 (list (rmail-output-read-file-name)
1704 (prefix-numeric-value current-prefix-arg))))
1705 (require 'rmailout) ; for rmail-output-as-seen in non-interactive case
1706 (let ((i 0) prev-msg)
1707 (while
1708 (and (< i n)
1709 (progn (rmail-summary-goto-msg)
1710 (not (eq prev-msg
1711 (setq prev-msg
1712 (with-current-buffer rmail-buffer
1713 rmail-current-message))))))
1714 (setq i (1+ i))
1715 (with-current-buffer rmail-buffer
1716 (let ((rmail-delete-after-output nil))
1717 (rmail-output-as-seen file-name 1)))
1718 (if rmail-delete-after-output
1719 (rmail-summary-delete-forward nil)
1720 (if (< i n)
1721 (rmail-summary-next-msg 1))))))
1722
1723(defun rmail-summary-output-menu ()
1724 "Output current message to another Rmail file, chosen with a menu.
1725Also set the default for subsequent \\[rmail-output-to-babyl-file] commands.
1726The variables `rmail-secondary-file-directory' and
1727`rmail-secondary-file-regexp' control which files are offered in the menu."
1728 (interactive)
937e6a56 1729 (with-current-buffer rmail-buffer
537ab246
BG		 1730 (let ((rmail-delete-after-output nil))
1731 (call-interactively 'rmail-output-menu)))
1732 (if rmail-delete-after-output
1733 (rmail-summary-delete-forward nil)))
1734
1735(defun rmail-summary-construct-io-menu ()
1736 (let ((files (rmail-find-all-files rmail-secondary-file-directory)))
1737 (if files
1738 (progn
1739 (define-key rmail-summary-mode-map [menu-bar classify input-menu]
1740 (cons "Input Rmail File"
1741 (rmail-list-to-menu "Input Rmail File"
1742 files
1743 'rmail-summary-input)))
1744 (define-key rmail-summary-mode-map [menu-bar classify output-menu]
1745 (cons "Output Rmail File"
1746 (rmail-list-to-menu "Output Rmail File"
1747 files
1748 'rmail-summary-output))))
1749 (define-key rmail-summary-mode-map [menu-bar classify input-menu]
1750 '("Input Rmail File" . rmail-disable-menu))
1751 (define-key rmail-summary-mode-map [menu-bar classify output-menu]
1752 '("Output Rmail File" . rmail-disable-menu)))))
1753
1754(defun rmail-summary-output-body (&optional file-name)
1755 "Write this message body to the file FILE-NAME.
1756FILE-NAME defaults, interactively, from the Subject field of the message."
1757 (interactive)
937e6a56 1758 (with-current-buffer rmail-buffer
537ab246
BG		 1759 (let ((rmail-delete-after-output nil))
1760 (if file-name
1761 (rmail-output-body-to-file file-name)
1762 (call-interactively 'rmail-output-body-to-file))))
1763 (if rmail-delete-after-output
1764 (rmail-summary-delete-forward nil)))
1765\f
1766;; Sorting messages in Rmail Summary buffer.
1767
1768(defun rmail-summary-sort-by-date (reverse)
11d6c061
GM		 1769 "Sort messages of current Rmail summary by \"Date\" header.
1770If prefix argument REVERSE is non-nil, sorts in reverse order."
537ab246
BG		 1771 (interactive "P")
1772 (rmail-sort-from-summary (function rmail-sort-by-date) reverse))
1773
1774(defun rmail-summary-sort-by-subject (reverse)
11d6c061
GM		 1775 "Sort messages of current Rmail summary by \"Subject\" header.
1776Ignores any \"Re: \" prefix. If prefix argument REVERSE is
1777non-nil, sorts in reverse order."
537ab246
BG		 1778 (interactive "P")
1779 (rmail-sort-from-summary (function rmail-sort-by-subject) reverse))
1780
1781(defun rmail-summary-sort-by-author (reverse)
1782 "Sort messages of current Rmail summary by author.
11d6c061
GM		 1783This uses either the \"From\" or \"Sender\" header, downcased.
1784If prefix argument REVERSE is non-nil, sorts in reverse order."
537ab246
BG		 1785 (interactive "P")
1786 (rmail-sort-from-summary (function rmail-sort-by-author) reverse))
1787
1788(defun rmail-summary-sort-by-recipient (reverse)
1789 "Sort messages of current Rmail summary by recipient.
11d6c061
GM		 1790This uses either the \"To\" or \"Apparently-To\" header, downcased.
1791If prefix argument REVERSE is non-nil, sorts in reverse order."
537ab246
BG		 1792 (interactive "P")
1793 (rmail-sort-from-summary (function rmail-sort-by-recipient) reverse))
1794
1795(defun rmail-summary-sort-by-correspondent (reverse)
1796 "Sort messages of current Rmail summary by other correspondent.
11d6c061
GM		 1797This uses either the \"From\", \"Sender\", \"To\", or
1798\"Apparently-To\" header, downcased. Uses the first header not
38a71655 1799excluded by `mail-dont-reply-to-names'. If prefix argument
11d6c061 1800REVERSE is non-nil, sorts in reverse order."
537ab246
BG		 1801 (interactive "P")
1802 (rmail-sort-from-summary (function rmail-sort-by-correspondent) reverse))
1803
1804(defun rmail-summary-sort-by-lines (reverse)
11d6c061
GM		 1805 "Sort messages of current Rmail summary by the number of lines.
1806If prefix argument REVERSE is non-nil, sorts in reverse order."
537ab246
BG		 1807 (interactive "P")
1808 (rmail-sort-from-summary (function rmail-sort-by-lines) reverse))
1809
1810(defun rmail-summary-sort-by-labels (reverse labels)
1811 "Sort messages of current Rmail summary by labels.
11d6c061
GM		 1812LABELS is a comma-separated list of labels.
1813If prefix argument REVERSE is non-nil, sorts in reverse order."
537ab246
BG		 1814 (interactive "P\nsSort by labels: ")
1815 (rmail-sort-from-summary
11d6c061 1816 (lambda (reverse) (rmail-sort-by-labels reverse labels))
537ab246
BG		 1817 reverse))
1818
1819(defun rmail-sort-from-summary (sortfun reverse)
11d6c061
GM		 1820 "Sort the Rmail buffer using sorting function SORTFUN.
1821Passes REVERSE to SORTFUN as its sole argument. Then regenerates
1822the summary. Note that the whole Rmail buffer is sorted, even if
1823the summary is only showing a subset of messages."
537ab246
BG		 1824 (require 'rmailsort)
1825 (let ((selwin (selected-window)))
1826 (unwind-protect
60f2013c 1827 (progn (rmail-pop-to-buffer rmail-buffer)
537ab246
BG		 1828 (funcall sortfun reverse))
1829 (select-window selwin))))
1830
1831(provide 'rmailsum)
1832
a5e92116
GM		 1833;; Local Variables:
1834;; generated-autoload-file: "rmail.el"
1835;; End:
1836
537ab246 1837;;; rmailsum.el ends here
Unnamed repository; edit this file 'description' to name the repository.