Merge from emacs--devo--0
[bpt/emacs.git] / lisp / mail / rmail.el
index 7319589..08c228b 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 Free Software Foundation, Inc.
+;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: mail
@@ -51,6 +51,7 @@
 (defvar rsf-beep)
 (defvar rsf-sleep-after-message)
 (defvar total-messages)
+(defvar tool-bar-map)
 
 ; These variables now declared in paths.el.
 ;(defvar rmail-spool-directory "/usr/spool/mail/"
@@ -268,7 +269,7 @@ It is useful to set this variable in the site customization file.")
          "\\|^list-id:\\|^list-unsubscribe:\\|^list-archive:"
          "\\|^content-length:\\|^nntp-posting-date:\\|^user-agent"
          "\\|^importance:\\|^envelope-to:\\|^delivery-date\\|^openpgp:"
-         "\\|^mbox-line:\\|^cancel-lock:"
+         "\\|^mbox-line:\\|^cancel-lock:\\|^DomainKey-Signature:"
          "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:"
 
          "\\|^x-.*:")
@@ -319,8 +320,14 @@ See also `rmail-highlight-face'."
   :type 'regexp
   :group 'rmail-headers)
 
+(defface rmail-highlight
+  '((t :default highlight))
+  "Face to use for highlighting the most important header fields."
+  :group 'rmail-headers
+  :version "22.1")
+
 ;;;###autoload
-(defcustom rmail-highlight-face nil "\
+(defcustom rmail-highlight-face 'rmail-highlight "\
 *Face used by Rmail for highlighting headers."
   :type '(choice (const :tag "Default" nil)
                 face)
@@ -415,7 +422,7 @@ still the current message in the Rmail buffer.")
 Called with region narrowed to the message, including headers,
 before obeying `rmail-ignored-headers'."
   :group 'rmail-headers
-  :type 'function)
+  :type '(choice (const nil) function))
 
 (defcustom rmail-automatic-folder-directives nil
   "List of directives specifying where to put a message.
@@ -447,10 +454,10 @@ examples:
   "String to prepend to Subject line when replying to a message.")
 
 ;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:".
