mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-24 07:20:37 +00:00
Code Issues Releases Activity

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

Browse Source 
press and perform default action if we get a mouse movement event.
This commit is contained in:
Chong Yidong 2006-02-16 15:58:32 +00:00
parent b51897597a
commit bc7b6e08e2
2 changed files with 68 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lisp/ChangeLog
View File

@ -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)

114
lisp/wid-edit.el
View File

@ -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 (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))))
(unless (pos-visible-in-window-p (widget-event-point event))
(mouse-set-point event)
(beginning-of-line)
(recenter))
)
;; 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))