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