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