X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=wl%2Fwl-highlight.el;h=f03fe3bd8deb3125ddcf15843a98b5486e75de4e;hb=4c3f56d75a954e8a1904bd767f2b544f5de57684;hp=f095221bff82c10b851e2398227b7d5a6137e03c;hpb=6db1adb1e5bb5405e23f59c239796e86e4e9d6dc;p=elisp%2Fwanderlust.git diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index f095221..f03fe3b 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -189,21 +189,6 @@ ;; important messages -(wl-defface wl-highlight-summary-important-face - '( - (((type tty) - (background dark)) - (:foreground "magenta")) - (((class color) - (background dark)) - (:foreground "orange")) - (((class color) - (background light)) - (:foreground "purple"))) - "Face used for displaying important messages." - :group 'wl-summary-faces - :group 'wl-faces) - (wl-defface wl-highlight-summary-new-face '( (((type tty) @@ -594,22 +579,19 @@ :group 'wl-faces) (wl-defface wl-highlight-demo-face - '( - (((type tty) - (background dark)) + '((((type tty)) (:foreground "green")) (((class color) - (background dark)) - (:foreground "GreenYellow")) - (((class color) (background light)) - (:foreground "blue2"))) + (:foreground "#006600" :background "#d9ffd9")) + (((class color) + (background dark)) + (:foreground "#d9ffd9" :background "#004400"))) "Face used for displaying demo." :group 'wl-faces) (wl-defface wl-highlight-logo-face - '( - (((type tty) + '((((type tty) (background dark)) (:foreground "cyan")) (((class color) @@ -748,6 +730,16 @@ :group 'wl-message-faces :group 'wl-faces) +(defface wl-message-header-narrowing-face + '((((class color) (background light)) + (:foreground "black" :background "dark khaki")) + (((class color) (background dark)) + (:foreground "white" :background "dark goldenrod")) + (t (:bold t))) + "Face used for header narrowing for the message." + :group 'wl-message-faces + :group 'wl-faces) + (defvar wl-highlight-folder-opened-regexp " *\\(\\[\\-\\]\\)") (defvar wl-highlight-folder-closed-regexp " *\\(\\[\\+\\]\\)") (defvar wl-highlight-folder-leaf-regexp "[ ]*\\([-%\\+]\\)\\(.*\\):.*$") @@ -820,92 +812,108 @@ (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 action) - (cond ((and (string= temp-mark wl-summary-score-over-mark) - (member mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark))) - (setq fsymbol 'wl-highlight-summary-high-unread-face)) - ((and (string= temp-mark wl-summary-score-below-mark) - (member mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark))) - (setq fsymbol 'wl-highlight-summary-low-unread-face)) - ((setq action (assoc temp-mark wl-summary-mark-action-list)) - (setq fsymbol (nth 5 action))) - ((string= mark wl-summary-new-mark) - (setq fsymbol 'wl-highlight-summary-new-face)) - ((member mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark)) - (setq fsymbol 'wl-highlight-summary-unread-face)) - ((member mark (list wl-summary-answered-cached-mark - wl-summary-answered-uncached-mark)) - (setq fsymbol 'wl-highlight-summary-answered-face)) - ((or (string= mark wl-summary-important-mark)) - (setq fsymbol 'wl-highlight-summary-important-face)) - ((string= temp-mark wl-summary-score-below-mark) - (setq fsymbol 'wl-highlight-summary-low-read-face)) - ((string= temp-mark wl-summary-score-over-mark) - (setq fsymbol 'wl-highlight-summary-high-read-face)) - (t (if (zerop (length indent)) - (setq fsymbol 'wl-highlight-summary-thread-top-face) - (setq fsymbol 'wl-highlight-summary-normal-face)))) +(defsubst wl-highlight-summary-line-face-spec (flags temp-mark indent) + "Return a cons cell of (face . argument)." + (let (action) + (if (setq action (assoc temp-mark wl-summary-mark-action-list)) + (cons (nth 5 action) (nth 2 action)) + (cond + ((and (string= temp-mark wl-summary-score-over-mark) + (or (memq 'new flags) (memq 'unread flags))) + '(wl-highlight-summary-high-unread-face)) + ((and (string= temp-mark wl-summary-score-below-mark) + (or (memq 'new flags) (memq 'unread flags))) + '(wl-highlight-summary-low-unread-face)) + ((let ((priorities wl-summary-persistent-mark-priority-list) + (fl wl-summary-flag-alist) + face result global-flags) + (while (and (null result) priorities) + (if (and (eq (car priorities) 'flag) + (setq global-flags + (elmo-get-global-flags flags 'ignore-preserved))) + (while fl + (when (memq (car (car fl)) global-flags) + (setq result + (progn + (setq face + (intern (format + "wl-highlight-summary-%s-flag-face" + (car (car fl))))) + (when (find-face face) + (list face))) + fl nil)) + (setq fl (cdr fl))) + (when (memq (car priorities) flags) + (setq result + (progn (setq face + (intern (format + "wl-highlight-summary-%s-face" + (car priorities)))) + (when (find-face face) + (list face)))))) + (setq priorities (cdr priorities))) + result)) + ((string= temp-mark wl-summary-score-below-mark) + '(wl-highlight-summary-low-read-face)) + ((string= temp-mark wl-summary-score-over-mark) + '(wl-highlight-summary-high-read-face)) + (t (if indent + '(wl-highlight-summary-normal-face) + '(wl-highlight-summary-thread-top-face))))))) + +(defun wl-highlight-summary-line-flag-folder (number beg end &optional string) + ;; help-echo for flag folder. + (let (flag-info) + (current-buffer) + (when (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder) + 'flag) + (setq flag-info + (elmo-flag-folder-referrer wl-summary-buffer-elmo-folder + number)) + (if flag-info + (put-text-property beg end 'help-echo + (concat "The message exists in " + (mapconcat + (lambda (pair) + (concat (car pair) "/" + (number-to-string + (cdr pair)))) + flag-info ",")) + string))))) + +(defun wl-highlight-summary-line-string (number line flags temp-mark indent) + (let ((fsymbol (car (wl-highlight-summary-line-face-spec + flags + temp-mark + (> (length indent) 0))))) (put-text-property 0 (length line) 'face fsymbol line)) - (if wl-use-highlight-mouse-line - (put-text-property 0 (length line) 'mouse-face 'highlight line))) + (when wl-use-highlight-mouse-line + (put-text-property 0 (length line) 'mouse-face 'highlight line)) + (when wl-use-flag-folder-help-echo + (wl-highlight-summary-line-flag-folder number 0 (length line) line))) -(defun wl-highlight-summary-current-line () +(defun wl-highlight-summary-current-line (&optional number flags) (interactive) (save-excursion (let ((inhibit-read-only t) - (case-fold-search nil) temp-mark status-mark + (case-fold-search nil) (deactivate-mark nil) - fsymbol action bol eol matched thread-top looked-at dest ds) + (number (or number (wl-summary-message-number))) + bol eol spec) (end-of-line) (setq eol (point)) (beginning-of-line) (setq bol (point)) - (setq status-mark (wl-summary-persistent-mark)) - (setq temp-mark (wl-summary-temp-mark)) - (when (setq action (assoc temp-mark wl-summary-mark-action-list)) - (setq fsymbol (nth 5 action)) - (setq dest (nth 2 action))) - (if (not fsymbol) - (cond - ((and (string= temp-mark wl-summary-score-over-mark) - (member status-mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark))) - (setq fsymbol 'wl-highlight-summary-high-unread-face)) - ((and (string= temp-mark wl-summary-score-below-mark) - (member status-mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark - wl-summary-new-mark))) - (setq fsymbol 'wl-highlight-summary-low-unread-face)) - ((string= status-mark wl-summary-new-mark) - (setq fsymbol 'wl-highlight-summary-new-face)) - ((member status-mark (list wl-summary-unread-cached-mark - wl-summary-unread-uncached-mark)) - (setq fsymbol 'wl-highlight-summary-unread-face)) - ((member status-mark (list wl-summary-answered-cached-mark - wl-summary-answered-uncached-mark)) - (setq fsymbol 'wl-highlight-summary-answered-face)) - ((string= status-mark wl-summary-important-mark) - (setq fsymbol 'wl-highlight-summary-important-face)) - ;; score mark - ((string= temp-mark wl-summary-score-below-mark) - (setq fsymbol 'wl-highlight-summary-low-read-face)) - ((string= temp-mark wl-summary-score-over-mark) - (setq fsymbol 'wl-highlight-summary-high-read-face)) - ;; - (t (if (null - (wl-thread-entity-get-parent-entity - (wl-thread-get-entity (wl-summary-message-number)))) - (setq fsymbol 'wl-highlight-summary-thread-top-face) - (setq fsymbol 'wl-highlight-summary-normal-face))))) - (put-text-property bol eol 'face fsymbol) - (when dest + (setq spec (wl-highlight-summary-line-face-spec + (or flags + (elmo-message-flags wl-summary-buffer-elmo-folder + number)) + (wl-summary-temp-mark number) + (wl-thread-entity-get-parent-entity + (wl-thread-get-entity number)))) + (when (car spec) + (put-text-property bol eol 'face (car spec))) + (when (cdr spec) (put-text-property (next-single-property-change (next-single-property-change bol 'wl-summary-action-argument @@ -914,11 +922,12 @@ eol 'face 'wl-highlight-action-argument-face)) - (if wl-use-highlight-mouse-line - (put-text-property bol - eol 'mouse-face 'highlight)) - (if wl-use-dnd - (wl-dnd-set-drag-starter bol eol))))) + (when wl-use-highlight-mouse-line + (put-text-property bol eol 'mouse-face 'highlight)) + (when wl-use-flag-folder-help-echo + (wl-highlight-summary-line-flag-folder number bol eol)) + (when wl-use-dnd + (wl-dnd-set-drag-starter bol eol))))) (defun wl-highlight-folder (start end) "Highlight folder between start and end. @@ -988,11 +997,11 @@ Variables used: "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-refiled-face messages mark as refiled wl-highlight-summary-copied-face messages mark as copied - wl-highlight-summary-new-face new messages" + wl-highlight-summary-new-face new messages + wl-highlight-summary-*-flag-face flagged messages" (if (< end start) (let ((s start)) (setq start end end s))) (let (lines too-big gc-message e p hend i percent) @@ -1096,9 +1105,9 @@ Returns start point of signature." 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 \"important\" headers - wl-highlight-message-important-header-contents2 contents of \"special\" + wl-highlight-message-important-header-contents2 contents of \"important\" headers wl-highlight-message-unimportant-header-contents contents of unimportant headers @@ -1108,9 +1117,9 @@ Faces used: wl-highlight-message-signature signature Variables used: - wl-highlight-important-header-regexp what makes a \"special\" header - wl-highlight-important-header2-regexp what makes a \"special\" header - wl-highlight-unimportant-header-regexp what makes a \"special\" header + wl-highlight-important-header-regexp what makes a \"important\" header + wl-highlight-important-header2-regexp what makes a \"important\" header + wl-highlight-unimportant-header-regexp what makes a \"not important\" header wl-highlight-citation-prefix-regexp matches lines of quoted text wl-highlight-citation-header-regexp matches headers for quoted text @@ -1238,6 +1247,9 @@ interpreted as cited text.)" (inhibit-read-only t)) (put-text-property beg end 'mouse-face 'highlight))) + +(autoload 'elmo-flag-folder-referrer "elmo-flag") + (require 'product) (product-provide (provide 'wl-highlight) (require 'wl-version))