aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--which-key.el62
1 files changed, 33 insertions, 29 deletions
diff --git a/which-key.el b/which-key.el
index bb1cf01ba45..d6baa70b537 100644
--- a/which-key.el
+++ b/which-key.el
@@ -1399,8 +1399,7 @@ Uses `string-lessp' after applying lowercase."
1399 (string-lessp (downcase (cdr acons)) (downcase (cdr bcons)))) 1399 (string-lessp (downcase (cdr acons)) (downcase (cdr bcons))))
1400 1400
1401(defsubst which-key--group-p (description) 1401(defsubst which-key--group-p (description)
1402 (or (string-match-p "^\\(group:\\|Prefix\\)" description) 1402 (keymapp (intern description)))
1403 (keymapp (intern description))))
1404 1403
1405(defun which-key-prefix-then-key-order (acons bcons) 1404(defun which-key-prefix-then-key-order (acons bcons)
1406 "Order first by whether A and/or B is a prefix with no prefix 1405 "Order first by whether A and/or B is a prefix with no prefix
@@ -1739,19 +1738,19 @@ alists. Returns a list (key separator description)."
1739Requires `which-key-compute-remaps' to be non-nil" 1738Requires `which-key-compute-remaps' to be non-nil"
1740 (let (remap) 1739 (let (remap)
1741 (if (and which-key-compute-remaps 1740 (if (and which-key-compute-remaps
1742 (setq remap (command-remapping (intern binding)))) 1741 (setq remap (command-remapping binding)))
1743 (copy-sequence (symbol-name remap)) 1742 (copy-sequence (symbol-name remap))
1744 (copy-sequence (symbol-name binding))))) 1743 (copy-sequence (symbol-name binding)))))
1745 1744
1746(defun which-key--get-keymap-bindings-1 1745(defun which-key--get-keymap-bindings-1
1747 "Helper function for `which-key--get-keymap-bindings'" 1746 (keymap start &optional prefix filter all ignore-commands)
1748 (keymap start &optional prefix all ignore-commands) 1747 "See `which-key--get-keymap-bindings'."
1749 (let ((bindings start) 1748 (let ((bindings start)
1750 (prefix-map (if prefix (lookup-key keymap prefix) keymap))) 1749 (prefix-map (if prefix (lookup-key keymap prefix) keymap)))
1751 (when (keymapp prefix-map) 1750 (when (keymapp prefix-map)
1752 (map-keymap 1751 (map-keymap
1753 (lambda (ev def) 1752 (lambda (ev def)
1754 (let* ((key (append prefix (list ev))) 1753 (let* ((key (vconcat prefix (list ev)))
1755 (key-desc (key-description key))) 1754 (key-desc (key-description key)))
1756 (cond 1755 (cond
1757 ((assoc key-desc bindings)) 1756 ((assoc key-desc bindings))
@@ -1768,25 +1767,29 @@ Requires `which-key-compute-remaps' to be non-nil"
1768 (and (numberp ev) (= ev 27)))) 1767 (and (numberp ev) (= ev 27))))
1769 (setq bindings 1768 (setq bindings
1770 (which-key--get-keymap-bindings-1 1769 (which-key--get-keymap-bindings-1
1771 keymap bindings key all ignore-commands))) 1770 keymap bindings key nil all ignore-commands)))
1772 (def 1771 (def
1773 (push 1772 (let ((binding
1774 (cons key-desc 1773 (cons key-desc
1775 (cond 1774 (cond
1776 ((keymapp def) "+prefix") 1775 ((keymapp def) "prefix")
1777 ((symbolp def) (which-key--compute-binding def)) 1776 ((symbolp def) (which-key--compute-binding def))
1778 ((eq 'lambda (car-safe def)) "lambda") 1777 ((eq 'lambda (car-safe def)) "lambda")
1779 ((eq 'menu-item (car-safe def)) 1778 ((eq 'menu-item (car-safe def))
1780 (keymap--menu-item-binding def)) 1779 (keymap--menu-item-binding def))
1781 ((stringp def) def) 1780 ((stringp def) def)
1782 ((vectorp def) (key-description def)) 1781 ((vectorp def) (key-description def))
1783 ((consp def) (car def)) 1782 ((consp def) (car def))
1784 (t "unknown"))) 1783 (t "unknown")))))
1785 bindings))))) 1784 (when (or (null filter)
1785 (and (functionp filter)
1786 (funcall filter binding)))
1787 (push binding bindings)))))))
1786 prefix-map)) 1788 prefix-map))
1787 bindings)) 1789 bindings))
1788 1790
1789(defun which-key--get-keymap-bindings (keymap &optional prefix start all evil) 1791(defun which-key--get-keymap-bindings
1792 (keymap &optional start prefix filter all evil)
1790 "Retrieve top-level bindings from KEYMAP. 1793 "Retrieve top-level bindings from KEYMAP.
1791PREFIX limits bindings to those starting with this key 1794PREFIX limits bindings to those starting with this key
1792sequence. START is a list of existing bindings to add to. If ALL 1795sequence. START is a list of existing bindings to add to. If ALL
@@ -1799,16 +1802,18 @@ EVIL is non-nil, extract active evil bidings."
1799 (lookup-key keymap (kbd (format "<%s-state>" evil-state)))))) 1802 (lookup-key keymap (kbd (format "<%s-state>" evil-state))))))
1800 (when (keymapp evil-map) 1803 (when (keymapp evil-map)
1801 (setq bindings (which-key--get-keymap-bindings-1 1804 (setq bindings (which-key--get-keymap-bindings-1
1802 evil-map bindings prefix all ignore))) 1805 evil-map bindings prefix filter all ignore)))
1803 (which-key--get-keymap-bindings-1 keymap bindings prefix all ignore))) 1806 (which-key--get-keymap-bindings-1
1807 keymap bindings prefix filter all ignore)))
1804 1808
1805(defun which-key--get-current-bindings (&optional prefix) 1809(defun which-key--get-current-bindings (&optional prefix filter)
1806 "Generate a list of current active bindings." 1810 "Generate a list of current active bindings."
1807 (let (bindings) 1811 (let (bindings)
1808 (dolist (map (current-active-maps t) bindings) 1812 (dolist (map (current-active-maps t) bindings)
1809 (when (cdr map) 1813 (when (cdr map)
1810 (setq bindings 1814 (setq bindings
1811 (which-key--get-keymap-bindings map prefix bindings)))))) 1815 (which-key--get-keymap-bindings
1816 map bindings prefix filter))))))
1812 1817
1813(defun which-key--get-bindings (&optional prefix keymap filter recursive) 1818(defun which-key--get-bindings (&optional prefix keymap filter recursive)
1814 "Collect key bindings. 1819 "Collect key bindings.
@@ -1818,13 +1823,12 @@ is a function to use to filter the bindings. If RECURSIVE is
1818non-nil, then bindings are collected recursively for all prefixes." 1823non-nil, then bindings are collected recursively for all prefixes."
1819 (let* ((unformatted 1824 (let* ((unformatted
1820 (cond ((keymapp keymap) 1825 (cond ((keymapp keymap)
1821 (which-key--get-keymap-bindings keymap recursive)) 1826 (which-key--get-keymap-bindings
1827 keymap prefix filter recursive))
1822 (keymap 1828 (keymap
1823 (error "%s is not a keymap" keymap)) 1829 (error "%s is not a keymap" keymap))
1824 (t 1830 (t
1825 (which-key--get-current-bindings prefix))))) 1831 (which-key--get-current-bindings prefix filter)))))
1826 (when filter
1827 (setq unformatted (cl-remove-if-not filter unformatted)))
1828 (when which-key-sort-order 1832 (when which-key-sort-order
1829 (setq unformatted 1833 (setq unformatted
1830 (sort unformatted which-key-sort-order))) 1834 (sort unformatted which-key-sort-order)))