:type 'directory)
(defcustom widget-image-enable t
- "If non nil, use image buttons in widgets when available."
+ "If non-nil, use image buttons in widgets when available."
:version "21.1"
:group 'widgets
:type 'boolean)
(define-key map [(shift tab)] 'advertised-widget-backward)
(define-key map [backtab] 'widget-backward)
(define-key map [down-mouse-2] 'widget-button-click)
+ (define-key map [down-mouse-1] 'widget-button-click)
(define-key map "\C-m" 'widget-button-press)
map)
"Keymap containing useful binding for buffers containing widgets.
;; backward-compatibility alias
(put 'widget-button-pressed-face 'face-alias 'widget-button-pressed)
+(defvar widget-button-click-moves-point nil
+ "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-click (event)
"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))
- )
-
+ (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)
;; 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))
;;; The `push-button' Widget.
;; (defcustom widget-push-button-gui t
-;; "If non nil, use GUI push buttons when available."
+;; "If non-nil, use GUI push buttons when available."
;; :group 'widgets
;; :type 'boolean)
"History of field minibuffer edits.")
(defun widget-field-prompt-internal (widget prompt initial history)
- "Read string for WIDGET promptinhg with PROMPT.
+ "Read string for WIDGET prompting with PROMPT.
INITIAL is the initial input and HISTORY is a symbol containing
the earlier input."
(read-string prompt initial history))
;;; The `editable-list' Widget.
;; (defcustom widget-editable-list-gui nil
-;; "If non nil, use GUI push-buttons in editable list when available."
+;; "If non-nil, use GUI push-buttons in editable list when available."
;; :type 'boolean
;; :group 'widgets)
(defcustom widget-documentation-link-p 'intern-soft
"Predicate used to test if a string is useful as a link.
-The value should be a function. The function will be called one
+The value should be a function. The function will be called with one
argument, a string, and should return non-nil if there should be a
link for that string."
:type 'function