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