declare smobs in alloc.c
[bpt/emacs.git] / lisp / help.el
index 14dda64..776e739 100644 (file)
@@ -1,7 +1,6 @@
 ;;; help.el --- help commands for Emacs
 
-;; Copyright (C) 1985-1986, 1993-1994, 1998-2014 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-1986, 1993-1994, 1998-2014 Free Software Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: help, internal
 ;; or run interpreted, but not when the compiled code is loaded.
 (eval-when-compile (require 'help-macro))
 
-;; This makes `with-output-to-temp-buffer' buffers use `help-mode'.
-(add-hook 'temp-buffer-setup-hook 'help-mode-setup)
-(add-hook 'temp-buffer-show-hook 'help-mode-finish)
-
 ;; `help-window-point-marker' is a marker you can move to a valid
 ;; position of the buffer shown in the help window in order to override
 ;; the standard positioning mechanism (`point-min') chosen by
 (defvar help-button-cache nil)
 
 \f
+;; `with-help-window' is a wrapper for `with-temp-buffer-window'
+;; providing the following additional twists:
+
+;; (1) It puts the buffer in `help-mode' (via `help-mode-setup') and
+;;     adds cross references (via `help-mode-finish').
+
+;; (2) It issues a message telling how to scroll and quit the help
+;;     window (via `help-window-setup').
+
+;; (3) An option (customizable via `help-window-select') to select the
+;;     help window automatically.
+
+;; (4) A marker (`help-window-point-marker') to move point in the help
+;;     window to an arbitrary buffer position.
+(defmacro with-help-window (buffer-name &rest body)
+  "Display buffer named BUFFER-NAME in a help window.
+Evaluate the forms in BODY with standard output bound to a buffer
+called BUFFER-NAME (creating it if it does not exist), put that
+buffer in `help-mode', display the buffer in a window (see
+`with-temp-buffer-window' for details) and issue a message how to
+deal with that \"help\" window when it's no more needed.  Select
+the help window if the current value of the user option
+`help-window-select' says so.  Return last value in BODY."
+  (declare (indent 1) (debug t))
+  `(progn
+     ;; Make `help-window-point-marker' point nowhere.  The only place
+     ;; where this should be set to a buffer position is within BODY.
+     (set-marker help-window-point-marker nil)
+     (let ((temp-buffer-window-setup-hook
+           (cons 'help-mode-setup temp-buffer-window-setup-hook))
+          (temp-buffer-window-show-hook
+           (cons 'help-mode-finish temp-buffer-window-show-hook)))
+       (with-temp-buffer-window
+       ,buffer-name nil 'help-window-setup (progn ,@body)))))
+
 (defun help-quit ()
   "Just exit from the Help command's command loop."
   (interactive)
@@ -297,10 +327,11 @@ If that doesn't give a function, return nil."
   (interactive)
   (view-help-file "COPYING"))
 
+;; Maybe this command should just be removed.
 (defun describe-gnu-project ()
-  "Display info on the GNU project."
+  "Browse online information on the GNU project."
   (interactive)
-  (view-help-file "THE-GNU-PROJECT"))
+  (browse-url "http://www.gnu.org/gnu/thegnuproject.html"))
 
 (define-obsolete-function-alias 'describe-project 'describe-gnu-project "22.2")
 
@@ -450,7 +481,7 @@ is specified by the variable `message-log-max'."
 (defun view-lossage ()
   "Display last 300 input keystrokes.
 
-To record all your input on a file, use `open-dribble-file'."
+To record all your input, use `open-dribble-file'."
   (interactive)
   (help-setup-xref (list #'view-lossage)
                   (called-interactively-p 'interactive))
@@ -486,8 +517,11 @@ or a buffer name."
   (or buffer (setq buffer (current-buffer)))
   (help-setup-xref (list #'describe-bindings prefix buffer)
                   (called-interactively-p 'interactive))
-  (with-current-buffer buffer
-    (describe-bindings-internal nil prefix)))
+  (with-help-window (help-buffer)
+    ;; Be aware that `describe-buffer-bindings' puts its output into
+    ;; the current buffer.
+    (with-current-buffer (help-buffer)
+      (describe-buffer-bindings buffer prefix))))
 
 ;; This function used to be in keymap.c.
 (defun describe-bindings-internal (&optional menus prefix)
@@ -498,6 +532,7 @@ The optional argument MENUS, if non-nil, says to mention menu bindings.
 \(Ordinarily these are omitted from the output.)
 The optional argument PREFIX, if non-nil, should be a key sequence;
 then we display only bindings that start with that prefix."
+  (declare (obsolete describe-buffer-bindings "24.4"))
   (let ((buf (current-buffer)))
     (with-help-window (help-buffer)
       ;; Be aware that `describe-buffer-bindings' puts its output into
@@ -517,8 +552,10 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
                (if fn
                    (format "Where is command (default %s): " fn)
                  "Where is command: ")
-               obarray 'commandp t))
-     (list (if (equal val "") fn (intern val)) current-prefix-arg)))
+               obarray 'commandp t nil nil
+               (and fn (symbol-name fn))))
+     (list (unless (equal val "") (intern val))
+          current-prefix-arg)))
   (unless definition (error "No command"))
   (let ((func (indirect-function definition))
         (defs nil)
@@ -644,6 +681,68 @@ temporarily enables it to allow getting help on disabled items and buttons."
        (princ (format "%s%s is undefined" key-desc mouse-msg))
       (princ (format "%s%s runs the command %S" key-desc mouse-msg defn)))))
 
+(defun help--key-binding-keymap (key &optional accept-default no-remap position)
+  "Return a keymap holding a binding for KEY within current keymaps.
+The effect of the arguments KEY, ACCEPT-DEFAULT, NO-REMAP and
+POSITION is as documented in the function `key-binding'."
+  (let* ((active-maps (current-active-maps t position))
+         map found)
+    ;; We loop over active maps like key-binding does.
+    (while (and
+            (not found)
+            (setq map (pop active-maps)))
+      (setq found (lookup-key map key accept-default))
+      (when (integerp found)
+        ;; The first `found' characters of KEY were found but not the
+        ;; whole sequence.
+        (setq found nil)))
+    (when found
+      (if (and (symbolp found)
+               (not no-remap)
+               (command-remapping found))
+          ;; The user might want to know in which map the binding is
+          ;; found, or in which map the remapping is found.  The
+          ;; default is to show the latter.
+          (help--key-binding-keymap (vector 'remap found))
+        map))))
+
+(defun help--binding-locus (key position)
+  "Describe in which keymap KEY is defined.
+Return a symbol pointing to that keymap if one exists ; otherwise
+return nil."
+  (let ((map (help--key-binding-keymap key t nil position)))
+    (when map
+      (catch 'found
+        (let ((advertised-syms (nconc
+                                (list 'overriding-terminal-local-map
+                                      'overriding-local-map)
+                                (delq nil
+                                      (mapcar
+                                       (lambda (mode-and-map)
+                                         (let ((mode (car mode-and-map)))
+                                           (when (symbol-value mode)
+                                             (intern-soft
+                                              (format "%s-map" mode)))))
+                                       minor-mode-map-alist))
+                                (list 'global-map
+                                      (intern-soft (format "%s-map" major-mode)))))
+              found)
+          ;; Look into these advertised symbols first.
+          (dolist (sym advertised-syms)
+            (when (and
+                   (boundp sym)
+                   (eq map (symbol-value sym)))
+              (throw 'found sym)))
+          ;; Only look in other symbols otherwise.
+          (mapatoms
+           (lambda (x)
+             (when (and (boundp x)
+                        ;; Avoid let-bound symbols.
+                        (special-variable-p x)
+                        (eq (symbol-value x) map))
+               (throw 'found x))))
+          nil)))))
+
 (defun describe-key (&optional key untranslated up-event)
   "Display documentation of the function invoked by KEY.
 KEY can be any kind of a key sequence; it can include keyboard events,
@@ -706,6 +805,7 @@ temporarily enables it to allow getting help on disabled items and buttons."
         (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
                            (memq 'drag modifiers)) " at that spot" ""))
         (defn (key-binding key t))
+         key-locus key-locus-up key-locus-up-tricky
         defn-up defn-up-tricky ev-type
         mouse-1-remapped mouse-1-tricky)
 
@@ -744,15 +844,19 @@ temporarily enables it to allow getting help on disabled items and buttons."
                   (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)))
+          (setq key-locus-up (help--binding-locus sequence (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))))))
+           (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event)))
+            (setq key-locus-up-tricky (help--binding-locus sequence (event-start up-event))))))
+      (setq key-locus (help--binding-locus key (event-start event)))
       (with-help-window (help-buffer)
        (princ (help-key-description key untranslated))
-       (princ (format "\
-%s runs the command %S, which is "
-                      mouse-msg defn))
+       (princ (format "%s runs the command %S%s, which is "
+                      mouse-msg defn (if key-locus
+                                          (format " (found in %s)" key-locus)
+                                        "")))
        (describe-function-1 defn)
        (when up-event
          (unless (or (null defn-up)
@@ -762,13 +866,15 @@ temporarily enables it to allow getting help on disabled items and buttons."
 
 ----------------- up-event %s----------------
 
-%s%s%s runs the command %S, which is "
+%s%s%s runs the command %S%s, which is "
                           (if mouse-1-tricky "(short click) " "")
                           (key-description (vector up-event))
                           mouse-msg
                           (if mouse-1-remapped
                                " is remapped to <mouse-2>, which" "")
-                          defn-up))
+                          defn-up (if key-locus-up
+                                       (format " (found in %s)" key-locus-up)
+                                     "")))
            (describe-function-1 defn-up))
          (unless (or (null defn-up-tricky)
                      (integerp defn-up-tricky)
@@ -778,10 +884,12 @@ temporarily enables it to allow getting help on disabled items and buttons."
 ----------------- up-event (long click) ----------------
 
 Pressing <%S>%s for longer than %d milli-seconds
-runs the command %S, which is "
+runs the command %S%s, which is "
                           ev-type mouse-msg
                           mouse-1-click-follows-link
-                          defn-up-tricky))
+                          defn-up-tricky (if key-locus-up-tricky
+                                              (format " (found in %s)" key-locus-up-tricky)
+                                            "")))
            (describe-function-1 defn-up-tricky)))))))
 \f
 (defun describe-mode (&optional buffer)
@@ -1181,41 +1289,6 @@ Return VALUE."
     ;; Return VALUE.
     value))
 
