- "Invoke the button that the mouse is pointing at, and move there."
- (interactive "@e")
- (mouse-set-point event)
- (cond ((and (fboundp 'event-glyph)
- (event-glyph event))
- (widget-glyph-click event))
- ((widget-event-point event)
- (let* ((pos (widget-event-point event))
- (button (get-char-property pos 'button)))
- (if button
- (let* ((overlay (widget-get button :button-overlay))
- (face (overlay-get overlay 'face))
- (mouse-face (overlay-get overlay 'mouse-face)))
- (unwind-protect
- (let ((track-mouse t))
- (overlay-put overlay
- 'face 'widget-button-pressed-face)
- (overlay-put overlay
- 'mouse-face 'widget-button-pressed-face)
- (unless (widget-apply button :mouse-down-action event)
- (while (not (button-release-event-p event))
- (setq event (widget-read-event)
- pos (widget-event-point event))
- (if (and pos
- (eq (get-char-property pos 'button)
- button))
- (progn
- (overlay-put overlay
- 'face
- 'widget-button-pressed-face)
- (overlay-put overlay
- 'mouse-face
- 'widget-button-pressed-face))
- (overlay-put overlay 'face face)
- (overlay-put overlay 'mouse-face mouse-face))))
- (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)))
- (let ((up t)
- command)
- ;; Find the global command to run, and check whether it
- ;; is bound to an up event.
- (cond ((setq command ;down event
- (lookup-key widget-global-map [ button2 ]))
- (setq up nil))
- ((setq command ;down event
- (lookup-key widget-global-map [ down-mouse-2 ]))
- (setq up nil))
- ((setq command ;up event
- (lookup-key widget-global-map [ button2up ])))
- ((setq command ;up event
- (lookup-key widget-global-map [ mouse-2]))))
- (when up
- ;; Don't execute up events twice.
- (while (not (button-release-event-p event))
- (setq event (widget-read-event))))
- (when command
- (call-interactively command))))))
- (t
- (message "You clicked somewhere weird."))))
-
-(defun widget-button1-click (event)
- "Invoke glyph below mouse pointer."
- (interactive "@e")
- (if (and (fboundp 'event-glyph)
- (event-glyph event))
- (widget-glyph-click event)
- (call-interactively (lookup-key widget-global-map (this-command-keys)))))
-
-(defun widget-glyph-click (event)
- "Handle click on a glyph."
- (let* ((glyph (event-glyph event))
- (widget (glyph-property glyph 'widget))
- (extent (event-glyph-extent event))
- (down-glyph (or (and widget (widget-get widget :glyph-down)) glyph))
- (up-glyph (or (and widget (widget-get widget :glyph-up)) glyph))
- (last event))
- ;; Wait for the release.
- (while (not (button-release-event-p last))
- (if (eq extent (event-glyph-extent last))
- (set-extent-property extent 'end-glyph down-glyph)
- (set-extent-property extent 'end-glyph up-glyph))
- (setq last (next-event event)))
- ;; Release glyph.
- (when down-glyph
- (set-extent-property extent 'end-glyph up-glyph))
- ;; Apply widget action.
- (when (eq extent (event-glyph-extent last))
- (let ((widget (glyph-property (event-glyph event) 'widget)))
- (cond ((null widget)
- (message "You clicked on a glyph."))
- ((not (widget-apply widget :active))
- (message "This glyph is inactive."))
- (t
- (widget-apply-action widget event)))))))
+ "Invoke the button that the mouse is pointing at."
+ (interactive "e")
+ (if (widget-event-point event)
+ (let* ((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))
+ (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 widget-button-pressed-face)
+ (overlay-put overlay
+ 'mouse-face widget-button-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
+ widget-button-pressed-face)
+ (overlay-put overlay
+ 'mouse-face
+ widget-button-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))
+ )
+
+ (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))
+ (cond ((setq command ;down event
+ (lookup-key widget-global-map [down-mouse-1]))
+ (setq up nil))
+ ((setq command ;up event
+ (lookup-key widget-global-map [mouse-1]))))
+ (cond ((setq command ;down event
+ (lookup-key widget-global-map [down-mouse-2]))
+ (setq up nil))
+ ((setq command ;up event
+ (lookup-key widget-global-map [mouse-2])))))
+ (when up
+ ;; Don't execute up events twice.
+ (while (not (widget-button-release-event-p event))
+ (setq event (read-event))))
+ (when command
+ (call-interactively command)))))
+ (message "You clicked somewhere weird.")))