Mercurial > emacs

diff lisp/help.el @ 83542:2d56e13fd23d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged from emacs@sv.gnu.org Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-413 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-414 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-415 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-416 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-417 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-418 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-419 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-420 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-421 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-422 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-423 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-424 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-425 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-426 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-427 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-428 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-429 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-430 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-431 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-432 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-433 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-434 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-435 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-436 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-437 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-438 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-439 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-440 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-441 lisp/url/url-methods.el: Fix format error when http_proxy is empty string * emacs@sv.gnu.org/emacs--devo--0--patch-442 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-443 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-444 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-445 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-446 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-447 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-448 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-449 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-450 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-451 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-452 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-453 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-454 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-455 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-456 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-457 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-458 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-459 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-460 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-461 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-462 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-463 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-464 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-465 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-466 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-467 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-468 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-469 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-470 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-471 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-472 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-473 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-128 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-129 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-130 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-131 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-132 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-133 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-134 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-135 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-136 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-137 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-138 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-139 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-140 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-141 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-142 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-143 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-144 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-145 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-146 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-147 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-148 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-149 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-582
author Karoly Lorentey <lorentey@elte.hu>
date Sat, 14 Oct 2006 17:36:28 +0000
parents b4697c34c8fd
children 6a147e17a7cd 8dd8c8286063
line wrap: on
line diff
--- a/lisp/help.el	Sat Oct 14 16:56:21 2006 +0000
+++ b/lisp/help.el	Sat Oct 14 17:36:28 2006 +0000
@@ -309,7 +309,7 @@
 The prefix described consists of all but the last event
 of the key sequence that ran this command."
   (interactive)
-  (let* ((key (this-command-keys)))
+  (let ((key (this-command-keys)))
     (describe-bindings
      (if (stringp key)
 	 (substring key 0 (1- (length key)))
@@ -535,28 +535,6 @@
 	  (princ string)))))
   nil)
 
