![[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] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to rmailsum.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / 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 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 "All" 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 "labels " 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 "recipients " 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: (new-summary-line-count 0))
76: (let ((msgnum 1)
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 nil))
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: (make-local-variable 'minor-mode-alist)
104: (setq minor-mode-alist (list ": " description))
105: (setq rmail-buffer rbuf
106: rmail-total-messages total)
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 (re-search-forward "^Date:" nil t))
189: " "
190: (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)"
191: (save-excursion (end-of-line) (point)) t)
192: (format "%2d-%3s"
193: (string-to-int (buffer-substring
194: (match-beginning 2)
195: (match-end 2)))
196: (buffer-substring
197: (match-beginning 4) (match-end 4))))
198: ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)"
199: (save-excursion (end-of-line) (point)) t)
200: (format "%2d-%3s"
201: (string-to-int (buffer-substring
202: (match-beginning 4)
203: (match-end 4)))
204: (buffer-substring
205: (match-beginning 2) (match-end 2))))
206: (t "??????"))))
207: " "
208: (save-excursion
209: (if (not (re-search-forward "^From:[ \t]*" nil t))
210: " "
211: (let* ((from (mail-strip-quoted-names
212: (buffer-substring
213: (1- (point))
214: (progn (end-of-line)
215: (skip-chars-backward " \t")
216: (point)))))
217: len mch lo)
218: (if (string-match (concat "^"
219: (regexp-quote (user-login-name))
220: "\\($\\|@\\)")
221: from)
222: (save-excursion
223: (goto-char (point-min))
224: (if (not (re-search-forward "^To:[ \t]*" nil t))
225: nil
226: (setq from
227: (concat "to: "
228: (mail-strip-quoted-names
229: (buffer-substring
230: (point)
231: (progn (end-of-line)
232: (skip-chars-backward " \t")
233: (point)))))))))
234: (setq len (length from))
235: (setq mch (string-match "[@%]" from))
236: (format "%25s"
237: (if (or (not mch) (<= len 25))
238: (substring from (max 0 (- len 25)))
239: (substring from
240: (setq lo (cond ((< (- mch 9) 0) 0)
241: ((< len (+ mch 16))
242: (- len 25))
243: (t (- mch 9))))
244: (min len (+ lo 25))))))))
245: " #"
246: (if (re-search-forward "^Subject:" nil t)
247: (progn (skip-chars-forward " \t")
248: (buffer-substring (point)
249: (progn (end-of-line)
250: (point))))
251: (re-search-forward "[\n][\n]+" nil t)
252: (buffer-substring (point) (progn (end-of-line) (point))))
253: "\n"))
254:
255: (defun rmail-summary-next-all (&optional number)
256: (interactive "p")
257: (forward-line (if number number 1))
258: (rmail-summary-goto-msg))
259:
260: (defun rmail-summary-previous-all (&optional number)
261: (interactive "p")
262: (forward-line (- (if number number 1)))
263: (rmail-summary-goto-msg))
264:
265: (defun rmail-summary-next-msg (&optional number)
266: (interactive "p")
267: (forward-line 0)
268: (and (> number 0) (forward-line 1))
269: (let ((count (if (< number 0) (- number) number))
270: (search (if (> number 0) 're-search-forward 're-search-backward))
271: end)
272: (while (and (> count 0) (funcall search "^.....[^D]" nil t))
273: (setq count (1- count)))
274: (rmail-summary-goto-msg)))
275:
276: (defun rmail-summary-previous-msg (&optional number)
277: (interactive "p")
278: (rmail-summary-next-msg (- (if number number 1))))
279:
280: (defun rmail-summary-delete-forward ()
281: (interactive)
282: (let (end)
283: (rmail-summary-goto-msg)
284: (pop-to-buffer rmail-buffer)
285: (rmail-delete-message)
286: (pop-to-buffer rmail-summary-buffer)
287: (let ((buffer-read-only nil))
288: (skip-chars-forward " ")
289: (skip-chars-forward "[0-9]")
290: (delete-char 1)
291: (insert "D"))
292: (rmail-summary-next-msg 1)))
293:
294: (defun rmail-summary-undelete ()
295: (interactive)
296: (let ((buffer-read-only nil))
297: (end-of-line)
298: (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t)
299: (replace-match "\\1 ")
300: (rmail-summary-goto-msg)
301: (pop-to-buffer rmail-buffer)
302: (and (rmail-message-deleted-p rmail-current-message)
303: (rmail-undelete-previous-message))
304: (pop-to-buffer rmail-summary-buffer))
305: (t
306: (rmail-summary-goto-msg)))))
307:
308: ;; Rmail Summary mode is suitable only for specially formatted data.
309: (put 'rmail-summary-mode 'mode-class 'special)
310:
311: (defun rmail-summary-mode ()
312: "Major mode in effect in Rmail summary buffer.
313: A subset of the Rmail mode commands are supported in this mode.
314: As commands are issued in the summary buffer the corresponding
315: mail message is displayed in the rmail buffer.
316:
317: n Move to next undeleted message, or arg messages.
318: p Move to previous undeleted message, or arg messages.
319: C-n Move to next, or forward arg messages.
320: C-p Move to previous, or previous arg messages.
321: j Jump to the message at the cursor location.
322: d Delete the message at the cursor location and move to next message.
323: u Undelete this or previous deleted message.
324: q Quit Rmail.
325: x Exit and kill the summary window.
326: space Scroll message in other window forward.
327: delete Scroll message backward.
328:
329: Entering this mode calls value of hook variable rmail-summary-mode-hook."
330: (interactive)
331: (kill-all-local-variables)
332: (make-local-variable 'rmail-buffer)
333: (make-local-variable 'rmail-total-messages)
334: (setq major-mode 'rmail-summary-mode)
335: (setq mode-name "RMAIL Summary")
336: (use-local-map rmail-summary-mode-map)
337: (setq truncate-lines t)
338: (setq buffer-read-only t)
339: (set-syntax-table text-mode-syntax-table)
340: (run-hooks 'rmail-summary-mode-hook))
341:
342: (defun rmail-summary-goto-msg (&optional n nowarn)
343: (interactive "P")
344: (if (consp n) (setq n (prefix-numeric-value n)))
345: (if (eobp) (forward-line -1))
346: (beginning-of-line)
347: (let ((buf rmail-buffer)
348: (cur (point))
349: (curmsg (string-to-int
350: (buffer-substring (point)
351: (min (point-max) (+ 5 (point)))))))
352: (if (not n)
353: (setq n curmsg)
354: (if (< n 1)
355: (progn (message "No preceding message")
356: (setq n 1)))
357: (if (> n rmail-total-messages)
358: (progn (message "No following message")
359: (goto-char (point-max))
360: (rmail-summary-goto-msg)))
361: (goto-char (point-min))
362: (if (not (re-search-forward (concat "^ *" (int-to-string n)) nil t))
363: (progn (or nowarn (message "Message %d not found" n))
364: (setq n curmsg)
365: (goto-char cur))))
366: (beginning-of-line)
367: (skip-chars-forward " ")
368: (skip-chars-forward "0-9")
369: (save-excursion (if (= (following-char) ?-)
370: (let ((buffer-read-only nil))
371: (delete-char 1)
372: (insert " "))))
373: (beginning-of-line)
374: (pop-to-buffer buf)
375: (rmail-show-message n)
376: (pop-to-buffer rmail-summary-buffer)))
377:
378: (defvar rmail-summary-mode-map nil)
379:
380: (if rmail-summary-mode-map
381: nil
382: (setq rmail-summary-mode-map (make-keymap))
383: (suppress-keymap rmail-summary-mode-map)
384: (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg)
385: (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg)
386: (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg)
387: (define-key rmail-summary-mode-map "\C-n" 'rmail-summary-next-all)
388: (define-key rmail-summary-mode-map "\C-p" 'rmail-summary-previous-all)
389: (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up)
390: (define-key rmail-summary-mode-map "q" 'rmail-summary-quit)
391: (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete)
392: (define-key rmail-summary-mode-map "x" 'rmail-summary-exit)
393: (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down)
394: (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward))
395:
396: (defun rmail-summary-scroll-msg-up (&optional dist)
397: "Scroll other window forward."
398: (interactive "P")
399: (scroll-other-window dist))
400:
401: (defun rmail-summary-scroll-msg-down (&optional dist)
402: "Scroll other window backward."
403: (interactive "P")
404: (scroll-other-window
405: (cond ((eq dist '-) nil)
406: ((null dist) '-)
407: (t (- (prefix-numeric-value dist))))))
408:
409: (defun rmail-summary-quit ()
410: "Quit out of rmail and rmail summary."
411: (interactive)
412: (rmail-summary-exit)
413: (rmail-quit))
414:
415: (defun rmail-summary-exit ()
416: "Exit rmail summary, remaining within rmail."
417: (interactive)
418: (bury-buffer (current-buffer))
419: (if (get-buffer-window rmail-buffer)
420: ;; Select the window with rmail in it, then delete this window.
421: (select-window (prog1
422: (get-buffer-window rmail-buffer)
423: (delete-window (selected-window))))
424: ;; Switch to the rmail buffer in this window.
425: (switch-to-buffer rmail-buffer)))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.