mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 10:30:25 -08:00
Merge remote-tracking branch 'savannah/master' into HEAD
This commit is contained in:
commit
15aedf3e3d
380 changed files with 7448 additions and 7560 deletions
|
|
@ -1564,6 +1564,103 @@ BUFFER should be a buffer or a buffer name."
|
|||
(insert "\nThe parent category table is:")
|
||||
(describe-vector table 'help-describe-category-set))))))
|
||||
|
||||
(defun help-fns-find-keymap-name (keymap)
|
||||
"Find the name of the variable with value KEYMAP.
|
||||
Return nil if KEYMAP is not a valid keymap, or if there is no
|
||||
variable with value KEYMAP."
|
||||
(when (keymapp keymap)
|
||||
(let ((name (catch 'found-keymap
|
||||
(mapatoms (lambda (symb)
|
||||
(when (and (boundp symb)
|
||||
(eq (symbol-value symb) keymap)
|
||||
(not (eq symb 'keymap))
|
||||
(throw 'found-keymap symb)))))
|
||||
nil)))
|
||||
;; Follow aliasing.
|
||||
(or (ignore-errors (indirect-variable name)) name))))
|
||||
|
||||
(defun help-fns--most-relevant-active-keymap ()
|
||||
"Return the name of the most relevant active keymap.
|
||||
The heuristic to determine which keymap is most likely to be
|
||||
relevant to a user follows this order:
|
||||
|
||||
1. 'keymap' text property at point
|
||||
2. 'local-map' text property at point
|
||||
3. the `current-local-map'
|
||||
|
||||
This is used to set the default value for the interactive prompt
|
||||
in `describe-keymap'. See also `Searching the Active Keymaps'."
|
||||
(help-fns-find-keymap-name (or (get-char-property (point) 'keymap)
|
||||
(if (get-text-property (point) 'local-map)
|
||||
(get-char-property (point) 'local-map)
|
||||
(current-local-map)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun describe-keymap (keymap)
|
||||
"Describe key bindings in KEYMAP.
|
||||
When called interactively, prompt for a variable that has a
|
||||
keymap value."
|
||||
(interactive
|
||||
(let* ((km (help-fns--most-relevant-active-keymap))
|
||||
(val (completing-read
|
||||
(format "Keymap (default %s): " km)
|
||||
obarray
|
||||
(lambda (m) (and (boundp m) (keymapp (symbol-value m))))
|
||||
t nil 'keymap-name-history
|
||||
(symbol-name km))))
|
||||
(unless (equal val "")
|
||||
(setq km (intern val)))
|
||||
(unless (and km (keymapp (symbol-value km)))
|
||||
(user-error "Not a keymap: %s" km))
|
||||
(list km)))
|
||||
(let (used-gentemp)
|
||||
(unless (and (symbolp keymap)
|
||||
(boundp keymap)
|
||||
(keymapp (symbol-value keymap)))
|
||||
(when (not (keymapp keymap))
|
||||
(if (symbolp keymap)
|
||||
(error "Not a keymap variable: %S" keymap)
|
||||
(error "Not a keymap")))
|
||||
(let ((sym nil))
|
||||
(unless sym
|
||||
(setq sym (cl-gentemp "KEYMAP OBJECT (no variable) "))
|
||||
(setq used-gentemp t)
|
||||
(set sym keymap))
|
||||
(setq keymap sym)))
|
||||
;; Follow aliasing.
|
||||
(setq keymap (or (ignore-errors (indirect-variable keymap)) keymap))
|
||||
(help-setup-xref (list #'describe-keymap keymap)
|
||||
(called-interactively-p 'interactive))
|
||||
(let* ((name (symbol-name keymap))
|
||||
(doc (documentation-property keymap 'variable-documentation))
|
||||
(file-name (find-lisp-object-file-name keymap 'defvar)))
|
||||
(with-help-window (help-buffer)
|
||||
(with-current-buffer standard-output
|
||||
(unless used-gentemp
|
||||
(princ (format-message "%S is a keymap variable" keymap))
|
||||
(if (not file-name)
|
||||
(princ ".\n\n")
|
||||
(princ (format-message
|
||||
" defined in `%s'.\n\n"
|
||||
(if (eq file-name 'C-source)
|
||||
"C source code"
|
||||
(file-name-nondirectory file-name))))
|
||||
(save-excursion
|
||||
(re-search-backward (substitute-command-keys
|
||||
"`\\([^`']+\\)'")
|
||||
nil t)
|
||||
(help-xref-button 1 'help-variable-def
|
||||
keymap file-name))))
|
||||
(when (and (not (equal "" doc)) doc)
|
||||
(princ "Documentation:\n")
|
||||
(princ (format-message "%s\n\n" doc)))
|
||||
;; Use `insert' instead of `princ', so control chars (e.g. \377)
|
||||
;; insert correctly.
|
||||
(insert (substitute-command-keys (concat "\\{" name "}"))))))
|
||||
;; Cleanup.
|
||||
(when used-gentemp
|
||||
(makunbound keymap))))
|
||||
|
||||
|
||||
;;; Replacements for old lib-src/ programs. Don't seem especially useful.
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue