]> code.delx.au - gnu-emacs/blobdiff - lisp/mail/rmail.el
Merge changes from emacs-23 branch.
[gnu-emacs] / lisp / mail / rmail.el
index 7e817de7f64a40ddbec4dac6a6e603691e23236c..47e52f27aa162447864cb8b47027449ff1a662e8 100644 (file)
@@ -1,7 +1,7 @@
 ;;; rmail.el --- main code of "RMAIL" mail reader for Emacs
 
 ;; Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
-;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
@@ -191,8 +191,6 @@ please report it with \\[report-emacs-bug].")
   :group 'rmail-retrieve
   :type '(repeat (directory)))
 
-(declare-function mail-position-on-field "sendmail" (field &optional soft))
-(declare-function mail-text-start "sendmail" ())
 (declare-function rmail-dont-reply-to "mail-utils" (destinations))
 (declare-function rmail-update-summary "rmailsum" (&rest ignore))
 
@@ -297,7 +295,7 @@ also the To field, unless this would leave an empty To field."
   :group 'rmail-reply)
 
 ;;;###autoload
-(defvar rmail-default-dont-reply-to-names "\\`info-"
+(defvar rmail-default-dont-reply-to-names (purecopy "\\`info-")
   "Regexp specifying part of the default value of `rmail-dont-reply-to-names'.
 This is used when the user does not set `rmail-dont-reply-to-names'
 explicitly.  (The other part of the default value is the user's
@@ -308,6 +306,7 @@ used for large mailing lists to broadcast announcements.")
 
 ;;;###autoload
 (defcustom rmail-ignored-headers
+  (purecopy
   (concat "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^sender:"
          "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:"
          "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:"
@@ -324,7 +323,7 @@ used for large mailing lists to broadcast announcements.")
          "\\|^mbox-line:\\|^cancel-lock:"
          "\\|^DomainKey-Signature:\\|^dkim-signature:"
          "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:"
-         "\\|^x-.*:")
+         "\\|^x-.*:"))
   "Regexp to match header fields that Rmail should normally hide.
 \(See also `rmail-nonignored-headers', which overrides this regexp.)
 This variable is used for reformatting the message header,
@@ -360,14 +359,14 @@ If nil, display all header fields except those matched by
   :group 'rmail-headers)
 
 ;;;###autoload
-(defcustom rmail-retry-ignored-headers "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:"
+(defcustom rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:")
   "Headers that should be stripped when retrying a failed message."
   :type '(choice regexp (const nil :tag "None"))
   :group 'rmail-headers
   :version "23.2")        ; added x-detected-operating-system, x-spam
 
 ;;;###autoload
-(defcustom rmail-highlighted-headers "^From:\\|^Subject:"
+(defcustom rmail-highlighted-headers (purecopy "^From:\\|^Subject:")
   "Regexp to match Header fields that Rmail should normally highlight.
 A value of nil means don't highlight.  Uses the face `rmail-highlight'."
   :type 'regexp
@@ -380,6 +379,20 @@ The variable `rmail-highlighted-headers' specifies which headers."
   :group 'rmail-headers
   :version "22.1")
 
+;; This was removed in Emacs 23.1 with no notification, an unnecessary
+;; incompatible change.
+(defcustom rmail-highlight-face 'rmail-highlight
+  "Face used by Rmail for highlighting headers."
+  ;; Note that nil doesn't actually mean use the default face, it
+  ;; means use either bold or highlight. It's not worth fixing this
+  ;; now that this is obsolete.
+  :type '(choice (const :tag "Default" nil)
+                face)
+  :group 'rmail-headers)
+(make-obsolete-variable 'rmail-highlight-face
+                       "customize the face `rmail-highlight' instead."
+                       "23.2")
+
 (defface rmail-header-name
   '((t (:inherit font-lock-function-name-face)))
   "Face to use for highlighting the header names.
@@ -418,12 +431,12 @@ the frame where you have the RMAIL buffer displayed."
   :group 'rmail-reply)
 
 ;;;###autoload
-(defcustom rmail-secondary-file-directory "~/"
+(defcustom rmail-secondary-file-directory (purecopy "~/")
   "Directory for additional secondary Rmail files."
   :type 'directory
   :group 'rmail-files)
 ;;;###autoload
-(defcustom rmail-secondary-file-regexp "\\.xmail$"
+(defcustom rmail-secondary-file-regexp (purecopy "\\.xmail$")
   "Regexp for which files are secondary Rmail files."
   :type 'regexp
   :group 'rmail-files)
@@ -791,6 +804,12 @@ that knows the exact ordering of the \\( \\) subexpressions.")
              . 'rmail-header-name))))
   "Additional expressions to highlight in Rmail mode.")
 
+;; Rmail does not expect horizontal splitting.  (Bug#2282)
+(defun rmail-pop-to-buffer (&rest args)
+  "Like `pop-to-buffer', but with `split-width-threshold' set to nil."
+  (let (split-width-threshold)
+    (apply 'pop-to-buffer args)))
+
 ;; Perform BODY in the summary buffer
 ;; in such a way that its cursor is properly updated in its own window.
 (defmacro rmail-select-summary (&rest body)
@@ -800,7 +819,7 @@ that knows the exact ordering of the \\( \\) subexpressions.")
           (save-excursion
             (unwind-protect
                 (progn
-                  (pop-to-buffer rmail-summary-buffer)
+                  (rmail-pop-to-buffer rmail-summary-buffer)
                   ;; rmail-total-messages is a buffer-local var
                   ;; in the rmail buffer.
                   ;; This way we make it available for the body
@@ -1309,13 +1328,19 @@ Create the buffer if necessary."
 This function preserves the current buffer's modified flag, and also
 sets the current buffer's `buffer-file-coding-system' to that of
 `rmail-view-buffer'."
-  (let ((modp (buffer-modified-p))
-       (coding
+  (let ((modp-this (buffer-modified-p))
+       (modp-that
+        (with-current-buffer rmail-view-buffer (buffer-modified-p)))
+       (coding-this buffer-file-coding-system)
+       (coding-that
         (with-current-buffer rmail-view-buffer
           buffer-file-coding-system)))
     (buffer-swap-text rmail-view-buffer)
-    (setq buffer-file-coding-system coding)
-    (restore-buffer-modified-p modp)))
+    (setq buffer-file-coding-system coding-that)
+    (with-current-buffer rmail-view-buffer
+      (setq buffer-file-coding-system coding-this)
+      (restore-buffer-modified-p modp-that))
+    (restore-buffer-modified-p modp-this)))
 
 (defun rmail-buffers-swapped-p ()
   "Return non-nil if the message collection is in `rmail-view-buffer'."
@@ -1616,8 +1641,6 @@ The duplicate copy goes into the Rmail file just after the original."
 (declare-function rmail-summary-mark-deleted "rmailsum" (&optional n undel))
 (declare-function rfc822-addresses "rfc822" (header-text))
 (declare-function mail-abbrev-make-syntax-table "mailabbrev.el" ())
-(declare-function mail-sendmail-delimit-header "sendmail" ())
-(declare-function mail-header-end "sendmail" ())
 
 ;; RLK feature not added in this version:
 ;; argument specifies inbox file or files in various ways.
@@ -2714,9 +2737,14 @@ The current mail message becomes the message displayed."
            (insert-buffer-substring mbox-buf body-start end)
            (cond
             ((string= character-coding "quoted-printable")
-             (mail-unquote-printable-region (point-min) (point-max)))
+             ;; See bug#5441.
+             (or (mail-unquote-printable-region (point-min) (point-max)
+                                                nil t 'unibyte)
+                 (message "Malformed MIME quoted-printable message")))
             ((and (string= character-coding "base64") is-text-message)
-             (base64-decode-region (point-min) (point-max)))
+             (condition-case err
+                 (base64-decode-region (point-min) (point-max))
+               (error (message "%s" (cdr err)))))
             ((eq character-coding 'uuencode)
              (error "uuencoded messages are not supported yet"))
             (t))
@@ -2867,7 +2895,7 @@ using the coding system CODING."
 
 (defun rmail-highlight-headers ()
   "Highlight the headers specified by `rmail-highlighted-headers'.
-Uses the face `rmail-highlight'."
+Uses the face specified by `rmail-highlight-face'."
   (if rmail-highlighted-headers
       (save-excursion
        (search-forward "\n\n" nil 'move)
@@ -2875,6 +2903,11 @@ Uses the face `rmail-highlight'."
          (narrow-to-region (point-min) (point))
          (let ((case-fold-search t)
                (inhibit-read-only t)
+               ;; When rmail-highlight-face is removed, just
+               ;; use 'rmail-highlight here.
+               (face (or rmail-highlight-face
+                         (if (face-differs-from-default-p 'bold)
+                             'bold 'highlight)))
                ;; List of overlays to reuse.
                (overlays rmail-overlay-list))
            (goto-char (point-min))
@@ -2893,12 +2926,12 @@ Uses the face `rmail-highlight'."
                    (progn
                      (setq overlay (car overlays)
                            overlays (cdr overlays))
-                     (overlay-put overlay 'face 'rmail-highlight)
+                     (overlay-put overlay 'face face)
                      (move-overlay overlay beg (point)))
                  ;; Make a new overlay and add it to
                  ;; rmail-overlay-list.
                  (setq overlay (make-overlay beg (point)))
-                 (overlay-put overlay 'face 'rmail-highlight)
+                 (overlay-put overlay 'face face)
                  (setq rmail-overlay-list
                        (cons overlay rmail-overlay-list))))))))))
 
@@ -3651,7 +3684,8 @@ see the documentation of `rmail-resend'."
          ;; The mail buffer is now current.
          (save-excursion
            ;; Insert after header separator--before signature if any.
-           (goto-char (mail-text-start))
+           (rfc822-goto-eoh)
+           (forward-line 1)
            (if (or rmail-enable-mime rmail-enable-mime-composing)
                (funcall rmail-insert-mime-forwarded-message-function
                         forward-buffer)
@@ -3806,6 +3840,8 @@ The message should be narrowed to just the headers."
                           (1- (point))
                         (point-max)))))))
 
+(autoload 'mail-position-on-field "sendmail")
+
 (defun rmail-retry-failure ()
   "Edit a mail message which is based on the contents of the current message.
 For a message rejected by the mail system, extract the interesting headers and
@@ -3890,16 +3926,19 @@ specifying headers which should not be copied into the new message."
          ;; Insert original text as initial text of new draft message.
          ;; Bind inhibit-read-only since the header delimiter
          ;; of the previous message was probably read-only.
-         (let ((inhibit-read-only t))
+         (let ((inhibit-read-only t)
+               eoh)
            (erase-buffer)
            (insert-buffer-substring rmail-this-buffer
                                     bounce-start bounce-end)
            (goto-char (point-min))
            (if bounce-indent
                (indent-rigidly (point-min) (point-max) bounce-indent))
-           (mail-sendmail-delimit-header)
+           (rfc822-goto-eoh)
+           (setq eoh (point))
+           (insert mail-header-separator)
            (save-restriction
-             (narrow-to-region (point-min) (mail-header-end))
+             (narrow-to-region (point-min) eoh)
              (rmail-delete-headers rmail-retry-ignored-headers)
              (rmail-delete-headers "^\\(sender\\|return-path\\|received\\):")
              (setq resending (mail-fetch-field "resent-to"))
@@ -4172,18 +4211,36 @@ encoded string (and the same mask) will decode the string."
 (add-to-list 'desktop-buffer-mode-handlers
             '(rmail-mode . rmail-restore-desktop-buffer))
 
+;; We use this to record the encoding of the current message before
+;; saving the message collection.
+(defvar rmail-message-encoding nil)
+
 ;; Used in `write-region-annotate-functions' to write rmail files.
 (defun rmail-write-region-annotate (start end)
   (when (and (null start) (rmail-buffers-swapped-p))
+    (setq rmail-message-encoding buffer-file-coding-system)
     (set-buffer rmail-view-buffer)
     (widen)
     nil))
 
+;; Used to restore the encoding of the buffer where we show the
+;; current message, after we save the message collection.  This is
+;; needed because rmail-write-region-annotate switches buffers behind
+;; save-file's back, with the side effect that last-coding-system-used
+;; is assigned to buffer-file-coding-system of the wrong buffer.
+(defun rmail-after-save-hook ()
+  (if (or (eq rmail-view-buffer (current-buffer))
+         (eq rmail-buffer (current-buffer)))
+      (with-current-buffer
+         (if (rmail-buffers-swapped-p) rmail-buffer rmail-view-buffer)
+       (setq buffer-file-coding-system rmail-message-encoding))))
+(add-hook 'after-save-hook 'rmail-after-save-hook)
+
 \f
 ;;; Start of automatically extracted autoloads.
 \f
 ;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el"
-;;;;;;  "31f0128d57ee5aefe13ec6060a5c63cc")
+;;;;;;  "4bf8a5cdfc921b9e30680ee71b7f9ca6")
 ;;; Generated autoloads from rmailedit.el
 
 (autoload 'rmail-edit-current-message "rmailedit" "\
@@ -4195,7 +4252,7 @@ Edit the contents of this message.
 \f
 ;;;### (autoloads (rmail-next-labeled-message rmail-previous-labeled-message
 ;;;;;;  rmail-read-label rmail-kill-label rmail-add-label) "rmailkwd"
-;;;;;;  "rmailkwd.el" "2e986921026eea971b49e91f53967f77")
+;;;;;;  "rmailkwd.el" "112240cbb53c402294013cc49987771a")
 ;;; Generated autoloads from rmailkwd.el
 
 (autoload 'rmail-add-label "rmailkwd" "\
@@ -4238,7 +4295,7 @@ With prefix argument N moves forward N messages with these labels.
 
 ;;;***
 \f
-;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "ab34439779d8036dbd5cdc80fb4cea64")
+;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "9f67f3b67de9b700b128b73c52abfefa")
 ;;; Generated autoloads from rmailmm.el
 
 (autoload 'rmail-mime "rmailmm" "\
@@ -4254,7 +4311,7 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'.
 ;;;***
 \f
 ;;;### (autoloads (set-rmail-inbox-list) "rmailmsc" "rmailmsc.el"
-;;;;;;  "de01c37c81339201034a01732b97f44e")
+;;;;;;  "c3575020691d5769bcf08ecc932304c3")
 ;;; Generated autoloads from rmailmsc.el
 
 (autoload 'set-rmail-inbox-list "rmailmsc" "\
@@ -4270,7 +4327,7 @@ This applies only to the current session.
 \f
 ;;;### (autoloads (rmail-sort-by-labels rmail-sort-by-lines rmail-sort-by-correspondent
 ;;;;;;  rmail-sort-by-recipient rmail-sort-by-author rmail-sort-by-subject
-;;;;;;  rmail-sort-by-date) "rmailsort" "rmailsort.el" "3f2b10b0272ea56cb604f29330d95fc4")
+;;;;;;  rmail-sort-by-date) "rmailsort" "rmailsort.el" "b96e85edd736f23f1e9d54a299268d1e")
 ;;; Generated autoloads from rmailsort.el
 
 (autoload 'rmail-sort-by-date "rmailsort" "\
@@ -4329,7 +4386,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order.
 \f
 ;;;### (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" "60bec0ae88b7ed18dd6845ddb9ccd904")
+;;;;;;  rmail-summary) "rmailsum" "rmailsum.el" "4715fb58fb191bf6b192458ea75524b2")
 ;;; Generated autoloads from rmailsum.el
 
 (autoload 'rmail-summary "rmailsum" "\
@@ -4377,7 +4434,7 @@ SENDERS is a string of regexps separated by commas.
 ;;;***
 \f
 ;;;### (autoloads (unforward-rmail-message undigestify-rmail-message)
-;;;;;;  "undigest" "undigest.el" "b691540ddff5c394e9ebc3517051445f")
+;;;;;;  "undigest" "undigest.el" "8cf8a8ffa48eeddf0bde388fa8de1783")
 ;;; Generated autoloads from undigest.el
 
 (autoload 'undigestify-rmail-message "undigest" "\
@@ -4400,5 +4457,4 @@ following the containing message.
 
 (provide 'rmail)
 
-;; arch-tag: 65d257d3-c281-4a65-9c38-e61af95af2f0
 ;;; rmail.el ends here