X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/a9269c187774dea6e939066a79901f23ae79641f..45261b503cea5ddf9dc2cbdf294c68b053875eb4:/lisp/mail/rmail.el diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index c43ec9e561..d1322915ab 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -91,6 +91,7 @@ its character representation and its display representation.") (defvar messages-head) (defvar total-messages) (defvar tool-bar-map) +(defvar mail-encode-mml) (defvar rmail-header-style 'normal "The current header display style choice, one of @@ -193,6 +194,7 @@ please report it with \\[report-emacs-bug].") (declare-function mail-dont-reply-to "mail-utils" (destinations)) (declare-function rmail-update-summary "rmailsum" (&rest ignore)) +(declare-function rmail-mime-toggle-hidden "rmailmm" ()) (defun rmail-probe (prog) "Determine what flavor of movemail PROG is. @@ -629,27 +631,20 @@ Element N specifies the summary line for message N+1.") This is set to nil by default.") (defcustom rmail-enable-mime t - "If non-nil, RMAIL uses MIME features. -If the value is t, RMAIL automatically shows MIME decoded message. -If the value is neither t nor nil, RMAIL does not show MIME decoded message -until a user explicitly requires it. - -Even if the value is non-nil, you can't use MIME features -unless the feature specified by `rmail-mime-feature' is available." - :type '(choice (const :tag "on" t) - (const :tag "off" nil) - (other :tag "when asked" ask)) + "If non-nil, RMAIL automatically displays decoded MIME messages. +For this to work, the feature specified by `rmail-mime-feature' must +be available." + :type 'boolean :version "23.3" :group 'rmail) -(defvar rmail-enable-mime-composing nil +(defvar rmail-enable-mime-composing t "*If non-nil, RMAIL uses `rmail-insert-mime-forwarded-message-function' to forward.") -;; FIXME unused. (defvar rmail-show-mime-function nil - "Function to show MIME decoded message of RMAIL file. + "Function of no argument called to show a decoded MIME message. This function is called when `rmail-enable-mime' is non-nil. -It is called with no argument.") +The package providing MIME support should set this.") ;;;###autoload (defvar rmail-insert-mime-forwarded-message-function nil @@ -685,7 +680,7 @@ where MSG is the message number, REGEXP is the regular expression, LIMIT is the position specifying the end of header.") (defvar rmail-mime-feature 'rmailmm - "Feature to require to load MIME support in Rmail. + "Feature to require for MIME support in Rmail. When starting Rmail, if `rmail-enable-mime' is non-nil, this feature is required with `require'. @@ -835,10 +830,10 @@ isn't provided." (display-warning 'rmail (format "Although MIME support is requested -by setting `rmail-enable-mime' to non-nil, the required feature +through `rmail-enable-mime' being non-nil, the required feature `%s' (the value of `rmail-mime-feature') is not available in the current session. -So, the MIME support is turned off for the moment." +So, MIME support is turned off for the moment." rmail-mime-feature) :warning) (setq rmail-enable-mime nil))))) @@ -1007,6 +1002,7 @@ The buffer is expected to be narrowed to just the header of the message." (define-key map "\e\C-l" 'rmail-summary-by-labels) (define-key map "\e\C-r" 'rmail-summary-by-recipients) (define-key map "\e\C-s" 'rmail-summary-by-regexp) + (define-key map "\e\C-f" 'rmail-summary-by-senders) (define-key map "\e\C-t" 'rmail-summary-by-topic) (define-key map "m" 'rmail-mail) (define-key map "\em" 'rmail-retry-failure) @@ -1034,8 +1030,8 @@ The buffer is expected to be narrowed to just the header of the message." (define-key map "/" 'rmail-end-of-message) (define-key map "<" 'rmail-first-message) (define-key map ">" 'rmail-last-message) - (define-key map " " 'scroll-up) - (define-key map "\177" 'scroll-down) + (define-key map " " 'scroll-up-command) + (define-key map "\177" 'scroll-down-command) (define-key map "?" 'describe-mode) (define-key map "\C-c\C-s\C-d" 'rmail-sort-by-date) (define-key map "\C-c\C-s\C-s" 'rmail-sort-by-subject) @@ -1309,9 +1305,14 @@ Create the buffer if necessary." (if (and (local-variable-p 'rmail-view-buffer) (buffer-live-p rmail-view-buffer)) rmail-view-buffer - (generate-new-buffer - (format " *message-viewer %s*" - (file-name-nondirectory (or buffer-file-name (buffer-name))))))) + (let ((newbuf + (generate-new-buffer + (format " *message-viewer %s*" + (file-name-nondirectory + (or buffer-file-name (buffer-name))))))) + (with-current-buffer newbuf + (add-hook 'kill-buffer-hook 'rmail-view-buffer-kill-buffer-hook nil t)) + newbuf))) (defun rmail-swap-buffers () "Swap text between current buffer and `rmail-view-buffer'. @@ -1371,7 +1372,14 @@ If so restore the actual mbox message collection." (message "Marking buffer unmodified to avoid rewriting Babyl file as mbox file"))) (defun rmail-mode-kill-buffer-hook () - (if (buffer-live-p rmail-view-buffer) (kill-buffer rmail-view-buffer))) + ;; Turn off the hook on the view buffer, so we can kill it, then kill it. + (if (buffer-live-p rmail-view-buffer) + (with-current-buffer rmail-view-buffer + (setq kill-buffer-hook nil) + (kill-buffer rmail-view-buffer)))) + +(defun rmail-view-buffer-kill-buffer-hook () + (error "Can't kill message view buffer by itself")) ;; Set up the permanent locals associated with an Rmail file. (defun rmail-perm-variables () @@ -1706,10 +1714,12 @@ not be a new one). It returns non-nil if it got any new messages." (setq all-files (cdr all-files))) ;; Put them back in their original order. (setq files (nreverse files)) - ;; In case of brain damage caused by require-final-newline. (goto-char (point-max)) - (skip-chars-backward " \t\n") - (delete-region (point) (point-max)) + ;; Make sure we end with a blank line unless there are + ;; no messages, as required by mbox format (Bug#9974). + (unless (bobp) + (while (not (looking-back "\n\n")) + (insert "\n"))) (setq found (or (rmail-get-new-mail-1 file-name files delete-files) found)))) @@ -2009,22 +2019,12 @@ Value is the size of the newly read mail after conversion." (rmail-unrmail-new-mail-maybe tofile (nth 1 (insert-file-contents tofile)))) - ;; Determine if a pair of newline message separators need - ;; to be added to the new collection of messages. This is - ;; the case for all new message collections added to a - ;; non-empty mail file. - (unless (zerop size) - (save-restriction - (let ((start (point-min))) - (widen) - (unless (eq start (point-min)) - (goto-char start) - (insert "\n\n") - (setq size (+ 2 size)))))) (goto-char (point-max)) - (or (= (preceding-char) ?\n) - (zerop size) - (insert ?\n)) + ;; Make sure the read-in mbox data properly ends with a + ;; blank line unless it is of size 0. + (unless (zerop size) + (while (not (looking-back "\n\n")) + (insert "\n"))) (if (not (and rmail-preserve-inbox (string= file tofile))) (setq delete-files (cons tofile delete-files))))) (message "") @@ -2064,7 +2064,7 @@ Call with point at the end of the message." (defun rmail-add-mbox-headers () "Validate the RFC2822 format for the new messages. Point should be at the first new message. -An error is signalled if the new messages are not RFC2822 +An error is signaled if the new messages are not RFC2822 compliant. Unless an Rmail attribute header already exists, add it to the new messages. Return the number of new messages." @@ -2433,7 +2433,7 @@ Output a helpful message unless NOMSG is non-nil." ;; the entry for message N+1, which marks ;; the end of message N. (N = number of messages). (setq messages-head (list (point-marker))) - (setq messages-after-point + (setq messages-after-point (or (rmail-set-message-counters-counter (min (point) point-save)) 0)) @@ -2595,6 +2595,8 @@ Ask the user whether to add that list name to `mail-mailing-lists'." "Return nil if there is mail, else \"No mail.\"." (if (zerop rmail-total-messages) (save-excursion + ;; Eg we deleted all the messages, so remove the old N/M mark. + (with-current-buffer rmail-buffer (setq mode-line-process nil)) (with-current-buffer rmail-view-buffer (erase-buffer) "No mail.")))) @@ -2691,6 +2693,7 @@ The current mail message becomes the message displayed." ;; inspect this value to determine how to toggle. (set (make-local-variable 'rmail-header-style) header-style)) (if (and rmail-enable-mime + rmail-show-mime-function (re-search-forward "mime-version: 1.0" nil t)) (let ((rmail-buffer mbox-buf) (rmail-view-buffer view-buf)) @@ -3087,7 +3090,7 @@ but probably is garbage." ;; correspond to the lines in the inbox file. (goto-char (point-min)) (if header-field - (progn + (progn (re-search-forward (concat "^" (regexp-quote header-field)) nil t) (forward-line line-number-within)) (search-forward "\n\n" nil t) @@ -3248,6 +3251,7 @@ Interactively, empty argument means use same regexp used last time." Simplifying the subject means stripping leading and trailing whitespace, and typical reply prefixes such as Re:." (let ((subject (or (rmail-get-header "Subject" msgnum) ""))) + (setq subject (rfc2047-decode-string subject)) (if (string-match "\\`[ \t]+" subject) (setq subject (substring subject (match-end 0)))) (if (string-match rmail-reply-regexp subject) @@ -3794,9 +3798,17 @@ see the documentation of `rmail-resend'." ;; Insert after header separator--before signature if any. (rfc822-goto-eoh) (forward-line 1) - (if (or rmail-enable-mime rmail-enable-mime-composing) - (funcall rmail-insert-mime-forwarded-message-function - forward-buffer) + (if (and rmail-enable-mime rmail-enable-mime-composing) + (prog1 + (funcall rmail-insert-mime-forwarded-message-function + forward-buffer) + ;; rmail-insert-mime-forwarded-message-function + ;; works by inserting MML tags into forward-buffer. + ;; The MUA will need to convert it to MIME before + ;; sending. mail-encode-mml tells them to do that. + ;; message.el does that automagically. + (or (eq mail-user-agent 'message-user-agent) + (setq mail-encode-mml t))) (insert "------- Start of forwarded message -------\n") ;; Quote lines with `- ' if they start with `-'. (let ((beg (point)) end) @@ -4249,7 +4261,7 @@ TEXT and INDENT are not used." ;; rmail-output expands non-absolute filenames against rmail-default-file. ;; What is the point of that, anyway? (rmail-output (expand-file-name token)))) - + ;; Functions for setting, getting and encoding the POP password. ;; The password is encoded to prevent it from being easily accessible ;; to "prying eyes." Obviously, this encoding isn't "real security," @@ -4300,6 +4312,85 @@ encoded string (and the same mask) will decode the string." (setq i (1+ i))) (concat string-vector))) +(defun rmail-epa-decrypt () + "Decrypt OpenPGP armors in current message." + (interactive) + + ;; Save the current buffer here for cleanliness, in case we + ;; change it in one of the calls to `epa-decrypt-region'. + + (save-excursion + (let (decrypts) + (goto-char (point-min)) + + ;; In case the encrypted data is inside a mime attachment, + ;; show it. This is a kludge; to be clean, it should not + ;; modify the buffer, but I don't see how to do that. + (when (search-forward "octet-stream" nil t) + (beginning-of-line) + (forward-button 1) + (if (looking-at "Show") + (rmail-mime-toggle-hidden))) + + ;; Now find all armored messages in the buffer + ;; and decrypt them one by one. + (goto-char (point-min)) + (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) + (let ((coding-system-for-read coding-system-for-read) + armor-start armor-end after-end) + (setq armor-start (match-beginning 0) + armor-end (re-search-forward "^-----END PGP MESSAGE-----$" + nil t)) + (unless armor-end + (error "Encryption armor beginning has no matching end")) + (goto-char armor-start) + + ;; Because epa--find-coding-system-for-mime-charset not autoloaded. + (require 'epa) + + ;; Use the charset specified in the armor. + (unless coding-system-for-read + (if (re-search-forward "^Charset: \\(.*\\)" armor-end t) + (setq coding-system-for-read + (epa--find-coding-system-for-mime-charset + (intern (downcase (match-string 1))))))) + + ;; Advance over this armor. + (goto-char armor-end) + (setq after-end (- (point-max) armor-end)) + + ;; Decrypt it, maybe in place, maybe making new buffer. + (epa-decrypt-region + armor-start armor-end + ;; Call back this function to prepare the output. + (lambda () + (let ((inhibit-read-only t)) + (delete-region armor-start armor-end) + (goto-char armor-start) + (current-buffer)))) + + (push (list armor-start (- (point-max) after-end)) + decrypts))) + + (when (and decrypts (rmail-buffers-swapped-p)) + (when (y-or-n-p "Replace the original message? ") + (setq decrypts (nreverse decrypts)) + (let ((beg (rmail-msgbeg rmail-current-message)) + (end (rmail-msgend rmail-current-message)) + (from-buffer (current-buffer))) + (with-current-buffer rmail-view-buffer + (narrow-to-region beg end) + (goto-char (point-min)) + (dolist (d decrypts) + (if (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) + (let (armor-start armor-end) + (setq armor-start (match-beginning 0) + armor-end (re-search-forward "^-----END PGP MESSAGE-----$" + nil t)) + (when armor-end + (delete-region armor-start armor-end) + (insert-buffer-substring from-buffer (nth 0 d) (nth 1 d))))))))))))) + ;;;; Desktop support (defun rmail-restore-desktop-buffer (desktop-buffer-file-name @@ -4403,7 +4494,7 @@ With prefix argument N moves forward N messages with these labels. ;;;*** -;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "a7d3e7205efa4e20ca9038c9b260ce83") +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "5d992206e382290d07ad7d9a2bf250c9") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ @@ -4504,7 +4595,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order. ;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic ;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels -;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "3817e21639db697abe5832d3223ecfc2") +;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "35e07b0a5ea8e41971f31a8780eba6bb") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\