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