Merge from emacs-24; up to 2012-04-25T15:23:19Z!sdl.web@gmail.com
[bpt/emacs.git] / lisp / mail / rmail.el
index a8efe10..9fe8f28 100644 (file)
@@ -1,6 +1,6 @@
 ;;; rmail.el --- main code of "RMAIL" mail reader for Emacs
 
-;; Copyright (C) 1985-1988, 1993-1998, 2000-2011
+;; Copyright (C) 1985-1988, 1993-1998, 2000-2012
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
@@ -40,6 +40,9 @@
 (require 'mail-utils)
 (require 'rfc2047)
 
+(declare-function compilation--message->loc "compile" (cl-x) t)
+(declare-function epa--find-coding-system-for-mime-charset "epa" (mime-charset))
+
 (defconst rmail-attribute-header "X-RMAIL-ATTRIBUTES"
   "The header that stores the Rmail attribute data.")
 
@@ -97,8 +100,6 @@ its character representation and its display representation.")
   "The current header display style choice, one of
 'normal (selected headers) or 'full (all headers).")
 
-;; rmail-spool-directory and rmail-file-name are defined in paths.el.
-
 (defgroup rmail nil
   "Mail reader for Emacs."
   :group 'mail)
@@ -140,6 +141,40 @@ its character representation and its display representation.")
   :prefix "rmail-edit-"
   :group 'rmail)
 
+;;;###autoload
+(defcustom rmail-file-name (purecopy "~/RMAIL")
+  "Name of user's primary mail file."
+  :type 'string
+  :group 'rmail
+  :version "21.1")
+
+;;;###autoload
+(put 'rmail-spool-directory 'standard-value
+     '((cond ((file-exists-p "/var/mail") "/var/mail/")
+            ((file-exists-p "/var/spool/mail") "/var/spool/mail/")
+            ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/")
+            (t "/usr/spool/mail/"))))
+
+;;;###autoload
+(defcustom rmail-spool-directory
+  (purecopy
+  (cond ((file-exists-p "/var/mail")
+        ;; SVR4 and recent BSD are said to use this.
+        ;; Rather than trying to know precisely which systems use it,
+        ;; let's assume this dir is never used for anything else.
+        "/var/mail/")
+       ;; Many GNU/Linux systems use this name.
+       ((file-exists-p "/var/spool/mail") "/var/spool/mail/")
+       ((memq system-type '(hpux usg-unix-v irix)) "/usr/mail/")
+       (t "/usr/spool/mail/")))
+  "Name of directory used by system mailer for delivering new mail.
+Its name should end with a slash."
+  :initialize 'custom-initialize-delay
+  :type 'directory
+  :group 'rmail)
+
+;;;###autoload(custom-initialize-delay 'rmail-spool-directory nil)
+
 (defcustom rmail-movemail-program nil
   "If non-nil, the file name of the `movemail' program."
   :group 'rmail-retrieve
@@ -285,8 +320,10 @@ Setting this variable has an effect only before reading a mail."
   :version "21.1")
 
 ;;;###autoload
-(defvaralias 'rmail-dont-reply-to-names 'mail-dont-reply-to-names)
+(define-obsolete-variable-alias 'rmail-dont-reply-to-names
+  'mail-dont-reply-to-names "24.1")
 
+;; Prior to 24.1, this used to contain "\\`info-".
 ;;;###autoload
 (defvar rmail-default-dont-reply-to-names nil
   "Regexp specifying part of the default value of `mail-dont-reply-to-names'.
@@ -482,6 +519,7 @@ still the current message in the Rmail buffer.")
 ;; It's not clear what it should do now, since there is nothing that
 ;; records when a message is shown for the first time (unseen is not
 ;; necessarily the same thing).
+;; See http://lists.gnu.org/archive/html/emacs-devel/2009-03/msg00013.html
 (defcustom rmail-message-filter nil
   "If non-nil, a filter function for new messages in RMAIL.
 Called with region narrowed to the message, including headers,
@@ -489,30 +527,41 @@ before obeying `rmail-ignored-headers'."
   :group 'rmail-headers
   :type '(choice (const nil) function))
 
+(make-obsolete-variable 'rmail-message-filter
+                       "it is not used (try `rmail-show-message-hook')."
+                       "23.1")
+
 (defcustom rmail-automatic-folder-directives nil
-  "List of directives specifying where to put a message.
+  "List of directives specifying how to automatically file messages.
+Whenever Rmail shows a message in the folder that `rmail-file-name'
+specifies, it calls `rmail-auto-file' to maybe file the message in
+another folder according to this list.  Messages that are already
+marked as `filed', or are in different folders, are left alone.
+
 Each element of the list is of the form:
 
   (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... )
 
-Where FOLDERNAME is the name of a folder to put the message.
-If any of the field regexp's are nil, then it is ignored.
+FOLDERNAME is the name of a folder in which to put the message.
+If FOLDERNAME is nil then Rmail deletes the message, and moves on to
+the next.  If FOLDERNAME is \"/dev/null\", Rmail deletes the message,
+but does not move to the next.
 
-If FOLDERNAME is \"/dev/null\", it is deleted.
-If FOLDERNAME is nil then it is deleted, and skipped.
+FIELD is the name of a header field in the message, such as
+\"subject\" or \"from\".  A FIELD of \"to\" includes all text
+from both the \"to\" and \"cc\" headers.
 
-FIELD is the plain text name of a field in the message, such as
-\"subject\" or \"from\".  A FIELD of \"to\" will automatically include
-all text from the \"cc\" field as well.
+REGEXP is a regular expression to match (case-sensitively) against
+the preceding specified FIELD.
 
-REGEXP is an expression to match in the preceding specified FIELD.
-FIELD/REGEXP pairs continue in the list.
+There may be any number of FIELD/REGEXP pairs.
+All pairs must match for a directive to apply to a message.
+For a given message, Rmail applies only the first matching directive.
 
-examples:
+Examples:
   (\"/dev/null\" \"from\" \"@spam.com\") ; delete all mail from spam.com
   (\"RMS\" \"from\" \"rms@\") ; save all mail from RMS.
-
-Note that this is only applied in the folder specifed by `rmail-file-name'."
+"
   :group 'rmail
   :version "21.1"
   :type '(repeat (sexp :tag "Directive")))
@@ -552,7 +601,9 @@ In a summary buffer, this holds the RMAIL buffer it is a summary for.")
 ;; Message counters and markers.  Deleted flags.
 
 (defvar rmail-current-message nil
-  "Integer specifying the message currently being displayed in this folder.")
+  "Integer specifying the message currently being displayed in this folder.
+Counts messages from 1 to `rmail-total-messages'.  A value of 0
+means there are no messages in the folder.")
 (put 'rmail-current-message 'permanent-local t)
 
 (defvar rmail-total-messages nil
@@ -694,19 +745,6 @@ to an appropriate value, and optionally also set
 `rmail-insert-mime-forwarded-message-function', and
 `rmail-insert-mime-resent-message-function'.")
 
-;; FIXME this is unused since 23.1.
-(defvar rmail-decode-mime-charset t
-  "*Non-nil means a message is decoded by MIME's charset specification.
-If this variable is nil, or the message has not MIME specification,
-the message is decoded as normal way.
-
-If the variable `rmail-enable-mime' is non-nil, this variable is
-ignored, and all the decoding work is done by a feature specified by
-the variable `rmail-mime-feature'.")
-
-(make-obsolete-variable 'rmail-decode-mime-charset
-                       "it does nothing." "23.1")
-
 (defvar rmail-mime-charset-pattern
   (concat "^content-type:[ \t]*text/plain;"
          "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
@@ -777,7 +815,7 @@ that knows the exact ordering of the \\( \\) subexpressions.")
   ;; These are all matched case-insensitively.
   (eval-when-compile
     (let* ((cite-chars "[>|}]")
-          (cite-prefix "a-z")
+          (cite-prefix "[:alpha:]")
           (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
       (list '("^\\(From\\|Sender\\|Resent-From\\):"
              . 'rmail-header-name)
@@ -1347,8 +1385,7 @@ sets the current buffer's `buffer-file-coding-system' to that of
 (defun rmail-buffers-swapped-p ()
   "Return non-nil if the message collection is in `rmail-view-buffer'."
   ;; This is analogous to tar-data-swapped-p in tar-mode.el.
-  (and (buffer-live-p rmail-view-buffer)
-       rmail-buffer-swapped))
+  rmail-buffer-swapped)
 
 (defun rmail-change-major-mode-hook ()
   ;; Bring the actual Rmail messages back into the main buffer.
@@ -1390,7 +1427,8 @@ If so restore the actual mbox message collection."
        (kill-buffer rmail-view-buffer))))
 
 (defun rmail-view-buffer-kill-buffer-hook ()
-  (error "Can't kill message view buffer by itself"))
+  (error "Can't kill Rmail view buffer `%s' by itself"
+        (buffer-name (current-buffer))))
 
 ;; Set up the permanent locals associated with an Rmail file.
 (defun rmail-perm-variables ()
@@ -2759,7 +2797,15 @@ The current mail message becomes the message displayed."
              (forward-line))
            (goto-char (point-min)))
          ;; Copy the headers to the front of the message view buffer.
-         (rmail-copy-headers beg end))
+         (rmail-copy-headers beg end)
+         ;; Decode any RFC2047 encoded message headers.
+         (if rmail-enable-mime
+             (with-current-buffer rmail-view-buffer
+               (rfc2047-decode-region
+                (point-min)
+                (progn
+                  (search-forward "\n\n" nil 'move)
+                  (point))))))
        ;; highlight the message, activate any URL like text and add
        ;; special highlighting for and quoted material.
        (with-current-buffer rmail-view-buffer
@@ -2934,8 +2980,11 @@ Uses the face specified by `rmail-highlight-face'."
                        (cons overlay rmail-overlay-list))))))))))
 
 (defun rmail-auto-file ()
-  "Automatically move a message into a sub-folder based on criteria.
-Called when a new message is displayed."
+  "Automatically move a message into another sfolder based on criteria.
+This moves messages according to `rmail-automatic-folder-directives'.
+It only does something in the folder that `rmail-file-name' specifies.
+The function `rmail-show-message' calls this whenever it shows a message.
+This leaves a message alone if it already has the `filed' attribute."
   (if (or (zerop rmail-total-messages)
          (rmail-message-attr-p rmail-current-message "...F")
          (not (string= (buffer-file-name)
@@ -2955,10 +3004,14 @@ Called when a new message is displayed."
              directive-loop (cdr (car d)))
        (while (and (car directive-loop)
                    (let ((f (cond
-                             ((string= (car directive-loop) "from") from)
-                             ((string= (car directive-loop) "to") to)
-                             ((string= (car directive-loop) "subject") subj)
+                             ((string= (downcase (car directive-loop)) "from")
+                              from)
+                             ((string= (downcase (car directive-loop)) "to")
+                              to)
+                             ((string= (downcase (car directive-loop))
+                                       "subject") subj)
                              (t (mail-fetch-field (car directive-loop))))))
+                     ;; FIXME - shouldn't this ignore case?
                      (and f (string-match (car (cdr directive-loop)) f))))
          (setq directive-loop (cdr (cdr directive-loop))))
        ;; If there are no directives left, then it was a complete match.
@@ -3529,6 +3582,25 @@ does not pop any summary buffer."
 \f
 ;;;; *** Rmail Mailing Commands ***
 
+(defun rmail-yank-current-message (buffer)
+  "Yank into the current buffer the current message of Rmail buffer BUFFER.
+If BUFFER is swapped with its message viewer buffer, yank out of BUFFER.
+If BUFFER is not swapped, yank out of its message viewer buffer."
+  (with-current-buffer buffer
+    (unless (rmail-buffers-swapped-p)
+      (setq buffer rmail-view-buffer)))
+  (insert-buffer-substring buffer)
+  ;; If they yank the text of BUFFER, the encoding of BUFFER is a
+  ;; better default for the reply message than the default value of
+  ;; buffer-file-coding-system.
+  (and (coding-system-equal (default-value 'buffer-file-coding-system)
+                           buffer-file-coding-system)
+       (setq buffer-file-coding-system
+            (coding-system-change-text-conversion
+             buffer-file-coding-system (coding-system-base
+                                        (with-current-buffer buffer
+                                          buffer-file-coding-system))))))
+
 (defun rmail-start-mail (&optional noerase to subject in-reply-to cc
                                   replybuffer sendactions same-window
                                   other-headers)
@@ -3540,7 +3612,8 @@ does not pop any summary buffer."
     (if replybuffer
        ;; The function used here must behave like insert-buffer wrt
        ;; point and mark (see doc of sc-cite-original).
-       (setq yank-action (list 'insert-buffer replybuffer)))
+       (setq yank-action
+             `(rmail-yank-current-message ,replybuffer)))
     (push (cons "cc" cc) other-headers)
     (push (cons "in-reply-to" in-reply-to) other-headers)
     (setq other-headers
@@ -3555,15 +3628,18 @@ does not pop any summary buffer."
     (if (stringp subject) (setq subject (rfc2047-decode-string subject)))
     (prog1
        (compose-mail to subject other-headers noerase
-                     switch-function yank-action sendactions)
+                     switch-function yank-action sendactions
+                     (if replybuffer `(rmail-mail-return ,replybuffer)))
       (if (eq switch-function 'switch-to-buffer-other-frame)
          ;; This is not a standard frame parameter; nothing except
          ;; sendmail.el looks at it.
-           (modify-frame-parameters (selected-frame)
+         (modify-frame-parameters (selected-frame)
                                   '((mail-dedicated-frame . t)))))))
 
 (defun rmail-mail-return (&optional newbuf)
-  "NEWBUF is a buffer to switch to."
+  "Try to return to Rmail from the mail window.
+If optional argument NEWBUF is specified, it is the Rmail buffer
+to switch to."
   (cond
    ;; If there is only one visible frame with no special handling,
    ;; consider deleting the mail window to return to Rmail.
@@ -3573,23 +3649,30 @@ does not pop any summary buffer."
                 (cdr (assq 'mail-dedicated-frame
                            (frame-parameters))))))
     (let (rmail-flag summary-buffer)
-      (and (not (one-window-p))
-          (with-current-buffer
-              (window-buffer (next-window (selected-window) 'not))
-            (setq rmail-flag (eq major-mode 'rmail-mode))
-            (setq summary-buffer
-                  (and (boundp 'mail-bury-selects-summary)
-                       mail-bury-selects-summary
-                       (boundp 'rmail-summary-buffer)
-                       rmail-summary-buffer
-                       (buffer-name rmail-summary-buffer)
-                       (not (get-buffer-window rmail-summary-buffer))
-                       rmail-summary-buffer))))
-      (if rmail-flag
-         ;; If the Rmail buffer has a summary, show that.
-         (if summary-buffer (switch-to-buffer summary-buffer)
-           (delete-window))
-       (switch-to-buffer newbuf))))
+      (unless (one-window-p)
+       (with-current-buffer
+           (window-buffer (next-window (selected-window) 'not))
+         (setq rmail-flag (eq major-mode 'rmail-mode))
+         (setq summary-buffer
+               (and (boundp 'mail-bury-selects-summary)
+                    mail-bury-selects-summary
+                    (boundp 'rmail-summary-buffer)
+                    rmail-summary-buffer
+                    (buffer-name rmail-summary-buffer)
+                    (not (get-buffer-window rmail-summary-buffer))
+                    rmail-summary-buffer))))
+      (cond ((null rmail-flag)
+            ;; If the Rmail buffer is not in the next window, switch
+            ;; directly to the Rmail buffer specified by NEWBUF.
+            (if (buffer-live-p newbuf)
+                (switch-to-buffer newbuf)))
+           ;; If the Rmail buffer is in the next window, switch to
+           ;; the summary buffer if `mail-bury-selects-summary' is
+           ;; non-nil.  Otherwise just delete this window.
+           (summary-buffer
+            (switch-to-buffer summary-buffer))
+           (t
+            (delete-window)))))
    ;; If the frame was probably made for this buffer, the user
    ;; probably wants to delete it now.
    ((display-multi-frame-p)
@@ -3603,7 +3686,7 @@ does not pop any summary buffer."
 While composing the message, use \\[mail-yank-original] to yank the
 original message into it."
   (interactive)
-  (rmail-start-mail nil nil nil nil nil rmail-view-buffer))
+  (rmail-start-mail nil nil nil nil nil rmail-buffer))
 
 ;; FIXME should complain if there is nothing to continue.
 (defun rmail-continue ()
@@ -3690,9 +3773,7 @@ use \\[mail-yank-original] to yank the original message into it."
                        (mail-strip-quoted-names
                         (if (null cc) to (concat to ", " cc))))))
         (if (string= cc-list "") nil cc-list)))
