]> code.delx.au - gnu-emacs/blobdiff - lisp/mail/rmail.el
Merge from emacs-24; up to 2014-05-01T10:21:17Z!rgm@gnu.org
[gnu-emacs] / lisp / mail / rmail.el
index 96d341c30d2d7a93d58fb307bf243664d5c6784f..673a85dc4c70e66c72802d8908b2991aac777dd1 100644 (file)
@@ -1,9 +1,8 @@
 ;;; rmail.el --- main code of "RMAIL" mail reader for Emacs
 
-;; Copyright (C) 1985-1988, 1993-1998, 2000-2013 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-1988, 1993-1998, 2000-2014 Free Software Foundation, Inc.
 
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: mail
 
 ;; This file is part of GNU Emacs.
@@ -104,6 +103,11 @@ its character representation and its display representation.")
   "Non-nil if message has been processed by `rmail-show-mime-function'.")
 (put 'rmail-mime-decoded 'permanent-local t) ; for rmail-edit
 
+(defsubst rmail-mime-message-p ()
+  "Non-nil if and only if the current message is a MIME."
+  (or (get-text-property (point) 'rmail-mime-entity)
+      (get-text-property (point-min) 'rmail-mime-entity)))
+
 (defgroup rmail nil
   "Mail reader for Emacs."
   :group 'mail)
@@ -249,7 +253,7 @@ We do this by executing it with `--version' and analyzing its output."
        (cond
         ((looking-at ".*movemail: invalid option")
          'emacs)    ;; Possibly...
-        ((looking-at "movemail (GNU Mailutils .*)")
+        ((looking-at "movemail (GNU Mailutils")
          'mailutils)
         (t
          ;; FIXME:
@@ -686,6 +690,12 @@ Element N specifies the summary line for message N+1.")
 
 This is set to nil by default.")
 
+(defcustom rmail-get-coding-function nil
+  "Function of no args to try to determine coding system for a message."
+  :type 'function
+  :group 'rmail
+  :version "24.4")
+
 (defcustom rmail-enable-mime t
   "If non-nil, RMAIL automatically displays decoded MIME messages.
 For this to work, the feature specified by `rmail-mime-feature' must
@@ -1029,9 +1039,11 @@ This function also reinitializes local variables used by Rmail."
 The buffer is expected to be narrowed to just the header of the message."
   (save-excursion
     (goto-char (point-min))
-    (if (re-search-forward rmail-mime-charset-pattern nil t)
-       (coding-system-from-name (match-string 1))
-      'undecided)))
+    (or (if rmail-get-coding-function
+           (funcall rmail-get-coding-function))
+       (if (re-search-forward rmail-mime-charset-pattern nil t)
+           (coding-system-from-name (match-string 1))
+         'undecided))))
 \f
 ;;; Set up Rmail mode keymaps
 
@@ -1085,6 +1097,7 @@ The buffer is expected to be narrowed to just the header of the message."
     (define-key map "<"      'rmail-first-message)
     (define-key map ">"      'rmail-last-message)
     (define-key map " "      'scroll-up-command)
+    (define-key map [?\S-\ ] 'scroll-down-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)
@@ -1559,7 +1572,7 @@ Hook `rmail-quit-hook' is run after expunging."
   (when (boundp 'rmail-quit-hook)
     (run-hooks 'rmail-quit-hook))
   ;; Don't switch to the summary buffer even if it was recently visible.
-  (when rmail-summary-buffer
+  (when (rmail-summary-exists)
     (with-current-buffer rmail-summary-buffer
       (set-buffer-modified-p nil))
     (replace-buffer-in-windows rmail-summary-buffer)
@@ -3435,47 +3448,64 @@ STATE non-nil means mark as deleted."
   "Delete this message and stay on it."
   (interactive)
   (rmail-set-attribute rmail-deleted-attr-index t)
-  (run-hooks 'rmail-delete-message-hook))
+  (run-hooks 'rmail-delete-message-hook)
+  (let ((del-msg rmail-current-message))
+    (if (rmail-summary-exists)
+       (rmail-select-summary
+        (rmail-summary-mark-deleted del-msg)))))
 
-(defun rmail-undelete-previous-message ()
+(defun rmail-undelete-previous-message (count)
   "Back up to deleted message, select it, and undelete it."
-  (interactive)
+  (interactive "p")
   (set-buffer rmail-buffer)
-  (let ((msg rmail-current-message))
-    (while (and (> msg 0)
-               (not (rmail-message-deleted-p msg)))
-      (setq msg (1- msg)))
-    (if (= msg 0)
-       (error "No previous deleted message")
-      (if (/= msg rmail-current-message)
-         (rmail-show-message msg))
-      (rmail-set-attribute rmail-deleted-attr-index nil)
-      (if (rmail-summary-exists)
-         (with-current-buffer rmail-summary-buffer
-           (rmail-summary-mark-undeleted msg)))
-      (rmail-maybe-display-summary))))
-
-(defun rmail-delete-forward (&optional backward)
+  (let (value)
+    (dotimes (i count)
+      (let ((msg rmail-current-message))
+       (while (and (> msg 0)
+                   (not (rmail-message-deleted-p msg)))
+         (setq msg (1- msg)))
+       (if (= msg 0)
+           (error "No previous deleted message")
+         (if (/= msg rmail-current-message)
+             (rmail-show-message msg))
+         (rmail-set-attribute rmail-deleted-attr-index nil)
+         (if (rmail-summary-exists)
+             (with-current-buffer rmail-summary-buffer
+               (rmail-summary-mark-undeleted msg))))))
+    (rmail-maybe-display-summary)))
+
+(defun rmail-delete-forward (&optional count)
   "Delete this message and move to next nondeleted one.
 Deleted messages stay in the file until the \\[rmail-expunge] command is given.
-With prefix argument, delete and move backward.
+A prefix argument is a repeat count;
+negative argument means move backwards instead of forwards.
 
 Returns t if a new message is displayed after the delete, or nil otherwise."
-  (interactive "P")
-  (rmail-set-attribute rmail-deleted-attr-index t)
-  (run-hooks 'rmail-delete-message-hook)
-  (let ((del-msg rmail-current-message))
-    (if (rmail-summary-exists)
-       (rmail-select-summary
-        (rmail-summary-mark-deleted del-msg)))
-    (prog1 (rmail-next-undeleted-message (if backward -1 1))
-      (rmail-maybe-display-summary))))
+  (interactive "p")
+  (let (value backward)
+    (if (< count 0)
+       (setq count (- count) backward t))
+    (dotimes (i count)
+      (rmail-set-attribute rmail-deleted-attr-index t)
+      (run-hooks 'rmail-delete-message-hook)
+      (let ((del-msg rmail-current-message))
+       (if (rmail-summary-exists)
+           (rmail-select-summary
+            (rmail-summary-mark-deleted del-msg)))
+       (setq value (rmail-next-undeleted-message (if backward -1 1)))))
+    (rmail-maybe-display-summary)
+    value))
 
-(defun rmail-delete-backward ()
+(defun rmail-delete-backward (count)
   "Delete this message and move to previous nondeleted one.
-Deleted messages stay in the file until the \\[rmail-expunge] command is given."
-  (interactive)
-  (rmail-delete-forward t))
+Deleted messages stay in the file until the \\[rmail-expunge] command is given.
+A prefix argument is a repeat count;
+negative argument means move forwards instead of backwards.
+
+Returns t if a new message is displayed after the delete, or nil otherwise."
+
+  (interactive "p")
+  (rmail-delete-forward (- count)))
 \f
 ;; Expunging.
 
@@ -3724,7 +3754,7 @@ to switch to."
    ;; If the frame was probably made for this buffer, the user
    ;; probably wants to delete it now.
    ((display-multi-frame-p)
-    (delete-frame (selected-frame)))
+    (delete-frame))
    ;; The previous frame is where normally they have the Rmail buffer
    ;; displayed.
    (t (other-frame -1))))
@@ -3862,16 +3892,18 @@ which is an element of rmail-msgref-vector."
                        message-id))
                    ;; missing From, or Message-ID is sufficiently informative
                    message-id
-                   (concat message-id " (" tem ")"))
+                (concat message-id " (" tem ")"))
+            ;; Message has no Message-ID field.
             ;; Copy TEM, discarding text properties.
             (setq tem (copy-sequence tem))
             (set-text-properties 0 (length tem) nil tem)
             (setq tem (copy-sequence tem))
             ;; Use prin1 to fake RFC822 quoting
             (let ((field (prin1-to-string tem)))
+              ;; Wrap it in parens to make it a comment according to RFC822
               (if date
-                  (concat field "'s message of " date)
-                  field)))))
+                  (concat "(" field "'s message of " date ")")
+                (concat "(" field ")"))))))
         ((let* ((foo "[^][\000-\037()<>@,;:\\\" ]+")
                 (bar "[^][\000-\037()<>@,;:\\\"]+"))
           ;; These strings both match all non-ASCII characters.
@@ -3897,7 +3929,8 @@ which is an element of rmail-msgref-vector."
              (if message-id
                  ;; "<AA259@bar.edu> (message from Unix Loser on 1-Apr-89)"
                  (concat message-id " (" field ")")
-                 field))))
+              ;; Wrap in parens to make it a comment, for RFC822.
+              (concat "(" field ")")))))
         (t
          ;; If we can't kludge it simply, do it correctly
          (let ((mail-use-rfc822 t))
@@ -4104,6 +4137,8 @@ The message should be narrowed to just the headers."
 
 (autoload 'mail-position-on-field "sendmail")
 
+(declare-function rmail-mime-toggle-raw "rmailmm" (&optional state))
+
 (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
@@ -4116,7 +4151,13 @@ The variable `rmail-retry-ignored-headers' is a regular expression
 specifying headers which should not be copied into the new message."
   (interactive)
   (require 'mail-utils)
-  (if rmail-enable-mime
+  ;; FIXME This does not handle rmail-mime-feature != 'rmailmm.
+  ;; There is no API defined for rmail-mime-feature to provide
+  ;; rmail-mime-message-p, rmail-mime-toggle-raw equivalents.
+  ;; But does anyone actually use rmail-mime-feature != 'rmailmm?
+  (if (and rmail-enable-mime
+          (eq rmail-mime-feature 'rmailmm)
+          (featurep rmail-mime-feature))
       (with-current-buffer rmail-buffer
        (if (rmail-mime-message-p)
            (let ((rmail-mime-mbox-buffer rmail-view-buffer)
@@ -4300,8 +4341,6 @@ This has an effect only if a summary buffer exists."
                  (restore-buffer-modified-p nil)))))))
 \f
 ;;; Speedbar support for RMAIL files.
-(eval-when-compile (require 'speedbar))
-
 (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
@@ -4316,12 +4355,12 @@ browsing, and moving of messages."
 (defvar rmail-speedbar-key-map nil
   "Keymap used when in rmail display mode.")
 
+(declare-function speedbar-make-specialized-keymap "speedbar" ())
+
 (defun rmail-install-speedbar-variables ()
   "Install those variables used by speedbar to enhance rmail."
-  (if rmail-speedbar-key-map
-      nil
+  (unless rmail-speedbar-key-map
     (setq rmail-speedbar-key-map (speedbar-make-specialized-keymap))
-
     (define-key rmail-speedbar-key-map "e" 'speedbar-edit-line)
     (define-key rmail-speedbar-key-map "r" 'speedbar-edit-line)
     (define-key rmail-speedbar-key-map "\C-m" 'speedbar-edit-line)
@@ -4336,6 +4375,9 @@ browsing, and moving of messages."
                     (looking-at "<M> "))])
   "Additional menu-items to add to speedbar frame.")
 
+(declare-function speedbar-insert-button "speedbar"
+                 (text face mouse function &optional token prevline))
+
 ;; Make sure our special speedbar major mode is loaded
 (if (featurep 'speedbar)
     (rmail-install-speedbar-variables)
@@ -4377,19 +4419,27 @@ current message into that RMAIL folder."
            (speedbar-insert-button file 'speedbar-file-face 'highlight
                                    'rmail-speedbar-find-file nil t)))))))
 
+(eval-when-compile (require 'dframe))
+;; Part of the macro expansion of dframe-with-attached-buffer.
+;; At runtime, will be pulled in as a require of speedbar.
+(declare-function dframe-select-attached-frame "dframe" (&optional frame))
+(declare-function dframe-maybee-jump-to-attached-frame "dframe" ())
+
 (defun rmail-speedbar-button (text token indent)
   "Execute an rmail command specified by TEXT.
 The command used is TOKEN.  INDENT is not used."
-  (speedbar-with-attached-buffer
+  (dframe-with-attached-buffer
    (funcall token t)))
 
 (defun rmail-speedbar-find-file (text token indent)
   "Load in the rmail file TEXT.
 TOKEN and INDENT are not used."
-  (speedbar-with-attached-buffer
+  (dframe-with-attached-buffer
    (message "Loading in RMAIL file %s..." text)
    (rmail text)))
 
+(declare-function speedbar-do-function-pointer "speedbar" ())
+
 (defun rmail-speedbar-move-message-to-folder-on-line ()
   "If the current line is a folder, move current message to it."
   (interactive)
@@ -4403,7 +4453,7 @@ TOKEN and INDENT are not used."
 (defun rmail-speedbar-move-message (text token indent)
   "From button TEXT, copy current message to the rmail file specified by TOKEN.
 TEXT and INDENT are not used."
-  (speedbar-with-attached-buffer
+  (dframe-with-attached-buffer
    (message "Moving message to %s" token)
    ;; expand-file-name is needed due to the unhelpful way in which
    ;; rmail-output expands non-absolute filenames against rmail-default-file.
@@ -4464,7 +4514,7 @@ encoded string (and the same mask) will decode the string."
 ;; 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."
+  "Decrypt GnuPG or OpenPGP armors in current message."
   (interactive)
 
   ;; Save the current buffer here for cleanliness, in case we
@@ -4474,14 +4524,10 @@ encoded string (and the same mask) will decode the string."
     (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)))
+      ;; Turn off mime processing.
+      (when (and (rmail-mime-message-p)
+                (not (get-text-property (point-min) 'rmail-mime-hidden)))
+       (rmail-mime))
 
       ;; Now find all armored messages in the buffer
       ;; and decrypt them one by one.
@@ -4541,6 +4587,7 @@ encoded string (and the same mask) will decode the string."
                      (when armor-end
                        (delete-region armor-start armor-end)
                        (insert-buffer-substring from-buffer (nth 0 d) (nth 1 d)))))))))))))
 \f
 ;;;;  Desktop support
 
@@ -4593,8 +4640,7 @@ encoded string (and the same mask) will decode the string."
 \f
 ;;; Start of automatically extracted autoloads.
 \f
-;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el"
-;;;;;;  "0b056146d4775080a1847b8ce7527bc5")
+;;;### (autoloads nil "rmailedit" "rmailedit.el" "b155463a02e4aa9256ac21997ea003e9")
 ;;; Generated autoloads from rmailedit.el
 
 (autoload 'rmail-edit-current-message "rmailedit" "\
@@ -4604,9 +4650,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" "b5337290fd35bbc11888afb25d767195")
+;;;### (autoloads nil "rmailkwd" "rmailkwd.el" "d462d15a119ee2a1733de2bc31bf347c")
 ;;; Generated autoloads from rmailkwd.el
 
 (autoload 'rmail-add-label "rmailkwd" "\
@@ -4649,7 +4693,7 @@ With prefix argument N moves forward N messages with these labels.
 
 ;;;***
 \f
-;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "93951f748e43e1015da1b485088970ca")
+;;;### (autoloads nil "rmailmm" "rmailmm.el" "4904dafb4e3b7b456c14e63d2dc9163d")
 ;;; Generated autoloads from rmailmm.el
 
 (autoload 'rmail-mime "rmailmm" "\
@@ -4675,8 +4719,7 @@ The arguments ARG and STATE have no effect in this case.
 
 ;;;***
 \f
-;;;### (autoloads (set-rmail-inbox-list) "rmailmsc" "rmailmsc.el"
-;;;;;;  "8a2466563b4a463710531d01766c07a3")
+;;;### (autoloads nil "rmailmsc" "rmailmsc.el" "0950b0ad020610737220948bb3f37c17")
 ;;; Generated autoloads from rmailmsc.el
 
 (autoload 'set-rmail-inbox-list "rmailmsc" "\
@@ -4690,9 +4733,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" "3e3a30326fc95d7f17835906c2ccb19f")
+;;;### (autoloads nil "rmailsort" "rmailsort.el" "4106a6e4898795822554ce931f531ab8")
 ;;; Generated autoloads from rmailsort.el
 
 (autoload 'rmail-sort-by-date "rmailsort" "\
@@ -4749,9 +4790,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" "341825201e892b8fc875c1ae49ffd560")
+;;;### (autoloads nil "rmailsum" "rmailsum.el" "cfbb230f38a9358564c242f595ba2527")
 ;;; Generated autoloads from rmailsum.el
 
 (autoload 'rmail-summary "rmailsum" "\
@@ -4798,8 +4837,7 @@ SENDERS is a string of regexps separated by commas.
 
 ;;;***
 \f
-;;;### (autoloads (unforward-rmail-message undigestify-rmail-message)
-;;;;;;  "undigest" "undigest.el" "9b273a3e15b5496ab6121b585d8bd3b3")
+;;;### (autoloads nil "undigest" "undigest.el" "f30d93eb6a006ac64080a1ee8a45a1af")
 ;;; Generated autoloads from undigest.el
 
 (autoload 'undigestify-rmail-message "undigest" "\