Use combining faces for highlighting.
authorLars Ingebrigtsen <larsi@gnus.org>
Thu, 6 Sep 2012 16:33:20 +0000 (18:33 +0200)
committerLars Ingebrigtsen <larsi@gnus.org>
Thu, 6 Sep 2012 16:33:20 +0000 (18:33 +0200)
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.

lisp/ChangeLog
lisp/gnus-compat.el
lisp/gnus-group.el
lisp/gnus-salt.el
lisp/gnus-sum.el
lisp/gnus-util.el

index 8187f82..44a9b46 100644 (file)
@@ -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
index 2b25e45..3241cd1 100644 (file)
@@ -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
index dcccdd8..11ba1b2 100644 (file)
@@ -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)
index 760a7a0..87a1202 100644 (file)
@@ -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)) ? )))
index efbcb4d..e8e9478 100644 (file)
@@ -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))))))
 
index 3c4af9b..791e744 100644 (file)
@@ -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)