;; 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)
(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")
(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)
\(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
(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)
(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,
(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)
(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)
----------------- 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)
----------------- 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)
;; 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 ()