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