X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/a8144f5e24fccd3186dd83567126690c1f0e4ec8..292203c9ef2ab5c1bb349b83132c9a51d3dfb274:/lisp/mail/rmail.el diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index b84ea1f34d..29f2d95be9 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -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 .") ;;;###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)