Initial revision
[emacs.git] / lisp / mail / rmail.el
blob49128f85eb50c66041577354fb755a3c17fc68cf
1 ;;; rmail.el --- main code of "RMAIL" mail reader for Emacs.
3 ;; Copyright (C) 1985,86,87,88,93,94,95 Free Software Foundation, Inc.
5 ;; Maintainer: FSF
6 ;; Keywords: mail
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24 ;;; Code:
26 ;; Souped up by shane@mit-ajax based on ideas of rlk@athena.mit.edu
27 ;; New features include attribute and keyword support, message
28 ;; selection by dispatch table, summary by attributes and keywords,
29 ;; expunging by dispatch table, sticky options for file commands.
31 ;; Extended by Bob Weiner of Motorola
32 ;; New features include: rmail and rmail-summary buffers remain
33 ;; synchronized and key bindings basically operate the same way in both
34 ;; buffers, summary by topic or by regular expression, rmail-reply-prefix
35 ;; variable, and a bury rmail buffer (wipe) command.
38 (require 'mail-utils)
40 ;; For Emacs V18 compatibility
41 (and (not (fboundp 'buffer-disable-undo))
42 (fboundp 'buffer-flush-undo)
43 (defalias 'buffer-disable-undo 'buffer-flush-undo))
45 ; These variables now declared in paths.el.
46 ;(defvar rmail-spool-directory "/usr/spool/mail/"
47 ; "This is the name of the directory used by the system mailer for\n\
48 ;delivering new mail. It's name should end with a slash.")
49 ;(defvar rmail-file-name
50 ; (expand-file-name "~/RMAIL")
51 ; "")
53 (defvar rmail-movemail-program nil
54 "If non-nil, name of program for fetching new mail.")
56 ;;;###autoload
57 (defvar rmail-dont-reply-to-names nil "\
58 *A regexp specifying names to prune of reply to messages.
59 A value of nil means exclude your own name only.")
61 ;;;###autoload
62 (defvar rmail-default-dont-reply-to-names "info-" "\
63 A regular expression specifying part of the value of the default value of
64 the variable `rmail-dont-reply-to-names', for when the user does not set
65 `rmail-dont-reply-to-names' explicitly. (The other part of the default
66 value is the user's name.)
67 It is useful to set this variable in the site customization file.")
69 ;;;###autoload
70 (defvar rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:\\|^\\(resent-\\|\\)message-id:\\|^summary-line:"
71 "*Regexp to match Header fields that Rmail should normally hide.")
73 ;;;###autoload
74 (defvar rmail-displayed-headers nil
75 "*Regexp to match Header fields that Rmail should display.
76 If nil, display all header fields except those matched by
77 `rmail-ignored-headers'.")
79 ;;;###autoload
80 (defvar rmail-retry-ignored-headers nil "\
81 *Headers that should be stripped when retrying a failed message.")
83 ;;;###autoload
84 (defvar rmail-highlighted-headers "^From:\\|^Subject:" "\
85 *Regexp to match Header fields that Rmail should normally highlight.
86 A value of nil means don't highlight.
87 See also `rmail-highlight-face'.")
89 ;;;###autoload
90 (defvar rmail-highlight-face nil "\
91 *Face used by Rmail for highlighting headers.")
93 ;;;###autoload
94 (defvar rmail-delete-after-output nil "\
95 *Non-nil means automatically delete a message that is copied to a file.")
97 ;;;###autoload
98 (defvar rmail-primary-inbox-list nil "\
99 *List of files which are inboxes for user's primary mail file `~/RMAIL'.
100 `nil' means the default, which is (\"/usr/spool/mail/$USER\")
101 \(the name varies depending on the operating system,
102 and the value of the environment variable MAIL overrides it).")
104 ;;;###autoload
105 (defvar rmail-mail-new-frame nil
106 "*Non-nil means Rmail makes a new frame for composing outgoing mail.")
108 ;;;###autoload
109 (defvar rmail-secondary-file-directory "~/"
110 "*Directory for additional secondary Rmail files.")
111 ;;;###autoload
112 (defvar rmail-secondary-file-regexp "\\.xmail$"
113 "*Regexp for which files are secondary Rmail files.")
115 ;; These may be altered by site-init.el to match the format of mmdf files
116 ;; delimiting used on a given host (delim1 and delim2 from the config
117 ;; files).
119 (defvar mmdf-delim1 "^\001\001\001\001\n"
120 "Regexp marking the start of an mmdf message")
121 (defvar mmdf-delim2 "^\001\001\001\001\n"
122 "Regexp marking the end of an mmdf message")
124 (defvar rmail-message-filter nil
125 "If non nil, a filter function for new messages in RMAIL.
126 Called with region narrowed to the message, including headers.")
128 (defvar rmail-reply-prefix "Re: "
129 "String to prepend to Subject line when replying to a message.")
131 ;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:".
132 ;; This pattern should catch all the common variants.
133 (defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\^[0-9]+\\)?: *\\)*"
134 "Regexp to delete from Subject line before inserting rmail-reply-prefix.")
136 (defvar rmail-display-summary nil
137 "If non nil, the summary buffer is always displayed.")
139 (defvar rmail-mode-map nil)
141 (defvar rmail-inbox-list nil)
142 (defvar rmail-keywords nil)
144 ;; Message counters and markers. Deleted flags.
146 (defvar rmail-current-message nil)
147 (defvar rmail-total-messages nil)
148 (defvar rmail-message-vector nil)
149 (defvar rmail-deleted-vector nil)
151 (defvar rmail-overlay-list nil)
153 (defvar rmail-font-lock-keywords
154 '(("^\\(From\\|Sender\\):" . font-lock-function-name-face)
155 ("^Reply-To:.*$" . font-lock-function-name-face)
156 ("^Subject:" . font-lock-comment-face)
157 ("^\\(To\\|Apparently-To\\|Cc\\):" . font-lock-keyword-face)
158 ("^[ \t]*\\sw*[>|}].*$" . font-lock-reference-face) ; Citation.
159 ("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\|Date\\):.*$" . font-lock-string-face))
160 "Additional expressions to highlight in Rmail mode.")
162 ;; These are used by autoloaded rmail-summary.
164 (defvar rmail-summary-buffer nil)
165 (defvar rmail-summary-vector nil)
167 ;; `Sticky' default variables.
169 ;; Last individual label specified to a or k.
170 (defvar rmail-last-label nil)
171 ;; Last set of values specified to C-M-n, C-M-p, C-M-s or C-M-l.
172 (defvar rmail-last-multi-labels nil)
173 (defvar rmail-last-regexp nil)
174 (defvar rmail-default-file "~/xmail"
175 "*Default file name for \\[rmail-output].")
176 (defvar rmail-default-rmail-file "~/XMAIL"
177 "*Default file name for \\[rmail-output-to-rmail-file].")
179 ;;; Regexp matching the delimiter of messages in UNIX mail format
180 ;;; (UNIX From lines), minus the initial ^. Note that if you change
181 ;;; this expression, you must change the code in rmail-nuke-pinhead-header
182 ;;; that knows the exact ordering of the \\( \\) subexpressions.
183 (defvar rmail-unix-mail-delimiter
184 (let ((time-zone-regexp
185 (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
186 "\\|[-+]?[0-9][0-9][0-9][0-9]"
187 "\\|"
188 "\\) *")))
189 (concat
190 "From "
192 ;; Username, perhaps with a quoted section that can contain spaces.
193 "\\("
194 "[^ \n]*"
195 "\\(\\|\".*\"[^ \n]*\\)"
196 "\\|<[^<>\n]+>"
197 "\\) ?"
199 ;; The time the message was sent.
200 "\\([^ \n]*\\) *" ; day of the week
201 "\\([^ ]*\\) *" ; month
202 "\\([0-9]*\\) *" ; day of month
203 "\\([0-9:]*\\) *" ; time of day
205 ;; Perhaps a time zone, specified by an abbreviation, or by a
206 ;; numeric offset.
207 time-zone-regexp
209 ;; The year.
210 " [0-9][0-9]\\([0-9]*\\) *"
212 ;; On some systems the time zone can appear after the year, too.
213 time-zone-regexp
215 ;; Old uucp cruft.
216 "\\(remote from .*\\)?"
218 "\n"))
219 nil)
221 ;; Perform BODY in the summary buffer
222 ;; in such a way that its cursor is properly updated in its own window.
223 (defmacro rmail-select-summary (&rest body)
224 (` (let ((total rmail-total-messages))
225 (if (rmail-summary-displayed)
226 (let ((window (selected-window)))
227 (save-excursion
228 (unwind-protect
229 (progn
230 (pop-to-buffer rmail-summary-buffer)
231 ;; rmail-total-messages is a buffer-local var
232 ;; in the rmail buffer.
233 ;; This way we make it available for the body
234 ;; even tho the rmail buffer is not current.
235 (let ((rmail-total-messages total))
236 (,@ body)))
237 (select-window window))))
238 (save-excursion
239 (set-buffer rmail-summary-buffer)
240 (let ((rmail-total-messages total))
241 (,@ body))))
242 (rmail-maybe-display-summary))))
244 ;;;; *** Rmail Mode ***
246 ;;;###autoload
247 (defun rmail (&optional file-name-arg)
248 "Read and edit incoming mail.
249 Moves messages into file named by `rmail-file-name' (a babyl format file)
250 and edits that file in RMAIL Mode.
251 Type \\[describe-mode] once editing that file, for a list of RMAIL commands.
253 May be called with file name as argument; then performs rmail editing on
254 that file, but does not copy any new mail into the file.
255 Interactively, if you supply a prefix argument, then you
256 have a chance to specify a file name with the minibuffer.
258 If `rmail-display-summary' is non-nil, make a summary for this RMAIL file."
259 (interactive (if current-prefix-arg
260 (list (read-file-name "Run rmail on RMAIL file: "
261 nil nil t))))
262 (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name)))
263 (existed (get-file-buffer file-name)))
264 ;; Like find-file, but in the case where a buffer existed
265 ;; and the file was reverted, recompute the message-data.
266 (if (and existed (not (verify-visited-file-modtime existed)))
267 (progn
268 ;; Don't be confused by apparent local-variables spec
269 ;; in the last message in the RMAIL file.
270 (let ((enable-local-variables nil))
271 (find-file file-name))
272 (if (and (verify-visited-file-modtime existed)
273 (eq major-mode 'rmail-mode))
274 (progn (rmail-forget-messages)
275 (rmail-set-message-counters))))
276 (let ((enable-local-variables nil))
277 (find-file file-name)))
278 (if (eq major-mode 'rmail-edit-mode)
279 (error "Exit Rmail Edit mode before getting new mail."))
280 (if (and existed (> (buffer-size) 0))
281 ;; Buffer not new and not empty; ensure in proper mode, but that's all.
282 (or (eq major-mode 'rmail-mode)
283 (rmail-mode-2))
284 (rmail-mode-2)
285 ;; Convert all or part to Babyl file if possible.
286 (rmail-convert-file)
287 (goto-char (point-max))
288 (if (null rmail-inbox-list)
289 (progn
290 (rmail-set-message-counters)
291 (rmail-show-message))))
292 (or (and (null file-name-arg)
293 (rmail-get-new-mail))
294 (rmail-show-message (rmail-first-unseen-message)))
295 (if rmail-display-summary (rmail-summary))
296 (rmail-construct-io-menu)))
298 ;; Given the value of MAILPATH, return a list of inbox file names.
299 ;; This is turned off because it is not clear that the user wants
300 ;; all these inboxes to feed into the primary rmail file.
301 ; (defun rmail-convert-mailpath (string)
302 ; (let (idx list)
303 ; (while (setq idx (string-match "[%:]" string))
304 ; (let ((this (substring string 0 idx)))
305 ; (setq string (substring string (1+ idx)))
306 ; (setq list (cons (if (string-match "%" this)
307 ; (substring this 0 (string-match "%" this))
308 ; this)
309 ; list))))
310 ; list))
312 ; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line
313 ; will not cause emacs 18.55 problems.
315 (defun rmail-convert-file ()
316 (let (convert)
317 (widen)
318 (goto-char (point-min))
319 ;; If file doesn't start like a Babyl file,
320 ;; convert it to one, by adding a header and converting each message.
321 (cond ((looking-at "BABYL OPTIONS:"))
322 ((looking-at "Version: 5\n")
323 ;; Losing babyl file made by old version of Rmail.
324 ;; Just fix the babyl file header; don't make a new one,
325 ;; so we don't lose the Labels: file attribute, etc.
326 (let ((buffer-read-only nil))
327 (insert "BABYL OPTIONS: -*- rmail -*-\n")))
328 ((equal (point-min) (point-max))
329 ;; Empty RMAIL file. Just insert the header.
330 (rmail-insert-rmail-file-header))
332 ;; Non-empty file in non-RMAIL format. Add header and convert.
333 (setq convert t)
334 (rmail-insert-rmail-file-header)))
335 ;; If file was not a Babyl file or if there are
336 ;; Unix format messages added at the end,
337 ;; convert file as necessary.
338 (if (or convert
339 (save-excursion
340 (goto-char (point-max))
341 (search-backward "\n\^_")
342 (forward-char 2)
343 (looking-at "\n*From ")))
344 (let ((buffer-read-only nil))
345 (message "Converting to Babyl format...")
346 ;; If file needs conversion, convert it all,
347 ;; except for the BABYL header.
348 ;; (rmail-convert-to-babyl-format would delete the header.)
349 (goto-char (point-min))
350 (search-forward "\n\^_" nil t)
351 (narrow-to-region (point) (point-max))
352 (rmail-convert-to-babyl-format)
353 (message "Converting to Babyl format...done")))))
355 ;;; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line
356 ;;; will not cause emacs 18.55 problems.
358 (defun rmail-insert-rmail-file-header ()
359 (let ((buffer-read-only nil))
360 (insert "BABYL OPTIONS: -*- rmail -*-
361 Version: 5
362 Labels:
363 Note: This is the header of an rmail file.
364 Note: If you are seeing it in rmail,
365 Note: it means the file has no messages in it.\n\^_")))
367 (if rmail-mode-map
369 (setq rmail-mode-map (make-keymap))
370 (suppress-keymap rmail-mode-map)
371 (define-key rmail-mode-map "a" 'rmail-add-label)
372 (define-key rmail-mode-map "b" 'rmail-bury)
373 (define-key rmail-mode-map "c" 'rmail-continue)
374 (define-key rmail-mode-map "d" 'rmail-delete-forward)
375 (define-key rmail-mode-map "\C-d" 'rmail-delete-backward)
376 (define-key rmail-mode-map "e" 'rmail-edit-current-message)
377 (define-key rmail-mode-map "f" 'rmail-forward)
378 (define-key rmail-mode-map "g" 'rmail-get-new-mail)
379 (define-key rmail-mode-map "h" 'rmail-summary)
380 (define-key rmail-mode-map "i" 'rmail-input)
381 (define-key rmail-mode-map "j" 'rmail-show-message)
382 (define-key rmail-mode-map "k" 'rmail-kill-label)
383 (define-key rmail-mode-map "l" 'rmail-summary-by-labels)
384 (define-key rmail-mode-map "\e\C-h" 'rmail-summary)
385 (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels)
386 (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients)
387 (define-key rmail-mode-map "\e\C-s" 'rmail-summary-by-regexp)
388 (define-key rmail-mode-map "\e\C-t" 'rmail-summary-by-topic)
389 (define-key rmail-mode-map "m" 'rmail-mail)
390 (define-key rmail-mode-map "\em" 'rmail-retry-failure)
391 (define-key rmail-mode-map "n" 'rmail-next-undeleted-message)
392 (define-key rmail-mode-map "\en" 'rmail-next-message)
393 (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message)
394 (define-key rmail-mode-map "o" 'rmail-output-to-rmail-file)
395 (define-key rmail-mode-map "\C-o" 'rmail-output)
396 (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message)
397 (define-key rmail-mode-map "\ep" 'rmail-previous-message)
398 (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message)
399 (define-key rmail-mode-map "q" 'rmail-quit)
400 (define-key rmail-mode-map "r" 'rmail-reply)
401 ;; I find I can't live without the default M-r command -- rms.
402 ;; (define-key rmail-mode-map "\er" 'rmail-search-backwards)
403 (define-key rmail-mode-map "s" 'rmail-expunge-and-save)
404 (define-key rmail-mode-map "\es" 'rmail-search)
405 (define-key rmail-mode-map "t" 'rmail-toggle-header)
406 (define-key rmail-mode-map "u" 'rmail-undelete-previous-message)
407 (define-key rmail-mode-map "w" 'rmail-edit-current-message)
408 (define-key rmail-mode-map "x" 'rmail-expunge)
409 (define-key rmail-mode-map "." 'rmail-beginning-of-message)
410 (define-key rmail-mode-map "<" 'rmail-first-message)
411 (define-key rmail-mode-map ">" 'rmail-last-message)
412 (define-key rmail-mode-map " " 'scroll-up)
413 (define-key rmail-mode-map "\177" 'scroll-down)
414 (define-key rmail-mode-map "?" 'describe-mode)
415 (define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date)
416 (define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject)
417 (define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author)
418 (define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient)
419 (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent)
420 (define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-lines)
421 (define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-keywords)
422 (define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject)
423 (define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject)
426 (define-key rmail-mode-map [menu-bar] (make-sparse-keymap))
428 (define-key rmail-mode-map [menu-bar classify]
429 (cons "Classify" (make-sparse-keymap "Classify")))
431 (define-key rmail-mode-map [menu-bar classify input-menu]
432 nil)
434 (define-key rmail-mode-map [menu-bar classify output-menu]
435 nil)
437 (define-key rmail-mode-map [menu-bar classify output-inbox]
438 '("Output (inbox)..." . rmail-output))
440 (define-key rmail-mode-map [menu-bar classify output]
441 '("Output (Rmail)..." . rmail-output-to-rmail-file))
443 (define-key rmail-mode-map [menu-bar classify kill-label]
444 '("Kill Label..." . rmail-kill-label))
446 (define-key rmail-mode-map [menu-bar classify add-label]
447 '("Add Label..." . rmail-add-label))
449 (define-key rmail-mode-map [menu-bar summary]
450 (cons "Summary" (make-sparse-keymap "Summary")))
452 (define-key rmail-mode-map [menu-bar summary senders]
453 '("By Senders..." . rmail-summary-by-senders))
455 (define-key rmail-mode-map [menu-bar summary labels]
456 '("By Labels..." . rmail-summary-by-labels))
458 (define-key rmail-mode-map [menu-bar summary recipients]
459 '("By Recipients..." . rmail-summary-by-recipients))
461 (define-key rmail-mode-map [menu-bar summary topic]
462 '("By Topic..." . rmail-summary-by-topic))
464 (define-key rmail-mode-map [menu-bar summary regexp]
465 '("By Regexp..." . rmail-summary-by-regexp))
467 (define-key rmail-mode-map [menu-bar summary all]
468 '("All" . rmail-summary))
470 (define-key rmail-mode-map [menu-bar mail]
471 (cons "Mail" (make-sparse-keymap "Mail")))
473 (define-key rmail-mode-map [menu-bar mail rmail-get-new-mail]
474 '("Get New Mail" . rmail-get-new-mail))
476 (define-key rmail-mode-map [menu-bar mail lambda]
477 '("----"))
479 (define-key rmail-mode-map [menu-bar mail continue]
480 '("Continue" . rmail-continue))
482 (define-key rmail-mode-map [menu-bar mail resend]
483 '("Re-send..." . rmail-resend))
485 (define-key rmail-mode-map [menu-bar mail forward]
486 '("Forward" . rmail-forward))
488 (define-key rmail-mode-map [menu-bar mail retry]
489 '("Retry" . rmail-retry-failure))
491 (define-key rmail-mode-map [menu-bar mail reply]
492 '("Reply" . rmail-reply))
494 (define-key rmail-mode-map [menu-bar mail mail]
495 '("Mail" . rmail-mail))
497 (define-key rmail-mode-map [menu-bar delete]
498 (cons "Delete" (make-sparse-keymap "Delete")))
500 (define-key rmail-mode-map [menu-bar delete expunge/save]
501 '("Expunge/Save" . rmail-expunge-and-save))
503 (define-key rmail-mode-map [menu-bar delete expunge]
504 '("Expunge" . rmail-expunge))
506 (define-key rmail-mode-map [menu-bar delete undelete]
507 '("Undelete" . rmail-undelete-previous-message))
509 (define-key rmail-mode-map [menu-bar delete delete]
510 '("Delete" . rmail-delete-forward))
512 (define-key rmail-mode-map [menu-bar move]
513 (cons "Move" (make-sparse-keymap "Move")))
515 (define-key rmail-mode-map [menu-bar move search-back]
516 '("Search Back..." . rmail-search-backwards))
518 (define-key rmail-mode-map [menu-bar move search]
519 '("Search..." . rmail-search))
521 (define-key rmail-mode-map [menu-bar move previous]
522 '("Previous Nondeleted" . rmail-previous-undeleted-message))
524 (define-key rmail-mode-map [menu-bar move next]
525 '("Next Nondeleted" . rmail-next-undeleted-message))
527 (define-key rmail-mode-map [menu-bar move last]
528 '("Last" . rmail-last-message))
530 (define-key rmail-mode-map [menu-bar move first]
531 '("First" . rmail-first-message))
533 (define-key rmail-mode-map [menu-bar move previous]
534 '("Previous" . rmail-previous-message))
536 (define-key rmail-mode-map [menu-bar move next]
537 '("Next" . rmail-next-message))
539 ;; Rmail mode is suitable only for specially formatted data.
540 (put 'rmail-mode 'mode-class 'special)
542 (defun rmail-mode-kill-summary ()
543 (if rmail-summary-buffer (kill-buffer rmail-summary-buffer)))
545 ;;;###autoload
546 (defun rmail-mode ()
547 "Rmail Mode is used by \\<rmail-mode-map>\\[rmail] for editing Rmail files.
548 All normal editing commands are turned off.
549 Instead, these commands are available:
551 \\[rmail-beginning-of-message] Move point to front of this message (same as \\[beginning-of-buffer]).
552 \\[scroll-up] Scroll to next screen of this message.
553 \\[scroll-down] Scroll to previous screen of this message.
554 \\[rmail-next-undeleted-message] Move to Next non-deleted message.
555 \\[rmail-previous-undeleted-message] Move to Previous non-deleted message.
556 \\[rmail-next-message] Move to Next message whether deleted or not.
557 \\[rmail-previous-message] Move to Previous message whether deleted or not.
558 \\[rmail-first-message] Move to the first message in Rmail file.
559 \\[rmail-last-message] Move to the last message in Rmail file.
560 \\[rmail-show-message] Jump to message specified by numeric position in file.
561 \\[rmail-search] Search for string and show message it is found in.
562 \\[rmail-delete-forward] Delete this message, move to next nondeleted.
563 \\[rmail-delete-backward] Delete this message, move to previous nondeleted.
564 \\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages
565 till a deleted message is found.
566 \\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail.
567 \\[rmail-expunge] Expunge deleted messages.
568 \\[rmail-expunge-and-save] Expunge and save the file.
569 \\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer.
570 \\[save-buffer] Save without expunging.
571 \\[rmail-get-new-mail] Move new mail from system spool directory into this file.
572 \\[rmail-mail] Mail a message (same as \\[mail-other-window]).
573 \\[rmail-continue] Continue composing outgoing message started before.
574 \\[rmail-reply] Reply to this message. Like \\[rmail-mail] but initializes some fields.
575 \\[rmail-retry-failure] Send this message again. Used on a mailer failure message.
576 \\[rmail-forward] Forward this message to another user.
577 \\[rmail-output-to-rmail-file] Output this message to an Rmail file (append it).
578 \\[rmail-output] Output this message to a Unix-format mail file (append it).
579 \\[rmail-input] Input Rmail file. Run Rmail on that file.
580 \\[rmail-add-label] Add label to message. It will be displayed in the mode line.
581 \\[rmail-kill-label] Kill label. Remove a label from current message.
582 \\[rmail-next-labeled-message] Move to Next message with specified label
583 (label defaults to last one specified).
584 Standard labels: filed, unseen, answered, forwarded, deleted.
585 Any other label is present only if you add it with \\[rmail-add-label].
586 \\[rmail-previous-labeled-message] Move to Previous message with specified label
587 \\[rmail-summary] Show headers buffer, with a one line summary of each message.
588 \\[rmail-summary-by-labels] Summarize only messages with particular label(s).
589 \\[rmail-summary-by-recipients] Summarize only messages with particular recipient(s).
590 \\[rmail-summary-by-regexp] Summarize only messages with particular regexp(s).
591 \\[rmail-summary-by-topic] Summarize only messages with subject line regexp(s).
592 \\[rmail-toggle-header] Toggle display of complete header."
593 (interactive)
594 (rmail-mode-2)
595 (rmail-set-message-counters)
596 (rmail-show-message rmail-total-messages))
598 (defun rmail-mode-2 ()
599 (kill-all-local-variables)
600 (rmail-mode-1)
601 (rmail-variables)
602 (run-hooks 'rmail-mode-hook))
604 (defun rmail-mode-1 ()
605 (setq major-mode 'rmail-mode)
606 (setq mode-name "RMAIL")
607 (setq buffer-read-only t)
608 ;; No need to auto save RMAIL files in normal circumstances
609 ;; because they contain no info except attribute changes
610 ;; and deletion of messages.
611 ;; The one exception is when messages are copied into an Rmail mode buffer.
612 ;; rmail-output-to-rmail-file enables auto save when you do that.
613 (setq buffer-auto-save-file-name nil)
614 (if (boundp 'mode-line-modified)
615 (setq mode-line-modified "--- ")
616 (setq mode-line-format
617 (cons "--- " (cdr (default-value 'mode-line-format)))))
618 (use-local-map rmail-mode-map)
619 (set-syntax-table text-mode-syntax-table)
620 (setq local-abbrev-table text-mode-abbrev-table))
622 (defun rmail-variables ()
623 (make-local-variable 'revert-buffer-function)
624 (setq revert-buffer-function 'rmail-revert)
625 (make-local-variable 'font-lock-defaults)
626 (setq font-lock-defaults '(rmail-font-lock-keywords t))
627 (make-local-variable 'rmail-last-label)
628 (make-local-variable 'rmail-last-regexp)
629 (make-local-variable 'rmail-deleted-vector)
630 (make-local-variable 'rmail-summary-buffer)
631 (make-local-variable 'rmail-summary-vector)
632 (make-local-variable 'rmail-current-message)
633 (make-local-variable 'rmail-total-messages)
634 (make-local-variable 'require-final-newline)
635 (setq require-final-newline nil)
636 (make-local-variable 'rmail-overlay-list)
637 (setq rmail-overlay-list nil)
638 (make-local-variable 'version-control)
639 (setq version-control 'never)
640 (make-local-variable 'kill-buffer-hook)
641 (add-hook 'kill-buffer-hook 'rmail-mode-kill-summary)
642 (make-local-variable 'file-precious-flag)
643 (setq file-precious-flag t)
644 (make-local-variable 'rmail-message-vector)
645 (make-local-variable 'rmail-inbox-list)
646 (setq rmail-inbox-list (rmail-parse-file-inboxes))
647 ;; Provide default set of inboxes for primary mail file ~/RMAIL.
648 (and (null rmail-inbox-list)
649 (or (equal buffer-file-name (expand-file-name rmail-file-name))
650 (equal buffer-file-truename
651 (abbreviate-file-name (file-truename rmail-file-name))))
652 (setq rmail-inbox-list
653 (or rmail-primary-inbox-list
654 (list (or (getenv "MAIL")
655 (concat rmail-spool-directory
656 (user-login-name)))))))
657 (make-local-variable 'rmail-keywords)
658 ;; this gets generated as needed
659 (setq rmail-keywords nil))
661 ;; Handle M-x revert-buffer done in an rmail-mode buffer.
662 (defun rmail-revert (arg noconfirm)
663 (let ((revert-buffer-function (default-value 'revert-buffer-function)))
664 ;; Call our caller again, but this time it does the default thing.
665 (if (revert-buffer arg noconfirm)
666 ;; If the user said "yes", and we changed something,
667 ;; reparse the messages.
668 (progn
669 (rmail-convert-file)
670 (goto-char (point-max))
671 (rmail-mode)))))
673 ;; Return a list of files from this buffer's Mail: option.
674 ;; Does not assume that messages have been parsed.
675 ;; Just returns nil if buffer does not look like Babyl format.
676 (defun rmail-parse-file-inboxes ()
677 (save-excursion
678 (save-restriction
679 (widen)
680 (goto-char 1)
681 (cond ((looking-at "BABYL OPTIONS:")
682 (search-forward "\n\^_" nil 'move)
683 (narrow-to-region 1 (point))
684 (goto-char 1)
685 (if (search-forward "\nMail:" nil t)
686 (progn
687 (narrow-to-region (point) (progn (end-of-line) (point)))
688 (goto-char (point-min))
689 (mail-parse-comma-list))))))))
691 (defun rmail-expunge-and-save ()
692 "Expunge and save RMAIL file."
693 (interactive)
694 (rmail-expunge)
695 (save-buffer)
696 (if (rmail-summary-exists)
697 (rmail-select-summary (set-buffer-modified-p nil))))
699 (defun rmail-quit ()
700 "Quit out of RMAIL."
701 (interactive)
702 (rmail-expunge-and-save)
703 ;; Don't switch to the summary buffer even if it was recently visible.
704 (if rmail-summary-buffer
705 (progn
706 (replace-buffer-in-windows rmail-summary-buffer)
707 (bury-buffer rmail-summary-buffer)))
708 (let ((obuf (current-buffer)))
709 (replace-buffer-in-windows obuf)
710 (bury-buffer obuf)))
712 (defun rmail-bury ()
713 "Bury current Rmail buffer and its summary buffer."
714 (interactive)
715 ;; This let var was called rmail-buffer, but that interfered
716 ;; with the buffer-local var used in summary buffers.
717 (let ((buffer-to-bury (current-buffer)))
718 (if (rmail-summary-exists)
719 (let (window)
720 (while (setq window (get-buffer-window rmail-summary-buffer))
721 (set-window-buffer window (other-buffer rmail-summary-buffer)))
722 (bury-buffer rmail-summary-buffer)))
723 (switch-to-buffer (other-buffer (current-buffer)))
724 (bury-buffer buffer-to-bury)))
726 (defun rmail-duplicate-message ()
727 "Create a duplicated copy of the current message.
728 The duplicate copy goes into the Rmail file just after the
729 original copy."
730 (interactive)
731 (widen)
732 (let ((buffer-read-only nil)
733 (number rmail-current-message)
734 (string (buffer-substring (rmail-msgbeg rmail-current-message)
735 (rmail-msgend rmail-current-message))))
736 (goto-char (rmail-msgend rmail-current-message))
737 (insert string)
738 (rmail-forget-messages)
739 (rmail-show-message number)
740 (message "Message duplicated")))
742 ;;;###autoload
743 (defun rmail-input (filename)
744 "Run Rmail on file FILENAME."
745 (interactive "FRun rmail on RMAIL file: ")
746 (rmail filename))
748 ;; Return a list of file names for all files in or under START
749 ;; whose names match rmail-secondary-file-regexp.
750 ;; This includes START itself, if that name matches.
751 ;; But normally START is a directory.
752 (defun rmail-find-all-files (start)
753 (if (file-accessible-directory-p start)
754 ;; Don't sort here.
755 (let ((files (directory-files start t
756 rmail-secondary-file-regexp t))
757 (ret nil)
758 file)
759 (while files
760 (setq file (car files))
761 (setq files (cdr files))
762 (setq ret (nconc
763 (rmail-find-all-files file)
764 ret)))
765 ;; Sort here instead of in directory-files
766 ;; because this list is usually much shorter.
767 (sort ret 'string<))
768 (let ((case-fold-search nil))
769 (if (string-match rmail-secondary-file-regexp start)
770 (list (file-name-nondirectory start))))))
772 (defun rmail-list-to-menu (menu-name l action &optional full-name)
773 (let ((menu (make-sparse-keymap menu-name)))
774 (mapcar
775 (function (lambda (item)
776 (let (command)
777 (if (consp item)
778 (progn
779 (setq command
780 (rmail-list-to-menu (car item) (cdr item)
781 action
782 (if full-name
783 (concat full-name "/"
784 (car item))
785 (car item))))
786 (setq name (car item)))
787 (progn
788 (setq name item)
789 (setq command
790 (list 'lambda () '(interactive)
791 (list action
792 (expand-file-name
793 (if full-name
794 (concat full-name "/" item)
795 item)
796 rmail-secondary-file-directory))))))
797 (define-key menu (vector (intern name))
798 (cons name command)))))
799 (reverse l))
800 menu))
802 ;; This command is always "disabled" when it appears in a menu.
803 (put 'rmail-disable-menu 'menu-enable ''nil)
805 (defun rmail-construct-io-menu ()
806 (let ((files (rmail-find-all-files rmail-secondary-file-directory)))
807 (if files
808 (progn
809 (define-key rmail-mode-map [menu-bar classify input-menu]
810 (cons "Input Rmail File"
811 (rmail-list-to-menu "Input Rmail File"
812 files
813 'rmail-input)))
814 (define-key rmail-mode-map [menu-bar classify output-menu]
815 (cons "Output Rmail File"
816 (rmail-list-to-menu "Output Rmail File"
817 files
818 'rmail-output-to-rmail-file))))
820 (define-key rmail-mode-map [menu-bar classify input-menu]
821 '("Input Rmail File" . rmail-disable-menu))
822 (define-key rmail-mode-map [menu-bar classify output-menu]
823 '("Output Rmail File" . rmail-disable-menu)))))
826 ;;;; *** Rmail input ***
828 ;; RLK feature not added in this version:
829 ;; argument specifies inbox file or files in various ways.
831 (defun rmail-get-new-mail (&optional file-name)
832 "Move any new mail from this RMAIL file's inbox files.
833 The inbox files can be specified with the file's Mail: option. The
834 variable `rmail-primary-inbox-list' specifies the inboxes for your
835 primary RMAIL file if it has no Mail: option. By default, this is
836 your /usr/spool/mail/$USER.
838 You can also specify the file to get new mail from. In this case, the
839 file of new mail is not changed or deleted. Noninteractively, you can
840 pass the inbox file name as an argument. Interactively, a prefix
841 argument causes us to read a file name and use that file as the inbox.
843 This function runs `rmail-get-new-mail-hook' before saving the updated file.
844 It returns t if it got any new messages."
845 (interactive
846 (list (if current-prefix-arg
847 (read-file-name "Get new mail from file: "))))
848 ;; If the disk file has been changed from under us,
849 ;; revert to it before we get new mail.
850 (or (verify-visited-file-modtime (current-buffer))
851 (find-file (buffer-file-name)))
852 (rmail-maybe-set-message-counters)
853 (widen)
854 ;; Get rid of all undo records for this buffer.
855 (or (eq buffer-undo-list t)
856 (setq buffer-undo-list nil))
857 (unwind-protect
858 (let ((opoint (point))
859 (new-messages 0)
860 (delete-files ())
861 ;; If buffer has not changed yet, and has not been saved yet,
862 ;; don't replace the old backup file now.
863 (make-backup-files (and make-backup-files (buffer-modified-p)))
864 (buffer-read-only nil)
865 ;; Don't make undo records for what we do in getting mail.
866 (buffer-undo-list t))
867 (goto-char (point-max))
868 (skip-chars-backward " \t\n") ; just in case of brain damage
869 (delete-region (point) (point-max)) ; caused by require-final-newline
870 (save-excursion
871 (save-restriction
872 (narrow-to-region (point) (point))
873 ;; Read in the contents of the inbox files,
874 ;; renaming them as necessary,
875 ;; and adding to the list of files to delete eventually.
876 (if file-name
877 (rmail-insert-inbox-text (list file-name) nil)
878 (setq delete-files (rmail-insert-inbox-text rmail-inbox-list t)))
879 ;; Scan the new text and convert each message to babyl format.
880 (goto-char (point-min))
881 (save-excursion
882 (setq new-messages (rmail-convert-to-babyl-format)))
883 (or (zerop new-messages)
884 (let (success)
885 (widen)
886 (search-backward "\n\^_" nil t)
887 (narrow-to-region (point) (point-max))
888 (goto-char (1+ (point-min)))
889 (rmail-count-new-messages)
890 (run-hooks 'rmail-get-new-mail-hook)
891 (save-buffer)))
892 ;; Delete the old files, now that babyl file is saved.
893 (while delete-files
894 (condition-case ()
895 ;; First, try deleting.
896 (condition-case ()
897 (delete-file (car delete-files))
898 (file-error
899 ;; If we can't delete it, truncate it.
900 (write-region (point) (point) (car delete-files))))
901 (file-error nil))
902 (setq delete-files (cdr delete-files)))))
903 (if (= new-messages 0)
904 (progn (goto-char opoint)
905 (if (or file-name rmail-inbox-list)
906 (message "(No new mail has arrived)"))
907 nil)
908 (if (rmail-summary-exists)
909 (rmail-select-summary
910 (rmail-update-summary)))
911 (message "%d new message%s read"
912 new-messages (if (= 1 new-messages) "" "s"))
913 ;; Move to the first new message
914 ;; unless we have other unseen messages before it.
915 (rmail-show-message (rmail-first-unseen-message))
916 ;; Update the displayed time, since that will clear out
917 ;; the flag that says you have mail.
918 (if (eq (process-status "display-time") 'run)
919 (display-time-filter display-time-process ""))
921 ;; Don't leave the buffer screwed up if we get a disk-full error.
922 (rmail-show-message)))
924 (defun rmail-insert-inbox-text (files renamep)
925 (let (file tofile delete-files movemail popmail)
926 (while files
927 (setq file (file-truename
928 (expand-file-name (substitute-in-file-name (car files))))
929 tofile (expand-file-name
930 ;; Generate name to move to from inbox name,
931 ;; in case of multiple inboxes that need moving.
932 (concat ".newmail-" (file-name-nondirectory file))
933 ;; Use the directory of this rmail file
934 ;; because it's a nuisance to use the homedir
935 ;; if that is on a full disk and this rmail
936 ;; file isn't.
937 (file-name-directory
938 (expand-file-name buffer-file-name))))
939 ;; Always use movemail to rename the file,
940 ;; since there can be mailboxes in various directories.
941 (setq movemail t)
942 ;;; ;; If getting from mail spool directory,
943 ;;; ;; use movemail to move rather than just renaming,
944 ;;; ;; so as to interlock with the mailer.
945 ;;; (setq movemail (string= file
946 ;;; (file-truename
947 ;;; (concat rmail-spool-directory
948 ;;; (file-name-nondirectory file)))))
949 (setq popmail (string-match "^po:" (file-name-nondirectory file)))
950 (if popmail (setq file (file-name-nondirectory file)
951 renamep t))
952 (if movemail
953 (progn
954 ;; On some systems, /usr/spool/mail/foo is a directory
955 ;; and the actual inbox is /usr/spool/mail/foo/foo.
956 (if (file-directory-p file)
957 (setq file (expand-file-name (user-login-name)
958 file)))))
959 (cond (popmail
960 (message "Getting mail from post office ..."))
961 ((and (file-exists-p tofile)
962 (/= 0 (nth 7 (file-attributes tofile))))
963 (message "Getting mail from %s..." tofile))
964 ((and (file-exists-p file)
965 (/= 0 (nth 7 (file-attributes file))))
966 (message "Getting mail from %s..." file)))
967 ;; Set TOFILE if have not already done so, and
968 ;; rename or copy the file FILE to TOFILE if and as appropriate.
969 (cond ((not renamep)
970 (setq tofile file))
971 ((or (file-exists-p tofile) (and (not popmail)
972 (not (file-exists-p file))))
973 nil)
974 ((and (not movemail) (not popmail))
975 ;; Try copying. If that fails (perhaps no space),
976 ;; rename instead.
977 (condition-case nil
978 (copy-file file tofile nil)
979 (error
980 ;; Third arg is t so we can replace existing file TOFILE.
981 (rename-file file tofile t)))
982 ;; Make the real inbox file empty.
983 ;; Leaving it deleted could cause lossage
984 ;; because mailers often won't create the file.
985 (condition-case ()
986 (write-region (point) (point) file)
987 (file-error nil)))
989 (let ((errors nil))
990 (unwind-protect
991 (save-excursion
992 (setq errors (generate-new-buffer " *rmail loss*"))
993 (buffer-disable-undo errors)
994 (call-process
995 (or rmail-movemail-program
996 (expand-file-name "movemail" exec-directory))
997 nil errors nil file tofile)
998 (if (not (buffer-modified-p errors))
999 ;; No output => movemail won
1001 (set-buffer errors)
1002 (subst-char-in-region (point-min) (point-max)
1003 ?\n ?\ )
1004 (goto-char (point-max))
1005 (skip-chars-backward " \t")
1006 (delete-region (point) (point-max))
1007 (goto-char (point-min))
1008 (if (looking-at "movemail: ")
1009 (delete-region (point-min) (match-end 0)))
1010 (beep t)
1011 (message (concat "movemail: "
1012 (buffer-substring (point-min)
1013 (point-max))))
1014 (sit-for 3)
1015 nil))
1016 (if errors (kill-buffer errors))))))
1017 ;; At this point, TOFILE contains the name to read:
1018 ;; Either the alternate name (if we renamed)
1019 ;; or the actual inbox (if not renaming).
1020 (if (file-exists-p tofile)
1021 (let (size)
1022 (goto-char (point-max))
1023 (setq size (nth 1 (insert-file-contents tofile)))
1024 (goto-char (point-max))
1025 (or (= (preceding-char) ?\n)
1026 (zerop size)
1027 (insert ?\n))
1028 (setq delete-files (cons tofile delete-files))))
1029 (message "")
1030 (setq files (cdr files)))
1031 delete-files))
1033 ;; the rmail-break-forwarded-messages feature is not implemented
1034 (defun rmail-convert-to-babyl-format ()
1035 (let ((count 0) start
1036 (case-fold-search nil)
1037 (invalid-input-resync
1038 (function (lambda ()
1039 (message "Invalid Babyl format in inbox!")
1040 (sit-for 1)
1041 ;; Try to get back in sync with a real message.
1042 (if (re-search-forward
1043 (concat mmdf-delim1 "\\|^From") nil t)
1044 (beginning-of-line)
1045 (goto-char (point-max)))))))
1046 (goto-char (point-min))
1047 (save-restriction
1048 (while (not (eobp))
1049 (cond ((looking-at "BABYL OPTIONS:");Babyl header
1050 (if (search-forward "\n\^_" nil t)
1051 ;; If we find the proper terminator, delete through there.
1052 (delete-region (point-min) (point))
1053 (funcall invalid-input-resync)
1054 (delete-region (point-min) (point))))
1055 ;; Babyl format message
1056 ((looking-at "\^L")
1057 (or (search-forward "\n\^_" nil t)
1058 (funcall invalid-input-resync))
1059 (setq count (1+ count))
1060 ;; Make sure there is no extra white space after the ^_
1061 ;; at the end of the message.
1062 ;; Narrowing will make sure that whatever follows the junk
1063 ;; will be treated properly.
1064 (delete-region (point)
1065 (save-excursion
1066 (skip-chars-forward " \t\n")
1067 (point)))
1068 (narrow-to-region (point) (point-max)))
1069 ;;*** MMDF format
1070 ((let ((case-fold-search t))
1071 (looking-at mmdf-delim1))
1072 (let ((case-fold-search t))
1073 (replace-match "\^L\n0, unseen,,\n*** EOOH ***\n")
1074 (setq start (point))
1075 (re-search-forward mmdf-delim2 nil t)
1076 (replace-match "\^_"))
1077 (save-excursion
1078 (save-restriction
1079 (narrow-to-region start (1- (point)))
1080 (goto-char (point-min))
1081 (while (search-forward "\n\^_" nil t); single char "\^_"
1082 (replace-match "\n^_")))); 2 chars: "^" and "_"
1083 (narrow-to-region (point) (point-max))
1084 (setq count (1+ count)))
1085 ;;*** Mail format
1086 ((looking-at "^From ")
1087 (setq start (point))
1088 (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
1089 (rmail-nuke-pinhead-header)
1090 ;; If this message has a Content-Length field,
1091 ;; skip to the end of the contents.
1092 (let* ((header-end (save-excursion
1093 (and (re-search-forward "\n\n" nil t)
1094 (1- (point)))))
1095 (case-fold-search t)
1096 (size
1097 ;; Get the numeric value from the Content-Length field.
1098 (save-excursion
1099 ;; Back up to end of prev line,
1100 ;; in case the Content-Length field comes first.
1101 (forward-char -1)
1102 (and (search-forward "\ncontent-length: "
1103 header-end t)
1104 (let ((beg (point))
1105 (eol (progn (end-of-line) (point))))
1106 (string-to-int (buffer-substring beg eol)))))))
1107 (and size
1108 (if (and (natnump size)
1109 (<= (+ header-end size) (point-max))
1110 ;; Make sure this would put us at a position
1111 ;; that we could continue from.
1112 (save-excursion
1113 (goto-char (+ header-end size))
1114 (skip-chars-forward "\n")
1115 (or (eobp)
1116 (and (looking-at "BABYL OPTIONS:")
1117 (search-forward "\n\^_" nil t))
1118 (and (looking-at "\^L")
1119 (search-forward "\n\^_" nil t))
1120 (let ((case-fold-search t))
1121 (looking-at mmdf-delim1))
1122 (looking-at "From "))))
1123 (goto-char (+ header-end size))
1124 (message "Ignoring invalid Content-Length field")
1125 (sit-for 1 0 t))))
1127 (if (re-search-forward
1128 (concat "^[\^_]?\\("
1129 rmail-unix-mail-delimiter
1130 "\\|"
1131 mmdf-delim1 "\\|"
1132 "^BABYL OPTIONS:\\|"
1133 "\^L\n[01],\\)") nil t)
1134 (goto-char (match-beginning 1))
1135 (goto-char (point-max)))
1136 (setq count (1+ count))
1137 (save-excursion
1138 (save-restriction
1139 (narrow-to-region start (point))
1140 (goto-char (point-min))
1141 (while (search-forward "\n\^_" nil t); single char
1142 (replace-match "\n^_")))); 2 chars: "^" and "_"
1143 (insert ?\^_)
1144 (narrow-to-region (point) (point-max)))
1146 ;; This kludge is because some versions of sendmail.el
1147 ;; insert an extra newline at the beginning that shouldn't
1148 ;; be there. sendmail.el has been fixed, but old versions
1149 ;; may still be in use. -- rms, 7 May 1993.
1150 ((eolp) (delete-char 1))
1151 (t (error "Cannot convert to babyl format")))))
1152 count))
1154 ;; Delete the "From ..." line, creating various other headers with
1155 ;; information from it if they don't already exist. Now puts the
1156 ;; original line into a mail-from: header line for debugging and for
1157 ;; use by the rmail-output function.
1158 (defun rmail-nuke-pinhead-header ()
1159 (save-excursion
1160 (save-restriction
1161 (let ((start (point))
1162 (end (progn
1163 (condition-case ()
1164 (search-forward "\n\n")
1165 (error
1166 (goto-char (point-max))
1167 (insert "\n\n")))
1168 (point)))
1169 has-from has-date)
1170 (narrow-to-region start end)
1171 (let ((case-fold-search t))
1172 (goto-char start)
1173 (setq has-from (search-forward "\nFrom:" nil t))
1174 (goto-char start)
1175 (setq has-date (and (search-forward "\nDate:" nil t) (point)))
1176 (goto-char start))
1177 (let ((case-fold-search nil))
1178 (if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t)
1179 (replace-match
1180 (concat
1181 "Mail-from: \\&"
1182 ;; Keep and reformat the date if we don't
1183 ;; have a Date: field.
1184 (if has-date
1186 (concat
1187 "Date: \\3, \\5 \\4 \\9 \\6 "
1189 ;; The timezone could be matched by group 7 or group 10.
1190 ;; If neither of them matched, assume EST, since only
1191 ;; Easterners would be so sloppy.
1192 ;; It's a shame the substitution can't use "\\10".
1193 (cond
1194 ((/= (match-beginning 7) (match-end 7)) "\\7")
1195 ((/= (match-beginning 10) (match-end 10))
1196 (buffer-substring (match-beginning 10)
1197 (match-end 10)))
1198 (t "EST"))
1199 "\n"))
1200 ;; Keep and reformat the sender if we don't
1201 ;; have a From: field.
1202 (if has-from
1204 "From: \\1\n"))
1205 t)))))))
1207 ;;;; *** Rmail Message Formatting and Header Manipulation ***
1209 (defun rmail-reformat-message (beg end)
1210 (goto-char beg)
1211 (forward-line 1)
1212 (if (/= (following-char) ?0)
1213 (error "Bad format in RMAIL file."))
1214 (let ((buffer-read-only nil)
1215 (delta (- (buffer-size) end)))
1216 (delete-char 1)
1217 (insert ?1)
1218 (forward-line 1)
1219 (let ((case-fold-search t))
1220 (while (looking-at "Summary-line:\\|Mail-From:")
1221 (forward-line 1)))
1222 (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n")
1223 (delete-region (point)
1224 (progn (forward-line 1) (point))))
1225 (let ((str (buffer-substring (point)
1226 (save-excursion (search-forward "\n\n" end 'move)
1227 (point)))))
1228 (insert str "*** EOOH ***\n")
1229 (narrow-to-region (point) (- (buffer-size) delta)))
1230 (goto-char (point-min))
1231 (if rmail-message-filter (funcall rmail-message-filter))
1232 (if (or rmail-displayed-headers rmail-ignored-headers)
1233 (rmail-clear-headers))))
1235 (defun rmail-clear-headers (&optional ignored-headers)
1236 "Delete all header fields that Rmail should not show.
1237 If the optional argument IGNORED-HEADERS is non-nil,
1238 delete all header fields whose names match that regexp.
1239 Otherwise, if `rmail-displayed-headers' is non-nil,
1240 delete all header fields *except* those whose names match that regexp.
1241 Otherwise, delete all header fields whose names match `rmail-ignored-headers'."
1242 (if (search-forward "\n\n" nil t)
1243 (if (and rmail-displayed-headers (null ignored-headers))
1244 (save-restriction
1245 (narrow-to-region (point-min) (point))
1246 (let ((buffer-read-only nil) lim)
1247 (goto-char (point-min))
1248 (while (save-excursion
1249 (re-search-forward "\n[^ \t]")
1250 (and (not (eobp))
1251 (setq lim (1- (point)))))
1252 (if (save-excursion
1253 (re-search-forward rmail-displayed-headers lim t))
1254 (goto-char lim)
1255 (delete-region (point) lim))))
1256 (goto-char (point-min)))
1257 (or ignored-headers (setq ignored-headers rmail-ignored-headers))
1258 (save-restriction
1259 (narrow-to-region (point-min) (point))
1260 (let ((buffer-read-only nil))
1261 (while (let ((case-fold-search t))
1262 (goto-char (point-min))
1263 (re-search-forward ignored-headers nil t))
1264 (beginning-of-line)
1265 (delete-region (point)
1266 (progn (re-search-forward "\n[^ \t]")
1267 (1- (point))))))))))
1269 (defun rmail-toggle-header ()
1270 "Show original message header if pruned header currently shown, or vice versa."
1271 (interactive)
1272 (rmail-maybe-set-message-counters)
1273 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
1274 (let ((buffer-read-only nil))
1275 (goto-char (point-min))
1276 (forward-line 1)
1277 (if (= (following-char) ?1)
1278 (progn (delete-char 1)
1279 (insert ?0)
1280 (forward-line 1)
1281 (let ((case-fold-search t))
1282 (while (looking-at "Summary-Line:\\|Mail-From:")
1283 (forward-line 1)))
1284 (insert "*** EOOH ***\n")
1285 (forward-char -1)
1286 (search-forward "\n*** EOOH ***\n")
1287 (forward-line -1)
1288 (let ((temp (point)))
1289 (and (search-forward "\n\n" nil t)
1290 (delete-region temp (point))))
1291 (goto-char (point-min))
1292 (search-forward "\n*** EOOH ***\n")
1293 (narrow-to-region (point) (point-max)))
1294 (rmail-reformat-message (point-min) (point-max))))
1295 (rmail-highlight-headers))
1297 ;;;; *** Rmail Attributes and Keywords ***
1299 ;; Make a string describing current message's attributes and keywords
1300 ;; and set it up as the name of a minor mode
1301 ;; so it will appear in the mode line.
1302 (defun rmail-display-labels ()
1303 (let ((blurb "") (beg (point-min-marker)) (end (point-max-marker)))
1304 (save-excursion
1305 (unwind-protect
1306 (progn
1307 (widen)
1308 (goto-char (rmail-msgbeg rmail-current-message))
1309 (forward-line 1)
1310 (if (looking-at "[01],")
1311 (progn
1312 (narrow-to-region (point) (progn (end-of-line) (point)))
1313 ;; Truly valid BABYL format requires a space before each
1314 ;; attribute or keyword name. Put them in if missing.
1315 (let (buffer-read-only)
1316 (goto-char (point-min))
1317 (while (search-forward "," nil t)
1318 (or (looking-at "[ ,]") (eobp)
1319 (insert " "))))
1320 (goto-char (point-max))
1321 (if (search-backward ",," nil 'move)
1322 (progn
1323 (if (> (point) (1+ (point-min)))
1324 (setq blurb (buffer-substring (+ 1 (point-min)) (point))))
1325 (if (> (- (point-max) (point)) 2)
1326 (setq blurb
1327 (concat blurb
1329 (buffer-substring (+ (point) 3)
1330 (1- (point-max)))))))))))
1331 ;; Note: we don't use save-restriction because that does not work right
1332 ;; if changes are made outside the saved restriction
1333 ;; before that restriction is restored.
1334 (narrow-to-region beg end)
1335 (set-marker beg nil)
1336 (set-marker end nil)))
1337 (while (string-match " +," blurb)
1338 (setq blurb (concat (substring blurb 0 (match-beginning 0)) ","
1339 (substring blurb (match-end 0)))))
1340 (while (string-match ", +" blurb)
1341 (setq blurb (concat (substring blurb 0 (match-beginning 0)) ","
1342 (substring blurb (match-end 0)))))
1343 (setq mode-line-process
1344 (format " %d/%d%s"
1345 rmail-current-message rmail-total-messages blurb))))
1347 ;; Turn an attribute of a message on or off according to STATE.
1348 ;; ATTR is the name of the attribute, as a string.
1349 ;; MSGNUM is message number to change; nil means current message.
1350 (defun rmail-set-attribute (attr state &optional msgnum)
1351 (let ((omax (point-max-marker))
1352 (omin (point-min-marker))
1353 (buffer-read-only nil))
1354 (or msgnum (setq msgnum rmail-current-message))
1355 (if (> msgnum 0)
1356 (unwind-protect
1357 (save-excursion
1358 (widen)
1359 (goto-char (+ 3 (rmail-msgbeg msgnum)))
1360 (let ((curstate
1361 (not
1362 (null (search-backward (concat ", " attr ",")
1363 (prog1 (point) (end-of-line)) t)))))
1364 (or (eq curstate (not (not state)))
1365 (if curstate
1366 (delete-region (point) (1- (match-end 0)))
1367 (beginning-of-line)
1368 (forward-char 2)
1369 (insert " " attr ","))))
1370 (if (string= attr "deleted")
1371 (rmail-set-message-deleted-p msgnum state)))
1372 ;; Note: we don't use save-restriction because that does not work right
1373 ;; if changes are made outside the saved restriction
1374 ;; before that restriction is restored.
1375 (narrow-to-region omin omax)
1376 (set-marker omin nil)
1377 (set-marker omax nil)
1378 (if (= msgnum rmail-current-message)
1379 (rmail-display-labels))))))
1381 ;; Return t if the attributes/keywords line of msg number MSG
1382 ;; contains a match for the regexp LABELS.
1383 (defun rmail-message-labels-p (msg labels)
1384 (save-excursion
1385 (save-restriction
1386 (widen)
1387 (goto-char (rmail-msgbeg msg))
1388 (forward-char 3)
1389 (re-search-backward labels (prog1 (point) (end-of-line)) t))))
1391 ;;;; *** Rmail Message Selection And Support ***
1393 (defun rmail-msgend (n)
1394 (marker-position (aref rmail-message-vector (1+ n))))
1396 (defun rmail-msgbeg (n)
1397 (marker-position (aref rmail-message-vector n)))
1399 (defun rmail-widen-to-current-msgbeg (function)
1400 "Call FUNCTION with point at start of internal data of current message.
1401 Assumes that bounds were previously narrowed to display the message in Rmail.
1402 The bounds are widened enough to move point where desired, then narrowed
1403 again afterward.
1405 FUNCTION may not change the visible text of the message, but it may
1406 change the invisible header text."
1407 (save-excursion
1408 (let ((obeg (- (point-max) (point-min))))
1409 (unwind-protect
1410 (progn
1411 (narrow-to-region (rmail-msgbeg rmail-current-message)
1412 (point-max))
1413 (goto-char (point-min))
1414 (funcall function))
1415 ;; Note: we don't use save-restriction because that does not work right
1416 ;; if changes are made outside the saved restriction
1417 ;; before that restriction is restored.
1418 ;; Here we assume that changes made by FUNCTION
1419 ;; occur before the visible region of the message.
1420 (narrow-to-region (- (point-max) obeg) (point-max))))))
1422 (defun rmail-forget-messages ()
1423 (unwind-protect
1424 (if (vectorp rmail-message-vector)
1425 (let* ((i 0)
1426 (v rmail-message-vector)
1427 (n (length v)))
1428 (while (< i n)
1429 (move-marker (aref v i) nil)
1430 (setq i (1+ i)))))
1431 (setq rmail-message-vector nil)
1432 (setq rmail-deleted-vector nil)))
1434 (defun rmail-maybe-set-message-counters ()
1435 (if (not (and rmail-deleted-vector
1436 rmail-message-vector
1437 rmail-current-message
1438 rmail-total-messages))
1439 (rmail-set-message-counters)))
1441 (defun rmail-count-new-messages (&optional nomsg)
1442 (let* ((case-fold-search nil)
1443 (total-messages 0)
1444 (messages-head nil)
1445 (deleted-head nil))
1446 (or nomsg (message "Counting new messages..."))
1447 (goto-char (point-max))
1448 ;; Put at the end of messages-head
1449 ;; the entry for message N+1, which marks
1450 ;; the end of message N. (N = number of messages).
1451 (search-backward "\n\^_")
1452 (forward-char 1)
1453 (setq messages-head (list (point-marker)))
1454 (rmail-set-message-counters-counter (point-min))
1455 (setq rmail-current-message (1+ rmail-total-messages))
1456 (setq rmail-total-messages
1457 (+ rmail-total-messages total-messages))
1458 (setq rmail-message-vector
1459 (vconcat rmail-message-vector (cdr messages-head)))
1460 (aset rmail-message-vector
1461 rmail-current-message (car messages-head))
1462 (setq rmail-deleted-vector
1463 (concat rmail-deleted-vector deleted-head))
1464 (setq rmail-summary-vector
1465 (vconcat rmail-summary-vector (make-vector total-messages nil)))
1466 (goto-char (point-min))
1467 (or nomsg (message "Counting new messages...done (%d)" total-messages))))
1469 (defun rmail-set-message-counters ()
1470 (rmail-forget-messages)
1471 (save-excursion
1472 (save-restriction
1473 (widen)
1474 (let* ((point-save (point))
1475 (total-messages 0)
1476 (messages-after-point)
1477 (case-fold-search nil)
1478 (messages-head nil)
1479 (deleted-head nil))
1480 (message "Counting messages...")
1481 (goto-char (point-max))
1482 ;; Put at the end of messages-head
1483 ;; the entry for message N+1, which marks
1484 ;; the end of message N. (N = number of messages).
1485 (search-backward "\n\^_" nil t)
1486 (if (/= (point) (point-max)) (forward-char 1))
1487 (setq messages-head (list (point-marker)))
1488 (rmail-set-message-counters-counter (min (point) point-save))
1489 (setq messages-after-point total-messages)
1490 (rmail-set-message-counters-counter)
1491 (setq rmail-total-messages total-messages)
1492 (setq rmail-current-message
1493 (min total-messages
1494 (max 1 (- total-messages messages-after-point))))
1495 (setq rmail-message-vector
1496 (apply 'vector (cons (point-min-marker) messages-head))
1497 rmail-deleted-vector (concat "D" deleted-head)
1498 rmail-summary-vector (make-vector rmail-total-messages nil))
1499 (message "Counting messages...done")))))
1501 (defun rmail-set-message-counters-counter (&optional stop)
1502 (while (search-backward "\n\^_\^L\n" stop t)
1503 (forward-char 1)
1504 (setq messages-head (cons (point-marker) messages-head))
1505 (save-excursion
1506 (setq deleted-head
1507 (cons (if (search-backward ", deleted,"
1508 (prog1 (point)
1509 (forward-line 2))
1511 ?D ?\ )
1512 deleted-head)))
1513 (if (zerop (% (setq total-messages (1+ total-messages)) 20))
1514 (message "Counting messages...%d" total-messages))))
1516 (defun rmail-beginning-of-message ()
1517 "Show current message starting from the beginning."
1518 (interactive)
1519 (rmail-show-message rmail-current-message))
1521 (defun rmail-show-message (&optional n no-summary)
1522 "Show message number N (prefix argument), counting from start of file.
1523 If summary buffer is currently displayed, update current message there also."
1524 (interactive "p")
1525 (rmail-maybe-set-message-counters)
1526 (widen)
1527 (if (zerop rmail-total-messages)
1528 (progn (narrow-to-region (point-min) (1- (point-max)))
1529 (goto-char (point-min))
1530 (setq mode-line-process nil))
1531 (let (blurb)
1532 (if (not n)
1533 (setq n rmail-current-message)
1534 (cond ((<= n 0)
1535 (setq n 1
1536 rmail-current-message 1
1537 blurb "No previous message"))
1538 ((> n rmail-total-messages)
1539 (setq n rmail-total-messages
1540 rmail-current-message rmail-total-messages
1541 blurb "No following message"))
1543 (setq rmail-current-message n))))
1544 (let ((beg (rmail-msgbeg n))
1545 (end (rmail-msgend n)))
1546 (goto-char beg)
1547 (forward-line 1)
1548 (if (= (following-char) ?0)
1549 (progn
1550 (rmail-reformat-message beg end)
1551 (rmail-set-attribute "unseen" nil))
1552 (search-forward "\n*** EOOH ***\n" end t)
1553 (narrow-to-region (point) end))
1554 (goto-char (point-min))
1555 (rmail-display-labels)
1556 (rmail-highlight-headers)
1557 (if transient-mark-mode (deactivate-mark))
1558 (run-hooks 'rmail-show-message-hook)
1559 ;; If there is a summary buffer, try to move to this message
1560 ;; in that buffer. But don't complain if this message
1561 ;; is not mentioned in the summary.
1562 ;; Don't do this at all if we were called on behalf
1563 ;; of cursor motion in the summary buffer.
1564 (and (rmail-summary-exists) (not no-summary)
1565 (let ((curr-msg rmail-current-message))
1566 (rmail-select-summary
1567 (rmail-summary-goto-msg curr-msg t t))))
1568 (if blurb
1569 (message blurb))))))
1571 ;; Find all occurrences of certain fields, and highlight them.
1572 (defun rmail-highlight-headers ()
1573 ;; Do this only if the system supports faces.
1574 (if (and (fboundp 'internal-find-face)
1575 rmail-highlighted-headers)
1576 (save-excursion
1577 (search-forward "\n\n" nil 'move)
1578 (save-restriction
1579 (narrow-to-region (point-min) (point))
1580 (let ((case-fold-search t)
1581 (inhibit-read-only t)
1582 ;; Highlight with boldface if that is available.
1583 ;; Otherwise use the `highlight' face.
1584 (face (or rmail-highlight-face
1585 (if (face-differs-from-default-p 'bold)
1586 'bold 'highlight)))
1587 ;; List of overlays to reuse.
1588 (overlays rmail-overlay-list))
1589 (goto-char (point-min))
1590 (while (re-search-forward rmail-highlighted-headers nil t)
1591 (skip-chars-forward " \t")
1592 (let ((beg (point))
1593 overlay)
1594 (while (progn (forward-line 1)
1595 (looking-at "[ \t]")))
1596 ;; Back up over newline, then trailing spaces or tabs
1597 (forward-char -1)
1598 (while (member (preceding-char) '(? ?\t))
1599 (forward-char -1))
1600 (if overlays
1601 ;; Reuse an overlay we already have.
1602 (progn
1603 (setq overlay (car overlays)
1604 overlays (cdr overlays))
1605 (overlay-put overlay 'face face)
1606 (move-overlay overlay beg (point)))
1607 ;; Make a new overlay and add it to
1608 ;; rmail-overlay-list.
1609 (setq overlay (make-overlay beg (point)))
1610 (overlay-put overlay 'face face)
1611 (setq rmail-overlay-list
1612 (cons overlay rmail-overlay-list))))))))))
1614 (defun rmail-next-message (n)
1615 "Show following message whether deleted or not.
1616 With prefix arg N, moves forward N messages, or backward if N is negative."
1617 (interactive "p")
1618 (rmail-maybe-set-message-counters)
1619 (rmail-show-message (+ rmail-current-message n)))
1621 (defun rmail-previous-message (n)
1622 "Show previous message whether deleted or not.
1623 With prefix arg N, moves backward N messages, or forward if N is negative."
1624 (interactive "p")
1625 (rmail-next-message (- n)))
1627 (defun rmail-next-undeleted-message (n)
1628 "Show following non-deleted message.
1629 With prefix arg N, moves forward N non-deleted messages,
1630 or backward if N is negative.
1632 Returns t if a new message is being shown, nil otherwise."
1633 (interactive "p")
1634 (rmail-maybe-set-message-counters)
1635 (let ((lastwin rmail-current-message)
1636 (current rmail-current-message))
1637 (while (and (> n 0) (< current rmail-total-messages))
1638 (setq current (1+ current))
1639 (if (not (rmail-message-deleted-p current))
1640 (setq lastwin current n (1- n))))
1641 (while (and (< n 0) (> current 1))
1642 (setq current (1- current))
1643 (if (not (rmail-message-deleted-p current))
1644 (setq lastwin current n (1+ n))))
1645 (if (/= lastwin rmail-current-message)
1646 (progn (rmail-show-message lastwin)
1648 (if (< n 0)
1649 (message "No previous nondeleted message"))
1650 (if (> n 0)
1651 (message "No following nondeleted message"))
1652 nil)))
1654 (defun rmail-previous-undeleted-message (n)
1655 "Show previous non-deleted message.
1656 With prefix argument N, moves backward N non-deleted messages,
1657 or forward if N is negative."
1658 (interactive "p")
1659 (rmail-next-undeleted-message (- n)))
1661 (defun rmail-first-message ()
1662 "Show first message in file."
1663 (interactive)
1664 (rmail-maybe-set-message-counters)
1665 (rmail-show-message 1))
1667 (defun rmail-last-message ()
1668 "Show last message in file."
1669 (interactive)
1670 (rmail-maybe-set-message-counters)
1671 (rmail-show-message rmail-total-messages))
1673 (defun rmail-what-message ()
1674 (let ((where (point))
1675 (low 1)
1676 (high rmail-total-messages)
1677 (mid (/ rmail-total-messages 2)))
1678 (while (> (- high low) 1)
1679 (if (>= where (rmail-msgbeg mid))
1680 (setq low mid)
1681 (setq high mid))
1682 (setq mid (+ low (/ (- high low) 2))))
1683 (if (>= where (rmail-msgbeg high)) high low)))
1685 (defun rmail-message-recipients-p (msg recipients &optional primary-only)
1686 (save-restriction
1687 (goto-char (rmail-msgbeg msg))
1688 (search-forward "\n*** EOOH ***\n")
1689 (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
1690 (or (string-match recipients (or (mail-fetch-field "To") ""))
1691 (string-match recipients (or (mail-fetch-field "From") ""))
1692 (if (not primary-only)
1693 (string-match recipients (or (mail-fetch-field "Cc") ""))))))
1695 (defun rmail-message-regexp-p (msg regexp)
1696 "Return t, if for message number MSG, regexp REGEXP matches in the header."
1697 (goto-char (rmail-msgbeg msg))
1698 (let ((end
1699 (save-excursion
1700 (search-forward "*** EOOH ***" (point-max)) (point))))
1701 (re-search-forward regexp end t)))
1703 (defvar rmail-search-last-regexp nil)
1704 (defun rmail-search (regexp &optional n)
1705 "Show message containing next match for REGEXP.
1706 Prefix argument gives repeat count; negative argument means search
1707 backwards (through earlier messages).
1708 Interactively, empty argument means use same regexp used last time."
1709 (interactive
1710 (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
1711 (prompt
1712 (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
1713 regexp)
1714 (if rmail-search-last-regexp
1715 (setq prompt (concat prompt
1716 "(default "
1717 rmail-search-last-regexp
1718 ") ")))
1719 (setq regexp (read-string prompt))
1720 (cond ((not (equal regexp ""))
1721 (setq rmail-search-last-regexp regexp))
1722 ((not rmail-search-last-regexp)
1723 (error "No previous Rmail search string")))
1724 (list rmail-search-last-regexp
1725 (prefix-numeric-value current-prefix-arg))))
1726 (or n (setq n 1))
1727 (message "%sRmail search for %s..."
1728 (if (< n 0) "Reverse " "")
1729 regexp)
1730 (rmail-maybe-set-message-counters)
1731 (let ((omin (point-min))
1732 (omax (point-max))
1733 (opoint (point))
1735 (reversep (< n 0))
1736 (msg rmail-current-message))
1737 (unwind-protect
1738 (progn
1739 (widen)
1740 (while (/= n 0)
1741 ;; Check messages one by one, advancing message number up or down
1742 ;; but searching forward through each message.
1743 (if reversep
1744 (while (and (null win) (> msg 1))
1745 (goto-char (rmail-msgbeg (setq msg (1- msg))))
1746 (setq win (re-search-forward
1747 regexp (rmail-msgend msg) t)))
1748 (while (and (null win) (< msg rmail-total-messages))
1749 (goto-char (rmail-msgbeg (setq msg (1+ msg))))
1750 (setq win (re-search-forward regexp (rmail-msgend msg) t))))
1751 (setq n (+ n (if reversep 1 -1)))))
1752 (if win
1753 (progn
1754 ;; If this is a reverse search and we found a message,
1755 ;; search backward thru this message to position point.
1756 (if reversep
1757 (progn
1758 (goto-char (rmail-msgend msg))
1759 (re-search-backward
1760 regexp (rmail-msgbeg msg) t)))
1761 (setq win (point))
1762 (rmail-show-message msg)
1763 (message "%sRmail search for %s...done"
1764 (if reversep "Reverse " "")
1765 regexp)
1766 (goto-char win))
1767 (goto-char opoint)
1768 (narrow-to-region omin omax)
1769 (ding)
1770 (message "Search failed: %s" regexp)))))
1772 (defun rmail-search-backwards (regexp &optional n)
1773 "Show message containing previous match for REGEXP.
1774 Prefix argument gives repeat count; negative argument means search
1775 forward (through later messages).
1776 Interactively, empty argument means use same regexp used last time."
1777 (interactive
1778 (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
1779 (prompt
1780 (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
1781 regexp)
1782 (if rmail-search-last-regexp
1783 (setq prompt (concat prompt
1784 "(default "
1785 rmail-search-last-regexp
1786 ") ")))
1787 (setq regexp (read-string prompt))
1788 (cond ((not (equal regexp ""))
1789 (setq rmail-search-last-regexp regexp))
1790 ((not rmail-search-last-regexp)
1791 (error "No previous Rmail search string")))
1792 (list rmail-search-last-regexp
1793 (prefix-numeric-value current-prefix-arg))))
1794 (rmail-search regexp (- (or n 1))))
1796 ;; Show the first message which has the `unseen' attribute.
1797 (defun rmail-first-unseen-message ()
1798 (rmail-maybe-set-message-counters)
1799 (let ((current 1)
1800 found)
1801 (save-restriction
1802 (widen)
1803 (while (and (not found) (<= current rmail-total-messages))
1804 (if (rmail-message-labels-p current ", ?\\(unseen\\),")
1805 (setq found current))
1806 (setq current (1+ current))))
1807 ;; Let the caller show the message.
1808 ;; (if found
1809 ;; (rmail-show-message found))
1810 found))
1812 (defun rmail-next-same-subject (n)
1813 "Go to the next mail message having the same subject header.
1814 With prefix argument N, do this N times.
1815 If N is negative, go backwards instead."
1816 (interactive "p")
1817 (let* ((subject (mail-fetch-field "Subject"))
1818 (search-regexp (concat "^Subject: *\\(Re: *\\)?"
1819 (regexp-quote subject)
1820 "\n"))
1821 (forward (> n 0))
1822 (i rmail-current-message)
1823 found)
1824 (if (string-match "Re:[ \t]*" subject)
1825 (setq subject (substring subject (match-end 0))))
1826 (save-excursion
1827 (save-restriction
1828 (widen)
1829 (while (and (/= n 0)
1830 (if forward
1831 (< i rmail-total-messages)
1832 (> i 1)))
1833 (let (done)
1834 (while (and (not done)
1835 (if forward
1836 (< i rmail-total-messages)
1837 (> i 1)))
1838 (setq i (if forward (1+ i) (1- i)))
1839 (goto-char (rmail-msgbeg i))
1840 (search-forward "\n*** EOOH ***\n")
1841 (let ((beg (point)) end)
1842 (search-forward "\n\n")
1843 (setq end (point))
1844 (goto-char beg)
1845 (setq done (re-search-forward search-regexp end t))))
1846 (if done (setq found i)))
1847 (setq n (if forward (1- n) (1+ n))))))
1848 (if found
1849 (rmail-show-message found)
1850 (error "No %s message with same subject"
1851 (if forward "following" "previous")))))
1853 (defun rmail-previous-same-subject (n)
1854 "Go to the previous mail message having the same subject header.
1855 With prefix argument N, do this N times.
1856 If N is negative, go forwards instead."
1857 (interactive "p")
1858 (rmail-next-same-subject (- n)))
1860 ;;;; *** Rmail Message Deletion Commands ***
1862 (defun rmail-message-deleted-p (n)
1863 (= (aref rmail-deleted-vector n) ?D))
1865 (defun rmail-set-message-deleted-p (n state)
1866 (aset rmail-deleted-vector n (if state ?D ?\ )))
1868 (defun rmail-delete-message ()
1869 "Delete this message and stay on it."
1870 (interactive)
1871 (rmail-set-attribute "deleted" t))
1873 (defun rmail-undelete-previous-message ()
1874 "Back up to deleted message, select it, and undelete it."
1875 (interactive)
1876 (let ((msg rmail-current-message))
1877 (while (and (> msg 0)
1878 (not (rmail-message-deleted-p msg)))
1879 (setq msg (1- msg)))
1880 (if (= msg 0)
1881 (error "No previous deleted message")
1882 (if (/= msg rmail-current-message)
1883 (rmail-show-message msg))
1884 (rmail-set-attribute "deleted" nil)
1885 (if (rmail-summary-exists)
1886 (save-excursion
1887 (set-buffer rmail-summary-buffer)
1888 (rmail-summary-mark-undeleted msg)))
1889 (rmail-maybe-display-summary))))
1891 (defun rmail-delete-forward (&optional backward)
1892 "Delete this message and move to next nondeleted one.
1893 Deleted messages stay in the file until the \\[rmail-expunge] command is given.
1894 With prefix argument, delete and move backward.
1896 Returns t if a new message is displayed after the delete, or nil otherwise."
1897 (interactive "P")
1898 (rmail-set-attribute "deleted" t)
1899 (let ((del-msg rmail-current-message))
1900 (if (rmail-summary-exists)
1901 (rmail-select-summary
1902 (rmail-summary-mark-deleted del-msg)))
1903 (prog1 (rmail-next-undeleted-message (if backward -1 1))
1904 (rmail-maybe-display-summary))))
1906 (defun rmail-delete-backward ()
1907 "Delete this message and move to previous nondeleted one.
1908 Deleted messages stay in the file until the \\[rmail-expunge] command is given."
1909 (interactive)
1910 (rmail-delete-forward t))
1912 ;; Compute the message number a given message would have after expunging.
1913 ;; The present number of the message is OLDNUM.
1914 ;; DELETEDVEC should be rmail-deleted-vector.
1915 ;; The value is nil for a message that would be deleted.
1916 (defun rmail-msg-number-after-expunge (deletedvec oldnum)
1917 (if (or (null oldnum) (= (aref deletedvec oldnum) ?D))
1919 (let ((i 0)
1920 (newnum 0))
1921 (while (< i oldnum)
1922 (if (/= (aref deletedvec i) ?D)
1923 (setq newnum (1+ newnum)))
1924 (setq i (1+ i)))
1925 newnum)))
1927 (defun rmail-only-expunge ()
1928 "Actually erase all deleted messages in the file."
1929 (interactive)
1930 (message "Expunging deleted messages...")
1931 ;; Discard all undo records for this buffer.
1932 (or (eq buffer-undo-list t)
1933 (setq buffer-undo-list nil))
1934 (rmail-maybe-set-message-counters)
1935 (let* ((omax (- (buffer-size) (point-max)))
1936 (omin (- (buffer-size) (point-min)))
1937 (opoint (if (and (> rmail-current-message 0)
1938 (rmail-message-deleted-p rmail-current-message))
1940 (- (point) (point-min))))
1941 (messages-head (cons (aref rmail-message-vector 0) nil))
1942 (messages-tail messages-head)
1943 ;; Don't make any undo records for the expunging.
1944 (buffer-undo-list t)
1945 (win))
1946 (unwind-protect
1947 (save-excursion
1948 (widen)
1949 (goto-char (point-min))
1950 (let ((counter 0)
1951 (number 1)
1952 (total rmail-total-messages)
1953 (new-message-number rmail-current-message)
1954 (new-summary nil)
1955 (rmailbuf (current-buffer))
1956 (buffer-read-only nil)
1957 (messages rmail-message-vector)
1958 (deleted rmail-deleted-vector)
1959 (summary rmail-summary-vector))
1960 (setq rmail-total-messages nil
1961 rmail-current-message nil
1962 rmail-message-vector nil
1963 rmail-deleted-vector nil
1964 rmail-summary-vector nil)
1966 ;; Find each sendmail buffer that is set to reply
1967 ;; to a message in this buffer, and update its
1968 ;; message number.
1969 (let ((bufs (buffer-list)))
1970 (while bufs
1971 (save-excursion
1972 (set-buffer (car bufs))
1973 (and (boundp 'rmail-send-actions-rmail-buffer)
1974 (eq rmail-send-actions-rmail-buffer rmailbuf)
1975 (setq rmail-send-actions-rmail-msg-number
1976 (rmail-msg-number-after-expunge
1977 deleted
1978 rmail-send-actions-rmail-msg-number))))
1979 (setq bufs (cdr bufs))))
1981 (while (<= number total)
1982 (if (= (aref deleted number) ?D)
1983 (progn
1984 (delete-region
1985 (marker-position (aref messages number))
1986 (marker-position (aref messages (1+ number))))
1987 (move-marker (aref messages number) nil)
1988 (if (> new-message-number counter)
1989 (setq new-message-number (1- new-message-number))))
1990 (setq counter (1+ counter))
1991 (setq messages-tail
1992 (setcdr messages-tail
1993 (cons (aref messages number) nil)))
1994 (setq new-summary
1995 (cons (if (= counter number) (aref summary (1- number)))
1996 new-summary)))
1997 (if (zerop (% (setq number (1+ number)) 20))
1998 (message "Expunging deleted messages...%d" number)))
1999 (setq messages-tail
2000 (setcdr messages-tail
2001 (cons (aref messages number) nil)))
2002 (setq rmail-current-message new-message-number
2003 rmail-total-messages counter
2004 rmail-message-vector (apply 'vector messages-head)
2005 rmail-deleted-vector (make-string (1+ counter) ?\ )
2006 rmail-summary-vector (vconcat (nreverse new-summary))
2007 win t)))
2008 (message "Expunging deleted messages...done")
2009 (if (not win)
2010 (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)))
2011 (rmail-show-message
2012 (if (zerop rmail-current-message) 1 nil))
2013 (forward-char opoint))))
2015 (defun rmail-expunge ()
2016 "Erase deleted messages from Rmail file and summary buffer."
2017 (interactive)
2018 (rmail-only-expunge)
2019 (if (rmail-summary-exists)
2020 (rmail-select-summary
2021 (rmail-update-summary))))
2023 ;;;; *** Rmail Mailing Commands ***
2025 (defun rmail-start-mail (&rest args)
2026 (if (and window-system rmail-mail-new-frame)
2027 (prog1
2028 (apply 'mail-other-frame args)
2029 (modify-frame-parameters (selected-frame)
2030 '((dedicated . t))))
2031 (apply 'mail-other-window args)))
2033 (defun rmail-mail ()
2034 "Send mail in another window.
2035 While composing the message, use \\[mail-yank-original] to yank the
2036 original message into it."
2037 (interactive)
2038 (rmail-start-mail nil nil nil nil nil (current-buffer)))
2040 (defun rmail-continue ()
2041 "Continue composing outgoing message previously being composed."
2042 (interactive)
2043 (rmail-start-mail t))
2045 (defun rmail-reply (just-sender)
2046 "Reply to the current message.
2047 Normally include CC: to all other recipients of original message;
2048 prefix argument means ignore them. While composing the reply,
2049 use \\[mail-yank-original] to yank the original message into it."
2050 (interactive "P")
2051 (let (from reply-to cc subject date to message-id resent-reply-to
2052 (msgnum rmail-current-message)
2053 (rmail-buffer (current-buffer)))
2054 (save-excursion
2055 (save-restriction
2056 (widen)
2057 (goto-char (rmail-msgbeg rmail-current-message))
2058 (forward-line 1)
2059 (if (= (following-char) ?0)
2060 (narrow-to-region
2061 (progn (forward-line 2)
2062 (point))
2063 (progn (search-forward "\n\n" (rmail-msgend rmail-current-message)
2064 'move)
2065 (point)))
2066 (narrow-to-region (point)
2067 (progn (search-forward "\n*** EOOH ***\n")
2068 (beginning-of-line) (point))))
2069 (setq resent-reply-to (mail-fetch-field "resent-reply-to" t)
2070 from (mail-fetch-field "from")
2071 reply-to (or resent-reply-to
2072 (mail-fetch-field "reply-to" nil t)
2073 from)
2074 cc (cond (just-sender nil)
2075 (resent-reply-to (mail-fetch-field "resent-cc" t))
2076 (t (mail-fetch-field "cc" nil t)))
2077 subject (or (and resent-reply-to
2078 (mail-fetch-field "resent-subject" t))
2079 (mail-fetch-field "subject"))
2080 date (or (and resent-reply-to
2081 (mail-fetch-field "resent-date" t))
2082 (mail-fetch-field "date"))
2083 to (cond (resent-reply-to
2084 (or (mail-fetch-field "resent-to" t)) "")
2085 ((mail-fetch-field "to" nil t))
2086 ;((mail-fetch-field "apparently-to")) ack gag barf
2087 (t ""))
2088 message-id (cond (resent-reply-to
2089 (mail-fetch-field "resent-message-id" t))
2090 ((mail-fetch-field "message-id"))))))
2091 (and (stringp subject)
2092 (setq subject
2093 (concat rmail-reply-prefix
2094 (if (string-match rmail-reply-regexp subject)
2095 (substring subject (match-end 0))
2096 subject))))
2097 (rmail-start-mail nil
2098 (mail-strip-quoted-names reply-to)
2099 subject
2100 (rmail-make-in-reply-to-field from date message-id)
2101 (if just-sender
2103 (let* ((cc-list (rmail-dont-reply-to
2104 (mail-strip-quoted-names
2105 (if (null cc) to (concat to ", " cc))))))
2106 (if (string= cc-list "") nil cc-list)))
2107 (current-buffer)
2108 (list (list '(lambda ()
2109 (let ((msgnum rmail-send-actions-rmail-msg-number))
2110 (save-excursion
2111 (set-buffer rmail-send-actions-rmail-buffer)
2112 (if msgnum
2113 (rmail-set-attribute "answered" t msgnum))))))))
2114 ;; We keep the rmail buffer and message number in these
2115 ;; buffer-local vars in the sendmail buffer,
2116 ;; so that rmail-only-expunge can relocate the message number.
2117 (make-local-variable 'rmail-send-actions-rmail-buffer)
2118 (make-local-variable 'rmail-send-actions-rmail-msg-number)
2119 (setq rmail-send-actions-rmail-buffer rmail-buffer)
2120 (setq rmail-send-actions-rmail-msg-number msgnum)))
2122 (defun rmail-make-in-reply-to-field (from date message-id)
2123 (cond ((not from)
2124 (if message-id
2125 message-id
2126 nil))
2127 (mail-use-rfc822
2128 (require 'rfc822)
2129 (let ((tem (car (rfc822-addresses from))))
2130 (if message-id
2131 (if (string-match
2132 (regexp-quote (if (string-match "@[^@]*\\'" tem)
2133 (substring tem 0 (match-beginning 0))
2134 tem))
2135 message-id)
2136 ;; Message-ID is sufficiently informative
2137 message-id
2138 (concat message-id " (" tem ")"))
2139 ;; Copy TEM, discarding text properties.
2140 (setq tem (copy-sequence tem))
2141 (set-text-properties 0 (length tem) nil tem)
2142 (setq tem (copy-sequence tem))
2143 ;; Use prin1 to fake RFC822 quoting
2144 (let ((field (prin1-to-string tem)))
2145 (if date
2146 (concat field "'s message of " date)
2147 field)))))
2148 ((let* ((foo "[^][\000-\037\177-\377()<>@,;:\\\" ]+")
2149 (bar "[^][\000-\037\177-\377()<>@,;:\\\"]+"))
2150 ;; Can't use format because format loses on \000 (unix *^&%*^&%$!!)
2151 (or (string-match (concat "\\`[ \t]*\\(" bar
2152 "\\)\\(<" foo "@" foo ">\\)?[ \t]*\\'")
2153 ;; "Unix Loser <Foo@bar.edu>" => "Unix Loser"
2154 from)
2155 (string-match (concat "\\`[ \t]*<" foo "@" foo ">[ \t]*(\\("
2156 bar "\\))[ \t]*\\'")
2157 ;; "<Bugs@bar.edu>" (Losing Unix) => "Losing Unix"
2158 from)))
2159 (let ((start (match-beginning 1))
2160 (end (match-end 1)))
2161 ;; Trim whitespace which above regexp match allows
2162 (while (and (< start end)
2163 (memq (aref from start) '(?\t ?\ )))
2164 (setq start (1+ start)))
2165 (while (and (< start end)
2166 (memq (aref from (1- end)) '(?\t ?\ )))
2167 (setq end (1- end)))
2168 (let ((field (substring from start end)))
2169 (if date (setq field (concat "message from " field " on " date)))
2170 (if message-id
2171 ;; "<AA259@bar.edu> (message from Unix Loser on 1-Apr-89)"
2172 (concat message-id " (" field ")")
2173 field))))
2175 ;; If we can't kludge it simply, do it correctly
2176 (let ((mail-use-rfc822 t))
2177 (rmail-make-in-reply-to-field from date message-id)))))
2179 (defun rmail-forward (resend)
2180 "Forward the current message to another user.
2181 With prefix argument, \"resend\" the message instead of forwarding it;
2182 see the documentation of `rmail-resend'."
2183 (interactive "P")
2184 (if resend
2185 (call-interactively 'rmail-resend)
2186 (let ((forward-buffer (current-buffer))
2187 (msgnum rmail-current-message)
2188 (subject (concat "["
2189 (let ((from (or (mail-fetch-field "From")
2190 (mail-fetch-field ">From"))))
2191 (if from
2192 (concat (mail-strip-quoted-names from) ": ")
2193 ""))
2194 (or (mail-fetch-field "Subject") "")
2195 "]")))
2196 ;; If only one window, use it for the mail buffer.
2197 ;; Otherwise, use another window for the mail buffer
2198 ;; so that the Rmail buffer remains visible
2199 ;; and sending the mail will get back to it.
2200 (if (funcall (if (and (not rmail-mail-new-frame) (one-window-p t))
2201 (function mail)
2202 (function rmail-start-mail))
2203 nil nil subject nil nil nil
2204 (list (list (function
2205 (lambda ()
2206 (let ((msgnum
2207 rmail-send-actions-rmail-msg-number))
2208 (save-excursion
2209 (set-buffer rmail-send-actions-rmail-buffer)
2210 (if msgnum
2211 (rmail-set-attribute
2212 "forwarded" t msgnum)))))))))
2213 ;; The mail buffer is now current.
2214 (save-excursion
2215 ;; We keep the rmail buffer and message number in these
2216 ;; buffer-local vars in the sendmail buffer,
2217 ;; so that rmail-only-expunge can relocate the message number.
2218 (make-local-variable 'rmail-send-actions-rmail-buffer)
2219 (make-local-variable 'rmail-send-actions-rmail-msg-number)
2220 (setq rmail-send-actions-rmail-buffer forward-buffer)
2221 (setq rmail-send-actions-rmail-msg-number msgnum)
2222 ;; Insert after header separator--before signature if any.
2223 (goto-char (point-min))
2224 (search-forward-regexp
2225 (concat "^" (regexp-quote mail-header-separator) "$"))
2226 (forward-line 1)
2227 (insert "------- Start of forwarded message -------\n")
2228 (insert-buffer-substring forward-buffer)
2229 (insert "------- End of forwarded message -------\n")
2230 (push-mark))))))
2232 (defun rmail-resend (address &optional from comment mail-alias-file)
2233 "Resend current message to ADDRESSES.
2234 ADDRESSES should be a single address, a string consisting of several
2235 addresses separated by commas, or a list of addresses.
2237 Optional FROM is the address to resend the message from, and
2238 defaults to the username of the person redistributing the message.
2239 Optional COMMENT is a string that will be inserted as a comment in the
2240 resent message.
2241 Optional ALIAS-FILE is alternate aliases file to be used by sendmail,
2242 typically for purposes of moderating a list."
2243 (interactive "sResend to: ")
2244 (require 'sendmail)
2245 (require 'mailalias)
2246 (if (not from) (setq from (user-login-name)))
2247 (let ((tembuf (generate-new-buffer " sendmail temp"))
2248 (mail-header-separator "")
2249 (case-fold-search nil)
2250 (mailbuf (current-buffer)))
2251 (unwind-protect
2252 (save-excursion
2253 ;;>> Copy message into temp buffer
2254 (set-buffer tembuf)
2255 (insert-buffer-substring mailbuf)
2256 (goto-char (point-min))
2257 ;; Delete any Sender field, since that's not specifyable.
2258 ; Only delete Sender fields in the actual header.
2259 (re-search-forward "^$" nil 'move)
2260 ; Using "while" here rather than "if" because some buggy mail
2261 ; software may have inserted multiple Sender fields.
2262 (while (re-search-backward "^Sender:" nil t)
2263 (let (beg)
2264 (setq beg (point))
2265 (forward-line 1)
2266 (while (looking-at "[ \t]")
2267 (forward-line 1))
2268 (delete-region beg (point))))
2269 ; Go back to the beginning of the buffer so the Resent- fields
2270 ; are inserted there.
2271 (goto-char (point-min))
2272 ;;>> Insert resent-from:
2273 (insert "Resent-From: " from "\n")
2274 (insert "Resent-Date: " (mail-rfc822-date) "\n")
2275 ;;>> Insert resent-to: and bcc if need be.
2276 (let ((before (point)))
2277 (if mail-self-blind
2278 (insert "Resent-Bcc: " (user-login-name) "\n"))
2279 (insert "Resent-To: " (if (stringp address)
2280 address
2281 (mapconcat 'identity address ",\n\t"))
2282 "\n")
2283 ;; Expand abbrevs in the recipients.
2284 (save-excursion
2285 (if (featurep 'mailabbrev)
2286 (let ((end (point-marker))
2287 (local-abbrev-table mail-abbrevs)
2288 (old-syntax-table (syntax-table)))
2289 (if (and (not (vectorp mail-abbrevs))
2290 (file-exists-p mail-personal-alias-file))
2291 (build-mail-abbrevs))
2292 (set-syntax-table mail-abbrev-syntax-table)
2293 (goto-char before)
2294 (while (and (< (point) end)
2295 (progn (forward-word 1)
2296 (<= (point) end)))
2297 (expand-abbrev))
2298 (set-syntax-table old-syntax-table))
2299 (expand-mail-aliases before (point)))))
2300 ;;>> Set up comment, if any.
2301 (if (and (sequencep comment) (not (zerop (length comment))))
2302 (let ((before (point))
2303 after)
2304 (insert comment)
2305 (or (eolp) (insert "\n"))
2306 (setq after (point))
2307 (goto-char before)
2308 (while (< (point) after)
2309 (insert "Resent-Comment: ")
2310 (forward-line 1))))
2311 ;; Don't expand aliases in the destination fields
2312 ;; of the original message.
2313 (let (mail-aliases)
2314 (funcall send-mail-function)))
2315 (kill-buffer tembuf))
2316 (rmail-set-attribute "resent" t rmail-current-message)))
2318 (defvar mail-unsent-separator
2319 (concat "^ *---+ +Unsent message follows +---+ *$\\|"
2320 "^ *---+ +Returned message +---+ *$\\|"
2321 "^Start of returned message$\\|"
2322 "^ *---+ +Original message +---+ *$\\|"
2323 "^ *--+ +begin message +--+ *$\\|"
2324 "^ *---+ +Original message follows +---+ *$\\|"
2325 "^|? *---+ +Message text follows: +---+ *|?$")
2326 "A regexp that matches the separator before the text of a failed message.")
2328 (defun rmail-retry-failure ()
2329 "Edit a mail message which is based on the contents of the current message.
2330 For a message rejected by the mail system, extract the interesting headers and
2331 the body of the original message.
2332 The variable `mail-unsent-separator' should match the string that
2333 delimits the returned original message.
2334 The variable `rmail-retry-ignored-headers' is a regular expression
2335 specifying headers which should not be copied into the new message."
2336 (interactive)
2337 (require 'mail-utils)
2338 (let (mail-buffer bounce-start bounce-end resending)
2339 (save-excursion
2340 ;; Narrow down to just the quoted original message
2341 (rmail-beginning-of-message)
2342 (let ((case-fold-search t))
2343 (if (search-forward "This is a MIME-encapsulated message\n\n--" nil t)
2344 (let ((codestring
2345 (buffer-substring (progn (beginning-of-line) (point))
2346 (progn (end-of-line) (point)))))
2347 (re-search-forward mail-unsent-separator)
2348 (setq mail-buffer (current-buffer))
2349 (search-forward codestring)
2350 (or (search-forward "\n\n" nil t)
2351 (error "Cannot find end of Mime data in failed message"))
2352 (setq bounce-start (point))
2353 (save-excursion
2354 (goto-char (point-max))
2355 (search-backward codestring)
2356 (setq bounce-end (point)))
2357 (or (search-forward "\n\n" nil t)
2358 (error "Cannot find end of header in failed message")))
2359 (or (re-search-forward mail-unsent-separator nil t)
2360 (error "Cannot parse this as a failure message"))
2361 (skip-chars-forward "\n")
2362 ;; Support a style of failure message in which the original
2363 ;; message is indented, and included within lines saying
2364 ;; `Start of returned message' and `End of returned message'.
2365 (if (looking-at " *Received:")
2366 (let (column)
2367 (skip-chars-forward " ")
2368 (setq column (current-column))
2369 (let ((old-buffer (current-buffer)))
2370 (set-buffer (get-buffer-create " rmail retry temp"))
2371 (insert-buffer old-buffer)
2372 (goto-char (point-max))
2373 (if (re-search-backward "^End of returned message$" nil t)
2374 (delete-region (point) (point-max)))
2375 (indent-rigidly (point-min) (point-max) (- column))
2376 (goto-char (point-min))
2377 (re-search-forward mail-unsent-separator nil t))))
2378 (save-restriction
2379 (let ((old-end (point-max)))
2380 ;; One message contained a few random lines before the old
2381 ;; message header. The first line of the message started with
2382 ;; two hyphens. A blank line follows these random lines.
2383 (skip-chars-forward "\n")
2384 (if (looking-at "^--")
2385 (progn
2386 (search-forward "\n\n")
2387 (skip-chars-forward "\n")))
2388 (beginning-of-line)
2389 (narrow-to-region (point) (point-max))
2390 (setq mail-buffer (current-buffer)
2391 bounce-start (point)
2392 bounce-end (point-max))
2393 (or (search-forward "\n\n" nil t)
2394 (error "Cannot find end of header in failed message")))))))
2395 ;; Start sending a new message; default header fields from the original.
2396 ;; Turn off the usual actions for initializing the message body
2397 ;; because we want to get only the text from the failure message.
2398 (let (mail-signature mail-setup-hook)
2399 (if (rmail-start-mail nil nil nil nil nil mail-buffer)
2400 ;; Insert original text as initial text of new draft message.
2401 (progn
2402 (erase-buffer)
2403 (insert-buffer-substring mail-buffer bounce-start bounce-end)
2404 (goto-char (point-min))
2405 (rmail-clear-headers rmail-retry-ignored-headers)
2406 (rmail-clear-headers "^sender:\\|^from\\|^return-path")
2407 (goto-char (point-min))
2408 (save-restriction
2409 (search-forward "\n\n")
2410 (forward-line -1)
2411 (narrow-to-region (point-min) (point))
2412 (setq resending (mail-fetch-field "resent-to"))
2413 (if mail-self-blind
2414 (if resending
2415 (insert "Resent-Bcc: " (user-login-name) "\n")
2416 (insert "BCC: " (user-login-name) "\n"))))
2417 (insert mail-header-separator)
2418 (mail-position-on-field (if resending "Resent-To" "To") t)
2419 (set-buffer mail-buffer)
2420 (rmail-beginning-of-message))))))
2422 (defun rmail-summary-exists ()
2423 "Non-nil iff in an RMAIL buffer and an associated summary buffer exists.
2424 In fact, the non-nil value returned is the summary buffer itself."
2425 (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
2426 rmail-summary-buffer))
2428 (defun rmail-summary-displayed ()
2429 "t iff in RMAIL buffer and an associated summary buffer is displayed."
2430 (and rmail-summary-buffer (get-buffer-window rmail-summary-buffer)))
2432 (defvar rmail-redisplay-summary nil
2433 "*Non-nil means Rmail should show the summary when it changes.
2434 This has an effect only if a summary buffer exists.")
2436 (defvar rmail-summary-window-size nil
2437 "*Non-nil means specify the height for an Rmail summary window.")
2439 ;; Put the summary buffer back on the screen, if user wants that.
2440 (defun rmail-maybe-display-summary ()
2441 (let ((selected (selected-window))
2442 window)
2443 ;; If requested, make sure the summary is displayed.
2444 (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
2445 rmail-redisplay-summary
2446 (if (get-buffer-window rmail-summary-buffer 0)
2447 ;; It's already in some frame; show that one.
2448 (let ((frame (window-frame
2449 (get-buffer-window rmail-summary-buffer 0))))
2450 (make-frame-visible frame)
2451 (raise-frame frame))
2452 (display-buffer rmail-summary-buffer)))
2453 ;; If requested, set the height of the summary window.
2454 (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
2455 rmail-summary-window-size
2456 (setq window (get-buffer-window rmail-summary-buffer))
2457 ;; Don't try to change the size if just one window in frame.
2458 (not (eq window (frame-root-window (window-frame window))))
2459 (unwind-protect
2460 (progn
2461 (select-window window)
2462 (enlarge-window (- rmail-summary-window-size
2463 (window-height))))
2464 (select-window selected)))))
2466 ;;;; *** Rmail Specify Inbox Files ***
2468 (autoload 'set-rmail-inbox-list "rmailmsc"
2469 "Set the inbox list of the current RMAIL file to FILE-NAME.
2470 This may be a list of file names separated by commas.
2471 If FILE-NAME is empty, remove any inbox list."
2474 ;;;; *** Rmail Commands for Labels ***
2476 (autoload 'rmail-add-label "rmailkwd"
2477 "Add LABEL to labels associated with current RMAIL message.
2478 Completion is performed over known labels when reading."
2481 (autoload 'rmail-kill-label "rmailkwd"
2482 "Remove LABEL from labels associated with current RMAIL message.
2483 Completion is performed over known labels when reading."
2486 (autoload 'rmail-next-labeled-message "rmailkwd"
2487 "Show next message with LABEL. Defaults to last label used.
2488 With prefix argument N moves forward N messages with this label."
2491 (autoload 'rmail-previous-labeled-message "rmailkwd"
2492 "Show previous message with LABEL. Defaults to last label used.
2493 With prefix argument N moves backward N messages with this label."
2496 (autoload 'rmail-read-label "rmailkwd"
2497 "PROMPT and read with completion an Rmail message label."
2500 ;;;; *** Rmail Edit Mode ***
2502 (autoload 'rmail-edit-current-message "rmailedit"
2503 "Edit the contents of the current message"
2506 ;;;; *** Rmail Sorting ***
2508 (autoload 'rmail-sort-by-date "rmailsort"
2509 "Sort messages of current Rmail file by date.
2510 If prefix argument REVERSE is non-nil, sort them in reverse order." t)
2512 (autoload 'rmail-sort-by-subject "rmailsort"
2513 "Sort messages of current Rmail file by subject.
2514 If prefix argument REVERSE is non-nil, sort them in reverse order." t)
2516 (autoload 'rmail-sort-by-author "rmailsort"
2517 "Sort messages of current Rmail file by author.
2518 If prefix argument REVERSE is non-nil, sort them in reverse order." t)
2520 (autoload 'rmail-sort-by-recipient "rmailsort"
2521 "Sort messages of current Rmail file by recipient.
2522 If prefix argument REVERSE is non-nil, sort them in reverse order." t)
2524 (autoload 'rmail-sort-by-correspondent "rmailsort"
2525 "Sort messages of current Rmail file by other correspondent.
2526 If prefix argument REVERSE is non-nil, sort them in reverse order." t)
2528 (autoload 'rmail-sort-by-lines "rmailsort"
2529 "Sort messages of current Rmail file by number of lines.
2530 If prefix argument REVERSE is non-nil, sort them in reverse order." t)
2532 (autoload 'rmail-sort-by-keywords "rmailsort"
2533 "Sort messages of current Rmail file by labels.
2534 If prefix argument REVERSE is non-nil, sort them in reverse order.
2535 KEYWORDS is a comma-separated list of labels." t)
2537 ;;;; *** Rmail Summary Mode ***
2539 (autoload 'rmail-summary "rmailsum"
2540 "Display a summary of all messages, one line per message."
2543 (autoload 'rmail-summary-by-labels "rmailsum"
2544 "Display a summary of all messages with one or more LABELS.
2545 LABELS should be a string containing the desired labels, separated by commas."
2548 (autoload 'rmail-summary-by-recipients "rmailsum"
2549 "Display a summary of all messages with the given RECIPIENTS.
2550 Normally checks the To, From and Cc fields of headers; but if PRIMARY-ONLY
2551 is non-nil (prefix arg given), only look in the To and From fields.
2552 RECIPIENTS is a string of regexps separated by commas."
2555 (autoload 'rmail-summary-by-regexp "rmailsum"
2556 "Display a summary of all messages according to regexp REGEXP.
2557 If the regular expression is found in the header of the message
2558 \(including in the date and other lines, as well as the subject line),
2559 Emacs will list the header line in the RMAIL-summary."
2562 (autoload 'rmail-summary-by-topic "rmailsum"
2563 "Display a summary of all messages with the given SUBJECT.
2564 Normally checks the Subject field of headers;
2565 but if WHOLE-MESSAGE is non-nil (prefix arg given),
2566 look in the whole message.
2567 SUBJECT is a string of regexps separated by commas."
2570 (autoload 'rmail-summary-by-sender "rmailsum"
2571 "Display a summary of all messages with the given SENDERS.
2572 SENDERS is a string of names separated by commas."
2575 ;;;; *** Rmail output messages to files ***
2577 (autoload 'rmail-output-to-rmail-file "rmailout"
2578 "Append the current message to an Rmail file named FILE-NAME.
2579 If the file does not exist, ask if it should be created.
2580 If file is being visited, the message is appended to the Emacs
2581 buffer visiting that file."
2584 (autoload 'rmail-output "rmailout"
2585 "Append this message to Unix mail file named FILE-NAME."
2588 ;;;; *** Rmail undigestification ***
2590 (autoload 'undigestify-rmail-message "undigest"
2591 "Break up a digest message into its constituent messages.
2592 Leaves original message, deleted, before the undigestified messages."
2595 (provide 'rmail)
2597 ;;; rmail.el ends here