;; 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)
: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)
: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 "[ ]*\\([-%\\+]\\)\\(.*\\):.*$")
(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
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.
"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)
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
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
(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))
projects / elisp / wanderlust.git / blobdiff