- (let ((highlights (list "opened" "closed"))
- (inhibit-read-only t)
- (fld-name (wl-folder-get-folder-name-by-id
- (get-text-property (point) 'wl-folder-entity-id)))
- fregexp fsymbol bol eol matched type extent num type glyph)
- (setq eol (progn (end-of-line) (point))
- bol (progn (beginning-of-line) (point)))
- (when (and fld-name (looking-at "[ \t]+\\([^ \t]+\\)"))
- (if (and (setq extent (extent-at (match-beginning 1) nil nil nil 'at))
- (extent-begin-glyph extent))
- (delete-extent extent))
- (setq extent (make-extent (match-beginning 1) (match-beginning 1)))
- (cond
- ((string= fld-name wl-trash-folder) ;; set trash folder icon
- (setq num (nth 2 numbers)) ;; number of messages
- (set-extent-begin-glyph extent
- (if (or (null num)
- (eq num 0))
- wl-folder-trash-empty-glyph
- wl-folder-trash-glyph)))
- ((string= fld-name wl-draft-folder) ;; set draft folder icon
- (set-extent-begin-glyph extent wl-folder-draft-glyph))
- ((string= fld-name wl-queue-folder)
- (set-extent-begin-glyph extent wl-folder-queue-glyph))
- ((and (setq type (elmo-folder-get-type fld-name))
- (or numbers ;; XXX dirty...!!
- (not (assoc fld-name wl-folder-group-alist))))
- ;; not group folder.
- (set-extent-begin-glyph extent
- (symbol-value
- (intern (format "wl-folder-%s-glyph"
- type)))))))
- (when (and numbers (nth 0 numbers) (nth 1 numbers))
- (setq fsymbol
- (let ((unsync (nth 0 numbers))
- (unread (nth 1 numbers)))
- (cond ((and unsync (eq unsync 0))
- (if (and unread (> unread 0))
- 'wl-highlight-folder-unread-face
- 'wl-highlight-folder-zero-face))
- ((and unsync
- (>= unsync wl-folder-many-unsync-threshold))
- 'wl-highlight-folder-many-face)
- (t
- 'wl-highlight-folder-few-face))))
- (put-text-property bol eol 'face nil)
- (put-text-property bol eol 'face fsymbol)
- (setq matched t))
- (while highlights
- (setq fregexp (symbol-value
- (intern (format "wl-highlight-folder-%s-regexp"
- (car highlights)))))
- (if (not wl-highlight-group-folder-by-numbers)
- (setq fsymbol (intern (format "wl-highlight-folder-%s-face"
- (car highlights)))))
- (when (looking-at fregexp)
- (setq extent (make-extent (match-beginning 1) (match-end 1))
- glyph (intern (format "wl-folder-%s-glyph"
- (car highlights))))
- (if (null (symbol-value glyph))
- (set glyph (wl-xmas-make-icon-glyph
- (extent-string extent)
- (symbol-value
- (cdr (assq glyph wl-folder-toggle-icon-list))))))
- (setq glyph (symbol-value glyph))
- (set-extent-property extent 'end-open t)
- (set-extent-property extent 'start-closed t)
- (set-extent-property extent 'invisible t)
- (set-extent-end-glyph extent glyph)
- (put-text-property bol eol 'face nil)
- (put-text-property bol eol 'face fsymbol)
- (setq matched t highlights nil))
- (setq highlights (cdr highlights)))
- (when (not matched)
- (put-text-property bol eol 'face nil)
- (if (looking-at (format "^[ ]*\\(%s\\|%s\\)"
- wl-folder-unsubscribe-mark
- wl-folder-removed-mark))
- (put-text-property bol eol 'face
- 'wl-highlight-folder-killed-face)
- (put-text-property bol eol 'face
- 'wl-highlight-folder-unknown-face)))
- (if wl-use-highlight-mouse-line
- (wl-highlight-folder-mouse-line))
- (if (and (featurep 'dragdrop) wl-use-dnd)
- (wl-dnd-set-drop-target bol eol)))))
+ (beginning-of-line)
+ (let (fld-name)
+ (cond
+ (;; opened folder group
+ (and (wl-folder-buffer-group-p)
+ (looking-at wl-highlight-folder-opened-regexp))
+ (wl-xmas-highlight-folder-group-line 'wl-folder-opened-glyph
+ 'wl-highlight-folder-opened-face
+ numbers))
+ (;; closed folder group
+ (and (wl-folder-buffer-group-p)
+ (looking-at wl-highlight-folder-closed-regexp))
+ (wl-xmas-highlight-folder-group-line 'wl-folder-closed-glyph
+ 'wl-highlight-folder-closed-face
+ numbers))
+ (;; basic folder
+ (and (setq fld-name (wl-folder-get-folder-name-by-id
+ (get-text-property (point) 'wl-folder-entity-id)))
+ (looking-at "[ \t]+\\([^ \t]+\\)"))
+ (let ((start (match-beginning 1)))
+ (let ((extent (or (map-extents
+ (lambda (extent maparg)
+ (and (eq start (extent-start-position extent))
+ (eq start (extent-end-position extent))
+ extent))
+ nil start start nil nil 'begin-glyph)
+ (make-extent start start))))
+ (let (type)
+ (set-extent-begin-glyph
+ extent
+ (cond
+ ((string= fld-name wl-trash-folder);; trash folder
+ (let ((num (nth 2 numbers)));; number of messages
+ (get (if (or (not num) (zerop num))
+ 'wl-folder-trash-empty-glyph
+ 'wl-folder-trash-glyph)
+ 'glyph)))
+ ((string= fld-name wl-draft-folder);; draft folder
+ (get 'wl-folder-draft-glyph 'glyph))
+ ((string= fld-name wl-queue-folder);; queue folder
+ (get 'wl-folder-queue-glyph 'glyph))
+ (;; and one of many other folders
+ (setq type (or (elmo-folder-type fld-name)
+ (elmo-folder-type-internal
+ (elmo-make-folder fld-name))))
+ (get (intern (format "wl-folder-%s-glyph" type)) 'glyph))))))
+ (let ((end (point-at-eol)))
+ (when wl-use-highlight-mouse-line
+ (put-text-property start end 'mouse-face 'highlight))
+ (let ((text-face
+ (if (looking-at (format "^[ \t]*\\(?:%s\\|%s\\)"
+ wl-folder-unsubscribe-mark
+ wl-folder-removed-mark))
+ 'wl-highlight-folder-killed-face
+ 'wl-highlight-folder-unknown-face)))
+ (if (and wl-highlight-folder-by-numbers
+ numbers (nth 0 numbers) (nth 1 numbers)
+ (re-search-forward "[0-9-]+/[0-9-]+/[0-9-]+" end t))
+ (let* ((unsync (nth 0 numbers))
+ (unread (nth 1 numbers))
+ (face (cond
+ ((and unsync (zerop unsync))
+ (if (and unread (zerop unread))
+ 'wl-highlight-folder-zero-face
+ 'wl-highlight-folder-unread-face))
+ ((and unsync
+ (>= unsync
+ wl-folder-many-unsync-threshold))
+ 'wl-highlight-folder-many-face)
+ (t
+ 'wl-highlight-folder-few-face))))
+ (if (numberp wl-highlight-folder-by-numbers)
+ (progn
+ (put-text-property start (match-beginning 0)
+ 'face text-face)
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'face face))
+ ;; Remove previous face.
+ (put-text-property start (match-end 0) 'face nil)
+ (put-text-property start (match-end 0) 'face face)))
+ (put-text-property start end 'face text-face))))))))))