X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-highlight.el;h=2c2dba4d613498629542d72fa5a0449438d2a2f7;hb=17d892dc665511c9c8fe2c9cd16a7d1c1d087c8c;hp=da9c23c70a72ed5a63eb714bb9a1709882e8da0a;hpb=d309a65d99f115e005ebaf628ea854c4c76838a5;p=elisp%2Fwanderlust.git diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index da9c23c..2c2dba4 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -1,6 +1,6 @@ ;;; wl-highlight.el --- Hilight modules for Wanderlust. -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Yuuichi Teranishi ;; Author: Yuuichi Teranishi @@ -189,6 +189,20 @@ ;; important messages +(wl-defface wl-highlight-summary-flagged-face + '((((type tty) + (background dark)) + (:foreground "magenta")) + (((class color) + (background dark)) + (:foreground "orange")) + (((class color) + (background light)) + (:foreground "purple"))) + "Face used for displaying flagged messages." + :group 'wl-summary-faces + :group 'wl-faces) + (wl-defface wl-highlight-summary-new-face '( (((type tty) @@ -204,6 +218,19 @@ :group 'wl-summary-faces :group 'wl-faces) +(wl-defface wl-highlight-summary-killed-face + '((((type tty) + (background dark)) + (:foreground "blue")) + (((class color) + (background dark)) + (:foreground "gray")) + (((class color)) + (:foreground "LightSlateGray"))) + "Face used for displaying killed messages." + :group 'wl-summary-faces + :group 'wl-faces) + (wl-defface wl-highlight-summary-displaying-face '((t (:underline t :bold t))) @@ -325,7 +352,7 @@ :group 'wl-summary-faces :group 'wl-faces) -;; answered +;; answered (wl-defface wl-highlight-summary-answered-face '((((type tty) (background dark)) @@ -623,11 +650,11 @@ (background dark)) (:foreground "cyan")) (((class color) - (background dark)) - (:foreground "SkyBlue")) - (((class color) (background light)) - (:foreground "SteelBlue"))) + (:foreground "SteelBlue" :background "#d9ffd9")) + (((class color) + (background dark)) + (:foreground "SkyBlue" :background "#004400"))) "Face used for displaying demo." :group 'wl-faces) @@ -840,55 +867,61 @@ (put-text-property bol (match-end 0) 'face face))) (put-text-property bol eol 'face text-face))))) -(defsubst wl-highlight-summary-line-face-spec (flags temp-mark indent) +(defsubst wl-highlight-get-face-by-name (format &rest args) + (let ((face (intern (apply #'format format args)))) + (and (find-face face) + face))) + +(defsubst wl-highlight-summary-line-face-spec (status 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) + (or (let (action) + (and (setq action (assoc temp-mark wl-summary-mark-action-list)) + (cons (nth 5 action) (nth 2 action)))) + (let ((flags (elmo-message-status-flags status))) + (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) + (cond + ((eq (car priorities) 'killed) + (when (elmo-message-status-killed-p status) + (setq result '(wl-highlight-summary-killed-face)))) + ((eq (car priorities) 'flag) + (when (setq global-flags + (elmo-get-global-flags flags 'ignore-preserved)) + (while fl + (when (memq (car (car fl)) global-flags) + (setq result + (list (or (wl-highlight-get-face-by-name + "wl-highlight-summary-%s-flag-face" + (car (car fl))) + 'wl-highlight-summary-flagged-face)) + fl nil)) + (setq fl (cdr fl))) + (unless result + (setq result (list 'wl-highlight-summary-flagged-face))))) + ((memq (car priorities) flags) (setq result - (progn (setq face - (intern (format - "wl-highlight-summary-%s-face" - (car priorities)))) - (if (find-face face) - (list face) - (list 'wl-summary-persistent-mark-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))))))) + (list (or (wl-highlight-get-face-by-name + "wl-highlight-summary-%s-face" + (car priorities)) + 'wl-summary-persistent-mark-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))))))) (autoload 'elmo-flag-folder-referrer "elmo-flag") (defun wl-highlight-flag-folder-help-echo (folder number) @@ -912,9 +945,9 @@ message string))))) -(defun wl-highlight-summary-line-string (number line flags temp-mark indent) +(defun wl-highlight-summary-line-string (number line status temp-mark indent) (let ((fsymbol (car (wl-highlight-summary-line-face-spec - flags + status temp-mark (> (length indent) 0))))) (put-text-property 0 (length line) 'face fsymbol line)) @@ -923,7 +956,7 @@ (when wl-highlight-summary-line-help-echo-alist (wl-highlight-summary-line-help-echo number 0 (length line) line))) -(defun wl-highlight-summary-current-line (&optional number flags) +(defun wl-highlight-summary-current-line (&optional number status) (interactive) (save-excursion (let ((inhibit-read-only t) @@ -937,9 +970,7 @@ (beginning-of-line) (setq bol (point)) (setq spec (wl-highlight-summary-line-face-spec - (or flags - (elmo-message-flags wl-summary-buffer-elmo-folder - number)) + (or status (wl-summary-message-status number)) (wl-summary-temp-mark number) (wl-thread-entity-get-parent-entity (wl-thread-get-entity number))))