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