* wid-edit.el (widget-button-click): For mouse-1, cancel button

	press and perform default action if we get a mouse movement event.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 670f6db6282ae5aa371da28da2c069b9263af3dc..5dc2fec8b979cf7a0d6368bbcdc941667d829f67 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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)

diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 659c562ea659dfc3e6f331eedc468325f30ab6e3..fc64dd5f3617294cd5a2e16a3fe3c7995bb477c0 100644 (file)
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -916,67 +916,79 @@ Recommended as a parent keymap for modes using widgets.")
   "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))