38 |
;; buffers, summary by topic or by regular expression, rmail-reply-prefix |
;; buffers, summary by topic or by regular expression, rmail-reply-prefix |
39 |
;; variable, and a bury rmail buffer (wipe) command. |
;; variable, and a bury rmail buffer (wipe) command. |
40 |
;; |
;; |
41 |
|
(provide 'rmail) |
42 |
|
|
43 |
(require 'mail-utils) |
(eval-when-compile |
44 |
(eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority |
(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)) |
54 |
|
|
55 |
; These variables now declared in paths.el. |
; These variables now declared in paths.el. |
56 |
;(defvar rmail-spool-directory "/usr/spool/mail/" |
;(defvar rmail-spool-directory "/usr/spool/mail/" |
101 |
:prefix "rmail-edit-" |
:prefix "rmail-edit-" |
102 |
:group 'rmail) |
:group 'rmail) |
103 |
|
|
|
|
|
104 |
(defcustom rmail-movemail-program nil |
(defcustom rmail-movemail-program nil |
105 |
"If non-nil, name of program for fetching new mail." |
"If non-nil, name of program for fetching new mail." |
106 |
:group 'rmail-retrieve |
:group 'rmail-retrieve |
157 |
|
|
158 |
;;;###autoload |
;;;###autoload |
159 |
(defcustom rmail-ignored-headers |
(defcustom rmail-ignored-headers |
160 |
(concat "^via:\\|^mail-from:\\|^origin:\\|^references:" |
(concat "^via:\\|^from \\|^origin:\\|^references:" |
161 |
"\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" |
"\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" |
162 |
"\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" |
"\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" |
163 |
"\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" |
"\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:" |
170 |
"\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" |
"\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:" |
171 |
"\\|^content-type:\\|^content-length:" |
"\\|^content-type:\\|^content-length:" |
172 |
"\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:" |
"\\|^x-attribution:\\|^x-disclaimer:\\|^x-trace:" |
173 |
"\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent" |
"\\|^x-complaints-to:\\|^nntp-posting-date:\\|^user-agent:" |
174 |
"\\|^importance:\\|^envelope-to:\\|^delivery-date" |
"\\|^x-importance:\\|^envelope-to:\\|^delivery-date:" |
175 |
"\\|^x.*-priority:\\|^x-mimeole:") |
"\\|^x-importance:\\|^envelope-to:\\|^delivery-date:" |
176 |
|
"\\|^x-*-priority:\\|x-mimeole:" |
177 |
|
"\\|^x-babyl-v6-attributes:\\|x-babyl-v6-keywords:") |
178 |
"*Regexp to match header fields that Rmail should normally hide. |
"*Regexp to match header fields that Rmail should normally hide. |
179 |
This variable is used for reformatting the message header, |
This variable is used for reformatting the message header, |
180 |
which normally happens once for each message, |
which normally happens once for each message, |
186 |
:group 'rmail-headers) |
:group 'rmail-headers) |
187 |
|
|
188 |
;;;###autoload |
;;;###autoload |
189 |
(defcustom rmail-displayed-headers nil |
(defcustom rmail-displayed-headers "\ |
190 |
|
^\\(to\\|from\\|sender\\|cc\\|date\\|subject\\|reply-to\\):[ \t]+" |
191 |
"*Regexp to match Header fields that Rmail should display. |
"*Regexp to match Header fields that Rmail should display. |
192 |
If nil, display all header fields except those matched by |
If nil, display all header fields except those matched by |
193 |
`rmail-ignored-headers'." |
`rmail-ignored-headers'." |
310 |
|
|
311 |
(FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... ) |
(FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... ) |
312 |
|
|
313 |
Where FOLDERNAME is the name of a BABYL format folder to put the |
Where FOLDERNAME is the name of a BABYL Version 6 (also known as mbox |
314 |
message. If any of the field regexp's are nil, then it is ignored. |
or Unix inbox format) folder to put the message. If any of the field |
315 |
|
regexp's are nil, then it is ignored. |
316 |
|
|
317 |
If FOLDERNAME is \"/dev/null\", it is deleted. |
If FOLDERNAME is \"/dev/null\", it is deleted. |
318 |
If FOLDERNAME is nil then it is deleted, and skipped. |
If FOLDERNAME is nil then it is deleted, and skipped. |
364 |
(defvar rmail-total-messages nil) |
(defvar rmail-total-messages nil) |
365 |
(put 'rmail-total-messages 'permanent-local t) |
(put 'rmail-total-messages 'permanent-local t) |
366 |
|
|
367 |
|
;;; mbox: deprecated. -pmr |
368 |
(defvar rmail-message-vector nil) |
(defvar rmail-message-vector nil) |
369 |
(put 'rmail-message-vector 'permanent-local t) |
(put 'rmail-message-vector 'permanent-local t) |
370 |
|
|
371 |
|
;;; mbox: deprecated. -pmr |
372 |
(defvar rmail-deleted-vector nil) |
(defvar rmail-deleted-vector nil) |
373 |
(put 'rmail-deleted-vector 'permanent-local t) |
(put 'rmail-deleted-vector 'permanent-local t) |
374 |
|
|
375 |
|
;; mbox: deprecated. -pmr |
376 |
(defvar rmail-msgref-vector nil |
(defvar rmail-msgref-vector nil |
377 |
"In an Rmail buffer, a vector whose Nth element is a list (N). |
"In an Rmail buffer, a vector whose Nth element is a list (N). |
378 |
When expunging renumbers messages, these lists are modified |
When expunging renumbers messages, these lists are modified |
409 |
"*Default file name for \\[rmail-output]." |
"*Default file name for \\[rmail-output]." |
410 |
:type 'file |
:type 'file |
411 |
:group 'rmail-files) |
:group 'rmail-files) |
412 |
|
|
413 |
(defcustom rmail-default-rmail-file "~/XMAIL" |
(defcustom rmail-default-rmail-file "~/XMAIL" |
414 |
"*Default file name for \\[rmail-output-to-rmail-file]." |
"*Default file name for \\[rmail-output-to-rmail-file]." |
415 |
:type 'file |
:type 'file |
416 |
:group 'rmail-files) |
:group 'rmail-files) |
417 |
|
|
418 |
(defcustom rmail-default-body-file "~/mailout" |
(defcustom rmail-default-body-file "~/mailout" |
419 |
"*Default file name for \\[rmail-output-body-to-file]." |
"*Default file name for \\[rmail-output-body-to-file]." |
420 |
:type 'file |
:type 'file |
506 |
|
|
507 |
|
|
508 |
;;; Regexp matching the delimiter of messages in UNIX mail format |
;;; Regexp matching the delimiter of messages in UNIX mail format |
509 |
;;; (UNIX From lines), minus the initial ^. Note that if you change |
;;; (UNIX From lines), with an initial ^. Used in rmail-decode-from-line, |
510 |
;;; this expression, you must change the code in rmail-nuke-pinhead-header |
;;; which knows the exact ordering of the \\(...\\) subexpressions. |
|
;;; that knows the exact ordering of the \\( \\) subexpressions. |
|
511 |
(defvar rmail-unix-mail-delimiter |
(defvar rmail-unix-mail-delimiter |
512 |
(let ((time-zone-regexp |
(let ((time-zone-regexp |
513 |
(concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" |
(concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" |
515 |
"\\|" |
"\\|" |
516 |
"\\) *"))) |
"\\) *"))) |
517 |
(concat |
(concat |
518 |
"From " |
"^From " |
519 |
|
|
520 |
;; Many things can happen to an RFC 822 mailbox before it is put into |
;; Many things can happen to an RFC 822 mailbox before it is put into |
521 |
;; a `From' line. The leading phrase can be stripped, e.g. |
;; a `From' line. The leading phrase can be stripped, e.g. |
566 |
(let* ((cite-chars "[>|}]") |
(let* ((cite-chars "[>|}]") |
567 |
(cite-prefix "a-z") |
(cite-prefix "a-z") |
568 |
(cite-suffix (concat cite-prefix "0-9_.@-`'\""))) |
(cite-suffix (concat cite-prefix "0-9_.@-`'\""))) |
569 |
(list '("^\\(From\\|Sender\\|Resent-From\\):" |
(list '("^\\(From\\|Sender\\|Resent-[Ff]rom\\):" |
570 |
. font-lock-function-name-face) |
. font-lock-function-name-face) |
571 |
'("^Reply-To:.*$" . font-lock-function-name-face) |
'("^Reply-To:.*$" . font-lock-function-name-face) |
572 |
'("^Subject:" . font-lock-comment-face) |
'("^Subject:" . font-lock-comment-face) |
573 |
'("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):" |
'("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):" |
581 |
(beginning-of-line) (end-of-line) |
(beginning-of-line) (end-of-line) |
582 |
(2 font-lock-constant-face nil t) |
(2 font-lock-constant-face nil t) |
583 |
(4 font-lock-comment-face nil t))) |
(4 font-lock-comment-face nil t))) |
584 |
'("^\\(X-[a-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$" |
'("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$" |
585 |
. font-lock-string-face)))) |
. font-lock-string-face)))) |
586 |
"Additional expressions to highlight in Rmail mode.") |
"Additional expressions to highlight in Rmail mode.") |
587 |
|
|
615 |
|
|
616 |
(defvar rmail-enable-multibyte nil) |
(defvar rmail-enable-multibyte nil) |
617 |
|
|
618 |
|
;;; mbox don't care |
619 |
(defun rmail-require-mime-maybe () |
(defun rmail-require-mime-maybe () |
620 |
"Require `rmail-mime-feature' if that is non-nil. |
"Require `rmail-mime-feature' if that is non-nil. |
621 |
Signal an error and set `rmail-mime-feature' to nil if the feature |
Signal an error and set `rmail-mime-feature' to nil if the feature |
629 |
(setq rmail-enable-mime nil))))) |
(setq rmail-enable-mime nil))))) |
630 |
|
|
631 |
|
|
632 |
|
;;; mbox ready |
633 |
;;;###autoload |
;;;###autoload |
634 |
(defun rmail (&optional file-name-arg) |
(defun rmail (&optional file-name-arg) |
635 |
"Read and edit incoming mail. |
"Read and edit incoming mail. |
692 |
(setq run-mail-hook t) |
(setq run-mail-hook t) |
693 |
(rmail-mode-2) |
(rmail-mode-2) |
694 |
;; Convert all or part to Babyl file if possible. |
;; Convert all or part to Babyl file if possible. |
695 |
(rmail-convert-file) |
;;; (rmail-convert-file) |
696 |
(goto-char (point-max))) |
(goto-char (point-max))) |
697 |
;; As we have read a file by raw-text, the buffer is set to |
;; As we have read a file by raw-text, the buffer is set to |
698 |
;; unibyte. We must make it multibyte if necessary. |
;; unibyte. We must make it multibyte if necessary. |
699 |
(if (and rmail-enable-multibyte |
(if (and rmail-enable-multibyte |
700 |
(not enable-multibyte-characters)) |
(not enable-multibyte-characters)) |
701 |
(set-buffer-multibyte t)) |
(set-buffer-multibyte t)) |
702 |
;; If necessary, scan to find all the messages. |
|
703 |
(rmail-maybe-set-message-counters) |
;; Initialize the Rmail state and process any messages in the buffer. |
704 |
(unwind-protect |
(rmail-initialize-messages) |
705 |
(unless (and (not file-name-arg) |
|
706 |
(rmail-get-new-mail)) |
;; Get new mail only if there is no explicit file argument. |
707 |
(rmail-show-message (rmail-first-unseen-message))) |
(and (not file-name-arg) (rmail-get-new-mail)) |
708 |
(progn |
|
709 |
(if rmail-display-summary (rmail-summary)) |
;; Deal with the summary display. |
710 |
(rmail-construct-io-menu) |
(if rmail-display-summary (rmail-summary)) |
711 |
(if run-mail-hook |
|
712 |
(run-hooks 'rmail-mode-hook)))))) |
;; 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)))) |
723 |
|
|
724 |
;; Given the value of MAILPATH, return a list of inbox file names. |
;; Given the value of MAILPATH, return a list of inbox file names. |
725 |
;; This is turned off because it is not clear that the user wants |
;; This is turned off because it is not clear that the user wants |
740 |
|
|
741 |
;; This calls rmail-decode-babyl-format if the file is already Babyl. |
;; This calls rmail-decode-babyl-format if the file is already Babyl. |
742 |
|
|
743 |
|
;;; mbox: DEPECATED |
744 |
(defun rmail-convert-file () |
(defun rmail-convert-file () |
745 |
(let (convert) |
(let (convert) |
746 |
(widen) |
(widen) |
785 |
;; We still have to decode BABYL part. |
;; We still have to decode BABYL part. |
786 |
(rmail-decode-babyl-format))))) |
(rmail-decode-babyl-format))))) |
787 |
|
|
788 |
|
;;;###deprecated |
789 |
(defun rmail-insert-rmail-file-header () |
(defun rmail-insert-rmail-file-header () |
790 |
(let ((buffer-read-only nil)) |
(let ((buffer-read-only nil) |
791 |
;; -*-rmail-*- is here so that visiting the file normally |
(header-line "X-BABYL: -*-rmail-*-")) |
792 |
;; recognizes it as an Rmail file. |
;; Determine if the header has already been inserted. |
793 |
(insert "BABYL OPTIONS: -*- rmail -*- |
(goto-char (point-min)) |
794 |
Version: 5 |
(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 |
800 |
Labels: |
Labels: |
801 |
Note: This is the header of an rmail file. |
Note: This is the header of an rmail file. |
802 |
Note: If you are seeing it in rmail, |
Note: If you are seeing it in rmail, |
803 |
Note: it means the file has no messages in it.\n\^_"))) |
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))) |
814 |
|
|
815 |
;; Decode Babyl formatted part at the head of current buffer by |
;; Decode Babyl formatted part at the head of current buffer by |
816 |
;; rmail-file-coding-system, or if it is nil, do auto conversion. |
;; rmail-file-coding-system, or if it is nil, do auto conversion. |
850 |
(or coding-system 'undecided)))) |
(or coding-system 'undecided)))) |
851 |
|
|
852 |
(defvar rmail-mode-map nil) |
(defvar rmail-mode-map nil) |
853 |
|
(defvar rmail-url-map nil) |
854 |
(if rmail-mode-map |
(if rmail-mode-map |
855 |
nil |
nil |
856 |
(setq rmail-mode-map (make-keymap)) |
(setq rmail-mode-map (make-keymap)) |
857 |
(suppress-keymap rmail-mode-map) |
(suppress-keymap rmail-mode-map) |
858 |
(define-key rmail-mode-map "a" 'rmail-add-label) |
(define-key rmail-mode-map "a" 'rmail-add-label) |
859 |
(define-key rmail-mode-map "b" 'rmail-bury) |
(define-key rmail-mode-map "b" 'rmail-bury) |
860 |
|
(define-key rmail-mode-map "B" 'rmail-browse-body) |
861 |
(define-key rmail-mode-map "c" 'rmail-continue) |
(define-key rmail-mode-map "c" 'rmail-continue) |
862 |
(define-key rmail-mode-map "d" 'rmail-delete-forward) |
(define-key rmail-mode-map "d" 'rmail-delete-forward) |
863 |
(define-key rmail-mode-map "\C-d" 'rmail-delete-backward) |
(define-key rmail-mode-map "\C-d" 'rmail-delete-backward) |
866 |
(define-key rmail-mode-map "g" 'rmail-get-new-mail) |
(define-key rmail-mode-map "g" 'rmail-get-new-mail) |
867 |
(define-key rmail-mode-map "h" 'rmail-summary) |
(define-key rmail-mode-map "h" 'rmail-summary) |
868 |
(define-key rmail-mode-map "i" 'rmail-input) |
(define-key rmail-mode-map "i" 'rmail-input) |
869 |
(define-key rmail-mode-map "j" 'rmail-show-message) |
(define-key rmail-mode-map "j" 'rmail-message) |
870 |
(define-key rmail-mode-map "k" 'rmail-kill-label) |
(define-key rmail-mode-map "k" 'rmail-kill-label) |
871 |
(define-key rmail-mode-map "l" 'rmail-summary-by-labels) |
(define-key rmail-mode-map "l" 'rmail-summary-by-labels) |
872 |
(define-key rmail-mode-map "\e\C-h" 'rmail-summary) |
(define-key rmail-mode-map "\e\C-h" 'rmail-summary) |
879 |
(define-key rmail-mode-map "n" 'rmail-next-undeleted-message) |
(define-key rmail-mode-map "n" 'rmail-next-undeleted-message) |
880 |
(define-key rmail-mode-map "\en" 'rmail-next-message) |
(define-key rmail-mode-map "\en" 'rmail-next-message) |
881 |
(define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message) |
(define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message) |
882 |
(define-key rmail-mode-map "o" 'rmail-output-to-rmail-file) |
(define-key rmail-mode-map "o" 'rmail-output) |
883 |
(define-key rmail-mode-map "\C-o" 'rmail-output) |
(define-key rmail-mode-map "\C-o" 'rmail-output) |
884 |
(define-key rmail-mode-map "p" 'rmail-previous-undeleted-message) |
(define-key rmail-mode-map "p" 'rmail-previous-undeleted-message) |
885 |
(define-key rmail-mode-map "\ep" 'rmail-previous-message) |
(define-key rmail-mode-map "\ep" 'rmail-previous-message) |
909 |
(define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels) |
(define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-labels) |
910 |
(define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject) |
(define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject) |
911 |
(define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject) |
(define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject) |
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)) |
919 |
|
|
920 |
(define-key rmail-mode-map [menu-bar] (make-sparse-keymap)) |
(define-key rmail-mode-map [menu-bar] (make-sparse-keymap)) |
921 |
|
|
935 |
'("Output (inbox)..." . rmail-output)) |
'("Output (inbox)..." . rmail-output)) |
936 |
|
|
937 |
(define-key rmail-mode-map [menu-bar classify output] |
(define-key rmail-mode-map [menu-bar classify output] |
938 |
'("Output (Rmail)..." . rmail-output-to-rmail-file)) |
'("Output (Rmail)..." . rmail-output)) |
939 |
|
|
940 |
(define-key rmail-mode-map [menu-bar classify kill-label] |
(define-key rmail-mode-map [menu-bar classify kill-label] |
941 |
'("Kill Label..." . rmail-kill-label)) |
'("Kill Label..." . rmail-kill-label)) |
1206 |
(progn |
(progn |
1207 |
(set-buffer rmail-buffer) |
(set-buffer rmail-buffer) |
1208 |
(rmail-mode-2) |
(rmail-mode-2) |
1209 |
;; Convert all or part to Babyl file if possible. |
|
|
(rmail-convert-file) |
|
1210 |
;; We have read the file as raw-text, so the buffer is set to |
;; We have read the file as raw-text, so the buffer is set to |
1211 |
;; unibyte. Make it multibyte if necessary. |
;; unibyte. Make it multibyte if necessary. |
1212 |
(if (and rmail-enable-multibyte |
(if (and rmail-enable-multibyte |
1213 |
(not enable-multibyte-characters)) |
(not enable-multibyte-characters)) |
1214 |
(set-buffer-multibyte t)) |
(set-buffer-multibyte t)) |
1215 |
(goto-char (point-max)) |
(rmail-initialize-messages) |
|
(rmail-set-message-counters) |
|
1216 |
(rmail-show-message rmail-total-messages) |
(rmail-show-message rmail-total-messages) |
1217 |
(run-hooks 'rmail-mode-hook))))) |
(run-hooks 'rmail-mode-hook))))) |
1218 |
|
|
1219 |
|
;; NOT DONE |
1220 |
;; Return a list of files from this buffer's Mail: option. |
;; Return a list of files from this buffer's Mail: option. |
1221 |
;; Does not assume that messages have been parsed. |
;; Does not assume that messages have been parsed. |
1222 |
;; Just returns nil if buffer does not look like Babyl format. |
;; Just returns nil if buffer does not look like Babyl format. |
1235 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1236 |
(mail-parse-comma-list)))))))) |
(mail-parse-comma-list)))))))) |
1237 |
|
|
1238 |
|
;;; mbox: ready |
1239 |
(defun rmail-expunge-and-save () |
(defun rmail-expunge-and-save () |
1240 |
"Expunge and save RMAIL file." |
"Expunge and save RMAIL file." |
1241 |
(interactive) |
(interactive) |
1242 |
(rmail-expunge) |
(rmail-expunge) |
|
(set-buffer rmail-buffer) |
|
1243 |
(save-buffer) |
(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." |
1249 |
(if (rmail-summary-exists) |
(if (rmail-summary-exists) |
1250 |
(rmail-select-summary (set-buffer-modified-p nil)))) |
(let ((current-message rmail-current-message)) |
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 |
1257 |
(defun rmail-quit () |
(defun rmail-quit () |
1258 |
"Quit out of RMAIL. |
"Quit out of RMAIL. |
1259 |
Hook `rmail-quit-hook' is run after expunging." |
Hook `rmail-quit-hook' is run after expunging." |
1277 |
(quit-window) |
(quit-window) |
1278 |
(replace-buffer-in-windows obuf)))) |
(replace-buffer-in-windows obuf)))) |
1279 |
|
|
1280 |
|
;;; mbox: ready |
1281 |
(defun rmail-bury () |
(defun rmail-bury () |
1282 |
"Bury current Rmail buffer and its summary buffer." |
"Bury current Rmail buffer and its summary buffer." |
1283 |
(interactive) |
(interactive) |
1291 |
(bury-buffer rmail-summary-buffer))) |
(bury-buffer rmail-summary-buffer))) |
1292 |
(quit-window))) |
(quit-window))) |
1293 |
|
|
1294 |
|
;;; mbox: not ready |
1295 |
(defun rmail-duplicate-message () |
(defun rmail-duplicate-message () |
1296 |
"Create a duplicated copy of the current message. |
"Create a duplicated copy of the current message. |
1297 |
The duplicate copy goes into the Rmail file just after the |
The duplicate copy goes into the Rmail file just after the |
1300 |
(widen) |
(widen) |
1301 |
(let ((buffer-read-only nil) |
(let ((buffer-read-only nil) |
1302 |
(number rmail-current-message) |
(number rmail-current-message) |
1303 |
(string (buffer-substring (rmail-msgbeg rmail-current-message) |
(string (buffer-substring (rmail-desc-get-start rmail-current-message) |
1304 |
(rmail-msgend rmail-current-message)))) |
(rmail-desc-get-end rmail-current-message)))) |
1305 |
(goto-char (rmail-msgend rmail-current-message)) |
(goto-char (rmail-desc-get-end rmail-current-message)) |
1306 |
(insert string) |
(insert string) |
1307 |
(rmail-forget-messages) |
(rmail-forget-messages) |
1308 |
(rmail-show-message number) |
(rmail-show-message number) |
1375 |
(cons "Output Rmail File" |
(cons "Output Rmail File" |
1376 |
(rmail-list-to-menu "Output Rmail File" |
(rmail-list-to-menu "Output Rmail File" |
1377 |
files |
files |
1378 |
'rmail-output-to-rmail-file)))) |
'rmail-output)))) |
1379 |
|
|
1380 |
(define-key rmail-mode-map [menu-bar classify input-menu] |
(define-key rmail-mode-map [menu-bar classify input-menu] |
1381 |
'("Input Rmail File" . rmail-disable-menu)) |
'("Input Rmail File" . rmail-disable-menu)) |
1388 |
;; RLK feature not added in this version: |
;; RLK feature not added in this version: |
1389 |
;; argument specifies inbox file or files in various ways. |
;; argument specifies inbox file or files in various ways. |
1390 |
|
|
1391 |
|
;;; DOC NOT DONE |
1392 |
(defun rmail-get-new-mail (&optional file-name) |
(defun rmail-get-new-mail (&optional file-name) |
1393 |
"Move any new mail from this RMAIL file's inbox files. |
"Move any new mail from this RMAIL file's inbox files. |
1394 |
The inbox files can be specified with the file's Mail: option. The |
The inbox files can be specified with the file's Mail: option. The |
1415 |
(or (verify-visited-file-modtime (current-buffer)) |
(or (verify-visited-file-modtime (current-buffer)) |
1416 |
(find-file (buffer-file-name))) |
(find-file (buffer-file-name))) |
1417 |
(set-buffer rmail-buffer) |
(set-buffer rmail-buffer) |
|
(rmail-maybe-set-message-counters) |
|
1418 |
(widen) |
(widen) |
1419 |
;; Get rid of all undo records for this buffer. |
;; Get rid of all undo records for this buffer. |
1420 |
(or (eq buffer-undo-list t) |
(or (eq buffer-undo-list t) |
1422 |
(let ((all-files (if file-name (list file-name) |
(let ((all-files (if file-name (list file-name) |
1423 |
rmail-inbox-list)) |
rmail-inbox-list)) |
1424 |
(rmail-enable-multibyte (default-value 'enable-multibyte-characters)) |
(rmail-enable-multibyte (default-value 'enable-multibyte-characters)) |
1425 |
found) |
found current-message) |
1426 |
(unwind-protect |
(unwind-protect |
1427 |
(progn |
(progn |
1428 |
(while all-files |
(while all-files |
1435 |
(buffer-read-only nil) |
(buffer-read-only nil) |
1436 |
;; Don't make undo records for what we do in getting mail. |
;; Don't make undo records for what we do in getting mail. |
1437 |
(buffer-undo-list t) |
(buffer-undo-list t) |
|
success |
|
1438 |
;; Files to insert this time around. |
;; Files to insert this time around. |
1439 |
files |
files |
1440 |
;; Last names of those files. |
;; Last names of those files. |
1453 |
;; Put them back in their original order. |
;; Put them back in their original order. |
1454 |
(setq files (nreverse files)) |
(setq files (nreverse files)) |
1455 |
|
|
|
(goto-char (point-max)) |
|
|
(skip-chars-backward " \t\n") ; just in case of brain damage |
|
|
(delete-region (point) (point-max)) ; caused by require-final-newline |
|
1456 |
(save-excursion |
(save-excursion |
1457 |
(save-restriction |
(save-restriction |
1458 |
|
(goto-char (point-max)) |
1459 |
(narrow-to-region (point) (point)) |
(narrow-to-region (point) (point)) |
1460 |
;; Read in the contents of the inbox files, |
;; Read in the contents of the inbox files, |
1461 |
;; renaming them as necessary, |
;; renaming them as necessary, |
1463 |
(if file-name |
(if file-name |
1464 |
(rmail-insert-inbox-text files nil) |
(rmail-insert-inbox-text files nil) |
1465 |
(setq delete-files (rmail-insert-inbox-text files t))) |
(setq delete-files (rmail-insert-inbox-text files t))) |
1466 |
;; Scan the new text and convert each message to babyl format. |
(unless (equal (point-min) (point-max)) |
1467 |
(goto-char (point-min)) |
(setq new-messages (rmail-process-new-messages) |
1468 |
(unwind-protect |
rmail-current-message (1+ rmail-total-messages) |
1469 |
(save-excursion |
rmail-total-messages (rmail-desc-get-count)) |
1470 |
(setq new-messages (rmail-convert-to-babyl-format) |
(run-hooks 'rmail-get-new-mail-hook) |
1471 |
success t)) |
(save-buffer)) |
1472 |
;; Try to delete the garbage just inserted. |
;; Delete the old files, now that the RMAIL file is saved. |
|
(or success (delete-region (point-min) (point-max))) |
|
|
;; If we could not convert the file's inboxes, |
|
|
;; rename the files we tried to read |
|
|
;; so we won't over and over again. |
|
|
(if (and (not file-name) (not success)) |
|
|
(let ((delfiles delete-files) |
|
|
(count 0)) |
|
|
(while delfiles |
|
|
(while (file-exists-p (format "RMAILOSE.%d" count)) |
|
|
(setq count (1+ count))) |
|
|
(rename-file (car delfiles) |
|
|
(format "RMAILOSE.%d" count)) |
|
|
(setq delfiles (cdr delfiles)))))) |
|
|
(or (zerop new-messages) |
|
|
(let (success) |
|
|
(widen) |
|
|
(search-backward "\n\^_" nil t) |
|
|
(narrow-to-region (point) (point-max)) |
|
|
(goto-char (1+ (point-min))) |
|
|
(rmail-count-new-messages) |
|
|
(run-hooks 'rmail-get-new-mail-hook) |
|
|
(save-buffer))) |
|
|
;; Delete the old files, now that babyl file is saved. |
|
1473 |
(while delete-files |
(while delete-files |
1474 |
(condition-case () |
(condition-case () |
1475 |
;; First, try deleting. |
;; First, try deleting. |
1484 |
(progn (goto-char opoint) |
(progn (goto-char opoint) |
1485 |
(if (or file-name rmail-inbox-list) |
(if (or file-name rmail-inbox-list) |
1486 |
(message "(No new mail has arrived)"))) |
(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)) |
1491 |
(if (rmail-summary-exists) |
(if (rmail-summary-exists) |
1492 |
(rmail-select-summary |
(with-current-buffer rmail-summary-buffer |
1493 |
(rmail-update-summary))) |
(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) |
1497 |
(message "%d new message%s read" |
(message "%d new message%s read" |
1498 |
new-messages (if (= 1 new-messages) "" "s")) |
new-messages (if (= 1 new-messages) "" "s")) |
|
;; Move to the first new message |
|
|
;; unless we have other unseen messages before it. |
|
|
(rmail-show-message (rmail-first-unseen-message)) |
|
|
(run-hooks 'rmail-after-get-new-mail-hook) |
|
1499 |
(setq found t)))) |
(setq found t)))) |
1500 |
found) |
found) |
1501 |
;; Don't leave the buffer screwed up if we get a disk-full error. |
;; Don't leave the buffer screwed up if we get a disk-full error. |
1658 |
(decode-coding-region from to coding)) |
(decode-coding-region from to coding)) |
1659 |
|
|
1660 |
;; the rmail-break-forwarded-messages feature is not implemented |
;; the rmail-break-forwarded-messages feature is not implemented |
1661 |
|
;;; NOT DONE but not called any more |
1662 |
(defun rmail-convert-to-babyl-format () |
(defun rmail-convert-to-babyl-format () |
1663 |
(let ((count 0) start |
(let ((count 0) start |
1664 |
(case-fold-search nil) |
(case-fold-search nil) |
1787 |
(message "Ignoring invalid Content-Length field") |
(message "Ignoring invalid Content-Length field") |
1788 |
(sit-for 1 0 t))) |
(sit-for 1 0 t))) |
1789 |
(if (let ((case-fold-search nil)) |
(if (let ((case-fold-search nil)) |
1790 |
(re-search-forward |
(re-search-forward |
1791 |
(concat "^[\^_]?\\(" |
(concat "^[\^_]?\\(" |
1792 |
rmail-unix-mail-delimiter |
rmail-unix-mail-delimiter |
1793 |
"\\|" |
"\\|" |
1794 |
rmail-mmdf-delim1 "\\|" |
rmail-mmdf-delim1 "\\|" |
1795 |
"^BABYL OPTIONS:\\|" |
"^BABYL OPTIONS:\\|" |
1796 |
"\^L\n[01],\\)") nil t)) |
"\^L\n[01],\\)") nil t)) |
1797 |
(goto-char (match-beginning 1)) |
(goto-char (match-beginning 1)) |
1798 |
(goto-char (point-max))) |
(goto-char (point-max))) |
1799 |
(setq count (1+ count)) |
(setq count (1+ count)) |
1800 |
(if quoted-printable-header-field-end |
(if quoted-printable-header-field-end |
1882 |
(t |
(t |
1883 |
(message "Malformed MIME quoted-printable message"))))) |
(message "Malformed MIME quoted-printable message"))))) |
1884 |
|
|
1885 |
|
;;; DEPRECATED -pmr |
1886 |
;; Delete the "From ..." line, creating various other headers with |
;; Delete the "From ..." line, creating various other headers with |
1887 |
;; information from it if they don't already exist. Now puts the |
;; information from it if they don't already exist. Now puts the |
1888 |
;; original line into a mail-from: header line for debugging and for |
;; original line into a mail-from: header line for debugging and for |
2004 |
(1- (point)) |
(1- (point)) |
2005 |
(point-max))))))))) |
(point-max))))))))) |
2006 |
|
|
2007 |
(defun rmail-msg-is-pruned () |
(defun rmail-msg-is-pruned (&optional msg) |
2008 |
(rmail-maybe-set-message-counters) |
"Determine if the headers for the current message are being |
2009 |
(save-restriction |
displayed. If MSG is non-nil it will be used as the message number |
2010 |
(narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) |
instead of the current message." |
2011 |
(save-excursion |
(rmail-desc-get-header-display-state (or msg rmail-current-message))) |
|
(goto-char (point-min)) |
|
|
(forward-line 1) |
|
|
(= (following-char) ?1)))) |
|
2012 |
|
|
2013 |
(defun rmail-msg-restore-non-pruned-header () |
(defun rmail-msg-restore-non-pruned-header () |
2014 |
(let ((old-point (point)) |
(let ((old-point (point)) |
2058 |
With argument ARG, show the message header pruned if ARG is greater than zero; |
With argument ARG, show the message header pruned if ARG is greater than zero; |
2059 |
otherwise, show it in full." |
otherwise, show it in full." |
2060 |
(interactive "P") |
(interactive "P") |
2061 |
(let* ((pruned (with-current-buffer rmail-buffer |
(rmail-header-toggle-visibility arg) |
2062 |
(rmail-msg-is-pruned))) |
(rmail-highlight-headers)) |
|
(prune (if arg |
|
|
(> (prefix-numeric-value arg) 0) |
|
|
(not pruned)))) |
|
|
(if (eq pruned prune) |
|
|
t |
|
|
(set-buffer rmail-buffer) |
|
|
(rmail-maybe-set-message-counters) |
|
|
(if rmail-enable-mime |
|
|
(let ((buffer-read-only nil)) |
|
|
(if pruned |
|
|
(rmail-msg-restore-non-pruned-header) |
|
|
(rmail-msg-prune-header)) |
|
|
(funcall rmail-show-mime-function)) |
|
|
(let* ((buffer-read-only nil) |
|
|
(window (get-buffer-window (current-buffer))) |
|
|
(at-point-min (= (point) (point-min))) |
|
|
(all-headers-visible (= (window-start window) (point-min))) |
|
|
(on-header |
|
|
(save-excursion |
|
|
(and (not (search-backward "\n\n" nil t)) |
|
|
(progn |
|
|
(end-of-line) |
|
|
(re-search-backward "^[-A-Za-z0-9]+:" nil t)) |
|
|
(match-string 0)))) |
|
|
(old-screen-line |
|
|
(rmail-count-screen-lines (window-start window) (point)))) |
|
|
(if pruned |
|
|
(rmail-msg-restore-non-pruned-header) |
|
|
(rmail-msg-prune-header)) |
|
|
(cond (at-point-min |
|
|
(goto-char (point-min))) |
|
|
(on-header |
|
|
(goto-char (point-min)) |
|
|
(search-forward "\n\n") |
|
|
(or (re-search-backward |
|
|
(concat "^" (regexp-quote on-header)) nil t) |
|
|
(goto-char (point-min)))) |
|
|
(t |
|
|
(save-selected-window |
|
|
(select-window window) |
|
|
(recenter old-screen-line) |
|
|
(if (and all-headers-visible |
|
|
(not (= (window-start) (point-min)))) |
|
|
(recenter (- (window-height) 2)))))))) |
|
|
(rmail-highlight-headers)))) |
|
2063 |
|
|
2064 |
(defun rmail-narrow-to-non-pruned-header () |
(defun rmail-narrow-to-non-pruned-header () |
2065 |
"Narrow to the whole (original) header of the current message." |
"Narrow to the whole (original) header of the current message." |
2066 |
(let (start end) |
(let (start end) |
2067 |
(narrow-to-region (rmail-msgbeg rmail-current-message) (point-max)) |
(narrow-to-region (rmail-desc-get-start rmail-current-message) (point-max)) |
2068 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2069 |
(forward-line 1) |
(forward-line 1) |
2070 |
(if (= (following-char) ?1) |
(if (= (following-char) ?1) |
2091 |
|
|
2092 |
;;;; *** Rmail Attributes and Keywords *** |
;;;; *** Rmail Attributes and Keywords *** |
2093 |
|
|
2094 |
;; Make a string describing current message's attributes and keywords |
;; Make a string describing the current message's attributes by |
2095 |
;; and set it up as the name of a minor mode |
;; keywords and set it up as the name of a minor mode so it will |
2096 |
;; so it will appear in the mode line. |
;; appear in the mode line. |
2097 |
(defun rmail-display-labels () |
(defun rmail-display-labels () |
2098 |
(let ((blurb "") (beg (point-min-marker)) (end (point-max-marker))) |
(let (keyword-list result) |
2099 |
(save-excursion |
|
2100 |
(unwind-protect |
;; Update the keyword list for the current message. |
2101 |
(progn |
(if (> rmail-current-message 0) |
2102 |
(widen) |
(setq keyword-list (rmail-desc-get-keywords rmail-current-message))) |
2103 |
(goto-char (rmail-msgbeg rmail-current-message)) |
|
2104 |
(forward-line 1) |
;; Generate the result string. |
2105 |
(if (looking-at "[01],") |
(setq result (mapconcat '(lambda (arg) arg) keyword-list " ")) |
2106 |
(progn |
|
2107 |
(narrow-to-region (point) (progn (end-of-line) (point))) |
;; Update the mode line to display the keywords, the current |
2108 |
;; Truly valid BABYL format requires a space before each |
;; message index and the total number of messages. |
|
;; attribute or keyword name. Put them in if missing. |
|
|
(let (buffer-read-only) |
|
|
(goto-char (point-min)) |
|
|
(while (search-forward "," nil t) |
|
|
(or (looking-at "[ ,]") (eobp) |
|
|
(insert " ")))) |
|
|
(goto-char (point-max)) |
|
|
(if (search-backward ",," nil 'move) |
|
|
(progn |
|
|
(if (> (point) (1+ (point-min))) |
|
|
(setq blurb (buffer-substring (+ 1 (point-min)) (point)))) |
|
|
(if (> (- (point-max) (point)) 2) |
|
|
(setq blurb |
|
|
(concat blurb |
|
|
";" |
|
|
(buffer-substring (+ (point) 3) |
|
|
(1- (point-max))))))))))) |
|
|
;; Note: we don't use save-restriction because that does not work right |
|
|
;; if changes are made outside the saved restriction |
|
|
;; before that restriction is restored. |
|
|
(narrow-to-region beg end) |
|
|
(set-marker beg nil) |
|
|
(set-marker end nil))) |
|
|
(while (string-match " +," blurb) |
|
|
(setq blurb (concat (substring blurb 0 (match-beginning 0)) "," |
|
|
(substring blurb (match-end 0))))) |
|
|
(while (string-match ", +" blurb) |
|
|
(setq blurb (concat (substring blurb 0 (match-beginning 0)) "," |
|
|
(substring blurb (match-end 0))))) |
|
2109 |
(setq mode-line-process |
(setq mode-line-process |
2110 |
(format " %d/%d%s" |
(format " %d/%d %s" |
2111 |
rmail-current-message rmail-total-messages blurb)) |
rmail-current-message rmail-total-messages result)) |
2112 |
|
|
2113 |
;; If rmail-enable-mime is non-nil, we may have to update |
;; If rmail-enable-mime is non-nil, we may have to update |
2114 |
;; `mode-line-process' of rmail-view-buffer too. |
;; `mode-line-process' of rmail-view-buffer too. |
2115 |
(if (and rmail-enable-mime |
(if (and rmail-enable-mime |
2123 |
;; ATTR is the name of the attribute, as a string. |
;; ATTR is the name of the attribute, as a string. |
2124 |
;; MSGNUM is message number to change; nil means current message. |
;; MSGNUM is message number to change; nil means current message. |
2125 |
(defun rmail-set-attribute (attr state &optional msgnum) |
(defun rmail-set-attribute (attr state &optional msgnum) |
2126 |
(set-buffer rmail-buffer) |
(save-excursion |
2127 |
(let ((omax (point-max-marker)) |
(save-restriction |
2128 |
(omin (point-min-marker)) |
(let ((attr-index (rmail-desc-get-attr-index attr))) |
2129 |
(buffer-read-only nil)) |
(set-buffer rmail-buffer) |
2130 |
(or msgnum (setq msgnum rmail-current-message)) |
(or msgnum (setq msgnum rmail-current-message)) |
2131 |
(if (> msgnum 0) |
(rmail-desc-set-attribute attr-index state msgnum) |
2132 |
(unwind-protect |
|
2133 |
(save-excursion |
;; Deal with the summary buffer. |
2134 |
(widen) |
(if rmail-summary-buffer |
2135 |
(goto-char (+ 3 (rmail-msgbeg msgnum))) |
(with-current-buffer rmail-summary-buffer |
2136 |
(let ((curstate |
(rmail-summary-update-attribute attr-index msgnum))))))) |
|
(not |
|
|
(null (search-backward (concat ", " attr ",") |
|
|
(prog1 (point) (end-of-line)) t))))) |
|
|
(or (eq curstate (not (not state))) |
|
|
(if curstate |
|
|
(delete-region (point) (1- (match-end 0))) |
|
|
(beginning-of-line) |
|
|
(forward-char 2) |
|
|
(insert " " attr ",")))) |
|
|
(if (string= attr "deleted") |
|
|
(rmail-set-message-deleted-p msgnum state))) |
|
|
;; Note: we don't use save-restriction because that does not work right |
|
|
;; if changes are made outside the saved restriction |
|
|
;; before that restriction is restored. |
|
|
(narrow-to-region omin omax) |
|
|
(set-marker omin nil) |
|
|
(set-marker omax nil) |
|
|
(if (= msgnum rmail-current-message) |
|
|
(rmail-display-labels)))))) |
|
2137 |
|
|
2138 |
;; Return t if the attributes/keywords line of msg number MSG |
;; Return t if the attributes/keywords line of msg number MSG |
2139 |
;; contains a match for the regexp LABELS. |
;; contains a match for the regexp LABELS. |
2141 |
(save-excursion |
(save-excursion |
2142 |
(save-restriction |
(save-restriction |
2143 |
(widen) |
(widen) |
2144 |
(goto-char (rmail-msgbeg msg)) |
(goto-char (rmail-desc-get-start msg)) |
2145 |
(forward-char 3) |
(forward-line 1) |
2146 |
(re-search-backward labels (prog1 (point) (end-of-line)) t)))) |
(re-search-backward labels (prog1 (point) (end-of-line)) t)))) |
2147 |
|
|
2148 |
;;;; *** Rmail Message Selection And Support *** |
;;;; *** Rmail Message Selection And Support *** |
2164 |
(save-excursion |
(save-excursion |
2165 |
(unwind-protect |
(unwind-protect |
2166 |
(progn |
(progn |
2167 |
(narrow-to-region (rmail-msgbeg rmail-current-message) |
(narrow-to-region (rmail-desc-get-start rmail-current-message) |
2168 |
(point-max)) |
(point-max)) |
2169 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2170 |
(funcall function)) |
(funcall function)) |
2171 |
;; Note: we don't use save-restriction because that does not work right |
;; Note: we don't use save-restriction because that does not work right |
2172 |
;; if changes are made outside the saved restriction |
;; if changes are made outside the saved restriction |
2173 |
;; before that restriction is restored. |
;; before that restriction is restored. |
2174 |
(narrow-to-region (rmail-msgbeg rmail-current-message) |
(narrow-to-region (rmail-desc-get-start rmail-current-message) |
2175 |
(rmail-msgend rmail-current-message))))) |
(rmail-desc-get-end rmail-current-message))))) |
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 |
2289 |
(defun rmail-forget-messages () |
(defun rmail-forget-messages () |
2290 |
(unwind-protect |
(unwind-protect |
2291 |
(if (vectorp rmail-message-vector) |
(if (vectorp rmail-message-vector) |
2299 |
(setq rmail-msgref-vector nil) |
(setq rmail-msgref-vector nil) |
2300 |
(setq rmail-deleted-vector nil))) |
(setq rmail-deleted-vector nil))) |
2301 |
|
|
2302 |
|
;;; mbox: deprecated |
2303 |
(defun rmail-maybe-set-message-counters () |
(defun rmail-maybe-set-message-counters () |
2304 |
(if (not (and rmail-deleted-vector |
(if (not (and rmail-deleted-vector |
2305 |
rmail-message-vector |
rmail-message-vector |
2342 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2343 |
(or nomsg (message "Counting new messages...done (%d)" total-messages)))) |
(or nomsg (message "Counting new messages...done (%d)" total-messages)))) |
2344 |
|
|
2345 |
|
;;; DEPRECATED |
2346 |
(defun rmail-set-message-counters () |
(defun rmail-set-message-counters () |
2347 |
(rmail-forget-messages) |
(rmail-forget-messages) |
2348 |
(save-excursion |
(save-excursion |
2380 |
(setq i (1+ i)))) |
(setq i (1+ i)))) |
2381 |
(message "Counting messages...done"))))) |
(message "Counting messages...done"))))) |
2382 |
|
|
2383 |
|
;;; DEPRECATED |
2384 |
(defun rmail-set-message-counters-counter (&optional stop) |
(defun rmail-set-message-counters-counter (&optional stop) |
2385 |
(let ((start (point)) |
(let ((start (point)) |
2386 |
next) |
next) |
2410 |
(if (zerop (% (setq total-messages (1+ total-messages)) 20)) |
(if (zerop (% (setq total-messages (1+ total-messages)) 20)) |
2411 |
(message "Counting messages...%d" total-messages))))) |
(message "Counting messages...%d" total-messages))))) |
2412 |
|
|
2413 |
|
;;; DEPRECATED |
2414 |
(defun rmail-beginning-of-message () |
(defun rmail-beginning-of-message () |
2415 |
"Show current message starting from the beginning." |
"Show current message starting from the beginning." |
2416 |
(interactive) |
(interactive) |
2418 |
|
|
2419 |
(defun rmail-show-message (&optional n no-summary) |
(defun rmail-show-message (&optional n no-summary) |
2420 |
"Show message number N (prefix argument), counting from start of file. |
"Show message number N (prefix argument), counting from start of file. |
2421 |
If summary buffer is currently displayed, update current message there also." |
If NO-SUMMARY is non-nil, then do not update the summary buffer." |
2422 |
(interactive "p") |
(interactive "p") |
2423 |
(or (eq major-mode 'rmail-mode) |
(or (eq major-mode 'rmail-mode) |
2424 |
(switch-to-buffer rmail-buffer)) |
(switch-to-buffer rmail-buffer)) |
2425 |
(rmail-maybe-set-message-counters) |
|
2426 |
(widen) |
;; If there are no messages to display, then provide a message to |
2427 |
|
;; indicate thusly. |
2428 |
(if (zerop rmail-total-messages) |
(if (zerop rmail-total-messages) |
2429 |
(progn (narrow-to-region (point-min) (1- (point-max))) |
|
2430 |
(goto-char (point-min)) |
;; There are no messages so display the Babyl boilerplate in the |
2431 |
(setq mode-line-process nil)) |
;; 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. |
2439 |
(let (blurb coding-system) |
(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. |
2443 |
(if (not n) |
(if (not n) |
2444 |
(setq n rmail-current-message) |
(setq n rmail-current-message) |
2445 |
(cond ((<= n 0) |
(cond ((<= n 0) |
2452 |
blurb "No following message")) |
blurb "No following message")) |
2453 |
(t |
(t |
2454 |
(setq rmail-current-message n)))) |
(setq rmail-current-message n)))) |
2455 |
(let ((beg (rmail-msgbeg n))) |
|
2456 |
(goto-char beg) |
;; Index into the Rmail message vector. |
2457 |
(forward-line 1) |
(let ((beg (rmail-desc-get-start n)) |
2458 |
(save-excursion |
(end (rmail-desc-get-end n))) |
2459 |
(let ((end (rmail-msgend n))) |
|
2460 |
(save-restriction |
;; Narrow the region to message N and display the headers |
2461 |
(if (prog1 (= (following-char) ?0) |
;; appropriately. |
2462 |
(forward-line 2) |
(rmail-header-show-headers) |
2463 |
;; If there's a Summary-line in the (otherwise empty) |
(widen) |
2464 |
;; header, we didn't yet get past the EOOH line. |
(narrow-to-region beg end) |
2465 |
(if (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n") |
(goto-char (point-min)) |
2466 |
(forward-line 1)) |
|
2467 |
(narrow-to-region (point) end)) |
;; I think this is stale. -pmr |
2468 |
(rfc822-goto-eoh) |
;;(rfc822-goto-eoh) |
2469 |
(search-forward "\n*** EOOH ***\n" end t)) |
;;(narrow-to-region beg (point)) |
2470 |
(narrow-to-region beg (point)) |
;;(goto-char (point-min)) |
2471 |
(goto-char (point-min)) |
;;(if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) |
2472 |
(if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) |
;; (let ((coding-system (intern (match-string 1)))) |
2473 |
(let ((coding-system (intern (match-string 1)))) |
;; (check-coding-system coding-system) |
2474 |
(condition-case nil |
;; (setq buffer-file-coding-system coding-system)) |
2475 |
(progn |
;; (setq buffer-file-coding-system nil)))) |
2476 |
(check-coding-system coding-system) |
|
2477 |
(setq buffer-file-coding-system coding-system)) |
;; Do something here with the coding system, I'm not sure what. -pmr |
2478 |
(error |
(if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) |
2479 |
(setq buffer-file-coding-system nil)))) |
(let ((coding-system (intern (match-string 1)))) |
2480 |
(setq buffer-file-coding-system nil))))) |
(condition-case nil |
2481 |
;; Clear the "unseen" attribute when we show a message. |
(progn |
2482 |
(rmail-set-attribute "unseen" nil) |
(check-coding-system coding-system) |
2483 |
(let ((end (rmail-msgend n))) |
(setq buffer-file-coding-system coding-system)) |
2484 |
;; Reformat the header, or else find the reformatted header. |
(error |
2485 |
(if (= (following-char) ?0) |
(setq buffer-file-coding-system nil)))) |
2486 |
(rmail-reformat-message beg end) |
(setq buffer-file-coding-system nil)) |
2487 |
(search-forward "\n*** EOOH ***\n" end t) |
|
2488 |
(narrow-to-region (point) end))) |
;; Clear the "unseen" attribute when we show a message, unless |
2489 |
(goto-char (point-min)) |
;; it is already cleared. |
2490 |
(walk-windows |
(if (rmail-desc-attr-p rmail-desc-unseen-index n) |
2491 |
(function (lambda (window) |
(rmail-desc-set-attribute rmail-desc-unseen-index nil n)) |
2492 |
(if (eq (window-buffer window) (current-buffer)) |
|
2493 |
(set-window-point window (point))))) |
;; More code that has been added that I ill understand. |
2494 |
nil t) |
;; (walk-windows |
2495 |
|
;; (function (lambda (window) |
2496 |
|
;; (if (eq (window-buffer window) (current-buffer)) |
2497 |
|
;; (set-window-point window (point))))) |
2498 |
|
;; nil t) |
2499 |
|
|
2500 |
(rmail-display-labels) |
(rmail-display-labels) |
2501 |
|
|
2502 |
|
;; Deal with MIME |
2503 |
(if (eq rmail-enable-mime t) |
(if (eq rmail-enable-mime t) |
2504 |
(funcall rmail-show-mime-function) |
(funcall rmail-show-mime-function) |
2505 |
(setq rmail-view-buffer rmail-buffer) |
(setq rmail-view-buffer rmail-buffer)) |
2506 |
) |
|
2507 |
|
;; Deal with the message headers and URLs.. |
2508 |
|
(rmail-header-hide-headers) |
2509 |
(rmail-highlight-headers) |
(rmail-highlight-headers) |
2510 |
|
(rmail-activate-urls) |
2511 |
|
|
2512 |
|
;; ? |
2513 |
(if transient-mark-mode (deactivate-mark)) |
(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. |
2519 |
(run-hooks 'rmail-show-message-hook) |
(run-hooks 'rmail-show-message-hook) |
2520 |
|
|
2521 |
;; If there is a summary buffer, try to move to this message |
;; If there is a summary buffer, try to move to this message |
2522 |
;; in that buffer. But don't complain if this message |
;; in that buffer. But don't complain if this message |
2523 |
;; is not mentioned in the summary. |
;; is not mentioned in the summary. |
2524 |
;; Don't do this at all if we were called on behalf |
;; Don't do this at all if we were called on behalf |
2525 |
;; of cursor motion in the summary buffer. |
;; of cursor motion in the summary buffer. |
2526 |
(and (rmail-summary-exists) (not no-summary) |
(and (rmail-summary-exists) (not no-summary) |
2527 |
(let ((curr-msg rmail-current-message)) |
(save-excursion |
2528 |
(rmail-select-summary |
(let ((curr-msg rmail-current-message)) |
2529 |
(rmail-summary-goto-msg curr-msg t t)))) |
;; 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? |
2536 |
(with-current-buffer rmail-buffer |
(with-current-buffer rmail-buffer |
2537 |
(rmail-auto-file)) |
(rmail-auto-file)) |
2538 |
|
|
2539 |
|
;; Post back any status messages. |
2540 |
(if blurb |
(if blurb |
2541 |
(message blurb)))))) |
(message blurb)))))) |
2542 |
|
|
2543 |
|
;;; NOT DONE |
2544 |
(defun rmail-redecode-body (coding) |
(defun rmail-redecode-body (coding) |
2545 |
"Decode the body of the current message using coding system CODING. |
"Decode the body of the current message using coding system CODING. |
2546 |
This is useful with mail messages that have malformed or missing |
This is useful with mail messages that have malformed or missing |
2562 |
(or (eq major-mode 'rmail-mode) |
(or (eq major-mode 'rmail-mode) |
2563 |
(switch-to-buffer rmail-buffer)) |
(switch-to-buffer rmail-buffer)) |
2564 |
(save-excursion |
(save-excursion |
2565 |
(let ((pruned (rmail-msg-is-pruned))) |
(unwind-protect |
2566 |
(unwind-protect |
(let ((msgbeg (rmail-desc-get-start rmail-current-message)) |
2567 |
(let ((msgbeg (rmail-msgbeg rmail-current-message)) |
(msgend (rmail-desc-get-end rmail-current-message)) |
2568 |
(msgend (rmail-msgend rmail-current-message)) |
x-coding-header) |
2569 |
x-coding-header) |
;; We need the message headers pruned (we later restore |
2570 |
;; We need the message headers pruned (we later restore |
;; the pruned stat to what it was, see the end of |
2571 |
;; the pruned stat to what it was, see the end of |
;; unwind-protect form). |
2572 |
;; unwind-protect form). |
(rmail-header-show-headers) |
2573 |
(or pruned |
(narrow-to-region msgbeg msgend) |
2574 |
(rmail-toggle-header 1)) |
(goto-char (point-min)) |
2575 |
(narrow-to-region msgbeg msgend) |
(if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) |
2576 |
(goto-char (point-min)) |
(let ((old-coding (intern (match-string 1))) |
2577 |
(when (search-forward "\n*** EOOH ***\n" (point-max) t) |
(buffer-read-only nil)) |
2578 |
(narrow-to-region msgbeg (point))) |
(check-coding-system old-coding) |
2579 |
(goto-char (point-min)) |
;; Make sure the new coding system uses the same EOL |
2580 |
(if (re-search-forward "^X-Coding-System: *\\(.*\\)$" nil t) |
;; conversion, to prevent ^M characters from popping |
2581 |
(let ((old-coding (intern (match-string 1))) |
;; up all over the place. |
2582 |
(buffer-read-only nil)) |
(setq coding |
2583 |
(check-coding-system old-coding) |
(coding-system-change-eol-conversion |
2584 |
;; Make sure the new coding system uses the same EOL |
coding |
2585 |
;; conversion, to prevent ^M characters from popping |
(coding-system-eol-type old-coding))) |
2586 |
;; up all over the place. |
(setq x-coding-header (point-marker)) |
2587 |
(setq coding |
(narrow-to-region msgbeg msgend) |
2588 |
(coding-system-change-eol-conversion |
(encode-coding-region (point) msgend old-coding) |
2589 |
coding |
(decode-coding-region (point) msgend coding) |
2590 |
(coding-system-eol-type old-coding))) |
(setq last-coding-system-used coding) |
2591 |
(setq x-coding-header (point-marker)) |
;; Rewrite the coding-system header according |
2592 |
(narrow-to-region msgbeg msgend) |
;; to what we did. |
2593 |
(encode-coding-region (point) msgend old-coding) |
(goto-char x-coding-header) |
2594 |
(decode-coding-region (point) msgend coding) |
(delete-region (point) |
2595 |
(setq last-coding-system-used coding) |
(save-excursion |
2596 |
;; Rewrite the coding-system header according |
(beginning-of-line) |
2597 |
;; to what we did. |
(point))) |
2598 |
(goto-char x-coding-header) |
(insert "X-Coding-System: " |
2599 |
(delete-region (point) |
(symbol-name last-coding-system-used)) |
2600 |
(save-excursion |
(set-marker x-coding-header nil) |
2601 |
(beginning-of-line) |
(rmail-show-message)) |
2602 |
(point))) |
(error "No X-Coding-System header found"))) |
2603 |
(insert "X-Coding-System: " |
(rmail-header-hide-headers))))) |
|
(symbol-name last-coding-system-used)) |
|
|
(set-marker x-coding-header nil) |
|
|
(rmail-show-message)) |
|
|
(error "No X-Coding-System header found"))) |
|
|
(or pruned |
|
|
(rmail-toggle-header 0))))))) |
|
2604 |
|
|
2605 |
;; Find all occurrences of certain fields, and highlight them. |
;; Find all occurrences of certain fields, and highlight them. |
2606 |
(defun rmail-highlight-headers () |
(defun rmail-highlight-headers () |
2645 |
(setq rmail-overlay-list |
(setq rmail-overlay-list |
2646 |
(cons overlay rmail-overlay-list)))))))))) |
(cons overlay rmail-overlay-list)))))))))) |
2647 |
|
|
2648 |
|
;;; mbox ready |
2649 |
(defun rmail-auto-file () |
(defun rmail-auto-file () |
2650 |
"Automatically move a message into a sub-folder based on criteria. |
"Automatically move a message into a sub-folder based on criteria. |
2651 |
Called when a new message is displayed." |
Called when a new message is displayed." |
2658 |
(let ((from (mail-fetch-field "from")) |
(let ((from (mail-fetch-field "from")) |
2659 |
(subj (mail-fetch-field "subject")) |
(subj (mail-fetch-field "subject")) |
2660 |
(to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc"))) |
(to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc"))) |
2661 |
(d rmail-automatic-folder-directives) |
(directives rmail-automatic-folder-directives) |
2662 |
(directive-loop nil) |
(directive-loop nil) |
2663 |
(folder nil)) |
(folder nil)) |
2664 |
(while d |
(while directives |
2665 |
(setq folder (car (car d)) |
(setq folder (car (car directives)) |
2666 |
directive-loop (cdr (car d))) |
directive-loop (cdr (car directives))) |
2667 |
(while (and (car directive-loop) |
(while (and (car directive-loop) |
2668 |
(let ((f (cond |
(let ((f (cond |
2669 |
((string= (car directive-loop) "from") from) |
((string= (car directive-loop) "from") from) |
2678 |
(rmail-delete-forward) |
(rmail-delete-forward) |
2679 |
(if (string= "/dev/null" folder) |
(if (string= "/dev/null" folder) |
2680 |
(rmail-delete-message) |
(rmail-delete-message) |
2681 |
(rmail-output-to-rmail-file folder 1 t) |
(rmail-output folder 1 t) |
2682 |
(setq d nil)))) |
(setq directives nil)))) |
2683 |
(setq d (cdr d)))))) |
(setq directives (cdr directives)))))) |
2684 |
|
|
2685 |
(defun rmail-next-message (n) |
(defun rmail-next-message (n) |
2686 |
"Show following message whether deleted or not. |
"Show following message whether deleted or not. |
2703 |
|
|
2704 |
Returns t if a new message is being shown, nil otherwise." |
Returns t if a new message is being shown, nil otherwise." |
2705 |
(interactive "p") |
(interactive "p") |
|
(set-buffer rmail-buffer) |
|
|
(rmail-maybe-set-message-counters) |
|
2706 |
(let ((lastwin rmail-current-message) |
(let ((lastwin rmail-current-message) |
2707 |
(current rmail-current-message)) |
(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. |
2712 |
(while (and (> n 0) (< current rmail-total-messages)) |
(while (and (> n 0) (< current rmail-total-messages)) |
2713 |
(setq current (1+ current)) |
(setq current (1+ current)) |
2714 |
(if (not (rmail-message-deleted-p current)) |
(if (not (rmail-desc-deleted-p current)) |
2715 |
(setq lastwin current n (1- n)))) |
(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. |
2721 |
(while (and (< n 0) (> current 1)) |
(while (and (< n 0) (> current 1)) |
2722 |
(setq current (1- current)) |
(setq current (1- current)) |
2723 |
(if (not (rmail-message-deleted-p current)) |
(if (not (rmail-desc-deleted-p current)) |
2724 |
(setq lastwin current n (1+ n)))) |
(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) |
2730 |
(if (/= lastwin rmail-current-message) |
(if (/= lastwin rmail-current-message) |
2731 |
(progn (rmail-show-message lastwin) |
t |
|
t) |
|
2732 |
(if (< n 0) |
(if (< n 0) |
2733 |
(message "No previous nondeleted message")) |
(message "No previous nondeleted message")) |
2734 |
(if (> n 0) |
(if (> n 0) |
2735 |
(message "No following nondeleted message")) |
(message "No following nondeleted message")) |
2736 |
nil))) |
nil))) |
2737 |
|
|
2738 |
|
;;; mbox: ready. |
2739 |
(defun rmail-previous-undeleted-message (n) |
(defun rmail-previous-undeleted-message (n) |
2740 |
"Show previous non-deleted message. |
"Show previous non-deleted message. |
2741 |
With prefix argument N, moves backward N non-deleted messages, |
With prefix argument N, moves backward N non-deleted messages, |
2743 |
(interactive "p") |
(interactive "p") |
2744 |
(rmail-next-undeleted-message (- n))) |
(rmail-next-undeleted-message (- n))) |
2745 |
|
|
2746 |
|
;;; mbox: ready. |
2747 |
(defun rmail-first-message () |
(defun rmail-first-message () |
2748 |
"Show first message in file." |
"Show first message in file." |
2749 |
(interactive) |
(interactive) |
|
(rmail-maybe-set-message-counters) |
|
2750 |
(rmail-show-message 1)) |
(rmail-show-message 1)) |
2751 |
|
|
2752 |
|
;;; mbox: ready |
2753 |
(defun rmail-last-message () |
(defun rmail-last-message () |
2754 |
"Show last message in file." |
"Show last message in file." |
2755 |
(interactive) |
(interactive) |
|
(rmail-maybe-set-message-counters) |
|
2756 |
(rmail-show-message rmail-total-messages)) |
(rmail-show-message rmail-total-messages)) |
2757 |
|
|
2758 |
|
;;; mbox: not called |
2759 |
(defun rmail-what-message () |
(defun rmail-what-message () |
2760 |
(let ((where (point)) |
(let ((where (point)) |
2761 |
(low 1) |
(low 1) |
2762 |
(high rmail-total-messages) |
(high rmail-total-messages) |
2763 |
(mid (/ rmail-total-messages 2))) |
(mid (/ rmail-total-messages 2))) |
2764 |
(while (> (- high low) 1) |
(while (> (- high low) 1) |
2765 |
(if (>= where (rmail-msgbeg mid)) |
(if (>= where (rmail-desc-get-start mid)) |
2766 |
(setq low mid) |
(setq low mid) |
2767 |
(setq high mid)) |
(setq high mid)) |
2768 |
(setq mid (+ low (/ (- high low) 2)))) |
(setq mid (+ low (/ (- high low) 2)))) |
2769 |
(if (>= where (rmail-msgbeg high)) high low))) |
(if (>= where (rmail-desc-get-start high)) high low))) |
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 |
2782 |
(defun rmail-message-recipients-p (msg recipients &optional primary-only) |
(defun rmail-message-recipients-p (msg recipients &optional primary-only) |
2783 |
(save-restriction |
(save-restriction |
|
(goto-char (rmail-msgbeg msg)) |
|
|
(search-forward "\n*** EOOH ***\n") |
|
|
(narrow-to-region (point) (progn (search-forward "\n\n") (point))) |
|
2784 |
(or (string-match recipients (or (mail-fetch-field "To") "")) |
(or (string-match recipients (or (mail-fetch-field "To") "")) |
2785 |
(string-match recipients (or (mail-fetch-field "From") "")) |
(string-match recipients (or (mail-fetch-field "From") "")) |
2786 |
(if (not primary-only) |
(if (not primary-only) |
2787 |
(string-match recipients (or (mail-fetch-field "Cc") "")))))) |
(string-match recipients (or (mail-fetch-field "Cc") "")))))) |
2788 |
|
|
2789 |
(defun rmail-message-regexp-p (n regexp) |
;;; mbox: ready |
2790 |
"Return t, if for message number N, regexp REGEXP matches in the header." |
(defun rmail-message-regexp-p (msg regexp) |
2791 |
(let ((beg (rmail-msgbeg n)) |
"Return t, if for message number MSG, regexp REGEXP matches in the header." |
2792 |
(end (rmail-msgend n))) |
(save-excursion |
2793 |
(goto-char beg) |
(save-restriction |
2794 |
(forward-line 1) |
(rmail-narrow-to-header msg) |
2795 |
(save-excursion |
(re-search-forward regexp nil t)))) |
|
(save-restriction |
|
|
(if (prog1 (= (following-char) ?0) |
|
|
(forward-line 2) |
|
|
;; If there's a Summary-line in the (otherwise empty) |
|
|
;; header, we didn't yet get past the EOOH line. |
|
|
(when (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n") |
|
|
(forward-line 1)) |
|
|
(setq beg (point)) |
|
|
(narrow-to-region (point) end)) |
|
|
(progn |
|
|
(rfc822-goto-eoh) |
|
|
(setq end (point))) |
|
|
(setq beg (point)) |
|
|
(search-forward "\n*** EOOH ***\n" end t) |
|
|
(setq end (1+ (match-beginning 0))))) |
|
|
(goto-char beg) |
|
|
(if rmail-enable-mime |
|
|
(funcall rmail-search-mime-header-function n regexp end) |
|
|
(re-search-forward regexp end t))))) |
|
2796 |
|
|
2797 |
|
;;; mbox: ready |
2798 |
(defun rmail-search-message (msg regexp) |
(defun rmail-search-message (msg regexp) |
2799 |
"Return non-nil, if for message number MSG, regexp REGEXP matches." |
"Return non-nil, if for message number MSG, regexp REGEXP matches." |
2800 |
(goto-char (rmail-msgbeg msg)) |
(goto-char (rmail-desc-get-start msg)) |
2801 |
(if rmail-enable-mime |
(if rmail-enable-mime |
2802 |
(funcall rmail-search-mime-message-function msg regexp) |
(funcall rmail-search-mime-message-function msg regexp) |
2803 |
(re-search-forward regexp (rmail-msgend msg) t))) |
(re-search-forward regexp (rmail-desc-get-end msg) t))) |
2804 |
|
|
2805 |
|
;;; mbox: ready |
2806 |
(defvar rmail-search-last-regexp nil) |
(defvar rmail-search-last-regexp nil) |
2807 |
(defun rmail-search (regexp &optional n) |
(defun rmail-search (regexp &optional n) |
2808 |
"Show message containing next match for REGEXP (but not the current msg). |
"Show message containing next match for REGEXP (but not the current msg). |
2831 |
(if (< n 0) "Reverse " "") |
(if (< n 0) "Reverse " "") |
2832 |
regexp) |
regexp) |
2833 |
(set-buffer rmail-buffer) |
(set-buffer rmail-buffer) |
|
(rmail-maybe-set-message-counters) |
|
2834 |
(let ((omin (point-min)) |
(let ((omin (point-min)) |
2835 |
(omax (point-max)) |
(omax (point-max)) |
2836 |
(opoint (point)) |
(opoint (point)) |
|
win |
|
2837 |
(reversep (< n 0)) |
(reversep (< n 0)) |
2838 |
(msg rmail-current-message)) |
(msg rmail-current-message) |
2839 |
|
win) |
2840 |
(unwind-protect |
(unwind-protect |
2841 |
(progn |
(progn |
2842 |
(widen) |
(widen) |
2898 |
(prefix-numeric-value current-prefix-arg)))) |
(prefix-numeric-value current-prefix-arg)))) |
2899 |
(rmail-search regexp (- (or n 1)))) |
(rmail-search regexp (- (or n 1)))) |
2900 |
|
|
|
;; Show the first message which has the `unseen' attribute. |
|
2901 |
(defun rmail-first-unseen-message () |
(defun rmail-first-unseen-message () |
2902 |
(rmail-maybe-set-message-counters) |
"Show the first message which has not been seen. If all messages |
2903 |
|
have been seen, then show the last message." |
2904 |
(let ((current 1) |
(let ((current 1) |
2905 |
found) |
found) |
2906 |
(save-restriction |
(while (and (not found) (<= current rmail-total-messages)) |
2907 |
(widen) |
(if (rmail-desc-attr-p rmail-desc-unseen-index current) |
2908 |
(while (and (not found) (<= current rmail-total-messages)) |
(setq found current)) |
2909 |
(if (rmail-message-labels-p current ", ?\\(unseen\\),") |
(setq current (1+ current))) |
|
(setq found current)) |
|
|
(setq current (1+ current)))) |
|
|
;; Let the caller show the message. |
|
|
;; (if found |
|
|
;; (rmail-show-message found)) |
|
2910 |
found)) |
found)) |
2911 |
|
|
2912 |
(defun rmail-next-same-subject (n) |
(defun rmail-next-same-subject (n) |
2931 |
(save-excursion |
(save-excursion |
2932 |
(save-restriction |
(save-restriction |
2933 |
(widen) |
(widen) |
2934 |
(while (and (/= n 0) |
(if forward |
2935 |
(if forward |
(while (and (/= n 0) (< i rmail-total-messages)) |
2936 |
(< i rmail-total-messages) |
(let (done) |
2937 |
(> i 1))) |
(while (and (not done) |
2938 |
(let (done) |
(< i rmail-total-messages)) |
2939 |
(while (and (not done) |
(setq i (+ i 1)) |
2940 |
(if forward |
(rmail-narrow-to-header i) |
2941 |
(< i rmail-total-messages) |
(goto-char (point-min)) |
2942 |
(> i 1))) |
(setq done (re-search-forward search-regexp (point-max) t))) |
2943 |
(setq i (if forward (1+ i) (1- i))) |
(if done (setq found i))) |
2944 |
(goto-char (rmail-msgbeg i)) |
(setq n (1- n))) |
2945 |
(search-forward "\n*** EOOH ***\n") |
(while (and (/= n 0) (> i 1)) |
2946 |
(let ((beg (point)) end) |
(let (done) |
2947 |
(search-forward "\n\n") |
(while (and (not done) (> i 1)) |
2948 |
(setq end (point)) |
(setq i (- i 1)) |
2949 |
(goto-char beg) |
(rmail-narrow-to-header i) |
2950 |
(setq done (re-search-forward search-regexp end t)))) |
(goto-char (point-min)) |
2951 |
(if done (setq found i))) |
(setq done (re-search-forward search-regexp (point-max) t))) |
2952 |
(setq n (if forward (1- n) (1+ n)))))) |
(if done (setq found i))) |
2953 |
|
(setq n (1+ n)))))) |
2954 |
(if found |
(if found |
2955 |
(rmail-show-message found) |
(rmail-show-message found) |
2956 |
(error "No %s message with same subject" |
(error "No %s message with same subject" |
2965 |
|
|
2966 |
;;;; *** Rmail Message Deletion Commands *** |
;;;; *** Rmail Message Deletion Commands *** |
2967 |
|
|
2968 |
|
;;; mbox: ready |
2969 |
(defun rmail-message-deleted-p (n) |
(defun rmail-message-deleted-p (n) |
2970 |
(= (aref rmail-deleted-vector n) ?D)) |
(rmail-desc-deleted-p n)) |
2971 |
|
|
2972 |
(defun rmail-set-message-deleted-p (n state) |
(defun rmail-set-message-deleted-p (n state) |
2973 |
(aset rmail-deleted-vector n (if state ?D ?\ ))) |
(aset rmail-deleted-vector n (if state ?D ?\ ))) |
2975 |
(defun rmail-delete-message () |
(defun rmail-delete-message () |
2976 |
"Delete this message and stay on it." |
"Delete this message and stay on it." |
2977 |
(interactive) |
(interactive) |
2978 |
(rmail-set-attribute "deleted" t) |
(rmail-desc-set-attribute rmail-desc-deleted-index t rmail-current-message) |
2979 |
(run-hooks 'rmail-delete-message-hook)) |
(run-hooks 'rmail-delete-message-hook) |
2980 |
|
(rmail-show-message rmail-current-message)) |
2981 |
|
|
2982 |
(defun rmail-undelete-previous-message () |
(defun rmail-undelete-previous-message () |
2983 |
"Back up to deleted message, select it, and undelete it." |
"Back up to deleted message, select it, and undelete it." |
2985 |
(set-buffer rmail-buffer) |
(set-buffer rmail-buffer) |
2986 |
(let ((msg rmail-current-message)) |
(let ((msg rmail-current-message)) |
2987 |
(while (and (> msg 0) |
(while (and (> msg 0) |
2988 |
(not (rmail-message-deleted-p msg))) |
(not (rmail-desc-attr-p rmail-desc-deleted-index msg))) |
2989 |
(setq msg (1- msg))) |
(setq msg (1- msg))) |
2990 |
(if (= msg 0) |
(if (= msg 0) |
2991 |
(error "No previous deleted message") |
(error "No previous deleted message") |
2992 |
(if (/= msg rmail-current-message) |
(rmail-desc-set-attribute rmail-desc-deleted-index nil msg) |
2993 |
(rmail-show-message msg)) |
(rmail-show-message msg) |
|
(rmail-set-attribute "deleted" nil) |
|
2994 |
(if (rmail-summary-exists) |
(if (rmail-summary-exists) |
2995 |
(save-excursion |
(save-excursion |
2996 |
(set-buffer rmail-summary-buffer) |
(set-buffer rmail-summary-buffer) |
2997 |
(rmail-summary-mark-undeleted msg))) |
(rmail-summary-mark-undeleted msg))) |
2998 |
(rmail-maybe-display-summary)))) |
(rmail-maybe-display-summary)))) |
2999 |
|
|
3000 |
|
;;; mbox: ready |
3001 |
(defun rmail-delete-forward (&optional backward) |
(defun rmail-delete-forward (&optional backward) |
3002 |
"Delete this message and move to next nondeleted one. |
"Delete this message and move to next nondeleted one. |
3003 |
Deleted messages stay in the file until the \\[rmail-expunge] command is given. |
Deleted messages stay in the file until the \\[rmail-expunge] command is given. |
3005 |
|
|
3006 |
Returns t if a new message is displayed after the delete, or nil otherwise." |
Returns t if a new message is displayed after the delete, or nil otherwise." |
3007 |
(interactive "P") |
(interactive "P") |
3008 |
(rmail-set-attribute "deleted" t) |
(rmail-desc-set-attribute rmail-desc-deleted-index t rmail-current-message) |
3009 |
(run-hooks 'rmail-delete-message-hook) |
(run-hooks 'rmail-delete-message-hook) |
3010 |
(let ((del-msg rmail-current-message)) |
(let ((del-msg rmail-current-message)) |
3011 |
(if (rmail-summary-exists) |
(if (rmail-summary-exists) |
3014 |
(prog1 (rmail-next-undeleted-message (if backward -1 1)) |
(prog1 (rmail-next-undeleted-message (if backward -1 1)) |
3015 |
(rmail-maybe-display-summary)))) |
(rmail-maybe-display-summary)))) |
3016 |
|
|
3017 |
|
;;; mbox: ready |
3018 |
(defun rmail-delete-backward () |
(defun rmail-delete-backward () |
3019 |
"Delete this message and move to previous nondeleted one. |
"Delete this message and move to previous nondeleted one. |
3020 |
Deleted messages stay in the file until the \\[rmail-expunge] command is given." |
Deleted messages stay in the file until the \\[rmail-expunge] command is given." |
3021 |
(interactive) |
(interactive) |
3022 |
(rmail-delete-forward t)) |
(rmail-delete-forward t)) |
3023 |
|
|
3024 |
|
;;; mbox: deprecated |
3025 |
;; Compute the message number a given message would have after expunging. |
;; Compute the message number a given message would have after expunging. |
3026 |
;; The present number of the message is OLDNUM. |
;; The present number of the message is OLDNUM. |
3027 |
;; DELETEDVEC should be rmail-deleted-vector. |
;; DELETEDVEC should be rmail-deleted-vector. |
3047 |
(funcall rmail-confirm-expunge |
(funcall rmail-confirm-expunge |
3048 |
"Erase deleted messages from Rmail file? "))) |
"Erase deleted messages from Rmail file? "))) |
3049 |
|
|
3050 |
|
;;; mbox: ready |
3051 |
(defun rmail-only-expunge () |
(defun rmail-only-expunge () |
3052 |
"Actually erase all deleted messages in the file." |
"Actually erase all deleted messages in the file." |
3053 |
(interactive) |
(interactive) |
|
(set-buffer rmail-buffer) |
|
3054 |
(message "Expunging deleted messages...") |
(message "Expunging deleted messages...") |
3055 |
|
|
3056 |
;; Discard all undo records for this buffer. |
;; Discard all undo records for this buffer. |
3057 |
(or (eq buffer-undo-list t) |
(or (eq buffer-undo-list t) (setq buffer-undo-list nil)) |
|
(setq buffer-undo-list nil)) |
|
|
(rmail-maybe-set-message-counters) |
|
|
(let* ((omax (- (buffer-size) (point-max))) |
|
|
(omin (- (buffer-size) (point-min))) |
|
|
(opoint (if (and (> rmail-current-message 0) |
|
|
(rmail-message-deleted-p rmail-current-message)) |
|
|
0 |
|
|
(if rmail-enable-mime |
|
|
(with-current-buffer rmail-view-buffer |
|
|
(- (point)(point-min))) |
|
|
(- (point) (point-min))))) |
|
|
(messages-head (cons (aref rmail-message-vector 0) nil)) |
|
|
(messages-tail messages-head) |
|
|
;; Don't make any undo records for the expunging. |
|
|
(buffer-undo-list t) |
|
|
(win)) |
|
|
(unwind-protect |
|
|
(save-excursion |
|
|
(widen) |
|
|
(goto-char (point-min)) |
|
|
(let ((counter 0) |
|
|
(number 1) |
|
|
(total rmail-total-messages) |
|
|
(new-message-number rmail-current-message) |
|
|
(new-summary nil) |
|
|
(new-msgref (list (list 0))) |
|
|
(rmailbuf (current-buffer)) |
|
|
(buffer-read-only nil) |
|
|
(messages rmail-message-vector) |
|
|
(deleted rmail-deleted-vector) |
|
|
(summary rmail-summary-vector)) |
|
|
(setq rmail-total-messages nil |
|
|
rmail-current-message nil |
|
|
rmail-message-vector nil |
|
|
rmail-deleted-vector nil |
|
|
rmail-summary-vector nil) |
|
|
|
|
|
(while (<= number total) |
|
|
(if (= (aref deleted number) ?D) |
|
|
(progn |
|
|
(delete-region |
|
|
(marker-position (aref messages number)) |
|
|
(marker-position (aref messages (1+ number)))) |
|
|
(move-marker (aref messages number) nil) |
|
|
(if (> new-message-number counter) |
|
|
(setq new-message-number (1- new-message-number)))) |
|
|
(setq counter (1+ counter)) |
|
|
(setq messages-tail |
|
|
(setcdr messages-tail |
|
|
(cons (aref messages number) nil))) |
|
|
(setq new-summary |
|
|
(cons (if (= counter number) (aref summary (1- number))) |
|
|
new-summary)) |
|
|
(setq new-msgref |
|
|
(cons (aref rmail-msgref-vector number) |
|
|
new-msgref)) |
|
|
(setcar (car new-msgref) counter)) |
|
|
(if (zerop (% (setq number (1+ number)) 20)) |
|
|
(message "Expunging deleted messages...%d" number))) |
|
|
(setq messages-tail |
|
|
(setcdr messages-tail |
|
|
(cons (aref messages number) nil))) |
|
|
(setq rmail-current-message new-message-number |
|
|
rmail-total-messages counter |
|
|
rmail-message-vector (apply 'vector messages-head) |
|
|
rmail-deleted-vector (make-string (1+ counter) ?\ ) |
|
|
rmail-summary-vector (vconcat (nreverse new-summary)) |
|
|
rmail-msgref-vector (apply 'vector (nreverse new-msgref)) |
|
|
win t))) |
|
|
(message "Expunging deleted messages...done") |
|
|
(if (not win) |
|
|
(narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) |
|
|
(rmail-show-message |
|
|
(if (zerop rmail-current-message) 1 nil)) |
|
|
(if rmail-enable-mime |
|
|
(goto-char (+ (point-min) opoint)) |
|
|
(goto-char (+ (point) opoint)))))) |
|
3058 |
|
|
3059 |
|
;; Remove the messages from the buffer and from the Rmail message |
3060 |
|
;; descriptor vector. |
3061 |
|
(rmail-desc-prune-deleted-messages 'rmail-expunge-callback) |
3062 |
|
|
3063 |
|
;; Update the Rmail message counter, deal with the summary buffer, |
3064 |
|
;; show the current message and update the User status. |
3065 |
|
(setq rmail-total-messages (rmail-desc-get-count)) |
3066 |
|
(rmail-show-message rmail-current-message t) |
3067 |
|
(if rmail-summary-buffer |
3068 |
|
(save-excursion |
3069 |
|
(set-buffer rmail-summary-buffer) |
3070 |
|
(rmail-update-summary))) |
3071 |
|
(message "Expunging deleted messages...done")) |
3072 |
|
|
3073 |
|
;;; We'll deal with this later. -pmr |
3074 |
|
;;; (if rmail-enable-mime |
3075 |
|
;;; (goto-char (+ (point-min) opoint)) |
3076 |
|
;;; (goto-char (+ (point) opoint)))))) |
3077 |
|
|
3078 |
|
;;; mbox: ready |
3079 |
|
(defun rmail-expunge-callback (n) |
3080 |
|
"Called after message N has been pruned to update the current Rmail |
3081 |
|
message counter." |
3082 |
|
(if (< n rmail-current-message) |
3083 |
|
(setq rmail-current-message (1- rmail-current-message)))) |
3084 |
|
|
3085 |
|
;;; mbox: ready |
3086 |
(defun rmail-expunge () |
(defun rmail-expunge () |
3087 |
"Erase deleted messages from Rmail file and summary buffer." |
"Erase deleted messages from Rmail file and summary buffer." |
3088 |
(interactive) |
(interactive) |
3089 |
(when (rmail-expunge-confirmed) |
(when (rmail-expunge-confirmed) |
3090 |
(rmail-only-expunge) |
(rmail-only-expunge))) |
|
(if (rmail-summary-exists) |
|
|
(rmail-select-summary (rmail-update-summary))))) |
|
3091 |
|
|
3092 |
;;;; *** Rmail Mailing Commands *** |
;;;; *** Rmail Mailing Commands *** |
3093 |
|
|
3094 |
|
;;; mbox: In progress. I'm still not happy with the initial citation |
3095 |
|
;;; stuff. -pmr |
3096 |
(defun rmail-start-mail (&optional noerase to subject in-reply-to cc |
(defun rmail-start-mail (&optional noerase to subject in-reply-to cc |
3097 |
replybuffer sendactions same-window others) |
replybuffer sendactions same-window others) |
3098 |
(let (yank-action) |
(let (yank-action) |
3129 |
(interactive) |
(interactive) |
3130 |
(rmail-start-mail t)) |
(rmail-start-mail t)) |
3131 |
|
|
3132 |
|
;;; mbox: ready -pmr |
3133 |
(defun rmail-reply (just-sender) |
(defun rmail-reply (just-sender) |
3134 |
"Reply to the current message. |
"Reply to the current message. |
3135 |
Normally include CC: to all other recipients of original message; |
Normally include CC: to all other recipients of original message; |
3136 |
prefix argument means ignore them. While composing the reply, |
prefix argument means ignore them. While composing the reply, |
3137 |
use \\[mail-yank-original] to yank the original message into it." |
use \\[mail-yank-original] to yank the original message into it." |
3138 |
(interactive "P") |
(interactive "P") |
3139 |
(let (from reply-to cc subject date to message-id references |
(save-excursion |
3140 |
resent-to resent-cc resent-reply-to |
(save-restriction |
3141 |
(msgnum rmail-current-message)) |
(let ((msgnum rmail-current-message) |
3142 |
(save-excursion |
(display-state (rmail-desc-get-header-display-state rmail-current-message)) |
3143 |
(save-restriction |
from reply-to cc subject date to message-id references |
3144 |
(if rmail-enable-mime |
resent-to resent-cc resent-reply-to) |
3145 |
(narrow-to-region |
(rmail-header-show-headers) |
3146 |
(goto-char (point-min)) |
(setq from (mail-fetch-field "from") |
3147 |
(if (search-forward "\n\n" nil 'move) |
reply-to (or (mail-fetch-field "reply-to" nil t) from) |
3148 |
(1+ (match-beginning 0)) |
cc (and (not just-sender) |
3149 |
(point))) |
(mail-fetch-field "cc" nil t)) |
3150 |
(widen) |
subject (mail-fetch-field "subject") |
3151 |
(goto-char (rmail-msgbeg rmail-current-message)) |
date (mail-fetch-field "date") |
3152 |
(forward-line 1) |
to (or (mail-fetch-field "to" nil t) "") |
3153 |
(if (= (following-char) ?0) |
message-id (mail-fetch-field "message-id") |
3154 |
(narrow-to-region |
references (mail-fetch-field "references" nil nil t) |
3155 |
(progn (forward-line 2) |
resent-reply-to (mail-fetch-field "resent-reply-to" nil t) |
3156 |
(point)) |
resent-cc (and (not just-sender) |
3157 |
(progn (search-forward "\n\n" (rmail-msgend rmail-current-message) |
(mail-fetch-field "resent-cc" nil t)) |
3158 |
'move) |
resent-to (or (mail-fetch-field "resent-to" nil t) "")) |
|
(point))) |
|
|
(narrow-to-region (point) |
|
|
(progn (search-forward "\n*** EOOH ***\n") |
|
|
(beginning-of-line) (point))))) |
|
|
(setq from (mail-fetch-field "from") |
|
|
reply-to (or (mail-fetch-field "reply-to" nil t) |
|
|
from) |
|
|
cc (and (not just-sender) |
|
|
(mail-fetch-field "cc" nil t)) |
|
|
subject (mail-fetch-field "subject") |
|
|
date (mail-fetch-field "date") |
|
|
to (or (mail-fetch-field "to" nil t) "") |
|
|
message-id (mail-fetch-field "message-id") |
|
|
references (mail-fetch-field "references" nil nil t) |
|
|
resent-reply-to (mail-fetch-field "resent-reply-to" nil t) |
|
|
resent-cc (and (not just-sender) |
|
|
(mail-fetch-field "resent-cc" nil t)) |
|
|
resent-to (or (mail-fetch-field "resent-to" nil t) "") |
|
3159 |
;;; resent-subject (mail-fetch-field "resent-subject") |
;;; resent-subject (mail-fetch-field "resent-subject") |
3160 |
;;; resent-date (mail-fetch-field "resent-date") |
;;; resent-date (mail-fetch-field "resent-date") |
3161 |
;;; resent-message-id (mail-fetch-field "resent-message-id") |
;;; resent-message-id (mail-fetch-field "resent-message-id") |
3162 |
))) |
|
3163 |
;; Merge the resent-to and resent-cc into the to and cc. |
;; Merge the resent-to and resent-cc into the to and cc. |
3164 |
(if (and resent-to (not (equal resent-to ""))) |
(if (and resent-to (not (equal resent-to ""))) |
3165 |
(if (not (equal to "")) |
(if (not (equal to "")) |
3166 |
(setq to (concat to ", " resent-to)) |
(setq to (concat to ", " resent-to)) |
3167 |
(setq to resent-to))) |
(setq to resent-to))) |
3168 |
(if (and resent-cc (not (equal resent-cc ""))) |
(if (and resent-cc (not (equal resent-cc ""))) |
3169 |
(if (not (equal cc "")) |
(if (not (equal cc "")) |
3170 |
(setq cc (concat cc ", " resent-cc)) |
(setq cc (concat cc ", " resent-cc)) |
3171 |
(setq cc resent-cc))) |
(setq cc resent-cc))) |
3172 |
;; Add `Re: ' to subject if not there already. |
;; Add `Re: ' to subject if not there already. |
3173 |
(and (stringp subject) |
(and (stringp subject) |
3174 |
(setq subject |
(setq subject |
3175 |
(concat rmail-reply-prefix |
(concat rmail-reply-prefix |
3176 |
(if (let ((case-fold-search t)) |
(if (let ((case-fold-search t)) |
3177 |
(string-match rmail-reply-regexp subject)) |
(string-match rmail-reply-regexp subject)) |
3178 |
(substring subject (match-end 0)) |
(substring subject (match-end 0)) |
3179 |
subject)))) |
subject)))) |
3180 |
(rmail-start-mail |
;; Reset the headers display state before switching to the |
3181 |
nil |
;; reply buffer. |
3182 |
;; Using mail-strip-quoted-names is undesirable with newer mailers |
(rmail-header-toggle-visibility (if display-state 1 0)) |
3183 |
;; since they can handle the names unstripped. |
|
3184 |
;; I don't know whether there are other mailers that still |
;; Now setup the mail reply buffer. |
3185 |
;; need the names to be stripped. |
(rmail-start-mail |
3186 |
;;; (mail-strip-quoted-names reply-to) |
nil |
3187 |
reply-to |
;; Using mail-strip-quoted-names is undesirable with newer mailers |
3188 |
subject |
;; since they can handle the names unstripped. |
3189 |
(rmail-make-in-reply-to-field from date message-id) |
;; I don't know whether there are other mailers that still |
3190 |
(if just-sender |
;; need the names to be stripped. |
3191 |
nil |
(mail-strip-quoted-names reply-to) |
3192 |
;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to |
subject |
3193 |
;; to do its job. |
(rmail-make-in-reply-to-field from date message-id) |
3194 |
(let* ((cc-list (rmail-dont-reply-to |
(if just-sender |
3195 |
(mail-strip-quoted-names |
nil |
3196 |
(if (null cc) to (concat to ", " cc)))))) |
;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to |
3197 |
(if (string= cc-list "") nil cc-list))) |
;; to do its job. |
3198 |
rmail-view-buffer |
(let* ((cc-list (rmail-dont-reply-to |
3199 |
(list (list 'rmail-mark-message |
(mail-strip-quoted-names |
3200 |
rmail-buffer |
(if (null cc) to (concat to ", " cc)))))) |
3201 |
(with-current-buffer rmail-buffer |
(if (string= cc-list "") nil cc-list))) |
3202 |
(aref rmail-msgref-vector msgnum)) |
rmail-view-buffer |
3203 |
"answered")) |
(list (list 'rmail-reply-callback rmail-buffer "answered" t msgnum)) |
3204 |
nil |
nil |
3205 |
(list (cons "References" (concat (mapconcat 'identity references " ") |
(list (cons "References" (concat (mapconcat 'identity references " ") |
3206 |
" " message-id)))))) |
" " message-id)))))))) |
3207 |
|
|
3208 |
(defun rmail-mark-message (buffer msgnum-list attribute) |
(defun rmail-reply-callback (buffer attr state n) |
3209 |
"Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE. |
"Mail reply callback function. Sets ATTR (a string) if STATE is |
3210 |
This is use in the send-actions for message buffers. |
non-nil, otherwise clears it. N is the message number. BUFFER, |
3211 |
MSGNUM-LIST is a list of the form (MSGNUM) |
possibly narrowed, contains an mbox mail message." |
|
which is an element of rmail-msgref-vector." |
|
3212 |
(save-excursion |
(save-excursion |
3213 |
(set-buffer buffer) |
(set-buffer buffer) |
3214 |
(if (car msgnum-list) |
(rmail-set-attribute attr state n))) |
3215 |
(rmail-set-attribute attribute t (car msgnum-list))))) |
|
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))) |
3231 |
|
|
3232 |
(defun rmail-make-in-reply-to-field (from date message-id) |
(defun rmail-make-in-reply-to-field (from date message-id) |
3233 |
(cond ((not from) |
(cond ((not from) |
3288 |
(let ((mail-use-rfc822 t)) |
(let ((mail-use-rfc822 t)) |
3289 |
(rmail-make-in-reply-to-field from date message-id))))) |
(rmail-make-in-reply-to-field from date message-id))))) |
3290 |
|
|
3291 |
|
;;; mbox: ready |
3292 |
(defun rmail-forward (resend) |
(defun rmail-forward (resend) |
3293 |
"Forward the current message to another user. |
"Forward the current message to another user. |
3294 |
With prefix argument, \"resend\" the message instead of forwarding it; |
With prefix argument, \"resend\" the message instead of forwarding it; |
3311 |
(list (list 'rmail-mark-message |
(list (list 'rmail-mark-message |
3312 |
forward-buffer |
forward-buffer |
3313 |
(with-current-buffer rmail-buffer |
(with-current-buffer rmail-buffer |
3314 |
(aref rmail-msgref-vector msgnum)) |
(rmail-desc-get-start msgnum)) |
3315 |
"forwarded")) |
"forwarded")) |
3316 |
;; If only one window, use it for the mail buffer. |
;; If only one window, use it for the mail buffer. |
3317 |
;; Otherwise, use another window for the mail buffer |
;; Otherwise, use another window for the mail buffer |
3453 |
(defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$" |
(defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$" |
3454 |
"A regexp that matches the header of a MIME body part with a failed message.") |
"A regexp that matches the header of a MIME body part with a failed message.") |
3455 |
|
|
3456 |
|
;;; NOT DONE |
3457 |
(defun rmail-retry-failure () |
(defun rmail-retry-failure () |
3458 |
"Edit a mail message which is based on the contents of the current message. |
"Edit a mail message which is based on the contents of the current message. |
3459 |
For a message rejected by the mail system, extract the interesting headers and |
For a message rejected by the mail system, extract the interesting headers and |
3803 |
(setq i (1+ i))) |
(setq i (1+ i))) |
3804 |
(concat string-vector))) |
(concat string-vector))) |
3805 |
|
|
3806 |
(provide 'rmail) |
;;;; 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 |
|
|
3921 |
|
|
3922 |
;;; rmail.el ends here |
;;; rmail.el ends here |