Mercurial > emacs
comparison lisp/help.el @ 69310:270a2959d019
* help.el (describe-key): Properly handle the return value of
read-key-sequence when grabbing an up-event. Cleanup mouse-1
remaps.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Mon, 06 Mar 2006 20:27:06 +0000 |
| parents | aa9f0a1e543f |
| children | c3bd744c874c |
comparison
equal
deleted
inserted
replaced
| 69309:f0678aafb24e | 69310:270a2959d019 |
|---|---|
| 651 ;; "Select and Paste" menu can generate a complete event. | 651 ;; "Select and Paste" menu can generate a complete event. |
| 652 (when (null (cdr yank-menu)) | 652 (when (null (cdr yank-menu)) |
| 653 (setq saved-yank-menu (copy-sequence yank-menu)) | 653 (setq saved-yank-menu (copy-sequence yank-menu)) |
| 654 (menu-bar-update-yank-menu "(any string)" nil)) | 654 (menu-bar-update-yank-menu "(any string)" nil)) |
| 655 (setq key (read-key-sequence "Describe key (or click or menu item): ")) | 655 (setq key (read-key-sequence "Describe key (or click or menu item): ")) |
| 656 (setq foo key) | |
| 656 (list | 657 (list |
| 657 key | 658 key |
| 658 (prefix-numeric-value current-prefix-arg) | 659 (prefix-numeric-value current-prefix-arg) |
| 659 ;; If KEY is a down-event, read the corresponding up-event | 660 ;; If KEY is a down-event, read the corresponding up-event |
| 660 ;; and use it as the third argument. | 661 ;; and use it as the third argument. |
| 661 (if (and (consp key) (symbolp (car key)) | 662 (if (and (vectorp key) |
| 662 (memq 'down (cdr (get (car key) 'event-symbol-elements)))) | 663 (eventp (elt key 0)) |
| 664 (memq 'down (event-modifiers (elt key 0)))) | |
| 663 (read-event)))) | 665 (read-event)))) |
| 664 ;; Put yank-menu back as it was, if we changed it. | 666 ;; Put yank-menu back as it was, if we changed it. |
| 665 (when saved-yank-menu | 667 (when saved-yank-menu |
| 666 (setq yank-menu (copy-sequence saved-yank-menu)) | 668 (setq yank-menu (copy-sequence saved-yank-menu)) |
| 667 (fset 'yank-menu (cons 'keymap yank-menu)))))) | 669 (fset 'yank-menu (cons 'keymap yank-menu)))))) |
| 702 (princ " at that spot")) | 704 (princ " at that spot")) |
| 703 (princ " runs the command ") | 705 (princ " runs the command ") |
| 704 (prin1 defn) | 706 (prin1 defn) |
| 705 (princ "\n which is ") | 707 (princ "\n which is ") |
| 706 (describe-function-1 defn) | 708 (describe-function-1 defn) |
| 709 (setq foo up-event) | |
| 707 (when up-event | 710 (when up-event |
| 708 (let ((ev (aref up-event 0)) | 711 (let ((type (event-basic-type up-event)) |
| 709 (descr (key-description up-event)) | |
| 710 (hdr "\n\n-------------- up event ---------------\n\n") | 712 (hdr "\n\n-------------- up event ---------------\n\n") |
| 711 defn | 713 defn |
| 712 mouse-1-tricky mouse-1-remapped) | 714 mouse-1-tricky mouse-1-remapped) |
| 713 (when (and (consp ev) | 715 (when (and (eq type 'mouse-1) |
| 714 (eq (car ev) 'mouse-1) | |
| 715 (windowp window) | 716 (windowp window) |
| 716 mouse-1-click-follows-link | 717 mouse-1-click-follows-link |
| 717 (not (eq mouse-1-click-follows-link 'double)) | 718 (not (eq mouse-1-click-follows-link 'double)) |
| 718 (with-current-buffer (window-buffer window) | 719 (with-current-buffer (window-buffer window) |
| 719 (mouse-on-link-p (posn-point (event-start ev))))) | 720 (mouse-on-link-p (posn-point (event-start up-event))))) |
| 720 (setq mouse-1-tricky (integerp mouse-1-click-follows-link) | 721 (setq mouse-1-remapped t) |
| 721 mouse-1-remapped (or (not mouse-1-tricky) | 722 (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link) |
| 722 (> mouse-1-click-follows-link 0))) | 723 (> mouse-1-click-follows-link 0))) |
| 723 (if mouse-1-remapped | 724 (setcar up-event 'mouse-2)) |
| 724 (setcar ev 'mouse-2))) | 725 (setq defn (key-binding (vector up-event))) |
| 725 (setq defn (or (string-key-binding up-event) (key-binding up-event))) | |
| 726 (unless (or (null defn) (integerp defn) (equal defn 'undefined)) | 726 (unless (or (null defn) (integerp defn) (equal defn 'undefined)) |
| 727 (princ (if mouse-1-tricky | 727 (princ (if mouse-1-tricky |
| 728 "\n\n----------------- up-event (short click) ----------------\n\n" | 728 "\n\n----------------- up-event (short click) ----------------\n\n" |
| 729 hdr)) | 729 hdr)) |
| 730 (setq hdr nil) | 730 (setq hdr nil) |
| 731 (princ descr) | 731 (princ (symbol-name type)) |
| 732 (if (windowp window) | 732 (if (windowp window) |
| 733 (princ " at that spot")) | 733 (princ " at that spot")) |
| 734 (if mouse-1-remapped | 734 (if mouse-1-remapped |
| 735 (princ " is remapped to <mouse-2>\n which" )) | 735 (princ " is remapped to <mouse-2>\n which" )) |
| 736 (princ " runs the command ") | 736 (princ " runs the command ") |
| 737 (prin1 defn) | 737 (prin1 defn) |
| 738 (princ "\n which is ") | 738 (princ "\n which is ") |
| 739 (describe-function-1 defn)) | 739 (describe-function-1 defn)) |
| 740 (when mouse-1-tricky | 740 (when mouse-1-tricky |
| 741 (setcar ev | 741 (setcar up-event 'mouse-1) |
| 742 (if (> mouse-1-click-follows-link 0) 'mouse-1 'mouse-2)) | 742 (setq defn (key-binding (vector up-event))) |
| 743 (setq defn (or (string-key-binding up-event) (key-binding up-event))) | 743 (unless (or (null defn) (integerp defn) (eq defn 'undefined)) |
| 744 (unless (or (null defn) (integerp defn) (equal defn 'undefined)) | |
| 745 (princ (or hdr | 744 (princ (or hdr |
| 746 "\n\n----------------- up-event (long click) ----------------\n\n")) | 745 "\n\n----------------- up-event (long click) ----------------\n\n")) |
| 747 (princ "Pressing ") | 746 (princ "Pressing mouse-1") |
| 748 (princ descr) | |
| 749 (if (windowp window) | 747 (if (windowp window) |
| 750 (princ " at that spot")) | 748 (princ " at that spot")) |
| 751 (princ (format " for longer than %d milli-seconds\n" | 749 (princ (format " for longer than %d milli-seconds\n" |
| 752 (abs mouse-1-click-follows-link))) | 750 mouse-1-click-follows-link)) |
| 753 (if (not mouse-1-remapped) | |
| 754 (princ " remaps it to <mouse-2> which" )) | |
| 755 (princ " runs the command ") | 751 (princ " runs the command ") |
| 756 (prin1 defn) | 752 (prin1 defn) |
| 757 (princ "\n which is ") | 753 (princ "\n which is ") |
| 758 (describe-function-1 defn))))) | 754 (describe-function-1 defn))))) |
| 759 (print-help-return-message))))))) | 755 (print-help-return-message))))))) |
| 760 | |
| 761 | 756 |
| 762 (defun describe-mode (&optional buffer) | 757 (defun describe-mode (&optional buffer) |
| 763 "Display documentation of current major mode and minor modes. | 758 "Display documentation of current major mode and minor modes. |
| 764 A brief summary of the minor modes comes first, followed by the | 759 A brief summary of the minor modes comes first, followed by the |
| 765 major mode description. This is followed by detailed | 760 major mode description. This is followed by detailed |