diff options
| author | Stefan Kangas | 2020-01-19 00:17:42 +0100 |
|---|---|---|
| committer | Stefan Kangas | 2020-02-04 02:04:20 +0100 |
| commit | 330228d5c71981d3e2d39387d5222c3670c467c6 (patch) | |
| tree | 3945f976b7d292ad9a441d8033ac8a77756f7e67 | |
| parent | 557b790e0a3fcb2cd4196a3119da3e92647f8def (diff) | |
| download | emacs-330228d5c71981d3e2d39387d5222c3670c467c6.tar.gz emacs-330228d5c71981d3e2d39387d5222c3670c467c6.zip | |
Provide default for describe-keymap prompt
* lisp/help-fns.el (describe-keymap): Provide a reasonable
default for prompt. (Bug#30660)
(help-fns-find-keymap-name)
(help-fns--most-relevant-active-keymap): New functions.
* test/lisp/help-fns-tests.el
(help-fns-test-find-keymap-name): New test.
| -rw-r--r-- | lisp/help-fns.el | 50 | ||||
| -rw-r--r-- | test/lisp/help-fns-tests.el | 9 |
2 files changed, 53 insertions, 6 deletions
diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 017bb3ae748..36c2a8b186d 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el | |||
| @@ -1562,17 +1562,55 @@ BUFFER should be a buffer or a buffer name." | |||
| 1562 | (insert "\nThe parent category table is:") | 1562 | (insert "\nThe parent category table is:") |
| 1563 | (describe-vector table 'help-describe-category-set)))))) | 1563 | (describe-vector table 'help-describe-category-set)))))) |
| 1564 | 1564 | ||
| 1565 | (defun help-fns-find-keymap-name (keymap) | ||
| 1566 | "Find the name of the variable with value KEYMAP. | ||
| 1567 | Return nil if KEYMAP is not a valid keymap, or if there is no | ||
| 1568 | variable with value KEYMAP." | ||
| 1569 | (when (keymapp keymap) | ||
| 1570 | (let ((name (catch 'found-keymap | ||
| 1571 | (mapatoms (lambda (symb) | ||
| 1572 | (when (and (boundp symb) | ||
| 1573 | (eq (symbol-value symb) keymap) | ||
| 1574 | (not (eq symb 'keymap)) | ||
| 1575 | (throw 'found-keymap symb))))) | ||
| 1576 | nil))) | ||
| 1577 | ;; Follow aliasing. | ||
| 1578 | (or (ignore-errors (indirect-variable name)) name)))) | ||
| 1579 | |||
| 1580 | (defun help-fns--most-relevant-active-keymap () | ||
| 1581 | "Return the name of the most relevant active keymap. | ||
| 1582 | The heuristic to determine which keymap is most likely to be | ||
| 1583 | relevant to a user follows this order: | ||
| 1584 | |||
| 1585 | 1. 'keymap' text property at point | ||
| 1586 | 2. 'local-map' text property at point | ||
| 1587 | 3. the `current-local-map' | ||
| 1588 | |||
| 1589 | This is used to set the default value for the interactive prompt | ||
| 1590 | in `describe-keymap'. See also `Searching the Active Keymaps'." | ||
| 1591 | (help-fns-find-keymap-name (or (get-char-property (point) 'keymap) | ||
| 1592 | (if (get-text-property (point) 'local-map) | ||
| 1593 | (get-char-property (point) 'local-map) | ||
| 1594 | (current-local-map))))) | ||
| 1595 | |||
| 1565 | ;;;###autoload | 1596 | ;;;###autoload |
| 1566 | (defun describe-keymap (keymap) | 1597 | (defun describe-keymap (keymap) |
| 1567 | "Describe key bindings in KEYMAP. | 1598 | "Describe key bindings in KEYMAP. |
| 1568 | When called interactively, prompt for a variable that has a | 1599 | When called interactively, prompt for a variable that has a |
| 1569 | keymap value." | 1600 | keymap value." |
| 1570 | (interactive (list | 1601 | (interactive |
| 1571 | (intern (completing-read "Keymap: " obarray | 1602 | (let* ((km (help-fns--most-relevant-active-keymap)) |
| 1572 | (lambda (m) | 1603 | (val (completing-read |
| 1573 | (and (boundp m) | 1604 | (format "Keymap (default %s): " km) |
| 1574 | (keymapp (symbol-value m)))) | 1605 | obarray |
| 1575 | t nil 'variable-name-history)))) | 1606 | (lambda (m) (and (boundp m) (keymapp (symbol-value m)))) |
| 1607 | t nil 'keymap-name-history | ||
| 1608 | (symbol-name km)))) | ||
| 1609 | (unless (equal val "") | ||
| 1610 | (setq km (intern val))) | ||
| 1611 | (unless (and km (keymapp (symbol-value km))) | ||
| 1612 | (user-error "Not a keymap: %s" km)) | ||
| 1613 | (list km))) | ||
| 1576 | (let (used-gentemp) | 1614 | (let (used-gentemp) |
| 1577 | (unless (and (symbolp keymap) | 1615 | (unless (and (symbolp keymap) |
| 1578 | (boundp keymap) | 1616 | (boundp keymap) |
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 1d6c062979f..d2dc3d24aec 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el | |||
| @@ -125,6 +125,15 @@ Return first line of the output of (describe-function-1 FUNC)." | |||
| 125 | 125 | ||
| 126 | 126 | ||
| 127 | ;;; Tests for describe-keymap | 127 | ;;; Tests for describe-keymap |
| 128 | (ert-deftest help-fns-test-find-keymap-name () | ||
| 129 | (should (equal (help-fns-find-keymap-name lisp-mode-map) 'lisp-mode-map)) | ||
| 130 | ;; Follow aliasing. | ||
| 131 | (unwind-protect | ||
| 132 | (progn | ||
| 133 | (defvaralias 'foo-test-map 'lisp-mode-map) | ||
| 134 | (should (equal (help-fns-find-keymap-name foo-test-map) 'lisp-mode-map))) | ||
| 135 | (makunbound 'foo-test-map))) | ||
| 136 | |||
| 128 | (ert-deftest help-fns-test-describe-keymap/symbol () | 137 | (ert-deftest help-fns-test-describe-keymap/symbol () |
| 129 | (describe-keymap 'minibuffer-local-must-match-map) | 138 | (describe-keymap 'minibuffer-local-must-match-map) |
| 130 | (with-current-buffer "*Help*" | 139 | (with-current-buffer "*Help*" |