]> code.delx.au - gnu-emacs/blob - lisp/mail/pmail.el
ea287927801639280da53fbffaf0c258b65f6387
[gnu-emacs] / lisp / mail / pmail.el
1 ;;; pmail.el --- main code of "PMAIL" mail reader for Emacs
2
3 ;; Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
4 ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
5 ; Free Software Foundation, Inc.
6
7 ;; Maintainer: FSF
8 ;; Keywords: mail
9
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
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) 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
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25 ;;; Commentary:
26
27 ;;; Code:
28
29 ;; Souped up by shane@mit-ajax based on ideas of rlk@athena.mit.edu
30 ;; New features include attribute and keyword support, message
31 ;; selection by dispatch table, summary by attributes and keywords,
32 ;; expunging by dispatch table, sticky options for file commands.
33
34 ;; Extended by Bob Weiner of Motorola
35 ;; New features include: pmail and pmail-summary buffers remain
36 ;; synchronized and key bindings basically operate the same way in both
37 ;; buffers, summary by topic or by regular expression, pmail-reply-prefix
38 ;; variable, and a bury pmail buffer (wipe) command.
39 ;;
40
41 (eval-when-compile
42 (require 'font-lock)
43 (require 'mailabbrev)
44 (require 'mule-util)) ; for detect-coding-with-priority
45
46 (require 'pmaildesc)
47 (require 'pmailhdr)
48 (require 'pmailkwd)
49 (require 'mail-parse)
50
51 (defvar deleted-head)
52 (defvar font-lock-fontified)
53 (defvar mail-abbrev-syntax-table)
54 (defvar mail-abbrevs)
55 (defvar messages-head)
56 (defvar rsf-beep)
57 (defvar rsf-sleep-after-message)
58 (defvar total-messages)
59 (defvar tool-bar-map)
60
61 ; These variables now declared in paths.el.
62 ;(defvar pmail-spool-directory "/usr/spool/mail/"
63 ; "This is the name of the directory used by the system mailer for\n\
64 ;delivering new mail. Its name should end with a slash.")
65 ;(defvar pmail-file-name
66 ; (expand-file-name "~/PMAIL")
67 ; "")
68
69 ;; Temporary support for mbox.
70 (defcustom pmail-file-name "~/PMAIL"
71 "*Name of user's primary mail file."
72 :type 'string
73 :group 'rmail
74 :version "21.1")
75
76 (defgroup pmail nil
77 "Mail reader for Emacs."
78 :group 'mail)
79
80 (defgroup pmail-retrieve nil
81 "Pmail retrieval options."
82 :prefix "pmail-"
83 :group 'pmail)
84
85 (defgroup pmail-files nil
86 "Pmail files."
87 :prefix "pmail-"
88 :group 'pmail)
89
90 (defgroup pmail-headers nil
91 "Pmail header options."
92 :prefix "pmail-"
93 :group 'pmail)
94
95 (defgroup pmail-reply nil
96 "Pmail reply options."
97 :prefix "pmail-"
98 :group 'pmail)
99
100 (defgroup pmail-summary nil
101 "Pmail summary options."
102 :prefix "pmail-"
103 :prefix "pmail-summary-"
104 :group 'pmail)
105
106 (defgroup pmail-output nil
107 "Output message to a file."
108 :prefix "pmail-output-"
109 :prefix "pmail-"
110 :group 'pmail)
111
112 (defgroup pmail-edit nil
113 "Pmail editing."
114 :prefix "pmail-edit-"
115 :group 'pmail)
116
117 (defgroup pmail-obsolete nil
118 "Pmail obsolete customization variables."
119 :group 'pmail)
120
121 (defcustom pmail-movemail-program nil
122 "If non-nil, the file name of the `movemail' program."
123 :group 'pmail-retrieve
124 :type '(choice (const nil) string))
125
126 (defcustom pmail-pop-password nil
127 "*Password to use when reading mail from POP server.
128 Please use `pmail-remote-password' instead."
129 :type '(choice (string :tag "Password")
130 (const :tag "Not Required" nil))
131 :group 'pmail-obsolete)
132
133 (defcustom pmail-pop-password-required nil
134 "*Non-nil if a password is required when reading mail from a POP server.
135 Please use pmail-remote-password-required instead."
136 :type 'boolean
137 :group 'pmail-obsolete)
138
139 (defcustom pmail-remote-password nil
140 "*Password to use when reading mail from a remote server.
141 This setting is ignored for mailboxes whose URL already contains a password."
142 :type '(choice (string :tag "Password")
143 (const :tag "Not Required" nil))
144 :set-after '(pmail-pop-password)
145 :set #'(lambda (symbol value)
146 (set-default symbol
147 (if (and (not value)
148 (boundp 'pmail-pop-password)
149 pmail-pop-password)
150 pmail-pop-password
151 value))
152 (setq pmail-pop-password nil))
153 :group 'pmail-retrieve
154 :version "22.1")
155
156 (defcustom pmail-remote-password-required nil
157 "*Non-nil if a password is required when reading mail from a remote server."
158 :type 'boolean
159 :set-after '(pmail-pop-password-required)
160 :set #'(lambda (symbol value)
161 (set-default symbol
162 (if (and (not value)
163 (boundp 'pmail-pop-password-required)
164 pmail-pop-password-required)
165 pmail-pop-password-required
166 value))
167 (setq pmail-pop-password-required nil))
168 :group 'pmail-retrieve
169 :version "22.1")
170
171 (defcustom pmail-movemail-flags nil
172 "*List of flags to pass to movemail.
173 Most commonly used to specify `-g' to enable GSS-API authentication
174 or `-k' to enable Kerberos authentication."
175 :type '(repeat string)
176 :group 'pmail-retrieve
177 :version "20.3")
178
179 (defvar pmail-remote-password-error "invalid usercode or password\\|
180 unknown user name or bad password\\|Authentication failed\\|MU_ERR_AUTH_FAILURE"
181 "Regular expression matching incorrect-password POP or IMAP server error
182 messages.
183 If you get an incorrect-password error that this expression does not match,
184 please report it with \\[report-emacs-bug].")
185
186 (defvar pmail-encoded-remote-password nil)
187
188 (defvar pmail-expunge-counter 0
189 "A counter used to keep track of the number of expunged
190 messages with a lower message number than the current message
191 index.")
192
193 (defcustom pmail-preserve-inbox nil
194 "*Non-nil means leave incoming mail in the user's inbox--don't delete it."
195 :type 'boolean
196 :group 'pmail-retrieve)
197
198 (defcustom pmail-movemail-search-path nil
199 "*List of directories to search for movemail (in addition to `exec-path')."
200 :group 'pmail-retrieve
201 :type '(repeat (directory)))
202
203 (declare-function mail-position-on-field "sendmail" (field &optional soft))
204 (declare-function mail-text-start "sendmail" ())
205 (declare-function pmail-update-summary "pmailsum" (&rest ignore))
206 (declare-function unrmail "unrmail" (file to-file))
207 (declare-function rmail-dont-reply-to "mail-utils" (destinations))
208 (declare-function pmail-summary-goto-msg "pmailsum" (&optional n nowarn skip-pmail))
209 (declare-function pmail-summary-pmail-update "pmailsum" ())
210 (declare-function pmail-summary-update "pmailsum" (n))
211
212 (defun pmail-probe (prog)
213 "Determine what flavor of movemail PROG is.
214 We do this by executing it with `--version' and analyzing its output."
215 (with-temp-buffer
216 (let ((tbuf (current-buffer)))
217 (buffer-disable-undo tbuf)
218 (call-process prog nil tbuf nil "--version")
219 (if (not (buffer-modified-p tbuf))
220 ;; Should not happen...
221 nil
222 (goto-char (point-min))
223 (cond
224 ((looking-at ".*movemail: invalid option")
225 'emacs) ;; Possibly...
226 ((looking-at "movemail (GNU Mailutils .*)")
227 'mailutils)
228 (t
229 ;; FIXME:
230 'emacs))))))
231
232 (defun pmail-autodetect ()
233 "Determine the file name of the `movemail' program and return its flavor.
234 If `pmail-movemail-program' is non-nil, use it.
235 Otherwise, look for `movemail' in the directories in
236 `pmail-movemail-search-path', those in `exec-path', and `exec-directory'."
237 (if pmail-movemail-program
238 (pmail-probe pmail-movemail-program)
239 (catch 'scan
240 (dolist (dir (append pmail-movemail-search-path exec-path
241 (list exec-directory)))
242 (when (and dir (file-accessible-directory-p dir))
243 ;; Previously, this didn't have to work on Windows, because
244 ;; pmail-insert-inbox-text before r1.439 fell back to using
245 ;; (expand-file-name "movemail" exec-directory) and just
246 ;; assuming it would work.
247 ;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-02/msg00087.html
248 (let ((progname (expand-file-name
249 (concat "movemail"
250 (if (memq system-type '(ms-dos windows-nt))
251 ".exe")) dir)))
252 (when (and (not (file-directory-p progname))
253 (file-executable-p progname))
254 (let ((x (pmail-probe progname)))
255 (when x
256 (setq pmail-movemail-program progname)
257 (throw 'scan x))))))))))
258
259 (defvar pmail-movemail-variant-in-use nil
260 "The movemail variant currently in use. Known variants are:
261
262 `emacs' Means any implementation, compatible with the native Emacs one.
263 This is the default;
264 `mailutils' Means GNU mailutils implementation, capable of handling full
265 mail URLs as the source mailbox.")
266
267 ;;;###autoload
268 (defun pmail-movemail-variant-p (&rest variants)
269 "Return t if the current movemail variant is any of VARIANTS.
270 Currently known variants are 'emacs and 'mailutils."
271 (when (not pmail-movemail-variant-in-use)
272 ;; Autodetect
273 (setq pmail-movemail-variant-in-use (pmail-autodetect)))
274 (not (null (member pmail-movemail-variant-in-use variants))))
275
276 ;; Call for effect, to set pmail-movemail-program (if not set by the
277 ;; user), and pmail-movemail-variant-in-use. Used by various functions.
278 ;; I'm not sure if M-x pmail is the only entry point to this package.
279 ;; If so, this can be moved there.
280 (pmail-movemail-variant-p)
281
282 ;;;###autoload
283 (defcustom pmail-dont-reply-to-names nil "\
284 *A regexp specifying addresses to prune from a reply message.
285 A value of nil means exclude your own email address as an address
286 plus whatever is specified by `pmail-default-dont-reply-to-names'."
287 :type '(choice regexp (const :tag "Your Name" nil))
288 :group 'pmail-reply)
289
290 ;;;###autoload
291 (defvar pmail-default-dont-reply-to-names "\\`info-" "\
292 A regular expression specifying part of the default value of the
293 variable `pmail-dont-reply-to-names', for when the user does not set
294 `pmail-dont-reply-to-names' explicitly. (The other part of the default
295 value is the user's email address and name.)
296 It is useful to set this variable in the site customization file.")
297
298 ;;;###autoload
299 (defcustom pmail-ignored-headers
300 (concat "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^sender:"
301 "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:"
302 "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:"
303 "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:"
304 "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^face:"
305 "\\|^x-mailer:\\|^delivered-to:\\|^lines:"
306 "\\|^content-transfer-encoding:\\|^x-coding-system:"
307 "\\|^return-path:\\|^errors-to:\\|^return-receipt-to:"
308 "\\|^precedence:\\|^list-help:\\|^list-post:\\|^list-subscribe:"
309 "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:"
310 "\\|^content-length:\\|^nntp-posting-date:\\|^user-agent"
311 "\\|^importance:\\|^envelope-to:\\|^delivery-date\\|^openpgp:"
312 "\\|^mbox-line:\\|^cancel-lock:\\|^DomainKey-Signature:"
313 "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:"
314 "\\|^x-.*:\\|^domainkey-signature:\\|^original-recipient:\\|^from ")
315 "*Regexp to match header fields that Pmail should normally hide.
316 \(See also `pmail-nonignored-headers', which overrides this regexp.)
317 This variable is used for reformatting the message header,
318 which normally happens once for each message,
319 when you view the message for the first time in Pmail.
320 To make a change in this variable take effect
321 for a message that you have already viewed,
322 go to that message and type \\[pmail-toggle-header] twice."
323 :type 'regexp
324 :group 'pmail-headers)
325
326 (defcustom pmail-nonignored-headers "^x-spam-status:"
327 "*Regexp to match X header fields that Pmail should show.
328 This regexp overrides `pmail-ignored-headers'; if both this regexp
329 and that one match a certain header field, Pmail shows the field.
330 If this is nil, ignore all header fields in `pmail-ignored-headers'.
331
332 This variable is used for reformatting the message header,
333 which normally happens once for each message,
334 when you view the message for the first time in Pmail.
335 To make a change in this variable take effect
336 for a message that you have already viewed,
337 go to that message and type \\[pmail-toggle-header] twice."
338 :type '(choice (const nil) (regexp))
339 :group 'pmail-headers)
340
341 ;;;###autoload
342 (defcustom pmail-displayed-headers nil
343 "*Regexp to match Header fields that Pmail should display.
344 If nil, display all header fields except those matched by
345 `pmail-ignored-headers'."
346 :type '(choice regexp (const :tag "All"))
347 :group 'pmail-headers)
348
349 ;;;###autoload
350 (defcustom pmail-retry-ignored-headers "^x-authentication-warning:" "\
351 *Headers that should be stripped when retrying a failed message."
352 :type '(choice regexp (const nil :tag "None"))
353 :group 'pmail-headers)
354
355 ;;;###autoload
356 (defcustom pmail-highlighted-headers "^From:\\|^Subject:" "\
357 *Regexp to match Header fields that Pmail should normally highlight.
358 A value of nil means don't highlight.
359 See also `pmail-highlight-face'."
360 :type 'regexp
361 :group 'pmail-headers)
362
363 (defface pmail-highlight
364 '((t (:inherit highlight)))
365 "Face to use for highlighting the most important header fields."
366 :group 'pmail-headers
367 :version "22.1")
368
369 (defface pmail-header-name
370 '((t (:inherit font-lock-function-name-face)))
371 "Face to use for highlighting the header names."
372 :group 'pmail-headers
373 :version "23.1")
374
375 ;;;###autoload
376 (defcustom pmail-highlight-face 'pmail-highlight "\
377 *Face used by Pmail for highlighting sender and subject.
378 See `pmail-font-lock-keywords'."
379 :type '(choice (const :tag "Default" nil)
380 face)
381 :group 'pmail-headers)
382
383 ;;;###autoload
384 (defcustom pmail-delete-after-output nil "\
385 *Non-nil means automatically delete a message that is copied to a file."
386 :type 'boolean
387 :group 'pmail-files)
388
389 ;;;###autoload
390 (defcustom pmail-primary-inbox-list nil "\
391 *List of files which are inboxes for user's primary mail file `~/PMAIL'.
392 nil means the default, which is (\"/usr/spool/mail/$USER\")
393 \(the name varies depending on the operating system,
394 and the value of the environment variable MAIL overrides it)."
395 ;; Don't use backquote here, because we don't want to need it
396 ;; at load time.
397 :type (list 'choice '(const :tag "Default" nil)
398 (list 'repeat ':value (list (or (getenv "MAIL")
399 (concat "/var/spool/mail/"
400 (getenv "USER"))))
401 'file))
402 :group 'pmail-retrieve
403 :group 'pmail-files)
404
405 ;;;###autoload
406 (defcustom pmail-inbox-alist nil
407 "*Alist of mail files and backup directory names.
408 Each element has the form (MAIL-FILE INBOX ...). When running
409 pmail on MAIL-FILE, mails in all the INBOX files listed will be
410 moved to the MAIL-FILE. Be sure to fully qualify your MAIL-FILE.
411
412 Example setting if procmail delivers all your spam to
413 ~/Mail/SPAM.in and you read it from the file ~/Mail/SPAM:
414
415 \(setq pmail-inbox-alist '((\"~/Mail/SPAM\" \"~/Mail/SPAM.in\")))"
416 :type '(alist :key-type file :value-type (repeat file))
417 :group 'pmail-retrieve
418 :group 'pmail-files
419 :version "22.1")
420
421 ;;;###autoload
422 (defcustom pmail-mail-new-frame nil
423 "*Non-nil means Pmail makes a new frame for composing outgoing mail.
424 This is handy if you want to preserve the window configuration of
425 the frame where you have the PMAIL buffer displayed."
426 :type 'boolean
427 :group 'pmail-reply)
428
429 ;;;###autoload
430 (defcustom pmail-secondary-file-directory "~/"
431 "*Directory for additional secondary Pmail files."
432 :type 'directory
433 :group 'pmail-files)
434 ;;;###autoload
435 (defcustom pmail-secondary-file-regexp "\\.xmail$"
436 "*Regexp for which files are secondary Pmail files."
437 :type 'regexp
438 :group 'pmail-files)
439
440 ;;;###autoload
441 (defcustom pmail-confirm-expunge 'y-or-n-p
442 "*Whether and how to ask for confirmation before expunging deleted messages."
443 :type '(choice (const :tag "No confirmation" nil)
444 (const :tag "Confirm with y-or-n-p" y-or-n-p)
445 (const :tag "Confirm with yes-or-no-p" yes-or-no-p))
446 :version "21.1"
447 :group 'pmail-files)
448
449 ;;;###autoload
450 (defvar pmail-mode-hook nil
451 "List of functions to call when Pmail is invoked.")
452
453 ;;;###autoload
454 (defvar pmail-get-new-mail-hook nil
455 "List of functions to call when Pmail has retrieved new mail.")
456
457 ;;;###autoload
458 (defcustom pmail-show-message-hook nil
459 "List of functions to call when Pmail displays a message."
460 :type 'hook
461 :options '(goto-address)
462 :group 'pmail)
463
464 ;;;###autoload
465 (defvar pmail-quit-hook nil
466 "List of functions to call when quitting out of Pmail.")
467
468 ;;;###autoload
469 (defvar pmail-delete-message-hook nil
470 "List of functions to call when Pmail deletes a message.
471 When the hooks are called, the message has been marked deleted but is
472 still the current message in the Pmail buffer.")
473
474 ;; These may be altered by site-init.el to match the format of mmdf files
475 ;; delimiting used on a given host (delim1 and delim2 from the config
476 ;; files).
477
478 (defvar pmail-mmdf-delim1 "^\001\001\001\001\n"
479 "Regexp marking the start of an mmdf message.")
480 (defvar pmail-mmdf-delim2 "^\001\001\001\001\n"
481 "Regexp marking the end of an mmdf message.")
482
483 (defcustom pmail-message-filter nil
484 "If non-nil, a filter function for new messages in PMAIL.
485 Called with region narrowed to the message, including headers,
486 before obeying `pmail-ignored-headers'."
487 :group 'pmail-headers
488 :type '(choice (const nil) function))
489
490 (defcustom pmail-automatic-folder-directives nil
491 "List of directives specifying where to put a message.
492 Each element of the list is of the form:
493
494 (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... )
495
496 Where FOLDERNAME is the name of a BABYL Version 6 (also known as mbox
497 or Unix inbox format) folder to put the message. If any of the field
498 regexp's are nil, then it is ignored.
499
500 If FOLDERNAME is \"/dev/null\", it is deleted.
501 If FOLDERNAME is nil then it is deleted, and skipped.
502
503 FIELD is the plain text name of a field in the message, such as
504 \"subject\" or \"from\". A FIELD of \"to\" will automatically include
505 all text from the \"cc\" field as well.
506
507 REGEXP is an expression to match in the preceeding specified FIELD.
508 FIELD/REGEXP pairs continue in the list.
509
510 examples:
511 (\"/dev/null\" \"from\" \"@spam.com\") ; delete all mail from spam.com
512 (\"RMS\" \"from\" \"rms@\") ; save all mail from RMS."
513 :group 'pmail
514 :version "21.1"
515 :type '(repeat (sexp :tag "Directive")))
516
517 (defvar pmail-reply-prefix "Re: "
518 "String to prepend to Subject line when replying to a message.")
519
520 ;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:".
521 ;; This pattern should catch all the common variants.
522 ;; rms: I deleted the change to delete tags in square brackets
523 ;; because they mess up RT tags.
524 (defvar pmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*"
525 "Regexp to delete from Subject line before inserting `pmail-reply-prefix'.")
526
527 (defcustom pmail-display-summary nil
528 "*If non-nil, Pmail always displays the summary buffer."
529 :group 'pmail-summary
530 :type 'boolean)
531 \f
532 (defvar pmail-inbox-list nil)
533 (put 'pmail-inbox-list 'permanent-local t)
534
535 (defvar pmail-keywords nil)
536 (put 'pmail-keywords 'permanent-local t)
537
538 (defvar pmail-buffer nil
539 "The PMAIL buffer related to the current buffer.
540 In an PMAIL buffer, this holds the PMAIL buffer itself.
541 In a summary buffer, this holds the PMAIL buffer it is a summary for.")
542 (put 'pmail-buffer 'permanent-local t)
543
544 ;; Message counters and markers. Deleted flags.
545
546 (defvar pmail-current-message nil)
547 (put 'pmail-current-message 'permanent-local t)
548
549 (defvar pmail-total-messages nil)
550 (put 'pmail-total-messages 'permanent-local t)
551
552 (defvar pmail-overlay-list nil)
553 (put 'pmail-overlay-list 'permanent-local t)
554
555 ;; These are used by autoloaded pmail-summary.
556
557 (defvar pmail-summary-buffer nil)
558 (put 'pmail-summary-buffer 'permanent-local t)
559
560 (defvar pmail-view-buffer nil
561 "Buffer which holds PMAIL message for MIME displaying.")
562 (put 'pmail-view-buffer 'permanent-local t)
563 \f
564 ;; `Sticky' default variables.
565
566 ;; Last individual label specified to a or k.
567 (defvar pmail-last-label nil)
568 (put 'pmail-last-label 'permanent-local t)
569
570 ;; Last set of values specified to C-M-n, C-M-p, C-M-s or C-M-l.
571 (defvar pmail-last-multi-labels nil)
572
573 (defvar pmail-last-regexp nil)
574 (put 'pmail-last-regexp 'permanent-local t)
575
576 (defcustom pmail-default-file "~/xmail"
577 "*Default file name for \\[pmail-output]."
578 :type 'file
579 :group 'pmail-files)
580
581 (defcustom pmail-default-pmail-file "~/XMAIL"
582 "*Default file name for \\[pmail-output-to-pmail-file]."
583 :type 'file
584 :group 'pmail-files)
585
586 (defcustom pmail-default-body-file "~/mailout"
587 "*Default file name for \\[pmail-output-body-to-file]."
588 :type 'file
589 :group 'pmail-files
590 :version "20.3")
591
592 ;; Mule and MIME related variables.
593
594 ;;;###autoload
595 (defvar pmail-file-coding-system nil
596 "Coding system used in PMAIL file.
597
598 This is set to nil by default.")
599
600 ;;;###autoload
601 (defcustom pmail-enable-mime nil
602 "*If non-nil, PMAIL uses MIME feature.
603 If the value is t, PMAIL automatically shows MIME decoded message.
604 If the value is neither t nor nil, PMAIL does not show MIME decoded message
605 until a user explicitly requires it.
606
607 Even if the value is non-nil, you can't use MIME feature
608 if the feature specified by `pmail-mime-feature' is not available
609 in your session."
610 :type '(choice (const :tag "on" t)
611 (const :tag "off" nil)
612 (other :tag "when asked" ask))
613 :group 'pmail)
614
615 (defvar pmail-enable-mime-composing nil
616 "*If non-nil, PMAIL uses `pmail-insert-mime-forwarded-message-function' to forward.")
617
618 ;;;###autoload
619 (defvar pmail-show-mime-function nil
620 "Function to show MIME decoded message of PMAIL file.
621 This function is called when `pmail-enable-mime' is non-nil.
622 It is called with no argument.")
623
624 ;;;###autoload
625 (defvar pmail-insert-mime-forwarded-message-function nil
626 "Function to insert a message in MIME format so it can be forwarded.
627 This function is called if `pmail-enable-mime' or
628 `pmail-enable-mime-composing' is non-nil.
629 It is called with one argument FORWARD-BUFFER, which is a
630 buffer containing the message to forward. The current buffer
631 is the outgoing mail buffer.")
632
633 ;;;###autoload
634 (defvar pmail-insert-mime-resent-message-function nil
635 "Function to insert a message in MIME format so it can be resent.
636 This function is called if `pmail-enable-mime' is non-nil.
637 It is called with one argument FORWARD-BUFFER, which is a
638 buffer containing the message to forward. The current buffer
639 is the outgoing mail buffer.")
640
641 ;;;###autoload
642 (defvar pmail-search-mime-message-function nil
643 "Function to check if a regexp matches a MIME message.
644 This function is called if `pmail-enable-mime' is non-nil.
645 It is called with two arguments MSG and REGEXP, where
646 MSG is the message number, REGEXP is the regular expression.")
647
648 ;;;###autoload
649 (defvar pmail-search-mime-header-function nil
650 "Function to check if a regexp matches a header of MIME message.
651 This function is called if `pmail-enable-mime' is non-nil.
652 It is called with three arguments MSG, REGEXP, and LIMIT, where
653 MSG is the message number,
654 REGEXP is the regular expression,
655 LIMIT is the position specifying the end of header.")
656
657 ;;;###autoload
658 (defvar pmail-mime-feature 'pmail-mime
659 "Feature to require to load MIME support in Pmail.
660 When starting Pmail, if `pmail-enable-mime' is non-nil,
661 this feature is required with `require'.
662
663 The default value is `pmail-mime'. This feature is provided by
664 the pmail-mime package available at <http://www.m17n.org/pmail-mime/>.")
665
666 ;;;###autoload
667 (defvar pmail-decode-mime-charset t
668 "*Non-nil means a message is decoded by MIME's charset specification.
669 If this variable is nil, or the message has not MIME specification,
670 the message is decoded as normal way.
671
672 If the variable `pmail-enable-mime' is non-nil, this variables is
673 ignored, and all the decoding work is done by a feature specified by
674 the variable `pmail-mime-feature'.")
675
676 ;;;###autoload
677 (defvar pmail-mime-charset-pattern
678 (concat "^content-type:[ \t]*text/plain;"
679 "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
680 "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?")
681 "Regexp to match MIME-charset specification in a header of message.
682 The first parenthesized expression should match the MIME-charset name.")
683
684 \f
685 ;;; Regexp matching the delimiter of messages in UNIX mail format
686 ;;; (UNIX From lines), with an initial ^. Used in pmail-decode-from-line,
687 ;;; which knows the exact ordering of the \\(...\\) subexpressions.
688 (defvar pmail-unix-mail-delimiter
689 (let ((time-zone-regexp
690 (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
691 "\\|[-+]?[0-9][0-9][0-9][0-9]"
692 "\\|"
693 "\\) *")))
694 (concat
695 "^From "
696
697 ;; Many things can happen to an RFC 822 mailbox before it is put into
698 ;; a `From' line. The leading phrase can be stripped, e.g.
699 ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g.
700 ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF
701 ;; can be removed, e.g.
702 ;; From: joe@y.z (Joe K
703 ;; User)
704 ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and
705 ;; From: Joe User
706 ;; <joe@y.z>
707 ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'.
708 ;; The mailbox can be removed or be replaced by white space, e.g.
709 ;; From: "Joe User"{space}{tab}
710 ;; <joe@y.z>
711 ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996',
712 ;; where {space} and {tab} represent the Ascii space and tab characters.
713 ;; We want to match the results of any of these manglings.
714 ;; The following regexp rejects names whose first characters are
715 ;; obviously bogus, but after that anything goes.
716 "\\([^\0-\b\n-\r\^?].*\\)? "
717
718 ;; The time the message was sent.
719 "\\([^\0-\r \^?]+\\) +" ; day of the week
720 "\\([^\0-\r \^?]+\\) +" ; month
721 "\\([0-3]?[0-9]\\) +" ; day of month
722 "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
723
724 ;; Perhaps a time zone, specified by an abbreviation, or by a
725 ;; numeric offset.
726 time-zone-regexp
727
728 ;; The year.
729 " \\([0-9][0-9]+\\) *"
730
731 ;; On some systems the time zone can appear after the year, too.
732 time-zone-regexp
733
734 ;; Old uucp cruft.
735 "\\(remote from .*\\)?"
736
737 "\n"))
738 nil)
739
740 (defvar pmail-font-lock-keywords
741 ;; These are all matched case-insensitively.
742 (eval-when-compile
743 (let* ((cite-chars "[>|}]")
744 (cite-prefix "a-z")
745 (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
746 (list '("^\\(Sender\\|Resent-From\\):"
747 . font-lock-function-name-face)
748 '("^Reply-To:.*$" . font-lock-function-name-face)
749 '("^\\(From:\\)\\(.*\\(\n[ \t]+.*\\)*\\)"
750 (1 font-lock-function-name-face)
751 (2 pmail-highlight-face))
752 '("^\\(Subject:\\)\\(.*\\(\n[ \t]+.*\\)*\\)"
753 (1 font-lock-comment-face)
754 (2 pmail-highlight-face))
755 '("^X-Spam-Status:" . font-lock-keyword-face)
756 '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):"
757 . font-lock-keyword-face)
758 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
759 `(,cite-chars
760 (,(concat "\\=[ \t]*"
761 "\\(\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
762 "\\(" cite-chars "[ \t]*\\)\\)+\\)"
763 "\\(.*\\)")
764 (beginning-of-line) (end-of-line)
765 (1 font-lock-comment-delimiter-face nil t)
766 (5 font-lock-comment-face nil t)))
767 '("^\\(X-[a-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$"
768 . 'pmail-header-name))))
769 "Additional expressions to highlight in Pmail mode.")
770
771 ;; Perform BODY in the summary buffer
772 ;; in such a way that its cursor is properly updated in its own window.
773 (defmacro pmail-select-summary (&rest body)
774 `(let ((total pmail-total-messages))
775 (if (pmail-summary-displayed)
776 (let ((window (selected-window)))
777 (save-excursion
778 (unwind-protect
779 (progn
780 (pop-to-buffer pmail-summary-buffer)
781 ;; pmail-total-messages is a buffer-local var
782 ;; in the pmail buffer.
783 ;; This way we make it available for the body
784 ;; even tho the pmail buffer is not current.
785 (let ((pmail-total-messages total))
786 ,@body))
787 (select-window window))))
788 (save-excursion
789 (set-buffer pmail-summary-buffer)
790 (let ((pmail-total-messages total))
791 ,@body)))
792 (pmail-maybe-display-summary)))
793 \f
794 ;;;; *** Pmail Mode ***
795
796 ;; This variable is dynamically bound. The defvar is here to placate
797 ;; the byte compiler.
798
799 (defvar pmail-enable-multibyte nil)
800
801 ;; XXX rmail-spam-filter hasn't been tested at all with the mbox
802 ;; branch. --enberg
803 (defvar pmail-use-spam-filter nil
804 "*Non-nil to activate the rmail spam filter with pmail.
805 WARNING - this has not been tested at all with pmail.")
806
807 (defun pmail-require-mime-maybe ()
808 "Require `pmail-mime-feature' if that is non-nil.
809 Signal an error and set `pmail-mime-feature' to nil if the feature
810 isn't provided."
811 (when pmail-enable-mime
812 (condition-case err
813 (require pmail-mime-feature)
814 (error
815 (display-warning
816 :warning
817 (format "Although MIME support is requested
818 by setting `pmail-enable-mime' to non-nil, the required feature
819 `%s' (the value of `pmail-mime-feature')
820 is not available in the current session.
821 So, the MIME support is turned off for the moment."
822 pmail-mime-feature))
823 (setq pmail-enable-mime nil)))))
824
825 ;;;###autoload
826 (defun pmail (&optional file-name-arg)
827 "Read and edit incoming mail.
828 Moves messages into file named by `pmail-file-name' (a babyl format file)
829 and edits that file in PMAIL Mode.
830 Type \\[describe-mode] once editing that file, for a list of PMAIL commands.
831
832 May be called with file name as argument; then performs pmail editing on
833 that file, but does not copy any new mail into the file.
834 Interactively, if you supply a prefix argument, then you
835 have a chance to specify a file name with the minibuffer.
836
837 If `pmail-display-summary' is non-nil, make a summary for this PMAIL file."
838 (interactive (if current-prefix-arg
839 (list (read-file-name "Run pmail on PMAIL file: "))))
840 (pmail-require-mime-maybe)
841 (let* ((file-name (expand-file-name (or file-name-arg pmail-file-name)))
842 ;; Use find-buffer-visiting, not get-file-buffer, for those users
843 ;; who have find-file-visit-truename set to t.
844 (existed (find-buffer-visiting file-name))
845 ;; This binding is necessary because we must decide if we
846 ;; need code conversion while the buffer is unibyte
847 ;; (i.e. enable-multibyte-characters is nil).
848 (pmail-enable-multibyte
849 (if existed
850 (with-current-buffer existed enable-multibyte-characters)
851 (default-value 'enable-multibyte-characters)))
852 run-mail-hook msg-shown)
853 (when (and existed (eq major-mode 'pmail-edit-mode))
854 (error "Exit Pmail Edit mode before getting new mail"))
855 (if (and existed (not (verify-visited-file-modtime existed)))
856 (progn
857 (find-file file-name)
858 (when (and (verify-visited-file-modtime existed)
859 (eq major-mode 'pmail-mode))
860 (setq major-mode 'fundamental-mode)))
861 (switch-to-buffer
862 (let ((enable-local-variables nil))
863 (find-file-noselect file-name)))
864 ;; As we have read a file as raw-text, the buffer is set to
865 ;; unibyte. We must make it multibyte if necessary.
866 (when (and pmail-enable-multibyte
867 (not enable-multibyte-characters))
868 (set-buffer-multibyte t)))
869 ;; Make sure we're in pmail-mode, even if the buffer did exist and
870 ;; the file was not changed.
871 (unless (eq major-mode 'pmail-mode)
872 ;; If file looks like a Babyl file, save it to a temp file,
873 ;; convert it, and replace the current content with the
874 ;; converted content. Don't save -- let the user do it.
875 (goto-char (point-min))
876 (when (looking-at "BABYL OPTIONS:")
877 (let ((old-file (make-temp-file "pmail"))
878 (new-file (make-temp-file "pmail")))
879 (unwind-protect
880 (progn
881 (write-region (point-min) (point-max) old-file)
882 (unrmail old-file new-file)
883 (message "Replacing BABYL format with mbox format...")
884 (let ((inhibit-read-only t))
885 (erase-buffer)
886 (insert-file-contents-literally new-file))
887 (message "Replacing BABYL format with mbox format...done"))
888 (delete-file old-file)
889 (delete-file new-file))))
890 (goto-char (point-max))
891 (pmail-mode-2)
892 ;; Convert all or parts of file to a format Pmail understands
893 (pmail-convert-file)
894 ;; We use `run-mail-hook' to remember whether we should run
895 ;; `pmail-mode-hook' at the end.
896 (setq run-mail-hook t)
897 ;; Initialize the Pmail state.
898 (pmail-initialize-messages))
899 ;; Now we're back in business. The happens even if we had a
900 ;; perfectly fine file.
901 (unwind-protect
902 (unless (and (not file-name-arg) (pmail-get-new-mail))
903 (pmail-show-message (pmail-first-unseen-message)))
904 (when pmail-display-summary
905 (pmail-summary))
906 (pmail-construct-io-menu)
907 ;; Run any callbacks if the buffer was not in pmail-mode
908 (when run-mail-hook
909 (run-hooks 'pmail-mode-hook)))))
910
911 (defun pmail-convert-file ()
912 "Convert unconverted messages.
913 A message is unconverted if it doesn't have the BABYL header
914 specified in `pmail-header-attribute-header'; it is converted
915 using `pmail-convert-mbox-format'."
916 (let ((convert
917 (save-restriction
918 (widen)
919 (let ((case-fold-search nil)
920 (start (point-max))
921 end)
922 (catch 'convert
923 (goto-char start)
924 (while (re-search-backward
925 pmail-unix-mail-delimiter nil t)
926 (setq end start)
927 (setq start (point))
928 (save-excursion
929 (save-restriction
930 (narrow-to-region start end)
931 (goto-char start)
932 (let ((attribute (pmail-header-get-header
933 pmail-header-attribute-header)))
934 (unless attribute
935 (throw 'convert t)))))))))))
936 (if convert
937 (let ((inhibit-read-only t))
938 (pmail-convert-mbox-format)))))
939
940 (defun pmail-initialize-messages ()
941 "Initialize message state based on messages in the buffer."
942 (setq pmail-total-messages 0
943 pmail-current-message 1)
944 (pmail-desc-clear-descriptors)
945 (widen)
946 (pmail-header-show-headers)
947 (setq pmail-total-messages (pmail-process-new-messages)))
948
949 (defvar pmail-mode-map
950 (let ((map (make-sparse-keymap)))
951 (suppress-keymap map)
952 (define-key map "a" 'pmail-add-label)
953 (define-key map "b" 'pmail-bury)
954 (define-key map "c" 'pmail-continue)
955 (define-key map "d" 'pmail-delete-forward)
956 (define-key map "\C-d" 'pmail-delete-backward)
957 (define-key map "e" 'pmail-edit-current-message)
958 (define-key map "f" 'pmail-forward)
959 (define-key map "g" 'pmail-get-new-mail)
960 (define-key map "h" 'pmail-summary)
961 (define-key map "i" 'pmail-input)
962 (define-key map "j" 'pmail-show-message)
963 (define-key map "k" 'pmail-kill-label)
964 (define-key map "l" 'pmail-summary-by-labels)
965 (define-key map "\e\C-h" 'pmail-summary)
966 (define-key map "\e\C-l" 'pmail-summary-by-labels)
967 (define-key map "\e\C-r" 'pmail-summary-by-recipients)
968 (define-key map "\e\C-s" 'pmail-summary-by-regexp)
969 (define-key map "\e\C-t" 'pmail-summary-by-topic)
970 (define-key map "m" 'pmail-mail)
971 (define-key map "\em" 'pmail-retry-failure)
972 (define-key map "n" 'pmail-next-undeleted-message)
973 (define-key map "\en" 'pmail-next-message)
974 (define-key map "\e\C-n" 'pmail-next-labeled-message)
975 (define-key map "o" 'pmail-output)
976 (define-key map "\C-o" 'pmail-output)
977 (define-key map "p" 'pmail-previous-undeleted-message)
978 (define-key map "\ep" 'pmail-previous-message)
979 (define-key map "\e\C-p" 'pmail-previous-labeled-message)
980 (define-key map "q" 'pmail-quit)
981 (define-key map "r" 'pmail-reply)
982 ;; I find I can't live without the default M-r command -- rms.
983 ;; (define-key map "\er" 'pmail-search-backwards)
984 (define-key map "s" 'pmail-expunge-and-save)
985 (define-key map "\es" 'pmail-search)
986 (define-key map "t" 'pmail-toggle-header)
987 (define-key map "u" 'pmail-undelete-previous-message)
988 (define-key map "w" 'pmail-output-body-to-file)
989 (define-key map "x" 'pmail-expunge)
990 (define-key map "." 'pmail-beginning-of-message)
991 (define-key map "/" 'pmail-end-of-message)
992 (define-key map "<" 'pmail-first-message)
993 (define-key map ">" 'pmail-last-message)
994 (define-key map " " 'scroll-up)
995 (define-key map "\177" 'scroll-down)
996 (define-key map "?" 'describe-mode)
997 (define-key map "\C-c\C-s\C-d" 'pmail-sort-by-date)
998 (define-key map "\C-c\C-s\C-s" 'pmail-sort-by-subject)
999 (define-key map "\C-c\C-s\C-a" 'pmail-sort-by-author)
1000 (define-key map "\C-c\C-s\C-r" 'pmail-sort-by-recipient)
1001 (define-key map "\C-c\C-s\C-c" 'pmail-sort-by-correspondent)
1002 (define-key map "\C-c\C-s\C-l" 'pmail-sort-by-lines)
1003 (define-key map "\C-c\C-s\C-k" 'pmail-sort-by-labels)
1004 (define-key map "\C-c\C-n" 'pmail-next-same-subject)
1005 (define-key map "\C-c\C-p" 'pmail-previous-same-subject)
1006 (define-key map [menu-bar] (make-sparse-keymap))
1007 (define-key map [menu-bar classify]
1008 (cons "Classify" (make-sparse-keymap "Classify")))
1009 (define-key map [menu-bar classify input-menu]
1010 nil)
1011 (define-key map [menu-bar classify output-menu]
1012 nil)
1013 (define-key map [menu-bar classify output-body]
1014 '("Output body to file..." . pmail-output-body-to-file))
1015 (define-key map [menu-bar classify output-inbox]
1016 '("Output (inbox)..." . pmail-output))
1017 (define-key map [menu-bar classify output]
1018 '("Output (Pmail)..." . pmail-output))
1019 (define-key map [menu-bar classify kill-label]
1020 '("Kill Label..." . pmail-kill-label))
1021 (define-key map [menu-bar classify add-label]
1022 '("Add Label..." . pmail-add-label))
1023 (define-key map [menu-bar summary]
1024 (cons "Summary" (make-sparse-keymap "Summary")))
1025 (define-key map [menu-bar summary senders]
1026 '("By Senders..." . pmail-summary-by-senders))
1027 (define-key map [menu-bar summary labels]
1028 '("By Labels..." . pmail-summary-by-labels))
1029 (define-key map [menu-bar summary recipients]
1030 '("By Recipients..." . pmail-summary-by-recipients))
1031 (define-key map [menu-bar summary topic]
1032 '("By Topic..." . pmail-summary-by-topic))
1033 (define-key map [menu-bar summary regexp]
1034 '("By Regexp..." . pmail-summary-by-regexp))
1035 (define-key map [menu-bar summary all]
1036 '("All" . pmail-summary))
1037 (define-key map [menu-bar mail]
1038 (cons "Mail" (make-sparse-keymap "Mail")))
1039 (define-key map [menu-bar mail pmail-get-new-mail]
1040 '("Get New Mail" . pmail-get-new-mail))
1041 (define-key map [menu-bar mail lambda]
1042 '("----"))
1043 (define-key map [menu-bar mail continue]
1044 '("Continue" . pmail-continue))
1045 (define-key map [menu-bar mail resend]
1046 '("Re-send..." . pmail-resend))
1047 (define-key map [menu-bar mail forward]
1048 '("Forward" . pmail-forward))
1049 (define-key map [menu-bar mail retry]
1050 '("Retry" . pmail-retry-failure))
1051 (define-key map [menu-bar mail reply]
1052 '("Reply" . pmail-reply))
1053 (define-key map [menu-bar mail mail]
1054 '("Mail" . pmail-mail))
1055 (define-key map [menu-bar delete]
1056 (cons "Delete" (make-sparse-keymap "Delete")))
1057 (define-key map [menu-bar delete expunge/save]
1058 '("Expunge/Save" . pmail-expunge-and-save))
1059 (define-key map [menu-bar delete expunge]
1060 '("Expunge" . pmail-expunge))
1061 (define-key map [menu-bar delete undelete]
1062 '("Undelete" . pmail-undelete-previous-message))
1063 (define-key map [menu-bar delete delete]
1064 '("Delete" . pmail-delete-forward))
1065 (define-key map [menu-bar move]
1066 (cons "Move" (make-sparse-keymap "Move")))
1067 (define-key map [menu-bar move search-back]
1068 '("Search Back..." . pmail-search-backwards))
1069 (define-key map [menu-bar move search]
1070 '("Search..." . pmail-search))
1071 (define-key map [menu-bar move previous]
1072 '("Previous Nondeleted" . pmail-previous-undeleted-message))
1073 (define-key map [menu-bar move next]
1074 '("Next Nondeleted" . pmail-next-undeleted-message))
1075 (define-key map [menu-bar move last]
1076 '("Last" . pmail-last-message))
1077 (define-key map [menu-bar move first]
1078 '("First" . pmail-first-message))
1079 (define-key map [menu-bar move previous]
1080 '("Previous" . pmail-previous-message))
1081 (define-key map [menu-bar move next]
1082 '("Next" . pmail-next-message))
1083 map)
1084 "Keymap for `pmail-mode'.")
1085
1086 ;; Pmail toolbar
1087 (defvar pmail-tool-bar-map
1088 (if (display-graphic-p)
1089 (let ((map (make-sparse-keymap)))
1090 (tool-bar-local-item-from-menu 'pmail-get-new-mail "mail/inbox"
1091 map pmail-mode-map)
1092 (tool-bar-local-item-from-menu 'pmail-next-undeleted-message "right-arrow"
1093 map pmail-mode-map)
1094 (tool-bar-local-item-from-menu 'pmail-previous-undeleted-message "left-arrow"
1095 map pmail-mode-map)
1096 (tool-bar-local-item-from-menu 'pmail-search "search"
1097 map pmail-mode-map)
1098 (tool-bar-local-item-from-menu 'pmail-input "open"
1099 map pmail-mode-map)
1100 (tool-bar-local-item-from-menu 'pmail-mail "mail/compose"
1101 map pmail-mode-map)
1102 (tool-bar-local-item-from-menu 'pmail-reply "mail/reply-all"
1103 map pmail-mode-map)
1104 (tool-bar-local-item-from-menu 'pmail-forward "mail/forward"
1105 map pmail-mode-map)
1106 (tool-bar-local-item-from-menu 'pmail-delete-forward "close"
1107 map pmail-mode-map)
1108 (tool-bar-local-item-from-menu 'pmail-output "mail/move"
1109 map pmail-mode-map)
1110 (tool-bar-local-item-from-menu 'pmail-output-body-to-file "mail/save"
1111 map pmail-mode-map)
1112 (tool-bar-local-item-from-menu 'pmail-expunge "delete"
1113 map pmail-mode-map)
1114 map)))
1115
1116
1117 \f
1118 ;; Pmail mode is suitable only for specially formatted data.
1119 (put 'pmail-mode 'mode-class 'special)
1120
1121 (defun pmail-mode-kill-summary ()
1122 (if pmail-summary-buffer (kill-buffer pmail-summary-buffer)))
1123
1124 ;;;###autoload
1125 (defun pmail-mode ()
1126 "Pmail Mode is used by \\<pmail-mode-map>\\[pmail] for editing Pmail files.
1127 All normal editing commands are turned off.
1128 Instead, these commands are available:
1129
1130 \\[pmail-beginning-of-message] Move point to front of this message.
1131 \\[pmail-end-of-message] Move point to bottom of this message.
1132 \\[scroll-up] Scroll to next screen of this message.
1133 \\[scroll-down] Scroll to previous screen of this message.
1134 \\[pmail-next-undeleted-message] Move to Next non-deleted message.
1135 \\[pmail-previous-undeleted-message] Move to Previous non-deleted message.
1136 \\[pmail-next-message] Move to Next message whether deleted or not.
1137 \\[pmail-previous-message] Move to Previous message whether deleted or not.
1138 \\[pmail-first-message] Move to the first message in Pmail file.
1139 \\[pmail-last-message] Move to the last message in Pmail file.
1140 \\[pmail-show-message] Jump to message specified by numeric position in file.
1141 \\[pmail-search] Search for string and show message it is found in.
1142 \\[pmail-delete-forward] Delete this message, move to next nondeleted.
1143 \\[pmail-delete-backward] Delete this message, move to previous nondeleted.
1144 \\[pmail-undelete-previous-message] Undelete message. Tries current message, then earlier messages
1145 till a deleted message is found.
1146 \\[pmail-edit-current-message] Edit the current message. \\[pmail-cease-edit] to return to Pmail.
1147 \\[pmail-expunge] Expunge deleted messages.
1148 \\[pmail-expunge-and-save] Expunge and save the file.
1149 \\[pmail-quit] Quit Pmail: expunge, save, then switch to another buffer.
1150 \\[save-buffer] Save without expunging.
1151 \\[pmail-get-new-mail] Move new mail from system spool directory into this file.
1152 \\[pmail-mail] Mail a message (same as \\[mail-other-window]).
1153 \\[pmail-continue] Continue composing outgoing message started before.
1154 \\[pmail-reply] Reply to this message. Like \\[pmail-mail] but initializes some fields.
1155 \\[pmail-retry-failure] Send this message again. Used on a mailer failure message.
1156 \\[pmail-forward] Forward this message to another user.
1157 \\[pmail-output-to-pmail-file] Output this message to an Pmail file (append it).
1158 \\[pmail-output] Output this message to a Unix-format mail file (append it).
1159 \\[pmail-output-body-to-file] Save message body to a file. Default filename comes from Subject line.
1160 \\[pmail-input] Input Pmail file. Run Pmail on that file.
1161 \\[pmail-add-label] Add label to message. It will be displayed in the mode line.
1162 \\[pmail-kill-label] Kill label. Remove a label from current message.
1163 \\[pmail-next-labeled-message] Move to Next message with specified label
1164 (label defaults to last one specified).
1165 Standard labels: filed, unseen, answered, forwarded, deleted.
1166 Any other label is present only if you add it with \\[pmail-add-label].
1167 \\[pmail-previous-labeled-message] Move to Previous message with specified label
1168 \\[pmail-summary] Show headers buffer, with a one line summary of each message.
1169 \\[pmail-summary-by-labels] Summarize only messages with particular label(s).
1170 \\[pmail-summary-by-recipients] Summarize only messages with particular recipient(s).
1171 \\[pmail-summary-by-regexp] Summarize only messages with particular regexp(s).
1172 \\[pmail-summary-by-topic] Summarize only messages with subject line regexp(s).
1173 \\[pmail-toggle-header] Toggle display of complete header."
1174 (interactive)
1175 (let ((finding-pmail-file (not (eq major-mode 'pmail-mode))))
1176 (pmail-mode-2)
1177 (when (and finding-pmail-file
1178 (null coding-system-for-read)
1179 default-enable-multibyte-characters)
1180 (let ((pmail-enable-multibyte t))
1181 (pmail-require-mime-maybe)
1182 (goto-char (point-max))
1183 (set-buffer-multibyte t)))
1184 (pmail-show-message pmail-total-messages)
1185 (when finding-pmail-file
1186 (when pmail-display-summary
1187 (pmail-summary))
1188 (pmail-construct-io-menu))
1189 (run-mode-hooks 'pmail-mode-hook)))
1190
1191 (defun pmail-mode-2 ()
1192 (kill-all-local-variables)
1193 (pmail-mode-1)
1194 (pmail-perm-variables)
1195 (pmail-variables))
1196
1197 (defun pmail-mode-1 ()
1198 (setq major-mode 'pmail-mode)
1199 (setq mode-name "PMAIL")
1200 (setq buffer-read-only t)
1201 ;; No need to auto save PMAIL files in normal circumstances
1202 ;; because they contain no info except attribute changes
1203 ;; and deletion of messages.
1204 ;; The one exception is when messages are copied into an Pmail mode buffer.
1205 ;; pmail-output-to-pmail-file enables auto save when you do that.
1206 (setq buffer-auto-save-file-name nil)
1207 (setq mode-line-modified "--")
1208 (use-local-map pmail-mode-map)
1209 (set-syntax-table text-mode-syntax-table)
1210 (setq local-abbrev-table text-mode-abbrev-table))
1211
1212 ;; Set up the permanent locals associated with an Pmail file.
1213 (defun pmail-perm-variables ()
1214 (make-local-variable 'pmail-last-label)
1215 (make-local-variable 'pmail-last-regexp)
1216 (make-local-variable 'pmail-buffer)
1217 (setq pmail-buffer (current-buffer))
1218 (make-local-variable 'pmail-view-buffer)
1219 (setq pmail-view-buffer pmail-buffer)
1220 (make-local-variable 'pmail-summary-buffer)
1221 (make-local-variable 'pmail-current-message)
1222 (make-local-variable 'pmail-total-messages)
1223 (make-local-variable 'pmail-overlay-list)
1224 (setq pmail-overlay-list nil)
1225 (make-local-variable 'pmail-desc-vector)
1226 (make-local-variable 'pmail-inbox-list)
1227 (setq pmail-inbox-list (pmail-get-file-inbox-list))
1228 ;; Provide default set of inboxes for primary mail file ~/PMAIL.
1229 (and (null pmail-inbox-list)
1230 (or (equal buffer-file-name (expand-file-name pmail-file-name))
1231 (equal buffer-file-truename
1232 (abbreviate-file-name (file-truename pmail-file-name))))
1233 (setq pmail-inbox-list
1234 (or pmail-primary-inbox-list
1235 (list (or (getenv "MAIL")
1236 (concat rmail-spool-directory
1237 (user-login-name)))))))
1238 (make-local-variable 'pmail-keywords)
1239 (set (make-local-variable 'tool-bar-map) pmail-tool-bar-map)
1240 ;; this gets generated as needed
1241 (setq pmail-keywords nil))
1242
1243 ;; Set up the non-permanent locals associated with Pmail mode.
1244 (defun pmail-variables ()
1245 ;; Don't let a local variables list in a message cause confusion.
1246 (make-local-variable 'local-enable-local-variables)
1247 (setq local-enable-local-variables nil)
1248 (make-local-variable 'revert-buffer-function)
1249 (setq revert-buffer-function 'pmail-revert)
1250 (make-local-variable 'font-lock-defaults)
1251 (setq font-lock-defaults
1252 '(pmail-font-lock-keywords
1253 t t nil nil
1254 (font-lock-maximum-size . nil)
1255 (font-lock-fontify-buffer-function . pmail-fontify-buffer-function)
1256 (font-lock-unfontify-buffer-function . pmail-unfontify-buffer-function)
1257 (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
1258 (make-local-variable 'require-final-newline)
1259 (setq require-final-newline nil)
1260 (make-local-variable 'version-control)
1261 (setq version-control 'never)
1262 (make-local-variable 'kill-buffer-hook)
1263 (add-hook 'kill-buffer-hook 'pmail-mode-kill-summary)
1264 (make-local-variable 'file-precious-flag)
1265 (setq file-precious-flag t)
1266 (make-local-variable 'desktop-save-buffer)
1267 (setq desktop-save-buffer t))
1268
1269 ;; Handle M-x revert-buffer done in an pmail-mode buffer.
1270 (defun pmail-revert (arg noconfirm)
1271 (with-current-buffer pmail-buffer
1272 (let* ((revert-buffer-function (default-value 'revert-buffer-function))
1273 (pmail-enable-multibyte enable-multibyte-characters))
1274 ;; Call our caller again, but this time it does the default thing.
1275 (when (revert-buffer arg noconfirm)
1276 ;; If the user said "yes", and we changed something, reparse the
1277 ;; messages.
1278 (with-current-buffer pmail-buffer
1279 (pmail-mode-2)
1280 (pmail-convert-file)
1281 ;; We have read the file as raw-text, so the buffer is set to
1282 ;; unibyte. Make it multibyte if necessary.
1283 (when (and pmail-enable-multibyte
1284 (not enable-multibyte-characters))
1285 (set-buffer-multibyte t))
1286 (pmail-initialize-messages)
1287 (pmail-show-message pmail-total-messages)
1288 (run-hooks 'pmail-mode-hook))))))
1289
1290 (defun pmail-get-file-inbox-list ()
1291 "Return a list of inbox files for this buffer."
1292 (let* ((filename (expand-file-name (buffer-file-name)))
1293 (inboxes (cdr (or (assoc filename pmail-inbox-alist)
1294 (assoc (abbreviate-file-name filename)
1295 pmail-inbox-alist))))
1296 (list nil))
1297 (dolist (i inboxes)
1298 (when (file-name-absolute-p i)
1299 (push (expand-file-name i) list)))
1300 (nreverse list)))
1301
1302 ;;; mbox: ready
1303 (defun pmail-expunge-and-save ()
1304 "Expunge and save PMAIL file."
1305 (interactive)
1306 (pmail-expunge)
1307 (save-buffer)
1308 (pmail-display-summary-maybe))
1309
1310 ;;; mbox: ready
1311 (defun pmail-display-summary-maybe ()
1312 "If a summary buffer exists then make sure it is updated and displayed."
1313 (if (pmail-summary-exists)
1314 (let ((current-message pmail-current-message))
1315 (pmail-select-summary
1316 (pmail-summary-goto-msg current-message)
1317 (pmail-summary-pmail-update)
1318 (set-buffer-modified-p nil)))))
1319
1320 ;;; mbox: ready
1321 (defun pmail-quit ()
1322 "Quit out of PMAIL.
1323 Hook `pmail-quit-hook' is run after expunging."
1324 (interactive)
1325 (pmail-expunge-and-save)
1326 (when (boundp 'pmail-quit-hook)
1327 (run-hooks 'pmail-quit-hook))
1328 ;; Don't switch to the summary buffer even if it was recently visible.
1329 (when pmail-summary-buffer
1330 (replace-buffer-in-windows pmail-summary-buffer)
1331 (bury-buffer pmail-summary-buffer))
1332 (if pmail-enable-mime
1333 (let ((obuf pmail-buffer)
1334 (ovbuf pmail-view-buffer))
1335 (set-buffer pmail-view-buffer)
1336 (quit-window)
1337 (replace-buffer-in-windows ovbuf)
1338 (replace-buffer-in-windows obuf)
1339 (bury-buffer obuf))
1340 (let ((obuf (current-buffer)))
1341 (quit-window)
1342 (replace-buffer-in-windows obuf))))
1343
1344 ;;; mbox: ready
1345 (defun pmail-bury ()
1346 "Bury current Pmail buffer and its summary buffer."
1347 (interactive)
1348 ;; This let var was called pmail-buffer, but that interfered
1349 ;; with the buffer-local var used in summary buffers.
1350 (let ((buffer-to-bury (current-buffer)))
1351 (if (pmail-summary-exists)
1352 (let (window)
1353 (while (setq window (get-buffer-window pmail-summary-buffer))
1354 (quit-window nil window))
1355 (bury-buffer pmail-summary-buffer)))
1356 (quit-window)))
1357
1358 ;;;??? Fails to add descriptor for new message.
1359 ;;; mbox: ready
1360 (defun pmail-duplicate-message ()
1361 "Create a duplicated copy of the current message.
1362 The duplicate copy goes into the Pmail file just after the
1363 original copy."
1364 (interactive)
1365 (widen)
1366 (let ((buffer-read-only nil)
1367 (number pmail-current-message)
1368 (string (buffer-substring (pmail-desc-get-start pmail-current-message)
1369 (pmail-desc-get-end pmail-current-message))))
1370 (goto-char (pmail-desc-get-end pmail-current-message))
1371 (insert string)
1372 (pmail-show-message number)
1373 (message "Message duplicated")))
1374
1375 ;;;###autoload
1376 (defun pmail-input (filename)
1377 "Run Pmail on file FILENAME."
1378 (interactive "FRun pmail on PMAIL file: ")
1379 (pmail filename))
1380
1381 ;; This used to scan subdirectories recursively, but someone pointed out
1382 ;; that if the user wants that, person can put all the files in one dir.
1383 ;; And the recursive scan was slow. So I took it out. rms, Sep 1996.
1384 (defun pmail-find-all-files (start)
1385 "Return list of file in dir START that match `pmail-secondary-file-regexp'."
1386 (if (file-accessible-directory-p start)
1387 ;; Don't sort here.
1388 (let* ((case-fold-search t)
1389 (files (directory-files start t pmail-secondary-file-regexp)))
1390 ;; Sort here instead of in directory-files
1391 ;; because this list is usually much shorter.
1392 (sort files 'string<))))
1393
1394 (defun pmail-list-to-menu (menu-name l action &optional full-name)
1395 (let ((menu (make-sparse-keymap menu-name)))
1396 (mapc
1397 (function (lambda (item)
1398 (let (command)
1399 (if (consp item)
1400 (progn
1401 (setq command
1402 (pmail-list-to-menu (car item) (cdr item)
1403 action
1404 (if full-name
1405 (concat full-name "/"
1406 (car item))
1407 (car item))))
1408 (setq name (car item)))
1409 (progn
1410 (setq name item)
1411 (setq command
1412 (list 'lambda () '(interactive)
1413 (list action
1414 (expand-file-name
1415 (if full-name
1416 (concat full-name "/" item)
1417 item)
1418 pmail-secondary-file-directory))))))
1419 (define-key menu (vector (intern name))
1420 (cons name command)))))
1421 (reverse l))
1422 menu))
1423
1424 ;; This command is always "disabled" when it appears in a menu.
1425 (put 'pmail-disable-menu 'menu-enable ''nil)
1426
1427 (defun pmail-construct-io-menu ()
1428 (let ((files (pmail-find-all-files pmail-secondary-file-directory)))
1429 (if files
1430 (progn
1431 (define-key pmail-mode-map [menu-bar classify input-menu]
1432 (cons "Input Pmail File"
1433 (pmail-list-to-menu "Input Pmail File"
1434 files
1435 'pmail-input)))
1436 (define-key pmail-mode-map [menu-bar classify output-menu]
1437 (cons "Output Pmail File"
1438 (pmail-list-to-menu "Output Pmail File"
1439 files
1440 'pmail-output))))
1441
1442 (define-key pmail-mode-map [menu-bar classify input-menu]
1443 '("Input Pmail File" . pmail-disable-menu))
1444 (define-key pmail-mode-map [menu-bar classify output-menu]
1445 '("Output Pmail File" . pmail-disable-menu)))))
1446
1447 \f
1448 ;;;; *** Pmail input ***
1449
1450 (declare-function pmail-summary-goto-msg "pmailsum"
1451 (&optional n nowarn skip-pmail))
1452 (declare-function pmail-summary-mark-undeleted "pmailsum" (n))
1453 (declare-function pmail-summary-mark-deleted "pmailsum" (&optional n undel))
1454 (declare-function rfc822-addresses "rfc822" (header-text))
1455 (declare-function mail-abbrev-make-syntax-table "mailabbrev.el" ())
1456 (declare-function mail-sendmail-delimit-header "sendmail" ())
1457 (declare-function mail-header-end "sendmail" ())
1458
1459 (defun pmail-get-inbox-files ()
1460 "Return all files from `pmail-inbox-list' without name conflicts.
1461 A conflict happens when two inbox file names have the same name
1462 according to `file-name-nondirectory'."
1463 (let (files last-names)
1464 (catch 'conflict
1465 (dolist (file pmail-inbox-list)
1466 (if (member (file-name-nondirectory file) last-names)
1467 (throw 'conflict t)
1468 (push file files))
1469 (push (file-name-nondirectory file) last-names)))
1470 (nreverse files)))
1471
1472 (defun pmail-delete-inbox-files (files)
1473 "Delete all files given in FILES.
1474 If delete fails, truncate them to zero length."
1475 (dolist (file files)
1476 (condition-case nil
1477 ;; First, try deleting.
1478 (condition-case nil
1479 (delete-file file)
1480 ;; If we can't delete it, truncate it.
1481 (file-error (write-region (point) (point) file)))
1482 (file-error nil))))
1483
1484 (defun pmail-get-new-mail (&optional file-name)
1485 "Move any new mail from this mail file's inbox files.
1486 The inbox files for the primary mail file are determined using
1487 various means when setting up the buffer. The list of inbox
1488 files are stored in `pmail-inbox-list'.
1489
1490 The most important variable that determines the value of this
1491 list is `pmail-inbox-alist' which lists the inbox files for any
1492 mail files you might be using.
1493
1494 If the above yields no inbox files, and if this is the primary
1495 mail file as determined by `pmail-file-name', the inbox lists
1496 otherwise defaults to `pmail-primary-inbox-list' if set, or the
1497 environment variable MAIL if set, or the user's mail file in
1498 `rmail-spool-directory'.
1499
1500 This is why, by default, no mail file has inbox files, except for
1501 the primary mail file ~/PMAIL, which gets its new mail from the
1502 mail spool.
1503
1504 You can also specify the file to get new mail from interactively.
1505 A prefix argument will read a file name and use that file as the
1506 inbox. Noninteractively, you can pass the inbox file name as an
1507 argument.
1508
1509 If the variable `pmail-preserve-inbox' is non-nil, new mail will
1510 always be left in inbox files rather than deleted.
1511
1512 This function runs `pmail-get-new-mail-hook' before saving the
1513 updated file. It returns t if it got any new messages."
1514 (interactive
1515 (list (when current-prefix-arg
1516 (read-file-name "Get new mail from file: "))))
1517 (run-hooks 'pmail-before-get-new-mail-hook)
1518 ;; If the disk file has been changed from under us, revert to it
1519 ;; before we get new mail.
1520 (unless (verify-visited-file-modtime (current-buffer))
1521 (find-file (buffer-file-name)))
1522 (with-current-buffer pmail-buffer
1523 (widen)
1524 ;; Get rid of all undo records for this buffer.
1525 (unless (eq buffer-undo-list t)
1526 (setq buffer-undo-list nil))
1527 (let ((pmail-enable-multibyte (default-value 'enable-multibyte-characters))
1528 ;; If buffer has not changed yet, and has not been saved yet,
1529 ;; don't replace the old backup file now.
1530 (make-backup-files (and make-backup-files (buffer-modified-p)))
1531 current-message found)
1532 (condition-case nil
1533 (let ((buffer-read-only nil)
1534 (buffer-undo-list t)
1535 (delete-files nil)
1536 (new-messages 0)
1537 (rsf-number-of-spam 0))
1538 (save-excursion
1539 (save-restriction
1540 (goto-char (point-max))
1541 (narrow-to-region (point) (point))
1542 ;; Read in the contents of the inbox files, renaming
1543 ;; them as necessary, and adding to the list of files to
1544 ;; delete eventually.
1545 (if file-name
1546 (pmail-insert-inbox-text (list file-name) nil)
1547 (setq delete-files (pmail-insert-inbox-text
1548 (pmail-get-inbox-files) t)))
1549 ;; Process newly found messages and save them into the
1550 ;; PMAIL file.
1551 (unless (equal (point-min) (point-max))
1552 (setq new-messages (pmail-convert-mbox-format))
1553 (unless (zerop new-messages)
1554 (pmail-process-new-messages)
1555 (setq pmail-current-message (1+ pmail-total-messages)
1556 pmail-total-messages (pmail-desc-get-count)))
1557 (save-buffer))
1558 ;; Delete the old files, now that the PMAIL file is
1559 ;; saved.
1560 (when delete-files
1561 (pmail-delete-inbox-files delete-files))))
1562
1563 (if (zerop new-messages)
1564 (when (or file-name pmail-inbox-list)
1565 (pmail-show-message)
1566 (message "(No new mail has arrived)"))
1567
1568 ;; Process the new messages for spam using the integrated
1569 ;; spam filter. The spam filter can mark messages for
1570 ;; deletion and can output a message.
1571 (setq current-message (pmail-first-unseen-message))
1572 (when pmail-use-spam-filter
1573 (while (<= current-message pmail-total-messages)
1574 (rmail-spam-filter current-message)
1575 (setq current-message (1+ current-message))))
1576 ;; Make the first unseen message the current message and
1577 ;; update the summary buffer, if one exists.
1578 (setq current-message (pmail-first-unseen-message))
1579 (if (pmail-summary-exists)
1580 (with-current-buffer pmail-summary-buffer
1581 (pmail-update-summary)
1582 (pmail-summary-goto-msg current-message))
1583 (pmail-show-message current-message))
1584 ;; Run the after get new mail hook.
1585 (run-hooks 'pmail-after-get-new-mail-hook)
1586 (message "%d new message%s read"
1587 new-messages (if (= 1 new-messages) "" "s"))
1588 (setq found t))
1589 found)
1590 ;; Don't leave the buffer screwed up if we get a disk-full error.
1591 (file-error (or found (pmail-show-message)))))))
1592
1593 (defun pmail-parse-url (file)
1594 "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD)
1595 WHERE MAILBOX-NAME is the name of the mailbox suitable as argument to the
1596 actual version of `movemail', REMOTE is non-nil if MAILBOX-NAME refers to
1597 a remote mailbox, PASSWORD is the password if it should be
1598 supplied as a separate argument to `movemail' or nil otherwise, GOT-PASSWORD
1599 is non-nil if the user has supplied the password interactively.
1600 "
1601 (cond
1602 ((string-match "^\\([^:]+\\)://\\(\\([^:@]+\\)\\(:\\([^@]+\\)\\)?@\\)?.*" file)
1603 (let (got-password supplied-password
1604 (proto (match-string 1 file))
1605 (user (match-string 3 file))
1606 (pass (match-string 5 file))
1607 (host (substring file (or (match-end 2)
1608 (+ 3 (match-end 1))))))
1609
1610 (if (not pass)
1611 (when pmail-remote-password-required
1612 (setq got-password (not (pmail-have-password)))
1613 (setq supplied-password (pmail-get-remote-password
1614 (string-equal proto "imap")))))
1615
1616 (if (pmail-movemail-variant-p 'emacs)
1617 (if (string-equal proto "pop")
1618 (list (concat "po:" user ":" host)
1619 t
1620 (or pass supplied-password)
1621 got-password)
1622 (error "Emacs movemail does not support %s protocol" proto))
1623 (list (concat proto "://" user "@" host)
1624 (or (string-equal proto "pop") (string-equal proto "imap"))
1625 (or supplied-password pass)
1626 got-password))))
1627
1628 ((string-match "^po:\\([^:]+\\)\\(:\\(.*\\)\\)?" file)
1629 (let (got-password supplied-password
1630 (proto "pop")
1631 (user (match-string 1 file))
1632 (host (match-string 3 file)))
1633
1634 (when pmail-remote-password-required
1635 (setq got-password (not (pmail-have-password)))
1636 (setq supplied-password (pmail-get-remote-password nil)))
1637
1638 (list file "pop" supplied-password got-password)))
1639
1640 (t
1641 (list file nil nil nil))))
1642
1643 (defun pmail-insert-inbox-text (files renamep)
1644 ;; Detect a locked file now, so that we avoid moving mail
1645 ;; out of the real inbox file. (That could scare people.)
1646 (or (memq (file-locked-p buffer-file-name) '(nil t))
1647 (error "PMAIL file %s is locked"
1648 (file-name-nondirectory buffer-file-name)))
1649 (let (file tofile delete-files movemail popmail got-password password)
1650 (while files
1651 ;; Handle remote mailbox names specially; don't expand as filenames
1652 ;; in case the userid contains a directory separator.
1653 (setq file (car files))
1654 (let ((url-data (pmail-parse-url file)))
1655 (setq file (nth 0 url-data))
1656 (setq popmail (nth 1 url-data))
1657 (setq password (nth 2 url-data))
1658 (setq got-password (nth 3 url-data)))
1659
1660 (if popmail
1661 (setq renamep t)
1662 (setq file (file-truename
1663 (substitute-in-file-name (expand-file-name file)))))
1664 (setq tofile (expand-file-name
1665 ;; Generate name to move to from inbox name,
1666 ;; in case of multiple inboxes that need moving.
1667 (concat ".newmail-"
1668 (file-name-nondirectory
1669 (if (memq system-type '(windows-nt cygwin ms-dos))
1670 ;; cannot have colons in file name
1671 (replace-regexp-in-string ":" "-" file)
1672 file)))
1673 ;; Use the directory of this pmail file
1674 ;; because it's a nuisance to use the homedir
1675 ;; if that is on a full disk and this pmail
1676 ;; file isn't.
1677 (file-name-directory
1678 (expand-file-name buffer-file-name))))
1679 ;; Always use movemail to rename the file,
1680 ;; since there can be mailboxes in various directories.
1681 (if (not popmail)
1682 (progn
1683 ;; On some systems, /usr/spool/mail/foo is a directory
1684 ;; and the actual inbox is /usr/spool/mail/foo/foo.
1685 (if (file-directory-p file)
1686 (setq file (expand-file-name (user-login-name)
1687 file)))))
1688 (cond (popmail
1689 (message "Getting mail from the remote server ..."))
1690 ((and (file-exists-p tofile)
1691 (/= 0 (nth 7 (file-attributes tofile))))
1692 (message "Getting mail from %s..." tofile))
1693 ((and (file-exists-p file)
1694 (/= 0 (nth 7 (file-attributes file))))
1695 (message "Getting mail from %s..." file)))
1696 ;; Set TOFILE if have not already done so, and
1697 ;; rename or copy the file FILE to TOFILE if and as appropriate.
1698 (cond ((not renamep)
1699 (setq tofile file))
1700 ((or (file-exists-p tofile) (and (not popmail)
1701 (not (file-exists-p file))))
1702 nil)
1703 (t
1704 (with-temp-buffer
1705 (let ((errors (current-buffer)))
1706 (buffer-disable-undo errors)
1707 (let ((args
1708 (append
1709 (list (or pmail-movemail-program "movemail") nil errors nil)
1710 (if pmail-preserve-inbox
1711 (list "-p")
1712 nil)
1713 (if (pmail-movemail-variant-p 'mailutils)
1714 (append (list "--emacs") pmail-movemail-flags)
1715 pmail-movemail-flags)
1716 (list file tofile)
1717 (if password (list password) nil))))
1718 (apply 'call-process args))
1719 (if (not (buffer-modified-p errors))
1720 ;; No output => movemail won
1721 nil
1722 (set-buffer errors)
1723 (subst-char-in-region (point-min) (point-max)
1724 ?\n ?\ )
1725 (goto-char (point-max))
1726 (skip-chars-backward " \t")
1727 (delete-region (point) (point-max))
1728 (goto-char (point-min))
1729 (if (looking-at "movemail: ")
1730 (delete-region (point-min) (match-end 0)))
1731 (beep t)
1732 ;; If we just read the password, most likely it is
1733 ;; wrong. Otherwise, see if there is a specific
1734 ;; reason to think that the problem is a wrong passwd.
1735 (if (or got-password
1736 (re-search-forward pmail-remote-password-error
1737 nil t))
1738 (pmail-set-remote-password nil))
1739
1740 ;; If using Mailutils, remove initial error code
1741 ;; abbreviation
1742 (when (pmail-movemail-variant-p 'mailutils)
1743 (goto-char (point-min))
1744 (when (looking-at "[A-Z][A-Z0-9_]*:")
1745 (delete-region (point-min) (match-end 0))))
1746
1747 (message "movemail: %s"
1748 (buffer-substring (point-min)
1749 (point-max)))
1750
1751 (sit-for 3)
1752 nil)))))
1753
1754 ;; At this point, TOFILE contains the name to read:
1755 ;; Either the alternate name (if we renamed)
1756 ;; or the actual inbox (if not renaming).
1757 (if (file-exists-p tofile)
1758 (let ((coding-system-for-read 'no-conversion)
1759 size)
1760 (goto-char (point-max))
1761 (setq size (nth 1 (insert-file-contents tofile)))
1762 (goto-char (point-max))
1763 (or (= (preceding-char) ?\n)
1764 (zerop size)
1765 (insert ?\n))
1766 (if (not (and pmail-preserve-inbox (string= file tofile)))
1767 (setq delete-files (cons tofile delete-files)))))
1768 (message "")
1769 (setq files (cdr files)))
1770 delete-files))
1771 \f
1772 ;;;; *** Pmail message decoding ***
1773
1774 ;; these two are unused, and possibly harmul.
1775
1776 ;; (defun pmail-decode-region (from to coding)
1777 ;; "Decode the region specified by FROM and TO by CODING.
1778 ;; If CODING is nil or an invalid coding system, decode by `undecided'."
1779 ;; (unless (and coding (coding-system-p coding))
1780 ;; (setq coding 'undecided))
1781 ;; ;; Use -dos decoding, to remove ^M characters left from base64 or
1782 ;; ;; rogue qp-encoded text.
1783 ;; (decode-coding-region from to
1784 ;; (coding-system-change-eol-conversion
1785 ;; coding 'dos))
1786 ;; ;; Don't reveal the fact we used -dos decoding, as users generally
1787 ;; ;; will not expect the PMAIL buffer to use DOS EOL format.
1788 ;; (setq buffer-file-coding-system
1789 ;; (setq last-coding-system-used
1790 ;; (coding-system-change-eol-conversion
1791 ;; coding 'unix))))
1792
1793 ;; (defun pmail-decode-by-content-type (from to)
1794 ;; "Decode message between FROM and TO according to Content-Type."
1795 ;; (when (and (not pmail-enable-mime) pmail-enable-multibyte)
1796 ;; (let ((coding-system-used nil)
1797 ;; (case-fold-search t))
1798 ;; (save-restriction
1799 ;; (narrow-to-region from to)
1800 ;; (when (and (not pmail-enable-mime) pmail-enable-multibyte)
1801 ;; (let ((coding
1802 ;; (when (save-excursion
1803 ;; (goto-char (pmail-header-get-limit))
1804 ;; (re-search-backward
1805 ;; pmail-mime-charset-pattern
1806 ;; (point-min) t))
1807 ;; (intern (downcase (match-string 1))))))
1808 ;; (setq coding-system-used (pmail-decode-region
1809 ;; (point-min) (point-max)
1810 ;; coding)))))
1811 ;; (setq last-coding-system-used coding-system-used))))
1812 \f
1813 ;;;; *** Pmail Message Formatting and Header Manipulation ***
1814
1815 (defun pmail-clear-headers (&optional ignored-headers)
1816 "Delete all header fields that Pmail should not show.
1817 If the optional argument IGNORED-HEADERS is non-nil,
1818 delete all header fields whose names match that regexp.
1819 Otherwise, if `pmail-displayed-headers' is non-nil,
1820 delete all header fields *except* those whose names match that regexp.
1821 Otherwise, delete all header fields whose names match `pmail-ignored-headers'
1822 unless they also match `pmail-nonignored-headers'."
1823 (when (search-forward "\n\n" nil t)
1824 (forward-char -1)
1825 (let ((case-fold-search t)
1826 (buffer-read-only nil))
1827 (if (and pmail-displayed-headers (null ignored-headers))
1828 (save-restriction
1829 (narrow-to-region (point-min) (point))
1830 (let (lim next)
1831 (goto-char (point-min))
1832 (while (and (not (eobp))
1833 (save-excursion
1834 (if (re-search-forward "\n[^ \t]" nil t)
1835 (setq lim (match-beginning 0)
1836 next (1+ lim))
1837 (setq lim nil next (point-max)))))
1838 (if (save-excursion
1839 (re-search-forward pmail-displayed-headers lim t))
1840 (goto-char next)
1841 (delete-region (point) next))))
1842 (goto-char (point-min)))
1843 (or ignored-headers (setq ignored-headers pmail-ignored-headers))
1844 (save-restriction
1845 (narrow-to-region (point-min) (point))
1846 (goto-char (point-min))
1847 (while (and ignored-headers
1848 (re-search-forward ignored-headers nil t))
1849 (beginning-of-line)
1850 (if (and pmail-nonignored-headers
1851 (looking-at pmail-nonignored-headers))
1852 (forward-line 1)
1853 (delete-region (point)
1854 (save-excursion
1855 (if (re-search-forward "\n[^ \t]" nil t)
1856 (1- (point))
1857 (point-max)))))))))))
1858
1859 (defun pmail-msg-is-pruned (&optional msg)
1860 "Determine if the headers for the current message are being
1861 displayed. If MSG is non-nil it will be used as the message number
1862 instead of the current message."
1863 (pmail-desc-get-header-display-state (or msg pmail-current-message)))
1864
1865 (defun pmail-toggle-header (&optional arg)
1866 "Show original message header if pruned header currently shown, or vice versa.
1867 With argument ARG, show the message header pruned if ARG is greater than zero;
1868 otherwise, show it in full."
1869 (interactive "P")
1870 (pmail-header-toggle-visibility arg))
1871
1872 ;; Lifted from repos-count-screen-lines.
1873 (defun pmail-count-screen-lines (start end)
1874 "Return number of screen lines between START and END."
1875 (save-excursion
1876 (save-restriction
1877 (narrow-to-region start end)
1878 (goto-char (point-min))
1879 (vertical-motion (- (point-max) (point-min))))))
1880 \f
1881 ;;;; *** Pmail Attributes and Keywords ***
1882
1883 ;; Make a string describing the current message's attributes by
1884 ;; keywords and set it up as the name of a minor mode so it will
1885 ;; appear in the mode line.
1886 (defun pmail-display-labels ()
1887 (let (keyword-list result)
1888 ;; Update the keyword list for the current message.
1889 (if (> pmail-current-message 0)
1890 (setq keyword-list (pmail-desc-get-keywords pmail-current-message)))
1891 ;; Generate the result string.
1892 (setq result (mapconcat 'identity keyword-list " "))
1893 ;; Update the mode line to display the keywords, the current
1894 ;; message index and the total number of messages.
1895 (setq mode-line-process
1896 (format " %d/%d%s"
1897 pmail-current-message pmail-total-messages
1898 (if keyword-list (concat " " result) "")))
1899 ;; If pmail-enable-mime is non-nil, we may have to update
1900 ;; `mode-line-process' of pmail-view-buffer too.
1901 (if (and pmail-enable-mime
1902 (not (eq (current-buffer) pmail-view-buffer))
1903 (buffer-live-p pmail-view-buffer))
1904 (let ((mlp mode-line-process))
1905 (with-current-buffer pmail-view-buffer
1906 (setq mode-line-process mlp))))))
1907
1908 (defun pmail-set-attribute (attr state &optional msgnum)
1909 "Turn a attribute ATTR of a message on or off according to STATE.
1910 ATTR is a string, MSGNUM is the optional message number. By
1911 default, the current message is changed."
1912 (save-excursion
1913 (save-restriction
1914 (let ((attr-index (pmail-desc-get-attr-index attr)))
1915 (set-buffer pmail-buffer)
1916 (or msgnum (setq msgnum pmail-current-message))
1917 (pmail-desc-set-attribute msgnum attr-index state)
1918 ;; Deal with the summary buffer.
1919 (when pmail-summary-buffer
1920 (pmail-summary-update msgnum))))))
1921
1922 (defun pmail-message-labels-p (n labels)
1923 "Return t if message number N has keywords matching LABELS.
1924 LABELS is a regular expression."
1925 (catch 'found
1926 (dolist (keyword (pmail-desc-get-keywords n))
1927 (when (string-match labels keyword)
1928 (throw 'found t)))))
1929
1930 \f
1931 ;;;; *** Pmail Message Selection And Support ***
1932
1933 (defun pmail-msgbeg (n)
1934 (pmail-desc-get-start n))
1935 (make-obsolete 'pmail-msgbeg 'pmail-desc-get-start "22.0")
1936
1937 (defun pmail-msgend (n)
1938 (pmail-desc-get-end n))
1939 (make-obsolete 'pmail-msgend 'pmail-desc-get-end "22.0")
1940
1941 (defun pmail-widen-to-current-msgbeg (function)
1942 "Call FUNCTION with point at start of internal data of current message.
1943 Assumes that bounds were previously narrowed to display the message in Pmail.
1944 The bounds are widened enough to move point where desired, then narrowed
1945 again afterward.
1946
1947 FUNCTION may not change the visible text of the message, but it may
1948 change the invisible header text."
1949 (save-excursion
1950 (unwind-protect
1951 (progn
1952 (narrow-to-region (pmail-desc-get-start pmail-current-message)
1953 (point-max))
1954 (goto-char (point-min))
1955 (funcall function))
1956 ;; Note: we don't use save-restriction because that does not work right
1957 ;; if changes are made outside the saved restriction
1958 ;; before that restriction is restored.
1959 (narrow-to-region (pmail-desc-get-start pmail-current-message)
1960 (pmail-desc-get-end pmail-current-message)))))
1961
1962 (defun pmail-process-new-messages (&optional nomsg)
1963 "Process the new messages in the buffer.
1964 The buffer has been narrowed to expose only the new messages.
1965 For each new message append an entry to the message vector and,
1966 if necessary, add a header that will capture the salient BABYL
1967 information. Return the number of new messages. If NOMSG is
1968 non-nil then do not show any progress messages."
1969 (let ((inhibit-read-only t)
1970 (case-fold-search nil)
1971 (new-message-counter 0)
1972 (start (point-max))
1973 end date keywords message-descriptor-list)
1974 (or nomsg (message "Processing new messages..."))
1975 ;; Process each message in turn starting from the back and
1976 ;; proceeding to the front of the region. This is especially a
1977 ;; good approach since the buffer will likely have new headers
1978 ;; added.
1979 (save-excursion
1980 (goto-char start)
1981 (while (re-search-backward pmail-unix-mail-delimiter nil t)
1982 ;; Cache the message date to facilitate generating a message
1983 ;; summary later. The format is '(DAY-OF-WEEK DAY-NUMBER MON
1984 ;; YEAR TIME)
1985 (setq date
1986 (list (buffer-substring (match-beginning 2) (match-end 2))
1987 (buffer-substring (match-beginning 4) (match-end 4))
1988 (buffer-substring (match-beginning 3) (match-end 3))
1989 (buffer-substring (match-beginning 7) (match-end 7))
1990 (buffer-substring (match-beginning 5) (match-end 5))))
1991 ;;Set start and end to bracket this message.
1992 (setq end start)
1993 (setq start (point))
1994 (save-excursion
1995 (save-restriction
1996 (narrow-to-region start end)
1997 (goto-char start)
1998 ;; Bump the new message counter.
1999 (setq new-message-counter (1+ new-message-counter))
2000
2001 ;; Set up keywords, if any. The keywords are provided via a
2002 ;; comma separated list and returned as a list of strings.
2003 (setq keywords (pmail-header-get-keywords))
2004 (when keywords
2005 ;; Keywords do exist. Register them with the keyword
2006 ;; management library.
2007 (pmail-register-keywords keywords))
2008 ;; Insure that we have From and Date headers.
2009 ;;(pmail-decode-from-line)
2010 ;; Perform User defined filtering.
2011 (save-excursion
2012 (if pmail-message-filter (funcall pmail-message-filter)))
2013 ;; Accumulate the message attributes along with the message
2014 ;; markers and the message date list.
2015 (setq message-descriptor-list
2016 (vconcat (list (list (point-min-marker)
2017 (pmail-header-get-header
2018 pmail-header-attribute-header)
2019 keywords
2020 date
2021 (count-lines start end)
2022 (cadr (mail-extract-address-components; does not like nil
2023 (or (pmail-header-get-header "from") "")))
2024 (or (pmail-header-get-header "subject")
2025 "none")))
2026 message-descriptor-list)))))
2027 ;; Add the new message data lists to the Pmail message descriptor
2028 ;; vector.
2029 (pmail-desc-add-descriptors message-descriptor-list)
2030 ;; Unless requested otherwise, show the number of new messages.
2031 ;; Return the number of new messages.
2032 (or nomsg (message "Processing new messages...done (%d)"
2033 new-message-counter))
2034 new-message-counter)))
2035
2036 (defun pmail-convert-mbox-format ()
2037 (let ((case-fold-search nil)
2038 (message-count 0)
2039 (start (point-max))
2040 end)
2041 (save-excursion
2042 (goto-char start)
2043 (while (re-search-backward pmail-unix-mail-delimiter nil t)
2044 (setq end start)
2045 (setq start (point))
2046 (save-excursion
2047 (save-restriction
2048 (narrow-to-region start end)
2049 (goto-char (point-min))
2050 ;; Bump the new message counter.
2051 (setq message-count (1+ message-count))
2052 ;; Detect messages that have been added with DOS line endings
2053 ;; and convert the line endings for such messages.
2054 (when (save-excursion (end-of-line) (= (preceding-char) ?\r))
2055 (let ((buffer-read-only nil)
2056 (buffer-undo t)
2057 (end-marker (copy-marker end)))
2058 (message
2059 "Processing new messages...(converting line endings)")
2060 (save-excursion
2061 (goto-char (point-max))
2062 (while (search-backward "\r\n" (point-min) t)
2063 (delete-char 1)))
2064 (setq end (marker-position end-marker))
2065 (set-marker end-marker nil)))
2066 ;; Make sure we have an Pmail BABYL attribute header field.
2067 ;; All we can assume is that the Pmail BABYL header field is
2068 ;; in the header section. It's placement can be modified by
2069 ;; another mailer.
2070 (let ((attributes (pmail-header-get-header
2071 pmail-header-attribute-header)))
2072 (unless attributes
2073 ;; No suitable header exists. Append the default BABYL
2074 ;; data header for a new message.
2075 (pmail-header-add-header pmail-header-attribute-header
2076 pmail-desc-default-attrs))))))
2077 message-count)))
2078
2079 (defun pmail-beginning-of-message ()
2080 "Show current message starting from the beginning."
2081 (interactive)
2082 (let ((pmail-show-message-hook
2083 (list (function (lambda ()
2084 (goto-char (point-min)))))))
2085 (pmail-show-message pmail-current-message)))
2086
2087 (defun pmail-end-of-message ()
2088 "Show bottom of current message."
2089 (interactive)
2090 (let ((pmail-show-message-hook
2091 (list (function (lambda ()
2092 (goto-char (point-max))
2093 (recenter (1- (window-height))))))))
2094 (pmail-show-message pmail-current-message)))
2095
2096 (defun pmail-unknown-mail-followup-to ()
2097 "Handle a \"Mail-Followup-To\" header field with an unknown mailing list.
2098 Ask the user whether to add that list name to `mail-mailing-lists'."
2099 (save-restriction
2100 (let ((mail-followup-to (pmail-header-get-header "mail-followup-to" nil t)))
2101 (when mail-followup-to
2102 (let ((addresses
2103 (split-string
2104 (mail-strip-quoted-names mail-followup-to)
2105 ",[[:space:]]+" t)))
2106 (dolist (addr addresses)
2107 (when (and (not (member addr mail-mailing-lists))
2108 (and pmail-user-mail-address-regexp
2109 (not (string-match pmail-user-mail-address-regexp
2110 addr)))
2111 (y-or-n-p
2112 (format "Add `%s' to `mail-mailing-lists'? "
2113 addr)))
2114 (customize-save-variable 'mail-mailing-lists
2115 (cons addr mail-mailing-lists)))))))))
2116
2117 (defun pmail-show-message (&optional n no-summary)
2118 "Show message number N (prefix argument), counting from start of file.
2119 If NO-SUMMARY is non-nil, then do not update the summary buffer."
2120 (interactive "p")
2121 (unless (eq major-mode 'pmail-mode)
2122 (switch-to-buffer pmail-buffer))
2123 (if (zerop pmail-total-messages)
2124 (progn
2125 (message "No messages to show. Add something better soon.")
2126 (force-mode-line-update))
2127 (let (blurb)
2128 ;; Set n to the first sane message based on the sign of n:
2129 ;; positive but greater than the total number of messages -> n;
2130 ;; negative -> 1.
2131 (if (not n)
2132 (setq n pmail-current-message)
2133 (cond ((<= n 0)
2134 (setq n 1
2135 pmail-current-message 1
2136 blurb "No previous message"))
2137 ((> n pmail-total-messages)
2138 (setq n pmail-total-messages
2139 pmail-current-message pmail-total-messages
2140 blurb "No following message"))
2141 (t
2142 (setq pmail-current-message n))))
2143 (let ((beg (pmail-desc-get-start n))
2144 (end (pmail-desc-get-end n)))
2145 (pmail-header-show-headers)
2146 (widen)
2147 (narrow-to-region beg end)
2148 (goto-char (point-min))
2149 ;; Clear the "unseen" attribute when we show a message, unless
2150 ;; it is already cleared.
2151 (when (pmail-desc-attr-p pmail-desc-unseen-index n)
2152 (pmail-desc-set-attribute n pmail-desc-unseen-index nil))
2153 (pmail-display-labels)
2154 ;; Deal with MIME
2155 (if (eq pmail-enable-mime t)
2156 (funcall pmail-show-mime-function)
2157 (setq pmail-view-buffer pmail-buffer))
2158 (when mail-mailing-lists
2159 (pmail-unknown-mail-followup-to))
2160 (pmail-header-hide-headers)
2161 (when transient-mark-mode (deactivate-mark))
2162 ;; Make sure that point in the Pmail window is at the beginning
2163 ;; of the buffer.
2164 (goto-char (point-min))
2165 (set-window-point (get-buffer-window pmail-buffer) (point))
2166 ;; Run any User code.
2167 (run-hooks 'pmail-show-message-hook)
2168 ;; If there is a summary buffer, try to move to this message in
2169 ;; that buffer. But don't complain if this message is not
2170 ;; mentioned in the summary. Don't do this at all if we were
2171 ;; called on behalf of cursor motion in the summary buffer.
2172 (when (and (pmail-summary-exists) (not no-summary))
2173 (let ((curr-msg pmail-current-message))
2174 ;; Set the summary current message, disabling the Pmail
2175 ;; buffer update.
2176 (with-current-buffer pmail-summary-buffer
2177 (pmail-summary-goto-msg curr-msg nil t))))
2178 (with-current-buffer pmail-buffer
2179 (pmail-auto-file))
2180 ;; Post back any status messages.
2181 (when blurb
2182 (message blurb))))))
2183
2184 (defun pmail-redecode-body (coding)
2185 "Decode the body of the current message using coding system CODING.
2186 This is useful with mail messages that have malformed or missing
2187 charset= headers.
2188
2189 This function assumes that the current message is already decoded
2190 and displayed in the PMAIL buffer, but the coding system used to
2191 decode it was incorrect. It then encodes the message back to its
2192 original form, and decodes it again, using the coding system CODING.
2193
2194 Note that if Emacs erroneously auto-detected one of the iso-2022
2195 encodings in the message, this function might fail because the escape
2196 sequences that switch between character sets and also single-shift and
2197 locking-shift codes are impossible to recover. This function is meant
2198 to be used to fix messages encoded with 8-bit encodings, such as
2199 iso-8859, koi8-r, etc."
2200 (interactive "zCoding system for re-decoding this message: ")
2201 (unless pmail-enable-mime
2202 (with-current-buffer pmail-buffer
2203 (save-excursion
2204 (let ((start (pmail-desc-get-start pmail-current-message))
2205 (end (pmail-desc-get-end pmail-current-message))
2206 header)
2207 (narrow-to-region start end)
2208 (setq header (pmail-header-get-header "X-Coding-System"))
2209 (if header
2210 (let ((old-coding (intern header))
2211 (buffer-read-only nil))
2212 (check-coding-system old-coding)
2213 ;; Make sure the new coding system uses the same EOL
2214 ;; conversion, to prevent ^M characters from popping
2215 ;; up all over the place.
2216 (setq coding
2217 (coding-system-change-eol-conversion
2218 coding
2219 (coding-system-eol-type old-coding)))
2220 ;; Do the actual recoding.
2221 (encode-coding-region start end old-coding)
2222 (decode-coding-region start end coding)
2223 ;; Rewrite the x-coding-system header according to
2224 ;; what we did.
2225 (setq last-coding-system-used coding)
2226 (pmail-header-add-header
2227 "X-Coding-System"
2228 (symbol-name last-coding-system-used))
2229 (pmail-show-message pmail-current-message))
2230 (error "No X-Coding-System header found")))))))
2231
2232 ;; FIXME: Double-check this
2233 (defun pmail-auto-file ()
2234 "Automatically move a message into a sub-folder based on criteria.
2235 Called when a new message is displayed."
2236 (if (or (member "filed" (pmail-desc-get-keywords pmail-current-message))
2237 (not (string= (buffer-file-name)
2238 (expand-file-name pmail-file-name))))
2239 ;; Do nothing if it's already been filed.
2240 nil
2241 ;; Find out some basics (common fields)
2242 (let ((from (mail-fetch-field "from"))
2243 (subj (mail-fetch-field "subject"))
2244 (to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc")))
2245 (directives pmail-automatic-folder-directives)
2246 (directive-loop nil)
2247 (folder nil))
2248 (while directives
2249 (setq folder (car (car directives))
2250 directive-loop (cdr (car directives)))
2251 (while (and (car directive-loop)
2252 (let ((f (cond
2253 ((string= (car directive-loop) "from") from)
2254 ((string= (car directive-loop) "to") to)
2255 ((string= (car directive-loop) "subject") subj)
2256 (t (mail-fetch-field (car directive-loop))))))
2257 (and f (string-match (car (cdr directive-loop)) f))))
2258 (setq directive-loop (cdr (cdr directive-loop))))
2259 ;; If there are no directives left, then it was a complete match.
2260 (if (null directive-loop)
2261 (if (null folder)
2262 (pmail-delete-forward)
2263 (if (string= "/dev/null" folder)
2264 (pmail-delete-message)
2265 (pmail-output folder 1 t)
2266 (setq directives nil))))
2267 (setq directives (cdr directives))))))
2268
2269 (defun pmail-next-message (n)
2270 "Show following message whether deleted or not.
2271 With prefix arg N, moves forward N messages, or backward if N is
2272 negative."
2273 (interactive "p")
2274 (with-current-buffer pmail-buffer
2275 (pmail-show-message (+ pmail-current-message n))))
2276
2277 (defun pmail-previous-message (n)
2278 "Show previous message whether deleted or not.
2279 With prefix arg N, moves backward N messages, or forward if N is
2280 negative."
2281 (interactive "p")
2282 (pmail-next-message (- n)))
2283
2284 (defun pmail-next-undeleted-message (n)
2285 "Show following non-deleted message.
2286 With prefix arg N, moves forward N non-deleted messages, or
2287 backward if N is negative.
2288
2289 Returns t if a new message is being shown, nil otherwise."
2290 (interactive "p")
2291 (let ((lastwin pmail-current-message)
2292 (original pmail-current-message)
2293 (current pmail-current-message))
2294 ;; Move forwards, remember the last undeleted message seen.
2295 (while (and (> n 0) (< current pmail-total-messages))
2296 (setq current (1+ current))
2297 (unless (pmail-desc-deleted-p current)
2298 (setq lastwin current
2299 n (1- n))))
2300 ;; Same thing for moving backwards
2301 (while (and (< n 0) (> current 1))
2302 (setq current (1- current))
2303 (unless (pmail-desc-deleted-p current)
2304 (setq lastwin current
2305 n (1+ n))))
2306 ;; Show the message (even if no movement took place so that the
2307 ;; delete attribute is marked) and determine the result value.
2308 (pmail-show-message lastwin)
2309 (if (/= lastwin original)
2310 t
2311 (if (< n 0)
2312 (message "No previous nondeleted message"))
2313 (if (> n 0)
2314 (message "No following nondeleted message"))
2315 nil)))
2316
2317 (defun pmail-previous-undeleted-message (n)
2318 "Show previous non-deleted message.
2319 With prefix argument N, moves backward N non-deleted messages,
2320 or forward if N is negative."
2321 (interactive "p")
2322 (pmail-next-undeleted-message (- n)))
2323
2324 (defun pmail-first-message ()
2325 "Show first message in file."
2326 (interactive)
2327 (pmail-show-message 1))
2328
2329 (defun pmail-last-message ()
2330 "Show last message in file."
2331 (interactive)
2332 (pmail-show-message pmail-total-messages))
2333
2334 (defun pmail-narrow-to-header (msg)
2335 "Narrow the buffer to the headers of message number MSG."
2336 (save-excursion
2337 (let ((start (pmail-desc-get-start msg))
2338 (end (pmail-desc-get-end msg)))
2339 (widen)
2340 (goto-char start)
2341 (unless (search-forward "\n\n" end t)
2342 (error "Invalid message format"))
2343 (narrow-to-region start (point)))))
2344
2345 (defun pmail-message-recipients-p (msg recipients &optional primary-only)
2346 (save-restriction
2347 (or (string-match recipients (or (mail-fetch-field "To") ""))
2348 (string-match recipients (or (mail-fetch-field "From") ""))
2349 (if (not primary-only)
2350 (string-match recipients (or (mail-fetch-field "Cc") ""))))))
2351
2352 (defun pmail-message-regexp-p (msg regexp)
2353 "Return t, if for message number MSG, regexp REGEXP matches in the header."
2354 (save-excursion
2355 (save-restriction
2356 (pmail-narrow-to-header msg)
2357 (re-search-forward regexp nil t))))
2358
2359 (defun pmail-search-message (msg regexp)
2360 "Return non-nil, if for message number MSG, regexp REGEXP matches."
2361 (goto-char (pmail-desc-get-start msg))
2362 (if pmail-enable-mime
2363 (funcall pmail-search-mime-message-function msg regexp)
2364 (re-search-forward regexp (pmail-desc-get-end msg) t)))
2365
2366 (defvar pmail-search-last-regexp nil)
2367 (defun pmail-search (regexp &optional n)
2368 "Show message containing next match for REGEXP (but not the current msg).
2369 Prefix argument gives repeat count; negative argument means search
2370 backwards (through earlier messages).
2371 Interactively, empty argument means use same regexp used last time."
2372 (interactive
2373 (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
2374 (prompt
2375 (concat (if reversep "Reverse " "") "Pmail search (regexp"))
2376 regexp)
2377 (setq prompt
2378 (concat prompt
2379 (if pmail-search-last-regexp
2380 (concat ", default "
2381 pmail-search-last-regexp "): ")
2382 "): ")))
2383 (setq regexp (read-string prompt))
2384 (cond ((not (equal regexp ""))
2385 (setq pmail-search-last-regexp regexp))
2386 ((not pmail-search-last-regexp)
2387 (error "No previous Pmail search string")))
2388 (list pmail-search-last-regexp
2389 (prefix-numeric-value current-prefix-arg))))
2390 (or n (setq n 1))
2391 (message "%sPmail search for %s..."
2392 (if (< n 0) "Reverse " "")
2393 regexp)
2394 (set-buffer pmail-buffer)
2395 (let ((omin (point-min))
2396 (omax (point-max))
2397 (opoint (point))
2398 (reversep (< n 0))
2399 (msg pmail-current-message)
2400 win)
2401 (unwind-protect
2402 (progn
2403 (widen)
2404 (while (/= n 0)
2405 ;; Check messages one by one, advancing message number up or down
2406 ;; but searching forward through each message.
2407 (if reversep
2408 (while (and (null win) (> msg 1))
2409 (setq msg (1- msg)
2410 win (pmail-search-message msg regexp)))
2411 (while (and (null win) (< msg pmail-total-messages))
2412 (setq msg (1+ msg)
2413 win (pmail-search-message msg regexp))))
2414 (setq n (+ n (if reversep 1 -1)))))
2415 (if win
2416 (progn
2417 (pmail-show-message msg)
2418 ;; Search forward (if this is a normal search) or backward
2419 ;; (if this is a reverse search) through this message to
2420 ;; position point. This search may fail because REGEXP
2421 ;; was found in the hidden portion of this message. In
2422 ;; that case, move point to the beginning of visible
2423 ;; portion.
2424 (if reversep
2425 (progn
2426 (goto-char (point-max))
2427 (re-search-backward regexp nil 'move))
2428 (goto-char (point-min))
2429 (re-search-forward regexp nil t))
2430 (message "%sPmail search for %s...done"
2431 (if reversep "Reverse " "")
2432 regexp))
2433 (goto-char opoint)
2434 (narrow-to-region omin omax)
2435 (ding)
2436 (message "Search failed: %s" regexp)))))
2437
2438 (defun pmail-search-backwards (regexp &optional n)
2439 "Show message containing previous match for REGEXP.
2440 Prefix argument gives repeat count; negative argument means search
2441 forward (through later messages).
2442 Interactively, empty argument means use same regexp used last time."
2443 (interactive
2444 (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
2445 (prompt
2446 (concat (if reversep "Reverse " "") "Pmail search (regexp"))
2447 regexp)
2448 (setq prompt
2449 (concat prompt
2450 (if pmail-search-last-regexp
2451 (concat ", default "
2452 pmail-search-last-regexp "): ")
2453 "): ")))
2454 (setq regexp (read-string prompt))
2455 (cond ((not (equal regexp ""))
2456 (setq pmail-search-last-regexp regexp))
2457 ((not pmail-search-last-regexp)
2458 (error "No previous Pmail search string")))
2459 (list pmail-search-last-regexp
2460 (prefix-numeric-value current-prefix-arg))))
2461 (pmail-search regexp (- (or n 1))))
2462
2463 ;; Show the first message which has the `unseen' attribute.
2464 (defun pmail-first-unseen-message ()
2465 "Return the first message which has not been seen. If all messages
2466 have been seen, then return the last message."
2467 (let ((current 1)
2468 found)
2469 (while (and (not found) (<= current pmail-total-messages))
2470 (if (pmail-desc-attr-p pmail-desc-unseen-index current)
2471 (setq found current))
2472 (setq current (1+ current)))
2473 (or found pmail-total-messages)))
2474
2475 (defun pmail-current-subject ()
2476 "Return the current subject.
2477 The subject is stripped of leading and trailing whitespace, and
2478 of typical reply prefixes such as Re:."
2479 (let ((subject (or (mail-fetch-field "Subject") "")))
2480 (if (string-match "\\`[ \t]+" subject)
2481 (setq subject (substring subject (match-end 0))))
2482 (if (string-match pmail-reply-regexp subject)
2483 (setq subject (substring subject (match-end 0))))
2484 (if (string-match "[ \t]+\\'" subject)
2485 (setq subject (substring subject 0 (match-beginning 0))))
2486 subject))
2487
2488 (defun pmail-current-subject-regexp ()
2489 "Return a regular expression matching the current subject.
2490 The regular expression matches the subject header line of
2491 messages about the same subject. The subject itself is stripped
2492 of leading and trailing whitespace, of typical reply prefixes
2493 such as Re: and whitespace within the subject is replaced by a
2494 regular expression matching whitespace in general in order to
2495 take into account that subject header lines may include newlines
2496 and more whitespace. The returned regular expressions contains
2497 `pmail-reply-regexp' and ends with a newline."
2498 (let ((subject (pmail-current-subject)))
2499 ;; If Subject is long, mailers will break it into several lines at
2500 ;; arbitrary places, so replace whitespace with a regexp that will
2501 ;; match any sequence of spaces, TABs, and newlines.
2502 (setq subject (regexp-quote subject))
2503 (setq subject
2504 (replace-regexp-in-string "[ \t\n]+" "[ \t\n]+" subject t t))
2505 ;; Some mailers insert extra spaces after "Subject:", so allow any
2506 ;; amount of them.
2507 (concat "^Subject:[ \t]+"
2508 (if (string= "\\`" (substring pmail-reply-regexp 0 2))
2509 (substring pmail-reply-regexp 2)
2510 pmail-reply-regexp)
2511 subject "[ \t]*\n")))
2512
2513 (defun pmail-next-same-subject (n)
2514 "Go to the next mail message having the same subject header.
2515 With prefix argument N, do this N times.
2516 If N is negative, go backwards instead."
2517 (interactive "p")
2518 (let ((search-regexp (pmail-current-subject-regexp))
2519 (forward (> n 0))
2520 (i pmail-current-message)
2521 (case-fold-search t)
2522 found)
2523 (save-excursion
2524 (save-restriction
2525 (widen)
2526 (if forward
2527 (while (and (/= n 0) (< i pmail-total-messages))
2528 (let (done)
2529 (while (and (not done)
2530 (< i pmail-total-messages))
2531 (setq i (+ i 1))
2532 (pmail-narrow-to-header i)
2533 (goto-char (point-min))
2534 (setq done (re-search-forward search-regexp (point-max) t)))
2535 (if done (setq found i)))
2536 (setq n (1- n)))
2537 (while (and (/= n 0) (> i 1))
2538 (let (done)
2539 (while (and (not done) (> i 1))
2540 (setq i (- i 1))
2541 (pmail-narrow-to-header i)
2542 (goto-char (point-min))
2543 (setq done (re-search-forward search-regexp (point-max) t)))
2544 (if done (setq found i)))
2545 (setq n (1+ n))))))
2546 (if found
2547 (pmail-show-message found)
2548 (error "No %s message with same subject"
2549 (if forward "following" "previous")))))
2550
2551 (defun pmail-previous-same-subject (n)
2552 "Go to the previous mail message having the same subject header.
2553 With prefix argument N, do this N times.
2554 If N is negative, go forwards instead."
2555 (interactive "p")
2556 (pmail-next-same-subject (- n)))
2557 \f
2558 ;;;; *** Pmail Message Deletion Commands ***
2559
2560 (defun pmail-delete-message ()
2561 "Delete this message and stay on it."
2562 (interactive)
2563 (pmail-desc-set-attribute pmail-current-message pmail-desc-deleted-index t)
2564 (run-hooks 'pmail-delete-message-hook)
2565 (pmail-show-message pmail-current-message))
2566
2567 (defun pmail-undelete-previous-message ()
2568 "Back up to deleted message, select it, and undelete it."
2569 (interactive)
2570 (set-buffer pmail-buffer)
2571 (let ((msg pmail-current-message))
2572 (while (and (> msg 0)
2573 (not (pmail-desc-attr-p pmail-desc-deleted-index msg)))
2574 (setq msg (1- msg)))
2575 (if (= msg 0)
2576 (error "No previous deleted message")
2577 (pmail-desc-set-attribute msg pmail-desc-deleted-index nil)
2578 (pmail-show-message msg)
2579 (if (pmail-summary-exists)
2580 (save-excursion
2581 (set-buffer pmail-summary-buffer)
2582 (pmail-summary-mark-undeleted msg)))
2583 (pmail-maybe-display-summary))))
2584
2585 ;;; mbox: ready
2586 (defun pmail-delete-forward (&optional backward)
2587 "Delete this message and move to next nondeleted one.
2588 Deleted messages stay in the file until the \\[pmail-expunge] command is given.
2589 With prefix argument, delete and move backward.
2590
2591 Returns t if a new message is displayed after the delete, or nil otherwise."
2592 (interactive "P")
2593 (pmail-desc-set-attribute pmail-current-message pmail-desc-deleted-index t)
2594 (run-hooks 'pmail-delete-message-hook)
2595 (let ((del-msg pmail-current-message))
2596 (if (pmail-summary-exists)
2597 (pmail-select-summary
2598 (pmail-summary-mark-deleted del-msg)))
2599 (prog1 (pmail-next-undeleted-message (if backward -1 1))
2600 (pmail-maybe-display-summary))))
2601
2602 ;;; mbox: ready
2603 (defun pmail-delete-backward ()
2604 "Delete this message and move to previous nondeleted one.
2605 Deleted messages stay in the file until the \\[pmail-expunge] command is given."
2606 (interactive)
2607 (pmail-delete-forward t))
2608
2609 (defun pmail-expunge-confirmed ()
2610 "Return t if deleted message should be expunged. If necessary, ask the user.
2611 See also user-option `pmail-confirm-expunge'."
2612 (set-buffer pmail-buffer)
2613 (let ((some-deleted))
2614 (dotimes (i pmail-total-messages)
2615 (if (pmail-desc-deleted-p (1+ i))
2616 (setq some-deleted t)))
2617 (or (not some-deleted)
2618 (null pmail-confirm-expunge)
2619 (funcall pmail-confirm-expunge
2620 "Erase deleted messages from Pmail file? "))))
2621
2622 (defun pmail-only-expunge (&optional dont-show)
2623 "Actually erase all deleted messages in the file."
2624 (interactive)
2625 (message "Expunging deleted messages...")
2626 ;; Discard all undo records for this buffer.
2627 (or (eq buffer-undo-list t) (setq buffer-undo-list nil))
2628 ;; Remove the messages from the buffer and from the Pmail message
2629 ;; descriptor vector.
2630 (setq pmail-expunge-counter 0)
2631 (pmail-desc-prune-deleted-messages 'pmail-expunge-callback)
2632 (setq pmail-current-message (- pmail-current-message pmail-expunge-counter))
2633 ;; Deal with the summary buffer and update
2634 ;; the User status.
2635 (let* ((omax (- (buffer-size) (point-max)))
2636 (omin (- (buffer-size) (point-min)))
2637 (opoint (if (and (> pmail-current-message 0)
2638 (pmail-message-deleted-p pmail-current-message))
2639 0
2640 (if pmail-enable-mime
2641 (with-current-buffer pmail-view-buffer
2642 (- (point)(point-min)))
2643 (- (point) (point-min))))))
2644 (when pmail-summary-buffer
2645 (with-current-buffer pmail-summary-buffer
2646 (pmail-update-summary)))
2647 (message "Expunging deleted messages...done")
2648 (if (not dont-show)
2649 (pmail-show-message
2650 (if (zerop pmail-current-message) 1 nil)))
2651 (if pmail-enable-mime
2652 (goto-char (+ (point-min) opoint))
2653 (goto-char (+ (point) opoint)))))
2654
2655 ;;; mbox: ready
2656 (defun pmail-expunge-callback (n)
2657 "Called after message N has been pruned to update the current Pmail
2658 message counter."
2659 ;; Process the various possible states to set the current message
2660 ;; counter.
2661 (setq pmail-total-messages (1- pmail-total-messages))
2662 (if (>= pmail-current-message n)
2663 (setq pmail-expunge-counter (1+ pmail-expunge-counter))))
2664
2665 ;;; mbox: ready
2666 (defun pmail-expunge ()
2667 "Erase deleted messages from Pmail file and summary buffer."
2668 (interactive)
2669 (when (pmail-expunge-confirmed)
2670 (pmail-only-expunge)))
2671 \f
2672 ;;;; *** Pmail Mailing Commands ***
2673
2674 ;;; mbox: In progress. I'm still not happy with the initial citation
2675 ;;; stuff. -pmr
2676 (defun pmail-start-mail (&optional noerase to subject in-reply-to cc
2677 replybuffer sendactions same-window others)
2678 (let (yank-action)
2679 (if replybuffer
2680 (setq yank-action (list 'insert-buffer replybuffer)))
2681 (setq others (cons (cons "cc" cc) others))
2682 (setq others (cons (cons "in-reply-to" in-reply-to) others))
2683 (if same-window
2684 (compose-mail to subject others
2685 noerase nil
2686 yank-action sendactions)
2687 (if pmail-mail-new-frame
2688 (prog1
2689 (compose-mail to subject others
2690 noerase 'switch-to-buffer-other-frame
2691 yank-action sendactions)
2692 ;; This is not a standard frame parameter;
2693 ;; nothing except sendmail.el looks at it.
2694 (modify-frame-parameters (selected-frame)
2695 '((mail-dedicated-frame . t))))
2696 (compose-mail to subject others
2697 noerase 'switch-to-buffer-other-window
2698 yank-action sendactions)))))
2699
2700 (defun pmail-mail ()
2701 "Send mail in another window.
2702 While composing the message, use \\[mail-yank-original] to yank the
2703 original message into it."
2704 (interactive)
2705 (pmail-start-mail nil nil nil nil nil pmail-view-buffer))
2706
2707 (defun pmail-continue ()
2708 "Continue composing outgoing message previously being composed."
2709 (interactive)
2710 (pmail-start-mail t))
2711
2712 (defun pmail-reply (just-sender)
2713 "Reply to the current message.
2714 Normally include CC: to all other recipients of original message;
2715 prefix argument means ignore them. While composing the reply,
2716 use \\[mail-yank-original] to yank the original message into it."
2717 (interactive "P")
2718 (if (= pmail-total-messages 0)
2719 (error "No messages in this file"))
2720 (save-excursion
2721 (save-restriction
2722 (let* ((msgnum pmail-current-message)
2723 (from (pmail-header-get-header "from"))
2724 (reply-to (or (pmail-header-get-header "reply-to" nil t) from))
2725 (cc (unless just-sender
2726 (pmail-header-get-header "cc" nil t)))
2727 (subject (pmail-header-get-header "subject"))
2728 (date (pmail-header-get-header "date"))
2729 (to (or (pmail-header-get-header "to" nil t) ""))
2730 (message-id (pmail-header-get-header "message-id"))
2731 (references (pmail-header-get-header "references" nil nil t))
2732 (resent-to (pmail-header-get-header "resent-reply-to" nil t))
2733 (resent-cc (unless just-sender
2734 (pmail-header-get-header "resent-cc" nil t)))
2735 (resent-reply-to (or (pmail-header-get-header "resent-to" nil t) "")))
2736 ;; Merge the resent-to and resent-cc into the to and cc.
2737 (if (and resent-to (not (equal resent-to "")))
2738 (if (not (equal to ""))
2739 (setq to (concat to ", " resent-to))
2740 (setq to resent-to)))
2741 (if (and resent-cc (not (equal resent-cc "")))
2742 (if (not (equal cc ""))
2743 (setq cc (concat cc ", " resent-cc))
2744 (setq cc resent-cc)))
2745 ;; Add `Re: ' to subject if not there already.
2746 (and (stringp subject)
2747 (setq subject
2748 (concat pmail-reply-prefix
2749 (if (let ((case-fold-search t))
2750 (string-match pmail-reply-regexp subject))
2751 (substring subject (match-end 0))
2752 subject))))
2753 ;; Now setup the mail reply buffer.
2754 (pmail-start-mail
2755 nil
2756 ;; Using mail-strip-quoted-names is undesirable with newer
2757 ;; mailers since they can handle the names unstripped. I
2758 ;; don't know whether there are other mailers that still need
2759 ;; the names to be stripped.
2760 ;;; (mail-strip-quoted-names reply-to)
2761 ;; Remove unwanted names from reply-to, since Mail-Followup-To
2762 ;; header causes all the names in it to wind up in reply-to, not
2763 ;; in cc. But if what's left is an empty list, use the original.
2764 (let* ((reply-to-list (rmail-dont-reply-to reply-to)))
2765 (if (string= reply-to-list "") reply-to reply-to-list))
2766 subject
2767 (pmail-make-in-reply-to-field from date message-id)
2768 (if just-sender
2769 nil
2770 ;; mail-strip-quoted-names is NOT necessary for
2771 ;; rmail-dont-reply-to to do its job.
2772 (let* ((cc-list (rmail-dont-reply-to
2773 (mail-strip-quoted-names
2774 (if (null cc) to (concat to ", " cc))))))
2775 (if (string= cc-list "") nil cc-list)))
2776 pmail-view-buffer
2777 (list (list 'pmail-reply-callback pmail-buffer "answered" t msgnum))
2778 nil
2779 (list (cons "References" (concat (mapconcat 'identity references " ")
2780 " " message-id))))))))
2781
2782 (defun pmail-reply-callback (buffer attr state n)
2783 "Mail reply callback function.
2784 Sets ATTR (a string) if STATE is
2785 non-nil, otherwise clears it. N is the message number.
2786 BUFFER, possibly narrowed, contains an mbox mail message."
2787 (save-excursion
2788 (set-buffer buffer)
2789 (pmail-set-attribute attr state n)
2790 (pmail-show-message)))
2791
2792 (defun pmail-mark-message (msgnum-list attr-index)
2793 "Set attribute ATTRIBUTE-INDEX in the message of the car of MSGNUM-LIST.
2794 This is used in the send-actions for
2795 message buffers. MSGNUM-LIST is a list of the form (MSGNUM)."
2796 (save-excursion
2797 (let ((n (car msgnum-list)))
2798 (set-buffer pmail-buffer)
2799 (pmail-narrow-to-message n)
2800 (pmail-desc-set-attribute n attr-index t))))
2801
2802 (defun pmail-narrow-to-message (n)
2803 "Narrow the current (pmail) buffer to bracket message N."
2804 (widen)
2805 (narrow-to-region (pmail-desc-get-start n) (pmail-desc-get-end n)))
2806
2807 (defun pmail-make-in-reply-to-field (from date message-id)
2808 (cond ((not from)
2809 (if message-id
2810 message-id
2811 nil))
2812 (mail-use-rfc822
2813 (require 'rfc822)
2814 (let ((tem (car (rfc822-addresses from))))
2815 (if message-id
2816 (if (or (not tem)
2817 (string-match
2818 (regexp-quote (if (string-match "@[^@]*\\'" tem)
2819 (substring tem 0
2820 (match-beginning 0))
2821 tem))
2822 message-id))
2823 ;; missing From, or Message-ID is sufficiently informative
2824 message-id
2825 (concat message-id " (" tem ")"))
2826 ;; Copy TEM, discarding text properties.
2827 (setq tem (copy-sequence tem))
2828 (set-text-properties 0 (length tem) nil tem)
2829 (setq tem (copy-sequence tem))
2830 ;; Use prin1 to fake RFC822 quoting
2831 (let ((field (prin1-to-string tem)))
2832 (if date
2833 (concat field "'s message of " date)
2834 field)))))
2835 ((let* ((foo "[^][\000-\037()<>@,;:\\\" ]+")
2836 (bar "[^][\000-\037()<>@,;:\\\"]+"))
2837 ;; These strings both match all non-ASCII characters.
2838 (or (string-match (concat "\\`[ \t]*\\(" bar
2839 "\\)\\(<" foo "@" foo ">\\)?[ \t]*\\'")
2840 ;; "Unix Loser <Foo@bar.edu>" => "Unix Loser"
2841 from)
2842 (string-match (concat "\\`[ \t]*<" foo "@" foo ">[ \t]*(\\("
2843 bar "\\))[ \t]*\\'")
2844 ;; "<Bugs@bar.edu>" (Losing Unix) => "Losing Unix"
2845 from)))
2846 (let ((start (match-beginning 1))
2847 (end (match-end 1)))
2848 ;; Trim whitespace which above regexp match allows
2849 (while (and (< start end)
2850 (memq (aref from start) '(?\t ?\ )))
2851 (setq start (1+ start)))
2852 (while (and (< start end)
2853 (memq (aref from (1- end)) '(?\t ?\ )))
2854 (setq end (1- end)))
2855 (let ((field (substring from start end)))
2856 (if date (setq field (concat "message from " field " on " date)))
2857 (if message-id
2858 ;; "<AA259@bar.edu> (message from Unix Loser on 1-Apr-89)"
2859 (concat message-id " (" field ")")
2860 field))))
2861 (t
2862 ;; If we can't kludge it simply, do it correctly
2863 (let ((mail-use-rfc822 t))
2864 (pmail-make-in-reply-to-field from date message-id)))))
2865 \f
2866 ;;; mbox: ready
2867 (defun pmail-forward (resend)
2868 "Forward the current message to another user.
2869 With prefix argument, \"resend\" the message instead of forwarding it;
2870 see the documentation of `pmail-resend'."
2871 (interactive "P")
2872 (if (= pmail-total-messages 0)
2873 (error "No messages in this file"))
2874 (if resend
2875 (call-interactively 'pmail-resend)
2876 (let ((forward-buffer pmail-buffer)
2877 (msgnum pmail-current-message)
2878 (subject (concat "["
2879 (let ((from (or (mail-fetch-field "From")
2880 (mail-fetch-field ">From"))))
2881 (if from
2882 (concat (mail-strip-quoted-names from) ": ")
2883 ""))
2884 (or (mail-fetch-field "Subject") "")
2885 "]")))
2886 (if (pmail-start-mail
2887 nil nil subject nil nil nil
2888 (list (list 'pmail-mark-message
2889 forward-buffer
2890 (with-current-buffer pmail-buffer
2891 (pmail-desc-get-start msgnum))
2892 "forwarded"))
2893 ;; If only one window, use it for the mail buffer.
2894 ;; Otherwise, use another window for the mail buffer
2895 ;; so that the Pmail buffer remains visible
2896 ;; and sending the mail will get back to it.
2897 (and (not pmail-mail-new-frame) (one-window-p t)))
2898 ;; The mail buffer is now current.
2899 (save-excursion
2900 ;; Insert after header separator--before signature if any.
2901 (goto-char (mail-text-start))
2902 (if (or pmail-enable-mime pmail-enable-mime-composing)
2903 (funcall pmail-insert-mime-forwarded-message-function
2904 forward-buffer)
2905 (insert "------- Start of forwarded message -------\n")
2906 ;; Quote lines with `- ' if they start with `-'.
2907 (let ((beg (point)) end)
2908 (setq end (point-marker))
2909 (set-marker-insertion-type end t)
2910 (insert-buffer-substring forward-buffer)
2911 (goto-char beg)
2912 (while (re-search-forward "^-" end t)
2913 (beginning-of-line)
2914 (insert "- ")
2915 (forward-line 1))
2916 (goto-char end)
2917 (skip-chars-backward "\n")
2918 (if (< (point) end)
2919 (forward-char 1))
2920 (delete-region (point) end)
2921 (set-marker end nil))
2922 (insert "------- End of forwarded message -------\n"))
2923 (push-mark))))))
2924 \f
2925 (defun pmail-resend (address &optional from comment mail-alias-file)
2926 "Resend current message to ADDRESSES.
2927 ADDRESSES should be a single address, a string consisting of several
2928 addresses separated by commas, or a list of addresses.
2929
2930 Optional FROM is the address to resend the message from, and
2931 defaults from the value of `user-mail-address'.
2932 Optional COMMENT is a string to insert as a comment in the resent message.
2933 Optional ALIAS-FILE is alternate aliases file to be used by sendmail,
2934 typically for purposes of moderating a list."
2935 (interactive "sResend to: ")
2936 (if (= pmail-total-messages 0)
2937 (error "No messages in this file"))
2938 (require 'sendmail)
2939 (require 'mailalias)
2940 (unless (or (eq pmail-view-buffer (current-buffer))
2941 (eq pmail-buffer (current-buffer)))
2942 (error "Not an Pmail buffer"))
2943 (if (not from) (setq from user-mail-address))
2944 (let ((tembuf (generate-new-buffer " sendmail temp"))
2945 (case-fold-search nil)
2946 (mail-personal-alias-file
2947 (or mail-alias-file mail-personal-alias-file))
2948 (mailbuf pmail-buffer))
2949 (unwind-protect
2950 (with-current-buffer tembuf
2951 ;;>> Copy message into temp buffer
2952 (if pmail-enable-mime
2953 (funcall pmail-insert-mime-resent-message-function mailbuf)
2954 (insert-buffer-substring mailbuf))
2955 (goto-char (point-min))
2956 ;; Delete any Sender field, since that's not specifiable.
2957 ; Only delete Sender fields in the actual header.
2958 (re-search-forward "^$" nil 'move)
2959 ; Using "while" here rather than "if" because some buggy mail
2960 ; software may have inserted multiple Sender fields.
2961 (while (re-search-backward "^Sender:" nil t)
2962 (let (beg)
2963 (setq beg (point))
2964 (forward-line 1)
2965 (while (looking-at "[ \t]")
2966 (forward-line 1))
2967 (delete-region beg (point))))
2968 ; Go back to the beginning of the buffer so the Resent- fields
2969 ; are inserted there.
2970 (goto-char (point-min))
2971 ;;>> Insert resent-from:
2972 (insert "Resent-From: " from "\n")
2973 (insert "Resent-Date: " (mail-rfc822-date) "\n")
2974 ;;>> Insert resent-to: and bcc if need be.
2975 (let ((before (point)))
2976 (if mail-self-blind
2977 (insert "Resent-Bcc: " (user-login-name) "\n"))
2978 (insert "Resent-To: " (if (stringp address)
2979 address
2980 (mapconcat 'identity address ",\n\t"))
2981 "\n")
2982 ;; Expand abbrevs in the recipients.
2983 (save-excursion
2984 (if (featurep 'mailabbrev)
2985 (let ((end (point-marker))
2986 (local-abbrev-table mail-abbrevs)
2987 (old-syntax-table (syntax-table)))
2988 (if (and (not (vectorp mail-abbrevs))
2989 (file-exists-p mail-personal-alias-file))
2990 (build-mail-abbrevs))
2991 (unless mail-abbrev-syntax-table
2992 (mail-abbrev-make-syntax-table))
2993 (set-syntax-table mail-abbrev-syntax-table)
2994 (goto-char before)
2995 (while (and (< (point) end)
2996 (progn (forward-word 1)
2997 (<= (point) end)))
2998 (expand-abbrev))
2999 (set-syntax-table old-syntax-table))
3000 (expand-mail-aliases before (point)))))
3001 ;;>> Set up comment, if any.
3002 (if (and (sequencep comment) (not (zerop (length comment))))
3003 (let ((before (point))
3004 after)
3005 (insert comment)
3006 (or (eolp) (insert "\n"))
3007 (setq after (point))
3008 (goto-char before)
3009 (while (< (point) after)
3010 (insert "Resent-Comment: ")
3011 (forward-line 1))))
3012 ;; Don't expand aliases in the destination fields
3013 ;; of the original message.
3014 (let (mail-aliases)
3015 (funcall send-mail-function)))
3016 (kill-buffer tembuf))
3017 (with-current-buffer pmail-buffer
3018 (pmail-set-attribute "resent" t pmail-current-message))))
3019 \f
3020 (defvar mail-unsent-separator
3021 (concat "^ *---+ +Unsent message follows +---+ *$\\|"
3022 "^ *---+ +Returned message +---+ *$\\|"
3023 "^ *---+ *Returned mail follows *---+ *$\\|"
3024 "^Start of returned message$\\|"
3025 "^---+ Below this line is a copy of the message.$\\|"
3026 "^ *---+ +Original message +---+ *$\\|"
3027 "^ *--+ +begin message +--+ *$\\|"
3028 "^ *---+ +Original message follows +---+ *$\\|"
3029 "^ *---+ +Your message follows +---+ *$\\|"
3030 "^|? *---+ +Message text follows: +---+ *|?$\\|"
3031 "^ *---+ +This is a copy of \\w+ message, including all the headers.*---+ *$")
3032 "A regexp that matches the separator before the text of a failed message.")
3033
3034 (defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$"
3035 "A regexp that matches the header of a MIME body part with a failed message.")
3036
3037 (defun pmail-retry-failure ()
3038 "Edit a mail message which is based on the contents of the current message.
3039 For a message rejected by the mail system, extract the interesting headers and
3040 the body of the original message.
3041 If the failed message is a MIME multipart message, it is searched for a
3042 body part with a header which matches the variable `mail-mime-unsent-header'.
3043 Otherwise, the variable `mail-unsent-separator' should match the string that
3044 delimits the returned original message.
3045 The variable `pmail-retry-ignored-headers' is a regular expression
3046 specifying headers which should not be copied into the new message."
3047 (interactive)
3048 (if (= pmail-total-messages 0)
3049 (error "No messages in this file"))
3050 (require 'mail-utils)
3051 (let ((pmail-this-buffer (current-buffer))
3052 (msgnum pmail-current-message)
3053 bounce-start bounce-end bounce-indent resending
3054 (content-type
3055 (save-excursion
3056 (save-restriction
3057 (pmail-header-get-header "Content-Type")))))
3058 (save-excursion
3059 (goto-char (point-min))
3060 (let ((case-fold-search t))
3061 (if (and content-type
3062 (string-match
3063 ";[\n\t ]*boundary=\"?\\([-0-9a-z'()+_,./:=? ]+\\)\"?"
3064 content-type))
3065 ;; Handle a MIME multipart bounce message.
3066 (let ((codestring
3067 (concat "\n--"
3068 (substring content-type (match-beginning 1)
3069 (match-end 1)))))
3070 (unless (re-search-forward mail-mime-unsent-header nil t)
3071 (error "Cannot find beginning of header in failed message"))
3072 (unless (search-forward "\n\n" nil t)
3073 (error "Cannot find start of Mime data in failed message"))
3074 (setq bounce-start (point))
3075 (if (search-forward codestring nil t)
3076 (setq bounce-end (match-beginning 0))
3077 (setq bounce-end (point-max))))
3078 ;; Non-MIME bounce.
3079 (or (re-search-forward mail-unsent-separator nil t)
3080 (error "Cannot parse this as a failure message"))
3081 (skip-chars-forward "\n")
3082 ;; Support a style of failure message in which the original
3083 ;; message is indented, and included within lines saying
3084 ;; `Start of returned message' and `End of returned message'.
3085 (if (looking-at " +Received:")
3086 (progn
3087 (setq bounce-start (point))
3088 (skip-chars-forward " ")
3089 (setq bounce-indent (- (current-column)))
3090 (goto-char (point-max))
3091 (re-search-backward "^End of returned message$" nil t)
3092 (setq bounce-end (point)))
3093 ;; One message contained a few random lines before
3094 ;; the old message header. The first line of the
3095 ;; message started with two hyphens. A blank line
3096 ;; followed these random lines. The same line
3097 ;; beginning with two hyphens was possibly marking
3098 ;; the end of the message.
3099 (if (looking-at "^--")
3100 (let ((boundary (buffer-substring-no-properties
3101 (point)
3102 (progn (end-of-line) (point)))))
3103 (search-forward "\n\n")
3104 (skip-chars-forward "\n")
3105 (setq bounce-start (point))
3106 (goto-char (point-max))
3107 (search-backward (concat "\n\n" boundary) bounce-start t)
3108 (setq bounce-end (point)))
3109 (setq bounce-start (point)
3110 bounce-end (point-max)))
3111 (unless (search-forward "\n\n" nil t)
3112 (error "Cannot find end of header in failed message"))))))
3113 ;; We have found the message that bounced, within the current message.
3114 ;; Now start sending new message; default header fields from original.
3115 ;; Turn off the usual actions for initializing the message body
3116 ;; because we want to get only the text from the failure message.
3117 (let (mail-signature mail-setup-hook)
3118 (if (pmail-start-mail nil nil nil nil nil pmail-this-buffer
3119 (list (list 'pmail-mark-message
3120 pmail-this-buffer
3121 (with-current-buffer pmail-buffer
3122 (pmail-desc-get-start msgnum))
3123 "retried")))
3124 ;; Insert original text as initial text of new draft message.
3125 ;; Bind inhibit-read-only since the header delimiter
3126 ;; of the previous message was probably read-only.
3127 (let ((inhibit-read-only t)
3128 pmail-displayed-headers
3129 pmail-ignored-headers)
3130 (erase-buffer)
3131 (insert-buffer-substring pmail-this-buffer
3132 bounce-start bounce-end)
3133 (goto-char (point-min))
3134 (if bounce-indent
3135 (indent-rigidly (point-min) (point-max) bounce-indent))
3136 (pmail-clear-headers pmail-retry-ignored-headers)
3137 (pmail-clear-headers "^sender:\\|^return-path:\\|^received:")
3138 (mail-sendmail-delimit-header)
3139 (save-restriction
3140 (narrow-to-region (point-min) (mail-header-end))
3141 (setq resending (mail-fetch-field "resent-to"))
3142 (if mail-self-blind
3143 (if resending
3144 (insert "Resent-Bcc: " (user-login-name) "\n")
3145 (insert "BCC: " (user-login-name) "\n"))))
3146 (goto-char (point-min))
3147 (mail-position-on-field (if resending "Resent-To" "To") t))))))
3148 \f
3149 (defun pmail-summary-exists ()
3150 "Non-nil if in an PMAIL buffer and an associated summary buffer exists.
3151 In fact, the non-nil value returned is the summary buffer itself."
3152 (and pmail-summary-buffer (buffer-name pmail-summary-buffer)
3153 pmail-summary-buffer))
3154
3155 (defun pmail-summary-displayed ()
3156 "t if in PMAIL buffer and an associated summary buffer is displayed."
3157 (and pmail-summary-buffer (get-buffer-window pmail-summary-buffer)))
3158
3159 (defcustom pmail-redisplay-summary nil
3160 "*Non-nil means Pmail should show the summary when it changes.
3161 This has an effect only if a summary buffer exists."
3162 :type 'boolean
3163 :group 'pmail-summary)
3164
3165 (defcustom pmail-summary-window-size nil
3166 "*Non-nil means specify the height for an Pmail summary window."
3167 :type '(choice (const :tag "Disabled" nil) integer)
3168 :group 'pmail-summary)
3169
3170 ;; Put the summary buffer back on the screen, if user wants that.
3171 (defun pmail-maybe-display-summary ()
3172 (let ((selected (selected-window))
3173 window)
3174 ;; If requested, make sure the summary is displayed.
3175 (and pmail-summary-buffer (buffer-name pmail-summary-buffer)
3176 pmail-redisplay-summary
3177 (if (get-buffer-window pmail-summary-buffer 0)
3178 ;; It's already in some frame; show that one.
3179 (let ((frame (window-frame
3180 (get-buffer-window pmail-summary-buffer 0))))
3181 (make-frame-visible frame)
3182 (raise-frame frame))
3183 (display-buffer pmail-summary-buffer)))
3184 ;; If requested, set the height of the summary window.
3185 (and pmail-summary-buffer (buffer-name pmail-summary-buffer)
3186 pmail-summary-window-size
3187 (setq window (get-buffer-window pmail-summary-buffer))
3188 ;; Don't try to change the size if just one window in frame.
3189 (not (eq window (frame-root-window (window-frame window))))
3190 (unwind-protect
3191 (progn
3192 (select-window window)
3193 (enlarge-window (- pmail-summary-window-size (window-height))))
3194 (select-window selected)))))
3195 \f
3196 ;;;; *** Pmail Local Fontification ***
3197
3198 (defun pmail-fontify-buffer-function ()
3199 ;; This function's symbol is bound to font-lock-fontify-buffer-function.
3200 (add-hook 'pmail-show-message-hook 'pmail-fontify-message nil t)
3201 ;; If we're already showing a message, fontify it now.
3202 (if pmail-current-message (pmail-fontify-message))
3203 ;; Prevent Font Lock mode from kicking in.
3204 (setq font-lock-fontified t))
3205
3206 (defun pmail-unfontify-buffer-function ()
3207 ;; This function's symbol is bound to font-lock-fontify-unbuffer-function.
3208 (let ((modified (buffer-modified-p))
3209 (buffer-undo-list t) (inhibit-read-only t)
3210 before-change-functions after-change-functions
3211 buffer-file-name buffer-file-truename)
3212 (save-restriction
3213 (widen)
3214 (remove-hook 'pmail-show-message-hook 'pmail-fontify-message t)
3215 (remove-text-properties (point-min) (point-max) '(pmail-fontified nil))
3216 (font-lock-default-unfontify-buffer)
3217 (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil)))))
3218
3219 (defun pmail-fontify-message ()
3220 "Fontify the current message if it is not already fontified."
3221 (when (text-property-any (point-min) (point-max) 'pmail-fontified nil)
3222 (let ((modified (buffer-modified-p))
3223 (buffer-undo-list t) (inhibit-read-only t)
3224 before-change-functions after-change-functions
3225 buffer-file-name buffer-file-truename)
3226 (save-excursion
3227 (save-match-data
3228 (add-text-properties (point-min) (point-max) '(pmail-fontified t))
3229 (font-lock-fontify-region (point-min) (point-max))
3230 (and (not modified) (buffer-modified-p)
3231 (set-buffer-modified-p nil)))))))
3232 \f
3233 ;;; Speedbar support for PMAIL files.
3234 (eval-when-compile (require 'speedbar))
3235
3236 (defvar pmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
3237 "*This regex is used to match folder names to be displayed in speedbar.
3238 Enabling this will permit speedbar to display your folders for easy
3239 browsing, and moving of messages.")
3240
3241 (defvar pmail-speedbar-last-user nil
3242 "The last user to be displayed in the speedbar.")
3243
3244 (defvar pmail-speedbar-key-map nil
3245 "Keymap used when in pmail display mode.")
3246
3247 (defun pmail-install-speedbar-variables ()
3248 "Install those variables used by speedbar to enhance pmail."
3249 (if pmail-speedbar-key-map
3250 nil
3251 (setq pmail-speedbar-key-map (speedbar-make-specialized-keymap))
3252
3253 (define-key pmail-speedbar-key-map "e" 'speedbar-edit-line)
3254 (define-key pmail-speedbar-key-map "r" 'speedbar-edit-line)
3255 (define-key pmail-speedbar-key-map "\C-m" 'speedbar-edit-line)
3256 (define-key pmail-speedbar-key-map "M"
3257 'pmail-speedbar-move-message-to-folder-on-line)))
3258
3259 (defvar pmail-speedbar-menu-items
3260 '(["Read Folder" speedbar-edit-line t]
3261 ["Move message to folder" pmail-speedbar-move-message-to-folder-on-line
3262 (save-excursion (beginning-of-line)
3263 (looking-at "<M> "))])
3264 "Additional menu-items to add to speedbar frame.")
3265
3266 ;; Make sure our special speedbar major mode is loaded
3267 (if (featurep 'speedbar)
3268 (pmail-install-speedbar-variables)
3269 (add-hook 'speedbar-load-hook 'pmail-install-speedbar-variables))
3270
3271 (defun pmail-speedbar-buttons (buffer)
3272 "Create buttons for BUFFER containing pmail messages.
3273 Click on the address under Reply to: to reply to this person.
3274 Under Folders: Click a name to read it, or on the <M> to move the
3275 current message into that PMAIL folder."
3276 (let ((from nil))
3277 (save-excursion
3278 (set-buffer buffer)
3279 (goto-char (point-min))
3280 (if (not (re-search-forward "^Reply-To: " nil t))
3281 (if (not (re-search-forward "^From:? " nil t))
3282 (setq from t)))
3283 (if from
3284 nil
3285 (setq from (buffer-substring (point) (save-excursion
3286 (end-of-line)
3287 (point))))))
3288 (goto-char (point-min))
3289 (if (and (looking-at "Reply to:")
3290 (equal from pmail-speedbar-last-user))
3291 nil
3292 (setq pmail-speedbar-last-user from)
3293 (erase-buffer)
3294 (insert "Reply To:\n")
3295 (if (stringp from)
3296 (speedbar-insert-button from 'speedbar-directory-face 'highlight
3297 'pmail-speedbar-button 'pmail-reply))
3298 (insert "Folders:\n")
3299 (let* ((case-fold-search nil)
3300 (df (directory-files (save-excursion (set-buffer buffer)
3301 default-directory)
3302 nil pmail-speedbar-match-folder-regexp)))
3303 (while df
3304 (speedbar-insert-button "<M>" 'speedbar-button-face 'highlight
3305 'pmail-speedbar-move-message (car df))
3306 (speedbar-insert-button (car df) 'speedbar-file-face 'highlight
3307 'pmail-speedbar-find-file nil t)
3308 (setq df (cdr df)))))))
3309
3310 (defun pmail-speedbar-button (text token indent)
3311 "Execute an pmail command specified by TEXT.
3312 The command used is TOKEN. INDENT is not used."
3313 (speedbar-with-attached-buffer
3314 (funcall token t)))
3315
3316 (defun pmail-speedbar-find-file (text token indent)
3317 "Load in the pmail file TEXT.
3318 TOKEN and INDENT are not used."
3319 (speedbar-with-attached-buffer
3320 (message "Loading in PMAIL file %s..." text)
3321 (find-file text)))
3322
3323 (defun pmail-speedbar-move-message-to-folder-on-line ()
3324 "If the current line is a folder, move current message to it."
3325 (interactive)
3326 (save-excursion
3327 (beginning-of-line)
3328 (if (re-search-forward "<M> " (save-excursion (end-of-line) (point)) t)
3329 (progn
3330 (forward-char -2)
3331 (speedbar-do-function-pointer)))))
3332
3333 (defun pmail-speedbar-move-message (text token indent)
3334 "From button TEXT, copy current message to the pmail file specified by TOKEN.
3335 TEXT and INDENT are not used."
3336 (speedbar-with-attached-buffer
3337 (message "Moving message to %s" token)
3338 (pmail-output-to-pmail-file token)))
3339
3340 ; Functions for setting, getting and encoding the POP password.
3341 ; The password is encoded to prevent it from being easily accessible
3342 ; to "prying eyes." Obviously, this encoding isn't "real security,"
3343 ; nor is it meant to be.
3344
3345 ;;;###autoload
3346 (defun pmail-set-remote-password (password)
3347 "Set PASSWORD to be used for retrieving mail from a POP or IMAP server."
3348 (interactive "sPassword: ")
3349 (if password
3350 (setq pmail-encoded-remote-password
3351 (pmail-encode-string password (emacs-pid)))
3352 (setq pmail-remote-password nil)
3353 (setq pmail-encoded-remote-password nil)))
3354
3355 (defun pmail-get-remote-password (imap)
3356 "Get the password for retrieving mail from a POP or IMAP server. If none
3357 has been set, then prompt the user for one."
3358 (when (not pmail-encoded-remote-password)
3359 (if (not pmail-remote-password)
3360 (setq pmail-remote-password
3361 (read-passwd (if imap
3362 "IMAP password: "
3363 "POP password: "))))
3364 (pmail-set-remote-password pmail-remote-password)
3365 (setq pmail-remote-password nil))
3366 (pmail-encode-string pmail-encoded-remote-password (emacs-pid)))
3367
3368 (defun pmail-have-password ()
3369 (or pmail-remote-password pmail-encoded-remote-password))
3370
3371 (defun pmail-encode-string (string mask)
3372 "Encode STRING with integer MASK, by taking the exclusive OR of the
3373 lowest byte in the mask with the first character of string, the
3374 second-lowest-byte with the second character of the string, etc.,
3375 restarting at the lowest byte of the mask whenever it runs out.
3376 Returns the encoded string. Calling the function again with an
3377 encoded string (and the same mask) will decode the string."
3378 (setq mask (abs mask)) ; doesn't work if negative
3379 (let* ((string-vector (string-to-vector string)) (i 0)
3380 (len (length string-vector)) (curmask mask) charmask)
3381 (while (< i len)
3382 (if (= curmask 0)
3383 (setq curmask mask))
3384 (setq charmask (% curmask 256))
3385 (setq curmask (lsh curmask -8))
3386 (aset string-vector i (logxor charmask (aref string-vector i)))
3387 (setq i (1+ i)))
3388 (concat string-vector)))
3389
3390 ;;;; Desktop support
3391
3392 (defun pmail-restore-desktop-buffer (desktop-buffer-file-name
3393 desktop-buffer-name
3394 desktop-buffer-misc)
3395 "Restore an pmail buffer specified in a desktop file."
3396 (condition-case error
3397 (progn
3398 (pmail-input desktop-buffer-file-name)
3399 (if (eq major-mode 'pmail-mode)
3400 (current-buffer)
3401 pmail-buffer))
3402 (file-locked
3403 (kill-buffer (current-buffer))
3404 nil)))
3405
3406 (add-to-list 'desktop-buffer-mode-handlers
3407 '(pmail-mode . pmail-restore-desktop-buffer))
3408
3409 (provide 'pmail)
3410
3411 ;; Local Variables:
3412 ;; change-log-default-name: "ChangeLog.pmail"
3413 ;; End:
3414
3415 ;; arch-tag: 65d257d3-c281-4a65-9c38-e61af95af2f0
3416 ;;; pmail.el ends here