(rmail-last-rmail-file): Initialize to a file name.
[bpt/emacs.git] / lisp / mail / rmail.el
CommitLineData
c88ab9ce
ER
1;;; rmail.el --- main code of "RMAIL" mail reader for Emacs.
2
bd1f0f84 3;; Copyright (C) 1985, 1986, 1987, 1988, 1993 Free Software Foundation, Inc.
3a801d0c 4
e5167999 5;; Maintainer: FSF
d7b4d18f 6;; Keywords: mail
e5167999 7
581d7e0b
RM
8;; This file is part of GNU Emacs.
9
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
e5167999 12;; the Free Software Foundation; either version 2, or (at your option)
581d7e0b
RM
13;; any later version.
14
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.
19
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.
23
e5167999 24;;; Code:
581d7e0b
RM
25
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.
30
bd1f0f84
RS
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.
36;;
37
581d7e0b 38(require 'mail-utils)
bd1f0f84
RS
39
40;; For Emacs V18 compatibility
41(and (not (fboundp 'user-original-login-name))
42 (fboundp 'user-real-login-name)
31e1d920 43 (defalias 'user-original-login-name 'user-real-login-name))
bd1f0f84
RS
44(and (not (fboundp 'buffer-disable-undo))
45 (fboundp 'buffer-flush-undo)
31e1d920 46 (defalias 'buffer-disable-undo 'buffer-flush-undo))
bd1f0f84
RS
47
48; These variables now declared in paths.el.
581d7e0b
RM
49;(defvar rmail-spool-directory "/usr/spool/mail/"
50; "This is the name of the directory used by the system mailer for\n\
51;delivering new mail. It's name should end with a slash.")
52;(defvar rmail-file-name
53; (expand-file-name "~/RMAIL")
54; "")
55
56;;;###autoload
57(defvar rmail-dont-reply-to-names nil "\
58*A regexp specifying names to prune of reply to messages.
388348ae 59A value of nil means exclude your own name only.")
581d7e0b
RM
60
61;;;###autoload
62(defvar rmail-default-dont-reply-to-names "info-" "\
63A regular expression specifying part of the value of the default value of
64the 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
66value is the user's name.)
388348ae 67It is useful to set this variable in the site customization file.")
581d7e0b
RM
68
69;;;###autoload
70(defvar rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^message-id:\\|^summary-line:" "\
71*Gubbish headers one would rather not see.")
72
73;;;###autoload
74(defvar rmail-delete-after-output nil "\
75*Non-nil means automatically delete a message that is copied to a file.")
76
77;;;###autoload
5009d9f0 78(defvar rmail-primary-inbox-list nil "\
3af9db89
RS
79*List of files which are inboxes for user's primary mail file `~/RMAIL'.
80`nil' means the default, which is (\"/usr/spool/mail/$USER\")
81\(the name varies depending on the operating system,
581d7e0b
RM
82and the value of the environment variable MAIL overrides it).")
83
94ed51e8
RS
84;;;###autoload
85(defvar rmail-mail-new-frame nil
86 "*Non-nil means Rmail makes a new frame for composing outgoing mail.")
87
bd1f0f84
RS
88;; These may be altered by site-init.el to match the format of mmdf files
89;; delimiting used on a given host (delim1 and delim2 from the config
90;; files).
581d7e0b
RM
91
92(defvar mmdf-delim1 "^\001\001\001\001\n"
93 "Regexp marking the start of an mmdf message")
94(defvar mmdf-delim2 "^\001\001\001\001\n"
95 "Regexp marking the end of an mmdf message")
96
97(defvar rmail-message-filter nil
98 "If non nil, is a filter function for new headers in RMAIL.
99Called with region narrowed to unformatted header.")
100
bd1f0f84
RS
101(defvar rmail-reply-prefix "Re: "
102 "String to prepend to Subject line when replying to a message.")
103
581d7e0b
RM
104(defvar rmail-mode-map nil)
105
106(defvar rmail-inbox-list nil)
107(defvar rmail-keywords nil)
108
109;; Message counters and markers. Deleted flags.
110
111(defvar rmail-current-message nil)
112(defvar rmail-total-messages nil)
113(defvar rmail-message-vector nil)
114(defvar rmail-deleted-vector nil)
115
116;; These are used by autoloaded rmail-summary.
117
118(defvar rmail-summary-buffer nil)
119(defvar rmail-summary-vector nil)
120
121;; `Sticky' default variables.
122
123;; Last individual label specified to a or k.
124(defvar rmail-last-label nil)
bd1f0f84 125;; Last set of values specified to C-M-n, C-M-p, C-M-s or C-M-l.
581d7e0b
RM
126(defvar rmail-last-multi-labels nil)
127(defvar rmail-last-file nil)
bd1f0f84 128(defvar rmail-last-regexp nil)
b1d9bfa7 129(defvar rmail-last-rmail-file (expand-file-name "~/XMAIL"))
46947372 130
4746118a
JB
131;;; Regexp matching the delimiter of messages in UNIX mail format
132;;; (UNIX From lines), minus the initial ^. Note that if you change
133;;; this expression, you must change the code in rmail-nuke-pinhead-header
134;;; that knows the exact ordering of the \\( \\) subexpressions.
46947372 135(defvar rmail-unix-mail-delimiter
b7cceaf1 136 (let ((time-zone-regexp
13a5fb22 137 (concat "\\([A-Z]?[A-Z][A-Z][A-Z]\\( DST\\)?"
b7cceaf1
JB
138 "\\|[-+]?[0-9][0-9][0-9][0-9]"
139 "\\|"
140 "\\) *")))
141 (concat
142 "From "
143
144 ;; Username, perhaps with a quoted section that can contain spaces.
145 "\\("
146 "[^ \n]*"
147 "\\(\\|\".*\"[^ \n]*\\)"
148 "\\) ?"
149
150 ;; The time the message was sent.
151 "\\([^ \n]*\\) *" ; day of the week
152 "\\([^ ]*\\) *" ; month
153 "\\([0-9]*\\) *" ; day of month
154 "\\([0-9:]*\\) *" ; time of day
155
156 ;; Perhaps a time zone, specified by an abbreviation, or by a
157 ;; numeric offset.
158 time-zone-regexp
159
160 ;; The year.
161 " [0-9][0-9]\\([0-9]*\\) *"
162
163 ;; On some systems the time zone can appear after the year, too.
164 time-zone-regexp
165
166 ;; I'm not sure what this is.
167 "\\(remote from [^\n]*\\)?"
168
169 "\n"))
170 nil)
171
bd1f0f84
RS
172;; Perform BODY in the summary buffer
173;; in such a way that its cursor is properly updated in its own window.
174(defmacro rmail-select-summary (&rest body)
175 (` (progn (if (rmail-summary-displayed)
176 (let ((window (selected-window)))
46564c8d
RS
177 (save-excursion
178 (unwind-protect
179 (progn
180 (pop-to-buffer rmail-summary-buffer)
181 (,@ body))
182 (select-window window))))
bd1f0f84
RS
183 (save-excursion
184 (set-buffer rmail-summary-buffer)
185 (progn (,@ body))))
186 (rmail-maybe-display-summary))))
581d7e0b
RM
187\f
188;;;; *** Rmail Mode ***
189
190;;;###autoload
191(defun rmail (&optional file-name-arg)
192 "Read and edit incoming mail.
193Moves messages into file named by rmail-file-name (a babyl format file)
194 and edits that file in RMAIL Mode.
195Type \\[describe-mode] once editing that file, for a list of RMAIL commands.
196
197May be called with filename as argument; then performs rmail editing on
198that file, but does not copy any new mail into the file."
199 (interactive (if current-prefix-arg
200 (list (read-file-name "Run rmail on RMAIL file: "
201 nil nil t))))
202 (or rmail-last-file
203 (setq rmail-last-file (expand-file-name "~/xmail")))
581d7e0b
RM
204 (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name)))
205 (existed (get-file-buffer file-name)))
206 ;; Like find-file, but in the case where a buffer existed
207 ;; and the file was reverted, recompute the message-data.
208 (if (and existed (not (verify-visited-file-modtime existed)))
209 (progn
210 ;; Don't be confused by apparent local-variables spec
211 ;; in the last message in the RMAIL file.
8defe99b 212 (let ((enable-local-variables nil))
581d7e0b 213 (find-file file-name))
bd1f0f84
RS
214 (if (and (verify-visited-file-modtime existed)
215 (eq major-mode 'rmail-mode))
581d7e0b
RM
216 (progn (rmail-forget-messages)
217 (rmail-set-message-counters))))
8defe99b 218 (let ((enable-local-variables nil))
581d7e0b 219 (find-file file-name)))
bd1f0f84
RS
220 (if (eq major-mode 'rmail-edit-mode)
221 (error "Exit Rmail Edit mode before getting new mail."))
581d7e0b
RM
222 (if (and existed (> (buffer-size) 0))
223 ;; Buffer not new and not empty; ensure in proper mode, but that's all.
224 (or (eq major-mode 'rmail-mode)
225 (rmail-mode-2))
226 (rmail-mode-2)
581d7e0b
RM
227 ;; Convert all or part to Babyl file if possible.
228 (rmail-convert-file)
229 (goto-char (point-max))
230 (if (null rmail-inbox-list)
231 (progn
232 (rmail-set-message-counters)
233 (rmail-show-message))))
e9c735fa
JA
234 (let ((existing-unseen (rmail-first-unseen-message)))
235 (rmail-get-new-mail)
236 ;; Show the first unseen message, which might be from a previous session
237 ;; or might have been just read in by rmail-get-new-mail. Must
238 ;; determine already unseen messages first, as rmail-get-new-mail
eb8c3be9 239 ;; positions on the first new message, thus marking it as seen.
e9c735fa 240 (rmail-show-message existing-unseen))))
581d7e0b
RM
241
242;; Given the value of MAILPATH, return a list of inbox file names.
243;; This is turned off because it is not clear that the user wants
244;; all these inboxes to feed into the primary rmail file.
245; (defun rmail-convert-mailpath (string)
246; (let (idx list)
247; (while (setq idx (string-match "[%:]" string))
248; (let ((this (substring string 0 idx)))
249; (setq string (substring string (1+ idx)))
250; (setq list (cons (if (string-match "%" this)
251; (substring this 0 (string-match "%" this))
252; this)
253; list))))
254; list))
255
256; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line
257; will not cause emacs 18.55 problems.
258
259(defun rmail-convert-file ()
260 (let (convert)
261 (widen)
262 (goto-char (point-min))
263 ;; If file doesn't start like a Babyl file,
264 ;; convert it to one, by adding a header and converting each message.
265 (cond ((looking-at "BABYL OPTIONS:"))
266 ((looking-at "Version: 5\n")
267 ;; Losing babyl file made by old version of Rmail.
268 ;; Just fix the babyl file header; don't make a new one,
269 ;; so we don't lose the Labels: file attribute, etc.
270 (let ((buffer-read-only nil))
271 (insert "BABYL OPTIONS: -*- rmail -*-\n")))
272 (t
273 (setq convert t)
274 (rmail-insert-rmail-file-header)))
275 ;; If file was not a Babyl file or if there are
276 ;; Unix format messages added at the end,
277 ;; convert file as necessary.
278 (if (or convert
279 (progn (goto-char (point-max))
280 (search-backward "\^_")
281 (forward-char 1)
282 (looking-at "\n*From ")))
283 (let ((buffer-read-only nil))
284 (message "Converting to Babyl format...")
285 (narrow-to-region (point) (point-max))
286 (rmail-convert-to-babyl-format)
287 (message "Converting to Babyl format...done")))))
288
289; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line
290; will not cause emacs 18.55 problems.
291
292(defun rmail-insert-rmail-file-header ()
293 (let ((buffer-read-only nil))
294 (insert "BABYL OPTIONS: -*- rmail -*-
295Version: 5
296Labels:
297Note: This is the header of an rmail file.
298Note: If you are seeing it in rmail,
299Note: it means the file has no messages in it.\n\^_")))
300
301(if rmail-mode-map
302 nil
303 (setq rmail-mode-map (make-keymap))
304 (suppress-keymap rmail-mode-map)
bd1f0f84
RS
305 (define-key rmail-mode-map "a" 'rmail-add-label)
306 (define-key rmail-mode-map "b" 'rmail-bury)
307 (define-key rmail-mode-map "c" 'rmail-continue)
308 (define-key rmail-mode-map "d" 'rmail-delete-forward)
309 (define-key rmail-mode-map "\C-d" 'rmail-delete-backward)
310 (define-key rmail-mode-map "e" 'rmail-edit-current-message)
311 (define-key rmail-mode-map "f" 'rmail-forward)
312 (define-key rmail-mode-map "g" 'rmail-get-new-mail)
313 (define-key rmail-mode-map "h" 'rmail-summary)
314 (define-key rmail-mode-map "i" 'rmail-input)
315 (define-key rmail-mode-map "j" 'rmail-show-message)
316 (define-key rmail-mode-map "k" 'rmail-kill-label)
317 (define-key rmail-mode-map "l" 'rmail-summary-by-labels)
581d7e0b 318 (define-key rmail-mode-map "\e\C-h" 'rmail-summary)
581d7e0b
RM
319 (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels)
320 (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients)
321 (define-key rmail-mode-map "\e\C-s" 'rmail-summary-by-regexp)
bd1f0f84
RS
322 (define-key rmail-mode-map "\e\C-t" 'rmail-summary-by-topic)
323 (define-key rmail-mode-map "m" 'rmail-mail)
324 (define-key rmail-mode-map "\em" 'rmail-retry-failure)
325 (define-key rmail-mode-map "n" 'rmail-next-undeleted-message)
326 (define-key rmail-mode-map "\en" 'rmail-next-message)
327 (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message)
328 (define-key rmail-mode-map "o" 'rmail-output-to-rmail-file)
329 (define-key rmail-mode-map "\C-o" 'rmail-output)
330 (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message)
331 (define-key rmail-mode-map "\ep" 'rmail-previous-message)
332 (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message)
333 (define-key rmail-mode-map "q" 'rmail-quit)
334 (define-key rmail-mode-map "r" 'rmail-reply)
ed7ace63 335;; I find I can't live without the default M-r command -- rms.
bd1f0f84
RS
336;; (define-key rmail-mode-map "\er" 'rmail-search-backwards)
337 (define-key rmail-mode-map "s" 'rmail-expunge-and-save)
338 (define-key rmail-mode-map "\es" 'rmail-search)
339 (define-key rmail-mode-map "t" 'rmail-toggle-header)
340 (define-key rmail-mode-map "u" 'rmail-undelete-previous-message)
341 (define-key rmail-mode-map "w" 'rmail-edit-current-message)
342 (define-key rmail-mode-map "x" 'rmail-expunge)
343 (define-key rmail-mode-map "." 'rmail-beginning-of-message)
344 (define-key rmail-mode-map "<" 'rmail-first-message)
345 (define-key rmail-mode-map ">" 'rmail-last-message)
346 (define-key rmail-mode-map " " 'scroll-up)
347 (define-key rmail-mode-map "\177" 'scroll-down)
348 (define-key rmail-mode-map "?" 'describe-mode)
3bf526cf
RS
349 (define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date)
350 (define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject)
351 (define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author)
352 (define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient)
353 (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent)
354 (define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-lines)
bd1f0f84 355 )
5201ddda
RS
356\f
357(define-key rmail-mode-map [menu-bar] (make-sparse-keymap))
358
359(define-key rmail-mode-map [menu-bar classify]
360 (cons "Classify" (make-sparse-keymap "Classify")))
361
362(define-key rmail-mode-map [menu-bar classify output-inbox]
363 '("Output (inbox)" . rmail-output))
364
365(define-key rmail-mode-map [menu-bar classify output]
366 '("Output (Rmail)" . rmail-output-to-rmail-file))
367
368(define-key rmail-mode-map [menu-bar classify kill-label]
369 '("Kill Label" . rmail-kill-label))
370
371(define-key rmail-mode-map [menu-bar classify add-label]
372 '("Add Label" . rmail-add-label))
373
374(define-key rmail-mode-map [menu-bar summary]
375 (cons "Summary" (make-sparse-keymap "Summary")))
376
377(define-key rmail-mode-map [menu-bar summary labels]
378 '("By Labels" . rmail-summary-by-labels))
379
380(define-key rmail-mode-map [menu-bar summary recipients]
381 '("By Recipients" . rmail-summary-by-recipients))
382
383(define-key rmail-mode-map [menu-bar summary topic]
384 '("By Topic" . rmail-summary-by-topic))
385
386(define-key rmail-mode-map [menu-bar summary regexp]
387 '("By Regexp" . rmail-summary-by-regexp))
388
389(define-key rmail-mode-map [menu-bar summary all]
390 '("All" . rmail-summary))
391
392(define-key rmail-mode-map [menu-bar mail]
393 (cons "Mail" (make-sparse-keymap "Mail")))
394
395(define-key rmail-mode-map [menu-bar mail continue]
396 '("Continue" . rmail-continue))
397
398(define-key rmail-mode-map [menu-bar mail forward]
399 '("Forward" . rmail-forward))
400
401(define-key rmail-mode-map [menu-bar mail retry]
402 '("Retry" . rmail-retry-failure))
403
404(define-key rmail-mode-map [menu-bar mail reply]
405 '("Reply" . rmail-reply))
406
407(define-key rmail-mode-map [menu-bar mail mail]
408 '("Mail" . rmail-mail))
409
410(define-key rmail-mode-map [menu-bar delete]
411 (cons "Delete" (make-sparse-keymap "Delete")))
412
413(define-key rmail-mode-map [menu-bar delete expunge/save]
414 '("Expunge/Save" . rmail-expunge-and-save))
581d7e0b 415
5201ddda
RS
416(define-key rmail-mode-map [menu-bar delete expunge]
417 '("Expunge" . rmail-expunge))
418
419(define-key rmail-mode-map [menu-bar delete undelete]
420 '("Undelete" . rmail-undelete-previous-message))
421
422(define-key rmail-mode-map [menu-bar delete delete]
423 '("Delete" . rmail-delete-forward))
424
425(define-key rmail-mode-map [menu-bar move]
426 (cons "Move" (make-sparse-keymap "Move")))
427
428(define-key rmail-mode-map [menu-bar move search-back]
429 '("Search Back" . rmail-search-backward))
430
431(define-key rmail-mode-map [menu-bar move search]
432 '("Search" . rmail-search))
433
434(define-key rmail-mode-map [menu-bar move previous]
435 '("Previous Nondeleted" . rmail-previous-undeleted-message))
436
437(define-key rmail-mode-map [menu-bar move next]
438 '("Next Nondeleted" . rmail-next-undeleted-message))
439
440(define-key rmail-mode-map [menu-bar move last]
441 '("Last" . rmail-last-message))
442
443(define-key rmail-mode-map [menu-bar move first]
444 '("First" . rmail-first-message))
445
446(define-key rmail-mode-map [menu-bar move previous]
447 '("Previous" . rmail-previous-message))
448
449(define-key rmail-mode-map [menu-bar move next]
450 '("Next" . rmail-next-message))
451\f
581d7e0b
RM
452;; Rmail mode is suitable only for specially formatted data.
453(put 'rmail-mode 'mode-class 'special)
454
9712b0bd 455;;;###autoload
581d7e0b
RM
456(defun rmail-mode ()
457 "Rmail Mode is used by \\<rmail-mode-map>\\[rmail] for editing Rmail files.
458All normal editing commands are turned off.
459Instead, these commands are available:
460
461\\[rmail-beginning-of-message] Move point to front of this message (same as \\[beginning-of-buffer]).
462\\[scroll-up] Scroll to next screen of this message.
463\\[scroll-down] Scroll to previous screen of this message.
464\\[rmail-next-undeleted-message] Move to Next non-deleted message.
465\\[rmail-previous-undeleted-message] Move to Previous non-deleted message.
466\\[rmail-next-message] Move to Next message whether deleted or not.
467\\[rmail-previous-message] Move to Previous message whether deleted or not.
468\\[rmail-first-message] Move to the first message in Rmail file.
469\\[rmail-last-message] Move to the last message in Rmail file.
470\\[rmail-show-message] Jump to message specified by numeric position in file.
471\\[rmail-search] Search for string and show message it is found in.
472\\[rmail-delete-forward] Delete this message, move to next nondeleted.
473\\[rmail-delete-backward] Delete this message, move to previous nondeleted.
474\\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages
475 till a deleted message is found.
bd1f0f84 476\\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail.
581d7e0b
RM
477\\[rmail-expunge] Expunge deleted messages.
478\\[rmail-expunge-and-save] Expunge and save the file.
479\\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer.
480\\[save-buffer] Save without expunging.
3af9db89 481\\[rmail-get-new-mail] Move new mail from system spool directory into this file.
581d7e0b
RM
482\\[rmail-mail] Mail a message (same as \\[mail-other-window]).
483\\[rmail-continue] Continue composing outgoing message started before.
bd1f0f84
RS
484\\[rmail-reply] Reply to this message. Like \\[rmail-mail] but initializes some fields.
485\\[rmail-retry-failure] Send this message again. Used on a mailer failure message.
581d7e0b
RM
486\\[rmail-forward] Forward this message to another user.
487\\[rmail-output-to-rmail-file] Output this message to an Rmail file (append it).
488\\[rmail-output] Output this message to a Unix-format mail file (append it).
489\\[rmail-input] Input Rmail file. Run Rmail on that file.
490\\[rmail-add-label] Add label to message. It will be displayed in the mode line.
491\\[rmail-kill-label] Kill label. Remove a label from current message.
492\\[rmail-next-labeled-message] Move to Next message with specified label
493 (label defaults to last one specified).
494 Standard labels: filed, unseen, answered, forwarded, deleted.
bd1f0f84 495 Any other label is present only if you add it with \\[rmail-add-label].
581d7e0b
RM
496\\[rmail-previous-labeled-message] Move to Previous message with specified label
497\\[rmail-summary] Show headers buffer, with a one line summary of each message.
bd1f0f84
RS
498\\[rmail-summary-by-labels] Summarize only messages with particular label(s).
499\\[rmail-summary-by-recipients] Summarize only messages with particular recipient(s).
500\\[rmail-summary-by-regexp] Summarize only messages with particular regexp(s).
501\\[rmail-summary-by-topic] Summarize only messages with subject line regexp(s).
502\\[rmail-toggle-header] Toggle display of complete header."
581d7e0b
RM
503 (interactive)
504 (rmail-mode-2)
505 (rmail-set-message-counters)
aac180a7 506 (rmail-show-message rmail-total-messages))
581d7e0b
RM
507
508(defun rmail-mode-2 ()
509 (kill-all-local-variables)
510 (rmail-mode-1)
511 (rmail-variables)
512 (run-hooks 'rmail-mode-hook))
513
514(defun rmail-mode-1 ()
515 (setq major-mode 'rmail-mode)
516 (setq mode-name "RMAIL")
517 (setq buffer-read-only t)
518 ;; No need to auto save RMAIL files.
519 (setq buffer-auto-save-file-name nil)
520 (if (boundp 'mode-line-modified)
521 (setq mode-line-modified "--- ")
522 (setq mode-line-format
523 (cons "--- " (cdr (default-value 'mode-line-format)))))
524 (use-local-map rmail-mode-map)
525 (set-syntax-table text-mode-syntax-table)
526 (setq local-abbrev-table text-mode-abbrev-table))
527
528(defun rmail-variables ()
529 (make-local-variable 'revert-buffer-function)
530 (setq revert-buffer-function 'rmail-revert)
531 (make-local-variable 'rmail-last-label)
bd1f0f84 532 (make-local-variable 'rmail-last-regexp)
581d7e0b
RM
533 (make-local-variable 'rmail-deleted-vector)
534 (make-local-variable 'rmail-summary-buffer)
535 (make-local-variable 'rmail-summary-vector)
536 (make-local-variable 'rmail-current-message)
537 (make-local-variable 'rmail-total-messages)
538 (make-local-variable 'require-final-newline)
539 (setq require-final-newline nil)
540 (make-local-variable 'version-control)
541 (setq version-control 'never)
542 (make-local-variable 'file-precious-flag)
543 (setq file-precious-flag t)
544 (make-local-variable 'rmail-message-vector)
545 (make-local-variable 'rmail-last-file)
546 (make-local-variable 'rmail-inbox-list)
547 (setq rmail-inbox-list (rmail-parse-file-inboxes))
849056cc
RS
548 ;; Provide default set of inboxes for primary mail file ~/RMAIL.
549 (and (null rmail-inbox-list)
6cd37f8f
RS
550 (or (equal buffer-file-name (expand-file-name rmail-file-name))
551 (equal buffer-file-truename (file-truename rmail-file-name)))
849056cc
RS
552 (setq rmail-inbox-list
553 (or rmail-primary-inbox-list
554 (list (or (getenv "MAIL")
555 (concat rmail-spool-directory
556 (user-original-login-name)))))))
581d7e0b
RM
557 (make-local-variable 'rmail-keywords)
558 ;; this gets generated as needed
4927c645 559 (setq rmail-keywords nil))
581d7e0b
RM
560
561;; Handle M-x revert-buffer done in an rmail-mode buffer.
562(defun rmail-revert (arg noconfirm)
563 (let (revert-buffer-function)
564 ;; Call our caller again, but this time it does the default thing.
565 (if (revert-buffer arg noconfirm)
566 ;; If the user said "yes", and we changed something,
567 ;; reparse the messages.
568 (progn
569 (rmail-convert-file)
570 (goto-char (point-max))
571 (rmail-set-message-counters)
572 (rmail-show-message)))))
573
574;; Return a list of files from this buffer's Mail: option.
575;; Does not assume that messages have been parsed.
576;; Just returns nil if buffer does not look like Babyl format.
577(defun rmail-parse-file-inboxes ()
578 (save-excursion
579 (save-restriction
580 (widen)
581 (goto-char 1)
582 (cond ((looking-at "BABYL OPTIONS:")
583 (search-forward "\n\^_" nil 'move)
584 (narrow-to-region 1 (point))
585 (goto-char 1)
586 (if (search-forward "\nMail:" nil t)
587 (progn
588 (narrow-to-region (point) (progn (end-of-line) (point)))
589 (goto-char (point-min))
590 (mail-parse-comma-list))))))))
591
592(defun rmail-expunge-and-save ()
593 "Expunge and save RMAIL file."
594 (interactive)
595 (rmail-expunge)
596 (save-buffer))
597
598(defun rmail-quit ()
599 "Quit out of RMAIL."
600 (interactive)
601 (rmail-expunge-and-save)
602 ;; Don't switch to the summary buffer even if it was recently visible.
603 (if rmail-summary-buffer
604 (bury-buffer rmail-summary-buffer))
605 (let ((obuf (current-buffer)))
606 (switch-to-buffer (other-buffer))
607 (bury-buffer obuf)))
608
609;;;###autoload
610(defun rmail-input (filename)
bd1f0f84 611 "Run Rmail on file FILENAME."
581d7e0b
RM
612 (interactive "FRun rmail on RMAIL file: ")
613 (rmail filename))
614
615\f
616;;;; *** Rmail input ***
617
618;; RLK feature not added in this version:
619;; argument specifies inbox file or files in various ways.
620
621(defun rmail-get-new-mail (&optional file-name)
622 "Move any new mail from this RMAIL file's inbox files.
623The inbox files can be specified with the file's Mail: option. The
624variable `rmail-primary-inbox-list' specifies the inboxes for your
3af9db89
RS
625primary RMAIL file if it has no Mail: option. By default, this is
626your /usr/spool/mail/$USER.
581d7e0b
RM
627
628You can also specify the file to get new mail from. In this case, the
629file of new mail is not changed or deleted. Noninteractively, you can
630pass the inbox file name as an argument. Interactively, a prefix
631argument causes us to read a file name and use that file as the inbox."
632 (interactive
633 (list (if current-prefix-arg
634 (read-file-name "Get new mail from file: "))))
635 (or (verify-visited-file-modtime (current-buffer))
636 (progn
637 (find-file (buffer-file-name))
449783e9 638 (setq buffer-read-only t)
581d7e0b
RM
639 (if (verify-visited-file-modtime (current-buffer))
640 (rmail-forget-messages))))
641 (rmail-maybe-set-message-counters)
642 (widen)
643 ;; Get rid of all undo records for this buffer.
644 (or (eq buffer-undo-list t)
645 (setq buffer-undo-list nil))
646 (unwind-protect
647 (let ((opoint (point))
648 (new-messages 0)
649 (delete-files ())
650 ;; If buffer has not changed yet, and has not been saved yet,
651 ;; don't replace the old backup file now.
652 (make-backup-files (and make-backup-files (buffer-modified-p)))
653 (buffer-read-only nil)
654 ;; Don't make undo records for what we do in getting mail.
655 (buffer-undo-list t))
656 (goto-char (point-max))
657 (skip-chars-backward " \t\n") ; just in case of brain damage
658 (delete-region (point) (point-max)) ; caused by require-final-newline
659 (save-excursion
660 (save-restriction
661 (narrow-to-region (point) (point))
662 ;; Read in the contents of the inbox files,
663 ;; renaming them as necessary,
664 ;; and adding to the list of files to delete eventually.
665 (if file-name
666 (rmail-insert-inbox-text (list file-name) nil)
667 (setq delete-files (rmail-insert-inbox-text rmail-inbox-list t)))
668 ;; Scan the new text and convert each message to babyl format.
669 (goto-char (point-min))
670 (save-excursion
671 (setq new-messages (rmail-convert-to-babyl-format)))
672 (or (zerop new-messages)
673 (let (success)
674 (widen)
675 (search-backward "\n\^_")
676 (narrow-to-region (point) (point-max))
677 (goto-char (1+ (point-min)))
678 (rmail-count-new-messages)
679 (save-buffer)))
680 ;; Delete the old files, now that babyl file is saved.
681 (while delete-files
682 (condition-case ()
ba0b5507
RS
683 ;; First, try deleting.
684 (condition-case ()
685 (delete-file (car delete-files))
686 (file-error
687 ;; If we can't delete it, truncate it.
688 (write-region (point) (point) (car delete-files))))
581d7e0b
RM
689 (file-error nil))
690 (setq delete-files (cdr delete-files)))))
691 (if (= new-messages 0)
692 (progn (goto-char opoint)
693 (if (or file-name rmail-inbox-list)
694 (message "(No new mail has arrived)")))
bd1f0f84
RS
695 (if (rmail-summary-exists)
696 (rmail-select-summary
697 (rmail-update-summary)))
581d7e0b
RM
698 (message "%d new message%s read"
699 new-messages (if (= 1 new-messages) "" "s"))
700 (and (boundp 'display-time-string)
701 (string-match " Mail" display-time-string)
702 (setq display-time-string
703 (concat
704 (substring display-time-string 0 (match-beginning 0))
705 (substring display-time-string (match-end 0))))
706 (force-mode-line-update 'all))))
707 ;; Don't leave the buffer screwed up if we get a disk-full error.
708 (rmail-show-message)))
709
710(defun rmail-insert-inbox-text (files renamep)
bd1f0f84 711 (let (file tofile delete-files movemail popmail)
581d7e0b
RM
712 (while files
713 (setq file (expand-file-name (substitute-in-file-name (car files)))
714 ;;>> un*x specific <<
2581ab99
JB
715 ;; The "+" used to be "~", which is an extremely poor choice;
716 ;; it might accidentally be deleted when space is low
717 ;; (as happened to me!).
718 tofile (concat file "+"))
581d7e0b
RM
719 ;; If getting from mail spool directory,
720 ;; use movemail to move rather than just renaming,
721 ;; so as to interlock with the mailer.
bd1f0f84
RS
722 (setq movemail (equal (file-name-directory file) rmail-spool-directory)
723 popmail (string-match "^po:" (file-name-nondirectory file)))
724 (if popmail (setq file (file-name-nondirectory file)
725 renamep t))
581d7e0b
RM
726 (if movemail
727 (progn
728 (setq tofile (expand-file-name
bd1f0f84
RS
729 ;; Generate name to move to from inbox name,
730 ;; in case of multiple inboxes that need moving.
731 (concat ".newmail-" (file-name-nondirectory file))
732 ;; Use the directory of this rmail file
733 ;; because it's a nuisance to use the homedir
734 ;; if that is on a full disk and this rmail
735 ;; file isn't.
736 (file-name-directory
737 (expand-file-name buffer-file-name))))
581d7e0b
RM
738 ;; On some systems, /usr/spool/mail/foo is a directory
739 ;; and the actual inbox is /usr/spool/mail/foo/foo.
740 (if (file-directory-p file)
741 (setq file (expand-file-name (user-original-login-name)
742 file)))))
bd1f0f84
RS
743 (if popmail
744 (message "Getting mail from post office ...")
745 (if (or (and (file-exists-p tofile)
746 (/= 0 (nth 7 (file-attributes tofile))))
747 (and (file-exists-p file)
748 (/= 0 (nth 7 (file-attributes file)))))
749 (message "Getting mail from %s..." file)))
581d7e0b
RM
750 ;; Set TOFILE if have not already done so, and
751 ;; rename or copy the file FILE to TOFILE if and as appropriate.
752 (cond ((not renamep)
753 (setq tofile file))
bd1f0f84
RS
754 ((or (file-exists-p tofile) (and (not popmail)
755 (not (file-exists-p file))))
581d7e0b 756 nil)
bd1f0f84 757 ((and (not movemail) (not popmail))
019bf2a3
RS
758 ;; Try copying. If that fails (perhaps no space),
759 ;; rename instead.
760 (condition-case nil
761 (copy-file file tofile nil)
762 (error
763 (rename-file file tofile nil)))
ba0b5507
RS
764 ;; Make the real inbox file empty.
765 ;; Leaving it deleted could cause lossage
766 ;; because mailers often won't create the file.
767 (condition-case ()
768 (write-region (point) (point) file)
769 (file-error nil)))
581d7e0b
RM
770 (t
771 (let ((errors nil))
772 (unwind-protect
773 (save-excursion
774 (setq errors (generate-new-buffer " *rmail loss*"))
775 (buffer-disable-undo errors)
776 (call-process
777 (expand-file-name "movemail" exec-directory)
778 nil errors nil file tofile)
779 (if (not (buffer-modified-p errors))
780 ;; No output => movemail won
781 nil
782 (set-buffer errors)
783 (subst-char-in-region (point-min) (point-max)
784 ?\n ?\ )
785 (goto-char (point-max))
786 (skip-chars-backward " \t")
787 (delete-region (point) (point-max))
788 (goto-char (point-min))
789 (if (looking-at "movemail: ")
790 (delete-region (point-min) (match-end 0)))
791 (beep t)
792 (message (concat "movemail: "
793 (buffer-substring (point-min)
794 (point-max))))
795 (sit-for 3)
796 nil))
797 (if errors (kill-buffer errors))))))
798 ;; At this point, TOFILE contains the name to read:
799 ;; Either the alternate name (if we renamed)
800 ;; or the actual inbox (if not renaming).
801 (if (file-exists-p tofile)
802 (let (size)
803 (goto-char (point-max))
804 (setq size (nth 1 (insert-file-contents tofile)))
805 (goto-char (point-max))
806 (or (= (preceding-char) ?\n)
807 (zerop size)
808 (insert ?\n))
809 (setq delete-files (cons tofile delete-files))))
810 (message "")
811 (setq files (cdr files)))
812 delete-files))
813
814;; the rmail-break-forwarded-messages feature is not implemented
815(defun rmail-convert-to-babyl-format ()
816 (let ((count 0) start
b77ab9e8
RS
817 (case-fold-search nil)
818 (invalid-input-resync
819 (function (lambda ()
820 (message "Invalid Babyl format in inbox!")
821 (sit-for 1)
822 ;; Try to get back in sync with a real message.
823 (if (re-search-forward
824 (concat mmdf-delim1 "\\|^From") nil t)
825 (beginning-of-line)
826 (goto-char (point-max)))))))
581d7e0b
RM
827 (goto-char (point-min))
828 (save-restriction
829 (while (not (eobp))
830 (cond ((looking-at "BABYL OPTIONS:");Babyl header
b77ab9e8
RS
831 (if (search-forward "\n\^_" nil t)
832 ;; If we find the proper terminator, delete through there.
833 (delete-region (point-min) (point))
834 (funcall invalid-input-resync)
a553316b 835 (delete-region (point-min) (point))))
581d7e0b
RM
836 ;; Babyl format message
837 ((looking-at "\^L")
838 (or (search-forward "\n\^_" nil t)
b77ab9e8 839 (funcall invalid-input-resync))
581d7e0b
RM
840 (setq count (1+ count))
841 ;; Make sure there is no extra white space after the ^_
842 ;; at the end of the message.
843 ;; Narrowing will make sure that whatever follows the junk
844 ;; will be treated properly.
845 (delete-region (point)
846 (save-excursion
847 (skip-chars-forward " \t\n")
848 (point)))
849 (narrow-to-region (point) (point-max)))
850 ;;*** MMDF format
851 ((let ((case-fold-search t))
852 (looking-at mmdf-delim1))
853 (let ((case-fold-search t))
854 (replace-match "\^L\n0, unseen,,\n*** EOOH ***\n")
855 (setq start (point))
856 (re-search-forward mmdf-delim2 nil t)
857 (replace-match "\^_"))
858 (save-excursion
859 (save-restriction
860 (narrow-to-region start (1- (point)))
861 (goto-char (point-min))
862 (while (search-forward "\n\^_" nil t); single char "\^_"
863 (replace-match "\n^_")))); 2 chars: "^" and "_"
864 (narrow-to-region (point) (point-max))
865 (setq count (1+ count)))
866 ;;*** Mail format
867 ((looking-at "^From ")
868 (setq start (point))
869 (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
870 (rmail-nuke-pinhead-header)
bd1f0f84
RS
871 ;; If this message has a Content-Length field,
872 ;; skip to the end of the contents.
873 (let* ((header-end (save-excursion
874 (and (re-search-forward "\n\n" nil t)
875 (point))))
876 (case-fold-search t)
877 (size
878 ;; Get the numeric value from the Content-Length field.
879 (save-excursion
880 ;; Back up to end of prev line,
881 ;; in case the Content-Length field comes first.
882 (forward-char -1)
883 (and (search-forward "\ncontent-length: "
884 header-end t)
885 (let ((beg (point))
886 (eol (progn (end-of-line) (point))))
887 (read (buffer-substring beg eol)))))))
888 (if size
889 (goto-char (+ header-end size))))
890
581d7e0b
RM
891 (if (re-search-forward
892 (concat "^[\^_]?\\("
46947372
JB
893 rmail-unix-mail-delimiter
894 "\\|"
581d7e0b
RM
895 mmdf-delim1 "\\|"
896 "^BABYL OPTIONS:\\|"
897 "\^L\n[01],\\)") nil t)
898 (goto-char (match-beginning 1))
899 (goto-char (point-max)))
900 (setq count (1+ count))
901 (save-excursion
902 (save-restriction
903 (narrow-to-region start (point))
904 (goto-char (point-min))
905 (while (search-forward "\n\^_" nil t); single char
906 (replace-match "\n^_")))); 2 chars: "^" and "_"
907 (insert ?\^_)
908 (narrow-to-region (point) (point-max)))
909 ;;
8896f2df
RS
910 ;; This kludge is because some versions of sendmail.el
911 ;; insert an extra newline at the beginning that shouldn't
912 ;; be there. sendmail.el has been fixed, but old versions
913 ;; may still be in use. -- rms, 7 May 1993.
914 ((eolp) (delete-char 1))
a553316b 915 (t (error "Cannot convert to babyl format")))))
581d7e0b
RM
916 count))
917
918;; Delete the "From ..." line, creating various other headers with
919;; information from it if they don't already exist. Now puts the
920;; original line into a mail-from: header line for debugging.
921(defun rmail-nuke-pinhead-header ()
922 (save-excursion
923 (save-restriction
924 (let ((start (point))
925 (end (progn
926 (condition-case ()
927 (search-forward "\n\n")
928 (error
929 (goto-char (point-max))
930 (insert "\n\n")))
931 (point)))
932 has-from has-date)
933 (narrow-to-region start end)
934 (let ((case-fold-search t))
935 (goto-char start)
936 (setq has-from (search-forward "\nFrom:" nil t))
937 (goto-char start)
938 (setq has-date (and (search-forward "\nDate:" nil t) (point)))
939 (goto-char start))
940 (let ((case-fold-search nil))
46947372 941 (if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t)
581d7e0b
RM
942 (replace-match
943 (concat
944 "Mail-from: \\&"
945 ;; Keep and reformat the date if we don't
946 ;; have a Date: field.
947 (if has-date
948 ""
b7cceaf1
JB
949 (concat
950 "Date: \\3, \\5 \\4 \\9 \\6 "
951
952 ;; The timezone could be matched by group 7 or group 10.
953 ;; If neither of them matched, assume EST, since only
954 ;; Easterners would be so sloppy.
955 ;; It's a shame the substitution can't use "\\10".
956 (cond
957 ((/= (match-beginning 7) (match-end 7)) "\\7")
958 ((/= (match-beginning 10) (match-end 10))
959 (buffer-substring (match-beginning 10)
960 (match-end 10)))
961 (t "EST"))
962 "\n"))
581d7e0b
RM
963 ;; Keep and reformat the sender if we don't
964 ;; have a From: field.
965 (if has-from
966 ""
967 "From: \\1\n")))))))))
968\f
969;;;; *** Rmail Message Formatting and Header Manipulation ***
970
971(defun rmail-reformat-message (beg end)
972 (goto-char beg)
973 (forward-line 1)
974 (if (/= (following-char) ?0)
975 (error "Bad format in RMAIL file."))
976 (let ((buffer-read-only nil)
977 (delta (- (buffer-size) end)))
978 (delete-char 1)
979 (insert ?1)
980 (forward-line 1)
981 (if (looking-at "Summary-line: ")
982 (forward-line 1))
983 (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n")
984 (delete-region (point)
985 (progn (forward-line 1) (point))))
986 (let ((str (buffer-substring (point)
987 (save-excursion (search-forward "\n\n" end 'move)
988 (point)))))
989 (insert str "*** EOOH ***\n")
990 (narrow-to-region (point) (- (buffer-size) delta)))
991 (goto-char (point-min))
992 (if rmail-ignored-headers (rmail-clear-headers))
993 (if rmail-message-filter (funcall rmail-message-filter))))
994
995(defun rmail-clear-headers ()
996 (if (search-forward "\n\n" nil t)
997 (save-restriction
998 (narrow-to-region (point-min) (point))
999 (let ((buffer-read-only nil))
1000 (while (let ((case-fold-search t))
1001 (goto-char (point-min))
1002 (re-search-forward rmail-ignored-headers nil t))
1003 (beginning-of-line)
1004 (delete-region (point)
1005 (progn (re-search-forward "\n[^ \t]")
1006 (forward-char -1)
1007 (point))))))))
1008
1009(defun rmail-toggle-header ()
1010 "Show original message header if pruned header currently shown, or vice versa."
1011 (interactive)
1012 (rmail-maybe-set-message-counters)
1013 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
1014 (let ((buffer-read-only nil))
1015 (goto-char (point-min))
1016 (forward-line 1)
1017 (if (= (following-char) ?1)
1018 (progn (delete-char 1)
1019 (insert ?0)
1020 (forward-line 1)
1021 (if (looking-at "Summary-Line:")
1022 (forward-line 1))
1023 (insert "*** EOOH ***\n")
1024 (forward-char -1)
1025 (search-forward "\n*** EOOH ***\n")
1026 (forward-line -1)
1027 (let ((temp (point)))
1028 (and (search-forward "\n\n" nil t)
1029 (delete-region temp (point))))
1030 (goto-char (point-min))
1031 (search-forward "\n*** EOOH ***\n")
1032 (narrow-to-region (point) (point-max)))
1033 (rmail-reformat-message (point-min) (point-max)))))
1034\f
1035;;;; *** Rmail Attributes and Keywords ***
1036
1037;; Make a string describing current message's attributes and keywords
1038;; and set it up as the name of a minor mode
1039;; so it will appear in the mode line.
1040(defun rmail-display-labels ()
1041 (let ((blurb "") (beg (point-min-marker)) (end (point-max-marker)))
1042 (save-excursion
1043 (unwind-protect
1044 (progn
1045 (widen)
1046 (goto-char (rmail-msgbeg rmail-current-message))
1047 (forward-line 1)
1048 (if (looking-at "[01],")
1049 (progn
1050 (narrow-to-region (point) (progn (end-of-line) (point)))
1051 ;; Truly valid BABYL format requires a space before each
1052 ;; attribute or keyword name. Put them in if missing.
1053 (let (buffer-read-only)
1054 (goto-char (point-min))
1055 (while (search-forward "," nil t)
1056 (or (looking-at "[ ,]") (eobp)
1057 (insert " "))))
1058 (goto-char (point-max))
1059 (if (search-backward ",," nil 'move)
1060 (progn
1061 (if (> (point) (1+ (point-min)))
1062 (setq blurb (buffer-substring (+ 1 (point-min)) (point))))
1063 (if (> (- (point-max) (point)) 2)
1064 (setq blurb
1065 (concat blurb
1066 ";"
1067 (buffer-substring (+ (point) 3)
1068 (1- (point-max)))))))))))
1069 ;; Note: we don't use save-restriction because that does not work right
1070 ;; if changes are made outside the saved restriction
1071 ;; before that restriction is restored.
1072 (narrow-to-region beg end)
1073 (set-marker beg nil)
1074 (set-marker end nil)))
1075 (while (string-match " +," blurb)
1076 (setq blurb (concat (substring blurb 0 (match-beginning 0)) ","
1077 (substring blurb (match-end 0)))))
1078 (while (string-match ", +" blurb)
1079 (setq blurb (concat (substring blurb 0 (match-beginning 0)) ","
1080 (substring blurb (match-end 0)))))
1081 (setq mode-line-process
1082 (concat " " rmail-current-message "/" rmail-total-messages
1083 blurb))))
1084
1085;; Turn an attribute of a message on or off according to STATE.
1086;; ATTR is the name of the attribute, as a string.
1087;; MSGNUM is message number to change; nil means current message.
1088(defun rmail-set-attribute (attr state &optional msgnum)
1089 (let ((omax (point-max-marker))
1090 (omin (point-min-marker))
1091 (buffer-read-only nil))
1092 (or msgnum (setq msgnum rmail-current-message))
1093 (unwind-protect
1094 (save-excursion
1095 (widen)
1096 (goto-char (+ 3 (rmail-msgbeg msgnum)))
1097 (let ((curstate
1098 (not
1099 (null (search-backward (concat ", " attr ",")
1100 (prog1 (point) (end-of-line)) t)))))
1101 (or (eq curstate (not (not state)))
1102 (if curstate
1103 (delete-region (point) (1- (match-end 0)))
1104 (beginning-of-line)
1105 (forward-char 2)
1106 (insert " " attr ","))))
1107 (if (string= attr "deleted")
1108 (rmail-set-message-deleted-p msgnum state)))
1109 ;; Note: we don't use save-restriction because that does not work right
1110 ;; if changes are made outside the saved restriction
1111 ;; before that restriction is restored.
1112 (narrow-to-region omin omax)
1113 (set-marker omin nil)
1114 (set-marker omax nil)
1115 (if (= msgnum rmail-current-message)
1116 (rmail-display-labels)))))
1117
1118;; Return t if the attributes/keywords line of msg number MSG
1119;; contains a match for the regexp LABELS.
1120(defun rmail-message-labels-p (msg labels)
1121 (save-excursion
1122 (save-restriction
1123 (widen)
1124 (goto-char (rmail-msgbeg msg))
1125 (forward-char 3)
1126 (re-search-backward labels (prog1 (point) (end-of-line)) t))))
1127\f
1128;;;; *** Rmail Message Selection And Support ***
1129
1130(defun rmail-msgend (n)
1131 (marker-position (aref rmail-message-vector (1+ n))))
1132
1133(defun rmail-msgbeg (n)
1134 (marker-position (aref rmail-message-vector n)))
1135
1136(defun rmail-widen-to-current-msgbeg (function)
1137 "Call FUNCTION with point at start of internal data of current message.
1138Assumes that bounds were previously narrowed to display the message in Rmail.
1139The bounds are widened enough to move point where desired, then narrowed
1140again afterward.
1141
1142FUNCTION may not change the visible text of the message, but it may
1143change the invisible header text."
1144 (save-excursion
c462c964 1145 (let ((obeg (- (point-max) (point-min))))
581d7e0b
RM
1146 (unwind-protect
1147 (progn
1148 (narrow-to-region (rmail-msgbeg rmail-current-message)
1149 (point-max))
1150 (goto-char (point-min))
1151 (funcall function))
1152 ;; Note: we don't use save-restriction because that does not work right
1153 ;; if changes are made outside the saved restriction
1154 ;; before that restriction is restored.
1155 ;; Here we assume that changes made by FUNCTION
1156 ;; occur before the visible region of the message.
c462c964 1157 (narrow-to-region (- (point-max) obeg) (point-max))))))
581d7e0b
RM
1158
1159(defun rmail-forget-messages ()
1160 (unwind-protect
1161 (if (vectorp rmail-message-vector)
1162 (let* ((i 0)
1163 (v rmail-message-vector)
1164 (n (length v)))
1165 (while (< i n)
1166 (move-marker (aref v i) nil)
1167 (setq i (1+ i)))))
1168 (setq rmail-message-vector nil)
1169 (setq rmail-deleted-vector nil)))
1170
1171(defun rmail-maybe-set-message-counters ()
1172 (if (not (and rmail-deleted-vector
1173 rmail-message-vector
1174 rmail-current-message
1175 rmail-total-messages))
1176 (rmail-set-message-counters)))
1177
1178(defun rmail-count-new-messages (&optional nomsg)
1179 (let* ((case-fold-search nil)
1180 (total-messages 0)
1181 (messages-head nil)
1182 (deleted-head nil))
1183 (or nomsg (message "Counting new messages..."))
1184 (goto-char (point-max))
1185 ;; Put at the end of messages-head
1186 ;; the entry for message N+1, which marks
1187 ;; the end of message N. (N = number of messages).
1188 (search-backward "\n\^_")
1189 (forward-char 1)
1190 (setq messages-head (list (point-marker)))
1191 (rmail-set-message-counters-counter (point-min))
1192 (setq rmail-current-message (1+ rmail-total-messages))
1193 (setq rmail-total-messages
1194 (+ rmail-total-messages total-messages))
1195 (setq rmail-message-vector
1196 (vconcat rmail-message-vector (cdr messages-head)))
1197 (aset rmail-message-vector
1198 rmail-current-message (car messages-head))
1199 (setq rmail-deleted-vector
1200 (concat rmail-deleted-vector deleted-head))
1201 (setq rmail-summary-vector
1202 (vconcat rmail-summary-vector (make-vector total-messages nil)))
1203 (goto-char (point-min))
1204 (or nomsg (message "Counting new messages...done (%d)" total-messages))))
1205
1206(defun rmail-set-message-counters ()
1207 (rmail-forget-messages)
1208 (save-excursion
1209 (save-restriction
1210 (widen)
1211 (let* ((point-save (point))
1212 (total-messages 0)
1213 (messages-after-point)
1214 (case-fold-search nil)
1215 (messages-head nil)
1216 (deleted-head nil))
1217 (message "Counting messages...")
1218 (goto-char (point-max))
1219 ;; Put at the end of messages-head
1220 ;; the entry for message N+1, which marks
1221 ;; the end of message N. (N = number of messages).
1222 (search-backward "\n\^_")
1223 (forward-char 1)
1224 (setq messages-head (list (point-marker)))
1225 (rmail-set-message-counters-counter (min (point) point-save))
1226 (setq messages-after-point total-messages)
1227 (rmail-set-message-counters-counter)
1228 (setq rmail-total-messages total-messages)
1229 (setq rmail-current-message
1230 (min total-messages
1231 (max 1 (- total-messages messages-after-point))))
1232 (setq rmail-message-vector
1233 (apply 'vector (cons (point-min-marker) messages-head))
1234 rmail-deleted-vector (concat "D" deleted-head)
1235 rmail-summary-vector (make-vector rmail-total-messages nil))
1236 (message "Counting messages...done")))))
1237
1238(defun rmail-set-message-counters-counter (&optional stop)
1239 (while (search-backward "\n\^_\^L\n" stop t)
1240 (forward-char 1)
1241 (setq messages-head (cons (point-marker) messages-head))
1242 (save-excursion
1243 (setq deleted-head
1244 (cons (if (search-backward ", deleted,"
1245 (prog1 (point)
1246 (forward-line 2))
1247 t)
1248 ?D ?\ )
1249 deleted-head)))
1250 (if (zerop (% (setq total-messages (1+ total-messages)) 20))
1251 (message "Counting messages...%d" total-messages))))
1252
1253(defun rmail-beginning-of-message ()
1254 "Show current message starting from the beginning."
1255 (interactive)
1256 (rmail-show-message rmail-current-message))
1257
1258(defun rmail-show-message (&optional n)
bd1f0f84
RS
1259 "Show message number N (prefix argument), counting from start of file.
1260If summary buffer is currently displayed, update current message there also."
581d7e0b
RM
1261 (interactive "p")
1262 (rmail-maybe-set-message-counters)
1263 (widen)
1264 (if (zerop rmail-total-messages)
1265 (progn (narrow-to-region (point-min) (1- (point-max)))
1266 (goto-char (point-min))
1267 (setq mode-line-process nil))
1268 (let (blurb)
1269 (if (not n)
1270 (setq n rmail-current-message)
1271 (cond ((<= n 0)
1272 (setq n 1
1273 rmail-current-message 1
1274 blurb "No previous message"))
1275 ((> n rmail-total-messages)
1276 (setq n rmail-total-messages
1277 rmail-current-message rmail-total-messages
1278 blurb "No following message"))
1279 (t
1280 (setq rmail-current-message n))))
1281 (let ((beg (rmail-msgbeg n))
1282 (end (rmail-msgend n)))
1283 (goto-char beg)
1284 (forward-line 1)
1285 (if (= (following-char) ?0)
1286 (progn
1287 (rmail-reformat-message beg end)
1288 (rmail-set-attribute "unseen" nil))
1289 (search-forward "\n*** EOOH ***\n" end t)
1290 (narrow-to-region (point) end))
1291 (goto-char (point-min))
1292 (rmail-display-labels)
1293 (run-hooks 'rmail-show-message-hook)
bd1f0f84
RS
1294 ;; If there is a summary buffer, try to move to this message
1295 ;; in that buffer. But don't complain if this message
1296 ;; is not mentioned in the summary.
1297 (if (rmail-summary-exists)
1298 (let ((curr-msg rmail-current-message))
1299 (rmail-select-summary
1300 (rmail-summary-goto-msg curr-msg t t))))
581d7e0b
RM
1301 (if blurb
1302 (message blurb))))))
1303
1304(defun rmail-next-message (n)
1305 "Show following message whether deleted or not.
1306With prefix arg N, moves forward N messages, or backward if N is negative."
1307 (interactive "p")
1308 (rmail-maybe-set-message-counters)
1309 (rmail-show-message (+ rmail-current-message n)))
1310
1311(defun rmail-previous-message (n)
1312 "Show previous message whether deleted or not.
1313With prefix arg N, moves backward N messages, or forward if N is negative."
1314 (interactive "p")
1315 (rmail-next-message (- n)))
1316
1317(defun rmail-next-undeleted-message (n)
1318 "Show following non-deleted message.
1319With prefix arg N, moves forward N non-deleted messages,
1320or backward if N is negative."
1321 (interactive "p")
1322 (rmail-maybe-set-message-counters)
1323 (let ((lastwin rmail-current-message)
1324 (current rmail-current-message))
1325 (while (and (> n 0) (< current rmail-total-messages))
1326 (setq current (1+ current))
1327 (if (not (rmail-message-deleted-p current))
1328 (setq lastwin current n (1- n))))
1329 (while (and (< n 0) (> current 1))
1330 (setq current (1- current))
1331 (if (not (rmail-message-deleted-p current))
1332 (setq lastwin current n (1+ n))))
1333 (if (/= lastwin rmail-current-message)
1334 (rmail-show-message lastwin))
1335 (if (< n 0)
4d4c4e02 1336 (message "No previous nondeleted message"))
581d7e0b 1337 (if (> n 0)
4d4c4e02 1338 (message "No following nondeleted message"))))
581d7e0b
RM
1339
1340(defun rmail-previous-undeleted-message (n)
1341 "Show previous non-deleted message.
1342With prefix argument N, moves backward N non-deleted messages,
1343or forward if N is negative."
1344 (interactive "p")
1345 (rmail-next-undeleted-message (- n)))
1346
1347(defun rmail-first-message ()
1348 "Show first message in file."
1349 (interactive)
1350 (rmail-maybe-set-message-counters)
1351 (rmail-show-message 1))
1352
1353(defun rmail-last-message ()
1354 "Show last message in file."
1355 (interactive)
1356 (rmail-maybe-set-message-counters)
1357 (rmail-show-message rmail-total-messages))
1358
1359(defun rmail-what-message ()
1360 (let ((where (point))
1361 (low 1)
1362 (high rmail-total-messages)
1363 (mid (/ rmail-total-messages 2)))
1364 (while (> (- high low) 1)
1365 (if (>= where (rmail-msgbeg mid))
1366 (setq low mid)
1367 (setq high mid))
1368 (setq mid (+ low (/ (- high low) 2))))
1369 (if (>= where (rmail-msgbeg high)) high low)))
1370
bd1f0f84
RS
1371(defun rmail-message-recipients-p (msg recipients &optional primary-only)
1372 (save-restriction
1373 (goto-char (rmail-msgbeg msg))
1374 (search-forward "\n*** EOOH ***\n")
1375 (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
1376 (or (string-match recipients (or (mail-fetch-field "To") ""))
1377 (string-match recipients (or (mail-fetch-field "From") ""))
1378 (if (not primary-only)
1379 (string-match recipients (or (mail-fetch-field "Cc") ""))))))
1380
1381(defun rmail-message-regexp-p (msg regexp)
1382 "Return t, if for message number MSG, regexp REGEXP matches in the header."
1383 (goto-char (rmail-msgbeg msg))
1384 (let ((end
1385 (save-excursion
1386 (search-forward "*** EOOH ***" (point-max)) (point))))
1387 (re-search-forward regexp end t)))
1388
5201ddda
RS
1389(defun rmail-search-backward (regexp &optional n)
1390 "Show message containing next match for REGEXP.
1391Prefix argument gives repeat count; negative argument means search
1392backwards (through earlier messages).
1393Interactively, empty argument means use same regexp used last time."
1394 (interactive
1395 (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
1396 (prompt
1397 (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
1398 regexp)
1399 (if rmail-search-last-regexp
1400 (setq prompt (concat prompt
1401 "(default "
1402 rmail-search-last-regexp
1403 ") ")))
1404 (setq regexp (read-string prompt))
1405 (cond ((not (equal regexp ""))
1406 (setq rmail-search-last-regexp regexp))
1407 ((not rmail-search-last-regexp)
1408 (error "No previous Rmail search string")))
1409 (list rmail-search-last-regexp
1410 (prefix-numeric-value current-prefix-arg))))
1411 (rmail-search regexp (- n)))
1412
581d7e0b 1413(defvar rmail-search-last-regexp nil)
e91f80c4 1414(defun rmail-search (regexp &optional n)
581d7e0b 1415 "Show message containing next match for REGEXP.
e91f80c4
RS
1416Prefix argument gives repeat count; negative argument means search
1417backwards (through earlier messages).
1418Interactively, empty argument means use same regexp used last time."
581d7e0b
RM
1419 (interactive
1420 (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
1421 (prompt
1422 (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
1423 regexp)
1424 (if rmail-search-last-regexp
1425 (setq prompt (concat prompt
1426 "(default "
1427 rmail-search-last-regexp
1428 ") ")))
1429 (setq regexp (read-string prompt))
1430 (cond ((not (equal regexp ""))
1431 (setq rmail-search-last-regexp regexp))
1432 ((not rmail-search-last-regexp)
1433 (error "No previous Rmail search string")))
e91f80c4
RS
1434 (list rmail-search-last-regexp
1435 (prefix-numeric-value current-prefix-arg))))
1436 (or n (setq n 1))
581d7e0b 1437 (message "%sRmail search for %s..."
df8a44dd 1438 (if (< n 0) "Reverse " "")
581d7e0b
RM
1439 regexp)
1440 (rmail-maybe-set-message-counters)
1441 (let ((omin (point-min))
1442 (omax (point-max))
1443 (opoint (point))
1444 win
e91f80c4 1445 (reversep (< n 0))
581d7e0b
RM
1446 (msg rmail-current-message))
1447 (unwind-protect
1448 (progn
1449 (widen)
e91f80c4
RS
1450 (while (/= n 0)
1451 ;; Check messages one by one, advancing message number up or down
1452 ;; but searching forward through each message.
1453 (if reversep
1454 (while (and (null win) (> msg 1))
1455 (goto-char (rmail-msgbeg (setq msg (1- msg))))
1456 (setq win (re-search-forward
1457 regexp (rmail-msgend msg) t)))
1458 (while (and (null win) (< msg rmail-total-messages))
1459 (goto-char (rmail-msgbeg (setq msg (1+ msg))))
1460 (setq win (re-search-forward regexp (rmail-msgend msg) t))))
df8a44dd 1461 (setq n (+ n (if reversep 1 -1)))))
581d7e0b
RM
1462 (if win
1463 (progn
1464 ;; If this is a reverse search and we found a message,
1465 ;; search backward thru this message to position point.
1466 (if reversep
1467 (progn
1468 (goto-char (rmail-msgend msg))
1469 (re-search-backward
1470 regexp (rmail-msgbeg msg) t)))
1471 (setq win (point))
1472 (rmail-show-message msg)
1473 (message "%sRmail search for %s...done"
1474 (if reversep "Reverse " "")
1475 regexp)
1476 (goto-char win))
1477 (goto-char opoint)
1478 (narrow-to-region omin omax)
1479 (ding)
1480 (message "Search failed: %s" regexp)))))
1481
e91f80c4
RS
1482(defun rmail-search-backwards (regexp &optional n)
1483 "Show message containing previous match for REGEXP.
1484Prefix argument gives repeat count; negative argument means search
1485forward (through later messages).
1486Interactively, empty argument means use same regexp used last time."
1487 (interactive
df8a44dd 1488 (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
e91f80c4
RS
1489 (prompt
1490 (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
1491 regexp)
1492 (if rmail-search-last-regexp
1493 (setq prompt (concat prompt
1494 "(default "
1495 rmail-search-last-regexp
1496 ") ")))
1497 (setq regexp (read-string prompt))
1498 (cond ((not (equal regexp ""))
1499 (setq rmail-search-last-regexp regexp))
1500 ((not rmail-search-last-regexp)
1501 (error "No previous Rmail search string")))
1502 (list rmail-search-last-regexp
1503 (prefix-numeric-value current-prefix-arg))))
1504 (rmail-search regexp (- (or n -1))))
1505
581d7e0b
RM
1506;; Show the first message which has the `unseen' attribute.
1507(defun rmail-first-unseen-message ()
117f4b92 1508 (rmail-maybe-set-message-counters)
581d7e0b
RM
1509 (let ((current 1)
1510 found)
1511 (save-restriction
1512 (widen)
1513 (while (and (not found) (< current rmail-total-messages))
581d7e0b 1514 (if (rmail-message-labels-p current ", ?\\(unseen\\),")
462c1094
RM
1515 (setq found current))
1516 (setq current (1+ current))))
e9c735fa
JA
1517;; Let the caller show the message.
1518;; (if found
1519;; (rmail-show-message found))
1520 found))
581d7e0b
RM
1521\f
1522;;;; *** Rmail Message Deletion Commands ***
1523
1524(defun rmail-message-deleted-p (n)
1525 (= (aref rmail-deleted-vector n) ?D))
1526
1527(defun rmail-set-message-deleted-p (n state)
1528 (aset rmail-deleted-vector n (if state ?D ?\ )))
1529
1530(defun rmail-delete-message ()
1531 "Delete this message and stay on it."
1532 (interactive)
1533 (rmail-set-attribute "deleted" t))
1534
1535(defun rmail-undelete-previous-message ()
1536 "Back up to deleted message, select it, and undelete it."
1537 (interactive)
1538 (let ((msg rmail-current-message))
1539 (while (and (> msg 0)
1540 (not (rmail-message-deleted-p msg)))
1541 (setq msg (1- msg)))
1542 (if (= msg 0)
1543 (error "No previous deleted message")
1544 (if (/= msg rmail-current-message)
1545 (rmail-show-message msg))
bd1f0f84
RS
1546 (rmail-set-attribute "deleted" nil)
1547 (if (rmail-summary-exists)
1548 (save-excursion
1549 (set-buffer rmail-summary-buffer)
1550 (rmail-summary-mark-undeleted msg)))
1551 (rmail-maybe-display-summary))))
581d7e0b
RM
1552
1553(defun rmail-delete-forward (&optional backward)
1554 "Delete this message and move to next nondeleted one.
1555Deleted messages stay in the file until the \\[rmail-expunge] command is given.
fd5285f3 1556With prefix argument, delete and move backward."
581d7e0b
RM
1557 (interactive "P")
1558 (rmail-set-attribute "deleted" t)
bd1f0f84
RS
1559 (let ((del-msg rmail-current-message))
1560 (if (rmail-summary-exists)
1561 (save-excursion
1562 (set-buffer rmail-summary-buffer)
1563 (rmail-summary-mark-deleted del-msg)))
1564 (rmail-next-undeleted-message (if backward -1 1))
1565 (rmail-maybe-display-summary)))
581d7e0b
RM
1566
1567(defun rmail-delete-backward ()
1568 "Delete this message and move to previous nondeleted one.
1569Deleted messages stay in the file until the \\[rmail-expunge] command is given."
1570 (interactive)
1571 (rmail-delete-forward t))
1572
bd1f0f84 1573(defun rmail-only-expunge ()
581d7e0b
RM
1574 "Actually erase all deleted messages in the file."
1575 (interactive)
1576 (message "Expunging deleted messages...")
1577 ;; Discard all undo records for this buffer.
1578 (or (eq buffer-undo-list t)
1579 (setq buffer-undo-list nil))
1580 (rmail-maybe-set-message-counters)
1581 (let* ((omax (- (buffer-size) (point-max)))
1582 (omin (- (buffer-size) (point-min)))
1583 (opoint (if (and (> rmail-current-message 0)
1584 (= ?D (aref rmail-deleted-vector rmail-current-message)))
1585 0 (- (point) (point-min))))
1586 (messages-head (cons (aref rmail-message-vector 0) nil))
1587 (messages-tail messages-head)
1588 ;; Don't make any undo records for the expunging.
1589 (buffer-undo-list t)
1590 (win))
1591 (unwind-protect
1592 (save-excursion
1593 (widen)
1594 (goto-char (point-min))
1595 (let ((counter 0)
1596 (number 1)
1597 (total rmail-total-messages)
1598 (new-message-number rmail-current-message)
1599 (new-summary nil)
1600 (buffer-read-only nil)
1601 (messages rmail-message-vector)
1602 (deleted rmail-deleted-vector)
1603 (summary rmail-summary-vector))
1604 (setq rmail-total-messages nil
1605 rmail-current-message nil
1606 rmail-message-vector nil
1607 rmail-deleted-vector nil
1608 rmail-summary-vector nil)
1609 (while (<= number total)
1610 (if (= (aref deleted number) ?D)
1611 (progn
1612 (delete-region
1613 (marker-position (aref messages number))
1614 (marker-position (aref messages (1+ number))))
1615 (move-marker (aref messages number) nil)
1616 (if (> new-message-number counter)
1617 (setq new-message-number (1- new-message-number))))
1618 (setq counter (1+ counter))
1619 (setq messages-tail
1620 (setcdr messages-tail
1621 (cons (aref messages number) nil)))
1622 (setq new-summary
1623 (cons (if (= counter number) (aref summary (1- number)))
1624 new-summary)))
1625 (if (zerop (% (setq number (1+ number)) 20))
1626 (message "Expunging deleted messages...%d" number)))
1627 (setq messages-tail
1628 (setcdr messages-tail
1629 (cons (aref messages number) nil)))
1630 (setq rmail-current-message new-message-number
1631 rmail-total-messages counter
1632 rmail-message-vector (apply 'vector messages-head)
1633 rmail-deleted-vector (make-string (1+ counter) ?\ )
1634 rmail-summary-vector (vconcat (nreverse new-summary))
1635 win t)))
1636 (message "Expunging deleted messages...done")
1637 (if (not win)
1638 (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)))
1639 (rmail-show-message
1640 (if (zerop rmail-current-message) 1 nil))
1641 (forward-char opoint))))
bd1f0f84
RS
1642
1643(defun rmail-expunge ()
1644 "Erase deleted messages from Rmail file and summary buffer."
1645 (interactive)
1646 (rmail-only-expunge)
1647 (if (rmail-summary-exists)
1648 (rmail-select-summary
1649 (rmail-update-summary))))
581d7e0b
RM
1650\f
1651;;;; *** Rmail Mailing Commands ***
1652
94ed51e8
RS
1653(defun rmail-start-mail (&rest args)
1654 (if rmail-mail-new-frame
b1d9bfa7 1655 (prog1
94ed51e8
RS
1656 (apply 'mail-other-frame args)
1657 (modify-frame-parameters (selected-frame)
1658 '((dedicated . t))))
1659 (apply 'mail-other-window args)))
1660
581d7e0b 1661(defun rmail-mail ()
bd1f0f84
RS
1662 "Send mail in another window.
1663While composing the message, use \\[mail-yank-original] to yank the
1664original message into it."
581d7e0b 1665 (interactive)
94ed51e8 1666 (rmail-start-mail nil nil nil nil nil (current-buffer)))
581d7e0b
RM
1667
1668(defun rmail-continue ()
1669 "Continue composing outgoing message previously being composed."
1670 (interactive)
94ed51e8 1671 (rmail-start-mail t))
581d7e0b
RM
1672
1673(defun rmail-reply (just-sender)
1674 "Reply to the current message.
1675Normally include CC: to all other recipients of original message;
1676prefix argument means ignore them. While composing the reply,
1677use \\[mail-yank-original] to yank the original message into it."
1678 (interactive "P")
1679 (let (from reply-to cc subject date to message-id resent-reply-to)
1680 (save-excursion
1681 (save-restriction
1682 (widen)
1683 (goto-char (rmail-msgbeg rmail-current-message))
1684 (forward-line 1)
1685 (if (= (following-char) ?0)
1686 (narrow-to-region
1687 (progn (forward-line 2)
1688 (point))
1689 (progn (search-forward "\n\n" (rmail-msgend rmail-current-message)
1690 'move)
1691 (point)))
1692 (narrow-to-region (point)
1693 (progn (search-forward "\n*** EOOH ***\n")
1694 (beginning-of-line) (point))))
1695 (setq resent-reply-to (mail-fetch-field "resent-reply-to" t)
1696 from (mail-fetch-field "from")
1697 reply-to (or resent-reply-to
1698 (mail-fetch-field "reply-to" nil t)
1699 from)
1700 cc (cond (just-sender nil)
1701 (resent-reply-to (mail-fetch-field "resent-cc" t))
1702 (t (mail-fetch-field "cc" nil t)))
1703 subject (or (and resent-reply-to
1704 (mail-fetch-field "resent-subject" t))
1705 (mail-fetch-field "subject"))
1706 date (cond (resent-reply-to
1707 (mail-fetch-field "resent-date" t))
1708 ((mail-fetch-field "date")))
1709 to (cond (resent-reply-to
1710 (mail-fetch-field "resent-to" t))
1711 ((mail-fetch-field "to" nil t))
1712 ;((mail-fetch-field "apparently-to")) ack gag barf
1713 (t ""))
1714 message-id (cond (resent-reply-to
1715 (mail-fetch-field "resent-message-id" t))
1716 ((mail-fetch-field "message-id"))))))
bd1f0f84
RS
1717 (and (stringp subject)
1718 (or (string-match (concat "\\`" (regexp-quote rmail-reply-prefix))
1719 subject)
1720 (setq subject (concat rmail-reply-prefix subject))))
94ed51e8 1721 (rmail-start-mail nil
581d7e0b
RM
1722 (mail-strip-quoted-names reply-to)
1723 subject
1724 (rmail-make-in-reply-to-field from date message-id)
1725 (if just-sender
1726 nil
1727 (let* ((cc-list (rmail-dont-reply-to
1728 (mail-strip-quoted-names
1729 (if (null cc) to (concat to ", " cc))))))
1730 (if (string= cc-list "") nil cc-list)))
1731 (current-buffer)
1732 (list (list '(lambda (buf msgnum)
1733 (save-excursion
1734 (set-buffer buf)
1735 (rmail-set-attribute "answered" t msgnum)))
1736 (current-buffer) rmail-current-message)))))
1737
1738(defun rmail-make-in-reply-to-field (from date message-id)
1739 (cond ((not from)
1740 (if message-id
1741 message-id
1742 nil))
1743 (mail-use-rfc822
1744 (require 'rfc822)
1745 (let ((tem (car (rfc822-addresses from))))
1746 (if message-id
1747 (if (string-match
1748 (regexp-quote (if (string-match "@[^@]*\\'" tem)
1749 (substring tem 0 (match-beginning 0))
1750 tem))
1751 message-id)
1752 ;; Message-ID is sufficiently informative
1753 message-id
1754 (concat message-id " (" tem ")"))
1755 ;; Use prin1 to fake RFC822 quoting
1756 (let ((field (prin1-to-string tem)))
1757 (if date
1758 (concat field "'s message of " date)
1759 field)))))
1760 ((let* ((foo "[^][\000-\037\177-\377()<>@,;:\\\" ]+")
1761 (bar "[^][\000-\037\177-\377()<>@,;:\\\"]+"))
1762 ;; Can't use format because format loses on \000 (unix *^&%*^&%$!!)
1763 (or (string-match (concat "\\`[ \t]*\\(" bar
1764 "\\)\\(<" foo "@" foo ">\\)?[ \t]*\\'")
1765 ;; "Unix Loser <Foo@bar.edu>" => "Unix Loser"
1766 from)
1767 (string-match (concat "\\`[ \t]*<" foo "@" foo ">[ \t]*(\\("
1768 bar "\\))[ \t]*\\'")
1769 ;; "<Bugs@bar.edu>" (Losing Unix) => "Losing Unix"
1770 from)))
1771 (let ((start (match-beginning 1))
1772 (end (match-end 1)))
1773 ;; Trim whitespace which above regexp match allows
1774 (while (and (< start end)
1775 (memq (aref from start) '(?\t ?\ )))
1776 (setq start (1+ start)))
1777 (while (and (< start end)
1778 (memq (aref from (1- end)) '(?\t ?\ )))
1779 (setq end (1- end)))
1780 (let ((field (substring from start end)))
1781 (if date (setq field (concat "message from " field " on " date)))
1782 (if message-id
1783 ;; "<AA259@bar.edu> (message from Unix Loser on 1-Apr-89)"
1784 (concat message-id " (" field ")")
1785 field))))
1786 (t
1787 ;; If we can't kludge it simply, do it correctly
1788 (let ((mail-use-rfc822 t))
1789 (rmail-make-in-reply-to-field from date message-id)))))
1790
8159f4af
RS
1791(defun rmail-forward (resend)
1792 "Forward the current message to another user.
1793With prefix argument, \"resend\" the message instead of forwarding it;
1794see the documentation of `rmail-resend'."
1795 (interactive "P")
1796 (if resend
1797 (call-interactively 'rmail-resend)
1798 (let ((forward-buffer (current-buffer))
1799 (subject (concat "["
1800 (let ((from (or (mail-fetch-field "From")
1801 (mail-fetch-field ">From"))))
1802 (if from
1803 (concat (mail-strip-quoted-names from) ": ")
1804 ""))
1805 (or (mail-fetch-field "Subject") "")
1806 "]")))
1807 ;; Turn off the usual actions for initializing the message body
1808 ;; because we want to get only the text from the failure message.
1809 (let (mail-signature mail-setup-hook)
1810 ;; If only one window, use it for the mail buffer.
1811 ;; Otherwise, use another window for the mail buffer
1812 ;; so that the Rmail buffer remains visible
1813 ;; and sending the mail will get back to it.
b1d9bfa7 1814 (if (funcall (if (and (not rmail-mail-new-frame) (one-window-p t))
8159f4af 1815 (function mail)
94ed51e8 1816 (function rmail-start-mail))
8159f4af
RS
1817 nil nil subject nil nil nil
1818 (list (list (function (lambda (buf msgnum)
1819 (save-excursion
1820 (set-buffer buf)
1821 (rmail-set-attribute
1822 "forwarded" t msgnum))))
1823 (current-buffer)
1824 rmail-current-message)))
b1d9bfa7
RS
1825 (save-excursion
1826 (goto-char (point-max))
1827 (forward-line 1)
1828 (insert-buffer forward-buffer)))))))
581d7e0b
RM
1829
1830(defun rmail-resend (address &optional from comment mail-alias-file)
1831 "Resend current message to ADDRESSES.
1832ADDRESSES should be a single address, a a string consisting of several
1833addresses separated by commas, or a list of addresses.
1834
1835Optional FROM is the address to resend the message from, and
1836defaults to the username of the person redistributing the message.
1837Optional COMMENT is a string that will be inserted as a comment in the
1838resent message.
1839Optional ALIAS-FILE is alternate aliases file to be used by sendmail,
1840typically for purposes of moderating a list."
1841 (interactive "sResend to: ")
9ad8712e
RS
1842 (require 'sendmail)
1843 (require 'mailalias)
581d7e0b
RM
1844 (if (not from) (setq from (user-login-name)))
1845 (let ((tembuf (generate-new-buffer " sendmail temp"))
1846 (mail-header-separator "")
1847 (case-fold-search nil)
1848 (mailbuf (current-buffer)))
1849 (unwind-protect
1850 (save-excursion
1851 ;;>> Copy message into temp buffer
1852 (set-buffer tembuf)
1853 (insert-buffer-substring mailbuf)
1854 (goto-char (point-min))
1855 ;;>> Insert resent-from:
1856 (insert "Resent-From: " from "\n")
bcf12025 1857 (insert "Resent-Date: " (mail-rfc822-date) "\n")
581d7e0b
RM
1858 ;;>> Insert resent-to: and bcc if need be.
1859 (let ((before (point)))
1860 (insert "Resent-To: " (if (stringp address)
1861 address
1862 (mapconcat 'identity address ",\n\t"))
1863 "\n")
1864 (expand-mail-aliases before (point)))
1865 ;;>> Set up comment, if any.
1866 (if (and (sequencep comment) (not (zerop (length comment))))
1867 (let ((before (point))
1868 after)
1869 (insert comment)
1870 (or (eolp) (insert "\n"))
1871 (setq after (point))
1872 (goto-char before)
1873 (while (< (point) after)
1874 (insert "Resent-Comment: ")
1875 (forward-line 1))))
1876 ;; Don't expand aliases in the destination fields
1877 ;; of the original message.
1878 (let (mail-aliases)
1879 (sendmail-send-it)))
8159f4af
RS
1880 (kill-buffer tembuf))
1881 (rmail-set-attribute "resent" t rmail-current-message)))
581d7e0b 1882
72e609d0 1883(defvar mail-unsent-separator
f2da0c68
RS
1884 (concat "^ *---+ +Unsent message follows +---+ *$\\|"
1885 "^ *---+ +Returned message +---+ *$\\|"
db32c193 1886 "^ *---+ +Original message +---+ *$\\|"
487fcdc0 1887 "^ *--+ +begin message +--+ *$\\|"
db32c193 1888 "^|? *---+ +Message text follows: +---+ *|?$"))
581d7e0b
RM
1889
1890(defun rmail-retry-failure ()
1891 "Edit a mail message which is based on the contents of the current message.
1892For a message rejected by the mail system, extract the interesting headers and
1893the body of the original message; otherwise copy the current message."
1894 (interactive)
1895 (require 'mail-utils)
1896 (let (to subj irp2 cc orig-message)
1897 (save-excursion
1898 ;; Narrow down to just the quoted original message
1899 (rmail-beginning-of-message)
f2da0c68
RS
1900 (let ((case-fold-search t))
1901 (or (re-search-forward mail-unsent-separator nil t)
1902 (error "Cannot parse this as a failure message")))
581d7e0b
RM
1903 (save-restriction
1904 (narrow-to-region (point) (point-max))
1905 ;; Now mail-fetch-field will get from headers of the original message,
1906 ;; not from the headers of the rejection.
1907 (setq to (mail-fetch-field "To")
1908 subj (mail-fetch-field "Subject")
1909 irp2 (mail-fetch-field "In-reply-to")
1910 cc (mail-fetch-field "Cc"))
1911 ;; Get the entire text (not headers) of the original message.
1912 (setq orig-message
1913 (buffer-substring
1914 (progn (search-forward "\n\n") (point))
1915 (point-max)))))
1916 ;; Start sending a new message; default header fields from the original.
854c16c5
RS
1917 ;; Turn off the usual actions for initializing the message body
1918 ;; because we want to get only the text from the failure message.
1919 (let (mail-signature mail-setup-hook)
94ed51e8 1920 (if (rmail-start-mail nil to subj irp2 cc (current-buffer))
854c16c5
RS
1921 ;; Insert original text as initial text of new draft message.
1922 (progn
1923 (goto-char (point-max))
1924 (insert orig-message)
1925 (goto-char (point-min))
1926 (end-of-line))))))
bd1f0f84
RS
1927
1928(defun rmail-bury ()
1929 "Bury current Rmail buffer and its summary buffer."
1930 (interactive)
1931 (let ((rmail-buffer (current-buffer)))
1932 (if (rmail-summary-exists)
1933 (let (window)
1934 (while (setq window (get-buffer-window rmail-summary-buffer))
b73e2d84 1935 (set-window-buffer window (other-buffer rmail-summary-buffer)))
bd1f0f84
RS
1936 (bury-buffer rmail-summary-buffer)))
1937 (switch-to-buffer (other-buffer (current-buffer)))
1938 (bury-buffer rmail-buffer)))
1939
1940(defun rmail-summary-exists ()
1941 "Non-nil iff in an RMAIL buffer and an associated summary buffer exists.
1942Non-nil value returned is the summary buffer."
1943 (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
1944 rmail-summary-buffer))
1945
1946(defun rmail-summary-displayed ()
1947 "t iff in RMAIL buffer and an associated summary buffer is displayed."
1948 (and rmail-summary-buffer (get-buffer-window rmail-summary-buffer)))
1949
1950(defvar rmail-redisplay-summary nil
1951 "*Non-nil means Rmail should show the summary when it changes.
1952This has an effect only if a summary buffer exists.")
1953
1954;; Put the summary buffer back on the screen, if user wants that.
1955(defun rmail-maybe-display-summary ()
1956 (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
1957 rmail-redisplay-summary
1958 (display-buffer rmail-summary-buffer)))
581d7e0b
RM
1959\f
1960;;;; *** Rmail Specify Inbox Files ***
1961
1962(autoload 'set-rmail-inbox-list "rmailmsc"
1963 "Set the inbox list of the current RMAIL file to FILE-NAME.
1964This may be a list of file names separated by commas.
1965If FILE-NAME is empty, remove any inbox list."
1966 t)
1967
1968;;;; *** Rmail Commands for Labels ***
1969
1970(autoload 'rmail-add-label "rmailkwd"
1971 "Add LABEL to labels associated with current RMAIL message.
1972Completion is performed over known labels when reading."
1973 t)
1974
1975(autoload 'rmail-kill-label "rmailkwd"
1976 "Remove LABEL from labels associated with current RMAIL message.
1977Completion is performed over known labels when reading."
1978 t)
1979
1980(autoload 'rmail-next-labeled-message "rmailkwd"
1981 "Show next message with LABEL. Defaults to last label used.
1982With prefix argument N moves forward N messages with this label."
1983 t)
1984
1985(autoload 'rmail-previous-labeled-message "rmailkwd"
1986 "Show previous message with LABEL. Defaults to last label used.
1987With prefix argument N moves backward N messages with this label."
1988 t)
1989
bd1f0f84
RS
1990(autoload 'rmail-read-label "rmailkwd"
1991 "PROMPT and read with completion an Rmail message label."
1992 t)
1993
581d7e0b
RM
1994;;;; *** Rmail Edit Mode ***
1995
1996(autoload 'rmail-edit-current-message "rmailedit"
1997 "Edit the contents of the current message"
1998 t)
3bf526cf
RS
1999
2000;;;; *** Rmail Sorting ***
2001
2002(autoload 'rmail-sort-by-date "rmailsort"
2003 "Sort messages of current Rmail file by date.
2004If prefix argument REVERSE is non-nil, sort them in reverse order." t)
2005
2006(autoload 'rmail-sort-by-subject "rmailsort"
2007 "Sort messages of current Rmail file by subject.
2008If prefix argument REVERSE is non-nil, sort them in reverse order." t)
2009
2010(autoload 'rmail-sort-by-author "rmailsort"
2011 "Sort messages of current Rmail file by author.
2012If prefix argument REVERSE is non-nil, sort them in reverse order." t)
2013
2014(autoload 'rmail-sort-by-recipient "rmailsort"
2015 "Sort messages of current Rmail file by recipient.
2016If prefix argument REVERSE is non-nil, sort them in reverse order." t)
2017
2018(autoload 'rmail-sort-by-correspondent "rmailsort"
2019 "Sort messages of current Rmail file by other correspondent.
2020If prefix argument REVERSE is non-nil, sort them in reverse order." t)
2021
2022(autoload 'rmail-sort-by-lines "rmailsort"
2023 "Sort messages of current Rmail file by number of lines.
2024If prefix argument REVERSE is non-nil, sort them in reverse order." t)
581d7e0b
RM
2025\f
2026;;;; *** Rmail Summary Mode ***
2027
2028(autoload 'rmail-summary "rmailsum"
2029 "Display a summary of all messages, one line per message."
2030 t)
2031
2032(autoload 'rmail-summary-by-labels "rmailsum"
2033 "Display a summary of all messages with one or more LABELS.
2034LABELS should be a string containing the desired labels, separated by commas."
2035 t)
2036
2037(autoload 'rmail-summary-by-recipients "rmailsum"
2038 "Display a summary of all messages with the given RECIPIENTS.
2039Normally checks the To, From and Cc fields of headers; but if PRIMARY-ONLY
2040is non-nil (prefix arg given), only look in the To and From fields.
bd1f0f84
RS
2041RECIPIENTS is a string of regexps separated by commas."
2042 t)
2043
2044(autoload 'rmail-summary-by-regexp "rmailsum"
2045 "Display a summary of all messages according to regexp REGEXP.
2046If the regular expression is found in the header of the message
2047\(including in the date and other lines, as well as the subject line),
2048Emacs will list the header line in the RMAIL-summary."
2049 t)
2050
2051(autoload 'rmail-summary-by-topic "rmailsum"
2052 "Display a summary of all messages with the given SUBJECT.
2053Normally checks the Subject field of headers;
2054but if WHOLE-MESSAGE is non-nil (prefix arg given),
2055 look in the whole message.
2056SUBJECT is a string of regexps separated by commas."
581d7e0b
RM
2057 t)
2058\f
2059;;;; *** Rmail output messages to files ***
2060
2061(autoload 'rmail-output-to-rmail-file "rmailout"
2062 "Append the current message to an Rmail file named FILE-NAME.
2063If the file does not exist, ask if it should be created.
2064If file is being visited, the message is appended to the Emacs
2065buffer visiting that file."
2066 t)
2067
2068(autoload 'rmail-output "rmailout"
2069 "Append this message to Unix mail file named FILE-NAME."
2070 t)
2071
2072;;;; *** Rmail undigestification ***
2073
2074(autoload 'undigestify-rmail-message "undigest"
2075 "Break up a digest message into its constituent messages.
2076Leaves original message, deleted, before the undigestified messages."
2077 t)
49116ac0
JB
2078
2079(provide 'rmail)
2080
c88ab9ce 2081;;; rmail.el ends here