[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 8b61e20 2/3: Refactor a very long wid-edit function and add addit
|
From: |
Lars Ingebrigtsen |
|
Subject: |
master 8b61e20 2/3: Refactor a very long wid-edit function and add additional checking |
|
Date: |
Thu, 17 Sep 2020 14:43:46 -0400 (EDT) |
branch: master
commit 8b61e20e4edb9d2f67134bc9f3739f936aafb01c
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>
Refactor a very long wid-edit function and add additional checking
* lisp/wid-edit.el (widget-button--check-and-call-button): Factor
out a too-long condition/call...
(widget-button-click): From here.
---
lisp/wid-edit.el | 151 ++++++++++++++++++++++++++++---------------------------
1 file changed, 78 insertions(+), 73 deletions(-)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index bc2afc6..8be489b 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -973,86 +973,91 @@ Note that such modes will need to require wid-edit.")
"If non-nil, `widget-button-click' moves point to a button after invoking it.
If nil, point returns to its original position after invoking a button.")
+(defun widget-button--check-and-call-button (event button)
+ "Call BUTTON if BUTTON is a widget and EVENT is correct for it.
+If nothing was called, return non-nil."
+ (let* ((oevent event)
+ (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
+ newpoint pos)
+ (catch 'button-press-cancelled
+ ;; Mouse click on a widget button. Do the following
+ ;; in a save-excursion so that the click on the button
+ ;; doesn't change point.
+ (save-selected-window
+ (select-window (posn-window (event-start event)))
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (let* ((overlay (widget-get button :button-overlay))
+ (pressed-face (or (widget-get button :pressed-face)
+ widget-button-pressed-face))
+ (face (overlay-get overlay 'face))
+ (mouse-face (overlay-get overlay 'mouse-face)))
+ (unwind-protect
+ ;; Read events, including mouse-movement
+ ;; events, waiting for a release event. If we
+ ;; began with a mouse-1 event and receive a
+ ;; movement event, that means the user wants
+ ;; to perform drag-selection, so cancel the
+ ;; button press and do the default mouse-1
+ ;; action. For mouse-2, just highlight/
+ ;; unhighlight the button the mouse was
+ ;; initially on when we move over it.
+ (save-excursion
+ (when face ; avoid changing around image
+ (overlay-put overlay 'face pressed-face)
+ (overlay-put overlay 'mouse-face pressed-face))
+ (unless (widget-apply button :mouse-down-action event)
+ (let ((track-mouse t))
+ (while (not (widget-button-release-event-p event))
+ (setq event (read-event))
+ (when (and mouse-1 (mouse-movement-p event))
+ (push event unread-command-events)
+ (setq event oevent)
+ (throw 'button-press-cancelled t))
+ (unless (or (integerp event)
+ (memq (car event)
+ '(switch-frame select-window))
+ (eq (car event) 'scroll-bar-movement))
+ (setq pos (widget-event-point event))
+ (if (and pos
+ (eq (get-char-property pos 'button)
+ button))
+ (when face
+ (overlay-put overlay 'face pressed-face)
+ (overlay-put overlay 'mouse-face pressed-face))
+ (overlay-put overlay 'face face)
+ (overlay-put overlay 'mouse-face mouse-face))))))
+
+ ;; When mouse is released over the button, run
+ ;; its action function.
+ (when (and pos (eq (get-char-property pos 'button) button))
+ (goto-char pos)
+ (widget-apply-action button event)
+ (if widget-button-click-moves-point
+ (setq newpoint (point)))))
+ (overlay-put overlay 'face face)
+ (overlay-put overlay 'mouse-face mouse-face))))
+
+ (when newpoint
+ (goto-char newpoint)))
+ nil)))
+
(defun widget-button-click (event)
"Invoke the button that the mouse is pointing at."
(interactive "e")
(if (widget-event-point event)
- (let* ((oevent event)
- (mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
+ (let* ((mouse-1 (memq (event-basic-type event) '(mouse-1 down-mouse-1)))
(pos (widget-event-point event))
(start (event-start event))
- (button (get-char-property
+ (button (get-char-property
pos 'button (and (windowp (posn-window start))
- (window-buffer (posn-window start)))))
- newpoint)
- (when (or (null button)
- (catch 'button-press-cancelled
- ;; Mouse click on a widget button. Do the following
- ;; in a save-excursion so that the click on the button
- ;; doesn't change point.
- (save-selected-window
- (select-window (posn-window (event-start event)))
- (save-excursion
- (goto-char (posn-point (event-start event)))
- (let* ((overlay (widget-get button :button-overlay))
- (pressed-face (or (widget-get button :pressed-face)
- widget-button-pressed-face))
- (face (overlay-get overlay 'face))
- (mouse-face (overlay-get overlay 'mouse-face)))
- (unwind-protect
- ;; Read events, including mouse-movement
- ;; events, waiting for a release event. If we
- ;; began with a mouse-1 event and receive a
- ;; movement event, that means the user wants
- ;; to perform drag-selection, so cancel the
- ;; button press and do the default mouse-1
- ;; action. For mouse-2, just highlight/
- ;; unhighlight the button the mouse was
- ;; initially on when we move over it.
- (save-excursion
- (when face ; avoid changing around image
- (overlay-put overlay 'face pressed-face)
- (overlay-put overlay 'mouse-face pressed-face))
- (unless (widget-apply button :mouse-down-action event)
- (let ((track-mouse t))
- (while (not (widget-button-release-event-p event))
- (setq event (read-event))
- (when (and mouse-1 (mouse-movement-p event))
- (push event unread-command-events)
- (setq event oevent)
- (throw 'button-press-cancelled t))
- (unless (or (integerp event)
- (memq (car event) '(switch-frame
select-window))
- (eq (car event)
'scroll-bar-movement))
- (setq pos (widget-event-point event))
- (if (and pos
- (eq (get-char-property pos 'button)
- button))
- (when face
- (overlay-put overlay 'face pressed-face)
- (overlay-put overlay 'mouse-face
pressed-face))
- (overlay-put overlay 'face face)
- (overlay-put overlay 'mouse-face
mouse-face))))))
-
- ;; When mouse is released over the button, run
- ;; its action function.
- (when (and pos (eq (get-char-property pos 'button)
button))
- (goto-char pos)
- (widget-apply-action button event)
- (if widget-button-click-moves-point
- (setq newpoint (point)))))
- (overlay-put overlay 'face face)
- (overlay-put overlay 'mouse-face mouse-face))))
-
- (if newpoint (goto-char newpoint))
- ;; This loses if the widget action switches windows. -- cyd
- ;; (unless (pos-visible-in-window-p (widget-event-point event))
- ;; (mouse-set-point event)
- ;; (beginning-of-line)
- ;; (recenter))
- )
- nil))
- (let ((up t) command)
+ (window-buffer (posn-window start))))))
+
+ (when (and (widget-get button :button-overlay)
+ (or (null button)
+ (widget-button--check-and-call-button event button)))
+ (let ((up t)
+ command)
;; Mouse click not on a widget button. Find the global
;; command to run, and check whether it is bound to an
;; up event.