]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/swiper/counsel.el
Merge commit '09f86fca437f1b2e168093824e9d4ee0aea5130a' from swiper
[gnu-emacs-elpa] / packages / swiper / counsel.el
index 94c8608eee308daa3b2e87bb1a7e53f1c7815607..63c9552f8cfa499593f7e0710cefede247df9561 100644 (file)
 
 (require 'swiper)
 
+(defvar counsel-completion-beg nil
+  "Completion bounds start.")
+
+(defvar counsel-completion-end nil
+  "Completion bounds end.")
+
 ;;;###autoload
 (defun counsel-el ()
   "Elisp completion at point."
               :initial-input str
               :action #'counsel--el-action)))
 
-(defvar counsel-completion-beg nil
-  "Completion bounds start.")
-
-(defvar counsel-completion-end nil
-  "Completion bounds end.")
-
 (defun counsel--el-action (symbol)
   "Insert SYMBOL, erasing the previous one."
   (when (stringp symbol)
              (match-string 1 s)
            s))))
 
+(defun counsel-variable-list ()
+  "Return the list of all currently bound variables."
+  (let (cands)
+    (mapatoms
+     (lambda (vv)
+       (when (or (get vv 'variable-documentation)
+                 (and (boundp vv) (not (keywordp vv))))
+         (push (symbol-name vv) cands))))
+    cands))
+
 ;;;###autoload
 (defun counsel-describe-variable ()
   "Forward to `describe-variable'."
   (let ((enable-recursive-minibuffers t))
     (ivy-read
      "Describe variable: "
-     (let (cands)
-       (mapatoms
-        (lambda (vv)
-          (when (or (get vv 'variable-documentation)
-                    (and (boundp vv) (not (keywordp vv))))
-            (push (symbol-name vv) cands))))
-       cands)
+     (counsel-variable-list)
      :keymap counsel-describe-map
      :preselect (counsel-symbol-at-point)
      :history 'counsel-describe-symbol-history
                (describe-variable
                 (intern x))))))
 
+(ivy-set-actions
+ 'counsel-describe-variable
+ '(("i" counsel-info-lookup-symbol "info")
+   ("d" counsel--find-symbol "definition")))
+
+(ivy-set-actions
+ 'counsel-describe-function
+ '(("i" counsel-info-lookup-symbol "info")
+   ("d" counsel--find-symbol "definition")))
+
 ;;;###autoload
 (defun counsel-describe-function ()
   "Forward to `describe-function'."
 (defvar counsel--git-grep-count nil
   "Store the line count in current repository.")
 
+(defun counsel-more-chars (n)
+  "Return two fake candidates prompting for at least N input."
+  (list ""
+        (format "%d chars more" (- n (length ivy-text)))))
+
 (defun counsel-git-grep-function (string &optional _pred &rest _unused)
   "Grep in the current git repository for STRING."
   (if (and (> counsel--git-grep-count 20000)
            (< (length string) 3))
-      (progn
-        (setq ivy--full-length counsel--git-grep-count)
-        (list ""
-              (format "%d chars more" (- 3 (length ivy-text)))))
+      (counsel-more-chars 3)
     (let* ((default-directory counsel--git-grep-dir)
            (cmd (format "git --no-pager grep --full-name -n --no-color -i -e %S"
-                        (ivy--regex string t)))
-           res)
+                        (ivy--regex string t))))
       (if (<= counsel--git-grep-count 20000)
-          (progn
-            (setq res (shell-command-to-string cmd))
-            (setq ivy--full-length nil)
-            (split-string res "\n" t))
-        (setq ivy--full-length -1)
+          (split-string (shell-command-to-string cmd) "\n" t)
         (counsel--gg-candidates (ivy--regex string))
         nil))))
 
 
 (defun counsel-git-grep-recenter ()
   (interactive)
-  (with-selected-window (ivy-state-window ivy-last)
+  (with-ivy-window
     (counsel-git-grep-action ivy--current)
     (recenter-top-bottom)))
 
 (defun counsel-git-grep-action (x)
   (when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" x)
-    (let ((file-name (match-string-no-properties 1 x))
-          (line-number (match-string-no-properties 2 x)))
-      (find-file (expand-file-name file-name counsel--git-grep-dir))
-      (goto-char (point-min))
-      (forward-line (1- (string-to-number line-number)))
-      (re-search-forward (ivy--regex ivy-text t) (line-end-position) t)
-      (unless (eq ivy-exit 'done)
-        (setq swiper--window (selected-window))
-        (swiper--cleanup)
-        (swiper--add-overlays (ivy--regex ivy-text))))))
+    (with-ivy-window
+      (let ((file-name (match-string-no-properties 1 x))
+            (line-number (match-string-no-properties 2 x)))
+        (find-file (expand-file-name file-name counsel--git-grep-dir))
+        (goto-char (point-min))
+        (forward-line (1- (string-to-number line-number)))
+        (re-search-forward (ivy--regex ivy-text t) (line-end-position) t)
+        (unless (eq ivy-exit 'done)
+          (swiper--cleanup)
+          (swiper--add-overlays (ivy--regex ivy-text)))))))
 
 (defvar counsel-git-grep-history nil
   "History for `counsel-git-grep'.")
 
 ;;;###autoload
 (defun counsel-git-grep (&optional initial-input)
-  "Grep for a string in the current git repository."
+  "Grep for a string in the current git repository.
+INITIAL-INPUT can be given as the initial minibuffer input."
   (interactive)
   (setq counsel--git-grep-dir
         (locate-dominating-file default-directory ".git"))
   (if (null counsel--git-grep-dir)
       (error "Not in a git repository")
     (setq counsel--git-grep-count (counsel--gg-count "" t))
-    (ivy-read "pattern: " 'counsel-git-grep-function
+    (ivy-read "git grep: " 'counsel-git-grep-function
               :initial-input initial-input
               :matcher #'counsel-git-grep-matcher
-              :dynamic-collection (when (> counsel--git-grep-count 20000)
-                                    'counsel-git-grep-function)
+              :dynamic-collection (> counsel--git-grep-count 20000)
               :keymap counsel-git-grep-map
               :action #'counsel-git-grep-action
               :unwind #'swiper--cleanup
 
 (declare-function ffap-guesser "ffap")
 
+(defvar counsel-find-file-map (make-sparse-keymap))
+
 ;;;###autoload
 (defun counsel-find-file ()
   "Forward to `find-file'."
             :matcher #'counsel--find-file-matcher
             :action
             (lambda (x)
-              (find-file (expand-file-name x ivy--directory)))
+              (with-ivy-window
+                (find-file (expand-file-name x ivy--directory))))
             :preselect (when counsel-find-file-at-point
                          (require 'ffap)
                          (ffap-guesser))
             :require-match 'confirm-after-completion
-            :history 'file-name-history))
+            :history 'file-name-history
+            :keymap counsel-find-file-map))
 
 (defcustom counsel-find-file-ignore-regexp nil
   "A regexp of files to ignore while in `counsel-find-file'.
@@ -397,13 +412,6 @@ Skip some dotfiles unless `ivy-text' requires them."
                  candidates))
         (setq ivy--old-re regexp))))
 
-(defun counsel-locate-function (str &rest _u)
-  (if (< (length str) 3)
-      (list ""
-            (format "%d chars more" (- 3 (length ivy-text))))
-    (counsel--async-command
-     (concat "locate -i --regex " (ivy--regex str)))))
-
 (defun counsel--async-command (cmd)
   (let* ((counsel--process " *counsel*")
          (proc (get-process counsel--process))
@@ -424,20 +432,50 @@ Skip some dotfiles unless `ivy-text' requires them."
         (with-current-buffer (process-buffer process)
           (setq ivy--all-candidates (split-string (buffer-string) "\n" t))
           (setq ivy--old-cands ivy--all-candidates))
-        (ivy--insert-minibuffer
-         (ivy--format ivy--all-candidates)))
+        (ivy--exhibit))
     (if (string= event "exited abnormally with code 1\n")
-        (message "Error"))))
+        (progn
+          (setq ivy--all-candidates '("Error"))
+          (setq ivy--old-cands ivy--all-candidates)
+          (ivy--exhibit)))))
+
+(defun counsel-locate-action-extern (x)
+  "Use xdg-open shell command on X."
+  (call-process shell-file-name nil
+                nil nil
+                shell-command-switch
+                (format "xdg-open %s" (shell-quote-argument x))))
+
+(declare-function dired-jump "dired-x")
+(defun counsel-locate-action-dired (x)
+  "Use `dired-jump' on X."
+  (dired-jump nil x))
+
+(defvar counsel-locate-history nil
+  "History for `counsel-locate'.")
+
+(ivy-set-actions
+ 'counsel-locate
+ '(("x" counsel-locate-action-extern "xdg-open")
+   ("d" counsel-locate-action-dired "dired")))
+
+(defun counsel-locate-function (str &rest _u)
+  (if (< (length str) 3)
+      (counsel-more-chars 3)
+    (counsel--async-command
+     (concat "locate -i --regex " (ivy--regex str)))
+    '("" "working...")))
 
 ;;;###autoload
 (defun counsel-locate ()
-  "Call locate."
+  "Call locate shell command."
   (interactive)
-  (ivy-read "pattern: " nil
-            :dynamic-collection #'counsel-locate-function
-            :action (lambda (val)
-                      (when val
-                        (find-file val)))))
+  (ivy-read "Locate: " #'counsel-locate-function
+            :dynamic-collection t
+            :history 'counsel-locate-history
+            :action (lambda (file)
+                      (when file
+                        (find-file file)))))
 
 (defun counsel--generic (completion-fn)
   "Complete thing at point with COMPLETION-FN."
@@ -517,8 +555,12 @@ The libraries are offered from `load-path'."
                          (get-text-property 0 'full-name x)))
               :keymap counsel-describe-map)))
 
+(defvar counsel-gg-state nil
+  "The current state of candidates / count sync.")
+
 (defun counsel--gg-candidates (regex)
   "Return git grep candidates for REGEX."
+  (setq counsel-gg-state -2)
   (counsel--gg-count regex)
   (let* ((default-directory counsel--git-grep-dir)
          (counsel-gg-process " *counsel-gg*")
@@ -543,11 +585,13 @@ The libraries are offered from `load-path'."
         (with-current-buffer (process-buffer process)
           (setq ivy--all-candidates (split-string (buffer-string) "\n" t))
           (setq ivy--old-cands ivy--all-candidates))
-        (unless (eq ivy--full-length -1)
-          (ivy--insert-minibuffer
-           (ivy--format ivy--all-candidates))))
+        (when (= 0 (cl-incf counsel-gg-state))
+          (ivy--exhibit)))
     (if (string= event "exited abnormally with code 1\n")
-        (message "Error"))))
+        (progn
+          (setq ivy--all-candidates '("Error"))
+          (setq ivy--old-cands ivy--all-candidates)
+          (ivy--exhibit)))))
 
 (defun counsel--gg-count (regex &optional no-async)
   "Quickly and asynchronously count the amount of git grep REGEX matches.
@@ -574,8 +618,8 @@ When NO-ASYNC is non-nil, do it synchronously."
              (when (string= event "finished\n")
                (with-current-buffer (process-buffer process)
                  (setq ivy--full-length (string-to-number (buffer-string))))
-               (ivy--insert-minibuffer
-                (ivy--format ivy--all-candidates)))))))))
+               (when (= 0 (cl-incf counsel-gg-state))
+                 (ivy--exhibit)))))))))
 
 (defun counsel--M-x-transformer (cmd)
   "Add a binding to CMD if it's bound in the current window.
@@ -608,7 +652,7 @@ Optional INITIAL-INPUT is the initial input in the minibuffer."
           (lambda (cands)
             (funcall
              store
-             (with-selected-window (ivy-state-window ivy-last)
+             (with-ivy-window
                (mapcar #'counsel--M-x-transformer cands)))))
          (cands obarray)
          (pred 'commandp)
@@ -660,6 +704,213 @@ Usable with `ivy-resume', `ivy-next-line-and-call' and
                     (custom-available-themes))
             :action #'counsel--load-theme-action))
 
+(defvar rhythmbox-library)
+(declare-function rhythmbox-load-library "ext:helm-rhythmbox")
+(declare-function dbus-call-method "dbus")
+(declare-function rhythmbox-song-uri "ext:helm-rhythmbox")
+(declare-function helm-rhythmbox-candidates "ext:helm-rhythmbox")
+
+(defun counsel-rhythmbox-enqueue-song (song)
+  "Let Rhythmbox enqueue SONG."
+  (let ((service "org.gnome.Rhythmbox3")
+        (path "/org/gnome/Rhythmbox3/PlayQueue")
+        (interface "org.gnome.Rhythmbox3.PlayQueue"))
+    (dbus-call-method :session service path interface
+                      "AddToQueue" (rhythmbox-song-uri song))))
+
+(defvar counsel-rhythmbox-history nil
+  "History for `counsel-rhythmbox'.")
+
+;;;###autoload
+(defun counsel-rhythmbox ()
+  "Choose a song from the Rhythmbox library to play or enqueue."
+  (interactive)
+  (unless (require 'helm-rhythmbox nil t)
+    (error "Please install `helm-rhythmbox'"))
+  (unless rhythmbox-library
+    (rhythmbox-load-library)
+    (while (null rhythmbox-library)
+      (sit-for 0.1)))
+  (ivy-read "Rhythmbox: "
+            (helm-rhythmbox-candidates)
+            :history 'counsel-rhythmbox-history
+            :action
+            '(1
+              ("p" helm-rhythmbox-play-song "Play song")
+              ("e" counsel-rhythmbox-enqueue-song "Enqueue song"))))
+
+(defvar counsel-org-tags nil
+  "Store the current list of tags.")
+
+(defvar org-outline-regexp)
+(defvar org-indent-mode)
+(defvar org-indent-indentation-per-level)
+(defvar org-tags-column)
+(declare-function org-get-tags-string "org")
+(declare-function org-move-to-column "org")
+
+(defun counsel-org-change-tags (tags)
+  (let ((current (org-get-tags-string))
+        (col (current-column))
+        level)
+    ;; Insert new tags at the correct column
+    (beginning-of-line 1)
+    (setq level (or (and (looking-at org-outline-regexp)
+                         (- (match-end 0) (point) 1))
+                    1))
+    (cond
+      ((and (equal current "") (equal tags "")))
+      ((re-search-forward
+        (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
+        (point-at-eol) t)
+       (if (equal tags "")
+           (delete-region
+            (match-beginning 0)
+            (match-end 0))
+         (goto-char (match-beginning 0))
+         (let* ((c0 (current-column))
+                ;; compute offset for the case of org-indent-mode active
+                (di (if (bound-and-true-p org-indent-mode)
+                        (* (1- org-indent-indentation-per-level) (1- level))
+                      0))
+                (p0 (if (equal (char-before) ?*) (1+ (point)) (point)))
+                (tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)))
+                (c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (string-width tags)))))
+                (rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
+           (replace-match rpl t t)
+           (and c0 indent-tabs-mode (tabify p0 (point)))
+           tags)))
+      (t (error "Tags alignment failed")))
+    (org-move-to-column col)))
+
+(defun counsel-org-tag-action (x)
+  (if (member x counsel-org-tags)
+      (progn
+        (setq counsel-org-tags (delete x counsel-org-tags)))
+    (setq counsel-org-tags (append counsel-org-tags (list x)))
+    (unless (member x ivy--all-candidates)
+      (setq ivy--all-candidates (append ivy--all-candidates (list x)))))
+  (let ((prompt (counsel-org-tag-prompt)))
+    (setf (ivy-state-prompt ivy-last) prompt)
+    (setq ivy--prompt (concat "%-4d " prompt)))
+  (cond ((memq this-command '(ivy-done ivy-alt-done))
+         (counsel-org-change-tags
+          (if counsel-org-tags
+              (format ":%s:"
+                      (mapconcat #'identity counsel-org-tags ":"))
+            "")))
+        ((eq this-command 'ivy-call)
+         (delete-minibuffer-contents))))
+
+(defun counsel-org-tag-prompt ()
+  (format "Tags (%s): "
+          (mapconcat #'identity counsel-org-tags ", ")))
+
+(defvar org-setting-tags)
+(defvar org-last-tags-completion-table)
+(defvar org-tag-persistent-alist)
+(defvar org-tag-alist)
+(defvar org-complete-tags-always-offer-all-agenda-tags)
+
+(declare-function org-at-heading-p "org")
+(declare-function org-back-to-heading "org")
+(declare-function org-get-buffer-tags "org")
+(declare-function org-global-tags-completion-table "org")
+(declare-function org-agenda-files "org")
+(declare-function org-agenda-set-tags "org-agenda")
+
+;;;###autoload
+(defun counsel-org-tag ()
+  "Add or remove tags in org-mode."
+  (interactive)
+  (save-excursion
+    (unless (org-at-heading-p)
+      (org-back-to-heading t))
+    (setq counsel-org-tags (split-string (org-get-tags-string) ":" t))
+    (let ((org-setting-tags t)
+          (org-last-tags-completion-table
+           (append org-tag-persistent-alist
+                   (or org-tag-alist (org-get-buffer-tags))
+                   (and
+                    org-complete-tags-always-offer-all-agenda-tags
+                    (org-global-tags-completion-table
+                     (org-agenda-files))))))
+      (ivy-read (counsel-org-tag-prompt)
+                (lambda (str &rest _unused)
+                  (delete-dups
+                   (all-completions str 'org-tags-completion-function)))
+                :history 'org-tags-history
+                :action 'counsel-org-tag-action))))
+
+;;;###autoload
+(defun counsel-org-tag-agenda ()
+  "Set tags for the current agenda item."
+  (interactive)
+  (let ((store (symbol-function 'org-set-tags)))
+    (unwind-protect
+         (progn
+           (fset 'org-set-tags
+                 (symbol-function 'counsel-org-tag))
+           (org-agenda-set-tags nil nil))
+      (fset 'org-set-tags store))))
+
+(defun counsel-ag-function (string &optional _pred &rest _unused)
+  "Grep in the current directory for STRING."
+  (if (< (length string) 3)
+      (counsel-more-chars 3)
+    (let ((regex (replace-regexp-in-string
+                  "\\\\)" ")"
+                  (replace-regexp-in-string
+                   "\\\\(" "("
+                   (ivy--regex string)))))
+      (counsel--async-command
+       (format "ag --noheading --nocolor %S" regex))
+      nil)))
+
+(defun counsel-ag (&optional initial-input)
+  "Grep for a string in the current directory using ag.
+INITIAL-INPUT can be given as the initial minibuffer input."
+  (interactive)
+  (setq counsel--git-grep-dir default-directory)
+  (ivy-read "ag: " 'counsel-ag-function
+            :initial-input initial-input
+            :dynamic-collection t
+            :history 'counsel-git-grep-history
+            :action #'counsel-git-grep-action
+            :unwind #'swiper--cleanup))
+
+(defun counsel-recoll-function (string &optional _pred &rest _unused)
+  "Grep in the current directory for STRING."
+  (if (< (length string) 3)
+      (counsel-more-chars 3)
+    (counsel--async-command
+     (format "recoll -t -b '%s'" string))
+    nil))
+
+;; This command uses the recollq command line tool that comes together
+;; with the recoll (the document indexing database) source:
+;;     http://www.lesbonscomptes.com/recoll/download.html
+;; You need to build it yourself (together with recoll):
+;;     cd ./query && make && sudo cp recollq /usr/local/bin
+;; You can try the GUI version of recoll with:
+;;     sudo apt-get install recoll
+;; Unfortunately, that does not install recollq.
+(defun counsel-recoll (&optional initial-input)
+  "Search for a string in the recoll database.
+You'll be given a list of files that match.
+Selecting a file will launch `swiper' for that file.
+INITIAL-INPUT can be given as the initial minibuffer input."
+  (interactive)
+  (ivy-read "recoll: " 'counsel-recoll-function
+            :initial-input initial-input
+            :dynamic-collection t
+            :history 'counsel-git-grep-history
+            :action (lambda (x)
+                      (when (string-match "file://\\(.*\\)\\'" x)
+                        (let ((file-name (match-string 1 x)))
+                          (find-file file-name)
+                          (unless (string-match "pdf$" x)
+                            (swiper ivy-text)))))))
 
 (provide 'counsel)