Mercurial > emacs
comparison lisp/wid-edit.el @ 35456:636e1b6488ea
(widget-button-click): Avoid a save-excursion
around running a global binding.
| author | Gerd Moellmann <gerd@gnu.org> |
|---|---|
| date | Mon, 22 Jan 2001 11:07:10 +0000 |
| parents | 689589ab80b3 |
| children | 783c81a841f6 |
comparison
equal
deleted
inserted
replaced
| 35455:726f7fb9d190 | 35456:636e1b6488ea |
|---|---|
| 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 (save-excursion | 854 (progn |
| 855 (mouse-set-point event) | 855 (mouse-set-point event) |
| 856 (let* ((pos (widget-event-point event)) | 856 (let* ((pos (widget-event-point event)) |
| 857 (button (get-char-property pos 'button))) | 857 (button (get-char-property pos 'button))) |
| 858 (if button | 858 (if button |
| 859 (let* ((overlay (widget-get button :button-overlay)) | 859 (save-excursion |
| 860 (face (overlay-get overlay 'face)) | 860 (let* ((overlay (widget-get button :button-overlay)) |
| 861 (mouse-face (overlay-get overlay 'mouse-face))) | 861 (face (overlay-get overlay 'face)) |
| 862 (unwind-protect | 862 (mouse-face (overlay-get overlay 'mouse-face))) |
| 863 (let ((track-mouse t)) | 863 (unwind-protect |
| 864 (save-excursion | 864 (let ((track-mouse t)) |
| 865 (when face ; avoid changing around image | 865 (save-excursion |
| 866 (overlay-put overlay | 866 (when face ; avoid changing around image |
| 867 'face widget-button-pressed-face) | 867 (overlay-put overlay |
| 868 (overlay-put overlay | 868 'face widget-button-pressed-face) |
| 869 'mouse-face widget-button-pressed-face)) | 869 (overlay-put overlay |
| 870 (unless (widget-apply button :mouse-down-action event) | 870 'mouse-face widget-button-pressed-face)) |
| 871 (while (not (widget-button-release-event-p event)) | 871 (unless (widget-apply button :mouse-down-action event) |
| 872 (setq event (read-event) | 872 (while (not (widget-button-release-event-p event)) |
| 873 pos (widget-event-point event)) | 873 (setq event (read-event) |
| 874 (if (and pos | 874 pos (widget-event-point event)) |
| 875 (eq (get-char-property pos 'button) | 875 (if (and pos |
| 876 button)) | 876 (eq (get-char-property pos 'button) |
| 877 (when face | 877 button)) |
| 878 (overlay-put overlay | 878 (when face |
| 879 'face | 879 (overlay-put overlay |
| 880 widget-button-pressed-face) | 880 'face |
| 881 (overlay-put overlay | 881 widget-button-pressed-face) |
| 882 'mouse-face | 882 (overlay-put overlay |
| 883 widget-button-pressed-face)) | 883 'mouse-face |
| 884 (overlay-put overlay 'face face) | 884 widget-button-pressed-face)) |
| 885 (overlay-put overlay 'mouse-face mouse-face)))) | 885 (overlay-put overlay 'face face) |
| 886 (when (and pos | 886 (overlay-put overlay 'mouse-face mouse-face)))) |
| 887 (eq (get-char-property pos 'button) button)) | 887 (when (and pos |
| 888 (widget-apply-action button event)))) | 888 (eq (get-char-property pos 'button) button)) |
| 889 (overlay-put overlay 'face face) | 889 (widget-apply-action button event)))) |
| 890 (overlay-put overlay 'mouse-face mouse-face))) | 890 (overlay-put overlay 'face face) |
| 891 (overlay-put overlay 'mouse-face mouse-face)))) | |
| 892 | |
| 893 ;; Not on a button. Find the global command to run, and | |
| 894 ;; check whether it is bound to an up event. Avoid a | |
| 895 ;; `save-excursion' here, since a global command may | |
| 896 ;; to change point, e.g. like `mouse-drag-drag' does. | |
| 891 (let ((up t) | 897 (let ((up t) |
| 892 command) | 898 command) |
| 893 ;; Find the global command to run, and check whether it | |
| 894 ;; is bound to an up event. | |
| 895 (if (memq (event-basic-type event) '(mouse-1 down-mouse-1)) | 899 (if (memq (event-basic-type event) '(mouse-1 down-mouse-1)) |
| 896 (cond ((setq command ;down event | 900 (cond ((setq command ;down event |
| 897 (lookup-key widget-global-map [down-mouse-1])) | 901 (lookup-key widget-global-map [down-mouse-1])) |
| 898 (setq up nil)) | 902 (setq up nil)) |
| 899 ((setq command ;up event | 903 ((setq command ;up event |