Mercurial > emacs
comparison lisp/wid-edit.el @ 35858:783c81a841f6
(widget-button-click): Fix last change.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Fri, 02 Feb 2001 14:55:04 +0000 |
parents | 636e1b6488ea |
children | 56d876c3560d |
comparison
equal
deleted
inserted
replaced
35857:84bccf78a45f | 35858:783c81a841f6 |
---|---|
849 | 849 |
850 (defun widget-button-click (event) | 850 (defun widget-button-click (event) |
851 "Invoke the button that the mouse is pointing at." | 851 "Invoke the button that the mouse is pointing at." |
852 (interactive "@e") | 852 (interactive "@e") |
853 (if (widget-event-point event) | 853 (if (widget-event-point event) |
854 (progn | 854 (let* ((pos (widget-event-point event)) |
855 (mouse-set-point event) | 855 (button (get-char-property pos 'button))) |
856 (let* ((pos (widget-event-point event)) | 856 (if button |
857 (button (get-char-property pos 'button))) | 857 ;; Mouse click on a widget button. Do the following |
858 (if button | 858 ;; in a save-excursion so that the click on the button |
859 ;; doesn't change point. | |
860 (progn | |
859 (save-excursion | 861 (save-excursion |
862 (mouse-set-point event) | |
860 (let* ((overlay (widget-get button :button-overlay)) | 863 (let* ((overlay (widget-get button :button-overlay)) |
861 (face (overlay-get overlay 'face)) | 864 (face (overlay-get overlay 'face)) |
862 (mouse-face (overlay-get overlay 'mouse-face))) | 865 (mouse-face (overlay-get overlay 'mouse-face))) |
863 (unwind-protect | 866 (unwind-protect |
867 ;; Read events, including mouse-movement events | |
868 ;; until we receive a release event. Highlight/ | |
869 ;; unhighlight the button the mouse was initially | |
870 ;; on when we move over it. | |
864 (let ((track-mouse t)) | 871 (let ((track-mouse t)) |
865 (save-excursion | 872 (save-excursion |
866 (when face ; avoid changing around image | 873 (when face ; avoid changing around image |
867 (overlay-put overlay | 874 (overlay-put overlay |
868 'face widget-button-pressed-face) | 875 'face widget-button-pressed-face) |
882 (overlay-put overlay | 889 (overlay-put overlay |
883 'mouse-face | 890 'mouse-face |
884 widget-button-pressed-face)) | 891 widget-button-pressed-face)) |
885 (overlay-put overlay 'face face) | 892 (overlay-put overlay 'face face) |
886 (overlay-put overlay 'mouse-face mouse-face)))) | 893 (overlay-put overlay 'mouse-face mouse-face)))) |
894 | |
895 ;; When mouse is released over the button, run | |
896 ;; its action function. | |
887 (when (and pos | 897 (when (and pos |
888 (eq (get-char-property pos 'button) button)) | 898 (eq (get-char-property pos 'button) button)) |
889 (widget-apply-action button event)))) | 899 (widget-apply-action button event)))) |
890 (overlay-put overlay 'face face) | 900 (overlay-put overlay 'face face) |
891 (overlay-put overlay 'mouse-face mouse-face)))) | 901 (overlay-put overlay 'mouse-face mouse-face)))) |
892 | 902 |
893 ;; Not on a button. Find the global command to run, and | 903 (unless (pos-visible-in-window-p (widget-event-point event)) |
894 ;; check whether it is bound to an up event. Avoid a | 904 (mouse-set-point event) |
895 ;; `save-excursion' here, since a global command may | 905 (beginning-of-line) |
896 ;; to change point, e.g. like `mouse-drag-drag' does. | 906 (recenter))) |
897 (let ((up t) | 907 |
898 command) | 908 (let ((up t) command) |
909 ;; Mouse click not on a widget button. Find the global | |
910 ;; command to run, and check whether it is bound to an | |
911 ;; up event. | |
912 (mouse-set-point event) | |
899 (if (memq (event-basic-type event) '(mouse-1 down-mouse-1)) | 913 (if (memq (event-basic-type event) '(mouse-1 down-mouse-1)) |
900 (cond ((setq command ;down event | 914 (cond ((setq command ;down event |
901 (lookup-key widget-global-map [down-mouse-1])) | 915 (lookup-key widget-global-map [down-mouse-1])) |
902 (setq up nil)) | 916 (setq up nil)) |
903 ((setq command ;up event | 917 ((setq command ;up event |
911 ;; Don't execute up events twice. | 925 ;; Don't execute up events twice. |
912 (while (not (widget-button-release-event-p event)) | 926 (while (not (widget-button-release-event-p event)) |
913 (setq event (read-event)))) | 927 (setq event (read-event)))) |
914 (when command | 928 (when command |
915 (call-interactively command))))) | 929 (call-interactively command))))) |
916 (unless (pos-visible-in-window-p (widget-event-point event)) | |
917 (mouse-set-point event) | |
918 (beginning-of-line) | |
919 (recenter))) | |
920 (message "You clicked somewhere weird."))) | 930 (message "You clicked somewhere weird."))) |
921 | 931 |
922 (defun widget-button-press (pos &optional event) | 932 (defun widget-button-press (pos &optional event) |
923 "Invoke button at POS." | 933 "Invoke button at POS." |
924 (interactive "@d") | 934 (interactive "@d") |