GNU bug report logs - #12451
[PATCH] Combine formatting faces with other highlighting

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 12451 in the body.
You can then email your comments to 12451 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Wolfgang Jenkner <wjenkner <at> inode.at>
To: submit <at> debbugs.gnu.org (The Gnus Bugfixing Girls + Boys)
Subject: [PATCH] Combine formatting faces with other highlighting
Date: Sat, 15 Sep 2012 16:55:00 +0200

This implements the proposal discussed in the thread starting with

http://article.gmane.org/gmane.emacs.gnus.general/82112

tl;dr: A formatting face is effectively prepended to other highlighting
(like gnus-summary-normal-unread).  That is, the value of the `face'
text property is a single face or a list of two faces.

I haven't updated the manual because (info "(gnus)Formatting Fonts")
doesn't really go into embarrassing details, to begin with.

A list of faces as value of the `face' text property has been supported
at least since emacs 21, see

http://www.delorie.com/gnu/docs/elisp-manual-21/elisp_527.html

I don't know since when xemacs has had this feature, though.

I tested this only with

Ma Gnus v0.6
GNU Emacs 24.2.50.1 (amd64-unknown-freebsd9.0, GTK+ Version 2.24.6)
 of 2012-09-11 on iznogoud.viz

2012-09-13  Wolfgang Jenkner  <wjenkner <at> inode.at>

	* 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

-- >8 --
Subject: [PATCH] Inherit from other highlighting where the gnus-face text
 property is set.

---
 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 ++++++++++++++++++++++-----------
 5 files changed, 33 insertions(+), 15 deletions(-)

diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el
index a19ba4d..becae7c 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 efbcb4d..e005007 100644
--- a/lisp/gnus-sum.el
+++ b/lisp/gnus-sum.el
@@ -12532,7 +12532,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 f5e1077..beec74c 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."
-- 
1.7.11.5

Message #8 received at 12451 <at> debbugs.gnu.org (full text, mbox):

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Wolfgang Jenkner <wjenkner <at> inode.at>
Cc: bugs <at> gnus.org, 12451 <at> debbugs.gnu.org
Subject: Re: bug#12451: [PATCH] Combine formatting faces with other
	highlighting
Date: Tue, 25 Dec 2012 13:55:53 +0100

Wolfgang Jenkner <wjenkner <at> inode.at> writes:

> This implements the proposal discussed in the thread starting with
>
> http://article.gmane.org/gmane.emacs.gnus.general/82112

Thanks; applied to Ma Gnus.

-- 
(domestic pets only, the antidote for overdose, milk.)
  http://lars.ingebrigtsen.no  *  Lars Magne Ingebrigtsen

Message #15 received at 12451 <at> debbugs.gnu.org (full text, mbox):

From: Wolfgang Jenkner <wjenkner <at> inode.at>
To: Lars Ingebrigtsen <larsi <at> gnus.org>
Cc: bugs <at> gnus.org, 12451 <at> debbugs.gnu.org
Subject: Re: bug#12451: [PATCH] Combine formatting faces with other
	highlighting
Date: Thu, 27 Dec 2012 18:10:13 +0100

On Tue, Dec 25 2012, Lars Ingebrigtsen wrote:

> Wolfgang Jenkner <wjenkner <at> inode.at> writes:
>
>> This implements the proposal discussed in the thread starting with
>>
>> http://article.gmane.org/gmane.emacs.gnus.general/82112
>
> Thanks; applied to Ma Gnus.

Here's a small correction (I don't see the messages I'm talking about
below in the echo area, only in *Messages*, so they had escaped me):

2012-12-27  Wolfgang Jenkner  <wjenkner <at> inode.at>

	* gnus-spec.el (gnus-face-face-function): Don't use nil as no-op face
	place holder since this gives `Invalid face reference: nil' messages.
	Use the `default' face instead.  It has the same effect here, even
	though it is not no-op.

	* gnus-util.el
	(gnus-put-text-property-excluding-characters-with-faces): Similarly.

-- >8 --
Subject: [PATCH] Avoid `Invalid face reference: nil' messages.

---
 lisp/gnus-spec.el | 2 +-
 lisp/gnus-util.el | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/lisp/gnus-spec.el b/lisp/gnus-spec.el
index 22d4627..0b5203d 100644
--- a/lisp/gnus-spec.el
+++ b/lisp/gnus-spec.el
@@ -270,7 +270,7 @@ Return a list of updated types."
 	   ;; 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)
+	   (list ',(symbol-value (intern (format "gnus-face-%d" type))) 'default)
 	   ;; Redundant now, but still convenient.
 	   '(gnus-face t)))))
 
diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el
index 705a9e0..fb218e5 100644
--- a/lisp/gnus-util.el
+++ b/lisp/gnus-util.el
@@ -875,7 +875,7 @@ Otherwise, do nothing."
     (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))
+	    (setcar (cdr (get-text-property beg 'face)) (or val 'default)))
 	(inline
 	  (gnus-put-text-property beg stop prop val)))
       (setq beg stop))))
-- 
1.8.0.2

Message #18 received at 12451 <at> debbugs.gnu.org (full text, mbox):

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Wolfgang Jenkner <wjenkner <at> inode.at>
Cc: 12451 <at> debbugs.gnu.org
Subject: Re: bug#12451: [PATCH] Combine formatting faces with other
	highlighting
Date: Thu, 27 Dec 2012 18:18:11 +0100

Wolfgang Jenkner <wjenkner <at> inode.at> writes:

> Here's a small correction (I don't see the messages I'm talking about
> below in the echo area, only in *Messages*, so they had escaped me):

Thanks; applied.

-- 
(domestic pets only, the antidote for overdose, milk.)
  http://lars.ingebrigtsen.no  *  Lars Magne Ingebrigtsen

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.