Mercurial > hg > xemacs-beta

changeset 4335:4ba890988caa

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Within #'describe-function, say what commands are bound to. 2007-12-18 Aidan Kehoe <kehoea@parhasard.net> * help.el (describe-function-1): Give details of bindings for commands, taking into account global-window-system-map and global-tty-map when bindings differ compared to the global map.
author Aidan Kehoe <kehoea@parhasard.net>
date Tue, 18 Dec 2007 21:28:12 +0100
parents 234b2c136e4d
children cdc2f70d4319
files lisp/ChangeLog lisp/help.el
diffstat 2 files changed, 54 insertions(+), 1 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Tue Dec 18 19:44:28 2007 +0100
+++ b/lisp/ChangeLog	Tue Dec 18 21:28:12 2007 +0100
@@ -1,3 +1,10 @@
+2007-12-18  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* help.el (describe-function-1):
+	Give details of bindings for commands, taking into account
+	global-window-system-map and global-tty-map when bindings differ
+	compared to the global map. 
+
 2007-12-17  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* subr.el (integer-to-bit-vector): New.
--- a/lisp/help.el	Tue Dec 18 19:44:28 2007 +0100
+++ b/lisp/help.el	Tue Dec 18 21:28:12 2007 +0100
@@ -1484,7 +1484,53 @@
 		   (goto-char newp standard-output))
 		 (unless (or (equal doc "")
 			     (eq ?\n (aref doc (1- (length doc)))))
-		   (terpri)))))))))
+		   (terpri)))
+	       (when (commandp function)
+		 (princ "\nInvoked with:\n")
+		 (let ((global-binding
+			(where-is-internal function global-map))
+		       (global-tty-binding 
+			(where-is-internal function global-tty-map))
+		       (global-window-system-binding 
+			(where-is-internal function global-window-system-map)))
+                   (if (or global-binding global-tty-binding
+                           global-window-system-binding)
+                       (if (and (equal global-binding
+                                       global-tty-binding)
+                                (equal global-binding
+                                       global-window-system-binding))
+                           (princ
+                            (substitute-command-keys
+                             (format "\n\\[%s]" function)))
+                         (when (and global-window-system-binding
+                                    (not (equal global-window-system-binding
+                                                global-binding)))
+                           (princ 
+                            (format 
+                             "\n%s\n        -- under window systems\n"
+                             (mapconcat #'key-description
+                                        global-window-system-binding
+                                        ", "))))
+                         (when (and global-tty-binding
+                                    (not (equal global-tty-binding
+                                                global-binding)))
+                           (princ 
+                            (format 
+                             "\n%s\n        -- under TTYs\n"
+                             (mapconcat #'key-description
+                                        global-tty-binding
+                                        ", "))))
+                         (when global-binding
+                           (princ 
+                            (format 
+                             "\n%s\n        -- generally (that is, unless\
+ overridden by TTY- or
+           window-system-specific mappings)\n"
+                             (mapconcat #'key-description
+                                        global-binding
+                                        ", ")))))
+                     (princ (substitute-command-keys
+                             (format "\n\\[%s]" function))))))))))))
 
 ;;; [Obnoxious, whining people who complain very LOUDLY on Usenet
 ;;; are binding this to keys.]