;;; 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 <teranisi@gohome.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; 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)
:group 'wl-summary-faces
:group 'wl-faces)
-;; answered
+;; answered
(wl-defface wl-highlight-summary-answered-face
'((((type tty)
(background dark))
(:foreground "khaki4")))
"Face used for displaying answered messages."
:group 'wl-summary-faces
- :group 'wl-faces)
+ :group 'wl-faces)
+
+;; forwarded
+(wl-defface wl-highlight-summary-forwarded-face
+ '((((type tty)
+ (background dark))
+ (:foreground "yellow"))
+ (((class color)
+ (background dark))
+ (:foreground "DarkOliveGreen2"))
+ (((class color)
+ (background light))
+ (:foreground "DarkOliveGreen4")))
+ "Face used for displaying forwarded messages."
+ :group 'wl-summary-faces
+ :group 'wl-faces)
+
+(wl-defface wl-summary-persistent-mark-face
+ '((((type tty))
+ (:foreground "blue"))
+ (((class color)
+ (background dark))
+ (:foreground "SeaGreen4"))
+ (((class color)
+ (background light))
+ (:foreground "SeaGreen1")))
+ "Dafault face used for displaying messages with persistent mark."
+ :group 'wl-summary-faces
+ :group 'wl-faces)
;; obsolete.
(wl-defface wl-highlight-summary-temp-face
(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)
(put-text-property bol (match-end 0) 'face face)))
(put-text-property bol eol 'face text-face)))))
+(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 (flags temp-mark indent)
"Return a cons cell of (face . argument)."
(let (action)
(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)))
+ (if (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))))
(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))))))
+ (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)
(deactivate-mark nil)
(number (or number (wl-summary-message-number)))
bol eol spec)
- (end-of-line)
- (setq eol (point))
- (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))
- (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
- nil eol)
- 'wl-summary-action-argument nil eol)
- eol
- 'face
- 'wl-highlight-action-argument-face))
- (when wl-use-highlight-mouse-line
- (put-text-property bol eol 'mouse-face 'highlight))
- (when wl-highlight-summary-line-help-echo-alist
- (wl-highlight-summary-line-help-echo number bol eol))
- (when wl-use-dnd
- (wl-dnd-set-drag-starter bol eol)))))
+ (when number
+ (end-of-line)
+ (setq eol (point))
+ (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))
+ (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
+ nil eol)
+ 'wl-summary-action-argument nil eol)
+ eol
+ 'face
+ 'wl-highlight-action-argument-face))
+ (when wl-use-highlight-mouse-line
+ (put-text-property bol eol 'mouse-face 'highlight))
+ (when wl-highlight-summary-line-help-echo-alist
+ (wl-highlight-summary-line-help-echo 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.
projects / elisp / wanderlust.git / blobdiff