emacs: show: make buttons select window

Emacs has two button type objects: widgets (as used for saved searches
in notmuch-hello) and buttons as used by parts/citations and id links
in notmuch-show. These two behave subtly differently when clicked with
the mouse: widgets select the window clicked before running the
action, buttons do not.

This patch makes all of these behave the same: clicking always selects
the clicked window. It does this by defining a notmuch-button-type
supertype that the other notmuch buttons can inherit from. This
supertype binds the mouse-action to select the window and then
activate the button.
This commit is contained in:
Mark Walters 2013-01-07 21:07:20 +00:00 committed by David Bremner
parent c34effad9a
commit 3901bbca2e
4 changed files with 24 additions and 3 deletions

View file

@ -19,6 +19,8 @@
;; ;;
;; Authors: Jameson Rollins <jrollins@finestructure.net> ;; Authors: Jameson Rollins <jrollins@finestructure.net>
(require 'notmuch-lib)
(defcustom notmuch-crypto-process-mime nil (defcustom notmuch-crypto-process-mime nil
"Should cryptographic MIME parts be processed? "Should cryptographic MIME parts be processed?
@ -76,7 +78,8 @@ mode."
(define-button-type 'notmuch-crypto-status-button-type (define-button-type 'notmuch-crypto-status-button-type
'action (lambda (button) (message (button-get button 'help-echo))) 'action (lambda (button) (message (button-get button 'help-echo)))
'follow-link t 'follow-link t
'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts.") 'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts."
:supertype 'notmuch-button-type)
(defun notmuch-crypto-insert-sigstatus-button (sigstatus from) (defun notmuch-crypto-insert-sigstatus-button (sigstatus from)
(let* ((status (plist-get sigstatus :status)) (let* ((status (plist-get sigstatus :status))

View file

@ -97,6 +97,21 @@ For example, if you wanted to remove an \"inbox\" tag and add an
:group 'notmuch-search :group 'notmuch-search
:group 'notmuch-show) :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 () (defun notmuch-version ()
"Return a string with the notmuch version number." "Return a string with the notmuch version number."
(let ((long-string (let ((long-string

View file

@ -469,7 +469,8 @@ message at DEPTH in the current thread."
'action 'notmuch-show-part-button-default 'action 'notmuch-show-part-button-default
'keymap 'notmuch-show-part-button-map 'keymap 'notmuch-show-part-button-map
'follow-link t 'follow-link t
'face 'message-mml) 'face 'message-mml
:supertype 'notmuch-button-type)
(defvar notmuch-show-part-button-map (defvar notmuch-show-part-button-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
@ -1085,6 +1086,7 @@ buttons for a corresponding notmuch search."
;; Remove the overlay created by goto-address-mode ;; Remove the overlay created by goto-address-mode
(remove-overlays (first link) (second link) 'goto-address t) (remove-overlays (first link) (second link) 'goto-address t)
(make-text-button (first link) (second link) (make-text-button (first link) (second link)
:type 'notmuch-button-type
'action `(lambda (arg) 'action `(lambda (arg)
(notmuch-show ,(third link))) (notmuch-show ,(third link)))
'follow-link t 'follow-link t

View file

@ -115,7 +115,8 @@ lower).")
(define-button-type 'notmuch-wash-button-invisibility-toggle-type (define-button-type 'notmuch-wash-button-invisibility-toggle-type
'action 'notmuch-wash-toggle-invisible-action 'action 'notmuch-wash-toggle-invisible-action
'follow-link t 'follow-link t
'face 'font-lock-comment-face) 'face 'font-lock-comment-face
:supertype 'notmuch-button-type)
(define-button-type 'notmuch-wash-button-citation-toggle-type (define-button-type 'notmuch-wash-button-citation-toggle-type
'help-echo "mouse-1, RET: Show citation" 'help-echo "mouse-1, RET: Show citation"