Re: Summary line format and gnus-face-X

[Wolfgang Jenkner <wjenkner@inode.at>]

On Thu, Sep 06 2012, Lars Ingebrigtsen wrote:

> Tassilo Horn <tsdh@gnu.org> writes:
>
>> But now my separators in summary lines like the ┃ and the arrows are
>> colorized and boldified, too.
>>
>> R ┃ +┃Lars Ingebrigtsen      ┃   ╰─❯  <Today, 16:34>
>>
>> For those I'd like to have a fixed face that doesn't change because of
>> score/readedness/age.
>
> Hm.  That sounds difficult.  :-)

What about something like the (barely tested) patch below?  This would
make it possible to do things like

(progn
  (fset 'gnus-put-text-property-excluding-characters-with-faces
	(lambda (start end property value)
	  (add-face start end value)))

  (defface foo
    `((t (:weight normal :foreground ,(face-attribute 'default :foreground))))
    "Foo face.")

  (setq gnus-face-9 'foo)

  (setq add-face-function
	(lambda (face faces)
	  (when (eq (car faces) 'foo)
	    (cons 'foo (cons face (cdr faces))))))

  (setq gnus-summary-line-format
	"%U%R%z%I%(%[%4L: %-23,23f%]%) %9{*%} %s
"))


Subject: [PATCH] New variable add-face-function.

The value (if non-nil) is a function which computes how the faces
should be combined.
---
 lisp/gnus-compat.el | 30 ++++++++++++++++++++++--------
 1 file changed, 22 insertions(+), 8 deletions(-)

diff --git a/lisp/gnus-compat.el b/lisp/gnus-compat.el
index 3241cd1..d829bbc 100644
--- a/lisp/gnus-compat.el
+++ b/lisp/gnus-compat.el
@@ -107,20 +107,34 @@ TRASH is ignored."
 
 ;; Emacs less than 24.3
 (unless (fboundp 'add-face)
+  (defvar add-face-function nil
+    "The value may be a function which is passed a face and
+a list of faces and which should return something suitable as
+value of the `face' property.  If it returns nil, however, or the
+value of `add-face-function' was nil to begin with, `add-face'
+will effectively just cons the face to the list of faces.")
+
   (defun add-face (beg end face)
-    "Combine FACE BEG and END."
+    "Combine FACE with the `face' text property values between 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)))))))))
+	   'face (or (and add-face-function
+			  (funcall add-face-function
+				   face
+				   (if (and (listp oldval)
+					    (not (keywordp (car oldval))))
+				       oldval
+				     (list oldval))))
+		     (cond ((null oldval)
+			    face)
+			   ((and (consp oldval)
+				 (not (keywordp (car oldval))))
+			    (cons face oldval))
+			   (t
+			    (list face oldval))))))))))
 
 (provide 'gnus-compat)
 
-- 
1.7.11.5