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