-(defvar mh-folder-unseen-seq-name nil
- "Name of unseen sequence.
-The default for this is provided by the function `mh-folder-unseen-seq-name'
-On nmh systems.")
-
-(defun mh-folder-unseen-seq-name ()
- "Provide name of unseen sequence from mhparam."
- (or mh-progs (mh-find-path))
- (save-excursion
- (let ((unseen-seq-name "unseen"))
- (with-temp-buffer
- (unwind-protect
- (progn
- (call-process (expand-file-name "mhparam" mh-progs)
- nil '(t t) nil "-component" "Unseen-Sequence")
- (goto-char (point-min))
- (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t)
- (setq unseen-seq-name (match-string 1))))))
- unseen-seq-name)))
-
-(defun mh-folder-unseen-seq-list ()
- "Return a list of unseen message numbers for current folder."
- (if (not mh-folder-unseen-seq-name)
- (setq mh-folder-unseen-seq-name (mh-folder-unseen-seq-name)))
- (cond
- ((not mh-folder-unseen-seq-name)
- nil)
- (t
- (let ((folder mh-current-folder))
- (save-excursion
- (with-temp-buffer
- (unwind-protect
- (progn
- (call-process (expand-file-name "mark" mh-progs)
- nil '(t t) nil
- folder "-seq" mh-folder-unseen-seq-name
- "-list")
- (goto-char (point-min))
- (sort (mh-read-msg-list) '<)))))))))
-
-(defvar mh-folder-unseen-seq-cache nil
- "Internal cache variable used for font-lock in MH-E.
-Should only be non-nil through font-lock stepping, and nil once font-lock
-is done highlighting.")
-(make-variable-buffer-local 'mh-folder-unseen-seq-cache)
-
-(defun mh-folder-font-lock-unseen (limit)
- "Return unseen message lines to font-lock between point and LIMIT."
- (if (not mh-folder-unseen-seq-cache)
- (setq mh-folder-unseen-seq-cache (mh-folder-unseen-seq-list)))
- (let ((cur-msg (mh-get-msg-num nil)))
- (cond
- ((not mh-folder-unseen-seq-cache)
- nil)
- ((>= (point) limit) ;Presumably at end of buffer
- (setq mh-folder-unseen-seq-cache nil)
- nil)
- ((member cur-msg mh-folder-unseen-seq-cache)
- (let ((bpoint (progn (beginning-of-line)(point)))
- (epoint (progn (forward-line 1)(point))))
- (if (<= limit (point))
- (setq mh-folder-unseen-seq-cache nil))
- (set-match-data (list bpoint epoint bpoint epoint))
- t))
- (t
- ;; move forward one line at a time, checking each message number.
- (while (and
- (= 0 (forward-line 1))
- (> limit (point))
- (not (member (mh-get-msg-num nil) mh-folder-unseen-seq-cache))))
- ;; Examine how we must have exited the loop...
- (let ((cur-msg (mh-get-msg-num nil)))
- (cond
- ((or (<= limit (point))
- (not (member cur-msg mh-folder-unseen-seq-cache)))
- (setq mh-folder-unseen-seq-cache nil)
- nil)
- ((member cur-msg mh-folder-unseen-seq-cache)
- (let ((bpoint (progn (beginning-of-line)(point)))
- (epoint (progn (forward-line 1)(point))))
- (if (<= limit (point))
- (setq mh-folder-unseen-seq-cache nil))
- (set-match-data (list bpoint epoint bpoint epoint))
- t))))))))
+(defmacro mh-generate-sequence-font-lock (seq prefix face)
+ "Generate the appropriate code to fontify messages in SEQ.
+PREFIX is used to generate unique names for the variables and
+functions defined by the macro. So a different prefix should be
+provided for every invocation.
+FACE is the font-lock face used to display the matching scan lines."
+ (let ((cache (intern (format "mh-folder-%s-seq-cache" prefix)))
+ (func (intern (format "mh-folder-font-lock-%s" prefix))))
+ `(progn
+ (defvar ,cache nil
+ "Internal cache variable used for font-lock in MH-E.
+Should only be non-nil through font-lock stepping, and nil once
+font-lock is done highlighting.")
+ (make-variable-buffer-local ',cache)
+
+ (defun ,func (limit)
+ "Return unseen message lines to font-lock between point and LIMIT."
+ (if (not ,cache) (setq ,cache (mh-seq-msgs (mh-find-seq ,seq))))
+ (let ((cur-msg (mh-get-msg-num nil)))
+ (cond ((not ,cache)
+ nil)
+ ((>= (point) limit) ;Presumably at end of buffer
+ (setq ,cache nil)
+ nil)
+ ((member cur-msg ,cache)
+ (let ((bpoint (progn (beginning-of-line)(point)))
+ (epoint (progn (forward-line 1)(point))))
+ (if (<= limit (point)) (setq ,cache nil))
+ (set-match-data (list bpoint epoint bpoint epoint))
+ t))
+ (t
+ ;; move forward one line at a time, checking each message
+ (while (and (= 0 (forward-line 1))
+ (> limit (point))
+ (not (member (mh-get-msg-num nil) ,cache))))
+ ;; Examine how we must have exited the loop...
+ (let ((cur-msg (mh-get-msg-num nil)))
+ (cond ((or (<= limit (point))
+ (not (member cur-msg ,cache)))
+ (setq ,cache nil)
+ nil)
+ ((member cur-msg ,cache)
+ (let ((bpoint (progn (beginning-of-line) (point)))
+ (epoint (progn (forward-line 1) (point))))
+ (if (<= limit (point)) (setq ,cache nil))
+ (set-match-data
+ (list bpoint epoint bpoint epoint))
+ t))))))))
+
+ (setq mh-folder-font-lock-keywords
+ (append mh-folder-font-lock-keywords
+ (list (list ',func (list 1 '',face 'prepend t))))))))
+
+(mh-generate-sequence-font-lock mh-unseen-seq unseen bold)
+(mh-generate-sequence-font-lock mh-tick-seq tick mh-folder-tick)