-;; `with-help-window' is a wrapper for `with-temp-buffer-window'
-;; providing the following additional twists:
-
-;; (1) It puts the buffer in `help-mode' (via `help-mode-setup') and
-;;     adds cross references (via `help-mode-finish').
-
-;; (2) It issues a message telling how to scroll and quit the help
-;;     window (via `help-window-setup').
-
-;; (3) An option (customizable via `help-window-select') to select the
-;;     help window automatically.
-
-;; (4) A marker (`help-window-point-marker') to move point in the help
-;;     window to an arbitrary buffer position.
-(defmacro with-help-window (buffer-name &rest body)
-  "Display buffer named BUFFER-NAME in a help window.
-Evaluate the forms in BODY with standard output bound to a buffer
-called BUFFER-NAME (creating it if it does not exist), put that
-buffer in `help-mode', display the buffer in a window (see
-`with-temp-buffer-window' for details) and issue a message how to
-deal with that \"help\" window when it's no more needed.  Select
-the help window if the current value of the user option
-`help-window-select' says so.  Return last value in BODY."
-  (declare (indent 1) (debug t))
-  `(progn
-     ;; Make `help-window-point-marker' point nowhere.  The only place
-     ;; where this should be set to a buffer position is within BODY.
-     (set-marker help-window-point-marker nil)
-     (let ((temp-buffer-window-setup-hook
-           (cons 'help-mode-setup temp-buffer-window-setup-hook))
-          (temp-buffer-window-show-hook
-           (cons 'help-mode-finish temp-buffer-window-show-hook)))
-       (with-temp-buffer-window
-       ,buffer-name nil 'help-window-setup (progn ,@body)))))
-
 ;; Called from C, on encountering `help-char' when reading a char.
 ;; Don't print to *Help*; that would clobber Help history.
 (defun help-form-show ()