Reverted wrong changes to rmail.el.
[bpt/emacs.git] / lisp / mail / rmail.el
CommitLineData
55535639 1;;; rmail.el --- main code of "RMAIL" mail reader for Emacs
c88ab9ce 2
e84b4b86 3;; Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
59ce725a 4;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
5701a0ce 5;; Free Software Foundation, Inc.
3a801d0c 6
e5167999 7;; Maintainer: FSF
d7b4d18f 8;; Keywords: mail
e5167999 9
581d7e0b
RM
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
ceaeecb0 14;; the Free Software Foundation; either version 3, or (at your option)
581d7e0b
RM
15;; any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
b578f267 23;; along with GNU Emacs; see the file COPYING. If not, write to the
3a35cf56
LK
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
581d7e0b 26
55535639
PJ
27;;; Commentary:
28
e5167999 29;;; Code:
581d7e0b
RM
30
31;; Souped up by shane@mit-ajax based on ideas of rlk@athena.mit.edu
32;; New features include attribute and keyword support, message
33;; selection by dispatch table, summary by attributes and keywords,
34;; expunging by dispatch table, sticky options for file commands.
35
bd1f0f84
RS
36;; Extended by Bob Weiner of Motorola
37;; New features include: rmail and rmail-summary buffers remain
38;; synchronized and key bindings basically operate the same way in both
39;; buffers, summary by topic or by regular expression, rmail-reply-prefix
40;; variable, and a bury rmail buffer (wipe) command.
41;;
42
581d7e0b 43(require 'mail-utils)
1bbdda4d 44(eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority
bd1f0f84 45
a8144f5e
JB
46(defvar deleted-head)
47(defvar font-lock-fontified)
48(defvar mail-abbrev-syntax-table)
49(defvar mail-abbrevs)
50(defvar messages-head)
51(defvar rmail-use-spam-filter)
52(defvar rsf-beep)
53(defvar rsf-sleep-after-message)
54(defvar total-messages)
1da6a64d 55(defvar tool-bar-map)
a8144f5e 56
bd1f0f84 57; These variables now declared in paths.el.
581d7e0b
RM
58;(defvar rmail-spool-directory "/usr/spool/mail/"
59; "This is the name of the directory used by the system mailer for\n\
6af28e9f 60;delivering new mail. Its name should end with a slash.")
581d7e0b
RM
61;(defvar rmail-file-name
62; (expand-file-name "~/RMAIL")
63; "")
64
9bb97fe9
RS
65(defgroup rmail nil
66 "Mail reader for Emacs."
67 :group 'mail)
68
69(defgroup rmail-retrieve nil
70 "Rmail retrieval options."
71 :prefix "rmail-"
72 :group 'rmail)
73
74(defgroup rmail-files nil
75 "Rmail files."
76 :prefix "rmail-"
77 :group 'rmail)
78
79(defgroup rmail-headers nil
80 "Rmail header options."
81 :prefix "rmail-"
82 :group 'rmail)
83
84(defgroup rmail-reply nil
85 "Rmail reply options."
86 :prefix "rmail-"
87 :group 'rmail)
88
89(defgroup rmail-summary nil
90 "Rmail summary options."
91 :prefix "rmail-"
92 :prefix "rmail-summary-"
93 :group 'rmail)
94
95(defgroup rmail-output nil
96 "Output message to a file."
97 :prefix "rmail-output-"
98 :prefix "rmail-"
99 :group 'rmail)
100
2bc7a799
GM
101(defgroup rmail-edit nil
102 "Rmail editing."
103 :prefix "rmail-edit-"
104 :group 'rmail)
105
1086788e
EZ
106(defgroup rmail-obsolete nil
107 "Rmail obsolete customization variables."
108 :group 'rmail)
9bb97fe9 109
9cda36c0 110(defcustom rmail-movemail-program nil
8510cb94 111 "If non-nil, the file name of the `movemail' program."
9cda36c0 112 :group 'rmail-retrieve
e1c3516e 113 :type '(choice (const nil) string))
74562053 114
9bb97fe9 115(defcustom rmail-pop-password nil
8510cb94
RS
116 "*Password to use when reading mail from POP server.
117Please use `rmail-remote-password' instead."
9bb97fe9
RS
118 :type '(choice (string :tag "Password")
119 (const :tag "Not Required" nil))
1086788e 120 :group 'rmail-obsolete)
ceeb471c 121
9bb97fe9 122(defcustom rmail-pop-password-required nil
e84b4b86 123 "*Non-nil if a password is required when reading mail from a POP server.
8510cb94 124Please use rmail-remote-password-required instead."
9bb97fe9 125 :type 'boolean
1086788e
EZ
126 :group 'rmail-obsolete)
127
128(defcustom rmail-remote-password nil
8510cb94
RS
129 "*Password to use when reading mail from a remote server.
130This setting is ignored for mailboxes whose URL already contains a password."
1086788e
EZ
131 :type '(choice (string :tag "Password")
132 (const :tag "Not Required" nil))
133 :set-after '(rmail-pop-password)
134 :set #'(lambda (symbol value)
bf247b6e 135 (set-default symbol
1086788e
EZ
136 (if (and (not value)
137 (boundp 'rmail-pop-password)
138 rmail-pop-password)
139 rmail-pop-password
140 value))
141 (setq rmail-pop-password nil))
142 :group 'rmail-retrieve
bf247b6e 143 :version "22.1")
1086788e
EZ
144
145(defcustom rmail-remote-password-required nil
146 "*Non-nil if a password is required when reading mail from a remote server."
147 :type 'boolean
148 :set-after '(rmail-pop-password-required)
149 :set #'(lambda (symbol value)
bf247b6e 150 (set-default symbol
1086788e
EZ
151 (if (and (not value)
152 (boundp 'rmail-pop-password-required)
153 rmail-pop-password-required)
154 rmail-pop-password-required
155 value))
156 (setq rmail-pop-password-required nil))
157 :group 'rmail-retrieve
bf247b6e 158 :version "22.1")
ceeb471c 159
757c2332 160(defcustom rmail-movemail-flags nil
442f5309
KH
161 "*List of flags to pass to movemail.
162Most commonly used to specify `-g' to enable GSS-API authentication
163or `-k' to enable Kerberos authentication."
84840709 164 :type '(repeat string)
cd32a7ba
DN
165 :group 'rmail-retrieve
166 :version "20.3")
757c2332 167
1086788e
EZ
168(defvar rmail-remote-password-error "invalid usercode or password\\|
169unknown user name or bad password\\|Authentication failed\\|MU_ERR_AUTH_FAILURE"
170 "Regular expression matching incorrect-password POP or IMAP server error
171messages.
0974f7bf
RS
172If you get an incorrect-password error that this expression does not match,
173please report it with \\[report-emacs-bug].")
174
1086788e 175(defvar rmail-encoded-remote-password nil)
90d56ed8 176
9bb97fe9 177(defcustom rmail-preserve-inbox nil
8510cb94 178 "*Non-nil means leave incoming mail in the user's inbox--don't delete it."
9bb97fe9
RS
179 :type 'boolean
180 :group 'rmail-retrieve)
4144e5cb 181
1086788e
EZ
182(defcustom rmail-movemail-search-path nil
183 "*List of directories to search for movemail (in addition to `exec-path')."
184 :group 'rmail-retrieve
185 :type '(repeat (directory)))
186
2b54af74
DN
187(declare-function mail-position-on-field "sendmail" (field &optional soft))
188(declare-function mail-text-start "sendmail" ())
189(declare-function rmail-update-summary "rmailsum" (&rest ignore))
190
1086788e 191(defun rmail-probe (prog)
8510cb94
RS
192 "Determine what flavor of movemail PROG is.
193We do this by executing it with `--version' and analyzing its output."
1086788e
EZ
194 (with-temp-buffer
195 (let ((tbuf (current-buffer)))
196 (buffer-disable-undo tbuf)
197 (call-process prog nil tbuf nil "--version")
198 (if (not (buffer-modified-p tbuf))
199 ;; Should not happen...
200 nil
201 (goto-char (point-min))
202 (cond
203 ((looking-at ".*movemail: invalid option")
204 'emacs) ;; Possibly...
205 ((looking-at "movemail (GNU Mailutils .*)")
206 'mailutils)
207 (t
208 ;; FIXME:
209 'emacs))))))
210
211(defun rmail-autodetect ()
0574be18 212 "Determine the file name of the `movemail' program and return its flavor.
8510cb94
RS
213If `rmail-movemail-program' is non-nil, use it.
214Otherwise, look for `movemail' in the directories in
215`rmail-movemail-search-path', those in `exec-path', and `exec-directory'."
1086788e
EZ
216 (if rmail-movemail-program
217 (rmail-probe rmail-movemail-program)
218 (catch 'scan
219 (dolist (dir (append rmail-movemail-search-path exec-path
220 (list exec-directory)))
221 (when (and dir (file-accessible-directory-p dir))
222 (let ((progname (expand-file-name "movemail" dir)))
223 (when (and (not (file-directory-p progname))
224 (file-executable-p progname))
225 (let ((x (rmail-probe progname)))
226 (when x
227 (setq rmail-movemail-program progname)
228 (throw 'scan x))))))))))
229
230(defvar rmail-movemail-variant-in-use nil
231 "The movemail variant currently in use. Known variants are:
232
233 `emacs' Means any implementation, compatible with the native Emacs one.
234 This is the default;
235 `mailutils' Means GNU mailutils implementation, capable of handling full
ab3c4f67 236mail URLs as the source mailbox.")
1086788e
EZ
237
238;;;###autoload
239(defun rmail-movemail-variant-p (&rest variants)
240 "Return t if the current movemail variant is any of VARIANTS.
241Currently known variants are 'emacs and 'mailutils."
242 (when (not rmail-movemail-variant-in-use)
243 ;; Autodetect
244 (setq rmail-movemail-variant-in-use (rmail-autodetect)))
245 (not (null (member rmail-movemail-variant-in-use variants))))
246
11bdb42c
GM
247;; Call for effect, to set rmail-movemail-program (if not set by the
248;; user), and rmail-movemail-variant-in-use. Used by various functions.
249;; I'm not sure if M-x rmail is the only entry point to this package.
250;; If so, this can be moved there.
251(rmail-movemail-variant-p)
252
581d7e0b 253;;;###autoload
9bb97fe9 254(defcustom rmail-dont-reply-to-names nil "\
0ffba6bd
PR
255*A regexp specifying addresses to prune from a reply message.
256A value of nil means exclude your own email address as an address
02eddff2 257plus whatever is specified by `rmail-default-dont-reply-to-names'."
9bb97fe9
RS
258 :type '(choice regexp (const :tag "Your Name" nil))
259 :group 'rmail-reply)
581d7e0b
RM
260
261;;;###autoload
608aa380
KH
262(defvar rmail-default-dont-reply-to-names "\\`info-" "\
263A regular expression specifying part of the default value of the
264variable `rmail-dont-reply-to-names', for when the user does not set
581d7e0b 265`rmail-dont-reply-to-names' explicitly. (The other part of the default
0ffba6bd 266value is the user's email address and name.)
388348ae 267It is useful to set this variable in the site customization file.")
581d7e0b
RM
268
269;;;###autoload
0404d031 270(defcustom rmail-ignored-headers
868e7865 271 (concat "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^sender:"
0404d031
GM
272 "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:"
273 "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:"
274 "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:"
588c9a71 275 "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^face:"
9c6f79c2 276 "\\|^x-mailer:\\|^delivered-to:\\|^lines:"
0404d031
GM
277 "\\|^content-transfer-encoding:\\|^x-coding-system:"
278 "\\|^return-path:\\|^errors-to:\\|^return-receipt-to:"
0404d031
GM
279 "\\|^precedence:\\|^list-help:\\|^list-post:\\|^list-subscribe:"
280 "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:"
5b9b5b89
RS
281 "\\|^content-length:\\|^nntp-posting-date:\\|^user-agent"
282 "\\|^importance:\\|^envelope-to:\\|^delivery-date\\|^openpgp:"
f7878d66 283 "\\|^mbox-line:\\|^cancel-lock:\\|^DomainKey-Signature:"
5b9b5b89
RS
284 "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:"
285
286 "\\|^x-.*:")
7c411780 287 "*Regexp to match header fields that Rmail should normally hide.
5b9b5b89
RS
288\(See also `rmail-nonignored-headers', which overrides this regexp.)
289This variable is used for reformatting the message header,
290which normally happens once for each message,
291when you view the message for the first time in Rmail.
292To make a change in this variable take effect
293for a message that you have already viewed,
294go to that message and type \\[rmail-toggle-header] twice."
295 :type 'regexp
296 :group 'rmail-headers)
297
298(defcustom rmail-nonignored-headers "^x-spam-status:"
299 "*Regexp to match X header fields that Rmail should show.
300This regexp overrides `rmail-ignored-headers'; if both this regexp
301and that one match a certain header field, Rmail shows the field.
be16d955 302If this is nil, ignore all header fields in `rmail-ignored-headers'.
5b9b5b89 303
7c411780
RS
304This variable is used for reformatting the message header,
305which normally happens once for each message,
306when you view the message for the first time in Rmail.
307To make a change in this variable take effect
308for a message that you have already viewed,
309go to that message and type \\[rmail-toggle-header] twice."
be16d955 310 :type '(choice (const nil) (regexp))
9bb97fe9 311 :group 'rmail-headers)
581d7e0b 312
8095bf23 313;;;###autoload
9bb97fe9 314(defcustom rmail-displayed-headers nil
8095bf23
RS
315 "*Regexp to match Header fields that Rmail should display.
316If nil, display all header fields except those matched by
9bb97fe9
RS
317`rmail-ignored-headers'."
318 :type '(choice regexp (const :tag "All"))
319 :group 'rmail-headers)
8095bf23 320
3db0cdac 321;;;###autoload
b926081f 322(defcustom rmail-retry-ignored-headers "^x-authentication-warning:" "\
9bb97fe9
RS
323*Headers that should be stripped when retrying a failed message."
324 :type '(choice regexp (const nil :tag "None"))
325 :group 'rmail-headers)
3db0cdac 326
072c3cd2 327;;;###autoload
9bb97fe9 328(defcustom rmail-highlighted-headers "^From:\\|^Subject:" "\
3df6812a 329*Regexp to match Header fields that Rmail should normally highlight.
a2e667ec 330A value of nil means don't highlight.
9bb97fe9
RS
331See also `rmail-highlight-face'."
332 :type 'regexp
333 :group 'rmail-headers)
072c3cd2 334
f7878d66 335(defface rmail-highlight
01e57329 336 '((t (:inherit highlight)))
f7878d66
RS
337 "Face to use for highlighting the most important header fields."
338 :group 'rmail-headers
339 :version "22.1")
340
3df6812a 341;;;###autoload
f7878d66 342(defcustom rmail-highlight-face 'rmail-highlight "\
9bb97fe9
RS
343*Face used by Rmail for highlighting headers."
344 :type '(choice (const :tag "Default" nil)
345 face)
346 :group 'rmail-headers)
3df6812a 347
581d7e0b 348;;;###autoload
9bb97fe9
RS
349(defcustom rmail-delete-after-output nil "\
350*Non-nil means automatically delete a message that is copied to a file."
351 :type 'boolean
352 :group 'rmail-files)
581d7e0b
RM
353
354;;;###autoload
9bb97fe9 355(defcustom rmail-primary-inbox-list nil "\
3af9db89 356*List of files which are inboxes for user's primary mail file `~/RMAIL'.
23a7c495 357nil means the default, which is (\"/usr/spool/mail/$USER\")
3af9db89 358\(the name varies depending on the operating system,
9bb97fe9 359and the value of the environment variable MAIL overrides it)."
2079601b
RS
360 ;; Don't use backquote here, because we don't want to need it
361 ;; at load time.
362 :type (list 'choice '(const :tag "Default" nil)
65e7e846
KH
363 (list 'repeat ':value (list (or (getenv "MAIL")
364 (concat "/var/spool/mail/"
365 (getenv "USER"))))
2079601b 366 'file))
9bb97fe9
RS
367 :group 'rmail-retrieve
368 :group 'rmail-files)
581d7e0b 369
94ed51e8 370;;;###autoload
9bb97fe9 371(defcustom rmail-mail-new-frame nil
8a60950d
EZ
372 "*Non-nil means Rmail makes a new frame for composing outgoing mail.
373This is handy if you want to preserve the window configuration of
374the frame where you have the RMAIL buffer displayed."
9bb97fe9
RS
375 :type 'boolean
376 :group 'rmail-reply)
94ed51e8 377
90254bb0 378;;;###autoload
9bb97fe9
RS
379(defcustom rmail-secondary-file-directory "~/"
380 "*Directory for additional secondary Rmail files."
381 :type 'directory
382 :group 'rmail-files)
90254bb0 383;;;###autoload
9bb97fe9
RS
384(defcustom rmail-secondary-file-regexp "\\.xmail$"
385 "*Regexp for which files are secondary Rmail files."
386 :type 'regexp
387 :group 'rmail-files)
90254bb0 388
9f7c6da9 389;;;###autoload
771e5387 390(defcustom rmail-confirm-expunge 'y-or-n-p
9f7c6da9
GM
391 "*Whether and how to ask for confirmation before expunging deleted messages."
392 :type '(choice (const :tag "No confirmation" nil)
393 (const :tag "Confirm with y-or-n-p" y-or-n-p)
394 (const :tag "Confirm with yes-or-no-p" yes-or-no-p))
395 :version "21.1"
396 :group 'rmail-files)
397
6c714afe
RS
398;;;###autoload
399(defvar rmail-mode-hook nil
400 "List of functions to call when Rmail is invoked.")
401
402;;;###autoload
403(defvar rmail-get-new-mail-hook nil
404 "List of functions to call when Rmail has retrieved new mail.")
405
406;;;###autoload
187962c4
DL
407(defcustom rmail-show-message-hook nil
408 "List of functions to call when Rmail displays a message."
409 :type 'hook
4e391653 410 :options '(goto-address)
187962c4 411 :group 'rmail)
6c714afe 412
6c5def8e
GM
413;;;###autoload
414(defvar rmail-quit-hook nil
415 "List of functions to call when quitting out of Rmail.")
416
6c714afe
RS
417;;;###autoload
418(defvar rmail-delete-message-hook nil
419 "List of functions to call when Rmail deletes a message.
420When the hooks are called, the message has been marked deleted but is
421still the current message in the Rmail buffer.")
422
bd1f0f84
RS
423;; These may be altered by site-init.el to match the format of mmdf files
424;; delimiting used on a given host (delim1 and delim2 from the config
425;; files).
581d7e0b 426
95b597ce 427(defvar rmail-mmdf-delim1 "^\001\001\001\001\n"
3e0b7b44 428 "Regexp marking the start of an mmdf message.")
95b597ce 429(defvar rmail-mmdf-delim2 "^\001\001\001\001\n"
3e0b7b44 430 "Regexp marking the end of an mmdf message.")
581d7e0b 431
9cda36c0 432(defcustom rmail-message-filter nil
7424c13b
RS
433 "If non-nil, a filter function for new messages in RMAIL.
434Called with region narrowed to the message, including headers,
9cda36c0
KH
435before obeying `rmail-ignored-headers'."
436 :group 'rmail-headers
8ae63446 437 :type '(choice (const nil) function))
581d7e0b 438
ab59163d
DL
439(defcustom rmail-automatic-folder-directives nil
440 "List of directives specifying where to put a message.
441Each element of the list is of the form:
442
443 (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... )
444
445Where FOLDERNAME is the name of a BABYL format folder to put the
446message. If any of the field regexp's are nil, then it is ignored.
447
448If FOLDERNAME is \"/dev/null\", it is deleted.
449If FOLDERNAME is nil then it is deleted, and skipped.
450
451FIELD is the plain text name of a field in the message, such as
452\"subject\" or \"from\". A FIELD of \"to\" will automatically include
453all text from the \"cc\" field as well.
454
455REGEXP is an expression to match in the preceeding specified FIELD.
456FIELD/REGEXP pairs continue in the list.
457
458examples:
459 (\"/dev/null\" \"from\" \"@spam.com\") ; delete all mail from spam.com
f0a7da4d
GM
460 (\"RMS\" \"from\" \"rms@\") ; save all mail from RMS."
461 :group 'rmail
462 :version "21.1"
463 :type '(repeat (sexp :tag "Directive")))
67f9d50e 464
bd1f0f84
RS
465(defvar rmail-reply-prefix "Re: "
466 "String to prepend to Subject line when replying to a message.")
467
a21b845b 468;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:".
052ec900
RS
469;; This pattern should catch all the common variants.
470;; rms: I deleted the change to delete tags in square brackets
471;; because they mess up RT tags.
472(defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*"
7424c13b 473 "Regexp to delete from Subject line before inserting `rmail-reply-prefix'.")
08960da1 474
9cda36c0
KH
475(defcustom rmail-display-summary nil
476 "*If non-nil, Rmail always displays the summary buffer."
477 :group 'rmail-summary
478 :type 'boolean)
479\f
581d7e0b 480(defvar rmail-inbox-list nil)
9cda36c0
KH
481(put 'rmail-inbox-list 'permanent-local t)
482
581d7e0b 483(defvar rmail-keywords nil)
9cda36c0 484(put 'rmail-keywords 'permanent-local t)
581d7e0b 485
6a338071
RS
486(defvar rmail-buffer nil
487 "The RMAIL buffer related to the current buffer.
488In an RMAIL buffer, this holds the RMAIL buffer itself.
489In a summary buffer, this holds the RMAIL buffer it is a summary for.")
490(put 'rmail-buffer 'permanent-local t)
491
581d7e0b
RM
492;; Message counters and markers. Deleted flags.
493
494(defvar rmail-current-message nil)
9cda36c0
KH
495(put 'rmail-current-message 'permanent-local t)
496
581d7e0b 497(defvar rmail-total-messages nil)
9cda36c0
KH
498(put 'rmail-total-messages 'permanent-local t)
499
581d7e0b 500(defvar rmail-message-vector nil)
9cda36c0
KH
501(put 'rmail-message-vector 'permanent-local t)
502
581d7e0b 503(defvar rmail-deleted-vector nil)
9cda36c0
KH
504(put 'rmail-deleted-vector 'permanent-local t)
505
0985b412
RS
506(defvar rmail-msgref-vector nil
507 "In an Rmail buffer, a vector whose Nth element is a list (N).
508When expunging renumbers messages, these lists are modified
509by substituting the new message number into the existing list.")
9cda36c0 510(put 'rmail-msgref-vector 'permanent-local t)
581d7e0b 511
24db549c 512(defvar rmail-overlay-list nil)
9cda36c0 513(put 'rmail-overlay-list 'permanent-local t)
a95caeed 514
581d7e0b
RM
515;; These are used by autoloaded rmail-summary.
516
517(defvar rmail-summary-buffer nil)
6a338071 518(put 'rmail-summary-buffer 'permanent-local t)
581d7e0b 519(defvar rmail-summary-vector nil)
6a338071 520(put 'rmail-summary-vector 'permanent-local t)
581d7e0b 521
9cda36c0
KH
522(defvar rmail-view-buffer nil
523 "Buffer which holds RMAIL message for MIME displaying.")
524(put 'rmail-view-buffer 'permanent-local t)
525\f
581d7e0b
RM
526;; `Sticky' default variables.
527
528;; Last individual label specified to a or k.
529(defvar rmail-last-label nil)
9cda36c0
KH
530(put 'rmail-last-label 'permanent-local t)
531
bd1f0f84 532;; Last set of values specified to C-M-n, C-M-p, C-M-s or C-M-l.
581d7e0b 533(defvar rmail-last-multi-labels nil)
9cda36c0 534
bd1f0f84 535(defvar rmail-last-regexp nil)
9cda36c0
KH
536(put 'rmail-last-regexp 'permanent-local t)
537
9bb97fe9
RS
538(defcustom rmail-default-file "~/xmail"
539 "*Default file name for \\[rmail-output]."
540 :type 'file
541 :group 'rmail-files)
542(defcustom rmail-default-rmail-file "~/XMAIL"
543 "*Default file name for \\[rmail-output-to-rmail-file]."
544 :type 'file
545 :group 'rmail-files)
966fbd00
RS
546(defcustom rmail-default-body-file "~/mailout"
547 "*Default file name for \\[rmail-output-body-to-file]."
548 :type 'file
549 :group 'rmail-files
550 :version "20.3")
46947372 551
9cda36c0
KH
552;; Mule and MIME related variables.
553
554;;;###autoload
555(defvar rmail-file-coding-system nil
556 "Coding system used in RMAIL file.
557
558This is set to nil by default.")
559
560;;;###autoload
561(defcustom rmail-enable-mime nil
562 "*If non-nil, RMAIL uses MIME feature.
563If the value is t, RMAIL automatically shows MIME decoded message.
564If the value is neither t nor nil, RMAIL does not show MIME decoded message
d9bf0f5a
KH
565until a user explicitly requires it.
566
567Even if the value is non-nil, you can't use MIME feature
568if the feature specified by `rmail-mime-feature' is not available
569in your session."
9cda36c0
KH
570 :type '(choice (const :tag "on" t)
571 (const :tag "off" nil)
16c53cdb 572 (other :tag "when asked" ask))
9cda36c0
KH
573 :group 'rmail)
574
0c773047
SZ
575(defvar rmail-enable-mime-composing nil
576 "*If non-nil, RMAIL uses `rmail-insert-mime-forwarded-message-function' to forward.")
577
9cda36c0
KH
578;;;###autoload
579(defvar rmail-show-mime-function nil
6b59a5fc
GM
580 "Function to show MIME decoded message of RMAIL file.
581This function is called when `rmail-enable-mime' is non-nil.
582It is called with no argument.")
583
584;;;###autoload
585(defvar rmail-insert-mime-forwarded-message-function nil
586 "Function to insert a message in MIME format so it can be forwarded.
67f9d50e 587This function is called if `rmail-enable-mime' or
0c773047 588`rmail-enable-mime-composing' is non-nil.
6b59a5fc
GM
589It is called with one argument FORWARD-BUFFER, which is a
590buffer containing the message to forward. The current buffer
591is the outgoing mail buffer.")
592
9652931f
GM
593;;;###autoload
594(defvar rmail-insert-mime-resent-message-function nil
595 "Function to insert a message in MIME format so it can be resent.
596This function is called if `rmail-enable-mime' is non-nil.
597It is called with one argument FORWARD-BUFFER, which is a
598buffer containing the message to forward. The current buffer
599is the outgoing mail buffer.")
600
6b59a5fc
GM
601;;;###autoload
602(defvar rmail-search-mime-message-function nil
603 "Function to check if a regexp matches a MIME message.
604This function is called if `rmail-enable-mime' is non-nil.
605It is called with two arguments MSG and REGEXP, where
606MSG is the message number, REGEXP is the regular expression.")
607
608;;;###autoload
609(defvar rmail-search-mime-header-function nil
610 "Function to check if a regexp matches a header of MIME message.
611This function is called if `rmail-enable-mime' is non-nil.
c59566eb 612It is called with three arguments MSG, REGEXP, and LIMIT, where
6b59a5fc
GM
613MSG is the message number,
614REGEXP is the regular expression,
615LIMIT is the position specifying the end of header.")
9cda36c0
KH
616
617;;;###autoload
618(defvar rmail-mime-feature 'rmail-mime
c1c92f8b
RS
619 "Feature to require to load MIME support in Rmail.
620When starting Rmail, if `rmail-enable-mime' is non-nil,
d9bf0f5a
KH
621this feature is required with `require'.
622
623The default value is `rmail-mime'. This feature is provided by
624the rmail-mime package available at <http://www.m17n.org/rmail-mime/>.")
aa2d5fe4
RS
625
626;;;###autoload
627(defvar rmail-decode-mime-charset t
628 "*Non-nil means a message is decoded by MIME's charset specification.
629If this variable is nil, or the message has not MIME specification,
630the message is decoded as normal way.
631
632If the variable `rmail-enable-mime' is non-nil, this variables is
633ignored, and all the decoding work is done by a feature specified by
634the variable `rmail-mime-feature'.")
635
636;;;###autoload
637(defvar rmail-mime-charset-pattern
0736daff 638 (concat "^content-type:[ \t]*text/plain;"
3b96a16d 639 "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
4f07f2e8 640 "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?")
aa2d5fe4
RS
641 "Regexp to match MIME-charset specification in a header of message.
642The first parenthesized expression should match the MIME-charset name.")
643
9cda36c0 644\f
4746118a
JB
645;;; Regexp matching the delimiter of messages in UNIX mail format
646;;; (UNIX From lines), minus the initial ^. Note that if you change
647;;; this expression, you must change the code in rmail-nuke-pinhead-header
648;;; that knows the exact ordering of the \\( \\) subexpressions.
46947372 649(defvar rmail-unix-mail-delimiter
b7cceaf1 650 (let ((time-zone-regexp
258b0b37 651 (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
b7cceaf1
JB
652 "\\|[-+]?[0-9][0-9][0-9][0-9]"
653 "\\|"
654 "\\) *")))
655 (concat
656 "From "
657
74d6e31c
RS
658 ;; Many things can happen to an RFC 822 mailbox before it is put into
659 ;; a `From' line. The leading phrase can be stripped, e.g.
660 ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g.
661 ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF
662 ;; can be removed, e.g.
663 ;; From: joe@y.z (Joe K
664 ;; User)
665 ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and
666 ;; From: Joe User
667 ;; <joe@y.z>
668 ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'.
4c4a44f3
PE
669 ;; The mailbox can be removed or be replaced by white space, e.g.
670 ;; From: "Joe User"{space}{tab}
671 ;; <joe@y.z>
672 ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996',
673 ;; where {space} and {tab} represent the Ascii space and tab characters.
74d6e31c
RS
674 ;; We want to match the results of any of these manglings.
675 ;; The following regexp rejects names whose first characters are
676 ;; obviously bogus, but after that anything goes.
4c4a44f3 677 "\\([^\0-\b\n-\r\^?].*\\)? "
b7cceaf1
JB
678
679 ;; The time the message was sent.
74d6e31c
RS
680 "\\([^\0-\r \^?]+\\) +" ; day of the week
681 "\\([^\0-\r \^?]+\\) +" ; month
682 "\\([0-3]?[0-9]\\) +" ; day of month
683 "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
b7cceaf1
JB
684
685 ;; Perhaps a time zone, specified by an abbreviation, or by a
686 ;; numeric offset.
687 time-zone-regexp
688
689 ;; The year.
74d6e31c 690 " \\([0-9][0-9]+\\) *"
b7cceaf1
JB
691
692 ;; On some systems the time zone can appear after the year, too.
693 time-zone-regexp
694
881fd7eb
KH
695 ;; Old uucp cruft.
696 "\\(remote from .*\\)?"
b7cceaf1
JB
697
698 "\n"))
699 nil)
700
926f559c 701(defvar rmail-font-lock-keywords
e68b1cf1 702 ;; These are all matched case-insensitively.
926f559c 703 (eval-when-compile
9cda36c0 704 (let* ((cite-chars "[>|}]")
e68b1cf1 705 (cite-prefix "a-z")
9cda36c0 706 (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
e68b1cf1 707 (list '("^\\(From\\|Sender\\|Resent-From\\):"
926f559c
BG
708 . font-lock-function-name-face)
709 '("^Reply-To:.*$" . font-lock-function-name-face)
710 '("^Subject:" . font-lock-comment-face)
711 '("^X-Spam-Status:" . font-lock-keyword-face)
9cda36c0 712 '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):"
926f559c 713 . font-lock-keyword-face)
9cda36c0
KH
714 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
715 `(,cite-chars
716 (,(concat "\\=[ \t]*"
fc2e9bcb
RS
717 "\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
718 "\\(" cite-chars "[ \t]*\\)\\)+\\)"
9cda36c0
KH
719 "\\(.*\\)")
720 (beginning-of-line) (end-of-line)
fc2e9bcb
RS
721 (1 font-lock-comment-delimiter-face nil t)
722 (5 font-lock-comment-face nil t)))
e68b1cf1 723 '("^\\(X-[a-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$"
926f559c
BG
724 . font-lock-string-face))))
725 "Additional expressions to highlight in Rmail mode.")
9cda36c0 726
bd1f0f84
RS
727;; Perform BODY in the summary buffer
728;; in such a way that its cursor is properly updated in its own window.
729(defmacro rmail-select-summary (&rest body)
b787fc05
GM
730 `(let ((total rmail-total-messages))
731 (if (rmail-summary-displayed)
732 (let ((window (selected-window)))
733 (save-excursion
734 (unwind-protect
735 (progn
736 (pop-to-buffer rmail-summary-buffer)
737 ;; rmail-total-messages is a buffer-local var
738 ;; in the rmail buffer.
739 ;; This way we make it available for the body
740 ;; even tho the rmail buffer is not current.
741 (let ((rmail-total-messages total))
742 ,@body))
743 (select-window window))))
744 (save-excursion
745 (set-buffer rmail-summary-buffer)
746 (let ((rmail-total-messages total))
747 ,@body)))
748 (rmail-maybe-display-summary)))
581d7e0b
RM
749\f
750;;;; *** Rmail Mode ***
751
f90c23ca
GM
752;; This variable is dynamically bound. The defvar is here to placate
753;; the byte compiler.
754
7d862e07
KH
755(defvar rmail-enable-multibyte nil)
756
f90c23ca
GM
757
758(defun rmail-require-mime-maybe ()
759 "Require `rmail-mime-feature' if that is non-nil.
760Signal an error and set `rmail-mime-feature' to nil if the feature
761isn't provided."
762 (when rmail-enable-mime
763 (condition-case err
764 (require rmail-mime-feature)
765 (error
d9bf0f5a
KH
766 (display-warning
767 :warning
768 (format "Although MIME support is requested
769by setting `rmail-enable-mime' to non-nil, the required feature
770`%s' (the value of `rmail-mime-feature')
771is not available in the current session.
772So, the MIME support is turned off for the moment."
773 rmail-mime-feature))
f90c23ca
GM
774 (setq rmail-enable-mime nil)))))
775
776
581d7e0b
RM
777;;;###autoload
778(defun rmail (&optional file-name-arg)
779 "Read and edit incoming mail.
c42722e3 780Moves messages into file named by `rmail-file-name' (a babyl format file)
581d7e0b
RM
781 and edits that file in RMAIL Mode.
782Type \\[describe-mode] once editing that file, for a list of RMAIL commands.
783
d2fc297c
RS
784May be called with file name as argument; then performs rmail editing on
785that file, but does not copy any new mail into the file.
786Interactively, if you supply a prefix argument, then you
a2e667ec
RS
787have a chance to specify a file name with the minibuffer.
788
789If `rmail-display-summary' is non-nil, make a summary for this RMAIL file."
581d7e0b 790 (interactive (if current-prefix-arg
b5e10b23 791 (list (read-file-name "Run rmail on RMAIL file: "))))
f90c23ca 792 (rmail-require-mime-maybe)
581d7e0b 793 (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name)))
85eba339
EZ
794 ;; Use find-buffer-visiting, not get-file-buffer, for those users
795 ;; who have find-file-visit-truename set to t.
796 (existed (find-buffer-visiting file-name))
1bbdda4d 797 ;; This binding is necessary because we must decide if we
55e2a603
KH
798 ;; need code conversion while the buffer is unibyte
799 ;; (i.e. enable-multibyte-characters is nil).
1ed79e41 800 (rmail-enable-multibyte
67f9d50e 801 (if existed
1ed79e41
RS
802 (with-current-buffer existed enable-multibyte-characters)
803 (default-value 'enable-multibyte-characters)))
7d862e07
KH
804 ;; Since the file may contain messages of different encodings
805 ;; at the tail (non-BYBYL part), we can't decode them at once
806 ;; on reading. So, at first, we read the file without text
807 ;; code conversion, then decode the messages one by one by
808 ;; rmail-decode-babyl-format or
809 ;; rmail-convert-to-babyl-format.
810 (coding-system-for-read (and rmail-enable-multibyte 'raw-text))
3ba3fa75 811 run-mail-hook msg-shown)
581d7e0b
RM
812 ;; Like find-file, but in the case where a buffer existed
813 ;; and the file was reverted, recompute the message-data.
078395ab
RS
814 ;; We used to bind enable-local-variables to nil here,
815 ;; but that should not be needed now that rmail-mode
816 ;; sets it locally to nil.
817 ;; (Binding a variable locally with let is not safe if it has
818 ;; buffer-local bindings.)
581d7e0b
RM
819 (if (and existed (not (verify-visited-file-modtime existed)))
820 (progn
078395ab 821 (find-file file-name)
bd1f0f84
RS
822 (if (and (verify-visited-file-modtime existed)
823 (eq major-mode 'rmail-mode))
581d7e0b
RM
824 (progn (rmail-forget-messages)
825 (rmail-set-message-counters))))
67f9d50e 826 (switch-to-buffer
4cc4a962
RS
827 (let ((enable-local-variables nil))
828 (find-file-noselect file-name))))
bd1f0f84 829 (if (eq major-mode 'rmail-edit-mode)
3210e730 830 (error "Exit Rmail Edit mode before getting new mail"))
581d7e0b
RM
831 (if (and existed (> (buffer-size) 0))
832 ;; Buffer not new and not empty; ensure in proper mode, but that's all.
833 (or (eq major-mode 'rmail-mode)
6af28e9f
RS
834 (progn (rmail-mode-2)
835 (setq run-mail-hook t)))
836 (setq run-mail-hook t)
581d7e0b 837 (rmail-mode-2)
581d7e0b
RM
838 ;; Convert all or part to Babyl file if possible.
839 (rmail-convert-file)
b5e00b02 840 (goto-char (point-max)))
e995c415
RS
841 ;; As we have read a file by raw-text, the buffer is set to
842 ;; unibyte. We must make it multibyte if necessary.
843 (if (and rmail-enable-multibyte
844 (not enable-multibyte-characters))
845 (set-buffer-multibyte t))
f4b5ab4c
RS
846 ;; If necessary, scan to find all the messages.
847 (rmail-maybe-set-message-counters)
afc070d1 848 (unwind-protect
b5e00b02
RS
849 (unless (and (not file-name-arg)
850 (rmail-get-new-mail))
851 (rmail-show-message (rmail-first-unseen-message)))
afc070d1
KH
852 (progn
853 (if rmail-display-summary (rmail-summary))
854 (rmail-construct-io-menu)
855 (if run-mail-hook
856 (run-hooks 'rmail-mode-hook))))))
581d7e0b
RM
857
858;; Given the value of MAILPATH, return a list of inbox file names.
859;; This is turned off because it is not clear that the user wants
860;; all these inboxes to feed into the primary rmail file.
861; (defun rmail-convert-mailpath (string)
862; (let (idx list)
863; (while (setq idx (string-match "[%:]" string))
864; (let ((this (substring string 0 idx)))
865; (setq string (substring string (1+ idx)))
866; (setq list (cons (if (string-match "%" this)
867; (substring this 0 (string-match "%" this))
868; this)
869; list))))
870; list))
871
872; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line
873; will not cause emacs 18.55 problems.
874
578b6415
RS
875;; This calls rmail-decode-babyl-format if the file is already Babyl.
876
581d7e0b
RM
877(defun rmail-convert-file ()
878 (let (convert)
879 (widen)
880 (goto-char (point-min))
881 ;; If file doesn't start like a Babyl file,
882 ;; convert it to one, by adding a header and converting each message.
883 (cond ((looking-at "BABYL OPTIONS:"))
884 ((looking-at "Version: 5\n")
885 ;; Losing babyl file made by old version of Rmail.
886 ;; Just fix the babyl file header; don't make a new one,
887 ;; so we don't lose the Labels: file attribute, etc.
888 (let ((buffer-read-only nil))
889 (insert "BABYL OPTIONS: -*- rmail -*-\n")))
760a3528
BF
890 ((equal (point-min) (point-max))
891 ;; Empty RMAIL file. Just insert the header.
892 (rmail-insert-rmail-file-header))
581d7e0b 893 (t
760a3528 894 ;; Non-empty file in non-RMAIL format. Add header and convert.
581d7e0b
RM
895 (setq convert t)
896 (rmail-insert-rmail-file-header)))
897 ;; If file was not a Babyl file or if there are
898 ;; Unix format messages added at the end,
899 ;; convert file as necessary.
900 (if (or convert
e3e87be8
RS
901 (save-excursion
902 (goto-char (point-max))
0b40717e
RS
903 (search-backward "\n\^_")
904 (forward-char 2)
e3e87be8 905 (looking-at "\n*From ")))
581d7e0b
RM
906 (let ((buffer-read-only nil))
907 (message "Converting to Babyl format...")
e3e87be8
RS
908 ;; If file needs conversion, convert it all,
909 ;; except for the BABYL header.
910 ;; (rmail-convert-to-babyl-format would delete the header.)
e3e87be8
RS
911 (goto-char (point-min))
912 (search-forward "\n\^_" nil t)
073fb956 913 (narrow-to-region (point) (point-max))
581d7e0b 914 (rmail-convert-to-babyl-format)
7d862e07
KH
915 (message "Converting to Babyl format...done"))
916 (if (and (not rmail-enable-mime)
917 rmail-enable-multibyte)
918 ;; We still have to decode BABYL part.
919 (rmail-decode-babyl-format)))))
581d7e0b 920
581d7e0b
RM
921(defun rmail-insert-rmail-file-header ()
922 (let ((buffer-read-only nil))
578b6415
RS
923 ;; -*-rmail-*- is here so that visiting the file normally
924 ;; recognizes it as an Rmail file.
581d7e0b
RM
925 (insert "BABYL OPTIONS: -*- rmail -*-
926Version: 5
927Labels:
928Note: This is the header of an rmail file.
929Note: If you are seeing it in rmail,
930Note: it means the file has no messages in it.\n\^_")))
931
95b56cdf 932;; Decode Babyl formatted part at the head of current buffer by
7d862e07 933;; rmail-file-coding-system, or if it is nil, do auto conversion.
d1e69dec
KH
934
935(defun rmail-decode-babyl-format ()
936 (let ((modifiedp (buffer-modified-p))
937 (buffer-read-only nil)
578b6415 938 (coding-system rmail-file-coding-system)
7d862e07 939 from to)
d1e69dec 940 (goto-char (point-min))
578b6415 941 (search-forward "\n\^_" nil t) ; Skip BABYL header.
7d862e07
KH
942 (setq from (point))
943 (goto-char (point-max))
944 (search-backward "\n\^_" from 'mv)
945 (setq to (point))
578b6415
RS
946 (unless (and coding-system
947 (coding-system-p coding-system))
1bbdda4d 948 (setq coding-system
9d2cd7ef
KH
949 ;; If rmail-file-coding-system is nil, Emacs 21 writes
950 ;; RMAIL files in emacs-mule, Emacs 22 in utf-8, but
951 ;; earlier versions did that with the current buffer's
952 ;; encoding. So we want to favor detection of emacs-mule
953 ;; (whose normal priority is quite low) and utf-8, but
954 ;; still allow detection of other encodings if they won't
955 ;; fit. The call to with-coding-priority below achieves
956 ;; that.
957 (with-coding-priority '(emacs-mule utf-8)
958 (detect-coding-region from to 'highest))))
959 (unless (eq (coding-system-type coding-system) 'undecided)
b68a01e7 960 (set-buffer-modified-p t) ; avoid locking when decoding
19032340
RS
961 (let ((buffer-undo-list t))
962 (decode-coding-region from to coding-system))
b68a01e7 963 (setq coding-system last-coding-system-used))
578b6415
RS
964 (set-buffer-modified-p modifiedp)
965 (setq buffer-file-coding-system nil)
966 (setq save-buffer-coding-system
967 (or coding-system 'undecided))))
d1e69dec 968
9cda36c0 969(defvar rmail-mode-map nil)
581d7e0b
RM
970(if rmail-mode-map
971 nil
972 (setq rmail-mode-map (make-keymap))
973 (suppress-keymap rmail-mode-map)
bd1f0f84
RS
974 (define-key rmail-mode-map "a" 'rmail-add-label)
975 (define-key rmail-mode-map "b" 'rmail-bury)
976 (define-key rmail-mode-map "c" 'rmail-continue)
977 (define-key rmail-mode-map "d" 'rmail-delete-forward)
978 (define-key rmail-mode-map "\C-d" 'rmail-delete-backward)
979 (define-key rmail-mode-map "e" 'rmail-edit-current-message)
980 (define-key rmail-mode-map "f" 'rmail-forward)
981 (define-key rmail-mode-map "g" 'rmail-get-new-mail)
982 (define-key rmail-mode-map "h" 'rmail-summary)
983 (define-key rmail-mode-map "i" 'rmail-input)
984 (define-key rmail-mode-map "j" 'rmail-show-message)
985 (define-key rmail-mode-map "k" 'rmail-kill-label)
986 (define-key rmail-mode-map "l" 'rmail-summary-by-labels)
581d7e0b 987 (define-key rmail-mode-map "\e\C-h" 'rmail-summary)
581d7e0b
RM
988 (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels)
989 (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients)
990 (define-key rmail-mode-map "\e\C-s" 'rmail-summary-by-regexp)
bd1f0f84
RS
991 (define-key rmail-mode-map "\e\C-t" 'rmail-summary-by-topic)
992 (define-key rmail-mode-map "m" 'rmail-mail)
993 (define-key rmail-mode-map "\em" 'rmail-retry-failure)
994 (define-key rmail-mode-map "n" 'rmail-next-undeleted-message)
995 (define-key rmail-mode-map "\en" 'rmail-next-message)
996 (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message)
997 (define-key rmail-mode-map "o" 'rmail-output-to-rmail-file)
998 (define-key rmail-mode-map "\C-o" 'rmail-output)
999 (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message)
1000 (define-key rmail-mode-map "\ep" 'rmail-previous-message)
1001 (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message)
1002 (define-key rmail-mode-map "q" 'rmail-quit)
1003 (define-key rmail-mode-map "r" 'rmail-reply)
ed7ace63 1004;; I find I can't live without the default M-r command -- rms.
bd1f0f84
RS
1005;; (define-key rmail-mode-map "\er" 'rmail-search-backwards)
1006 (define-key rmail-mode-map "s" 'rmail-expunge-and-save)
1007 (define-key rmail-mode-map "\es" 'rmail-search)
1008 (define-key rmail-mode-map "t" 'rmail-toggle-header)
1009 (define-key rmail-mode-map "u" 'rmail-undelete-previous-message)
5eb9cf97 1010 (define-key rmail-mode-map "w" 'rmail-output-body-to-file)
bd1f0f84
RS
1011 (define-key rmail-mode-map "x" 'rmail-expunge)
1012 (define-key rmail-mode-map "." 'rmail-beginning-of-message)
3deac4a1 1013 (define-key rmail-mode-map "/" 'rmail-end-of-message)
bd1f0f84
RS
1014 (define-key rmail-mode-map "<" 'rmail-first-message)
1015 (define-key rmail-mode-map ">" 'rmail-last-message)
1016 (define-key rmail-mode-map " " 'scroll-up)
1017 (define-key rmail-mode-map "\177" 'scroll-down)
1018 (define-key rmail-mode-map "?" 'describe-mode)
3bf526cf
RS
1019 (define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date)
1020 (define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject)
1021 (define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author)
1022 (define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient)
1023 (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent)
1024 (define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-lines)
f851a71c 1025 (define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels)
60fb2b34
RS
1026 (define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject)
1027 (define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject)
bd1f0f84 1028 )
5201ddda
RS
1029\f
1030(define-key rmail-mode-map [menu-bar] (make-sparse-keymap))
1031
1032(define-key rmail-mode-map [menu-bar classify]
1033 (cons "Classify" (make-sparse-keymap "Classify")))
1034
4139208e 1035(define-key rmail-mode-map [menu-bar classify input-menu]
8b7ef584 1036 nil)
4139208e
RS
1037
1038(define-key rmail-mode-map [menu-bar classify output-menu]
8b7ef584 1039 nil)
4139208e 1040
5eb9cf97
RS
1041(define-key rmail-mode-map [menu-bar classify output-body]
1042 '("Output body to file..." . rmail-output-body-to-file))
1043
5201ddda 1044(define-key rmail-mode-map [menu-bar classify output-inbox]
37fdc96f 1045 '("Output (inbox)..." . rmail-output))
5201ddda
RS
1046
1047(define-key rmail-mode-map [menu-bar classify output]
37fdc96f 1048 '("Output (Rmail)..." . rmail-output-to-rmail-file))
5201ddda
RS
1049
1050(define-key rmail-mode-map [menu-bar classify kill-label]
37fdc96f 1051 '("Kill Label..." . rmail-kill-label))
5201ddda
RS
1052
1053(define-key rmail-mode-map [menu-bar classify add-label]
37fdc96f 1054 '("Add Label..." . rmail-add-label))
5201ddda
RS
1055
1056(define-key rmail-mode-map [menu-bar summary]
1057 (cons "Summary" (make-sparse-keymap "Summary")))
1058
c0a5a948
RS
1059(define-key rmail-mode-map [menu-bar summary senders]
1060 '("By Senders..." . rmail-summary-by-senders))
1061
5201ddda 1062(define-key rmail-mode-map [menu-bar summary labels]
37fdc96f 1063 '("By Labels..." . rmail-summary-by-labels))
5201ddda
RS
1064
1065(define-key rmail-mode-map [menu-bar summary recipients]
37fdc96f 1066 '("By Recipients..." . rmail-summary-by-recipients))
5201ddda
RS
1067
1068(define-key rmail-mode-map [menu-bar summary topic]
37fdc96f 1069 '("By Topic..." . rmail-summary-by-topic))
5201ddda
RS
1070
1071(define-key rmail-mode-map [menu-bar summary regexp]
37fdc96f 1072 '("By Regexp..." . rmail-summary-by-regexp))
5201ddda
RS
1073
1074(define-key rmail-mode-map [menu-bar summary all]
1075 '("All" . rmail-summary))
1076
1077(define-key rmail-mode-map [menu-bar mail]
1078 (cons "Mail" (make-sparse-keymap "Mail")))
386c099f 1079
5358bc42 1080(define-key rmail-mode-map [menu-bar mail rmail-get-new-mail]
12dd87fc
RS
1081 '("Get New Mail" . rmail-get-new-mail))
1082
1083(define-key rmail-mode-map [menu-bar mail lambda]
6ae1efb4 1084 '("----"))
12dd87fc 1085
5201ddda
RS
1086(define-key rmail-mode-map [menu-bar mail continue]
1087 '("Continue" . rmail-continue))
1088
754b4eb7 1089(define-key rmail-mode-map [menu-bar mail resend]
37fdc96f 1090 '("Re-send..." . rmail-resend))
754b4eb7 1091
5201ddda
RS
1092(define-key rmail-mode-map [menu-bar mail forward]
1093 '("Forward" . rmail-forward))
1094
1095(define-key rmail-mode-map [menu-bar mail retry]
1096 '("Retry" . rmail-retry-failure))
1097
1098(define-key rmail-mode-map [menu-bar mail reply]
1099 '("Reply" . rmail-reply))
1100
1101(define-key rmail-mode-map [menu-bar mail mail]
1102 '("Mail" . rmail-mail))
1103
1104(define-key rmail-mode-map [menu-bar delete]
1105 (cons "Delete" (make-sparse-keymap "Delete")))
1106
1107(define-key rmail-mode-map [menu-bar delete expunge/save]
1108 '("Expunge/Save" . rmail-expunge-and-save))
581d7e0b 1109
5201ddda
RS
1110(define-key rmail-mode-map [menu-bar delete expunge]
1111 '("Expunge" . rmail-expunge))
1112
1113(define-key rmail-mode-map [menu-bar delete undelete]
1114 '("Undelete" . rmail-undelete-previous-message))
1115
1116(define-key rmail-mode-map [menu-bar delete delete]
1117 '("Delete" . rmail-delete-forward))
1118
1119(define-key rmail-mode-map [menu-bar move]
1120 (cons "Move" (make-sparse-keymap "Move")))
1121
1122(define-key rmail-mode-map [menu-bar move search-back]
342aa439 1123 '("Search Back..." . rmail-search-backwards))
5201ddda
RS
1124
1125(define-key rmail-mode-map [menu-bar move search]
37fdc96f 1126 '("Search..." . rmail-search))
5201ddda
RS
1127
1128(define-key rmail-mode-map [menu-bar move previous]
1129 '("Previous Nondeleted" . rmail-previous-undeleted-message))
1130
1131(define-key rmail-mode-map [menu-bar move next]
1132 '("Next Nondeleted" . rmail-next-undeleted-message))
1133
1134(define-key rmail-mode-map [menu-bar move last]
1135 '("Last" . rmail-last-message))
1136
1137(define-key rmail-mode-map [menu-bar move first]
1138 '("First" . rmail-first-message))
1139
1140(define-key rmail-mode-map [menu-bar move previous]
1141 '("Previous" . rmail-previous-message))
1142
1143(define-key rmail-mode-map [menu-bar move next]
1144 '("Next" . rmail-next-message))
1da6a64d
EZ
1145
1146;; Rmail toolbar
1147(defvar rmail-tool-bar-map
1148 (if (display-graphic-p)
1149 (let ((map (make-sparse-keymap)))
1150 (tool-bar-local-item-from-menu 'rmail-get-new-mail "mail/inbox"
1151 map rmail-mode-map)
1152 (tool-bar-local-item-from-menu 'rmail-next-undeleted-message "right-arrow"
1153 map rmail-mode-map)
1154 (tool-bar-local-item-from-menu 'rmail-previous-undeleted-message "left-arrow"
1155 map rmail-mode-map)
1156 (tool-bar-local-item-from-menu 'rmail-search "search"
1157 map rmail-mode-map)
1158 (tool-bar-local-item-from-menu 'rmail-input "open"
1159 map rmail-mode-map)
1160 (tool-bar-local-item-from-menu 'rmail-mail "mail/compose"
1161 map rmail-mode-map)
1162 (tool-bar-local-item-from-menu 'rmail-reply "mail/reply-all"
1163 map rmail-mode-map)
1164 (tool-bar-local-item-from-menu 'rmail-forward "mail/forward"
1165 map rmail-mode-map)
1166 (tool-bar-local-item-from-menu 'rmail-delete-forward "close"
1167 map rmail-mode-map)
1168 (tool-bar-local-item-from-menu 'rmail-output "mail/move"
1169 map rmail-mode-map)
1170 (tool-bar-local-item-from-menu 'rmail-output-body-to-file "mail/save"
1171 map rmail-mode-map)
1172 (tool-bar-local-item-from-menu 'rmail-expunge "delete"
1173 map rmail-mode-map)
1174 map)))
1175
1176
5201ddda 1177\f
581d7e0b
RM
1178;; Rmail mode is suitable only for specially formatted data.
1179(put 'rmail-mode 'mode-class 'special)
1180
3f320f98
RS
1181(defun rmail-mode-kill-summary ()
1182 (if rmail-summary-buffer (kill-buffer rmail-summary-buffer)))
1183
9712b0bd 1184;;;###autoload
581d7e0b
RM
1185(defun rmail-mode ()
1186 "Rmail Mode is used by \\<rmail-mode-map>\\[rmail] for editing Rmail files.
1187All normal editing commands are turned off.
1188Instead, these commands are available:
1189
3deac4a1
EZ
1190\\[rmail-beginning-of-message] Move point to front of this message.
1191\\[rmail-end-of-message] Move point to bottom of this message.
581d7e0b
RM
1192\\[scroll-up] Scroll to next screen of this message.
1193\\[scroll-down] Scroll to previous screen of this message.
1194\\[rmail-next-undeleted-message] Move to Next non-deleted message.
1195\\[rmail-previous-undeleted-message] Move to Previous non-deleted message.
1196\\[rmail-next-message] Move to Next message whether deleted or not.
1197\\[rmail-previous-message] Move to Previous message whether deleted or not.
1198\\[rmail-first-message] Move to the first message in Rmail file.
1199\\[rmail-last-message] Move to the last message in Rmail file.
1200\\[rmail-show-message] Jump to message specified by numeric position in file.
1201\\[rmail-search] Search for string and show message it is found in.
1202\\[rmail-delete-forward] Delete this message, move to next nondeleted.
1203\\[rmail-delete-backward] Delete this message, move to previous nondeleted.
1204\\[rmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages
1205 till a deleted message is found.
bd1f0f84 1206\\[rmail-edit-current-message] Edit the current message. \\[rmail-cease-edit] to return to Rmail.
581d7e0b
RM
1207\\[rmail-expunge] Expunge deleted messages.
1208\\[rmail-expunge-and-save] Expunge and save the file.
1209\\[rmail-quit] Quit Rmail: expunge, save, then switch to another buffer.
1210\\[save-buffer] Save without expunging.
3af9db89 1211\\[rmail-get-new-mail] Move new mail from system spool directory into this file.
581d7e0b
RM
1212\\[rmail-mail] Mail a message (same as \\[mail-other-window]).
1213\\[rmail-continue] Continue composing outgoing message started before.
bd1f0f84
RS
1214\\[rmail-reply] Reply to this message. Like \\[rmail-mail] but initializes some fields.
1215\\[rmail-retry-failure] Send this message again. Used on a mailer failure message.
581d7e0b
RM
1216\\[rmail-forward] Forward this message to another user.
1217\\[rmail-output-to-rmail-file] Output this message to an Rmail file (append it).
1218\\[rmail-output] Output this message to a Unix-format mail file (append it).
74ae80cd 1219\\[rmail-output-body-to-file] Save message body to a file. Default filename comes from Subject line.
581d7e0b
RM
1220\\[rmail-input] Input Rmail file. Run Rmail on that file.
1221\\[rmail-add-label] Add label to message. It will be displayed in the mode line.
1222\\[rmail-kill-label] Kill label. Remove a label from current message.
1223\\[rmail-next-labeled-message] Move to Next message with specified label
1224 (label defaults to last one specified).
1225 Standard labels: filed, unseen, answered, forwarded, deleted.
bd1f0f84 1226 Any other label is present only if you add it with \\[rmail-add-label].
581d7e0b
RM
1227\\[rmail-previous-labeled-message] Move to Previous message with specified label
1228\\[rmail-summary] Show headers buffer, with a one line summary of each message.
bd1f0f84
RS
1229\\[rmail-summary-by-labels] Summarize only messages with particular label(s).
1230\\[rmail-summary-by-recipients] Summarize only messages with particular recipient(s).
1231\\[rmail-summary-by-regexp] Summarize only messages with particular regexp(s).
1232\\[rmail-summary-by-topic] Summarize only messages with subject line regexp(s).
1233\\[rmail-toggle-header] Toggle display of complete header."
581d7e0b 1234 (interactive)
f90c23ca
GM
1235 (let ((finding-rmail-file (not (eq major-mode 'rmail-mode))))
1236 (rmail-mode-2)
1237 (when (and finding-rmail-file
1238 (null coding-system-for-read)
1239 default-enable-multibyte-characters)
1240 (let ((rmail-enable-multibyte t))
1241 (rmail-require-mime-maybe)
1242 (rmail-convert-file)
1243 (goto-char (point-max))
1244 (set-buffer-multibyte t)))
1245 (rmail-set-message-counters)
1246 (rmail-show-message rmail-total-messages)
1247 (when finding-rmail-file
1248 (when rmail-display-summary
1249 (rmail-summary))
1250 (rmail-construct-io-menu))
6f9402eb 1251 (run-mode-hooks 'rmail-mode-hook)))
581d7e0b
RM
1252
1253(defun rmail-mode-2 ()
1254 (kill-all-local-variables)
1255 (rmail-mode-1)
9cda36c0 1256 (rmail-perm-variables)
6af28e9f 1257 (rmail-variables))
581d7e0b
RM
1258
1259(defun rmail-mode-1 ()
1260 (setq major-mode 'rmail-mode)
1261 (setq mode-name "RMAIL")
1262 (setq buffer-read-only t)
876cd689
RS
1263 ;; No need to auto save RMAIL files in normal circumstances
1264 ;; because they contain no info except attribute changes
1265 ;; and deletion of messages.
1266 ;; The one exception is when messages are copied into an Rmail mode buffer.
1267 ;; rmail-output-to-rmail-file enables auto save when you do that.
581d7e0b 1268 (setq buffer-auto-save-file-name nil)
e823bfa3 1269 (setq mode-line-modified "--")
581d7e0b
RM
1270 (use-local-map rmail-mode-map)
1271 (set-syntax-table text-mode-syntax-table)
1272 (setq local-abbrev-table text-mode-abbrev-table))
1273
9cda36c0
KH
1274;; Set up the permanent locals associated with an Rmail file.
1275(defun rmail-perm-variables ()
581d7e0b 1276 (make-local-variable 'rmail-last-label)
bd1f0f84 1277 (make-local-variable 'rmail-last-regexp)
581d7e0b 1278 (make-local-variable 'rmail-deleted-vector)
d1e69dec
KH
1279 (make-local-variable 'rmail-buffer)
1280 (setq rmail-buffer (current-buffer))
1281 (make-local-variable 'rmail-view-buffer)
1282 (setq rmail-view-buffer rmail-buffer)
581d7e0b
RM
1283 (make-local-variable 'rmail-summary-buffer)
1284 (make-local-variable 'rmail-summary-vector)
1285 (make-local-variable 'rmail-current-message)
1286 (make-local-variable 'rmail-total-messages)
24db549c
RS
1287 (make-local-variable 'rmail-overlay-list)
1288 (setq rmail-overlay-list nil)
581d7e0b 1289 (make-local-variable 'rmail-message-vector)
0985b412 1290 (make-local-variable 'rmail-msgref-vector)
581d7e0b
RM
1291 (make-local-variable 'rmail-inbox-list)
1292 (setq rmail-inbox-list (rmail-parse-file-inboxes))
849056cc
RS
1293 ;; Provide default set of inboxes for primary mail file ~/RMAIL.
1294 (and (null rmail-inbox-list)
6cd37f8f 1295 (or (equal buffer-file-name (expand-file-name rmail-file-name))
a38837b5
RS
1296 (equal buffer-file-truename
1297 (abbreviate-file-name (file-truename rmail-file-name))))
849056cc
RS
1298 (setq rmail-inbox-list
1299 (or rmail-primary-inbox-list
1300 (list (or (getenv "MAIL")
1301 (concat rmail-spool-directory
d0eecffa 1302 (user-login-name)))))))
581d7e0b 1303 (make-local-variable 'rmail-keywords)
1da6a64d 1304 (set (make-local-variable 'tool-bar-map) rmail-tool-bar-map)
581d7e0b 1305 ;; this gets generated as needed
6016579d 1306 (setq rmail-keywords nil))
581d7e0b 1307
9cda36c0
KH
1308;; Set up the non-permanent locals associated with Rmail mode.
1309(defun rmail-variables ()
578b6415
RS
1310 (make-local-variable 'save-buffer-coding-system)
1311 ;; If we don't already have a value for save-buffer-coding-system,
1312 ;; get it from buffer-file-coding-system, and clear that
1313 ;; because it should be determined in rmail-show-message.
1314 (unless save-buffer-coding-system
1315 (setq save-buffer-coding-system (or buffer-file-coding-system 'undecided))
1316 (setq buffer-file-coding-system nil))
9cda36c0 1317 ;; Don't let a local variables list in a message cause confusion.
4cc4a962
RS
1318 (make-local-variable 'local-enable-local-variables)
1319 (setq local-enable-local-variables nil)
9cda36c0
KH
1320 (make-local-variable 'revert-buffer-function)
1321 (setq revert-buffer-function 'rmail-revert)
1322 (make-local-variable 'font-lock-defaults)
1323 (setq font-lock-defaults
578b6415 1324 '(rmail-font-lock-keywords
e68b1cf1 1325 t t nil nil
578b6415
RS
1326 (font-lock-maximum-size . nil)
1327 (font-lock-fontify-buffer-function . rmail-fontify-buffer-function)
1328 (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function)
1329 (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
9cda36c0
KH
1330 (make-local-variable 'require-final-newline)
1331 (setq require-final-newline nil)
1332 (make-local-variable 'version-control)
1333 (setq version-control 'never)
1334 (make-local-variable 'kill-buffer-hook)
1335 (add-hook 'kill-buffer-hook 'rmail-mode-kill-summary)
1336 (make-local-variable 'file-precious-flag)
2b5f7b7f
LH
1337 (setq file-precious-flag t)
1338 (make-local-variable 'desktop-save-buffer)
1339 (setq desktop-save-buffer t))
9cda36c0 1340
581d7e0b
RM
1341;; Handle M-x revert-buffer done in an rmail-mode buffer.
1342(defun rmail-revert (arg noconfirm)
9652931f 1343 (set-buffer rmail-buffer)
1ed79e41
RS
1344 (let* ((revert-buffer-function (default-value 'revert-buffer-function))
1345 (rmail-enable-multibyte enable-multibyte-characters)
1346 ;; See similar code in `rmail'.
1347 (coding-system-for-read (and rmail-enable-multibyte 'raw-text)))
581d7e0b
RM
1348 ;; Call our caller again, but this time it does the default thing.
1349 (if (revert-buffer arg noconfirm)
1350 ;; If the user said "yes", and we changed something,
1351 ;; reparse the messages.
3210e730 1352 (progn
9652931f
GM
1353 (set-buffer rmail-buffer)
1354 (rmail-mode-2)
1ed79e41 1355 ;; Convert all or part to Babyl file if possible.
581d7e0b 1356 (rmail-convert-file)
1ed79e41
RS
1357 ;; We have read the file as raw-text, so the buffer is set to
1358 ;; unibyte. Make it multibyte if necessary.
1359 (if (and rmail-enable-multibyte
1360 (not enable-multibyte-characters))
1361 (set-buffer-multibyte t))
581d7e0b 1362 (goto-char (point-max))
1ed79e41
RS
1363 (rmail-set-message-counters)
1364 (rmail-show-message rmail-total-messages)
1365 (run-hooks 'rmail-mode-hook)))))
581d7e0b
RM
1366
1367;; Return a list of files from this buffer's Mail: option.
1368;; Does not assume that messages have been parsed.
1369;; Just returns nil if buffer does not look like Babyl format.
1370(defun rmail-parse-file-inboxes ()
1371 (save-excursion
1372 (save-restriction
1373 (widen)
1374 (goto-char 1)
1375 (cond ((looking-at "BABYL OPTIONS:")
1376 (search-forward "\n\^_" nil 'move)
1377 (narrow-to-region 1 (point))
1378 (goto-char 1)
1379 (if (search-forward "\nMail:" nil t)
1380 (progn
1381 (narrow-to-region (point) (progn (end-of-line) (point)))
1382 (goto-char (point-min))
1383 (mail-parse-comma-list))))))))
1384
1385(defun rmail-expunge-and-save ()
1386 "Expunge and save RMAIL file."
1387 (interactive)
1388 (rmail-expunge)
6b59a5fc 1389 (set-buffer rmail-buffer)
c7065819
KH
1390 (save-buffer)
1391 (if (rmail-summary-exists)
1392 (rmail-select-summary (set-buffer-modified-p nil))))
581d7e0b
RM
1393
1394(defun rmail-quit ()
dd5ee393
RS
1395 "Quit out of RMAIL.
1396Hook `rmail-quit-hook' is run after expunging."
581d7e0b
RM
1397 (interactive)
1398 (rmail-expunge-and-save)
dd5ee393
RS
1399 (when (boundp 'rmail-quit-hook)
1400 (run-hooks 'rmail-quit-hook))
581d7e0b 1401 ;; Don't switch to the summary buffer even if it was recently visible.
df211784
RS
1402 (when rmail-summary-buffer
1403 (replace-buffer-in-windows rmail-summary-buffer)
1404 (bury-buffer rmail-summary-buffer))
6b59a5fc
GM
1405 (if rmail-enable-mime
1406 (let ((obuf rmail-buffer)
1407 (ovbuf rmail-view-buffer))
1408 (set-buffer rmail-view-buffer)
1409 (quit-window)
1410 (replace-buffer-in-windows ovbuf)
1411 (replace-buffer-in-windows obuf)
1412 (bury-buffer obuf))
1413 (let ((obuf (current-buffer)))
1414 (quit-window)
1415 (replace-buffer-in-windows obuf))))
581d7e0b 1416
a16aef15
RS
1417(defun rmail-bury ()
1418 "Bury current Rmail buffer and its summary buffer."
1419 (interactive)
1420 ;; This let var was called rmail-buffer, but that interfered
1421 ;; with the buffer-local var used in summary buffers.
1422 (let ((buffer-to-bury (current-buffer)))
1423 (if (rmail-summary-exists)
1424 (let (window)
1425 (while (setq window (get-buffer-window rmail-summary-buffer))
df211784 1426 (quit-window nil window))
a16aef15 1427 (bury-buffer rmail-summary-buffer)))
df211784 1428 (quit-window)))
a16aef15
RS
1429
1430(defun rmail-duplicate-message ()
1431 "Create a duplicated copy of the current message.
1432The duplicate copy goes into the Rmail file just after the
1433original copy."
1434 (interactive)
1435 (widen)
1436 (let ((buffer-read-only nil)
1437 (number rmail-current-message)
1438 (string (buffer-substring (rmail-msgbeg rmail-current-message)
1439 (rmail-msgend rmail-current-message))))
1440 (goto-char (rmail-msgend rmail-current-message))
1441 (insert string)
1442 (rmail-forget-messages)
1443 (rmail-show-message number)
1444 (message "Message duplicated")))
1445
581d7e0b
RM
1446;;;###autoload
1447(defun rmail-input (filename)
bd1f0f84 1448 "Run Rmail on file FILENAME."
581d7e0b
RM
1449 (interactive "FRun rmail on RMAIL file: ")
1450 (rmail filename))
1451
563ab60d
RS
1452
1453;; This used to scan subdirectories recursively, but someone pointed out
1454;; that if the user wants that, person can put all the files in one dir.
1455;; And the recursive scan was slow. So I took it out.
1456;; rms, Sep 1996.
8b7ef584 1457(defun rmail-find-all-files (start)
563ab60d 1458 "Return list of file in dir START that match `rmail-secondary-file-regexp'."
8b7ef584 1459 (if (file-accessible-directory-p start)
1529a12f 1460 ;; Don't sort here.
563ab60d
RS
1461 (let* ((case-fold-search t)
1462 (files (directory-files start t rmail-secondary-file-regexp)))
1529a12f
RS
1463 ;; Sort here instead of in directory-files
1464 ;; because this list is usually much shorter.
563ab60d 1465 (sort files 'string<))))
8b7ef584
RS
1466
1467(defun rmail-list-to-menu (menu-name l action &optional full-name)
1468 (let ((menu (make-sparse-keymap menu-name)))
5701a0ce 1469 (mapc
8b7ef584 1470 (function (lambda (item)
bc8661ca
RS
1471 (let (command)
1472 (if (consp item)
1473 (progn
1474 (setq command
67f9d50e
FP
1475 (rmail-list-to-menu (car item) (cdr item)
1476 action
bc8661ca
RS
1477 (if full-name
1478 (concat full-name "/"
1479 (car item))
1480 (car item))))
1481 (setq name (car item)))
8b7ef584 1482 (progn
bc8661ca 1483 (setq name item)
67f9d50e 1484 (setq command
bc8661ca
RS
1485 (list 'lambda () '(interactive)
1486 (list action
67f9d50e 1487 (expand-file-name
bc8661ca
RS
1488 (if full-name
1489 (concat full-name "/" item)
1490 item)
1491 rmail-secondary-file-directory))))))
1492 (define-key menu (vector (intern name))
1493 (cons name command)))))
1529a12f 1494 (reverse l))
8b7ef584 1495 menu))
67f9d50e 1496
1529a12f
RS
1497;; This command is always "disabled" when it appears in a menu.
1498(put 'rmail-disable-menu 'menu-enable ''nil)
1499
8b7ef584
RS
1500(defun rmail-construct-io-menu ()
1501 (let ((files (rmail-find-all-files rmail-secondary-file-directory)))
1529a12f 1502 (if files
8b7ef584
RS
1503 (progn
1504 (define-key rmail-mode-map [menu-bar classify input-menu]
67f9d50e
FP
1505 (cons "Input Rmail File"
1506 (rmail-list-to-menu "Input Rmail File"
1529a12f 1507 files
8b7ef584
RS
1508 'rmail-input)))
1509 (define-key rmail-mode-map [menu-bar classify output-menu]
67f9d50e
FP
1510 (cons "Output Rmail File"
1511 (rmail-list-to-menu "Output Rmail File"
1529a12f
RS
1512 files
1513 'rmail-output-to-rmail-file))))
1514
1515 (define-key rmail-mode-map [menu-bar classify input-menu]
1516 '("Input Rmail File" . rmail-disable-menu))
1517 (define-key rmail-mode-map [menu-bar classify output-menu]
1518 '("Output Rmail File" . rmail-disable-menu)))))
90254bb0 1519
581d7e0b
RM
1520\f
1521;;;; *** Rmail input ***
1522
73e72da4
DN
1523(declare-function rmail-spam-filter "rmail-spam-filter" (msg))
1524(declare-function rmail-summary-goto-msg "rmailsum" (&optional n nowarn skip-rmail))
1525(declare-function rmail-summary-mark-undeleted "rmailsum" (n))
1526(declare-function rmail-summary-mark-deleted "rmailsum" (&optional n undel))
1527(declare-function rfc822-addresses "rfc822" (header-text))
1528(declare-function mail-abbrev-make-syntax-table "mailabbrev.el" ())
1529(declare-function mail-sendmail-delimit-header "sendmail" ())
1530(declare-function mail-header-end "sendmail" ())
1531
581d7e0b
RM
1532;; RLK feature not added in this version:
1533;; argument specifies inbox file or files in various ways.
1534
1535(defun rmail-get-new-mail (&optional file-name)
1536 "Move any new mail from this RMAIL file's inbox files.
1537The inbox files can be specified with the file's Mail: option. The
1538variable `rmail-primary-inbox-list' specifies the inboxes for your
3af9db89
RS
1539primary RMAIL file if it has no Mail: option. By default, this is
1540your /usr/spool/mail/$USER.
581d7e0b
RM
1541
1542You can also specify the file to get new mail from. In this case, the
1543file of new mail is not changed or deleted. Noninteractively, you can
1544pass the inbox file name as an argument. Interactively, a prefix
38e76742
RS
1545argument causes us to read a file name and use that file as the inbox.
1546
4144e5cb
RS
1547If the variable `rmail-preserve-inbox' is non-nil, new mail will
1548always be left in inbox files rather than deleted.
1549
bcddd52e
RS
1550This function runs `rmail-get-new-mail-hook' before saving the updated file.
1551It returns t if it got any new messages."
581d7e0b
RM
1552 (interactive
1553 (list (if current-prefix-arg
1554 (read-file-name "Get new mail from file: "))))
1d08d733 1555 (run-hooks 'rmail-before-get-new-mail-hook)
3f3495d3
RS
1556 ;; If the disk file has been changed from under us,
1557 ;; revert to it before we get new mail.
581d7e0b 1558 (or (verify-visited-file-modtime (current-buffer))
3f3495d3 1559 (find-file (buffer-file-name)))
6b59a5fc 1560 (set-buffer rmail-buffer)
581d7e0b
RM
1561 (rmail-maybe-set-message-counters)
1562 (widen)
1563 ;; Get rid of all undo records for this buffer.
1564 (or (eq buffer-undo-list t)
1565 (setq buffer-undo-list nil))
563ab60d 1566 (let ((all-files (if file-name (list file-name)
3ba3fa75 1567 rmail-inbox-list))
7d862e07 1568 (rmail-enable-multibyte (default-value 'enable-multibyte-characters))
3ba3fa75 1569 found)
563ab60d 1570 (unwind-protect
3ba3fa75 1571 (progn
9a10bd0d
KH
1572 (while all-files
1573 (let ((opoint (point))
1574 (new-messages 0)
608aa380 1575 (rsf-number-of-spam 0)
9a10bd0d
KH
1576 (delete-files ())
1577 ;; If buffer has not changed yet, and has not been saved yet,
1578 ;; don't replace the old backup file now.
1579 (make-backup-files (and make-backup-files (buffer-modified-p)))
1580 (buffer-read-only nil)
1581 ;; Don't make undo records for what we do in getting mail.
1582 (buffer-undo-list t)
1583 success
1584 ;; Files to insert this time around.
1585 files
1586 ;; Last names of those files.
1587 file-last-names)
1588 ;; Pull files off all-files onto files
1589 ;; as long as there is no name conflict.
1590 ;; A conflict happens when two inbox file names
1591 ;; have the same last component.
1592 (while (and all-files
1593 (not (member (file-name-nondirectory (car all-files))
1594 file-last-names)))
1595 (setq files (cons (car all-files) files)
1596 file-last-names
1597 (cons (file-name-nondirectory (car all-files)) files))
1598 (setq all-files (cdr all-files)))
1599 ;; Put them back in their original order.
1600 (setq files (nreverse files))
1601
1602 (goto-char (point-max))
1603 (skip-chars-backward " \t\n") ; just in case of brain damage
1604 (delete-region (point) (point-max)) ; caused by require-final-newline
1605 (save-excursion
1606 (save-restriction
1607 (narrow-to-region (point) (point))
1608 ;; Read in the contents of the inbox files,
1609 ;; renaming them as necessary,
1610 ;; and adding to the list of files to delete eventually.
1611 (if file-name
1612 (rmail-insert-inbox-text files nil)
1613 (setq delete-files (rmail-insert-inbox-text files t)))
1614 ;; Scan the new text and convert each message to babyl format.
1615 (goto-char (point-min))
1616 (unwind-protect
1617 (save-excursion
1618 (setq new-messages (rmail-convert-to-babyl-format)
1619 success t))
c317dd93
RS
1620 ;; Try to delete the garbage just inserted.
1621 (or success (delete-region (point-min) (point-max)))
9a10bd0d
KH
1622 ;; If we could not convert the file's inboxes,
1623 ;; rename the files we tried to read
1624 ;; so we won't over and over again.
1625 (if (and (not file-name) (not success))
1626 (let ((delfiles delete-files)
1627 (count 0))
1628 (while delfiles
1629 (while (file-exists-p (format "RMAILOSE.%d" count))
1630 (setq count (1+ count)))
1631 (rename-file (car delfiles)
1632 (format "RMAILOSE.%d" count))
1633 (setq delfiles (cdr delfiles))))))
1634 (or (zerop new-messages)
1635 (let (success)
1636 (widen)
1637 (search-backward "\n\^_" nil t)
1638 (narrow-to-region (point) (point-max))
1639 (goto-char (1+ (point-min)))
1640 (rmail-count-new-messages)
1641 (run-hooks 'rmail-get-new-mail-hook)
1642 (save-buffer)))
1643 ;; Delete the old files, now that babyl file is saved.
1644 (while delete-files
1645 (condition-case ()
1646 ;; First, try deleting.
1647 (condition-case ()
1648 (delete-file (car delete-files))
1649 (file-error
1650 ;; If we can't delete it, truncate it.
1651 (write-region (point) (point) (car delete-files))))
1652 (file-error nil))
1653 (setq delete-files (cdr delete-files)))))
1654 (if (= new-messages 0)
1655 (progn (goto-char opoint)
1656 (if (or file-name rmail-inbox-list)
1657 (message "(No new mail has arrived)")))
608aa380
KH
1658 ;; check new messages to see if any of them is spam:
1659 (if (and (featurep 'rmail-spam-filter)
1660 rmail-use-spam-filter)
1661 (let*
1662 ((old-messages (- rmail-total-messages new-messages))
1663 (rsf-scanned-message-number (1+ old-messages))
1664 ;; save deletion flags of old messages: vector starts
1665 ;; at zero (is one longer that no of messages),
1666 ;; therefore take 1+ old-messages
1667 (save-deleted
1668 (substring rmail-deleted-vector 0 (1+
1669 old-messages))))
1670 ;; set all messages to undeleted
1671 (setq rmail-deleted-vector
1672 (make-string (1+ rmail-total-messages) ?\ ))
1673 (while (<= rsf-scanned-message-number
1674 rmail-total-messages)
1675 (progn
1676 (if (not (rmail-spam-filter rsf-scanned-message-number))
1677 (progn (setq rsf-number-of-spam (1+ rsf-number-of-spam)))
1678 )
1679 (setq rsf-scanned-message-number (1+ rsf-scanned-message-number))
1680 ))
1681 (if (> rsf-number-of-spam 0)
1682 (progn
1683 (when (rmail-expunge-confirmed)
1684 (rmail-only-expunge t))
1685 ))
1686 (setq rmail-deleted-vector
1687 (concat
1688 save-deleted
1689 (make-string (- rmail-total-messages old-messages)
1690 ?\ )))
1691 ))
1692 (if (rmail-summary-exists)
9a10bd0d
KH
1693 (rmail-select-summary
1694 (rmail-update-summary)))
608aa380
KH
1695 (message "%d new message%s read%s"
1696 new-messages (if (= 1 new-messages) "" "s")
1697 ;; print out a message on number of spam messages found:
1698 (if (and (featurep 'rmail-spam-filter)
1699 rmail-use-spam-filter
1700 (> rsf-number-of-spam 0))
ee1d889f
RS
1701 (cond ((= 1 new-messages)
1702 ", and appears to be spam")
1703 ((= rsf-number-of-spam new-messages)
1704 ", and all appear to be spam")
1705 ((> rsf-number-of-spam 1)
1706 (format ", and %d appear to be spam"
1707 rsf-number-of-spam))
1708 (t
1709 ", and 1 appears to be spam"))
608aa380
KH
1710 ""))
1711 (if (and (featurep 'rmail-spam-filter)
1712 rmail-use-spam-filter
1713 (> rsf-number-of-spam 0))
f431a910
EZ
1714 (progn (if rsf-beep (beep t))
1715 (sleep-for rsf-sleep-after-message)))
608aa380 1716
9a10bd0d
KH
1717 ;; Move to the first new message
1718 ;; unless we have other unseen messages before it.
1719 (rmail-show-message (rmail-first-unseen-message))
1720 (run-hooks 'rmail-after-get-new-mail-hook)
1721 (setq found t))))
1722 found)
563ab60d 1723 ;; Don't leave the buffer screwed up if we get a disk-full error.
3ba3fa75 1724 (or found (rmail-show-message)))))
581d7e0b 1725
1086788e
EZ
1726(defun rmail-parse-url (file)
1727 "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD)
1728WHERE MAILBOX-NAME is the name of the mailbox suitable as argument to the
1729actual version of `movemail', REMOTE is non-nil if MAILBOX-NAME refers to
1730a remote mailbox, PASSWORD is the password if it should be
1731supplied as a separate argument to `movemail' or nil otherwise, GOT-PASSWORD
1732is non-nil if the user has supplied the password interactively.
1733"
2f2e2373
EZ
1734 (cond
1735 ((string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file)
bf247b6e 1736 (let (got-password supplied-password
1086788e
EZ
1737 (proto (match-string 1 file))
1738 (user (match-string 3 file))
1739 (pass (match-string 5 file))
1740 (host (substring file (or (match-end 2)
1741 (+ 3 (match-end 1))))))
e84b4b86 1742
1086788e
EZ
1743 (if (not pass)
1744 (when rmail-remote-password-required
1745 (setq got-password (not (rmail-have-password)))
1746 (setq supplied-password (rmail-get-remote-password
1747 (string-equal proto "imap")))))
bf247b6e 1748
1086788e
EZ
1749 (if (rmail-movemail-variant-p 'emacs)
1750 (if (string-equal proto "pop")
1751 (list (concat "po:" user ":" host)
1752 t
1753 (or pass supplied-password)
1754 got-password)
1755 (error "Emacs movemail does not support %s protocol" proto))
1756 (list file
1757 (or (string-equal proto "pop") (string-equal proto "imap"))
1758 supplied-password
2f2e2373 1759 got-password))))
e84b4b86 1760
2f2e2373
EZ
1761 ((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file)
1762 (let (got-password supplied-password
1763 (proto "pop")
1764 (user (match-string 1 file))
1765 (host (match-string 3 file)))
e84b4b86 1766
2f2e2373
EZ
1767 (when rmail-remote-password-required
1768 (setq got-password (not (rmail-have-password)))
1769 (setq supplied-password (rmail-get-remote-password nil)))
1770
1771 (list file "pop" supplied-password got-password)))
e84b4b86 1772
2f2e2373
EZ
1773 (t
1774 (list file nil nil nil))))
1086788e 1775
581d7e0b 1776(defun rmail-insert-inbox-text (files renamep)
563ab60d
RS
1777 ;; Detect a locked file now, so that we avoid moving mail
1778 ;; out of the real inbox file. (That could scare people.)
1779 (or (memq (file-locked-p buffer-file-name) '(nil t))
1780 (error "RMAIL file %s is locked"
1781 (file-name-nondirectory buffer-file-name)))
639540ec 1782 (let (file tofile delete-files movemail popmail got-password password)
581d7e0b 1783 (while files
1086788e 1784 ;; Handle remote mailbox names specially; don't expand as filenames
1f0402c3
AI
1785 ;; in case the userid contains a directory separator.
1786 (setq file (car files))
1086788e
EZ
1787 (let ((url-data (rmail-parse-url file)))
1788 (setq file (nth 0 url-data))
1789 (setq popmail (nth 1 url-data))
1790 (setq password (nth 2 url-data))
1791 (setq got-password (nth 3 url-data)))
1792
1f0402c3
AI
1793 (if popmail
1794 (setq renamep t)
1795 (setq file (file-truename
3a85a179 1796 (substitute-in-file-name (expand-file-name file)))))
1f0402c3 1797 (setq tofile (expand-file-name
ec3bba39
RS
1798 ;; Generate name to move to from inbox name,
1799 ;; in case of multiple inboxes that need moving.
1086788e 1800 (concat ".newmail-"
bf247b6e 1801 (file-name-nondirectory
1086788e
EZ
1802 (if (memq system-type '(windows-nt cygwin))
1803 ;; cannot have "po:" in file name
1804 (substring file 3)
1805 file)))
ec3bba39
RS
1806 ;; Use the directory of this rmail file
1807 ;; because it's a nuisance to use the homedir
1808 ;; if that is on a full disk and this rmail
1809 ;; file isn't.
1810 (file-name-directory
1811 (expand-file-name buffer-file-name))))
1812 ;; Always use movemail to rename the file,
1813 ;; since there can be mailboxes in various directories.
2f2e2373 1814 (if (not popmail)
581d7e0b 1815 (progn
581d7e0b
RM
1816 ;; On some systems, /usr/spool/mail/foo is a directory
1817 ;; and the actual inbox is /usr/spool/mail/foo/foo.
1818 (if (file-directory-p file)
d0eecffa 1819 (setq file (expand-file-name (user-login-name)
581d7e0b 1820 file)))))
8095bf23 1821 (cond (popmail
1086788e 1822 (message "Getting mail from the remote server ..."))
8095bf23
RS
1823 ((and (file-exists-p tofile)
1824 (/= 0 (nth 7 (file-attributes tofile))))
1825 (message "Getting mail from %s..." tofile))
1826 ((and (file-exists-p file)
1827 (/= 0 (nth 7 (file-attributes file))))
1828 (message "Getting mail from %s..." file)))
581d7e0b
RM
1829 ;; Set TOFILE if have not already done so, and
1830 ;; rename or copy the file FILE to TOFILE if and as appropriate.
1831 (cond ((not renamep)
1832 (setq tofile file))
bd1f0f84
RS
1833 ((or (file-exists-p tofile) (and (not popmail)
1834 (not (file-exists-p file))))
581d7e0b 1835 nil)
581d7e0b 1836 (t
1086788e
EZ
1837 (with-temp-buffer
1838 (let ((errors (current-buffer)))
1839 (buffer-disable-undo errors)
1840 (let ((args
1841 (append
11bdb42c 1842 (list rmail-movemail-program nil errors nil)
1086788e
EZ
1843 (if rmail-preserve-inbox
1844 (list "-p")
1845 nil)
1846 (if (rmail-movemail-variant-p 'mailutils)
1847 (append (list "--emacs") rmail-movemail-flags)
1848 rmail-movemail-flags)
1849 (list file tofile)
1850 (if password (list password) nil))))
1851 (apply 'call-process args))
1852 (if (not (buffer-modified-p errors))
1853 ;; No output => movemail won
1854 nil
1855 (set-buffer errors)
1856 (subst-char-in-region (point-min) (point-max)
1857 ?\n ?\ )
1858 (goto-char (point-max))
1859 (skip-chars-backward " \t")
1860 (delete-region (point) (point-max))
1861 (goto-char (point-min))
1862 (if (looking-at "movemail: ")
1863 (delete-region (point-min) (match-end 0)))
1864 (beep t)
1865 ;; If we just read the password, most likely it is
1866 ;; wrong. Otherwise, see if there is a specific
1867 ;; reason to think that the problem is a wrong passwd.
1868 (if (or got-password
1869 (re-search-forward rmail-remote-password-error
1870 nil t))
1871 (rmail-set-remote-password nil))
1872
1873 ;; If using Mailutils, remove initial error code
1874 ;; abbreviation
1875 (when (rmail-movemail-variant-p 'mailutils)
1876 (goto-char (point-min))
1877 (when (looking-at "[A-Z][A-Z0-9_]*:")
1878 (delete-region (point-min) (match-end 0))))
bf247b6e 1879
1086788e
EZ
1880 (message "movemail: %s"
1881 (buffer-substring (point-min)
1882 (point-max)))
bf247b6e 1883
1086788e
EZ
1884 (sit-for 3)
1885 nil)))))
bf247b6e 1886
581d7e0b
RM
1887 ;; At this point, TOFILE contains the name to read:
1888 ;; Either the alternate name (if we renamed)
1889 ;; or the actual inbox (if not renaming).
1890 (if (file-exists-p tofile)
d1e69dec
KH
1891 (let ((coding-system-for-read 'no-conversion)
1892 size)
581d7e0b 1893 (goto-char (point-max))
d1e69dec 1894 (setq size (nth 1 (insert-file-contents tofile)))
581d7e0b
RM
1895 (goto-char (point-max))
1896 (or (= (preceding-char) ?\n)
1897 (zerop size)
1898 (insert ?\n))
4144e5cb
RS
1899 (if (not (and rmail-preserve-inbox (string= file tofile)))
1900 (setq delete-files (cons tofile delete-files)))))
581d7e0b
RM
1901 (message "")
1902 (setq files (cdr files)))
1903 delete-files))
1904
aa2d5fe4
RS
1905;; Decode the region specified by FROM and TO by CODING.
1906;; If CODING is nil or an invalid coding system, decode by `undecided'.
1907(defun rmail-decode-region (from to coding)
1908 (if (or (not coding) (not (coding-system-p coding)))
1909 (setq coding 'undecided))
8a60950d
EZ
1910 ;; Use -dos decoding, to remove ^M characters left from base64 or
1911 ;; rogue qp-encoded text.
1912 (decode-coding-region from to
1913 (coding-system-change-eol-conversion coding 1))
1914 ;; Don't reveal the fact we used -dos decoding, as users generally
1915 ;; will not expect the RMAIL buffer to use DOS EOL format.
1916 (setq buffer-file-coding-system
1917 (setq last-coding-system-used
1918 (coding-system-change-eol-conversion coding 0))))
aa2d5fe4 1919
581d7e0b
RM
1920;; the rmail-break-forwarded-messages feature is not implemented
1921(defun rmail-convert-to-babyl-format ()
1922 (let ((count 0) start
b77ab9e8 1923 (case-fold-search nil)
ee1d889f 1924 (buffer-undo-list t)
b77ab9e8
RS
1925 (invalid-input-resync
1926 (function (lambda ()
1927 (message "Invalid Babyl format in inbox!")
563ab60d 1928 (sit-for 3)
b77ab9e8
RS
1929 ;; Try to get back in sync with a real message.
1930 (if (re-search-forward
95b597ce 1931 (concat rmail-mmdf-delim1 "\\|^From") nil t)
b77ab9e8
RS
1932 (beginning-of-line)
1933 (goto-char (point-max)))))))
581d7e0b
RM
1934 (goto-char (point-min))
1935 (save-restriction
1936 (while (not (eobp))
d1e69dec 1937 (setq start (point))
19e2f1bf 1938 (cond ((looking-at "BABYL OPTIONS:") ;Babyl header
b77ab9e8
RS
1939 (if (search-forward "\n\^_" nil t)
1940 ;; If we find the proper terminator, delete through there.
1941 (delete-region (point-min) (point))
1942 (funcall invalid-input-resync)
a553316b 1943 (delete-region (point-min) (point))))
581d7e0b
RM
1944 ;; Babyl format message
1945 ((looking-at "\^L")
1946 (or (search-forward "\n\^_" nil t)
b77ab9e8 1947 (funcall invalid-input-resync))
581d7e0b
RM
1948 (setq count (1+ count))
1949 ;; Make sure there is no extra white space after the ^_
1950 ;; at the end of the message.
1951 ;; Narrowing will make sure that whatever follows the junk
1952 ;; will be treated properly.
1953 (delete-region (point)
1954 (save-excursion
1955 (skip-chars-forward " \t\n")
1956 (point)))
19e2f1bf
MR
1957 ;; The following let* form was wrapped in a `save-excursion'
1958 ;; which in one case caused infinite looping, see:
1959 ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00968.html
1960 ;; Removing that form leaves `point' at the end of the
1961 ;; region decoded by `rmail-decode-region' which should
1962 ;; be correct.
1963 (let* ((header-end
1964 (progn
608aa380
KH
1965 (save-excursion
1966 (goto-char start)
19e2f1bf
MR
1967 (forward-line 1)
1968 (if (looking-at "0")
1969 (forward-line 1)
1970 (forward-line 2))
1971 (save-restriction
1972 (narrow-to-region (point) (point-max))
1973 (rfc822-goto-eoh)
1974 (point)))))
1975 (case-fold-search t)
1976 (quoted-printable-header-field-end
608aa380 1977 (save-excursion
19e2f1bf
MR
1978 (goto-char start)
1979 (re-search-forward
1980 "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
1981 header-end t)))
1982 (base64-header-field-end
608aa380 1983 (save-excursion
19e2f1bf
MR
1984 (goto-char start)
1985 ;; Don't try to decode non-text data.
1986 (and (re-search-forward
1987 "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/"
1988 header-end t)
1989 (goto-char start)
1990 (re-search-forward
1991 "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*"
1992 header-end t)))))
1993 (if quoted-printable-header-field-end
1994 (save-excursion
1995 (unless
1996 (mail-unquote-printable-region header-end (point) nil t t)
1997 (message "Malformed MIME quoted-printable message"))
1998 ;; Change "quoted-printable" to "8bit",
1999 ;; to reflect the decoding we just did.
2000 (goto-char quoted-printable-header-field-end)
2001 (delete-region (point) (search-backward ":"))
2002 (insert ": 8bit")))
2003 (if base64-header-field-end
2004 (save-excursion
2005 (when
2006 (condition-case nil
2007 (progn
2008 (base64-decode-region (1+ header-end)
2009 (- (point) 2))
2010 t)
2011 (error nil))
2012 ;; Change "base64" to "8bit", to reflect the
2013 ;; decoding we just did.
2014 (goto-char base64-header-field-end)
2015 (delete-region (point) (search-backward ":"))
2016 (insert ": 8bit"))))
2017 (setq last-coding-system-used nil)
2018 (or rmail-enable-mime
2019 (not rmail-enable-multibyte)
2020 (let ((mime-charset
2021 (if (and rmail-decode-mime-charset
2022 (save-excursion
2023 (goto-char start)
2024 (search-forward "\n\n" nil t)
2025 (let ((case-fold-search t))
2026 (re-search-backward
2027 rmail-mime-charset-pattern
2028 start t))))
2029 (intern (downcase (match-string 1))))))
2030 (rmail-decode-region start (point) mime-charset))))
578b6415
RS
2031 ;; Add an X-Coding-System: header if we don't have one.
2032 (save-excursion
2033 (goto-char start)
2034 (forward-line 1)
2035 (if (looking-at "0")
2036 (forward-line 1)
2037 (forward-line 2))
2038 (or (save-restriction
2039 (narrow-to-region (point) (point-max))
2040 (rfc822-goto-eoh)
2041 (goto-char (point-min))
2042 (re-search-forward "^X-Coding-System:" nil t))
2043 (insert "X-Coding-System: "
2044 (symbol-name last-coding-system-used)
2045 "\n")))
608aa380
KH
2046 (narrow-to-region (point) (point-max))
2047 (and (= 0 (% count 10))
2048 (message "Converting to Babyl format...%d" count)))
581d7e0b
RM
2049 ;;*** MMDF format
2050 ((let ((case-fold-search t))
95b597ce 2051 (looking-at rmail-mmdf-delim1))
581d7e0b
RM
2052 (let ((case-fold-search t))
2053 (replace-match "\^L\n0, unseen,,\n*** EOOH ***\n")
95b597ce 2054 (re-search-forward rmail-mmdf-delim2 nil t)
581d7e0b
RM
2055 (replace-match "\^_"))
2056 (save-excursion
2057 (save-restriction
2058 (narrow-to-region start (1- (point)))
2059 (goto-char (point-min))
19e2f1bf
MR
2060 (while (search-forward "\n\^_" nil t) ; single char "\^_"
2061 (replace-match "\n^_")))) ; 2 chars: "^" and "_"
578b6415 2062 (setq last-coding-system-used nil)
d1e69dec 2063 (or rmail-enable-mime
7d862e07 2064 (not rmail-enable-multibyte)
426591c3 2065 (decode-coding-region start (point) 'undecided))
578b6415
RS
2066 (save-excursion
2067 (goto-char start)
2068 (forward-line 3)
2069 (insert "X-Coding-System: "
2070 (symbol-name last-coding-system-used)
2071 "\n"))
581d7e0b 2072 (narrow-to-region (point) (point-max))
608aa380
KH
2073 (setq count (1+ count))
2074 (and (= 0 (% count 10))
2075 (message "Converting to Babyl format...%d" count)))
581d7e0b
RM
2076 ;;*** Mail format
2077 ((looking-at "^From ")
581d7e0b
RM
2078 (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
2079 (rmail-nuke-pinhead-header)
bd1f0f84
RS
2080 ;; If this message has a Content-Length field,
2081 ;; skip to the end of the contents.
2082 (let* ((header-end (save-excursion
2083 (and (re-search-forward "\n\n" nil t)
a865e55b 2084 (1- (point)))))
bd1f0f84 2085 (case-fold-search t)
ae9f695f
KH
2086 (quoted-printable-header-field-end
2087 (save-excursion
ae9f695f 2088 (re-search-forward
4877ba13 2089 "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
ae9f695f 2090 header-end t)))
608aa380 2091 (base64-header-field-end
db0821c8 2092 (and
5c43b3ca 2093 ;; Don't decode non-text data.
db0821c8
EZ
2094 (save-excursion
2095 (re-search-forward
5c43b3ca 2096 "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/"
db0821c8 2097 header-end t))
db0821c8
EZ
2098 (save-excursion
2099 (re-search-forward
5c43b3ca 2100 "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*"
db0821c8 2101 header-end t))))
bd1f0f84
RS
2102 (size
2103 ;; Get the numeric value from the Content-Length field.
2104 (save-excursion
2105 ;; Back up to end of prev line,
2106 ;; in case the Content-Length field comes first.
2107 (forward-char -1)
2108 (and (search-forward "\ncontent-length: "
2109 header-end t)
2110 (let ((beg (point))
2111 (eol (progn (end-of-line) (point))))
027a4b6b 2112 (string-to-number (buffer-substring beg eol)))))))
5458f7f1
KH
2113 (and size
2114 (if (and (natnump size)
2115 (<= (+ header-end size) (point-max))
2116 ;; Make sure this would put us at a position
2117 ;; that we could continue from.
2118 (save-excursion
2119 (goto-char (+ header-end size))
2120 (skip-chars-forward "\n")
2121 (or (eobp)
2122 (and (looking-at "BABYL OPTIONS:")
2123 (search-forward "\n\^_" nil t))
2124 (and (looking-at "\^L")
2125 (search-forward "\n\^_" nil t))
2126 (let ((case-fold-search t))
95b597ce 2127 (looking-at rmail-mmdf-delim1))
5458f7f1
KH
2128 (looking-at "From "))))
2129 (goto-char (+ header-end size))
2130 (message "Ignoring invalid Content-Length field")
ae9f695f 2131 (sit-for 1 0 t)))
a4e19cc2
RS
2132 (if (let ((case-fold-search nil))
2133 (re-search-forward
2134 (concat "^[\^_]?\\("
2135 rmail-unix-mail-delimiter
2136 "\\|"
2137 rmail-mmdf-delim1 "\\|"
2138 "^BABYL OPTIONS:\\|"
2139 "\^L\n[01],\\)") nil t))
ae9f695f
KH
2140 (goto-char (match-beginning 1))
2141 (goto-char (point-max)))
2142 (setq count (1+ count))
2143 (if quoted-printable-header-field-end
2144 (save-excursion
608aa380 2145 (unless
6b61353c 2146 (mail-unquote-printable-region header-end (point) nil t t)
608aa380 2147 (message "Malformed MIME quoted-printable message"))
ae9f695f
KH
2148 ;; Change "quoted-printable" to "8bit",
2149 ;; to reflect the decoding we just did.
2150 (goto-char quoted-printable-header-field-end)
4877ba13 2151 (delete-region (point) (search-backward ":"))
608aa380
KH
2152 (insert ": 8bit")))
2153 (if base64-header-field-end
2154 (save-excursion
2155 (when
2156 (condition-case nil
2157 (progn
2158 (base64-decode-region
2159 (1+ header-end)
2160 (save-excursion
2161 ;; Prevent base64-decode-region
2162 ;; from removing newline characters.
2163 (skip-chars-backward "\n\t ")
2164 (point)))
2165 t)
2166 (error nil))
608aa380
KH
2167 ;; Change "base64" to "8bit", to reflect the
2168 ;; decoding we just did.
2169 (goto-char base64-header-field-end)
2170 (delete-region (point) (search-backward ":"))
2171 (insert ": 8bit")))))
ae9f695f 2172
581d7e0b
RM
2173 (save-excursion
2174 (save-restriction
2175 (narrow-to-region start (point))
2176 (goto-char (point-min))
19e2f1bf
MR
2177 (while (search-forward "\n\^_" nil t) ; single char
2178 (replace-match "\n^_")))) ; 2 chars: "^" and "_"
6b61353c
KH
2179 ;; This is for malformed messages that don't end in newline.
2180 ;; There shouldn't be any, but some users say occasionally
2181 ;; there are some.
2182 (or (bolp) (newline))
581d7e0b 2183 (insert ?\^_)
578b6415 2184 (setq last-coding-system-used nil)
d1e69dec 2185 (or rmail-enable-mime
7d862e07 2186 (not rmail-enable-multibyte)
aa2d5fe4
RS
2187 (let ((mime-charset
2188 (if (and rmail-decode-mime-charset
2189 (save-excursion
2190 (goto-char start)
2191 (search-forward "\n\n" nil t)
2192 (let ((case-fold-search t))
2193 (re-search-backward
2194 rmail-mime-charset-pattern
2195 start t))))
3b96a16d 2196 (intern (downcase (match-string 1))))))
aa2d5fe4 2197 (rmail-decode-region start (point) mime-charset)))
578b6415
RS
2198 (save-excursion
2199 (goto-char start)
2200 (forward-line 3)
2201 (insert "X-Coding-System: "
2202 (symbol-name last-coding-system-used)
2203 "\n"))
608aa380
KH
2204 (narrow-to-region (point) (point-max))
2205 (and (= 0 (% count 10))
2206 (message "Converting to Babyl format...%d" count)))
581d7e0b 2207 ;;
8896f2df
RS
2208 ;; This kludge is because some versions of sendmail.el
2209 ;; insert an extra newline at the beginning that shouldn't
2210 ;; be there. sendmail.el has been fixed, but old versions
2211 ;; may still be in use. -- rms, 7 May 1993.
2212 ((eolp) (delete-char 1))
a553316b 2213 (t (error "Cannot convert to babyl format")))))
ee1d889f 2214 (setq buffer-undo-list nil)
581d7e0b
RM
2215 count))
2216
2217;; Delete the "From ..." line, creating various other headers with
2218;; information from it if they don't already exist. Now puts the
c42722e3
RS
2219;; original line into a mail-from: header line for debugging and for
2220;; use by the rmail-output function.
581d7e0b
RM
2221(defun rmail-nuke-pinhead-header ()
2222 (save-excursion
2223 (save-restriction
2224 (let ((start (point))
2225 (end (progn
2226 (condition-case ()
2227 (search-forward "\n\n")
2228 (error
2229 (goto-char (point-max))
2230 (insert "\n\n")))
2231 (point)))
2232 has-from has-date)
2233 (narrow-to-region start end)
2234 (let ((case-fold-search t))
2235 (goto-char start)
2236 (setq has-from (search-forward "\nFrom:" nil t))
2237 (goto-char start)
2238 (setq has-date (and (search-forward "\nDate:" nil t) (point)))
2239 (goto-char start))
2240 (let ((case-fold-search nil))
46947372 2241 (if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t)
581d7e0b
RM
2242 (replace-match
2243 (concat
2244 "Mail-from: \\&"
2245 ;; Keep and reformat the date if we don't
2246 ;; have a Date: field.
2247 (if has-date
2248 ""
b7cceaf1 2249 (concat
74d6e31c 2250 "Date: \\2, \\4 \\3 \\9 \\5 "
67f9d50e 2251
b7cceaf1
JB
2252 ;; The timezone could be matched by group 7 or group 10.
2253 ;; If neither of them matched, assume EST, since only
2254 ;; Easterners would be so sloppy.
2255 ;; It's a shame the substitution can't use "\\10".
2256 (cond
2257 ((/= (match-beginning 7) (match-end 7)) "\\7")
2258 ((/= (match-beginning 10) (match-end 10))
2259 (buffer-substring (match-beginning 10)
2260 (match-end 10)))
2261 (t "EST"))
2262 "\n"))
581d7e0b
RM
2263 ;; Keep and reformat the sender if we don't
2264 ;; have a From: field.
2265 (if has-from
2266 ""
15a36ac5
RS
2267 "From: \\1\n"))
2268 t)))))))
581d7e0b
RM
2269\f
2270;;;; *** Rmail Message Formatting and Header Manipulation ***
2271
2272(defun rmail-reformat-message (beg end)
2273 (goto-char beg)
2274 (forward-line 1)
2275 (if (/= (following-char) ?0)
55535639 2276 (error "Bad format in RMAIL file"))
ed104a87 2277 (let ((inhibit-read-only t)
581d7e0b
RM
2278 (delta (- (buffer-size) end)))
2279 (delete-char 1)
2280 (insert ?1)
2281 (forward-line 1)
15a36ac5 2282 (let ((case-fold-search t))
c42722e3
RS
2283 (while (looking-at "Summary-line:\\|Mail-From:")
2284 (forward-line 1)))
581d7e0b
RM
2285 (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n")
2286 (delete-region (point)
2287 (progn (forward-line 1) (point))))
2288 (let ((str (buffer-substring (point)
2289 (save-excursion (search-forward "\n\n" end 'move)
2290 (point)))))
2291 (insert str "*** EOOH ***\n")
2292 (narrow-to-region (point) (- (buffer-size) delta)))
2293 (goto-char (point-min))
423c0dfa 2294 (if rmail-message-filter (funcall rmail-message-filter))
8095bf23
RS
2295 (if (or rmail-displayed-headers rmail-ignored-headers)
2296 (rmail-clear-headers))))
581d7e0b 2297
3db0cdac 2298(defun rmail-clear-headers (&optional ignored-headers)
8095bf23
RS
2299 "Delete all header fields that Rmail should not show.
2300If the optional argument IGNORED-HEADERS is non-nil,
2301delete all header fields whose names match that regexp.
2302Otherwise, if `rmail-displayed-headers' is non-nil,
2303delete all header fields *except* those whose names match that regexp.
5b9b5b89
RS
2304Otherwise, delete all header fields whose names match `rmail-ignored-headers'
2305unless they also match `rmail-nonignored-headers'."
f92f70bc
RS
2306 (when (search-forward "\n\n" nil t)
2307 (forward-char -1)
2308 (let ((case-fold-search t)
2309 (buffer-read-only nil))
2310 (if (and rmail-displayed-headers (null ignored-headers))
d155ff18
RS
2311 (save-restriction
2312 (narrow-to-region (point-min) (point))
2313 (let (lim next)
2314 (goto-char (point-min))
2315 (while (and (not (eobp))
2316 (save-excursion
2317 (if (re-search-forward "\n[^ \t]" nil t)
2318 (setq lim (match-beginning 0)
2319 next (1+ lim))
2320 (setq lim nil next (point-max)))))
2321 (if (save-excursion
2322 (re-search-forward rmail-displayed-headers lim t))
2323 (goto-char next)
2324 (delete-region (point) next))))
2325 (goto-char (point-min)))
f92f70bc
RS
2326 (or ignored-headers (setq ignored-headers rmail-ignored-headers))
2327 (save-restriction
2328 (narrow-to-region (point-min) (point))
5b9b5b89 2329 (goto-char (point-min))
bdbeb193 2330 (while (and ignored-headers
5b9b5b89 2331 (re-search-forward ignored-headers nil t))
f92f70bc 2332 (beginning-of-line)
be16d955
BG
2333 (if (and rmail-nonignored-headers
2334 (looking-at rmail-nonignored-headers))
5b9b5b89
RS
2335 (forward-line 1)
2336 (delete-region (point)
2337 (save-excursion
2338 (if (re-search-forward "\n[^ \t]" nil t)
2339 (1- (point))
2340 (point-max)))))))))))
581d7e0b 2341
dbf71ee9 2342(defun rmail-msg-is-pruned ()
581d7e0b 2343 (rmail-maybe-set-message-counters)
dbf71ee9 2344 (save-restriction
903e09b7 2345 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
dbf71ee9 2346 (save-excursion
903e09b7
RS
2347 (goto-char (point-min))
2348 (forward-line 1)
dbf71ee9
RS
2349 (= (following-char) ?1))))
2350
157521c5 2351(defun rmail-msg-restore-non-pruned-header ()
ed104a87
RS
2352 (let ((old-point (point))
2353 new-point
2354 new-start
2355 (inhibit-read-only t))
2356 (save-excursion
2357 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
157521c5
GM
2358 (goto-char (point-min))
2359 (forward-line 1)
2360 ;; Change 1 to 0.
2361 (delete-char 1)
2362 (insert ?0)
2363 ;; Insert new EOOH line at the proper place.
2364 (forward-line 1)
2365 (let ((case-fold-search t))
2366 (while (looking-at "Summary-Line:\\|Mail-From:")
2367 (forward-line 1)))
2368 (insert "*** EOOH ***\n")
2369 (setq new-start (point))
2370 ;; Delete the old reformatted header.
2371 (forward-char -1)
2372 (search-forward "\n*** EOOH ***\n")
2373 (forward-line -1)
2374 (let ((start (point)))
2375 (search-forward "\n\n")
ed104a87
RS
2376 (if (and (<= start old-point)
2377 (<= old-point (point)))
2378 (setq new-point new-start))
157521c5
GM
2379 (delete-region start (point)))
2380 ;; Narrow to after the new EOOH line.
ed104a87
RS
2381 (narrow-to-region new-start (point-max)))
2382 (if new-point
2383 (goto-char new-point))))
157521c5
GM
2384
2385(defun rmail-msg-prune-header ()
ed104a87
RS
2386 (let ((new-point
2387 (= (point) (point-min))))
2388 (save-excursion
2389 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
2390 (rmail-reformat-message (point-min) (point-max)))
2391 (if new-point
2392 (goto-char (point-min)))))
157521c5 2393
dbf71ee9
RS
2394(defun rmail-toggle-header (&optional arg)
2395 "Show original message header if pruned header currently shown, or vice versa.
2396With argument ARG, show the message header pruned if ARG is greater than zero;
2397otherwise, show it in full."
2398 (interactive "P")
157521c5
GM
2399 (let* ((pruned (with-current-buffer rmail-buffer
2400 (rmail-msg-is-pruned)))
6a91b84a
KH
2401 (prune (if arg
2402 (> (prefix-numeric-value arg) 0)
2403 (not pruned))))
2404 (if (eq pruned prune)
2405 t
157521c5 2406 (set-buffer rmail-buffer)
6a91b84a 2407 (rmail-maybe-set-message-counters)
157521c5
GM
2408 (if rmail-enable-mime
2409 (let ((buffer-read-only nil))
2410 (if pruned
2411 (rmail-msg-restore-non-pruned-header)
2412 (rmail-msg-prune-header))
2413 (funcall rmail-show-mime-function))
2414 (let* ((buffer-read-only nil)
2415 (window (get-buffer-window (current-buffer)))
2416 (at-point-min (= (point) (point-min)))
2417 (all-headers-visible (= (window-start window) (point-min)))
2418 (on-header
2419 (save-excursion
2420 (and (not (search-backward "\n\n" nil t))
2421 (progn
2422 (end-of-line)
2423 (re-search-backward "^[-A-Za-z0-9]+:" nil t))
2424 (match-string 0))))
2425 (old-screen-line
2426 (rmail-count-screen-lines (window-start window) (point))))
f4b5ab4c 2427 (if pruned
157521c5
GM
2428 (rmail-msg-restore-non-pruned-header)
2429 (rmail-msg-prune-header))
2430 (cond (at-point-min
2431 (goto-char (point-min)))
2432 (on-header
2433 (goto-char (point-min))
2434 (search-forward "\n\n")
2435 (or (re-search-backward
2436 (concat "^" (regexp-quote on-header)) nil t)
2437 (goto-char (point-min))))
2438 (t
2439 (save-selected-window
2440 (select-window window)
2441 (recenter old-screen-line)
2442 (if (and all-headers-visible
2443 (not (= (window-start) (point-min))))
9d43f6f1 2444 (recenter (- (window-height) 2))))))))
6a91b84a
KH
2445 (rmail-highlight-headers))))
2446
ed104a87
RS
2447(defun rmail-narrow-to-non-pruned-header ()
2448 "Narrow to the whole (original) header of the current message."
2449 (let (start end)
2450 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
2451 (goto-char (point-min))
2452 (forward-line 1)
2453 (if (= (following-char) ?1)
2454 (progn
2455 (forward-line 1)
2456 (setq start (point))
2457 (search-forward "*** EOOH ***\n")
2458 (setq end (match-beginning 0)))
2459 (forward-line 2)
2460 (setq start (point))
2461 (search-forward "\n\n")
2462 (setq end (1- (point))))
2463 (narrow-to-region start end)
2464 (goto-char start)))
2465
6a91b84a
KH
2466;; Lifted from repos-count-screen-lines.
2467;; Return number of screen lines between START and END.
2468(defun rmail-count-screen-lines (start end)
72f69d0f 2469 (save-excursion
6a91b84a
KH
2470 (save-restriction
2471 (narrow-to-region start end)
2472 (goto-char (point-min))
2473 (vertical-motion (- (point-max) (point-min))))))
581d7e0b
RM
2474\f
2475;;;; *** Rmail Attributes and Keywords ***
2476
2477;; Make a string describing current message's attributes and keywords
2478;; and set it up as the name of a minor mode
2479;; so it will appear in the mode line.
2480(defun rmail-display-labels ()
2481 (let ((blurb "") (beg (point-min-marker)) (end (point-max-marker)))
2482 (save-excursion
2483 (unwind-protect
2484 (progn
2485 (widen)
2486 (goto-char (rmail-msgbeg rmail-current-message))
2487 (forward-line 1)
2488 (if (looking-at "[01],")
2489 (progn
2490 (narrow-to-region (point) (progn (end-of-line) (point)))
2491 ;; Truly valid BABYL format requires a space before each
2492 ;; attribute or keyword name. Put them in if missing.
2493 (let (buffer-read-only)
2494 (goto-char (point-min))
2495 (while (search-forward "," nil t)
2496 (or (looking-at "[ ,]") (eobp)
2497 (insert " "))))
2498 (goto-char (point-max))
2499 (if (search-backward ",," nil 'move)
2500 (progn
2501 (if (> (point) (1+ (point-min)))
2502 (setq blurb (buffer-substring (+ 1 (point-min)) (point))))
2503 (if (> (- (point-max) (point)) 2)
2504 (setq blurb
2505 (concat blurb
2506 ";"
2507 (buffer-substring (+ (point) 3)
2508 (1- (point-max)))))))))))
2509 ;; Note: we don't use save-restriction because that does not work right
2510 ;; if changes are made outside the saved restriction
2511 ;; before that restriction is restored.
2512 (narrow-to-region beg end)
2513 (set-marker beg nil)
2514 (set-marker end nil)))
2515 (while (string-match " +," blurb)
2516 (setq blurb (concat (substring blurb 0 (match-beginning 0)) ","
2517 (substring blurb (match-end 0)))))
2518 (while (string-match ", +" blurb)
2519 (setq blurb (concat (substring blurb 0 (match-beginning 0)) ","
2520 (substring blurb (match-end 0)))))
2521 (setq mode-line-process
8095bf23 2522 (format " %d/%d%s"
6b59a5fc
GM
2523 rmail-current-message rmail-total-messages blurb))
2524 ;; If rmail-enable-mime is non-nil, we may have to update
2525 ;; `mode-line-process' of rmail-view-buffer too.
2526 (if (and rmail-enable-mime
2527 (not (eq (current-buffer) rmail-view-buffer))
2528 (buffer-live-p rmail-view-buffer))
2529 (let ((mlp mode-line-process))
2530 (with-current-buffer rmail-view-buffer
2531 (setq mode-line-process mlp))))))
581d7e0b
RM
2532
2533;; Turn an attribute of a message on or off according to STATE.
2534;; ATTR is the name of the attribute, as a string.
2535;; MSGNUM is message number to change; nil means current message.
2536(defun rmail-set-attribute (attr state &optional msgnum)
6b59a5fc 2537 (set-buffer rmail-buffer)
581d7e0b
RM
2538 (let ((omax (point-max-marker))
2539 (omin (point-min-marker))
2540 (buffer-read-only nil))
2541 (or msgnum (setq msgnum rmail-current-message))
708bfd4f
RS
2542 (if (> msgnum 0)
2543 (unwind-protect
2544 (save-excursion
2545 (widen)
2546 (goto-char (+ 3 (rmail-msgbeg msgnum)))
2547 (let ((curstate
2548 (not
2549 (null (search-backward (concat ", " attr ",")
2550 (prog1 (point) (end-of-line)) t)))))
2551 (or (eq curstate (not (not state)))
2552 (if curstate
2553 (delete-region (point) (1- (match-end 0)))
2554 (beginning-of-line)
2555 (forward-char 2)
2556 (insert " " attr ","))))
2557 (if (string= attr "deleted")
2558 (rmail-set-message-deleted-p msgnum state)))
2559 ;; Note: we don't use save-restriction because that does not work right
2560 ;; if changes are made outside the saved restriction
2561 ;; before that restriction is restored.
2562 (narrow-to-region omin omax)
2563 (set-marker omin nil)
2564 (set-marker omax nil)
2565 (if (= msgnum rmail-current-message)
2566 (rmail-display-labels))))))
581d7e0b
RM
2567
2568;; Return t if the attributes/keywords line of msg number MSG
2569;; contains a match for the regexp LABELS.
2570(defun rmail-message-labels-p (msg labels)
2571 (save-excursion
2572 (save-restriction
2573 (widen)
2574 (goto-char (rmail-msgbeg msg))
2575 (forward-char 3)
2576 (re-search-backward labels (prog1 (point) (end-of-line)) t))))
2577\f
2578;;;; *** Rmail Message Selection And Support ***
2579
2580(defun rmail-msgend (n)
2581 (marker-position (aref rmail-message-vector (1+ n))))
2582
2583(defun rmail-msgbeg (n)
2584 (marker-position (aref rmail-message-vector n)))
2585
2586(defun rmail-widen-to-current-msgbeg (function)
2587 "Call FUNCTION with point at start of internal data of current message.
2588Assumes that bounds were previously narrowed to display the message in Rmail.
2589The bounds are widened enough to move point where desired, then narrowed
2590again afterward.
2591
2592FUNCTION may not change the visible text of the message, but it may
2593change the invisible header text."
2594 (save-excursion
07ae0d66
GM
2595 (unwind-protect
2596 (progn
2597 (narrow-to-region (rmail-msgbeg rmail-current-message)
2598 (point-max))
2599 (goto-char (point-min))
2600 (funcall function))
581d7e0b
RM
2601 ;; Note: we don't use save-restriction because that does not work right
2602 ;; if changes are made outside the saved restriction
2603 ;; before that restriction is restored.
07ae0d66
GM
2604 (narrow-to-region (rmail-msgbeg rmail-current-message)
2605 (rmail-msgend rmail-current-message)))))
581d7e0b
RM
2606
2607(defun rmail-forget-messages ()
2608 (unwind-protect
2609 (if (vectorp rmail-message-vector)
2610 (let* ((i 0)
2611 (v rmail-message-vector)
2612 (n (length v)))
2613 (while (< i n)
2614 (move-marker (aref v i) nil)
2615 (setq i (1+ i)))))
2616 (setq rmail-message-vector nil)
0985b412 2617 (setq rmail-msgref-vector nil)
581d7e0b
RM
2618 (setq rmail-deleted-vector nil)))
2619
2620(defun rmail-maybe-set-message-counters ()
2621 (if (not (and rmail-deleted-vector
2622 rmail-message-vector
2623 rmail-current-message
2624 rmail-total-messages))
2625 (rmail-set-message-counters)))
2626
2627(defun rmail-count-new-messages (&optional nomsg)
2628 (let* ((case-fold-search nil)
2629 (total-messages 0)
2630 (messages-head nil)
2631 (deleted-head nil))
2632 (or nomsg (message "Counting new messages..."))
2633 (goto-char (point-max))
2634 ;; Put at the end of messages-head
2635 ;; the entry for message N+1, which marks
2636 ;; the end of message N. (N = number of messages).
2637 (search-backward "\n\^_")
2638 (forward-char 1)
2639 (setq messages-head (list (point-marker)))
2640 (rmail-set-message-counters-counter (point-min))
2641 (setq rmail-current-message (1+ rmail-total-messages))
2642 (setq rmail-total-messages
2643 (+ rmail-total-messages total-messages))
2644 (setq rmail-message-vector
2645 (vconcat rmail-message-vector (cdr messages-head)))
2646 (aset rmail-message-vector
2647 rmail-current-message (car messages-head))
2648 (setq rmail-deleted-vector
2649 (concat rmail-deleted-vector deleted-head))
2650 (setq rmail-summary-vector
2651 (vconcat rmail-summary-vector (make-vector total-messages nil)))
0985b412
RS
2652 (setq rmail-msgref-vector
2653 (vconcat rmail-msgref-vector (make-vector total-messages nil)))
2654 ;; Fill in the new elements of rmail-msgref-vector.
79d8d8d5 2655 (let ((i (1+ (- rmail-total-messages total-messages))))
0985b412
RS
2656 (while (<= i rmail-total-messages)
2657 (aset rmail-msgref-vector i (list i))
2658 (setq i (1+ i))))
581d7e0b
RM
2659 (goto-char (point-min))
2660 (or nomsg (message "Counting new messages...done (%d)" total-messages))))
2661
2662(defun rmail-set-message-counters ()
2663 (rmail-forget-messages)
2664 (save-excursion
2665 (save-restriction
2666 (widen)
2667 (let* ((point-save (point))
2668 (total-messages 0)
2669 (messages-after-point)
2670 (case-fold-search nil)
2671 (messages-head nil)
2672 (deleted-head nil))
2673 (message "Counting messages...")
2674 (goto-char (point-max))
2675 ;; Put at the end of messages-head
2676 ;; the entry for message N+1, which marks
2677 ;; the end of message N. (N = number of messages).
cf805d5d
RS
2678 (search-backward "\n\^_" nil t)
2679 (if (/= (point) (point-max)) (forward-char 1))
581d7e0b
RM
2680 (setq messages-head (list (point-marker)))
2681 (rmail-set-message-counters-counter (min (point) point-save))
2682 (setq messages-after-point total-messages)
2683 (rmail-set-message-counters-counter)
2684 (setq rmail-total-messages total-messages)
2685 (setq rmail-current-message
2686 (min total-messages
2687 (max 1 (- total-messages messages-after-point))))
2688 (setq rmail-message-vector
2689 (apply 'vector (cons (point-min-marker) messages-head))
2c0b1898 2690 rmail-deleted-vector (concat "0" deleted-head)
0985b412
RS
2691 rmail-summary-vector (make-vector rmail-total-messages nil)
2692 rmail-msgref-vector (make-vector (1+ rmail-total-messages) nil))
2693 (let ((i 0))
2694 (while (<= i rmail-total-messages)
2695 (aset rmail-msgref-vector i (list i))
2696 (setq i (1+ i))))
581d7e0b 2697 (message "Counting messages...done")))))
67f9d50e 2698
581d7e0b 2699(defun rmail-set-message-counters-counter (&optional stop)
582e5ff7
AI
2700 (let ((start (point))
2701 next)
2702 (while (search-backward "\n\^_\^L" stop t)
2703 ;; Detect messages that have been added with DOS line endings and
2704 ;; convert the line endings for such messages.
2705 (setq next (point))
2706 (if (looking-at "\n\^_\^L\r\n")
2707 (let ((buffer-read-only nil)
2708 (buffer-undo t))
2709 (message "Counting messages...(converting line endings)")
2710 (save-excursion
2711 (goto-char start)
2712 (while (search-backward "\r\n" next t)
2713 (delete-char 1)))))
2714 (setq start next)
2715 (forward-char 1)
2716 (setq messages-head (cons (point-marker) messages-head))
2717 (save-excursion
2718 (setq deleted-head
2719 (cons (if (search-backward ", deleted,"
2720 (prog1 (point)
2721 (forward-line 2))
2722 t)
2723 ?D ?\ )
2724 deleted-head)))
2725 (if (zerop (% (setq total-messages (1+ total-messages)) 20))
2726 (message "Counting messages...%d" total-messages)))))
581d7e0b
RM
2727
2728(defun rmail-beginning-of-message ()
2729 "Show current message starting from the beginning."
2730 (interactive)
3deac4a1
EZ
2731 (let ((rmail-show-message-hook
2732 (list (function (lambda ()
2733 (goto-char (point-min)))))))
2734 (rmail-show-message rmail-current-message)))
2735
2736(defun rmail-end-of-message ()
2737 "Show bottom of current message."
2738 (interactive)
2739 (let ((rmail-show-message-hook
2740 (list (function (lambda ()
2741 (goto-char (point-max))
2742 (recenter (1- (window-height))))))))
2743 (rmail-show-message rmail-current-message)))
581d7e0b 2744
8510cb94
RS
2745(defun rmail-unknown-mail-followup-to ()
2746 "Handle a \"Mail-Followup-To\" header field with an unknown mailing list.
2747Ask the user whether to add that list name to `mail-mailing-lists'."
2748 (save-restriction
2749 (rmail-narrow-to-non-pruned-header)
2750 (let ((mail-followup-to (mail-fetch-field "mail-followup-to" nil t)))
2751 (when mail-followup-to
2752 (let ((addresses
e84b4b86 2753 (split-string
8510cb94
RS
2754 (mail-strip-quoted-names mail-followup-to)
2755 ",[[:space:]]+" t)))
2756 (dolist (addr addresses)
2757 (when (and (not (member addr mail-mailing-lists))
2758 (not
2759 ;; taken from rmailsum.el
2760 (string-match
2761 (or rmail-user-mail-address-regexp
2762 (concat "^\\("
2763 (regexp-quote (user-login-name))
2764 "\\($\\|@\\)\\|"
2765 (regexp-quote
2766 (or user-mail-address
2767 (concat (user-login-name) "@"
2768 (or mail-host-address
2769 (system-name)))))
2770 "\\>\\)"))
2771 addr))
2772 (y-or-n-p
2773 (format "Add `%s' to `mail-mailing-lists'? "
2774 addr)))
2775 (customize-save-variable 'mail-mailing-lists
2776 (cons addr mail-mailing-lists)))))))))
2777
bdf03600 2778(defun rmail-show-message (&optional n no-summary)
bd1f0f84
RS
2779 "Show message number N (prefix argument), counting from start of file.
2780If summary buffer is currently displayed, update current message there also."
581d7e0b 2781 (interactive "p")
d1e69dec
KH
2782 (or (eq major-mode 'rmail-mode)
2783 (switch-to-buffer rmail-buffer))
581d7e0b
RM
2784 (rmail-maybe-set-message-counters)
2785 (widen)
2786 (if (zerop rmail-total-messages)
2787 (progn (narrow-to-region (point-min) (1- (point-max)))
2788 (goto-char (point-min))
2789 (setq mode-line-process nil))
578b6415 2790 (let (blurb coding-system)
581d7e0b
RM
2791 (if (not n)
2792 (setq n rmail-current-message)
2793 (cond ((<= n 0)
2794 (setq n 1
2795 rmail-current-message 1
2796 blurb "No previous message"))
2797 ((> n rmail-total-messages)
2798 (setq n rmail-total-messages
2799 rmail-current-message rmail-total-messages
2800 blurb "No following message"))
2801 (t
2802 (setq rmail-current-message n))))
563ab60d 2803 (let ((beg (rmail-msgbeg n)))
581d7e0b
RM
2804 (goto-char beg)
2805 (forward-line 1)
578b6415
RS
2806 (save-excursion
2807 (let ((end (rmail-msgend n)))
2808 (save-restriction
2809 (if (prog1 (= (following-char) ?0)
2810 (forward-line 2)
2751e20b
RS
2811 ;; If there's a Summary-line in the (otherwise empty)
2812 ;; header, we didn't yet get past the EOOH line.
2813 (if (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n")
2814 (forward-line 1))
578b6415
RS
2815 (narrow-to-region (point) end))
2816 (rfc822-goto-eoh)
2817 (search-forward "\n*** EOOH ***\n" end t))
2818 (narrow-to-region beg (point))
2819 (goto-char (point-min))
2820 (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
2821 (let ((coding-system (intern (match-string 1))))
de971ad1
RS
2822 (condition-case nil
2823 (progn
2824 (check-coding-system coding-system)
2825 (setq buffer-file-coding-system coding-system))
3e0b7b44 2826 (error
de971ad1 2827 (setq buffer-file-coding-system nil))))
578b6415 2828 (setq buffer-file-coding-system nil)))))
563ab60d
RS
2829 ;; Clear the "unseen" attribute when we show a message.
2830 (rmail-set-attribute "unseen" nil)
563ab60d 2831 (let ((end (rmail-msgend n)))
578b6415 2832 ;; Reformat the header, or else find the reformatted header.
563ab60d 2833 (if (= (following-char) ?0)
581d7e0b 2834 (rmail-reformat-message beg end)
563ab60d
RS
2835 (search-forward "\n*** EOOH ***\n" end t)
2836 (narrow-to-region (point) end)))
581d7e0b 2837 (goto-char (point-min))
6f19114e
GM
2838 (walk-windows
2839 (function (lambda (window)
2840 (if (eq (window-buffer window) (current-buffer))
2841 (set-window-point window (point)))))
2842 nil t)
581d7e0b 2843 (rmail-display-labels)
d1e69dec
KH
2844 (if (eq rmail-enable-mime t)
2845 (funcall rmail-show-mime-function)
8510cb94
RS
2846 (setq rmail-view-buffer rmail-buffer))
2847 (when mail-mailing-lists
2848 (rmail-unknown-mail-followup-to))
99887e16 2849 (rmail-highlight-headers)
d43277ab 2850 (if transient-mark-mode (deactivate-mark))
581d7e0b 2851 (run-hooks 'rmail-show-message-hook)
bd1f0f84
RS
2852 ;; If there is a summary buffer, try to move to this message
2853 ;; in that buffer. But don't complain if this message
2854 ;; is not mentioned in the summary.
bdf03600
RS
2855 ;; Don't do this at all if we were called on behalf
2856 ;; of cursor motion in the summary buffer.
2857 (and (rmail-summary-exists) (not no-summary)
2858 (let ((curr-msg rmail-current-message))
2859 (rmail-select-summary
2860 (rmail-summary-goto-msg curr-msg t t))))
6b59a5fc
GM
2861 (with-current-buffer rmail-buffer
2862 (rmail-auto-file))
581d7e0b
RM
2863 (if blurb
2864 (message blurb))))))
2865
d3e1986f 2866(defun rmail-redecode-body (coding &optional raw)
fd4976b8
EZ
2867 "Decode the body of the current message using coding system CODING.
2868This is useful with mail messages that have malformed or missing
2869charset= headers.
2870
2871This function assumes that the current message is already decoded
2872and displayed in the RMAIL buffer, but the coding system used to
2873decode it was incorrect. It then encodes the message back to its
4685e6b7 2874original form, and decodes it again, using the coding system CODING.
fd4976b8 2875
d3e1986f
EZ
2876Optional argument RAW, if non-nil, means don't encode the message
2877before decoding it with the new CODING. This is useful if the current
2878message text was produced by some function which invokes `insert',
2879since `insert' leaves unibyte character codes 128 through 255 unconverted
2880to multibyte. One example of such a situation is when the text was
2881produced by `base64-decode-region'.
2882
2883Interactively, invoke the function with a prefix argument to set RAW
2884non-nil.
2885
fd4976b8
EZ
2886Note that if Emacs erroneously auto-detected one of the iso-2022
2887encodings in the message, this function might fail because the escape
2888sequences that switch between character sets and also single-shift and
2889locking-shift codes are impossible to recover. This function is meant
2890to be used to fix messages encoded with 8-bit encodings, such as
2891iso-8859, koi8-r, etc."
2892 (interactive "zCoding system for re-decoding this message: ")
2893 (when (not rmail-enable-mime)
2894 (or (eq major-mode 'rmail-mode)
2895 (switch-to-buffer rmail-buffer))
2896 (save-excursion
d3e1986f
EZ
2897 (let ((pruned (rmail-msg-is-pruned))
2898 (raw (or raw current-prefix-arg)))
d54f26b1
EZ
2899 (unwind-protect
2900 (let ((msgbeg (rmail-msgbeg rmail-current-message))
2901 (msgend (rmail-msgend rmail-current-message))
2902 x-coding-header)
2903 ;; We need the message headers pruned (we later restore
2904 ;; the pruned stat to what it was, see the end of
2905 ;; unwind-protect form).
2906 (or pruned
2907 (rmail-toggle-header 1))
2908 (narrow-to-region msgbeg msgend)
2909 (goto-char (point-min))
2910 (when (search-forward "\n*** EOOH ***\n" (point-max) t)
2911 (narrow-to-region msgbeg (point)))
2912 (goto-char (point-min))
2913 (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t)
2914 (let ((old-coding (intern (match-string 1)))
2915 (buffer-read-only nil))
2916 (check-coding-system old-coding)
2917 ;; Make sure the new coding system uses the same EOL
2918 ;; conversion, to prevent ^M characters from popping
2919 ;; up all over the place.
2920 (setq coding
2921 (coding-system-change-eol-conversion
2922 coding
2923 (coding-system-eol-type old-coding)))
4baf35c9
EZ
2924 ;; If old-coding is `undecided', encode-coding-region
2925 ;; will not encode the text at all. Find a proper
2926 ;; non-trivial encoding to use.
2927 (if (memq (coding-system-base old-coding) '(nil undecided))
2928 (setq old-coding
2929 (car (find-coding-systems-region msgbeg msgend))))
d54f26b1
EZ
2930 (setq x-coding-header (point-marker))
2931 (narrow-to-region msgbeg msgend)
d3e1986f
EZ
2932 (and (null raw)
2933 ;; If old and new encoding are the same, it
2934 ;; clearly doesn't make sense to encode.
2935 (not (coding-system-equal
2936 (coding-system-base old-coding)
2937 (coding-system-base coding)))
2938 ;; If the body includes only eight-bit-*
2939 ;; characters, encoding might fail, e.g. with
2940 ;; UTF-8, and isn't needed anyway.
2941 (> (length (delq 'ascii
2942 (delq 'eight-bit-graphic
2943 (delq 'eight-bit-control
2944 (find-charset-region
2945 msgbeg msgend)))))
2946 0)
2947 (encode-coding-region (point) msgend old-coding))
d54f26b1
EZ
2948 (decode-coding-region (point) msgend coding)
2949 (setq last-coding-system-used coding)
2950 ;; Rewrite the coding-system header according
2951 ;; to what we did.
2952 (goto-char x-coding-header)
2953 (delete-region (point)
2954 (save-excursion
2955 (beginning-of-line)
2956 (point)))
2957 (insert "X-Coding-System: "
2958 (symbol-name last-coding-system-used))
2959 (set-marker x-coding-header nil)
2960 (rmail-show-message))
2961 (error "No X-Coding-System header found")))
2962 (or pruned
2963 (rmail-toggle-header 0)))))))
fd4976b8 2964
99887e16
KH
2965;; Find all occurrences of certain fields, and highlight them.
2966(defun rmail-highlight-headers ()
2967 ;; Do this only if the system supports faces.
f9a9d26e
RS
2968 (if (and (fboundp 'internal-find-face)
2969 rmail-highlighted-headers)
99887e16
KH
2970 (save-excursion
2971 (search-forward "\n\n" nil 'move)
2972 (save-restriction
2973 (narrow-to-region (point-min) (point))
2974 (let ((case-fold-search t)
2975 (inhibit-read-only t)
2976 ;; Highlight with boldface if that is available.
2977 ;; Otherwise use the `highlight' face.
3df6812a
RS
2978 (face (or rmail-highlight-face
2979 (if (face-differs-from-default-p 'bold)
2980 'bold 'highlight)))
99887e16
KH
2981 ;; List of overlays to reuse.
2982 (overlays rmail-overlay-list))
2983 (goto-char (point-min))
2984 (while (re-search-forward rmail-highlighted-headers nil t)
92e06883 2985 (skip-chars-forward " \t")
99887e16
KH
2986 (let ((beg (point))
2987 overlay)
2988 (while (progn (forward-line 1)
2989 (looking-at "[ \t]")))
2990 ;; Back up over newline, then trailing spaces or tabs
2991 (forward-char -1)
2992 (while (member (preceding-char) '(? ?\t))
2993 (forward-char -1))
2994 (if overlays
2995 ;; Reuse an overlay we already have.
2996 (progn
2997 (setq overlay (car overlays)
2998 overlays (cdr overlays))
2999 (overlay-put overlay 'face face)
3000 (move-overlay overlay beg (point)))
3001 ;; Make a new overlay and add it to
3002 ;; rmail-overlay-list.
3003 (setq overlay (make-overlay beg (point)))
3004 (overlay-put overlay 'face face)
3005 (setq rmail-overlay-list
3006 (cons overlay rmail-overlay-list))))))))))
3007
ab59163d
DL
3008(defun rmail-auto-file ()
3009 "Automatically move a message into a sub-folder based on criteria.
3010Called when a new message is displayed."
3011 (if (or (rmail-message-labels-p rmail-current-message "filed")
3012 (not (string= (buffer-file-name)
3013 (expand-file-name rmail-file-name))))
3014 ;; Do nothing if it's already been filed.
3015 nil
3016 ;; Find out some basics (common fields)
3017 (let ((from (mail-fetch-field "from"))
3018 (subj (mail-fetch-field "subject"))
3019 (to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc")))
3020 (d rmail-automatic-folder-directives)
3021 (directive-loop nil)
3022 (folder nil))
3023 (while d
3024 (setq folder (car (car d))
3025 directive-loop (cdr (car d)))
3026 (while (and (car directive-loop)
3027 (let ((f (cond
3028 ((string= (car directive-loop) "from") from)
3029 ((string= (car directive-loop) "to") to)
3030 ((string= (car directive-loop) "subject") subj)
3031 (t (mail-fetch-field (car directive-loop))))))
3032 (and f (string-match (car (cdr directive-loop)) f))))
3033 (setq directive-loop (cdr (cdr directive-loop))))
3034 ;; If there are no directives left, then it was a complete match.
3035 (if (null directive-loop)
3036 (if (null folder)
3037 (rmail-delete-forward)
3038 (if (string= "/dev/null" folder)
3039 (rmail-delete-message)
3040 (rmail-output-to-rmail-file folder 1 t)
3041 (setq d nil))))
3042 (setq d (cdr d))))))
3043
581d7e0b
RM
3044(defun rmail-next-message (n)
3045 "Show following message whether deleted or not.
3046With prefix arg N, moves forward N messages, or backward if N is negative."
3047 (interactive "p")
6b59a5fc 3048 (set-buffer rmail-buffer)
581d7e0b
RM
3049 (rmail-maybe-set-message-counters)
3050 (rmail-show-message (+ rmail-current-message n)))
3051
3052(defun rmail-previous-message (n)
3053 "Show previous message whether deleted or not.
3054With prefix arg N, moves backward N messages, or forward if N is negative."
3055 (interactive "p")
67f9d50e 3056 (rmail-next-message (- n)))
581d7e0b
RM
3057
3058(defun rmail-next-undeleted-message (n)
3059 "Show following non-deleted message.
3060With prefix arg N, moves forward N non-deleted messages,
c42722e3
RS
3061or backward if N is negative.
3062
3063Returns t if a new message is being shown, nil otherwise."
581d7e0b 3064 (interactive "p")
6b59a5fc 3065 (set-buffer rmail-buffer)
581d7e0b
RM
3066 (rmail-maybe-set-message-counters)
3067 (let ((lastwin rmail-current-message)
3068 (current rmail-current-message))
3069 (while (and (> n 0) (< current rmail-total-messages))
3070 (setq current (1+ current))
3071 (if (not (rmail-message-deleted-p current))
3072 (setq lastwin current n (1- n))))
3073 (while (and (< n 0) (> current 1))
3074 (setq current (1- current))
3075 (if (not (rmail-message-deleted-p current))
3076 (setq lastwin current n (1+ n))))
3077 (if (/= lastwin rmail-current-message)
c42722e3
RS
3078 (progn (rmail-show-message lastwin)
3079 t)
3080 (if (< n 0)
3081 (message "No previous nondeleted message"))
3082 (if (> n 0)
3083 (message "No following nondeleted message"))
3084 nil)))
581d7e0b
RM
3085
3086(defun rmail-previous-undeleted-message (n)
3087 "Show previous non-deleted message.
3088With prefix argument N, moves backward N non-deleted messages,
3089or forward if N is negative."
3090 (interactive "p")
3091 (rmail-next-undeleted-message (- n)))
3092
3093(defun rmail-first-message ()
3094 "Show first message in file."
3095 (interactive)
3096 (rmail-maybe-set-message-counters)
3097 (rmail-show-message 1))
3098
3099(defun rmail-last-message ()
3100 "Show last message in file."
3101 (interactive)
3102 (rmail-maybe-set-message-counters)
3103 (rmail-show-message rmail-total-messages))
3104
3105(defun rmail-what-message ()
3106 (let ((where (point))
3107 (low 1)
3108 (high rmail-total-messages)
3109 (mid (/ rmail-total-messages 2)))
3110 (while (> (- high low) 1)
3111 (if (>= where (rmail-msgbeg mid))
3112 (setq low mid)
3113 (setq high mid))
3114 (setq mid (+ low (/ (- high low) 2))))
3115 (if (>= where (rmail-msgbeg high)) high low)))
3116
bd1f0f84
RS
3117(defun rmail-message-recipients-p (msg recipients &optional primary-only)
3118 (save-restriction
3119 (goto-char (rmail-msgbeg msg))
b4b87b68 3120 (search-forward "\n*** EOOH ***\n")
bd1f0f84
RS
3121 (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
3122 (or (string-match recipients (or (mail-fetch-field "To") ""))
3123 (string-match recipients (or (mail-fetch-field "From") ""))
3124 (if (not primary-only)
3125 (string-match recipients (or (mail-fetch-field "Cc") ""))))))
3126
7cff9c6f
GM
3127(defun rmail-message-regexp-p (n regexp)
3128 "Return t, if for message number N, regexp REGEXP matches in the header."
3129 (let ((beg (rmail-msgbeg n))
3130 (end (rmail-msgend n)))
3131 (goto-char beg)
3132 (forward-line 1)
3133 (save-excursion
3134 (save-restriction
3135 (if (prog1 (= (following-char) ?0)
3136 (forward-line 2)
3137 ;; If there's a Summary-line in the (otherwise empty)
3138 ;; header, we didn't yet get past the EOOH line.
50df7214
GM
3139 (when (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n")
3140 (forward-line 1))
b2b8f8fa 3141 (setq beg (point))
7cff9c6f 3142 (narrow-to-region (point) end))
67f9d50e 3143 (progn
50df7214
GM
3144 (rfc822-goto-eoh)
3145 (setq end (point)))
b2b8f8fa 3146 (setq beg (point))
50df7214
GM
3147 (search-forward "\n*** EOOH ***\n" end t)
3148 (setq end (1+ (match-beginning 0)))))
b2b8f8fa 3149 (goto-char beg)
6b59a5fc
GM
3150 (if rmail-enable-mime
3151 (funcall rmail-search-mime-header-function n regexp end)
3152 (re-search-forward regexp end t)))))
3153
3154(defun rmail-search-message (msg regexp)
3155 "Return non-nil, if for message number MSG, regexp REGEXP matches."
3156 (goto-char (rmail-msgbeg msg))
3157 (if rmail-enable-mime
3158 (funcall rmail-search-mime-message-function msg regexp)
3159 (re-search-forward regexp (rmail-msgend msg) t)))
bd1f0f84 3160
581d7e0b 3161(defvar rmail-search-last-regexp nil)
e91f80c4 3162(defun rmail-search (regexp &optional n)
40e09f88 3163 "Show message containing next match for REGEXP (but not the current msg).
e91f80c4
RS
3164Prefix argument gives repeat count; negative argument means search
3165backwards (through earlier messages).
3166Interactively, empty argument means use same regexp used last time."
581d7e0b
RM
3167 (interactive
3168 (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
3169 (prompt
5b76833f 3170 (concat (if reversep "Reverse " "") "Rmail search (regexp"))
581d7e0b 3171 regexp)
5b76833f
RF
3172 (setq prompt
3173 (concat prompt
3174 (if rmail-search-last-regexp
3175 (concat ", default "
3176 rmail-search-last-regexp "): ")
3177 "): ")))
581d7e0b
RM
3178 (setq regexp (read-string prompt))
3179 (cond ((not (equal regexp ""))
3180 (setq rmail-search-last-regexp regexp))
3181 ((not rmail-search-last-regexp)
3182 (error "No previous Rmail search string")))
e91f80c4
RS
3183 (list rmail-search-last-regexp
3184 (prefix-numeric-value current-prefix-arg))))
3185 (or n (setq n 1))
581d7e0b 3186 (message "%sRmail search for %s..."
df8a44dd 3187 (if (< n 0) "Reverse " "")
581d7e0b 3188 regexp)
6b59a5fc 3189 (set-buffer rmail-buffer)
581d7e0b
RM
3190 (rmail-maybe-set-message-counters)
3191 (let ((omin (point-min))
3192 (omax (point-max))
3193 (opoint (point))
3194 win
e91f80c4 3195 (reversep (< n 0))
581d7e0b
RM
3196 (msg rmail-current-message))
3197 (unwind-protect
3198 (progn
3199 (widen)
e91f80c4
RS
3200 (while (/= n 0)
3201 ;; Check messages one by one, advancing message number up or down
3202 ;; but searching forward through each message.
3203 (if reversep
3204 (while (and (null win) (> msg 1))
6b59a5fc
GM
3205 (setq msg (1- msg)
3206 win (rmail-search-message msg regexp)))
e91f80c4 3207 (while (and (null win) (< msg rmail-total-messages))
6b59a5fc
GM
3208 (setq msg (1+ msg)
3209 win (rmail-search-message msg regexp))))
df8a44dd 3210 (setq n (+ n (if reversep 1 -1)))))
581d7e0b
RM
3211 (if win
3212 (progn
6b59a5fc
GM
3213 (rmail-show-message msg)
3214 ;; Search forward (if this is a normal search) or backward
3215 ;; (if this is a reverse search) through this message to
3216 ;; position point. This search may fail because REGEXP
3217 ;; was found in the hidden portion of this message. In
3218 ;; that case, move point to the beginning of visible
3219 ;; portion.
581d7e0b
RM
3220 (if reversep
3221 (progn
6b59a5fc
GM
3222 (goto-char (point-max))
3223 (re-search-backward regexp nil 'move))
3224 (goto-char (point-min))
3225 (re-search-forward regexp nil t))
581d7e0b
RM
3226 (message "%sRmail search for %s...done"
3227 (if reversep "Reverse " "")
6b59a5fc 3228 regexp))
581d7e0b
RM
3229 (goto-char opoint)
3230 (narrow-to-region omin omax)
3231 (ding)
3232 (message "Search failed: %s" regexp)))))
3233
e91f80c4
RS
3234(defun rmail-search-backwards (regexp &optional n)
3235 "Show message containing previous match for REGEXP.
3236Prefix argument gives repeat count; negative argument means search
3237forward (through later messages).
3238Interactively, empty argument means use same regexp used last time."
3239 (interactive
df8a44dd 3240 (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
e91f80c4 3241 (prompt
5b76833f 3242 (concat (if reversep "Reverse " "") "Rmail search (regexp"))
e91f80c4 3243 regexp)
5b76833f
RF
3244 (setq prompt
3245 (concat prompt
3246 (if rmail-search-last-regexp
3247 (concat ", default "
3248 rmail-search-last-regexp "): ")
3249 "): ")))
e91f80c4
RS
3250 (setq regexp (read-string prompt))
3251 (cond ((not (equal regexp ""))
3252 (setq rmail-search-last-regexp regexp))
3253 ((not rmail-search-last-regexp)
3254 (error "No previous Rmail search string")))
3255 (list rmail-search-last-regexp
3256 (prefix-numeric-value current-prefix-arg))))
68d30f2b 3257 (rmail-search regexp (- (or n 1))))
e91f80c4 3258
581d7e0b
RM
3259;; Show the first message which has the `unseen' attribute.
3260(defun rmail-first-unseen-message ()
117f4b92 3261 (rmail-maybe-set-message-counters)
581d7e0b
RM
3262 (let ((current 1)
3263 found)
3264 (save-restriction
3265 (widen)
bb9dcce1 3266 (while (and (not found) (<= current rmail-total-messages))
581d7e0b 3267 (if (rmail-message-labels-p current ", ?\\(unseen\\),")
462c1094
RM
3268 (setq found current))
3269 (setq current (1+ current))))
e9c735fa
JA
3270;; Let the caller show the message.
3271;; (if found
3272;; (rmail-show-message found))
3273 found))
60fb2b34 3274
80068231
AS
3275(defun rmail-current-subject ()
3276 "Return the current subject.
3277The subject is stripped of leading and trailing whitespace, and
3278of typical reply prefixes such as Re:."
3279 (let ((subject (or (mail-fetch-field "Subject") "")))
df211784
RS
3280 (if (string-match "\\`[ \t]+" subject)
3281 (setq subject (substring subject (match-end 0))))
80068231 3282 (if (string-match rmail-reply-regexp subject)
60fb2b34 3283 (setq subject (substring subject (match-end 0))))
df211784
RS
3284 (if (string-match "[ \t]+\\'" subject)
3285 (setq subject (substring subject 0 (match-beginning 0))))
80068231
AS
3286 subject))
3287
3288(defun rmail-current-subject-regexp ()
3289 "Return a regular expression matching the current subject.
3290The regular expression matches the subject header line of
3291messages about the same subject. The subject itself is stripped
3292of leading and trailing whitespace, of typical reply prefixes
3293such as Re: and whitespace within the subject is replaced by a
3294regular expression matching whitespace in general in order to
3295take into account that subject header lines may include newlines
3296and more whitespace. The returned regular expressions contains
3297`rmail-reply-regexp' and ends with a newline."
3298 (let ((subject (rmail-current-subject)))
7c86d70e
EZ
3299 ;; If Subject is long, mailers will break it into several lines at
3300 ;; arbitrary places, so replace whitespace with a regexp that will
3301 ;; match any sequence of spaces, TABs, and newlines.
3302 (setq subject (regexp-quote subject))
3303 (setq subject
3304 (replace-regexp-in-string "[ \t\n]+" "[ \t\n]+" subject t t))
cca24670
EZ
3305 ;; Some mailers insert extra spaces after "Subject:", so allow any
3306 ;; amount of them.
3307 (concat "^Subject:[ \t]+"
80068231
AS
3308 (if (string= "\\`" (substring rmail-reply-regexp 0 2))
3309 (substring rmail-reply-regexp 2)
3310 rmail-reply-regexp)
3311 subject "[ \t]*\n")))
3312
60fb2b34
RS
3313(defun rmail-next-same-subject (n)
3314 "Go to the next mail message having the same subject header.
3315With prefix argument N, do this N times.
3316If N is negative, go backwards instead."
3317 (interactive "p")
80068231 3318 (let ((search-regexp (rmail-current-subject-regexp))
e8417bb0
KH
3319 (forward (> n 0))
3320 (i rmail-current-message)
a21b845b 3321 (case-fold-search t)
80068231 3322 found)
60fb2b34
RS
3323 (save-excursion
3324 (save-restriction
3325 (widen)
3326 (while (and (/= n 0)
3327 (if forward
3328 (< i rmail-total-messages)
3329 (> i 1)))
3330 (let (done)
3331 (while (and (not done)
3332 (if forward
3333 (< i rmail-total-messages)
3334 (> i 1)))
3335 (setq i (if forward (1+ i) (1- i)))
3336 (goto-char (rmail-msgbeg i))
3337 (search-forward "\n*** EOOH ***\n")
3338 (let ((beg (point)) end)
3339 (search-forward "\n\n")
3340 (setq end (point))
3341 (goto-char beg)
3342 (setq done (re-search-forward search-regexp end t))))
3343 (if done (setq found i)))
3344 (setq n (if forward (1- n) (1+ n))))))
3345 (if found
3346 (rmail-show-message found)
3347 (error "No %s message with same subject"
3348 (if forward "following" "previous")))))
3349
3350(defun rmail-previous-same-subject (n)
3351 "Go to the previous mail message having the same subject header.
3352With prefix argument N, do this N times.
3353If N is negative, go forwards instead."
3354 (interactive "p")
3355 (rmail-next-same-subject (- n)))
581d7e0b
RM
3356\f
3357;;;; *** Rmail Message Deletion Commands ***
3358
3359(defun rmail-message-deleted-p (n)
3360 (= (aref rmail-deleted-vector n) ?D))
3361
3362(defun rmail-set-message-deleted-p (n state)
3363 (aset rmail-deleted-vector n (if state ?D ?\ )))
3364
3365(defun rmail-delete-message ()
3366 "Delete this message and stay on it."
3367 (interactive)
6c714afe
RS
3368 (rmail-set-attribute "deleted" t)
3369 (run-hooks 'rmail-delete-message-hook))
581d7e0b
RM
3370
3371(defun rmail-undelete-previous-message ()
3372 "Back up to deleted message, select it, and undelete it."
3373 (interactive)
6b59a5fc 3374 (set-buffer rmail-buffer)
581d7e0b
RM
3375 (let ((msg rmail-current-message))
3376 (while (and (> msg 0)
3377 (not (rmail-message-deleted-p msg)))
3378 (setq msg (1- msg)))
3379 (if (= msg 0)
3380 (error "No previous deleted message")
3381 (if (/= msg rmail-current-message)
3382 (rmail-show-message msg))
bd1f0f84
RS
3383 (rmail-set-attribute "deleted" nil)
3384 (if (rmail-summary-exists)
3385 (save-excursion
3386 (set-buffer rmail-summary-buffer)
3387 (rmail-summary-mark-undeleted msg)))
3388 (rmail-maybe-display-summary))))
581d7e0b
RM
3389
3390(defun rmail-delete-forward (&optional backward)
3391 "Delete this message and move to next nondeleted one.
3392Deleted messages stay in the file until the \\[rmail-expunge] command is given.
c42722e3
RS
3393With prefix argument, delete and move backward.
3394
3395Returns t if a new message is displayed after the delete, or nil otherwise."
581d7e0b
RM
3396 (interactive "P")
3397 (rmail-set-attribute "deleted" t)
6c714afe 3398 (run-hooks 'rmail-delete-message-hook)
bd1f0f84
RS
3399 (let ((del-msg rmail-current-message))
3400 (if (rmail-summary-exists)
4edaa169
RS
3401 (rmail-select-summary
3402 (rmail-summary-mark-deleted del-msg)))
c42722e3
RS
3403 (prog1 (rmail-next-undeleted-message (if backward -1 1))
3404 (rmail-maybe-display-summary))))
581d7e0b
RM
3405
3406(defun rmail-delete-backward ()
3407 "Delete this message and move to previous nondeleted one.
3408Deleted messages stay in the file until the \\[rmail-expunge] command is given."
3409 (interactive)
3410 (rmail-delete-forward t))
3411
1825bea1
RS
3412;; Compute the message number a given message would have after expunging.
3413;; The present number of the message is OLDNUM.
3414;; DELETEDVEC should be rmail-deleted-vector.
3415;; The value is nil for a message that would be deleted.
3416(defun rmail-msg-number-after-expunge (deletedvec oldnum)
3417 (if (or (null oldnum) (= (aref deletedvec oldnum) ?D))
3418 nil
3419 (let ((i 0)
3420 (newnum 0))
3421 (while (< i oldnum)
3422 (if (/= (aref deletedvec i) ?D)
3423 (setq newnum (1+ newnum)))
3424 (setq i (1+ i)))
3425 newnum)))
3426
e6be618b
GM
3427(defun rmail-expunge-confirmed ()
3428 "Return t if deleted message should be expunged. If necessary, ask the user.
3429See also user-option `rmail-confirm-expunge'."
6b59a5fc 3430 (set-buffer rmail-buffer)
e6be618b
GM
3431 (or (not (stringp rmail-deleted-vector))
3432 (not (string-match "D" rmail-deleted-vector))
3433 (null rmail-confirm-expunge)
3434 (funcall rmail-confirm-expunge
3435 "Erase deleted messages from Rmail file? ")))
3436
608aa380 3437(defun rmail-only-expunge (&optional dont-show)
581d7e0b
RM
3438 "Actually erase all deleted messages in the file."
3439 (interactive)
6b59a5fc 3440 (set-buffer rmail-buffer)
581d7e0b
RM
3441 (message "Expunging deleted messages...")
3442 ;; Discard all undo records for this buffer.
3443 (or (eq buffer-undo-list t)
3444 (setq buffer-undo-list nil))
3445 (rmail-maybe-set-message-counters)
3446 (let* ((omax (- (buffer-size) (point-max)))
3447 (omin (- (buffer-size) (point-min)))
3448 (opoint (if (and (> rmail-current-message 0)
881fd7eb
KH
3449 (rmail-message-deleted-p rmail-current-message))
3450 0
6b59a5fc
GM
3451 (if rmail-enable-mime
3452 (with-current-buffer rmail-view-buffer
3453 (- (point)(point-min)))
3454 (- (point) (point-min)))))
581d7e0b
RM
3455 (messages-head (cons (aref rmail-message-vector 0) nil))
3456 (messages-tail messages-head)
3457 ;; Don't make any undo records for the expunging.
3458 (buffer-undo-list t)
3459 (win))
3460 (unwind-protect
3461 (save-excursion
3462 (widen)
3463 (goto-char (point-min))
3464 (let ((counter 0)
3465 (number 1)
3466 (total rmail-total-messages)
3467 (new-message-number rmail-current-message)
3468 (new-summary nil)
0985b412 3469 (new-msgref (list (list 0)))
1825bea1 3470 (rmailbuf (current-buffer))
581d7e0b
RM
3471 (buffer-read-only nil)
3472 (messages rmail-message-vector)
3473 (deleted rmail-deleted-vector)
3474 (summary rmail-summary-vector))
3475 (setq rmail-total-messages nil
3476 rmail-current-message nil
3477 rmail-message-vector nil
3478 rmail-deleted-vector nil
3479 rmail-summary-vector nil)
1825bea1 3480
581d7e0b
RM
3481 (while (<= number total)
3482 (if (= (aref deleted number) ?D)
3483 (progn
3484 (delete-region
3485 (marker-position (aref messages number))
3486 (marker-position (aref messages (1+ number))))
3487 (move-marker (aref messages number) nil)
3488 (if (> new-message-number counter)
3489 (setq new-message-number (1- new-message-number))))
3490 (setq counter (1+ counter))
3491 (setq messages-tail
3492 (setcdr messages-tail
3493 (cons (aref messages number) nil)))
3494 (setq new-summary
3495 (cons (if (= counter number) (aref summary (1- number)))
0985b412
RS
3496 new-summary))
3497 (setq new-msgref
3498 (cons (aref rmail-msgref-vector number)
3499 new-msgref))
3500 (setcar (car new-msgref) counter))
581d7e0b
RM
3501 (if (zerop (% (setq number (1+ number)) 20))
3502 (message "Expunging deleted messages...%d" number)))
3503 (setq messages-tail
3504 (setcdr messages-tail
3505 (cons (aref messages number) nil)))
3506 (setq rmail-current-message new-message-number
3507 rmail-total-messages counter
3508 rmail-message-vector (apply 'vector messages-head)
3509 rmail-deleted-vector (make-string (1+ counter) ?\ )
3510 rmail-summary-vector (vconcat (nreverse new-summary))
0985b412 3511 rmail-msgref-vector (apply 'vector (nreverse new-msgref))
581d7e0b
RM
3512 win t)))
3513 (message "Expunging deleted messages...done")
3514 (if (not win)
3515 (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)))
608aa380
KH
3516 (if (not dont-show)
3517 (rmail-show-message
c32e5fb0
RS
3518 (if (zerop rmail-current-message) 1 nil)))
3519 (if rmail-enable-mime
3520 (goto-char (+ (point-min) opoint))
3521 (goto-char (+ (point) opoint))))))
bd1f0f84
RS
3522
3523(defun rmail-expunge ()
3524 "Erase deleted messages from Rmail file and summary buffer."
3525 (interactive)
e6be618b 3526 (when (rmail-expunge-confirmed)
9f7c6da9
GM
3527 (rmail-only-expunge)
3528 (if (rmail-summary-exists)
e6be618b 3529 (rmail-select-summary (rmail-update-summary)))))
581d7e0b
RM
3530\f
3531;;;; *** Rmail Mailing Commands ***
3532
bde7cb3f
RS
3533(defun rmail-start-mail (&optional noerase to subject in-reply-to cc
3534 replybuffer sendactions same-window others)
3535 (let (yank-action)
3536 (if replybuffer
3537 (setq yank-action (list 'insert-buffer replybuffer)))
3538 (setq others (cons (cons "cc" cc) others))
3539 (setq others (cons (cons "in-reply-to" in-reply-to) others))
3540 (if same-window
3541 (compose-mail to subject others
3542 noerase nil
3543 yank-action sendactions)
8a60950d 3544 (if rmail-mail-new-frame
bde7cb3f
RS
3545 (prog1
3546 (compose-mail to subject others
3547 noerase 'switch-to-buffer-other-frame
3548 yank-action sendactions)
3549 ;; This is not a standard frame parameter;
3550 ;; nothing except sendmail.el looks at it.
3551 (modify-frame-parameters (selected-frame)
3552 '((mail-dedicated-frame . t))))
3553 (compose-mail to subject others
3554 noerase 'switch-to-buffer-other-window
3555 yank-action sendactions)))))
94ed51e8 3556
581d7e0b 3557(defun rmail-mail ()
bd1f0f84
RS
3558 "Send mail in another window.
3559While composing the message, use \\[mail-yank-original] to yank the
3560original message into it."
581d7e0b 3561 (interactive)
d1e69dec 3562 (rmail-start-mail nil nil nil nil nil rmail-view-buffer))
581d7e0b
RM
3563
3564(defun rmail-continue ()
3565 "Continue composing outgoing message previously being composed."
3566 (interactive)
94ed51e8 3567 (rmail-start-mail t))
581d7e0b
RM
3568
3569(defun rmail-reply (just-sender)
3570 "Reply to the current message.
3571Normally include CC: to all other recipients of original message;
3572prefix argument means ignore them. While composing the reply,
3573use \\[mail-yank-original] to yank the original message into it."
3574 (interactive "P")
11aea8f5 3575 (let (from reply-to cc subject date to message-id references
037fa8ca 3576 resent-to resent-cc resent-reply-to
d1e69dec 3577 (msgnum rmail-current-message))
581d7e0b
RM
3578 (save-excursion
3579 (save-restriction
a2cc5c4f
GM
3580 (if rmail-enable-mime
3581 (narrow-to-region
3582 (goto-char (point-min))
3583 (if (search-forward "\n\n" nil 'move)
3584 (1+ (match-beginning 0))
3585 (point)))
6b59a5fc
GM
3586 (widen)
3587 (goto-char (rmail-msgbeg rmail-current-message))
3588 (forward-line 1)
3589 (if (= (following-char) ?0)
3590 (narrow-to-region
3591 (progn (forward-line 2)
3592 (point))
3593 (progn (search-forward "\n\n" (rmail-msgend rmail-current-message)
3594 'move)
3595 (point)))
3596 (narrow-to-region (point)
3597 (progn (search-forward "\n*** EOOH ***\n")
3598 (beginning-of-line) (point)))))
037fa8ca 3599 (setq from (mail-fetch-field "from")
5b9b5b89 3600 reply-to (or (mail-fetch-field "mail-reply-to" nil t)
8510cb94 3601 (mail-fetch-field "reply-to" nil t)
581d7e0b 3602 from)
037fa8ca
RS
3603 subject (mail-fetch-field "subject")
3604 date (mail-fetch-field "date")
037fa8ca 3605 message-id (mail-fetch-field "message-id")
11aea8f5
RS
3606 references (mail-fetch-field "references" nil nil t)
3607 resent-reply-to (mail-fetch-field "resent-reply-to" nil t)
037fa8ca
RS
3608 resent-cc (and (not just-sender)
3609 (mail-fetch-field "resent-cc" nil t))
3610 resent-to (or (mail-fetch-field "resent-to" nil t) "")
3611;;; resent-subject (mail-fetch-field "resent-subject")
3612;;; resent-date (mail-fetch-field "resent-date")
3613;;; resent-message-id (mail-fetch-field "resent-message-id")
5b9b5b89
RS
3614 )
3615 (unless just-sender
3616 (if (mail-fetch-field "mail-followup-to" nil t)
3617 ;; If this header field is present, use it instead of the To and CC fields.
3618 (setq to (mail-fetch-field "mail-followup-to" nil t))
3619 (setq cc (or (mail-fetch-field "cc" nil t) "")
3620 to (or (mail-fetch-field "to" nil t) ""))))
3621
3622 ))
3623
037fa8ca
RS
3624 ;; Merge the resent-to and resent-cc into the to and cc.
3625 (if (and resent-to (not (equal resent-to "")))
3626 (if (not (equal to ""))
3627 (setq to (concat to ", " resent-to))
3628 (setq to resent-to)))
3629 (if (and resent-cc (not (equal resent-cc "")))
3630 (if (not (equal cc ""))
3631 (setq cc (concat cc ", " resent-cc))
3632 (setq cc resent-cc)))
3633 ;; Add `Re: ' to subject if not there already.
bd1f0f84 3634 (and (stringp subject)
08960da1
KH
3635 (setq subject
3636 (concat rmail-reply-prefix
a21b845b
KH
3637 (if (let ((case-fold-search t))
3638 (string-match rmail-reply-regexp subject))
08960da1
KH
3639 (substring subject (match-end 0))
3640 subject))))
95b597ce
RS
3641 (rmail-start-mail
3642 nil
3643 ;; Using mail-strip-quoted-names is undesirable with newer mailers
3644 ;; since they can handle the names unstripped.
3645 ;; I don't know whether there are other mailers that still
3646 ;; need the names to be stripped.
ab233196 3647;;; (mail-strip-quoted-names reply-to)
d184e182
EZ
3648 ;; Remove unwanted names from reply-to, since Mail-Followup-To
3649 ;; header causes all the names in it to wind up in reply-to, not
3650 ;; in cc. But if what's left is an empty list, use the original.
3651 (let* ((reply-to-list (rmail-dont-reply-to reply-to)))
3652 (if (string= reply-to-list "") reply-to reply-to-list))
95b597ce
RS
3653 subject
3654 (rmail-make-in-reply-to-field from date message-id)
3655 (if just-sender
3656 nil
3657 ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to
3658 ;; to do its job.
3659 (let* ((cc-list (rmail-dont-reply-to
3660 (mail-strip-quoted-names
3661 (if (null cc) to (concat to ", " cc))))))
3662 (if (string= cc-list "") nil cc-list)))
3663 rmail-view-buffer
3664 (list (list 'rmail-mark-message
6b59a5fc
GM
3665 rmail-buffer
3666 (with-current-buffer rmail-buffer
3667 (aref rmail-msgref-vector msgnum))
95b597ce
RS
3668 "answered"))
3669 nil
3670 (list (cons "References" (concat (mapconcat 'identity references " ")
3671 " " message-id))))))
fa2795ca 3672
0985b412
RS
3673(defun rmail-mark-message (buffer msgnum-list attribute)
3674 "Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE.
3675This is use in the send-actions for message buffers.
3676MSGNUM-LIST is a list of the form (MSGNUM)
3677which is an element of rmail-msgref-vector."
fa2795ca
RS
3678 (save-excursion
3679 (set-buffer buffer)
0985b412
RS
3680 (if (car msgnum-list)
3681 (rmail-set-attribute attribute t (car msgnum-list)))))
581d7e0b
RM
3682
3683(defun rmail-make-in-reply-to-field (from date message-id)
3684 (cond ((not from)
3685 (if message-id
3686 message-id
3687 nil))
3688 (mail-use-rfc822
3689 (require 'rfc822)
3690 (let ((tem (car (rfc822-addresses from))))
3691 (if message-id
8148a3ad
RS
3692 (if (or (not tem)
3693 (string-match
3694 (regexp-quote (if (string-match "@[^@]*\\'" tem)
3695 (substring tem 0
3696 (match-beginning 0))
3697 tem))
3698 message-id))
3699 ;; missing From, or Message-ID is sufficiently informative
581d7e0b
RM
3700 message-id
3701 (concat message-id " (" tem ")"))
1de48e7f
RS
3702 ;; Copy TEM, discarding text properties.
3703 (setq tem (copy-sequence tem))
3704 (set-text-properties 0 (length tem) nil tem)
3705 (setq tem (copy-sequence tem))
3706 ;; Use prin1 to fake RFC822 quoting
3707 (let ((field (prin1-to-string tem)))
3708 (if date
3709 (concat field "'s message of " date)
3710 field)))))
3210e730
RS
3711 ((let* ((foo "[^][\000-\037()<>@,;:\\\" ]+")
3712 (bar "[^][\000-\037()<>@,;:\\\"]+"))
3713 ;; These strings both match all non-ASCII characters.
581d7e0b
RM
3714 (or (string-match (concat "\\`[ \t]*\\(" bar
3715 "\\)\\(<" foo "@" foo ">\\)?[ \t]*\\'")
3716 ;; "Unix Loser <Foo@bar.edu>" => "Unix Loser"
3717 from)
3718 (string-match (concat "\\`[ \t]*<" foo "@" foo ">[ \t]*(\\("
3719 bar "\\))[ \t]*\\'")
3720 ;; "<Bugs@bar.edu>" (Losing Unix) => "Losing Unix"
3721 from)))
3722 (let ((start (match-beginning 1))
3723 (end (match-end 1)))
3724 ;; Trim whitespace which above regexp match allows
3725 (while (and (< start end)
3726 (memq (aref from start) '(?\t ?\ )))
3727 (setq start (1+ start)))
3728 (while (and (< start end)
3729 (memq (aref from (1- end)) '(?\t ?\ )))
3730 (setq end (1- end)))
3731 (let ((field (substring from start end)))
3732 (if date (setq field (concat "message from " field " on " date)))
3733 (if message-id
3734 ;; "<AA259@bar.edu> (message from Unix Loser on 1-Apr-89)"
3735 (concat message-id " (" field ")")
3736 field))))
3737 (t
3738 ;; If we can't kludge it simply, do it correctly
3739 (let ((mail-use-rfc822 t))
3740 (rmail-make-in-reply-to-field from date message-id)))))
a16aef15 3741\f
8159f4af
RS
3742(defun rmail-forward (resend)
3743 "Forward the current message to another user.
3744With prefix argument, \"resend\" the message instead of forwarding it;
3745see the documentation of `rmail-resend'."
3746 (interactive "P")
3747 (if resend
3748 (call-interactively 'rmail-resend)
6b59a5fc 3749 (let ((forward-buffer rmail-buffer)
1825bea1 3750 (msgnum rmail-current-message)
8159f4af
RS
3751 (subject (concat "["
3752 (let ((from (or (mail-fetch-field "From")
3753 (mail-fetch-field ">From"))))
3754 (if from
3755 (concat (mail-strip-quoted-names from) ": ")
3756 ""))
3757 (or (mail-fetch-field "Subject") "")
3758 "]")))
bde7cb3f
RS
3759 (if (rmail-start-mail
3760 nil nil subject nil nil nil
fa2795ca 3761 (list (list 'rmail-mark-message
0985b412 3762 forward-buffer
6b59a5fc
GM
3763 (with-current-buffer rmail-buffer
3764 (aref rmail-msgref-vector msgnum))
fa2795ca 3765 "forwarded"))
bde7cb3f
RS
3766 ;; If only one window, use it for the mail buffer.
3767 ;; Otherwise, use another window for the mail buffer
3768 ;; so that the Rmail buffer remains visible
3769 ;; and sending the mail will get back to it.
3770 (and (not rmail-mail-new-frame) (one-window-p t)))
1825bea1 3771 ;; The mail buffer is now current.
b1d9bfa7 3772 (save-excursion
0f0a85b3 3773 ;; Insert after header separator--before signature if any.
c7ed80bc 3774 (goto-char (mail-text-start))
0c773047 3775 (if (or rmail-enable-mime rmail-enable-mime-composing)
6b59a5fc
GM
3776 (funcall rmail-insert-mime-forwarded-message-function
3777 forward-buffer)
3778 (insert "------- Start of forwarded message -------\n")
3779 ;; Quote lines with `- ' if they start with `-'.
3780 (let ((beg (point)) end)
3781 (setq end (point-marker))
3782 (set-marker-insertion-type end t)
3783 (insert-buffer-substring forward-buffer)
3784 (goto-char beg)
3785 (while (re-search-forward "^-" end t)
3786 (beginning-of-line)
3787 (insert "- ")
3788 (forward-line 1))
3789 (goto-char end)
3790 (skip-chars-backward "\n")
3791 (if (< (point) end)
3792 (forward-char 1))
3793 (delete-region (point) end)
3794 (set-marker end nil))
3795 (insert "------- End of forwarded message -------\n"))
1825bea1 3796 (push-mark))))))
a16aef15 3797\f
581d7e0b
RM
3798(defun rmail-resend (address &optional from comment mail-alias-file)
3799 "Resend current message to ADDRESSES.
d2fc297c 3800ADDRESSES should be a single address, a string consisting of several
581d7e0b
RM
3801addresses separated by commas, or a list of addresses.
3802
3803Optional FROM is the address to resend the message from, and
9a2fe7b2
RS
3804defaults from the value of `user-mail-address'.
3805Optional COMMENT is a string to insert as a comment in the resent message.
581d7e0b
RM
3806Optional ALIAS-FILE is alternate aliases file to be used by sendmail,
3807typically for purposes of moderating a list."
3808 (interactive "sResend to: ")
9ad8712e
RS
3809 (require 'sendmail)
3810 (require 'mailalias)
9652931f
GM
3811 (unless (or (eq rmail-view-buffer (current-buffer))
3812 (eq rmail-buffer (current-buffer)))
70908594 3813 (error "Not an Rmail buffer"))
9a2fe7b2 3814 (if (not from) (setq from user-mail-address))
581d7e0b 3815 (let ((tembuf (generate-new-buffer " sendmail temp"))
581d7e0b 3816 (case-fold-search nil)
75e6b970
RS
3817 (mail-personal-alias-file
3818 (or mail-alias-file mail-personal-alias-file))
7d8a6e1f 3819 (mailbuf rmail-buffer))
581d7e0b 3820 (unwind-protect
7d8a6e1f 3821 (with-current-buffer tembuf
581d7e0b 3822 ;;>> Copy message into temp buffer
9652931f
GM
3823 (if rmail-enable-mime
3824 (funcall rmail-insert-mime-resent-message-function mailbuf)
3825 (insert-buffer-substring mailbuf))
581d7e0b 3826 (goto-char (point-min))
e20903fb 3827 ;; Delete any Sender field, since that's not specifiable.
d2fc297c
RS
3828 ; Only delete Sender fields in the actual header.
3829 (re-search-forward "^$" nil 'move)
3830 ; Using "while" here rather than "if" because some buggy mail
3831 ; software may have inserted multiple Sender fields.
3832 (while (re-search-backward "^Sender:" nil t)
3833 (let (beg)
3834 (setq beg (point))
3835 (forward-line 1)
3836 (while (looking-at "[ \t]")
3837 (forward-line 1))
3838 (delete-region beg (point))))
3839 ; Go back to the beginning of the buffer so the Resent- fields
3840 ; are inserted there.
3841 (goto-char (point-min))
581d7e0b
RM
3842 ;;>> Insert resent-from:
3843 (insert "Resent-From: " from "\n")
bcf12025 3844 (insert "Resent-Date: " (mail-rfc822-date) "\n")
581d7e0b
RM
3845 ;;>> Insert resent-to: and bcc if need be.
3846 (let ((before (point)))
c42722e3
RS
3847 (if mail-self-blind
3848 (insert "Resent-Bcc: " (user-login-name) "\n"))
581d7e0b
RM
3849 (insert "Resent-To: " (if (stringp address)
3850 address
3851 (mapconcat 'identity address ",\n\t"))
3852 "\n")
8095bf23 3853 ;; Expand abbrevs in the recipients.
50703776 3854 (save-excursion
8095bf23 3855 (if (featurep 'mailabbrev)
3f3495d3
RS
3856 (let ((end (point-marker))
3857 (local-abbrev-table mail-abbrevs)
3858 (old-syntax-table (syntax-table)))
3859 (if (and (not (vectorp mail-abbrevs))
3860 (file-exists-p mail-personal-alias-file))
3861 (build-mail-abbrevs))
ed1086b7
RS
3862 (unless mail-abbrev-syntax-table
3863 (mail-abbrev-make-syntax-table))
3f3495d3
RS
3864 (set-syntax-table mail-abbrev-syntax-table)
3865 (goto-char before)
3866 (while (and (< (point) end)
3867 (progn (forward-word 1)
3868 (<= (point) end)))
3869 (expand-abbrev))
3870 (set-syntax-table old-syntax-table))
8095bf23 3871 (expand-mail-aliases before (point)))))
581d7e0b
RM
3872 ;;>> Set up comment, if any.
3873 (if (and (sequencep comment) (not (zerop (length comment))))
3874 (let ((before (point))
3875 after)
3876 (insert comment)
3877 (or (eolp) (insert "\n"))
3878 (setq after (point))
3879 (goto-char before)
3880 (while (< (point) after)
3881 (insert "Resent-Comment: ")
3882 (forward-line 1))))
3883 ;; Don't expand aliases in the destination fields
3884 ;; of the original message.
3885 (let (mail-aliases)
389e8f11 3886 (funcall send-mail-function)))
8159f4af 3887 (kill-buffer tembuf))
7d8a6e1f
KH
3888 (with-current-buffer rmail-buffer
3889 (rmail-set-attribute "resent" t rmail-current-message))))
a16aef15 3890\f
72e609d0 3891(defvar mail-unsent-separator
f2da0c68
RS
3892 (concat "^ *---+ +Unsent message follows +---+ *$\\|"
3893 "^ *---+ +Returned message +---+ *$\\|"
dc47993c 3894 "^ *---+ *Returned mail follows *---+ *$\\|"
20424e68 3895 "^Start of returned message$\\|"
0599b925 3896 "^---+ Below this line is a copy of the message.$\\|"
db32c193 3897 "^ *---+ +Original message +---+ *$\\|"
487fcdc0 3898 "^ *--+ +begin message +--+ *$\\|"
c42722e3 3899 "^ *---+ +Original message follows +---+ *$\\|"
f980ec39 3900 "^ *---+ +Your message follows +---+ *$\\|"
ea0d05b4 3901 "^|? *---+ +Message text follows: +---+ *|?$\\|"
c70d7359 3902 "^ *---+ +This is a copy of \\w+ message, including all the headers.*---+ *$")
03863002 3903 "A regexp that matches the separator before the text of a failed message.")
581d7e0b 3904
55a42e8c
RS
3905(defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$"
3906 "A regexp that matches the header of a MIME body part with a failed message.")
3907
581d7e0b
RM
3908(defun rmail-retry-failure ()
3909 "Edit a mail message which is based on the contents of the current message.
3910For a message rejected by the mail system, extract the interesting headers and
03863002 3911the body of the original message.
55a42e8c
RS
3912If the failed message is a MIME multipart message, it is searched for a
3913body part with a header which matches the variable `mail-mime-unsent-header'.
3914Otherwise, the variable `mail-unsent-separator' should match the string that
3db0cdac
RS
3915delimits the returned original message.
3916The variable `rmail-retry-ignored-headers' is a regular expression
3917specifying headers which should not be copied into the new message."
581d7e0b
RM
3918 (interactive)
3919 (require 'mail-utils)
2079601b 3920 (let ((rmail-this-buffer (current-buffer))
40e09f88 3921 (msgnum rmail-current-message)
ed104a87
RS
3922 bounce-start bounce-end bounce-indent resending
3923 ;; Fetch any content-type header in current message
3924 ;; Must search thru the whole unpruned header.
3925 (content-type
3926 (save-excursion
3927 (save-restriction
3928 (rmail-narrow-to-non-pruned-header)
3929 (mail-fetch-field "Content-Type") ))))
3930 (save-excursion
3931 (goto-char (point-min))
3932 (let ((case-fold-search t))
67f9d50e
FP
3933 (if (and content-type
3934 (string-match
3935 ";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?"
ed104a87
RS
3936 content-type))
3937 ;; Handle a MIME multipart bounce message.
3938 (let ((codestring
3939 (concat "\n--"
67f9d50e 3940 (substring content-type (match-beginning 1)
ed104a87
RS
3941 (match-end 1)))))
3942 (unless (re-search-forward mail-mime-unsent-header nil t)
3943 (error "Cannot find beginning of header in failed message"))
3944 (unless (search-forward "\n\n" nil t)
3945 (error "Cannot find start of Mime data in failed message"))
3946 (setq bounce-start (point))
3947 (if (search-forward codestring nil t)
3948 (setq bounce-end (match-beginning 0))
3949 (setq bounce-end (point-max))))
3950 ;; Non-MIME bounce.
3951 (or (re-search-forward mail-unsent-separator nil t)
3952 (error "Cannot parse this as a failure message"))
3953 (skip-chars-forward "\n")
3954 ;; Support a style of failure message in which the original
3955 ;; message is indented, and included within lines saying
3956 ;; `Start of returned message' and `End of returned message'.
3957 (if (looking-at " +Received:")
3958 (progn
3959 (setq bounce-start (point))
3960 (skip-chars-forward " ")
3961 (setq bounce-indent (- (current-column)))
3962 (goto-char (point-max))
3963 (re-search-backward "^End of returned message$" nil t)
3964 (setq bounce-end (point)))
3965 ;; One message contained a few random lines before
3966 ;; the old message header. The first line of the
3967 ;; message started with two hyphens. A blank line
3968 ;; followed these random lines. The same line
3969 ;; beginning with two hyphens was possibly marking
3970 ;; the end of the message.
3971 (if (looking-at "^--")
3972 (let ((boundary (buffer-substring-no-properties
3973 (point)
3974 (progn (end-of-line) (point)))))
3975 (search-forward "\n\n")
3976 (skip-chars-forward "\n")
3977 (setq bounce-start (point))
3978 (goto-char (point-max))
3979 (search-backward (concat "\n\n" boundary) bounce-start t)
3980 (setq bounce-end (point)))
3981 (setq bounce-start (point)
3982 bounce-end (point-max)))
3983 (unless (search-forward "\n\n" nil t)
3984 (error "Cannot find end of header in failed message"))))))
3985 ;; We have found the message that bounced, within the current message.
3986 ;; Now start sending new message; default header fields from original.
3987 ;; Turn off the usual actions for initializing the message body
3988 ;; because we want to get only the text from the failure message.
3989 (let (mail-signature mail-setup-hook)
3990 (if (rmail-start-mail nil nil nil nil nil rmail-this-buffer
3991 (list (list 'rmail-mark-message
3992 rmail-this-buffer
3993 (aref rmail-msgref-vector msgnum)
3994 "retried")))
3995 ;; Insert original text as initial text of new draft message.
3996 ;; Bind inhibit-read-only since the header delimiter
3997 ;; of the previous message was probably read-only.
3998 (let ((inhibit-read-only t)
3999 rmail-displayed-headers
4000 rmail-ignored-headers)
4001 (erase-buffer)
4002 (insert-buffer-substring rmail-this-buffer
4003 bounce-start bounce-end)
4004 (goto-char (point-min))
4005 (if bounce-indent
4006 (indent-rigidly (point-min) (point-max) bounce-indent))
4007 (rmail-clear-headers rmail-retry-ignored-headers)
4008 (rmail-clear-headers "^sender:\\|^return-path:\\|^received:")
4009 (mail-sendmail-delimit-header)
4010 (save-restriction
4011 (narrow-to-region (point-min) (mail-header-end))
4012 (setq resending (mail-fetch-field "resent-to"))
4013 (if mail-self-blind
4014 (if resending
4015 (insert "Resent-Bcc: " (user-login-name) "\n")
4016 (insert "BCC: " (user-login-name) "\n"))))
4017 (goto-char (point-min))
4018 (mail-position-on-field (if resending "Resent-To" "To") t))))))
a16aef15 4019\f
bd1f0f84 4020(defun rmail-summary-exists ()
81bb49ce 4021 "Non-nil if in an RMAIL buffer and an associated summary buffer exists.
90254bb0 4022In fact, the non-nil value returned is the summary buffer itself."
bd1f0f84
RS
4023 (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
4024 rmail-summary-buffer))
4025
4026(defun rmail-summary-displayed ()
81bb49ce 4027 "t if in RMAIL buffer and an associated summary buffer is displayed."
bd1f0f84
RS
4028 (and rmail-summary-buffer (get-buffer-window rmail-summary-buffer)))
4029
9bb97fe9 4030(defcustom rmail-redisplay-summary nil
bd1f0f84 4031 "*Non-nil means Rmail should show the summary when it changes.
9bb97fe9
RS
4032This has an effect only if a summary buffer exists."
4033 :type 'boolean
4034 :group 'rmail-summary)
4035
4036(defcustom rmail-summary-window-size nil
4037 "*Non-nil means specify the height for an Rmail summary window."
d177349a 4038 :type '(choice (const :tag "Disabled" nil) integer)
9bb97fe9 4039 :group 'rmail-summary)
90254bb0 4040
bd1f0f84
RS
4041;; Put the summary buffer back on the screen, if user wants that.
4042(defun rmail-maybe-display-summary ()
90254bb0
RS
4043 (let ((selected (selected-window))
4044 window)
4045 ;; If requested, make sure the summary is displayed.
4046 (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
4047 rmail-redisplay-summary
6b265868
RS
4048 (if (get-buffer-window rmail-summary-buffer 0)
4049 ;; It's already in some frame; show that one.
4050 (let ((frame (window-frame
4051 (get-buffer-window rmail-summary-buffer 0))))
4052 (make-frame-visible frame)
4053 (raise-frame frame))
4054 (display-buffer rmail-summary-buffer)))
90254bb0
RS
4055 ;; If requested, set the height of the summary window.
4056 (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
4057 rmail-summary-window-size
4058 (setq window (get-buffer-window rmail-summary-buffer))
6b265868
RS
4059 ;; Don't try to change the size if just one window in frame.
4060 (not (eq window (frame-root-window (window-frame window))))
67f9d50e 4061 (unwind-protect
90254bb0
RS
4062 (progn
4063 (select-window window)
35aba739 4064 (enlarge-window (- rmail-summary-window-size (window-height))))
90254bb0 4065 (select-window selected)))))
581d7e0b 4066\f
271c888a
SM
4067;;;; *** Rmail Local Fontification ***
4068
4069(defun rmail-fontify-buffer-function ()
4070 ;; This function's symbol is bound to font-lock-fontify-buffer-function.
f512e4c0 4071 (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t)
35aba739
SM
4072 ;; If we're already showing a message, fontify it now.
4073 (if rmail-current-message (rmail-fontify-message))
4074 ;; Prevent Font Lock mode from kicking in.
f512e4c0 4075 (setq font-lock-fontified t))
271c888a
SM
4076
4077(defun rmail-unfontify-buffer-function ()
4078 ;; This function's symbol is bound to font-lock-fontify-unbuffer-function.
f512e4c0
SM
4079 (let ((modified (buffer-modified-p))
4080 (buffer-undo-list t) (inhibit-read-only t)
4081 before-change-functions after-change-functions
4082 buffer-file-name buffer-file-truename)
4083 (save-restriction
4084 (widen)
4085 (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t)
4086 (remove-text-properties (point-min) (point-max) '(rmail-fontified nil))
1afb7be2
RS
4087 (font-lock-default-unfontify-buffer)
4088 (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil)))))
271c888a
SM
4089
4090(defun rmail-fontify-message ()
4091 ;; Fontify the current message if it is not already fontified.
4092 (if (text-property-any (point-min) (point-max) 'rmail-fontified nil)
4093 (let ((modified (buffer-modified-p))
4094 (buffer-undo-list t) (inhibit-read-only t)
4095 before-change-functions after-change-functions
4096 buffer-file-name buffer-file-truename)
4097 (save-excursion
4098 (save-match-data
4099 (add-text-properties (point-min) (point-max) '(rmail-fontified t))
1afb7be2
RS
4100 (font-lock-fontify-region (point-min) (point-max))
4101 (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil)))))))
b04fa5c5 4102\f
03c9127e 4103;;; Speedbar support for RMAIL files.
b04fa5c5
KH
4104(eval-when-compile (require 'speedbar))
4105
4106(defvar rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
82e736c1 4107 "*This regex is used to match folder names to be displayed in speedbar.
b04fa5c5
KH
4108Enabling this will permit speedbar to display your folders for easy
4109browsing, and moving of messages.")
03c9127e
EL
4110
4111(defvar rmail-speedbar-last-user nil
4112 "The last user to be displayed in the speedbar.")
4113
b04fa5c5
KH
4114(defvar rmail-speedbar-key-map nil
4115 "Keymap used when in rmail display mode.")
4116
4117(defun rmail-install-speedbar-variables ()
4118 "Install those variables used by speedbar to enhance rmail."
4119 (if rmail-speedbar-key-map
4120 nil
4121 (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap))
4122
4123 (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line)
4124 (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line)
4125 (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line)
4126 (define-key rmail-speedbar-key-map "M"
4127 'rmail-speedbar-move-message-to-folder-on-line)))
4128
03c9127e 4129(defvar rmail-speedbar-menu-items
b04fa5c5
KH
4130 '(["Read Folder" speedbar-edit-line t]
4131 ["Move message to folder" rmail-speedbar-move-message-to-folder-on-line
03c9127e
EL
4132 (save-excursion (beginning-of-line)
4133 (looking-at "<M> "))])
4134 "Additional menu-items to add to speedbar frame.")
4135
b04fa5c5
KH
4136;; Make sure our special speedbar major mode is loaded
4137(if (featurep 'speedbar)
4138 (rmail-install-speedbar-variables)
4139 (add-hook 'speedbar-load-hook 'rmail-install-speedbar-variables))
4140
03c9127e
EL
4141(defun rmail-speedbar-buttons (buffer)
4142 "Create buttons for BUFFER containing rmail messages.
4143Click on the address under Reply to: to reply to this person.
4144Under Folders: Click a name to read it, or on the <M> to move the
4145current message into that RMAIL folder."
4146 (let ((from nil))
4147 (save-excursion
4148 (set-buffer buffer)
4149 (goto-char (point-min))
4150 (if (not (re-search-forward "^Reply-To: " nil t))
4151 (if (not (re-search-forward "^From:? " nil t))
4152 (setq from t)))
4153 (if from
4154 nil
4155 (setq from (buffer-substring (point) (save-excursion
4156 (end-of-line)
4157 (point))))))
4158 (goto-char (point-min))
4159 (if (and (looking-at "Reply to:")
4160 (equal from rmail-speedbar-last-user))
4161 nil
4162 (setq rmail-speedbar-last-user from)
4163 (erase-buffer)
4164 (insert "Reply To:\n")
4165 (if (stringp from)
4166 (speedbar-insert-button from 'speedbar-directory-face 'highlight
4167 'rmail-speedbar-button 'rmail-reply))
4168 (insert "Folders:\n")
4169 (let* ((case-fold-search nil)
4170 (df (directory-files (save-excursion (set-buffer buffer)
4171 default-directory)
b04fa5c5 4172 nil rmail-speedbar-match-folder-regexp)))
03c9127e
EL
4173 (while df
4174 (speedbar-insert-button "<M>" 'speedbar-button-face 'highlight
4175 'rmail-speedbar-move-message (car df))
4176 (speedbar-insert-button (car df) 'speedbar-file-face 'highlight
4177 'rmail-speedbar-find-file nil t)
4178 (setq df (cdr df)))))))
4179
4180(defun rmail-speedbar-button (text token indent)
4181 "Execute an rmail command specified by TEXT.
4182The command used is TOKEN. INDENT is not used."
4183 (speedbar-with-attached-buffer
4184 (funcall token t)))
4185
4186(defun rmail-speedbar-find-file (text token indent)
4187 "Load in the rmail file TEXT.
4188TOKEN and INDENT are not used."
4189 (speedbar-with-attached-buffer
4190 (message "Loading in RMAIL file %s..." text)
4191 (find-file text)))
4192
b04fa5c5 4193(defun rmail-speedbar-move-message-to-folder-on-line ()
03c9127e
EL
4194 "If the current line is a folder, move current message to it."
4195 (interactive)
4196 (save-excursion
4197 (beginning-of-line)
4198 (if (re-search-forward "<M> " (save-excursion (end-of-line) (point)) t)
4199 (progn
4200 (forward-char -2)
4201 (speedbar-do-function-pointer)))))
4202
4203(defun rmail-speedbar-move-message (text token indent)
4204 "From button TEXT, copy current message to the rmail file specified by TOKEN.
4205TEXT and INDENT are not used."
4206 (speedbar-with-attached-buffer
4207 (message "Moving message to %s" token)
4208 (rmail-output-to-rmail-file token)))
4209
639540ec
RS
4210; Functions for setting, getting and encoding the POP password.
4211; The password is encoded to prevent it from being easily accessible
4212; to "prying eyes." Obviously, this encoding isn't "real security,"
4213; nor is it meant to be.
4214
4215;;;###autoload
1086788e
EZ
4216(defun rmail-set-remote-password (password)
4217 "Set PASSWORD to be used for retrieving mail from a POP or IMAP server."
639540ec
RS
4218 (interactive "sPassword: ")
4219 (if password
1086788e 4220 (setq rmail-encoded-remote-password
639540ec 4221 (rmail-encode-string password (emacs-pid)))
1086788e
EZ
4222 (setq rmail-remote-password nil)
4223 (setq rmail-encoded-remote-password nil)))
639540ec 4224
1086788e
EZ
4225(defun rmail-get-remote-password (imap)
4226 "Get the password for retrieving mail from a POP or IMAP server. If none
639540ec 4227has been set, then prompt the user for one."
1086788e
EZ
4228 (when (not rmail-encoded-remote-password)
4229 (if (not rmail-remote-password)
4230 (setq rmail-remote-password
4231 (read-passwd (if imap
4232 "IMAP password: "
4233 "POP password: "))))
4234 (rmail-set-remote-password rmail-remote-password)
4235 (setq rmail-remote-password nil))
4236 (rmail-encode-string rmail-encoded-remote-password (emacs-pid)))
639540ec
RS
4237
4238(defun rmail-have-password ()
1086788e 4239 (or rmail-remote-password rmail-encoded-remote-password))
639540ec
RS
4240
4241(defun rmail-encode-string (string mask)
4242 "Encode STRING with integer MASK, by taking the exclusive OR of the
4243lowest byte in the mask with the first character of string, the
4244second-lowest-byte with the second character of the string, etc.,
4245restarting at the lowest byte of the mask whenever it runs out.
4246Returns the encoded string. Calling the function again with an
4247encoded string (and the same mask) will decode the string."
7d6d84c1 4248 (setq mask (abs mask)) ; doesn't work if negative
67f9d50e 4249 (let* ((string-vector (string-to-vector string)) (i 0)
639540ec
RS
4250 (len (length string-vector)) (curmask mask) charmask)
4251 (while (< i len)
4252 (if (= curmask 0)
4253 (setq curmask mask))
4254 (setq charmask (% curmask 256))
4255 (setq curmask (lsh curmask -8))
4256 (aset string-vector i (logxor charmask (aref string-vector i)))
4257 (setq i (1+ i)))
4258 (concat string-vector)))
03c9127e 4259
431f70e0
LH
4260;;;; Desktop support
4261
431f70e0
LH
4262(defun rmail-restore-desktop-buffer (desktop-buffer-file-name
4263 desktop-buffer-name
4264 desktop-buffer-misc)
4265 "Restore an rmail buffer specified in a desktop file."
4266 (condition-case error
4267 (progn
4268 (rmail-input desktop-buffer-file-name)
4269 (if (eq major-mode 'rmail-mode)
4270 (current-buffer)
4271 rmail-buffer))
4272 (file-locked
4273 (kill-buffer (current-buffer))
4274 nil)))
4275
9e7357b0
AS
4276(add-to-list 'desktop-buffer-mode-handlers
4277 '(rmail-mode . rmail-restore-desktop-buffer))
695a1fa4 4278
49116ac0
JB
4279(provide 'rmail)
4280
608aa380 4281;;; arch-tag: cff0a950-57fe-4f73-a86e-91ff75afd06c
c88ab9ce 4282;;; rmail.el ends here