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