-;; This pattern should catch all the common variants.  The pattern
-;; also ignores mailing list identifiers sometimes added in square
-;; brackets at the beginning of subject lines.
-(defvar rmail-reply-regexp "\\`\\(\\[.+?\\] \\)?\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*"
+;; This pattern should catch all the common variants.
+;; rms: I deleted the change to delete tags in square brackets
+;; because they mess up RT tags.
+(defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*"
   "Regexp to delete from Subject line before inserting `rmail-reply-prefix'.")
 
 (defcustom rmail-display-summary nil
@@ -616,7 +623,9 @@ the variable `rmail-mime-feature'.")
 
 ;;;###autoload
 (defvar rmail-mime-charset-pattern
-  "^content-type:[ ]*text/plain;[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?"
+  (concat "^content-type:[ \t]*text/plain;"
+         "\\(?:[ \t\n]*\\(?:format\\|delsp\\)=\"?[-a-z0-9]+\"?;\\)*"
+         "[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?")
   "Regexp to match MIME-charset specification in a header of message.
 The first parenthesized expression should match the MIME-charset name.")
 
@@ -1121,6 +1130,38 @@ Note:    it means the file has no messages in it.\n\^_")))
 
 (define-key rmail-mode-map [menu-bar move next]
   '("Next" . rmail-next-message))
+
+;; Rmail toolbar
+(defvar rmail-tool-bar-map
+  (if (display-graphic-p)
+      (let ((map (make-sparse-keymap)))
+       (tool-bar-local-item-from-menu 'rmail-get-new-mail "mail/inbox"
+                                      map rmail-mode-map)
+       (tool-bar-local-item-from-menu 'rmail-next-undeleted-message "right-arrow"
+                                      map rmail-mode-map)
+       (tool-bar-local-item-from-menu 'rmail-previous-undeleted-message "left-arrow"
+                                      map rmail-mode-map)
+       (tool-bar-local-item-from-menu 'rmail-search "search"
+                                      map rmail-mode-map)
+       (tool-bar-local-item-from-menu 'rmail-input "open"
+                                      map rmail-mode-map)
+       (tool-bar-local-item-from-menu 'rmail-mail "mail/compose"
+                                      map rmail-mode-map)
+       (tool-bar-local-item-from-menu 'rmail-reply "mail/reply-all"
+                                      map rmail-mode-map)
+       (tool-bar-local-item-from-menu 'rmail-forward "mail/forward"
+                                      map rmail-mode-map)
+       (tool-bar-local-item-from-menu 'rmail-delete-forward "close"
+                                      map rmail-mode-map)
+       (tool-bar-local-item-from-menu 'rmail-output "mail/move"
+                                      map rmail-mode-map)
+       (tool-bar-local-item-from-menu 'rmail-output-body-to-file "mail/save"
+                                      map rmail-mode-map)
+       (tool-bar-local-item-from-menu 'rmail-expunge "delete"
+                                      map rmail-mode-map)
+       map)))
+
+
 \f
 ;; Rmail mode is suitable only for specially formatted data.
 (put 'rmail-mode 'mode-class 'special)
@@ -1248,6 +1289,7 @@ Instead, these commands are available:
                           (concat rmail-spool-directory
                                   (user-login-name)))))))
   (make-local-variable 'rmail-keywords)
+  (set (make-local-variable 'tool-bar-map) rmail-tool-bar-map)
   ;; this gets generated as needed
   (setq rmail-keywords nil))
 
@@ -1635,12 +1677,15 @@ It returns t if it got any new messages."
                         (if (and (featurep 'rmail-spam-filter)
                                  rmail-use-spam-filter
                                  (> rsf-number-of-spam 0))
-                            (if (= 1 new-messages)
-                                ", and found to be a spam message"
-                              (if (> rsf-number-of-spam 1)
-                                  (format ", %d of which found to be spam messages"
-                                          rsf-number-of-spam)
-                                ", one of which found to be a spam message"))
+                            (cond ((= 1 new-messages)
+                                   ", and appears to be spam")
+                                  ((= rsf-number-of-spam new-messages)
+                                   ", and all appear to be spam")
+                                  ((> rsf-number-of-spam 1)
+                                   (format ", and %d appear to be spam"
+                                           rsf-number-of-spam))
+                                  (t
+                                   ", and 1 appears to be spam"))
                           ""))
                (if (and (featurep 'rmail-spam-filter)
                         rmail-use-spam-filter
@@ -1858,6 +1903,7 @@ is non-nil if the user has supplied the password interactively.
 (defun rmail-convert-to-babyl-format ()
   (let ((count 0) start
        (case-fold-search nil)
+       (buffer-undo-list t)
        (invalid-input-resync
         (function (lambda ()
                     (message "Invalid Babyl format in inbox!")
@@ -2131,6 +2177,7 @@ is non-nil if the user has supplied the password interactively.
              ;; may still be in use.  -- rms, 7 May 1993.
              ((eolp) (delete-char 1))
              (t (error "Cannot convert to babyl format")))))
+    (setq buffer-undo-list nil)
     count))
 
 ;; Delete the "From ..." line, creating various other headers with
@@ -2781,7 +2828,7 @@ If summary buffer is currently displayed, update current message there also."
        (if blurb
            (message blurb))))))
 
-(defun rmail-redecode-body (coding)
+(defun rmail-redecode-body (coding &optional raw)
   "Decode the body of the current message using coding system CODING.
 This is useful with mail messages that have malformed or missing
 charset= headers.
@@ -2791,6 +2838,16 @@ and displayed in the RMAIL buffer, but the coding system used to
 decode it was incorrect.  It then encodes the message back to its
 original form, and decodes it again, using the coding system CODING.
 
+Optional argument RAW, if non-nil, means don't encode the message
+before decoding it with the new CODING.  This is useful if the current
+message text was produced by some function which invokes `insert',
+since `insert' leaves unibyte character codes 128 through 255 unconverted
+to multibyte.  One example of such a situation is when the text was
+produced by `base64-decode-region'.
+
+Interactively, invoke the function with a prefix argument to set RAW
+non-nil.
+
 Note that if Emacs erroneously auto-detected one of the iso-2022
 encodings in the message, this function might fail because the escape
 sequences that switch between character sets and also single-shift and
@@ -2802,7 +2859,8 @@ iso-8859, koi8-r, etc."
     (or (eq major-mode 'rmail-mode)
        (switch-to-buffer rmail-buffer))
     (save-excursion
-      (let ((pruned (rmail-msg-is-pruned)))
+      (let ((pruned (rmail-msg-is-pruned))
+           (raw (or raw current-prefix-arg)))
        (unwind-protect
            (let ((msgbeg (rmail-msgbeg rmail-current-message))
                  (msgend (rmail-msgend rmail-current-message))
@@ -2828,9 +2886,30 @@ iso-8859, koi8-r, etc."
                          (coding-system-change-eol-conversion
                           coding
                           (coding-system-eol-type old-coding)))
+                   ;; If old-coding is `undecided', encode-coding-region
+                   ;; will not encode the text at all.  Find a proper
+                   ;; non-trivial encoding to use.
+                   (if (memq (coding-system-base old-coding) '(nil undecided))
+                       (setq old-coding
+                             (car (find-coding-systems-region msgbeg msgend))))
                    (setq x-coding-header (point-marker))
                    (narrow-to-region msgbeg msgend)
-                   (encode-coding-region (point) msgend old-coding)
+                   (and (null raw)
+                        ;; If old and new encoding are the same, it
+                        ;; clearly doesn't make sense to encode.
+                        (not (coding-system-equal
+                              (coding-system-base old-coding)
+                              (coding-system-base coding)))
+                        ;; If the body includes only eight-bit-*
+                        ;; characters, encoding might fail, e.g. with
+                        ;; UTF-8, and isn't needed anyway.
+                        (> (length (delq 'ascii
+                                         (delq 'eight-bit-graphic
+                                               (delq 'eight-bit-control
+                                                     (find-charset-region
+                                                      msgbeg msgend)))))
+                           0)
+                        (encode-coding-region (point) msgend old-coding))
                    (decode-coding-region (point) msgend coding)
                    (setq last-coding-system-used coding)
                    ;; Rewrite the coding-system header according