diff options
| -rw-r--r-- | lisp/ChangeLog | 18 | ||||
| -rw-r--r-- | lisp/help.el | 265 | ||||
| -rw-r--r-- | lisp/mouse-sel.el | 2 | ||||
| -rw-r--r-- | lisp/mouse.el | 43 |
4 files changed, 175 insertions, 153 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index efcb538d075..e1d51646046 100644 --- 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 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." (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)))))) (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 a64dabaec81..a327b589f54 100644 --- 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 4e11b1d4c96..5a598c304c9 100644 --- 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) |