Commit | Line | Data |
---|---|---|
c88ab9ce ER |
1 | ;;; rmailsum.el --- "RMAIL" mail reader for Emacs. |
2 | ||
e5167999 ER |
3 | ;; Maintainer: FSF |
4 | ;; Last-Modified: 30 Nov 1990 | |
d7b4d18f | 5 | ;; Keywords: mail |
e5167999 | 6 | |
4d4d11cc JB |
7 | ;; Copyright (C) 1985 Free Software Foundation, Inc. |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
e5167999 | 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
4d4d11cc JB |
14 | ;; any later version. |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
23 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
24 | ||
e5167999 | 25 | ;;; Code: |
4d4d11cc JB |
26 | |
27 | ;; summary things | |
28 | ||
29 | (defun rmail-summary () | |
30 | "Display a summary of all messages, one line per message." | |
31 | (interactive) | |
32 | (rmail-new-summary "All" nil)) | |
33 | ||
34 | (defun rmail-summary-by-labels (labels) | |
35 | "Display a summary of all messages with one or more LABELS. | |
36 | LABELS should be a string containing the desired labels, separated by commas." | |
37 | (interactive "sLabels to summarize by: ") | |
38 | (if (string= labels "") | |
39 | (setq labels (or rmail-last-multi-labels | |
40 | (error "No label specified")))) | |
41 | (setq rmail-last-multi-labels labels) | |
42 | (rmail-new-summary (concat "labels " labels) | |
43 | 'rmail-message-labels-p | |
44 | (concat ", \\(" (mail-comma-list-regexp labels) "\\),"))) | |
45 | ||
46 | (defun rmail-summary-by-recipients (recipients &optional primary-only) | |
47 | "Display a summary of all messages with the given RECIPIENTS. | |
48 | Normally checks the To, From and Cc fields of headers; | |
49 | but if PRIMARY-ONLY is non-nil (prefix arg given), | |
50 | only look in the To and From fields. | |
51 | RECIPIENTS is a string of names separated by commas." | |
52 | (interactive "sRecipients to summarize by: \nP") | |
53 | (rmail-new-summary | |
54 | (concat "recipients " recipients) | |
55 | 'rmail-message-recipients-p | |
56 | (mail-comma-list-regexp recipients) primary-only)) | |
57 | ||
58 | (defun rmail-message-recipients-p (msg recipients &optional primary-only) | |
59 | (save-restriction | |
60 | (goto-char (rmail-msgbeg msg)) | |
61 | (search-forward "\n*** EOOH ***\n") | |
62 | (narrow-to-region (point) (progn (search-forward "\n\n") (point))) | |
63 | (or (string-match recipients (or (mail-fetch-field "To") "")) | |
64 | (string-match recipients (or (mail-fetch-field "From") "")) | |
65 | (if (not primary-only) | |
66 | (string-match recipients (or (mail-fetch-field "Cc") "")))))) | |
67 | ||
68 | (defun rmail-summary-by-regexp (regexp) | |
69 | "Display a summary of all messages according to regexp REGEXP. | |
70 | If the regular expression is found in the header of the message | |
71 | \(including in the date and other lines, as well as the subject line), | |
72 | Emacs will list the header line in the RMAIL-summary." | |
73 | (interactive "sRegexp to summarize by: ") | |
74 | (if (string= regexp "") | |
75 | (setq regexp (or rmail-last-regexp | |
76 | (error "No regexp specified")))) | |
77 | (setq rmail-last-regexp regexp) | |
78 | (rmail-new-summary (concat "regexp " regexp) | |
79 | 'rmail-message-regexp-p | |
80 | regexp)) | |
81 | ||
82 | (defun rmail-message-regexp-p (msg regexp) | |
83 | "Return t, if for message number MSG, regexp REGEXP matches in the header." | |
84 | (goto-char (rmail-msgbeg msg)) | |
85 | (let ((end | |
86 | (save-excursion | |
87 | (search-forward "*** EOOH ***" (point-max)) (point)))) | |
88 | (re-search-forward regexp end t))) | |
89 | \f | |
90 | (defun rmail-new-summary (description function &rest args) | |
91 | "Create a summary of selected messages. | |
92 | DESCRIPTION makes part of the mode line of the summary buffer. | |
93 | For each message, FUNCTION is applied to the message number and ARGS... | |
94 | and if the result is non-nil, that message is included. | |
95 | nil for FUNCTION means all messages." | |
96 | (message "Computing summary lines...") | |
97 | (or (and rmail-summary-buffer | |
98 | (buffer-name rmail-summary-buffer)) | |
99 | (setq rmail-summary-buffer | |
100 | (generate-new-buffer (concat (buffer-name) "-summary")))) | |
101 | (let ((summary-msgs ()) | |
102 | (new-summary-line-count 0)) | |
103 | (let ((msgnum 1) | |
104 | (buffer-read-only nil)) | |
105 | (save-restriction | |
106 | (save-excursion | |
107 | (widen) | |
108 | (goto-char (point-min)) | |
109 | (while (>= rmail-total-messages msgnum) | |
110 | (if (or (null function) | |
111 | (apply function (cons msgnum args))) | |
112 | (setq summary-msgs | |
113 | (cons (rmail-make-summary-line msgnum) | |
114 | summary-msgs))) | |
115 | (setq msgnum (1+ msgnum)))))) | |
116 | (let ((sbuf rmail-summary-buffer) | |
117 | (rbuf (current-buffer)) | |
118 | (total rmail-total-messages) | |
119 | (mesg rmail-current-message)) | |
120 | (pop-to-buffer sbuf) | |
121 | ;; Our scroll command should always scroll the Rmail buffer. | |
122 | (make-local-variable 'other-window-scroll-buffer) | |
123 | (setq other-window-scroll-buffer rbuf) | |
124 | (let ((buffer-read-only nil)) | |
125 | (erase-buffer) | |
126 | (cond (summary-msgs | |
127 | (princ (nreverse summary-msgs) sbuf) | |
128 | (delete-char -1) | |
129 | (subst-char-in-region 1 2 ?\( ?\ )))) | |
130 | (setq buffer-read-only t) | |
131 | (goto-char (point-min)) | |
132 | (rmail-summary-mode) | |
133 | (make-local-variable 'minor-mode-alist) | |
134 | (setq minor-mode-alist (list ": " description)) | |
135 | (setq rmail-buffer rbuf | |
136 | rmail-total-messages total) | |
137 | (rmail-summary-goto-msg mesg t))) | |
138 | (message "Computing summary lines...done")) | |
139 | ||
140 | (defun rmail-make-summary-line (msg) | |
141 | (let ((line (or (aref rmail-summary-vector (1- msg)) | |
142 | (progn | |
143 | (setq new-summary-line-count | |
144 | (1+ new-summary-line-count)) | |
145 | (if (zerop (% new-summary-line-count 10)) | |
146 | (message "Computing summary lines...%d" | |
147 | new-summary-line-count)) | |
148 | (rmail-make-summary-line-1 msg))))) | |
149 | ;; Fix up the part of the summary that says "deleted" or "unseen". | |
150 | (aset line 4 | |
151 | (if (rmail-message-deleted-p msg) ?\D | |
152 | (if (= ?0 (char-after (+ 3 (rmail-msgbeg msg)))) | |
153 | ?\- ?\ ))) | |
154 | line)) | |
155 | ||
156 | (defun rmail-make-summary-line-1 (msg) | |
157 | (goto-char (rmail-msgbeg msg)) | |
158 | (let* ((lim (save-excursion (forward-line 2) (point))) | |
159 | pos | |
160 | (labels | |
161 | (progn | |
162 | (forward-char 3) | |
163 | (concat | |
164 | ; (if (save-excursion (re-search-forward ",answered," lim t)) | |
165 | ; "*" "") | |
166 | ; (if (save-excursion (re-search-forward ",filed," lim t)) | |
167 | ; "!" "") | |
168 | (if (progn (search-forward ",,") (eolp)) | |
169 | "" | |
170 | (concat "{" | |
171 | (buffer-substring (point) | |
172 | (progn (end-of-line) (point))) | |
173 | "} "))))) | |
174 | (line | |
175 | (progn | |
176 | (forward-line 1) | |
177 | (if (looking-at "Summary-line: ") | |
178 | (progn | |
179 | (goto-char (match-end 0)) | |
180 | (setq line | |
181 | (buffer-substring (point) | |
182 | (progn (forward-line 1) (point))))))))) | |
183 | ;; Obsolete status lines lacking a # should be flushed. | |
184 | (and line | |
185 | (not (string-match "#" line)) | |
186 | (progn | |
187 | (delete-region (point) | |
188 | (progn (forward-line -1) (point))) | |
189 | (setq line nil))) | |
190 | ;; If we didn't get a valid status line from the message, | |
191 | ;; make a new one and put it in the message. | |
192 | (or line | |
193 | (let* ((case-fold-search t) | |
194 | (next (rmail-msgend msg)) | |
195 | (beg (if (progn (goto-char (rmail-msgbeg msg)) | |
196 | (search-forward "\n*** EOOH ***\n" next t)) | |
197 | (point) | |
198 | (forward-line 1) | |
199 | (point))) | |
200 | (end (progn (search-forward "\n\n" nil t) (point)))) | |
201 | (save-restriction | |
202 | (narrow-to-region beg end) | |
203 | (goto-char beg) | |
204 | (setq line (rmail-make-basic-summary-line))) | |
205 | (goto-char (rmail-msgbeg msg)) | |
206 | (forward-line 2) | |
207 | (insert "Summary-line: " line))) | |
208 | (setq pos (string-match "#" line)) | |
209 | (aset rmail-summary-vector (1- msg) | |
210 | (concat (format "%4d " msg) | |
211 | (substring line 0 pos) | |
212 | labels | |
213 | (substring line (1+ pos)))))) | |
214 | ||
215 | (defun rmail-make-basic-summary-line () | |
216 | (goto-char (point-min)) | |
217 | (concat (save-excursion | |
218 | (if (not (re-search-forward "^Date:" nil t)) | |
219 | " " | |
220 | (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)" | |
221 | (save-excursion (end-of-line) (point)) t) | |
222 | (format "%2d-%3s" | |
223 | (string-to-int (buffer-substring | |
224 | (match-beginning 2) | |
225 | (match-end 2))) | |
226 | (buffer-substring | |
227 | (match-beginning 4) (match-end 4)))) | |
228 | ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)" | |
229 | (save-excursion (end-of-line) (point)) t) | |
230 | (format "%2d-%3s" | |
231 | (string-to-int (buffer-substring | |
232 | (match-beginning 4) | |
233 | (match-end 4))) | |
234 | (buffer-substring | |
235 | (match-beginning 2) (match-end 2)))) | |
236 | (t "??????")))) | |
237 | " " | |
238 | (save-excursion | |
239 | (if (not (re-search-forward "^From:[ \t]*" nil t)) | |
240 | " " | |
241 | (let* ((from (mail-strip-quoted-names | |
242 | (buffer-substring | |
243 | (1- (point)) | |
244 | (progn (end-of-line) | |
245 | (skip-chars-backward " \t") | |
246 | (point))))) | |
247 | len mch lo) | |
248 | (if (string-match (concat "^" | |
249 | (regexp-quote (user-login-name)) | |
250 | "\\($\\|@\\)") | |
251 | from) | |
252 | (save-excursion | |
253 | (goto-char (point-min)) | |
254 | (if (not (re-search-forward "^To:[ \t]*" nil t)) | |
255 | nil | |
256 | (setq from | |
257 | (concat "to: " | |
258 | (mail-strip-quoted-names | |
259 | (buffer-substring | |
260 | (point) | |
261 | (progn (end-of-line) | |
262 | (skip-chars-backward " \t") | |
263 | (point))))))))) | |
264 | (setq len (length from)) | |
265 | (setq mch (string-match "[@%]" from)) | |
266 | (format "%25s" | |
267 | (if (or (not mch) (<= len 25)) | |
268 | (substring from (max 0 (- len 25))) | |
269 | (substring from | |
270 | (setq lo (cond ((< (- mch 9) 0) 0) | |
271 | ((< len (+ mch 16)) | |
272 | (- len 25)) | |
273 | (t (- mch 9)))) | |
274 | (min len (+ lo 25)))))))) | |
275 | " #" | |
276 | (if (re-search-forward "^Subject:" nil t) | |
277 | (progn (skip-chars-forward " \t") | |
278 | (buffer-substring (point) | |
279 | (progn (end-of-line) | |
280 | (point)))) | |
281 | (re-search-forward "[\n][\n]+" nil t) | |
282 | (buffer-substring (point) (progn (end-of-line) (point)))) | |
283 | "\n")) | |
284 | ||
285 | (defun rmail-summary-next-all (&optional number) | |
286 | (interactive "p") | |
287 | (forward-line (if number number 1)) | |
288 | (rmail-summary-goto-msg)) | |
289 | ||
290 | (defun rmail-summary-previous-all (&optional number) | |
291 | (interactive "p") | |
292 | (forward-line (- (if number number 1))) | |
293 | (rmail-summary-goto-msg)) | |
294 | ||
295 | (defun rmail-summary-next-msg (&optional number) | |
296 | (interactive "p") | |
297 | (forward-line 0) | |
298 | (and (> number 0) (forward-line 1)) | |
299 | (let ((count (if (< number 0) (- number) number)) | |
300 | (search (if (> number 0) 're-search-forward 're-search-backward)) | |
301 | end) | |
302 | (while (and (> count 0) (funcall search "^.....[^D]" nil t)) | |
303 | (setq count (1- count))) | |
304 | (rmail-summary-goto-msg))) | |
305 | ||
306 | (defun rmail-summary-previous-msg (&optional number) | |
307 | (interactive "p") | |
308 | (rmail-summary-next-msg (- (if number number 1)))) | |
309 | ||
310 | (defun rmail-summary-delete-forward () | |
311 | (interactive) | |
312 | (let (end) | |
313 | (rmail-summary-goto-msg) | |
314 | (pop-to-buffer rmail-buffer) | |
315 | (rmail-delete-message) | |
316 | (pop-to-buffer rmail-summary-buffer) | |
317 | (let ((buffer-read-only nil)) | |
318 | (skip-chars-forward " ") | |
319 | (skip-chars-forward "[0-9]") | |
320 | (delete-char 1) | |
321 | (insert "D")) | |
322 | (rmail-summary-next-msg 1))) | |
323 | ||
324 | (defun rmail-summary-delete-backward () | |
325 | (interactive) | |
326 | (let (end) | |
327 | (rmail-summary-goto-msg) | |
328 | (pop-to-buffer rmail-buffer) | |
329 | (rmail-delete-message) | |
330 | (pop-to-buffer rmail-summary-buffer) | |
331 | (let ((buffer-read-only nil)) | |
332 | (skip-chars-forward " ") | |
333 | (skip-chars-forward "[0-9]") | |
334 | (delete-char 1) | |
335 | (insert "D")) | |
336 | (rmail-summary-next-msg -1))) | |
337 | ||
338 | (defun rmail-summary-undelete () | |
339 | (interactive) | |
340 | (let ((buffer-read-only nil)) | |
341 | (end-of-line) | |
342 | (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t) | |
343 | (replace-match "\\1 ") | |
344 | (rmail-summary-goto-msg) | |
345 | (pop-to-buffer rmail-buffer) | |
346 | (and (rmail-message-deleted-p rmail-current-message) | |
347 | (rmail-undelete-previous-message)) | |
348 | (pop-to-buffer rmail-summary-buffer)) | |
349 | (t | |
350 | (rmail-summary-goto-msg))))) | |
351 | ||
352 | ;; Rmail Summary mode is suitable only for specially formatted data. | |
353 | (put 'rmail-summary-mode 'mode-class 'special) | |
354 | ||
355 | (defun rmail-summary-mode () | |
356 | "Major mode in effect in Rmail summary buffer. | |
357 | A subset of the Rmail mode commands are supported in this mode. | |
358 | As commands are issued in the summary buffer the corresponding | |
359 | mail message is displayed in the rmail buffer. | |
360 | ||
361 | n Move to next undeleted message, or arg messages. | |
362 | p Move to previous undeleted message, or arg messages. | |
363 | M-n Move to next, or forward arg messages. | |
364 | M-p Move to previous, or previous arg messages. | |
365 | j Jump to the message at the cursor location. | |
366 | d Delete the message at the cursor location and move to next message. | |
367 | C-d Delete the message at the cursor location and move to previous message. | |
368 | u Undelete this or previous deleted message. | |
369 | q Quit Rmail. | |
370 | x Exit and kill the summary window. | |
371 | space Scroll message in other window forward. | |
372 | delete Scroll message backward. | |
373 | ||
374 | Entering this mode calls value of hook variable rmail-summary-mode-hook." | |
375 | (interactive) | |
376 | (kill-all-local-variables) | |
377 | (make-local-variable 'rmail-buffer) | |
378 | (make-local-variable 'rmail-total-messages) | |
379 | (setq major-mode 'rmail-summary-mode) | |
380 | (setq mode-name "RMAIL Summary") | |
381 | (use-local-map rmail-summary-mode-map) | |
382 | (setq truncate-lines t) | |
383 | (setq buffer-read-only t) | |
384 | (set-syntax-table text-mode-syntax-table) | |
385 | (run-hooks 'rmail-summary-mode-hook)) | |
386 | ||
387 | (defun rmail-summary-goto-msg (&optional n nowarn) | |
388 | (interactive "P") | |
389 | (if (consp n) (setq n (prefix-numeric-value n))) | |
390 | (if (eobp) (forward-line -1)) | |
391 | (beginning-of-line) | |
392 | (let ((buf rmail-buffer) | |
393 | (cur (point)) | |
394 | (curmsg (string-to-int | |
395 | (buffer-substring (point) | |
396 | (min (point-max) (+ 5 (point))))))) | |
397 | (if (not n) | |
398 | (setq n curmsg) | |
399 | (if (< n 1) | |
400 | (progn (message "No preceding message") | |
401 | (setq n 1))) | |
402 | (if (> n rmail-total-messages) | |
403 | (progn (message "No following message") | |
404 | (goto-char (point-max)) | |
405 | (rmail-summary-goto-msg))) | |
406 | (goto-char (point-min)) | |
407 | (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t)) | |
408 | (progn (or nowarn (message "Message %d not found" n)) | |
409 | (setq n curmsg) | |
410 | (goto-char cur)))) | |
411 | (beginning-of-line) | |
412 | (skip-chars-forward " ") | |
413 | (skip-chars-forward "0-9") | |
414 | (save-excursion (if (= (following-char) ?-) | |
415 | (let ((buffer-read-only nil)) | |
416 | (delete-char 1) | |
417 | (insert " ")))) | |
418 | (beginning-of-line) | |
419 | (pop-to-buffer buf) | |
420 | (rmail-show-message n) | |
421 | (pop-to-buffer rmail-summary-buffer))) | |
422 | ||
423 | (defvar rmail-summary-mode-map nil) | |
424 | ||
425 | (if rmail-summary-mode-map | |
426 | nil | |
427 | (setq rmail-summary-mode-map (make-keymap)) | |
428 | (suppress-keymap rmail-summary-mode-map) | |
429 | (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg) | |
430 | (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg) | |
431 | (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg) | |
432 | (define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all) | |
433 | (define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all) | |
434 | (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up) | |
435 | (define-key rmail-summary-mode-map "q" 'rmail-summary-quit) | |
436 | (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete) | |
437 | (define-key rmail-summary-mode-map "x" 'rmail-summary-exit) | |
438 | (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down) | |
439 | (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward) | |
440 | (define-key rmail-summary-mode-map "\C-d" 'rmail-summary-delete-backward)) | |
441 | ||
442 | (defun rmail-summary-scroll-msg-up (&optional dist) | |
443 | "Scroll other window forward." | |
444 | (interactive "P") | |
445 | (let ((window (selected-window)) | |
446 | (new-window (display-buffer rmail-buffer))) | |
447 | (unwind-protect | |
448 | (progn | |
449 | (select-window new-window) | |
450 | (scroll-up dist)) | |
451 | (select-window window)))) | |
452 | ||
453 | (defun rmail-summary-scroll-msg-down (&optional dist) | |
454 | "Scroll other window backward." | |
455 | (interactive "P") | |
456 | (let ((window (selected-window)) | |
457 | (new-window (display-buffer rmail-buffer))) | |
458 | (unwind-protect | |
459 | (progn | |
460 | (select-window new-window) | |
461 | (scroll-down dist)) | |
462 | (select-window window)))) | |
463 | ||
464 | (defun rmail-summary-quit () | |
465 | "Quit out of rmail and rmail summary." | |
466 | (interactive) | |
467 | (rmail-summary-exit) | |
468 | (rmail-quit)) | |
469 | ||
470 | (defun rmail-summary-exit () | |
471 | "Exit rmail summary, remaining within rmail." | |
472 | (interactive) | |
473 | (bury-buffer (current-buffer)) | |
474 | (if (get-buffer-window rmail-buffer) | |
475 | ;; Select the window with rmail in it, then delete this window. | |
476 | (select-window (prog1 | |
477 | (get-buffer-window rmail-buffer) | |
478 | (delete-window (selected-window)))) | |
479 | ;; Switch to the rmail buffer in this window. | |
480 | (switch-to-buffer rmail-buffer))) | |
c88ab9ce ER |
481 | |
482 | ;;; rmailsum.el ends here |