code.delx.au - gnu-emacs-elpa/blob - 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   (setq ivy--action 'counsel--find-symbol)
  52   (setq ivy-exit 'done)
  53   (exit-minibuffer))
  54
  55 (defun counsel--find-symbol ()
  56   (let ((sym (read ivy--current)))
  57     (cond ((boundp sym)
  58            (find-variable sym))
  59           ((fboundp sym)
  60            (find-function sym))
  61           ((or (featurep sym)
  62                (locate-library
  63                 (prin1-to-string sym)))
  64            (find-library (prin1-to-string sym)))
  65           (t
  66            (error "Couldn't fild definition of %s"
  67                   sym)))))
  68
  69 (defun counsel-describe-variable (variable &optional buffer frame)
  70   "Forward to (`describe-variable' VARIABLE BUFFER FRAME)."
  71   (interactive
  72    (let ((v (variable-at-point))
  73          (enable-recursive-minibuffers t)
  74          (preselect (thing-at-point 'symbol))
  75          val)
  76      (setq ivy--action nil)
  77      (setq val (ivy-read
  78                 (if (symbolp v)
  79                     (format
  80                      "Describe variable (default %s): " v)
  81                   "Describe variable: ")
  82                 (let (cands)
  83                   (mapatoms
  84                    (lambda (vv)
  85                      (when (or (get vv 'variable-documentation)
  86                                (and (boundp vv) (not (keywordp vv))))
  87                        (push (symbol-name vv) cands))))
  88                   cands)
  89                 nil nil counsel-describe-map preselect
  90                 nil t))
  91      (list (if (equal val "")
  92                v
  93              (intern val)))))
  94   (unless (eq ivy--action 'counsel--find-symbol)
  95     (describe-variable variable buffer frame)))
  96
  97 (defun counsel-describe-function (function)
  98   "Forward to (`describe-function' FUNCTION) with ivy completion."
  99   (interactive
 100    (let ((fn (function-called-at-point))
 101          (enable-recursive-minibuffers t)
 102          (preselect (thing-at-point 'symbol))
 103          val)
 104      (setq ivy--action nil)
 105      (setq val (ivy-read (if fn
 106                              (format "Describe function (default %s): " fn)
 107                            "Describe function: ")
 108                          (let (cands)
 109                            (mapatoms
 110                             (lambda (x)
 111                               (when (fboundp x)
 112                                 (push (symbol-name x) cands))))
 113                            cands)
 114                          nil nil counsel-describe-map preselect
 115                          nil t))
 116      (list (if (equal val "")
 117                fn (intern val)))))
 118   (unless (eq ivy--action 'counsel--find-symbol)
 119     (describe-function function)))
 120
 121 (defvar info-lookup-mode)
 122 (declare-function info-lookup->completions "info-look")
 123 (declare-function info-lookup->mode-value "info-look")
 124 (declare-function info-lookup-select-mode "info-look")
 125 (declare-function info-lookup-change-mode "info-look")
 126 (declare-function info-lookup "info-look")
 127
 128 (defun counsel-info-lookup-symbol (symbol &optional mode)
 129   "Forward to (`info-describe-symbol' SYMBOL MODE) with ivy completion."
 130   (interactive
 131    (progn
 132      (require 'info-look)
 133      (let* ((topic 'symbol)
 134             (mode (cond (current-prefix-arg
 135                          (info-lookup-change-mode topic))
 136                         ((info-lookup->mode-value
 137                           topic (info-lookup-select-mode))
 138                          info-lookup-mode)
 139                         ((info-lookup-change-mode topic))))
 140             (completions (info-lookup->completions topic mode))
 141             (enable-recursive-minibuffers t)
 142             (value (ivy-read
 143                     "Describe symbol: "
 144                     (mapcar #'car completions))))
 145        (list value info-lookup-mode))))
 146   (info-lookup 'symbol symbol mode))
 147
 148 (defun counsel-unicode-char ()
 149   "Insert a Unicode character at point."
 150   (interactive)
 151   (let* ((minibuffer-allow-text-properties t)
 152          (char (ivy-read "Unicode name: "
 153                          (mapcar (lambda (x)
 154                                    (propertize
 155                                     (format "% -60s%c" (car x) (cdr x))
 156                                     'result (cdr x)))
 157                                  (ucs-names)))))
 158     (insert-char (get-text-property 0 'result char))))
 159
 160 (declare-function cider-sync-request:complete "ext:cider-client")
 161 (defun counsel-clj ()
 162   "Clojure completion at point."
 163   (interactive)
 164   (counsel--generic
 165    (lambda (str)
 166      (mapcar
 167       #'cl-caddr
 168       (cider-sync-request:complete str ":same")))))
 169
 170 (defun counsel-git ()
 171   "Find file in the current Git repository."
 172   (interactive)
 173   (let* ((default-directory (locate-dominating-file
 174                              default-directory ".git"))
 175          (cands (split-string
 176                  (shell-command-to-string
 177                   "git ls-files --full-name --")
 178                  "\n"
 179                  t))
 180          (file (ivy-read "Find file: " cands)))
 181     (when file
 182       (find-file file))))
 183
 184 (defun counsel-git-grep-count (str)
 185   "Quickly count the amount of git grep STR matches."
 186   (let ((out (shell-command-to-string
 187               (format "git grep -c '%s' | sed 's/.*:\\(.*\\)/\\1/g' | awk '{s+=$1} END {print s}'"
 188                       (ivy--regex str)))))
 189     (string-to-number out)))
 190
 191 (defvar counsel--git-grep-count nil
 192   "Store the line count in current repository.")
 193
 194 (defun counsel-git-grep-function (string &optional _pred &rest _unused)
 195   "Grep in the current git repository for STRING."
 196   (if (and (> counsel--git-grep-count 20000)
 197            (< (length string) 3))
 198       (progn
 199         (setq ivy--full-length counsel--git-grep-count)
 200         (list ""
 201               (format "%d chars more" (- 3 (length ivy-text)))))
 202     (let ((cmd (format "git --no-pager grep --full-name -n --no-color -i -e \"%s\""
 203                        (ivy--regex string t)))
 204           res)
 205       (if (<= counsel--git-grep-count 20000)
 206           (progn
 207             (setq res (shell-command-to-string cmd))
 208             (setq ivy--full-length nil))
 209         (setq res (shell-command-to-string (concat cmd " | head -n 5000")))
 210         (setq ivy--full-length (counsel-git-grep-count ivy-text)))
 211       (split-string res "\n" t))))
 212
 213 (defun counsel-git-grep ()
 214   "Grep for a string in the current git repository."
 215   (interactive)
 216   (unwind-protect
 217        (let* ((counsel--git-grep-count (counsel-git-grep-count ""))
 218               (ivy--dynamic-function (when (> counsel--git-grep-count 20000)
 219                                        'counsel-git-grep-function))
 220               (git-dir (locate-dominating-file
 221                         default-directory ".git"))
 222               (ivy--persistent-action (lambda (x)
 223                                         (setq lst (split-string x ":"))
 224                                         (find-file (expand-file-name (car lst) git-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               (val (ivy-read "pattern: " 'counsel-git-grep-function))
 231               lst)
 232          (when val
 233            (funcall ivy--persistent-action val)))
 234     (swiper--cleanup)))
 235
 236 (defun counsel-locate-function (str &rest _u)
 237   (if (< (length str) 3)
 238       (list ""
 239             (format "%d chars more" (- 3 (length ivy-text))))
 240     (split-string
 241      (shell-command-to-string (concat "locate -i -l 20 --regex " (ivy--regex str))) "\n" t)))
 242
 243 (defun counsel-locate ()
 244   "Call locate."
 245   (interactive)
 246   (let* ((ivy--dynamic-function 'counsel-locate-function)
 247          (val (ivy-read "pattern: " 'counsel-locate-function)))
 248     (when val
 249       (find-file val))))
 250
 251 (defun counsel--generic (completion-fn)
 252   "Complete thing at point with COMPLETION-FN."
 253   (let* ((bnd (bounds-of-thing-at-point 'symbol))
 254          (str (if bnd
 255                   (buffer-substring-no-properties
 256                    (car bnd) (cdr bnd))
 257                 ""))
 258          (candidates (funcall completion-fn str))
 259          (ivy-height 7)
 260          (res (ivy-read (format "pattern (%s): " str)
 261                         candidates)))
 262     (when (stringp res)
 263       (when bnd
 264         (delete-region (car bnd) (cdr bnd)))
 265       (insert res))))
 266
 267 (provide 'counsel)
 268
 269 ;;; counsel.el ends here