[gnus git] branch master updated: m0-5-209-g04580ac =1= Combine formatting faces with other highlighting

       via  04580ac4011bb78e17016bfe8fbedb03a8d5dce1 (commit)
      from  4704a2e650646ac28300f051cea9cab3e46fb2f4 (commit)


- Log -----------------------------------------------------------------
commit 04580ac4011bb78e17016bfe8fbedb03a8d5dce1
Author: Wolfgang Jenkner <[email protected]>
Date:   Tue Dec 25 13:55:28 2012 +0100

    Combine formatting faces with other highlighting
    
    * lisp/gnus-spec.el (gnus-face-face-function): Initialize the value of
    the `face' property with a list whose car is the face specified in the
    format string and whose cdr is (nil).
    * lisp/gnus-util.el
    (gnus-put-text-property-excluding-characters-with-faces): Change
    accordingly.
    (gnus-get-text-property-excluding-characters-with-faces): New function.
    * lisp/gnus-sum.el (gnus-summary-highlight-line):
    * lisp/gnus-salt.el (gnus-tree-highlight-node):
    * lisp/gnus-group.el (gnus-group-highlight-line): Use it.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b62b1ad..cc52eee 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,16 @@
+2012-09-13  Wolfgang Jenkner  <[email protected]>
+
+	* lisp/gnus-spec.el (gnus-face-face-function): Initialize the value of
+	the `face' property with a list whose car is the face specified in the
+	format string and whose cdr is (nil).
+	* lisp/gnus-util.el
+	(gnus-put-text-property-excluding-characters-with-faces): Change
+	accordingly.
+	(gnus-get-text-property-excluding-characters-with-faces): New function.
+	* lisp/gnus-sum.el (gnus-summary-highlight-line):
+	* lisp/gnus-salt.el (gnus-tree-highlight-node):
+	* lisp/gnus-group.el (gnus-group-highlight-line): Use it.
+
 2012-12-25  Lars Ingebrigtsen  <[email protected]>
 
 	* nnimap.el (nnimap-authenticator): Expand to allow specifying the
diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index 5247102..9435dde 100644
--- a/lisp/gnus-group.el
+++ b/lisp/gnus-group.el
@@ -1667,7 +1667,7 @@ and ends at END."
   (let ((face (cdar (gnus-group-update-eval-form
                       group
                       gnus-group-highlight))))
-    (unless (eq face (get-text-property beg 'face))
+    (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face))
       (let ((inhibit-read-only t))
         (gnus-put-text-property-excluding-characters-with-faces
          beg end 'face
diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el
index 760a7a0..5ac2c55 100644
--- a/lisp/gnus-salt.el
+++ b/lisp/gnus-salt.el
@@ -659,7 +659,7 @@ Two predefined functions are available:
 	(while (and list
 		    (not (eval (caar list))))
 	  (setq list (cdr list)))))
-    (unless (eq (setq face (cdar list)) (get-text-property beg 'face))
+    (unless (eq (setq face (cdar list)) (gnus-get-text-property-excluding-characters-with-faces beg 'face))
       (gnus-put-text-property-excluding-characters-with-faces
        beg end 'face
        (if (boundp face) (symbol-value face) face)))))
diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el
index f40177d..22d4627 100644
--- a/lisp/gnus-spec.el
+++ b/lisp/gnus-spec.el
@@ -265,7 +265,14 @@ Return a list of updated types."
 (defun gnus-face-face-function (form type)
   `(gnus-add-text-properties
     (point) (progn ,@form (point))
-    '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type))))))
+    (cons 'face
+	  (cons
+	   ;; Delay consing the value of the `face' property until
+	   ;; `gnus-add-text-properties' runs, since it will be modified
+	   ;; by `gnus-put-text-property-excluding-characters-with-faces'.
+	   (list ',(symbol-value (intern (format "gnus-face-%d" type))) nil)
+	   ;; Redundant now, but still convenient.
+	   '(gnus-face t)))))
 
 (defun gnus-balloon-face-function (form type)
   `(gnus-put-text-property
diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el
index 744afdb..e57f90e 100644
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -12535,7 +12535,7 @@ If REVERSE, save parts that do not match TYPE."
                         (memq article gnus-newsgroup-undownloaded)
                         (not (memq article gnus-newsgroup-cached)))))
     (let ((face (funcall (gnus-summary-highlight-line-0))))
-      (unless (eq face (get-text-property beg 'face))
+      (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face))
 	(gnus-put-text-property-excluding-characters-with-faces
 	 beg (point-at-eol) 'face
 	 (setq face (if (boundp face) (symbol-value face) face)))
diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 7b1e2b5..1c22bdf 100644
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -866,18 +866,29 @@ 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)
+(defun gnus-put-text-property-excluding-characters-with-faces (beg end prop val)
+  "The same as `put-text-property', except where `gnus-face' is set.
+If so, and PROP is `face', set the second element of its value to VAL.
+Otherwise, do nothing."
+  (while (< beg end)
+    ;; Property values are compared with `eq'.
+    (let ((stop (next-single-property-change beg 'face nil end)))
+      (if (get-text-property beg 'gnus-face)
+	  (when (eq prop 'face)
+	    (setcar (cdr (get-text-property beg 'face)) val))
 	(inline
-	  (gnus-put-text-property
-	   b (setq b (next-single-property-change b 'gnus-face nil end))
-	   prop val))))))
+	  (gnus-put-text-property beg stop prop val)))
+      (setq beg stop))))
+
+(defun gnus-get-text-property-excluding-characters-with-faces (pos prop)
+  "The same as `get-text-property', except where `gnus-face' is set.
+If so, and PROP is `face', return the second element of its value.
+Otherwise, return the value."
+  (let ((val (get-text-property pos prop)))
+    (if (and (get-text-property pos 'gnus-face)
+	     (eq prop 'face))
+	(cadr val)
+      (get-text-property pos prop))))
 
 (defmacro gnus-faces-at (position)
   "Return a list of faces at POSITION."

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog     |   13 +++++++++++++
 lisp/gnus-group.el |    2 +-
 lisp/gnus-salt.el  |    2 +-
 lisp/gnus-spec.el  |    9 ++++++++-
 lisp/gnus-sum.el   |    2 +-
 lisp/gnus-util.el  |   33 ++++++++++++++++++++++-----------
 6 files changed, 46 insertions(+), 15 deletions(-)

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, master has been updated


hooks/post-receive
-- 
Gnus Project