* 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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index efcb538d07519fb147bfe7f97fc71d0a1130b7ad..e1d51646046da8bbb046d647c451eabba913ed4e 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,21 @@
+2006-09-15  David Kastrup  <dak@gnu.org>
+
+       * 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.
+
 2006-09-15  Juanma Barranquero  <lekktu@gmail.com>
 
        * play/life.el (life-patterns): Add a few more interesting patterns.

diff --git a/lisp/help.el b/lisp/help.el
index d5682512b2d83ff0bb5dea54d286d2b658e40ddf..72a45ec15bfbb214f876789e4778290d76922d63 100644 (file)
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -567,11 +567,16 @@ temporarily enables it to allow getting help on disabled items and buttons."
             (menu-bar-update-yank-menu "(any string)" nil))
           (setq key (read-key-sequence "Describe key (or click or menu item): "))
           ;; If KEY is a down-event, read and discard the
-          ;; corresponding up-event.
-          (if (and (vectorp key)
-                   (eventp (elt key 0))
-                   (memq 'down (event-modifiers (elt key 0))))
-              (read-event))
+          ;; corresponding up-event.  Note that there are also
+          ;; down-events on scroll bars and mode lines: the actual
+          ;; event then is in the second element of the vector.
+          (and (vectorp key)
+               (or (and (eventp (aref key 0))
+                        (memq 'down (event-modifiers (aref key 0))))
+                   (and (> (length key) 1)
+                        (eventp (aref key 1))
+                        (memq 'down (event-modifiers (aref key 1)))))
+               (read-event))
           (list
            key
            (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."
         (fset 'yank-menu (cons 'keymap yank-menu))))))
   (if (numberp untranslated)
       (setq untranslated (this-single-command-raw-keys)))
-  (save-excursion
-    (let ((modifiers (event-modifiers (aref key 0)))
-         (standard-output (if insert (current-buffer) t))
-         window position)
-      ;; For a mouse button event, go to the button it applies to
-      ;; to get the right key bindings.  And go to the right place
-      ;; in case the keymap depends on where you clicked.
-      (if (or (memq 'click modifiers) (memq 'down modifiers)
-             (memq 'drag modifiers))
-         (setq window (posn-window (event-start (aref key 0)))
-               position (posn-point (event-start (aref key 0)))))
-      (if (windowp window)
-         (progn
-           (set-buffer (window-buffer window))
-           (goto-char position)))
-      ;; Ok, now look up the key and name the command.
-      (let ((defn (key-binding key t))
-           key-desc)
-       ;; Handle the case where we faked an entry in "Select and Paste" menu.
-       (if (and (eq defn nil)
-                (stringp (aref key (1- (length key))))
-                (eq (key-binding (substring key 0 -1)) 'yank-menu))
-           (setq defn 'menu-bar-select-yank))
-       ;; Don't bother user with strings from (e.g.) the select-paste menu.
-       (if (stringp (aref key (1- (length key))))
-           (aset key (1- (length key)) "(any string)"))
-       (if (and (> (length untranslated) 0)
-                (stringp (aref untranslated (1- (length untranslated)))))
-           (aset untranslated (1- (length untranslated))
-                 "(any string)"))
-       ;; Now describe the key, perhaps as changed.
-       (setq key-desc (help-key-description key untranslated))
-       (if (or (null defn) (integerp defn) (equal defn 'undefined))
-           (princ (format "%s is undefined" key-desc))
-         (princ (format (if (windowp window)
-                            "%s at that spot runs the command %s"
-                          "%s runs the command %s")
-                        key-desc
-                        (if (symbolp defn) defn (prin1-to-string defn)))))))))
+  (let* ((event (if (and (symbolp (aref key 0))
+                        (> (length key) 1)
+                        (consp (aref key 1)))
+                   (aref key 1)
+                 (aref key 0)))
+        (modifiers (event-modifiers event))
+        (standard-output (if insert (current-buffer) t))
+        (mousep
+         (or (memq 'click modifiers) (memq 'down modifiers)
+             (memq 'drag modifiers))))
+    ;; Ok, now look up the key and name the command.
+    (let ((defn (key-binding key t))
+         key-desc)
+      ;; Handle the case where we faked an entry in "Select and Paste" menu.
+      (if (and (eq defn nil)
+              (stringp (aref key (1- (length key))))
+              (eq (key-binding (substring key 0 -1)) 'yank-menu))
+         (setq defn 'menu-bar-select-yank))
+      ;; Don't bother user with strings from (e.g.) the select-paste menu.
+      (if (stringp (aref key (1- (length key))))
+         (aset key (1- (length key)) "(any string)"))
+      (if (and (> (length untranslated) 0)
+              (stringp (aref untranslated (1- (length untranslated)))))
+         (aset untranslated (1- (length untranslated))
+               "(any string)"))
+      ;; Now describe the key, perhaps as changed.
+      (setq key-desc (help-key-description key untranslated))
+      (if (or (null defn) (integerp defn) (equal defn 'undefined))
+         (princ (format "%s is undefined" key-desc))
+       (princ (format (if mousep
+                          "%s at that spot runs the command %s"
+                        "%s runs the command %s")
+                      key-desc
+                      (if (symbolp defn) defn (prin1-to-string defn))))))))
 
 (defun describe-key (&optional key untranslated up-event)
   "Display documentation of the function invoked by KEY.
@@ -652,105 +652,104 @@ temporarily enables it to allow getting help on disabled items and buttons."
            (prefix-numeric-value current-prefix-arg)
            ;; If KEY is a down-event, read the corresponding up-event
            ;; and use it as the third argument.
-           (if (and (vectorp key)
-                    (eventp (elt key 0))
-                    (memq 'down (event-modifiers (elt key 0))))
-               (read-event))))
+           (and (vectorp key)
+                (or (and (eventp (aref key 0))
+                         (memq 'down (event-modifiers (aref key 0))))
+                    (and (> (length key) 1)
+                         (eventp (aref key 1))
+                         (memq 'down (event-modifiers (aref key 1)))))
+                (read-event))))
        ;; Put yank-menu back as it was, if we changed it.
        (when saved-yank-menu
         (setq yank-menu (copy-sequence saved-yank-menu))
         (fset 'yank-menu (cons 'keymap yank-menu))))))
   (if (numberp untranslated)
       (setq untranslated (this-single-command-raw-keys)))
-  (save-excursion
-    (let ((modifiers (event-modifiers (aref key 0)))
-         window position)
-      ;; For a mouse button event, go to the button it applies to
-      ;; to get the right key bindings.  And go to the right place
-      ;; in case the keymap depends on where you clicked.
-      (if (or (memq 'click modifiers) (memq 'down modifiers)
-             (memq 'drag modifiers))
-         (setq window (posn-window (event-start (aref key 0)))
-               position (posn-point (event-start (aref key 0)))))
-      (when (windowp window)
-           (set-buffer (window-buffer window))
-       (goto-char position))
-      (let ((defn (key-binding key t)))
-       ;; Handle the case where we faked an entry in "Select and Paste" menu.
-       (if (and (eq defn nil)
-                (stringp (aref key (1- (length key))))
-                (eq (key-binding (substring key 0 -1)) 'yank-menu))
-           (setq defn 'menu-bar-select-yank))
-       (if (or (null defn) (integerp defn) (equal defn 'undefined))
-           (message "%s is undefined" (help-key-description key untranslated))
-         (help-setup-xref (list #'describe-function defn) (interactive-p))
-         ;; Don't bother user with strings from (e.g.) the select-paste menu.
-         (if (stringp (aref key (1- (length key))))
-             (aset key (1- (length key)) "(any string)"))
-         (if (and untranslated
-                  (stringp (aref untranslated (1- (length untranslated)))))
-             (aset untranslated (1- (length untranslated))
-                   "(any string)"))
-         (with-output-to-temp-buffer (help-buffer)
-           (princ (help-key-description key untranslated))
-           (if (windowp window)
-               (princ " at that spot"))
-           (princ " runs the command ")
-           (prin1 defn)
-           (princ "\n   which is ")
-           (describe-function-1 defn)
-           (when up-event
-             (let ((type (event-basic-type up-event))
-                   (hdr "\n\n-------------- up event ---------------\n\n")
-                   defn sequence
-                   mouse-1-tricky mouse-1-remapped)
-               (setq sequence (vector up-event))
-               (when (and (eq type 'mouse-1)
-                          (windowp window)
-                          mouse-1-click-follows-link
-                          (not (eq mouse-1-click-follows-link 'double))
-                          (setq mouse-1-remapped
-                                (with-current-buffer (window-buffer window)
-                                  (mouse-on-link-p (posn-point
-                                                    (event-start up-event))))))
-                 (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link)
-                                           (> mouse-1-click-follows-link 0)))
-                 (cond ((stringp mouse-1-remapped)
-                        (setq sequence mouse-1-remapped))
-                       ((vectorp mouse-1-remapped)
-                        (setcar up-event (elt mouse-1-remapped 0)))
-                       (t (setcar up-event 'mouse-2))))
-               (setq defn (key-binding sequence))
-               (unless (or (null defn) (integerp defn) (equal defn 'undefined))
-                 (princ (if mouse-1-tricky
-                            "\n\n----------------- up-event (short click) ----------------\n\n"
-                          hdr))
-                 (setq hdr nil)
-                 (princ (symbol-name type))
-                 (if (windowp window)
+  (let* ((event (if (and (symbolp (aref key 0))
+                        (> (length key) 1)
+                        (consp (aref key 1)))
+                   (aref key 1)
+                 (aref key 0)))
+        (modifiers (event-modifiers event))
+        (mousep
+         (or (memq 'click modifiers) (memq 'down modifiers)
+             (memq 'drag modifiers))))
+    ;; Ok, now look up the key and name the command.
+
+    (let ((defn (key-binding key t)))
+      ;; Handle the case where we faked an entry in "Select and Paste" menu.
+      (if (and (eq defn nil)
+              (stringp (aref key (1- (length key))))
+              (eq (key-binding (substring key 0 -1)) 'yank-menu))
+         (setq defn 'menu-bar-select-yank))
+      (if (or (null defn) (integerp defn) (equal defn 'undefined))
+         (message "%s is undefined" (help-key-description key untranslated))
+       (help-setup-xref (list #'describe-function defn) (interactive-p))
+       ;; Don't bother user with strings from (e.g.) the select-paste menu.
+       (if (stringp (aref key (1- (length key))))
+           (aset key (1- (length key)) "(any string)"))
+       (if (and untranslated
+                (stringp (aref untranslated (1- (length untranslated)))))
+           (aset untranslated (1- (length untranslated))
+                 "(any string)"))
+       (with-output-to-temp-buffer (help-buffer)
+         (princ (help-key-description key untranslated))
+         (if mousep
+             (princ " at that spot"))
+         (princ " runs the command ")
+         (prin1 defn)
+         (princ "\n   which is ")
+         (describe-function-1 defn)
+         (when up-event
+           (let ((type (event-basic-type up-event))
+                 (hdr "\n\n-------------- up event ---------------\n\n")
+                 defn sequence
+                 mouse-1-tricky mouse-1-remapped)
+             (setq sequence (vector up-event))
+             (when (and (eq type 'mouse-1)
+                        mouse-1-click-follows-link
+                        (not (eq mouse-1-click-follows-link 'double))
+                        (setq mouse-1-remapped
+                              (mouse-on-link-p (event-start up-event))))
+               (setq mouse-1-tricky (and (integerp mouse-1-click-follows-link)
+                                         (> mouse-1-click-follows-link 0)))
+               (cond ((stringp mouse-1-remapped)
+                      (setq sequence mouse-1-remapped))
+                     ((vectorp mouse-1-remapped)
+                      (setcar up-event (elt mouse-1-remapped 0)))
+                     (t (setcar up-event 'mouse-2))))
+             (setq defn (key-binding sequence nil nil (event-start up-event)))
+             (unless (or (null defn) (integerp defn) (equal defn 'undefined))
+               (princ (if mouse-1-tricky
+                          "\n\n----------------- up-event (short click) ----------------\n\n"
+                        hdr))
+               (setq hdr nil)
+               (princ (symbol-name type))
+               (if mousep
+                   (princ " at that spot"))
+               (if mouse-1-remapped
+                   (princ " is remapped to <mouse-2>\n  which" ))
+               (princ " runs the command ")
+               (prin1 defn)
+               (princ "\n   which is ")
+               (describe-function-1 defn))
+             (when mouse-1-tricky
+               (setcar up-event 'mouse-1)
+               (setq defn (key-binding (vector up-event) nil nil
+                                       (event-start up-event)))
+               (unless (or (null defn) (integerp defn) (eq defn 'undefined))
+                 (princ (or hdr
+                            "\n\n----------------- up-event (long click) ----------------\n\n"))
+                 (princ "Pressing mouse-1")
+                 (if mousep
                      (princ " at that spot"))
-                 (if mouse-1-remapped
-                     (princ " is remapped to <mouse-2>\n  which" ))
+                 (princ (format " for longer than %d milli-seconds\n"
+                                mouse-1-click-follows-link))
                  (princ " runs the command ")
                  (prin1 defn)
                  (princ "\n   which is ")
-                 (describe-function-1 defn))
-               (when mouse-1-tricky
-                 (setcar up-event 'mouse-1)
-                 (setq defn (key-binding (vector up-event)))
-                 (unless (or (null defn) (integerp defn) (eq defn 'undefined))
-                   (princ (or hdr
-                              "\n\n----------------- up-event (long click) ----------------\n\n"))
-                   (princ "Pressing mouse-1")
-                   (if (windowp window)
-                       (princ " at that spot"))
-                   (princ (format " for longer than %d milli-seconds\n"
-                                  mouse-1-click-follows-link))
-                   (princ " runs the command ")
-                   (prin1 defn)
-                   (princ "\n   which is ")
-                   (describe-function-1 defn)))))
-           (print-help-return-message)))))))
+                 (describe-function-1 defn)))))
+         (print-help-return-message))))))
 \f
 (defun describe-mode (&optional buffer)
   "Display documentation of current major mode and minor modes.

diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el
index a64dabaec8187174d444a92da90622a03879e50a..a327b589f5448dc5025344dd9f8d02931af6e830 100644 (file)
--- a/lisp/mouse-sel.el
+++ b/lisp/mouse-sel.el
@@ -702,7 +702,7 @@ Sel mode does not support using a `double' value to follow links
 using double-clicks."
   (and initial final mouse-1-click-follows-link
        (eq (car initial) 'down-mouse-1)
-       (mouse-on-link-p        (posn-point (event-start initial)))
+       (mouse-on-link-p (event-start initial))
        (= (posn-point (event-start initial))
          (posn-point (event-end final)))
        (= (event-click-count initial) 1)

diff --git a/lisp/mouse.el b/lisp/mouse.el
index 4e11b1d4c963e6201ac86f72d54b032d0a24e88f..5a598c304c9f4ae34e1413b63e0946d82789d862 100644 (file)
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -775,6 +775,17 @@ If the click is in the echo area, display the `*Messages*' buffer."
       (mouse-drag-track start-event t))))
 
 
+(defun mouse-posn-property (pos property)
+  "Look for a property at click position."
+  (if (consp pos)
+      (let ((w (posn-window pos)) (pt (posn-point pos))
+           (str (posn-string pos)))
+       (or (and str
+                (get-text-property (cdr str) property (car str)))
+           (and pt
+                (get-char-property pt property w))))
+    (get-char-property pos property)))
+
 (defun mouse-on-link-p (pos)
   "Return non-nil if POS is on a link in the current buffer.
 POS must be a buffer position in the current buffer or a mouse
@@ -814,24 +825,18 @@ click is the local or global binding of that event.
 
 - Otherwise, the mouse-1 event is translated into a mouse-2 event
 at the same position."
-  (let ((w (and (consp pos) (posn-window pos))))
-    (if (consp pos)
-       (setq pos (and (or mouse-1-click-in-non-selected-windows
-                          (eq (selected-window) w))
-                      (posn-point pos))))
-    (when pos
-      (with-current-buffer (window-buffer w)
-       (let ((action
-              (or (get-char-property pos 'follow-link)
-                  (save-excursion
-                    (goto-char pos)
-                    (key-binding [follow-link] nil t)))))
-         (cond
-          ((eq action 'mouse-face)
-           (and (get-char-property pos 'mouse-face) t))
-          ((functionp action)
-           (funcall action pos))
-          (t action)))))))
+  (let ((action
+        (and (or (not (consp pos))
+                 mouse-1-click-in-non-selected-windows
+                 (eq (selected-window) (posn-window pos)))
+             (or (mouse-posn-property pos 'follow-link)
+                 (key-binding [follow-link] nil t pos)))))
+    (cond
+     ((eq action 'mouse-face)
+      (and (mouse-posn-property pos 'mouse-face) t))
+     ((functionp action)
+      (funcall action pos))
+     (t action))))
 
 (defun mouse-fixup-help-message (msg)
   "Fix help message MSG for `mouse-1-click-follows-link'."
@@ -904,7 +909,7 @@ should only be used by mouse-drag-region."
                        ;; Use start-point before the intangibility
                        ;; treatment, in case we click on a link inside an
                        ;; intangible text.
-                       (mouse-on-link-p start-point)))
+                       (mouse-on-link-p start-posn)))
         (click-count (1- (event-click-count start-event)))
         (remap-double-click (and on-link
                                  (eq mouse-1-click-follows-link 'double)