Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-46
[bpt/emacs.git] / lisp / mail / rmail.el
index b84ea1f..29f2d95 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 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: mail
@@ -268,7 +268,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 +319,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)
@@ -448,6 +454,8 @@ examples:
 
 ;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:".
 ;; 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'.")
 
@@ -541,7 +549,11 @@ This is set to nil by default.")
   "*If non-nil, RMAIL uses MIME feature.
 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."
+until a user explicitly requires it.
+
+Even if the value is non-nil, you can't use MIME feature
+if the feature specified by `rmail-mime-feature' is not available
+in your session."
   :type '(choice (const :tag "on" t)
                 (const :tag "off" nil)
                 (other :tag "when asked" ask))
@@ -593,7 +605,10 @@ LIMIT is the position specifying the end of header.")
 (defvar rmail-mime-feature 'rmail-mime
   "Feature to require to load MIME support in Rmail.
 When starting Rmail, if `rmail-enable-mime' is non-nil,
-this feature is required with `require'.")
+this feature is required with `require'.
+
+The default value is `rmail-mime'.  This feature is provided by
+the rmail-mime package available at <http://www.m17n.org/rmail-mime/>.")
 
 ;;;###autoload
 (defvar rmail-decode-mime-charset t
@@ -733,8 +748,14 @@ isn't provided."
     (condition-case err
        (require rmail-mime-feature)
       (error
-       (message "Feature `%s' not provided" rmail-mime-feature)
-       (sit-for 1)
+       (display-warning
+       :warning
+       (format "Although MIME support is requested
+by setting `rmail-enable-mime' to 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." 
+               rmail-mime-feature))
        (setq rmail-enable-mime nil)))))
 
 
@@ -910,17 +931,17 @@ Note:    it means the file has no messages in it.\n\^_")))
     (unless (and coding-system
                 (coding-system-p coding-system))
       (setq coding-system
-           ;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but
-           ;; earlier versions did that with the current buffer's encoding.
-           ;; So we want to favor detection of emacs-mule (whose normal
-           ;; priority is quite low), but still allow detection of other
-           ;; encodings if emacs-mule won't fit.  The call to
-           ;; detect-coding-with-priority below achieves that.
-           (car (detect-coding-with-priority
-                 from to
-                 '((coding-category-emacs-mule . emacs-mule))))))
-    (unless (memq coding-system
-                 '(undecided undecided-unix))
+           ;; If rmail-file-coding-system is nil, Emacs 21 writes
+           ;; RMAIL files in emacs-mule, Emacs 22 in utf-8, but
+           ;; earlier versions did that with the current buffer's
+           ;; encoding.  So we want to favor detection of emacs-mule
+           ;; (whose normal priority is quite low) and utf-8, but
+           ;; still allow detection of other encodings if they won't
+           ;; fit.  The call to with-coding-priority below achieves
+           ;; that.
+           (with-coding-priority '(emacs-mule utf-8)
+             (detect-coding-region from to 'highest))))
+    (unless (eq (coding-system-type coding-system) 'undecided)
       (set-buffer-modified-p t)                ; avoid locking when decoding
       (let ((buffer-undo-list t))
        (decode-coding-region from to coding-system))
@@ -3038,13 +3059,14 @@ Interactively, empty argument means use same regexp used last time."
   (interactive
     (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
           (prompt
-           (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
+           (concat (if reversep "Reverse " "") "Rmail search (regexp"))
           regexp)
-      (if rmail-search-last-regexp
-         (setq prompt (concat prompt
-                              "(default "
-                              rmail-search-last-regexp
-                              ") ")))
+      (setq prompt
+           (concat prompt
+                   (if rmail-search-last-regexp
+                       (concat ", default "
+                               rmail-search-last-regexp "): ")
+                     "): ")))
       (setq regexp (read-string prompt))
       (cond ((not (equal regexp ""))
             (setq rmail-search-last-regexp regexp))
@@ -3109,13 +3131,14 @@ Interactively, empty argument means use same regexp used last time."
   (interactive
     (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
           (prompt
-           (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
+           (concat (if reversep "Reverse " "") "Rmail search (regexp"))
           regexp)
-      (if rmail-search-last-regexp
-         (setq prompt (concat prompt
-                              "(default "
-                              rmail-search-last-regexp
-                              ") ")))
+      (setq prompt
+           (concat prompt
+                   (if rmail-search-last-regexp
+                       (concat ", default "
+                               rmail-search-last-regexp "): ")
+                     "): ")))
       (setq regexp (read-string prompt))
       (cond ((not (equal regexp ""))
             (setq rmail-search-last-regexp regexp))
@@ -3141,25 +3164,52 @@ Interactively, empty argument means use same regexp used last time."
 ;;     (rmail-show-message found))
     found))
 
+(defun rmail-current-subject ()
+  "Return the current subject.
+The subject is stripped of leading and trailing whitespace, and
+of typical reply prefixes such as Re:."
+  (let ((subject (or (mail-fetch-field "Subject") "")))
+    (if (string-match "\\`[ \t]+" subject)
+       (setq subject (substring subject (match-end 0))))
+    (if (string-match rmail-reply-regexp subject)
+       (setq subject (substring subject (match-end 0))))
+    (if (string-match "[ \t]+\\'" subject)
+       (setq subject (substring subject 0 (match-beginning 0))))
+    subject))
+
+(defun rmail-current-subject-regexp ()
+  "Return a regular expression matching the current subject.
+The regular expression matches the subject header line of
+messages about the same subject.  The subject itself is stripped
+of leading and trailing whitespace, of typical reply prefixes
+such as Re: and whitespace within the subject is replaced by a
+regular expression matching whitespace in general in order to
+take into account that subject header lines may include newlines
+and more whitespace.  The returned regular expressions contains
+`rmail-reply-regexp' and ends with a newline."
+  (let ((subject (rmail-current-subject)))
+    ;; If Subject is long, mailers will break it into several lines at
+    ;; arbitrary places, so replace whitespace with a regexp that will
+    ;; match any sequence of spaces, TABs, and newlines.
+    (setq subject (regexp-quote subject))
+    (setq subject
+         (replace-regexp-in-string "[ \t\n]+" "[ \t\n]+" subject t t))
+    (concat "^Subject: "
+           (if (string= "\\`" (substring rmail-reply-regexp 0 2))
+               (substring rmail-reply-regexp 2)
+             rmail-reply-regexp)
+           subject "[ \t]*\n")))
+
 (defun rmail-next-same-subject (n)
   "Go to the next mail message having the same subject header.
 With prefix argument N, do this N times.
 If N is negative, go backwards instead."
   (interactive "p")
-  (let ((subject (mail-fetch-field "Subject"))
+  (let ((search-regexp (rmail-current-subject-regexp))
        (forward (> n 0))
        (i rmail-current-message)
        (case-fold-search t)
-       search-regexp found)
-    (if (string-match "\\`[ \t]+" subject)
-       (setq subject (substring subject (match-end 0))))
-    (if (string-match "Re:[ \t]*" subject)
-       (setq subject (substring subject (match-end 0))))
-    (if (string-match "[ \t]+\\'" subject)
-       (setq subject (substring subject 0 (match-beginning 0))))
-    (setq search-regexp (concat "^Subject: *\\(Re:[ \t]*\\)?"
-                               (regexp-quote subject)
-                               "[ \t]*\n"))
+       found)
     (save-excursion
       (save-restriction
        (widen)