![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to rmail.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 rmail.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: ;; Souped up by shane@mit-ajax based on ideas of rlk@mit-clio
23: ;; New features include attribute and keyword support, message
24: ;; selection by dispatch table, summary by attributes and keywords,
25: ;; expunging by dispatch table, sticky options for file commands.
26:
27: (require 'mail-utils)
28: (provide 'rmail)
29:
30: ; these variables now declared in loaddefs or paths.el
31: ;(defvar rmail-spool-directory "/usr/spool/mail/"
32: ; "This is the name of the directory used by the system mailer for\n\
33: ;delivering new mail. It's name should end with a slash.")
34: ;(defvar rmail-dont-reply-to-names
35: ; nil
36: ; "*A regexp specifying names to prune of reply to messages.
37: ;nil means dont reply to yourself.")
38: ;(defvar rmail-ignored-headers
39: ; "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^message-id:\\|^summary-line:"
40: ; "*Gubbish headers one would rather not see.")
41: ;(defvar rmail-file-name
42: ; (expand-file-name "~/RMAIL")
43: ; "")
44: ;
45: ;(defvar rmail-delete-after-output nil
46: ; "*Non-nil means automatically delete a message that is copied to a file.")
47: ;
48: ;(defvar rmail-primary-inbox-list
49: ; '("/usr/spool/mail/$USER" "~/mbox")
50: ; "")
51:
52: ;; these may be altered by site-init.el to match the format of mmdf files
53: ;; delimitation used on a given host (delim1 and delim2 from the config
54: ;; files)
55:
56: (defvar mmdf-delim1 "^\001\001\001\001\n"
57: "Regexp marking the start of an mmdf message")
58: (defvar mmdf-delim2 "^\001\001\001\001\n"
59: "Regexp marking the end of an mmdf message")
60:
61: (defvar rmail-message-filter nil
62: "If non nil, is a filter function for new headers in RMAIL.
63: Called with region narrowed to unformatted header.")
64:
65: (defvar rmail-mode-map nil)
66:
67: ;; Message counters and markers. Deleted flags.
68:
69: (defvar rmail-current-message nil)
70: (defvar rmail-total-messages nil)
71: (defvar rmail-message-vector nil)
72: (defvar rmail-deleted-vector nil)
73:
74: ;; These are used by autoloaded rmail-summary.
75:
76: (defvar rmail-summary-buffer nil)
77: (defvar rmail-summary-vector nil)
78:
79: ;; `Sticky' default variables.
80:
81: ;; Last individual label specified to a or k.
82: (defvar rmail-last-label nil)
83: ;; Last set of labels specified to C-M-n or C-M-p or C-M-l.
84: (defvar rmail-last-multi-labels nil)
85: (defvar rmail-last-file (expand-file-name "~/XMAIL"))
86: (defvar rmail-last-rmail-file (expand-file-name "~/XMAIL"))
87:
88: ;;;; *** Rmail Mode ***
89:
90: (defun rmail (&optional file-name-arg)
91: "Read and edit incoming mail.
92: Moves messages into file named by rmail-file-name (a babyl format file)
93: and edits that file in RMAIL Mode.
94: Type \\[describe-mode] once editing that file, for a list of RMAIL commands.
95:
96: May be called with filename as argument;
97: then performs rmail editing on that file,
98: but does not copy any new mail into the file."
99: (interactive)
100: (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name)))
101: (existed (get-file-buffer file-name))
102: (convert))
103: (find-file file-name)
104: (if existed
105: nil
106: (rmail-mode)
107: ;; If file just read in for first time, and not valid babyl file,
108: ;; convert it to one, by adding a header and converting each message.
109: (cond ((looking-at "BABYL OPTIONS:"))
110: ((looking-at "Version: 5\n")
111: ;; Losing babyl file made by old version of Rmail.
112: ;; Just fix the babyl file header; don't make a new one,
113: ;; so we don't lose the Labels: file attribute, etc.
114: (let ((buffer-read-only nil))
115: (insert "BABYL OPTIONS:\n")))
116: (t
117: (setq convert t)
118: (rmail-insert-rmail-file-header)))
119: ;; If file was not a Babyl file or if there are
120: ;; Unix format messages added at the end,
121: ;; convert file as necessary.
122: (if (or convert
123: (progn (goto-char (point-max))
124: (search-backward "\^_")
125: (forward-char 1)
126: (looking-at "\n*From ")))
127: (let ((buffer-read-only nil))
128: (message "Converting to Babyl format...")
129: (narrow-to-region (point) (point-max))
130: (rmail-convert-to-babyl-format)
131: (message "Converting to Babyl format...done")))
132: ;; Provide default set of inboxes for primary mail file ~/RMAIL.
133: (and (null rmail-inbox-list)
134: (null file-name-arg)
135: (setq rmail-inbox-list rmail-primary-inbox-list))
136: (goto-char (point-max))
137: (if (null rmail-inbox-list)
138: (progn
139: (rmail-set-message-counters)
140: (rmail-show-message))
141: (rmail-get-new-mail)))))
142:
143: (defun rmail-insert-rmail-file-header ()
144: (let ((buffer-read-only nil))
145: (insert "BABYL OPTIONS:
146: Version: 5
147: Labels:
148: Note: This is the header of an rmail file.
149: Note: If you are seeing it in rmail,
150: Note: it means the file has no messages in it.\n\^_")))
151:
152: (if rmail-mode-map
153: nil
154: (setq rmail-mode-map (make-keymap))
155: (suppress-keymap rmail-mode-map)
156: (define-key rmail-mode-map "." 'rmail-beginning-of-message)
157: (define-key rmail-mode-map " " 'scroll-up)
158: (define-key rmail-mode-map "\177" 'scroll-down)
159: (define-key rmail-mode-map "n" 'rmail-next-undeleted-message)
160: (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message)
161: (define-key rmail-mode-map "\en" 'rmail-next-message)
162: (define-key rmail-mode-map "\ep" 'rmail-previous-message)
163: (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message)
164: (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message)
165: (define-key rmail-mode-map "a" 'rmail-add-label)
166: (define-key rmail-mode-map "k" 'rmail-kill-label)
167: (define-key rmail-mode-map "d" 'rmail-delete-forward)
168: (define-key rmail-mode-map "u" 'rmail-undelete-previous-message)
169: (define-key rmail-mode-map "e" 'rmail-expunge)
170: (define-key rmail-mode-map "s" 'rmail-save)
171: (define-key rmail-mode-map "g" 'rmail-get-new-mail)
172: (define-key rmail-mode-map "h" 'rmail-summary)
173: (define-key rmail-mode-map "\e\C-h" 'rmail-summary)
174: (define-key rmail-mode-map "l" 'rmail-summary-by-labels)
175: (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels)
176: (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients)
177: (define-key rmail-mode-map "t" 'rmail-toggle-header)
178: (define-key rmail-mode-map "m" 'rmail-mail)
179: (define-key rmail-mode-map "r" 'rmail-reply)
180: (define-key rmail-mode-map "c" 'rmail-continue)
181: (define-key rmail-mode-map "f" 'rmail-forward)
182: (define-key rmail-mode-map "\es" 'rmail-search)
183: (define-key rmail-mode-map "j" 'rmail-show-message)
184: (define-key rmail-mode-map "o" 'rmail-output-to-rmail-file)
185: (define-key rmail-mode-map "\C-o" 'rmail-output)
186: (define-key rmail-mode-map "i" 'rmail-input)
187: (define-key rmail-mode-map "q" 'rmail-quit)
188: (define-key rmail-mode-map ">" 'rmail-last-message)
189: (define-key rmail-mode-map "?" 'describe-mode)
190: (define-key rmail-mode-map "\C-r" 'rmail-edit-current-message)
191: (define-key rmail-mode-map "\C-d" 'rmail-delete-backward))
192:
193: (defun rmail-mode ()
194: "Rmail Mode is used by \\[rmail] for editing Rmail files.
195: All normal editing commands are turned off.
196: Instead, these commands are available:
197:
198: . Move point to front of this message (same as \\[beginning-of-buffer]).
199: SPC Scroll to next screen of this message.
200: DEL Scroll to previous screen of this message.
201: n Move to Next non-deleted message.
202: p Move to Previous non-deleted message.
203: M-n Move to Next message whether deleted or not.
204: M-p Move to Previous message whether deleted or not.
205: > Move to the last message in Rmail file.
206: j Jump to message specified by numeric position in file.
207: M-s Search for string and show message it is found in.
208: d Delete this message, move to next nondeleted.
209: C-d Delete this message, move to previous nondeleted.
210: u Undelete message. Tries current message, then earlier messages
211: till a deleted message is found.
212: e Expunge deleted messages.
213: s Expunge and save the file.
214: q Quit Rmail: expunge, save, then switch to another buffer.
215: C-x C-s Save without expunging.
216: g Move new mail from system spool directory or mbox into this file.
217: m Mail a message (same as \\[mail-other-window]).
218: c Continue composing outgoing message started before.
219: r Reply to this message. Like m but initializes some fields.
220: f Forward this message to another user.
221: o Output this message to an Rmail file (append it).
222: C-o Output this message to a Unix-format mail file (append it).
223: i Input Rmail file. Run Rmail on that file.
224: a Add label to message. It will be displayed in the mode line.
225: k Kill label. Remove a label from current message.
226: C-M-n Move to Next message with specified label
227: (label defaults to last one specified).
228: Standard labels: filed, unseen, answered, forwarded, deleted.
229: Any other label is present only if you add it with `a'.
230: C-M-p Move to Previous message with specified label
231: C-M-h Show headers buffer, with a one line summary of each message.
232: C-M-l Like h only just messages with particular label(s) are summarized.
233: C-M-r Like h only just messages with particular recipient(s) are summarized.
234: t Toggle header, show Rmail header if unformatted or vice versa.
235: C-r Edit the current message. C-c C-c to return to Rmail."
236: (interactive)
237: (kill-all-local-variables)
238: (rmail-mode-1)
239: (rmail-variables)
240: (run-hooks 'rmail-mode-hook))
241:
242: (defun rmail-mode-1 ()
243: (setq major-mode 'rmail-mode)
244: (setq mode-name "RMAIL")
245: (setq buffer-read-only t)
246: ;; No need to auto save RMAIL files.
247: (setq buffer-auto-save-file-name nil)
248: (setq mode-line-format "--- Emacs: %b %M %[(%m)%] ----%3p-%-")
249: (use-local-map rmail-mode-map)
250: (set-syntax-table text-mode-syntax-table)
251: (setq local-abbrev-table text-mode-abbrev-table))
252:
253: (defun rmail-variables ()
254: (make-local-variable 'rmail-last-label)
255: (make-local-variable 'rmail-deleted-vector)
256: (make-local-variable 'rmail-keywords)
257: (make-local-variable 'rmail-summary-buffer)
258: (make-local-variable 'rmail-summary-vector)
259: (make-local-variable 'rmail-current-message)
260: (make-local-variable 'rmail-total-messages)
261: (make-local-variable 'require-final-newline)
262: (setq require-final-newline nil)
263: (make-local-variable 'version-control)
264: (setq version-control 'never)
265: (make-local-variable 'rmail-message-vector)
266: (make-local-variable 'rmail-last-file)
267: (make-local-variable 'rmail-inbox-list)
268: (setq rmail-inbox-list (rmail-parse-file-inboxes)))
269:
270: ;; Return a list of files from this buffer's Mail: option.
271: ;; Does not assume that messages have been parsed.
272: ;; Just returns nil if buffer does not look like Babyl format.
273: (defun rmail-parse-file-inboxes ()
274: (save-excursion
275: (save-restriction
276: (widen)
277: (goto-char 1)
278: (cond ((looking-at "Babyl options:")
279: (search-forward "\^_" nil 'move)
280: (narrow-to-region 1 (point))
281: (goto-char 1)
282: (if (search-forward "\nMail:" nil t)
283: (progn
284: (narrow-to-region (point) (progn (end-of-line) (point)))
285: (goto-char (point-min))
286: (mail-parse-comma-list))))))))
287:
288: (defun rmail-save ()
289: "Expunge and save RMAIL file."
290: (interactive)
291: (rmail-expunge)
292: (save-buffer))
293:
294: (defun rmail-quit ()
295: "Quit out of RMAIL."
296: (interactive)
297: (rmail-save)
298: ;; Don't switch to the summary buffer even if it was recently visible.
299: (if rmail-summary-buffer
300: (bury-buffer rmail-summary-buffer))
301: (let ((obuf (current-buffer)))
302: (switch-to-buffer (other-buffer))
303: (bury-buffer obuf)))
304:
305: (defun rmail-input (filename)
306: "Run RMAIL on FILENAME."
307: (interactive "FRun rmail on RMAIL file: ")
308: (rmail filename))
309:
310:
311: ;;;; *** Rmail input ***
312:
313: ;; RLK feature not added in this version:
314: ;; argument specifies inbox file or files in various ways.
315:
316: (defun rmail-get-new-mail (&optional file-name)
317: "Move any new mail from this RMAIL file's inbox files.
318: The inbox files can be specified with the file's Mail: option.
319: The variable rmail-primary-inbox-list specifies the inboxes for
320: your primary RMAIL file if it has no Mail: option.
321: These are normally your ~/mbox and your /usr/spool/mail/$USER.
322:
323: You can also specify the file to get new mail from. In this
324: case, the file of new mail is not changed or deleted.
325: Noninteractively, you can pass the inbox file name as an argument.
326: Interactively, a prefix argument causes us to read a file name
327: and use that file as the inbox."
328: (interactive
329: (list (if current-prefix-arg
330: (read-file-name "Get new mail from file: "))))
331: (rmail-maybe-set-message-counters)
332: (widen)
333: (let ((opoint (point))
334: (new-messages 0)
335: (delete-files ())
336: (buffer-read-only nil))
337: (goto-char (point-max))
338: (skip-chars-backward " \t\n") ; just in case of brain damage
339: (delete-region (point) (point-max)) ; caused by require-final-newline
340: (unwind-protect
341: (save-restriction
342: (narrow-to-region (point) (point))
343: ;; Read in the contents of the inbox files,
344: ;; renaming them as necessary,
345: ;; and adding to the list of files to delete eventually.
346: (if file-name
347: (rmail-insert-inbox-text (list file-name) nil)
348: (setq delete-files (rmail-insert-inbox-text rmail-inbox-list t)))
349: ;; Scan the new text and convert each message to babyl format.
350: (goto-char (point-min))
351: (save-excursion
352: (setq new-messages (rmail-convert-to-babyl-format)))
353: (or (zerop new-messages)
354: (progn
355: (widen)
356: (search-backward "\^_")
357: (narrow-to-region (point) (point-max))
358: (goto-char (1+ (point-min)))
359: (rmail-count-new-messages)))
360: (save-buffer)
361: ;; Delete the old files, now that babyl file is saved.
362: (while delete-files
363: (condition-case ()
364: (delete-file (car delete-files))
365: (file-error nil))
366: (setq delete-files (cdr delete-files))))
367: (if (= new-messages 0)
368: (progn (goto-char opoint)
369: (message "(No new mail has arrived)"))
370: (message "%d new message%s read"
371: new-messages (if (= 1 new-messages) "" "s")))
372: (rmail-show-message))))
373:
374: (defun rmail-insert-inbox-text (files renamep)
375: (let (file tofile delete-files movemail)
376: (while files
377: (setq file (substitute-in-file-name (car files))
378: tofile (concat file "~"))
379: ;; If getting from mail spool directory,
380: ;; use movemail to move rather than renaming.
381: (setq movemail (equal (file-name-directory file) rmail-spool-directory))
382: (if movemail
383: (progn
384: (setq tofile (expand-file-name "~/.newmail"))
385: ;; On some systems, /usr/spool/mail/foo is a directory
386: ;; and the actual inbox is /usr/spool/mail/foo/foo.
387: (if (file-directory-p file)
388: (setq file (substitute-in-file-name
389: (concat file "/$USER"))))))
390: ;; If not renaming, get straight out of the actual inbox.
391: ;; If renaming, get out of the alternate name if that exists,
392: ;; otherwise rename the inbox to the alternate name and get from it.
393: (if renamep
394: (if (and (not (file-exists-p tofile)) (file-exists-p file))
395: (if movemail
396: (call-process
397: (expand-file-name "movemail" exec-directory)
398: nil nil nil file tofile)
399: (rename-file file tofile nil)))
400: (setq tofile file))
401: ;; At this point, tofile contains the name to read.
402: ;; Either the alternate name (if we renamed)
403: ;; or the actual inbox (if not renaming).
404: (if (file-exists-p tofile)
405: (progn (goto-char (point-max))
406: (insert-file-contents tofile)
407: (goto-char (point-max))
408: (or (= (preceding-char) ?\n)
409: (insert ?\n))
410: (setq delete-files (cons tofile delete-files))))
411: (setq files (cdr files)))
412: delete-files))
413:
414: ;; the rmail-break-forwarded-messages feature is not implemented
415: (defun rmail-convert-to-babyl-format ()
416: (let ((count 0) start
417: (case-fold-search t))
418: (goto-char (point-min))
419: (save-restriction
420: (while (not (eobp))
421: (cond ((looking-at "Babyl Options:");Babyl header
422: (search-forward "\n\^_")
423: (delete-region (point-min) (point)))
424: ;; Babyl format message
425: ((looking-at "\^L")
426: (or (search-forward "\n\^_" nil t)
427: (progn
428: (message "Invalid Babyl format in inbox!")
429: (sit-for 1)
430: (goto-char (point-max))))
431: (setq count (1+ count))
432: (skip-chars-forward " \t\n")
433: (narrow-to-region (point) (point-max)))
434: ;;*** MMDF format
435: ((looking-at mmdf-delim1)
436: (replace-match "\^L\n0,unseen,,\n*** EOOH ***\n")
437: (setq start (point))
438: (re-search-forward mmdf-delim2 nil t)
439: (replace-match "\^_")
440: (save-excursion
441: (save-restriction
442: (narrow-to-region start (1- (point)))
443: (goto-char (point-min))
444: (while (search-forward "\n\^_" nil t); single char "\^_"
445: (replace-match "\n^_")))); 2 chars: "^" and "_"
446: (narrow-to-region (point) (point-max))
447: (setq count (1+ count)))
448: ;;*** Mail format
449: ((looking-at "^From ")
450: (setq start (point))
451: (insert "\^L\n0,unseen,,\n*** EOOH ***\n")
452: (rmail-nuke-pinhead-header)
453: (if (re-search-forward
454: (concat "^[\^_]?\\("
455: "From [^ \n]*\\(\\|\".*\"[^ \n]*\\) ?[^ \n]* [^ \n]* *"
456: "[0-9]* [0-9:]* \\(..T \\|\\)" ; EDT
457: "19[0-9]*$\\|"
458: mmdf-delim1 "\\|"
459: "^Babyl Options:\\|"
460: "\^L\n[01],\\)") nil t)
461: (goto-char (match-beginning 1))
462: (goto-char (point-max)))
463: (setq count (1+ count))
464: (save-excursion
465: (save-restriction
466: (narrow-to-region start (point))
467: (goto-char (point-min))
468: (while (search-forward "\n\^_" nil t); single char
469: (replace-match "\n^_")))); 2 chars: "^" and "_"
470: (insert ?\^_)
471: (narrow-to-region (point) (point-max)))
472: ;;
473: ;;This is a kludge, in case we're wrong about mmdf not
474: ;;allowing anything in between. If it loses, we'll have
475: ;;to look for something else
476: (t (delete-char 1)))))
477: count))
478:
479: (defun rmail-nuke-pinhead-header ()
480: (save-excursion
481: (save-restriction
482: (let ((start (point))
483: (end (condition-case ()
484: (progn (search-forward "\n\n") (point))
485: (error (message "Can't find EOH") nil)))
486: has-from has-date
487: (case-fold-search t))
488: (if (not end)
489: nil
490: (narrow-to-region start end)
491: (goto-char start)
492: (setq has-from (search-forward "\nFrom:" nil t))
493: (goto-char start)
494: (setq has-date (and (search-forward "\nDate:" nil t) (point)))
495: (goto-char start)
496: (setq case-fold-search nil)
497: (if (re-search-forward
498: "^From \\([^ ]*\\(\\|\".*\"[^ ]*\\)\\) ?\\([^ ]*\\) \\([^ ]*\\) *\\([0-9]*\\) \\([0-9:]*\\)\\( ..T\\|\\) 19\\([0-9]*\\)\n" nil t)
499: (replace-match
500: (concat
501: ;; Keep and reformat the date if we don't have a Date: field.
502: (if has-date
503: ""
504: ;; If no time zone specified, assume est.
505: (if (= (match-beginning 7) (match-end 7))
506: "Date: \\3, \\5 \\4 \\8 \\6 est\n"
507: "Date: \\3, \\5 \\4 \\8 \\6\\7\n"))
508: ;; Keep and reformat the sender if we don't have a From: field.
509: (if has-from ""
510: "From: \\1\n")))))))))
511:
512: ;;;; *** Rmail Message Formatting and Header Manipulation ***
513:
514: (defun rmail-reformat-message (beg end)
515: (goto-char beg)
516: (forward-line 1)
517: (if (/= (following-char) ?0)
518: (error "Bad format in RMAIL file."))
519: (let ((buffer-read-only nil)
520: (delta (- (buffer-size) end)))
521: (delete-char 1)
522: (insert ?1)
523: (forward-line 1)
524: (if (looking-at "Summary-line: ")
525: (forward-line 1))
526: (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n")
527: (delete-region (point)
528: (progn (forward-line 1) (point))))
529: (let ((str (buffer-substring (point)
530: (save-excursion (search-forward "\n\n" end 'move)
531: (point)))))
532: (insert str "*** EOOH ***\n")
533: (narrow-to-region (point) (- (buffer-size) delta)))
534: (goto-char (point-min))
535: (if rmail-ignored-headers (rmail-clear-headers))
536: (if rmail-message-filter (funcall rmail-message-filter))))
537:
538: (defun rmail-clear-headers ()
539: (if (search-forward "\n\n" nil t)
540: (save-restriction
541: (narrow-to-region (point-min) (point))
542: (let ((buffer-read-only nil))
543: (while (let ((case-fold-search t))
544: (goto-char (point-min))
545: (re-search-forward rmail-ignored-headers nil t))
546: (beginning-of-line)
547: (delete-region (point)
548: (progn (re-search-forward "\n[^ \t]")
549: (forward-char -1)
550: (point))))))))
551:
552: (defun rmail-toggle-header ()
553: "Show original message header if pruned header currently shown, or vice versa."
554: (interactive)
555: (rmail-maybe-set-message-counters)
556: (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
557: (let ((buffer-read-only nil))
558: (goto-char (point-min))
559: (forward-line 1)
560: (if (= (following-char) ?1)
561: (progn (delete-char 1)
562: (insert ?0)
563: (forward-line 1)
564: (if (looking-at "Summary-Line:")
565: (forward-line 1))
566: (insert "*** EOOH ***\n")
567: (forward-char -1)
568: (search-forward "\n*** EOOH ***\n")
569: (forward-line -1)
570: (let ((temp (point)))
571: (and (search-forward "\n\n" nil t)
572: (delete-region temp (point))))
573: (goto-char (point-min))
574: (search-forward "\n*** EOOH ***\n")
575: (narrow-to-region (point) (point-max)))
576: (rmail-reformat-message (point-min) (point-max)))))
577:
578: ;;;; *** Rmail Attributes and Keywords ***
579:
580: ;; Make a string describing current message's attributes and keywords
581: ;; and set it up as the name of a minor mode
582: ;; so it will appear in the mode line.
583: (defun rmail-display-labels ()
584: (let ((blurb ""))
585: (save-excursion
586: (save-restriction
587: (widen)
588: (goto-char (rmail-msgbeg rmail-current-message))
589: (forward-line 1)
590: (if (looking-at "[01],")
591: (progn
592: (narrow-to-region (point) (progn (end-of-line) (point)))
593: (if (search-backward ",," nil 'move)
594: (progn
595: (if (> (point) (1+ (point-min)))
596: (setq blurb (buffer-substring (1+ (point-min)) (point))))
597: (if (> (- (point-max) (point)) 2)
598: (setq blurb
599: (concat blurb
600: ";"
601: (buffer-substring (+ (point) 2)
602: (1- (point-max))))))))))))
603: (setq minor-modes
604: (list (cons 'foo
605: (concat rmail-current-message "/" rmail-total-messages
606: blurb))))))
607:
608: ;; Turn an attribute of the current message on or off according to STATE.
609: ;; ATTR is the name of the attribute, as a string.
610: (defun rmail-set-attribute (attr state)
611: (let ((omax (- (buffer-size) (point-max)))
612: (omin (- (buffer-size) (point-min)))
613: (buffer-read-only nil))
614: (unwind-protect
615: (save-excursion
616: (widen)
617: (goto-char (+ 3 (rmail-msgbeg rmail-current-message)))
618: (let ((curstate (search-backward (concat "," attr ",")
619: (prog1 (point) (end-of-line)) t)))
620: (or (eq curstate (not (not state)))
621: (if curstate
622: (delete-region (point) (1- (match-end 0)))
623: (beginning-of-line)
624: (forward-char 2)
625: (insert attr ","))))
626: (if (string= attr "deleted")
627: (rmail-set-message-deleted-p rmail-current-message state)))
628: (narrow-to-region (max 1 (- (buffer-size) omin))
629: (- (buffer-size) omax))
630: (rmail-display-labels))))
631:
632: ;; Return t if the attributes/keywords line of msg number MSG
633: ;; contains a match for the regexp LABELS.
634: (defun rmail-message-labels-p (msg labels)
635: (goto-char (rmail-msgbeg msg))
636: (forward-char 3)
637: (re-search-backward labels (prog1 (point) (end-of-line)) t))
638:
639: ;;;; *** Rmail Message Selection And Support ***
640:
641: (defun rmail-msgend (n)
642: (marker-position (aref rmail-message-vector (1+ n))))
643:
644: (defun rmail-msgbeg (n)
645: (marker-position (aref rmail-message-vector n)))
646:
647: (defun rmail-widen-to-current-msgbeg (function)
648: "Call FUNCTION with point at start of internal data of current message.
649: Assumes that bounds were previously narrowed to display the message in Rmail.
650: The bounds are widened enough to move point where desired,
651: then narrowed again afterward.
652: Assumes that the visible text of the message is not changed by FUNCTION."
653: (save-excursion
654: (let ((obeg (- (point-max) (point-min)))
655: (unwind-protect
656: (progn
657: (narrow-to-region (rmail-msgbeg rmail-current-message)
658: (point-max))
659: (goto-char (point-min))
660: (funcall function))
661: (narrow-to-region (- (point-max) obeg) (point-max)))))))
662:
663: (defun rmail-forget-messages ()
664: (unwind-protect
665: (if (vectorp rmail-message-vector)
666: (let* ((i 0)
667: (v rmail-message-vector)
668: (n (length v)))
669: (while (< i n)
670: (move-marker (aref v i) nil)
671: (setq i (1+ i)))))
672: (setq rmail-message-vector nil)
673: (setq rmail-deleted-vector nil)))
674:
675: (defun rmail-maybe-set-message-counters ()
676: (if (not (and rmail-deleted-vector
677: rmail-message-vector
678: rmail-current-message
679: rmail-total-messages))
680: (rmail-set-message-counters)))
681:
682: (defun rmail-count-new-messages ()
683: (message "Counting new messages...")
684: (let* ((case-fold-search nil)
685: (total-messages 0)
686: (messages-head nil)
687: (deleted-head nil))
688: (goto-char (point-max))
689: ;; Put at the end of messages-head
690: ;; the entry for message N+1, which marks
691: ;; the end of message N. (N = number of messages).
692: (search-backward "\^_")
693: (setq messages-head (list (point-marker)))
694: (rmail-set-message-counters-counter (point-min))
695: (setq rmail-current-message (1+ rmail-total-messages))
696: (setq rmail-total-messages
697: (+ rmail-total-messages total-messages))
698: (setq rmail-message-vector
699: (vconcat rmail-message-vector (cdr messages-head)))
700: (aset rmail-message-vector
701: rmail-current-message (car messages-head))
702: (setq rmail-deleted-vector
703: (concat rmail-deleted-vector deleted-head))
704: (setq rmail-summary-vector
705: (vconcat rmail-summary-vector (make-vector total-messages nil)))
706: (goto-char (point-min))
707: (message "Counting new messages...done (%d)" total-messages)))
708:
709: (defun rmail-set-message-counters ()
710: (rmail-forget-messages)
711: (message "Counting messages...")
712: (save-excursion
713: (save-restriction
714: (widen)
715: (let* ((point-save (point))
716: (total-messages 0)
717: (messages-after-point)
718: (case-fold-search nil)
719: (messages-head nil)
720: (deleted-head nil))
721: (goto-char (point-max))
722: ;; Put at the end of messages-head
723: ;; the entry for message N+1, which marks
724: ;; the end of message N. (N = number of messages).
725: (search-backward "\^_")
726: (setq messages-head (list (point-marker)))
727: (rmail-set-message-counters-counter (min (point) point-save))
728: (setq messages-after-point total-messages)
729: (rmail-set-message-counters-counter)
730: (setq rmail-total-messages total-messages)
731: (setq rmail-current-message
732: (max 1 (- total-messages messages-after-point)))
733: (setq rmail-message-vector
734: (apply 'vector (cons (point-min-marker) messages-head))
735: rmail-deleted-vector (concat "D" deleted-head)
736: rmail-summary-vector (make-vector rmail-total-messages nil)))))
737: (message "Counting messages...done"))
738:
739: (defun rmail-set-message-counters-counter (&optional stop)
740: (while (search-backward "\^_\^L\n" stop t)
741: (setq messages-head (cons (point-marker) messages-head))
742: (save-excursion
743: (setq deleted-head
744: (cons (if (search-backward ",deleted,"
745: (prog1 (point)
746: (forward-line 2))
747: t)
748: ?D ?\ )
749: deleted-head)))
750: (if (zerop (% (setq total-messages (1+ total-messages)) 20))
751: (message "Counting messages...%d" total-messages))))
752:
753: (defun rmail-beginning-of-message ()
754: "Show current message starting from the beginning."
755: (interactive)
756: (rmail-show-message rmail-current-message))
757:
758: (defun rmail-show-message (&optional n)
759: "Show message number N (prefix argument), counting from start of file."
760: (interactive "p")
761: (rmail-maybe-set-message-counters)
762: (widen)
763: (if (zerop rmail-total-messages)
764: (progn (ding)
765: (narrow-to-region (point-min) (1- (point-max)))
766: (setq minor-modes nil))
767: (let (blurb)
768: (if (not n)
769: (setq n rmail-current-message)
770: (cond ((<= n 0)
771: (setq n 1
772: rmail-current-message 1
773: blurb "No previous message"))
774: ((> n rmail-total-messages)
775: (setq n rmail-total-messages
776: rmail-current-message rmail-total-messages
777: blurb "No following message"))
778: (t
779: (setq rmail-current-message n))))
780: (let ((beg (rmail-msgbeg n))
781: (end (rmail-msgend n)))
782: (goto-char beg)
783: (forward-line 1)
784: (if (= (following-char) ?0)
785: (progn
786: (rmail-reformat-message beg end)
787: (rmail-set-attribute "unseen" nil))
788: (search-forward "\n*** EOOH ***\n" end t)
789: (narrow-to-region (point) end))
790: (goto-char (point-min))
791: (rmail-display-labels)
792: (if blurb
793: (message blurb))))))
794:
795: (defun rmail-next-message (n)
796: "Show following message whether deleted or not.
797: With prefix argument N, moves forward N messages,
798: or backward if N is negative."
799: (interactive "p")
800: (rmail-maybe-set-message-counters)
801: (rmail-show-message (+ rmail-current-message n)))
802:
803: (defun rmail-previous-message (n)
804: "Show previous message whether deleted or not.
805: With prefix argument N, moves backward N messages,
806: or forward if N is negative."
807: (interactive "p")
808: (rmail-next-message (- n)))
809:
810: (defun rmail-next-undeleted-message (n)
811: "Show following non-deleted message.
812: With prefix argument N, moves forward N non-deleted messages,
813: or backward if N is negative."
814: (interactive "p")
815: (rmail-maybe-set-message-counters)
816: (let ((lastwin rmail-current-message)
817: (current rmail-current-message))
818: (while (and (> n 0) (< current rmail-total-messages))
819: (setq current (1+ current))
820: (if (not (rmail-message-deleted-p current))
821: (setq lastwin current n (1- n))))
822: (while (and (< n 0) (> current 1))
823: (setq current (1- current))
824: (if (not (rmail-message-deleted-p current))
825: (setq lastwin current n (1+ n))))
826: (rmail-show-message lastwin)
827: (if (< n 0)
828: (message "No previous nondeleted message"))
829: (if (> n 0)
830: (message "No following nondeleted message"))))
831:
832: (defun rmail-previous-undeleted-message (n)
833: "Show previous non-deleted message.
834: With prefix argument N, moves backward N non-deleted messages,
835: or forward if N is negative."
836: (interactive "p")
837: (rmail-next-undeleted-message (- n)))
838:
839: (defun rmail-last-message ()
840: "Show last message in file."
841: (interactive)
842: (rmail-maybe-set-message-counters)
843: (rmail-show-message rmail-total-messages))
844:
845: (defun rmail-what-message ()
846: (let ((where (point))
847: (low 1)
848: (high rmail-total-messages)
849: (mid (/ rmail-total-messages 2)))
850: (while (> (- high low) 1)
851: (if (>= where (rmail-msgbeg mid))
852: (setq low mid)
853: (setq high mid))
854: (setq mid (+ low (/ (- high low) 2))))
855: (if (>= where (rmail-msgbeg high)) high low)))
856:
857: (defvar rmail-search-last-regexp nil)
858: (defun rmail-search (regexp &optional reversep)
859: "Show message containing next match for REGEXP.
860: Search in reverse (earlier messages) with non-nil 2nd arg REVERSEP.
861: Interactively, empty argument means use same regexp used last time,
862: and reverse search is specified by a negative numeric arg."
863: (interactive
864: (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
865: (prompt (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
866: regexp)
867: (if rmail-search-last-regexp
868: (setq prompt (concat prompt
869: "(default "
870: rmail-search-last-regexp
871: ") ")))
872: (setq regexp (read-string prompt))
873: (cond ((not (equal regexp ""))
874: (setq rmail-search-last-regexp regexp))
875: ((not rmail-search-last-regexp)
876: (error "No previous Rmail search string")))
877: (list rmail-search-last-regexp reversep)))
878: (message "%sRmail search for %s..."
879: (if reversep "Reverse " "")
880: regexp)
881: (let ((omin (point-min))
882: (omax (point-max))
883: (opoint (point))
884: win
885: (msg rmail-current-message))
886: (unwind-protect
887: (if (funcall (if reversep 're-search-backward 're-search-backward)
888: regexp nil t)
889: (setq win t)
890: (widen)
891: (if reversep
892: (while (and (null win) (> msg 1))
893: (goto-char (rmail-msgend (setq msg (1- msg))))
894: (setq win (re-search-backward
895: regexp (rmail-msgbeg msg) t)))
896: (while (and (null win) (< msg rmail-total-messages))
897: (goto-char (rmail-msgbeg (setq msg (1+ msg))))
898: (setq win (re-search-forward regexp (rmail-msgend msg) t)))))
899: (if win
900: (progn
901: (setq win (point))
902: (rmail-show-message msg)
903: (message "%sRmail search for %s...done"
904: (if reversep "Reverse " "")
905: regexp)
906: (goto-char win))
907: (goto-char opoint)
908: (narrow-to-region omin omax)
909: (ding)
910: (message "Searched failed: %s" regexp)))))
911:
912: ;;;; *** Rmail Message Deletion Commands ***
913:
914: (defun rmail-message-deleted-p (n)
915: (= (aref rmail-deleted-vector n) ?D))
916:
917: (defun rmail-set-message-deleted-p (n state)
918: (aset rmail-deleted-vector n (if state ?D ?\ )))
919:
920: (defun rmail-delete-message ()
921: "Delete this message and stay on it."
922: (interactive)
923: (rmail-set-attribute "deleted" t))
924:
925: (defun rmail-undelete-previous-message ()
926: "Back up to deleted message, select it, and undelete it."
927: (interactive)
928: (let ((msg rmail-current-message))
929: (while (and (> msg 0)
930: (not (rmail-message-deleted-p msg)))
931: (setq msg (1- msg)))
932: (if (= msg 0)
933: (error "No previous deleted message")
934: (rmail-show-message msg)
935: (rmail-set-attribute "deleted" nil))))
936:
937: (defun rmail-delete-forward (&optional backward)
938: "Delete this message and move to next nondeleted one.
939: Deleted messages stay in the file until the \\[rmail-expunge] command is given.
940: With prefix argument, delete and move backward."
941: (interactive "P")
942: (rmail-set-attribute "deleted" t)
943: (rmail-next-undeleted-message (if backward -1 1)))
944:
945: (defun rmail-delete-backward ()
946: "Delete this message and move to previous nondeleted one.
947: Deleted messages stay in the file until the \\[rmail-expunge] command is given."
948: (interactive)
949: (rmail-delete-forward t))
950:
951: (defun rmail-expunge ()
952: "Actually erase all deleted messages in the file."
953: (interactive)
954: (message "Expunging deleted messages...")
955: (rmail-maybe-set-message-counters)
956: (let* ((omax (- (buffer-size) (point-max)))
957: (omin (- (buffer-size) (point-min)))
958: (messages-head (cons (aref rmail-message-vector 0) nil))
959: (messages-tail messages-head)
960: (win))
961: (unwind-protect
962: (save-excursion
963: (widen)
964: (goto-char (point-min))
965: (let ((counter 0)
966: (number 1)
967: (total rmail-total-messages)
968: (new-message-number rmail-current-message)
969: (new-summary nil)
970: (buffer-read-only nil)
971: (messages rmail-message-vector)
972: (deleted rmail-deleted-vector)
973: (summary rmail-summary-vector))
974: (setq rmail-total-messages nil
975: rmail-current-message nil
976: rmail-message-vector nil
977: rmail-deleted-vector nil
978: rmail-summary-vector nil)
979: (while (<= number total)
980: (if (= (aref deleted number) ?D)
981: (progn
982: (delete-region
983: (marker-position (aref messages number))
984: (marker-position (aref messages (1+ number))))
985: (move-marker (aref messages number) nil)
986: (if (> new-message-number counter)
987: (setq new-message-number (1- new-message-number))))
988: (setq counter (1+ counter))
989: (setq messages-tail
990: (setcdr messages-tail
991: (cons (aref messages number) nil)))
992: (setq new-summary
993: (cons (if (= counter number) (aref summary (1- number)))
994: new-summary)))
995: (if (zerop (% (setq number (1+ number)) 20))
996: (message "Expunging deleted messages...%d" number)))
997: (setq messages-tail
998: (setcdr messages-tail
999: (cons (aref messages number) nil)))
1000: (setq rmail-current-message new-message-number
1001: rmail-total-messages counter
1002: rmail-message-vector (apply 'vector messages-head)
1003: rmail-deleted-vector (make-string (1+ counter) ?\ )
1004: rmail-summary-vector (vconcat (nreverse new-summary))
1005: win t)))
1006: (message "Expunging deleted messages...done")
1007: (if (not win)
1008: (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)))
1009: (rmail-show-message
1010: (if (zerop rmail-current-message) 1 nil)))))
1011:
1012: ;;;; *** Rmail Mailing Commands ***
1013:
1014: (defun rmail-mail ()
1015: "Send mail in another window.
1016: While composing the message, use \\[mail-yank-original] to yank the
1017: original message into it."
1018: (interactive)
1019: (mail-other-window nil nil nil nil nil (current-buffer)))
1020:
1021: (defun rmail-continue ()
1022: "Continue composing outgoing message previously being composed."
1023: (interactive)
1024: (mail-other-window t))
1025:
1026: (defun rmail-reply (just-sender)
1027: "Reply to the current message.
1028: Normally include CC: to all other recipients of original message;
1029: prefix argument means ignore them.
1030: While composing the reply, use \\[mail-yank-original] to yank the
1031: original message into it."
1032: (interactive "P")
1033: ;;>> this gets set even if we abort. Can't do anything about it, though.
1034: (rmail-set-attribute "answered" t)
1035: (rmail-display-labels)
1036: (let (from reply-to cc subject date to)
1037: (save-excursion
1038: (save-restriction
1039: (widen)
1040: (goto-char (rmail-msgbeg rmail-current-message))
1041: (forward-line 1)
1042: (if (= (following-char) ?0)
1043: (narrow-to-region
1044: (progn (forward-line 2)
1045: (point))
1046: (progn (search-forward "\n\n" (rmail-msgend rmail-current-message)
1047: 'move)
1048: (point)))
1049: (narrow-to-region (point)
1050: (progn (search-forward "\n*** EOOH ***\n")
1051: (beginning-of-line) (point))))
1052: (setq from (mail-fetch-field "from")
1053: reply-to (or (mail-fetch-field "resent-reply-to" t)
1054: (mail-fetch-field "reply-to" nil t)
1055: from)
1056: cc (if (not just-sender) (mail-fetch-field "cc" nil t))
1057: subject (mail-fetch-field "subject")
1058: date (mail-fetch-field "date")
1059: to (or (mail-fetch-field "to" nil t)
1060: ; (mail-fetch-field "apparently-to") ack gag barf
1061: ""))))
1062: (and subject
1063: (string-match "^Re: " subject)
1064: (setq subject (substring subject 4)))
1065: (mail-other-window nil
1066: (mail-strip-quoted-names reply-to)
1067: subject
1068: (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from)))
1069: (concat (if stop-pos (substring from 0 stop-pos) from)
1070: "'s message of " date))
1071: (if just-sender
1072: nil
1073: (let* ((cc-list (rmail-dont-reply-to
1074: (mail-strip-quoted-names
1075: (if (null cc) to (concat to ", " cc))))))
1076: (if (string= cc-list "") nil cc-list)))
1077: (current-buffer))))
1078:
1079: (defun rmail-forward ()
1080: "Forward the current message to another user."
1081: (interactive)
1082: ;;>> this gets set even if we abort. Can't do anything about it, though.
1083: (rmail-set-attribute "forwarded" t)
1084: (let ((forward-buffer (current-buffer))
1085: (subject (concat "["
1086: (mail-strip-quoted-names (mail-fetch-field "From"))
1087: ": " (or (mail-fetch-field "Subject") "") "]")))
1088: (if (mail-other-window nil nil subject)
1089: (save-excursion
1090: (goto-char (point-max))
1091: (forward-line 1)
1092: (insert-buffer forward-buffer)))))
1093:
1094:
1095: ;;;; *** Rmail Specify Inbox Files ***
1096:
1097: (autoload 'set-rmail-inbox-list "rmailmsc"
1098: "Set the inbox list of the current RMAIL file to FILE-NAME.
1099: This may be a list of file names separated by commas.
1100: If FILE-NAME is empty, remove any inbox list."
1101: t)
1102:
1103: ;;;; *** Rmail Commands for Labels ***
1104:
1105: (autoload 'rmail-add-label "rmailkwd"
1106: "Add LABEL to labels associated with current RMAIL message.
1107: Completion is performed over known labels when reading."
1108: t)
1109:
1110: (autoload 'rmail-kill-label "rmailkwd"
1111: "Remove LABEL from labels associated with current RMAIL message.
1112: Completion is performed over known labels when reading."
1113: t)
1114:
1115: (autoload 'rmail-next-labeled-message "rmailkwd"
1116: "Show next message with LABEL. Defaults to last label used.
1117: With prefix argument N moves forward N messages with this label."
1118: t)
1119:
1120: (autoload 'rmail-previous-labeled-message "rmailkwd"
1121: "Show previous message with LABEL. Defaults to last label used.
1122: With prefix argument N moves backward N messages with this label."
1123: t)
1124:
1125: ;;;; *** Rmail Edit Mode ***
1126:
1127: (autoload 'rmail-edit-current-message "rmailedit"
1128: "Edit the contents of the current message"
1129: t)
1130:
1131: ;;;; *** Rmail Summary Mode ***
1132:
1133: (autoload 'rmail-summary "rmailsum"
1134: "Display a summary of all messages, one line per message."
1135: t)
1136:
1137: (autoload 'rmail-summary-by-labels "rmailsum"
1138: "Display a summary of all messages with one or more LABELS.
1139: LABELS should be a string containing the desired labels, separated by commas."
1140: t)
1141:
1142: (autoload 'rmail-summary-by-recipients "rmailsum"
1143: "Display a summary of all messages with the given RECIPIENTS.
1144: Normally checks the To, From and Cc fields of headers;
1145: but if PRIMARY-ONLY is non-nil (prefix arg given),
1146: only look in the To and From fields.
1147: RECIPIENTS is a string of names separated by commas."
1148: t)
1149:
1150: ;;;; *** Rmail output messages to files ***
1151:
1152: (autoload 'rmail-output-to-rmail-file "rmailout"
1153: "Append the current message to an Rmail file named FILE-NAME.
1154: If the file does not exist, ask if it should be created.
1155: If file is being visited, the message is appended to the Emacs
1156: buffer visiting that file."
1157: t)
1158:
1159: (autoload 'rmail-output "rmailout"
1160: "Append this message to Unix mail file named FILE-NAME."
1161: t)
1162:
1163: ;;;; *** Rmail undigestification ***
1164:
1165: (autoload 'undigestify-rmail-message "undigest"
1166: "Break up a digest message into its constituent messages.
1167: Leaves original message, deleted, before the undigestified messages."
1168: t)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.