emacs: Handle all face forms when combining faces

[notmuch] / emacs / notmuch-lib.el

diff --git a/emacs/notmuch-lib.el b/emacs/notmuch-lib.el
index d78bcf8065aae699a162241e9e7e92b114a3267a..e7e71ea6cc64d9aabf2049c336c8074a2cdf01e3 100644 (file)
--- a/emacs/notmuch-lib.el
+++ b/emacs/notmuch-lib.el
@@ -97,6 +97,21 @@ For example, if you wanted to remove an \"inbox\" tag and add an
   :group 'notmuch-search
   :group 'notmuch-show)
 
+;; By default clicking on a button does not select the window
+;; containing the button (as opposed to clicking on a widget which
+;; does). This means that the button action is then executed in the
+;; current selected window which can cause problems if the button
+;; changes the buffer (e.g., id: links) or moves point.
+;;
+;; This provides a button type which overrides mouse-action so that
+;; the button's window is selected before the action is run. Other
+;; notmuch buttons can get the same behaviour by inheriting from this
+;; button type.
+(define-button-type 'notmuch-button-type
+  'mouse-action (lambda (button)
+                 (select-window (posn-window (event-start last-input-event)))
+                 (button-activate button)))
+
 (defun notmuch-version ()
   "Return a string with the notmuch version number."
   (let ((long-string
@@ -301,6 +316,16 @@ current buffer, if possible."
   (loop for (key value . rest) on plist by #'cddr
        collect (cons (intern (substring (symbol-name key) 1)) value)))
 
+(defun notmuch-face-ensure-list-form (face)
+  "Return FACE in face list form.
+
+If FACE is already a face list, it will be returned as-is.  If
+FACE is a face name or face plist, it will be returned as a
+single element face list."
+  (if (and (listp face) (not (keywordp (car face))))
+      face
+    (list face)))
+
 (defun notmuch-combine-face-text-property (start end face)
   "Combine FACE into the 'face text property between START and END.
 
@@ -309,11 +334,20 @@ and END.  Attributes specified by FACE take precedence over
 existing attributes.  FACE must be a face name (a symbol or
 string), a property list of face attributes, or a list of these."
 
-  (let ((pos start))
+  ;; 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
+  ;; list case, the faces will be combined, with the earlier faces
+  ;; taking precedent.  Here we canonicalize everything to list form
+  ;; to make it easy to combine.
+  (let ((pos start)
+       (face-list (notmuch-face-ensure-list-form face)))
     (while (< pos end)
-      (let ((cur (get-text-property pos 'face))
-           (next (next-single-property-change pos 'face nil end)))
-       (put-text-property pos next 'face (cons face cur))
+      (let* ((cur (get-text-property pos 'face))
+            (cur-list (notmuch-face-ensure-list-form cur))
+            (new (cond ((null cur-list) face)
+                       (t (append face-list cur-list))))
+            (next (next-single-property-change pos 'face nil end)))
+       (put-text-property pos next 'face new)
        (setq pos next)))))
 
 (defun notmuch-logged-error (msg &optional extra)