code.delx.au - gnu-emacs-elpa/blob - packages/swiper/counsel.el

   1 ;;; counsel.el --- Various completion functions using Ivy -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
   6 ;; URL: https://github.com/abo-abo/swiper
   7 ;; Version: 0.1.0
   8 ;; Package-Requires: ((emacs "24.1") (swiper "0.3.0"))
   9 ;; Keywords: completion, matching
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; This file is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 3, or (at your option)
  16 ;; any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; For a full copy of the GNU General Public License
  24 ;; see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; Just call one of the interactive functions in this file to complete
  29 ;; the corresponding thing using `ivy'.
  30 ;;
  31 ;; Currently available: Elisp symbols, Clojure symbols, Git files.
  32
  33 ;;; Code:
  34
  35 (require 'swiper)
  36
  37 (defun counsel-el ()
  38   "Elisp completion at point."
  39   (interactive)
  40   (counsel--generic
  41    (lambda (str) (all-completions str obarray))))
  42
  43 (defvar counsel-describe-map
  44   (let ((map (make-sparse-keymap)))
  45     (define-key map (kbd "C-.") 'counsel-find-symbol)
  46     map))
  47
  48 (defun counsel-find-symbol ()
  49   "Jump to the definition of the current symbol."
  50   (interactive)
  51   (ivy-set-action 'counsel--find-symbol)
  52   (ivy-done))
  53
  54 (defun counsel--find-symbol ()
  55   (let ((sym (read ivy--current)))
  56     (cond ((boundp sym)
  57            (find-variable sym))
  58           ((fboundp sym)
  59            (find-function sym))
  60           ((or (featurep sym)
  61                (locate-library
  62                 (prin1-to-string sym)))
  63            (find-library (prin1-to-string sym)))
  64           (t
  65            (error "Couldn't fild definition of %s"
  66                   sym)))))
  67
  68 (defvar counsel-describe-symbol-history nil
  69   "History for `counsel-describe-variable' and `counsel-describe-function'.")
  70
  71 (defun counsel-describe-variable ()
  72   "Forward to `describe-variable'."
  73   (interactive)
  74   (let ((enable-recursive-minibuffers t))
  75     (ivy-read
  76      "Describe variable: "
  77      (let (cands)
  78        (mapatoms
  79         (lambda (vv)
  80           (when (or (get vv 'variable-documentation)
  81                     (and (boundp vv) (not (keywordp vv))))
  82             (push (symbol-name vv) cands))))
  83        cands)
  84      :keymap counsel-describe-map
  85      :preselect (thing-at-point 'symbol)
  86      :history 'counsel-describe-symbol-history
  87      :require-match t
  88      :sort t
  89      :action (lambda ()
  90                (describe-variable
  91                 (intern ivy--current))))))
  92
  93 (defun counsel-describe-function ()
  94   "Forward to `describe-function'."
  95   (interactive)
  96   (let ((enable-recursive-minibuffers t))
  97     (ivy-read "Describe function: "
  98               (let (cands)
  99                 (mapatoms
 100                  (lambda (x)
 101                    (when (fboundp x)
 102                      (push (symbol-name x) cands))))
 103                 cands)
 104               :keymap counsel-describe-map
 105               :preselect (thing-at-point 'symbol)
 106               :history 'counsel-describe-symbol-history
 107               :require-match t
 108               :sort t
 109               :action (lambda ()
 110                         (describe-function
 111                          (intern ivy--current))))))
 112
 113 (defvar info-lookup-mode)
 114 (declare-function info-lookup->completions "info-look")
 115 (declare-function info-lookup->mode-value "info-look")
 116 (declare-function info-lookup-select-mode "info-look")
 117 (declare-function info-lookup-change-mode "info-look")
 118 (declare-function info-lookup "info-look")
 119
 120 (defun counsel-info-lookup-symbol (symbol &optional mode)
 121   "Forward to (`info-describe-symbol' SYMBOL MODE) with ivy completion."
 122   (interactive
 123    (progn
 124      (require 'info-look)
 125      (let* ((topic 'symbol)
 126             (mode (cond (current-prefix-arg
 127                          (info-lookup-change-mode topic))
 128                         ((info-lookup->mode-value
 129                           topic (info-lookup-select-mode))
 130                          info-lookup-mode)
 131                         ((info-lookup-change-mode topic))))
 132             (completions (info-lookup->completions topic mode))
 133             (enable-recursive-minibuffers t)
 134             (value (ivy-read
 135                     "Describe symbol: "
 136                     (mapcar #'car completions))))
 137        (list value info-lookup-mode))))
 138   (info-lookup 'symbol symbol mode))
 139
 140 (defun counsel-unicode-char ()
 141   "Insert a Unicode character at point."
 142   (interactive)
 143   (let* ((minibuffer-allow-text-properties t)
 144          (char (ivy-read "Unicode name: "
 145                          (mapcar (lambda (x)
 146                                    (propertize
 147                                     (format "% -60s%c" (car x) (cdr x))
 148                                     'result (cdr x)))
 149                                  (ucs-names)))))
 150     (insert-char (get-text-property 0 'result char))))
 151
 152 (declare-function cider-sync-request:complete "ext:cider-client")
 153 (defun counsel-clj ()
 154   "Clojure completion at point."
 155   (interactive)
 156   (counsel--generic
 157    (lambda (str)
 158      (mapcar
 159       #'cl-caddr
 160       (cider-sync-request:complete str ":same")))))
 161
 162 (defun counsel-git ()
 163   "Find file in the current Git repository."
 164   (interactive)
 165   (let* ((default-directory (locate-dominating-file
 166                              default-directory ".git"))
 167          (cands (split-string
 168                  (shell-command-to-string
 169                   "git ls-files --full-name --")
 170                  "\n"
 171                  t))
 172          (file (ivy-read "Find file: " cands)))
 173     (when file
 174       (find-file file))))
 175
 176 (defvar counsel--git-grep-dir nil
 177   "Store the base git directory.")
 178
 179 (defun counsel-git-grep-count (str)
 180   "Quickly count the amount of git grep STR matches."
 181   (let* ((default-directory counsel--git-grep-dir)
 182          (out (shell-command-to-string
 183                (format "git grep -i -c '%s' | sed 's/.*:\\(.*\\)/\\1/g' | awk '{s+=$1} END {print s}'"
 184                        (ivy--regex str)))))
 185     (string-to-number out)))
 186
 187 (defvar counsel--git-grep-count nil
 188   "Store the line count in current repository.")
 189
 190 (defun counsel-git-grep-function (string &optional _pred &rest _unused)
 191   "Grep in the current git repository for STRING."
 192   (if (and (> counsel--git-grep-count 20000)
 193            (< (length string) 3))
 194       (progn
 195         (setq ivy--full-length counsel--git-grep-count)
 196         (list ""
 197               (format "%d chars more" (- 3 (length ivy-text)))))
 198     (let* ((default-directory counsel--git-grep-dir)
 199            (cmd (format "git --no-pager grep --full-name -n --no-color -i -e \"%s\""
 200                         (ivy--regex string t)))
 201            res)
 202       (if (<= counsel--git-grep-count 20000)
 203           (progn
 204             (setq res (shell-command-to-string cmd))
 205             (setq ivy--full-length nil))
 206         (setq res (shell-command-to-string (concat cmd " | head -n 2000")))
 207         (setq ivy--full-length (counsel-git-grep-count ivy-text)))
 208       (split-string res "\n" t))))
 209
 210 (defun counsel-git-grep (&optional initial-input)
 211   "Grep for a string in the current git repository."
 212   (interactive)
 213   (unwind-protect
 214        (let* ((counsel--git-grep-dir (locate-dominating-file
 215                                       default-directory ".git"))
 216               (counsel--git-grep-count (counsel-git-grep-count ""))
 217               (ivy--dynamic-function (when (> counsel--git-grep-count 20000)
 218                                        'counsel-git-grep-function)))
 219          (ivy-read "pattern: " 'counsel-git-grep-function
 220                    :initial-input initial-input
 221                    :action
 222                    (lambda ()
 223                      (let ((lst (split-string ivy--current ":")))
 224                        (find-file (expand-file-name (car lst) counsel--git-grep-dir))
 225                        (goto-char (point-min))
 226                        (forward-line (1- (string-to-number (cadr lst))))
 227                        (setq swiper--window (selected-window))
 228                        (swiper--cleanup)
 229                        (swiper--add-overlays (ivy--regex ivy-text))))))
 230     (swiper--cleanup)))
 231
 232 (defun counsel-locate-function (str &rest _u)
 233   (if (< (length str) 3)
 234       (list ""
 235             (format "%d chars more" (- 3 (length ivy-text))))
 236     (split-string
 237      (shell-command-to-string (concat "locate -i -l 20 --regex " (ivy--regex str))) "\n" t)))
 238
 239 (defun counsel-locate ()
 240   "Call locate."
 241   (interactive)
 242   (let* ((ivy--dynamic-function 'counsel-locate-function)
 243          (val (ivy-read "pattern: " 'counsel-locate-function)))
 244     (when val
 245       (find-file val))))
 246
 247 (defun counsel--generic (completion-fn)
 248   "Complete thing at point with COMPLETION-FN."
 249   (let* ((bnd (bounds-of-thing-at-point 'symbol))
 250          (str (if bnd
 251                   (buffer-substring-no-properties
 252                    (car bnd) (cdr bnd))
 253                 ""))
 254          (candidates (funcall completion-fn str))
 255          (ivy-height 7)
 256          (res (ivy-read (format "pattern (%s): " str)
 257                         candidates)))
 258     (when (stringp res)
 259       (when bnd
 260         (delete-region (car bnd) (cdr bnd)))
 261       (insert res))))
 262
 263 (provide 'counsel)
 264
 265 ;;; counsel.el ends here