diff options
| -rw-r--r-- | which-key.el | 62 |
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)." | |||
| 1739 | Requires `which-key-compute-remaps' to be non-nil" | 1738 | Requires `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. |
| 1791 | PREFIX limits bindings to those starting with this key | 1794 | PREFIX limits bindings to those starting with this key |
| 1792 | sequence. START is a list of existing bindings to add to. If ALL | 1795 | sequence. 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 | |||
| 1818 | non-nil, then bindings are collected recursively for all prefixes." | 1823 | non-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))) |