+2012-09-13 Wolfgang Jenkner <wjenkner@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.
+
2012-12-25 Lars Ingebrigtsen <larsi@gnus.org>
* nnimap.el (nnimap-authenticator): Expand to allow specifying the
(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
(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)))))
(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
(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)))
(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."