emacs: Combine string faces and combine under existing faces

This improves notmuch-combine-face-text-property to support both
applying faces to strings and to support combining the given face
under existing faces, rather than over.
This commit is contained in:
Austin Clements 2013-02-04 16:37:02 -05:00 committed by David Bremner
parent 3ddb4dc806
commit 9cf89a3c04

View file

@ -326,13 +326,16 @@ single element face list."
face face
(list face))) (list face)))
(defun notmuch-combine-face-text-property (start end face) (defun notmuch-combine-face-text-property (start end face &optional below object)
"Combine FACE into the 'face text property between START and END. "Combine FACE into the 'face text property between START and END.
This function combines FACE with any existing faces between START This function combines FACE with any existing faces between START
and END. Attributes specified by FACE take precedence over and END in OBJECT (which defaults to the current buffer).
existing attributes. FACE must be a face name (a symbol or Attributes specified by FACE take precedence over existing
string), a property list of face attributes, or a list of these." attributes unless BELOW is non-nil. FACE must be a face name (a
symbol or string), a property list of face attributes, or a list
of these. For convenience when applied to strings, this returns
OBJECT."
;; A face property can have three forms: a face name (a string or ;; A face property can have three forms: a face name (a string or
;; symbol), a property list, or a list of these two forms. In the ;; symbol), a property list, or a list of these two forms. In the
@ -342,13 +345,15 @@ string), a property list of face attributes, or a list of these."
(let ((pos start) (let ((pos start)
(face-list (notmuch-face-ensure-list-form face))) (face-list (notmuch-face-ensure-list-form face)))
(while (< pos end) (while (< pos end)
(let* ((cur (get-text-property pos 'face)) (let* ((cur (get-text-property pos 'face object))
(cur-list (notmuch-face-ensure-list-form cur)) (cur-list (notmuch-face-ensure-list-form cur))
(new (cond ((null cur-list) face) (new (cond ((null cur-list) face)
(below (append cur-list face-list))
(t (append face-list cur-list)))) (t (append face-list cur-list))))
(next (next-single-property-change pos 'face nil end))) (next (next-single-property-change pos 'face object end)))
(put-text-property pos next 'face new) (put-text-property pos next 'face new object)
(setq pos next))))) (setq pos next))))
object)
(defun notmuch-logged-error (msg &optional extra) (defun notmuch-logged-error (msg &optional extra)
"Log MSG and EXTRA to *Notmuch errors* and signal MSG. "Log MSG and EXTRA to *Notmuch errors* and signal MSG.