From 04580ac4011bb78e17016bfe8fbedb03a8d5dce1 Mon Sep 17 00:00:00 2001 From: Wolfgang Jenkner Date: Tue, 25 Dec 2012 13:55:28 +0100 Subject: [PATCH] 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. --- 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(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b62b1adff..cc52eeeaf 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2012-09-13 Wolfgang Jenkner + + * 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 * nnimap.el (nnimap-authenticator): Expand to allow specifying the diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 52471026a..9435dde44 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 760a7a094..5ac2c5542 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 f40177d5c..22d4627bf 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 744afdb7d..e57f90e26 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 7b1e2b5c7..1c22bdfd2 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." -- 2.34.1