Mercurial > emacs
changeset 68935:bb4dc0e56e88
* wid-edit.el (widget-button-click): For mouse-1, cancel button
press and perform default action if we get a mouse movement event.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Thu, 16 Feb 2006 15:58:32 +0000 |
| parents | b2331da25bb1 |
| children | 133a58334c29 |
| files | lisp/ChangeLog lisp/wid-edit.el |
| diffstat | 2 files changed, 70 insertions(+), 53 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Thu Feb 16 11:45:23 2006 +0000 +++ b/lisp/ChangeLog Thu Feb 16 15:58:32 2006 +0000 @@ -1,3 +1,8 @@ +2006-02-16 Chong Yidong <cyd@stupidchicken.com> + + * wid-edit.el (widget-button-click): For mouse-1, cancel button + press and perform default action if we get a mouse movement event. + 2006-02-16 Juanma Barranquero <lekktu@gmail.com> * calendar/icalendar.el (icalendar--get-event-property)
--- a/lisp/wid-edit.el Thu Feb 16 11:45:23 2006 +0000 +++ b/lisp/wid-edit.el Thu Feb 16 15:58:32 2006 +0000 @@ -916,67 +916,79 @@ "Invoke the button that the mouse is pointing at." (interactive "e") (if (widget-event-point event) - (let* ((pos (widget-event-point event)) + (let* ((oevent event) + (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 pos 'button (and (windowp (posn-window start)) (window-buffer (posn-window start)))))) - (if button - ;; 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 - ;; until we receive a release event. 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) - 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)) - (widget-apply-action button event))) - (overlay-put overlay 'face face) - (overlay-put overlay 'mouse-face mouse-face)))) - - (unless (pos-visible-in-window-p (widget-event-point event)) - (mouse-set-point event) - (beginning-of-line) - (recenter)) - ) - + (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)) + (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)) + (widget-apply-action button event))) + (overlay-put overlay 'face face) + (overlay-put overlay 'mouse-face mouse-face)))) + + ;; 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) ;; Mouse click not on a widget button. Find the global ;; command to run, and check whether it is bound to an ;; up event. - (mouse-set-point event) - (if (memq (event-basic-type event) '(mouse-1 down-mouse-1)) + (if mouse-1 (cond ((setq command ;down event (lookup-key widget-global-map [down-mouse-1])) (setq up nil))