| author | Lars Ingebrigtsen <larsi@gnus.org> | 2012-09-06 16:33:20 (GMT) |
|---|---|---|
| committer | Lars Ingebrigtsen <larsi@gnus.org> | 2012-09-06 16:33:20 (GMT) |
| commit | 5c28209571b30b445cbbbc1bfb92b72d8a5914a3 (patch) (side-by-side diff) | |
| tree | 02a3ccfe3c457893b9211990ec85e512dd5f4679 | |
| parent | f6b456bf14e4638970fbe61de6be8ccd525b0b5a (diff) | |
| download | gnus-5c28209571b30b445cbbbc1bfb92b72d8a5914a3.zip | |
Use combining faces for highlighting.
This allows people to define their own faces, yet have highlighting
based on readedness (etc.) to take place.
* gnus-salt.el (gnus-tree-highlight-node): Ditto.
* gnus-sum.el (gnus-summary-highlight-line): Ditto.
* gnus-group.el (gnus-group-highlight-line): Use combining faces.
* gnus-compat.el: Define compat function `add-face' from Wolfgang
Jenkner.
* gnus-util.el
(gnus-put-text-property-excluding-characters-with-faces): Removed.
| -rw-r--r-- | lisp/ChangeLog | 14 | ||||
| -rw-r--r-- | lisp/gnus-compat.el | 18 | ||||
| -rw-r--r-- | lisp/gnus-group.el | 4 | ||||
| -rw-r--r-- | lisp/gnus-salt.el | 4 | ||||
| -rw-r--r-- | lisp/gnus-sum.el | 5 | ||||
| -rw-r--r-- | lisp/gnus-util.el | 13 |
6 files changed, 36 insertions, 22 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8187f82..44a9b46 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,17 @@ +2012-09-06 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-util.el + (gnus-put-text-property-excluding-characters-with-faces): Removed. + + * gnus-compat.el: Define compat function `add-face' from Wolfgang + Jenkner. + + * gnus-group.el (gnus-group-highlight-line): Use combining faces. + + * gnus-sum.el (gnus-summary-highlight-line): Ditto. + + * gnus-salt.el (gnus-tree-highlight-node): Ditto. + 2012-09-06 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-score.el (gnus-score-decode-text-parts): Use #' for diff --git a/lisp/gnus-compat.el b/lisp/gnus-compat.el index 2b25e45..3241cd1 100644 --- a/lisp/gnus-compat.el +++ b/lisp/gnus-compat.el @@ -104,6 +104,24 @@ TRASH is ignored." (and (boundp var) (symbol-value var)))) + +;; Emacs less than 24.3 +(unless (fboundp 'add-face) + (defun add-face (beg end face) + "Combine FACE 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))))))))) + (provide 'gnus-compat) ;; gnus-compat.el ends here diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index dcccdd8..11ba1b2 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -1669,9 +1669,7 @@ and ends at END." gnus-group-highlight)))) (unless (eq face (get-text-property beg 'face)) (let ((inhibit-read-only t)) - (gnus-put-text-property-excluding-characters-with-faces - beg end 'face - (if (boundp face) (symbol-value face) face))) + (add-face beg end (if (boundp face) (symbol-value face) face))) (gnus-extent-start-open beg)))) (defun gnus-group-get-icon (group) diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index 760a7a0..87a1202 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -660,9 +660,7 @@ Two predefined functions are available: (not (eval (caar list)))) (setq list (cdr list))))) (unless (eq (setq face (cdar list)) (get-text-property beg 'face)) - (gnus-put-text-property-excluding-characters-with-faces - beg end 'face - (if (boundp face) (symbol-value face) face))))) + (add-face beg end (if (boundp face) (symbol-value face) face))))) (defun gnus-tree-indent (level) (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? ))) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index efbcb4d..e8e9478 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -12533,9 +12533,8 @@ If REVERSE, save parts that do not match TYPE." (not (memq article gnus-newsgroup-cached))))) (let ((face (funcall (gnus-summary-highlight-line-0)))) (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property-excluding-characters-with-faces - beg (point-at-eol) 'face - (setq face (if (boundp face) (symbol-value face) face))) + (add-face beg (point-at-eol) + (setq face (if (boundp face) (symbol-value face) face))) (when gnus-summary-highlight-line-function (funcall gnus-summary-highlight-line-function article face)))))) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 3c4af9b..791e744 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -866,19 +866,6 @@ 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) - (inline - (gnus-put-text-property - b (setq b (next-single-property-change b 'gnus-face nil end)) - prop val)))))) - (defmacro gnus-faces-at (position) "Return a list of faces at POSITION." (if (featurep 'xemacs) |
