aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/help.el
diff options
context:
space:
mode:
authorDavid Kastrup2006-09-15 08:53:18 +0000
committerDavid Kastrup2006-09-15 08:53:18 +0000
commit91a2acb229ac102ef15866174fb2d62c8e36598c (patch)
tree5d23741ece50bf6da9e72a6b51aadc74a54f7c61 /lisp/help.el
parentb74e16a384ddbded12eb7e8c7250253614554641 (diff)
downloademacs-91a2acb229ac102ef15866174fb2d62c8e36598c.tar.gz
emacs-91a2acb229ac102ef15866174fb2d62c8e36598c.zip
* mouse-sel.el (mouse-sel-follow-link-p): Use event position
instead of buffer position for `mouse-on-link-p'. * mouse.el (mouse-posn-property): New function looking up the properties at a click position in overlays and text properties in either buffer or strings. (mouse-on-link-p): Use `mouse-posn-property' to streamline lookup of both `follow-link' as well as `mouse-face' properties. (mouse-drag-track): Check `mouse-on-link-p' on event position, not buffer position. * help.el (describe-key-briefly): When reading a down-event on mode lines or scroll bar, swallow the following up event, too. Use the new mouse sensitity of `key-binding' for lookup. (describe-key): The same here.
Diffstat (limited to 'lisp/help.el')
-rw-r--r--lisp/help.el265
1 files changed, 132 insertions, 133 deletions
diff --git a/lisp/help.el b/lisp/help.el
index d5682512b2d..72a45ec15bf 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -567,11 +567,16 @@ temporarily enables it to allow getting help on disabled items and buttons."
567 (menu-bar-update-yank-menu "(any string)" nil)) 567 (menu-bar-update-yank-menu "(any string)" nil))
568 (setq key (read-key-sequence "Describe key (or click or menu item): ")) 568 (setq key (read-key-sequence "Describe key (or click or menu item): "))
569 ;; If KEY is a down-event, read and discard the 569 ;; If KEY is a down-event, read and discard the
570 ;; corresponding up-event. 570 ;; corresponding up-event. Note that there are also
571 (if (and (vectorp key) 571 ;; down-events on scroll bars and mode lines: the actual
572 (eventp (elt key 0)) 572 ;; event then is in the second element of the vector.
573 (memq 'down (event-modifiers (elt key 0)))) 573 (and (vectorp key)
574 (read-event)) 574 (or (and (eventp (aref key 0))
575 (memq 'down (event-modifiers (aref key 0))))
576 (and (> (length key) 1)
577 (eventp (aref key 1))
578 (memq 'down (event-modifiers (aref key 1)))))
579 (read-event))
575 (list 580 (list
576 key 581 key
577 (if current-prefix-arg (prefix-numeric-value current-prefix-arg)) 582 (if current-prefix-arg (prefix-numeric-value current-prefix-arg))
@@ -582,45 +587,40 @@ temporarily enables it to allow getting help on disabled items and buttons."
582 (fset 'yank-menu (cons 'keymap yank-menu)))))) 587 (fset 'yank-menu (cons 'keymap yank-menu))))))
583 (if (numberp untranslated) 588 (if (numberp untranslated)
584 (setq untranslated (this-single-command-raw-keys))) 589 (setq untranslated (this-single-command-raw-keys)))
585 (save-excursion 590 (let* ((event (if (and (symbolp (aref key 0))
586 (let ((modifiers (event-modifiers (aref key 0))) 591 (> (length key) 1)
587 (standard-output (if insert (current-buffer) t)) 592 (consp (aref key 1)))
588 window position) 593 (aref key 1)
589 ;; For a mouse button event, go to the button it applies to 594 (aref key 0)))
590 ;; to get the right key bindings. And go to the right place 595 (modifiers (event-modifiers event))
591 ;; in case the keymap depends on where you clicked. 596 (standard-output (if insert (current-buffer) t))
592 (if (or (memq 'click modifiers) (memq 'down modifiers) 597 (mousep
593 (memq 'drag modifiers)) 598 (or (memq 'click modifiers) (memq 'down modifiers)
594 (setq window (posn-window (event-start (aref key 0))) 599 (memq 'drag modifiers))))
595 position (posn-point (event-start (aref key 0))))) 600 ;; Ok, now look up the key and name the command.
596 (if (windowp window) 601 (let ((defn (key-binding key t))
597 (progn 602 key-desc)
598 (set-buffer (window-buffer window)) 603 ;; Handle the case where we faked an entry in "Select and Paste" menu.
599 (goto-char position))) 604 (if (and (eq defn nil)
600 ;; Ok, now look up the key and name the command. 605 (stringp (aref key (1- (length key))))
601 (let ((defn (key-binding key t)) 606 (eq (key-binding (substring key 0 -1)) 'yank-menu))
602 key-desc) 607 (setq defn 'menu-bar-select-yank))
603 ;; Handle the case where we faked an entry in "Select and Paste" menu. 608 ;; Don't bother user with strings from (e.g.) the select-paste menu.
604 (if (and (eq defn nil) 609 (if (stringp (aref key (1- (length key))))
605 (stringp (aref key (1- (length key)))) 610 (aset key (1- (length key)) "(any string)"))
606 (eq (key-binding (substring key 0 -1)) 'yank-menu)) 611 (if (and (> (length untranslated) 0)
607 (setq defn 'menu-bar-select-yank)) 612 (stringp (aref untranslated (1- (length untranslated)))))
608 ;; Don't bother user with strings from (e.g.) the select-paste menu. 613 (aset untranslated (1- (length untranslated))
609 (if (stringp (aref key (1- (length key)))) 614 "(any string)"))
610 (aset key (1- (length key)) "(any string)")) 615 ;; Now describe the key, perhaps as changed.
611 (if (and (> (length untranslated) 0) 616 (setq key-desc (help-key-description key untranslated))
612 (stringp (aref untranslated (1- (length untranslated))))) 617 (if (or (null defn) (integerp defn) (equal defn 'undefined))
613 (aset untranslated (1- (length untranslated)) 618 (princ (format "%s is undefined" key-desc))
614 "(any string)")) 619 (princ (format (if mousep
615 ;; Now describe the key, perhaps as changed. 620 "%s at that spot runs the command %s"
616 (setq key-desc (help-key-description key untranslated)) 621 "%s runs the command %s")
617 (if (or (null defn) (integerp defn) (equal defn 'undefined)) 622 key-desc
618 (princ (format "%s is undefined" key-desc)) 623 (if (symbolp defn) defn (prin1-to-string defn))))))))
619 (princ (format (if (windowp window)
620 "%s at that spot runs the command %s"
621 "%s runs the command %s")
622 key-desc
623 (if (symbolp defn) defn (prin1-to-string defn)))))))))
624 624
625(defun describe-key (&optional key untranslated up-event) 625(defun describe-key (&optional key untranslated up-event)
626 "Display documentation of the function invoked by KEY. 626 "Display documentation of the function invoked by KEY.
@@ -652,105 +652,104 @@ temporarily enables it to allow getting help on disabled items and buttons."
652 (prefix-numeric-value current-prefix-arg) 652 (prefix-numeric-value current-prefix-arg)
653 ;; If KEY is a down-event, read the corresponding up-event 653 ;; If KEY is a down-event, read the corresponding up-event
654 ;; and use it as the third argument. 654 ;; and use it as the third argument.
655 (if (and (vectorp key) 655 (and (vectorp key)
656 (eventp (elt key 0)) 656 (or (and (eventp (aref key 0))
657 (memq 'down (event-modifiers (elt key 0)))) 657 (memq 'down (event-modifiers (aref key 0))))
658 (read-event)))) 658 (and (> (length key) 1)
659 (eventp (aref key 1))
660 (memq 'down (event-modifiers (aref key 1)))))
661 (read-event))))
659 ;; Put yank-menu back as it was, if we changed it. 662 ;; Put yank-menu back as it was, if we changed it.
660 (when saved-yank-menu 663 (when saved-yank-menu
661 (setq yank-menu (copy-sequence saved-yank-menu)) 664 (setq yank-menu (copy-sequence saved-yank-menu))
662 (fset 'yank-menu (cons 'keymap yank-menu)))))) 665 (fset 'yank-menu (cons 'keymap yank-menu))))))
663 (if (numberp untranslated) 666 (if (numberp untranslated)
664 (setq untranslated (this-single-command-raw-keys))) 667 (setq untranslated (this-single-command-raw-keys)))
665 (save-excursion 668 (let* ((event (if (and (symbolp (aref key 0))
666 (let ((modifiers (event-modifiers (aref key 0))) 669 (> (length key) 1)
667 window position) 670 (consp (aref key 1)))
668 ;; For a mouse button event, go to the button it applies to 671 (aref key 1)
669 ;; to get the right key bindings. And go to the right place 672 (aref key 0)))
670 ;; in case the keymap depends on where you clicked. 673 (modifiers (event-modifiers event))
671 (if (or (memq 'click modifiers) (memq 'down modifiers) 674 (mousep
672 (memq 'drag modifiers)) 675 (or (memq 'click modifiers) (memq 'down modifiers)
673 (setq window (posn-window (event-start (aref key 0))) 676 (memq 'drag modifiers))))
674 position (posn-point (event-start (aref key 0))))) 677 ;; Ok, now look up the key and name the command.
675 (when (windowp window) 678
676 (set-buffer (window-buffer window)) 679 (let ((defn (key-binding key t)))
677 (goto-char position)) 680 ;; Handle the case where we faked an entry in "Select and Paste" menu.
678 (let ((defn (key-binding key t))) 681 (if (and (eq defn nil)
679 ;; Handle the case where we faked an entry in "Select and Paste" menu. 682 (stringp (aref key (1- (length key))))
680 (if (and (eq defn nil) 683 (eq (key-binding (substring key 0 -1)) 'yank-menu))
681 (stringp (aref key (1- (length key)))) 684 (setq defn 'menu-bar-select-yank))
682 (eq (key-binding (substring key 0 -1)) 'yank-menu)) 685 (if (or (null defn) (integerp defn) (equal defn 'undefined))
683 (setq defn 'menu-bar-select-yank)) 686 (message "%s is undefined" (help-key-description key untranslated))
684 (if (or (null defn) (integerp defn) (equal defn 'undefined)) 687 (help-setup-xref (list #'describe-function defn) (interactive-p))
685 (message "%s is undefined" (help-key-description key untranslated)) 688 ;; Don't bother user with strings from (e.g.) the select-paste menu.
686 (help-setup-xref (list #'describe-function defn) (interactive-p)) 689 (if (stringp (aref key (1- (length key))))
687 ;; Don't bother user with strings from (e.g.) the select-paste menu. 690 (aset key (1- (length key)) "(any string)"))
688 (if (stringp (aref key (1- (length key)))) 691 (if (and untranslated
689 (aset key (1- (length key)) "(any string)")) 692 (stringp (aref untranslated (1- (length untranslated)))))
690 (if (and untranslated 693 (aset untranslated (1- (length untranslated))
691 (stringp (aref untranslated (1- (length untranslated))))) 694 "(any string)"))
692 (aset untranslated (1- (length untranslated)) 695 (with-output-to-temp-buffer (help-buffer)
693 "(any string)")) 696 (princ (help-key-description key untranslated))
694 (with-output-to-temp-buffer (help-buffer) 697 (if mousep
695 (princ (help-key-description key untranslated)) 698 (princ " at that spot"))
696 (if (windowp window) 699 (princ " runs the command ")
697 (princ " at that spot")) 700 (prin1 defn)
698 (princ " runs the command ") 701 (princ "\n which is ")
699 (prin1 defn) 702 (describe-function-1 defn)
700 (princ "\n which is ") 703 (when up-event
701 (describe-function-1 defn) 704 (let ((type (event-basic-type up-event))
702 (when up-event 705 (hdr "\n\n-------------- up event ---------------\n\n")
703 (let ((type (event-basic-type up-event)) 706 defn sequence
704 (hdr "\n\n-------------- up event ---------------\n\n") 707 mouse-1-tricky mouse-1-remapped)
705 defn sequence 708 (setq sequence (vector up-event))
706 mouse-1-tricky mouse-1-remapped) 709 (when (and (eq type 'mouse-1)
707 (setq sequence (vector up-event)) 710 mouse-1-click-follows-link
708 (when (and (eq type 'mouse-1) 711 (not (eq mouse-1-click-follows-link 'double))
709 (windowp window) 712 (setq mouse-1-remapped
710 mouse-1-click-follows-link 713 (mouse-on-link-p (event-start up-event))))
711 (not (eq mouse-1-click-follows-link 'double)) 714 (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link)
712 (setq mouse-1-remapped 715 (> mouse-1-click-follows-link 0)))
713 (with-current-buffer (window-buffer window) 716 (cond ((stringp mouse-1-remapped)
714 (mouse-on-link-p (posn-point 717 (setq sequence mouse-1-remapped))
715 (event-start up-event)))))) 718 ((vectorp mouse-1-remapped)
716 (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link) 719 (setcar up-event (elt mouse-1-remapped 0)))
717 (> mouse-1-click-follows-link 0))) 720 (t (setcar up-event 'mouse-2))))
718 (cond ((stringp mouse-1-remapped) 721 (setq defn (key-binding sequence nil nil (event-start up-event)))
719 (setq sequence mouse-1-remapped)) 722 (unless (or (null defn) (integerp defn) (equal defn 'undefined))
720 ((vectorp mouse-1-remapped) 723 (princ (if mouse-1-tricky
721 (setcar up-event (elt mouse-1-remapped 0))) 724 "\n\n----------------- up-event (short click) ----------------\n\n"
722 (t (setcar up-event 'mouse-2)))) 725 hdr))
723 (setq defn (key-binding sequence)) 726 (setq hdr nil)
724 (unless (or (null defn) (integerp defn) (equal defn 'undefined)) 727 (princ (symbol-name type))
725 (princ (if mouse-1-tricky 728 (if mousep
726 "\n\n----------------- up-event (short click) ----------------\n\n" 729 (princ " at that spot"))
727 hdr)) 730 (if mouse-1-remapped
728 (setq hdr nil) 731 (princ " is remapped to <mouse-2>\n which" ))
729 (princ (symbol-name type)) 732 (princ " runs the command ")
730 (if (windowp window) 733 (prin1 defn)
734 (princ "\n which is ")
735 (describe-function-1 defn))
736 (when mouse-1-tricky
737 (setcar up-event 'mouse-1)
738 (setq defn (key-binding (vector up-event) nil nil
739 (event-start up-event)))
740 (unless (or (null defn) (integerp defn) (eq defn 'undefined))
741 (princ (or hdr
742 "\n\n----------------- up-event (long click) ----------------\n\n"))
743 (princ "Pressing mouse-1")
744 (if mousep
731 (princ " at that spot")) 745 (princ " at that spot"))
732 (if mouse-1-remapped 746 (princ (format " for longer than %d milli-seconds\n"
733 (princ " is remapped to <mouse-2>\n which" )) 747 mouse-1-click-follows-link))
734 (princ " runs the command ") 748 (princ " runs the command ")
735 (prin1 defn) 749 (prin1 defn)
736 (princ "\n which is ") 750 (princ "\n which is ")
737 (describe-function-1 defn)) 751 (describe-function-1 defn)))))
738 (when mouse-1-tricky 752 (print-help-return-message))))))
739 (setcar up-event 'mouse-1)
740 (setq defn (key-binding (vector up-event)))
741 (unless (or (null defn) (integerp defn) (eq defn 'undefined))
742 (princ (or hdr
743 "\n\n----------------- up-event (long click) ----------------\n\n"))
744 (princ "Pressing mouse-1")
745 (if (windowp window)
746 (princ " at that spot"))
747 (princ (format " for longer than %d milli-seconds\n"
748 mouse-1-click-follows-link))
749 (princ " runs the command ")
750 (prin1 defn)
751 (princ "\n which is ")
752 (describe-function-1 defn)))))
753 (print-help-return-message)))))))
754 753
755(defun describe-mode (&optional buffer) 754(defun describe-mode (&optional buffer)
756 "Display documentation of current major mode and minor modes. 755 "Display documentation of current major mode and minor modes.