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.2.1"))
   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 'ivy)
  36
  37 (defun counsel-el ()
  38   "Elisp completion at point."
  39   (interactive)
  40   (counsel--generic
  41    (lambda (str) (all-completions str obarray))))
  42
  43 (defun counsel-describe-variable (variable &optional buffer frame)
  44   "Forward to (`describe-variable' VARIABLE BUFFER FRAME)."
  45   (interactive
  46    (let ((v (variable-at-point))
  47          (enable-recursive-minibuffers t)
  48          (preselect (thing-at-point 'symbol))
  49          val)
  50      (setq val (ivy-read
  51                 (if (symbolp v)
  52                     (format
  53                      "Describe variable (default %s): " v)
  54                   "Describe variable: ")
  55                 (let (cands)
  56                   (mapatoms
  57                    (lambda (vv)
  58                      (when (or (get vv 'variable-documentation)
  59                                (and (boundp vv) (not (keywordp vv))))
  60                        (push (symbol-name vv) cands))))
  61                   cands)
  62                 nil nil nil preselect))
  63      (list (if (equal val "")
  64                v
  65              (intern val)))))
  66   (describe-variable variable buffer frame))
  67
  68 (defun counsel-describe-function (function)
  69   "Forward to (`describe-function' FUNCTION) with ivy completion."
  70   (interactive
  71    (let ((fn (function-called-at-point))
  72          (enable-recursive-minibuffers t)
  73          (preselect (thing-at-point 'symbol))
  74          val)
  75      (setq val (ivy-read (if fn
  76                              (format "Describe function (default %s): " fn)
  77                            "Describe function: ")
  78                          (let (cands)
  79                            (mapatoms
  80                             (lambda (x)
  81                               (when (fboundp x)
  82                                 (push (symbol-name x) cands))))
  83                            cands)
  84                          nil nil nil preselect))
  85      (list (if (equal val "")
  86                fn (intern val)))))
  87   (describe-function function))
  88
  89 (defvar info-lookup-mode)
  90 (declare-function info-lookup->completions "info-look")
  91 (declare-function info-lookup->mode-value "info-look")
  92 (declare-function info-lookup-select-mode "info-look")
  93 (declare-function info-lookup-change-mode "info-look")
  94 (declare-function info-lookup "info-look")
  95
  96 (defun counsel-info-lookup-symbol (symbol &optional mode)
  97   "Forward to (`info-describe-symbol' SYMBOL MODE) with ivy completion."
  98   (interactive
  99    (progn
 100      (require 'info-look)
 101      (let* ((topic 'symbol)
 102             (mode (cond (current-prefix-arg
 103                          (info-lookup-change-mode topic))
 104                         ((info-lookup->mode-value
 105                           topic (info-lookup-select-mode))
 106                          info-lookup-mode)
 107                         ((info-lookup-change-mode topic))))
 108             (completions (info-lookup->completions topic mode))
 109             (enable-recursive-minibuffers t)
 110             (value (ivy-read
 111                     "Describe symbol: "
 112                     (mapcar #'car completions))))
 113        (list value info-lookup-mode))))
 114   (info-lookup 'symbol symbol mode))
 115
 116 (defun counsel-unicode-char ()
 117   "Insert a Unicode character at point."
 118   (interactive)
 119   (let* ((minibuffer-allow-text-properties t)
 120          (char (ivy-read "Unicode name: "
 121                          (mapcar (lambda (x)
 122                                    (propertize
 123                                     (format "% -60s%c" (car x) (cdr x))
 124                                     'result (cdr x)))
 125                                  (ucs-names)))))
 126     (insert-char (get-text-property 0 'result char))))
 127
 128 (declare-function cider-sync-request:complete "ext:cider-client")
 129 (defun counsel-clj ()
 130   "Clojure completion at point."
 131   (interactive)
 132   (counsel--generic
 133    (lambda (str)
 134      (mapcar
 135       #'cl-caddr
 136       (cider-sync-request:complete str ":same")))))
 137
 138 (defun counsel-git ()
 139   "Find file in the current Git repository."
 140   (interactive)
 141   (let* ((default-directory (locate-dominating-file
 142                              default-directory ".git"))
 143          (cands (split-string
 144                  (shell-command-to-string
 145                   "git ls-files --full-name --")
 146                  "\n"
 147                  t))
 148          (file (ivy-read "Find file: " cands)))
 149     (when file
 150       (find-file file))))
 151
 152 (defun counsel--generic (completion-fn)
 153   "Complete thing at point with COMPLETION-FN."
 154   (let* ((bnd (bounds-of-thing-at-point 'symbol))
 155          (str (if bnd
 156                   (buffer-substring-no-properties
 157                    (car bnd) (cdr bnd))
 158                 ""))
 159          (candidates (funcall completion-fn str))
 160          (ivy-height 7)
 161          (res (ivy-read (format "pattern (%s): " str)
 162                         candidates)))
 163     (when (stringp res)
 164       (when bnd
 165         (delete-region (car bnd) (cdr bnd)))
 166       (insert res))))
 167
 168 (provide 'counsel)
 169
 170 ;;; counsel.el ends here