summaryrefslogtreecommitdiffstatsabout
authorLars Ingebrigtsen <larsi@gnus.org>2012-09-06 16:33:20 (GMT)
committer Lars Ingebrigtsen <larsi@gnus.org>2012-09-06 16:33:20 (GMT)
commit5c28209571b30b445cbbbc1bfb92b72d8a5914a3 (patch) (side-by-side diff)
tree02a3ccfe3c457893b9211990ec85e512dd5f4679
parentf6b456bf14e4638970fbe61de6be8ccd525b0b5a (diff)
downloadgnus-5c28209571b30b445cbbbc1bfb92b72d8a5914a3.zip
Use combining faces for highlighting.
This allows people to define their own faces, yet have highlighting based on readedness (etc.) to take place. * gnus-salt.el (gnus-tree-highlight-node): Ditto. * gnus-sum.el (gnus-summary-highlight-line): Ditto. * gnus-group.el (gnus-group-highlight-line): Use combining faces. * gnus-compat.el: Define compat function `add-face' from Wolfgang Jenkner. * gnus-util.el (gnus-put-text-property-excluding-characters-with-faces): Removed.
-rw-r--r--lisp/ChangeLog14
-rw-r--r--lisp/gnus-compat.el18
-rw-r--r--lisp/gnus-group.el4
-rw-r--r--lisp/gnus-salt.el4
-rw-r--r--lisp/gnus-sum.el5
-rw-r--r--lisp/gnus-util.el13
6 files changed, 36 insertions, 22 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 8187f82..44a9b46 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,17 @@
+2012-09-06 Lars Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-util.el
+ (gnus-put-text-property-excluding-characters-with-faces): Removed.
+
+ * gnus-compat.el: Define compat function `add-face' from Wolfgang
+ Jenkner.
+
+ * gnus-group.el (gnus-group-highlight-line): Use combining faces.
+
+ * gnus-sum.el (gnus-summary-highlight-line): Ditto.
+
+ * gnus-salt.el (gnus-tree-highlight-node): Ditto.
+
2012-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-score.el (gnus-score-decode-text-parts): Use #' for
diff --git a/lisp/gnus-compat.el b/lisp/gnus-compat.el
index 2b25e45..3241cd1 100644
--- a/lisp/gnus-compat.el
+++ b/lisp/gnus-compat.el
@@ -104,6 +104,24 @@ TRASH is ignored."
(and (boundp var)
(symbol-value var))))
+
+;; Emacs less than 24.3
+(unless (fboundp 'add-face)
+ (defun add-face (beg end face)
+ "Combine FACE BEG and END."
+ (let ((b beg))
+ (while (< b end)
+ (let ((oldval (get-text-property b 'face)))
+ (put-text-property
+ b (setq b (next-single-property-change b 'face nil end))
+ 'face (cond ((null oldval)
+ face)
+ ((and (consp oldval)
+ (not (keywordp (car oldval))))
+ (cons face oldval))
+ (t
+ (list face oldval)))))))))
+
(provide 'gnus-compat)
;; gnus-compat.el ends here
diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index dcccdd8..11ba1b2 100644
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -1669,9 +1669,7 @@ and ends at END."
gnus-group-highlight))))
(unless (eq face (get-text-property beg 'face))
(let ((inhibit-read-only t))
- (gnus-put-text-property-excluding-characters-with-faces
- beg end 'face
- (if (boundp face) (symbol-value face) face)))
+ (add-face beg end (if (boundp face) (symbol-value face) face)))
(gnus-extent-start-open beg))))
(defun gnus-group-get-icon (group)
diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el
index 760a7a0..87a1202 100644
--- a/lisp/gnus-salt.el
+++ b/lisp/gnus-salt.el
@@ -660,9 +660,7 @@ Two predefined functions are available:
(not (eval (caar list))))
(setq list (cdr list)))))
(unless (eq (setq face (cdar list)) (get-text-property beg 'face))
- (gnus-put-text-property-excluding-characters-with-faces
- beg end 'face
- (if (boundp face) (symbol-value face) face)))))
+ (add-face beg end (if (boundp face) (symbol-value face) face)))))
(defun gnus-tree-indent (level)
(insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? )))
diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index efbcb4d..e8e9478 100644
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -12533,9 +12533,8 @@ If REVERSE, save parts that do not match TYPE."
(not (memq article gnus-newsgroup-cached)))))
(let ((face (funcall (gnus-summary-highlight-line-0))))
(unless (eq face (get-text-property beg 'face))
- (gnus-put-text-property-excluding-characters-with-faces
- beg (point-at-eol) 'face
- (setq face (if (boundp face) (symbol-value face) face)))
+ (add-face beg (point-at-eol)
+ (setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
(funcall gnus-summary-highlight-line-function article face))))))
diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 3c4af9b..791e744 100644
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -866,19 +866,6 @@ If there's no subdirectory, delete DIRECTORY as well."
(setq beg (point)))
(gnus-overlay-put (gnus-make-overlay beg (point)) prop val)))))
-(defun gnus-put-text-property-excluding-characters-with-faces (beg end
- prop val)
- "The same as `put-text-property', but don't put props on characters with the `gnus-face' property."
- (let ((b beg))
- (while (/= b end)
- (when (get-text-property b 'gnus-face)
- (setq b (next-single-property-change b 'gnus-face nil end)))
- (when (/= b end)
- (inline
- (gnus-put-text-property
- b (setq b (next-single-property-change b 'gnus-face nil end))
- prop val))))))
-
(defmacro gnus-faces-at (position)
"Return a list of faces at POSITION."
(if (featurep 'xemacs)