-     (if (rmail-buffers-swapped-p)
-        rmail-buffer
-       rmail-view-buffer)
+     rmail-buffer
      (list (list 'rmail-mark-message
                 rmail-buffer
                 (with-current-buffer rmail-buffer
@@ -3779,6 +3860,8 @@ which is an element of rmail-msgref-vector."
 With prefix argument, \"resend\" the message instead of forwarding it;
 see the documentation of `rmail-resend'."
   (interactive "P")
+  (if (zerop rmail-current-message)
+      (error "No message to forward"))
   (if resend
       (call-interactively 'rmail-resend)
     (let ((forward-buffer rmail-buffer)
@@ -3792,7 +3875,7 @@ see the documentation of `rmail-resend'."
                           (or (mail-fetch-field "Subject") "")
                           "]")))
       (if (rmail-start-mail
-          nil nil subject nil nil nil
+          nil nil subject nil nil rmail-buffer
           (list (list 'rmail-mark-message
                       forward-buffer
                       (with-current-buffer rmail-buffer
@@ -4167,10 +4250,13 @@ This has an effect only if a summary buffer exists."
 ;;; Speedbar support for RMAIL files.
 (eval-when-compile (require 'speedbar))
 
-(defvar rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
-  "*This regex is used to match folder names to be displayed in speedbar.
-Enabling this will permit speedbar to display your folders for easy
-browsing, and moving of messages.")
+(defcustom rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$"
+  "Regexp matching Rmail folder names to be displayed in Speedbar.
+Enabling this permits Speedbar to display your folders for easy
+browsing, and moving of messages."
+  :type 'regexp
+  :group 'rmail
+  :group 'speedbar)
 
 (defvar rmail-speedbar-last-user nil
   "The last user to be displayed in the speedbar.")
@@ -4322,6 +4408,9 @@ encoded string (and the same mask) will decode the string."
      (setq i (1+ i)))
    (concat string-vector)))
 
+;; Should this have a key-binding, or be in a menu?
+;; There doesn't really seem to be an appropriate menu.
+;; Eg the edit command is not in a menu either.
 (defun rmail-epa-decrypt ()
   "Decrypt OpenPGP armors in current message."
   (interactive)
@@ -4426,7 +4515,11 @@ encoded string (and the same mask) will decode the string."
 
 ;; 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))
+  (when (and (null start) rmail-buffer-swapped)
+    (unless (buffer-live-p rmail-view-buffer)
+      (error "Buffer `%s' with real text of `%s' has disappeared"
+            (buffer-name rmail-view-buffer)
+            (buffer-name (current-buffer))))
     (setq rmail-message-encoding buffer-file-coding-system)
     (set-buffer rmail-view-buffer)
     (widen)
@@ -4449,7 +4542,7 @@ encoded string (and the same mask) will decode the string."
 ;;; Start of automatically extracted autoloads.
 \f
 ;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el"
-;;;;;;  "7f9bff22ed0bbac561c97fd1e3ab503d")
+;;;;;;  "7d558f958574f6003fa474ce2f3c80a8")
 ;;; Generated autoloads from rmailedit.el
 
 (autoload 'rmail-edit-current-message "rmailedit" "\
@@ -4461,7 +4554,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" "08c288c88cfe7be50830122c064e3884")
+;;;;;;  "rmailkwd.el" "4ae5660d86d49e524f4a6bcbc6d9a984")
 ;;; Generated autoloads from rmailkwd.el
 
 (autoload 'rmail-add-label "rmailkwd" "\
@@ -4504,7 +4597,7 @@ With prefix argument N moves forward N messages with these labels.
 
 ;;;***
 \f
-;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "6296f0170a37670c49a88a1b92d78187")
+;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "cd7656f82944d0b92b0d093a5f3a4c36")
 ;;; Generated autoloads from rmailmm.el
 
 (autoload 'rmail-mime "rmailmm" "\
@@ -4531,7 +4624,7 @@ The arguments ARG and STATE have no effect in this case.
 ;;;***
 \f
 ;;;### (autoloads (set-rmail-inbox-list) "rmailmsc" "rmailmsc.el"
-;;;;;;  "ca19b2f8a3e8aa01aa75ca7413f8a5ef")
+;;;;;;  "e2212ea15561d60365ffa1f7a5902939")
 ;;; Generated autoloads from rmailmsc.el
 
 (autoload 'set-rmail-inbox-list "rmailmsc" "\
@@ -4547,7 +4640,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" "ad1c98fe868c0e5804cf945d6c980d0b")
+;;;;;;  rmail-sort-by-date) "rmailsort" "rmailsort.el" "38da5f17d4ed0dcd2b09c158642cef63")
 ;;; Generated autoloads from rmailsort.el
 
 (autoload 'rmail-sort-by-date "rmailsort" "\
@@ -4606,7 +4699,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" "35e07b0a5ea8e41971f31a8780eba6bb")
+;;;;;;  rmail-summary) "rmailsum" "rmailsum.el" "bef21a376bd5bd59792a20dd86e6ec34")
 ;;; Generated autoloads from rmailsum.el
 
 (autoload 'rmail-summary "rmailsum" "\
@@ -4654,7 +4747,7 @@ SENDERS is a string of regexps separated by commas.
 ;;;***
 \f
 ;;;### (autoloads (unforward-rmail-message undigestify-rmail-message)
-;;;;;;  "undigest" "undigest.el" "41e6a48ea63224385c447a944528feb6")
+;;;;;;  "undigest" "undigest.el" "9f270a2571bbbbfabc27498a8d4089c7")
 ;;; Generated autoloads from undigest.el
 
 (autoload 'undigestify-rmail-message "undigest" "\
@@ -4665,8 +4758,9 @@ Leaves original message, deleted, before the undigestified messages.
 
 (autoload 'unforward-rmail-message "undigest" "\
 Extract a forwarded message from the containing message.
-This puts the forwarded message into a separate rmail message
-following the containing message.
+This puts the forwarded message into a separate rmail message following
+the containing message.  This command is only useful when messages are
+forwarded with `rmail-enable-mime-composing' set to nil.
 
 \(fn)" t nil)