[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Change the algorithm used for highlighting messages
Kazuhiro-san, could you please review the attached patch?
David, is that something you would be willing to consider for master?
Thanks,
-- Juliusz
From ccdc2593fc22c9aa6aceba3cdfdf628c3cb78f3f Mon Sep 17 00:00:00 2001
From: Juliusz Chroboczek <jch@pps.univ-paris-diderot.fr>
Date: Thu, 8 May 2014 21:19:53 +0200
Subject: [PATCH] Make wl-highlight-message use the citation depth for choosing
the face.
Rather than using a stateful algorithm for choosing arbitrary but
distinct faces for the various citation prefixes in the message,
this simply uses the citation depth. The main advantage is that
it is now possible to highlight a single line in a message without
reparsing the whole message. The main flaw is that all SC-style
citations will get the same face.
---
wl/wl-highlight.el | 23 ++++++++++++-----------
1 file changed, 12 insertions(+), 11 deletions(-)
diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el
index 0ee809e..d1fc629 100644
--- a/wl/wl-highlight.el
+++ b/wl/wl-highlight.el
@@ -1172,6 +1172,13 @@ Returns start point of signature."
(point))) ;; if no separator found, returns end.
)))
+(defun wl-highlight-citation-prefix-depth (prefix)
+ "Return the citation depth indicated by the prefix of a cited line."
+ (let ((result 0))
+ (dotimes (n (length prefix) (max result 1))
+ (when (member (aref prefix n) '(?> ?| ?: ?}))
+ (setq result (1+ result))))))
+
(defun wl-highlight-message (start end hack-sig &optional body-only)
"Highlight message headers between start and end.
Faces used:
@@ -1258,7 +1265,7 @@ interpreted as cited text.)"
(put-text-property (match-beginning 0) (match-end 0)
'face 'wl-highlight-header-separator-face)
(forward-line 1))
- (let (prefix prefix-face-alist pair end)
+ (let (prefix end)
(while (null (progn
;; Skip invisible region.
(when (invisible-p (point))
@@ -1273,18 +1280,12 @@ interpreted as cited text.)"
(looking-at wl-highlight-citation-prefix-regexp))
(setq prefix (buffer-substring (point)
(match-end 0)))
- (setq pair (assoc prefix prefix-face-alist))
- (unless pair
- (setq pair (cons prefix
- (nth (% (length prefix-face-alist)
- (length
- wl-highlight-citation-face-list))
- wl-highlight-citation-face-list)))
- (setq prefix-face-alist
- (cons pair prefix-face-alist)))
(unless wl-highlight-highlight-citation-too
(goto-char (match-end 0)))
- (setq current (cdr pair)))
+ (setq current
+ (nth (% (wl-highlight-citation-prefix-depth prefix)
+ (length wl-highlight-citation-face-list))
+ wl-highlight-citation-face-list)))
((and wl-highlight-citation-header-regexp
(looking-at wl-highlight-citation-header-regexp))
(setq current 'wl-highlight-message-citation-header)
--
1.9.2