[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Change the algorithm used for highlighting messages
> And I wrote another wl-highlight-citation-prefix-depth function
> which enables each SC-style citations to have different faces (with
> any luck).
Excellent idea. Thanks.
> But, highlighting multiple lines, e.g. text matching with
> wl-highlight-citation-header-regexp or header field consist of
> multiple lines, does not work well especially when the text
> modified.
This should be fixed now, and I've also added support for signatures.
The only remaining issue is what happens when a multi-line attribution
header is edited -- the other line of the attribution may remain
highlighted until you edit it too. The only solution I can see is
some hackery with text properties, but I'm not very keen on attempting
that.
David, opinions? Is that good enough to go into master?
-- Juliusz
From 2d815cd8842e2369662a06c4ff8866c2cb47008b 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 1/2] 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 uses the citation depth for plain citations and an arbitrary
hash of the attribution name for SC-style attributions.
---
wl/wl-highlight.el | 25 ++++++++++++++-----------
1 file changed, 14 insertions(+), 11 deletions(-)
diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el
index 0ee809e..2f4295e 100644
--- a/wl/wl-highlight.el
+++ b/wl/wl-highlight.el
@@ -1172,6 +1172,15 @@ Returns start point of signature."
(point))) ;; if no separator found, returns end.
)))
+(defun wl-highlight-citation-prefix-index (prefix)
+ "Return a face index for a given citation prefix"
+ (apply '+ (mapcar (lambda (ch)
+ (cond
+ ((memq ch '(?> ?| ?: ?})) 1)
+ ((memq ch '(9 32)) 0)
+ (t ch)))
+ prefix)))
+
(defun wl-highlight-message (start end hack-sig &optional body-only)
"Highlight message headers between start and end.
Faces used:
@@ -1258,7 +1267,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 +1282,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-index 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
From 654efed08418d6f8b3c980bdef01df11ce877be3 Mon Sep 17 00:00:00 2001
From: Juliusz Chroboczek <jch@pps.univ-paris-diderot.fr>
Date: Wed, 7 May 2014 00:30:12 +0200
Subject: [PATCH 2/2] Implement draft highlighting using jit-lock-mode.
This uses Emacs' 21 native highlighting mechanism, and is enabled
by default if available.
---
wl/wl-draft.el | 66 +++++++++++++++++++++++++++++++++++++++++++++++++---------
wl/wl-e21.el | 7 ++++---
2 files changed, 60 insertions(+), 13 deletions(-)
diff --git a/wl/wl-draft.el b/wl/wl-draft.el
index b688e57..350fc9c 100644
--- a/wl/wl-draft.el
+++ b/wl/wl-draft.el
@@ -541,8 +541,9 @@ or `wl-draft-reply-with-argument-list' if WITH-ARG argument is non-nil."
(wl-draft-add-references)
(if wl-draft-add-in-reply-to
(wl-draft-add-in-reply-to)))
- (wl-highlight-headers 'for-draft)) ; highlight when added References:
- (when wl-highlight-body-too
+ (unless wl-draft-jit-highlight
+ (wl-highlight-headers 'for-draft))) ; highlight when added References:
+ (when (and wl-highlight-body-too (not wl-draft-jit-highlight))
(wl-highlight-body-region beg (point-max)))))
(defun wl-message-news-p ()
@@ -1809,7 +1810,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
(when wl-draft-write-file-function
(add-hook 'local-write-file-hooks wl-draft-write-file-function))
(wl-draft-overload-functions)
- (wl-highlight-headers 'for-draft)
+ (unless wl-draft-jit-highlight
+ (wl-highlight-headers 'for-draft))
(wl-draft-save)
(clear-visited-file-modtime)))
@@ -2013,7 +2015,8 @@ If KILL-WHEN-DONE is non-nil, current draft buffer is killed"
(setq wl-draft-parent-folder ""))
(when wl-draft-write-file-function
(add-hook 'local-write-file-hooks wl-draft-write-file-function))
- (wl-highlight-headers 'for-draft)
+ (unless wl-draft-jit-highlight
+ (wl-highlight-headers 'for-draft))
(goto-char body-top)
(run-hooks 'wl-draft-reedit-hook)
(goto-char (point-max))
@@ -2201,7 +2204,8 @@ Automatically applied in draft sending time."
(setq wl-draft-config-exec-flag nil))
(run-hooks 'wl-draft-config-exec-hook)
(put-text-property (point-min)(point-max) 'face nil)
- (wl-highlight-message (point-min)(point-max) t)
+ (unless wl-draft-jit-highlight
+ (wl-highlight-message (point-min)(point-max) t))
(setq wl-draft-config-variables
(elmo-uniq-list local-variables)))))
@@ -2618,7 +2622,8 @@ been implemented yet. Partial support for SWITCH-FUNCTION now supported."
t)
(setq headers (cdr headers))))
;; highlight headers (from wl-draft in wl-draft.el)
- (wl-highlight-headers 'for-draft)
+ (unless wl-draft-jit-highlight
+ (wl-highlight-headers 'for-draft))
;; insert body
(let ((body (wl-string-match-assoc "\\`body\\'"
wl-user-agent-headers-and-body-alist
@@ -2649,8 +2654,20 @@ been implemented yet. Partial support for SWITCH-FUNCTION now supported."
(rename-file old-name new-name 'ok-if-already-exists))))
;; Real-time draft highlighting
+(defcustom wl-draft-jit-highlight (featurep 'jit-lock)
+ "When non-nil, enable real-time highlighting using jit-lock-mode.
+This only works in Emacs 21 and later."
+ :type 'boolean
+ :group 'wl-draft)
+
+(defcustom wl-draft-jit-highlight-function 'wl-draft-default-jit-highlight
+ "The function used for real-time highlighting using jit-lock-mode."
+ :type 'function
+ :group 'wl-draft)
+
(defcustom wl-draft-idle-highlight t
- "When non-nil, enable real-time highlighting."
+ "When non-nil, enable real-time highlighting using a timer.
+This is ignored when wl-draft-jit-highlight is set."
:type 'boolean
:group 'wl-draft)
@@ -2660,10 +2677,39 @@ been implemented yet. Partial support for SWITCH-FUNCTION now supported."
:group 'wl-draft)
(defcustom wl-draft-idle-highlight-function 'wl-draft-default-idle-highlight
- "A function for real-time highlighting."
+ "The function for real-time highlighting using a timer."
:type 'function
:group 'wl-draft)
+(defun wl-draft-default-jit-highlight (start end)
+ (goto-char start)
+ (let ((in-header (wl-draft-point-in-header-p)))
+ ;; check for multi-line header, extend region if necessary
+ (when in-header
+ (while (and (> start (point-min)) (looking-at "^[ \t]"))
+ (forward-line -1))
+ (setq start (point)))
+ ;; check for multi-line attribution
+ (when (not in-header)
+ (forward-line -1)
+ (when (looking-at wl-highlight-citation-prefix-regexp)
+ (setq start (point))))
+ ;; check for signature
+ (let ((hack-sig
+ (cond
+ ((= end (point-max)) t)
+ ((< end (- (point-max) wl-max-signature-size)) nil)
+ (t
+ (let ((sig (funcall wl-highlight-signature-search-function
+ (- (point-max) wl-max-signature-size))))
+ (cond
+ ((>= start sig) (setq start sig end (point-max)) t)
+ ((>= end sig) (setq end (point-max)) t)
+ (t nil)))))))
+ (put-text-property start end 'face nil)
+ (wl-highlight-message start end hack-sig
+ (not (wl-draft-point-in-header-p))))))
+
(defvar wl-draft-idle-highlight-timer nil)
(defun wl-draft-idle-highlight (&optional state)
@@ -2683,13 +2729,13 @@ If STATE is positive, enable real-time highlighting, and disable it otherwise.
(save-match-data (wl-draft-highlight)))
(defun wl-draft-idle-highlight-timer (buffer)
- (when (and wl-draft-idle-highlight
+ (when (and (not wl-draft-jit-highlight) wl-draft-idle-highlight
(buffer-live-p buffer))
(with-current-buffer buffer
(funcall wl-draft-idle-highlight-function))))
(defun wl-draft-idle-highlight-set-timer (beg end len)
- (when wl-draft-idle-highlight
+ (when (and (not wl-draft-jit-highlight) wl-draft-idle-highlight)
(require 'timer)
(when (timerp wl-draft-idle-highlight-timer)
(cancel-timer wl-draft-idle-highlight-timer))
diff --git a/wl/wl-e21.el b/wl/wl-e21.el
index 45d99bb..20b3dcc 100644
--- a/wl/wl-e21.el
+++ b/wl/wl-e21.el
@@ -652,9 +652,10 @@ See info under Wanderlust for full documentation.
Special commands:
\\{wl-draft-mode-map}"
(setq font-lock-defaults nil)
- (add-hook 'after-change-functions
- 'wl-draft-idle-highlight-set-timer nil t)
- ))
+ (if wl-draft-jit-highlight
+ (jit-lock-register wl-draft-jit-highlight-function)
+ (add-hook 'after-change-functions
+ 'wl-draft-idle-highlight-set-timer nil t))))
(defun wl-draft-key-setup ()
(define-key wl-draft-mode-map "\C-c\C-y" 'wl-draft-yank-original)
--
1.9.2