Mercurial > emacs
annotate lisp/mail/rmailsum.el @ 1557:816bfa185671
* isearch.el (isearch-frames-exist): This isn't what we want -
replaced by...
(isearch-gnu-emacs-events): non-nil if should expect events in the
style generated by GNU Emacs 19. Set if set-frame-height is
fboundp; this is true on any GNU Emacs 19, whether or not it was
compiled with multiple frame support.
(isearch-mode-map): Test isearch-gnu-emacs-events instead of
isearch-frames-exist to see if we should bind switch-frame events.
(isearch-update): Test isearch-gnu-emacs-events instead of
isearch-frames-exist to see if unread-command-char's quiescent
value is nil or -1.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Sat, 07 Nov 1992 06:17:04 +0000 |
parents | 213978acbc1e |
children | 6885836c2f98 |
rev | line source |
---|---|
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
130
diff
changeset
|
1 ;;; rmailsum.el --- "RMAIL" mail reader for Emacs. |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
130
diff
changeset
|
2 |
845 | 3 ;; Copyright (C) 1985 Free Software Foundation, Inc. |
4 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
5 ;; Maintainer: FSF |
814
38b2499cb3e9
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
6 ;; Keywords: mail |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
7 |
130 | 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 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
130 | 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 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
658
diff
changeset
|
24 ;;; Code: |
130 | 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 | |
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))) | |
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
130
diff
changeset
|
480 |
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
130
diff
changeset
|
481 ;;; rmailsum.el ends here |