X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/438e51d8ae7cd9ab5b107151ca863e7cabb8ce41..50f309204d51d7e8bf3a4910854ccdf23cece49f:/counsel.el diff --git a/counsel.el b/counsel.el index dec621aa0..53da88935 100644 --- a/counsel.el +++ b/counsel.el @@ -4,7 +4,6 @@ ;; Author: Oleh Krehel ;; URL: https://github.com/abo-abo/swiper -;; Version: 0.1.0 ;; Package-Requires: ((emacs "24.1") (swiper "0.4.0")) ;; Keywords: completion, matching @@ -33,13 +32,144 @@ ;;; Code: (require 'swiper) +(require 'etags) -(defvar counsel-completion-beg nil - "Completion bounds start.") +;;* Utility +(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-unquote-regex-parens (str) + (replace-regexp-in-string + "\\\\)" ")" + (replace-regexp-in-string + "\\\\(" "(" + str))) + +(defun counsel-directory-parent (dir) + "Return the directory parent of directory DIR." + (concat (file-name-nondirectory + (directory-file-name dir)) "/")) -(defvar counsel-completion-end nil - "Completion bounds end.") +(defun counsel-string-compose (prefix str) + "Make PREFIX the display prefix of STR though text properties." + (let ((str (copy-sequence str))) + (put-text-property + 0 1 'display + (concat prefix (substring str 0 1)) + str) + str)) + +;;* Async Utility +(defvar counsel--async-time nil + "Store the time when a new process was started. +Or the time of the last minibuffer update.") + +(defvar counsel--async-exit-code-plist nil + "Associates exit codes with reasons.") + +(defun counsel-set-async-exit-code (cmd number str) + "For CMD, associate NUMBER exit code with STR." + (let ((plist (plist-get counsel--async-exit-code-plist cmd))) + (setq counsel--async-exit-code-plist + (plist-put + counsel--async-exit-code-plist + cmd + (plist-put plist number str))))) + +(defvar counsel-async-split-string-re "\n" + "Store the regexp for splitting shell command output.") + +(defun counsel--async-command (cmd &optional process-sentinel process-filter) + (let* ((counsel--process " *counsel*") + (proc (get-process counsel--process)) + (buff (get-buffer counsel--process))) + (when proc + (delete-process proc)) + (when buff + (kill-buffer buff)) + (setq proc (start-process-shell-command + counsel--process + counsel--process + cmd)) + (setq counsel--async-time (current-time)) + (set-process-sentinel proc (or process-sentinel #'counsel--async-sentinel)) + (set-process-filter proc (or process-filter #'counsel--async-filter)))) +(defun counsel--async-sentinel (process event) + (let ((cands + (cond ((string= event "finished\n") + (with-current-buffer (process-buffer process) + (split-string + (buffer-string) + counsel-async-split-string-re + t))) + ((string-match "exited abnormally with code \\([0-9]+\\)\n" event) + (let* ((exit-code-plist (plist-get counsel--async-exit-code-plist + (ivy-state-caller ivy-last))) + (exit-num (read (match-string 1 event))) + (exit-code (plist-get exit-code-plist exit-num))) + (list + (or exit-code + (format "error code %d" exit-num)))))))) + (cond ((string= event "finished\n") + (ivy--set-candidates + (ivy--sort-maybe + cands)) + (if (null ivy--old-cands) + (setq ivy--index + (or (ivy--preselect-index + (ivy-state-preselect ivy-last) + ivy--all-candidates) + 0)) + (let ((re (funcall ivy--regex-function ivy-text))) + (unless (stringp re) + (setq re (caar re))) + (ivy--recompute-index + ivy-text re ivy--all-candidates))) + (setq ivy--old-cands ivy--all-candidates) + (if (null ivy--all-candidates) + (ivy--insert-minibuffer "") + (ivy--exhibit))) + ((string-match "exited abnormally with code \\([0-9]+\\)\n" event) + (setq ivy--all-candidates cands) + (setq ivy--old-cands ivy--all-candidates) + (ivy--exhibit))))) + +(defun counsel--async-filter (process str) + "Receive from PROCESS the output STR. +Update the minibuffer with the amount of lines collected every +0.5 seconds since the last update." + (with-current-buffer (process-buffer process) + (insert str)) + (let (size) + (when (time-less-p + ;; 0.5s + '(0 0 500000 0) + (time-since counsel--async-time)) + (with-current-buffer (process-buffer process) + (goto-char (point-min)) + (setq size (- (buffer-size) (forward-line (buffer-size)))) + (ivy--set-candidates + (split-string + (buffer-string) + counsel-async-split-string-re + t))) + (let ((ivy--prompt (format + (concat "%d++ " (ivy-state-prompt ivy-last)) + size))) + (ivy--insert-minibuffer + (ivy--format ivy--all-candidates))) + (setq counsel--async-time (current-time))))) + +(defun counsel-delete-process () + (let ((process (get-process " *counsel*"))) + (when process + (delete-process process)))) + +;;* Completion at point +;;** `counsel-el' ;;;###autoload (defun counsel-el () "Elisp completion at point." @@ -58,12 +188,12 @@ symbol-names) (if bnd (progn - (setq counsel-completion-beg + (setq ivy-completion-beg (move-marker (make-marker) (car bnd))) - (setq counsel-completion-end + (setq ivy-completion-end (move-marker (make-marker) (cdr bnd)))) - (setq counsel-completion-beg nil) - (setq counsel-completion-end nil)) + (setq ivy-completion-beg nil) + (setq ivy-completion-end nil)) (if (string= str "") (mapatoms (lambda (x) @@ -79,34 +209,26 @@ (ivy-read "Symbol name: " symbol-names :predicate (and funp #'functionp) :initial-input str - :action #'counsel--el-action))) + :action #'ivy-completion-in-region-action))) + +;;** `counsel-cl' +(declare-function slime-symbol-start-pos "ext:slime") +(declare-function slime-symbol-end-pos "ext:slime") +(declare-function slime-contextual-completions "ext:slime-c-p-c") ;;;###autoload (defun counsel-cl () "Common Lisp completion at point." (interactive) - (setq counsel-completion-beg (slime-symbol-start-pos)) - (setq counsel-completion-end (slime-symbol-end-pos)) + (setq ivy-completion-beg (slime-symbol-start-pos)) + (setq ivy-completion-end (slime-symbol-end-pos)) (ivy-read "Symbol name: " (car (slime-contextual-completions - counsel-completion-beg - counsel-completion-end)) - :action #'counsel--el-action)) - -(defun counsel--el-action (symbol) - "Insert SYMBOL, erasing the previous one." - (when (stringp symbol) - (with-ivy-window - (when counsel-completion-beg - (delete-region - counsel-completion-beg - counsel-completion-end)) - (setq counsel-completion-beg - (move-marker (make-marker) (point))) - (insert symbol) - (setq counsel-completion-end - (move-marker (make-marker) (point)))))) + ivy-completion-beg + ivy-completion-end)) + :action #'ivy-completion-in-region-action)) +;;** `counsel-jedi' (declare-function deferred:sync! "ext:deferred") (declare-function jedi:complete-request "ext:jedi-core") (declare-function jedi:ac-direct-matches "ext:jedi") @@ -117,12 +239,12 @@ (let ((bnd (bounds-of-thing-at-point 'symbol))) (if bnd (progn - (setq counsel-completion-beg (car bnd)) - (setq counsel-completion-end (cdr bnd))) - (setq counsel-completion-beg nil) - (setq counsel-completion-end nil))) + (setq ivy-completion-beg (car bnd)) + (setq ivy-completion-end (cdr bnd))) + (setq ivy-completion-beg nil) + (setq ivy-completion-end nil))) (deferred:sync! - (jedi:complete-request)) + (jedi:complete-request)) (ivy-read "Symbol name: " (jedi:ac-direct-matches) :action #'counsel--py-action)) @@ -130,68 +252,127 @@ "Insert SYMBOL, erasing the previous one." (when (stringp symbol) (with-ivy-window - (when counsel-completion-beg + (when ivy-completion-beg (delete-region - counsel-completion-beg - counsel-completion-end)) - (setq counsel-completion-beg + ivy-completion-beg + ivy-completion-end)) + (setq ivy-completion-beg (move-marker (make-marker) (point))) (insert symbol) - (setq counsel-completion-end + (setq ivy-completion-end (move-marker (make-marker) (point))) (when (equal (get-text-property 0 'symbol symbol) "f") (insert "()") - (setq counsel-completion-end + (setq ivy-completion-end (move-marker (make-marker) (point))) (backward-char 1))))) +;;** `counsel-clj' +(declare-function cider-sync-request:complete "ext:cider-client") +(defun counsel--generic (completion-fn) + "Complete thing at point with COMPLETION-FN." + (let* ((bnd (or (bounds-of-thing-at-point 'symbol) + (cons (point) (point)))) + (str (buffer-substring-no-properties + (car bnd) (cdr bnd))) + (candidates (funcall completion-fn str)) + (ivy-height 7) + (res (ivy-read (format "pattern (%s): " str) + candidates))) + (when (stringp res) + (when bnd + (delete-region (car bnd) (cdr bnd))) + (insert res)))) + +;;;###autoload +(defun counsel-clj () + "Clojure completion at point." + (interactive) + (counsel--generic + (lambda (str) + (mapcar + #'cl-caddr + (cider-sync-request:complete str ":same"))))) + +;;** `counsel-unicode-char' +(defvar counsel-unicode-char-history nil + "History for `counsel-unicode-char'.") + +;;;###autoload +(defun counsel-unicode-char () + "Insert a Unicode character at point." + (interactive) + (let ((minibuffer-allow-text-properties t)) + (setq ivy-completion-beg (point)) + (setq ivy-completion-end (point)) + (ivy-read "Unicode name: " + (mapcar (lambda (x) + (propertize + (format "% -6X% -60s%c" (cdr x) (car x) (cdr x)) + 'result (cdr x))) + (ucs-names)) + :action (lambda (char) + (with-ivy-window + (delete-region ivy-completion-beg ivy-completion-end) + (setq ivy-completion-beg (point)) + (insert-char (get-text-property 0 'result char)) + (setq ivy-completion-end (point)))) + :history 'counsel-unicode-char-history))) + +;;* Elisp symbols +;;** `counsel-describe-variable' (defvar counsel-describe-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-.") #'counsel-find-symbol) (define-key map (kbd "C-,") #'counsel--info-lookup-symbol) map)) +(ivy-set-actions + 'counsel-describe-variable + '(("i" counsel-info-lookup-symbol "info") + ("d" counsel--find-symbol "definition"))) + +(defvar counsel-describe-symbol-history nil + "History for `counsel-describe-variable' and `counsel-describe-function'.") + (defun counsel-find-symbol () "Jump to the definition of the current symbol." (interactive) - (ivy-set-action #'counsel--find-symbol) - (ivy-done)) + (ivy-exit-with-action #'counsel--find-symbol)) (defun counsel--info-lookup-symbol () "Lookup the current symbol in the info docs." (interactive) - (ivy-set-action #'counsel-info-lookup-symbol) - (ivy-done)) + (ivy-exit-with-action #'counsel-info-lookup-symbol)) (defun counsel--find-symbol (x) "Find symbol definition that corresponds to string X." - (let ((full-name (get-text-property 0 'full-name x))) - (if full-name - (find-library full-name) - (let ((sym (read x))) - (cond ((boundp sym) - (find-variable sym)) - ((fboundp sym) - (find-function 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'.") - -(defun counsel-symbol-at-point () - "Return current symbol at point as a string." - (let ((s (thing-at-point 'symbol))) - (and (stringp s) - (if (string-match "\\`[`']?\\(.*?\\)'?\\'" s) - (match-string 1 s) - s)))) + (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)))))))) + +(define-obsolete-function-alias 'counsel-symbol-at-point + 'ivy-thing-at-point "0.7.0") (defun counsel-variable-list () "Return the list of all currently bound variables." @@ -212,19 +393,16 @@ "Describe variable: " (counsel-variable-list) :keymap counsel-describe-map - :preselect (counsel-symbol-at-point) + :preselect (ivy-thing-at-point) :history 'counsel-describe-symbol-history :require-match t :sort t :action (lambda (x) (describe-variable - (intern x)))))) - -(ivy-set-actions - 'counsel-describe-variable - '(("i" counsel-info-lookup-symbol "info") - ("d" counsel--find-symbol "definition"))) + (intern x))) + :caller 'counsel-describe-variable))) +;;** `counsel-describe-function' (ivy-set-actions 'counsel-describe-function '(("i" counsel-info-lookup-symbol "info") @@ -243,14 +421,16 @@ (push (symbol-name x) cands)))) cands) :keymap counsel-describe-map - :preselect (counsel-symbol-at-point) + :preselect (ivy-thing-at-point) :history 'counsel-describe-symbol-history :require-match t :sort t :action (lambda (x) (describe-function - (intern x)))))) + (intern x))) + :caller 'counsel-describe-function))) +;;** `counsel-info-lookup-symbol' (defvar info-lookup-mode) (declare-function info-lookup->completions "info-look") (declare-function info-lookup->mode-value "info-look") @@ -281,45 +461,257 @@ (require 'info-look) (info-lookup 'symbol symbol mode)) +;;** `counsel-M-x' +(ivy-set-actions + 'counsel-M-x + '(("d" counsel--find-symbol "definition"))) + +(ivy-set-display-transformer + 'counsel-M-x + 'counsel-M-x-transformer) + +(defun counsel-M-x-transformer (cmd) + "Return CMD appended with the corresponding binding in the current window." + (let ((binding (substitute-command-keys (format "\\[%s]" cmd)))) + (setq binding (replace-regexp-in-string "C-x 6" "" binding)) + (if (string-match "^M-x" binding) + cmd + (format "%s (%s)" + cmd (propertize binding 'face 'font-lock-keyword-face))))) + +(defvar smex-initialized-p) +(defvar smex-ido-cache) +(declare-function smex-initialize "ext:smex") +(declare-function smex-detect-new-commands "ext:smex") +(declare-function smex-update "ext:smex") +(declare-function smex-rank "ext:smex") + +(defun counsel--M-x-prompt () + "M-x plus the string representation of `current-prefix-arg'." + (if (not current-prefix-arg) + "M-x " + (concat + (if (eq current-prefix-arg '-) + "- " + (if (integerp current-prefix-arg) + (format "%d " current-prefix-arg) + (if (= (car current-prefix-arg) 4) + "C-u " + (format "%d " (car current-prefix-arg))))) + "M-x "))) + ;;;###autoload -(defun counsel-unicode-char () - "Insert a Unicode character at point." +(defun counsel-M-x (&optional initial-input) + "Ivy version of `execute-extended-command'. +Optional INITIAL-INPUT is the initial input in the minibuffer." (interactive) - (let ((minibuffer-allow-text-properties t)) - (ivy-read "Unicode name: " - (mapcar (lambda (x) - (propertize - (format "% -60s%c" (car x) (cdr x)) - 'result (cdr x))) - (ucs-names)) - :action (lambda (char) - (insert-char (get-text-property 0 'result char)))))) + (unless initial-input + (setq initial-input (cdr (assoc this-command + ivy-initial-inputs-alist)))) + (let* ((cands obarray) + (pred 'commandp) + (sort t)) + (when (require 'smex nil 'noerror) + (unless smex-initialized-p + (smex-initialize)) + (smex-detect-new-commands) + (smex-update) + (setq cands smex-ido-cache) + (setq pred nil) + (setq sort nil)) + (ivy-read (counsel--M-x-prompt) cands + :predicate pred + :require-match t + :history 'extended-command-history + :action + (lambda (cmd) + (when (featurep 'smex) + (smex-rank (intern cmd))) + (let ((prefix-arg current-prefix-arg) + (this-command (intern cmd))) + (command-execute (intern cmd) 'record))) + :sort sort + :keymap counsel-describe-map + :initial-input initial-input + :caller 'counsel-M-x))) -(declare-function cider-sync-request:complete "ext:cider-client") +;;** `counsel-load-library' ;;;###autoload -(defun counsel-clj () - "Clojure completion at point." +(defun counsel-load-library () + "Load a selected the Emacs Lisp library. +The libraries are offered from `load-path'." (interactive) - (counsel--generic - (lambda (str) - (mapcar - #'cl-caddr - (cider-sync-request:complete str ":same"))))) + (let ((dirs load-path) + (suffix (concat (regexp-opt '(".el" ".el.gz") t) "\\'")) + (cands (make-hash-table :test #'equal)) + short-name + old-val + dir-parent + res) + (dolist (dir dirs) + (when (file-directory-p dir) + (dolist (file (file-name-all-completions "" dir)) + (when (string-match suffix file) + (unless (string-match "pkg.elc?$" file) + (setq short-name (substring file 0 (match-beginning 0))) + (if (setq old-val (gethash short-name cands)) + (progn + ;; assume going up directory once will resolve name clash + (setq dir-parent (counsel-directory-parent (cdr old-val))) + (puthash short-name + (cons + (counsel-string-compose dir-parent (car old-val)) + (cdr old-val)) + cands) + (setq dir-parent (counsel-directory-parent dir)) + (puthash (concat dir-parent short-name) + (cons + (propertize + (counsel-string-compose + dir-parent short-name) + 'full-name (expand-file-name file dir)) + dir) + cands)) + (puthash short-name + (cons (propertize + short-name + 'full-name (expand-file-name file dir)) + dir) cands))))))) + (maphash (lambda (_k v) (push (car v) res)) cands) + (ivy-read "Load library: " (nreverse res) + :action (lambda (x) + (load-library + (get-text-property 0 'full-name x))) + :keymap counsel-describe-map))) + +;;** `counsel-load-theme' +(declare-function powerline-reset "ext:powerline") + +(defun counsel-load-theme-action (x) + "Disable current themes and load theme X." + (condition-case nil + (progn + (mapc #'disable-theme custom-enabled-themes) + (load-theme (intern x)) + (when (fboundp 'powerline-reset) + (powerline-reset))) + (error "Problem loading theme %s" x))) + +;;;###autoload +(defun counsel-load-theme () + "Forward to `load-theme'. +Usable with `ivy-resume', `ivy-next-line-and-call' and +`ivy-previous-line-and-call'." + (interactive) + (ivy-read "Load custom theme: " + (mapcar 'symbol-name + (custom-available-themes)) + :action #'counsel-load-theme-action + :caller 'counsel-load-theme)) + +;;** `counsel-descbinds' +(ivy-set-actions + 'counsel-descbinds + '(("d" counsel-descbinds-action-find "definition") + ("i" counsel-descbinds-action-info "info"))) + +(defvar counsel-descbinds-history nil + "History for `counsel-descbinds'.") + +(defun counsel--descbinds-cands () + (let ((buffer (current-buffer)) + (re-exclude (regexp-opt + '("" "" "" + "" "" "" + "" "" + "" ""))) + 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))) + +(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 + :history 'counsel-descbinds-history + :caller 'counsel-descbinds)) +;;* Git +;;** `counsel-git' +(defvar counsel--git-dir nil + "Store the base git directory.") ;;;###autoload (defun counsel-git () "Find file in the current Git repository." (interactive) - (let* ((default-directory (locate-dominating-file - default-directory ".git")) + (setq counsel--git-dir (expand-file-name + (locate-dominating-file + default-directory ".git"))) + (let* ((default-directory counsel--git-dir) (cands (split-string (shell-command-to-string "git ls-files --full-name --") "\n" - t)) - (action (lambda (x) (find-file x)))) + t))) (ivy-read "Find file: " cands - :action action))) + :action #'counsel-git-action))) + +(defun counsel-git-action (x) + (with-ivy-window + (let ((default-directory counsel--git-dir)) + (find-file x)))) + +;;** `counsel-git-grep' +(defvar counsel-git-grep-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-l") 'counsel-git-grep-recenter) + (define-key map (kbd "M-q") 'counsel-git-grep-query-replace) + (define-key map (kbd "C-c C-m") 'counsel-git-grep-switch-cmd) + map)) + +(ivy-set-occur 'counsel-git-grep 'counsel-git-grep-occur) +(ivy-set-display-transformer 'counsel-git-grep 'counsel-git-grep-transformer) + +(defvar counsel-git-grep-cmd "git --no-pager grep --full-name -n --no-color -i -e %S" + "Store the command for `counsel-git-grep'.") (defvar counsel--git-grep-dir nil "Store the base git directory.") @@ -327,10 +719,12 @@ (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))))) +(defvar counsel-git-grep-history nil + "History for `counsel-git-grep'.") + +(defvar counsel-git-grep-cmd-history + '("git --no-pager grep --full-name -n --no-color -i -e %S") + "History for `counsel-git-grep' shell commands.") (defun counsel-git-grep-function (string &optional _pred &rest _unused) "Grep in the current git repository for STRING." @@ -338,24 +732,13 @@ (< (length string) 3)) (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" + (cmd (format counsel-git-grep-cmd (setq ivy--old-re (ivy--regex string t))))) (if (<= counsel--git-grep-count 20000) (split-string (shell-command-to-string cmd) "\n" t) (counsel--gg-candidates (ivy--regex string)) nil)))) -(defvar counsel-git-grep-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-l") 'counsel-git-grep-recenter) - map)) - -(defun counsel-git-grep-recenter () - (interactive) - (with-ivy-window - (counsel-git-grep-action ivy--current) - (recenter-top-bottom))) - (defun counsel-git-grep-action (x) (when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" x) (with-ivy-window @@ -369,76 +752,6 @@ (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. -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 "git grep: " 'counsel-git-grep-function - :initial-input initial-input - :matcher #'counsel-git-grep-matcher - :dynamic-collection (> counsel--git-grep-count 20000) - :keymap counsel-git-grep-map - :action #'counsel-git-grep-action - :unwind #'swiper--cleanup - :history 'counsel-git-grep-history))) - -(defcustom counsel-find-file-at-point nil - "When non-nil, add file-at-point to the list of candidates." - :type 'boolean - :group 'ivy) - -(declare-function ffap-guesser "ffap") - -(defvar counsel-find-file-map (make-sparse-keymap)) - -;;;###autoload -(defun counsel-find-file () - "Forward to `find-file'." - (interactive) - (ivy-read "Find file: " 'read-file-name-internal - :matcher #'counsel--find-file-matcher - :action - (lambda (x) - (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 - :keymap counsel-find-file-map)) - -(defcustom counsel-find-file-ignore-regexp nil - "A regexp of files to ignore while in `counsel-find-file'. -These files are un-ignored if `ivy-text' matches them. -The common way to show all files is to start `ivy-text' with a dot. -Possible value: \"\\(?:\\`[#.]\\)\\|\\(?:[#~]\\'\\)\"." - :group 'ivy) - -(defun counsel--find-file-matcher (regexp candidates) - "Return REGEXP-matching CANDIDATES. -Skip some dotfiles unless `ivy-text' requires them." - (let ((res (cl-remove-if-not - (lambda (x) - (string-match regexp x)) - candidates))) - (if (or (null counsel-find-file-ignore-regexp) - (string-match counsel-find-file-ignore-regexp ivy-text)) - res - (cl-remove-if - (lambda (x) - (string-match counsel-find-file-ignore-regexp x)) - res)))) - (defun counsel-git-grep-matcher (regexp candidates) (or (and (equal regexp ivy--old-re) ivy--old-cands) @@ -463,171 +776,63 @@ Skip some dotfiles unless `ivy-text' requires them." candidates)) (setq ivy--old-re regexp)))) -(defun counsel--async-command (cmd) - (let* ((counsel--process " *counsel*") - (proc (get-process counsel--process)) - (buff (get-buffer counsel--process))) - (when proc - (delete-process proc)) - (when buff - (kill-buffer buff)) - (setq proc (start-process-shell-command - counsel--process - counsel--process - cmd)) - (set-process-sentinel proc #'counsel--async-sentinel))) - -(defun counsel--async-sentinel (process event) - (if (string= event "finished\n") - (progn - (with-current-buffer (process-buffer process) - (setq ivy--all-candidates - (ivy--sort-maybe - (split-string (buffer-string) "\n" t))) - (setq ivy--old-cands ivy--all-candidates)) - (ivy--exhibit)) - (if (string= event "exited abnormally with code 1\n") - (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 "%s %s" - (if (eq system-type 'darwin) - "open" - "xdg-open") - (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'.") - -(defcustom counsel-locate-options (if (eq system-type 'darwin) - '("-i") - '("-i" "--regex")) - "Command line options for `locate`." - :group 'ivy - :type '(repeat string)) - -(ivy-set-actions - 'counsel-locate - '(("x" counsel-locate-action-extern "xdg-open") - ("d" counsel-locate-action-dired "dired"))) - -(defun counsel-unquote-regex-parens (str) - (replace-regexp-in-string - "\\\\)" ")" - (replace-regexp-in-string - "\\\\(" "(" - str))) - -(defun counsel-locate-function (str &rest _u) - (if (< (length str) 3) - (counsel-more-chars 3) - (counsel--async-command - (format "locate %s '%s'" - (mapconcat #'identity counsel-locate-options " ") - (counsel-unquote-regex-parens - (ivy--regex str)))) - '("" "working..."))) +(defun counsel-git-grep-transformer (str) + "Higlight file and line number in STR." + (when (string-match "\\`\\([^:]+\\):\\([^:]+\\):" str) + (set-text-properties (match-beginning 1) + (match-end 1) + '(face compilation-info) + str) + (set-text-properties (match-beginning 2) + (match-end 2) + '(face compilation-line-number) + str)) + str) ;;;###autoload -(defun counsel-locate () - "Call locate shell command." - (interactive) - (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." - (let* ((bnd (bounds-of-thing-at-point 'symbol)) - (str (if bnd - (buffer-substring-no-properties - (car bnd) (cdr bnd)) - "")) - (candidates (funcall completion-fn str)) - (ivy-height 7) - (res (ivy-read (format "pattern (%s): " str) - candidates))) - (when (stringp res) - (when bnd - (delete-region (car bnd) (cdr bnd))) - (insert res)))) - -(defun counsel-directory-parent (dir) - "Return the directory parent of directory DIR." - (concat (file-name-nondirectory - (directory-file-name dir)) "/")) - -(defun counsel-string-compose (prefix str) - "Make PREFIX the display prefix of STR though text properties." - (let ((str (copy-sequence str))) - (put-text-property - 0 1 'display - (concat prefix (substring str 0 1)) - str) - str)) +(defun counsel-git-grep (&optional cmd initial-input) + "Grep for a string in the current git repository. +When CMD is a string, use it as a \"git grep\" command. +When CMD is non-nil, prompt for a specific \"git grep\" command. +INITIAL-INPUT can be given as the initial minibuffer input." + (interactive "P") + (cond + ((stringp cmd) + (setq counsel-git-grep-cmd cmd)) + (cmd + (setq counsel-git-grep-cmd + (ivy-read "cmd: " counsel-git-grep-cmd-history + :history 'counsel-git-grep-cmd-history)) + (setq counsel-git-grep-cmd-history + (delete-dups counsel-git-grep-cmd-history))) + (t + (setq counsel-git-grep-cmd "git --no-pager grep --full-name -n --no-color -i -e %S"))) + (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 "git grep: " 'counsel-git-grep-function + :initial-input initial-input + :matcher #'counsel-git-grep-matcher + :dynamic-collection (> counsel--git-grep-count 20000) + :keymap counsel-git-grep-map + :action #'counsel-git-grep-action + :unwind #'swiper--cleanup + :history 'counsel-git-grep-history + :caller 'counsel-git-grep))) -;;;###autoload -(defun counsel-load-library () - "Load a selected the Emacs Lisp library. -The libraries are offered from `load-path'." +(defun counsel-git-grep-switch-cmd () + "Set `counsel-git-grep-cmd' to a different value." (interactive) - (let ((dirs load-path) - (suffix (concat (regexp-opt '(".el" ".el.gz") t) "\\'")) - (cands (make-hash-table :test #'equal)) - short-name - old-val - dir-parent - res) - (dolist (dir dirs) - (when (file-directory-p dir) - (dolist (file (file-name-all-completions "" dir)) - (when (string-match suffix file) - (unless (string-match "pkg.elc?$" file) - (setq short-name (substring file 0 (match-beginning 0))) - (if (setq old-val (gethash short-name cands)) - (progn - ;; assume going up directory once will resolve name clash - (setq dir-parent (counsel-directory-parent (cdr old-val))) - (puthash short-name - (cons - (counsel-string-compose dir-parent (car old-val)) - (cdr old-val)) - cands) - (setq dir-parent (counsel-directory-parent dir)) - (puthash (concat dir-parent short-name) - (cons - (propertize - (counsel-string-compose - dir-parent short-name) - 'full-name (expand-file-name file dir)) - dir) - cands)) - (puthash short-name - (cons (propertize - short-name - 'full-name (expand-file-name file dir)) - dir) cands))))))) - (maphash (lambda (_k v) (push (car v) res)) cands) - (ivy-read "Load library: " (nreverse res) - :action (lambda (x) - (load-library - (get-text-property 0 'full-name x))) - :keymap counsel-describe-map))) + (setq counsel-git-grep-cmd + (ivy-read "cmd: " counsel-git-grep-cmd-history + :history 'counsel-git-grep-cmd-history)) + (setq counsel-git-grep-cmd-history + (delete-dups counsel-git-grep-cmd-history)) + (unless (ivy-state-dynamic-collection ivy-last) + (setq ivy--all-candidates + (all-completions "" 'counsel-git-grep-function)))) (defvar counsel-gg-state nil "The current state of candidates / count sync.") @@ -647,8 +852,9 @@ The libraries are offered from `load-path'." (setq proc (start-process-shell-command counsel-gg-process counsel-gg-process - (format "git --no-pager grep --full-name -n --no-color -i -e %S | head -n 200" - regex))) + (concat + (format counsel-git-grep-cmd regex) + " | head -n 200"))) (set-process-sentinel proc #'counsel--gg-sentinel))) @@ -657,7 +863,9 @@ The libraries are offered from `load-path'." (if (string= event "finished\n") (progn (with-current-buffer (process-buffer process) - (setq ivy--all-candidates (split-string (buffer-string) "\n" t)) + (setq ivy--all-candidates + (or (split-string (buffer-string) "\n" t) + '(""))) (setq ivy--old-cands ivy--all-candidates)) (when (= 0 (cl-incf counsel-gg-state)) (ivy--exhibit))) @@ -671,8 +879,17 @@ The libraries are offered from `load-path'." "Quickly and asynchronously count the amount of git grep REGEX matches. When NO-ASYNC is non-nil, do it synchronously." (let ((default-directory counsel--git-grep-dir) - (cmd (format "git grep -i -c '%s' | sed 's/.*:\\(.*\\)/\\1/g' | awk '{s+=$1} END {print s}'" - regex)) + (cmd + (concat + (format + (replace-regexp-in-string + "--full-name" "-c" + counsel-git-grep-cmd) + ;; "git grep -i -c '%s'" + (replace-regexp-in-string + "-" "\\\\-" + (replace-regexp-in-string "'" "''" regex))) + " | sed 's/.*:\\(.*\\)/\\1/g' | awk '{s+=$1} END {print s}'")) (counsel-ggc-process " *counsel-gg-count*")) (if no-async (string-to-number (shell-command-to-string cmd)) @@ -695,124 +912,434 @@ When NO-ASYNC is non-nil, do it synchronously." (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. -CMD is a command name." - (let ((binding (substitute-command-keys (format "\\[%s]" cmd)))) - (setq binding (replace-regexp-in-string "C-x 6" "" binding)) - (if (string-match "^M-x" binding) - cmd - (format "%s (%s)" cmd - (propertize binding 'face 'font-lock-keyword-face))))) +(defun counsel-git-grep-occur () + "Generate a custom occur buffer for `counsel-git-grep'." + (ivy-occur-grep-mode) + (setq default-directory counsel--git-grep-dir) + (let ((cands (split-string + (shell-command-to-string + (format counsel-git-grep-cmd + (setq ivy--old-re (ivy--regex ivy-text t)))) + "\n" + t))) + ;; Need precise number of header lines for `wgrep' to work. + (insert (format "-*- mode:grep; default-directory: %S -*-\n\n\n" + default-directory)) + (insert (format "%d candidates:\n" (length cands))) + (ivy--occur-insert-lines + (mapcar + (lambda (cand) (concat "./" cand)) + cands)))) + +(defun counsel-git-grep-query-replace () + "Start `query-replace' with string to replace from last search string." + (interactive) + (if (null (window-minibuffer-p)) + (user-error + "Should only be called in the minibuffer through `counsel-git-grep-map'") + (let* ((enable-recursive-minibuffers t) + (from (ivy--regex ivy-text)) + (to (query-replace-read-to from "Query replace" t))) + (ivy-exit-with-action + (lambda (_) + (let (done-buffers) + (dolist (cand ivy--old-cands) + (when (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" cand) + (with-ivy-window + (let ((file-name (match-string-no-properties 1 cand))) + (setq file-name (expand-file-name file-name counsel--git-grep-dir)) + (unless (member file-name done-buffers) + (push file-name done-buffers) + (find-file file-name) + (goto-char (point-min))) + (perform-replace from to t t nil))))))))))) + +(defun counsel-git-grep-recenter () + (interactive) + (with-ivy-window + (counsel-git-grep-action ivy--current) + (recenter-top-bottom))) + +;;** `counsel-git-stash' +(defun counsel-git-stash-kill-action (x) + (when (string-match "\\([^:]+\\):" x) + (kill-new (message (format "git stash apply %s" (match-string 1 x)))))) + +;;;###autoload +(defun counsel-git-stash () + "Search through all available git stashes." + (interactive) + (let ((dir (locate-dominating-file default-directory ".git"))) + (if (null dir) + (error "Not in a git repository") + (let ((cands (split-string (shell-command-to-string + "IFS=$'\n' +for i in `git stash list --format=\"%gd\"`; do + git stash show -p $i | grep -H --label=\"$i\" \"$1\" +done") "\n" t))) + (ivy-read "git stash: " cands + :action 'counsel-git-stash-kill-action + :caller 'counsel-git-stash))))) +;;** `counsel-git-log' +(defun counsel-git-log-function (input) + (if (< (length input) 3) + (counsel-more-chars 3) + ;; `counsel--yank-pop-format-function' uses this + (setq ivy--old-re (funcall ivy--regex-function input)) + (counsel--async-command + ;; "git log --grep" likes to have groups quoted e.g. \(foo\). + ;; But it doesn't like the non-greedy ".*?". + (format "GIT_PAGER=cat git log --grep '%s'" + (replace-regexp-in-string + "\\.\\*\\?" ".*" + ivy--old-re))) + nil)) + +(defun counsel-git-log-action (x) + (message "%S" (kill-new x))) + +(defcustom counsel-yank-pop-truncate-radius 2 + "When non-nil, truncate the display of long strings." + :type 'integer + :group 'ivy) + +;;;###autoload +(defun counsel-git-log () + "Call the \"git log --grep\" shell command." + (interactive) + (let ((counsel-async-split-string-re "\ncommit ") + (counsel-yank-pop-truncate-radius 5) + (ivy-format-function #'counsel--yank-pop-format-function) + (ivy-height 4)) + (ivy-read "Grep log: " #'counsel-git-log-function + :dynamic-collection t + :action #'counsel-git-log-action + :unwind #'counsel-delete-process + :caller 'counsel-git-log))) + +;;* File +;;** `counsel-find-file' +(defvar counsel-find-file-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-DEL") 'counsel-up-directory) + (define-key map (kbd "C-") 'counsel-up-directory) + map)) + +(add-to-list 'ivy-ffap-url-functions 'counsel-github-url-p) +(add-to-list 'ivy-ffap-url-functions 'counsel-emacs-url-p) + +(defcustom counsel-find-file-at-point nil + "When non-nil, add file-at-point to the list of candidates." + :type 'boolean + :group 'ivy) + +(defcustom counsel-find-file-ignore-regexp nil + "A regexp of files to ignore while in `counsel-find-file'. +These files are un-ignored if `ivy-text' matches them. The +common way to show all files is to start `ivy-text' with a dot. + +Example value: \"\\(?:\\`[#.]\\)\\|\\(?:[#~]\\'\\)\". This will hide +temporary and lock files. +\\ +Choosing the dotfiles option, \"\\`\\.\", might be convenient, +since you can still access the dotfiles if your input starts with +a dot. The generic way to toggle ignored files is \\[ivy-toggle-ignore], +but the leading dot is a lot faster." + :group 'ivy + :type '(choice + (const :tag "None" nil) + (const :tag "Dotfiles" "\\`\\.") + (regexp :tag "Regex"))) + +(defun counsel--find-file-matcher (regexp candidates) + "Return REGEXP-matching CANDIDATES. +Skip some dotfiles unless `ivy-text' requires them." + (let ((res (ivy--re-filter regexp candidates))) + (if (or (null ivy-use-ignore) + (null counsel-find-file-ignore-regexp) + (string-match "\\`\\." ivy-text)) + res + (or (cl-remove-if + (lambda (x) + (and + (string-match counsel-find-file-ignore-regexp x) + (not (member x ivy-extra-directories)))) + res) + res)))) + +(declare-function ffap-guesser "ffap") + +;;;###autoload +(defun counsel-find-file (&optional initial-input) + "Forward to `find-file'. +When INITIAL-INPUT is non-nil, use it in the minibuffer during completion." + (interactive) + (ivy-read "Find file: " 'read-file-name-internal + :matcher #'counsel--find-file-matcher + :initial-input initial-input + :action + (lambda (x) + (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 + :keymap counsel-find-file-map)) + +(defun counsel-up-directory () + "Go to the parent directory preselecting the current one." + (interactive) + (let ((dir-file-name + (directory-file-name (expand-file-name ivy--directory)))) + (ivy--cd (file-name-directory dir-file-name)) + (setf (ivy-state-preselect ivy-last) + (file-name-as-directory (file-name-nondirectory dir-file-name))))) + +(defun counsel-at-git-issue-p () + "Whe point is at an issue in a Git-versioned file, return the issue string." + (and (looking-at "#[0-9]+") + (or + (eq (vc-backend (buffer-file-name)) 'Git) + (memq major-mode '(magit-commit-mode))) + (match-string-no-properties 0))) + +(defun counsel-github-url-p () + "Return a Github issue URL at point." + (let ((url (counsel-at-git-issue-p))) + (when url + (let ((origin (shell-command-to-string + "git remote get-url origin")) + user repo) + (cond ((string-match "\\`git@github.com:\\([^/]+\\)/\\(.*\\)\\.git$" + origin) + (setq user (match-string 1 origin)) + (setq repo (match-string 2 origin))) + ((string-match "\\`https://github.com/\\([^/]+\\)/\\(.*\\)$" + origin) + (setq user (match-string 1 origin)) + (setq repo (match-string 2 origin)))) + (when user + (setq url (format "https://github.com/%s/%s/issues/%s" + user repo (substring url 1)))))))) + +(defun counsel-emacs-url-p () + "Return a Debbugs issue URL at point." + (let ((url (counsel-at-git-issue-p))) + (when url + (let ((origin (shell-command-to-string + "git remote get-url origin"))) + (when (string-match "git.sv.gnu.org:/srv/git/emacs.git" origin) + (format "http://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s" + (substring url 1))))))) + +;;** `counsel-locate' +(defcustom counsel-locate-options nil + "Command line options for `locate`." + :group 'ivy + :type '(repeat string)) + +(make-obsolete-variable 'counsel-locate-options 'counsel-locate-cmd "0.7.0") + +(defcustom counsel-locate-cmd (if (eq system-type 'darwin) + 'counsel-locate-cmd-noregex + 'counsel-locate-cmd-default) + "The function for producing a locate command string from the input. + +The function takes a string - the current input, and returns a +string - the full shell command to run." + :group 'ivy + :type '(choice + (const :tag "Default" counsel-locate-cmd-default) + (const :tag "No regex" counsel-locate-cmd-noregex) + (const :tag "mdfind" counsel-locate-cmd-mdfind))) + +(ivy-set-actions + 'counsel-locate + '(("x" counsel-locate-action-extern "xdg-open") + ("d" counsel-locate-action-dired "dired"))) + +(counsel-set-async-exit-code 'counsel-locate 1 "Nothing found") + +(defvar counsel-locate-history nil + "History for `counsel-locate'.") + +(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 "%s %s" + (if (eq system-type 'darwin) + "open" + "xdg-open") + (shell-quote-argument x)))) + +(declare-function dired-jump "dired-x") -(defvar smex-initialized-p) -(defvar smex-ido-cache) -(declare-function smex-initialize "ext:smex") -(declare-function smex-detect-new-commands "ext:smex") -(declare-function smex-update "ext:smex") -(declare-function smex-rank "ext:smex") -(declare-function package-installed-p "package") +(defun counsel-locate-action-dired (x) + "Use `dired-jump' on X." + (dired-jump nil x)) + +(defun counsel-locate-cmd-default (input) + "Return a shell command based on INPUT." + (format "locate -i --regex '%s'" + (counsel-unquote-regex-parens + (ivy--regex input)))) + +(defun counsel-locate-cmd-noregex (input) + "Return a shell command based on INPUT." + (format "locate -i '%s'" input)) + +(defun counsel-locate-cmd-mdfind (input) + "Return a shell command based on INPUT." + (format "mdfind -name '%s'" input)) + +(defun counsel-locate-function (input) + (if (< (length input) 3) + (counsel-more-chars 3) + (counsel--async-command + (funcall counsel-locate-cmd input)) + '("" "working..."))) ;;;###autoload -(defun counsel-M-x (&optional initial-input) - "Ivy version of `execute-extended-command'. -Optional INITIAL-INPUT is the initial input in the minibuffer." +(defun counsel-locate (&optional initial-input) + "Call the \"locate\" shell command. +INITIAL-INPUT can be given as the initial minibuffer input." (interactive) - (unless initial-input - (setq initial-input (cdr (assoc this-command - ivy-initial-inputs-alist)))) - (let* ((store ivy-format-function) - (ivy-format-function - (lambda (cands) - (funcall - store - (with-ivy-window - (mapcar #'counsel--M-x-transformer cands))))) - (cands obarray) - (pred 'commandp) - (sort t)) - (when (or (featurep 'smex) - (package-installed-p 'smex)) - (require 'smex) - (unless smex-initialized-p - (smex-initialize)) - (smex-detect-new-commands) - (smex-update) - (setq cands smex-ido-cache) - (setq pred nil) - (setq sort nil)) - (ivy-read "M-x " cands - :predicate pred - :require-match t - :history 'extended-command-history - :action - (lambda (cmd) - (when (featurep 'smex) - (smex-rank (intern cmd))) - (let ((prefix-arg current-prefix-arg)) - (command-execute (intern cmd) 'record))) - :sort sort - :keymap counsel-describe-map - :initial-input initial-input))) + (ivy-read "Locate: " #'counsel-locate-function + :initial-input initial-input + :dynamic-collection t + :history 'counsel-locate-history + :action (lambda (file) + (with-ivy-window + (when file + (find-file file)))) + :unwind #'counsel-delete-process + :caller 'counsel-locate)) + +;;* Grep +;;** `counsel-ag' +(defcustom counsel-ag-base-command "ag --vimgrep %s" + "Format string to use in `cousel-ag-function' to construct the +command. %S will be replaced by the regex string. The default is +\"ag --vimgrep %S\"." + :type 'string + :group 'ivy) -(declare-function powerline-reset "ext:powerline") +(counsel-set-async-exit-code 'counsel-ag 1 "No matches found") -(defun counsel--load-theme-action (x) - "Disable current themes and load theme X." - (condition-case nil - (progn - (mapc #'disable-theme custom-enabled-themes) - (load-theme (intern x)) - (when (fboundp 'powerline-reset) - (powerline-reset))) - (error "Problem loading theme %s" x))) +(defun counsel-ag-function (string) + "Grep in the current directory for STRING." + (if (< (length string) 3) + (counsel-more-chars 3) + (let ((default-directory counsel--git-grep-dir) + (regex (counsel-unquote-regex-parens + (setq ivy--old-re + (ivy--regex string))))) + (counsel--async-command + (format counsel-ag-base-command (shell-quote-argument regex))) + nil))) ;;;###autoload -(defun counsel-load-theme () - "Forward to `load-theme'. -Usable with `ivy-resume', `ivy-next-line-and-call' and -`ivy-previous-line-and-call'." +(defun counsel-ag (&optional initial-input initial-directory) + "Grep for a string in the current directory using ag. +INITIAL-INPUT can be given as the initial minibuffer input." (interactive) - (ivy-read "Load custom theme: " - (mapcar 'symbol-name - (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") + (setq counsel--git-grep-dir (or initial-directory 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 (lambda () + (counsel-delete-process) + (swiper--cleanup)) + :caller 'counsel-ag)) -(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)))) +;;** `counsel-grep' +(defun counsel-grep-function (string) + "Grep in the current directory for STRING." + (if (< (length string) 3) + (counsel-more-chars 3) + (let ((regex (counsel-unquote-regex-parens + (setq ivy--old-re + (ivy--regex string))))) + (counsel--async-command + (format "grep -nP --ignore-case '%s' %s" regex counsel--git-grep-dir)) + nil))) -(defvar counsel-rhythmbox-history nil - "History for `counsel-rhythmbox'.") +(defun counsel-grep-action (x) + (when (string-match "\\`\\([0-9]+\\):\\(.*\\)\\'" x) + (with-ivy-window + (let ((file-name counsel--git-grep-dir) + (line-number (match-string-no-properties 1 x))) + (find-file file-name) + (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))))))) ;;;###autoload -(defun counsel-rhythmbox () - "Choose a song from the Rhythmbox library to play or enqueue." +(defun counsel-grep () + "Grep for a string in the current file." (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")))) + (setq counsel--git-grep-dir (buffer-file-name)) + (ivy-read "grep: " 'counsel-grep-function + :dynamic-collection t + :preselect (format "%d:%s" + (line-number-at-pos) + (buffer-substring-no-properties + (line-beginning-position) + (line-end-position))) + :history 'counsel-git-grep-history + :update-fn (lambda () + (counsel-grep-action ivy--current)) + :action #'counsel-grep-action + :unwind (lambda () + (counsel-delete-process) + (swiper--cleanup)) + :caller 'counsel-grep)) +;;** `counsel-recoll' +(defun counsel-recoll-function (string) + "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))))) + :unwind #'counsel-delete-process + :caller 'counsel-recoll)) +;;* Misc Emacs +;;** `counsel-org-tag' (defvar counsel-org-tags nil "Store the current list of tags.") @@ -821,7 +1348,7 @@ Usable with `ivy-resume', `ivy-next-line-and-call' and (defvar org-indent-indentation-per-level) (defvar org-tags-column) (declare-function org-get-tags-string "org") -(declare-function org-move-to-column "org") +(declare-function org-move-to-column "org-compat") (defun counsel-org-change-tags (tags) (let ((current (org-get-tags-string)) @@ -952,7 +1479,8 @@ Usable with `ivy-resume', `ivy-next-line-and-call' and (delete-dups (all-completions str 'org-tags-completion-function))) :history 'org-tags-history - :action 'counsel-org-tag-action)))) + :action 'counsel-org-tag-action + :caller 'counsel-org-tag)))) ;;;###autoload (defun counsel-org-tag-agenda () @@ -966,59 +1494,266 @@ Usable with `ivy-resume', `ivy-next-line-and-call' and (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 (counsel-unquote-regex-parens (ivy--regex string)))) - (counsel--async-command - (format "ag --noheading --nocolor %S" regex)) - nil))) +;;** `counsel-tmm' +(defvar tmm-km-list nil) +(declare-function tmm-get-keymap "tmm") +(declare-function tmm--completion-table "tmm") +(declare-function tmm-get-keybind "tmm") + +(defun counsel-tmm-prompt (menu) + "Select and call an item from the MENU keymap." + (let (out + choice + chosen-string) + (setq tmm-km-list nil) + (map-keymap (lambda (k v) (tmm-get-keymap (cons k v))) menu) + (setq tmm-km-list (nreverse tmm-km-list)) + (setq out (ivy-read "Menu bar: " (tmm--completion-table tmm-km-list) + :require-match t + :sort nil)) + (setq choice (cdr (assoc out tmm-km-list))) + (setq chosen-string (car choice)) + (setq choice (cdr choice)) + (cond ((keymapp choice) + (counsel-tmm-prompt choice)) + ((and choice chosen-string) + (setq last-command-event chosen-string) + (call-interactively choice))))) + +(defvar tmm-table-undef) -(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." +;;;###autoload +(defun counsel-tmm () + "Text-mode emulation of looking and choosing from a menubar." (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)) + (require 'tmm) + (run-hooks 'menu-bar-update-hook) + (setq tmm-table-undef nil) + (counsel-tmm-prompt (tmm-get-keybind [menu-bar]))) -(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)) +;;** `counsel-yank-pop' +(defun counsel--yank-pop-truncate (str) + (condition-case nil + (let* ((lines (split-string str "\n" t)) + (n (length lines)) + (first-match (cl-position-if + (lambda (s) (string-match ivy--old-re s)) + lines)) + (beg (max 0 (- first-match + counsel-yank-pop-truncate-radius))) + (end (min n (+ first-match + counsel-yank-pop-truncate-radius + 1))) + (seq (cl-subseq lines beg end))) + (if (null first-match) + (error "Could not match %s" str) + (when (> beg 0) + (setcar seq (concat "[...] " (car seq)))) + (when (< end n) + (setcar (last seq) + (concat (car (last seq)) " [...]"))) + (mapconcat #'identity seq "\n"))) + (error str))) + +(defun counsel--yank-pop-format-function (cand-pairs) + (ivy--format-function-generic + (lambda (str) + (mapconcat + (lambda (s) + (ivy--add-face s 'ivy-current-match)) + (split-string + (counsel--yank-pop-truncate str) "\n" t) + "\n")) + (lambda (str) + (counsel--yank-pop-truncate str)) + cand-pairs + "\n")) -;; 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." +(defun counsel-yank-pop-action (s) + "Insert S into the buffer, overwriting the previous yank." + (with-ivy-window + (delete-region ivy-completion-beg + ivy-completion-end) + (insert (substring-no-properties s)) + (setq ivy-completion-end (point)))) + +;;;###autoload +(defun counsel-yank-pop () + "Ivy replacement for `yank-pop'." (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))))))) + (if (eq last-command 'yank) + (progn + (setq ivy-completion-end (point)) + (setq ivy-completion-beg + (save-excursion + (search-backward (car kill-ring)) + (point)))) + (setq ivy-completion-beg (point)) + (setq ivy-completion-end (point))) + (let ((candidates (cl-remove-if + (lambda (s) + (or (< (length s) 3) + (string-match "\\`[\n[:blank:]]+\\'" s))) + (delete-dups kill-ring)))) + (let ((ivy-format-function #'counsel--yank-pop-format-function) + (ivy-height 5)) + (ivy-read "kill-ring: " candidates + :action 'counsel-yank-pop-action + :caller 'counsel-yank-pop)))) + +;;** `counsel-imenu' +(defvar imenu-auto-rescan) +(declare-function imenu--subalist-p "imenu") +(declare-function imenu--make-index-alist "imenu") + +(defun counsel-imenu-get-candidates-from (alist &optional prefix) + "Create a list of (key . value) from ALIST. +PREFIX is used to create the key." + (cl-mapcan (lambda (elm) + (if (imenu--subalist-p elm) + (counsel-imenu-get-candidates-from + (cl-loop for (e . v) in (cdr elm) collect + (cons e (if (integerp v) (copy-marker v) v))) + ;; pass the prefix to next recursive call + (concat prefix (if prefix ".") (car elm))) + (let ((key (concat prefix (if prefix ".") (car elm)))) + (list (cons key + ;; create a imenu candidate here + (cons key (if (overlayp (cdr elm)) + (overlay-start (cdr elm)) + (cdr elm)))))))) + alist)) + +;;;###autoload +(defun counsel-imenu () + "Jump to a buffer position indexed by imenu." + (interactive) + (unless (featurep 'imenu) + (require 'imenu nil t)) + (let* ((imenu-auto-rescan t) + (items (imenu--make-index-alist t)) + (items (delete (assoc "*Rescan*" items) items))) + (ivy-read "imenu items:" (counsel-imenu-get-candidates-from items) + :preselect (thing-at-point 'symbol) + :require-match t + :action (lambda (candidate) + (with-ivy-window + ;; In org-mode, (imenu candidate) will expand child node + ;; after jump to the candidate position + (imenu candidate))) + :caller 'counsel-imenu))) + +;;** `counsel-list-processes' +(defun counsel-list-processes-action-delete (x) + (delete-process x) + (setf (ivy-state-collection ivy-last) + (setq ivy--all-candidates + (delete x ivy--all-candidates)))) + +(defun counsel-list-processes-action-switch (x) + (let* ((proc (get-process x)) + (buf (and proc (process-buffer proc)))) + (if buf + (switch-to-buffer x) + (message "Process %s doesn't have a buffer" x)))) + +;;;###autoload +(defun counsel-list-processes () + "Offer completion for `process-list' +The default action deletes the selected process. +An extra action allows to switch to the process buffer." + (interactive) + (list-processes--refresh) + (ivy-read "Process: " (mapcar #'process-name (process-list)) + :require-match t + :action + '(1 + ("o" counsel-list-processes-action-delete "kill") + ("s" counsel-list-processes-action-switch "switch")) + :caller 'counsel-list-processes)) + +;;* Misc OS +;;** `counsel-rhythmbox' +(defvar rhythmbox-library) +(declare-function rhythmbox-load-library "ext:helm-rhythmbox") +(declare-function dbus-call-method "dbus") +(declare-function dbus-get-property "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'.") + +(defun counsel-rhythmbox-current-song () + "Return the currently playing song title." + (ignore-errors + (let* ((entry (dbus-get-property + :session + "org.mpris.MediaPlayer2.rhythmbox" + "/org/mpris/MediaPlayer2" + "org.mpris.MediaPlayer2.Player" + "Metadata")) + (artist (caar (cadr (assoc "xesam:artist" entry)))) + (album (cl-caadr (assoc "xesam:album" entry))) + (title (cl-caadr (assoc "xesam:title" entry)))) + (format "%s - %s - %s" artist album title)))) + +;;;###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 + :preselect (counsel-rhythmbox-current-song) + :action + '(1 + ("p" helm-rhythmbox-play-song "Play song") + ("e" counsel-rhythmbox-enqueue-song "Enqueue song")) + :caller 'counsel-rhythmbox)) + +;;** `counsel-mode' +(defvar counsel-mode-map + (let ((map (make-sparse-keymap))) + (dolist (binding + '((execute-extended-command . counsel-M-x) + (describe-bindings . counsel-descbinds) + (describe-function . counsel-describe-function) + (describe-variable . counsel-describe-variable) + (find-file . counsel-find-file) + (imenu . counsel-imenu) + (load-library . counsel-load-library) + (load-theme . counsel-load-theme) + (yank-pop . counsel-yank-pop))) + (define-key map (vector 'remap (car binding)) (cdr binding))) + map) + "Map for `counsel-mode'. Remaps built-in functions to counsel +replacements.") + +;;;###autoload +(define-minor-mode counsel-mode + "Toggle Counsel mode on or off. +Turn Counsel mode on if ARG is positive, off otherwise. Counsel +mode remaps built-in emacs functions that have counsel +replacements. " + :group 'ivy + :global t + :keymap counsel-mode-map + :lighter " counsel") (provide 'counsel)