Mercurial > emacs
comparison lisp/mail/rmail.el @ 88125:5da4d43003a3
Modify requires and evals to reduce byte compilation warnings.
(rmail-ignored-headers): Ignore "from" but not "mail-from". Ignore
"x-authentication-warning", "x-operating-system", and new babyl-V6
headers.
(rmail-displayed-headers): Add basic headers.
(rmail-message-vector, rmail-deleted-vector, rmail-msgref-vector,
rmail-convert-file): Deprecated.
(rmail-unix-mail-delimiter): Updated comment, anchored the "From"
string to the beginning of the line.
(rmail): Do not convert the buffer to Babyl format; Add support for
initializing and getting mbox format mail
(rmail-insert-rmail-file-header): Replace the Babyl identifier text
with an X-BABYL mail header.
(rmail-initialize-message): New function.
(rmail-url-map): Use "B" to send a mail message body to a browser; Map
"j" to (rmail-message) rather than (rmail-show-message); Map "o" to
(rmail-output) rather than (rmail-output-to-rmail-file); Add support
for handling embedded URLs.
(rmail-mode-map): Map the "Output (inbox)" menubar item to use
rmail-output.
(rmail-revert): Do not convert to Babyl 5 format; Use the new
initialization function.
(rmail-expunge-and-save): Use (rmail-display-summary-maybe).
(rmail-display-summary-maybe): New function.
(rmail-duplicate-message): Use the new rmail message descriptor to
access the message start and end positions.
(rmail-construct-io-menu): Use (rmail-output) instead of
(rmail-output-to-rmail-file).
(rmail-get-new-mail): Do not do a partial initialization; add a local
variable: 'current-message'; remove local variable 'success'; overhaul
the Babyl 5 specific parts.
(rmail-msg-is-pruned): Rewrite using the rmail message descriptor.
(rmail-toggle-header): Complete rewrite.
(rmail-narrow-to-non-pruned-header): Use the rmail message descriptor.
(rmail-display-labels, rmail-set-attribute): Rewrite.
(rmail-widen-to-current-msgbeg): Use the rmail message descriptor.
(rmail-process-new-messages): New (refactored) method.
(rmail-show-message): Rewrite.
(rmail-redecode-body): Rewrite using rmail message descriptor.
(rmail-auto-file): Make a little clearer; user (rmail-output) instead
of (rmail-output-to-rmail-file).
(rmail-next-undeleted-message): Slight rewrite.
(rmail-first-message, rmail-last-message, rmail-search-last-regexp):
Do not do partial initialization.
(rmail-what-message, rmail-search-message, rmail-message-regexp-p,
rmail-narrow-to-header): Use the rmail message descriptor.
(rmail-first-unseen-message, rmail-next-same-subject): Rewrite.
(rmail-message-deleted-p, rmail-delete-message,
rmail-undelete-previous-message, rmail-delete-forward, rmail-forward):
Use the rmail message descriptor.
(rmail-only-expunge, rmail-expunge): Rewrite.
(rmail-reply): Rewrite.
(rmail-narrow-to-message): New function.
(rmail-activate-urls, rmail-visit-url-at-mouse,
rmail-visit-url-at-point, rmail-browse-body, rmail-get-sender): New
functions.
author | Paul Reilly <pmr@pajato.com> |
---|---|
date | Sat, 15 Feb 2003 13:36:53 +0000 |
parents | 336bfea9bad4 |
children | aa85e6f55862 |
comparison
equal
deleted
inserted
replaced
88124:30235d819e60 | 88125:5da4d43003a3 |
---|---|
36 ;; New features include: rmail and rmail-summary buffers remain | 36 ;; New features include: rmail and rmail-summary buffers remain |
37 ;; synchronized and key bindings basically operate the same way in both | 37 ;; synchronized and key bindings basically operate the same way in both |
38 ;; buffers, summary by topic or by regular expression, rmail-reply-prefix | 38 ;; buffers, summary by topic or by regular expression, rmail-reply-prefix |
39 ;; variable, and a bury rmail buffer (wipe) command. | 39 ;; variable, and a bury rmail buffer (wipe) command. |
40 ;; | 40 ;; |
41 | 41 (provide 'rmail) |
42 (require 'mail-utils) | 42 |
43 (eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority | 43 (eval-when-compile |
44 (require 'font-lock) | |
45 (require 'mailabbrev) | |
46 (require 'mule-util) ; for detect-coding-with-priority | |
47 (require 'rmailout) | |
48 (require 'rmailsum)) | |
49 | |
50 (eval-and-compile | |
51 (require 'browse-url) | |
52 (require 'rmaildesc) | |
53 (require 'rmailhdr)) | |
44 | 54 |
45 ; These variables now declared in paths.el. | 55 ; These variables now declared in paths.el. |
46 ;(defvar rmail-spool-directory "/usr/spool/mail/" | 56 ;(defvar rmail-spool-directory "/usr/spool/mail/" |
47 ; "This is the name of the directory used by the system mailer for\n\ | 57 ; "This is the name of the directory used by the system mailer for\n\ |
48 ;delivering new mail. Its name should end with a slash.") | 58 ;delivering new mail. Its name should end with a slash.") |
89 (defgroup rmail-edit nil | 99 (defgroup rmail-edit nil |
90 "Rmail editing." | 100 "Rmail editing." |
91 :prefix "rmail-edit-" | 101 :prefix "rmail-edit-" |
92 :group 'rmail) | 102 :group 'rmail) |
93 | 103 |
94 | |
95 (defcustom rmail-movemail-program nil | 104 (defcustom rmail-movemail-program nil |
96 "If non-nil, name of program for fetching new mail." | 105 "If non-nil, name of program for fetching new mail." |
97 :group 'rmail-retrieve | 106 :group 'rmail-retrieve |
98 :type '(choice (const nil) string)) | 107 :type '(choice (const nil) string)) |
99 | 108 |
146 value is the user's email address and name.) | 155 value is the user's email address and name.) |
147 It is useful to set this variable in the site customization file.") | 156 It is useful to set this variable in the site customization file.") |
148 | 157 |
149 ;;;###autoload | 158 ;;;###autoload |
150 (defcustom rmail-ignored-headers | 159 (defcustom rmail-ignored-headers |
151 (concat "^via:\\|^mail-from:\\|^origin:\\|^references:" | 160 (concat "^via:\\|^from \\|^origin:\\|^references:" |
152 "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" | 161 "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" |
153 "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" | 162 "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" |
154 "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" | 163 "\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" |
155 "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:" | 164 "\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:" |
156 "\\|^x-mailer:\\|^delivered-to:\\|^lines:\\|^mime-version:" | 165 "\\|^x-mailer:\\|^delivered-to:\\|^lines:\\|^mime-version:" |
159 "\\|^x-sign:\\|^x-beenthere:\\|^x-mailman-version:" | 168 "\\|^x-sign:\\|^x-beenthere:\\|^x-mailman-version:" |
160 "\\|^precedence:\\|^list-help:\\|^list-post:\\|^list-subscribe:" | 169 "\\|^precedence:\\|^list-help:\\|^list-post:\\|^list-subscribe:" |
161 "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" | 170 "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" |
162 "\\|^content-type:\\|^content-length:" | 171 "\\|^content-type:\\|^content-length:" |
163 "\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:" | 172 "\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:" |
164 "\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent" | 173 "\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent:" |
165 "\\|^importance:\\|^envelope-to:\\|^delivery-date" | 174 "\\|^x-importance:\\|^envelope-to:\\|^delivery-date:" |
166 "\\|^x.*-priority:\\|^x-mimeole:") | 175 "\\|^x-importance:\\|^envelope-to:\\|^delivery-date:" |
176 "\\|^x-*-priority:\\|x-mimeole:" | |
177 "\\|^x-babyl-v6-attributes:\\|x-babyl-v6-keywords:") | |
167 "*Regexp to match header fields that Rmail should normally hide. | 178 "*Regexp to match header fields that Rmail should normally hide. |
168 This variable is used for reformatting the message header, | 179 This variable is used for reformatting the message header, |
169 which normally happens once for each message, | 180 which normally happens once for each message, |
170 when you view the message for the first time in Rmail. | 181 when you view the message for the first time in Rmail. |
171 To make a change in this variable take effect | 182 To make a change in this variable take effect |
173 go to that message and type \\[rmail-toggle-header] twice." | 184 go to that message and type \\[rmail-toggle-header] twice." |
174 :type 'regexp | 185 :type 'regexp |
175 :group 'rmail-headers) | 186 :group 'rmail-headers) |
176 | 187 |
177 ;;;###autoload | 188 ;;;###autoload |
178 (defcustom rmail-displayed-headers nil | 189 (defcustom rmail-displayed-headers "\ |
190 ^\\(to\\|from\\|sender\\|cc\\|date\\|subject\\|reply-to\\):[ \t]+" | |
179 "*Regexp to match Header fields that Rmail should display. | 191 "*Regexp to match Header fields that Rmail should display. |
180 If nil, display all header fields except those matched by | 192 If nil, display all header fields except those matched by |
181 `rmail-ignored-headers'." | 193 `rmail-ignored-headers'." |
182 :type '(choice regexp (const :tag "All")) | 194 :type '(choice regexp (const :tag "All")) |
183 :group 'rmail-headers) | 195 :group 'rmail-headers) |
296 "List of directives specifying where to put a message. | 308 "List of directives specifying where to put a message. |
297 Each element of the list is of the form: | 309 Each element of the list is of the form: |
298 | 310 |
299 (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... ) | 311 (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... ) |
300 | 312 |
301 Where FOLDERNAME is the name of a BABYL format folder to put the | 313 Where FOLDERNAME is the name of a BABYL Version 6 (also known as mbox |
302 message. If any of the field regexp's are nil, then it is ignored. | 314 or Unix inbox format) folder to put the message. If any of the field |
315 regexp's are nil, then it is ignored. | |
303 | 316 |
304 If FOLDERNAME is \"/dev/null\", it is deleted. | 317 If FOLDERNAME is \"/dev/null\", it is deleted. |
305 If FOLDERNAME is nil then it is deleted, and skipped. | 318 If FOLDERNAME is nil then it is deleted, and skipped. |
306 | 319 |
307 FIELD is the plain text name of a field in the message, such as | 320 FIELD is the plain text name of a field in the message, such as |
349 (put 'rmail-current-message 'permanent-local t) | 362 (put 'rmail-current-message 'permanent-local t) |
350 | 363 |
351 (defvar rmail-total-messages nil) | 364 (defvar rmail-total-messages nil) |
352 (put 'rmail-total-messages 'permanent-local t) | 365 (put 'rmail-total-messages 'permanent-local t) |
353 | 366 |
367 ;;; mbox: deprecated. -pmr | |
354 (defvar rmail-message-vector nil) | 368 (defvar rmail-message-vector nil) |
355 (put 'rmail-message-vector 'permanent-local t) | 369 (put 'rmail-message-vector 'permanent-local t) |
356 | 370 |
371 ;;; mbox: deprecated. -pmr | |
357 (defvar rmail-deleted-vector nil) | 372 (defvar rmail-deleted-vector nil) |
358 (put 'rmail-deleted-vector 'permanent-local t) | 373 (put 'rmail-deleted-vector 'permanent-local t) |
359 | 374 |
375 ;; mbox: deprecated. -pmr | |
360 (defvar rmail-msgref-vector nil | 376 (defvar rmail-msgref-vector nil |
361 "In an Rmail buffer, a vector whose Nth element is a list (N). | 377 "In an Rmail buffer, a vector whose Nth element is a list (N). |
362 When expunging renumbers messages, these lists are modified | 378 When expunging renumbers messages, these lists are modified |
363 by substituting the new message number into the existing list.") | 379 by substituting the new message number into the existing list.") |
364 (put 'rmail-msgref-vector 'permanent-local t) | 380 (put 'rmail-msgref-vector 'permanent-local t) |
391 | 407 |
392 (defcustom rmail-default-file "~/xmail" | 408 (defcustom rmail-default-file "~/xmail" |
393 "*Default file name for \\[rmail-output]." | 409 "*Default file name for \\[rmail-output]." |
394 :type 'file | 410 :type 'file |
395 :group 'rmail-files) | 411 :group 'rmail-files) |
412 | |
396 (defcustom rmail-default-rmail-file "~/XMAIL" | 413 (defcustom rmail-default-rmail-file "~/XMAIL" |
397 "*Default file name for \\[rmail-output-to-rmail-file]." | 414 "*Default file name for \\[rmail-output-to-rmail-file]." |
398 :type 'file | 415 :type 'file |
399 :group 'rmail-files) | 416 :group 'rmail-files) |
417 | |
400 (defcustom rmail-default-body-file "~/mailout" | 418 (defcustom rmail-default-body-file "~/mailout" |
401 "*Default file name for \\[rmail-output-body-to-file]." | 419 "*Default file name for \\[rmail-output-body-to-file]." |
402 :type 'file | 420 :type 'file |
403 :group 'rmail-files | 421 :group 'rmail-files |
404 :version "20.3") | 422 :version "20.3") |
486 "Regexp to match MIME-charset specification in a header of message. | 504 "Regexp to match MIME-charset specification in a header of message. |
487 The first parenthesized expression should match the MIME-charset name.") | 505 The first parenthesized expression should match the MIME-charset name.") |
488 | 506 |
489 | 507 |
490 ;;; Regexp matching the delimiter of messages in UNIX mail format | 508 ;;; Regexp matching the delimiter of messages in UNIX mail format |
491 ;;; (UNIX From lines), minus the initial ^. Note that if you change | 509 ;;; (UNIX From lines), with an initial ^. Used in rmail-decode-from-line, |
492 ;;; this expression, you must change the code in rmail-nuke-pinhead-header | 510 ;;; which knows the exact ordering of the \\(...\\) subexpressions. |
493 ;;; that knows the exact ordering of the \\( \\) subexpressions. | |
494 (defvar rmail-unix-mail-delimiter | 511 (defvar rmail-unix-mail-delimiter |
495 (let ((time-zone-regexp | 512 (let ((time-zone-regexp |
496 (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" | 513 (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" |
497 "\\|[-+]?[0-9][0-9][0-9][0-9]" | 514 "\\|[-+]?[0-9][0-9][0-9][0-9]" |
498 "\\|" | 515 "\\|" |
499 "\\) *"))) | 516 "\\) *"))) |
500 (concat | 517 (concat |
501 "From " | 518 "^From " |
502 | 519 |
503 ;; Many things can happen to an RFC 822 mailbox before it is put into | 520 ;; Many things can happen to an RFC 822 mailbox before it is put into |
504 ;; a `From' line. The leading phrase can be stripped, e.g. | 521 ;; a `From' line. The leading phrase can be stripped, e.g. |
505 ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g. | 522 ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g. |
506 ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF | 523 ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF |
547 ;; These are all matched case-insensitively. | 564 ;; These are all matched case-insensitively. |
548 (eval-when-compile | 565 (eval-when-compile |
549 (let* ((cite-chars "[>|}]") | 566 (let* ((cite-chars "[>|}]") |
550 (cite-prefix "a-z") | 567 (cite-prefix "a-z") |
551 (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) | 568 (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) |
552 (list '("^\\(From\\|Sender\\|Resent-From\\):" | 569 (list '("^\\(From\\|Sender\\|Resent-[Ff]rom\\):" |
553 . font-lock-function-name-face) | 570 . font-lock-function-name-face) |
554 '("^Reply-To:.*$" . font-lock-function-name-face) | 571 '("^Reply-To:.*$" . font-lock-function-name-face) |
555 '("^Subject:" . font-lock-comment-face) | 572 '("^Subject:" . font-lock-comment-face) |
556 '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):" | 573 '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):" |
557 . font-lock-keyword-face) | 574 . font-lock-keyword-face) |
558 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. | 575 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. |
562 "\\(" cite-chars "[ \t]*\\)\\)+" | 579 "\\(" cite-chars "[ \t]*\\)\\)+" |
563 "\\(.*\\)") | 580 "\\(.*\\)") |
564 (beginning-of-line) (end-of-line) | 581 (beginning-of-line) (end-of-line) |
565 (2 font-lock-constant-face nil t) | 582 (2 font-lock-constant-face nil t) |
566 (4 font-lock-comment-face nil t))) | 583 (4 font-lock-comment-face nil t))) |
567 '("^\\(X-[a-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$" | 584 '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$" |
568 . font-lock-string-face)))) | 585 . font-lock-string-face)))) |
569 "Additional expressions to highlight in Rmail mode.") | 586 "Additional expressions to highlight in Rmail mode.") |
570 | 587 |
571 ;; Perform BODY in the summary buffer | 588 ;; Perform BODY in the summary buffer |
572 ;; in such a way that its cursor is properly updated in its own window. | 589 ;; in such a way that its cursor is properly updated in its own window. |
596 ;; This variable is dynamically bound. The defvar is here to placate | 613 ;; This variable is dynamically bound. The defvar is here to placate |
597 ;; the byte compiler. | 614 ;; the byte compiler. |
598 | 615 |
599 (defvar rmail-enable-multibyte nil) | 616 (defvar rmail-enable-multibyte nil) |
600 | 617 |
601 | 618 ;;; mbox don't care |
602 (defun rmail-require-mime-maybe () | 619 (defun rmail-require-mime-maybe () |
603 "Require `rmail-mime-feature' if that is non-nil. | 620 "Require `rmail-mime-feature' if that is non-nil. |
604 Signal an error and set `rmail-mime-feature' to nil if the feature | 621 Signal an error and set `rmail-mime-feature' to nil if the feature |
605 isn't provided." | 622 isn't provided." |
606 (when rmail-enable-mime | 623 (when rmail-enable-mime |
610 (message "Feature `%s' not provided" rmail-mime-feature) | 627 (message "Feature `%s' not provided" rmail-mime-feature) |
611 (sit-for 1) | 628 (sit-for 1) |
612 (setq rmail-enable-mime nil))))) | 629 (setq rmail-enable-mime nil))))) |
613 | 630 |
614 | 631 |
632 ;;; mbox ready | |
615 ;;;###autoload | 633 ;;;###autoload |
616 (defun rmail (&optional file-name-arg) | 634 (defun rmail (&optional file-name-arg) |
617 "Read and edit incoming mail. | 635 "Read and edit incoming mail. |
618 Moves messages into file named by `rmail-file-name' (a babyl format file) | 636 Moves messages into file named by `rmail-file-name' (a babyl format file) |
619 and edits that file in RMAIL Mode. | 637 and edits that file in RMAIL Mode. |
672 (progn (rmail-mode-2) | 690 (progn (rmail-mode-2) |
673 (setq run-mail-hook t))) | 691 (setq run-mail-hook t))) |
674 (setq run-mail-hook t) | 692 (setq run-mail-hook t) |
675 (rmail-mode-2) | 693 (rmail-mode-2) |
676 ;; Convert all or part to Babyl file if possible. | 694 ;; Convert all or part to Babyl file if possible. |
677 (rmail-convert-file) | 695 ;;; (rmail-convert-file) |
678 (goto-char (point-max))) | 696 (goto-char (point-max))) |
679 ;; As we have read a file by raw-text, the buffer is set to | 697 ;; As we have read a file by raw-text, the buffer is set to |
680 ;; unibyte. We must make it multibyte if necessary. | 698 ;; unibyte. We must make it multibyte if necessary. |
681 (if (and rmail-enable-multibyte | 699 (if (and rmail-enable-multibyte |
682 (not enable-multibyte-characters)) | 700 (not enable-multibyte-characters)) |
683 (set-buffer-multibyte t)) | 701 (set-buffer-multibyte t)) |
684 ;; If necessary, scan to find all the messages. | 702 |
685 (rmail-maybe-set-message-counters) | 703 ;; Initialize the Rmail state and process any messages in the buffer. |
686 (unwind-protect | 704 (rmail-initialize-messages) |
687 (unless (and (not file-name-arg) | 705 |
688 (rmail-get-new-mail)) | 706 ;; Get new mail only if there is no explicit file argument. |
689 (rmail-show-message (rmail-first-unseen-message))) | 707 (and (not file-name-arg) (rmail-get-new-mail)) |
690 (progn | 708 |
691 (if rmail-display-summary (rmail-summary)) | 709 ;; Deal with the summary display. |
692 (rmail-construct-io-menu) | 710 (if rmail-display-summary (rmail-summary)) |
693 (if run-mail-hook | 711 |
694 (run-hooks 'rmail-mode-hook)))))) | 712 ;; Show the first unseen message or, if all messages have been |
713 ;; seen, the last message. | |
714 (rmail-show-message (or (rmail-first-unseen-message) | |
715 rmail-total-messages)) | |
716 | |
717 ;; Not sure what this is all about. | |
718 (rmail-construct-io-menu) | |
719 | |
720 ;; Run any User callbacks. | |
721 (if run-mail-hook | |
722 (run-hooks 'rmail-mode-hook)))) | |
695 | 723 |
696 ;; Given the value of MAILPATH, return a list of inbox file names. | 724 ;; Given the value of MAILPATH, return a list of inbox file names. |
697 ;; This is turned off because it is not clear that the user wants | 725 ;; This is turned off because it is not clear that the user wants |
698 ;; all these inboxes to feed into the primary rmail file. | 726 ;; all these inboxes to feed into the primary rmail file. |
699 ; (defun rmail-convert-mailpath (string) | 727 ; (defun rmail-convert-mailpath (string) |
710 ; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line | 738 ; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line |
711 ; will not cause emacs 18.55 problems. | 739 ; will not cause emacs 18.55 problems. |
712 | 740 |
713 ;; This calls rmail-decode-babyl-format if the file is already Babyl. | 741 ;; This calls rmail-decode-babyl-format if the file is already Babyl. |
714 | 742 |
743 ;;; mbox: DEPECATED | |
715 (defun rmail-convert-file () | 744 (defun rmail-convert-file () |
716 (let (convert) | 745 (let (convert) |
717 (widen) | 746 (widen) |
718 (goto-char (point-min)) | 747 (goto-char (point-min)) |
719 ;; If file doesn't start like a Babyl file, | 748 ;; If file doesn't start like a Babyl file, |
754 (if (and (not rmail-enable-mime) | 783 (if (and (not rmail-enable-mime) |
755 rmail-enable-multibyte) | 784 rmail-enable-multibyte) |
756 ;; We still have to decode BABYL part. | 785 ;; We still have to decode BABYL part. |
757 (rmail-decode-babyl-format))))) | 786 (rmail-decode-babyl-format))))) |
758 | 787 |
788 ;;;###deprecated | |
759 (defun rmail-insert-rmail-file-header () | 789 (defun rmail-insert-rmail-file-header () |
760 (let ((buffer-read-only nil)) | 790 (let ((buffer-read-only nil) |
761 ;; -*-rmail-*- is here so that visiting the file normally | 791 (header-line "X-BABYL: -*-rmail-*-")) |
762 ;; recognizes it as an Rmail file. | 792 ;; Determine if the header has already been inserted. |
763 (insert "BABYL OPTIONS: -*- rmail -*- | 793 (goto-char (point-min)) |
764 Version: 5 | 794 (if (not (looking-at "X-BABYL: ")) |
795 ;; The header has not been inserted. Insert -*-rmail-*- here | |
796 ;; so that visiting the file normally recognizes it as an | |
797 ;; Rmail file. | |
798 (insert (concat header-line "\nX-BABYL-Version: 6 | |
799 Version: 6 | |
765 Labels: | 800 Labels: |
766 Note: This is the header of an rmail file. | 801 Note: This is the header of an rmail file. |
767 Note: If you are seeing it in rmail, | 802 Note: If you are seeing it in rmail, |
768 Note: it means the file has no messages in it.\n\^_"))) | 803 Note: it means the file has no messages in it."))))) |
804 | |
805 (defun rmail-initialize-messages () | |
806 "Initialize message state and process the messages in the buffer to | |
807 update message state." | |
808 (setq rmail-total-messages 0 | |
809 rmail-current-message 1) | |
810 (rmail-desc-clear-descriptors) | |
811 (widen) | |
812 (rmail-header-show-headers) | |
813 (setq rmail-total-messages (rmail-process-new-messages))) | |
769 | 814 |
770 ;; Decode Babyl formatted part at the head of current buffer by | 815 ;; Decode Babyl formatted part at the head of current buffer by |
771 ;; rmail-file-coding-system, or if it is nil, do auto conversion. | 816 ;; rmail-file-coding-system, or if it is nil, do auto conversion. |
772 | 817 |
773 (defun rmail-decode-babyl-format () | 818 (defun rmail-decode-babyl-format () |
803 (setq buffer-file-coding-system nil) | 848 (setq buffer-file-coding-system nil) |
804 (setq save-buffer-coding-system | 849 (setq save-buffer-coding-system |
805 (or coding-system 'undecided)))) | 850 (or coding-system 'undecided)))) |
806 | 851 |
807 (defvar rmail-mode-map nil) | 852 (defvar rmail-mode-map nil) |
853 (defvar rmail-url-map nil) | |
808 (if rmail-mode-map | 854 (if rmail-mode-map |
809 nil | 855 nil |
810 (setq rmail-mode-map (make-keymap)) | 856 (setq rmail-mode-map (make-keymap)) |
811 (suppress-keymap rmail-mode-map) | 857 (suppress-keymap rmail-mode-map) |
812 (define-key rmail-mode-map "a" 'rmail-add-label) | 858 (define-key rmail-mode-map "a" 'rmail-add-label) |
813 (define-key rmail-mode-map "b" 'rmail-bury) | 859 (define-key rmail-mode-map "b" 'rmail-bury) |
860 (define-key rmail-mode-map "B" 'rmail-browse-body) | |
814 (define-key rmail-mode-map "c" 'rmail-continue) | 861 (define-key rmail-mode-map "c" 'rmail-continue) |
815 (define-key rmail-mode-map "d" 'rmail-delete-forward) | 862 (define-key rmail-mode-map "d" 'rmail-delete-forward) |
816 (define-key rmail-mode-map "\C-d" 'rmail-delete-backward) | 863 (define-key rmail-mode-map "\C-d" 'rmail-delete-backward) |
817 (define-key rmail-mode-map "e" 'rmail-edit-current-message) | 864 (define-key rmail-mode-map "e" 'rmail-edit-current-message) |
818 (define-key rmail-mode-map "f" 'rmail-forward) | 865 (define-key rmail-mode-map "f" 'rmail-forward) |
819 (define-key rmail-mode-map "g" 'rmail-get-new-mail) | 866 (define-key rmail-mode-map "g" 'rmail-get-new-mail) |
820 (define-key rmail-mode-map "h" 'rmail-summary) | 867 (define-key rmail-mode-map "h" 'rmail-summary) |
821 (define-key rmail-mode-map "i" 'rmail-input) | 868 (define-key rmail-mode-map "i" 'rmail-input) |
822 (define-key rmail-mode-map "j" 'rmail-show-message) | 869 (define-key rmail-mode-map "j" 'rmail-message) |
823 (define-key rmail-mode-map "k" 'rmail-kill-label) | 870 (define-key rmail-mode-map "k" 'rmail-kill-label) |
824 (define-key rmail-mode-map "l" 'rmail-summary-by-labels) | 871 (define-key rmail-mode-map "l" 'rmail-summary-by-labels) |
825 (define-key rmail-mode-map "\e\C-h" 'rmail-summary) | 872 (define-key rmail-mode-map "\e\C-h" 'rmail-summary) |
826 (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels) | 873 (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels) |
827 (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients) | 874 (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients) |
830 (define-key rmail-mode-map "m" 'rmail-mail) | 877 (define-key rmail-mode-map "m" 'rmail-mail) |
831 (define-key rmail-mode-map "\em" 'rmail-retry-failure) | 878 (define-key rmail-mode-map "\em" 'rmail-retry-failure) |
832 (define-key rmail-mode-map "n" 'rmail-next-undeleted-message) | 879 (define-key rmail-mode-map "n" 'rmail-next-undeleted-message) |
833 (define-key rmail-mode-map "\en" 'rmail-next-message) | 880 (define-key rmail-mode-map "\en" 'rmail-next-message) |
834 (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message) | 881 (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message) |
835 (define-key rmail-mode-map "o" 'rmail-output-to-rmail-file) | 882 (define-key rmail-mode-map "o" 'rmail-output) |
836 (define-key rmail-mode-map "\C-o" 'rmail-output) | 883 (define-key rmail-mode-map "\C-o" 'rmail-output) |
837 (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message) | 884 (define-key rmail-mode-map "p" 'rmail-previous-undeleted-message) |
838 (define-key rmail-mode-map "\ep" 'rmail-previous-message) | 885 (define-key rmail-mode-map "\ep" 'rmail-previous-message) |
839 (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message) | 886 (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message) |
840 (define-key rmail-mode-map "q" 'rmail-quit) | 887 (define-key rmail-mode-map "q" 'rmail-quit) |
860 (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent) | 907 (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent) |
861 (define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-lines) | 908 (define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-lines) |
862 (define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels) | 909 (define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels) |
863 (define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject) | 910 (define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject) |
864 (define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject) | 911 (define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject) |
865 ) | 912 |
913 ;; Set up a keymap derived from the standard Rmail mode keymap to | |
914 ;; send activated URLs to a browser. | |
915 (setq rmail-url-map (make-sparse-keymap)) | |
916 (set-keymap-parent rmail-url-map rmail-mode-map) | |
917 (define-key rmail-url-map [mouse-2] 'rmail-visit-url-at-mouse) | |
918 (define-key rmail-url-map "\r" 'rmail-visit-url-at-point)) | |
866 | 919 |
867 (define-key rmail-mode-map [menu-bar] (make-sparse-keymap)) | 920 (define-key rmail-mode-map [menu-bar] (make-sparse-keymap)) |
868 | 921 |
869 (define-key rmail-mode-map [menu-bar classify] | 922 (define-key rmail-mode-map [menu-bar classify] |
870 (cons "Classify" (make-sparse-keymap "Classify"))) | 923 (cons "Classify" (make-sparse-keymap "Classify"))) |
880 | 933 |
881 (define-key rmail-mode-map [menu-bar classify output-inbox] | 934 (define-key rmail-mode-map [menu-bar classify output-inbox] |
882 '("Output (inbox)..." . rmail-output)) | 935 '("Output (inbox)..." . rmail-output)) |
883 | 936 |
884 (define-key rmail-mode-map [menu-bar classify output] | 937 (define-key rmail-mode-map [menu-bar classify output] |
885 '("Output (Rmail)..." . rmail-output-to-rmail-file)) | 938 '("Output (Rmail)..." . rmail-output)) |
886 | 939 |
887 (define-key rmail-mode-map [menu-bar classify kill-label] | 940 (define-key rmail-mode-map [menu-bar classify kill-label] |
888 '("Kill Label..." . rmail-kill-label)) | 941 '("Kill Label..." . rmail-kill-label)) |
889 | 942 |
890 (define-key rmail-mode-map [menu-bar classify add-label] | 943 (define-key rmail-mode-map [menu-bar classify add-label] |
1151 ;; If the user said "yes", and we changed something, | 1204 ;; If the user said "yes", and we changed something, |
1152 ;; reparse the messages. | 1205 ;; reparse the messages. |
1153 (progn | 1206 (progn |
1154 (set-buffer rmail-buffer) | 1207 (set-buffer rmail-buffer) |
1155 (rmail-mode-2) | 1208 (rmail-mode-2) |
1156 ;; Convert all or part to Babyl file if possible. | 1209 |
1157 (rmail-convert-file) | |
1158 ;; We have read the file as raw-text, so the buffer is set to | 1210 ;; We have read the file as raw-text, so the buffer is set to |
1159 ;; unibyte. Make it multibyte if necessary. | 1211 ;; unibyte. Make it multibyte if necessary. |
1160 (if (and rmail-enable-multibyte | 1212 (if (and rmail-enable-multibyte |
1161 (not enable-multibyte-characters)) | 1213 (not enable-multibyte-characters)) |
1162 (set-buffer-multibyte t)) | 1214 (set-buffer-multibyte t)) |
1163 (goto-char (point-max)) | 1215 (rmail-initialize-messages) |
1164 (rmail-set-message-counters) | |
1165 (rmail-show-message rmail-total-messages) | 1216 (rmail-show-message rmail-total-messages) |
1166 (run-hooks 'rmail-mode-hook))))) | 1217 (run-hooks 'rmail-mode-hook))))) |
1167 | 1218 |
1219 ;; NOT DONE | |
1168 ;; Return a list of files from this buffer's Mail: option. | 1220 ;; Return a list of files from this buffer's Mail: option. |
1169 ;; Does not assume that messages have been parsed. | 1221 ;; Does not assume that messages have been parsed. |
1170 ;; Just returns nil if buffer does not look like Babyl format. | 1222 ;; Just returns nil if buffer does not look like Babyl format. |
1171 (defun rmail-parse-file-inboxes () | 1223 (defun rmail-parse-file-inboxes () |
1172 (save-excursion | 1224 (save-excursion |
1181 (progn | 1233 (progn |
1182 (narrow-to-region (point) (progn (end-of-line) (point))) | 1234 (narrow-to-region (point) (progn (end-of-line) (point))) |
1183 (goto-char (point-min)) | 1235 (goto-char (point-min)) |
1184 (mail-parse-comma-list)))))))) | 1236 (mail-parse-comma-list)))))))) |
1185 | 1237 |
1238 ;;; mbox: ready | |
1186 (defun rmail-expunge-and-save () | 1239 (defun rmail-expunge-and-save () |
1187 "Expunge and save RMAIL file." | 1240 "Expunge and save RMAIL file." |
1188 (interactive) | 1241 (interactive) |
1189 (rmail-expunge) | 1242 (rmail-expunge) |
1190 (set-buffer rmail-buffer) | |
1191 (save-buffer) | 1243 (save-buffer) |
1244 (rmail-display-summary-maybe)) | |
1245 | |
1246 ;;; mbox: ready | |
1247 (defun rmail-display-summary-maybe () | |
1248 "If a summary buffer exists then make sure it is updated and displayed." | |
1192 (if (rmail-summary-exists) | 1249 (if (rmail-summary-exists) |
1193 (rmail-select-summary (set-buffer-modified-p nil)))) | 1250 (let ((current-message rmail-current-message)) |
1194 | 1251 (rmail-select-summary |
1252 (rmail-summary-goto-msg current-message) | |
1253 (rmail-summary-rmail-update) | |
1254 (set-buffer-modified-p nil))))) | |
1255 | |
1256 ;;; mbox: ready | |
1195 (defun rmail-quit () | 1257 (defun rmail-quit () |
1196 "Quit out of RMAIL. | 1258 "Quit out of RMAIL. |
1197 Hook `rmail-quit-hook' is run after expunging." | 1259 Hook `rmail-quit-hook' is run after expunging." |
1198 (interactive) | 1260 (interactive) |
1199 (rmail-expunge-and-save) | 1261 (rmail-expunge-and-save) |
1213 (bury-buffer obuf)) | 1275 (bury-buffer obuf)) |
1214 (let ((obuf (current-buffer))) | 1276 (let ((obuf (current-buffer))) |
1215 (quit-window) | 1277 (quit-window) |
1216 (replace-buffer-in-windows obuf)))) | 1278 (replace-buffer-in-windows obuf)))) |
1217 | 1279 |
1280 ;;; mbox: ready | |
1218 (defun rmail-bury () | 1281 (defun rmail-bury () |
1219 "Bury current Rmail buffer and its summary buffer." | 1282 "Bury current Rmail buffer and its summary buffer." |
1220 (interactive) | 1283 (interactive) |
1221 ;; This let var was called rmail-buffer, but that interfered | 1284 ;; This let var was called rmail-buffer, but that interfered |
1222 ;; with the buffer-local var used in summary buffers. | 1285 ;; with the buffer-local var used in summary buffers. |
1226 (while (setq window (get-buffer-window rmail-summary-buffer)) | 1289 (while (setq window (get-buffer-window rmail-summary-buffer)) |
1227 (quit-window nil window)) | 1290 (quit-window nil window)) |
1228 (bury-buffer rmail-summary-buffer))) | 1291 (bury-buffer rmail-summary-buffer))) |
1229 (quit-window))) | 1292 (quit-window))) |
1230 | 1293 |
1294 ;;; mbox: not ready | |
1231 (defun rmail-duplicate-message () | 1295 (defun rmail-duplicate-message () |
1232 "Create a duplicated copy of the current message. | 1296 "Create a duplicated copy of the current message. |
1233 The duplicate copy goes into the Rmail file just after the | 1297 The duplicate copy goes into the Rmail file just after the |
1234 original copy." | 1298 original copy." |
1235 (interactive) | 1299 (interactive) |
1236 (widen) | 1300 (widen) |
1237 (let ((buffer-read-only nil) | 1301 (let ((buffer-read-only nil) |
1238 (number rmail-current-message) | 1302 (number rmail-current-message) |
1239 (string (buffer-substring (rmail-msgbeg rmail-current-message) | 1303 (string (buffer-substring (rmail-desc-get-start rmail-current-message) |
1240 (rmail-msgend rmail-current-message)))) | 1304 (rmail-desc-get-end rmail-current-message)))) |
1241 (goto-char (rmail-msgend rmail-current-message)) | 1305 (goto-char (rmail-desc-get-end rmail-current-message)) |
1242 (insert string) | 1306 (insert string) |
1243 (rmail-forget-messages) | 1307 (rmail-forget-messages) |
1244 (rmail-show-message number) | 1308 (rmail-show-message number) |
1245 (message "Message duplicated"))) | 1309 (message "Message duplicated"))) |
1246 | 1310 |
1309 'rmail-input))) | 1373 'rmail-input))) |
1310 (define-key rmail-mode-map [menu-bar classify output-menu] | 1374 (define-key rmail-mode-map [menu-bar classify output-menu] |
1311 (cons "Output Rmail File" | 1375 (cons "Output Rmail File" |
1312 (rmail-list-to-menu "Output Rmail File" | 1376 (rmail-list-to-menu "Output Rmail File" |
1313 files | 1377 files |
1314 'rmail-output-to-rmail-file)))) | 1378 'rmail-output)))) |
1315 | 1379 |
1316 (define-key rmail-mode-map [menu-bar classify input-menu] | 1380 (define-key rmail-mode-map [menu-bar classify input-menu] |
1317 '("Input Rmail File" . rmail-disable-menu)) | 1381 '("Input Rmail File" . rmail-disable-menu)) |
1318 (define-key rmail-mode-map [menu-bar classify output-menu] | 1382 (define-key rmail-mode-map [menu-bar classify output-menu] |
1319 '("Output Rmail File" . rmail-disable-menu))))) | 1383 '("Output Rmail File" . rmail-disable-menu))))) |
1322 ;;;; *** Rmail input *** | 1386 ;;;; *** Rmail input *** |
1323 | 1387 |
1324 ;; RLK feature not added in this version: | 1388 ;; RLK feature not added in this version: |
1325 ;; argument specifies inbox file or files in various ways. | 1389 ;; argument specifies inbox file or files in various ways. |
1326 | 1390 |
1391 ;;; DOC NOT DONE | |
1327 (defun rmail-get-new-mail (&optional file-name) | 1392 (defun rmail-get-new-mail (&optional file-name) |
1328 "Move any new mail from this RMAIL file's inbox files. | 1393 "Move any new mail from this RMAIL file's inbox files. |
1329 The inbox files can be specified with the file's Mail: option. The | 1394 The inbox files can be specified with the file's Mail: option. The |
1330 variable `rmail-primary-inbox-list' specifies the inboxes for your | 1395 variable `rmail-primary-inbox-list' specifies the inboxes for your |
1331 primary RMAIL file if it has no Mail: option. By default, this is | 1396 primary RMAIL file if it has no Mail: option. By default, this is |
1348 ;; If the disk file has been changed from under us, | 1413 ;; If the disk file has been changed from under us, |
1349 ;; revert to it before we get new mail. | 1414 ;; revert to it before we get new mail. |
1350 (or (verify-visited-file-modtime (current-buffer)) | 1415 (or (verify-visited-file-modtime (current-buffer)) |
1351 (find-file (buffer-file-name))) | 1416 (find-file (buffer-file-name))) |
1352 (set-buffer rmail-buffer) | 1417 (set-buffer rmail-buffer) |
1353 (rmail-maybe-set-message-counters) | |
1354 (widen) | 1418 (widen) |
1355 ;; Get rid of all undo records for this buffer. | 1419 ;; Get rid of all undo records for this buffer. |
1356 (or (eq buffer-undo-list t) | 1420 (or (eq buffer-undo-list t) |
1357 (setq buffer-undo-list nil)) | 1421 (setq buffer-undo-list nil)) |
1358 (let ((all-files (if file-name (list file-name) | 1422 (let ((all-files (if file-name (list file-name) |
1359 rmail-inbox-list)) | 1423 rmail-inbox-list)) |
1360 (rmail-enable-multibyte (default-value 'enable-multibyte-characters)) | 1424 (rmail-enable-multibyte (default-value 'enable-multibyte-characters)) |
1361 found) | 1425 found current-message) |
1362 (unwind-protect | 1426 (unwind-protect |
1363 (progn | 1427 (progn |
1364 (while all-files | 1428 (while all-files |
1365 (let ((opoint (point)) | 1429 (let ((opoint (point)) |
1366 (new-messages 0) | 1430 (new-messages 0) |
1369 ;; don't replace the old backup file now. | 1433 ;; don't replace the old backup file now. |
1370 (make-backup-files (and make-backup-files (buffer-modified-p))) | 1434 (make-backup-files (and make-backup-files (buffer-modified-p))) |
1371 (buffer-read-only nil) | 1435 (buffer-read-only nil) |
1372 ;; Don't make undo records for what we do in getting mail. | 1436 ;; Don't make undo records for what we do in getting mail. |
1373 (buffer-undo-list t) | 1437 (buffer-undo-list t) |
1374 success | |
1375 ;; Files to insert this time around. | 1438 ;; Files to insert this time around. |
1376 files | 1439 files |
1377 ;; Last names of those files. | 1440 ;; Last names of those files. |
1378 file-last-names) | 1441 file-last-names) |
1379 ;; Pull files off all-files onto files | 1442 ;; Pull files off all-files onto files |
1388 (cons (file-name-nondirectory (car all-files)) files)) | 1451 (cons (file-name-nondirectory (car all-files)) files)) |
1389 (setq all-files (cdr all-files))) | 1452 (setq all-files (cdr all-files))) |
1390 ;; Put them back in their original order. | 1453 ;; Put them back in their original order. |
1391 (setq files (nreverse files)) | 1454 (setq files (nreverse files)) |
1392 | 1455 |
1393 (goto-char (point-max)) | |
1394 (skip-chars-backward " \t\n") ; just in case of brain damage | |
1395 (delete-region (point) (point-max)) ; caused by require-final-newline | |
1396 (save-excursion | 1456 (save-excursion |
1397 (save-restriction | 1457 (save-restriction |
1458 (goto-char (point-max)) | |
1398 (narrow-to-region (point) (point)) | 1459 (narrow-to-region (point) (point)) |
1399 ;; Read in the contents of the inbox files, | 1460 ;; Read in the contents of the inbox files, |
1400 ;; renaming them as necessary, | 1461 ;; renaming them as necessary, |
1401 ;; and adding to the list of files to delete eventually. | 1462 ;; and adding to the list of files to delete eventually. |
1402 (if file-name | 1463 (if file-name |
1403 (rmail-insert-inbox-text files nil) | 1464 (rmail-insert-inbox-text files nil) |
1404 (setq delete-files (rmail-insert-inbox-text files t))) | 1465 (setq delete-files (rmail-insert-inbox-text files t))) |
1405 ;; Scan the new text and convert each message to babyl format. | 1466 (unless (equal (point-min) (point-max)) |
1406 (goto-char (point-min)) | 1467 (setq new-messages (rmail-process-new-messages) |
1407 (unwind-protect | 1468 rmail-current-message (1+ rmail-total-messages) |
1408 (save-excursion | 1469 rmail-total-messages (rmail-desc-get-count)) |
1409 (setq new-messages (rmail-convert-to-babyl-format) | 1470 (run-hooks 'rmail-get-new-mail-hook) |
1410 success t)) | 1471 (save-buffer)) |
1411 ;; Try to delete the garbage just inserted. | 1472 ;; Delete the old files, now that the RMAIL file is saved. |
1412 (or success (delete-region (point-min) (point-max))) | |
1413 ;; If we could not convert the file's inboxes, | |
1414 ;; rename the files we tried to read | |
1415 ;; so we won't over and over again. | |
1416 (if (and (not file-name) (not success)) | |
1417 (let ((delfiles delete-files) | |
1418 (count 0)) | |
1419 (while delfiles | |
1420 (while (file-exists-p (format "RMAILOSE.%d" count)) | |
1421 (setq count (1+ count))) | |
1422 (rename-file (car delfiles) | |
1423 (format "RMAILOSE.%d" count)) | |
1424 (setq delfiles (cdr delfiles)))))) | |
1425 (or (zerop new-messages) | |
1426 (let (success) | |
1427 (widen) | |
1428 (search-backward "\n\^_" nil t) | |
1429 (narrow-to-region (point) (point-max)) | |
1430 (goto-char (1+ (point-min))) | |
1431 (rmail-count-new-messages) | |
1432 (run-hooks 'rmail-get-new-mail-hook) | |
1433 (save-buffer))) | |
1434 ;; Delete the old files, now that babyl file is saved. | |
1435 (while delete-files | 1473 (while delete-files |
1436 (condition-case () | 1474 (condition-case () |
1437 ;; First, try deleting. | 1475 ;; First, try deleting. |
1438 (condition-case () | 1476 (condition-case () |
1439 (delete-file (car delete-files)) | 1477 (delete-file (car delete-files)) |
1444 (setq delete-files (cdr delete-files))))) | 1482 (setq delete-files (cdr delete-files))))) |
1445 (if (= new-messages 0) | 1483 (if (= new-messages 0) |
1446 (progn (goto-char opoint) | 1484 (progn (goto-char opoint) |
1447 (if (or file-name rmail-inbox-list) | 1485 (if (or file-name rmail-inbox-list) |
1448 (message "(No new mail has arrived)"))) | 1486 (message "(No new mail has arrived)"))) |
1487 | |
1488 ;; Make the first unseen message the current message | |
1489 ;; and update the summary buffer, if one exists. | |
1490 (setq current-message (rmail-first-unseen-message)) | |
1449 (if (rmail-summary-exists) | 1491 (if (rmail-summary-exists) |
1450 (rmail-select-summary | 1492 (with-current-buffer rmail-summary-buffer |
1451 (rmail-update-summary))) | 1493 (rmail-update-summary) |
1494 (rmail-summary-goto-msg current-message)) | |
1495 (rmail-show-message current-message)) | |
1496 (run-hooks 'rmail-after-get-new-mail-hook) | |
1452 (message "%d new message%s read" | 1497 (message "%d new message%s read" |
1453 new-messages (if (= 1 new-messages) "" "s")) | 1498 new-messages (if (= 1 new-messages) "" "s")) |
1454 ;; Move to the first new message | |
1455 ;; unless we have other unseen messages before it. | |
1456 (rmail-show-message (rmail-first-unseen-message)) | |
1457 (run-hooks 'rmail-after-get-new-mail-hook) | |
1458 (setq found t)))) | 1499 (setq found t)))) |
1459 found) | 1500 found) |
1460 ;; Don't leave the buffer screwed up if we get a disk-full error. | 1501 ;; Don't leave the buffer screwed up if we get a disk-full error. |
1461 (or found (rmail-show-message))))) | 1502 (or found (rmail-show-message))))) |
1462 | 1503 |
1615 (if (or (not coding) (not (coding-system-p coding))) | 1656 (if (or (not coding) (not (coding-system-p coding))) |
1616 (setq coding 'undecided)) | 1657 (setq coding 'undecided)) |
1617 (decode-coding-region from to coding)) | 1658 (decode-coding-region from to coding)) |
1618 | 1659 |
1619 ;; the rmail-break-forwarded-messages feature is not implemented | 1660 ;; the rmail-break-forwarded-messages feature is not implemented |
1661 ;;; NOT DONE but not called any more | |
1620 (defun rmail-convert-to-babyl-format () | 1662 (defun rmail-convert-to-babyl-format () |
1621 (let ((count 0) start | 1663 (let ((count 0) start |
1622 (case-fold-search nil) | 1664 (case-fold-search nil) |
1623 (invalid-input-resync | 1665 (invalid-input-resync |
1624 (function (lambda () | 1666 (function (lambda () |
1743 (looking-at "From ")))) | 1785 (looking-at "From ")))) |
1744 (goto-char (+ header-end size)) | 1786 (goto-char (+ header-end size)) |
1745 (message "Ignoring invalid Content-Length field") | 1787 (message "Ignoring invalid Content-Length field") |
1746 (sit-for 1 0 t))) | 1788 (sit-for 1 0 t))) |
1747 (if (let ((case-fold-search nil)) | 1789 (if (let ((case-fold-search nil)) |
1748 (re-search-forward | 1790 (re-search-forward |
1749 (concat "^[\^_]?\\(" | 1791 (concat "^[\^_]?\\(" |
1750 rmail-unix-mail-delimiter | 1792 rmail-unix-mail-delimiter |
1751 "\\|" | 1793 "\\|" |
1752 rmail-mmdf-delim1 "\\|" | 1794 rmail-mmdf-delim1 "\\|" |
1753 "^BABYL OPTIONS:\\|" | 1795 "^BABYL OPTIONS:\\|" |
1754 "\^L\n[01],\\)") nil t)) | 1796 "\^L\n[01],\\)") nil t)) |
1755 (goto-char (match-beginning 1)) | 1797 (goto-char (match-beginning 1)) |
1756 (goto-char (point-max))) | 1798 (goto-char (point-max))) |
1757 (setq count (1+ count)) | 1799 (setq count (1+ count)) |
1758 (if quoted-printable-header-field-end | 1800 (if quoted-printable-header-field-end |
1759 (save-excursion | 1801 (save-excursion |
1760 (rmail-decode-quoted-printable header-end (point)) | 1802 (rmail-decode-quoted-printable header-end (point)) |
1838 ((looking-at "=") | 1880 ((looking-at "=") |
1839 (delete-char 1)) | 1881 (delete-char 1)) |
1840 (t | 1882 (t |
1841 (message "Malformed MIME quoted-printable message"))))) | 1883 (message "Malformed MIME quoted-printable message"))))) |
1842 | 1884 |
1885 ;;; DEPRECATED -pmr | |
1843 ;; Delete the "From ..." line, creating various other headers with | 1886 ;; Delete the "From ..." line, creating various other headers with |
1844 ;; information from it if they don't already exist. Now puts the | 1887 ;; information from it if they don't already exist. Now puts the |
1845 ;; original line into a mail-from: header line for debugging and for | 1888 ;; original line into a mail-from: header line for debugging and for |
1846 ;; use by the rmail-output function. | 1889 ;; use by the rmail-output function. |
1847 (defun rmail-nuke-pinhead-header () | 1890 (defun rmail-nuke-pinhead-header () |
1959 (delete-region (point) | 2002 (delete-region (point) |
1960 (if (re-search-forward "\n[^ \t]" nil t) | 2003 (if (re-search-forward "\n[^ \t]" nil t) |
1961 (1- (point)) | 2004 (1- (point)) |
1962 (point-max))))))))) | 2005 (point-max))))))))) |
1963 | 2006 |
1964 (defun rmail-msg-is-pruned () | 2007 (defun rmail-msg-is-pruned (&optional msg) |
1965 (rmail-maybe-set-message-counters) | 2008 "Determine if the headers for the current message are being |
1966 (save-restriction | 2009 displayed. If MSG is non-nil it will be used as the message number |
1967 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) | 2010 instead of the current message." |
1968 (save-excursion | 2011 (rmail-desc-get-header-display-state (or msg rmail-current-message))) |
1969 (goto-char (point-min)) | |
1970 (forward-line 1) | |
1971 (= (following-char) ?1)))) | |
1972 | 2012 |
1973 (defun rmail-msg-restore-non-pruned-header () | 2013 (defun rmail-msg-restore-non-pruned-header () |
1974 (let ((old-point (point)) | 2014 (let ((old-point (point)) |
1975 new-point | 2015 new-point |
1976 new-start | 2016 new-start |
2016 (defun rmail-toggle-header (&optional arg) | 2056 (defun rmail-toggle-header (&optional arg) |
2017 "Show original message header if pruned header currently shown, or vice versa. | 2057 "Show original message header if pruned header currently shown, or vice versa. |
2018 With argument ARG, show the message header pruned if ARG is greater than zero; | 2058 With argument ARG, show the message header pruned if ARG is greater than zero; |
2019 otherwise, show it in full." | 2059 otherwise, show it in full." |
2020 (interactive "P") | 2060 (interactive "P") |
2021 (let* ((pruned (with-current-buffer rmail-buffer | 2061 (rmail-header-toggle-visibility arg) |
2022 (rmail-msg-is-pruned))) | 2062 (rmail-highlight-headers)) |
2023 (prune (if arg | |
2024 (> (prefix-numeric-value arg) 0) | |
2025 (not pruned)))) | |
2026 (if (eq pruned prune) | |
2027 t | |
2028 (set-buffer rmail-buffer) | |
2029 (rmail-maybe-set-message-counters) | |
2030 (if rmail-enable-mime | |
2031 (let ((buffer-read-only nil)) | |
2032 (if pruned | |
2033 (rmail-msg-restore-non-pruned-header) | |
2034 (rmail-msg-prune-header)) | |
2035 (funcall rmail-show-mime-function)) | |
2036 (let* ((buffer-read-only nil) | |
2037 (window (get-buffer-window (current-buffer))) | |
2038 (at-point-min (= (point) (point-min))) | |
2039 (all-headers-visible (= (window-start window) (point-min))) | |
2040 (on-header | |
2041 (save-excursion | |
2042 (and (not (search-backward "\n\n" nil t)) | |
2043 (progn | |
2044 (end-of-line) | |
2045 (re-search-backward "^[-A-Za-z0-9]+:" nil t)) | |
2046 (match-string 0)))) | |
2047 (old-screen-line | |
2048 (rmail-count-screen-lines (window-start window) (point)))) | |
2049 (if pruned | |
2050 (rmail-msg-restore-non-pruned-header) | |
2051 (rmail-msg-prune-header)) | |
2052 (cond (at-point-min | |
2053 (goto-char (point-min))) | |
2054 (on-header | |
2055 (goto-char (point-min)) | |
2056 (search-forward "\n\n") | |
2057 (or (re-search-backward | |
2058 (concat "^" (regexp-quote on-header)) nil t) | |
2059 (goto-char (point-min)))) | |
2060 (t | |
2061 (save-selected-window | |
2062 (select-window window) | |
2063 (recenter old-screen-line) | |
2064 (if (and all-headers-visible | |
2065 (not (= (window-start) (point-min)))) | |
2066 (recenter (- (window-height) 2)))))))) | |
2067 (rmail-highlight-headers)))) | |
2068 | 2063 |
2069 (defun rmail-narrow-to-non-pruned-header () | 2064 (defun rmail-narrow-to-non-pruned-header () |
2070 "Narrow to the whole (original) header of the current message." | 2065 "Narrow to the whole (original) header of the current message." |
2071 (let (start end) | 2066 (let (start end) |
2072 (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) | 2067 (narrow-to-region (rmail-desc-get-start rmail-current-message) (point-max)) |
2073 (goto-char (point-min)) | 2068 (goto-char (point-min)) |
2074 (forward-line 1) | 2069 (forward-line 1) |
2075 (if (= (following-char) ?1) | 2070 (if (= (following-char) ?1) |
2076 (progn | 2071 (progn |
2077 (forward-line 1) | 2072 (forward-line 1) |
2094 (goto-char (point-min)) | 2089 (goto-char (point-min)) |
2095 (vertical-motion (- (point-max) (point-min)))))) | 2090 (vertical-motion (- (point-max) (point-min)))))) |
2096 | 2091 |
2097 ;;;; *** Rmail Attributes and Keywords *** | 2092 ;;;; *** Rmail Attributes and Keywords *** |
2098 | 2093 |
2099 ;; Make a string describing current message's attributes and keywords | 2094 ;; Make a string describing the current message's attributes by |
2100 ;; and set it up as the name of a minor mode | 2095 ;; keywords and set it up as the name of a minor mode so it will |
2101 ;; so it will appear in the mode line. | 2096 ;; appear in the mode line. |
2102 (defun rmail-display-labels () | 2097 (defun rmail-display-labels () |
2103 (let ((blurb "") (beg (point-min-marker)) (end (point-max-marker))) | 2098 (let (keyword-list result) |
2104 (save-excursion | 2099 |
2105 (unwind-protect | 2100 ;; Update the keyword list for the current message. |
2106 (progn | 2101 (if (> rmail-current-message 0) |
2107 (widen) | 2102 (setq keyword-list (rmail-desc-get-keywords rmail-current-message))) |
2108 (goto-char (rmail-msgbeg rmail-current-message)) | 2103 |
2109 (forward-line 1) | 2104 ;; Generate the result string. |
2110 (if (looking-at "[01],") | 2105 (setq result (mapconcat '(lambda (arg) arg) keyword-list " ")) |
2111 (progn | 2106 |
2112 (narrow-to-region (point) (progn (end-of-line) (point))) | 2107 ;; Update the mode line to display the keywords, the current |
2113 ;; Truly valid BABYL format requires a space before each | 2108 ;; message index and the total number of messages. |
2114 ;; attribute or keyword name. Put them in if missing. | |
2115 (let (buffer-read-only) | |
2116 (goto-char (point-min)) | |
2117 (while (search-forward "," nil t) | |
2118 (or (looking-at "[ ,]") (eobp) | |
2119 (insert " ")))) | |
2120 (goto-char (point-max)) | |
2121 (if (search-backward ",," nil 'move) | |
2122 (progn | |
2123 (if (> (point) (1+ (point-min))) | |
2124 (setq blurb (buffer-substring (+ 1 (point-min)) (point)))) | |
2125 (if (> (- (point-max) (point)) 2) | |
2126 (setq blurb | |
2127 (concat blurb | |
2128 ";" | |
2129 (buffer-substring (+ (point) 3) | |
2130 (1- (point-max))))))))))) | |
2131 ;; Note: we don't use save-restriction because that does not work right | |
2132 ;; if changes are made outside the saved restriction | |
2133 ;; before that restriction is restored. | |
2134 (narrow-to-region beg end) | |
2135 (set-marker beg nil) | |
2136 (set-marker end nil))) | |
2137 (while (string-match " +," blurb) | |
2138 (setq blurb (concat (substring blurb 0 (match-beginning 0)) "," | |
2139 (substring blurb (match-end 0))))) | |
2140 (while (string-match ", +" blurb) | |
2141 (setq blurb (concat (substring blurb 0 (match-beginning 0)) "," | |
2142 (substring blurb (match-end 0))))) | |
2143 (setq mode-line-process | 2109 (setq mode-line-process |
2144 (format " %d/%d%s" | 2110 (format " %d/%d %s" |
2145 rmail-current-message rmail-total-messages blurb)) | 2111 rmail-current-message rmail-total-messages result)) |
2112 | |
2146 ;; If rmail-enable-mime is non-nil, we may have to update | 2113 ;; If rmail-enable-mime is non-nil, we may have to update |
2147 ;; `mode-line-process' of rmail-view-buffer too. | 2114 ;; `mode-line-process' of rmail-view-buffer too. |
2148 (if (and rmail-enable-mime | 2115 (if (and rmail-enable-mime |
2149 (not (eq (current-buffer) rmail-view-buffer)) | 2116 (not (eq (current-buffer) rmail-view-buffer)) |
2150 (buffer-live-p rmail-view-buffer)) | 2117 (buffer-live-p rmail-view-buffer)) |
2154 | 2121 |
2155 ;; Turn an attribute of a message on or off according to STATE. | 2122 ;; Turn an attribute of a message on or off according to STATE. |
2156 ;; ATTR is the name of the attribute, as a string. | 2123 ;; ATTR is the name of the attribute, as a string. |
2157 ;; MSGNUM is message number to change; nil means current message. | 2124 ;; MSGNUM is message number to change; nil means current message. |
2158 (defun rmail-set-attribute (attr state &optional msgnum) | 2125 (defun rmail-set-attribute (attr state &optional msgnum) |
2159 (set-buffer rmail-buffer) | 2126 (save-excursion |
2160 (let ((omax (point-max-marker)) | 2127 (save-restriction |
2161 (omin (point-min-marker)) | 2128 (let ((attr-index (rmail-desc-get-attr-index attr))) |
2162 (buffer-read-only nil)) | 2129 (set-buffer rmail-buffer) |
2163 (or msgnum (setq msgnum rmail-current-message)) | 2130 (or msgnum (setq msgnum rmail-current-message)) |
2164 (if (> msgnum 0) | 2131 (rmail-desc-set-attribute attr-index state msgnum) |
2165 (unwind-protect | 2132 |
2166 (save-excursion | 2133 ;; Deal with the summary buffer. |
2167 (widen) | 2134 (if rmail-summary-buffer |
2168 (goto-char (+ 3 (rmail-msgbeg msgnum))) | 2135 (with-current-buffer rmail-summary-buffer |
2169 (let ((curstate | 2136 (rmail-summary-update-attribute attr-index msgnum))))))) |
2170 (not | |
2171 (null (search-backward (concat ", " attr ",") | |
2172 (prog1 (point) (end-of-line)) t))))) | |
2173 (or (eq curstate (not (not state))) | |
2174 (if curstate | |
2175 (delete-region (point) (1- (match-end 0))) | |
2176 (beginning-of-line) | |
2177 (forward-char 2) | |
2178 (insert " " attr ",")))) | |
2179 (if (string= attr "deleted") | |
2180 (rmail-set-message-deleted-p msgnum state))) | |
2181 ;; Note: we don't use save-restriction because that does not work right | |
2182 ;; if changes are made outside the saved restriction | |
2183 ;; before that restriction is restored. | |
2184 (narrow-to-region omin omax) | |
2185 (set-marker omin nil) | |
2186 (set-marker omax nil) | |
2187 (if (= msgnum rmail-current-message) | |
2188 (rmail-display-labels)))))) | |
2189 | 2137 |
2190 ;; Return t if the attributes/keywords line of msg number MSG | 2138 ;; Return t if the attributes/keywords line of msg number MSG |
2191 ;; contains a match for the regexp LABELS. | 2139 ;; contains a match for the regexp LABELS. |
2192 (defun rmail-message-labels-p (msg labels) | 2140 (defun rmail-message-labels-p (msg labels) |
2193 (save-excursion | 2141 (save-excursion |
2194 (save-restriction | 2142 (save-restriction |
2195 (widen) | 2143 (widen) |
2196 (goto-char (rmail-msgbeg msg)) | 2144 (goto-char (rmail-desc-get-start msg)) |
2197 (forward-char 3) | 2145 (forward-line 1) |
2198 (re-search-backward labels (prog1 (point) (end-of-line)) t)))) | 2146 (re-search-backward labels (prog1 (point) (end-of-line)) t)))) |
2199 | 2147 |
2200 ;;;; *** Rmail Message Selection And Support *** | 2148 ;;;; *** Rmail Message Selection And Support *** |
2201 | 2149 |
2202 (defun rmail-msgend (n) | 2150 (defun rmail-msgend (n) |
2214 FUNCTION may not change the visible text of the message, but it may | 2162 FUNCTION may not change the visible text of the message, but it may |
2215 change the invisible header text." | 2163 change the invisible header text." |
2216 (save-excursion | 2164 (save-excursion |
2217 (unwind-protect | 2165 (unwind-protect |
2218 (progn | 2166 (progn |
2219 (narrow-to-region (rmail-msgbeg rmail-current-message) | 2167 (narrow-to-region (rmail-desc-get-start rmail-current-message) |
2220 (point-max)) | 2168 (point-max)) |
2221 (goto-char (point-min)) | 2169 (goto-char (point-min)) |
2222 (funcall function)) | 2170 (funcall function)) |
2223 ;; Note: we don't use save-restriction because that does not work right | 2171 ;; Note: we don't use save-restriction because that does not work right |
2224 ;; if changes are made outside the saved restriction | 2172 ;; if changes are made outside the saved restriction |
2225 ;; before that restriction is restored. | 2173 ;; before that restriction is restored. |
2226 (narrow-to-region (rmail-msgbeg rmail-current-message) | 2174 (narrow-to-region (rmail-desc-get-start rmail-current-message) |
2227 (rmail-msgend rmail-current-message))))) | 2175 (rmail-desc-get-end rmail-current-message))))) |
2228 | 2176 |
2177 (defun rmail-process-new-messages (&optional nomsg) | |
2178 "Process the new messages in the buffer. The buffer has been | |
2179 narrowed to expose only the new messages. For each new message append | |
2180 an entry to the message vector and, if necessary, add a header that | |
2181 will capture the salient BABYL information. Return the number of new | |
2182 messages. If NOMSG is non-nil then do not show any progress | |
2183 messages." | |
2184 (let ((inhibit-read-only t) | |
2185 (case-fold-search nil) | |
2186 (new-message-counter 0) | |
2187 (start (point-max)) | |
2188 end attributes keywords message-descriptor-list date) | |
2189 (or nomsg (message "Processing new messages...")) | |
2190 | |
2191 ;; Process each message in turn starting from the back and | |
2192 ;; proceeding to the front of the region. This is especially a | |
2193 ;; good approach since the buffer will likely have new headers | |
2194 ;; added. | |
2195 (goto-char start) | |
2196 (while (re-search-backward rmail-unix-mail-delimiter nil t) | |
2197 | |
2198 ;; Cache the message date to facilitate generating a message | |
2199 ;; summary later. The format is '(DAY-OF-WEEK DAY-NUMBER MON | |
2200 ;; YEAR TIME) | |
2201 (setq date | |
2202 (list (buffer-substring (match-beginning 2) (match-end 2)) | |
2203 (buffer-substring (match-beginning 4) (match-end 4)) | |
2204 (buffer-substring (match-beginning 3) (match-end 3)) | |
2205 (buffer-substring (match-beginning 7) (match-end 7)) | |
2206 (buffer-substring (match-beginning 5) (match-end 5)))) | |
2207 | |
2208 | |
2209 ;;Set start and end to bracket this message. | |
2210 (setq end start) | |
2211 (setq start (point)) | |
2212 (save-excursion | |
2213 (save-restriction | |
2214 (narrow-to-region start end) | |
2215 (goto-char start) | |
2216 | |
2217 ;; Bump the new message counter. | |
2218 (setq new-message-counter (1+ new-message-counter)) | |
2219 | |
2220 ;; I don't understand why the following is done ... -pmr | |
2221 ;; Detect messages that have been added with DOS line | |
2222 ;; endings and convert the line endings for such messages. | |
2223 (if (save-excursion (end-of-line) (= (preceding-char) ?\r)) | |
2224 (let ((buffer-read-only nil) | |
2225 (buffer-undo t) | |
2226 (end-marker (copy-marker end))) | |
2227 (message | |
2228 "Processing new messages...(converting line endings)") | |
2229 (save-excursion | |
2230 (goto-char (point-max)) | |
2231 (while (search-backward "\r\n" (point-min) t) | |
2232 (delete-char 1))) | |
2233 (setq end (marker-position end-marker)) | |
2234 (set-marker end-marker nil))) | |
2235 | |
2236 ;; Make sure we have an Rmail BABYL attribute header field. | |
2237 ;; All we can assume is that the Rmail BABYL header field is | |
2238 ;; in the header section. It's placement can be modified by | |
2239 ;; another mailer. | |
2240 (setq attributes | |
2241 (rmail-header-get-header rmail-header-attribute-header)) | |
2242 (unless attributes | |
2243 | |
2244 ;; No suitable header exists. Append the default BABYL | |
2245 ;; data header for a new message. | |
2246 (setq attributes (rmail-desc-get-default-attrs)) | |
2247 (rmail-header-add-header | |
2248 rmail-header-attribute-header attributes)) | |
2249 | |
2250 ;; Set up keywords, if any. The keywords are provided via a | |
2251 ;; comma separated list and returned as a list of strings. | |
2252 (setq keywords (rmail-header-get-keywords)) | |
2253 (if keywords | |
2254 | |
2255 ;; Keywords do exist. Register them with the keyword | |
2256 ;; management library. | |
2257 (rmail-keyword-register-keywords keywords)) | |
2258 | |
2259 | |
2260 ;; Insure that we have From and Date headers. | |
2261 ;;(rmail-decode-from-line) | |
2262 | |
2263 ;; Perform User defined filtering. | |
2264 (save-excursion | |
2265 (if rmail-message-filter (funcall rmail-message-filter))) | |
2266 | |
2267 ;; Accumulate the message attributes along with the message | |
2268 ;; markers and the message date list. | |
2269 (setq message-descriptor-list | |
2270 (vconcat (list (list (point-min-marker) | |
2271 attributes | |
2272 keywords | |
2273 date | |
2274 (count-lines start end) | |
2275 (rmail-get-sender) | |
2276 (rmail-header-get-header "subject"))) | |
2277 message-descriptor-list))))) | |
2278 | |
2279 ;; Add the new message data lists to the Rmail message descriptor | |
2280 ;; vector. | |
2281 (rmail-desc-add-descriptors message-descriptor-list) | |
2282 | |
2283 ;; Unless requested otherwise, show the number of new messages. | |
2284 ;; Return the number of new messages. | |
2285 (or nomsg (message "Processing new messages...done (%d)" new-message-counter)) | |
2286 new-message-counter)) | |
2287 | |
2288 ;;; mbox: deprecated | |
2229 (defun rmail-forget-messages () | 2289 (defun rmail-forget-messages () |
2230 (unwind-protect | 2290 (unwind-protect |
2231 (if (vectorp rmail-message-vector) | 2291 (if (vectorp rmail-message-vector) |
2232 (let* ((i 0) | 2292 (let* ((i 0) |
2233 (v rmail-message-vector) | 2293 (v rmail-message-vector) |
2237 (setq i (1+ i))))) | 2297 (setq i (1+ i))))) |
2238 (setq rmail-message-vector nil) | 2298 (setq rmail-message-vector nil) |
2239 (setq rmail-msgref-vector nil) | 2299 (setq rmail-msgref-vector nil) |
2240 (setq rmail-deleted-vector nil))) | 2300 (setq rmail-deleted-vector nil))) |
2241 | 2301 |
2302 ;;; mbox: deprecated | |
2242 (defun rmail-maybe-set-message-counters () | 2303 (defun rmail-maybe-set-message-counters () |
2243 (if (not (and rmail-deleted-vector | 2304 (if (not (and rmail-deleted-vector |
2244 rmail-message-vector | 2305 rmail-message-vector |
2245 rmail-current-message | 2306 rmail-current-message |
2246 rmail-total-messages)) | 2307 rmail-total-messages)) |
2279 (aset rmail-msgref-vector i (list i)) | 2340 (aset rmail-msgref-vector i (list i)) |
2280 (setq i (1+ i)))) | 2341 (setq i (1+ i)))) |
2281 (goto-char (point-min)) | 2342 (goto-char (point-min)) |
2282 (or nomsg (message "Counting new messages...done (%d)" total-messages)))) | 2343 (or nomsg (message "Counting new messages...done (%d)" total-messages)))) |
2283 | 2344 |
2345 ;;; DEPRECATED | |
2284 (defun rmail-set-message-counters () | 2346 (defun rmail-set-message-counters () |
2285 (rmail-forget-messages) | 2347 (rmail-forget-messages) |
2286 (save-excursion | 2348 (save-excursion |
2287 (save-restriction | 2349 (save-restriction |
2288 (widen) | 2350 (widen) |
2316 (while (<= i rmail-total-messages) | 2378 (while (<= i rmail-total-messages) |
2317 (aset rmail-msgref-vector i (list i)) | 2379 (aset rmail-msgref-vector i (list i)) |
2318 (setq i (1+ i)))) | 2380 (setq i (1+ i)))) |
2319 (message "Counting messages...done"))))) | 2381 (message "Counting messages...done"))))) |
2320 | 2382 |
2383 ;;; DEPRECATED | |
2321 (defun rmail-set-message-counters-counter (&optional stop) | 2384 (defun rmail-set-message-counters-counter (&optional stop) |
2322 (let ((start (point)) | 2385 (let ((start (point)) |
2323 next) | 2386 next) |
2324 (while (search-backward "\n\^_\^L" stop t) | 2387 (while (search-backward "\n\^_\^L" stop t) |
2325 ;; Detect messages that have been added with DOS line endings and | 2388 ;; Detect messages that have been added with DOS line endings and |
2345 ?D ?\ ) | 2408 ?D ?\ ) |
2346 deleted-head))) | 2409 deleted-head))) |
2347 (if (zerop (% (setq total-messages (1+ total-messages)) 20)) | 2410 (if (zerop (% (setq total-messages (1+ total-messages)) 20)) |
2348 (message "Counting messages...%d" total-messages))))) | 2411 (message "Counting messages...%d" total-messages))))) |
2349 | 2412 |
2413 ;;; DEPRECATED | |
2350 (defun rmail-beginning-of-message () | 2414 (defun rmail-beginning-of-message () |
2351 "Show current message starting from the beginning." | 2415 "Show current message starting from the beginning." |
2352 (interactive) | 2416 (interactive) |
2353 (rmail-show-message rmail-current-message)) | 2417 (rmail-show-message rmail-current-message)) |
2354 | 2418 |
2355 (defun rmail-show-message (&optional n no-summary) | 2419 (defun rmail-show-message (&optional n no-summary) |
2356 "Show message number N (prefix argument), counting from start of file. | 2420 "Show message number N (prefix argument), counting from start of file. |
2357 If summary buffer is currently displayed, update current message there also." | 2421 If NO-SUMMARY is non-nil, then do not update the summary buffer." |
2358 (interactive "p") | 2422 (interactive "p") |
2359 (or (eq major-mode 'rmail-mode) | 2423 (or (eq major-mode 'rmail-mode) |
2360 (switch-to-buffer rmail-buffer)) | 2424 (switch-to-buffer rmail-buffer)) |
2361 (rmail-maybe-set-message-counters) | 2425 |
2362 (widen) | 2426 ;; If there are no messages to display, then provide a message to |
2427 ;; indicate thusly. | |
2363 (if (zerop rmail-total-messages) | 2428 (if (zerop rmail-total-messages) |
2364 (progn (narrow-to-region (point-min) (1- (point-max))) | 2429 |
2365 (goto-char (point-min)) | 2430 ;; There are no messages so display the Babyl boilerplate in the |
2366 (setq mode-line-process nil)) | 2431 ;; presentation buffer. It is important to keep the boilerplate |
2432 ;; out of the Rmail file so as not to break other mail agents. | |
2433 (progn | |
2434 (message "No messages to show. Add something better soon.") | |
2435 (rmail-display-labels) | |
2436 (force-mode-line-update)) | |
2437 | |
2438 ;; There are messages. Show one. | |
2367 (let (blurb coding-system) | 2439 (let (blurb coding-system) |
2440 ;; Set n to the first sane message based on the sign of n: | |
2441 ;; positive but greater than the total number of messages -> n; | |
2442 ;; negative -> 1. | |
2368 (if (not n) | 2443 (if (not n) |
2369 (setq n rmail-current-message) | 2444 (setq n rmail-current-message) |
2370 (cond ((<= n 0) | 2445 (cond ((<= n 0) |
2371 (setq n 1 | 2446 (setq n 1 |
2372 rmail-current-message 1 | 2447 rmail-current-message 1 |
2375 (setq n rmail-total-messages | 2450 (setq n rmail-total-messages |
2376 rmail-current-message rmail-total-messages | 2451 rmail-current-message rmail-total-messages |
2377 blurb "No following message")) | 2452 blurb "No following message")) |
2378 (t | 2453 (t |
2379 (setq rmail-current-message n)))) | 2454 (setq rmail-current-message n)))) |
2380 (let ((beg (rmail-msgbeg n))) | 2455 |
2381 (goto-char beg) | 2456 ;; Index into the Rmail message vector. |
2382 (forward-line 1) | 2457 (let ((beg (rmail-desc-get-start n)) |
2383 (save-excursion | 2458 (end (rmail-desc-get-end n))) |
2384 (let ((end (rmail-msgend n))) | 2459 |
2385 (save-restriction | 2460 ;; Narrow the region to message N and display the headers |
2386 (if (prog1 (= (following-char) ?0) | 2461 ;; appropriately. |
2387 (forward-line 2) | 2462 (rmail-header-show-headers) |
2388 ;; If there's a Summary-line in the (otherwise empty) | 2463 (widen) |
2389 ;; header, we didn't yet get past the EOOH line. | 2464 (narrow-to-region beg end) |
2390 (if (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n") | 2465 (goto-char (point-min)) |
2391 (forward-line 1)) | 2466 |
2392 (narrow-to-region (point) end)) | 2467 ;; I think this is stale. -pmr |
2393 (rfc822-goto-eoh) | 2468 ;;(rfc822-goto-eoh) |
2394 (search-forward "\n*** EOOH ***\n" end t)) | 2469 ;;(narrow-to-region beg (point)) |
2395 (narrow-to-region beg (point)) | 2470 ;;(goto-char (point-min)) |
2396 (goto-char (point-min)) | 2471 ;;(if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) |
2397 (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) | 2472 ;; (let ((coding-system (intern (match-string 1)))) |
2398 (let ((coding-system (intern (match-string 1)))) | 2473 ;; (check-coding-system coding-system) |
2399 (condition-case nil | 2474 ;; (setq buffer-file-coding-system coding-system)) |
2400 (progn | 2475 ;; (setq buffer-file-coding-system nil)))) |
2401 (check-coding-system coding-system) | 2476 |
2402 (setq buffer-file-coding-system coding-system)) | 2477 ;; Do something here with the coding system, I'm not sure what. -pmr |
2403 (error | 2478 (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) |
2404 (setq buffer-file-coding-system nil)))) | 2479 (let ((coding-system (intern (match-string 1)))) |
2405 (setq buffer-file-coding-system nil))))) | 2480 (condition-case nil |
2406 ;; Clear the "unseen" attribute when we show a message. | 2481 (progn |
2407 (rmail-set-attribute "unseen" nil) | 2482 (check-coding-system coding-system) |
2408 (let ((end (rmail-msgend n))) | 2483 (setq buffer-file-coding-system coding-system)) |
2409 ;; Reformat the header, or else find the reformatted header. | 2484 (error |
2410 (if (= (following-char) ?0) | 2485 (setq buffer-file-coding-system nil)))) |
2411 (rmail-reformat-message beg end) | 2486 (setq buffer-file-coding-system nil)) |
2412 (search-forward "\n*** EOOH ***\n" end t) | 2487 |
2413 (narrow-to-region (point) end))) | 2488 ;; Clear the "unseen" attribute when we show a message, unless |
2414 (goto-char (point-min)) | 2489 ;; it is already cleared. |
2415 (walk-windows | 2490 (if (rmail-desc-attr-p rmail-desc-unseen-index n) |
2416 (function (lambda (window) | 2491 (rmail-desc-set-attribute rmail-desc-unseen-index nil n)) |
2417 (if (eq (window-buffer window) (current-buffer)) | 2492 |
2418 (set-window-point window (point))))) | 2493 ;; More code that has been added that I ill understand. |
2419 nil t) | 2494 ;; (walk-windows |
2495 ;; (function (lambda (window) | |
2496 ;; (if (eq (window-buffer window) (current-buffer)) | |
2497 ;; (set-window-point window (point))))) | |
2498 ;; nil t) | |
2499 | |
2420 (rmail-display-labels) | 2500 (rmail-display-labels) |
2501 | |
2502 ;; Deal with MIME | |
2421 (if (eq rmail-enable-mime t) | 2503 (if (eq rmail-enable-mime t) |
2422 (funcall rmail-show-mime-function) | 2504 (funcall rmail-show-mime-function) |
2423 (setq rmail-view-buffer rmail-buffer) | 2505 (setq rmail-view-buffer rmail-buffer)) |
2424 ) | 2506 |
2507 ;; Deal with the message headers and URLs.. | |
2508 (rmail-header-hide-headers) | |
2425 (rmail-highlight-headers) | 2509 (rmail-highlight-headers) |
2510 (rmail-activate-urls) | |
2511 | |
2512 ;; ? | |
2426 (if transient-mark-mode (deactivate-mark)) | 2513 (if transient-mark-mode (deactivate-mark)) |
2514 | |
2515 ;; Make sure that point in the Rmail window is at the beginning of the buffer. | |
2516 (set-window-point (get-buffer-window rmail-buffer) (point)) | |
2517 | |
2518 ;; Run any User code. | |
2427 (run-hooks 'rmail-show-message-hook) | 2519 (run-hooks 'rmail-show-message-hook) |
2520 | |
2428 ;; If there is a summary buffer, try to move to this message | 2521 ;; If there is a summary buffer, try to move to this message |
2429 ;; in that buffer. But don't complain if this message | 2522 ;; in that buffer. But don't complain if this message |
2430 ;; is not mentioned in the summary. | 2523 ;; is not mentioned in the summary. |
2431 ;; Don't do this at all if we were called on behalf | 2524 ;; Don't do this at all if we were called on behalf |
2432 ;; of cursor motion in the summary buffer. | 2525 ;; of cursor motion in the summary buffer. |
2433 (and (rmail-summary-exists) (not no-summary) | 2526 (and (rmail-summary-exists) (not no-summary) |
2434 (let ((curr-msg rmail-current-message)) | 2527 (save-excursion |
2435 (rmail-select-summary | 2528 (let ((curr-msg rmail-current-message)) |
2436 (rmail-summary-goto-msg curr-msg t t)))) | 2529 ;; Set the summary current message, disabling the |
2530 ;; Rmail buffer update. | |
2531 (set-buffer rmail-summary-buffer) | |
2532 (rmail-summary-goto-msg curr-msg nil t)))) | |
2533 ;;; (rmail-summary-rmail-update)))) | |
2534 | |
2535 ;; What is going on here? | |
2437 (with-current-buffer rmail-buffer | 2536 (with-current-buffer rmail-buffer |
2438 (rmail-auto-file)) | 2537 (rmail-auto-file)) |
2538 | |
2539 ;; Post back any status messages. | |
2439 (if blurb | 2540 (if blurb |
2440 (message blurb)))))) | 2541 (message blurb)))))) |
2441 | 2542 |
2543 ;;; NOT DONE | |
2442 (defun rmail-redecode-body (coding) | 2544 (defun rmail-redecode-body (coding) |
2443 "Decode the body of the current message using coding system CODING. | 2545 "Decode the body of the current message using coding system CODING. |
2444 This is useful with mail messages that have malformed or missing | 2546 This is useful with mail messages that have malformed or missing |
2445 charset= headers. | 2547 charset= headers. |
2446 | 2548 |
2458 (interactive "zCoding system for re-decoding this message: ") | 2560 (interactive "zCoding system for re-decoding this message: ") |
2459 (when (not rmail-enable-mime) | 2561 (when (not rmail-enable-mime) |
2460 (or (eq major-mode 'rmail-mode) | 2562 (or (eq major-mode 'rmail-mode) |
2461 (switch-to-buffer rmail-buffer)) | 2563 (switch-to-buffer rmail-buffer)) |
2462 (save-excursion | 2564 (save-excursion |
2463 (let ((pruned (rmail-msg-is-pruned))) | 2565 (unwind-protect |
2464 (unwind-protect | 2566 (let ((msgbeg (rmail-desc-get-start rmail-current-message)) |
2465 (let ((msgbeg (rmail-msgbeg rmail-current-message)) | 2567 (msgend (rmail-desc-get-end rmail-current-message)) |
2466 (msgend (rmail-msgend rmail-current-message)) | 2568 x-coding-header) |
2467 x-coding-header) | 2569 ;; We need the message headers pruned (we later restore |
2468 ;; We need the message headers pruned (we later restore | 2570 ;; the pruned stat to what it was, see the end of |
2469 ;; the pruned stat to what it was, see the end of | 2571 ;; unwind-protect form). |
2470 ;; unwind-protect form). | 2572 (rmail-header-show-headers) |
2471 (or pruned | 2573 (narrow-to-region msgbeg msgend) |
2472 (rmail-toggle-header 1)) | 2574 (goto-char (point-min)) |
2473 (narrow-to-region msgbeg msgend) | 2575 (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) |
2474 (goto-char (point-min)) | 2576 (let ((old-coding (intern (match-string 1))) |
2475 (when (search-forward "\n*** EOOH ***\n" (point-max) t) | 2577 (buffer-read-only nil)) |
2476 (narrow-to-region msgbeg (point))) | 2578 (check-coding-system old-coding) |
2477 (goto-char (point-min)) | 2579 ;; Make sure the new coding system uses the same EOL |
2478 (if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) | 2580 ;; conversion, to prevent ^M characters from popping |
2479 (let ((old-coding (intern (match-string 1))) | 2581 ;; up all over the place. |
2480 (buffer-read-only nil)) | 2582 (setq coding |
2481 (check-coding-system old-coding) | 2583 (coding-system-change-eol-conversion |
2482 ;; Make sure the new coding system uses the same EOL | 2584 coding |
2483 ;; conversion, to prevent ^M characters from popping | 2585 (coding-system-eol-type old-coding))) |
2484 ;; up all over the place. | 2586 (setq x-coding-header (point-marker)) |
2485 (setq coding | 2587 (narrow-to-region msgbeg msgend) |
2486 (coding-system-change-eol-conversion | 2588 (encode-coding-region (point) msgend old-coding) |
2487 coding | 2589 (decode-coding-region (point) msgend coding) |
2488 (coding-system-eol-type old-coding))) | 2590 (setq last-coding-system-used coding) |
2489 (setq x-coding-header (point-marker)) | 2591 ;; Rewrite the coding-system header according |
2490 (narrow-to-region msgbeg msgend) | 2592 ;; to what we did. |
2491 (encode-coding-region (point) msgend old-coding) | 2593 (goto-char x-coding-header) |
2492 (decode-coding-region (point) msgend coding) | 2594 (delete-region (point) |
2493 (setq last-coding-system-used coding) | 2595 (save-excursion |
2494 ;; Rewrite the coding-system header according | 2596 (beginning-of-line) |
2495 ;; to what we did. | 2597 (point))) |
2496 (goto-char x-coding-header) | 2598 (insert "X-Coding-System: " |
2497 (delete-region (point) | 2599 (symbol-name last-coding-system-used)) |
2498 (save-excursion | 2600 (set-marker x-coding-header nil) |
2499 (beginning-of-line) | 2601 (rmail-show-message)) |
2500 (point))) | 2602 (error "No X-Coding-System header found"))) |
2501 (insert "X-Coding-System: " | 2603 (rmail-header-hide-headers))))) |
2502 (symbol-name last-coding-system-used)) | |
2503 (set-marker x-coding-header nil) | |
2504 (rmail-show-message)) | |
2505 (error "No X-Coding-System header found"))) | |
2506 (or pruned | |
2507 (rmail-toggle-header 0))))))) | |
2508 | 2604 |
2509 ;; Find all occurrences of certain fields, and highlight them. | 2605 ;; Find all occurrences of certain fields, and highlight them. |
2510 (defun rmail-highlight-headers () | 2606 (defun rmail-highlight-headers () |
2511 ;; Do this only if the system supports faces. | 2607 ;; Do this only if the system supports faces. |
2512 (if (and (fboundp 'internal-find-face) | 2608 (if (and (fboundp 'internal-find-face) |
2547 (setq overlay (make-overlay beg (point))) | 2643 (setq overlay (make-overlay beg (point))) |
2548 (overlay-put overlay 'face face) | 2644 (overlay-put overlay 'face face) |
2549 (setq rmail-overlay-list | 2645 (setq rmail-overlay-list |
2550 (cons overlay rmail-overlay-list)))))))))) | 2646 (cons overlay rmail-overlay-list)))))))))) |
2551 | 2647 |
2648 ;;; mbox ready | |
2552 (defun rmail-auto-file () | 2649 (defun rmail-auto-file () |
2553 "Automatically move a message into a sub-folder based on criteria. | 2650 "Automatically move a message into a sub-folder based on criteria. |
2554 Called when a new message is displayed." | 2651 Called when a new message is displayed." |
2555 (if (or (rmail-message-labels-p rmail-current-message "filed") | 2652 (if (or (rmail-message-labels-p rmail-current-message "filed") |
2556 (not (string= (buffer-file-name) | 2653 (not (string= (buffer-file-name) |
2559 nil | 2656 nil |
2560 ;; Find out some basics (common fields) | 2657 ;; Find out some basics (common fields) |
2561 (let ((from (mail-fetch-field "from")) | 2658 (let ((from (mail-fetch-field "from")) |
2562 (subj (mail-fetch-field "subject")) | 2659 (subj (mail-fetch-field "subject")) |
2563 (to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc"))) | 2660 (to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc"))) |
2564 (d rmail-automatic-folder-directives) | 2661 (directives rmail-automatic-folder-directives) |
2565 (directive-loop nil) | 2662 (directive-loop nil) |
2566 (folder nil)) | 2663 (folder nil)) |
2567 (while d | 2664 (while directives |
2568 (setq folder (car (car d)) | 2665 (setq folder (car (car directives)) |
2569 directive-loop (cdr (car d))) | 2666 directive-loop (cdr (car directives))) |
2570 (while (and (car directive-loop) | 2667 (while (and (car directive-loop) |
2571 (let ((f (cond | 2668 (let ((f (cond |
2572 ((string= (car directive-loop) "from") from) | 2669 ((string= (car directive-loop) "from") from) |
2573 ((string= (car directive-loop) "to") to) | 2670 ((string= (car directive-loop) "to") to) |
2574 ((string= (car directive-loop) "subject") subj) | 2671 ((string= (car directive-loop) "subject") subj) |
2579 (if (null directive-loop) | 2676 (if (null directive-loop) |
2580 (if (null folder) | 2677 (if (null folder) |
2581 (rmail-delete-forward) | 2678 (rmail-delete-forward) |
2582 (if (string= "/dev/null" folder) | 2679 (if (string= "/dev/null" folder) |
2583 (rmail-delete-message) | 2680 (rmail-delete-message) |
2584 (rmail-output-to-rmail-file folder 1 t) | 2681 (rmail-output folder 1 t) |
2585 (setq d nil)))) | 2682 (setq directives nil)))) |
2586 (setq d (cdr d)))))) | 2683 (setq directives (cdr directives)))))) |
2587 | 2684 |
2588 (defun rmail-next-message (n) | 2685 (defun rmail-next-message (n) |
2589 "Show following message whether deleted or not. | 2686 "Show following message whether deleted or not. |
2590 With prefix arg N, moves forward N messages, or backward if N is negative." | 2687 With prefix arg N, moves forward N messages, or backward if N is negative." |
2591 (interactive "p") | 2688 (interactive "p") |
2604 With prefix arg N, moves forward N non-deleted messages, | 2701 With prefix arg N, moves forward N non-deleted messages, |
2605 or backward if N is negative. | 2702 or backward if N is negative. |
2606 | 2703 |
2607 Returns t if a new message is being shown, nil otherwise." | 2704 Returns t if a new message is being shown, nil otherwise." |
2608 (interactive "p") | 2705 (interactive "p") |
2609 (set-buffer rmail-buffer) | |
2610 (rmail-maybe-set-message-counters) | |
2611 (let ((lastwin rmail-current-message) | 2706 (let ((lastwin rmail-current-message) |
2612 (current rmail-current-message)) | 2707 (current rmail-current-message)) |
2708 | |
2709 ;; Handle forward movement looking for an undeleted message. Move | |
2710 ;; forward a message at a time as long as there are subsequent | |
2711 ;; messages. Stop if the last message is encountered. | |
2613 (while (and (> n 0) (< current rmail-total-messages)) | 2712 (while (and (> n 0) (< current rmail-total-messages)) |
2614 (setq current (1+ current)) | 2713 (setq current (1+ current)) |
2615 (if (not (rmail-message-deleted-p current)) | 2714 (if (not (rmail-desc-deleted-p current)) |
2616 (setq lastwin current n (1- n)))) | 2715 (setq lastwin current |
2716 n (1- n)))) | |
2717 | |
2718 ;; Handle backward movement looking for an undeleted message. | |
2719 ;; Move backward a message at a time as long as there are | |
2720 ;; preceding messages. Stop if the first message is encountered. | |
2617 (while (and (< n 0) (> current 1)) | 2721 (while (and (< n 0) (> current 1)) |
2618 (setq current (1- current)) | 2722 (setq current (1- current)) |
2619 (if (not (rmail-message-deleted-p current)) | 2723 (if (not (rmail-desc-deleted-p current)) |
2620 (setq lastwin current n (1+ n)))) | 2724 (setq lastwin current |
2725 n (1+ n)))) | |
2726 | |
2727 ;; Show the message (even if no movement took place so that the | |
2728 ;; delete attribute is marked) and determine the result value. | |
2729 (rmail-show-message lastwin) | |
2621 (if (/= lastwin rmail-current-message) | 2730 (if (/= lastwin rmail-current-message) |
2622 (progn (rmail-show-message lastwin) | 2731 t |
2623 t) | |
2624 (if (< n 0) | 2732 (if (< n 0) |
2625 (message "No previous nondeleted message")) | 2733 (message "No previous nondeleted message")) |
2626 (if (> n 0) | 2734 (if (> n 0) |
2627 (message "No following nondeleted message")) | 2735 (message "No following nondeleted message")) |
2628 nil))) | 2736 nil))) |
2629 | 2737 |
2738 ;;; mbox: ready. | |
2630 (defun rmail-previous-undeleted-message (n) | 2739 (defun rmail-previous-undeleted-message (n) |
2631 "Show previous non-deleted message. | 2740 "Show previous non-deleted message. |
2632 With prefix argument N, moves backward N non-deleted messages, | 2741 With prefix argument N, moves backward N non-deleted messages, |
2633 or forward if N is negative." | 2742 or forward if N is negative." |
2634 (interactive "p") | 2743 (interactive "p") |
2635 (rmail-next-undeleted-message (- n))) | 2744 (rmail-next-undeleted-message (- n))) |
2636 | 2745 |
2746 ;;; mbox: ready. | |
2637 (defun rmail-first-message () | 2747 (defun rmail-first-message () |
2638 "Show first message in file." | 2748 "Show first message in file." |
2639 (interactive) | 2749 (interactive) |
2640 (rmail-maybe-set-message-counters) | |
2641 (rmail-show-message 1)) | 2750 (rmail-show-message 1)) |
2642 | 2751 |
2752 ;;; mbox: ready | |
2643 (defun rmail-last-message () | 2753 (defun rmail-last-message () |
2644 "Show last message in file." | 2754 "Show last message in file." |
2645 (interactive) | 2755 (interactive) |
2646 (rmail-maybe-set-message-counters) | |
2647 (rmail-show-message rmail-total-messages)) | 2756 (rmail-show-message rmail-total-messages)) |
2648 | 2757 |
2758 ;;; mbox: not called | |
2649 (defun rmail-what-message () | 2759 (defun rmail-what-message () |
2650 (let ((where (point)) | 2760 (let ((where (point)) |
2651 (low 1) | 2761 (low 1) |
2652 (high rmail-total-messages) | 2762 (high rmail-total-messages) |
2653 (mid (/ rmail-total-messages 2))) | 2763 (mid (/ rmail-total-messages 2))) |
2654 (while (> (- high low) 1) | 2764 (while (> (- high low) 1) |
2655 (if (>= where (rmail-msgbeg mid)) | 2765 (if (>= where (rmail-desc-get-start mid)) |
2656 (setq low mid) | 2766 (setq low mid) |
2657 (setq high mid)) | 2767 (setq high mid)) |
2658 (setq mid (+ low (/ (- high low) 2)))) | 2768 (setq mid (+ low (/ (- high low) 2)))) |
2659 (if (>= where (rmail-msgbeg high)) high low))) | 2769 (if (>= where (rmail-desc-get-start high)) high low))) |
2660 | 2770 |
2771 ;;; mbox: ready | |
2772 (defun rmail-narrow-to-header (msg) | |
2773 (save-excursion | |
2774 (let ((start (rmail-desc-get-start msg)) | |
2775 (end (rmail-desc-get-end msg))) | |
2776 (widen) | |
2777 (goto-char start) | |
2778 (search-forward "\n\n" end nil t) | |
2779 (narrow-to-region start (point))))) | |
2780 | |
2781 ;;; mbox: ready | |
2661 (defun rmail-message-recipients-p (msg recipients &optional primary-only) | 2782 (defun rmail-message-recipients-p (msg recipients &optional primary-only) |
2662 (save-restriction | 2783 (save-restriction |
2663 (goto-char (rmail-msgbeg msg)) | |
2664 (search-forward "\n*** EOOH ***\n") | |
2665 (narrow-to-region (point) (progn (search-forward "\n\n") (point))) | |
2666 (or (string-match recipients (or (mail-fetch-field "To") "")) | 2784 (or (string-match recipients (or (mail-fetch-field "To") "")) |
2667 (string-match recipients (or (mail-fetch-field "From") "")) | 2785 (string-match recipients (or (mail-fetch-field "From") "")) |
2668 (if (not primary-only) | 2786 (if (not primary-only) |
2669 (string-match recipients (or (mail-fetch-field "Cc") "")))))) | 2787 (string-match recipients (or (mail-fetch-field "Cc") "")))))) |
2670 | 2788 |
2671 (defun rmail-message-regexp-p (n regexp) | 2789 ;;; mbox: ready |
2672 "Return t, if for message number N, regexp REGEXP matches in the header." | 2790 (defun rmail-message-regexp-p (msg regexp) |
2673 (let ((beg (rmail-msgbeg n)) | 2791 "Return t, if for message number MSG, regexp REGEXP matches in the header." |
2674 (end (rmail-msgend n))) | 2792 (save-excursion |
2675 (goto-char beg) | 2793 (save-restriction |
2676 (forward-line 1) | 2794 (rmail-narrow-to-header msg) |
2677 (save-excursion | 2795 (re-search-forward regexp nil t)))) |
2678 (save-restriction | 2796 |
2679 (if (prog1 (= (following-char) ?0) | 2797 ;;; mbox: ready |
2680 (forward-line 2) | |
2681 ;; If there's a Summary-line in the (otherwise empty) | |
2682 ;; header, we didn't yet get past the EOOH line. | |
2683 (when (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n") | |
2684 (forward-line 1)) | |
2685 (setq beg (point)) | |
2686 (narrow-to-region (point) end)) | |
2687 (progn | |
2688 (rfc822-goto-eoh) | |
2689 (setq end (point))) | |
2690 (setq beg (point)) | |
2691 (search-forward "\n*** EOOH ***\n" end t) | |
2692 (setq end (1+ (match-beginning 0))))) | |
2693 (goto-char beg) | |
2694 (if rmail-enable-mime | |
2695 (funcall rmail-search-mime-header-function n regexp end) | |
2696 (re-search-forward regexp end t))))) | |
2697 | |
2698 (defun rmail-search-message (msg regexp) | 2798 (defun rmail-search-message (msg regexp) |
2699 "Return non-nil, if for message number MSG, regexp REGEXP matches." | 2799 "Return non-nil, if for message number MSG, regexp REGEXP matches." |
2700 (goto-char (rmail-msgbeg msg)) | 2800 (goto-char (rmail-desc-get-start msg)) |
2701 (if rmail-enable-mime | 2801 (if rmail-enable-mime |
2702 (funcall rmail-search-mime-message-function msg regexp) | 2802 (funcall rmail-search-mime-message-function msg regexp) |
2703 (re-search-forward regexp (rmail-msgend msg) t))) | 2803 (re-search-forward regexp (rmail-desc-get-end msg) t))) |
2704 | 2804 |
2805 ;;; mbox: ready | |
2705 (defvar rmail-search-last-regexp nil) | 2806 (defvar rmail-search-last-regexp nil) |
2706 (defun rmail-search (regexp &optional n) | 2807 (defun rmail-search (regexp &optional n) |
2707 "Show message containing next match for REGEXP (but not the current msg). | 2808 "Show message containing next match for REGEXP (but not the current msg). |
2708 Prefix argument gives repeat count; negative argument means search | 2809 Prefix argument gives repeat count; negative argument means search |
2709 backwards (through earlier messages). | 2810 backwards (through earlier messages). |
2728 (or n (setq n 1)) | 2829 (or n (setq n 1)) |
2729 (message "%sRmail search for %s..." | 2830 (message "%sRmail search for %s..." |
2730 (if (< n 0) "Reverse " "") | 2831 (if (< n 0) "Reverse " "") |
2731 regexp) | 2832 regexp) |
2732 (set-buffer rmail-buffer) | 2833 (set-buffer rmail-buffer) |
2733 (rmail-maybe-set-message-counters) | |
2734 (let ((omin (point-min)) | 2834 (let ((omin (point-min)) |
2735 (omax (point-max)) | 2835 (omax (point-max)) |
2736 (opoint (point)) | 2836 (opoint (point)) |
2737 win | |
2738 (reversep (< n 0)) | 2837 (reversep (< n 0)) |
2739 (msg rmail-current-message)) | 2838 (msg rmail-current-message) |
2839 win) | |
2740 (unwind-protect | 2840 (unwind-protect |
2741 (progn | 2841 (progn |
2742 (widen) | 2842 (widen) |
2743 (while (/= n 0) | 2843 (while (/= n 0) |
2744 ;; Check messages one by one, advancing message number up or down | 2844 ;; Check messages one by one, advancing message number up or down |
2796 (error "No previous Rmail search string"))) | 2896 (error "No previous Rmail search string"))) |
2797 (list rmail-search-last-regexp | 2897 (list rmail-search-last-regexp |
2798 (prefix-numeric-value current-prefix-arg)))) | 2898 (prefix-numeric-value current-prefix-arg)))) |
2799 (rmail-search regexp (- (or n 1)))) | 2899 (rmail-search regexp (- (or n 1)))) |
2800 | 2900 |
2801 ;; Show the first message which has the `unseen' attribute. | |
2802 (defun rmail-first-unseen-message () | 2901 (defun rmail-first-unseen-message () |
2803 (rmail-maybe-set-message-counters) | 2902 "Show the first message which has not been seen. If all messages |
2903 have been seen, then show the last message." | |
2804 (let ((current 1) | 2904 (let ((current 1) |
2805 found) | 2905 found) |
2806 (save-restriction | 2906 (while (and (not found) (<= current rmail-total-messages)) |
2807 (widen) | 2907 (if (rmail-desc-attr-p rmail-desc-unseen-index current) |
2808 (while (and (not found) (<= current rmail-total-messages)) | 2908 (setq found current)) |
2809 (if (rmail-message-labels-p current ", ?\\(unseen\\),") | 2909 (setq current (1+ current))) |
2810 (setq found current)) | |
2811 (setq current (1+ current)))) | |
2812 ;; Let the caller show the message. | |
2813 ;; (if found | |
2814 ;; (rmail-show-message found)) | |
2815 found)) | 2910 found)) |
2816 | 2911 |
2817 (defun rmail-next-same-subject (n) | 2912 (defun rmail-next-same-subject (n) |
2818 "Go to the next mail message having the same subject header. | 2913 "Go to the next mail message having the same subject header. |
2819 With prefix argument N, do this N times. | 2914 With prefix argument N, do this N times. |
2834 (regexp-quote subject) | 2929 (regexp-quote subject) |
2835 "[ \t]*\n")) | 2930 "[ \t]*\n")) |
2836 (save-excursion | 2931 (save-excursion |
2837 (save-restriction | 2932 (save-restriction |
2838 (widen) | 2933 (widen) |
2839 (while (and (/= n 0) | 2934 (if forward |
2840 (if forward | 2935 (while (and (/= n 0) (< i rmail-total-messages)) |
2841 (< i rmail-total-messages) | 2936 (let (done) |
2842 (> i 1))) | 2937 (while (and (not done) |
2843 (let (done) | 2938 (< i rmail-total-messages)) |
2844 (while (and (not done) | 2939 (setq i (+ i 1)) |
2845 (if forward | 2940 (rmail-narrow-to-header i) |
2846 (< i rmail-total-messages) | 2941 (goto-char (point-min)) |
2847 (> i 1))) | 2942 (setq done (re-search-forward search-regexp (point-max) t))) |
2848 (setq i (if forward (1+ i) (1- i))) | 2943 (if done (setq found i))) |
2849 (goto-char (rmail-msgbeg i)) | 2944 (setq n (1- n))) |
2850 (search-forward "\n*** EOOH ***\n") | 2945 (while (and (/= n 0) (> i 1)) |
2851 (let ((beg (point)) end) | 2946 (let (done) |
2852 (search-forward "\n\n") | 2947 (while (and (not done) (> i 1)) |
2853 (setq end (point)) | 2948 (setq i (- i 1)) |
2854 (goto-char beg) | 2949 (rmail-narrow-to-header i) |
2855 (setq done (re-search-forward search-regexp end t)))) | 2950 (goto-char (point-min)) |
2856 (if done (setq found i))) | 2951 (setq done (re-search-forward search-regexp (point-max) t))) |
2857 (setq n (if forward (1- n) (1+ n)))))) | 2952 (if done (setq found i))) |
2953 (setq n (1+ n)))))) | |
2858 (if found | 2954 (if found |
2859 (rmail-show-message found) | 2955 (rmail-show-message found) |
2860 (error "No %s message with same subject" | 2956 (error "No %s message with same subject" |
2861 (if forward "following" "previous"))))) | 2957 (if forward "following" "previous"))))) |
2862 | 2958 |
2867 (interactive "p") | 2963 (interactive "p") |
2868 (rmail-next-same-subject (- n))) | 2964 (rmail-next-same-subject (- n))) |
2869 | 2965 |
2870 ;;;; *** Rmail Message Deletion Commands *** | 2966 ;;;; *** Rmail Message Deletion Commands *** |
2871 | 2967 |
2968 ;;; mbox: ready | |
2872 (defun rmail-message-deleted-p (n) | 2969 (defun rmail-message-deleted-p (n) |
2873 (= (aref rmail-deleted-vector n) ?D)) | 2970 (rmail-desc-deleted-p n)) |
2874 | 2971 |
2875 (defun rmail-set-message-deleted-p (n state) | 2972 (defun rmail-set-message-deleted-p (n state) |
2876 (aset rmail-deleted-vector n (if state ?D ?\ ))) | 2973 (aset rmail-deleted-vector n (if state ?D ?\ ))) |
2877 | 2974 |
2878 (defun rmail-delete-message () | 2975 (defun rmail-delete-message () |
2879 "Delete this message and stay on it." | 2976 "Delete this message and stay on it." |
2880 (interactive) | 2977 (interactive) |
2881 (rmail-set-attribute "deleted" t) | 2978 (rmail-desc-set-attribute rmail-desc-deleted-index t rmail-current-message) |
2882 (run-hooks 'rmail-delete-message-hook)) | 2979 (run-hooks 'rmail-delete-message-hook) |
2980 (rmail-show-message rmail-current-message)) | |
2883 | 2981 |
2884 (defun rmail-undelete-previous-message () | 2982 (defun rmail-undelete-previous-message () |
2885 "Back up to deleted message, select it, and undelete it." | 2983 "Back up to deleted message, select it, and undelete it." |
2886 (interactive) | 2984 (interactive) |
2887 (set-buffer rmail-buffer) | 2985 (set-buffer rmail-buffer) |
2888 (let ((msg rmail-current-message)) | 2986 (let ((msg rmail-current-message)) |
2889 (while (and (> msg 0) | 2987 (while (and (> msg 0) |
2890 (not (rmail-message-deleted-p msg))) | 2988 (not (rmail-desc-attr-p rmail-desc-deleted-index msg))) |
2891 (setq msg (1- msg))) | 2989 (setq msg (1- msg))) |
2892 (if (= msg 0) | 2990 (if (= msg 0) |
2893 (error "No previous deleted message") | 2991 (error "No previous deleted message") |
2894 (if (/= msg rmail-current-message) | 2992 (rmail-desc-set-attribute rmail-desc-deleted-index nil msg) |
2895 (rmail-show-message msg)) | 2993 (rmail-show-message msg) |
2896 (rmail-set-attribute "deleted" nil) | |
2897 (if (rmail-summary-exists) | 2994 (if (rmail-summary-exists) |
2898 (save-excursion | 2995 (save-excursion |
2899 (set-buffer rmail-summary-buffer) | 2996 (set-buffer rmail-summary-buffer) |
2900 (rmail-summary-mark-undeleted msg))) | 2997 (rmail-summary-mark-undeleted msg))) |
2901 (rmail-maybe-display-summary)))) | 2998 (rmail-maybe-display-summary)))) |
2902 | 2999 |
3000 ;;; mbox: ready | |
2903 (defun rmail-delete-forward (&optional backward) | 3001 (defun rmail-delete-forward (&optional backward) |
2904 "Delete this message and move to next nondeleted one. | 3002 "Delete this message and move to next nondeleted one. |
2905 Deleted messages stay in the file until the \\[rmail-expunge] command is given. | 3003 Deleted messages stay in the file until the \\[rmail-expunge] command is given. |
2906 With prefix argument, delete and move backward. | 3004 With prefix argument, delete and move backward. |
2907 | 3005 |
2908 Returns t if a new message is displayed after the delete, or nil otherwise." | 3006 Returns t if a new message is displayed after the delete, or nil otherwise." |
2909 (interactive "P") | 3007 (interactive "P") |
2910 (rmail-set-attribute "deleted" t) | 3008 (rmail-desc-set-attribute rmail-desc-deleted-index t rmail-current-message) |
2911 (run-hooks 'rmail-delete-message-hook) | 3009 (run-hooks 'rmail-delete-message-hook) |
2912 (let ((del-msg rmail-current-message)) | 3010 (let ((del-msg rmail-current-message)) |
2913 (if (rmail-summary-exists) | 3011 (if (rmail-summary-exists) |
2914 (rmail-select-summary | 3012 (rmail-select-summary |
2915 (rmail-summary-mark-deleted del-msg))) | 3013 (rmail-summary-mark-deleted del-msg))) |
2916 (prog1 (rmail-next-undeleted-message (if backward -1 1)) | 3014 (prog1 (rmail-next-undeleted-message (if backward -1 1)) |
2917 (rmail-maybe-display-summary)))) | 3015 (rmail-maybe-display-summary)))) |
2918 | 3016 |
3017 ;;; mbox: ready | |
2919 (defun rmail-delete-backward () | 3018 (defun rmail-delete-backward () |
2920 "Delete this message and move to previous nondeleted one. | 3019 "Delete this message and move to previous nondeleted one. |
2921 Deleted messages stay in the file until the \\[rmail-expunge] command is given." | 3020 Deleted messages stay in the file until the \\[rmail-expunge] command is given." |
2922 (interactive) | 3021 (interactive) |
2923 (rmail-delete-forward t)) | 3022 (rmail-delete-forward t)) |
2924 | 3023 |
3024 ;;; mbox: deprecated | |
2925 ;; Compute the message number a given message would have after expunging. | 3025 ;; Compute the message number a given message would have after expunging. |
2926 ;; The present number of the message is OLDNUM. | 3026 ;; The present number of the message is OLDNUM. |
2927 ;; DELETEDVEC should be rmail-deleted-vector. | 3027 ;; DELETEDVEC should be rmail-deleted-vector. |
2928 ;; The value is nil for a message that would be deleted. | 3028 ;; The value is nil for a message that would be deleted. |
2929 (defun rmail-msg-number-after-expunge (deletedvec oldnum) | 3029 (defun rmail-msg-number-after-expunge (deletedvec oldnum) |
2945 (not (string-match "D" rmail-deleted-vector)) | 3045 (not (string-match "D" rmail-deleted-vector)) |
2946 (null rmail-confirm-expunge) | 3046 (null rmail-confirm-expunge) |
2947 (funcall rmail-confirm-expunge | 3047 (funcall rmail-confirm-expunge |
2948 "Erase deleted messages from Rmail file? "))) | 3048 "Erase deleted messages from Rmail file? "))) |
2949 | 3049 |
3050 ;;; mbox: ready | |
2950 (defun rmail-only-expunge () | 3051 (defun rmail-only-expunge () |
2951 "Actually erase all deleted messages in the file." | 3052 "Actually erase all deleted messages in the file." |
2952 (interactive) | 3053 (interactive) |
2953 (set-buffer rmail-buffer) | |
2954 (message "Expunging deleted messages...") | 3054 (message "Expunging deleted messages...") |
3055 | |
2955 ;; Discard all undo records for this buffer. | 3056 ;; Discard all undo records for this buffer. |
2956 (or (eq buffer-undo-list t) | 3057 (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) |
2957 (setq buffer-undo-list nil)) | 3058 |
2958 (rmail-maybe-set-message-counters) | 3059 ;; Remove the messages from the buffer and from the Rmail message |
2959 (let* ((omax (- (buffer-size) (point-max))) | 3060 ;; descriptor vector. |
2960 (omin (- (buffer-size) (point-min))) | 3061 (rmail-desc-prune-deleted-messages 'rmail-expunge-callback) |
2961 (opoint (if (and (> rmail-current-message 0) | 3062 |
2962 (rmail-message-deleted-p rmail-current-message)) | 3063 ;; Update the Rmail message counter, deal with the summary buffer, |
2963 0 | 3064 ;; show the current message and update the User status. |
2964 (if rmail-enable-mime | 3065 (setq rmail-total-messages (rmail-desc-get-count)) |
2965 (with-current-buffer rmail-view-buffer | 3066 (rmail-show-message rmail-current-message t) |
2966 (- (point)(point-min))) | 3067 (if rmail-summary-buffer |
2967 (- (point) (point-min))))) | 3068 (save-excursion |
2968 (messages-head (cons (aref rmail-message-vector 0) nil)) | 3069 (set-buffer rmail-summary-buffer) |
2969 (messages-tail messages-head) | 3070 (rmail-update-summary))) |
2970 ;; Don't make any undo records for the expunging. | 3071 (message "Expunging deleted messages...done")) |
2971 (buffer-undo-list t) | 3072 |
2972 (win)) | 3073 ;;; We'll deal with this later. -pmr |
2973 (unwind-protect | 3074 ;;; (if rmail-enable-mime |
2974 (save-excursion | 3075 ;;; (goto-char (+ (point-min) opoint)) |
2975 (widen) | 3076 ;;; (goto-char (+ (point) opoint)))))) |
2976 (goto-char (point-min)) | 3077 |
2977 (let ((counter 0) | 3078 ;;; mbox: ready |
2978 (number 1) | 3079 (defun rmail-expunge-callback (n) |
2979 (total rmail-total-messages) | 3080 "Called after message N has been pruned to update the current Rmail |
2980 (new-message-number rmail-current-message) | 3081 message counter." |
2981 (new-summary nil) | 3082 (if (< n rmail-current-message) |
2982 (new-msgref (list (list 0))) | 3083 (setq rmail-current-message (1- rmail-current-message)))) |
2983 (rmailbuf (current-buffer)) | 3084 |
2984 (buffer-read-only nil) | 3085 ;;; mbox: ready |
2985 (messages rmail-message-vector) | |
2986 (deleted rmail-deleted-vector) | |
2987 (summary rmail-summary-vector)) | |
2988 (setq rmail-total-messages nil | |
2989 rmail-current-message nil | |
2990 rmail-message-vector nil | |
2991 rmail-deleted-vector nil | |
2992 rmail-summary-vector nil) | |
2993 | |
2994 (while (<= number total) | |
2995 (if (= (aref deleted number) ?D) | |
2996 (progn | |
2997 (delete-region | |
2998 (marker-position (aref messages number)) | |
2999 (marker-position (aref messages (1+ number)))) | |
3000 (move-marker (aref messages number) nil) | |
3001 (if (> new-message-number counter) | |
3002 (setq new-message-number (1- new-message-number)))) | |
3003 (setq counter (1+ counter)) | |
3004 (setq messages-tail | |
3005 (setcdr messages-tail | |
3006 (cons (aref messages number) nil))) | |
3007 (setq new-summary | |
3008 (cons (if (= counter number) (aref summary (1- number))) | |
3009 new-summary)) | |
3010 (setq new-msgref | |
3011 (cons (aref rmail-msgref-vector number) | |
3012 new-msgref)) | |
3013 (setcar (car new-msgref) counter)) | |
3014 (if (zerop (% (setq number (1+ number)) 20)) | |
3015 (message "Expunging deleted messages...%d" number))) | |
3016 (setq messages-tail | |
3017 (setcdr messages-tail | |
3018 (cons (aref messages number) nil))) | |
3019 (setq rmail-current-message new-message-number | |
3020 rmail-total-messages counter | |
3021 rmail-message-vector (apply 'vector messages-head) | |
3022 rmail-deleted-vector (make-string (1+ counter) ?\ ) | |
3023 rmail-summary-vector (vconcat (nreverse new-summary)) | |
3024 rmail-msgref-vector (apply 'vector (nreverse new-msgref)) | |
3025 win t))) | |
3026 (message "Expunging deleted messages...done") | |
3027 (if (not win) | |
3028 (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) | |
3029 (rmail-show-message | |
3030 (if (zerop rmail-current-message) 1 nil)) | |
3031 (if rmail-enable-mime | |
3032 (goto-char (+ (point-min) opoint)) | |
3033 (goto-char (+ (point) opoint)))))) | |
3034 | |
3035 (defun rmail-expunge () | 3086 (defun rmail-expunge () |
3036 "Erase deleted messages from Rmail file and summary buffer." | 3087 "Erase deleted messages from Rmail file and summary buffer." |
3037 (interactive) | 3088 (interactive) |
3038 (when (rmail-expunge-confirmed) | 3089 (when (rmail-expunge-confirmed) |
3039 (rmail-only-expunge) | 3090 (rmail-only-expunge))) |
3040 (if (rmail-summary-exists) | |
3041 (rmail-select-summary (rmail-update-summary))))) | |
3042 | 3091 |
3043 ;;;; *** Rmail Mailing Commands *** | 3092 ;;;; *** Rmail Mailing Commands *** |
3044 | 3093 |
3094 ;;; mbox: In progress. I'm still not happy with the initial citation | |
3095 ;;; stuff. -pmr | |
3045 (defun rmail-start-mail (&optional noerase to subject in-reply-to cc | 3096 (defun rmail-start-mail (&optional noerase to subject in-reply-to cc |
3046 replybuffer sendactions same-window others) | 3097 replybuffer sendactions same-window others) |
3047 (let (yank-action) | 3098 (let (yank-action) |
3048 (if replybuffer | 3099 (if replybuffer |
3049 (setq yank-action (list 'insert-buffer replybuffer))) | 3100 (setq yank-action (list 'insert-buffer replybuffer))) |
3076 (defun rmail-continue () | 3127 (defun rmail-continue () |
3077 "Continue composing outgoing message previously being composed." | 3128 "Continue composing outgoing message previously being composed." |
3078 (interactive) | 3129 (interactive) |
3079 (rmail-start-mail t)) | 3130 (rmail-start-mail t)) |
3080 | 3131 |
3132 ;;; mbox: ready -pmr | |
3081 (defun rmail-reply (just-sender) | 3133 (defun rmail-reply (just-sender) |
3082 "Reply to the current message. | 3134 "Reply to the current message. |
3083 Normally include CC: to all other recipients of original message; | 3135 Normally include CC: to all other recipients of original message; |
3084 prefix argument means ignore them. While composing the reply, | 3136 prefix argument means ignore them. While composing the reply, |
3085 use \\[mail-yank-original] to yank the original message into it." | 3137 use \\[mail-yank-original] to yank the original message into it." |
3086 (interactive "P") | 3138 (interactive "P") |
3087 (let (from reply-to cc subject date to message-id references | 3139 (save-excursion |
3088 resent-to resent-cc resent-reply-to | 3140 (save-restriction |
3089 (msgnum rmail-current-message)) | 3141 (let ((msgnum rmail-current-message) |
3090 (save-excursion | 3142 (display-state (rmail-desc-get-header-display-state rmail-current-message)) |
3091 (save-restriction | 3143 from reply-to cc subject date to message-id references |
3092 (if rmail-enable-mime | 3144 resent-to resent-cc resent-reply-to) |
3093 (narrow-to-region | 3145 (rmail-header-show-headers) |
3094 (goto-char (point-min)) | 3146 (setq from (mail-fetch-field "from") |
3095 (if (search-forward "\n\n" nil 'move) | 3147 reply-to (or (mail-fetch-field "reply-to" nil t) from) |
3096 (1+ (match-beginning 0)) | 3148 cc (and (not just-sender) |
3097 (point))) | 3149 (mail-fetch-field "cc" nil t)) |
3098 (widen) | 3150 subject (mail-fetch-field "subject") |
3099 (goto-char (rmail-msgbeg rmail-current-message)) | 3151 date (mail-fetch-field "date") |
3100 (forward-line 1) | 3152 to (or (mail-fetch-field "to" nil t) "") |
3101 (if (= (following-char) ?0) | 3153 message-id (mail-fetch-field "message-id") |
3102 (narrow-to-region | 3154 references (mail-fetch-field "references" nil nil t) |
3103 (progn (forward-line 2) | 3155 resent-reply-to (mail-fetch-field "resent-reply-to" nil t) |
3104 (point)) | 3156 resent-cc (and (not just-sender) |
3105 (progn (search-forward "\n\n" (rmail-msgend rmail-current-message) | 3157 (mail-fetch-field "resent-cc" nil t)) |
3106 'move) | 3158 resent-to (or (mail-fetch-field "resent-to" nil t) "")) |
3107 (point))) | |
3108 (narrow-to-region (point) | |
3109 (progn (search-forward "\n*** EOOH ***\n") | |
3110 (beginning-of-line) (point))))) | |
3111 (setq from (mail-fetch-field "from") | |
3112 reply-to (or (mail-fetch-field "reply-to" nil t) | |
3113 from) | |
3114 cc (and (not just-sender) | |
3115 (mail-fetch-field "cc" nil t)) | |
3116 subject (mail-fetch-field "subject") | |
3117 date (mail-fetch-field "date") | |
3118 to (or (mail-fetch-field "to" nil t) "") | |
3119 message-id (mail-fetch-field "message-id") | |
3120 references (mail-fetch-field "references" nil nil t) | |
3121 resent-reply-to (mail-fetch-field "resent-reply-to" nil t) | |
3122 resent-cc (and (not just-sender) | |
3123 (mail-fetch-field "resent-cc" nil t)) | |
3124 resent-to (or (mail-fetch-field "resent-to" nil t) "") | |
3125 ;;; resent-subject (mail-fetch-field "resent-subject") | 3159 ;;; resent-subject (mail-fetch-field "resent-subject") |
3126 ;;; resent-date (mail-fetch-field "resent-date") | 3160 ;;; resent-date (mail-fetch-field "resent-date") |
3127 ;;; resent-message-id (mail-fetch-field "resent-message-id") | 3161 ;;; resent-message-id (mail-fetch-field "resent-message-id") |
3128 ))) | 3162 |
3129 ;; Merge the resent-to and resent-cc into the to and cc. | 3163 ;; Merge the resent-to and resent-cc into the to and cc. |
3130 (if (and resent-to (not (equal resent-to ""))) | 3164 (if (and resent-to (not (equal resent-to ""))) |
3131 (if (not (equal to "")) | 3165 (if (not (equal to "")) |
3132 (setq to (concat to ", " resent-to)) | 3166 (setq to (concat to ", " resent-to)) |
3133 (setq to resent-to))) | 3167 (setq to resent-to))) |
3134 (if (and resent-cc (not (equal resent-cc ""))) | 3168 (if (and resent-cc (not (equal resent-cc ""))) |
3135 (if (not (equal cc "")) | 3169 (if (not (equal cc "")) |
3136 (setq cc (concat cc ", " resent-cc)) | 3170 (setq cc (concat cc ", " resent-cc)) |
3137 (setq cc resent-cc))) | 3171 (setq cc resent-cc))) |
3138 ;; Add `Re: ' to subject if not there already. | 3172 ;; Add `Re: ' to subject if not there already. |
3139 (and (stringp subject) | 3173 (and (stringp subject) |
3140 (setq subject | 3174 (setq subject |
3141 (concat rmail-reply-prefix | 3175 (concat rmail-reply-prefix |
3142 (if (let ((case-fold-search t)) | 3176 (if (let ((case-fold-search t)) |
3143 (string-match rmail-reply-regexp subject)) | 3177 (string-match rmail-reply-regexp subject)) |
3144 (substring subject (match-end 0)) | 3178 (substring subject (match-end 0)) |
3145 subject)))) | 3179 subject)))) |
3146 (rmail-start-mail | 3180 ;; Reset the headers display state before switching to the |
3147 nil | 3181 ;; reply buffer. |
3148 ;; Using mail-strip-quoted-names is undesirable with newer mailers | 3182 (rmail-header-toggle-visibility (if display-state 1 0)) |
3149 ;; since they can handle the names unstripped. | 3183 |
3150 ;; I don't know whether there are other mailers that still | 3184 ;; Now setup the mail reply buffer. |
3151 ;; need the names to be stripped. | 3185 (rmail-start-mail |
3152 ;;; (mail-strip-quoted-names reply-to) | 3186 nil |
3153 reply-to | 3187 ;; Using mail-strip-quoted-names is undesirable with newer mailers |
3154 subject | 3188 ;; since they can handle the names unstripped. |
3155 (rmail-make-in-reply-to-field from date message-id) | 3189 ;; I don't know whether there are other mailers that still |
3156 (if just-sender | 3190 ;; need the names to be stripped. |
3157 nil | 3191 (mail-strip-quoted-names reply-to) |
3158 ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to | 3192 subject |
3159 ;; to do its job. | 3193 (rmail-make-in-reply-to-field from date message-id) |
3160 (let* ((cc-list (rmail-dont-reply-to | 3194 (if just-sender |
3161 (mail-strip-quoted-names | 3195 nil |
3162 (if (null cc) to (concat to ", " cc)))))) | 3196 ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to |
3163 (if (string= cc-list "") nil cc-list))) | 3197 ;; to do its job. |
3164 rmail-view-buffer | 3198 (let* ((cc-list (rmail-dont-reply-to |
3165 (list (list 'rmail-mark-message | 3199 (mail-strip-quoted-names |
3166 rmail-buffer | 3200 (if (null cc) to (concat to ", " cc)))))) |
3167 (with-current-buffer rmail-buffer | 3201 (if (string= cc-list "") nil cc-list))) |
3168 (aref rmail-msgref-vector msgnum)) | 3202 rmail-view-buffer |
3169 "answered")) | 3203 (list (list 'rmail-reply-callback rmail-buffer "answered" t msgnum)) |
3170 nil | 3204 nil |
3171 (list (cons "References" (concat (mapconcat 'identity references " ") | 3205 (list (cons "References" (concat (mapconcat 'identity references " ") |
3172 " " message-id)))))) | 3206 " " message-id)))))))) |
3173 | 3207 |
3174 (defun rmail-mark-message (buffer msgnum-list attribute) | 3208 (defun rmail-reply-callback (buffer attr state n) |
3175 "Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE. | 3209 "Mail reply callback function. Sets ATTR (a string) if STATE is |
3176 This is use in the send-actions for message buffers. | 3210 non-nil, otherwise clears it. N is the message number. BUFFER, |
3177 MSGNUM-LIST is a list of the form (MSGNUM) | 3211 possibly narrowed, contains an mbox mail message." |
3178 which is an element of rmail-msgref-vector." | |
3179 (save-excursion | 3212 (save-excursion |
3180 (set-buffer buffer) | 3213 (set-buffer buffer) |
3181 (if (car msgnum-list) | 3214 (rmail-set-attribute attr state n))) |
3182 (rmail-set-attribute attribute t (car msgnum-list))))) | 3215 |
3216 (defun rmail-mark-message (msgnum-list attr-index) | |
3217 "Set the attribute denoted by ATTRIBUTE-INDEX in the message denoted | |
3218 by the car of MSGNUM-LIST. This is used in the send-actions for | |
3219 message buffers. MSGNUM-LIST is a list of the form (MSGNUM)." | |
3220 (save-excursion | |
3221 (let ((n (car msgnum-list))) | |
3222 (set-buffer rmail-buffer) | |
3223 (rmail-narrow-to-message n) | |
3224 (rmail-desc-set-attribute attr-index t n)))) | |
3225 | |
3226 (defun rmail-narrow-to-message (n) | |
3227 "Set the narrowing restriction in the current (rmail) buffer to | |
3228 bracket message N." | |
3229 (widen) | |
3230 (narrow-to-region (rmail-desc-get-start n) (rmail-desc-get-end n))) | |
3183 | 3231 |
3184 (defun rmail-make-in-reply-to-field (from date message-id) | 3232 (defun rmail-make-in-reply-to-field (from date message-id) |
3185 (cond ((not from) | 3233 (cond ((not from) |
3186 (if message-id | 3234 (if message-id |
3187 message-id | 3235 message-id |
3238 (t | 3286 (t |
3239 ;; If we can't kludge it simply, do it correctly | 3287 ;; If we can't kludge it simply, do it correctly |
3240 (let ((mail-use-rfc822 t)) | 3288 (let ((mail-use-rfc822 t)) |
3241 (rmail-make-in-reply-to-field from date message-id))))) | 3289 (rmail-make-in-reply-to-field from date message-id))))) |
3242 | 3290 |
3291 ;;; mbox: ready | |
3243 (defun rmail-forward (resend) | 3292 (defun rmail-forward (resend) |
3244 "Forward the current message to another user. | 3293 "Forward the current message to another user. |
3245 With prefix argument, \"resend\" the message instead of forwarding it; | 3294 With prefix argument, \"resend\" the message instead of forwarding it; |
3246 see the documentation of `rmail-resend'." | 3295 see the documentation of `rmail-resend'." |
3247 (interactive "P") | 3296 (interactive "P") |
3260 (if (rmail-start-mail | 3309 (if (rmail-start-mail |
3261 nil nil subject nil nil nil | 3310 nil nil subject nil nil nil |
3262 (list (list 'rmail-mark-message | 3311 (list (list 'rmail-mark-message |
3263 forward-buffer | 3312 forward-buffer |
3264 (with-current-buffer rmail-buffer | 3313 (with-current-buffer rmail-buffer |
3265 (aref rmail-msgref-vector msgnum)) | 3314 (rmail-desc-get-start msgnum)) |
3266 "forwarded")) | 3315 "forwarded")) |
3267 ;; If only one window, use it for the mail buffer. | 3316 ;; If only one window, use it for the mail buffer. |
3268 ;; Otherwise, use another window for the mail buffer | 3317 ;; Otherwise, use another window for the mail buffer |
3269 ;; so that the Rmail buffer remains visible | 3318 ;; so that the Rmail buffer remains visible |
3270 ;; and sending the mail will get back to it. | 3319 ;; and sending the mail will get back to it. |
3402 "A regexp that matches the separator before the text of a failed message.") | 3451 "A regexp that matches the separator before the text of a failed message.") |
3403 | 3452 |
3404 (defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$" | 3453 (defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$" |
3405 "A regexp that matches the header of a MIME body part with a failed message.") | 3454 "A regexp that matches the header of a MIME body part with a failed message.") |
3406 | 3455 |
3456 ;;; NOT DONE | |
3407 (defun rmail-retry-failure () | 3457 (defun rmail-retry-failure () |
3408 "Edit a mail message which is based on the contents of the current message. | 3458 "Edit a mail message which is based on the contents of the current message. |
3409 For a message rejected by the mail system, extract the interesting headers and | 3459 For a message rejected by the mail system, extract the interesting headers and |
3410 the body of the original message. | 3460 the body of the original message. |
3411 If the failed message is a MIME multipart message, it is searched for a | 3461 If the failed message is a MIME multipart message, it is searched for a |
3751 (setq curmask (lsh curmask -8)) | 3801 (setq curmask (lsh curmask -8)) |
3752 (aset string-vector i (logxor charmask (aref string-vector i))) | 3802 (aset string-vector i (logxor charmask (aref string-vector i))) |
3753 (setq i (1+ i))) | 3803 (setq i (1+ i))) |
3754 (concat string-vector))) | 3804 (concat string-vector))) |
3755 | 3805 |
3756 (provide 'rmail) | 3806 ;;;; Browser related functions |
3807 | |
3808 (defun rmail-activate-urls () | |
3809 "Highlight URLs embedded in the message body." | |
3810 (save-excursion | |
3811 (goto-char (point-min)) | |
3812 (search-forward "\n\n" nil t) | |
3813 (browse-url-activate-urls (point) (point-max) | |
3814 'bold 'bold-italic 'highlight rmail-url-map))) | |
3815 | |
3816 ;;; mbox: not ready, there is a bug here which I don't | |
3817 ;;; understand. When invoked with the summary buffer as the current | |
3818 ;;; buffer, the save-excursion does not seem to work. -pmr | |
3819 (defun rmail-visit-url-at-mouse (event) | |
3820 "Visit the URL underneath the mouse." | |
3821 (interactive "e") | |
3822 (save-window-excursion | |
3823 | |
3824 ;; Determine if the function has been invoked from a summary | |
3825 ;; buffer. | |
3826 (if (eq major-mode 'rmail-summary-mode) | |
3827 | |
3828 ;; It has. DTRT. | |
3829 (progn | |
3830 (set-buffer rmail-buffer) | |
3831 (save-excursion | |
3832 (browse-url-at-mouse event) | |
3833 (rmail-show-message rmail-current-message)) | |
3834 (switch-to-buffer rmail-summary-buffer)) | |
3835 | |
3836 ;; The function has been invoked from an Rmail buffer. Visit the | |
3837 ;; URL and then repaint the current message to reflect a visited | |
3838 ;; URL. | |
3839 (browse-url-at-mouse event) | |
3840 (rmail-show-message rmail-current-message)))) | |
3841 | |
3842 (defun rmail-visit-url-at-point () | |
3843 "Visit the URL at point." | |
3844 (interactive) | |
3845 (save-excursion | |
3846 | |
3847 ;; Visit the URL and then repaint the current message to reflect a | |
3848 ;; visited URL. | |
3849 (browse-url-at-point) | |
3850 (rmail-show-message rmail-current-message))) | |
3851 | |
3852 (defun rmail-browse-body () | |
3853 "Send the message body to a browser to be rendered." | |
3854 (interactive) | |
3855 (save-excursion | |
3856 (save-restriction | |
3857 (goto-char (point-min)) | |
3858 (search-forward "\n\n" (point-max) t) | |
3859 (narrow-to-region (point) (point-max)) | |
3860 (browse-url-of-buffer)))) | |
3861 | |
3862 ;;; New functions that need better placement. | |
3863 (defun rmail-get-sender () | |
3864 "Return the message sender. | |
3865 The current buffer (possibly narrowed) contains a single message." | |
3866 (save-excursion | |
3867 (goto-char (point-min)) | |
3868 (if (not (re-search-forward "^From:[ \t]*" nil t)) | |
3869 " " | |
3870 (let* ((from (mail-strip-quoted-names | |
3871 (buffer-substring | |
3872 (1- (point)) | |
3873 ;; Get all the lines of the From field | |
3874 ;; so that we get a whole comment if there is one, | |
3875 ;; so that mail-strip-quoted-names can discard it. | |
3876 (let ((opoint (point))) | |
3877 (while (progn (forward-line 1) | |
3878 (looking-at "[ \t]"))) | |
3879 ;; Back up over newline, then trailing spaces or tabs | |
3880 (forward-char -1) | |
3881 (skip-chars-backward " \t") | |
3882 (point))))) | |
3883 len mch lo) | |
3884 (if (string-match (concat "^\\(" | |
3885 (regexp-quote (user-login-name)) | |
3886 "\\($\\|@\\)\\|" | |
3887 (regexp-quote | |
3888 ;; Don't lose if run from init file | |
3889 ;; where user-mail-address is not | |
3890 ;; set yet. | |
3891 (or user-mail-address | |
3892 (concat (user-login-name) "@" | |
3893 (or mail-host-address | |
3894 (system-name))))) | |
3895 "\\>\\)") | |
3896 from) | |
3897 (save-excursion | |
3898 (goto-char (point-min)) | |
3899 (if (not (re-search-forward "^To:[ \t]*" nil t)) | |
3900 nil | |
3901 (setq from | |
3902 (concat "to: " | |
3903 (mail-strip-quoted-names | |
3904 (buffer-substring | |
3905 (point) | |
3906 (progn (end-of-line) | |
3907 (skip-chars-backward " \t") | |
3908 (point))))))))) | |
3909 (setq len (length from)) | |
3910 (setq mch (string-match "[@%]" from)) | |
3911 (format "%25s" | |
3912 (if (or (not mch) (<= len 25)) | |
3913 (substring from (max 0 (- len 25))) | |
3914 (substring from | |
3915 (setq lo (cond ((< (- mch 14) 0) 0) | |
3916 ((< len (+ mch 11)) | |
3917 (- len 25)) | |
3918 (t (- mch 14)))) | |
3919 (min len (+ lo 25))))))))) | |
3920 | |
3757 | 3921 |
3758 ;;; rmail.el ends here | 3922 ;;; rmail.el ends here |