X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-highlight.el;h=5a1654c7345e9e0d38c92162e89e571a406f7a12;hb=50e87247bc89cd4eead8633be07a758798831042;hp=b9f4c206e31a892602a0b11e46a605935ae43fca;hpb=1e366a559be4aec4ad4d3cf3e954b8e62a20d2f3;p=elisp%2Fwanderlust.git diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index b9f4c20..5a1654c 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -1,10 +1,9 @@ ;;; wl-highlight.el -- Hilight modules for Wanderlust. -;; Copyright 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news -;; Time-stamp: <00/03/05 00:59:10 teranisi> ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). @@ -25,23 +24,24 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (if (and (featurep 'xemacs) (featurep 'dragdrop)) (require 'wl-dnd)) (require 'wl-vars) -(provide 'wl-highlight) +(provide 'wl-highlight) ; circular dependency (eval-when-compile - (if wl-on-xemacs - (require 'wl-xmas) - (if wl-on-nemacs - (require 'wl-nemacs) - (require 'wl-mule))) + (cond (wl-on-xemacs + (require 'wl-xmas)) + (wl-on-emacs21 + (require 'wl-e21)) + (t + (require 'wl-mule))) (defun-maybe extent-begin-glyph (a)) (defun-maybe delete-extent (a)) (defun-maybe make-extent (a b)) @@ -704,7 +704,7 @@ (defvar wl-highlight-summary-refiled-regexp " *[0-9]+o") (defvar wl-highlight-summary-copied-regexp " *[0-9]+O") (defvar wl-highlight-summary-target-regexp " *[0-9]+\\*") -;(defvar wl-highlight-summary-thread-top-regexp " *[0-9]+[^0-9][^0-9]../..\(.*\)..:.. \\[") +;;(defvar wl-highlight-summary-thread-top-regexp " *[0-9]+[^0-9][^0-9]../..\(.*\)..:.. \\[") (defvar wl-highlight-citation-face-list '(wl-highlight-message-cited-text-1 @@ -718,67 +718,63 @@ wl-highlight-message-cited-text-9 wl-highlight-message-cited-text-10)) -(defmacro defun-hilit (name &rest everything-else) - "Define a function for highlight. Nemacs implementation is set as empty." - (if wl-on-nemacs - (` (defun (, name) nil nil)) - (` (defun (, name) (,@ everything-else))))) - -(defmacro defun-hilit2 (name &rest everything-else) - "Define a function for highlight w/o nemacs." - (if wl-on-nemacs - () ; noop - (` (defun (, name) (,@ everything-else))))) +(defmacro wl-delete-all-overlays () + "Delete all momentary overlays." + '(let ((overlays (overlays-in (point-min) (point-max))) + overlay) + (while (setq overlay (car overlays)) + (if (overlay-get overlay 'wl-momentary-overlay) + (delete-overlay overlay)) + (setq overlays (cdr overlays))))) -(defun-hilit wl-highlight-summary-displaying () +(defun wl-highlight-summary-displaying () (interactive) (wl-delete-all-overlays) (let (bol eol ov) (save-excursion + (end-of-line) + (setq eol (point)) (beginning-of-line) (setq bol (point)) - (save-excursion (end-of-line) (setq eol (point))) (setq ov (make-overlay bol eol)) - (overlay-put ov 'face 'wl-highlight-summary-displaying-face)))) - -(defun-hilit2 wl-highlight-folder-group-line (numbers) - (if wl-highlight-group-folder-by-numbers - (let (fsymbol bol eol) - (beginning-of-line) - (setq bol (point)) - (save-excursion (end-of-line) (setq eol (point))) - (setq fsymbol - (let ((unsync (nth 0 numbers)) - (unread (nth 1 numbers))) - (cond ((and unsync (eq unsync 0)) - (if (and unread (> unread 0)) - 'wl-highlight-folder-unread-face - 'wl-highlight-folder-zero-face)) - ((and unsync - (>= unsync wl-folder-many-unsync-threshold)) - 'wl-highlight-folder-many-face) - (t - 'wl-highlight-folder-few-face)))) - (put-text-property bol eol 'face fsymbol)) - (let ((highlights (list "opened" "closed")) - fregexp fsymbol bol eol matched type extent num type) - (beginning-of-line) - (setq bol (point)) - (save-excursion (end-of-line) (setq eol (point))) - (catch 'highlighted - (while highlights - (setq fregexp (symbol-value - (intern (format "wl-highlight-folder-%s-regexp" - (car highlights))))) - (setq fsymbol (intern (format "wl-highlight-folder-%s-face" - (car highlights)))) - (when (looking-at fregexp) - (put-text-property bol eol 'face fsymbol) - (setq matched t) - (throw 'highlighted nil)) - (setq highlights (cdr highlights))))))) - -(defun-hilit2 wl-highlight-summary-line-string (line mark temp-mark indent) + (overlay-put ov 'face 'wl-highlight-summary-displaying-face) + (overlay-put ov 'evaporate t) + (overlay-put ov 'wl-momentary-overlay t)))) + +(defun wl-highlight-folder-group-line (numbers) + (end-of-line) + (let ((eol (point)) + bol) + (beginning-of-line) + (setq bol (point)) + (let ((text-face (cond ((looking-at wl-highlight-folder-opened-regexp) + 'wl-highlight-folder-opened-face) + ((looking-at wl-highlight-folder-closed-regexp) + 'wl-highlight-folder-closed-face)))) + (if (and wl-highlight-folder-by-numbers + (re-search-forward "[0-9-]+/[0-9-]+/[0-9-]+" eol t)) + (let* ((unsync (nth 0 numbers)) + (unread (nth 1 numbers)) + (face (cond ((and unsync (zerop unsync)) + (if (and unread (> unread 0)) + 'wl-highlight-folder-unread-face + 'wl-highlight-folder-zero-face)) + ((and unsync + (>= unsync wl-folder-many-unsync-threshold)) + 'wl-highlight-folder-many-face) + (t + 'wl-highlight-folder-few-face)))) + (if (numberp wl-highlight-folder-by-numbers) + (progn + (put-text-property bol (match-beginning 0) 'face text-face) + (put-text-property (match-beginning 0) (match-end 0) + 'face face)) + ;; Remove previous face. + (put-text-property bol (match-end 0) 'face nil) + (put-text-property bol (match-end 0) 'face face))) + (put-text-property bol eol 'face text-face))))) + +(defun wl-highlight-summary-line-string (line mark temp-mark indent) (let (fsymbol) (cond ((and (string= temp-mark "+") (member mark (list wl-summary-unread-cached-mark @@ -797,7 +793,7 @@ ((string= temp-mark "D") (setq fsymbol 'wl-highlight-summary-deleted-face)) ((string= temp-mark "*") - (setq fsymbol 'wl-highlight-summary-temp-face)) + (setq fsymbol 'wl-highlight-summary-temp-face)) ((string= mark wl-summary-new-mark) (setq fsymbol 'wl-highlight-summary-new-face)) ((member mark (list wl-summary-unread-cached-mark @@ -809,33 +805,36 @@ (setq fsymbol 'wl-highlight-summary-low-read-face)) ((string= temp-mark "+") (setq fsymbol 'wl-highlight-summary-high-read-face)) - (t (if (= 0 (length indent)) + (t (if (zerop (length indent)) (setq fsymbol 'wl-highlight-summary-thread-top-face) (setq fsymbol 'wl-highlight-summary-normal-face)))) (put-text-property 0 (length line) 'face fsymbol line)) - (if wl-use-highlight-mouse-line + (if wl-use-highlight-mouse-line (put-text-property 0 (length line) 'mouse-face 'highlight line))) - -(defun-hilit2 wl-highlight-summary-current-line (&optional smark regexp temp-too) + +(defun wl-highlight-summary-current-line (&optional smark regexp temp-too) (interactive) (save-excursion (let ((inhibit-read-only t) (case-fold-search nil) temp-mark status-mark - (sregexp (concat - "^" - wl-summary-buffer-number-regexp + (deactivate-mark nil) + (sregexp (concat + "^" + wl-summary-buffer-number-regexp "\\(.\\)\\(.\\)../..\(.*\)..:.. \\(" wl-highlight-thread-indent-string-regexp - "\\)\\[")) + "\\)[[<]")) fregexp fsymbol bol eol matched thread-top looked-at) + (end-of-line) + (setq eol (point)) (beginning-of-line) (setq bol (point)) - (save-excursion (end-of-line) (setq eol (point))) - (if smark + (if smark (setq status-mark smark) (setq looked-at (looking-at sregexp)) - (setq status-mark (buffer-substring (match-beginning 2) - (match-end 2)))) + (when looked-at + (setq status-mark (buffer-substring (match-beginning 2) + (match-end 2))))) (when temp-too (unless looked-at (setq looked-at (looking-at sregexp))) @@ -852,7 +851,7 @@ ((string= temp-mark "o") (setq fsymbol 'wl-highlight-summary-refiled-face))))) (if (not fsymbol) - (cond + (cond ((and (string= temp-mark "+") (member status-mark (list wl-summary-unread-cached-mark wl-summary-unread-uncached-mark @@ -878,21 +877,23 @@ ;; (t (if (and looked-at (string= (buffer-substring - (match-beginning 3) + (match-beginning 3) (match-end 3)) "")) (setq fsymbol 'wl-highlight-summary-thread-top-face) (setq fsymbol 'wl-highlight-summary-normal-face))))) (put-text-property bol eol 'face fsymbol) - (if wl-use-highlight-mouse-line - (put-text-property bol;(1- (match-end 0)) + (if wl-use-highlight-mouse-line + (put-text-property bol +;;; Use bol instead of (1- (match-end 0)) +;;; (1- (match-end 0)) eol 'mouse-face 'highlight)) -; (put-text-property (match-beginning 3) (match-end 3) -; 'face 'wl-highlight-thread-indent-face) +;;; (put-text-property (match-beginning 3) (match-end 3) +;;; 'face 'wl-highlight-thread-indent-face) ;; Dnd stuff. (if wl-use-dnd (wl-dnd-set-drag-starter bol eol))))) -(defun-hilit2 wl-highlight-folder (start end) +(defun wl-highlight-folder (start end) "Highlight folder between start and end. Faces used: wl-highlight-folder-unknown-face unread messages @@ -922,13 +923,7 @@ Variables used: (wl-highlight-folder-current-line) (forward-line 1))))))) -(if (not wl-on-nemacs) - (defsubst wl-delete-all-overlays () - (mapcar (lambda (x) - (delete-overlay x)) - (overlays-in (point-min) (point-max))))) - -(defun-hilit2 wl-highlight-folder-path (folder-path) +(defun wl-highlight-folder-path (folder-path) "Highlight current folder path...overlay" (save-excursion (wl-delete-all-overlays) @@ -943,29 +938,31 @@ Variables used: (get-text-property (point) 'wl-folder-entity-id) (car fp)) (setq fp (cdr fp)) - (setq ov (make-overlay + (setq ov (make-overlay (match-beginning 1) (match-end 1))) (setq wl-folder-buffer-cur-point (point)) - (overlay-put ov 'face 'wl-highlight-folder-path-face)) + (overlay-put ov 'face 'wl-highlight-folder-path-face) + (overlay-put ov 'evaporate t) + (overlay-put ov 'wl-momentary-overlay t)) (forward-line 1))))) -(defun-hilit2 wl-highlight-refile-destination-string (string) - (put-text-property 0 (length string) 'face +(defun wl-highlight-refile-destination-string (string) + (put-text-property 0 (length string) 'face 'wl-highlight-refile-destination-face string)) -(defun-hilit wl-highlight-summary-all () +(defun wl-highlight-summary-all () "For evaluation" (interactive) (wl-highlight-summary (point-min)(point-max))) - -(defun-hilit2 wl-highlight-summary (start end) + +(defun wl-highlight-summary (start end) "Highlight summary between start and end. Faces used: wl-highlight-summary-unread-face unread messages wl-highlight-summary-important-face important messages - wl-highlight-summary-deleted-face messages mark as deleted + wl-highlight-summary-deleted-face messages mark as deleted wl-highlight-summary-refiled-face messages mark as refiled wl-highlight-summary-copied-face messages mark as copied wl-highlight-summary-new-face new messages @@ -973,66 +970,102 @@ Faces used: Variables used: wl-highlight-summary-unread-regexp matches unread messages wl-highlight-summary-important-regexp matches important messages - wl-highlight-summary-deleted-regexp matches messages mark as deleted + wl-highlight-summary-deleted-regexp matches messages mark as deleted wl-highlight-summary-refiled-regexp matches messages mark as refiled wl-highlight-summary-copied-regexp matches messages mark as copied wl-highlight-summary-new-regexp matches new messages - -If HACK-SIG is true,then we search backward from END for something that -looks like the beginning of a signature block, and don't consider that a -part of the message (this is because signatures are often incorrectly -interpreted as cited text.)" +" (if (< end start) (let ((s start)) (setq start end end s))) - (let* ((lines (count-lines start end)) - (too-big (and wl-highlight-max-summary-lines - (> lines wl-highlight-max-summary-lines))) - (real-end end) - gc-message - e p hend i percent) + (let (lines too-big gc-message e p hend i percent) (save-excursion - (save-restriction - (widen) - (narrow-to-region start end) - (if (not too-big) - (save-restriction - (goto-char start) - (setq i 0) - (while (not (eobp)) - (wl-highlight-summary-current-line nil nil wl-summary-scored) - (setq i (+ i 1)) - (setq percent (/ (* i 100) lines)) - (if (eq (% percent 5) 0) - (elmo-display-progress - 'wl-highlight-summary "Highlighting..." - percent)) - (forward-line 1)) - (message "Highlighting...done."))))))) - -(defun wl-highlight-headers () + (unless wl-summary-lazy-highlight + (setq lines (count-lines start end) + too-big (and wl-highlight-max-summary-lines + (> lines wl-highlight-max-summary-lines)))) + (goto-char start) + (setq i 0) + (while (and (not (eobp)) + (< (point) end)) + (wl-highlight-summary-current-line nil nil + (or wl-summary-lazy-highlight + wl-summary-scored)) + (when (and (not wl-summary-lazy-highlight) + (> lines elmo-display-progress-threshold)) + (setq i (+ i 1)) + (setq percent (/ (* i 100) lines)) + (if (or (zerop (% percent 5)) (= i lines)) + (elmo-display-progress + 'wl-highlight-summary "Highlighting..." + percent))) + (forward-line 1)) + (unless wl-summary-lazy-highlight + (message "Highlighting...done"))))) + +(defun wl-highlight-summary-window (&optional win beg) + "Highlight summary window. +This function is defined for `window-scroll-functions'" + (if wl-summary-highlight + (with-current-buffer (window-buffer win) + (wl-highlight-summary (window-start win) + (save-excursion + (goto-char (window-start win)) + (forward-line (frame-height)) + (point))) + (set-buffer-modified-p nil)))) + +(defun wl-highlight-headers (&optional for-draft) (let ((beg (point-min)) - (end (or (save-excursion (re-search-forward "^$" nil t)) + (end (or (save-excursion (re-search-forward "^$" nil t) + (point)) (point-max)))) (wl-highlight-message beg end nil) - (and wl-highlight-x-face-func - (funcall wl-highlight-x-face-func beg end)) + (unless for-draft + (wl-highlight-message-add-buttons-to-header beg end) + (when wl-highlight-x-face-function + (funcall wl-highlight-x-face-function beg end))) (run-hooks 'wl-highlight-headers-hook))) +(defun wl-highlight-message-add-buttons-to-header (start end) + (save-excursion + (save-restriction + (narrow-to-region start end) + (let ((case-fold-search t) + (alist wl-highlight-message-header-button-alist) + entry) + (while alist + (setq entry (car alist) + alist (cdr alist)) + (goto-char (point-min)) + (while (re-search-forward (car entry) nil t) + (setq start (match-beginning 0) + end (if (re-search-forward "^[^ \t]" nil t) + (match-beginning 0) + (point-max))) + (goto-char start) + (while (re-search-forward (nth 1 entry) end t) + (goto-char (match-end 0)) + (wl-message-add-button + (match-beginning (nth 2 entry)) + (match-end (nth 2 entry)) + (nth 3 entry) (match-string (nth 4 entry)))) + (goto-char end))))))) + (defun wl-highlight-body-all () (wl-highlight-message (point-min) (point-max) t t)) -(defun-hilit wl-highlight-body () +(defun wl-highlight-body () (let ((beg (or (save-excursion (goto-char (point-min)) (re-search-forward "^$" nil t)) (point-min))) (end (point-max))) (wl-highlight-message beg end t))) -(defun-hilit2 wl-highlight-body-region (beg end) +(defun wl-highlight-body-region (beg end) (wl-highlight-message beg end t t)) (defun wl-highlight-signature-search-simple (beg end) - "Search signature area in the body message between beg and end. + "Search signature area in the body message between BEG and END. Returns start point of signature." (save-excursion (goto-char end) @@ -1043,7 +1076,7 @@ Returns start point of signature." end))) (defun wl-highlight-signature-search (beg end) - "Search signature area in the body message between beg and end. + "Search signature area in the body message between BEG and END. Returns start point of signature." (save-excursion (goto-char end) @@ -1056,9 +1089,9 @@ Returns start point of signature." (and (re-search-backward "^[^A-Za-z0-9> \t\n]+ *$" beg t) (> (- (match-end 0) (match-beginning 0)) 10);; "10" is a magic number. - (re-search-backward - (concat "^" - (regexp-quote (buffer-substring (match-beginning 0) (match-end 0))) + (re-search-backward + (concat "^" + (regexp-quote (buffer-substring (match-beginning 0) (match-end 0))) "$") beg t))) ;; look for user specified signature-separator @@ -1071,18 +1104,18 @@ Returns start point of signature." (point))) ;; if no separator found, returns end. ))) -(defun-hilit2 wl-highlight-message (start end hack-sig &optional body-only) +(defun wl-highlight-message (start end hack-sig &optional body-only) "Highlight message headers between start and end. Faces used: wl-highlight-message-headers the part before the colon wl-highlight-message-header-contents the part after the colon - wl-highlight-message-important-header-contents contents of \"special\" + wl-highlight-message-important-header-contents contents of \"special\" headers - wl-highlight-message-important-header-contents2 contents of \"special\" + wl-highlight-message-important-header-contents2 contents of \"special\" headers - wl-highlight-message-unimportant-header-contents contents of unimportant + wl-highlight-message-unimportant-header-contents contents of unimportant headers - wl-highlight-message-cited-text quoted text from other + wl-highlight-message-cited-text quoted text from other messages wl-highlight-message-citation-header header of quoted texts wl-highlight-message-signature signature @@ -1100,116 +1133,116 @@ part of the message (this is because signatures are often incorrectly interpreted as cited text.)" (if (< end start) (let ((s start)) (setq start end end s))) - (let* ((too-big (and wl-highlight-max-message-size - (> (- end start) - wl-highlight-max-message-size))) - (real-end end) - current beg - e p hend) - (save-excursion - (save-restriction - (widen) - ;; take off signature - (if (and hack-sig (not too-big)) - (setq end (funcall wl-highlight-signature-search-func - (- end wl-max-signature-size) end))) - (if hack-sig - (put-text-property end (point-max) - 'face 'wl-highlight-message-signature)) - (narrow-to-region start end) - + (let ((too-big (and wl-highlight-max-message-size + (> (- end start) + wl-highlight-max-message-size))) + (real-end end) + current beg + e p hend) + (if too-big + nil + (save-excursion (save-restriction - ;; narrow down to just the headers... - (goto-char start) - ;; If this search fails then the narrowing performed above - ;; is sufficient - (if (re-search-forward (format - "^$\\|%s" - (regexp-quote mail-header-separator)) nil t) - (narrow-to-region (point-min) (point))) - (goto-char start) - (while (and (not body-only) - (not (eobp))) - (cond - ((looking-at "^\\([^ \t\n:]+[ \t]*:\\) *\\(.*\\(\n[ \t].*\\)*\n\\)") - (setq hend (match-end 0)) - (put-text-property (match-beginning 1) (match-end 1) - 'face 'wl-highlight-message-headers) - (setq p (match-end 1)) - (cond - ((catch 'match - (let ((regexp-alist wl-highlight-message-header-alist)) - (while regexp-alist - (when (save-match-data - (looking-at (caar regexp-alist))) - (put-text-property - (match-beginning 2) (match-end 2) - 'face - (cdar regexp-alist)) - (throw 'match t)) - (setq regexp-alist (cdr regexp-alist))) - (throw 'match nil)))) - (t - (put-text-property - (match-beginning 2) (match-end 2) - 'face 'wl-highlight-message-header-contents))) - (goto-char hend)) - ((looking-at mail-header-separator) - (put-text-property (match-beginning 0) (match-end 0) - 'face 'wl-highlight-header-separator-face) - (goto-char (match-end 0))) - ;; ignore non-header field name lines - (t (forward-line 1))))) - ;; now do the body, unless it's too big.... - (if too-big - nil + (widen) + ;; take off signature + (if (and hack-sig (not too-big)) + (setq end (funcall wl-highlight-signature-search-function + (- end wl-max-signature-size) end))) + (if (and hack-sig + (not (eq end real-end))) + (put-text-property end (point-max) + 'face 'wl-highlight-message-signature)) + (narrow-to-region start end) + (save-restriction + ;; narrow down to just the headers... + (goto-char start) + ;; If this search fails then the narrowing performed above + ;; is sufficient + (if (re-search-forward (format + "^$\\|%s" + (regexp-quote mail-header-separator)) + nil t) + (narrow-to-region (point-min) (match-beginning 0))) + ;; highlight only when header is not too-big. + (when (or (null wl-highlight-max-header-size) + (< (point) wl-highlight-max-header-size)) + (goto-char start) + (while (and (not body-only) + (not (eobp))) + (cond + ((looking-at "^[^ \t\n:]+[ \t]*:") + (put-text-property (match-beginning 0) (match-end 0) + 'face 'wl-highlight-message-headers) + (setq p (match-end 0)) + (setq hend (save-excursion (std11-field-end end))) + (cond + ((catch 'match + (let ((regexp-alist wl-highlight-message-header-alist)) + (while regexp-alist + (when (save-match-data + (looking-at (caar regexp-alist))) + (put-text-property p hend 'face + (cdar regexp-alist)) + (throw 'match t)) + (setq regexp-alist (cdr regexp-alist))) + (throw 'match nil)))) + (t + (put-text-property + p hend 'face 'wl-highlight-message-header-contents))) + (goto-char hend)) + ;; ignore non-header field name lines + (t (forward-line 1)))))) (let (prefix prefix-face-alist pair end) - (while (not (eobp)) - (cond - ((null wl-highlight-force-citation-header-regexp) - nil) - ((looking-at wl-highlight-force-citation-header-regexp) - (setq current 'wl-highlight-message-citation-header) - (setq end (match-end 0))) - ((null wl-highlight-citation-prefix-regexp) - nil) - ((looking-at wl-highlight-citation-prefix-regexp) - (setq prefix (buffer-substring (point) - (match-end 0))) - (setq pair (assoc prefix prefix-face-alist)) - (unless pair - (setq prefix-face-alist - (append prefix-face-alist - (list - (setq pair - (cons - prefix - (nth - (% (length prefix-face-alist) - (length - wl-highlight-citation-face-list)) - wl-highlight-citation-face-list))))))) - (unless wl-highlight-highlight-citation-too + (while (not (eobp)) + (cond + ((looking-at mail-header-separator) + (put-text-property (match-beginning 0) (match-end 0) + 'face 'wl-highlight-header-separator-face) (goto-char (match-end 0))) - (setq current (cdr pair))) - ((null wl-highlight-citation-header-regexp) - nil) - ((looking-at wl-highlight-citation-header-regexp) - (setq current 'wl-highlight-message-citation-header) - (setq end (match-end 0))) - (t (setq current nil))) - (cond (current - (setq p (point)) - (forward-line 1) ; this is to put the \n in the face too - (let ();(inhibit-read-only t)) - (put-text-property p (or end (point)) - 'face current) - (setq end nil)) - (forward-char -1))) - (forward-line 1))) + ((null wl-highlight-force-citation-header-regexp) + nil) + ((looking-at wl-highlight-force-citation-header-regexp) + (setq current 'wl-highlight-message-citation-header) + (setq end (match-end 0))) + ((null wl-highlight-citation-prefix-regexp) + nil) + ((looking-at wl-highlight-citation-prefix-regexp) + (setq prefix (buffer-substring (point) + (match-end 0))) + (setq pair (assoc prefix prefix-face-alist)) + (unless pair + (setq prefix-face-alist + (append prefix-face-alist + (list + (setq pair + (cons + prefix + (nth + (% (length prefix-face-alist) + (length + wl-highlight-citation-face-list)) + wl-highlight-citation-face-list))))))) + (unless wl-highlight-highlight-citation-too + (goto-char (match-end 0))) + (setq current (cdr pair))) + ((null wl-highlight-citation-header-regexp) + nil) + ((looking-at wl-highlight-citation-header-regexp) + (setq current 'wl-highlight-message-citation-header) + (setq end (match-end 0))) + (t (setq current nil))) + (cond (current + (setq p (point)) + (forward-line 1) ; this is to put the \n in the face too + (let () +;;; ((inhibit-read-only t)) + (put-text-property p (or end (point)) + 'face current) + (setq end nil)) + (forward-char -1))) + (forward-line 1))) (run-hooks 'wl-highlight-message-hook)))))) - ;; highlight-mouse-line for folder mode (defun wl-highlight-folder-mouse-line () @@ -1221,4 +1254,7 @@ interpreted as cited text.)" (inhibit-read-only t)) (put-text-property beg end 'mouse-face 'highlight))) +(require 'product) +(product-provide (provide 'wl-highlight) (require 'wl-version)) + ;;; wl-highlight.el ends here