]> code.delx.au - gnu-emacs/blob - lisp/mail/rmailsum.el
(rmail-summary-overlay): Make it a permanent local.
[gnu-emacs] / lisp / mail / rmailsum.el
1 ;;; rmailsum.el --- make summary buffers for the mail reader
2
3 ;; Copyright (C) 1985, 1993, 1994, 1995 Free Software Foundation, Inc.
4
5 ;; Maintainer: FSF
6 ;; Keywords: mail
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
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
32 ;; For rmail-select-summary
33 (require 'rmail)
34
35 (defvar rmail-summary-font-lock-keywords
36 '(("^....D.*" . font-lock-string-face) ; Deleted.
37 ("^....-.*" . font-lock-type-face) ; Unread.
38 ;; Neither of the below will be highlighted if either of the above are:
39 ("^....[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date.
40 ("{ \\([^}]+\\),}" 1 font-lock-comment-face)) ; Labels.
41 "Additional expressions to highlight in Rmail Summary mode.")
42
43 ;; Entry points for making a summary buffer.
44
45 ;; Regenerate the contents of the summary
46 ;; using the same selection criterion as last time.
47 ;; M-x revert-buffer in a summary buffer calls this function.
48 (defun rmail-update-summary (&rest ignore)
49 (apply (car rmail-summary-redo) (cdr rmail-summary-redo)))
50
51 (defun rmail-summary ()
52 "Display a summary of all messages, one line per message."
53 (interactive)
54 (rmail-new-summary "All" '(rmail-summary) nil))
55
56 (defun rmail-summary-by-labels (labels)
57 "Display a summary of all messages with one or more LABELS.
58 LABELS should be a string containing the desired labels, separated by commas."
59 (interactive "sLabels to summarize by: ")
60 (if (string= labels "")
61 (setq labels (or rmail-last-multi-labels
62 (error "No label specified"))))
63 (setq rmail-last-multi-labels labels)
64 (rmail-new-summary (concat "labels " labels)
65 (list 'rmail-summary-by-labels labels)
66 'rmail-message-labels-p
67 (concat ", \\(" (mail-comma-list-regexp labels) "\\),")))
68
69 (defun rmail-summary-by-recipients (recipients &optional primary-only)
70 "Display a summary of all messages with the given RECIPIENTS.
71 Normally checks the To, From and Cc fields of headers;
72 but if PRIMARY-ONLY is non-nil (prefix arg given),
73 only look in the To and From fields.
74 RECIPIENTS is a string of regexps separated by commas."
75 (interactive "sRecipients to summarize by: \nP")
76 (rmail-new-summary
77 (concat "recipients " recipients)
78 (list 'rmail-summary-by-recipients recipients primary-only)
79 'rmail-message-recipients-p
80 (mail-comma-list-regexp recipients) primary-only))
81
82 (defun rmail-summary-by-regexp (regexp)
83 "Display a summary of all messages according to regexp REGEXP.
84 If the regular expression is found in the header of the message
85 \(including in the date and other lines, as well as the subject line),
86 Emacs will list the header line in the RMAIL-summary."
87 (interactive "sRegexp to summarize by: ")
88 (if (string= regexp "")
89 (setq regexp (or rmail-last-regexp
90 (error "No regexp specified."))))
91 (setq rmail-last-regexp regexp)
92 (rmail-new-summary (concat "regexp " regexp)
93 (list 'rmail-summary-by-regexp regexp)
94 'rmail-message-regexp-p
95 regexp))
96
97 ;; rmail-summary-by-topic
98 ;; 1989 R.A. Schnitzler
99
100 (defun rmail-summary-by-topic (subject &optional whole-message)
101 "Display a summary of all messages with the given SUBJECT.
102 Normally checks the Subject field of headers;
103 but if WHOLE-MESSAGE is non-nil (prefix arg given),
104 look in the whole message.
105 SUBJECT is a string of regexps separated by commas."
106 (interactive "sTopics to summarize by: \nP")
107 (rmail-new-summary
108 (concat "about " subject)
109 (list 'rmail-summary-by-topic subject whole-message)
110 'rmail-message-subject-p
111 (mail-comma-list-regexp subject) whole-message))
112
113 (defun rmail-message-subject-p (msg subject &optional whole-message)
114 (save-restriction
115 (goto-char (rmail-msgbeg msg))
116 (search-forward "\n*** EOOH ***\n")
117 (narrow-to-region
118 (point)
119 (progn (search-forward (if whole-message "\^_" "\n\n")) (point)))
120 (goto-char (point-min))
121 (if whole-message (re-search-forward subject nil t)
122 (string-match subject (or (mail-fetch-field "Subject") "")) )))
123
124 (defun rmail-summary-by-senders (senders)
125 "Display a summary of all messages with the given SENDERS.
126 SENDERS is a string of names separated by commas."
127 (interactive "sSenders to summarize by: ")
128 (rmail-new-summary
129 (concat "senders " senders)
130 (list 'rmail-summary-by-senders senders)
131 'rmail-message-senders-p
132 (mail-comma-list-regexp senders)))
133
134 (defun rmail-message-senders-p (msg senders)
135 (save-restriction
136 (goto-char (rmail-msgbeg msg))
137 (search-forward "\n*** EOOH ***\n")
138 (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
139 (string-match senders (or (mail-fetch-field "From") ""))))
140 \f
141 ;; General making of a summary buffer.
142
143 (defvar rmail-summary-symbol-number 0)
144
145 (defun rmail-new-summary (description redo-form function &rest args)
146 "Create a summary of selected messages.
147 DESCRIPTION makes part of the mode line of the summary buffer.
148 For each message, FUNCTION is applied to the message number and ARGS...
149 and if the result is non-nil, that message is included.
150 nil for FUNCTION means all messages."
151 (message "Computing summary lines...")
152 (let (sumbuf mesg was-in-summary)
153 (save-excursion
154 ;; Go to the Rmail buffer.
155 (if (eq major-mode 'rmail-summary-mode)
156 (progn
157 (setq was-in-summary t)
158 (set-buffer rmail-buffer)))
159 ;; Find its summary buffer, or make one.
160 (setq sumbuf
161 (if (and rmail-summary-buffer
162 (buffer-name rmail-summary-buffer))
163 rmail-summary-buffer
164 (generate-new-buffer (concat (buffer-name) "-summary"))))
165 (setq mesg rmail-current-message)
166 ;; Filter the messages; make or get their summary lines.
167 (let ((summary-msgs ())
168 (new-summary-line-count 0))
169 (let ((msgnum 1)
170 (buffer-read-only nil)
171 (old-min (point-min-marker))
172 (old-max (point-max-marker)))
173 ;; Can't use save-restriction here; that doesn't work if we
174 ;; plan to modify text outside the original restriction.
175 (save-excursion
176 (widen)
177 (goto-char (point-min))
178 (while (>= rmail-total-messages msgnum)
179 (if (or (null function)
180 (apply function (cons msgnum args)))
181 (setq summary-msgs
182 (cons (cons msgnum (rmail-make-summary-line msgnum))
183 summary-msgs)))
184 (setq msgnum (1+ msgnum)))
185 (setq summary-msgs (nreverse summary-msgs)))
186 (narrow-to-region old-min old-max))
187 ;; Temporarily, while summary buffer is unfinished,
188 ;; we "don't have" a summary.
189 (setq rmail-summary-buffer nil)
190 (save-excursion
191 (let ((rbuf (current-buffer))
192 (total rmail-total-messages))
193 (set-buffer sumbuf)
194 ;; Set up the summary buffer's contents.
195 (let ((buffer-read-only nil))
196 (erase-buffer)
197 (while summary-msgs
198 (princ (cdr (car summary-msgs)) sumbuf)
199 (setq summary-msgs (cdr summary-msgs)))
200 (goto-char (point-min)))
201 ;; Set up the rest of its state and local variables.
202 (setq buffer-read-only t)
203 (rmail-summary-mode)
204 (make-local-variable 'minor-mode-alist)
205 (setq minor-mode-alist (list '(t (concat ": " description))))
206 (setq rmail-buffer rbuf
207 rmail-summary-redo redo-form
208 rmail-total-messages total))))
209 (setq rmail-summary-buffer sumbuf))
210 ;; Now display the summary buffer and go to the right place in it.
211 (or was-in-summary
212 (progn
213 (if (and (one-window-p)
214 pop-up-windows (not pop-up-frames))
215 ;; If there is just one window, put the summary on the top.
216 (progn
217 (split-window (selected-window) rmail-summary-window-size)
218 (select-window (next-window (frame-first-window)))
219 (pop-to-buffer sumbuf)
220 ;; If pop-to-buffer did not use that window, delete that
221 ;; window. (This can happen if it uses another frame.)
222 (if (not (eq sumbuf (window-buffer (frame-first-window))))
223 (delete-other-windows)))
224 (pop-to-buffer sumbuf))
225 (set-buffer rmail-buffer)
226 ;; This is how rmail makes the summary buffer reappear.
227 ;; We do this here to make the window the proper size.
228 (rmail-select-summary nil)
229 (set-buffer rmail-summary-buffer)))
230 (rmail-summary-goto-msg mesg t t)
231 (rmail-summary-construct-io-menu)
232 (message "Computing summary lines...done")))
233 \f
234 ;; Low levels of generating a summary.
235
236 (defun rmail-make-summary-line (msg)
237 (let ((line (or (aref rmail-summary-vector (1- msg))
238 (progn
239 (setq new-summary-line-count
240 (1+ new-summary-line-count))
241 (if (zerop (% new-summary-line-count 10))
242 (message "Computing summary lines...%d"
243 new-summary-line-count))
244 (rmail-make-summary-line-1 msg)))))
245 ;; Fix up the part of the summary that says "deleted" or "unseen".
246 (aset line 4
247 (if (rmail-message-deleted-p msg) ?\D
248 (if (= ?0 (char-after (+ 3 (rmail-msgbeg msg))))
249 ?\- ?\ )))
250 line))
251
252 (defun rmail-make-summary-line-1 (msg)
253 (goto-char (rmail-msgbeg msg))
254 (let* ((lim (save-excursion (forward-line 2) (point)))
255 pos
256 (labels
257 (progn
258 (forward-char 3)
259 (concat
260 ; (if (save-excursion (re-search-forward ",answered," lim t))
261 ; "*" "")
262 ; (if (save-excursion (re-search-forward ",filed," lim t))
263 ; "!" "")
264 (if (progn (search-forward ",,") (eolp))
265 ""
266 (concat "{"
267 (buffer-substring (point)
268 (progn (end-of-line) (point)))
269 "} ")))))
270 (line
271 (progn
272 (forward-line 1)
273 (if (looking-at "Summary-line: ")
274 (progn
275 (goto-char (match-end 0))
276 (setq line
277 (buffer-substring (point)
278 (progn (forward-line 1) (point)))))))))
279 ;; Obsolete status lines lacking a # should be flushed.
280 (and line
281 (not (string-match "#" line))
282 (progn
283 (delete-region (point)
284 (progn (forward-line -1) (point)))
285 (setq line nil)))
286 ;; If we didn't get a valid status line from the message,
287 ;; make a new one and put it in the message.
288 (or line
289 (let* ((case-fold-search t)
290 (next (rmail-msgend msg))
291 (beg (if (progn (goto-char (rmail-msgbeg msg))
292 (search-forward "\n*** EOOH ***\n" next t))
293 (point)
294 (forward-line 1)
295 (point)))
296 (end (progn (search-forward "\n\n" nil t) (point))))
297 (save-restriction
298 (narrow-to-region beg end)
299 (goto-char beg)
300 (setq line (rmail-make-basic-summary-line)))
301 (goto-char (rmail-msgbeg msg))
302 (forward-line 2)
303 (insert "Summary-line: " line)))
304 (setq pos (string-match "#" line))
305 (aset rmail-summary-vector (1- msg)
306 (concat (format "%4d " msg)
307 (substring line 0 pos)
308 labels
309 (substring line (1+ pos))))))
310
311 (defun rmail-make-basic-summary-line ()
312 (goto-char (point-min))
313 (concat (save-excursion
314 (if (not (re-search-forward "^Date:" nil t))
315 " "
316 (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)"
317 (save-excursion (end-of-line) (point)) t)
318 (format "%2d-%3s"
319 (string-to-int (buffer-substring
320 (match-beginning 2)
321 (match-end 2)))
322 (buffer-substring
323 (match-beginning 4) (match-end 4))))
324 ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)"
325 (save-excursion (end-of-line) (point)) t)
326 (format "%2d-%3s"
327 (string-to-int (buffer-substring
328 (match-beginning 4)
329 (match-end 4)))
330 (buffer-substring
331 (match-beginning 2) (match-end 2))))
332 (t "??????"))))
333 " "
334 (save-excursion
335 (if (not (re-search-forward "^From:[ \t]*" nil t))
336 " "
337 (let* ((from (mail-strip-quoted-names
338 (buffer-substring
339 (1- (point))
340 ;; Get all the lines of the From field
341 ;; so that we get a whole comment if there is one,
342 ;; so that mail-strip-quoted-names can discard it.
343 (let ((opoint (point)))
344 (while (progn (forward-line 1)
345 (looking-at "[ \t]")))
346 ;; Back up over newline, then trailing spaces or tabs
347 (forward-char -1)
348 (skip-chars-backward " \t")
349 (point)))))
350 len mch lo)
351 (if (string-match (concat "^"
352 (regexp-quote (user-login-name))
353 "\\($\\|@\\)")
354 from)
355 (save-excursion
356 (goto-char (point-min))
357 (if (not (re-search-forward "^To:[ \t]*" nil t))
358 nil
359 (setq from
360 (concat "to: "
361 (mail-strip-quoted-names
362 (buffer-substring
363 (point)
364 (progn (end-of-line)
365 (skip-chars-backward " \t")
366 (point)))))))))
367 (setq len (length from))
368 (setq mch (string-match "[@%]" from))
369 (format "%25s"
370 (if (or (not mch) (<= len 25))
371 (substring from (max 0 (- len 25)))
372 (substring from
373 (setq lo (cond ((< (- mch 14) 0) 0)
374 ((< len (+ mch 11))
375 (- len 25))
376 (t (- mch 14))))
377 (min len (+ lo 25))))))))
378 " #"
379 (if (re-search-forward "^Subject:" nil t)
380 (progn (skip-chars-forward " \t")
381 (buffer-substring (point)
382 (progn (end-of-line)
383 (point))))
384 (re-search-forward "[\n][\n]+" nil t)
385 (buffer-substring (point) (progn (end-of-line) (point))))
386 "\n"))
387 \f
388 ;; Simple motion in a summary buffer.
389
390 (defun rmail-summary-next-all (&optional number)
391 (interactive "p")
392 (forward-line (if number number 1))
393 ;; It doesn't look nice to move forward past the last message line.
394 (and (eobp) (> number 0)
395 (forward-line -1))
396 (display-buffer rmail-buffer))
397
398 (defun rmail-summary-previous-all (&optional number)
399 (interactive "p")
400 (forward-line (- (if number number 1)))
401 ;; It doesn't look nice to move forward past the last message line.
402 (and (eobp) (< number 0)
403 (forward-line -1))
404 (display-buffer rmail-buffer))
405
406 (defun rmail-summary-next-msg (&optional number)
407 "Display next non-deleted msg from rmail file.
408 With optional prefix argument NUMBER, moves forward this number of non-deleted
409 messages, or backward if NUMBER is negative."
410 (interactive "p")
411 (forward-line 0)
412 (and (> number 0) (end-of-line))
413 (let ((count (if (< number 0) (- number) number))
414 (search (if (> number 0) 're-search-forward 're-search-backward))
415 (non-del-msg-found nil))
416 (while (and (> count 0) (setq non-del-msg-found
417 (or (funcall search "^....[^D]" nil t)
418 non-del-msg-found)))
419 (setq count (1- count))))
420 (beginning-of-line)
421 (display-buffer rmail-buffer))
422
423 (defun rmail-summary-previous-msg (&optional number)
424 (interactive "p")
425 (rmail-summary-next-msg (- (if number number 1))))
426
427 (defun rmail-summary-next-labeled-message (n labels)
428 "Show next message with LABEL. Defaults to last labels used.
429 With prefix argument N moves forward N messages with these labels."
430 (interactive "p\nsMove to next msg with labels: ")
431 (save-excursion
432 (set-buffer rmail-buffer)
433 (rmail-next-labeled-message n labels)))
434
435 (defun rmail-summary-previous-labeled-message (n labels)
436 "Show previous message with LABEL. Defaults to last labels used.
437 With prefix argument N moves backward N messages with these labels."
438 (interactive "p\nsMove to previous msg with labels: ")
439 (save-excursion
440 (set-buffer rmail-buffer)
441 (rmail-previous-labeled-message n labels)))
442
443 (defun rmail-summary-next-same-subject (n)
444 "Go to the next message in the summary having the same subject.
445 With prefix argument N, do this N times.
446 If N is negative, go backwards."
447 (interactive "p")
448 (let (subject search-regexp i found
449 (forward (> n 0)))
450 (save-excursion
451 (set-buffer rmail-buffer)
452 (setq subject (mail-fetch-field "Subject"))
453 (setq search-regexp (concat "^Subject: *\\(Re: *\\)?"
454 (regexp-quote subject)
455 "\n"))
456 (setq i rmail-current-message))
457 (if (string-match "Re:[ \t]*" subject)
458 (setq subject (substring subject (match-end 0))))
459 (save-excursion
460 (while (and (/= n 0)
461 (if forward
462 (not (eobp))
463 (not (bobp))))
464 (let (done)
465 (while (and (not done)
466 (if forward
467 (not (eobp))
468 (not (bobp))))
469 ;; Advance thru summary.
470 (forward-line (if forward 1 -1))
471 ;; Get msg number of this line.
472 (setq i (string-to-int
473 (buffer-substring (point)
474 (min (point-max) (+ 5 (point))))))
475 ;; See if that msg has desired subject.
476 (save-excursion
477 (set-buffer rmail-buffer)
478 (save-restriction
479 (widen)
480 (goto-char (rmail-msgbeg i))
481 (search-forward "\n*** EOOH ***\n")
482 (let ((beg (point)) end)
483 (search-forward "\n\n")
484 (setq end (point))
485 (goto-char beg)
486 (setq done (re-search-forward search-regexp end t))))))
487 (if done (setq found i)))
488 (setq n (if forward (1- n) (1+ n)))))
489 (if found
490 (rmail-summary-goto-msg found)
491 (error "No %s message with same subject"
492 (if forward "following" "previous")))))
493
494 (defun rmail-summary-previous-same-subject (n)
495 "Go to the previous message in the summary having the same subject.
496 With prefix argument N, do this N times.
497 If N is negative, go forwards instead."
498 (interactive "p")
499 (rmail-summary-next-same-subject (- n)))
500 \f
501 ;; Delete and undelete summary commands.
502
503 (defun rmail-summary-delete-forward (&optional backward)
504 "Delete this message and move to next nondeleted one.
505 Deleted messages stay in the file until the \\[rmail-expunge] command is given.
506 With prefix argument, delete and move backward."
507 (interactive "P")
508 (let (end)
509 (rmail-summary-goto-msg)
510 (pop-to-buffer rmail-buffer)
511 (rmail-delete-message)
512 (let ((del-msg rmail-current-message))
513 (pop-to-buffer rmail-summary-buffer)
514 (rmail-summary-mark-deleted del-msg)
515 (while (and (not (if backward (bobp) (eobp)))
516 (save-excursion (beginning-of-line)
517 (looking-at " *[0-9]+D")))
518 (forward-line (if backward -1 1)))
519 ;; It looks ugly to move to the empty line at end of buffer.
520 (and (eobp) (not backward)
521 (forward-line -1)))))
522
523 (defun rmail-summary-delete-backward ()
524 "Delete this message and move to previous nondeleted one.
525 Deleted messages stay in the file until the \\[rmail-expunge] command is given."
526 (interactive)
527 (rmail-summary-delete-forward t))
528
529 (defun rmail-summary-mark-deleted (&optional n undel)
530 (and n (rmail-summary-goto-msg n t t))
531 (or (eobp)
532 (not (overlay-get rmail-summary-overlay 'face))
533 (let ((buffer-read-only nil))
534 (skip-chars-forward " ")
535 (skip-chars-forward "[0-9]")
536 (if undel
537 (if (looking-at "D")
538 (progn (delete-char 1) (insert " ")))
539 (delete-char 1)
540 (insert "D"))))
541 (beginning-of-line))
542
543 (defun rmail-summary-mark-undeleted (n)
544 (rmail-summary-mark-deleted n t))
545
546 (defun rmail-summary-deleted-p (&optional n)
547 (save-excursion
548 (and n (rmail-summary-goto-msg n nil t))
549 (skip-chars-forward " ")
550 (skip-chars-forward "[0-9]")
551 (looking-at "D")))
552
553 (defun rmail-summary-undelete (&optional arg)
554 "Undelete current message.
555 Optional prefix ARG means undelete ARG previous messages."
556 (interactive "p")
557 (if (/= arg 1)
558 (rmail-summary-undelete-many arg)
559 (let ((buffer-read-only nil)
560 (opoint (point)))
561 (end-of-line)
562 (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t)
563 (replace-match "\\1 ")
564 (rmail-summary-goto-msg)
565 (pop-to-buffer rmail-buffer)
566 (and (rmail-message-deleted-p rmail-current-message)
567 (rmail-undelete-previous-message))
568 (pop-to-buffer rmail-summary-buffer))
569 (t (goto-char opoint))))))
570
571 (defun rmail-summary-undelete-many (&optional n)
572 "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs."
573 (interactive "P")
574 (save-excursion
575 (set-buffer rmail-buffer)
576 (let* ((init-msg (if n rmail-current-message rmail-total-messages))
577 (rmail-current-message init-msg)
578 (n (or n rmail-total-messages))
579 (msgs-undeled 0))
580 (while (and (> rmail-current-message 0)
581 (< msgs-undeled n))
582 (if (rmail-message-deleted-p rmail-current-message)
583 (progn (rmail-set-attribute "deleted" nil)
584 (setq msgs-undeled (1+ msgs-undeled))))
585 (setq rmail-current-message (1- rmail-current-message)))
586 (set-buffer rmail-summary-buffer)
587 (setq rmail-current-message init-msg msgs-undeled 0)
588 (while (and (> rmail-current-message 0)
589 (< msgs-undeled n))
590 (if (rmail-summary-deleted-p rmail-current-message)
591 (progn (rmail-summary-mark-undeleted rmail-current-message)
592 (setq msgs-undeled (1+ msgs-undeled))))
593 (setq rmail-current-message (1- rmail-current-message))))
594 (rmail-summary-goto-msg)))
595 \f
596 ;; Rmail Summary mode is suitable only for specially formatted data.
597 (put 'rmail-summary-mode 'mode-class 'special)
598
599 (defun rmail-summary-mode ()
600 "Rmail Summary Mode is invoked from Rmail Mode by using \\<rmail-mode-map>\\[rmail-summary].
601 As commands are issued in the summary buffer, they are applied to the
602 corresponding mail messages in the rmail buffer.
603
604 All normal editing commands are turned off.
605 Instead, nearly all the Rmail mode commands are available,
606 though many of them move only among the messages in the summary.
607
608 These additional commands exist:
609
610 \\[rmail-summary-undelete-many] Undelete all or prefix arg deleted messages.
611 \\[rmail-summary-wipe] Delete the summary and go to the Rmail buffer.
612
613 Commands for sorting the summary:
614
615 \\[rmail-summary-sort-by-date] Sort by date.
616 \\[rmail-summary-sort-by-subject] Sort by subject.
617 \\[rmail-summary-sort-by-author] Sort by author.
618 \\[rmail-summary-sort-by-recipient] Sort by recipient.
619 \\[rmail-summary-sort-by-correspondent] Sort by correspondent.
620 \\[rmail-summary-sort-by-lines] Sort by lines.
621 \\[rmail-summary-sort-by-keywords] Sort by keywords."
622 (interactive)
623 (kill-all-local-variables)
624 (setq major-mode 'rmail-summary-mode)
625 (setq mode-name "RMAIL Summary")
626 (setq truncate-lines t)
627 (setq buffer-read-only t)
628 (set-syntax-table text-mode-syntax-table)
629 (make-local-variable 'rmail-buffer)
630 (make-local-variable 'rmail-total-messages)
631 (make-local-variable 'rmail-current-message)
632 (setq rmail-current-message nil)
633 (make-local-variable 'rmail-summary-redo)
634 (setq rmail-summary-redo nil)
635 (make-local-variable 'revert-buffer-function)
636 (make-local-variable 'post-command-hook)
637 (make-local-variable 'font-lock-defaults)
638 (setq font-lock-defaults '(rmail-summary-font-lock-keywords t))
639 (rmail-summary-enable)
640 (run-hooks 'rmail-summary-mode-hook))
641
642 ;; Summary features need to be disabled during edit mode.
643 (defun rmail-summary-disable ()
644 (use-local-map text-mode-map)
645 (remove-hook 'post-command-hook 'rmail-summary-rmail-update)
646 (setq revert-buffer-function nil))
647
648 (defun rmail-summary-enable ()
649 (use-local-map rmail-summary-mode-map)
650 (add-hook 'post-command-hook 'rmail-summary-rmail-update)
651 (setq revert-buffer-function 'rmail-update-summary))
652
653 ;; Show in Rmail the message described by the summary line that point is on,
654 ;; but only if the Rmail buffer is already visible.
655 ;; This is a post-command-hook in summary buffers.
656 (defun rmail-summary-rmail-update ()
657 (let (buffer-read-only)
658 (save-excursion
659 ;; If at end of buffer, pretend we are on the last text line.
660 (if (eobp)
661 (forward-line -1))
662 (beginning-of-line)
663 (skip-chars-forward " ")
664 (let ((msg-num (string-to-int (buffer-substring
665 (point)
666 (progn (skip-chars-forward "0-9")
667 (point))))))
668 (or (eq rmail-current-message msg-num)
669 (let ((window (get-buffer-window rmail-buffer))
670 (owin (selected-window)))
671 (setq rmail-current-message msg-num)
672 (if (= (following-char) ?-)
673 (progn
674 (delete-char 1)
675 (insert " ")))
676 (if window
677 ;; Using save-window-excursion would cause the new value
678 ;; of point to get lost.
679 (unwind-protect
680 (progn
681 (select-window window)
682 (rmail-show-message msg-num t))
683 (select-window owin))
684 (if (buffer-name rmail-buffer)
685 (save-excursion
686 (set-buffer rmail-buffer)
687 (rmail-show-message msg-num t))))))
688 (rmail-summary-update-highlight nil)))))
689 \f
690 (defvar rmail-summary-mode-map nil)
691
692 (if rmail-summary-mode-map
693 nil
694 (setq rmail-summary-mode-map (make-keymap))
695 (suppress-keymap rmail-summary-mode-map)
696 (define-key rmail-summary-mode-map "a" 'rmail-summary-add-label)
697 (define-key rmail-summary-mode-map "c" 'rmail-summary-continue)
698 (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward)
699 (define-key rmail-summary-mode-map "\C-d" 'rmail-summary-delete-backward)
700 (define-key rmail-summary-mode-map "e" 'rmail-summary-edit-current-message)
701 (define-key rmail-summary-mode-map "f" 'rmail-summary-forward)
702 (define-key rmail-summary-mode-map "g" 'rmail-summary-get-new-mail)
703 (define-key rmail-summary-mode-map "h" 'rmail-summary)
704 (define-key rmail-summary-mode-map "i" 'rmail-summary-input)
705 (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg)
706 (define-key rmail-summary-mode-map "k" 'rmail-summary-kill-label)
707 (define-key rmail-summary-mode-map "l" 'rmail-summary-by-labels)
708 (define-key rmail-summary-mode-map "\e\C-h" 'rmail-summary)
709 (define-key rmail-summary-mode-map "\e\C-l" 'rmail-summary-by-labels)
710 (define-key rmail-summary-mode-map "\e\C-r" 'rmail-summary-by-recipients)
711 (define-key rmail-summary-mode-map "\e\C-s" 'rmail-summary-by-regexp)
712 (define-key rmail-summary-mode-map "\e\C-t" 'rmail-summary-by-topic)
713 (define-key rmail-summary-mode-map "m" 'rmail-summary-mail)
714 (define-key rmail-summary-mode-map "\M-m" 'rmail-summary-retry-failure)
715 (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
716 (define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all)
717 (define-key rmail-summary-mode-map "\e\C-n" 'rmail-summary-next-labeled-message)
718 (define-key rmail-summary-mode-map "o" 'rmail-summary-output-to-rmail-file)
719 (define-key rmail-summary-mode-map "\C-o" 'rmail-summary-output)
720 (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
721 (define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all)
722 (define-key rmail-summary-mode-map "\e\C-p" 'rmail-summary-previous-labeled-message)
723 (define-key rmail-summary-mode-map "q" 'rmail-summary-quit)
724 (define-key rmail-summary-mode-map "r" 'rmail-summary-reply)
725 (define-key rmail-summary-mode-map "s" 'rmail-summary-expunge-and-save)
726 (define-key rmail-summary-mode-map "\es" 'rmail-summary-search)
727 (define-key rmail-summary-mode-map "t" 'rmail-summary-toggle-header)
728 (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete)
729 (define-key rmail-summary-mode-map "\M-u" 'rmail-summary-undelete-many)
730 (define-key rmail-summary-mode-map "w" 'rmail-summary-wipe)
731 (define-key rmail-summary-mode-map "x" 'rmail-summary-expunge)
732 (define-key rmail-summary-mode-map "." 'rmail-summary-beginning-of-message)
733 (define-key rmail-summary-mode-map "<" 'rmail-summary-first-message)
734 (define-key rmail-summary-mode-map ">" 'rmail-summary-last-message)
735 (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up)
736 (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down)
737 (define-key rmail-summary-mode-map "?" 'describe-mode)
738 (define-key rmail-summary-mode-map "\C-c\C-n" 'rmail-summary-next-same-subject)
739 (define-key rmail-summary-mode-map "\C-c\C-p" 'rmail-summary-previous-same-subject)
740 (define-key rmail-summary-mode-map "\C-c\C-s\C-d"
741 'rmail-summary-sort-by-date)
742 (define-key rmail-summary-mode-map "\C-c\C-s\C-s"
743 'rmail-summary-sort-by-subject)
744 (define-key rmail-summary-mode-map "\C-c\C-s\C-a"
745 'rmail-summary-sort-by-author)
746 (define-key rmail-summary-mode-map "\C-c\C-s\C-r"
747 'rmail-summary-sort-by-recipient)
748 (define-key rmail-summary-mode-map "\C-c\C-s\C-c"
749 'rmail-summary-sort-by-correspondent)
750 (define-key rmail-summary-mode-map "\C-c\C-s\C-l"
751 'rmail-summary-sort-by-lines)
752 (define-key rmail-summary-mode-map "\C-c\C-s\C-k"
753 'rmail-summary-sort-by-keywords)
754 )
755 \f
756 ;;; Menu bar bindings.
757
758 (define-key rmail-summary-mode-map [menu-bar] (make-sparse-keymap))
759
760 (define-key rmail-summary-mode-map [menu-bar classify]
761 (cons "Classify" (make-sparse-keymap "Classify")))
762
763 (define-key rmail-summary-mode-map [menu-bar classify output-menu]
764 '("Output (Rmail Menu)..." . rmail-summary-output-menu))
765
766 (define-key rmail-summary-mode-map [menu-bar classify input-menu]
767 '("Input Rmail File (menu)..." . rmail-input-menu))
768
769 (define-key rmail-summary-mode-map [menu-bar classify input-menu]
770 '(nil))
771
772 (define-key rmail-summary-mode-map [menu-bar classify output-menu]
773 '(nil))
774
775 (define-key rmail-summary-mode-map [menu-bar classify output-inbox]
776 '("Output (inbox)..." . rmail-summary-output))
777
778 (define-key rmail-summary-mode-map [menu-bar classify output]
779 '("Output (Rmail)..." . rmail-summary-output-to-rmail-file))
780
781 (define-key rmail-summary-mode-map [menu-bar classify kill-label]
782 '("Kill Label..." . rmail-summary-kill-label))
783
784 (define-key rmail-summary-mode-map [menu-bar classify add-label]
785 '("Add Label..." . rmail-summary-add-label))
786
787 (define-key rmail-summary-mode-map [menu-bar summary]
788 (cons "Summary" (make-sparse-keymap "Summary")))
789
790 (define-key rmail-summary-mode-map [menu-bar summary labels]
791 '("By Labels..." . rmail-summary-by-labels))
792
793 (define-key rmail-summary-mode-map [menu-bar summary recipients]
794 '("By Recipients..." . rmail-summary-by-recipients))
795
796 (define-key rmail-summary-mode-map [menu-bar summary topic]
797 '("By Topic..." . rmail-summary-by-topic))
798
799 (define-key rmail-summary-mode-map [menu-bar summary regexp]
800 '("By Regexp..." . rmail-summary-by-regexp))
801
802 (define-key rmail-summary-mode-map [menu-bar summary all]
803 '("All" . rmail-summary))
804
805 (define-key rmail-summary-mode-map [menu-bar mail]
806 (cons "Mail" (make-sparse-keymap "Mail")))
807
808 (define-key rmail-summary-mode-map [menu-bar mail rmail-summary-get-new-mail]
809 '("Get New Mail" . rmail-summary-get-new-mail))
810
811 (define-key rmail-summary-mode-map [menu-bar mail lambda]
812 '("----"))
813
814 (define-key rmail-summary-mode-map [menu-bar mail continue]
815 '("Continue" . rmail-summary-continue))
816
817 (define-key rmail-summary-mode-map [menu-bar mail resend]
818 '("Re-send..." . rmail-summary-resend))
819
820 (define-key rmail-summary-mode-map [menu-bar mail forward]
821 '("Forward" . rmail-summary-forward))
822
823 (define-key rmail-summary-mode-map [menu-bar mail retry]
824 '("Retry" . rmail-summary-retry-failure))
825
826 (define-key rmail-summary-mode-map [menu-bar mail reply]
827 '("Reply" . rmail-summary-reply))
828
829 (define-key rmail-summary-mode-map [menu-bar mail mail]
830 '("Mail" . rmail-summary-mail))
831
832 (define-key rmail-summary-mode-map [menu-bar delete]
833 (cons "Delete" (make-sparse-keymap "Delete")))
834
835 (define-key rmail-summary-mode-map [menu-bar delete expunge/save]
836 '("Expunge/Save" . rmail-summary-expunge-and-save))
837
838 (define-key rmail-summary-mode-map [menu-bar delete expunge]
839 '("Expunge" . rmail-summary-expunge))
840
841 (define-key rmail-summary-mode-map [menu-bar delete undelete]
842 '("Undelete" . rmail-summary-undelete))
843
844 (define-key rmail-summary-mode-map [menu-bar delete delete]
845 '("Delete" . rmail-summary-delete-forward))
846
847 (define-key rmail-summary-mode-map [menu-bar move]
848 (cons "Move" (make-sparse-keymap "Move")))
849
850 (define-key rmail-summary-mode-map [menu-bar move search-back]
851 '("Search Back..." . rmail-summary-search-backward))
852
853 (define-key rmail-summary-mode-map [menu-bar move search]
854 '("Search..." . rmail-summary-search))
855
856 (define-key rmail-summary-mode-map [menu-bar move previous]
857 '("Previous Nondeleted" . rmail-summary-previous-msg))
858
859 (define-key rmail-summary-mode-map [menu-bar move next]
860 '("Next Nondeleted" . rmail-summary-next-msg))
861
862 (define-key rmail-summary-mode-map [menu-bar move last]
863 '("Last" . rmail-summary-last-message))
864
865 (define-key rmail-summary-mode-map [menu-bar move first]
866 '("First" . rmail-summary-first-message))
867
868 (define-key rmail-summary-mode-map [menu-bar move previous]
869 '("Previous" . rmail-summary-previous-all))
870
871 (define-key rmail-summary-mode-map [menu-bar move next]
872 '("Next" . rmail-summary-next-all))
873 \f
874 (defvar rmail-summary-overlay nil)
875 (put 'rmail-summary-overlay 'permanent-local t)
876
877 (defun rmail-summary-goto-msg (&optional n nowarn skip-rmail)
878 (interactive "P")
879 (if (consp n) (setq n (prefix-numeric-value n)))
880 (if (eobp) (forward-line -1))
881 (beginning-of-line)
882 (let* ((obuf (current-buffer))
883 (buf rmail-buffer)
884 (cur (point))
885 message-not-found
886 (curmsg (string-to-int
887 (buffer-substring (point)
888 (min (point-max) (+ 5 (point))))))
889 (total (save-excursion (set-buffer buf) rmail-total-messages)))
890 ;; If message number N was specified, find that message's line
891 ;; or set message-not-found.
892 ;; If N wasn't specified or that message can't be found.
893 ;; set N by default.
894 (if (not n)
895 (setq n curmsg)
896 (if (< n 1)
897 (progn (message "No preceding message")
898 (setq n 1)))
899 (if (> n total)
900 (progn (message "No following message")
901 (goto-char (point-max))
902 (rmail-summary-goto-msg)))
903 (goto-char (point-min))
904 (if (not (re-search-forward (format "^%4d[^0-9]" n) nil t))
905 (progn (or nowarn (message "Message %d not found" n))
906 (setq n curmsg)
907 (setq message-not-found t)
908 (goto-char cur))))
909 (beginning-of-line)
910 (skip-chars-forward " ")
911 (skip-chars-forward "0-9")
912 (save-excursion (if (= (following-char) ?-)
913 (let ((buffer-read-only nil))
914 (delete-char 1)
915 (insert " "))))
916 (rmail-summary-update-highlight message-not-found)
917 (beginning-of-line)
918 (if skip-rmail
919 nil
920 (let ((selwin (selected-window)))
921 (unwind-protect
922 (progn (pop-to-buffer buf)
923 (rmail-show-message n))
924 (select-window selwin)
925 ;; The actions above can alter the current buffer. Preserve it.
926 (set-buffer obuf))))))
927
928 ;; Update the highlighted line in an rmail summary buffer.
929 ;; That should be current. We highlight the line point is on.
930 ;; If NOT-FOUND is non-nil, we turn off highlighting.
931 (defun rmail-summary-update-highlight (not-found)
932 ;; Make sure we have an overlay to use.
933 (or rmail-summary-overlay
934 (progn
935 (make-local-variable 'rmail-summary-overlay)
936 (setq rmail-summary-overlay (make-overlay (point) (point)))))
937 ;; If this message is in the summary, use the overlay to highlight it.
938 ;; Otherwise, don't highlight anything.
939 (if not-found
940 (overlay-put rmail-summary-overlay 'face nil)
941 (move-overlay rmail-summary-overlay
942 (save-excursion (beginning-of-line)
943 (skip-chars-forward " ")
944 (point))
945 (save-excursion (end-of-line) (point)))
946 (overlay-put rmail-summary-overlay 'face 'highlight)))
947 \f
948 (defun rmail-summary-scroll-msg-up (&optional dist)
949 "Scroll the Rmail window forward.
950 If the Rmail window is displaying the end of a message,
951 advance to the next message."
952 (interactive "P")
953 (if (eq dist '-)
954 (rmail-summary-scroll-msg-down nil)
955 (let ((rmail-buffer-window (get-buffer-window rmail-buffer)))
956 (if rmail-buffer-window
957 (if (let ((rmail-summary-window (selected-window)))
958 (select-window rmail-buffer-window)
959 (prog1
960 ;; Is EOB visible in the buffer?
961 (save-excursion
962 (let ((ht (window-height (selected-window))))
963 (move-to-window-line (- ht 2))
964 (end-of-line)
965 (eobp)))
966 (select-window rmail-summary-window)))
967 (rmail-summary-next-msg (or dist 1))
968 (let ((other-window-scroll-buffer rmail-buffer))
969 (scroll-other-window dist)))
970 ;; This forces rmail-buffer to be sized correctly later.
971 (display-buffer rmail-buffer)
972 (setq rmail-current-message nil)))))
973
974 (defun rmail-summary-scroll-msg-down (&optional dist)
975 "Scroll the Rmail window backward.
976 If the Rmail window is displaying the beginning of a message,
977 advance to the previous message."
978 (interactive "P")
979 (if (eq dist '-)
980 (rmail-summary-scroll-msg-up nil)
981 (let ((rmail-buffer-window (get-buffer-window rmail-buffer)))
982 (if rmail-buffer-window
983 (if (let ((rmail-summary-window (selected-window)))
984 (select-window rmail-buffer-window)
985 (prog1
986 ;; Is BOB visible in the buffer?
987 (save-excursion
988 (move-to-window-line 0)
989 (beginning-of-line)
990 (bobp))
991 (select-window rmail-summary-window)))
992 (rmail-summary-previous-msg (or dist 1))
993 (let ((other-window-scroll-buffer rmail-buffer))
994 (scroll-other-window-down dist)))
995 ;; This forces rmail-buffer to be sized correctly later.
996 (display-buffer rmail-buffer)
997 (setq rmail-current-message nil)))))
998
999 (defun rmail-summary-beginning-of-message ()
1000 "Show current message from the beginning."
1001 (interactive)
1002 (pop-to-buffer rmail-buffer)
1003 (beginning-of-buffer)
1004 (pop-to-buffer rmail-summary-buffer))
1005
1006 (defun rmail-summary-quit ()
1007 "Quit out of Rmail and Rmail summary."
1008 (interactive)
1009 (rmail-summary-wipe)
1010 (rmail-quit))
1011
1012 (defun rmail-summary-wipe ()
1013 "Kill and wipe away Rmail summary, remaining within Rmail."
1014 (interactive)
1015 (save-excursion (set-buffer rmail-buffer) (setq rmail-summary-buffer nil))
1016 (let ((local-rmail-buffer rmail-buffer))
1017 (kill-buffer (current-buffer))
1018 ;; Delete window if not only one.
1019 (if (not (eq (selected-window) (next-window nil 'no-minibuf)))
1020 (delete-window))
1021 ;; Switch windows to the rmail buffer, or switch to it in this window.
1022 (pop-to-buffer local-rmail-buffer)))
1023
1024 (defun rmail-summary-expunge ()
1025 "Actually erase all deleted messages and recompute summary headers."
1026 (interactive)
1027 (save-excursion
1028 (set-buffer rmail-buffer)
1029 (rmail-only-expunge))
1030 (rmail-update-summary))
1031
1032 (defun rmail-summary-expunge-and-save ()
1033 "Expunge and save RMAIL file."
1034 (interactive)
1035 (save-excursion
1036 (set-buffer rmail-buffer)
1037 (rmail-only-expunge))
1038 (rmail-update-summary)
1039 (save-excursion
1040 (set-buffer rmail-buffer)
1041 (save-buffer))
1042 (set-buffer-modified-p nil))
1043
1044 (defun rmail-summary-get-new-mail ()
1045 "Get new mail and recompute summary headers."
1046 (interactive)
1047 (let (msg)
1048 (save-excursion
1049 (set-buffer rmail-buffer)
1050 (rmail-get-new-mail)
1051 ;; Get the proper new message number.
1052 (setq msg rmail-current-message))
1053 ;; Make sure that message is displayed.
1054 (rmail-summary-goto-msg msg)))
1055
1056 (defun rmail-summary-input (filename)
1057 "Run Rmail on file FILENAME."
1058 (interactive "FRun rmail on RMAIL file: ")
1059 ;; We switch windows here, then display the other Rmail file there.
1060 (pop-to-buffer rmail-buffer)
1061 (rmail filename))
1062
1063 (defun rmail-summary-first-message ()
1064 "Show first message in Rmail file from summary buffer."
1065 (interactive)
1066 (beginning-of-buffer))
1067
1068 (defun rmail-summary-last-message ()
1069 "Show last message in Rmail file from summary buffer."
1070 (interactive)
1071 (end-of-buffer)
1072 (forward-line -1))
1073
1074 (defvar rmail-summary-edit-map nil)
1075 (if rmail-summary-edit-map
1076 nil
1077 (setq rmail-summary-edit-map
1078 (nconc (make-sparse-keymap) text-mode-map))
1079 (define-key rmail-summary-edit-map "\C-c\C-c" 'rmail-cease-edit)
1080 (define-key rmail-summary-edit-map "\C-c\C-]" 'rmail-abort-edit))
1081
1082 (defun rmail-summary-edit-current-message ()
1083 "Edit the contents of this message."
1084 (interactive)
1085 (pop-to-buffer rmail-buffer)
1086 (rmail-edit-current-message)
1087 (use-local-map rmail-summary-edit-map))
1088
1089 (defun rmail-summary-cease-edit ()
1090 "Finish editing message, then go back to Rmail summary buffer."
1091 (interactive)
1092 (rmail-cease-edit)
1093 (pop-to-buffer rmail-summary-buffer))
1094
1095 (defun rmail-summary-abort-edit ()
1096 "Abort edit of current message; restore original contents.
1097 Go back to summary buffer."
1098 (interactive)
1099 (rmail-abort-edit)
1100 (pop-to-buffer rmail-summary-buffer))
1101
1102 (defun rmail-summary-search-backward (regexp &optional n)
1103 "Show message containing next match for REGEXP.
1104 Prefix argument gives repeat count; negative argument means search
1105 backwards (through earlier messages).
1106 Interactively, empty argument means use same regexp used last time."
1107 (interactive
1108 (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
1109 (prompt
1110 (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
1111 regexp)
1112 (if rmail-search-last-regexp
1113 (setq prompt (concat prompt
1114 "(default "
1115 rmail-search-last-regexp
1116 ") ")))
1117 (setq regexp (read-string prompt))
1118 (cond ((not (equal regexp ""))
1119 (setq rmail-search-last-regexp regexp))
1120 ((not rmail-search-last-regexp)
1121 (error "No previous Rmail search string")))
1122 (list rmail-search-last-regexp
1123 (prefix-numeric-value current-prefix-arg))))
1124 ;; Don't use save-excursion because that prevents point from moving
1125 ;; properly in the summary buffer.
1126 (let ((buffer (current-buffer)))
1127 (unwind-protect
1128 (progn
1129 (set-buffer rmail-buffer)
1130 (rmail-search regexp (- n)))
1131 (set-buffer buffer))))
1132
1133 (defun rmail-summary-search (regexp &optional n)
1134 "Show message containing next match for REGEXP.
1135 Prefix argument gives repeat count; negative argument means search
1136 backwards (through earlier messages).
1137 Interactively, empty argument means use same regexp used last time."
1138 (interactive
1139 (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
1140 (prompt
1141 (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
1142 regexp)
1143 (if rmail-search-last-regexp
1144 (setq prompt (concat prompt
1145 "(default "
1146 rmail-search-last-regexp
1147 ") ")))
1148 (setq regexp (read-string prompt))
1149 (cond ((not (equal regexp ""))
1150 (setq rmail-search-last-regexp regexp))
1151 ((not rmail-search-last-regexp)
1152 (error "No previous Rmail search string")))
1153 (list rmail-search-last-regexp
1154 (prefix-numeric-value current-prefix-arg))))
1155 ;; Don't use save-excursion because that prevents point from moving
1156 ;; properly in the summary buffer.
1157 (let ((buffer (current-buffer)))
1158 (unwind-protect
1159 (progn
1160 (set-buffer rmail-buffer)
1161 (rmail-search regexp n))
1162 (set-buffer buffer))))
1163
1164 (defun rmail-summary-toggle-header ()
1165 "Show original message header if pruned header currently shown, or vice versa."
1166 (interactive)
1167 (save-excursion
1168 (set-buffer rmail-buffer)
1169 (rmail-toggle-header))
1170 ;; Inside save-excursion, some changes to point in the RMAIL buffer are lost.
1171 ;; Set point to point-min in the RMAIL buffer, if it is visible.
1172 (let ((window (get-buffer-window rmail-buffer)))
1173 (if window
1174 ;; Using save-window-excursion would lose the new value of point.
1175 (let ((owin (selected-window)))
1176 (unwind-protect
1177 (progn
1178 (select-window window)
1179 (goto-char (point-min)))
1180 (select-window owin))))))
1181
1182
1183 (defun rmail-summary-add-label (label)
1184 "Add LABEL to labels associated with current Rmail message.
1185 Completion is performed over known labels when reading."
1186 (interactive (list (save-excursion
1187 (set-buffer rmail-buffer)
1188 (rmail-read-label "Add label"))))
1189 (save-excursion
1190 (set-buffer rmail-buffer)
1191 (rmail-add-label label)))
1192
1193 (defun rmail-summary-kill-label (label)
1194 "Remove LABEL from labels associated with current Rmail message.
1195 Completion is performed over known labels when reading."
1196 (interactive (list (save-excursion
1197 (set-buffer rmail-buffer)
1198 (rmail-read-label "Kill label"))))
1199 (save-excursion
1200 (set-buffer rmail-buffer)
1201 (rmail-set-label label nil)))
1202 \f
1203 ;;;; *** Rmail Summary Mailing Commands ***
1204
1205 (defun rmail-summary-mail ()
1206 "Send mail in another window.
1207 While composing the message, use \\[mail-yank-original] to yank the
1208 original message into it."
1209 (interactive)
1210 (let ((window (get-buffer-window rmail-buffer)))
1211 (if window
1212 (select-window window)
1213 (set-buffer rmail-buffer)))
1214 (rmail-start-mail nil nil nil nil nil (current-buffer))
1215 (use-local-map (copy-keymap (current-local-map)))
1216 (define-key (current-local-map)
1217 "\C-c\C-c" 'rmail-summary-send-and-exit))
1218
1219 (defun rmail-summary-continue ()
1220 "Continue composing outgoing message previously being composed."
1221 (interactive)
1222 (let ((window (get-buffer-window rmail-buffer)))
1223 (if window
1224 (select-window window)
1225 (set-buffer rmail-buffer)))
1226 (rmail-start-mail t))
1227
1228 (defun rmail-summary-reply (just-sender)
1229 "Reply to the current message.
1230 Normally include CC: to all other recipients of original message;
1231 prefix argument means ignore them. While composing the reply,
1232 use \\[mail-yank-original] to yank the original message into it."
1233 (interactive "P")
1234 (let ((window (get-buffer-window rmail-buffer)))
1235 (if window
1236 (select-window window)
1237 (set-buffer rmail-buffer)))
1238 (rmail-reply just-sender)
1239 (use-local-map (copy-keymap (current-local-map)))
1240 (define-key (current-local-map)
1241 "\C-c\C-c" 'rmail-summary-send-and-exit))
1242
1243 (defun rmail-summary-retry-failure ()
1244 "Edit a mail message which is based on the contents of the current message.
1245 For a message rejected by the mail system, extract the interesting headers and
1246 the body of the original message; otherwise copy the current message."
1247 (interactive)
1248 (let ((window (get-buffer-window rmail-buffer)))
1249 (if window
1250 (select-window window)
1251 (set-buffer rmail-buffer)))
1252 (rmail-retry-failure)
1253 (use-local-map (copy-keymap (current-local-map)))
1254 (define-key (current-local-map)
1255 "\C-c\C-c" 'rmail-summary-send-and-exit))
1256
1257 (defun rmail-summary-send-and-exit ()
1258 "Send mail reply and return to summary buffer."
1259 (interactive)
1260 (mail-send-and-exit t))
1261
1262 (defun rmail-summary-forward (resend)
1263 "Forward the current message to another user.
1264 With prefix argument, \"resend\" the message instead of forwarding it;
1265 see the documentation of `rmail-resend'."
1266 (interactive "P")
1267 (save-excursion
1268 (let ((window (get-buffer-window rmail-buffer)))
1269 (if window
1270 (select-window window)
1271 (set-buffer rmail-buffer)))
1272 (rmail-forward resend)
1273 (use-local-map (copy-keymap (current-local-map)))
1274 (define-key (current-local-map)
1275 "\C-c\C-c" 'rmail-summary-send-and-exit)))
1276
1277 (defun rmail-summary-resend ()
1278 "Resend current message using 'rmail-resend'."
1279 (interactive)
1280 (save-excursion
1281 (let ((window (get-buffer-window rmail-buffer)))
1282 (if window
1283 (select-window window)
1284 (set-buffer rmail-buffer)))
1285 (call-interactively 'rmail-resend)))
1286 \f
1287 ;; Summary output commands.
1288
1289 (defun rmail-summary-output-to-rmail-file (&optional file-name)
1290 "Append the current message to an Rmail file named FILE-NAME.
1291 If the file does not exist, ask if it should be created.
1292 If file is being visited, the message is appended to the Emacs
1293 buffer visiting that file."
1294 (interactive)
1295 (save-excursion
1296 (set-buffer rmail-buffer)
1297 (let ((rmail-delete-after-output nil))
1298 (if file-name
1299 (rmail-output-to-rmail-file file-name)
1300 (call-interactively 'rmail-output-to-rmail-file))))
1301 (if rmail-delete-after-output
1302 (rmail-summary-delete-forward nil)))
1303
1304 (defun rmail-summary-output-menu ()
1305 "Output current message to another Rmail file, chosen with a menu.
1306 Also set the default for subsequent \\[rmail-output-to-rmail-file] commands.
1307 The variables `rmail-secondary-file-directory' and
1308 `rmail-secondary-file-regexp' control which files are offered in the menu."
1309 (interactive)
1310 (save-excursion
1311 (set-buffer rmail-buffer)
1312 (let ((rmail-delete-after-output nil))
1313 (call-interactively 'rmail-output-menu)))
1314 (if rmail-delete-after-output
1315 (rmail-summary-delete-forward nil)))
1316
1317 (defun rmail-summary-output ()
1318 "Append this message to Unix mail file named FILE-NAME."
1319 (interactive)
1320 (save-excursion
1321 (set-buffer rmail-buffer)
1322 (let ((rmail-delete-after-output nil))
1323 (call-interactively 'rmail-output)))
1324 (if rmail-delete-after-output
1325 (rmail-summary-delete-forward nil)))
1326
1327 (defun rmail-summary-construct-io-menu ()
1328 (let ((files (rmail-find-all-files rmail-secondary-file-directory)))
1329 (if files
1330 (progn
1331 (define-key rmail-summary-mode-map [menu-bar classify input-menu]
1332 (cons "Input Rmail File"
1333 (rmail-list-to-menu "Input Rmail File"
1334 files
1335 'rmail-summary-input)))
1336 (define-key rmail-summary-mode-map [menu-bar classify output-menu]
1337 (cons "Output Rmail File"
1338 (rmail-list-to-menu "Output Rmail File"
1339 files
1340 'rmail-summary-output-to-rmail-file))))
1341 (define-key rmail-summary-mode-map [menu-bar classify input-menu]
1342 '("Input Rmail File" . rmail-disable-menu))
1343 (define-key rmail-summary-mode-map [menu-bar classify output-menu]
1344 '("Output Rmail File" . rmail-disable-menu)))))
1345
1346 \f
1347 ;; Sorting messages in Rmail Summary buffer.
1348
1349 (defun rmail-summary-sort-by-date (reverse)
1350 "Sort messages of current Rmail summary by date.
1351 If prefix argument REVERSE is non-nil, sort them in reverse order."
1352 (interactive "P")
1353 (rmail-sort-from-summary (function rmail-sort-by-date) reverse))
1354
1355 (defun rmail-summary-sort-by-subject (reverse)
1356 "Sort messages of current Rmail summary by subject.
1357 If prefix argument REVERSE is non-nil, sort them in reverse order."
1358 (interactive "P")
1359 (rmail-sort-from-summary (function rmail-sort-by-subject) reverse))
1360
1361 (defun rmail-summary-sort-by-author (reverse)
1362 "Sort messages of current Rmail summary by author.
1363 If prefix argument REVERSE is non-nil, sort them in reverse order."
1364 (interactive "P")
1365 (rmail-sort-from-summary (function rmail-sort-by-author) reverse))
1366
1367 (defun rmail-summary-sort-by-recipient (reverse)
1368 "Sort messages of current Rmail summary by recipient.
1369 If prefix argument REVERSE is non-nil, sort them in reverse order."
1370 (interactive "P")
1371 (rmail-sort-from-summary (function rmail-sort-by-recipient) reverse))
1372
1373 (defun rmail-summary-sort-by-correspondent (reverse)
1374 "Sort messages of current Rmail summary by other correspondent.
1375 If prefix argument REVERSE is non-nil, sort them in reverse order."
1376 (interactive "P")
1377 (rmail-sort-from-summary (function rmail-sort-by-correspondent) reverse))
1378
1379 (defun rmail-summary-sort-by-lines (reverse)
1380 "Sort messages of current Rmail summary by lines of the message.
1381 If prefix argument REVERSE is non-nil, sort them in reverse order."
1382 (interactive "P")
1383 (rmail-sort-from-summary (function rmail-sort-by-lines) reverse))
1384
1385 (defun rmail-summary-sort-by-keywords (reverse labels)
1386 "Sort messages of current Rmail summary by keywords.
1387 If prefix argument REVERSE is non-nil, sort them in reverse order.
1388 KEYWORDS is a comma-separated list of labels."
1389 (interactive "P\nsSort by labels: ")
1390 (rmail-sort-from-summary
1391 (function (lambda (reverse)
1392 (rmail-sort-by-keywords reverse labels)))
1393 reverse))
1394
1395 (defun rmail-sort-from-summary (sortfun reverse)
1396 "Sort Rmail messages from Summary buffer and update it after sorting."
1397 (require 'rmailsort)
1398 (let ((selwin (selected-window)))
1399 (unwind-protect
1400 (progn (pop-to-buffer rmail-buffer)
1401 (funcall sortfun reverse))
1402 (select-window selwin))))
1403
1404 ;;; rmailsum.el ends here