[elpa] master d996215 038/272: Add counsel-descbinds

[Oleh Krehel]

branch: master
commit d996215c9e2757deae391619839037cbbdfa7b9c
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>

    Add counsel-descbinds
    
    * ivy.el (ivy-read-action): Update prompt for "C-M-a".
    
    * counsel.el (counsel--find-symbol): Use ivy-window.
    (counsel--descbinds-cands): New defun.
    (counsel-descbinds-history): New defvar.
    (counsel-descbinds-action-describe): New defun.
    (counsel-descbinds-action-find): New defun.
    (counsel-descbinds-action-info): New defun.
    (counsel-descbinds): New command. Very similar to `counsel-M-x', except
    that only bound commands are displayed.
    
    Fixes #332
---
 counsel.el |  109 ++++++++++++++++++++++++++++++++++++++++++++++++------------
 ivy.el     |    4 ++-
 2 files changed, 90 insertions(+), 23 deletions(-)

diff --git a/counsel.el b/counsel.el
index 6a97b70..e9baba0 100644
--- a/counsel.el
+++ b/counsel.el
@@ -148,28 +148,29 @@
 
 (defun counsel--find-symbol (x)
   "Find symbol definition that corresponds to string X."
-  (with-no-warnings
-    (ring-insert find-tag-marker-ring (point-marker)))
-  (let ((full-name (get-text-property 0 'full-name x)))
-    (if full-name
-        (find-library full-name)
-      (let ((sym (read x)))
-        (cond ((and (eq (ivy-state-caller ivy-last)
-                        'counsel-describe-variable)
-                    (boundp sym))
-               (find-variable sym))
-              ((fboundp sym)
-               (find-function sym))
-              ((boundp sym)
-               (find-variable sym))
-              ((or (featurep sym)
-                   (locate-library
-                    (prin1-to-string sym)))
-               (find-library
-                (prin1-to-string sym)))
-              (t
-               (error "Couldn't fild definition of %s"
-                      sym)))))))
+  (with-ivy-window
+    (with-no-warnings
+      (ring-insert find-tag-marker-ring (point-marker)))
+    (let ((full-name (get-text-property 0 'full-name x)))
+      (if full-name
+          (find-library full-name)
+        (let ((sym (read x)))
+          (cond ((and (eq (ivy-state-caller ivy-last)
+                          'counsel-describe-variable)
+                      (boundp sym))
+                 (find-variable sym))
+                ((fboundp sym)
+                 (find-function sym))
+                ((boundp sym)
+                 (find-variable sym))
+                ((or (featurep sym)
+                     (locate-library
+                      (prin1-to-string sym)))
+                 (find-library
+                  (prin1-to-string sym)))
+                (t
+                 (error "Couldn't fild definition of %s"
+                        sym))))))))
 
 (defvar counsel-describe-symbol-history nil
   "History for `counsel-describe-variable' and `counsel-describe-function'.")
@@ -1340,6 +1341,70 @@ PREFIX is used to create the key."
                         (with-ivy-window
                           (goto-char pos))))))
 
+(defun counsel--descbinds-cands ()
+  (let ((buffer (current-buffer))
+        (re-exclude (regexp-opt
+                     '("<vertical-line>" "<bottom-divider>" "<right-divider>"
+                       "<mode-line>" "<C-down-mouse-2>" "<left-fringe>"
+                       "<right-fringe>" "<header-line>"
+                       "<vertical-scroll-bar>" "<horizontal-scroll-bar>")))
+        res)
+    (with-temp-buffer
+      (let ((indent-tabs-mode t))
+        (describe-buffer-bindings buffer))
+      (goto-char (point-min))
+      ;; Skip the "Key translations" section
+      (re-search-forward "")
+      (forward-char 1)
+      (while (not (eobp))
+        (when (looking-at "^\\([^\t\n]+\\)\t+\\(.*\\)$")
+          (let ((key (match-string 1))
+                (fun (match-string 2))
+                cmd)
+            (unless (or (member fun '("??" "self-insert-command"))
+                        (string-match re-exclude key)
+                        (not (or (commandp (setq cmd (intern-soft fun)))
+                                 (member fun '("Prefix Command")))))
+              (push
+               (cons (format
+                      "%-15s %s"
+                      (propertize key 'face 'font-lock-builtin-face)
+                      fun)
+                     (cons key cmd))
+               res))))
+        (forward-line 1)))
+    (nreverse res)))
+
+(defvar counsel-descbinds-history nil
+  "History for `counsel-descbinds'.")
+
+(defun counsel-descbinds-action-describe (x)
+  (let ((cmd (cdr x)))
+    (describe-function cmd)))
+
+(defun counsel-descbinds-action-find (x)
+  (let ((cmd (cdr x)))
+    (counsel--find-symbol (symbol-name cmd))))
+
+(defun counsel-descbinds-action-info (x)
+  (let ((cmd (cdr x)))
+    (counsel-info-lookup-symbol (symbol-name cmd))))
+
+;;;###autoload
+(defun counsel-descbinds ()
+  "Show a list of all defined keys, and their definitions.
+Describe the selected candidate."
+  (interactive)
+  (ivy-read "Bindings: " (counsel--descbinds-cands)
+            :action #'counsel-descbinds-action-describe
+            :caller 'counsel-descbinds
+            :history 'counsel-descbinds-history))
+
+(ivy-set-actions
+ 'counsel-descbinds
+ '(("d" counsel-descbinds-action-find "definition")
+   ("i" counsel-descbinds-action-info "info")))
+
 (provide 'counsel)
 
 ;;; counsel.el ends here
diff --git a/ivy.el b/ivy.el
index 6ff1e87..33c9017 100644
--- a/ivy.el
+++ b/ivy.el
@@ -372,7 +372,9 @@ When non-nil, it should contain at least one %d.")
   (interactive)
   (let ((actions (ivy-state-action ivy-last)))
     (unless (null (ivy--actionp actions))
-      (let* ((hint (concat ivy--current
+      (let* ((hint (concat (if (eq this-command 'ivy-read-action)
+                               "Select action: "
+                             ivy--current)
                            "\n"
                            (mapconcat
                             (lambda (x)