-(defun string-key-binding (key)
-  "Value is the binding of KEY in a string.
-If KEY is an event on a string, and that string has a `local-map'
-or `keymap' property, return the binding of KEY in the string's keymap."
-  (let* ((defn nil)
-	 (start (when (vectorp key)
-		  (if (memq (aref key 0)
-			    '(mode-line header-line left-margin right-margin))
-		      (event-start (aref key 1))
-		    (and (consp (aref key 0))
-			 (event-start (aref key 0))))))
-	 (string-info (and (consp start) (nth 4 start))))
-    (when string-info
-      (let* ((string (car string-info))
-	     (pos (cdr string-info))
-	     (local-map (and (>= pos 0)
-			     (< pos (length string))
-			     (or (get-text-property pos 'local-map string)
-				 (get-text-property pos 'keymap string)))))
-	(setq defn (and local-map (lookup-key local-map key)))))
-    defn))
-
 (defun help-key-description (key untranslated)
   (let ((string (key-description key)))
     (if (or (not untranslated)
@@ -589,11 +567,14 @@
 	     (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)
+		(let ((last-idx (1- (length key))))
+		  (and (eventp (aref key last-idx))
+		       (memq 'down (event-modifiers (aref key last-idx)))))
+		(read-event))
 	   (list
 	    key
 	    (if current-prefix-arg (prefix-numeric-value current-prefix-arg))
@@ -604,46 +585,33 @@
 	 (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 (or (string-key-binding key)
-		      (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))
+	 (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
+			    (memq 'drag modifiers)) " at that spot" ""))
+	 (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%s is undefined" key-desc mouse-msg))
+      (princ (format "%s%s runs the command %S" key-desc mouse-msg defn)))))
 
 (defun describe-key (&optional key untranslated up-event)
   "Display documentation of the function invoked by KEY.
@@ -673,109 +641,119 @@
 	   (list
 	    key
 	    (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))))
+	    ;; If KEY is a down-event, read and discard the
+	    ;; 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)
+		 (let ((last-idx (1- (length key))))
+		   (and (eventp (aref key last-idx))
+			(memq 'down (event-modifiers (aref key last-idx)))))
+		 (or (and (eventp (aref key 0))
+			  (memq 'down (event-modifiers (aref key 0)))
+			  ;; However, for the C-down-mouse-2 popup
+			  ;; menu, there is no subsequent up-event.  In
+			  ;; this case, the up-event is the next
+			  ;; element in the supplied vector.
+			  (= (length key) 1))
+		     (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 (or (string-key-binding key) (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)
+  (let* ((event (aref key (if (and (symbolp (aref key 0))
+				   (> (length key) 1)
+				   (consp (aref key 1)))
+			      1
+			    0)))
+	 (modifiers (event-modifiers event))
+	 (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
+			    (memq 'drag modifiers)) " at that spot" ""))
+	 (defn (key-binding key t))
+	 defn-up defn-up-tricky ev-type
+	 mouse-1-remapped mouse-1-tricky)
+
+    ;; Handle the case where we faked an entry in "Select and Paste" menu.
+    (when (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%s is undefined"
+		 (help-key-description key untranslated) mouse-msg)
+      (help-setup-xref (list #'describe-function defn) (interactive-p))
+      ;; Don't bother user with strings from (e.g.) the select-paste menu.
+      (when (stringp (aref key (1- (length key))))
+	(aset key (1- (length key)) "(any string)"))
+      (when (and untranslated
+		 (stringp (aref untranslated (1- (length untranslated)))))
+	(aset untranslated (1- (length untranslated))
+	      "(any string)"))
+      ;; Need to do this before erasing *Help* buffer in case event
+      ;; is a mouse click in an existing *Help* buffer.
+      (when up-event
+	(setq ev-type (event-basic-type up-event))
+	(let ((sequence (vector up-event)))
+	  (when (and (eq ev-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-up (key-binding sequence nil nil (event-start up-event)))
+	  (when mouse-1-tricky
+	    (setq sequence (vector up-event))
+	    (aset sequence 0 'mouse-1)
+	    (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))))))
+      (with-output-to-temp-buffer (help-buffer)
+	(princ (help-key-description key untranslated))
+	(princ (format "\
+%s runs the command %S
+  which is "
+		       mouse-msg defn))
+	(describe-function-1 defn)
+	(when up-event
+	  (unless (or (null defn-up)
+		      (integerp defn-up)
+		      (equal defn-up 'undefined))
+	    (princ (format "
+
+----------------- up-event %s----------------
+
+<%S>%s%s runs the command %S
+  which is "
+			   (if mouse-1-tricky "(short click) " "")
+			   ev-type mouse-msg
+			   (if mouse-1-remapped
+			       " is remapped to <mouse-2>\nwhich" "")
+			   defn-up))
+	    (describe-function-1 defn-up))
+	  (unless (or (null defn-up-tricky)
+		      (integerp defn-up-tricky)
+		      (eq defn-up-tricky 'undefined))
+	    (princ (format "
+
+----------------- up-event (long click) ----------------
+
+Pressing <%S>%s for longer than %d milli-seconds
+runs the command %S
+  which is "
+			   ev-type mouse-msg
 			   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 (or (string-key-binding sequence)
-			       (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)
-		      (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 (or (string-key-binding (vector up-event))
-				 (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)))))))
+			   defn-up-tricky))
+	    (describe-function-1 defn-up-tricky)))
+	(print-help-return-message)))))
 
 (defun describe-mode (&optional buffer)
   "Display documentation of current major mode and minor modes.
@@ -786,7 +764,7 @@
 For this to work correctly for a minor mode, the mode's indicator
 variable \(listed in `minor-mode-alist') must also be a function
 whose documentation describes the minor mode."
-  (interactive)
+  (interactive "@")
   (unless buffer (setq buffer (current-buffer)))
   (help-setup-xref (list #'describe-mode buffer)
 		   (interactive-p))