* 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.
This commit is contained in:
David Kastrup
parent
b74e16a384
commit
91a2acb229
4 changed files with 175 additions and 153 deletions
|
|
@ -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.
|
||||
|
|
|
|||
265
lisp/help.el
265
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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue