X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-highlight.el;h=b432a6a94419677d9cca81a3885d20d75774281c;hb=c2738fdc4e616fb55973a7e285432f60af6c1c57;hp=31a47cc094afb2bb0bfe09b9c19cf11316d2437d;hpb=78df756a09a45881882cab105e9b1cf20b1f3408;p=elisp%2Fwanderlust.git diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index 31a47cc..b432a6a 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -250,7 +250,7 @@ :group 'wl-summary-faces :group 'wl-faces) -(wl-defface wl-highlight-summary-deleted-face +(wl-defface wl-highlight-summary-disposed-face '( (((type tty) (background dark)) @@ -261,10 +261,55 @@ (((class color) (background light)) (:foreground "DarkKhaki"))) + "Face used for displaying messages mark as disposed." + :group 'wl-summary-faces + :group 'wl-faces) + +(wl-defface wl-highlight-summary-deleted-face + '( + (((type tty) + (background dark)) + (:foreground "blue")) + (((class color) + (background dark)) + (:foreground "SteelBlue")) + (((class color) + (background light)) + (:foreground "RoyalBlue4"))) + "Face used for displaying messages mark as deleted." + :group 'wl-summary-faces + :group 'wl-faces) + +(wl-defface wl-highlight-summary-prefetch-face + '( + (((type tty) + (background dark)) + (:foreground "Green")) + (((class color) + (background dark)) + (:foreground "DeepSkyBlue")) + (((class color) + (background light)) + (:foreground "brown"))) "Face used for displaying messages mark as deleted." :group 'wl-summary-faces :group 'wl-faces) +(wl-defface wl-highlight-summary-resend-face + '( + (((type tty) + (background dark)) + (:foreground "Yellow")) + (((class color) + (background dark)) + (:foreground "orange3")) + (((class color) + (background light)) + (:foreground "orange3"))) + "Face used for displaying messages mark as resend." + :group 'wl-summary-faces + :group 'wl-faces) + (wl-defface wl-highlight-summary-refiled-face '( (((type tty) @@ -295,6 +340,21 @@ :group 'wl-summary-faces :group 'wl-faces) +;; answered +(wl-defface wl-highlight-summary-answered-face + '((((type tty) + (background dark)) + (:foreground "yellow")) + (((class color) + (background dark)) + (:foreground "khaki")) + (((class color) + (background light)) + (:foreground "khaki4"))) + "Face used for displaying answered messages." + :group 'wl-summary-faces + :group 'wl-faces) + ;; obsolete. (wl-defface wl-highlight-summary-temp-face '( @@ -561,14 +621,14 @@ "Face used for displaying demo." :group 'wl-faces) -(wl-defface wl-highlight-refile-destination-face +(wl-defface wl-highlight-action-argument-face '((((class color) (background dark)) (:foreground "pink")) (((class color) (background light)) (:foreground "red"))) - "Face used for displaying refile destination." + "Face used for displaying action argument." :group 'wl-summary-faces :group 'wl-faces) @@ -760,118 +820,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) - (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)) - ((string= temp-mark "o") - (setq fsymbol 'wl-highlight-summary-refiled-face)) - ((string= temp-mark "O") - (setq fsymbol 'wl-highlight-summary-copied-face)) - ((string= temp-mark "D") - (setq fsymbol 'wl-highlight-summary-deleted-face)) - ((string= temp-mark "*") - (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 - wl-summary-unread-uncached-mark)) - (setq fsymbol 'wl-highlight-summary-unread-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-flag-priority-list) + result) + (while (and (null result) priorities) + (when (memq (car priorities) flags) + (setq result + (case (car priorities) + (new + '(wl-highlight-summary-new-face)) + (important + '(wl-highlight-summary-important-face)) + (answered + '(wl-highlight-summary-answered-face)) + (unread + '(wl-highlight-summary-unread-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 () (interactive) (save-excursion (let ((inhibit-read-only t) - (case-fold-search nil) temp-mark status-mark + (case-fold-search nil) (deactivate-mark nil) - fsymbol bol eol matched thread-top looked-at dest ds) + (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)) - (cond - ((string= temp-mark "*") - (setq fsymbol 'wl-highlight-summary-temp-face)) - ((string= temp-mark "D") - (setq fsymbol 'wl-highlight-summary-deleted-face)) - ((string= temp-mark "O") - (setq fsymbol 'wl-highlight-summary-copied-face - dest t)) - ((string= temp-mark "o") - (setq fsymbol 'wl-highlight-summary-refiled-face - dest t))) - (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)) - ((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 + (elmo-message-flags wl-summary-buffer-elmo-folder + number) + (wl-summary-temp-mark) + (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-destination + bol 'wl-summary-action-argument nil eol) - 'wl-summary-destination nil eol) + 'wl-summary-action-argument nil eol) eol 'face - 'wl-highlight-refile-destination-face)) - (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) - ;; Dnd stuff. - (if wl-use-dnd - (wl-dnd-set-drag-starter bol eol))))) + 'wl-highlight-action-argument-face)) + (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. @@ -927,9 +977,9 @@ Variables used: (overlay-put ov 'wl-momentary-overlay t)) (forward-line 1))))) -(defun wl-highlight-refile-destination-string (string) +(defun wl-highlight-action-argument-string (string) (put-text-property 0 (length string) 'face - 'wl-highlight-refile-destination-face + 'wl-highlight-action-argument-face string)) (defun wl-highlight-summary-all () @@ -1191,6 +1241,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))