# HG changeset patch # User Alex Schroeder # Date 1137867667 0 # Node ID defd9948075bb284b7b99fb124eaa1b68cbdd006 # Parent 127c0cb667424624bd71fe8fdcf4a2ae1ab573a5 (rmail-highlight-face): Doc. (rmail-font-lock-keywords): Add the stuff necessary to make rmail-highlight-headers obsolete. (rmail-toggle-header, rmail-show-message): Don't call rmail-highlight-headers anymore. (rmail-highlight-headers): Deleted. diff -r 127c0cb66742 -r defd9948075b lisp/mail/rmail.el --- a/lisp/mail/rmail.el Sat Jan 21 16:27:59 2006 +0000 +++ b/lisp/mail/rmail.el Sat Jan 21 18:21:07 2006 +0000 @@ -44,11 +44,9 @@ (require 'mailabbrev) (require 'mule-util)) ; for detect-coding-with-priority -(eval-and-compile - (require 'rmaildesc) - (require 'rmailhdr) - (require 'rmailkwd)) - +(require 'rmaildesc) +(require 'rmailhdr) +(require 'rmailkwd) (require 'mail-parse) (defvar deleted-head) @@ -329,8 +327,9 @@ :group 'rmail-headers) ;;;###autoload -(defcustom rmail-highlight-face nil "\ -*Face used by Rmail for highlighting headers." +(defcustom rmail-highlight-face 'bold "\ +*Face used by Rmail for highlighting sender and subject. +See `rmail-font-lock-keywords'." :type '(choice (const :tag "Default" nil) face) :group 'rmail-headers) @@ -688,10 +687,15 @@ (let* ((cite-chars "[>|}]") (cite-prefix "a-z") (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) - (list '("^\\(From\\|Sender\\|Resent-From\\):" + (list '("^\\(Sender\\|Resent-From\\):" . font-lock-function-name-face) '("^Reply-To:.*$" . font-lock-function-name-face) - '("^Subject:" . font-lock-comment-face) + '("^\\(From:\\)\\(.*\\(\n[ \t]+.*\\)*\\)" + (1 font-lock-function-name-face) + (2 rmail-highlight-face)) + '("^\\(Subject:\\)\\(.*\\(\n[ \t]+.*\\)*\\)" + (1 font-lock-comment-face) + (2 rmail-highlight-face)) '("^X-Spam-Status:" . font-lock-keyword-face) '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):" . font-lock-keyword-face) @@ -1766,8 +1770,7 @@ With argument ARG, show the message header pruned if ARG is greater than zero; otherwise, show it in full." (interactive "P") - (rmail-header-toggle-visibility arg) - (rmail-highlight-headers)) + (rmail-header-toggle-visibility arg)) (defun rmail-narrow-to-non-pruned-header () "Narrow to the whole (original) header of the current message." @@ -2105,7 +2108,6 @@ (setq rmail-view-buffer rmail-buffer)) ;; Deal with the message headers and URLs.. (rmail-header-hide-headers) - (rmail-highlight-headers) (when transient-mark-mode (deactivate-mark)) ;; Make sure that point in the Rmail window is at the beginning ;; of the buffer. @@ -2184,52 +2186,6 @@ (error "No X-Coding-System header found"))) (rmail-header-hide-headers)))))) -(defun rmail-highlight-headers () - "Find all occurrences of certain fields, and highlight them. -The fields highlighted are determined by `rmail-highlighted-headers'. -The face used is stored in the variable `rmail-highlight-face' and -defaults to the face `rmail-highlight-face'." - ;; Do this only if the system supports faces. - (if (and (fboundp 'internal-find-face) - rmail-highlighted-headers) - (save-excursion - (search-forward "\n\n" nil 'move) - (save-restriction - (narrow-to-region (point-min) (point)) - (let ((case-fold-search t) - (inhibit-read-only t) - ;; Highlight with boldface if that is available. - ;; Otherwise use the `highlight' face. - (face (or rmail-highlight-face - (if (face-differs-from-default-p 'bold) - 'bold 'highlight))) - ;; List of overlays to reuse. - (overlays rmail-overlay-list)) - (goto-char (point-min)) - (while (re-search-forward rmail-highlighted-headers nil t) - (skip-chars-forward " \t") - (let ((beg (point)) - overlay) - (while (progn (forward-line 1) - (looking-at "[ \t]"))) - ;; Back up over newline, then trailing spaces or tabs - (forward-char -1) - (while (member (preceding-char) '(? ?\t)) - (forward-char -1)) - (if overlays - ;; Reuse an overlay we already have. - (progn - (setq overlay (car overlays) - overlays (cdr overlays)) - (overlay-put overlay 'face face) - (move-overlay overlay beg (point))) - ;; Make a new overlay and add it to - ;; rmail-overlay-list. - (setq overlay (make-overlay beg (point))) - (overlay-put overlay 'face face) - (setq rmail-overlay-list - (cons overlay rmail-overlay-list)))))))))) - ;;; mbox ready (defun rmail-auto-file () "Automatically move a message into a sub-folder based on criteria.