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