diff --git a/.emacs.d/init.el b/.emacs.d/init.el index b3232bc..b139112 100755 --- a/.emacs.d/init.el +++ b/.emacs.d/init.el @@ -15,8 +15,8 @@ (require 'popup) ;; Completion framework -(require 'ivy) -(require 'counsel) +(require 'vertico) +(require 'orderless) ;; Language modes (require 'yaml-mode) @@ -52,31 +52,34 @@ (add-to-list 'auto-mode-alist '("\\.[hc]\\(pp\\)?\\'" . simpc-mode)) ;;; ============================================================================ -;;; IVY & COMPLETION FRAMEWORK +;;; VERTICO & COMPLETION FRAMEWORK ;;; ============================================================================ -(ivy-mode 1) -(setq ivy-use-virtual-buffers t) -(setq ivy-count-format "(%d/%d) ") -(setq ivy-wrap t) +(vertico-mode 1) +(setq vertico-cycle t) +(setq vertico-count 15) + +;; orderless completion style +(setq completion-styles '(orderless basic)) +(setq completion-category-overrides '((file (styles basic partial-completion)))) +(setq orderless-matching-styles '(orderless-literal orderless-regexp)) ;;; ============================================================================ -;;; XREF, CTAGS & NAVIGATION +;;; XREF & NAVIGATION ;;; ============================================================================ -;; dumb-jump as fallback for xref +;; dumb-jump as fallback for xref when LSP is not available (setq dumb-jump-force-searcher 'grep) -(setq dumb-jump-selector 'ivy) +(setq dumb-jump-selector 'completing-read) (setq xref-show-definitions-function #'xref-show-definitions-completing-read) -(setq tags-revert-without-query t) (add-hook 'xref-backend-functions #'dumb-jump-xref-activate 100) ;;; ============================================================================ ;;; EGLOT (LSP) CONFIGURATION ;;; ============================================================================ -;; When eglot is active, xref commands (F12, M-f12) automatically use LSP -;; instead of CTAGS. Eglot registers itself as a higher-priority xref backend. +;; When eglot is active, xref commands (F12, M-f12) automatically use LSP. +;; Eglot registers itself as a higher-priority xref backend, with dumb-jump as fallback. (setq eglot-autoshutdown t) ; shutdown server when last buffer is closed (setq eglot-confirm-server-initiated-edits nil) ; don't ask for confirmation on renames @@ -99,39 +102,33 @@ "Interactively search for symbols in workspace using LSP." (interactive) (if (eglot-managed-p) - (let ((server (eglot-current-server)) - (root (project-root (project-current)))) - (ivy-read "Symbol: " - (lambda (input) - (when (and input (>= (length input) 1)) - (condition-case nil - (let* ((resp (jsonrpc-request server :workspace/symbol - `(:query ,input))) - (items (append resp nil))) - (delq nil - (mapcar (lambda (item) - (condition-case nil - (let* ((name (plist-get item :name)) - (loc (plist-get item :location)) - (uri (plist-get loc :uri)) - (range (plist-get loc :range)) - (start (plist-get range :start)) - (line (1+ (plist-get start :line))) - (file (eglot-uri-to-path uri)) - (rel-path (file-relative-name file root))) - (propertize (format "%s %s:%d" name rel-path line) - 'file file - 'line line)) - (error nil))) - items))) - (error nil)))) - :dynamic-collection t - :require-match t - :action (lambda (candidate) - (when (and candidate (get-text-property 0 'file candidate)) - (find-file (get-text-property 0 'file candidate)) - (goto-char (point-min)) - (forward-line (1- (get-text-property 0 'line candidate))))))) + (let* ((server (eglot-current-server)) + (root (project-root (project-current))) + (query (read-string "Symbol query: ")) + (resp (jsonrpc-request server :workspace/symbol `(:query ,query))) + (items (append resp nil)) + (candidates + (delq nil + (mapcar (lambda (item) + (condition-case nil + (let* ((name (plist-get item :name)) + (loc (plist-get item :location)) + (uri (plist-get loc :uri)) + (range (plist-get loc :range)) + (start (plist-get range :start)) + (line (1+ (plist-get start :line))) + (file (eglot-uri-to-path uri)) + (rel-path (file-relative-name file root))) + (propertize (format "%s %s:%d" name rel-path line) + 'file file + 'line line)) + (error nil))) + items))) + (candidate (completing-read "Symbol: " candidates nil t))) + (when (and candidate (get-text-property 0 'file candidate)) + (find-file (get-text-property 0 'file candidate)) + (goto-char (point-min)) + (forward-line (1- (get-text-property 0 'line candidate))))) (call-interactively 'xref-find-apropos))) ;;; ============================================================================ @@ -297,7 +294,7 @@ (setq compilation-scroll-output -1) (setq compilation-save-buffers-predicate 'ignore) -(defvar my-bottom-panel-buffers '("\\*compilation\\*" "\\*xref\\*" "\\*Flymake diagnostics.*\\*") +(defvar my-bottom-panel-buffers '("\\*compilation\\*" "\\*xref\\*" "\\*Flymake diagnostics.*\\*" "\\*grep\\*") "List of buffer name patterns for bottom panel.") (defun my-bottom-panel-buffer-p (buf) @@ -331,6 +328,8 @@ '("\\*xref\\*" (my-display-in-bottom-panel) (window-height . 0.25))) (add-to-list 'display-buffer-alist '("\\*Flymake diagnostics.*\\*" (my-display-in-bottom-panel) (window-height . 0.25))) +(add-to-list 'display-buffer-alist + '("\\*grep\\*" (my-display-in-bottom-panel) (window-height . 0.25))) (defun my-bottom-panel-toggle () "Toggle the bottom panel. Close if visible, open if hidden." @@ -487,7 +486,7 @@ ;; --- Project Management --- (global-set-key (kbd "") 'project-switch-project) -(global-set-key (kbd "C-S-p") 'counsel-M-x) +(global-set-key (kbd "C-S-p") 'execute-extended-command) ;; --- Bookmarks --- (global-set-key (kbd "") 'bookmark-jump) @@ -883,46 +882,6 @@ Does not copy to kill ring." (compile cmd) (my-compile-custom)))) -;;; ============================================================================ -;;; CUSTOM FUNCTIONS - CTAGS -;;; ============================================================================ - -(defun my-tags-get-saved () - "Get saved TAGS file path for current project." - (when (project-current) - (let ((file (my-project-data-file "tags-file"))) - (when (file-exists-p file) - (with-temp-buffer - (insert-file-contents file) - (string-trim (buffer-string))))))) - -(defun my-tags-save (tags-path) - "Save TAGS file path for current project." - (when (project-current) - (let ((file (my-project-data-file "tags-file"))) - (with-temp-file file - (insert tags-path))))) - -(defun my-tags-load () - "Load saved TAGS file for current project." - (let ((saved (my-tags-get-saved))) - (when (and saved (file-exists-p saved)) - (visit-tags-table saved t)))) - -(add-hook 'find-file-hook #'my-tags-load) - -(defun ctags-generate () - "Generate TAGS file using ctags in project root or current directory." - (interactive) - (let* ((default-directory (or (and (project-current) - (project-root (project-current))) - default-directory)) - (tags-path (expand-file-name "TAGS" default-directory))) - (message "Generating TAGS in %s..." default-directory) - (shell-command "ctags -e -R --exclude=.git --exclude=log *") - (my-tags-save tags-path) - (visit-tags-table tags-path) - (message "TAGS generated and saved: %s" tags-path))) ;;; ============================================================================ ;;; CUSTOM FUNCTIONS - File Operations diff --git a/.emacs.d/lisp/colir.el b/.emacs.d/lisp/colir.el deleted file mode 100644 index a06e495..0000000 --- a/.emacs.d/lisp/colir.el +++ /dev/null @@ -1,130 +0,0 @@ -;;; colir.el --- Color blending library -*- lexical-binding: t -*- - -;; Copyright (C) 2015-2025 Free Software Foundation, Inc. - -;; Author: Oleh Krehel - -;; This file is part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; For a full copy of the GNU General Public License -;; see . - -;;; Commentary: - -;; This package solves the problem of adding a face with a background -;; to text which may already have a background. In all conflicting -;; areas, instead of choosing either the original or the new -;; background face, their blended sum is used. -;; -;; The blend mode functions are taken from URL -;; `https://en.wikipedia.org/wiki/Blend_modes'. - -;;; Code: - -(require 'cl-lib) - -(eval-and-compile - ;; Autoloaded since Emacs 31. - (unless (fboundp 'color-rgb-to-hex) - (autoload 'color-rgb-to-hex "color"))) - -(defcustom colir-compose-method #'colir-compose-alpha - "The method `colir-blend' uses to compose two color channels." - :group 'ivy - :type '(radio - (function-item colir-compose-alpha) - (function-item colir-compose-overlay) - (function-item colir-compose-soft-light))) - -(defun colir-compose-soft-light (a b) - "Compose color channels A and B in Soft Light blend mode. -See URL `https://en.wikipedia.org/wiki/Blend_modes#Soft_Light'." - (if (< b 0.5) - (+ (* 2 a b) (* a a (- 1 b b))) - (+ (* 2 a (- 1 b)) (* (sqrt a) (+ b b -1))))) - -(defun colir-compose-overlay (a b) - "Compose color channels A and B in Overlay blend mode. -See URL `https://en.wikipedia.org/wiki/Blend_modes#Overlay'." - (if (< a 0.5) - (* 2 a b) - (- 1 (* 2 (- 1 a) (- 1 b))))) - -;; Generalizes Emacs 31 `color-blend'. -(defun colir-compose-alpha (a b &optional alpha gamma) - "Compose color channels A and B using alpha blending. -Optional argument ALPHA controls the influence of A on the result. -It is a number between 0.0 and 1.0, inclusive (default 0.5). -Optional argument GAMMA controls gamma correction (default 2.2)." - (setq alpha (or alpha 0.5)) - (setq gamma (or gamma 2.2)) - (+ (* (expt a gamma) alpha) (* (expt b gamma) (- 1 alpha)))) - -(defun colir-blend (c1 c2) - "Blend the two colors C1 and C2 using `colir-compose-method'. -C1 and C2 are triples of floats in [0.0 1.0] range." - (apply #'color-rgb-to-hex - (cl-mapcar - (if (eq (frame-parameter nil 'background-mode) 'dark) - ;; This method works nicely for dark themes. - #'colir-compose-soft-light - colir-compose-method) - c1 c2))) - -(defun colir-color-parse (color) - "Convert string COLOR to triple of floats in [0.0 1.0]." - (if (string-match "#\\([[:xdigit:]]\\{2\\}\\)\\([[:xdigit:]]\\{2\\}\\)\\([[:xdigit:]]\\{2\\}\\)" color) - (mapcar (lambda (v) (/ (string-to-number v 16) 255.0)) - (list (match-string 1 color) (match-string 2 color) (match-string 3 color))) - ;; does not work properly in terminal (maps color to nearest color - ;; from available color palette). - (color-name-to-rgb color))) - -(defun colir--blend-background (start next prevn face object) - (let ((background-prev (face-background prevn))) - (put-text-property - start next 'face - (if background-prev - (cons `(background-color - . ,(colir-blend - (colir-color-parse background-prev) - (colir-color-parse (face-background face nil t)))) - prevn) - (list face prevn)) - object))) - -(defun colir-blend-face-background (start end face &optional object) - "Append to the face property of the text from START to END the face FACE. -When the text already has a face with a non-plain background, -blend it with the background of FACE. -Optional argument OBJECT is the string or buffer containing the text. -See also `font-lock-append-text-property'." - (let (next prev prevn) - (while (/= start end) - (setq next (next-single-property-change start 'face object end)) - (setq prev (get-text-property start 'face object)) - (setq prevn (if (listp prev) - (cl-find-if #'atom prev) - prev)) - (cond - ((or (keywordp (car-safe prev)) (consp (car-safe prev))) - (put-text-property start next 'face (cons face prev) object)) - ((facep prevn) - (colir--blend-background start next prevn face object)) - (t - (put-text-property start next 'face face object))) - (setq start next)))) - -(provide 'colir) - -;;; colir.el ends here diff --git a/.emacs.d/lisp/counsel.el b/.emacs.d/lisp/counsel.el deleted file mode 100644 index 9aa7f1c..0000000 --- a/.emacs.d/lisp/counsel.el +++ /dev/null @@ -1,7398 +0,0 @@ -;;; counsel.el --- Various completion functions using Ivy -*- lexical-binding: t -*- - -;; Copyright (C) 2015-2025 Free Software Foundation, Inc. - -;; Author: Oleh Krehel -;; Maintainer: Basil L. Contovounesios -;; URL: https://github.com/abo-abo/swiper -;; Version: 0.15.1 -;; Package-Requires: ((emacs "24.5") (ivy "0.15.1") (swiper "0.15.1")) -;; Keywords: convenience, matching, tools - -;; This file is part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; For a full copy of the GNU General Public License -;; see . - -;;; Commentary: - -;; Just call one of the interactive functions in this file to complete -;; the corresponding thing using `ivy'. -;; -;; Currently available: -;; - Symbol completion for Elisp, Common Lisp, Python, Clojure, C, C++. -;; - Describe functions for Elisp: function, variable, library, command, -;; bindings, theme. -;; - Navigation functions: imenu, ace-line, semantic, outline. -;; - Git utilities: git-files, git-grep, git-log, git-stash, git-checkout. -;; - Grep utilities: grep, ag, pt, recoll, ack, rg. -;; - System utilities: process list, rhythmbox, linux-app. -;; - Many more. - -;;; Code: - -(require 'ivy) -(require 'swiper) - -(eval-when-compile - (require 'subr-x)) - -(eval-when-compile - (unless (fboundp 'static-if) - (defmacro static-if (condition then-form &rest else-forms) - "Expand to THEN-FORM or ELSE-FORMS based on compile-time CONDITION. -Polyfill for Emacs 30 `static-if'." - (declare (debug (sexp sexp &rest sexp)) (indent 2)) - (if (eval condition lexical-binding) - then-form - (macroexp-progn else-forms))))) - -(defgroup counsel nil - "Completion functions using Ivy." - :group 'matching - :prefix "counsel-") - -;;; Utility - -(defun counsel--elisp-to-pcre (regex &optional look-around) - "Convert REGEX from Elisp format to PCRE format, on best-effort basis. -REGEX may be of any format returned by an Ivy regex function, -namely a string or a list. The return value is always a string. - -Note that incorrect results may be returned for sufficiently -complex regexes." - (if (consp regex) - (if (and look-around - (or (cdr regex) - (not (cdar regex)))) - (concat - "^" - (mapconcat - (lambda (pair) - (let ((subexp (counsel--elisp-to-pcre (car pair)))) - (format "(?%c.*%s)" - (if (cdr pair) ?= ?!) - subexp))) - regex - "")) - (mapconcat - (lambda (pair) - (let ((subexp (counsel--elisp-to-pcre (car pair)))) - (if (ivy--string-search "|" subexp) - (format "(?:%s)" subexp) - subexp))) - (cl-remove-if-not #'cdr regex) - ".*")) - (replace-regexp-in-string - "\\\\[(){}|`']\\|[()]" - (lambda (s) - (or (cdr (assoc s '(("\\(" . "(") - ("\\)" . ")") - ("(" . "\\(") - (")" . "\\)") - ("\\{" . "{") - ("\\}" . "}") - ("\\|" . "|") - ("\\`" . "^") - ("\\'" . "$")))) - (error - "Unexpected error in `counsel--elisp-to-pcre' (got match %S)" s))) - regex t t))) - -(defun counsel-directory-name (dir) - "Return the name of directory DIR with a slash." - (file-name-as-directory - (file-name-nondirectory - (directory-file-name dir)))) - -(defun counsel-string-compose (prefix str) - "Make PREFIX the display prefix of STR through text properties." - (let ((str (copy-sequence str))) - (put-text-property - 0 1 'display - (concat prefix (substring str 0 1)) - str) - str)) - -(defalias 'counsel--executable-find - ;; Gained optional argument in 27.1. - (if (>= emacs-major-version 27) - #'executable-find - (lambda (command &optional _remote) - (executable-find command))) - "Compatibility shim for `executable-find'.") - -(defun counsel-require-program (cmd &optional noerror) - "Check system for program used in CMD, printing error if not found. -CMD is either a string or a list of strings. -To skip the `executable-find' check, start the string with a space. -When NOERROR is non-nil, return nil instead of raising an error." - (unless (and (stringp cmd) (string-prefix-p " " cmd)) - (let ((program (if (listp cmd) - (car cmd) - (car (split-string cmd))))) - (or (and (stringp program) - (not (string= program "")) - (counsel--executable-find program t)) - (unless noerror - (user-error "Required program \"%s\" not found in your path" program)))))) - -(defun counsel-prompt-function-dir () - "Return prompt appended with the parent directory." - (declare (obsolete "it is no longer used." "0.15.1")) - (require 'esh-util) - (let* ((dir (ivy-state-directory ivy-last)) - (parts (nthcdr 3 (funcall (if (fboundp 'eshell-split-filename) - ;; New name since Emacs 30. - #'eshell-split-filename - 'eshell-split-path) - dir))) - (dir (format " [%s]: " (if parts (apply #'concat "..." parts) dir)))) - (ivy-add-prompt-count - (replace-regexp-in-string ; Insert dir before any trailing colon. - "\\(?:: ?\\)?\\'" dir (ivy-state-prompt ivy-last) t t)))) - -(defalias 'counsel--flatten - ;; Added in Emacs 27.1 - (if (fboundp 'flatten-tree) - #'flatten-tree - (lambda (tree) - (let (elems) - (while (consp tree) - (let ((elem (pop tree))) - (while (consp elem) - (push (cdr elem) tree) - (setq elem (car elem))) - (if elem (push elem elems)))) - (if tree (push tree elems)) - (nreverse elems)))) - "Compatibility shim for `flatten-tree'.") - -(defun counsel--format (formatter &rest args) - "Like `format' but FORMATTER can be a list. -When FORMATTER is a list, only `%s' is replaced with ARGS. - -Return a list or string depending on input." - (cond - ((listp formatter) - (counsel--flatten (mapcar - (lambda (it) (if (equal it "%s") (pop args) it)) - formatter))) - (t (apply #'format formatter args)))) - -(defalias 'counsel--null-device - (if (fboundp 'null-device) #'null-device (lambda () null-device)) - "Compatibility shim for Emacs 28 function `null-device'.") - -;;;; 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-start nil - "Store the time when a new process was started.") - -(defvar counsel--async-timer nil - "Timer used to dispose `counsel--async-command.") - -(defvar counsel--async-duration nil - "Store the time a process takes to gather all its candidates. -The time is measured in seconds.") - -(defvar counsel--async-exit-code-plist () - "Associate commands with their exit code descriptions. -This plist maps commands to a plist mapping their exit codes to -descriptions.") - -(defvar counsel--async-last-error-string nil - "When the process returned non-0, store the output here.") - -(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-alist '((t . "[\r\n]")) - "Store the regexp for splitting shell command output.") - -(defvar counsel-async-ignore-re-alist nil - "An alist of regexp matching candidates to ignore in `counsel--async-filter'.") - -(defvar counsel--async-last-command nil - "Store the last command ran by `counsel--async-command-1'.") - -(defun counsel--async-command-1 (cmd &optional sentinel filter name) - "Start and return new counsel process by calling CMD. -CMD can be either a shell command as a string, or a list of the -program name to be called directly, followed by its arguments. -If the default counsel process or one with NAME already exists, -kill it and its associated buffer before starting a new one. -Give the process the functions SENTINEL and FILTER, which default -to `counsel--async-sentinel' and `counsel--async-filter', -respectively." - (counsel-delete-process name) - (setq name (or name " *counsel*")) - (when (get-buffer name) - (kill-buffer name)) - (setq counsel--async-last-command cmd) - (let* ((buf (get-buffer-create name)) - (proc (if (listp cmd) - (apply #'start-file-process name buf cmd) - (start-file-process-shell-command name buf cmd)))) - (setq counsel--async-time (current-time)) - (setq counsel--async-start counsel--async-time) - (set-process-sentinel proc (or sentinel #'counsel--async-sentinel)) - (set-process-filter proc (or filter #'counsel--async-filter)) - proc)) - -(defcustom counsel-async-command-delay 0 - "Number of seconds to wait before spawning another async command." - :type 'number) - -(defun counsel--async-command (&rest args) - "Like `counsel--async-command-1', with same ARGS, but debounced. -Calls to `counsel--async-command-1' are separated by at least -`counsel-async-command-delay' seconds, so as to avoid issues -caused by spawning too many subprocesses too quickly." - (if (zerop counsel-async-command-delay) - (apply #'counsel--async-command-1 args) - (when counsel--async-timer - (cancel-timer counsel--async-timer)) - (setq counsel--async-timer - (apply #'run-with-timer - counsel-async-command-delay - nil - #'counsel--async-command-1 - args)))) - -(defun counsel--split-string (&optional str) - (split-string - (or str (buffer-string)) - (ivy-alist-setting counsel-async-split-string-re-alist) - t)) - -(defun counsel--sync-sentinel-on-exit (process) - (if (zerop (process-exit-status process)) - (let ((cur (ivy-state-current ivy-last))) - (ivy--set-candidates - (ivy--sort-maybe - (with-current-buffer (process-buffer process) - (counsel--split-string)))) - (when counsel--async-start - (setq counsel--async-duration - (time-to-seconds (time-since counsel--async-start)))) - (let ((re (ivy-re-to-str ivy-regex))) - (if ivy--old-cands - (if (eq (ivy-alist-setting ivy-index-functions-alist) 'ivy-recompute-index-zero) - (ivy-set-index 0) - (ivy--recompute-index re ivy--all-candidates)) - ;; index was changed before a long-running query exited - (unless (string= cur (nth ivy--index ivy--all-candidates)) - (let ((func (ivy-alist-setting ivy-index-functions-alist))) - (if func - (funcall func re ivy--all-candidates) - (ivy--preselect-index - (if (> (length re) 0) - cur - (ivy-state-preselect ivy-last)) - ivy--all-candidates)))))) - (setq ivy--old-cands ivy--all-candidates) - (if ivy--all-candidates - (ivy--exhibit) - (ivy--insert-minibuffer ""))) - (setq counsel--async-last-error-string - (with-current-buffer (process-buffer process) (buffer-string))) - (setq ivy--all-candidates - (let ((status (process-exit-status process)) - (plist (plist-get counsel--async-exit-code-plist - (ivy-state-caller ivy-last)))) - (list (or (plist-get plist status) - (format "error code %d" status))))) - (setq ivy--old-cands ivy--all-candidates) - (ivy--exhibit))) - -(defun counsel--async-sentinel (process _msg) - "Sentinel function for an asynchronous counsel PROCESS." - (when (eq (process-status process) 'exit) - (counsel--sync-sentinel-on-exit process))) - -(defcustom counsel-async-filter-update-time 500000 - "The amount of microseconds to wait until updating `counsel--async-filter'." - :type 'integer) - -(defalias 'counsel--async-filter-update-time - (if (fboundp 'time-convert) - ;; Preferred (TICKS . HZ) format since Emacs 27.1. - (lambda () (cons counsel-async-filter-update-time 1000000)) - (lambda () (list 0 0 counsel-async-filter-update-time))) - "Return `counsel-async-filter-update-time' as a time value.") - -(defun counsel--async-filter (process str) - "Receive from PROCESS the output STR. -Update the minibuffer with the amount of lines collected every -`counsel-async-filter-update-time' microseconds since the last update." - (with-current-buffer (process-buffer process) - (insert str)) - (when (time-less-p (counsel--async-filter-update-time) - (time-since counsel--async-time)) - (let (numlines) - (with-current-buffer (process-buffer process) - (setq numlines (count-lines (point-min) (point-max))) - (ivy--set-candidates - (let ((lines (counsel--split-string)) - (ignore-re (ivy-alist-setting counsel-async-ignore-re-alist))) - (if (stringp ignore-re) - (cl-delete-if (lambda (line) - (string-match-p ignore-re line)) - lines) - lines)))) - (let ((ivy--prompt (format "%d++ %s" numlines (ivy-state-prompt ivy-last)))) - (ivy--insert-minibuffer (ivy--format ivy--all-candidates))) - (setq counsel--async-time (current-time))))) - -(defun counsel-delete-process (&optional name) - "Delete current counsel process or that with NAME." - (let ((process (get-process (or name " *counsel*")))) - (when process - (delete-process process)))) - -;;; Completion at point - -(define-obsolete-function-alias 'counsel-el - #'complete-symbol "0.13.2 (2020-05-20)") -(define-obsolete-function-alias 'counsel-cl - #'complete-symbol "0.13.2 (2020-05-20)") -(define-obsolete-function-alias 'counsel-jedi - #'complete-symbol "0.13.2 (2020-05-20)") -(define-obsolete-function-alias 'counsel-clj - #'complete-symbol "0.13.2 (2020-05-20)") - -;;;; `counsel-company' - -(defvar company-candidates) -(declare-function company-abort "ext:company") -(declare-function company-complete "ext:company") -(declare-function company-mode "ext:company") -(declare-function company-call-backend "ext:company") -(declare-function company--clean-string "ext:company") -(declare-function company--continue "ext:company") - -;;;###autoload -(defun counsel-company () - "Complete using `company-candidates'." - (interactive) - (company-mode 1) - (unless company-candidates - (company-complete)) - (when company-candidates - (company--continue) - (ivy-read "Candidate: " company-candidates - :action 'company-finish - :caller 'counsel-company))) - -(ivy-configure 'counsel-company - :display-transformer-fn #'counsel--company-display-transformer - :unwind-fn (lambda() (unless ivy-exit (company-abort)))) - -(defun counsel--company-display-transformer (s) - (concat s (let ((annot (company-call-backend 'annotation s))) - (when annot - (company--clean-string annot))))) - -;;;; `counsel-irony' - -(declare-function irony-completion-candidates-async "ext:irony-completion") -(declare-function irony-completion-symbol-bounds "ext:irony-completion") -(declare-function irony-completion-annotation "ext:irony-completion") - -;;;###autoload -(defun counsel-irony () - "Inline C/C++ completion using Irony." - (interactive) - (irony-completion-candidates-async 'counsel-irony-callback)) - -(defun counsel-irony-callback (candidates) - "Callback function for Irony to search among CANDIDATES." - (interactive) - (let* ((symbol-bounds (irony-completion-symbol-bounds)) - (beg (car symbol-bounds)) - (end (cdr symbol-bounds)) - (prefix (buffer-substring-no-properties beg end))) - (setq ivy-completion-beg beg - ivy-completion-end end) - (ivy-read "code: " (mapcar #'counsel-irony-annotate candidates) - :predicate (lambda (candidate) - (string-prefix-p prefix (car candidate))) - :caller 'counsel-irony - :action #'ivy-completion-in-region-action))) - -(defun counsel-irony-annotate (x) - "Make Ivy candidate from Irony candidate X." - (cons (concat (car x) (irony-completion-annotation x)) - (car x))) - -(ivy-configure #'counsel-irony - :display-fn #'ivy-display-function-overlay) - -;;; 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 () - "History list for variable and function names. -Used by commands `counsel-describe-symbol', -`counsel-describe-variable', and `counsel-describe-function'.") - -(defun counsel-find-symbol () - "Jump to the definition of the current symbol." - (interactive) - (ivy-exit-with-action #'counsel--find-symbol)) -(function-put #'counsel-find-symbol 'no-counsel-M-x t) - -(defun counsel--info-lookup-symbol () - "Lookup the current symbol in the info docs." - (interactive) - (ivy-exit-with-action #'counsel-info-lookup-symbol)) - -(defun counsel--push-xref-marker (&optional m) - "Compatibility shim for `xref-push-marker-stack'." - (static-if (require 'xref nil t) - ;; Added in Emacs 25.1. - (progn - (unless (fboundp 'xref-push-marker-stack) - (require 'xref)) - (xref-push-marker-stack m)) - (unless (boundp 'find-tag-marker-ring) - (require 'etags)) - (unless (fboundp 'ring-insert) - (require 'ring)) - (defvar find-tag-marker-ring) - (declare-function ring-insert "ring" (ring item)) - (ring-insert find-tag-marker-ring (or m (point-marker))))) - -(defun counsel--find-symbol (x) - "Find symbol definition that corresponds to string X." - (with-ivy-window - (counsel--push-xref-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 find definition of %s" - sym)))))))) - -(defun counsel--variable-p (symbol) - "Return non-nil if SYMBOL is a bound or documented variable." - (or (and (boundp symbol) - (not (keywordp symbol))) - (get symbol 'variable-documentation))) - -(defcustom counsel-describe-variable-function #'describe-variable - "Function to call to describe a variable passed as parameter." - :type 'function) - -(defun counsel-describe-variable-transformer (var) - "Propertize VAR if it's a custom variable." - (if (custom-variable-p (intern var)) - (ivy-append-face var 'ivy-highlight-face) - var)) - -;;;###autoload -(defun counsel-describe-variable () - "Forward to `describe-variable'. - -Variables declared using `defcustom' are highlighted according to -`ivy-highlight-face'." - (interactive) - (let ((enable-recursive-minibuffers t)) - (ivy-read "Describe variable: " obarray - :predicate #'counsel--variable-p - :require-match t - :history 'counsel-describe-symbol-history - :keymap counsel-describe-map - :preselect (ivy-thing-at-point) - :action (lambda (x) - (funcall counsel-describe-variable-function (intern x))) - :caller 'counsel-describe-variable))) - -(ivy-configure 'counsel-describe-variable - :parent 'counsel-describe-symbol - :display-transformer-fn #'counsel-describe-variable-transformer) - -;;;; `counsel-describe-function' - -(ivy-set-actions - 'counsel-describe-function - `(("I" ,#'counsel-info-lookup-symbol "info") - ("d" ,#'counsel--find-symbol "definition"))) - -(defcustom counsel-describe-function-function #'describe-function - "Function to call to describe a function passed as parameter." - :type 'function) - -(defun counsel-describe-function-transformer (function-name) - "Propertize FUNCTION-NAME if it's an interactive function." - (if (commandp (intern function-name)) - (ivy-append-face function-name 'ivy-highlight-face) - function-name)) - -(defun ivy-function-called-at-point () - (let ((f (function-called-at-point))) - (and f (symbol-name f)))) - -(defcustom counsel-describe-function-preselect #'ivy-thing-at-point - "Determine what `counsel-describe-function' should preselect." - :type '(radio - (function-item ivy-thing-at-point) - (function-item ivy-function-called-at-point))) - -(defun counsel--describe-function (candidate) - "Pass string CANDIDATE to `counsel-describe-function-function'." - (funcall counsel-describe-function-function (intern candidate))) - -;;;###autoload -(defun counsel-describe-function () - "Forward to `describe-function'. - -Interactive functions (i.e., commands) are highlighted according -to `ivy-highlight-face'." - (interactive) - (let ((enable-recursive-minibuffers t)) - (ivy-read "Describe function: " obarray - :predicate (lambda (sym) - (or (fboundp sym) - (get sym 'function-documentation))) - :require-match t - :history 'counsel-describe-symbol-history - :keymap counsel-describe-map - :preselect (funcall counsel-describe-function-preselect) - :action #'counsel--describe-function - :caller 'counsel-describe-function))) - -(ivy-configure 'counsel-describe-function - :parent 'counsel-describe-symbol - :display-transformer-fn #'counsel-describe-function-transformer) - -;;;; `counsel-describe-symbol' - -(defcustom counsel-describe-symbol-function 'describe-symbol - "Function to call to describe a symbol passed as parameter." - :type 'function) - -;;;###autoload -(defun counsel-describe-symbol () - "Forward to `describe-symbol'." - (interactive) - (unless (functionp 'describe-symbol) - (user-error "This command requires Emacs 25.1 or later")) - (require 'help-mode) - (defvar describe-symbol-backends) - (let ((enable-recursive-minibuffers t)) - (ivy-read "Describe symbol: " obarray - :predicate (lambda (sym) - (cl-some (lambda (backend) - (funcall (cadr backend) sym)) - describe-symbol-backends)) - :require-match t - :history 'counsel-describe-symbol-history - :keymap counsel-describe-map - :preselect (ivy-thing-at-point) - :action (lambda (x) - (funcall counsel-describe-symbol-function (intern x))) - :caller 'counsel-describe-symbol))) - -(ivy-configure 'counsel-describe-symbol - :initial-input "^" - :sort-fn #'ivy-string<) - -(ivy-set-actions - 'counsel-describe-symbol - `(("I" ,#'counsel-info-lookup-symbol "info") - ("d" ,#'counsel--find-symbol "definition"))) - -;;;; `counsel-set-variable' - -(defvar counsel-set-variable-history nil - "Store history for `counsel-set-variable'.") - -(defun counsel-read-setq-expression (sym) - "Read and eval a setq expression for SYM." - (setq this-command 'eval-expression) - (let* ((sym-value (symbol-value sym)) - (init (format "(setq %s%S)" - (if (or (consp sym-value) - (and sym-value (symbolp sym-value))) - "'" - "") - sym-value))) - ;; Most of this duplicates `read--expression'. - (minibuffer-with-setup-hook - (lambda () - (set-syntax-table emacs-lisp-mode-syntax-table) - ;; Added in Emacs 25.1. - (when (fboundp 'elisp-completion-at-point) - (add-hook 'completion-at-point-functions - #'elisp-completion-at-point nil t)) - ;; Emacs 27+ already sets up ElDoc in this hook. Emacs 25 added - ;; `elisp-eldoc-documentation-function' and Emacs 28 obsoletes it. - (when (< emacs-major-version 27) - (when (fboundp 'elisp-eldoc-documentation-function) - (add-function :before-until (local 'eldoc-documentation-function) - #'elisp-eldoc-documentation-function)) - (eldoc-mode)) - (run-hooks 'eval-expression-minibuffer-setup-hook) - ;; The following diverges from `read--expression'. - (goto-char (minibuffer-prompt-end)) - (forward-char 6) - (insert (format "%S " sym))) - (read-from-minibuffer "Eval: " init read-expression-map t - 'read-expression-history)))) - -(defun counsel--setq-doconst (x) - "Return a cons of description and value for X. -X is an item of a radio- or choice-type defcustom." - (when (listp x) - (let ((v (car-safe (last x))) - (tag (and (eq (car x) 'const) - (plist-get (cdr x) :tag)))) - (when (and (or v tag) (not (eq v 'function))) - (cons - (concat - (when tag - (concat tag ": ")) - (if (stringp v) v (prin1-to-string v))) - (if (symbolp v) - (list 'quote v) - v)))))) - -(declare-function lv-message "ext:lv") -(declare-function lv-delete-window "ext:lv") -(declare-function custom-variable-documentation "cus-edit") - -(defface counsel-variable-documentation - '((t :inherit font-lock-comment-face)) - "Face for displaying Lisp documentation." - :group 'ivy-faces) - -;;;###autoload -(defun counsel-set-variable (sym) - "Set a variable SYM, with completion. - -When the selected variable is a `defcustom' with the type boolean -or radio, offer completion of all possible values. - -Otherwise, offer a variant of `eval-expression', with the initial -input corresponding to the chosen variable. - -With a prefix arg, restrict list to variables defined using -`defcustom'." - (interactive (list (intern - (ivy-read "Set variable: " obarray - :predicate (if current-prefix-arg - #'custom-variable-p - #'counsel--variable-p) - :history 'counsel-set-variable-history - :preselect (ivy-thing-at-point))))) - (let ((doc (and (require 'cus-edit) - (require 'lv nil t) - (not (string= "nil" (custom-variable-documentation sym))) - (propertize (custom-variable-documentation sym) - 'face 'counsel-variable-documentation))) - sym-type - cands) - (unwind-protect - (progn - (when doc - (lv-message (ivy--quote-format-string doc))) - (if (and (boundp sym) - (setq sym-type (get sym 'custom-type)) - (cond - ((and (consp sym-type) - (memq (car sym-type) '(choice radio))) - (setq cands (delq nil (mapcar #'counsel--setq-doconst - (cdr sym-type))))) - ((eq sym-type 'boolean) - (setq cands '(("nil" . nil) ("t" . t)))) - (t nil))) - (let* ((sym-val (symbol-value sym)) - (res (ivy-read (format "Set (%S <%s>): " sym sym-val) - cands - :preselect (prin1-to-string sym-val)))) - (when res - (setq res - (if (assoc res cands) - (cdr (assoc res cands)) - (read res))) - (kill-new (format "(setq %S %S)" sym res)) - (set sym (if (and (listp res) (eq (car res) 'quote)) - (cadr res) - res)))) - (unless (boundp sym) - (set sym nil)) - (let ((expr (counsel-read-setq-expression sym))) - (kill-new (format "%S" expr)) - (eval-expression expr)))) - (when doc - (lv-delete-window))))) - -;;;; `counsel-apropos' - -;;;###autoload -(defun counsel-apropos () - "Show all matching symbols. -See `apropos' for further information on what is considered -a symbol and how to search for them." - (interactive) - (ivy-read "Search for symbol (word list or regexp): " obarray - :predicate (lambda (sym) - (or (fboundp sym) - (boundp sym) - (facep sym) - (symbol-plist sym))) - :history 'counsel-apropos-history - :preselect (ivy-thing-at-point) - :action (lambda (pattern) - (when (string= pattern "") - (user-error "Please specify a pattern")) - ;; If the user selected a candidate form the list, we use - ;; a pattern which matches only the selected symbol. - (if (memq this-command '(ivy-immediate-done ivy-alt-done)) - ;; Regexp pattern are passed verbatim, other input is - ;; split into words. - (if (string= (regexp-quote pattern) pattern) - (apropos (split-string pattern "[ \t]+" t)) - (apropos pattern)) - (apropos (concat "\\`" pattern "\\'")))) - :caller 'counsel-apropos)) - -(ivy-configure 'counsel-apropos - :sort-fn #'ivy-string<) - -;;;; `counsel-info-lookup-symbol' - -(defvar info-lookup-mode) -(declare-function info-lookup-guess-default "info-look") -(declare-function info-lookup->completions "info-look") -(declare-function info-lookup->mode-value "info-look") -(declare-function info-lookup-select-mode "info-look") -(declare-function info-lookup-change-mode "info-look") -(declare-function info-lookup "info-look") - -;;;###autoload -(defun counsel-info-lookup-symbol (symbol &optional mode) - "Forward SYMBOL to `info-lookup-symbol' with ivy completion. -With prefix arg MODE a query for the symbol help mode is offered." - (interactive - (progn - (require 'info-look) - ;; Courtesy of `info-lookup-interactive-arguments' - (let* ((topic 'symbol) - (mode (cond (current-prefix-arg - (info-lookup-change-mode topic)) - ((info-lookup->mode-value - topic (info-lookup-select-mode)) - info-lookup-mode) - ((info-lookup-change-mode topic)))) - (enable-recursive-minibuffers t)) - (list (ivy-read "Describe symbol: " (info-lookup->completions topic mode) - :history 'info-lookup-history - :preselect (info-lookup-guess-default topic mode) - :caller 'counsel-info-lookup-symbol) - mode)))) - (info-lookup-symbol symbol mode)) - -(ivy-configure 'counsel-info-lookup-symbol - :sort-fn #'ivy-string<) - -;;;; `counsel-M-x' - -(defface counsel-key-binding - '((t :inherit font-lock-keyword-face)) - "Face used by `counsel-M-x' for key bindings." - :group 'ivy-faces) - -(defface counsel-active-mode - '((t :inherit font-lock-builtin-face)) - "Face used by `counsel-M-x' for activated modes." - :group 'ivy-faces) - -(defcustom counsel-alias-expand t - "When non-nil, show the expansion of aliases in `counsel-M-x'." - :type 'boolean - :group 'ivy) - -(defun counsel-M-x-transformer (cmd) - "Return CMD annotated with its active key binding, if any." - (let* ((sym (intern cmd)) - (alias (symbol-function sym)) - (key (where-is-internal sym nil t))) - (when (or (eq sym major-mode) - (and - (memq sym minor-mode-list) - (boundp sym) - (buffer-local-value sym (ivy-state-buffer ivy-last)))) - (setq cmd (propertize cmd 'face 'counsel-active-mode))) - (concat cmd - (when (and (symbolp alias) counsel-alias-expand) - (format " (%s)" alias)) - (when key - ;; Prefer `' over `C-x 6' where applicable - (let ((i (cl-search [?\C-x ?6] key))) - (when i - (let ((dup (vconcat (substring key 0 i) [f2] (substring key (+ i 2)))) - (map (current-global-map))) - (when (equal (lookup-key map key) - (lookup-key map dup)) - (setq key dup))))) - (setq key (key-description key)) - (put-text-property 0 (length key) 'face 'counsel-key-binding key) - (format " (%s)" key))))) - -(defvar amx-initialized) -(defvar amx-cache) -(declare-function amx-initialize "ext:amx") -(declare-function amx-detect-new-commands "ext:amx") -(declare-function amx-update "ext:amx") -(declare-function amx-rank "ext:amx") -(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-externs () - "Return `counsel-M-x' candidates from external packages. -The return value is a list of strings. The currently supported -packages are, in order of precedence, `amx' and `smex'." - (cond ((require 'amx nil t) - (unless amx-initialized - (amx-initialize)) - (when (amx-detect-new-commands) - (amx-update)) - (mapcar (lambda (entry) - (symbol-name (car entry))) - amx-cache)) - ((require 'smex nil t) - (unless smex-initialized-p - (smex-initialize)) - (when (smex-detect-new-commands) - (smex-update)) - smex-ido-cache))) - -(defun counsel--M-x-externs-predicate (cand) - "Return non-nil if `counsel-M-x' should complete CAND. -CAND is a string returned by `counsel--M-x-externs'." - (not (get (intern cand) 'no-counsel-M-x))) - -(defun counsel--M-x-make-predicate () - "Return a predicate for `counsel-M-x' in the current buffer." - (defvar read-extended-command-predicate) - (let ((buf (current-buffer))) - (lambda (sym) - (and (commandp sym) - (not (get sym 'byte-obsolete-info)) - (not (get sym 'no-counsel-M-x)) - (cond ((not (bound-and-true-p read-extended-command-predicate))) - ((functionp read-extended-command-predicate) - (condition-case-unless-debug err - (funcall read-extended-command-predicate sym buf) - (error (message "read-extended-command-predicate: %s: %s" - sym (error-message-string err)))))))))) - -(defun counsel--M-x-prompt () - "String for `M-x' plus the string representation of `current-prefix-arg'." - (concat (cond ((null current-prefix-arg) - nil) - ((eq current-prefix-arg '-) - "- ") - ((integerp current-prefix-arg) - (format "%d " current-prefix-arg)) - ((= (car current-prefix-arg) 4) - "C-u ") - (t - (format "%d " (car current-prefix-arg)))) - "M-x ")) - -(defvar counsel-M-x-history nil - "History for `counsel-M-x'.") - -(defun counsel-M-x-action (cmd) - "Execute CMD." - (setq cmd (intern - (subst-char-in-string ?\s ?- (string-remove-prefix "^" cmd)))) - (cond ((bound-and-true-p amx-initialized) - (amx-rank cmd)) - ((bound-and-true-p smex-initialized-p) - (smex-rank cmd))) - (setq prefix-arg current-prefix-arg) - (setq this-command cmd) - (setq real-this-command cmd) - (command-execute cmd 'record)) - -;;;###autoload -(defun counsel-M-x (&optional initial-input) - "Ivy version of `execute-extended-command'. -Optional INITIAL-INPUT is the initial input in the minibuffer. -This function integrates with either the `amx' or `smex' package -when available, in that order of precedence." - (interactive) - ;; When `counsel-M-x' returns, `last-command' would be set to - ;; `counsel-M-x' because :action hasn't been invoked yet. - ;; Instead, preserve the old value of `this-command'. - (setq this-command last-command) - (setq real-this-command real-last-command) - (let ((externs (counsel--M-x-externs))) - (ivy-read (counsel--M-x-prompt) (or externs obarray) - :predicate (if externs - #'counsel--M-x-externs-predicate - (counsel--M-x-make-predicate)) - :require-match t - :history 'counsel-M-x-history - :action #'counsel-M-x-action - :keymap counsel-describe-map - :initial-input initial-input - :caller 'counsel-M-x))) - -(ivy-configure 'counsel-M-x - :initial-input "^" - :display-transformer-fn #'counsel-M-x-transformer) - -(ivy-set-actions - 'counsel-M-x - `(("d" ,#'counsel--find-symbol "definition") - ("h" ,#'counsel--describe-function "help"))) - -;;;; `counsel-command-history' - -(defun counsel-command-history-action-eval (cmd) - "Eval the command CMD." - (eval (read cmd) t)) - -(defun counsel-command-history-action-edit-and-eval (cmd) - "Edit and eval the command CMD." - (edit-and-eval-command "Eval: " (read cmd))) - -(ivy-set-actions - 'counsel-command-history - '(("r" counsel-command-history-action-eval "eval command") - ("e" counsel-command-history-action-edit-and-eval "edit and eval command"))) - -;;;###autoload -(defun counsel-command-history () - "Show the history of commands." - (interactive) - (ivy-read "Command: " (mapcar #'prin1-to-string command-history) - :require-match t - :action #'counsel-command-history-action-eval - :caller 'counsel-command-history)) - -;;;; `counsel-load-library' - -(defun counsel-library-candidates () - "Return a list of completion candidates for `counsel-load-library'." - (let ((suffix (concat (regexp-opt '(".el" ".el.gz") t) "\\'")) - (cands (make-hash-table :test #'equal)) - short-name - old-val - dir-parent - res) - (dolist (dir load-path) - (setq dir (or dir default-directory)) ;; interpret nil in load-path as default-directory - (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-name (cdr old-val))) - (puthash short-name - (cons - (counsel-string-compose dir-parent (car old-val)) - (cdr old-val)) - cands) - (setq dir-parent (counsel-directory-name 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) - (nreverse res))) - -;;;###autoload -(defun counsel-load-library () - "Load a selected the Emacs Lisp library. -The libraries are offered from `load-path'." - (interactive) - (let ((cands (counsel-library-candidates))) - (ivy-read "Load library: " cands - :action (lambda (x) - (load-library - (get-text-property 0 'full-name x))) - :keymap counsel-describe-map))) - -(ivy-set-actions - 'counsel-load-library - `(("d" ,#'counsel--find-symbol "definition"))) - -;;;; `counsel-find-library' - -(declare-function find-library-name "find-func") -(defun counsel-find-library-other-window (library) - (let ((buf (find-file-noselect (find-library-name library)))) - (pop-to-buffer buf 'other-window))) - -(defun counsel-find-library-other-frame (library) - (let ((buf (find-file-noselect (find-library-name library)))) - (condition-case nil - (switch-to-buffer-other-frame buf) - (error (pop-to-buffer buf))))) - -(ivy-set-actions - 'counsel-find-library - '(("j" counsel-find-library-other-window "other window") - ("f" counsel-find-library-other-frame "other frame"))) - -;;;###autoload -(defun counsel-find-library () - "Visit a selected the Emacs Lisp library. -The libraries are offered from `load-path'." - (interactive) - (let ((cands (counsel-library-candidates))) - (ivy-read "Find library: " cands - :action #'counsel--find-symbol - :keymap counsel-describe-map - :caller 'counsel-find-library))) - -;;;; `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) t) - (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") - ("x" counsel-descbinds-action-exec "execute"))) - -(defvar counsel-descbinds-history nil - "History for `counsel-descbinds'.") - -(defun counsel--descbinds-cands (&optional prefix buffer) - "Get key bindings starting with PREFIX in BUFFER. -See `describe-buffer-bindings' for further information." - (let ((buffer (or buffer (current-buffer))) - (re-exclude (regexp-opt - '("" "" "" - "" "" "" - "" "" - "" ""))) - res) - (with-temp-buffer - (let ((indent-tabs-mode t)) - (describe-buffer-bindings buffer prefix)) - (goto-char (point-min)) - ;; Skip the "Key translations" section - (skip-chars-forward "^\C-l") - (forward-char 2) - (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-p re-exclude key) - (not (or (commandp (setq cmd (intern-soft fun))) - (equal fun "Prefix Command")))) - (push - (cons (format - "%-15s %s" - (propertize key 'face 'counsel-key-binding) - fun) - (cons key cmd)) - res)))) - (forward-line))) - (nreverse res))) - -(defcustom counsel-descbinds-function #'describe-function - "Function to call to describe a function passed as parameter." - :type 'function) - -(defun counsel-descbinds-action-describe (x) - "Describe function of candidate X. -See `describe-function' for further information." - (let ((cmd (cddr x))) - (funcall counsel-descbinds-function cmd))) - -(defun counsel-descbinds-action-exec (x) - "Run candidate X. -See `execute-extended-command' for further information." - (let ((cmd (cddr x))) - (command-execute cmd 'record))) - -(defun counsel-descbinds-action-find (x) - "Find symbol definition of candidate X. -See `counsel--find-symbol' for further information." - (let ((cmd (cddr x))) - (counsel--find-symbol (symbol-name cmd)))) - -(defun counsel-descbinds-action-info (x) - "Display symbol definition of candidate X, as found in the relevant manual. -See `info-lookup-symbol' for further information." - (let ((cmd (cddr x))) - (counsel-info-lookup-symbol (symbol-name cmd)))) - -;;;###autoload -(defun counsel-descbinds (&optional prefix buffer) - "Show a list of all defined keys and their definitions. -If non-nil, show only bindings that start with PREFIX. -BUFFER defaults to the current one." - (interactive) - (ivy-read "Bindings: " (counsel--descbinds-cands prefix buffer) - :action #'counsel-descbinds-action-describe - :history 'counsel-descbinds-history - :caller 'counsel-descbinds)) - -;;;; `counsel-describe-face' - -(defcustom counsel-describe-face-function #'describe-face - "Function to call to describe a face or face name argument." - :type 'function) - -(defun counsel--face-at-point () - "Return name of face around point. -Try detecting a face name in the text around point before falling -back to the face of the character after point, and finally the -`default' face." - (symbol-name (or (face-at-point t) 'default))) - -;;;###autoload -(defun counsel-describe-face () - "Completion for `describe-face'." - (interactive) - (ivy-read "Face: " (face-list) - :require-match t - :history 'face-name-history - :preselect (counsel--face-at-point) - :action counsel-describe-face-function - :caller 'counsel-describe-face)) - -(ivy-configure 'counsel-describe-face - :sort-fn #'ivy-string<) - -(defun counsel-customize-face (name) - "Customize face with NAME." - (customize-face (intern name))) - -(defun counsel-customize-face-other-window (name) - "Customize face with NAME in another window." - (customize-face-other-window (intern name))) - -(declare-function hi-lock-set-pattern "hi-lock") -(defun counsel-highlight-with-face (face) - "Highlight thing-at-point with FACE." - (hi-lock-mode 1) - (let ((thing (ivy-thing-at-point))) - (when (use-region-p) - (deactivate-mark)) - (hi-lock-set-pattern (regexp-quote thing) (intern face)))) - -(ivy-set-actions - 'counsel-describe-face - '(("c" counsel-customize-face "customize") - ("C" counsel-customize-face-other-window "customize other window"))) - -;;;; `counsel-faces' - -(defvar counsel--faces-format "%-40s %s") - -(defun counsel--faces-format-function (names) - "Format NAMES according to `counsel--faces-format'." - (let ((formatter - (lambda (name) - (format counsel--faces-format name - (propertize list-faces-sample-text - 'face (intern name)))))) - (ivy--format-function-generic - (lambda (name) - (funcall formatter (ivy--add-face name 'ivy-current-match))) - formatter names "\n"))) - -;;;###autoload -(defun counsel-faces () - "Complete faces with preview. -Actions are provided by default for describing or customizing the -selected face." - (interactive) - (let* ((names (mapcar #'symbol-name (face-list))) - (counsel--faces-format - (format "%%-%ds %%s" - (apply #'max 0 (mapcar #'string-width names))))) - (ivy-read "Face: " names - :require-match t - :history 'face-name-history - :preselect (counsel--face-at-point) - :action counsel-describe-face-function - :caller 'counsel-faces))) - -(ivy-configure 'counsel-faces - :parent 'counsel-describe-face - :format-fn #'counsel--faces-format-function) - -(ivy-set-actions - 'counsel-faces - '(("c" counsel-customize-face "customize") - ("C" counsel-customize-face-other-window "customize other window") - ("h" counsel-highlight-with-face "highlight"))) - -;;;; Modes - -(defvar counsel-minor-history nil - "History for `counsel-minor'.") - -(defun counsel--minor-candidates () - "Return completion alist for `counsel-minor'. - -The alist element is cons of minor mode string with its lighter -and minor mode symbol." - (cl-mapcan - (let ((suffix (propertize " \"%s\"" 'face 'font-lock-string-face))) - (lambda (mode) - (when (and (boundp mode) (commandp mode)) - (let ((lighter (cdr (assq mode minor-mode-alist)))) - (list (cons (concat - (if (symbol-value mode) "-" "+") - (symbol-name mode) - (and lighter - (format suffix - (format-mode-line (cons t lighter))))) - mode)))))) - minor-mode-list)) - -;;;###autoload -(defun counsel-minor () - "Enable or disable minor mode. - -Disabled minor modes are prefixed with \"+\", and -selecting one of these will enable it. -Enabled minor modes are prefixed with \"-\", and -selecting one of these will enable it. - -Additional actions:\\ - - \\[ivy-dispatching-done] d: Go to minor mode definition - \\[ivy-dispatching-done] h: Describe minor mode" - - (interactive) - (ivy-read "Minor modes (enable +mode or disable -mode): " - (counsel--minor-candidates) - :require-match t - :history 'counsel-minor-history - :action (lambda (x) - (call-interactively (cdr x))))) - -(ivy-configure 'counsel-minor - :initial-input "^+" - :sort-fn #'ivy-string<) - -(ivy-set-actions - 'counsel-minor - `(("d" ,(lambda (x) (find-function (cdr x))) "definition") - ("h" ,(lambda (x) (describe-function (cdr x))) "help"))) - -;;;###autoload -(defun counsel-major () - (interactive) - (ivy-read "Major modes: " obarray - :predicate (lambda (f) - (and (commandp f) - (string-suffix-p "-mode" (symbol-name f)) - (or (and (autoloadp (symbol-function f)) - (let ((doc-split (help-split-fundoc (documentation f) f))) - ;; major mode starters have no arguments - (and doc-split (null (cdr (read (car doc-split))))))) - (null (help-function-arglist f))))) - :action #'counsel-M-x-action - :caller 'counsel-major)) - -;;; Git -;;;; `counsel-git' - -(defvar counsel-git-cmd "git ls-files -z --full-name --" - "Command for `counsel-git'.") - -(ivy-set-actions - 'counsel-git - '(("j" find-file-other-window "other window") - ("x" counsel-find-file-extern "open externally"))) - -(defun counsel--dominating-file (file &optional dir) - "Look up directory hierarchy for FILE, starting in DIR. -Like `locate-dominating-file', but DIR defaults to -`default-directory' and the return value is expanded." - (and (setq dir (locate-dominating-file (or dir default-directory) file)) - (expand-file-name dir))) - -(defun counsel-locate-git-root () - "Return the root of the Git repository containing the current buffer." - (or (counsel--git-root) - (error "Not in a Git repository"))) - -(defun counsel-git-cands (dir) - (let ((default-directory dir)) - (split-string - (shell-command-to-string counsel-git-cmd) - "\0" - t))) - -(defvar counsel-git-history nil - "History for `counsel-git'.") - -;;;###autoload -(defun counsel-git (&optional initial-input) - "Find file in the current Git repository. -INITIAL-INPUT can be given as the initial minibuffer input." - (interactive) - (counsel-require-program counsel-git-cmd) - (let ((default-directory (counsel-locate-git-root))) - (ivy-read "Find file: " (counsel-git-cands default-directory) - :initial-input initial-input - :action #'counsel-git-action - :history 'counsel-git-history - :caller 'counsel-git))) - -(ivy-configure 'counsel-git - :occur #'counsel-git-occur) - -(defun counsel-git-action (x) - "Find file X in current Git repository." - (with-ivy-window - (let ((default-directory (ivy-state-directory ivy-last))) - (find-file x)))) - -(defun counsel-git-occur (&optional _cands) - "Occur function for `counsel-git' using `counsel-cmd-to-dired'." - (cd (ivy-state-directory ivy-last)) - (counsel-cmd-to-dired - (counsel--expand-ls - (format "%s | %s | xargs ls" - (replace-regexp-in-string - "\\(-0\\)\\|\\(-z\\)" "" counsel-git-cmd t t) - (counsel--file-name-filter))))) - -(defvar counsel-dired-listing-switches "-alh" - "Switches passed to `ls' for `counsel-cmd-to-dired'.") - -(defun counsel-cmd-to-dired (full-cmd &optional filter) - "Adapted from `find-dired'." - (let ((inhibit-read-only t)) - (erase-buffer) - (dired-mode default-directory counsel-dired-listing-switches) - (defvar dired-sort-inhibit) - (defvar dired-subdir-alist) - (declare-function dired-insert-set-properties "dired") - (declare-function dired-move-to-filename "dired") - (insert " " default-directory ":\n") - (let ((point (point))) - (insert " " full-cmd "\n") - (dired-insert-set-properties point (point))) - (setq-local dired-sort-inhibit t) - (setq-local revert-buffer-function - (lambda (_1 _2) (counsel-cmd-to-dired full-cmd))) - (setq-local dired-subdir-alist - (list (cons default-directory (point-min-marker)))) - (let ((proc (start-process-shell-command - "counsel-cmd" (current-buffer) full-cmd))) - (set-process-filter proc filter) - (set-process-sentinel - proc - (lambda (process _msg) - (when (and (eq (process-status process) 'exit) - (zerop (process-exit-status process))) - (goto-char (point-min)) - (forward-line 2) - (dired-move-to-filename))))))) - -;;;; `counsel-git-grep' - -(defvar counsel-git-grep-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-l") #'ivy-call-and-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) - (define-key map (kbd "C-x C-d") #'counsel-cd) - map)) - -(defvar counsel-git-grep-cmd-default "git --no-pager grep -n --no-color -I -e \"%s\"" - "Initial command for `counsel-git-grep'.") - -(defvar counsel-git-grep-cmd nil - "Store the command for `counsel-git-grep'.") - -(defvar counsel-git-grep-history nil - "History for `counsel-git-grep'.") - -(defvar counsel-git-grep-cmd-history - (list counsel-git-grep-cmd-default) - "History for `counsel-git-grep' shell commands.") - -(defcustom counsel-grep-post-action-hook nil - "Hook that runs after the point moves to the next candidate. -A typical example of what to add to this hook is the function -`recenter'." - :type 'hook - :options '(recenter)) - -(defcustom counsel-git-grep-cmd-function #'counsel-git-grep-cmd-function-default - "How a git-grep shell call is built from the input. -This function should set `ivy--old-re'." - :type '(radio - (function-item counsel-git-grep-cmd-function-default) - (function-item counsel-git-grep-cmd-function-ignore-order) - (function :tag "Other"))) - -(defun counsel-git-grep-cmd-function-default (str) - (format counsel-git-grep-cmd - (setq ivy--old-re - (if (eq ivy--regex-function #'ivy--regex-fuzzy) - (ivy--string-replace "\n" "" (ivy--regex-fuzzy str)) - (ivy--regex str t))))) - -(defun counsel-git-grep-cmd-function-ignore-order (str) - (setq ivy--old-re (ivy--regex str t)) - (let ((parts (split-string str " " t))) - (concat - "git --no-pager grep --full-name -n --no-color -i -e " - (mapconcat #'shell-quote-argument parts " --and -e ")))) - -(defun counsel-git-grep-function (string) - "Grep in the current Git repository for STRING." - (or - (ivy-more-chars) - (ignore - (counsel--async-command - (concat - (funcall counsel-git-grep-cmd-function string) - (and (ivy--case-fold-p string) " -i")))))) - -(defun counsel-git-grep-action (x) - "Go to occurrence X in current Git repository." - (counsel--git-grep-visit x)) - -(defun counsel-git-grep-action-other-window (x) - "Go to occurrence X in current Git repository in another window." - (counsel--git-grep-visit x t)) - -(defun counsel--git-grep-file-and-line (x) - "Extract file name and line number from `counsel-git-grep' line X. -Return a pair (FILE . LINE) on success; nil otherwise." - (and (string-match "\\`\\(.*?\\):\\([0-9]+\\):\\(.*\\)\\'" x) - (cons (match-string-no-properties 1 x) - (string-to-number (match-string-no-properties 2 x))))) - -(defun counsel--git-grep-visit (cand &optional other-window) - "Visit `counsel-git-grep' CAND, optionally in OTHER-WINDOW." - (let ((file-and-line (counsel--git-grep-file-and-line cand))) - (when file-and-line - (funcall (if other-window #'find-file-other-window #'find-file) - (expand-file-name (car file-and-line) - (ivy-state-directory ivy-last))) - (goto-char (point-min)) - (forward-line (1- (cdr file-and-line))) - (when (re-search-forward (ivy--regex ivy-text t) (line-end-position) t) - (when swiper-goto-start-of-match - (goto-char (match-beginning 0)))) - (swiper--ensure-visible) - (run-hooks 'counsel-grep-post-action-hook) - (unless (eq ivy-exit 'done) - (swiper--cleanup) - (swiper--add-overlays (ivy--regex ivy-text)))))) - -(ivy-set-actions - 'counsel-git-grep - '(("j" counsel-git-grep-action-other-window "other window"))) - -(defun counsel-git-grep-transformer (str) - "Highlight file and line number in STR." - (when (string-match "\\`\\([^:]+\\):\\([^:]+\\):" str) - (add-face-text-property (match-beginning 1) (match-end 1) - 'ivy-grep-info nil str) - (add-face-text-property (match-beginning 2) (match-end 2) - 'ivy-grep-line-number nil str)) - str) - -(defvar counsel-git-grep-projects-alist nil - "An alist of project directory to \"git-grep\" command. -Allows to automatically use a custom \"git-grep\" command for all -files in a project.") - -(defun counsel--git-grep-cmd-and-proj (cmd) - (let ((dd (expand-file-name default-directory)) - proj) - (cond - ((stringp cmd)) - (current-prefix-arg - (if (setq proj - (cl-find-if - (lambda (x) - (string-match-p (car x) dd)) - counsel-git-grep-projects-alist)) - (setq cmd (cdr proj)) - (setq cmd - (ivy-read "cmd: " counsel-git-grep-cmd-history - :history 'counsel-git-grep-cmd-history - :re-builder #'ivy--regex)) - (setq counsel-git-grep-cmd-history - (delete-dups counsel-git-grep-cmd-history)))) - (t - (setq cmd counsel-git-grep-cmd-default))) - (cons proj cmd))) - -(defun counsel--call (command &optional result-fn) - "Synchronously call COMMAND and return its output as a string. -COMMAND comprises the program name followed by its arguments, as -in `make-process'. Signal `file-error' and emit a warning if -COMMAND fails. Obey file handlers based on `default-directory'. -On success, RESULT-FN is called in output buffer with no arguments." - (let ((stderr (make-temp-file "counsel-call-stderr-")) - status) - (unwind-protect - (with-temp-buffer - (setq status (apply #'process-file (car command) nil - (list t stderr) nil (cdr command))) - (if (eq status 0) - (if result-fn - (funcall result-fn) - ;; Return all output except trailing newline. - (buffer-substring (point-min) - (- (point) - (if (eq (bobp) (bolp)) - 0 - 1)))) - ;; Convert process status into error list. - (setq status (list 'file-error - (mapconcat #'identity `(,@command "failed") " ") - status)) - ;; Print stderr contents, if any, to *Warnings* buffer. - (let ((msg (condition-case err - (unless (zerop (cadr (insert-file-contents - stderr nil nil nil t))) - (buffer-string)) - (error (error-message-string err))))) - (lwarn 'ivy :warning "%s" (apply #'concat - (error-message-string status) - (and msg (list "\n" msg))))) - ;; Signal `file-error' with process status. - (signal (car status) (cdr status)))) - (delete-file stderr)))) - -(defun counsel--command (&rest command) - "Forward COMMAND to `counsel--call'." - (counsel--call command)) - -(defun counsel--grep-unwind () - (counsel-delete-process) - (swiper--cleanup)) - -;;;###autoload -(defun counsel-git-grep (&optional initial-input initial-directory cmd) - "Grep for a string in the current Git repository. -INITIAL-INPUT can be given as the initial minibuffer input. -INITIAL-DIRECTORY, if non-nil, is used as the root directory for search. -When CMD is a string, use it as a \"git grep\" command. -When CMD is non-nil, prompt for a specific \"git grep\" command." - (interactive) - (let ((proj-and-cmd (counsel--git-grep-cmd-and-proj cmd)) - proj) - (setq proj (car proj-and-cmd)) - (setq counsel-git-grep-cmd (cdr proj-and-cmd)) - (counsel-require-program counsel-git-grep-cmd) - (let ((collection-function - (if proj - #'counsel-git-grep-proj-function - #'counsel-git-grep-function)) - (default-directory (or initial-directory - (if proj - (car proj) - (counsel-locate-git-root))))) - (ivy-read "git grep: " collection-function - :initial-input initial-input - :dynamic-collection t - :keymap counsel-git-grep-map - :action #'counsel-git-grep-action - :history 'counsel-git-grep-history - :require-match t - :caller 'counsel-git-grep)))) - -(defun counsel--git-grep-index (_re-str cands) - (let (name ln) - (cond - (ivy--old-cands - (ivy-recompute-index-swiper-async nil cands)) - ((unless (with-ivy-window - (when buffer-file-name - (setq ln (line-number-at-pos)) - (setq name (file-name-nondirectory buffer-file-name)))) - 0)) - ;; Closest to current line going forwards. - ((let ((beg (1+ (length name)))) - (cl-position-if (lambda (x) - (and (string-prefix-p name x) - (>= (string-to-number (substring x beg)) ln))) - cands))) - ;; Closest to current line going backwards. - ((cl-position-if (lambda (x) - (string-prefix-p name x)) - cands - :from-end t)) - (t 0)))) - -(ivy-configure 'counsel-git-grep - :occur #'counsel-git-grep-occur - :unwind-fn #'counsel--grep-unwind - :index-fn #'counsel--git-grep-index - :display-transformer-fn #'counsel-git-grep-transformer - :grep-p t - :exit-codes '(1 "No matches found")) - -(defun counsel-git-grep-proj-function (str) - "Grep for STR in the current Git repository." - (or - (ivy-more-chars) - (let ((regex (setq ivy--old-re - (ivy--regex str t)))) - (counsel--async-command - (concat - (format counsel-git-grep-cmd regex) - (if (ivy--case-fold-p str) " -i" ""))) - nil))) - -(defun counsel-git-grep-switch-cmd () - "Set `counsel-git-grep-cmd' to a different value." - (interactive) - (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)))) - -(defun counsel--normalize-grep-match (str) - ;; Prepend ./ if necessary: - (unless (ivy--starts-with-dotslash str) - (setq str (concat "./" str))) - ;; Remove column info if any: - (save-match-data - (when (string-match - "[^\n:]+?[^\n/:]:[\t ]*[1-9][0-9]*[\t ]*:\\([1-9][0-9]*:\\)" - str) - (setq str (replace-match "" t t str 1)))) - str) - -(defun counsel--git-grep-occur-cmd (input) - (let* ((regex ivy--old-re) - (positive-pattern ;; git-grep can't handle .*? - (ivy--string-replace ".*?" ".*" (ivy-re-to-str regex))) - (negative-patterns - (if (stringp regex) "" - (mapconcat (lambda (x) - (and (null (cdr x)) - (format "| grep -v %s" (car x)))) - regex - " ")))) - (concat - (format counsel-git-grep-cmd positive-pattern) - negative-patterns - (if (ivy--case-fold-p input) " -i" "")))) - -(defun counsel-git-grep-occur (&optional _cands) - "Generate a custom occur buffer for `counsel-git-grep'." - (counsel-grep-like-occur #'counsel--git-grep-occur-cmd)) - -(defun counsel-git-grep-query-replace () - "Start `query-replace' with string to replace from last search string." - (interactive) - (unless (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 - (ivy-state-directory ivy-last))) - (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)))))))))) - -;;;; `counsel-git-stash' - -(defun counsel-git-stash-kill-action (x) - "Add git stash command to kill ring. -The git command applies the stash entry where candidate X was found in." - (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* ((default-directory (counsel-locate-git-root)) - (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' - -(defvar counsel-git-log-cmd "GIT_PAGER=cat git log --no-color --grep '%s'" - "Command used for \"git log\".") - -(defun counsel-git-log-function (_) - "Search for `ivy-regex' in git log." - (or - (ivy-more-chars) - (progn - ;; `counsel--yank-pop-format-function' uses this - (setq ivy--old-re ivy-regex) - (counsel--async-command - ;; "git log --grep" likes to have groups quoted e.g. \(foo\). - ;; But it doesn't like the non-greedy ".*?". - (format counsel-git-log-cmd - (ivy--string-replace ".*?" ".*" (ivy-re-to-str ivy--old-re)))) - nil))) - -(defun counsel-git-log-action (x) - "Add candidate X to kill ring." - (message "%S" (kill-new x))) - -(declare-function magit-show-commit "ext:magit-diff") - -(defun counsel-git-log-show-commit-action (log-entry) - "Visit the commit corresponding to LOG-ENTRY." - (require 'magit-diff) - (let ((commit (substring-no-properties log-entry 0 (string-match-p "\\W" log-entry)))) - (magit-show-commit commit))) - -(ivy-set-actions - 'counsel-git-log - '(("v" counsel-git-log-show-commit-action "visit commit"))) - -;;;; `counsel-git-change-worktree' - -(defun counsel-git-change-worktree-action (git-root-dir tree) - "Find the corresponding file in the worktree located at tree. -The current buffer is assumed to be in a subdirectory of GIT-ROOT-DIR. -TREE is the selected candidate." - (let* ((new-root-dir (counsel-git-worktree-parse-root tree)) - (tree-filename (file-relative-name buffer-file-name git-root-dir)) - (file-name (expand-file-name tree-filename new-root-dir))) - (find-file file-name))) - -(defun counsel-git-worktree-list () - "List worktrees in the Git repository containing the current buffer." - (let ((default-directory (counsel-locate-git-root))) - (split-string (shell-command-to-string "git worktree list") "\n" t))) - -(defun counsel-git-worktree-parse-root (tree) - "Return worktree from candidate TREE." - (substring tree 0 (ivy--string-search " " tree))) - -(defun counsel-git-close-worktree-files-action (root-dir) - "Close all buffers from the worktree located at ROOT-DIR." - (setq root-dir (counsel-git-worktree-parse-root root-dir)) - (save-excursion - (dolist (buf (buffer-list)) - (set-buffer buf) - (and buffer-file-name - (string= "." (file-relative-name root-dir (counsel-locate-git-root))) - (kill-buffer buf))))) - -(ivy-set-actions - 'counsel-git-change-worktree - '(("k" counsel-git-close-worktree-files-action "kill all"))) - -;;;###autoload -(defun counsel-git-change-worktree () - "Find the file corresponding to the current buffer on a different worktree." - (interactive) - (let ((default-directory (counsel-locate-git-root))) - (ivy-read "Select worktree: " - (or (cl-delete default-directory (counsel-git-worktree-list) - :key #'counsel-git-worktree-parse-root :test #'string=) - (error "No other worktrees")) - :action (lambda (tree) - (counsel-git-change-worktree-action - (ivy-state-directory ivy-last) tree)) - :require-match t - :caller 'counsel-git-change-worktree))) - -;;;; `counsel-git-checkout' - -(defun counsel-git-checkout-action (branch) - "Switch branch by invoking git-checkout(1). -The command is passed a single argument comprising all characters -in BRANCH up to, but not including, the first space -character (#x20), or the string's end if it lacks a space." - (shell-command - (format "git checkout %s" - (shell-quote-argument - (substring branch 0 (ivy--string-search " " branch)))))) - -(defun counsel-git-branch-list () - "Return list of branches in the current Git repository. -Value comprises all local and remote branches bar the one -currently checked out." - (cl-mapcan (lambda (line) - (and (string-match "\\`[[:blank:]]+" line) - (list (substring line (match-end 0))))) - (let ((default-directory (counsel-locate-git-root))) - (split-string (shell-command-to-string - "git branch -vv --all --no-color") - "\n" t)))) - -;;;###autoload -(defun counsel-git-checkout () - "Call the \"git checkout\" command." - (interactive) - (ivy-read "Checkout branch: " (counsel-git-branch-list) - :action #'counsel-git-checkout-action - :caller 'counsel-git-checkout)) - -(defvar counsel-yank-pop-truncate-radius) - -(defun counsel--git-log-format-function (str) - (let ((counsel-yank-pop-truncate-radius 5)) - (counsel--yank-pop-format-function str))) - -;;;###autoload -(defun counsel-git-log () - "Call the \"git log --grep\" shell command." - (interactive) - (ivy-read "Grep log: " #'counsel-git-log-function - :dynamic-collection t - :action #'counsel-git-log-action - :caller 'counsel-git-log)) - -(ivy-configure 'counsel-git-log - :height 4 - :unwind-fn #'counsel-delete-process - :format-fn #'counsel--git-log-format-function) - -(add-to-list 'counsel-async-split-string-re-alist '(counsel-git-log . "^commit ")) -(add-to-list 'counsel-async-ignore-re-alist '(counsel-git-log . "^[ \n]*$")) - -;;; 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) - (define-key map (kbd "`") #'counsel-file-jump-from-find) - (define-key map (kbd "C-`") (ivy-make-magic-action #'counsel-find-file "b")) - (define-key map `[remap ,#'undo] #'counsel-find-file-undo) - map)) - -(defun counsel-file-jump-from-find () - "Switch to `counsel-file-jump' from `counsel-find-file'." - (interactive) - (ivy-quit-and-run - (counsel-file-jump ivy-text (ivy-state-directory ivy-last)))) - -(when (executable-find "git") - (add-to-list 'ivy-ffap-url-functions 'counsel-github-url-p) - (add-to-list 'ivy-ffap-url-functions 'counsel-emacs-url-p)) -(add-to-list 'ivy-ffap-url-functions 'counsel-url-expand) -(defun counsel-find-file-cd-bookmark-action (_) - "Reset `counsel-find-file' from selected directory." - (ivy-read "cd: " - (progn - (ivy--virtual-buffers) - (delete-dups - (mapcar (lambda (x) (file-name-directory (cdr x))) - ivy--virtual-buffers))) - :action (lambda (x) - (let ((default-directory (file-name-directory x))) - (counsel-find-file))))) - -(defcustom counsel-root-command "sudo" - "Command to gain root privileges." - :type 'string) - -(defun counsel-find-file-as-root (x) - "Find file X with root privileges." - (counsel-require-program counsel-root-command) - (let* ((host (file-remote-p x 'host)) - (file-name (format "/%s:%s:%s" - counsel-root-command - (or host "") - (expand-file-name - (if host - (file-remote-p x 'localname) - x))))) - ;; If the current buffer visits the same file we are about to open, - ;; replace the current buffer with the new one. - (if (eq (current-buffer) (get-file-buffer x)) - (find-alternate-file file-name) - (find-file file-name)))) - -(defun counsel--yes-or-no-p (fmt &rest args) - "Ask user a yes or no question created using FMT and ARGS. -If Emacs 26 user option `read-answer-short' is bound, use it to -choose between `yes-or-no-p' and `y-or-n-p'; otherwise default to -`yes-or-no-p'." - (funcall (if (and (boundp 'read-answer-short) - (cond ((eq read-answer-short t)) - ((eq read-answer-short 'auto) - (eq (symbol-function 'yes-or-no-p) 'y-or-n-p)))) - #'y-or-n-p - #'yes-or-no-p) - (apply #'format fmt args))) - -(defun counsel-find-file-copy (x) - "Copy file X." - ;; Autoloaded by `dired'. - (declare-function dired-copy-file "dired-aux") - (counsel--find-file-1 "Copy file to: " - ivy--directory - (lambda (new-name) - (dired-copy-file x new-name 1)) - 'counsel-find-file-copy)) - -(defun counsel-find-file-delete (x) - "Delete file X." - (defvar dired-recursive-deletes) - (declare-function dired-clean-up-after-deletion "dired") - (declare-function dired-delete-file "dired") - (when (or delete-by-moving-to-trash - ;; `dired-delete-file', which see, already prompts for directories - (eq t (car (file-attributes x))) - (counsel--yes-or-no-p "Delete %s? " x)) - (dired-delete-file x dired-recursive-deletes delete-by-moving-to-trash) - (dired-clean-up-after-deletion x) - (let ((win (and (not (eq ivy-exit 'done)) - (active-minibuffer-window)))) - (when win (with-selected-window win (ivy--cd ivy--directory)))))) - -(defun counsel-find-file-move (x) - "Move or rename file X." - ;; Autoloaded by `dired'. - (declare-function dired-rename-file "dired-aux") - (counsel--find-file-1 "Rename file to: " - ivy--directory - (lambda (new-name) - (dired-rename-file x new-name 1)) - 'counsel-find-file-move)) - -(defun counsel-find-file-mkdir-action (_x) - "Create a directory and any nonexistent parent dirs from `ivy-text'." - (let ((dir (file-name-as-directory - (expand-file-name ivy-text ivy--directory))) - (win (and (not (eq ivy-exit 'done)) - (active-minibuffer-window)))) - (make-directory dir t) - (when win (with-selected-window win (ivy--cd dir))))) - -(ivy-set-actions - 'counsel-find-file - '(("j" find-file-other-window "other window") - ("f" find-file-other-frame "other frame") - ("b" counsel-find-file-cd-bookmark-action "cd bookmark") - ("x" counsel-find-file-extern "open externally") - ("r" counsel-find-file-as-root "open as root") - ("R" find-file-read-only "read only") - ("l" find-file-literally "open literally") - ("k" counsel-find-file-delete "delete") - ("c" counsel-find-file-copy "copy file") - ("m" counsel-find-file-move "move or rename") - ("d" counsel-find-file-mkdir-action "mkdir"))) - -(defcustom counsel-find-file-at-point nil - "When non-nil, add file-at-point to the list of candidates." - :type 'boolean) - -(defcustom counsel-preselect-current-file nil - "When non-nil, preselect current file in list of candidates." - :type 'boolean) - -(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." - :type `(choice - (const :tag "None" nil) - (const :tag "Dotfiles and Lockfiles" "\\(?:\\`\\|[/\\]\\)\\(?:[#.]\\)") - (const :tag "Ignored Extensions" - ,(concat (regexp-opt completion-ignored-extensions) "\\'")) - (regexp :tag "Regex"))) - -(defvar counsel--find-file-predicate nil - "When non-nil, `counsel--find-file-matcher' will use this predicate.") - -(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 - (lambda (re-str) - (lambda (x) - (string-match re-str (directory-file-name x))))))) - (when counsel--find-file-predicate - (let ((default-directory ivy--directory)) - (setq res (cl-remove-if-not counsel--find-file-predicate res)))) - (if (or (null ivy-use-ignore) - (null counsel-find-file-ignore-regexp) - (string-match-p counsel-find-file-ignore-regexp ivy-text)) - res - (or (cl-remove-if - (lambda (x) - (and - (string-match-p counsel-find-file-ignore-regexp x) - (not (member x ivy-extra-directories)))) - res) - res)))) - -(declare-function ffap-guesser "ffap") - -(defvar counsel-find-file-speedup-remote t - "Speed up opening remote files by disabling `find-file-hook' for them.") - -(defcustom counsel-find-file-extern-extensions '("mp4" "mkv" "xlsx") - "List of extensions that make `counsel-find-file' use `counsel-find-file-extern'." - :type '(repeat string)) - -(defun counsel-find-file-action (x) - "Find file X." - (cond ((and counsel-find-file-speedup-remote - (file-remote-p ivy--directory)) - (let ((find-file-hook nil)) - (find-file (expand-file-name x ivy--directory)))) - ((member (file-name-extension x) counsel-find-file-extern-extensions) - (counsel-find-file-extern x)) - (t - (find-file (expand-file-name x ivy--directory))))) - -(defun counsel--preselect-file () - "Return candidate to preselect during filename completion. -The preselect behavior can be customized via user options -`counsel-find-file-at-point' and -`counsel-preselect-current-file', which see." - (or - (when counsel-find-file-at-point - (require 'ffap) - (let ((f (ffap-guesser))) - (when (and f (not (ivy-ffap-url-p f))) - (expand-file-name f)))) - (and counsel-preselect-current-file - buffer-file-name - (file-name-nondirectory buffer-file-name)))) - -(defun counsel--find-file-1 (prompt initial-input action caller) - (declare-function dired-current-directory "dired") - (let ((default-directory - (if (derived-mode-p 'dired-mode) - (dired-current-directory) - default-directory))) - (ivy-read prompt #'read-file-name-internal - :matcher #'counsel--find-file-matcher - :initial-input initial-input - :action action - :preselect (counsel--preselect-file) - :require-match 'confirm-after-completion - :history 'file-name-history - :keymap counsel-find-file-map - :caller caller))) - -;;;###autoload -(defun counsel-find-file (&optional initial-input initial-directory) - "Forward to `find-file'. -When INITIAL-INPUT is non-nil, use it in the minibuffer during completion." - (interactive) - (require 'dired) - (defvar tramp-archive-enabled) - (let ((tramp-archive-enabled nil) - (default-directory (or initial-directory default-directory))) - (counsel--find-file-1 "Find file: " initial-input - #'counsel-find-file-action - 'counsel-find-file))) - -(ivy-configure 'counsel-find-file - :parent 'read-file-name-internal - :occur #'counsel-find-file-occur) - -(defvar counsel-find-file-occur-cmd "ls -a | %s | xargs -d '\\n' ls -d --group-directories-first" - "Format string for `counsel-find-file-occur'.") - -(defvar counsel-find-file-occur-use-find (not (eq system-type 'gnu/linux)) - "When non-nil, `counsel-find-file-occur' will use \"find\" as the base cmd.") - -(defun counsel--expand-ls (cmd) - "Expand CMD that ends in \"ls\" with switches." - (concat cmd " " counsel-dired-listing-switches " | sed -e \"s/^/ /\"")) - -(defvar counsel-file-name-filter-alist - '(("ag -i '%s'" . t) - ("ack -i '%s'" . t) - ("perl -ne '/(.*%s.*)/i && print \"$1\\n\";'" . t) - ("grep -i -E '%s'")) - "Alist of file name filtering commands. -The car is a shell command and the cdr is t when the shell -command supports look-arounds. The executable for the commands -will be checked for existence via `executable-find'. The first -one that exists will be used.") - -(defun counsel--file-name-filter (&optional use-ignore) - "Return a command that filters a file list to match ivy candidates. -If USE-IGNORE is non-nil, try to generate a command that respects -`counsel-find-file-ignore-regexp'." - (let ((regex ivy--old-re)) - (if (= 0 (length regex)) - "cat" - (let ((filter-cmd (cl-find-if - (lambda (x) - (executable-find - (car (split-string (car x))))) - counsel-file-name-filter-alist)) - cmd) - (when (and use-ignore ivy-use-ignore - counsel-find-file-ignore-regexp - (cdr filter-cmd) - (not (string-match-p counsel-find-file-ignore-regexp ivy-text)) - (not (string-match-p counsel-find-file-ignore-regexp - (or (car ivy--old-cands) "")))) - (let ((ignore-re (list (counsel--elisp-to-pcre - counsel-find-file-ignore-regexp)))) - (setq regex (if (stringp regex) - (list ignore-re (cons regex t)) - (cons ignore-re regex))))) - (setq cmd (format (car filter-cmd) - (counsel--elisp-to-pcre regex (cdr filter-cmd)))) - (if (string-suffix-p "csh" shell-file-name) - (ivy--string-replace "?!" "?\\!" cmd) - cmd))))) - -(defun counsel--occur-cmd-find () - (let ((cmd (format - "find . -maxdepth 1 | %s | xargs -I {} find {} -maxdepth 0 -ls" - (counsel--file-name-filter t)))) - (concat - (counsel--cmd-to-dired-by-type "d" cmd) - " && " - (counsel--cmd-to-dired-by-type "f" cmd)))) - -(defun counsel--cmd-to-dired-by-type (type cmd) - (let ((exclude-dots - (unless (string-prefix-p "." ivy-text) - " | grep -v '/\\.'"))) - (ivy--string-replace - " | grep" - (concat " -type " type exclude-dots " | grep") cmd))) - -(defun counsel-find-file-occur (&optional _cands) - (require 'find-dired) - (cd ivy--directory) - (if counsel-find-file-occur-use-find - (counsel-cmd-to-dired - (counsel--occur-cmd-find) - 'find-dired-filter) - (counsel-cmd-to-dired - (counsel--expand-ls - (format counsel-find-file-occur-cmd - (if (ivy--string-search "grep" counsel-find-file-occur-cmd) - ;; for backwards compatibility - (counsel--elisp-to-pcre ivy--old-re) - (counsel--file-name-filter t))))))) - -(defvar counsel-up-directory-level t - "Control whether `counsel-up-directory' goes up a level or always a directory. - -If non-nil, then `counsel-up-directory' will remove the final level of the path. -For example: /a/long/path/file.jpg => /a/long/path/ - /a/long/path/ => /a/long/ - -If nil, then `counsel-up-directory' will go up a directory. -For example: /a/long/path/file.jpg => /a/long/ - /a/long/path/ => /a/long/") - -(defun counsel-up-directory () - "Go to the parent directory preselecting the current one. - -If the current directory is remote and it's not possible to go up any -further, make the remote prefix editable. - -See variable `counsel-up-directory-level'." - (interactive) - (let* ((cur-dir (directory-file-name (expand-file-name ivy--directory))) - (up-dir (file-name-directory cur-dir))) - (if (and (file-remote-p cur-dir) (string-equal cur-dir up-dir)) - (progn - ;; make the remote prefix editable - (setq ivy--old-cands nil) - (setq ivy--old-re nil) - (ivy-set-index 0) - (setq ivy--directory "") - (setq ivy--all-candidates nil) - (ivy-set-text "") - (delete-minibuffer-contents) - (insert up-dir)) - (if (and counsel-up-directory-level (not (string= ivy-text ""))) - (delete-region (line-beginning-position) (line-end-position)) - (ivy--cd up-dir) - (setf (ivy-state-preselect ivy-last) - (file-name-as-directory (file-name-nondirectory cur-dir))))))) - -(defun counsel-down-directory () - "Descend into the current directory." - (interactive) - (ivy--directory-enter)) - -(defun counsel-find-file-undo () - (interactive) - (if (string= ivy-text "") - (let ((dir (progn - (pop ivy--directory-hist) - (pop ivy--directory-hist)))) - (when dir - (ivy--cd dir))) - (undo))) - -(defun counsel-at-git-issue-p () - "When point is at an issue in a Git-versioned file, return the issue string." - (and (looking-at "#[0-9]+") - (save-match-data - (or (eq (vc-backend buffer-file-name) 'Git) - (memq major-mode '(magit-commit-mode vc-git-log-view-mode)) - (bound-and-true-p magit-commit-mode))) - (match-string-no-properties 0))) - -(defun counsel-github-url-p () - "Return a Github issue URL at point." - (when (counsel-require-program "git" t) - (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 (and (counsel-require-program "git" t) - (counsel-at-git-issue-p)))) - (when url - (let ((origin (shell-command-to-string "git remote get-url origin"))) - (when (string-match-p "git.sv.gnu.org:/srv/git/emacs.git" origin) - (format "https://bugs.gnu.org/%s" (substring url 1))))))) - -(defvar counsel-url-expansions-alist nil - "Map of regular expressions to expansions. - -The value of this variable is a list of pairs (REGEXP . FORMAT). - -`counsel-url-expand' expands the word at point according to -FORMAT for the first matching REGEXP. FORMAT can be either a -string or a function. If it is a string, it is used as the -format string for the function `format', with the word at point -as the next argument. If it is a function, it is called with the -word at point as the sole argument. - -For example, a pair of the form: - \\='(\"\\\\\\=`BSERV-[[:digit:]]+\\\\\\='\" . - \"https://jira.atlassian.com/browse/%s\") -expands to the URL `https://jira.atlassian.com/browse/BSERV-100' -when the word at point is \"BSERV-100\". - -If FORMAT is a function, more powerful transformations are -possible. As an example, - \\='(\"\\\\\\=`issue\\\\([[:digit:]]+\\\\)\\\\\\='\" . - (lambda (word) - (concat \"https://bugs.gnu.org/\" (match-string 1 word)))) -trims the \"issue\" prefix from the word at point before creating -the URL.") - -(defun counsel-url-expand () - "Expand word at point using `counsel-url-expansions-alist'. -The first pair in the list whose regexp matches the word at point -will be expanded according to its format. This function is -intended to be used in `ivy-ffap-url-functions' to browse the -result as a URL." - (let ((word-at-point (current-word))) - (when word-at-point - (cl-some - (lambda (pair) - (let ((regexp (car pair)) - (formatter (cdr pair))) - (when (string-match regexp word-at-point) - (if (functionp formatter) - (funcall formatter word-at-point) - (format formatter word-at-point))))) - counsel-url-expansions-alist)))) - -;;;; `counsel-dired' - -;;;###autoload -(defun counsel-dired (&optional initial-input) - "Forward to `dired'. -When INITIAL-INPUT is non-nil, use it in the minibuffer during completion." - (interactive) - (require 'dired) - (let ((counsel--find-file-predicate #'file-directory-p)) - (counsel--find-file-1 - "Dired (directory): " initial-input - (lambda (d) (dired (expand-file-name d))) - 'counsel-dired))) - -(ivy-configure 'counsel-dired - :parent 'read-file-name-internal) - -;;;; `counsel-recentf' - -(defvar recentf-list) -(declare-function recentf-mode "recentf") - -(defcustom counsel-recentf-include-xdg-list nil - "Include recently used files listed by XDG-compliant environments. -Examples of such environments are GNOME and KDE. See the URL -`https://www.freedesktop.org/wiki/Specifications/desktop-bookmark-spec'." - :type 'boolean - :link '(url-link "\ -https://www.freedesktop.org/wiki/Specifications/desktop-bookmark-spec")) - -;;;###autoload -(defun counsel-recentf () - "Find a file on `recentf-list'." - (interactive) - (recentf-mode) - (ivy-read "Recentf: " (counsel-recentf-candidates) - :action (lambda (f) - (with-ivy-window - (find-file f))) - :require-match t - :caller 'counsel-recentf)) - -(ivy-set-actions - 'counsel-recentf - `(("j" find-file-other-window "other window") - ("f" find-file-other-frame "other frame") - ("x" counsel-find-file-extern "open externally") - ("d" ,(lambda (file) (setq recentf-list (delete file recentf-list))) - "delete from recentf"))) - -(defun counsel-recentf-candidates () - "Return candidates for `counsel-recentf'. - -When `counsel-recentf-include-xdg-list' is non-nil, also include -the files in said list, sorting the combined list by file access -time." - (if (and counsel-recentf-include-xdg-list - (>= emacs-major-version 26)) - (delete-dups - (sort (nconc (mapcar #'substring-no-properties recentf-list) - (counsel--recentf-get-xdg-recent-files)) - (lambda (file1 file2) - (cond ((file-remote-p file1) - nil) - ((file-remote-p file2)) - (t - ;; Added in Emacs 26.1. - (declare-function file-attribute-access-time "files" - (attributes)) - (time-less-p (file-attribute-access-time - (file-attributes file2)) - (file-attribute-access-time - (file-attributes file1)))))))) - (mapcar #'substring-no-properties recentf-list))) - -(defalias 'counsel--xml-parse-region - (if (cond ((fboundp 'libxml-available-p) - ;; Added in Emacs 27.1. - (libxml-available-p)) - ((fboundp 'libxml-parse-xml-region) - ;; Checking for `fboundp' is not enough on Windows, where it - ;; will return non-nil even if the library is not installed. - (with-temp-buffer - (insert "") - (libxml-parse-xml-region (point-min) (point-max))))) - (lambda (&optional beg end) - (libxml-parse-xml-region (or beg (point-min)) (or end (point-max)))) - #'xml-parse-region) - "Compatibility shim for `libxml-parse-xml-region'. -For convenience, BEG and END default to `point-min' and -`point-max', respectively. - -\(fn &optional BEG END)") - -(defun counsel--recentf-get-xdg-recent-files () - "Return list of XDG recent files. - -This information is parsed from the file \"recently-used.xbel\", -which lists both files and directories, under `xdg-data-home'. -This function uses the `dom' library from Emacs 25.1 or later." - (unless (eval-and-compile (require 'dom nil t)) - (user-error "This function requires Emacs 25.1 or later")) - (declare-function dom-by-tag "dom" (dom tag)) - (let ((file-of-recent-files - (expand-file-name "recently-used.xbel" (counsel--xdg-data-home)))) - (unless (file-readable-p file-of-recent-files) - (user-error "List of XDG recent files not found: %s" - file-of-recent-files)) - (when (fboundp 'dom-attr) ;; Pacify Emacs 24. - (cl-mapcan (lambda (bookmark-node) - (let* ((file (dom-attr bookmark-node 'href)) - (file (string-remove-prefix "file://" file)) - (file (url-unhex-string file t)) - (file (decode-coding-string file 'utf-8 t))) - (and (file-exists-p file) - (list file)))) - (let ((dom (with-temp-buffer - (insert-file-contents file-of-recent-files) - (counsel--xml-parse-region)))) - (nreverse (dom-by-tag dom 'bookmark))))))) - -(defun counsel-buffer-or-recentf-candidates () - "Return candidates for `counsel-buffer-or-recentf'." - (recentf-mode) - (let ((buffers (delq nil (mapcar #'buffer-file-name (buffer-list))))) - (nconc - buffers - (cl-remove-if (lambda (f) (member f buffers)) - (counsel-recentf-candidates))))) - -;;;###autoload -(defun counsel-buffer-or-recentf () - "Find a buffer visiting a file or file on `recentf-list'." - (interactive) - (ivy-read "Buffer File or Recentf: " (counsel-buffer-or-recentf-candidates) - :action (lambda (s) - (with-ivy-window - (if (bufferp s) - (switch-to-buffer s) - (find-file s)))) - :require-match t - :caller 'counsel-buffer-or-recentf)) - -(ivy-configure 'counsel-buffer-or-recentf - :display-transformer-fn #'counsel-buffer-or-recentf-transformer) - -(ivy-set-actions - 'counsel-buffer-or-recentf - '(("j" find-file-other-window "other window") - ("f" find-file-other-frame "other frame") - ("x" counsel-find-file-extern "open externally"))) - -(defun counsel-buffer-or-recentf-transformer (var) - "Propertize VAR if it's a buffer visiting a file." - (if (member var (mapcar #'buffer-file-name (buffer-list))) - (ivy-append-face var 'ivy-highlight-face) - var)) - -;;;; `counsel-bookmark' - -(defcustom counsel-bookmark-avoid-dired nil - "If non-nil, open directory bookmarks with `counsel-find-file'. -By default `counsel-bookmark' opens a dired buffer for directories." - :type 'boolean) - -(defvar bookmark-alist) -(declare-function bookmark-location "bookmark") -(declare-function bookmark-all-names "bookmark") -(declare-function bookmark-get-filename "bookmark") -(declare-function bookmark-maybe-load-default-file "bookmark") - -;;;###autoload -(defun counsel-bookmark () - "Forward to `bookmark-jump' or `bookmark-set' if bookmark doesn't exist." - (interactive) - (require 'bookmark) - (ivy-read "Create or jump to bookmark: " - (bookmark-all-names) - :history 'bookmark-history - :action (lambda (x) - (cond ((and counsel-bookmark-avoid-dired - (member x (bookmark-all-names)) - (file-directory-p (bookmark-location x))) - (with-ivy-window - (let ((default-directory (bookmark-location x))) - (counsel-find-file)))) - ((member x (bookmark-all-names)) - (with-ivy-window - (bookmark-jump x))) - (t - (bookmark-set x)))) - :caller 'counsel-bookmark)) - -(defun counsel--apply-bookmark-fn (fn) - "Return a function applying FN to a bookmark's location." - (lambda (bookmark) - (funcall fn (bookmark-location bookmark)))) - -(ivy-set-actions - 'counsel-bookmark - `(("j" bookmark-jump-other-window "other window") - ("d" bookmark-delete "delete") - ("e" bookmark-rename "edit") - ("s" bookmark-set "overwrite") - ("x" ,(counsel--apply-bookmark-fn #'counsel-find-file-extern) - "open externally") - ("r" ,(counsel--apply-bookmark-fn #'counsel-find-file-as-root) - "open as root"))) - -;;;; `counsel-bookmarked-directory' - -(defun counsel-bookmarked-directory--candidates () - "Get a list of bookmarked directories sorted by file path." - (bookmark-maybe-load-default-file) - (sort (cl-delete-if-not - #'ivy--dirname-p - (delq nil (mapcar #'bookmark-get-filename bookmark-alist))) - #'string<)) - -;;;###autoload -(defun counsel-bookmarked-directory () - "Ivy interface for bookmarked directories. - -With a prefix argument, this command creates a new bookmark which points to the -current value of `default-directory'." - (interactive) - (require 'bookmark) - (ivy-read "Bookmarked directory: " - (counsel-bookmarked-directory--candidates) - :caller 'counsel-bookmarked-directory - :action #'dired)) - -(ivy-set-actions 'counsel-bookmarked-directory - `(("j" ,#'dired-other-window "other window") - ("x" ,#'counsel-find-file-extern "open externally") - ("r" ,#'counsel-find-file-as-root "open as root") - ("f" ,(lambda (dir) - (let ((default-directory dir)) - (call-interactively #'find-file))) - "find-file"))) - -;;;; `counsel-file-register' - -;;;###autoload -(defun counsel-file-register () - "Search file in register. - -You cannot use Emacs' normal register commands to create file -registers. Instead you must use the `set-register' function like -so: `(set-register ?i \"/home/eric/.emacs.d/init.el\")'. Now you -can use `C-x r j i' to open that file." - (interactive) - (ivy-read "File Register: " - ;; Use the `register-alist' variable to filter out file - ;; registers. Each entry for a file register will have the - ;; following layout: - ;; - ;; (NUMBER 'file . "string/path/to/file") - ;; - ;; So we go through each entry and see if the `cadr' is - ;; `eq' to the symbol `file'. If so then add the filename - ;; (`cddr') which `ivy-read' will use for its choices. - (mapcar (lambda (register-alist-entry) - (if (eq 'file (cadr register-alist-entry)) - (cddr register-alist-entry))) - register-alist) - :require-match t - :history 'counsel-file-register - :caller 'counsel-file-register - :action (lambda (register-file) - (with-ivy-window (find-file register-file))))) - -(ivy-configure 'counsel-file-register - :sort-fn #'ivy-string<) - -(ivy-set-actions - 'counsel-file-register - '(("j" find-file-other-window "other window"))) - -;;;; `counsel-locate' - -(defcustom counsel-locate-cmd (cond ((memq system-type '(darwin berkeley-unix)) - #'counsel-locate-cmd-noregex) - ((and (eq system-type 'windows-nt) - (executable-find "es.exe")) - #'counsel-locate-cmd-es) - (t - #'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." - :type '(choice - (const :tag "Default" counsel-locate-cmd-default) - (const :tag "No regex" counsel-locate-cmd-noregex) - (const :tag "mdfind" counsel-locate-cmd-mdfind) - (const :tag "everything" counsel-locate-cmd-es) - (function :tag "Custom"))) - -(ivy-set-actions - 'counsel-locate - '(("x" counsel-locate-action-extern "xdg-open") - ("r" counsel-find-file-as-root "open as root") - ("d" counsel-locate-action-dired "dired"))) - -(defvar counsel-locate-history nil - "History for `counsel-locate'.") - -;;;###autoload -(defun counsel-locate-action-extern (x) - "Pass X to `xdg-open' or equivalent command via the shell." - (interactive "FFile: ") - (if (and (eq system-type 'windows-nt) - (fboundp 'w32-shell-execute)) - (w32-shell-execute "open" x) - (call-process-shell-command (format "%s %s" - (cl-case system-type - (darwin "open") - (cygwin "cygstart") - (t "xdg-open")) - (shell-quote-argument x)) - nil 0))) - -(defalias 'counsel-find-file-extern #'counsel-locate-action-extern) - -(eval-and-compile - ;; Autoloaded by `dired' since Emacs 28. - (unless (fboundp 'dired-jump) - (autoload 'dired-jump "dired-x" nil t))) - -(defun counsel-locate-action-dired (x) - "Use `dired-jump' on X." - (dired-jump nil x)) - -(defvar locate-command) - -(defun counsel-locate-cmd-default (input) - "Return a `locate' shell command based on regexp INPUT. -This uses the user option `locate-command' from the `locate' -library, which see." - (counsel-require-program locate-command) - (format "%s -i --regex %s" - locate-command - (shell-quote-argument - (counsel--elisp-to-pcre - (ivy--regex input))))) - -(defun counsel-locate-cmd-noregex (input) - "Return a `locate' shell command based on INPUT. -This uses the user option `locate-command' from the `locate' -library, which see." - (counsel-require-program locate-command) - (format "%s -i %s" - locate-command - (shell-quote-argument input))) - -(defun counsel-locate-cmd-mdfind (input) - "Return a `mdfind' shell command based on INPUT." - (counsel-require-program "mdfind") - (format "mdfind -name %s 2>%s" - (shell-quote-argument input) - (shell-quote-argument (counsel--null-device)))) - -(defun counsel-locate-cmd-es (input) - "Return a `es' shell command based on INPUT." - (defvar w32-ansi-code-page) - (counsel-require-program "es.exe") - (let ((raw-string (format "es.exe -i -p -r %s" - (counsel--elisp-to-pcre - (ivy--regex input t))))) - ;; W32 doesn't use Unicode by default, so we encode search command - ;; to local codepage to support searching file names containing - ;; non-ASCII characters. - (if (and (eq system-type 'windows-nt) - (boundp 'w32-ansi-code-page)) - (encode-coding-string raw-string - (intern (format "cp%d" w32-ansi-code-page))) - raw-string))) - -(defun counsel-locate-function (input) - "Call a \"locate\" style shell command with INPUT." - (or - (ivy-more-chars) - (progn - (counsel--async-command - (funcall counsel-locate-cmd input)) - '("" "working...")))) - -(defcustom counsel-locate-db-path "~/.local/mlocate.db" - "Location where to put the locatedb in case your home folder is encrypted." - :type 'file) - -(defun counsel-file-stale-p (fname seconds) - "Return non-nil if FNAME was modified more than SECONDS ago." - (> (float-time (time-since (nth 5 (file-attributes fname)))) - seconds)) - -(defun counsel--locate-updatedb () - (when (file-exists-p "~/.Private") - (let ((db-fname (expand-file-name counsel-locate-db-path))) - (setenv "LOCATE_PATH" db-fname) - (when (or (not (file-exists-p db-fname)) - (counsel-file-stale-p db-fname 60)) - (message "Updating %s..." db-fname) - (counsel--command - "updatedb" "-l" "0" "-o" db-fname "-U" (expand-file-name "~")))))) - -;;;###autoload -(defun counsel-locate (&optional initial-input) - "Call a \"locate\" style shell command. -INITIAL-INPUT can be given as the initial minibuffer input." - (interactive) - ;; For `locate-command', which is honored in some options of `counsel-locate-cmd'. - (require 'locate) - (counsel--locate-updatedb) - (ivy-read "Locate: " #'counsel-locate-function - :initial-input initial-input - :dynamic-collection t - :history 'counsel-locate-history - :action (lambda (file) - (when file - (with-ivy-window - (find-file - (concat (file-remote-p default-directory) file))))) - :caller 'counsel-locate)) - -(ivy-configure 'counsel-locate - :unwind-fn #'counsel-delete-process - :exit-codes '(1 "Nothing found")) - -;;;; `counsel-tracker' - -(defun counsel-tracker-function (input) - "Call the \"tracker\" shell command with INPUT." - (or - (ivy-more-chars) - (progn - (counsel--async-command - (format - "tracker sparql -q \"SELECT ?url WHERE { ?s a nfo:FileDataObject ; nie:url ?url . FILTER (STRSTARTS (?url, 'file://$HOME/')) . FILTER regex(?url, '%s') }\" | tail -n +2 | head -n -1" - (counsel--elisp-to-pcre (funcall ivy--regex-function input)))) - '("" "working...")))) - -(defun counsel-tracker-transformer (str) - (if (string-match "file:///" str) - (decode-coding-string (url-unhex-string (substring str 9)) 'utf-8) - str)) - -;;;###autoload -(defun counsel-tracker () - (interactive) - (ivy-read "Tracker: " 'counsel-tracker-function - :dynamic-collection t - :action (lambda (s) (find-file (counsel-tracker-transformer s))) - :caller 'counsel-tracker)) - -(ivy-configure 'counsel-tracker - :display-transformer-fn #'counsel-tracker-transformer - :unwind-fn #'counsel-delete-process) - -;;;; `counsel-fzf' - -(defvar counsel-fzf-cmd "fzf -f \"%s\"" - "Command for `counsel-fzf'.") - -(defvar counsel--fzf-dir nil - "Store the base fzf directory.") - -(defvar counsel-fzf-dir-function #'counsel-fzf-dir-function-projectile - "Function that returns a directory for fzf to use.") - -(defun counsel-fzf-dir-function-projectile () - (if (and - (fboundp 'projectile-project-p) - (fboundp 'projectile-project-root) - (projectile-project-p)) - (projectile-project-root) - default-directory)) - -(defun counsel-fzf-function (str) - (let ((default-directory counsel--fzf-dir)) - (setq ivy--old-re (ivy--regex-fuzzy str)) - (counsel--async-command - (format counsel-fzf-cmd str))) - nil) - -;;;###autoload -(defun counsel-fzf (&optional initial-input initial-directory fzf-prompt) - "Open a file using the fzf shell command. -INITIAL-INPUT can be given as the initial minibuffer input. -INITIAL-DIRECTORY, if non-nil, is used as the root directory for search. -FZF-PROMPT, if non-nil, is passed as `ivy-read' prompt argument." - (interactive - (let ((fzf-basename (car (split-string counsel-fzf-cmd)))) - (list nil - (when current-prefix-arg - (counsel-read-directory-name (concat - fzf-basename - " in directory: ")))))) - (counsel-require-program counsel-fzf-cmd) - (setq counsel--fzf-dir - (or initial-directory - (funcall counsel-fzf-dir-function))) - (ivy-read (or fzf-prompt "fzf: ") - #'counsel-fzf-function - :initial-input initial-input - :re-builder #'ivy--regex-fuzzy - :dynamic-collection t - :action #'counsel-fzf-action - :caller 'counsel-fzf)) - -(ivy-configure 'counsel-fzf - :occur #'counsel-fzf-occur - :unwind-fn #'counsel-delete-process - :exit-codes '(1 "Nothing found")) - -(defun counsel-fzf-action (x) - "Find file X in current fzf directory." - (with-ivy-window - (let ((default-directory counsel--fzf-dir)) - (find-file x)))) - -(defun counsel-fzf-occur (&optional _cands) - "Occur function for `counsel-fzf' using `counsel-cmd-to-dired'." - (cd counsel--fzf-dir) - (counsel-cmd-to-dired - (counsel--expand-ls - (format - "%s --print0 | xargs -0 ls" - (format counsel-fzf-cmd ivy-text))))) - -(ivy-set-actions - 'counsel-fzf - '(("x" counsel-locate-action-extern "xdg-open") - ("d" counsel-locate-action-dired "dired"))) - -;;;; `counsel-dpkg' - -;;;###autoload -(defun counsel-dpkg () - "Call the \"dpkg\" shell command." - (interactive) - (counsel-require-program "dpkg") - (let ((cands (mapcar - (lambda (x) - (let ((y (split-string x " +"))) - (cons (format "%-40s %s" - (ivy--truncate-string - (nth 1 y) 40) - (nth 4 y)) - (mapconcat #'identity y " ")))) - (split-string - (shell-command-to-string "dpkg -l | tail -n+6") "\n" t)))) - (ivy-read "dpkg: " cands - :action (lambda (x) - (message (cdr x))) - :caller 'counsel-dpkg))) - -;;;; `counsel-rpm' - -;;;###autoload -(defun counsel-rpm () - "Call the \"rpm\" shell command." - (interactive) - (counsel-require-program "rpm") - (let ((cands (mapcar - (lambda (x) - (let ((y (split-string x "|"))) - (cons (format "%-40s %s" - (ivy--truncate-string - (nth 0 y) 40) - (nth 1 y)) - (mapconcat #'identity y " ")))) - (split-string - (shell-command-to-string "rpm -qa --qf \"%{NAME}|%{SUMMARY}\\n\"") "\n" t)))) - (ivy-read "rpm: " cands - :action (lambda (x) - (message (cdr x))) - :caller 'counsel-rpm))) - -(defun counsel--find-return-list (args) - (unless (listp args) - (user-error - "`counsel-file-jump-args' is a list now; please customize accordingly")) - (counsel--call - (cons find-program args) - (lambda () - (let (files) - (goto-char (point-min)) - (while (< (point) (point-max)) - (when (looking-at "\\./") - (goto-char (match-end 0))) - (push (buffer-substring (point) (line-end-position)) files) - (beginning-of-line 2)) - (nreverse files))))) - -(defcustom counsel-file-jump-args (split-string ". -name .git -prune -o -type f -print") - "Arguments for the `find-command' when using `counsel-file-jump'." - :type '(repeat string)) - -;;;; `counsel-file-jump' - -(defvar counsel-file-jump-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "`") #'counsel-find-file-from-jump) - map) - "Key bindings to be used when in a file-jump minibuffer.") - -(defun counsel-find-file-from-jump () - "Switch to `counsel-find-file' from `counsel-file-jump'." - (interactive) - (ivy-quit-and-run - (counsel-find-file ivy-text (ivy-state-directory ivy-last)))) - -;;;###autoload -(defun counsel-file-jump (&optional initial-input initial-directory) - "Jump to a file below the current directory. -List all files within the current directory or any of its sub-directories. -INITIAL-INPUT can be given as the initial minibuffer input. -INITIAL-DIRECTORY, if non-nil, is used as the root directory for search." - (interactive - (list nil - (when current-prefix-arg - (counsel-read-directory-name "From directory: ")))) - (counsel-require-program find-program) - (let ((default-directory (or initial-directory default-directory))) - (ivy-read "Find file: " - (counsel--find-return-list counsel-file-jump-args) - :matcher #'counsel--find-file-matcher - :initial-input initial-input - :action #'find-file - :preselect (counsel--preselect-file) - :require-match 'confirm-after-completion - :history 'file-name-history - :keymap counsel-file-jump-map - :caller 'counsel-file-jump))) - -(ivy-set-actions - 'counsel-file-jump - `(("d" ,(lambda (x) - (dired (or (file-name-directory x) default-directory))) - "open in dired"))) - -;;;; `counsel-dired-jump' - -(defcustom counsel-dired-jump-args (split-string ". -name .git -prune -o -type d -print") - "Arguments for the `find-command' when using `counsel-dired-jump'." - :type '(repeat string)) - -;;;###autoload -(defun counsel-dired-jump (&optional initial-input initial-directory) - "Jump to a directory (see `dired-jump') below the current directory. -List all sub-directories within the current directory. -INITIAL-INPUT can be given as the initial minibuffer input. -INITIAL-DIRECTORY, if non-nil, is used as the root directory for search." - (interactive - (list nil - (when current-prefix-arg - (counsel-read-directory-name "From directory: ")))) - (counsel-require-program find-program) - (let ((default-directory (or initial-directory default-directory))) - (ivy-read "Find directory: " - (cdr - (counsel--find-return-list counsel-dired-jump-args)) - :matcher #'counsel--find-file-matcher - :initial-input initial-input - :action (lambda (d) (dired-jump nil (expand-file-name d))) - :history 'file-name-history - :keymap counsel-find-file-map - :caller 'counsel-dired-jump))) - -;;; Grep -;;;; `counsel-ag' - -(defvar counsel-ag-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-l") #'ivy-call-and-recenter) - (define-key map (kbd "M-q") #'counsel-git-grep-query-replace) - (define-key map (kbd "C-'") #'swiper-avy) - (define-key map (kbd "C-x C-d") #'counsel-cd) - map)) - -(defcustom counsel-ag-base-command (list "ag" "--vimgrep" "%s") - "Template for default `counsel-ag' command. -The value should be either a list of strings, starting with the -`ag' executable file name and followed by its arguments, or a -single string describing a full `ag' shell command. - -If the command is specified as a list, `ag' is called directly -using `process-file'; otherwise, it is called as a shell command. -Calling `ag' directly avoids various shell quoting pitfalls, so -it is generally recommended. - -If the string \"%s\" appears as an element of the list, or as a -substring of the command string, it is replaced by any optional -`ag' arguments followed by the search regexp specified during the -`counsel-ag' session." - :package-version '(counsel . "0.14.0") - :type '(choice (repeat :tag "Command list to call directly" string) - (string :tag "Shell command"))) - -(defvar counsel-ag-command nil) - -(defvar counsel--grep-tool-look-around t) - -(defvar counsel--regex-look-around nil) - -(defconst counsel--command-args-separator " -- ") - -(defun counsel--split-command-args (arguments) - "Split ARGUMENTS into its switches and search-term parts. -Return pair of corresponding strings (SWITCHES . SEARCH-TERM)." - (if (string-match counsel--command-args-separator arguments) - (let ((args (substring arguments (match-end 0))) - (search-term (substring arguments 0 (match-beginning 0)))) - (if (string-prefix-p "-" arguments) - (cons search-term args) - (cons args search-term))) - (cons "" arguments))) - -(defun counsel--format-ag-command (extra-args needle) - "Construct a complete `counsel-ag-command' as a string. -EXTRA-ARGS is a string of the additional arguments. -NEEDLE is the search string." - (counsel--format counsel-ag-command - (if (listp counsel-ag-command) - (if (string-match " \\(--\\) " extra-args) - (counsel--format - (split-string (replace-match "%s" t t extra-args 1)) - needle) - (nconc (split-string extra-args) needle)) - (if (string-match " \\(--\\) " extra-args) - (replace-match needle t t extra-args 1) - (concat extra-args " " needle))))) - -(defun counsel--grep-regex (str) - (counsel--elisp-to-pcre - (setq ivy--old-re - (funcall (ivy-state-re-builder ivy-last) str)) - counsel--regex-look-around)) - -(defun counsel--ag-extra-switches (regex) - "Get additional switches needed for look-arounds." - (and (stringp counsel--regex-look-around) - ;; using look-arounds - (string-match-p "\\`\\^(\\?[=!]" regex) - (concat " " counsel--regex-look-around " "))) - -(defun counsel-ag-function (string) - "Grep in the current directory for STRING." - (let* ((command-args (counsel--split-command-args string)) - (search-term (cdr command-args))) - (or - (let ((ivy-text search-term)) - (ivy-more-chars)) - (let* ((default-directory (ivy-state-directory ivy-last)) - (regex (counsel--grep-regex search-term)) - (switches (concat (if (ivy--case-fold-p string) - " -i " - " -s ") - (counsel--ag-extra-switches regex) - (car command-args)))) - (counsel--async-command (counsel--format-ag-command - switches - (funcall (if (listp counsel-ag-command) #'identity - #'shell-quote-argument) - regex))) - nil)))) - -;;;###autoload -(cl-defun counsel-ag (&optional initial-input initial-directory extra-ag-args ag-prompt - &key caller) - "Grep for a string in a root directory using `ag'. - -By default, the root directory is the first directory containing -a .git subdirectory. - -INITIAL-INPUT can be given as the initial minibuffer input. -INITIAL-DIRECTORY, if non-nil, is used as the root directory for search. -EXTRA-AG-ARGS, if non-nil, is appended to `counsel-ag-base-command'. -AG-PROMPT, if non-nil, is passed as `ivy-read' prompt argument. -CALLER is passed to `ivy-read'. - -With a `\\[universal-argument]' prefix argument, prompt for INITIAL-DIRECTORY. -With a `\\[universal-argument] \\[universal-argument]' prefix argument, \ -prompt additionally for EXTRA-AG-ARGS." - (interactive) - (setq counsel-ag-command counsel-ag-base-command) - (setq counsel--regex-look-around counsel--grep-tool-look-around) - (counsel-require-program counsel-ag-command) - (let ((prog-name (car (if (listp counsel-ag-command) counsel-ag-command - (split-string counsel-ag-command)))) - (arg (prefix-numeric-value current-prefix-arg))) - (when (>= arg 4) - (setq initial-directory - (or initial-directory - (counsel-read-directory-name (concat - prog-name - " in directory: "))))) - (when (>= arg 16) - (setq extra-ag-args - (or extra-ag-args - (read-from-minibuffer (format "%s args: " prog-name))))) - (setq counsel-ag-command (counsel--format-ag-command (or extra-ag-args "") "%s")) - (let ((default-directory (or initial-directory - (counsel--git-root) - default-directory))) - (ivy-read (or ag-prompt - (concat prog-name ": ")) - #'counsel-ag-function - :initial-input initial-input - :dynamic-collection t - :keymap counsel-ag-map - :history 'counsel-git-grep-history - :action #'counsel-git-grep-action - :require-match t - :caller (or caller 'counsel-ag))))) - -(ivy-configure 'counsel-ag - :occur #'counsel-ag-occur - :unwind-fn #'counsel--grep-unwind - :display-transformer-fn #'counsel-git-grep-transformer - :grep-p t - :exit-codes '(1 "No matches found")) - -(defun counsel-read-directory-name (prompt &optional default) - "Read a directory name. -This is intended as a (partial) replacement for -`read-directory-name'." - (let ((counsel--find-file-predicate #'file-directory-p)) - (ivy-read prompt - #'read-file-name-internal - :matcher #'counsel--find-file-matcher - :def default - :history 'file-name-history - :keymap counsel-find-file-map - :caller 'counsel-read-directory-name))) - -(ivy-configure 'counsel-read-directory-name - :parent 'read-file-name-internal) - -(defun counsel-cd () - "Change the directory for the currently running Ivy grep-like command. -Works for `counsel-git-grep', `counsel-ag', etc." - (interactive) - (counsel-delete-process) - (let* ((input ivy-text) - (enable-recursive-minibuffers t) - (def-dir (buffer-file-name (ivy-state-buffer ivy-last))) - (def-dir (and def-dir (file-name-directory def-dir))) - (new-dir (counsel-read-directory-name "cd: " def-dir))) - (ivy-quit-and-run - (funcall (ivy-state-caller ivy-last) input new-dir)))) - -(defun counsel--grep-smart-case-flag () - (if (ivy--case-fold-p ivy-text) - "-i" - (if (and (stringp counsel-ag-base-command) - (string-prefix-p "pt" counsel-ag-base-command)) - "-S" - "-s"))) - -(defun counsel-grep-like-occur (cmd-template) - (unless (eq major-mode 'ivy-occur-grep-mode) - (ivy-occur-grep-mode) - (setq default-directory (ivy-state-directory ivy-last))) - (ivy-set-text - (let ((name (buffer-name))) - (if (string-match "\"\\(.*\\)\"" name) - (match-string 1 name) - (ivy-state-text ivy-occur-last)))) - (let* ((cmd - (if (functionp cmd-template) - (funcall cmd-template ivy-text) - (let* ((command-args (counsel--split-command-args ivy-text)) - (regex (counsel--grep-regex (cdr command-args))) - (extra-switches (counsel--ag-extra-switches regex)) - (all-args (append - (when (car command-args) - (split-string (car command-args))) - (when extra-switches - (split-string extra-switches)) - (list - (counsel--grep-smart-case-flag) - regex)))) - (if (stringp cmd-template) - (counsel--format - cmd-template - (mapconcat #'shell-quote-argument all-args " ")) - (cl-mapcan - (lambda (x) (if (string= x "%s") (copy-sequence all-args) (list x))) - cmd-template))))) - (cands (counsel--split-string - (if (stringp cmd) - (shell-command-to-string cmd) - (counsel--call cmd))))) - (swiper--occur-insert-lines (mapcar #'counsel--normalize-grep-match cands)))) - -(defun counsel-ag-occur (&optional _cands) - "Generate a custom occur buffer for `counsel-ag'." - (counsel-grep-like-occur - counsel-ag-command)) - -;;;; `counsel-pt' - -(defcustom counsel-pt-base-command "pt --nocolor --nogroup -e %s" - "Alternative to `counsel-ag-base-command' using pt." - :type 'string) - -;;;###autoload -(defun counsel-pt (&optional initial-input) - "Grep for a string in the current directory using pt. -INITIAL-INPUT can be given as the initial minibuffer input. -This uses `counsel-ag' with `counsel-pt-base-command' instead of -`counsel-ag-base-command'." - (interactive) - (let ((counsel-ag-base-command counsel-pt-base-command) - (counsel--grep-tool-look-around nil)) - (counsel-ag initial-input nil nil nil :caller 'counsel-pt))) - -(ivy-configure 'counsel-pt - :unwind-fn #'counsel--grep-unwind - :display-transformer-fn #'counsel-git-grep-transformer - :grep-p t) - -;;;; `counsel-ack' - -(defcustom counsel-ack-base-command - (concat - (file-name-nondirectory - (or (executable-find "ack-grep") "ack")) - " --nocolor --nogroup %s") - "Alternative to `counsel-ag-base-command' using ack." - :type 'string) - -;;;###autoload -(defun counsel-ack (&optional initial-input) - "Grep for a string in the current directory using ack. -INITIAL-INPUT can be given as the initial minibuffer input. -This uses `counsel-ag' with `counsel-ack-base-command' replacing -`counsel-ag-base-command'." - (interactive) - (let ((counsel-ag-base-command counsel-ack-base-command) - (counsel--grep-tool-look-around t)) - (counsel-ag - initial-input nil nil nil - :caller 'counsel-ack))) - -;;;; `counsel-rg' - -(defcustom counsel-rg-base-command - `("rg" - "--max-columns" "240" - "--with-filename" - "--no-heading" - "--line-number" - "--color" "never" - "%s" - ,@(and (memq system-type '(ms-dos windows-nt)) - (list "--path-separator" "/" "."))) - "Like `counsel-ag-base-command', but for `counsel-rg'. - -Note: don't use single quotes for the regexp." - :package-version '(counsel . "0.14.0") - :type '(choice (repeat :tag "Command list to call directly" string) - (string :tag "Shell command"))) - -(defun counsel--rg-targets () - "Return a list of files to operate on, based on `dired-mode' marks." - (when (derived-mode-p 'dired-mode) - (declare-function dired-get-marked-files "dired") - (declare-function dired-toggle-marks "dired") - (let ((files - (dired-get-marked-files 'no-dir nil nil t))) - (when (or (cdr files) - (when (ivy--string-search "*ivy-occur" (buffer-name)) - (dired-toggle-marks) - (setq files (dired-get-marked-files 'no-dir)) - (dired-toggle-marks) - t)) - (delq t files))))) - -;;;###autoload -(defun counsel-rg (&optional initial-input initial-directory extra-rg-args rg-prompt) - "Grep for a string in the current directory using `rg'. -INITIAL-INPUT can be given as the initial minibuffer input. -INITIAL-DIRECTORY, if non-nil, is used as the root directory for search. -EXTRA-RG-ARGS string, if non-nil, is appended to `counsel-rg-base-command'. -RG-PROMPT, if non-nil, is passed as `ivy-read' prompt argument. - -Example input with inclusion and exclusion file patterns: - require i -- -g*.el" - (interactive) - (let ((counsel-ag-base-command - (if (listp counsel-rg-base-command) - (append counsel-rg-base-command (counsel--rg-targets)) - (concat counsel-rg-base-command " " - (mapconcat #'shell-quote-argument (counsel--rg-targets) " ")))) - (counsel--grep-tool-look-around - (let ((rg (car (if (listp counsel-rg-base-command) counsel-rg-base-command - (split-string counsel-rg-base-command)))) - (switch "--pcre2")) - (and (eq 0 (call-process rg nil nil nil switch "--pcre2-version")) - switch)))) - (counsel-ag initial-input initial-directory extra-rg-args rg-prompt - :caller 'counsel-rg))) - -(ivy-configure 'counsel-rg - :occur #'counsel-ag-occur - :unwind-fn #'counsel--grep-unwind - :display-transformer-fn #'counsel-git-grep-transformer - :grep-p t - :exit-codes '(1 "No matches found")) - -;;;; `counsel-grep' - -(defvar counsel-grep-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-l") #'ivy-call-and-recenter) - (define-key map (kbd "M-q") #'swiper-query-replace) - (define-key map (kbd "C-'") #'swiper-avy) - map)) - -(defcustom counsel-grep-base-command "grep -E -n -e %s %s" - "Format string used by `counsel-grep' to build a shell command. -It should contain two %-sequences (see function `format') to be -substituted by the search regexp and file, respectively. Neither -%-sequence should be contained in single quotes." - :type 'string) - -(defvar counsel-grep-command nil) - -(defun counsel-grep-function (string) - "Grep in the current directory for STRING." - (or - (ivy-more-chars) - (let* ((regex (counsel--grep-regex string)) - (cmd (counsel--format - counsel-grep-command - (funcall (if (listp counsel-grep-command) #'identity - #'shell-quote-argument) - regex)))) - (counsel--async-command - (if (ivy--case-fold-p regex) - (if (listp cmd) (nconc (list (car cmd) "-i") (cdr cmd)) - (string-match " " cmd) - (replace-match " -i " nil nil cmd)) - cmd)) - nil))) - -(defvar counsel--grep-last-pos nil - "Store the last point and line that `counsel-grep-action' scrolled to. -This speeds up scrolling: instead of going to `point-min' and -`forward-line' with a huge arg (e.g. to scroll 50K lines), scroll -relative to the last position stored here.") - -(defun counsel-grep-action (x) - "Go to candidate X." - (with-ivy-window - (swiper--cleanup) - (let ((default-directory - (file-name-directory - (ivy-state-directory ivy-last))) - file-name line-number) - (when (cond ((string-match "\\`\\([0-9]+\\):\\(.*\\)\\'" x) - (setq file-name (buffer-file-name (ivy-state-buffer ivy-last))) - (setq line-number (match-string-no-properties 1 x))) - ((string-match "\\`\\([^:]+\\):\\([0-9]+\\):\\(.*\\)\\'" x) - (setq file-name (match-string-no-properties 1 x)) - (setq line-number (match-string-no-properties 2 x)))) - ;; If the file buffer is already open, just get it. Prevent doing - ;; `find-file', as that file could have already been opened using - ;; `find-file-literally'. - (with-current-buffer (or (get-file-buffer file-name) - (find-file file-name)) - (setq line-number (string-to-number line-number)) - (if (and counsel--grep-last-pos (= (point) (car counsel--grep-last-pos))) - (forward-line (- line-number (cdr counsel--grep-last-pos))) - (goto-char (point-min)) - (forward-line (1- line-number))) - (setq counsel--grep-last-pos (cons (point) line-number)) - (when (re-search-forward (ivy--regex ivy-text t) (line-end-position) t) - (when swiper-goto-start-of-match - (goto-char (match-beginning 0)))) - (run-hooks 'counsel-grep-post-action-hook) - (if (eq ivy-exit 'done) - (swiper--ensure-visible) - (isearch-range-invisible (line-beginning-position) - (line-end-position)) - (swiper--add-overlays (ivy--regex ivy-text)))))))) - -(defun counsel-grep-occur (&optional _cands) - "Generate a custom Occur buffer for `counsel-grep'." - (let ((file (buffer-file-name (ivy-state-buffer ivy-last)))) - (counsel-grep-like-occur - (format "grep -niE %%s %s %s" - (if file (shell-quote-argument (file-name-nondirectory file)) "") - (shell-quote-argument (counsel--null-device)))))) - -(defvar counsel-grep-history nil - "History for `counsel-grep'.") - -;;;###autoload -(defun counsel-grep (&optional initial-input) - "Grep for a string in the file visited by the current buffer. -When non-nil, INITIAL-INPUT is the initial search pattern." - (interactive) - (unless buffer-file-name - (user-error "Current buffer is not visiting a file")) - (counsel-require-program counsel-grep-base-command) - (setq counsel-grep-command - (counsel--format counsel-grep-base-command "%s" - (funcall (if (listp counsel-grep-base-command) #'identity - #'shell-quote-argument) - (file-name-nondirectory - buffer-file-name)))) - (let ((default-directory (file-name-directory buffer-file-name)) - (init-point (point)) - res) - (unwind-protect - (setq res (ivy-read "grep: " #'counsel-grep-function - :initial-input initial-input - :dynamic-collection t - :require-match t - :preselect - (when (< (- (line-end-position) (line-beginning-position)) 300) - (format "%d:%s" - (line-number-at-pos) - (regexp-quote - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position))))) - :keymap counsel-grep-map - :history 'counsel-grep-history - :re-builder #'ivy--regex - :action #'counsel-grep-action - :caller 'counsel-grep)) - (unless res - (goto-char init-point))))) - -(ivy-configure 'counsel-grep - :update-fn 'auto - :unwind-fn #'counsel--grep-unwind - :index-fn #'ivy-recompute-index-swiper-async - :occur #'counsel-grep-occur - :more-chars 2 - :grep-p t - :exit-codes '(1 "")) - -;;;###autoload -(defun counsel-grep-backward (&optional initial-input) - "Grep for a string in the file visited by the current buffer going -backward similar to `swiper-backward'. When non-nil, INITIAL-INPUT is -the initial search pattern." - (interactive) - (let ((ivy-index-functions-alist - '((counsel-grep . ivy-recompute-index-swiper-async-backward)))) - (counsel-grep initial-input))) - -;;;; `counsel-grep-or-swiper' - -(defcustom counsel-grep-swiper-limit 300000 - "Buffer size threshold for `counsel-grep-or-swiper'. -When the number of characters in a buffer exceeds this threshold, -`counsel-grep' will be used instead of `swiper'." - :type 'integer) - -(defcustom counsel-grep-use-swiper-p #'counsel-grep-use-swiper-p-default - "When this function returns non-nil, call `swiper', else `counsel-grep'." - :type '(choice - (const :tag "Rely on `counsel-grep-swiper-limit'." - counsel-grep-use-swiper-p-default) - (const :tag "Always use `counsel-grep'." ignore) - (function :tag "Custom"))) - -(defun counsel-grep-use-swiper-p-default () - (<= (buffer-size) - (/ counsel-grep-swiper-limit - (if (eq major-mode 'org-mode) 4 1)))) - -;;;###autoload -(defun counsel-grep-or-swiper (&optional initial-input) - "Call `swiper' for small buffers and `counsel-grep' for large ones. -When non-nil, INITIAL-INPUT is the initial search pattern." - (interactive) - (if (or (not buffer-file-name) - (buffer-narrowed-p) - (ignore-errors - (file-remote-p buffer-file-name)) - (jka-compr-get-compression-info buffer-file-name) - (funcall counsel-grep-use-swiper-p)) - (swiper initial-input) - (when (file-writable-p buffer-file-name) - (save-buffer)) - (counsel-grep initial-input))) - -;;;; `counsel-grep-or-swiper-backward' - -;;;###autoload -(defun counsel-grep-or-swiper-backward (&optional initial-input) - "Call `swiper-backward' for small buffers and `counsel-grep-backward' for -large ones. When non-nil, INITIAL-INPUT is the initial search pattern." - (interactive) - (let ((ivy-index-functions-alist - '((swiper . ivy-recompute-index-swiper-backward) - (counsel-grep . ivy-recompute-index-swiper-async-backward)))) - (counsel-grep-or-swiper initial-input))) - -;;;; `counsel-recoll' - -(defun counsel-recoll-function (str) - "Run recoll for STR." - (or - (ivy-more-chars) - (progn - (counsel--async-command - (format "recoll -t -b %s" - (shell-quote-argument str))) - nil))) - -;; This command uses the recollq command line tool that comes together -;; with the recoll (the document indexing database) source: -;; https://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. -;;;###autoload -(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) - (counsel-require-program "recoll") - (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))))) - :caller 'counsel-recoll)) - -(ivy-configure 'counsel-recoll - :unwind-fn #'counsel-delete-process) - -;;; Org -;;;; `counsel-org-tag' - -(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 "org") -(declare-function org-move-to-column "org-compat") - -(defun counsel--org-make-tag-string () - (if (fboundp 'org-make-tag-string) - ;; >= Org 9.2 - (org-make-tag-string (counsel--org-get-tags)) - (with-no-warnings - (org-get-tags-string)))) - -(defun counsel-org-change-tags (tags) - "Change tags of current org headline to TAGS." - (let ((current (counsel--org-make-tag-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]*$") - (line-end-position) 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--set-tags () - "Set tags of current org headline to `counsel-org-tags'." - (counsel-org-change-tags - (if counsel-org-tags - (format ":%s:" - (mapconcat #'identity counsel-org-tags ":")) - ""))) - -(defvar org-agenda-bulk-marked-entries) - -;; Moved from `org' to `org-macs' in Emacs 27. -(declare-function org-get-at-bol "org-macs") -(declare-function org-trim "org-macs") - -(declare-function org-agenda-error "org-agenda") - -(defun counsel-org-tag-action (x) - "Add tag X to `counsel-org-tags'. -If X is already part of the list, remove it instead. Quit the selection if -X is selected by either `ivy-done', `ivy-alt-done' or `ivy-immediate-done', -otherwise continue prompting for tags." - (if (member x counsel-org-tags) - (progn - (setq counsel-org-tags (delete x counsel-org-tags))) - (unless (equal x "") - (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 - ivy-immediate-done)) - (if (eq major-mode 'org-agenda-mode) - (if (null org-agenda-bulk-marked-entries) - (let ((hdmarker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error)))) - (with-current-buffer (marker-buffer hdmarker) - (goto-char hdmarker) - (counsel-org--set-tags))) - (let ((add-tags (copy-sequence counsel-org-tags))) - (dolist (m org-agenda-bulk-marked-entries) - (with-current-buffer (marker-buffer m) - (save-excursion - (goto-char m) - (setq counsel-org-tags - (delete-dups - (append (counsel--org-get-tags) add-tags))) - (counsel-org--set-tags)))))) - (counsel-org--set-tags) - (unless (member x counsel-org-tags) - (message "Tag %S has been removed." x)))) - ((eq this-command 'ivy-call) - (with-selected-window (active-minibuffer-window) - (delete-minibuffer-contents))))) - -(defun counsel-org-tag-prompt () - "Return prompt for `counsel-org-tag'." - (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") -(declare-function org-tags-completion-function "org") - -;;;###autoload -(defun counsel--org-get-tags () - (delete "" (condition-case nil - (org-get-tags nil t) - (error (org-get-tags))))) - -;;;###autoload -(defun counsel-org-tag () - "Add or remove tags in `org-mode'." - (interactive) - (save-excursion - (if (eq major-mode 'org-agenda-mode) - (if org-agenda-bulk-marked-entries - (setq counsel-org-tags nil) - (let ((hdmarker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error)))) - (with-current-buffer (marker-buffer hdmarker) - (goto-char hdmarker) - (setq counsel-org-tags (counsel--org-get-tags))))) - (unless (org-at-heading-p) - (org-back-to-heading t)) - (setq counsel-org-tags (counsel--org-get-tags))) - (let ((org-last-tags-completion-table - (append (and (or org-complete-tags-always-offer-all-agenda-tags - (eq major-mode 'org-agenda-mode)) - (org-global-tags-completion-table - (org-agenda-files))) - (unless (boundp 'org-current-tag-alist) - org-tag-persistent-alist) - (or (if (boundp 'org-current-tag-alist) - org-current-tag-alist - org-tag-alist) - (org-get-buffer-tags))))) - (ivy-read (counsel-org-tag-prompt) - (lambda (str _pred _action) - (delete-dups - (all-completions str #'org-tags-completion-function))) - :history 'org-tags-history - :action #'counsel-org-tag-action - :caller 'counsel-org-tag)))) - -(defvar org-version) - -;;;###autoload -(defun counsel-org-tag-agenda () - "Set tags for the current agenda item." - (interactive) - (cl-letf (((symbol-function (if (version< org-version "9.2") - 'org-set-tags - 'org-set-tags-command)) - #'counsel-org-tag)) - (org-agenda-set-tags))) - -(defcustom counsel-org-headline-display-tags nil - "If non-nil, display tags in matched `org-mode' headlines." - :type 'boolean) - -(defcustom counsel-org-headline-display-todo nil - "If non-nil, display todo keywords in matched `org-mode' headlines." - :type 'boolean) - -(defcustom counsel-org-headline-display-priority nil - "If non-nil, display priorities in matched `org-mode' headlines." - :type 'boolean) - -(defcustom counsel-org-headline-display-comment nil - "If non-nil, display COMMENT string in matched `org-mode' headlines." - :type 'boolean) - -(defcustom counsel-org-headline-display-statistics nil - "If non-nil, display statistics cookie in matched `org-mode' headlines." - :type 'boolean) - -(declare-function org-get-heading "org") -(declare-function org-goto-marker-or-bmk "org") -(declare-function outline-next-heading "outline") - -;;;###autoload -(defalias 'counsel-org-goto #'counsel-outline) - -(defcustom counsel-org-goto-all-outline-path-prefix nil - "Prefix for outline candidates in `counsel-org-goto-all'." - :type '(choice - (const :tag "None" nil) - (const :tag "File name" file-name) - (const :tag "File name (nondirectory part)" file-name-nondirectory) - (const :tag "Buffer name" buffer-name))) - -(defun counsel-org-goto-all--outline-path-prefix () - (cl-case counsel-org-goto-all-outline-path-prefix - (file-name buffer-file-name) - (file-name-nondirectory (file-name-nondirectory buffer-file-name)) - (buffer-name (buffer-name)))) - -(defvar counsel-outline-settings - '((emacs-lisp-mode - :outline-regexp ";;[;*]+[\s\t]+" - :outline-level counsel-outline-level-emacs-lisp) - (org-mode - :outline-title counsel-outline-title-org - :action counsel-org-goto-action - :history counsel-org-goto-history - :caller counsel-org-goto) - ;; markdown-mode package - (markdown-mode - :outline-title counsel-outline-title-markdown) - ;; Built-in mode or AUCTeX package - (latex-mode - :outline-title counsel-outline-title-latex)) - "Alist mapping major modes to their `counsel-outline' settings. - -Each entry is a pair (MAJOR-MODE . PLIST). `counsel-outline' -checks whether an entry exists for the current buffer's -MAJOR-MODE and, if so, loads the settings specified by PLIST -instead of the default settings. The following settings are -recognized: - -- `:outline-regexp' is a regexp to match the beginning of an - outline heading. It is only checked at the start of a line and - so need not start with \"^\". - Defaults to the value of the variable `outline-regexp'. - -- `:outline-level' is a function of no arguments which computes - the level of an outline heading. It is called with point at - the beginning of `outline-regexp' and with the match data - corresponding to `outline-regexp'. - Defaults to the value of the variable `outline-level'. - -- `:outline-title' is a function of no arguments which returns - the title of an outline heading. It is called with point at - the end of `outline-regexp' and with the match data - corresponding to `outline-regexp'. - Defaults to the function `counsel-outline-title'. - -- `:action' is a function of one argument, the selected outline - heading to jump to. This setting corresponds directly to its - eponymous `ivy-read' keyword, as used by `counsel-outline', so - the type of the function's argument depends on the value - returned by `counsel-outline-candidates'. - Defaults to the function `counsel-outline-action'. - -- `:history' is a history list, usually a symbol representing a - history list variable. It corresponds directly to its - eponymous `ivy-read' keyword, as used by `counsel-outline'. - Defaults to the symbol `counsel-outline-history'. - -- `:caller' is a symbol to uniquely identify the caller to - `ivy-read'. It corresponds directly to its eponymous - `ivy-read' keyword, as used by `counsel-outline'. - Defaults to the symbol `counsel-outline'. - -- `:display-style' overrides the variable - `counsel-outline-display-style'. - -- `:path-separator' overrides the variable - `counsel-outline-path-separator'. - -- `:face-style' overrides the variable - `counsel-outline-face-style'. - -- `:custom-faces' overrides the variable - `counsel-outline-custom-faces'.") - -;;;###autoload -(defun counsel-org-goto-all () - "Go to a different location in any org file." - (interactive) - (let (entries) - (dolist (b (buffer-list)) - (with-current-buffer b - (when (derived-mode-p 'org-mode) - (setq entries - (nconc entries - (counsel-outline-candidates - (cdr (assq 'org-mode counsel-outline-settings)) - (counsel-org-goto-all--outline-path-prefix))))))) - (ivy-read "Goto: " entries - :history 'counsel-org-goto-history - :action #'counsel-org-goto-action - :caller 'counsel-org-goto-all))) - -(defun counsel-org-goto-action (x) - "Go to headline in candidate X." - (org-goto-marker-or-bmk (cdr x))) - -(defun counsel--org-get-heading-args () - "Return list of arguments for `org-get-heading'. -Try to return the right number of arguments for the current Org -version. Argument values are based on the -`counsel-org-headline-display-*' user options." - (nbutlast (mapcar #'not (list counsel-org-headline-display-tags - counsel-org-headline-display-todo - counsel-org-headline-display-priority - counsel-org-headline-display-comment)) - ;; Added in Emacs 26.1. - (if (if (fboundp 'func-arity) - (< (cdr (func-arity #'org-get-heading)) 3) - (version< org-version "9.1.1")) - 2 0))) - -;;;; `counsel-org-file' - -(declare-function org-attach-dir "org-attach") -(declare-function org-attach-file-list "org-attach") -(defvar org-attach-directory) - -(defun counsel-org-files () - "Return list of all files under current Org attachment directories. -Filenames returned are relative to `default-directory'. For each -attachment directory associated with the current buffer, all -contained files are listed, so the return value could conceivably -include attachments of other Org buffers." - (require 'org-attach) - (let (dirs) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward ":\\(?:ATTACH_DIR\\|ID\\):[\t ]+.*$" nil t) - (let ((dir (org-attach-dir))) - (when dir - (push dir dirs))))) - (cl-mapcan - (lambda (dir) - (mapcar (lambda (file) - (file-relative-name (expand-file-name file dir))) - (org-attach-file-list dir))) - (nreverse dirs)))) - -;;;###autoload -(defun counsel-org-file () - "Browse all attachments for current Org file." - (interactive) - (ivy-read "file: " (counsel-org-files) - :action #'counsel-locate-action-dired - :caller 'counsel-org-file)) - -;;;; `counsel-org-entity' - -;;;###autoload -(defun counsel-org-entity () - "Complete Org entities using Ivy." - (interactive) - (require 'org) - (defvar org-entities) - (defvar org-entities-user) - (ivy-read "Entity: " - (cl-loop for element in (append org-entities org-entities-user) - when (consp element) - collect (cons - (format "%20s | %20s | %20s | %s" - (nth 0 element) ; Name. - (nth 1 element) ; LaTeX. - (nth 3 element) ; HTML. - (nth 6 element)) ; UTF-8. - element)) - :require-match t - :action `(1 - ("u" ,(lambda (candidate) - (insert (nth 6 (cdr candidate)))) - "UTF-8") - ("o" ,(lambda (candidate) - (insert "\\" (nth 0 (cdr candidate)))) - "Org entity") - ("l" ,(lambda (candidate) - (insert (nth 1 (cdr candidate)))) - "LaTeX") - ("h" ,(lambda (candidate) - (insert (nth 3 (cdr candidate)))) - "HTML") - ("a" ,(lambda (candidate) - (insert (nth 4 (cdr candidate)))) - "ASCII") - ("L" ,(lambda (candidate) - (insert (nth 5 (cdr candidate)))) - "Latin-1")))) - -;;;; `counsel-org-capture' - -(defvar org-capture-templates) -(defvar org-capture-templates-contexts) -(declare-function org-contextualize-keys "org") -(declare-function org-capture-goto-last-stored "org-capture") -(declare-function org-capture-goto-target "org-capture") -(declare-function org-capture-upgrade-templates "org-capture") - -;;;###autoload -(defun counsel-org-capture () - "Capture something." - (interactive) - (require 'org-capture) - (ivy-read "Capture template: " - ;; We build the list of capture templates as in `org-capture-select-template': - (let (prefixes) - (cl-mapcan - (lambda (x) - (let ((x-keys (car x))) - ;; Remove prefixed keys until we get one that matches the current item. - (while (and prefixes - (let ((p1-keys (caar prefixes))) - (or - (<= (length x-keys) (length p1-keys)) - (not (string-prefix-p p1-keys x-keys))))) - (pop prefixes)) - (if (> (length x) 2) - (let ((desc (mapconcat #'cadr (reverse (cons x prefixes)) " | "))) - (list (format "%-5s %s" x-keys desc))) - (push x prefixes) - nil))) - (or (org-contextualize-keys - (org-capture-upgrade-templates org-capture-templates) - org-capture-templates-contexts) - '(("t" "Task" entry (file+headline "" "Tasks") - "* TODO %?\n %u\n %a"))))) - :require-match t - :action (lambda (x) - (org-capture nil (car (split-string x)))) - :caller 'counsel-org-capture)) - -(ivy-configure 'counsel-org-capture - :initial-input "^") - -(ivy-set-actions - 'counsel-org-capture - `(("t" ,(lambda (x) - (org-capture-goto-target (car (split-string x)))) - "go to target") - ("l" ,(lambda (_x) - (org-capture-goto-last-stored)) - "go to last stored") - ("p" ,(lambda (x) - (org-capture 0 (car (split-string x)))) - "insert template at point") - ("c" ,(lambda (_x) - (customize-variable 'org-capture-templates)) - "customize org-capture-templates"))) - -;;;; `counsel-org-agenda-headlines' - -(defvar org-odd-levels-only) -(declare-function org-map-entries "org") -(declare-function org-heading-components "org") - -(defun counsel-org-agenda-headlines-action-goto (headline) - "Go to the `org-mode' agenda HEADLINE." - (find-file (nth 1 headline)) - (if (fboundp 'org-cycle-set-startup-visibility) - (org-cycle-set-startup-visibility) - ;; Obsolete alias since Org 9.6 / Emacs 29. - (with-no-warnings - (org-set-startup-visibility))) - (goto-char (nth 2 headline)) - (if (fboundp 'org-fold-show-entry) - (org-fold-show-entry) - ;; Obsolete alias since Org 9.6 / Emacs 29. - (with-no-warnings - (org-show-entry)))) - -(ivy-set-actions - 'counsel-org-agenda-headlines - '(("g" counsel-org-agenda-headlines-action-goto "goto headline"))) - -(defvar counsel-org-agenda-headlines-history nil - "History for `counsel-org-agenda-headlines'.") - -(defcustom counsel-outline-display-style 'path - "The style used when displaying matched outline headings. - -If `headline', the title is displayed with leading stars -indicating the outline level. - -If `path', the path hierarchy is displayed. For each entry the -title is shown. Entries are separated with -`counsel-outline-path-separator'. - -If `title' or any other value, only the title of the heading is -displayed. - -For displaying tags and TODO keywords in `org-mode' buffers, see -`counsel-org-headline-display-tags' and -`counsel-org-headline-display-todo', respectively." - :type '(choice - (const :tag "Title only" title) - (const :tag "Headline" headline) - (const :tag "Path" path))) - -(defcustom counsel-outline-path-separator "/" - "String separating path entries in matched outline headings. -This variable has no effect unless -`counsel-outline-display-style' is set to `path'." - :type 'string) - -(declare-function org-get-outline-path "org") - -(defun counsel-org-agenda-headlines--candidates () - "Return a list of completion candidates for `counsel-org-agenda-headlines'." - (org-map-entries - (lambda () - (let* ((components (org-heading-components)) - (level (and (eq counsel-outline-display-style 'headline) - (make-string - (if org-odd-levels-only - (nth 1 components) - (nth 0 components)) - ?*))) - (todo (and counsel-org-headline-display-todo - (nth 2 components))) - (path (and (eq counsel-outline-display-style 'path) - (org-get-outline-path))) - (priority (and counsel-org-headline-display-priority - (nth 3 components))) - (text (nth 4 components)) - (tags (and counsel-org-headline-display-tags - (nth 5 components)))) - (list (string-join - (delq nil (list level - todo - (and priority (format "[#%c]" priority)) - (string-join (append path (list text)) - counsel-outline-path-separator) - tags)) - " ") - buffer-file-name - (point)))) - nil - 'agenda)) - -;;;###autoload -(defun counsel-org-agenda-headlines () - "Choose from headers of `org-mode' files in the agenda." - (interactive) - (require 'org) - (let ((minibuffer-allow-text-properties t)) - (ivy-read "Org headline: " - (counsel-org-agenda-headlines--candidates) - :action #'counsel-org-agenda-headlines-action-goto - :history 'counsel-org-agenda-headlines-history - :caller 'counsel-org-agenda-headlines))) - -;;;; `counsel-org-link' - -;; Moved from `org' to `ol' in Emacs 27. -(declare-function org-insert-link "ol") -(declare-function org-id-get-create "org-id") - -(defun counsel-org-link-action (x) - "Insert a link to X." - (let ((id (save-excursion - (goto-char (cdr x)) - (org-id-get-create)))) - (org-insert-link nil (concat "id:" id) (car x)))) - -;;;###autoload -(defun counsel-org-link () - "Insert a link to an headline with completion." - (interactive) - (ivy-read "Link: " (counsel-outline-candidates - '(:outline-title counsel-outline-title-org )) - :action #'counsel-org-link-action - :history 'counsel-org-link-history - :caller 'counsel-org-link)) - -;;; Misc. Emacs -;;;; `counsel-mark-ring' - -(defface counsel--mark-ring-highlight - '((t :inherit highlight)) - "Face for current `counsel-mark-ring' line." - :group 'ivy-faces) - -(defvar counsel--mark-ring-overlay nil - "Internal overlay to highlight line by candidate of `counsel-mark-ring'.") - -(defun counsel--mark-ring-add-highlight () - "Add highlight to current line." - (setq counsel--mark-ring-overlay - (make-overlay (line-beginning-position) (1+ (line-end-position)))) - (with-ivy-window - (overlay-put counsel--mark-ring-overlay 'face - 'counsel--mark-ring-highlight))) - -(defun counsel--mark-ring-delete-highlight () - "If `counsel-mark-ring' have highlight, delete highlight." - (if counsel--mark-ring-overlay (delete-overlay counsel--mark-ring-overlay))) - -(defvar counsel--mark-ring-calling-point 0 - "Internal variable to remember calling position.") - -(defun counsel--mark-ring-unwind () - "Return back to calling position of `counsel-mark-ring'." - (goto-char counsel--mark-ring-calling-point) - (counsel--mark-ring-delete-highlight)) - -(defun counsel--mark-ring-update-fn () - "Show preview by candidate." - (let ((pos (get-text-property 0 'point (ivy-state-current ivy-last)))) - (counsel--mark-ring-delete-highlight) - (with-ivy-window - (goto-char pos) - (counsel--mark-ring-add-highlight)))) - -;;;###autoload -(defun counsel-mark-ring () - "Browse `mark-ring' interactively. -Obeys `widen-automatically', which see." - (interactive) - (let* ((counsel--mark-ring-calling-point (point)) - (marks (copy-sequence mark-ring)) - (marks (delete-dups marks)) - (marks - ;; mark-marker is empty? - (if (equal (mark-marker) (make-marker)) - marks - (cons (copy-marker (mark-marker)) marks))) - (candidates (counsel-mark--get-candidates marks))) - (if candidates - (counsel-mark--ivy-read "Mark: " candidates 'counsel-mark-ring) - (message "Mark ring is empty")))) - -(defun counsel-mark--get-candidates (marks) - "Convert a list of MARKS into mark candidates. -candidates are simply strings formatted to have the line number of the -associated mark prepended to them and having an extra text property of -point to indicarte where the candidate mark is." - (when marks - (save-excursion - (save-restriction - ;; Widen, both to save `line-number-at-pos' the trouble - ;; and for `buffer-substring' to work. - (widen) - (let* ((width (length (number-to-string (line-number-at-pos (point-max))))) - (fmt (format "%%%dd %%s" width))) - (mapcar (lambda (mark) - (goto-char (marker-position mark)) - (let ((linum (line-number-at-pos)) - (line (buffer-substring - (line-beginning-position) (line-end-position)))) - (propertize (format fmt linum line) 'point (point)))) - marks)))))) - -(defun counsel-mark--ivy-read (prompt candidates caller) - "Call `ivy-read' with sane defaults for traversing marks. -CANDIDATES should be an alist with the `car' of the list being -the completion candidate string and the `cdr' being the point that -mark should take you to. - -This subroutine is intended to be used by both `counsel-mark-ring' and -`counsel-evil-marks'." - (ivy-read prompt candidates - :require-match t - :update-fn #'counsel--mark-ring-update-fn - :action (lambda (cand) - (let ((pos (get-text-property 0 'point cand))) - (when pos - (unless (<= (point-min) pos (point-max)) - (if widen-automatically - (widen) - (error "\ -Position of selected mark outside accessible part of buffer"))) - (goto-char pos)))) - :unwind #'counsel--mark-ring-unwind - :caller caller)) - -(ivy-configure 'counsel-mark-ring - :update-fn #'counsel--mark-ring-update-fn - :unwind-fn #'counsel--mark-ring-unwind - :sort-fn #'ivy-string<) - -;;;; `counsel-evil-marks' - -(defvar counsel-evil-marks-exclude-registers nil - "List of evil registers to not display in `counsel-evil-marks' by default. -Each member of the list should be a character (stored as an integer).") - -(defvar evil-markers-alist) -(declare-function evil-global-marker-p "ext:evil-common") - -(defun counsel-mark--get-evil-candidates (all-markers-p) - "Convert all evil MARKS in the current buffer to mark candidates. -Works like `counsel-mark--get-candidates' but also prepends the -register tied to a mark in the message string." - ;; evil doesn't provide a standalone method to access the list of - ;; marks in the current buffer, as it does with registers. - (let* ((all-markers - (append - (cl-remove-if (lambda (m) - (or (evil-global-marker-p (car m)) - (not (markerp (cdr m))))) - evil-markers-alist) - (cl-remove-if (lambda (m) - (or (not (evil-global-marker-p (car m))) - (not (markerp (cdr m))))) - (default-value 'evil-markers-alist)))) - - (all-markers - ;; with prefix, ignore register exclusion list. - (if all-markers-p - all-markers - (cl-remove-if - (lambda (x) (member (car x) counsel-evil-marks-exclude-registers)) - all-markers))) - ;; separate the markers from the evil registers - ;; for call to `counsel-mark--get-candidates' - (registers (mapcar #'car all-markers)) - (markers (mapcar #'cdr all-markers)) - (candidates (counsel-mark--get-candidates markers))) - (when candidates - (let (register candidate result) - (while (and (setq register (pop registers)) - (setq candidate (pop candidates))) - (let ((point (get-text-property 0 'point candidate)) - (evil-candidate - (format "[%s]: %s" - (propertize (char-to-string register) - 'face 'counsel-evil-register-face) - candidate))) - (push (propertize evil-candidate 'point point) result))) - result)))) - -;;;###autoload -(defun counsel-evil-marks (&optional arg) - "Ivy replacement for `evil-show-marks'. -By default, this function respects `counsel-evil-marks-exclude-registers'. -When ARG is non-nil, display all active evil registers." - (interactive "P") - (if (and (boundp 'evil-markers-alist) - (fboundp 'evil-global-marker-p)) - (let* ((counsel--mark-ring-calling-point (point)) - (candidates (counsel-mark--get-evil-candidates arg))) - (if candidates - (counsel-mark--ivy-read "Evil mark: " candidates 'counsel-evil-marks) - (message "No evil marks are active"))) - (user-error "Required feature `evil' not installed or loaded"))) - -;;;; `counsel-package' - -(defvar package--initialized) -(defvar package-alist) -(defvar package-archive-contents) -(defvar package-archives) -(defvar package-user-dir) -(declare-function package-installed-p "package") -(declare-function package-delete "package") -(declare-function package-desc-extras "package" t t) - -(defvar counsel-package-history nil - "History for `counsel-package'.") - -(defun counsel--package-candidates () - "Return completion alist for `counsel-package'." - (unless package--initialized - (package-initialize t)) - (if (or (not package-archive-contents) - (cl-find-if (lambda (package-archive) - (let ((fname - (format - "%s/archives/%s/archive-contents" - package-user-dir (car package-archive)))) - (or (not (file-exists-p fname)) - (counsel-file-stale-p fname (* 4 60 60))))) - package-archives)) - (package-refresh-contents)) - (sort (mapcar (lambda (entry) - (cons (let ((pkg (car entry))) - (concat (if (package-installed-p pkg) "-" "+") - (symbol-name pkg))) - entry)) - package-archive-contents) - #'counsel--package-sort)) - -;;;###autoload -(defun counsel-package () - "Install or delete packages. - -Packages not currently installed are prefixed with \"+\", and -selecting one of these will try to install it. -Packages currently installed are prefixed with \"-\", and -selecting one of these will try to delete it. - -Additional actions:\\ - - \\[ivy-dispatching-done] d: Describe package - \\[ivy-dispatching-done] h: Visit package's homepage" - (interactive) - (require 'package) - (ivy-read "Packages (install +pkg or delete -pkg): " - (counsel--package-candidates) - :action #'counsel-package-action - :require-match t - :history 'counsel-package-history - :caller 'counsel-package)) - -(ivy-configure 'counsel-package - :initial-input "^+") - -(defun counsel-package-action (package) - "Delete or install PACKAGE." - (setq package (cadr package)) - (if (package-installed-p package) - (package-delete (cadr (assq package package-alist))) - (package-install package))) - -(defun counsel-package-action-describe (package) - "Call `describe-package' on PACKAGE." - (describe-package (cadr package))) - -(defun counsel-package-action-homepage (package) - "Open homepage for PACKAGE in a WWW browser." - (let ((url (cdr (assq :url (package-desc-extras (nth 2 package)))))) - (if url - (browse-url url) - (message "No homepage specified for package `%s'" (nth 1 package))))) - -(defun counsel--package-sort (a b) - "Sort function for `counsel-package' candidates." - (let* ((a (car a)) - (b (car b)) - (a-inst (= (string-to-char a) ?+)) - (b-inst (= (string-to-char b) ?+))) - (or (and a-inst (not b-inst)) - (and (eq a-inst b-inst) (string-lessp a b))))) - -(ivy-set-actions - 'counsel-package - '(("d" counsel-package-action-describe "describe package") - ("h" counsel-package-action-homepage "open package homepage"))) - -;;;; `counsel-tmm' - -(declare-function tmm-get-keymap "tmm" (elt &optional in-x-menu)) - -(defalias 'counsel--menu-keymap - ;; Added in Emacs 28.1. - (if (fboundp 'menu-bar-keymap) - #'menu-bar-keymap - ;; Removed in Emacs 28.1. - (declare-function tmm-get-keybind "tmm" (keyseq) t) - (lambda () (tmm-get-keybind [menu-bar]))) - "Compatibility shim for `menu-bar-keymap'.") - -(defun counsel-tmm-prompt (menu) - "Select and call an item from the MENU keymap." - (defvar tmm-km-list) - (let (out - choice - chosen-string) - (setq tmm-km-list nil) - (map-keymap (lambda (k v) (tmm-get-keymap (cons k v))) menu) - (let ((items (setq tmm-km-list (nreverse tmm-km-list)))) - (setq out (ivy-read "Menu bar: " - ;; From `tmm--completion-table', removed in Emacs 31. - (lambda (str pred action) - (if (eq action 'metadata) - '(metadata (display-sort-function . identity)) - (complete-with-action action items str pred))) - :require-match t))) - (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))))) - -;;;###autoload -(defun counsel-tmm () - "Text-mode emulation of looking and choosing from a menu bar." - (interactive) - (require 'tmm) - (defvar tmm-table-undef) - (run-hooks 'menu-bar-update-hook) - (setq tmm-table-undef nil) - (counsel-tmm-prompt (counsel--menu-keymap))) - -;;;; `counsel-yank-pop' - -(defcustom counsel-yank-pop-truncate-radius 2 - "Number of context lines around `counsel-yank-pop' candidates." - :type 'integer) - -(defun counsel--yank-pop-truncate (str) - "Truncate STR for use in `counsel-yank-pop'." - (condition-case nil - (let* ((lines (split-string str "\n" t)) - (n (length lines)) - (re (ivy-re-to-str ivy--old-re)) - (first-match (cl-position-if - (lambda (s) (string-match 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))) - -(defcustom counsel-yank-pop-separator "\n" - "Separator for the kill ring strings in `counsel-yank-pop'." - :type '(choice - (const :tag "Plain" "\n") - (const :tag "Dashes" "\n----\n") - string)) - -(defun counsel--yank-pop-format-function (cand-pairs) - "Transform CAND-PAIRS into a string for `counsel-yank-pop'." - (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 - (propertize counsel-yank-pop-separator 'face 'ivy-separator))) - -;; Macro to leverage `compiler-macro' of `cl-member' in Emacs >= 24. -(defmacro counsel--idx-of (elt list test) - "Return index of ELT in LIST, comparing with TEST. -Typically faster than `cl-position' using `equal' on large LIST." - ;; No `macroexp-let2*' before Emacs 25. - (macroexp-let2 nil elt elt - (macroexp-let2 nil list list - (macroexp-let2 nil tail `(cl-member ,elt ,list :test ,test) - `(and ,tail (- (length ,list) (length ,tail))))))) - -(defun counsel--yank-pop-position (s) - "Return position of S in `kill-ring' relative to last yank." - (or (counsel--idx-of s kill-ring-yank-pointer #'equal-including-properties) - (counsel--idx-of s kill-ring-yank-pointer #'equal) - (+ (or (counsel--idx-of s kill-ring #'equal-including-properties) - (counsel--idx-of s kill-ring #'equal)) - (- (length kill-ring-yank-pointer) - (length kill-ring))))) - -(defun counsel-string-non-blank-p (s) - "Return non-nil if S includes non-blank characters. -Newlines and carriage returns are considered blank." - (string-match-p "[^\n\r[:blank:]]" s)) - -(defcustom counsel-yank-pop-filter #'counsel-string-non-blank-p - "Unary filter function applied to `counsel-yank-pop' candidates. -All elements of `kill-ring' for which this function returns nil -will be destructively removed from `kill-ring' before completion. -All blank strings are deleted from `kill-ring' by default." - :type '(radio - (function-item counsel-string-non-blank-p) - (function-item identity) ;; Faster than the newer `always'. - (function :tag "Other"))) - -(defun counsel--equal-w-props () - "Return a `hash-table-test' using `equal-including-properties'. -If not available, return nil." - ;; Added in Emacs 28. - (when (fboundp 'sxhash-equal-including-properties) - (let ((name 'counsel--equal-w-props)) - ;; Define the test only once. - (unless (get name 'hash-table-test) - (define-hash-table-test name #'equal-including-properties - #'sxhash-equal-including-properties)) - name))) - -(defun counsel--yank-pop-filter (kills) - "Apply `counsel-yank-pop-filter' to and deduplicate KILLS. -Equality is defined by `equal-including-properties' for some consistency -with `kill-do-not-save-duplicates' (which is otherwise ignored). This -function tries to be faster than `cl-delete-duplicates' when possible." - (let* ((pred counsel-yank-pop-filter) - (len (length kills)) - ;; Same threshold as `delete-dups'. - (test (and (> len 100) (counsel--equal-w-props)))) - (if (not test) ;; Slow fallback. - (cl-delete-duplicates (cl-delete-if-not pred kills) - :test #'equal-including-properties - :from-end t) - ;; The rest is `delete-dups' combined with `delete' in a single pass. - ;; Find first (or no) element that passes through filter. - (while (unless (funcall pred (car kills)) - (cl-decf len) - (setq kills (cdr kills)))) - (let ((ht (make-hash-table :test test :size len)) - (tail kills) - retail) - ;; Mark it and continue with the rest. - (puthash (car tail) t ht) - (while (setq retail (cdr tail)) - (let ((elt (car retail))) - (if (or (gethash elt ht) - (not (funcall pred elt))) - (setcdr tail (cdr retail)) - (puthash elt t ht) - (setq tail retail))))) - kills))) - -(defun counsel--yank-pop-kills () - "Return filtered `kill-ring' for `counsel-yank-pop' completion. -Both `kill-ring' and `kill-ring-yank-pointer' may be -destructively modified to eliminate duplicates under -`equal-including-properties', satisfy `counsel-yank-pop-filter', -and incorporate `interprogram-paste-function'." - ;; Protect against `kill-ring' and result of - ;; `interprogram-paste-function' both being nil - (ignore-errors (current-kill 0)) - ;; Keep things consistent with the rest of Emacs - (prog1 (setq kill-ring (counsel--yank-pop-filter kill-ring)) - (setq kill-ring-yank-pointer - (counsel--yank-pop-filter kill-ring-yank-pointer)))) - -(defcustom counsel-yank-pop-after-point nil - "Whether `counsel-yank-pop' yanks after point. -Nil means `counsel-yank-pop' puts point at the end of the yanked -text and mark at its beginning, as per the default \\[yank]. -Non-nil means `counsel-yank-pop' swaps the resulting point and -mark, as per \\[universal-argument] \\[yank]." - :type 'boolean) - -(defun counsel-yank-pop-action (s) - "Like `yank-pop', but insert the kill corresponding to S. -Signal a `buffer-read-only' error if called from a read-only -buffer position." - (when (and (eq major-mode 'vterm-mode) - (fboundp 'vterm-insert)) - (let ((inhibit-read-only t)) - (vterm-insert s))) - (barf-if-buffer-read-only) - (setq yank-window-start (window-start)) - (unless (eq last-command 'yank) - ;; Avoid unexpected deletions with `yank-handler' properties. - (setq yank-undo-function nil)) - (condition-case nil - (let (;; Deceive `yank-pop'. - (last-command 'yank) - ;; Avoid unexpected additions to `kill-ring'. - interprogram-paste-function) - (yank-pop (counsel--yank-pop-position s))) - (error - ;; Support strings not present in the kill ring. - (insert s))) - (when (funcall (if counsel-yank-pop-after-point #'> #'<) - (point) (mark t)) - (exchange-point-and-mark t))) - -(defun counsel-yank-pop-action-remove (s) - "Remove all occurrences of S from the kill ring." - (setq kill-ring - (cl-delete s kill-ring :test #'equal-including-properties)) - (setq kill-ring-yank-pointer - (cl-delete s kill-ring-yank-pointer :test #'equal-including-properties)) - ;; Update collection and preselect for next `ivy-call' - (setf (ivy-state-collection ivy-last) kill-ring) - (setf (ivy-state-preselect ivy-last) - (nth (min ivy--index (1- (length kill-ring))) - kill-ring)) - (ivy--reset-state ivy-last)) - -(defun counsel-yank-pop-action-rotate (s) - "Rotate the yanking point to S in the kill ring. -See `current-kill' for how this interacts with the window system -selection." - (let ((i (counsel--yank-pop-position s))) - ;; Avoid unexpected additions to `kill-ring' - (let (interprogram-paste-function) - (setf (ivy-state-preselect ivy-last) (current-kill i))) - ;; Manually change window system selection because `current-kill' won't - (when (and (zerop i) - yank-pop-change-selection - interprogram-cut-function) - (funcall interprogram-cut-function (car kill-ring-yank-pointer)))) - (ivy--reset-state ivy-last)) - -(defcustom counsel-yank-pop-preselect-last nil - "Whether `counsel-yank-pop' preselects the last kill by default. - -The command `counsel-yank-pop' always preselects the same kill -that `yank-pop' would have inserted, given the same prefix -argument. - -When `counsel-yank-pop-preselect-last' is nil (the default), the -prefix argument of `counsel-yank-pop' defaults to 1 (as per -`yank-pop'), which causes the next-to-last kill to be -preselected. Otherwise, the prefix argument defaults to 0, which -results in the most recent kill being preselected." - :type 'boolean) - -;;;###autoload -(defun counsel-yank-pop (&optional arg) - "Ivy replacement for `yank-pop'. -With a plain prefix argument (\\[universal-argument]), -temporarily toggle the value of `counsel-yank-pop-after-point'. -Any other value of ARG has the same meaning as in `yank-pop', but -`counsel-yank-pop-preselect-last' determines its default value. -See also `counsel-yank-pop-filter' for how to filter candidates. - -Note: Duplicate elements of `kill-ring' are always deleted." - ;; Do not specify `*' to allow browsing `kill-ring' in read-only buffers - (interactive "P") - (let ((kills (or (counsel--yank-pop-kills) - (error "Kill ring is empty or blank"))) - (preselect (let (interprogram-paste-function) - (current-kill (cond ((nlistp arg) - (prefix-numeric-value arg)) - (counsel-yank-pop-preselect-last 0) - (t 1)) - t))) - (counsel-yank-pop-after-point - (xor (consp arg) counsel-yank-pop-after-point))) - (unless (eq last-command 'yank) - (push-mark)) - (ivy-read "kill-ring: " kills - :require-match t - :preselect preselect - :action #'counsel-yank-pop-action - :caller 'counsel-yank-pop))) - -(function-put #'counsel-yank-pop 'delete-selection 'yank) - -(ivy-configure 'counsel-yank-pop - :height 5 - :format-fn #'counsel--yank-pop-format-function) - -(ivy-set-actions - 'counsel-yank-pop - '(("d" counsel-yank-pop-action-remove "delete") - ("r" counsel-yank-pop-action-rotate "rotate"))) - -;;;; `counsel-register' - -(defvar counsel-register-actions - '(("\\`buffer" . jump-to-register) - ("\\`text" . insert-register) - ("\\`rectangle" . insert-register) - ("\\`window" . jump-to-register) - ("\\`frame" . jump-to-register) - ("\\`[-+]?[0-9]+\\(?:\\.[0-9]\\)?\\'" . insert-register) - ("\\`\\(?:the \\)?file " . jump-to-register) - ("\\`keyboard" . jump-to-register) - ("\\`file-query" . jump-to-register)) - "Alist of (REGEXP . FUNCTION) pairs for `counsel-register'. -Selecting a register whose description matches REGEXP specifies -FUNCTION as the action to take on the register.") - -(defvar counsel-register-history nil - "History for `counsel-register'.") - -(defun counsel-register-action (register) - "Default action for `counsel-register'. - -Call a function on REGISTER. The function is determined by -matching the register's value description against a regexp in -`counsel-register-actions'." - (let* ((val (get-text-property 0 'register register)) - (desc (register-describe-oneline val)) - (action (cdr (cl-assoc-if (lambda (re) (string-match-p re desc)) - counsel-register-actions)))) - (if action - (funcall action val) - (error "No action was found for register %s" - (single-key-description val))))) - -;;;###autoload -(defun counsel-register () - "Interactively choose a register." - (interactive) - (ivy-read "Register: " - (cl-mapcan - (lambda (reg) - (let ((s (funcall register-preview-function reg))) - (setq s (substring s 0 (string-match-p "[ \t\n\r]+\\'" s))) - (unless (string= s "") - (put-text-property 0 1 'register (car reg) s) - (list s)))) - register-alist) - :require-match t - :history 'counsel-register-history - :action #'counsel-register-action - :caller 'counsel-register)) - -(ivy-configure 'counsel-register - :sort-fn #'ivy-string<) - -;;;; `counsel-evil-registers' - -(defface counsel-evil-register-face - '((t :inherit counsel-outline-1)) - "Face for highlighting `evil' registers in ivy." - :group 'ivy-faces) - -;;;###autoload -(defun counsel-evil-registers () - "Ivy replacement for `evil-show-registers'." - (interactive) - (if (fboundp 'evil-register-list) - (ivy-read "evil-registers: " - (cl-loop for (key . val) in (evil-register-list) - collect (format "[%s]: %s" - (propertize (char-to-string key) - 'face 'counsel-evil-register-face) - (if (stringp val) val ""))) - :require-match t - :action #'counsel-evil-registers-action - :caller 'counsel-evil-registers) - (user-error "Required feature `evil' not installed"))) - -(ivy-configure 'counsel-evil-registers - :height 5 - :format-fn #'counsel--yank-pop-format-function) - -(defun counsel-evil-registers-action (s) - "Paste contents of S, trimming the register part. - -S will be of the form \"[register]: content\"." - (with-ivy-window - (insert - (replace-regexp-in-string "\\`\\[.*?]: " "" s t t)))) - -;;;; `counsel-imenu' - -(declare-function imenu--subalist-p "imenu") -(declare-function imenu--make-index-alist "imenu") - -(defun counsel--imenu-candidates () - (require 'imenu) - (defvar imenu-auto-rescan) - (defvar imenu-auto-rescan-maxout) - (let* ((imenu-auto-rescan t) - (imenu-auto-rescan-maxout (if current-prefix-arg - (buffer-size) - imenu-auto-rescan-maxout)) - (items (imenu--make-index-alist t)) - (items (delete (assoc "*Rescan*" items) items)) - (items (cond ((eq major-mode 'emacs-lisp-mode) - (counsel-imenu-categorize-functions items)) - ((and (derived-mode-p 'python-mode) - (fboundp 'python-imenu-create-flat-index)) - (python-imenu-create-flat-index)) - (t - items)))) - (counsel-imenu-get-candidates-from items))) - -(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 - (when prefix - (concat - (propertize prefix 'face 'ivy-grep-info) - ": ")) - (car elm)))) - (list (cons key - (cons key (if (overlayp (cdr elm)) - (overlay-start (cdr elm)) - (cdr elm)))))))) - alist)) - -(defvar counsel-imenu-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-l") #'ivy-call-and-recenter) - map)) - -(defun counsel-imenu-categorize-functions (items) - "Categorize all the functions of imenu." - (let ((fns (cl-remove-if #'listp items :key #'cdr))) - (if fns - (append (cl-remove-if #'nlistp items :key #'cdr) - `(("Functions" ,@fns))) - items))) - -(defun counsel-imenu-action (x) - (imenu (cdr x))) - -(defvar counsel-imenu-history nil - "History for `counsel-imenu'.") - -;;;###autoload -(defun counsel-imenu () - "Jump to a buffer position indexed by imenu." - (interactive) - (ivy-read "imenu items: " (counsel--imenu-candidates) - :preselect (thing-at-point 'symbol) - :require-match t - :action #'counsel-imenu-action - :keymap counsel-imenu-map - :history 'counsel-imenu-history - :caller 'counsel-imenu)) - -;;;; `counsel-list-processes' - -(defun counsel-list-processes-action-delete (x) - "Delete process 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) - "Switch to buffer of process X." - (let* ((proc (get-process x)) - (buf (and proc (process-buffer proc)))) - (if buf - (switch-to-buffer buf) - (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) - (with-temp-buffer - (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)) - -;;;; `counsel-ace-link' - -(defun counsel-ace-link () - "Use Ivy completion for `ace-link'." - (interactive) - (let (collection action) - (cond ((eq major-mode 'Info-mode) - (setq collection 'ace-link--info-collect) - (setq action 'ace-link--info-action)) - ((eq major-mode 'help-mode) - (setq collection 'ace-link--help-collect) - (setq action 'ace-link--help-action)) - ((eq major-mode 'woman-mode) - (setq collection 'ace-link--woman-collect) - (setq action 'ace-link--woman-action)) - ((eq major-mode 'eww-mode) - (setq collection 'ace-link--eww-collect) - (setq action 'ace-link--eww-action)) - ((eq major-mode 'compilation-mode) - (setq collection 'ace-link--eww-collect) - (setq action 'ace-link--compilation-action)) - ((eq major-mode 'org-mode) - (setq collection 'ace-link--org-collect) - (setq action 'ace-link--org-action))) - (if (null collection) - (error "%S is not supported" major-mode) - (ivy-read "Ace-Link: " (funcall collection) - :action (lambda (x) (funcall action (cdr x))) - :require-match t - :caller 'counsel-ace-link)))) - -;;;; `counsel-minibuffer-history' - -;;;###autoload -(defun counsel-minibuffer-history () - "Browse minibuffer history." - (interactive) - (let ((enable-recursive-minibuffers t)) - (ivy-read "History: " (ivy-history-contents minibuffer-history-variable) - :keymap ivy-reverse-i-search-map - :action (lambda (x) - (delete-minibuffer-contents) - (insert (substring-no-properties (car x)))) - :caller 'counsel-minibuffer-history))) - -;;;; `counsel-esh-history' - -(defvar comint-input-ring-index) -(defvar eshell-history-index) -(defvar slime-repl-input-history-position) - -(defvar counsel-esh--index-last nil - "Index corresponding to last selection with `counsel-esh-history'.") - -(defvar counsel-shell-history--index-last nil - "Index corresponding to last selection with `counsel-shell-history'.") - -(defun counsel--browse-history-action (pair) - (let ((snd (cdr pair))) - (cl-case (ivy-state-caller ivy-last) - (counsel-esh-history - (setq eshell-history-index snd - counsel-esh--index-last snd)) - (counsel-shell-history - (setq comint-input-ring-index snd - counsel-shell-history--index-last snd)) - ;; Leave this as a no-op. If someone decides to patch - ;; `slime-repl-previous-input' or one of its utility functions, - ;; or to add history-replay to Slime, then this section can be - ;; updated to add the relevant support for those commands. - (counsel-slime-repl-history - nil)) - (ivy-completion-in-region-action (car pair)))) - -(cl-defun counsel--browse-history (ring &key caller) - "Use Ivy to navigate through RING." - (let* ((proc (get-buffer-process (current-buffer))) - (end (point)) - (beg (if proc - (min (process-mark proc) end) - end)) - (input (when (< beg end) - (concat "^" (buffer-substring beg end))))) - (setq ivy-completion-beg beg) - (setq ivy-completion-end end) - (ivy-read "History: " (ivy-history-contents ring) - :keymap ivy-reverse-i-search-map - :initial-input input - :action #'counsel--browse-history-action - :caller caller))) - -(defvar eshell-history-ring) -(defvar eshell-matching-input-from-input-string) - -;;;###autoload -(defun counsel-esh-history () - "Browse Eshell history." - (interactive) - (require 'em-hist) - (counsel--browse-history eshell-history-ring - :caller #'counsel-esh-history)) - -(advice-add 'eshell-previous-matching-input - :before #'counsel--set-eshell-history-index) -(defun counsel--set-eshell-history-index (&rest _) - "Reassign `eshell-history-index'." - (when (and (memq last-command '(ivy-alt-done ivy-done)) - (equal (ivy-state-caller ivy-last) 'counsel-esh-history)) - (setq eshell-history-index counsel-esh--index-last))) - -(defvar comint-input-ring) -(defvar comint-matching-input-from-input-string) - -;;;###autoload -(defun counsel-shell-history () - "Browse shell history." - (interactive) - (require 'comint) - (counsel--browse-history comint-input-ring - :caller #'counsel-shell-history)) - -(advice-add 'comint-previous-matching-input - :before #'counsel--set-comint-history-index) -(defun counsel--set-comint-history-index (&rest _) - "Reassign `comint-input-ring-index'." - (when (and (memq last-command '(ivy-alt-done ivy-done)) - (equal (ivy-state-caller ivy-last) 'counsel-shell-history)) - (setq comint-input-ring-index counsel-shell-history--index-last))) - -(defvar slime-repl-input-history) - -;;;###autoload -(defun counsel-slime-repl-history () - "Browse Slime REPL history." - (interactive) - (require 'slime-repl) - (counsel--browse-history slime-repl-input-history - :caller #'counsel-slime-repl-history)) - -;; TODO: add advice for slime-repl-input-previous/next to properly -;; reassign the ring index and match string. This requires a case for -;; `counsel-slime-repl-history' within -;; `counsel--browse-history-action'. - -;;;; `counsel-hydra-heads' - -(defvar hydra-curr-body-fn) -(declare-function hydra-keyboard-quit "ext:hydra") - -;;;###autoload -(defun counsel-hydra-heads () - "Call a head of the current/last hydra." - (interactive) - (let* ((base (substring - (prin1-to-string hydra-curr-body-fn) - 0 -4)) - (heads (symbol-value (intern (concat base "heads")))) - (keymap (symbol-value (intern (concat base "keymap")))) - (head-names - (mapcar (lambda (x) - (cons - (if (nth 2 x) - (format "[%s] %S (%s)" (nth 0 x) (nth 1 x) (nth 2 x)) - (format "[%s] %S" (nth 0 x) (nth 1 x))) - (lookup-key keymap (kbd (nth 0 x))))) - heads))) - (ivy-read "head: " head-names - :action (lambda (x) (call-interactively (cdr x)))) - (hydra-keyboard-quit))) - -;;;; `counsel-semantic' - -(declare-function semantic-tag-start "semantic/tag") -(declare-function semantic-tag-class "semantic/tag") -(declare-function semantic-tag-name "semantic/tag") -(declare-function semantic-tag-put-attribute "semantic/tag") -(declare-function semantic-tag-get-attribute "semantic/tag") -(declare-function semantic-fetch-tags "semantic") -(declare-function semantic-format-tag-summarize "semantic/format") -(declare-function semantic-active-p "semantic/fw") - -(defun counsel-semantic-action (x) - "Got to semantic TAG." - (goto-char (semantic-tag-start (cdr x)))) - -(defvar counsel-semantic-history nil - "History for `counsel-semantic'.") - -(defun counsel-semantic-format-tag (tag) - "Return a pretty string representation of TAG." - (let ((depth (or (semantic-tag-get-attribute tag :depth) 0)) - (parent (semantic-tag-get-attribute tag :parent))) - (concat (make-string (* depth 2) ?\ ) - (if parent - (concat "(" parent ") ") - "") - (semantic-format-tag-summarize tag nil t)))) - -(defun counsel-flatten-forest (func treep forest) - "Use FUNC and TREEP to flatten FOREST. -FUNC is applied to each node. -TREEP is used to expand internal nodes." - (cl-labels ((reducer (forest out depth) - (dolist (tree forest) - (let ((this (cons (funcall func tree depth) out)) - (leafs (funcall treep tree))) - (setq out - (if leafs - (reducer leafs this (1+ depth)) - this)))) - out)) - (nreverse (reducer forest nil 0)))) - -(defun counsel-semantic-tags () - "Fetch semantic tags." - (counsel-flatten-forest - (lambda (tree depth) - (semantic-tag-put-attribute tree :depth depth)) - (lambda (tag) - (when (eq (semantic-tag-class tag) 'type) - (let ((name (semantic-tag-name tag))) - (mapcar - (lambda (x) (semantic-tag-put-attribute x :parent name)) - (semantic-tag-get-attribute tag :members))))) - (semantic-fetch-tags))) - -;;;###autoload -(defun counsel-semantic () - "Jump to a semantic tag in the current buffer." - (interactive) - (let ((tags (mapcar - (lambda (x) - (cons - (counsel-semantic-format-tag x) - x)) - (counsel-semantic-tags)))) - (ivy-read "tag: " tags - :action #'counsel-semantic-action - :history 'counsel-semantic-history - :caller 'counsel-semantic))) - -;;;###autoload -(defun counsel-semantic-or-imenu () - (interactive) - (require 'semantic/fw) - (if (semantic-active-p) - (counsel-semantic) - (counsel-imenu))) - -;;;; `counsel-outline' - -(defcustom counsel-outline-face-style nil - "Determines how to style outline headings during completion. - -If `org', the faces `counsel-outline-1' through -`counsel-outline-8' are applied in a similar way to Org. -Note that no cycling is performed, so headings on levels 9 and -higher are not styled. - -If `verbatim', the faces used in the buffer are applied. For -simple headlines in `org-mode' buffers, this is usually the same -as the `org' setting, except that it depends on how much of the -buffer has been completely fontified. If your buffer exceeds a -certain size, headlines are styled lazily depending on which -parts of the tree are visible. Headlines which are not yet -styled in the buffer will appear unstyled in the minibuffer as -well. If your headlines contain parts which are fontified -differently than the headline itself (e.g. TODO keywords, tags, -links) and you want these parts to be styled properly, verbatim -is the way to go; otherwise you are probably better off using the -`org' setting instead. - -If `custom', the faces defined in `counsel-outline-custom-faces' -are applied. Note that no cycling is performed, so if there is -no face defined for a certain level, headlines on that level will -not be styled. - -If `nil', all headlines are highlighted using -`counsel-outline-default'. - -For displaying tags and TODO keywords in `org-mode' buffers, see -`counsel-org-headline-display-tags' and -`counsel-org-headline-display-todo', respectively." - :type '(choice - (const :tag "Same as org-mode" org) - (const :tag "Verbatim" verbatim) - (const :tag "Custom" custom) - (const :tag "No style" nil))) - -(defcustom counsel-outline-custom-faces nil - "List of faces for custom display of outline headings. - -Headlines on level N are fontified with the Nth entry of this -list, starting with N = 1. Headline levels with no corresponding -entry in this list will not be styled. - -This variable has no effect unless `counsel-outline-face-style' -is set to `custom'." - :type '(repeat face)) - -(defun counsel-outline-title () - "Return title of current outline heading. -Intended as a value for the `:outline-title' setting in -`counsel-outline-settings', which see." - (buffer-substring (point) (line-end-position))) - -(defun counsel-outline-title-org () - "Return title of current outline heading. -Like `counsel-outline-title' (which see), but for `org-mode' -buffers." - (let ((statistics-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)]") - (heading (apply #'org-get-heading (counsel--org-get-heading-args)))) - (cond (counsel-org-headline-display-statistics - heading) - (heading - (org-trim (replace-regexp-in-string - statistics-re " " heading t t)))))) - -(defun counsel-outline-title-markdown () - "Return title of current outline heading. -Like `counsel-outline-title' (which see), but for -`markdown-mode' (from the eponymous package) buffers." - ;; `outline-regexp' is set by `markdown-mode' to match both setext - ;; (underline) and atx (hash) headings (see - ;; `markdown-regex-header'). - (or (match-string 1) ; setext heading title - (match-string 5))) ; atx heading title - -(defun counsel-outline-title-latex () - "Return title of current outline heading. -Like `counsel-outline-title' (which see), but for `latex-mode' -buffers." - ;; `outline-regexp' is set by `latex-mode' (see variable - ;; `latex-section-alist' for the built-in mode or function - ;; `LaTeX-outline-regexp' for the AUCTeX package) to match section - ;; macros, in which case we get the section name, as well as - ;; `\appendix', `\documentclass', `\begin{document}', and - ;; `\end{document}', in which case we simply return that. - (if (and (assoc (match-string 1) ; Macro name - (or (bound-and-true-p LaTeX-section-list) ; AUCTeX - (bound-and-true-p latex-section-alist))) ; Built-in - (progn - ;; Point is at end of macro name, skip stars and optional args - (skip-chars-forward "*") - (while (looking-at-p "\\[") - (forward-list)) - ;; First mandatory arg should be section title - (looking-at-p "{"))) - (buffer-substring (1+ (point)) (1- (progn (forward-list) (point)))) - (buffer-substring (line-beginning-position) (point)))) - -(defun counsel-outline-level-emacs-lisp () - "Return level of current outline heading. -Like `lisp-outline-level', but adapted for the `:outline-level' -setting in `counsel-outline-settings', which see." - (if (looking-at ";;\\([;*]+\\)") - (- (match-end 1) (match-beginning 1)) - (funcall outline-level))) - -(defvar counsel-outline--preselect 0 - "Index of the preselected candidate in `counsel-outline'.") - -(defun counsel-outline-candidates (&optional settings prefix) - "Return an alist of outline heading completion candidates. -Each element is a pair (HEADING . MARKER), where the string -HEADING is located at the position of MARKER. SETTINGS is a -plist entry from `counsel-outline-settings', which see. -PREFIX is a string prepended to all candidates." - (let* ((bol-regex (concat "^\\(?:" - (or (plist-get settings :outline-regexp) - outline-regexp) - "\\)")) - (outline-title-fn (or (plist-get settings :outline-title) - #'counsel-outline-title)) - (outline-level-fn (or (plist-get settings :outline-level) - outline-level)) - (display-style (or (plist-get settings :display-style) - counsel-outline-display-style)) - (path-separator (or (plist-get settings :path-separator) - counsel-outline-path-separator)) - (face-style (or (plist-get settings :face-style) - counsel-outline-face-style)) - (custom-faces (or (plist-get settings :custom-faces) - counsel-outline-custom-faces)) - (stack-level 0) - (orig-point (point)) - (stack (and prefix (list (counsel-outline--add-face - prefix 0 face-style custom-faces)))) - cands name level marker) - (save-excursion - (setq counsel-outline--preselect 0) - (goto-char (point-min)) - (while (re-search-forward bol-regex nil t) - (save-excursion - (setq name (or (save-match-data - (funcall outline-title-fn)) - "")) - (goto-char (match-beginning 0)) - (setq marker (point-marker)) - (setq level (funcall outline-level-fn)) - (cond ((eq display-style 'path) - ;; Update stack. The empty entry guards against incorrect - ;; headline hierarchies, e.g. a level 3 headline - ;; immediately following a level 1 entry. - (while (<= level stack-level) - (pop stack) - (cl-decf stack-level)) - (while (> level stack-level) - (push "" stack) - (cl-incf stack-level)) - (setf (car stack) - (counsel-outline--add-face - name level face-style custom-faces)) - (setq name (mapconcat #'identity - (reverse stack) - path-separator))) - (t - (when (eq display-style 'headline) - (setq name (concat (make-string level ?*) " " name))) - (setq name (counsel-outline--add-face - name level face-style custom-faces)))) - (push (cons name marker) cands)) - (unless (or (string= name "") - (< orig-point marker)) - (cl-incf counsel-outline--preselect)))) - (nreverse cands))) - -(defun counsel-outline--add-face (name level &optional face-style custom-faces) - "Set the `face' property on headline NAME according to LEVEL. -FACE-STYLE and CUSTOM-FACES override `counsel-outline-face-style' -and `counsel-outline-custom-faces', respectively, which determine -the face to apply." - (let ((face (cl-case (or face-style counsel-outline-face-style) - (verbatim) - (custom (nth (1- level) - (or custom-faces counsel-outline-custom-faces))) - (org (format "counsel-outline-%d" level)) - (t 'counsel-outline-default)))) - (when face - (put-text-property 0 (length name) 'face face name))) - name) - -(defun counsel-outline-action (x) - "Go to outline X." - (goto-char (cdr x))) - -;;;###autoload -(defun counsel-outline () - "Jump to an outline heading with completion." - (interactive) - (let ((settings (cdr (assq major-mode counsel-outline-settings)))) - (ivy-read "Outline: " (counsel-outline-candidates settings) - :action (or (plist-get settings :action) - #'counsel-outline-action) - :history (or (plist-get settings :history) - 'counsel-outline-history) - :preselect (max (1- counsel-outline--preselect) 0) - :caller (or (plist-get settings :caller) - 'counsel-outline)))) - -;;;; `counsel-ibuffer' - -(defvar counsel-ibuffer--buffer-name nil - "Name of the buffer to use for `counsel-ibuffer'.") - -;;;###autoload -(defun counsel-ibuffer (&optional name) - "Use ibuffer to switch to another buffer. -NAME specifies the name of the buffer (defaults to \"*Ibuffer*\")." - (interactive) - (setq counsel-ibuffer--buffer-name (or name "*Ibuffer*")) - (ivy-read "Switch to buffer: " (counsel--ibuffer-get-buffers) - :history 'counsel-ibuffer-history - :action #'counsel-ibuffer-visit-buffer - :caller 'counsel-ibuffer)) - -(declare-function ibuffer-update "ibuffer") -(declare-function ibuffer-current-buffer "ibuffer") -(declare-function ibuffer-forward-line "ibuffer") -(defvar ibuffer-movement-cycle) - -(defun counsel--ibuffer-get-buffers () - "Return an alist with buffer completion candidates from Ibuffer. -The keys are buffer-related lines from Ibuffer as strings, and -the values are the corresponding buffer objects." - (let ((oldbuf (get-buffer counsel-ibuffer--buffer-name))) - (unless oldbuf - ;; Avoid messing with the user's precious window/frame configuration. - (save-window-excursion - (let ((display-buffer-overriding-action - '(display-buffer-same-window (inhibit-same-window . nil)))) - (ibuffer nil counsel-ibuffer--buffer-name nil t)))) - (with-current-buffer counsel-ibuffer--buffer-name - (when oldbuf - ;; Forcibly update possibly stale existing buffer. - (ibuffer-update nil t)) - (goto-char (point-min)) - (let ((ibuffer-movement-cycle nil) - entries) - (while (not (eobp)) - (ibuffer-forward-line 1 t) - (let ((buf (ibuffer-current-buffer))) - ;; We are only interested in buffers we can actually visit. - ;; This filters out headings and other unusable entries. - (when (buffer-live-p buf) - (push (cons (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)) - buf) - entries)))) - (nreverse entries))))) - -(defun counsel-ibuffer-visit-buffer (x) - "Switch to buffer of candidate X." - (switch-to-buffer (or (cdr-safe x) x))) - -(defun counsel-ibuffer-visit-buffer-other-window (x) - "Switch to buffer of candidate X in another window." - (switch-to-buffer-other-window (or (cdr-safe x) x))) - -(defun counsel-ibuffer-visit-ibuffer (_) - "Switch to Ibuffer buffer." - (switch-to-buffer counsel-ibuffer--buffer-name)) - -(ivy-set-actions - 'counsel-ibuffer - '(("j" counsel-ibuffer-visit-buffer-other-window "other window") - ("v" counsel-ibuffer-visit-ibuffer "switch to Ibuffer"))) - -;;;; `counsel-switch-to-shell-buffer' - -(defun counsel--buffers-with-mode (mode) - "Return names of buffers with MODE as their `major-mode'." - (let (bufs) - (dolist (buf (buffer-list)) - (when (eq (buffer-local-value 'major-mode buf) mode) - (push (buffer-name buf) bufs))) - (nreverse bufs))) - -(declare-function shell-mode "shell") - -;;;###autoload -(defun counsel-switch-to-shell-buffer () - "Switch to a shell buffer, or create one." - (interactive) - (ivy-read "Shell buffer: " (counsel--buffers-with-mode #'shell-mode) - :action #'counsel--switch-to-shell - :caller 'counsel-switch-to-shell-buffer)) - -(defun counsel--switch-to-shell (name) - "Display shell buffer with NAME and select its window. -Reuse any existing window already displaying the named buffer. -If there is no such buffer, start a new `shell' with NAME." - (if (get-buffer name) - (pop-to-buffer name '((display-buffer-reuse-window - display-buffer-same-window) - (inhibit-same-window . nil) - (reusable-frames . visible))) - (shell name))) - -;;;; `counsel-unicode-char' - -(defvar counsel-unicode-char-history nil - "History for `counsel-unicode-char'.") - -(defun counsel--unicode-names () - "Return formatted and sorted list of `ucs-names'. -The result of `ucs-names' is mostly, but not completely, sorted, -so this function ensures lexicographic order." - (let* (cands - (table (ucs-names)) ; Either hash map or alist - (fmt (lambda (name code) ; Common format function - (let ((cand (format "%06X %-58s %c" code name code))) - (put-text-property 0 1 'code code cand) - (push cand cands))))) - (if (not (hash-table-p table)) - ;; Support `ucs-names' returning an alist in Emacs < 26. - ;; The result of `ucs-names' comes pre-reversed so no need to repeat. - (dolist (entry table) - (funcall fmt (car entry) (cdr entry))) - (maphash fmt table) - ;; Reverse to speed up sorting - (setq cands (nreverse cands))) - (sort cands #'string-lessp))) - -(defvar counsel--unicode-table - (lazy-completion-table counsel--unicode-table counsel--unicode-names) - "Lazy completion table for `counsel-unicode-char'. -Candidates comprise `counsel--unicode-names', which see.") - -;;;###autoload -(defun counsel-unicode-char (&optional count) - "Insert COUNT copies of a Unicode character at point. -COUNT defaults to 1." - (interactive "p") - (setq ivy-completion-beg (point)) - (setq ivy-completion-end (point)) - (ivy-read "Unicode name: " counsel--unicode-table - :history 'counsel-unicode-char-history - :action (lambda (name) - (with-ivy-window - (delete-region ivy-completion-beg ivy-completion-end) - (setq ivy-completion-beg (point)) - (insert-char (get-text-property 0 'code name) count) - (setq ivy-completion-end (point)))) - :caller 'counsel-unicode-char)) - -(ivy-configure 'counsel-unicode-char - :sort-fn #'ivy-string<) - -(defun counsel-unicode-copy (name) - "Ivy action to copy the unicode from NAME to the kill ring." - (kill-new (char-to-string (get-text-property 0 'code name)))) - -(ivy-set-actions - 'counsel-unicode-char - '(("w" counsel-unicode-copy "copy"))) - -;;;; Colors - -(defun counsel-colors-action-insert-hex (color) - "Insert the hexadecimal RGB value of COLOR." - (insert (get-text-property 0 'hex color))) - -(defun counsel-colors-action-kill-hex (color) - "Kill the hexadecimal RGB value of COLOR." - (kill-new (get-text-property 0 'hex color))) - -;;;;; `counsel-colors-emacs' - -(defvar counsel-colors-emacs-history () - "History for `counsel-colors-emacs'.") - -(defun counsel-colors--name-to-hex (name) - "Return hexadecimal RGB value of color with NAME. - -Return nil if NAME does not designate a valid color." - (let ((rgb (color-name-to-rgb name))) - (when rgb - (apply #'color-rgb-to-hex rgb)))) - -(defvar shr-color-visible-luminance-min) -(declare-function shr-color-visible "shr-color") -(defvar counsel--colors-format "%-20s %s %s%s") - -(defun counsel--colors-emacs-format-function (colors) - "Format function for `counsel-colors-emacs'." - (require 'shr-color) - (let* ((blank (make-string 10 ?\s)) - (formatter - (lambda (color) - (let ((fg (list :foreground color))) - (format counsel--colors-format color - (propertize (get-text-property 0 'hex color) 'face fg) - (propertize blank 'face (list :background color)) - (propertize (mapconcat (lambda (dup) - (concat " " dup)) - (get-text-property 0 'dups color) - ",") - 'face fg)))))) - (ivy--format-function-generic - (lambda (color) - (let* ((hex (get-text-property 0 'hex color)) - (shr-color-visible-luminance-min 100) - (fg (cadr (shr-color-visible hex "black" t)))) - (propertize (funcall formatter color) - 'face (list :foreground fg :background hex)))) - formatter colors "\n"))) - -(defun counsel--colors-web-format-function (colors) - "Format function for `counsel-colors-web'." - (require 'shr-color) - (let* ((blank (make-string 10 ?\s)) - (formatter (lambda (color) - (let ((hex (get-text-property 0 'hex color))) - (format counsel--colors-format color - (propertize hex 'face (list :foreground hex)) - (propertize blank 'face (list :background hex))))))) - (ivy--format-function-generic - (lambda (color) - (let* ((hex (get-text-property 0 'hex color)) - (shr-color-visible-luminance-min 100) - (fg (cadr (shr-color-visible hex "black" t)))) - (propertize (funcall formatter color) - 'face (list :foreground fg :background hex)))) - formatter colors "\n"))) - -;; No longer preloaded in Emacs 28. -(autoload 'list-colors-duplicates "facemenu") - -;;;###autoload -(defun counsel-colors-emacs () - "Show a list of all supported colors for a particular frame. - -You can insert or kill the name or hexadecimal RGB value of the -selected color." - (interactive) - (let* ((colors - (delete nil - (mapcar (lambda (cell) - (let* ((name (car cell)) - (dups (cdr cell)) - (hex (counsel-colors--name-to-hex name))) - (when hex - (propertize name 'hex hex 'dups dups)))) - (list-colors-duplicates)))) - (counsel--colors-format - (format "%%-%ds %%s %%s%%s" - (apply #'max 0 (mapcar #'string-width colors))))) - (ivy-read "Emacs color: " colors - :require-match t - :history 'counsel-colors-emacs-history - :action #'insert - :caller 'counsel-colors-emacs))) -(ivy-configure 'counsel-colors-emacs - :format-fn #'counsel--colors-emacs-format-function) - -(ivy-set-actions - 'counsel-colors-emacs - '(("h" counsel-colors-action-insert-hex "insert hexadecimal value") - ("H" counsel-colors-action-kill-hex "kill hexadecimal value"))) - -;;;;; `counsel-colors-web' - -(defvar shr-color-html-colors-alist) - -(defun counsel-colors--web-alist () - "Return list of CSS colors for `counsel-colors-web'." - (require 'shr-color) - (let* ((alist (copy-alist shr-color-html-colors-alist)) - (mp (assoc "MediumPurple" alist)) - (pvr (assoc "PaleVioletRed" alist)) - (rp (assoc "RebeccaPurple" alist))) - ;; Backport GNU Emacs bug#30377 - (when mp (setcdr mp "#9370db")) - (when pvr (setcdr pvr "#db7093")) - (unless rp (push (cons "rebeccapurple" "#663399") alist)) - (sort (mapcar (lambda (cell) - (propertize (downcase (car cell)) - 'hex (downcase (cdr cell)))) - alist) - #'string-lessp))) - -(defvar counsel-colors-web-history () - "History for `counsel-colors-web'.") - -;;;###autoload -(defun counsel-colors-web () - "Show a list of all W3C web colors for use in CSS. - -You can insert or kill the name or hexadecimal RGB value of the -selected color." - (interactive) - (let* ((colors (counsel-colors--web-alist)) - (counsel--colors-format - (format "%%-%ds %%s %%s" - (apply #'max 0 (mapcar #'string-width colors))))) - (ivy-read "Web color: " colors - :require-match t - :history 'counsel-colors-web-history - :action #'insert - :caller 'counsel-colors-web))) - -(ivy-configure 'counsel-colors-web - :sort-fn #'ivy-string< - :format-fn #'counsel--colors-web-format-function) - -(ivy-set-actions - 'counsel-colors-web - '(("h" counsel-colors-action-insert-hex "insert hexadecimal value") - ("H" counsel-colors-action-kill-hex "kill hexadecimal value"))) - -;;;; `counsel-fonts' - -(defvar counsel-fonts-history () - "History for `counsel-fonts'.") - -;;;###autoload -(defun counsel-fonts () - "Show a list of all supported font families for a particular frame. - -You can insert or kill the name of the selected font." - (interactive) - (let ((current-font - (symbol-name (font-get (face-attribute 'default :font) :family)))) - (ivy-read "Font: " (delete-dups (font-family-list)) - :preselect current-font - :require-match t - :history 'counsel-fonts-history - :action #'insert - :caller 'counsel-fonts))) - -(ivy-configure 'counsel-fonts - :display-transformer-fn #'counsel--font-with-sample) - -(defun counsel--font-with-sample (font-name) - "Format function for `counsel-fonts'." - (format "%-75s%s" font-name - (propertize "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" - 'face (list :family font-name)))) - -;;;; `counsel-kmacro' - -(defvar counsel-kmacro-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-k") #'counsel-kmacro-kill) - map)) - -;; Avoid (declare (modes ...)) warnings in Emacs < 28. -(function-put #'counsel-kmacro-kill 'command-modes '(minibuffer-mode)) -(defun counsel-kmacro-kill () - "Kill the line, or delete the currently selected keyboard macro." - (interactive) - (unless (window-minibuffer-p) - (user-error "No completion session is active")) - (if (not (eolp)) - (ivy-kill-line) - (counsel-kmacro-action-delete-kmacro - (assoc - (ivy-state-current ivy-last) - (ivy-state-collection ivy-last))) - (ivy--kill-current-candidate))) - -(defvar kmacro-counter) -(defvar kmacro-counter-format-start) -(defvar kmacro-ring) -(declare-function kmacro-cycle-ring-next "kmacro" (&optional arg)) -(declare-function kmacro-cycle-ring-previous "kmacro" (&optional arg)) -(declare-function kmacro-delete-ring-head "kmacro" (&optional arg)) -(declare-function kmacro-ring-head "kmacro" ()) -(declare-function kmacro-set-counter "kmacro" (arg)) -(declare-function kmacro-set-format "kmacro" (format)) -(declare-function kmacro-split-ring-element "kmacro" (elt)) - -;;;###autoload -(defun counsel-kmacro () - "Interactively choose and execute a keyboard macro. - -With a prefix argument, execute the macro that many times. - -Macros are executed using their respective `kmacro-counter' value and -counter format; these values are also displayed next to each completion -candidate. - -The default actions include the ability to copy one macro's counter -value or format as the basis for another macro execution or definition. - -The following key bindings are also available: -\\{counsel-kmacro-map}" - (interactive) - (require 'kmacro) - (ivy-read "Execute macro: " - (or (counsel--kmacro-candidates) - (user-error "No keyboard macros defined")) - :keymap counsel-kmacro-map - :require-match t - :action #'counsel-kmacro-action-run - :caller 'counsel-kmacro)) - -(ivy-configure 'counsel-kmacro - :format-fn #'counsel--kmacro-format-function) - -(defcustom counsel-kmacro-separator "\n------------------------\n" - "Separator displayed between keyboard macros in `counsel-kmacro'." - :type 'string) - -(defun counsel--kmacro-format-function (formatted-kmacro) - "Transform FORMATTED-KMACRO into a string for `counsel-kmacro'." - (ivy--format-function-generic - (lambda (str) (ivy--add-face str 'ivy-current-match)) - #'identity - formatted-kmacro - (propertize counsel-kmacro-separator 'face 'ivy-separator))) - -(defmacro counsel--with-kmacro (kmacro &rest body) - "Split KMACRO slots into corresponding dynvars around BODY." - (declare (debug t) (indent 1)) - `(let ((last-kbd-macro nil) - (kmacro-counter nil) - (kmacro-counter-format-start nil)) - ;; Works with both older triplets and Emacs 29 OClosures. - (kmacro-split-ring-element ,kmacro) - ,@body)) - -(defun counsel--format-kmacro () - "Return string representation of current keyboard macro." - (format "(%s,%s): %s" kmacro-counter-format-start kmacro-counter - (condition-case err - (format-kbd-macro last-kbd-macro 1) - ;; Recover from error in `edmacro-fix-menu-commands', - ;; especially prior to mouse event support in Emacs 27. - (error - (format (propertize "[Unprintable macro: %s]" 'face 'warning) - (error-message-string err)))))) - -(defun counsel--kmacro-candidates () - "Return an alist of known keyboard macros for `counsel-kmacro'. -The cdrs are the original `kmacro' objects from `kmacro-ring-head' and -`kmacro-ring'; the cars are a corresponding string representation." - (mapcar (lambda (km) - (cons (counsel--with-kmacro km - (counsel--format-kmacro)) - km)) - (let ((head (kmacro-ring-head))) - (and head (cons head kmacro-ring))))) - -(defun counsel--kmacro-exec (kmacro n) - "Execute KMACRO ring item N times." - (funcall (if (and (fboundp 'kmacro-p) (kmacro-p kmacro)) - #'funcall ;; Emacs 29 OClosure. - 'kmacro-exec-ring-item) - kmacro n)) - -(defun counsel-kmacro-action-run (candidate) - "Execute keyboard macro from `counsel-kmacro' CANDIDATE. -With a prefix argument, execute the macro that many times." - ;; Action prefix overrides `counsel-kmacro' prefix. - (let* ((pre (or ivy-current-prefix-arg current-prefix-arg)) - (km (cdr candidate)) - (head (equal km (kmacro-ring-head)))) - (counsel--kmacro-exec km (prefix-numeric-value pre)) - (when head - ;; Executing pseudo `kmacro-ring-head' updates that object's counter, - ;; but not the current `kmacro-counter', so reconcile them here. - (kmacro-split-ring-element km)) - ;; Update state for next `ivy-call'. - (counsel--with-kmacro km - (setcar candidate (counsel--format-kmacro)))) - (setf (ivy-state-current ivy-last) (car candidate)) - (setf (ivy-state-preselect ivy-last) ivy--index) - (ivy--reset-state ivy-last)) - -(defun counsel-kmacro-action-delete-kmacro (candidate) - "Delete the keyboard macro in `counsel-kmacro' CANDIDATE. -Either delete it from `kmacro-ring', or set `last-kbd-macro' -to the popped head of the ring." - (let ((km (cdr candidate))) - (if (memq km kmacro-ring) - (setq kmacro-ring (delq km kmacro-ring)) - (kmacro-delete-ring-head))) - ;; Update state for next `ivy-call'. - ;; TODO: Is `ivy--kill-current-candidate' required? - (let ((kms (ivy-state-collection ivy-last))) - (setf (ivy-state-collection ivy-last) (delq candidate kms)) - (setf (ivy-state-preselect ivy-last) - (max 0 (min ivy--index (1- (length kms)))))) - (ivy--reset-state ivy-last)) - -(defun counsel-kmacro-action-copy-initial-counter-value (candidate) - "Pass `counsel-kmacro' CANDIDATE's counter value to `kmacro-set-counter'. -This value will be used by the next executed macro, or as a -starting value by the next macro defined. - -Note that executing an existing macro that itself uses a counter -effectively resets the starting counter value for the next macro -definition to 0." - (kmacro-set-counter (counsel--with-kmacro (cdr candidate) - kmacro-counter))) - -(defun counsel-kmacro-action-copy-counter-format-for-new-macro (candidate) - "Pass `counsel-kmacro' CANDIDATE's counter format to `kmacro-set-format'. - -When no keyboard macro is being defined or executed, this affects the -default for all subsequent macro definitions." - (kmacro-set-format (counsel--with-kmacro (cdr candidate) - kmacro-counter-format-start))) - -(defun counsel--kmacro-cycle-until (kmacro) - "Cycle macro ring until KMACRO is the head; return number of steps." - (let ((i 0) - ;; Purely defensive; infloop should never happen. - ;; Purely defensive; infloop should never happen. - ;; Purely defensive; infloop should never happen.[Quit] - (fuel (* 4 (1+ (length kmacro-ring))))) - (while (not (equal kmacro (kmacro-ring-head))) - (unless (natnump (cl-decf fuel)) - (error "`counsel-kmacro' bug: exceeded cycle limit")) - (kmacro-cycle-ring-previous) - (cl-incf i)) - i)) - -(defun counsel-kmacro-action-cycle-ring-to-macro (candidate) - "Cycle `kmacro-ring' until `last-kbd-macro' is the selected macro. -This is convenient when using \\[kmacro-end-or-call-macro] to call macros." - (counsel--kmacro-cycle-until (cdr candidate)) - ;; Update state for next `ivy-call'. - (setf (ivy-state-collection ivy-last) (counsel--kmacro-candidates)) - (ivy--reset-state ivy-last)) - -(defun counsel-kmacro-action-set-saved-starting-counter (candidate) - "Set the counter value of `counsel-kmacro' CANDIDATE. -Interactively reads a new counter value from the minibuffer. - -Note that this requires cycling the keyboard macro ring until CANDIDATE, -and then cycling back." - (let* ((km (cdr candidate)) - (cnt (counsel--with-kmacro km kmacro-counter)) - (cnt (if (zerop cnt) cnt (list 0 cnt))) - (i (counsel--kmacro-cycle-until km))) - (setq kmacro-counter (read-number "New macro counter: " cnt)) - (dotimes (_ i) (kmacro-cycle-ring-next))) - ;; Update state for next `ivy-call'. - (setf (ivy-state-collection ivy-last) (counsel--kmacro-candidates)) - (setf (ivy-state-preselect ivy-last) ivy--index) - ;; Emacs 28 seems to have some bug where the text of the candidates - ;; in the minibuffer is not immediately refreshed. - (ivy--reset-state ivy-last)) - -(defun counsel-kmacro-action-execute-after-prompt (candidate) - "Execute selected keyboard macro with a different counter and format. - -Prompt for the number of times to execute the macro, the starting -counter, and the counter format. The corresponding values from the -selected `counsel-kmacro' CANDIDATE serve as defaults. If this action -is called with a prefix argument, its numeric value also serves as a -default option for the number of iterations and counter. - -The existing CANDIDATE, its counter and format, are left unchanged." - (let* ((pre (or ivy-current-prefix-arg current-prefix-arg)) - (pre (and pre (prefix-numeric-value pre)))) - (counsel--with-kmacro (cdr candidate) - (let ((times (read-number "Number of macro iterations: " - (let ((def '(1 2))) - (if pre (cons pre def) def))))) - (setq kmacro-counter - (read-number "Macro counter value: " - (if pre (list pre kmacro-counter) kmacro-counter))) - (setq kmacro-counter-format-start - (let ((prompt "Macro counter format") - (def kmacro-counter-format-start)) - (read-string (if (fboundp 'format-prompt) - (format-prompt prompt def) - (format "%s (default: %s): " prompt def)) - nil nil def))) - (counsel--kmacro-exec (kmacro-ring-head) times))))) - -(ivy-set-actions - 'counsel-kmacro - `(("c" ,#'counsel-kmacro-action-cycle-ring-to-macro - "cycle to") - ("d" ,#'counsel-kmacro-action-delete-kmacro - "delete") - ("e" ,#'counsel-kmacro-action-execute-after-prompt - "execute after prompt") - ("f" ,#'counsel-kmacro-action-copy-counter-format-for-new-macro - "copy counter format for new macro") - ("s" ,#'counsel-kmacro-action-set-saved-starting-counter - "set this counter value") - ("v" ,#'counsel-kmacro-action-copy-initial-counter-value - "copy starting counter value"))) - -;;;; `counsel-geiser-doc-look-up-manual' - -(declare-function geiser-doc-manual-for-symbol "ext:geiser-doc") -(defvar geiser-completion-symbol-list-func) - -(defvar counsel-geiser-doc-look-up-manual-history () - "History for `counsel-geiser-doc-look-up-manual'.") - -;;;###autoload -(defun counsel-geiser-doc-look-up-manual () - "Search Scheme documentation." - (interactive) - (ivy-read "Symbol: " geiser-completion-symbol-list-func - :require-match t - :history 'counsel-geiser-doc-look-up-manual-history - :action (lambda (cand) - (geiser-doc-manual-for-symbol (intern cand))) - :caller 'counsel-geiser-doc-look-up-manual)) - -;;; Misc. OS -;;;; `counsel-rhythmbox' - -(declare-function dbus-call-method "dbus") -(declare-function dbus-get-property "dbus") - -(defun counsel--run (&rest program-and-args) - (let ((name (mapconcat #'identity program-and-args " "))) - (apply #'start-process name nil program-and-args) - name)) - -(defun counsel--sl (cmd) - "Shell command to list." - (split-string (shell-command-to-string cmd) "\n" t)) - -(defun counsel-rhythmbox-play-song (song) - "Let Rhythmbox play SONG." - (let ((first (string= (shell-command-to-string "pidof rhythmbox") "")) - (service "org.gnome.Rhythmbox3") - (path "/org/mpris/MediaPlayer2") - (interface "org.mpris.MediaPlayer2.Player")) - (when first - (counsel--run "nohup" "rhythmbox") - (sit-for 1.5)) - (dbus-call-method :session service path interface - "OpenUri" (cdr song)) - (let ((id (and first - (cdr (counsel--wmctrl-parse - (shell-command-to-string - "wmctrl -l -p | grep $(pidof rhythmbox)")))))) - (when id - (sit-for 0.2) - (counsel--run "wmctrl" "-ic" id))))) - -(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" (cdr song)))) - -(defun counsel-rhythmbox-playpause-current-song () - "Play/pause the current song." - (interactive) - (let ((service "org.gnome.Rhythmbox3") - (path "/org/mpris/MediaPlayer2") - (interface "org.mpris.MediaPlayer2.Player")) - (dbus-call-method :session service path interface - "PlayPause"))) - -(defun counsel-rhythmbox-toggle-shuffle (_song) - "Toggle Rhythmbox shuffle setting." - (let* ((old-order (counsel--command "dconf" "read" "/org/gnome/rhythmbox/player/play-order")) - (new-order (if (string= old-order "'shuffle'") - "'linear'" - "'shuffle'"))) - (counsel--command - "dconf" - "write" - "/org/gnome/rhythmbox/player/play-order" - new-order) - (message (if (string= new-order "'shuffle'") - "shuffle on" - "shuffle off")))) - -(defvar counsel-rhythmbox-history nil - "History for `counsel-rhythmbox'.") - -(defvar counsel-rhythmbox-songs nil) - -(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 (&optional arg) - "Choose a song from the Rhythmbox library to play or enqueue." - (interactive "P") - (require 'dbus) - (when (or arg (null counsel-rhythmbox-songs)) - (let* ((service "org.gnome.Rhythmbox3") - (path "/org/gnome/UPnP/MediaServer2/Library/all") - (interface "org.gnome.UPnP.MediaContainer2") - (nb-songs (dbus-get-property - :session service path interface "ChildCount"))) - (if (not nb-songs) - (error "Couldn't connect to Rhythmbox") - (setq counsel-rhythmbox-songs - (mapcar (lambda (x) - (cons - (format - "%s - %s - %s" - (cl-caadr (assoc "Artist" x)) - (cl-caadr (assoc "Album" x)) - (cl-caadr (assoc "DisplayName" x))) - (cl-caaadr (assoc "URLs" x)))) - (dbus-call-method - :session service path interface "ListChildren" - 0 nb-songs '("*"))))))) - (ivy-read "Rhythmbox: " counsel-rhythmbox-songs - :require-match t - :history 'counsel-rhythmbox-history - :preselect (counsel-rhythmbox-current-song) - :action - '(1 - ("p" counsel-rhythmbox-play-song "Play song") - ("e" counsel-rhythmbox-enqueue-song "Enqueue song") - ("s" counsel-rhythmbox-toggle-shuffle "Shuffle on/off")) - :caller 'counsel-rhythmbox)) - -;;;; `counsel-linux-app' - -;; Added in Emacs 26.1. -(require 'xdg nil t) - -(defalias 'counsel--xdg-data-home - (if (fboundp 'xdg-data-home) - #'xdg-data-home - (lambda () - (let ((directory (getenv "XDG_DATA_HOME"))) - (if (or (null directory) (string= directory "")) - "~/.local/share" - directory)))) - "Compatibility shim for `xdg-data-home'.") - -(defalias 'counsel--xdg-data-dirs - (if (fboundp 'xdg-data-dirs) - #'xdg-data-dirs - (lambda () - (let ((path (getenv "XDG_DATA_DIRS"))) - (if (or (null path) (string= path "")) - '("/usr/local/share" "/usr/share") - (parse-colon-path path))))) - "Compatibility shim for `xdg-data-dirs'.") - -(defcustom counsel-linux-apps-directories - (mapcar (lambda (dir) (expand-file-name "applications" dir)) - (cons (counsel--xdg-data-home) - (counsel--xdg-data-dirs))) - "Directories in which to search for applications (.desktop files)." - :type '(repeat directory)) - -(defcustom counsel-linux-app-format-function #'counsel-linux-app-format-function-default - "Function to format Linux application names the `counsel-linux-app' menu. -The format function will be passed the application's name, comment, and command -as arguments." - :type '(choice - (const :tag "Command : Name - Comment" counsel-linux-app-format-function-default) - (const :tag "Name - Comment (Command)" counsel-linux-app-format-function-name-first) - (const :tag "Name - Comment" counsel-linux-app-format-function-name-only) - (const :tag "Name - Comment (Pretty)" counsel-linux-app-format-function-name-pretty) - (const :tag "Command" counsel-linux-app-format-function-command-only) - (function :tag "Custom"))) - -(defface counsel-application-name - '((t :inherit font-lock-builtin-face)) - "Face for displaying executable names." - :group 'ivy-faces) - -(defface counsel-outline-1 - '((t :inherit org-level-1)) - "Face for displaying level 1 headings." - :group 'ivy-faces) - -(defface counsel-outline-2 - '((t :inherit org-level-2)) - "Face for displaying level 2 headings." - :group 'ivy-faces) - -(defface counsel-outline-3 - '((t :inherit org-level-3)) - "Face for displaying level 3 headings." - :group 'ivy-faces) - -(defface counsel-outline-4 - '((t :inherit org-level-4)) - "Face for displaying level 4 headings." - :group 'ivy-faces) - -(defface counsel-outline-5 - '((t :inherit org-level-5)) - "Face for displaying level 5 headings." - :group 'ivy-faces) - -(defface counsel-outline-6 - '((t :inherit org-level-6)) - "Face for displaying level 6 headings." - :group 'ivy-faces) - -(defface counsel-outline-7 - '((t :inherit org-level-7)) - "Face for displaying level 7 headings." - :group 'ivy-faces) - -(defface counsel-outline-8 - '((t :inherit org-level-8)) - "Face for displaying level 8 headings." - :group 'ivy-faces) - -(defface counsel-outline-default - '((t :inherit minibuffer-prompt)) - "Face for displaying headings." - :group 'ivy-faces) - -(defvar counsel-linux-apps-faulty nil - "List of faulty desktop files.") - -(defvar counsel--linux-apps-cache nil - "Cache of desktop files data.") - -(defvar counsel--linux-apps-cached-files nil - "List of cached desktop files.") - -(defvar counsel--linux-apps-cache-timestamp nil - "Time when we last updated the cached application list.") - -(defvar counsel--linux-apps-cache-format-function nil - "The function used to format the cached Linux application menu.") - -(defun counsel-linux-app-format-function-default (name comment exec) - "Default Linux application name formatter. -NAME is the name of the application, COMMENT its comment and EXEC -the command to launch it." - (format "% -45s: %s%s" - (propertize - (ivy--truncate-string - (replace-regexp-in-string "env +[^ ]+ +" "" exec t t) - 45) - 'face 'counsel-application-name) - name - (if comment - (concat " - " comment) - ""))) - -(defun counsel-linux-app-format-function-name-first (name comment exec) - "Format Linux application names with the NAME (and COMMENT) first. -EXEC is the command to launch the application." - (format "%s%s (%s)" - name - (if comment - (concat " - " comment) - "") - (propertize exec 'face 'counsel-application-name))) - -(defun counsel-linux-app-format-function-name-only (name comment _exec) - "Format Linux application names with the NAME (and COMMENT) only." - (format "%s%s" - name - (if comment - (concat " - " comment) - ""))) - -(defun counsel-linux-app-format-function-command-only (_name _comment exec) - "Display only the command EXEC when formatting Linux application names." - exec) - -(defun counsel-linux-app-format-function-name-pretty (name comment _exec) - "Format Linux application names with the NAME (and COMMENT) only, but pretty." - (format "% -45s%s" - (propertize - (ivy--truncate-string name 45) - 'face 'counsel-application-name) - (if comment - (concat ": " comment) - ""))) - -(defun counsel-linux-apps-list-desktop-files () - "Return an alist of all Linux applications. -Each list entry is a pair of (desktop-name . desktop-file). -This function always returns its elements in a stable order." - (let ((hash (make-hash-table :test #'equal)) - result) - (dolist (dir counsel-linux-apps-directories) - (when (file-exists-p dir) - (let ((dir (file-name-as-directory dir))) - ;; Function `directory-files-recursively' added in Emacs 25.1. - (dolist (file (and (fboundp 'directory-files-recursively) - (directory-files-recursively dir "\\.desktop\\'"))) - (let ((id (subst-char-in-string ?/ ?- (file-relative-name file dir)))) - (when (and (not (gethash id hash)) (file-readable-p file)) - (push (cons id file) result) - (puthash id file hash))))))) - result)) - -(defun counsel-linux-app--parse-file (file) - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-min)) - (let ((start (re-search-forward "^\\[Desktop Entry\\] *$" nil t)) - (end (re-search-forward "^\\[" nil t)) - (visible t) - name comment exec) - (catch 'break - (unless start - (push file counsel-linux-apps-faulty) - (message "Warning: File %s has no [Desktop Entry] group" file) - (throw 'break nil)) - - (goto-char start) - (when (re-search-forward "^\\(Hidden\\|NoDisplay\\) *= *\\(1\\|true\\) *$" end t) - (setq visible nil)) - (setq name (match-string 1)) - - (goto-char start) - (unless (re-search-forward "^Type *= *Application *$" end t) - (throw 'break nil)) - (setq name (match-string 1)) - - (goto-char start) - (unless (re-search-forward "^Name *= *\\(.+\\)$" end t) - (push file counsel-linux-apps-faulty) - (message "Warning: File %s has no Name" file) - (throw 'break nil)) - (setq name (match-string 1)) - - (goto-char start) - (when (re-search-forward "^Comment *= *\\(.+\\)$" end t) - (setq comment (match-string 1))) - - (goto-char start) - (unless (re-search-forward "^Exec *= *\\(.+\\)$" end t) - ;; Don't warn because this can technically be a valid desktop file. - (throw 'break nil)) - (setq exec (match-string 1)) - - (goto-char start) - (when (re-search-forward "^TryExec *= *\\(.+\\)$" end t) - (let ((try-exec (match-string 1))) - (unless (locate-file try-exec exec-path nil #'file-executable-p) - (throw 'break nil)))) - (propertize - (funcall counsel-linux-app-format-function name comment exec) - 'visible visible))))) - -(defun counsel-linux-apps-parse (desktop-entries-alist) - "Parse the given alist of Linux desktop entries. -Each entry in DESKTOP-ENTRIES-ALIST is a pair of ((id . file-name)). -Any desktop entries that fail to parse are recorded in -`counsel-linux-apps-faulty'." - (let (result) - (setq counsel-linux-apps-faulty nil) - (dolist (entry desktop-entries-alist result) - (let* ((id (car entry)) - (file (cdr entry)) - (r (counsel-linux-app--parse-file file))) - (when r - (push (cons r id) result)))))) - -(defun counsel-linux-apps-list () - "Return list of all Linux desktop applications." - (let* ((new-desktop-alist (counsel-linux-apps-list-desktop-files)) - (new-files (mapcar #'cdr new-desktop-alist))) - (unless (and - (eq counsel-linux-app-format-function - counsel--linux-apps-cache-format-function) - (equal new-files counsel--linux-apps-cached-files) - (null (cl-find-if - (lambda (file) - (time-less-p - counsel--linux-apps-cache-timestamp - (nth 5 (file-attributes file)))) - new-files))) - (setq counsel--linux-apps-cache (counsel-linux-apps-parse new-desktop-alist)) - (setq counsel--linux-apps-cache-format-function counsel-linux-app-format-function) - (setq counsel--linux-apps-cache-timestamp (current-time)) - (setq counsel--linux-apps-cached-files new-files))) - counsel--linux-apps-cache) - - -(defun counsel-linux-app-action-default (desktop-shortcut) - "Launch DESKTOP-SHORTCUT." - (call-process "gtk-launch" nil 0 nil (cdr desktop-shortcut))) - -(defun counsel-linux-app-action-file (desktop-shortcut) - "Launch DESKTOP-SHORTCUT with a selected file." - (call-process "gtk-launch" nil 0 nil - (cdr desktop-shortcut) - (read-file-name "File: "))) - -(defun counsel-linux-app-action-open-desktop (desktop-shortcut) - "Open DESKTOP-SHORTCUT." - (let* ((app (cdr desktop-shortcut)) - (file (cdr (assoc app (counsel-linux-apps-list-desktop-files))))) - (if file - (find-file file) - (error "Could not find location of file %s" app)))) - -(ivy-set-actions - 'counsel-linux-app - '(("f" counsel-linux-app-action-file "run on a file") - ("d" counsel-linux-app-action-open-desktop "open desktop file"))) - -;;;###autoload -(defun counsel-linux-app (&optional arg) - "Launch a Linux desktop application, similar to Alt-. -When ARG is non-nil, ignore NoDisplay property in *.desktop files." - (interactive "P") - (ivy-read "Run application: " (counsel-linux-apps-list) - :predicate (unless arg (lambda (x) (get-text-property 0 'visible (car x)))) - :action #'counsel-linux-app-action-default - :caller 'counsel-linux-app)) - -;;;; `counsel-wmctrl' - -(defun counsel-wmctrl-action (x) - "Select the desktop window that corresponds to X." - (counsel--run "wmctrl" "-i" "-a" (cdr x))) - -(defvar counsel-wmctrl-ignore '("XdndCollectionWindowImp" - "unity-launcher" "unity-panel" "unity-dash" - "Hud" "Desktop") - "List of window titles to ignore for `counsel-wmctrl'.") - -(defun counsel--wmctrl-parse (s) - (when (string-match "\\`\\([0-9a-fx]+\\) +\\([-0-9]+\\) +\\(?:[0-9]+\\) +\\([^ ]+\\) \\(.+\\)$" s) - (let ((title (match-string 4 s)) - (id (match-string 1 s))) - (unless (member title counsel-wmctrl-ignore) - (cons title id))))) - -;;;###autoload -(defun counsel-wmctrl () - "Select a desktop window using wmctrl." - (interactive) - (let* ((cands1 (counsel--sl "wmctrl -l -p")) - (cands2 (delq nil (mapcar #'counsel--wmctrl-parse cands1)))) - (ivy-read "window: " cands2 - :action #'counsel-wmctrl-action - :caller 'counsel-wmctrl))) - -(defvar counsel--switch-buffer-temporary-buffers nil - "Internal.") - -(defvar counsel--switch-buffer-previous-buffers nil - "Internal.") - -(defun counsel--switch-buffer-unwind () - "Clear temporary file buffers and restore `buffer-list'. -The buffers are those opened during a session of `counsel-switch-buffer'." - (mapc #'kill-buffer counsel--switch-buffer-temporary-buffers) - (dolist (buf counsel--switch-buffer-previous-buffers) - (when (buffer-live-p buf) (bury-buffer buf))) - (setq counsel--switch-buffer-temporary-buffers ()) - (setq counsel--switch-buffer-previous-buffers ())) - -(defcustom counsel-switch-buffer-preview-virtual-buffers t - "When non-nil, `counsel-switch-buffer' will preview virtual buffers." - :type 'boolean) - -(defun counsel--switch-buffer-update-fn () - (unless counsel--switch-buffer-previous-buffers - (setq counsel--switch-buffer-previous-buffers (buffer-list))) - (let* ((virtual (assoc (ivy-state-current ivy-last) ivy--virtual-buffers))) - (when (member (ivy-state-current ivy-last) ivy-marked-candidates) - (setf (ivy-state-current ivy-last) - (substring (ivy-state-current ivy-last) (length ivy-mark-prefix)))) - (cond - ((get-buffer (ivy-state-current ivy-last)) - (let ((ivy-marked-candidates nil)) - (ivy-call))) - ((and counsel-switch-buffer-preview-virtual-buffers virtual (file-exists-p (cdr virtual))) - (let ((buf (ignore-errors - ;; may not open due to `large-file-warning-threshold' etc. - (find-file-noselect (cdr virtual))))) - (if buf - (progn - (push buf counsel--switch-buffer-temporary-buffers) - (ivy-call)) - ;; clean up the minibuffer so that there's no delay before - ;; the Ivy candidates are displayed once again - (message "")))) - (t - (with-ivy-window - (switch-to-buffer (ivy-state-buffer ivy-last))))))) - -;;;###autoload -(defun counsel-switch-buffer () - "Switch to another buffer. -Display a preview of the selected ivy completion candidate buffer -in the current window." - (interactive) - (let ((ivy-update-fns-alist - '((ivy-switch-buffer . counsel--switch-buffer-update-fn))) - (ivy-unwind-fns-alist - '((ivy-switch-buffer . counsel--switch-buffer-unwind)))) - (ivy-switch-buffer))) - -;;;###autoload -(defun counsel-switch-buffer-other-window () - "Switch to another buffer in another window. -Display a preview of the selected ivy completion candidate buffer -in the current window." - (interactive) - (let ((ivy-update-fns-alist - '((ivy-switch-buffer-other-window . counsel--switch-buffer-update-fn))) - (ivy-unwind-fns-alist - '((ivy-switch-buffer-other-window . counsel--switch-buffer-unwind)))) - (ivy-switch-buffer-other-window))) - -(defun counsel-open-buffer-file-externally (buffer) - "Open the file associated with BUFFER with an external program." - (when (zerop (length buffer)) - (user-error "Can't open that")) - (let* ((virtual (assoc buffer ivy--virtual-buffers)) - (filename (if virtual - (cdr virtual) - (buffer-file-name (get-buffer buffer))))) - (unless filename - (user-error "Can't open `%s' externally" buffer)) - (counsel-locate-action-extern (expand-file-name filename)))) - -(ivy-add-actions - 'ivy-switch-buffer - '(("x" counsel-open-buffer-file-externally "open externally"))) - -(ivy-set-actions - 'counsel-switch-buffer - '(("x" counsel-open-buffer-file-externally "open externally") - ("j" ivy--switch-buffer-other-window-action "other window"))) - -;;;; `counsel-compile' - -(defvar counsel-compile-history nil - "History for `counsel-compile'. - -This is a list of strings with additional properties which allow -the history to be filtered depending on the context of the call. -The properties include: - -`srcdir' - the root directory of the source code -`blddir' - the root directory of the build (in or outside the `srcdir') -`bldenv' - the build environment as passed to `compilation-environment' -`recursive' - the completion should be run again in `blddir' of this result -`cmd' - if set, pass only the substring with this property to `compile' - -This variable is suitable for addition to -`savehist-additional-variables'.") - -(defvar counsel-compile-root-functions - '(counsel--projectile-root - counsel--project-current - counsel--configure-root - counsel--git-root - counsel--dir-locals-root) - "Special hook to find the project root for compile commands. -Each function on this hook is called in turn with no arguments -and should return either a directory, or nil if no root was -found.") - -(defun counsel--compile-root () - "Return root of current project or signal an error on failure. -The root is determined by `counsel-compile-root-functions'." - (or (run-hook-with-args-until-success 'counsel-compile-root-functions) - (error "Couldn't find project root"))) - -(defun counsel--projectile-root () - "Return root of current projectile project or nil on failure. -Use `projectile-project-root' to determine the root." - (and (fboundp 'projectile-project-root) - (projectile-project-root))) - -(defun counsel--project-current () - "Return root of current project or nil on failure. -Use `project-current' to determine the root." - (let ((proj (and (fboundp 'project-current) - (project-current)))) - (cond ((not proj) nil) - ((fboundp 'project-root) - (project-root proj)) - ((fboundp 'project-roots) - (car (project-roots proj)))))) - -(defun counsel--configure-root () - "Return root of current project or nil on failure. -Use the presence of a \"configure\" file to determine the root." - (counsel--dominating-file "configure")) - -(defun counsel--git-root () - "Return root of current project or nil on failure. -Use the presence of a \".git\" file to determine the root." - (counsel--dominating-file ".git")) - -(defun counsel--dir-locals-root () - "Return root of current project or nil on failure. -Use the presence of a `dir-locals-file' to determine the root." - (counsel--dominating-file dir-locals-file)) - -(defvar counsel-compile-local-builds - '(counsel-compile-get-filtered-history - counsel-compile-get-build-directories - counsel-compile-get-make-invocation - counsel-compile-get-make-help-invocations) - "Additional compile invocations to feed into `counsel-compile'. - -This can either be a list of compile invocation strings or -functions that will provide such a list. You should customize -this if you want to provide specific non-standard build types to -`counsel-compile'. The default helpers are set up to handle -common build environments.") - -(defcustom counsel-compile-make-args "-k" - "Additional arguments for make. -You may, for example, want to add \"-jN\" for the number of cores -N in your system." - :type 'string) - -(defcustom counsel-compile-env nil - "List of environment variables for compilation to inherit. -Each element should be a string of the form ENVVARNAME=VALUE. This -list is passed to `compilation-environment'." - :type '(repeat (string :tag "ENVVARNAME=VALUE"))) - -(defvar counsel-compile-env-history nil - "History for `counsel-compile-env'.") - -(defvar counsel-compile-env-pattern - "[_[:digit:][:upper:]]+=[/[:alnum:]]*" - "Pattern to match valid environment variables.") - -(defcustom counsel-compile-make-pattern "\\`\\(?:GNUm\\|[Mm]\\)akefile\\'" - "Regexp for matching the names of Makefiles." - :type 'regexp) - -(defcustom counsel-compile-build-directories - '("build" "builds" "bld" ".build") - "List of potential build subdirectory names to check for." - :type '(repeat directory)) - -(defvar counsel-compile-phony-pattern "^\\.PHONY:[\t ]+\\(.+\\)$" - "Regexp for extracting phony targets from Makefiles.") - -(defvar counsel-compile-help-pattern - "\\(?:^\\(\\*\\)?[[:space:]]+\\([^[:space:]]+\\)[[:space:]]+-\\)" - "Regexp for extracting help targets from a make help call.") - -;; This is loosely based on the Bash Make completion code which -;; relies on GNUMake having the following return codes: -;; 0 = no-rebuild, -q & 1 needs rebuild, 2 error -(defun counsel-compile--probe-make-targets (dir) - "Return a list of Make targets for DIR. - -Return a single blank target (so we invoke the default target) -if Make exits with an error. This might happen because some sort -of configuration needs to be done first or the source tree is -pristine and being used for multiple build trees." - (with-temp-buffer - (let* ((default-directory dir) - (res (call-process "make" nil t nil "-nqp")) - targets) - (if (or (not (numberp res)) (> res 1)) - (list "") - (goto-char (point-min)) - (while (re-search-forward counsel-compile-phony-pattern nil t) - (push (split-string (match-string-no-properties 1)) targets)) - (sort (apply #'nconc targets) #'string-lessp))))) - -(defun counsel-compile--pretty-propertize (leader text face) - "Return a pretty string of the form \" LEADER TEXT\". -LEADER is propertized with a warning face and the remaining -text with FACE." - (concat (propertize (concat " " leader " ") - 'face - 'font-lock-warning-face) - (propertize text 'face face))) - -(defun counsel--compile-get-make-targets (probe-fn srcdir &optional blddir) - "Return propertized make targets returned by PROBE-FN in SRCDIR. - -The optional BLDDIR allows for handling build directories. We -search the Makefile for a list of phony targets which are -generally the top level targets a Make system provides. The -resulting strings are tagged with properties that -`counsel-compile-history' can use for filtering results." - (let ((fmt (format (propertize "make %s %%s" 'cmd t) - counsel-compile-make-args)) - (suffix (and blddir - (counsel-compile--pretty-propertize "in" blddir - 'dired-directory))) - (build-env (and counsel-compile-env - (counsel-compile--pretty-propertize - "with" - (mapconcat #'identity counsel-compile-env " ") - 'font-lock-variable-name-face))) - (props `(srcdir ,srcdir blddir ,blddir bldenv ,counsel-compile-env))) - (mapcar (lambda (target) - (setq target (concat (format fmt target) suffix build-env)) - (add-text-properties 0 (length target) props target) - target) - (funcall probe-fn (or blddir srcdir))))) - -(defun counsel-compile-get-make-invocation (&optional blddir) - "Have a look in the root directory for any build control files. - -The optional BLDDIR is useful for other helpers that have found -sub-directories that builds may be invoked in." - (let ((srcdir (counsel--compile-root))) - (when (directory-files (or blddir srcdir) nil - counsel-compile-make-pattern t) - (counsel--compile-get-make-targets - #'counsel-compile--probe-make-targets srcdir blddir)))) - -(defun counsel-compile--probe-make-help (dir) - "Return a list of Make targets based on help for DIR. - -It is quite common for a \"make help\" invocation to return a -human readable list of targets. Often common targets are marked -with a leading asterisk. The exact search pattern is controlled -by `counsel-compile-help-pattern'." - (let ((default-directory dir) - primary-targets targets) - ;; Only proceed if the help target exists. - (when (eql 1 (apply #'call-process "make" nil nil nil "-q" "help" - counsel-compile-env)) - (with-temp-buffer - (when (eql 0 (apply #'call-process "make" nil t nil "help" - counsel-compile-env)) - (goto-char (point-min)) - (while (re-search-forward counsel-compile-help-pattern nil t) - (push (match-string 2) - (if (match-beginning 1) primary-targets targets))) - (nconc (sort primary-targets #'string-lessp) - (sort targets #'string-lessp))))))) - -(defun counsel-compile-get-make-help-invocations (&optional blddir) - "Query the root directory for makefiles with help output. - -The optional BLDDIR is useful for other helpers that have found -sub-directories that builds may be invoked in." - (let ((srcdir (counsel--compile-root))) - (when (directory-files (or blddir srcdir) nil - counsel-compile-make-pattern t) - (counsel--compile-get-make-targets - #'counsel-compile--probe-make-help srcdir blddir)))) - -(defun counsel--find-build-subdir (srcdir) - "Return builds subdirectory of SRCDIR, if one exists." - (cl-some (lambda (dir) - (setq dir (expand-file-name dir srcdir)) - (and (file-directory-p dir) dir)) - counsel-compile-build-directories)) - -(defun counsel--get-build-subdirs (blddir) - "Return all subdirs under BLDDIR sorted by modification time. -If there are non-directory files in BLDDIR, include BLDDIR in the -list as it may also be a build directory." - (let* ((files (directory-files-and-attributes - blddir t directory-files-no-dot-files-regexp t)) - (total (length files)) - (dirs (cl-delete-if-not - (lambda (entry) - (let ((dir (nth 1 entry))) - (and dir (or (eq dir t) - ;; Symlink. - (file-directory-p (nth 0 entry)))))) - files))) - ;; Any non-dir files? - (when (< (length dirs) total) - (push (cons blddir (file-attributes blddir)) dirs)) - (mapcar #'car (sort dirs (lambda (x y) - (time-less-p (nth 6 y) (nth 6 x))))))) - -(defun counsel-compile-get-build-directories (&optional dir) - "Return a list of potential build directories." - (let* ((srcdir (or dir (counsel--compile-root))) - (blddir (counsel--find-build-subdir srcdir)) - (props `(srcdir ,srcdir recursive t)) - (fmt (concat (propertize "Select build in " - 'face 'font-lock-warning-face) - (propertize "%s" 'face 'dired-directory)))) - (mapcar (lambda (subdir) - (let ((s (format fmt subdir))) - (add-text-properties 0 (length s) `(blddir ,subdir ,@props) s) - s)) - (and blddir (counsel--get-build-subdirs blddir))))) - -;; This is a workaround for the fact there is no concept of "project" -;; local variables (as opposed to for example buffer-local). So we -;; store all our history in a global list filter out the results we -;; don't want. -(defun counsel-compile-get-filtered-history (&optional dir) - "Return a compile history relevant to current project." - (let ((root (or dir (counsel--compile-root))) - history) - (dolist (item counsel-compile-history) - (let ((srcdir (get-text-property 0 'srcdir item)) - (blddir (get-text-property 0 'blddir item))) - (when (or (and srcdir (file-in-directory-p srcdir root)) - (and blddir (file-in-directory-p blddir root))) - (push item history)))) - (nreverse history))) - -(defun counsel--get-compile-candidates (&optional dir) - "Return the list of compile commands. -This is determined by `counsel-compile-local-builds', which see." - (let (cands) - (dolist (cmds counsel-compile-local-builds) - (when (functionp cmds) - (setq cmds (funcall cmds dir))) - (when cmds - (push (if (listp cmds) cmds (list cmds)) cands))) - (apply #'append (nreverse cands)))) - -;; This is a workaround to ensure we tag all the relevant metadata in -;; our compile history. This also allows M-x compile to do fancy -;; things like infer `default-directory' from 'cd's in the string. -(defun counsel-compile--update-history (_proc) - "Update `counsel-compile-history' from the compilation state." - (defvar compilation-arguments) - (defvar compilation-environment) - (let* ((srcdir (counsel--compile-root)) - (blddir default-directory) - (bldenv compilation-environment) - (cmd (concat - (propertize (car compilation-arguments) 'cmd t) - (unless (file-equal-p blddir srcdir) - (counsel-compile--pretty-propertize "in" blddir - 'dired-directory)) - (when bldenv - (counsel-compile--pretty-propertize "with" - (mapconcat #'identity bldenv " ") - 'font-lock-variable-name-face))))) - (add-text-properties 0 (length cmd) - `(srcdir ,srcdir blddir ,blddir bldenv ,bldenv) cmd) - (add-to-history 'counsel-compile-history cmd))) - -(defvar counsel-compile--current-build-dir nil - "Tracks the last directory `counsel-compile' was called with. - -This state allows us to set it correctly if the user has manually -edited the command, thus losing our embedded state.") - -(defun counsel-compile--action (cmd) - "Process CMD to call `compile'. - -If CMD has the `recursive' property set we call `counsel-compile' -again to further refine the compile options in the directory -specified by the `blddir' property." - (defvar compilation-environment) - (let ((blddir (get-text-property 0 'blddir cmd)) - (bldenv (get-text-property 0 'bldenv cmd))) - (if (get-text-property 0 'recursive cmd) - (counsel-compile blddir) - (when (get-char-property 0 'cmd cmd) - (setq cmd (substring-no-properties - cmd 0 (next-single-property-change 0 'cmd cmd)))) - (let ((default-directory (or blddir - counsel-compile--current-build-dir - default-directory)) - (compilation-environment bldenv)) - ;; No need to specify `:history' because of this hook. - (add-hook 'compilation-start-hook #'counsel-compile--update-history) - (unwind-protect - (compile cmd) - (remove-hook 'compilation-start-hook #'counsel-compile--update-history)))))) - -(defun counsel-compile-edit-command () - "Insert current compile command into the minibuffer for editing. - -This mirrors the behavior of `ivy-insert-current' but with specific -handling for the `counsel-compile' metadata." - (interactive) - (delete-minibuffer-contents) - (let* ((cmd (ivy-state-current ivy-last)) - (blddir (get-text-property 0 'blddir cmd))) - (when blddir - (setq counsel-compile--current-build-dir blddir)) - (insert (substring-no-properties - cmd 0 (and (get-text-property 0 'cmd cmd) - (next-single-property-change 0 'cmd cmd)))))) - -;; Currently the only thing we do is override ivy's default insert -;; operation which doesn't include the metadata we want. -(defvar counsel-compile-map - (let ((map (make-sparse-keymap))) - (define-key map `[remap ,#'ivy-insert-current] - #'counsel-compile-edit-command) - map) - "Additional ivy keybindings during command selection.") - -;;;###autoload -(defun counsel-compile (&optional dir) - "Call `compile' completing with smart suggestions, optionally for DIR. - -Additional actions: - -\\{counsel-compile-map}" - (interactive) - (require 'compile) - (require 'dired) ;; For face `dired-directory'. - (setq counsel-compile--current-build-dir (or dir - (counsel--compile-root) - default-directory)) - (ivy-read "Compile command: " - (delete-dups (counsel--get-compile-candidates dir)) - :action #'counsel-compile--action - :keymap counsel-compile-map - :caller 'counsel-compile)) - -(ivy-add-actions - 'counsel-compile - '(("d" counsel-compile-forget-command "delete"))) - -(defun counsel-compile-forget-command (cmd) - "Delete CMD from `counsel-compile-history'." - (setq counsel-compile-history - (delete cmd counsel-compile-history))) - -(defun counsel-compile-env--format-hint (cands) - "Return a formatter for compile-env CANDS." - (let ((rmstr - (propertize "remove" 'face 'font-lock-warning-face)) - (addstr - (propertize "add" 'face 'font-lock-variable-name-face))) - (ivy--format-function-generic - (lambda (selected) - (format "%s %s" - (if (member selected counsel-compile-env) rmstr addstr) - selected)) - #'identity - cands - "\n"))) - -(defun counsel-compile-env--update (var) - "Update `counsel-compile-env' either adding or removing VAR." - (cond ((member var counsel-compile-env) - (setq counsel-compile-env (delete var counsel-compile-env))) - ((string-match-p counsel-compile-env-pattern var) - (push var counsel-compile-env)) - (t (user-error "Ignoring malformed variable: '%s'" var)))) - -;;;###autoload -(defun counsel-compile-env () - "Update `counsel-compile-env' interactively." - (interactive) - (ivy-read "Compile environment variable: " - (delete-dups (append - counsel-compile-env counsel-compile-env-history)) - :action #'counsel-compile-env--update - :predicate (lambda (cand) - (string-match-p counsel-compile-env-pattern - cand)) - :history 'counsel-compile-env-history - :caller 'counsel-compile-env)) - -(ivy-configure 'counsel-compile-env - :format-fn #'counsel-compile-env--format-hint) - -;;;; `counsel-search' - -(defcustom counsel-search-engine 'ddg - "The search engine choice in `counsel-search-engines-alist'." - :type '(choice - (const :tag "DuckDuckGo" ddg) - (const :tag "Google" google))) - -(defcustom counsel-search-engines-alist - '((ddg - "https://duckduckgo.com/ac/" - "https://duckduckgo.com/html/?q=" - counsel--search-request-data-ddg) - (google - "https://suggestqueries.google.com/complete/search" - "https://www.google.com/search?q=" - counsel--search-request-data-google)) - "List of search engine parameters for `counsel-search'. -Each element is of the form (SYMBOL SUGGEST BROWSE EXTRACT), where: -SYMBOL identifies the search engine, as per `counsel-search-engine'. -SUGGEST is the URL to query for suggestions. -BROWSE is the URL prefix for visiting the selected result. -EXTRACT is a function that takes the object parsed from the SUGGEST - endpoint and transforms it into a set of Ivy candidates." - :package-version '(counsel . "0.15.1") - :type '(alist :key-type symbol :value-type (list string string function))) - -(defun counsel--search-request-data-google (data) - "Extract Google suggestions from parsed JSON DATA. -Expects input of the form [\"a\" [\"ab\" \"ac\"] ...]." - (append (aref data 1) ())) - -(defun counsel--search-request-data-ddg (data) - "Extract DuckDuckGo suggestions from parsed JSON DATA. -Expects input of the form [((phrase . \"ab\")) ...]." - (mapcar #'cdar data)) - -(defvar counsel--native-json) -(put 'counsel--native-json 'variable-documentation - "Non-nil if Emacs supports JSON natively, or void.") - -(defun counsel--search-update (extract str type) - "Call EXTRACT on JSON STR of Content-TYPE." - (unless (fboundp 'mail-header-parse-content-type) - (require 'mail-parse)) - (declare-function json-parse-string "json.c") - (declare-function json-read-from-string "json") - (declare-function mail-content-type-get "mail-parse") - (declare-function mail-header-parse-content-type "mail-parse") - (let* ((ct (and type (mail-header-parse-content-type type))) - (coding (coding-system-from-name (mail-content-type-get ct 'charset)))) - (when coding - (setq str (decode-coding-string str coding t)))) - (let ((obj (if counsel--native-json - (json-parse-string str :object-type 'alist) - (defvar json-array-type) - (defvar json-object-type) - (let ((json-array-type 'vector) - (json-object-type 'alist)) - (json-read-from-string str))))) - (ivy-update-candidates (funcall extract obj)))) - -(defun counsel--search-plz (url extract) - "Fetch URL with `plz' and EXTRACT its JSON payload." - (declare-function plz "ext:plz") - (declare-function plz-response-body "ext:plz") - (declare-function plz-response-headers "ext:plz") - ;; Doesn't handle Content-Type, so defer decoding+parsing until :then. - ;; (See URL `https://github.com/alphapapa/plz.el/pull/66'.) - ;; Ask for a `plz-response' object because it already contains the parsed - ;; headers (though just widening the response buffer could be quicker). - (plz 'get url :as 'response :decode nil :noquery t - :then (lambda (response) - (let* ((heads (plz-response-headers response)) - (body (plz-response-body response)) - (ct (cdr (assq 'content-type heads)))) - (counsel--search-update extract body ct))))) - -(defun counsel--search-request (url extract) - "Fetch URL with `request' and EXTRACT its JSON payload." - (declare-function request "ext:request") - (declare-function request-response-header "ext:request") - ;; Doesn't handle Content-Type (expects coding system a priori), - ;; so defer decoding+parsing until :success. - (request url :type "GET" - :success (cl-function - (lambda (&key data response &allow-other-keys) - (let ((ct (request-response-header response "content-type"))) - (counsel--search-update extract data ct)))))) - -(defvar counsel--search-backend) -(put 'counsel--search-backend 'variable-documentation - "Feature symbol indicating available HTTP library, or void. -Valid values are the keys of `counsel--search-backends'.") - -(defvar counsel--search-backends - `((plz ,#'counsel--search-plz) - (request ,#'counsel--search-request)) - "List of (BACKEND GETTER) for `counsel-search'. -BACKEND is a feature symbol like `counsel--search-backend'. -GETTER is a function taking a URL and an EXTRACT function as in - `counsel-search-engines-alist'.") - -(defun counsel-search-function (input) - "Create a request to a search engine with INPUT. -Return 0 tells `ivy--exhibit' not to update the minibuffer. -We update it in the callback with `ivy-update-candidates'." - (or - (ivy-more-chars) - (let* ((backend (assq counsel--search-backend counsel--search-backends)) - (engine (assq counsel-search-engine counsel-search-engines-alist)) - (suggest (nth 1 engine)) - (extract (nth 3 engine)) - (url (concat suggest (if (ivy--string-search "?" suggest) "&" "?") - ;; FIXME: `client' needed only for `google'? - (url-build-query-string `(("client" "firefox") - ("q" ,input)))))) - ;; Do we need to cancel requests already in flight? - (funcall (nth 1 backend) url extract) - 0))) - -(defun counsel-search-action (candidate) - "Browse the search results for `counsel-search' CANDIDATE." - (let ((engine (assq counsel-search-engine counsel-search-engines-alist))) - (browse-url (concat (nth 2 engine) (url-hexify-string candidate))))) - -(defun counsel-search () - "Ivy interface for querying a search engine. -Dynamically displays search suggestions for the current input. -The user options `counsel-search-engine' and -`counsel-search-engines-alist' determine the engine." - (interactive) - (unless (boundp 'counsel--search-backend) - (setq counsel--search-backend - ;; `plz' is on GNU ELPA; `request' on NonGNU ELPA. - (or (require 'plz nil t) - (require 'request nil t) - (user-error - "Required package `plz' (or `request') not installed")))) - ;; - Emacs 27: optional native JSON support. - ;; - Emacs 28: `json-available-p'. - ;; - Emacs 30: unconditional native JSON support. - ;; That means the following sets `counsel--native-json' to nil even for - ;; Emacs 27 with native JSON support, in the interest of simplicity. - (or (boundp 'counsel--native-json) - (setq counsel--native-json - (and (fboundp 'json-available-p) - (json-available-p))) - (require 'json)) - (ivy-read "search: " #'counsel-search-function - :action #'counsel-search-action - :dynamic-collection t - :caller 'counsel-search)) - -(define-obsolete-function-alias 'counsel-google - #'counsel-search "0.13.2 (2019-10-17)") - -;;;; `counsel-compilation-errors' - -(declare-function compilation--message->loc "compile" t t) -(declare-function compilation-buffer-p "compile") -(declare-function compilation-next-single-property-change "compile") -(declare-function compile-goto-error "compile") - -(defun counsel--compilation-errors-buffer (buf) - (with-current-buffer buf - (let ((res nil) - (pt (point-min))) - (save-excursion - (while (setq pt (compilation-next-single-property-change - pt 'compilation-message)) - (let ((loc (get-text-property pt 'compilation-message))) - (when (and loc (setq loc (compilation--message->loc loc))) - (goto-char pt) - (push - (propertize - (buffer-substring-no-properties pt (line-end-position)) - 'pt pt - 'buffer buf) - res))))) - (nreverse res)))) - -(defun counsel-compilation-errors-cands () - (cl-loop - for buf in (buffer-list) - when (compilation-buffer-p buf) - nconc (counsel--compilation-errors-buffer buf))) - -(defun counsel-compilation-errors-action (x) - (pop-to-buffer (get-text-property 0 'buffer x)) - (goto-char (get-text-property 0 'pt x)) - (compile-goto-error)) - -;;;###autoload -(defun counsel-compilation-errors () - "Compilation errors." - (interactive) - (require 'compile) - (ivy-read "compilation errors: " (counsel-compilation-errors-cands) - :require-match t - :action #'counsel-compilation-errors-action - :history 'counsel-compilation-errors-history)) - -;;;; `counsel-flycheck' - -(defvar flycheck-current-errors) -(declare-function flycheck-error-filename "ext:flycheck") -(declare-function flycheck-error-line "ext:flycheck") -(declare-function flycheck-error-message "ext:flycheck") -(declare-function flycheck-jump-to-error "ext:flycheck") - -(defun counsel-flycheck-errors-cands () - (mapcar - (lambda (err) - (propertize - (format "%s:%d:%s" - (file-name-base (flycheck-error-filename err)) - (flycheck-error-line err) - (flycheck-error-message err)) 'error err)) - flycheck-current-errors)) - -(defun counsel-flycheck-occur (cands) - "Generate a custom occur buffer for `counsel-flycheck'." - (unless (eq major-mode 'ivy-occur-grep-mode) - (ivy-occur-grep-mode) - (setq default-directory (ivy-state-directory ivy-last))) - (swiper--occur-insert-lines - (mapcar - (lambda (cand) - (let ((err (get-text-property 0 'error cand))) - (propertize - (format - "%s:%d:%s" - (flycheck-error-filename err) - (flycheck-error-line err) - cand) - 'error err))) - cands))) - -(defun counsel-flycheck-errors-action (err) - (flycheck-jump-to-error (get-text-property 0 'error err))) - -(ivy-configure 'counsel-flycheck - :occur #'counsel-flycheck-occur) - -;;;###autoload -(defun counsel-flycheck () - "Flycheck errors." - (interactive) - (require 'flycheck) - (ivy-read "flycheck errors: " (counsel-flycheck-errors-cands) - :require-match t - :action #'counsel-flycheck-errors-action - :history 'counsel-flycheck-errors-history)) - -;;; `counsel-mode' - -(defvar counsel-mode-map - (let ((map (make-sparse-keymap))) - (define-key map `[remap ,#'execute-extended-command] #'counsel-M-x) - (define-key map `[remap ,#'describe-bindings] #'counsel-descbinds) - (define-key map `[remap ,#'describe-function] #'counsel-describe-function) - (define-key map `[remap ,#'describe-variable] #'counsel-describe-variable) - (define-key map [remap describe-symbol] #'counsel-describe-symbol) - (define-key map `[remap ,#'apropos-command] #'counsel-apropos) - (define-key map `[remap ,#'describe-face] #'counsel-describe-face) - (define-key map `[remap ,#'list-faces-display] #'counsel-faces) - (define-key map `[remap ,#'find-file] #'counsel-find-file) - (define-key map `[remap ,#'find-library] #'counsel-find-library) - (define-key map `[remap ,#'imenu] #'counsel-imenu) - (define-key map `[remap ,#'load-library] #'counsel-load-library) - (define-key map `[remap ,#'load-theme] #'counsel-load-theme) - (define-key map `[remap ,#'yank-pop] #'counsel-yank-pop) - (define-key map `[remap ,#'info-lookup-symbol] #'counsel-info-lookup-symbol) - (define-key map `[remap ,#'pop-to-mark-command] #'counsel-mark-ring) - (define-key map [remap geiser-doc-look-up-manual] - #'counsel-geiser-doc-look-up-manual) - (define-key map `[remap ,#'bookmark-jump] #'counsel-bookmark) - map) - "Keymap for `counsel-mode'. -Remaps built-in and external functions to Counsel replacements.") - -(defcustom counsel-mode-override-describe-bindings nil - "Whether to override `describe-bindings' when `counsel-mode' is active." - :type 'boolean) - -;;;###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. - -Local bindings (`counsel-mode-map'): -\\{counsel-mode-map}" - :global t - :keymap counsel-mode-map - :lighter " counsel" - (if counsel-mode - (progn - (when counsel-mode-override-describe-bindings - (advice-add #'describe-bindings :override #'counsel-descbinds)) - (define-key minibuffer-local-map (kbd "C-r") - #'counsel-minibuffer-history)) - (advice-remove #'describe-bindings #'counsel-descbinds))) - -(provide 'counsel) - -;;; counsel.el ends here diff --git a/.emacs.d/lisp/ivy-faces.el b/.emacs.d/lisp/ivy-faces.el deleted file mode 100644 index 5f76ba9..0000000 --- a/.emacs.d/lisp/ivy-faces.el +++ /dev/null @@ -1,145 +0,0 @@ -;;; ivy-faces.el --- Faces for Ivy -*- lexical-binding: t -*- - -;; Copyright (C) 2020-2025 Free Software Foundation, Inc. - -;; Author: Oleh Krehel -;; Keywords: convenience - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;;; Code: - -(defgroup ivy-faces nil - "Font-lock faces for `ivy'." - :group 'ivy - :group 'faces) - -(defface ivy-cursor - '((((class color) (background light)) - :background "black" :foreground "white") - (((class color) (background dark)) - :background "white" :foreground "black")) - "Cursor face for inline completion.") - -(defface ivy-current-match - '((((class color) (background light)) - :background "#1a4b77" :foreground "white" :extend t) - (((class color) (background dark)) - :background "#65a7e2" :foreground "black" :extend t)) - "Face used by Ivy for highlighting the current match.") - -(defface ivy-minibuffer-match-highlight - '((t :inherit highlight)) - "Face used by Ivy for highlighting the match under the cursor.") - -(defface ivy-minibuffer-match-face-1 - '((((class color) (background light)) - :background "#d3d3d3") - (((class color) (background dark)) - :background "#555555")) - "The background face for `ivy' minibuffer matches.") - -(defface ivy-minibuffer-match-face-2 - '((((class color) (background light)) - :background "#e99ce8" :weight bold) - (((class color) (background dark)) - :background "#777777" :weight bold)) - "Face for `ivy' minibuffer matches numbered 1 modulo 3.") - -(defface ivy-minibuffer-match-face-3 - '((((class color) (background light)) - :background "#bbbbff" :weight bold) - (((class color) (background dark)) - :background "#7777ff" :weight bold)) - "Face for `ivy' minibuffer matches numbered 2 modulo 3.") - -(defface ivy-minibuffer-match-face-4 - '((((class color) (background light)) - :background "#ffbbff" :weight bold) - (((class color) (background dark)) - :background "#8a498a" :weight bold)) - "Face for `ivy' minibuffer matches numbered 3 modulo 3.") - -(defface ivy-confirm-face - '((t :foreground "ForestGreen" :inherit minibuffer-prompt)) - "Face used by Ivy for a confirmation prompt.") - -(defface ivy-match-required-face - '((t :foreground "red" :inherit minibuffer-prompt)) - "Face used by Ivy for a match required prompt.") - -(defface ivy-subdir - '((t :inherit dired-directory)) - "Face used by Ivy for highlighting subdirs in the alternatives.") - -(defface ivy-org - '((t :inherit org-level-4)) - "Face used by Ivy for highlighting Org buffers in the alternatives.") - -(defface ivy-modified-buffer - '((t :inherit default)) - "Face used by Ivy for highlighting modified file visiting buffers.") - -(defface ivy-modified-outside-buffer - '((t :inherit default)) - "Face used by Ivy for highlighting file visiting buffers modified outside Emacs.") - -(defface ivy-remote - '((((class color) (background light)) - :foreground "#110099") - (((class color) (background dark)) - :foreground "#7B6BFF")) - "Face used by Ivy for highlighting remotes in the alternatives.") - -(defface ivy-virtual - '((t :inherit font-lock-builtin-face)) - "Face used by Ivy for matching virtual buffer names.") - -(defface ivy-action - '((t :inherit font-lock-builtin-face)) - "Face used by Ivy for displaying keys in `ivy-read-action'.") - -(defface ivy-highlight-face - '((t :inherit highlight)) - "Face used by Ivy to highlight certain candidates.") - -(defface ivy-prompt-match - '((t :inherit ivy-current-match)) - "Face used by Ivy for highlighting the selected prompt line.") - -(defface ivy-separator - '((t :inherit font-lock-doc-face)) - "Face for multiline source separator.") - -(defface ivy-grep-info - '((t :inherit compilation-info)) - "Face for highlighting grep information such as file names.") - -(defface ivy-grep-line-number - '((t :inherit compilation-line-number)) - "Face for displaying line numbers in grep messages.") - -(defface ivy-completions-annotations - '((t :inherit completions-annotations)) - "Face for displaying completion annotations.") - -(defface ivy-yanked-word - '((t :inherit highlight)) - "Face used to highlight yanked word.") - -(provide 'ivy-faces) - -;;; ivy-faces.el ends here diff --git a/.emacs.d/lisp/ivy-overlay.el b/.emacs.d/lisp/ivy-overlay.el deleted file mode 100644 index 8803e60..0000000 --- a/.emacs.d/lisp/ivy-overlay.el +++ /dev/null @@ -1,176 +0,0 @@ -;;; ivy-overlay.el --- Overlay display functions for Ivy -*- lexical-binding: t -*- - -;; Copyright (C) 2016-2025 Free Software Foundation, Inc. - -;; Author: Oleh Krehel -;; Keywords: convenience - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . - -;;; Commentary: - -;; Normally, Ivy displays completion candidates and entered text in -;; the minibuffer. This file enables in-buffer completion to be -;; displayed at point instead. - -;;; Code: - -(eval-when-compile - (require 'cl-lib) - (require 'subr-x)) - -(defvar ivy--old-cursor-type t) - -(defvar ivy-overlay-at nil - "Overlay variable for `ivy-display-function-overlay'.") - -(declare-function ivy--truncate-string "ivy") - -(defun ivy-left-pad (str width) - "Return STR, but with each line indented by WIDTH spaces. -Lines are truncated to the window width." - (let ((padding (make-string width ?\s))) - (mapconcat (lambda (x) - (ivy--truncate-string (concat padding x) - (1- (+ (window-width) - (window-hscroll))))) - (split-string str "\n") - "\n"))) - -(defun ivy-overlay-cleanup () - "Clean up after `ivy-display-function-overlay'." - (when (overlayp ivy-overlay-at) - (delete-overlay ivy-overlay-at) - (setq ivy-overlay-at nil)) - (unless cursor-type - (setq cursor-type ivy--old-cursor-type)) - (when (fboundp 'company-abort) - (company-abort))) - -(defvar ivy-height) - -(defun ivy-overlay-show-after (str) - "Display STR in an overlay at point. - -First, fill each line of STR with spaces to the current column. -Then attach the overlay to the character before point." - (if ivy-overlay-at - (progn - (move-overlay ivy-overlay-at (1- (point)) (line-end-position)) - (overlay-put ivy-overlay-at 'invisible nil)) - (let ((available-height (- (window-height) (count-lines (window-start) (point)) 1))) - (unless (>= available-height ivy-height) - (recenter (- (window-height) ivy-height 2)))) - (setq ivy-overlay-at (make-overlay (1- (point)) (line-end-position))) - ;; Specify face to avoid clashing with other overlays. - (overlay-put ivy-overlay-at 'face 'default) - (overlay-put ivy-overlay-at 'priority 9999)) - (overlay-put ivy-overlay-at 'display str) - (overlay-put ivy-overlay-at 'after-string "")) - -(declare-function org-current-level "org") -(declare-function org-at-heading-p "org") -(defvar org-indent-indentation-per-level) -(defvar ivy-last) -(defvar ivy-text) -(defvar ivy-completion-beg) -(declare-function ivy--get-window "ivy") -(declare-function ivy-state-window "ivy" t t) - -(defun ivy-overlay--current-column () - "Return `current-column', ignoring `ivy-overlay-at'. -Temporarily make `ivy-overlay-at' invisible so that the -`string-width' of its `display' property is not included in the -`current-column' calculation by Emacs >= 29. -See URL `https://bugs.gnu.org/53795'." - (if (overlayp ivy-overlay-at) - (cl-letf (((overlay-get ivy-overlay-at 'invisible) t)) - (1+ (current-column))) - (current-column))) - -(defun ivy-overlay-impossible-p (_str) - (or - (and (eq major-mode 'org-mode) - ;; If this breaks, an alternative is to call the canonical function - ;; `org-in-src-block-p', which is slower. Neither approach works - ;; in Org versions that shipped with Emacs < 26, however. - (get-text-property (point) 'src-block)) - (<= (window-height) (+ ivy-height 2)) - (bobp) - (< (- (+ (window-width) (window-hscroll)) - (ivy-overlay--current-column)) - 30))) - -(defun ivy-overlay--org-indent () - "Return `ivy-overlay-at' indentation due to `org-indent-mode'. -That is, the additional number of columns needed under the mode." - ;; Emacs 28 includes the following fix for `https://bugs.gnu.org/49695': - ;; - ;; "Fix display of line/wrap-prefix when there's a display property at BOL" - ;; 662f91a795 2021-07-22 21:23:48 +0300 - ;; `https://git.sv.gnu.org/cgit/emacs.git/commit/?id=662f91a795' - ;; - ;; This increasingly misindents `ivy-overlay-at' with each additional Org - ;; level. See also `https://github.com/abo-abo/swiper/commit/ee7f7f8c79'. - ;; FIXME: Is there a better way to work around this? - (if (and (eq major-mode 'org-mode) - (bound-and-true-p org-indent-mode) - (< emacs-major-version 28)) - (let ((level (org-current-level))) - (if (org-at-heading-p) - (1- level) - (* org-indent-indentation-per-level (or level 1)))) - 0)) - -(defun ivy-display-function-overlay (str) - "Called from the minibuffer, display STR in an overlay in Ivy window. -Hide the minibuffer contents and cursor." - (if (save-selected-window - (select-window (ivy-state-window ivy-last)) - (ivy-overlay-impossible-p str)) - (let ((buffer-undo-list t)) - (save-excursion - (forward-line 1) - (insert str))) - (add-face-text-property (minibuffer-prompt-end) (point-max) - '(:foreground "white")) - (setq cursor-type nil) - (with-selected-window (ivy--get-window ivy-last) - (when cursor-type - (setq ivy--old-cursor-type cursor-type)) - (setq cursor-type nil) - (let ((overlay-str - (apply - #'concat - (buffer-substring (max (point-min) (1- (point))) (point)) - ivy-text - (and (eolp) " ") - (buffer-substring (point) (line-end-position)) - (and (> (length str) 0) - (list "\n" - (ivy-left-pad - (string-remove-prefix "\n" str) - (+ (ivy-overlay--org-indent) - (save-excursion - (when ivy-completion-beg - (goto-char ivy-completion-beg)) - (ivy-overlay--current-column))))))))) - (let ((cursor-offset (1+ (length ivy-text)))) - (add-face-text-property cursor-offset (1+ cursor-offset) - 'ivy-cursor t overlay-str)) - (ivy-overlay-show-after overlay-str))))) - -(provide 'ivy-overlay) - -;;; ivy-overlay.el ends here diff --git a/.emacs.d/lisp/ivy.el b/.emacs.d/lisp/ivy.el deleted file mode 100644 index 3c900c9..0000000 --- a/.emacs.d/lisp/ivy.el +++ /dev/null @@ -1,5558 +0,0 @@ -;;; ivy.el --- Incremental Vertical completYon -*- lexical-binding: t -*- - -;; Copyright (C) 2015-2025 Free Software Foundation, Inc. - -;; Author: Oleh Krehel -;; Maintainer: Basil L. Contovounesios -;; URL: https://github.com/abo-abo/swiper -;; Version: 0.15.1 -;; Package-Requires: ((emacs "24.5")) -;; Keywords: matching - -;; This file is part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; For a full copy of the GNU General Public License -;; see . - -;;; Commentary: - -;; This package provides `ivy-read' as an alternative to -;; `completing-read' and similar functions. -;; -;; There's no intricate code to determine the best candidate. -;; Instead, the user can navigate to it with `ivy-next-line' and -;; `ivy-previous-line'. -;; -;; The matching is done by splitting the input text by spaces and -;; re-building it into a regex. -;; So "for example" is transformed into "\\(for\\).*\\(example\\)". - -;;; Code: - -(require 'colir) -(require 'ivy-faces) -(autoload 'ivy-overlay-cleanup "ivy-overlay") -(autoload 'ivy-display-function-overlay "ivy-overlay") - -(require 'cl-lib) - -(eval-when-compile - (require 'subr-x) - - (unless (fboundp 'static-if) - (defmacro static-if (condition then-form &rest else-forms) - "Expand to THEN-FORM or ELSE-FORMS based on compile-time CONDITION. -Polyfill for Emacs 30 `static-if'." - (declare (debug (sexp sexp &rest sexp)) (indent 2)) - (if (eval condition lexical-binding) - then-form - (macroexp-progn else-forms))))) - -;;; Customization - -(defgroup ivy nil - "Incremental vertical completion." - :group 'convenience) - -(defcustom ivy-height 10 - "Number of lines for the minibuffer window. - -See also `ivy-height-alist'." - :type 'integer) - -(defcustom ivy-count-format "%-4d " - "The style to use for displaying the current candidate count for `ivy-read'. -Set this to \"\" to suppress the count visibility. -Set this to \"(%d/%d) \" to display both the index and the count." - :type '(choice - (const :tag "Count disabled" "") - (const :tag "Count matches" "%-4d ") - (const :tag "Count matches and show current match" "(%d/%d) ") - string)) - -(defcustom ivy-pre-prompt-function nil - "When non-nil, add strings before the `ivy-read' prompt." - :type '(choice - (const :tag "Do nothing" nil) - (function :tag "Custom function"))) - -(defcustom ivy-add-newline-after-prompt nil - "When non-nil, add a newline after the `ivy-read' prompt." - :type 'boolean) - -(defcustom ivy-wrap nil - "When non-nil, wrap around after the first and the last candidate." - :type 'boolean) - -(defcustom ivy-display-style 'fancy - "The style for formatting the minibuffer. - -By default, the matched strings are copied as is. - -The fancy display style highlights matching parts of the regexp, -a behavior similar to `swiper'." - :type '(choice - (const :tag "Plain" nil) - (const :tag "Fancy" fancy))) - -(defcustom ivy-on-del-error-function #'abort-recursive-edit - "Function to call when deletion fails during completion. -The usual reason for `ivy-backward-delete-char' to fail is when -there is no text left to delete, i.e., when it is called at the -beginning of the minibuffer. -The default setting provides a quick exit from completion. -Another common option is `ignore', which does nothing." - :type '(choice - (const :tag "Exit completion" abort-recursive-edit) - (const :tag "Do nothing" ignore) - (function :tag "Custom function"))) - -(defcustom ivy-extra-directories '("../" "./") - "Add this to the front of the list when completing file names. -Only \"./\" and \"../\" apply here. They appear in reverse order." - :type '(repeat :tag "Dirs" - (choice - (const :tag "Parent Directory" "../") - (const :tag "Current Directory" "./")))) - -(defcustom ivy-use-virtual-buffers nil - "When non-nil, add recent files and/or bookmarks to `ivy-switch-buffer'. -The value `recentf' includes only recent files to the virtual -buffers list, whereas the value `bookmarks' does the same for -bookmarks. Any other non-nil value includes both." - :type '(choice - (const :tag "Don't use virtual buffers" nil) - (const :tag "Recent files" recentf) - (const :tag "Bookmarks" bookmarks) - (const :tag "All virtual buffers" t))) - -(defvar ivy--display-function nil - "The display-function is used in current.") - -(defvar ivy-display-functions-props - '((ivy-display-function-overlay :cleanup ivy-overlay-cleanup)) - "Map Ivy display functions to their property lists. -Examples of properties include associated `:cleanup' functions.") - -(defcustom ivy-display-functions-alist - '((ivy-completion-in-region . ivy-display-function-overlay) - (t . nil)) - "An alist for customizing where to display the candidates. - -Each key is a caller symbol. When the value is nil (the default), -the candidates are shown in the minibuffer. Otherwise, the value -is a function which takes a string argument comprising the -current matching candidates and displays it somewhere. - -See also `https://github.com/abo-abo/swiper/wiki/ivy-display-function'." - :type '(alist - :key-type symbol - :value-type (choice - (const :tag "Minibuffer" nil) - (const :tag "LV" ivy-display-function-lv) - (const :tag "Popup" ivy-display-function-popup) - (const :tag "Overlay" ivy-display-function-overlay) - (function :tag "Custom function")))) - -(defvar ivy-completing-read-dynamic-collection nil - "Run `ivy-completing-read' with `:dynamic-collection t`.") - -(defcustom ivy-completing-read-handlers-alist - '((tmm-menubar . completing-read-default) - (tmm-shortcut . completing-read-default) - (bbdb-create . ivy-completing-read-with-empty-string-def) - (auto-insert . ivy-completing-read-with-empty-string-def) - (Info-on-current-buffer . ivy-completing-read-with-empty-string-def) - (Info-follow-reference . ivy-completing-read-with-empty-string-def) - (Info-menu . ivy-completing-read-with-empty-string-def) - (Info-index . ivy-completing-read-with-empty-string-def) - (Info-virtual-index . ivy-completing-read-with-empty-string-def) - (info-display-manual . ivy-completing-read-with-empty-string-def)) - "An alist of handlers to replace `completing-read' in `ivy-mode'." - :type '(alist :key-type symbol :value-type function)) - -(defcustom ivy-height-alist nil - "An alist to customize `ivy-height'. - -It is a list of (CALLER . HEIGHT). CALLER is a caller of -`ivy-read' and HEIGHT is the number of lines displayed. -HEIGHT can also be a function that returns the number of lines." - :type '(alist - :key-type function - :value-type (choice integer function))) - -(defvar ivy-completing-read-ignore-handlers-depth -1 - "Used to avoid infinite recursion. - -If `(minibuffer-depth)' equals this, `ivy-completing-read' will -act as if `ivy-completing-read-handlers-alist' is empty.") - -(defvar ivy-highlight-grep-commands nil - "List of grep-like commands.") - -(defvar ivy--actions-list nil - "A list of extra actions per command.") - -(defun ivy-set-actions (cmd actions) - "Set CMD extra exit points to ACTIONS." - (setq ivy--actions-list - (plist-put ivy--actions-list cmd actions))) - -(defun ivy-add-actions (cmd actions) - "Add extra exit points ACTIONS to CMD. -Existing exit points of CMD are overwritten by those in -ACTIONS that have the same key." - (setq ivy--actions-list - (plist-put ivy--actions-list cmd - (cl-delete-duplicates - (append (plist-get ivy--actions-list cmd) actions) - :key #'car :test #'equal)))) - -(defun ivy--compute-extra-actions (action caller) - "Add extra actions to ACTION based on CALLER." - (let* ((extra-actions (cl-delete-duplicates - (append (plist-get ivy--actions-list t) - (plist-get ivy--actions-list this-command) - (plist-get ivy--actions-list caller)) - :key #'car :test #'equal)) - (override-default (assoc "o" extra-actions))) - (cond (override-default - (cons 1 (cons override-default - (cl-delete "o" extra-actions - :key #'car :test #'equal)))) - ((not extra-actions) - action) - ((functionp action) - `(1 - ("o" ,action "default") - ,@extra-actions)) - ((null action) - `(1 - ("o" identity "default") - ,@extra-actions)) - (t - (cons (car action) - (cl-delete-duplicates (cdr (append action extra-actions)) - :key #'car :test #'equal :from-end t)))))) - -(defvar ivy--prompts-list nil) - -(defun ivy-set-prompt (caller prompt-fn) - "Associate CALLER with PROMPT-FN. -PROMPT-FN is a function of no arguments that returns a prompt string." - (setq ivy--prompts-list - (plist-put ivy--prompts-list caller prompt-fn))) - -(defvar ivy--display-transformers-alist nil - "A list of str->str transformers per command.") - -(defun ivy-set-display-transformer (cmd transformer) - "Set CMD a displayed candidate TRANSFORMER. - -It's a lambda that takes a string one of the candidates in the -collection and returns a string for display, the same candidate -plus some extra information. - -This lambda is called only on the `ivy-height' candidates that -are about to be displayed, not on the whole collection." - (declare (obsolete "use `ivy-configure' :display-transformer-fn instead." - "0.13.2 (2020-05-20)")) - (ivy--alist-set 'ivy--display-transformers-alist cmd transformer)) - -(defvar ivy--sources-list nil - "A list of extra sources per command.") - -(defun ivy-set-sources (cmd sources) - "Attach to CMD a list of extra SOURCES. - -Each static source is a function that takes no argument and -returns a list of strings. - -The (original-source) determines the position of the original -dynamic source. - -Extra dynamic sources aren't supported yet. - -Example: - - (defun small-recentf () - (cl-subseq recentf-list 0 20)) - - (ivy-set-sources - \\='counsel-locate - \\='((small-recentf) - (original-source)))" - (setq ivy--sources-list - (plist-put ivy--sources-list cmd sources))) - -(defun ivy--compute-extra-candidates (caller) - (let ((extra-sources (or (plist-get ivy--sources-list caller) - '((original-source)))) - (result nil)) - (dolist (source extra-sources) - (cond ((equal source '(original-source)) - (push source result)) - ((null (cdr source)) - (push (list (car source) (funcall (car source))) result)))) - result)) - -(defvar ivy-current-prefix-arg nil - "Prefix arg to pass to actions. -This is a global variable that is set by ivy functions for use in -action functions.") - -;;; Keymap - -(autoload 'minibuffer-keyboard-quit "delsel" nil t) -(autoload 'hydra-ivy/body "ivy-hydra" nil t) -(autoload 'ivy-hydra-read-action "ivy-hydra" nil t) - -(defun ivy-define-key (keymap key def) - "Forward to (`define-key' KEYMAP KEY DEF). -Remove DEF from `counsel-M-x' list." - (function-put def 'no-counsel-M-x t) - (define-key keymap key def)) - -(defvar ivy-minibuffer-map - (let ((map (make-sparse-keymap))) - (ivy-define-key map (kbd "C-m") #'ivy-done) - (define-key map [down-mouse-1] #'ignore) - (ivy-define-key map [mouse-1] #'ivy-mouse-done) - (ivy-define-key map [mouse-3] #'ivy-mouse-dispatching-done) - (ivy-define-key map (kbd "C-M-m") #'ivy-call) - (ivy-define-key map (kbd "C-j") #'ivy-alt-done) - (ivy-define-key map (kbd "C-M-j") #'ivy-immediate-done) - (ivy-define-key map (kbd "TAB") #'ivy-partial-or-done) - (ivy-define-key map `[remap ,#'next-line] #'ivy-next-line) - (ivy-define-key map `[remap ,#'previous-line] #'ivy-previous-line) - (ivy-define-key map (kbd "C-r") #'ivy-reverse-i-search) - (define-key map (kbd "SPC") #'self-insert-command) - (ivy-define-key map `[remap ,#'delete-backward-char] - #'ivy-backward-delete-char) - (ivy-define-key map `[remap ,#'backward-delete-char-untabify] - #'ivy-backward-delete-char) - (ivy-define-key map `[remap ,#'backward-kill-word] #'ivy-backward-kill-word) - (ivy-define-key map `[remap ,#'delete-char] #'ivy-delete-char) - (ivy-define-key map `[remap ,#'forward-char] #'ivy-forward-char) - (ivy-define-key map (kbd "") #'ivy-forward-char) - (ivy-define-key map `[remap ,#'kill-word] #'ivy-kill-word) - (ivy-define-key map `[remap ,#'beginning-of-buffer] - #'ivy-beginning-of-buffer) - (ivy-define-key map `[remap ,#'end-of-buffer] #'ivy-end-of-buffer) - (ivy-define-key map (kbd "M-n") #'ivy-next-history-element) - (ivy-define-key map (kbd "M-p") #'ivy-previous-history-element) - (define-key map (kbd "C-g") #'minibuffer-keyboard-quit) - (ivy-define-key map `[remap ,#'scroll-up-command] #'ivy-scroll-up-command) - (ivy-define-key map `[remap ,#'scroll-down-command] - #'ivy-scroll-down-command) - (ivy-define-key map (kbd "") #'ivy-scroll-up-command) - (ivy-define-key map (kbd "") #'ivy-scroll-down-command) - (ivy-define-key map (kbd "C-v") #'ivy-scroll-up-command) - (ivy-define-key map (kbd "M-v") #'ivy-scroll-down-command) - (ivy-define-key map (kbd "C-M-n") #'ivy-next-line-and-call) - (ivy-define-key map (kbd "C-M-p") #'ivy-previous-line-and-call) - (ivy-define-key map (kbd "M-a") #'ivy-toggle-marks) - (ivy-define-key map (kbd "M-r") #'ivy-toggle-regexp-quote) - (ivy-define-key map (kbd "M-j") #'ivy-yank-word) - (ivy-define-key map (kbd "M-i") #'ivy-insert-current) - (ivy-define-key map (kbd "C-M-y") #'ivy-insert-current-full) - (ivy-define-key map (kbd "C-o") #'hydra-ivy/body) - (ivy-define-key map (kbd "M-o") #'ivy-dispatching-done) - (ivy-define-key map (kbd "C-M-o") #'ivy-dispatching-call) - (ivy-define-key map `[remap ,#'kill-line] #'ivy-kill-line) - (ivy-define-key map `[remap ,#'kill-whole-line] #'ivy-kill-whole-line) - (ivy-define-key map (kbd "S-SPC") #'ivy-restrict-to-matches) - (ivy-define-key map `[remap ,#'kill-ring-save] #'ivy-kill-ring-save) - (ivy-define-key map (kbd "C-M-a") #'ivy-read-action) - (ivy-define-key map (kbd "C-c C-o") #'ivy-occur) - (ivy-define-key map (kbd "C-c C-a") #'ivy-toggle-ignore) - (ivy-define-key map (kbd "C-c C-s") #'ivy-rotate-sort) - (ivy-define-key map `[remap ,#'describe-mode] #'ivy-help) - (ivy-define-key map "$" #'ivy-magic-read-file-env) - map) - "Keymap used in the minibuffer.") - -(defvar ivy-mode-map - (let ((map (make-sparse-keymap))) - (ivy-define-key map `[remap ,#'switch-to-buffer] #'ivy-switch-buffer) - (ivy-define-key map `[remap ,#'switch-to-buffer-other-window] - #'ivy-switch-buffer-other-window) - map) - "Keymap for `ivy-mode'.") - -;;; Globals - -(cl-defstruct ivy-state - prompt collection - predicate require-match initial-input - history preselect keymap update-fn sort - ;; The frame in which `ivy-read' was called - frame - ;; The window in which `ivy-read' was called - window - ;; The buffer in which `ivy-read' was called - buffer - ;; The value of `ivy-text' to be used by `ivy-occur' - text - action - unwind - re-builder - matcher - ;; When this is non-nil, call it for each input change to get new candidates - dynamic-collection - ;; A lambda that transforms candidates only for display - display-transformer-fn - directory - caller - current - def - ignore - multi-action - extra-props) - -(defvar ivy-last (make-ivy-state) - "The last parameters passed to `ivy-read'. - -This should eventually become a stack so that you could use -`ivy-read' recursively.") - -(defvar ivy--sessions nil - "Alist mapping session symbols to `ivy-state' objects.") - -(defvar ivy-recursive-last nil) - -(defvar ivy-recursive-restore t - "When non-nil, restore the above state when exiting the minibuffer. -This variable is let-bound to nil by functions that take care of -the restoring themselves.") - -(defsubst ivy-set-action (action) - "Set the current `ivy-last' field to ACTION." - (setf (ivy-state-action ivy-last) action)) - -(defvar inhibit-message) - -(defvar ffap-machine-p-known) - -(defun ivy-thing-at-point () - "Return a string that corresponds to the current thing at point." - (substring-no-properties - (cond - ((use-region-p) - (let* ((beg (region-beginning)) - (end (region-end)) - (eol (save-excursion (goto-char beg) (line-end-position)))) - (buffer-substring-no-properties beg (min end eol)))) - ((let ((url (thing-at-point 'url))) - ;; Work around `https://bugs.gnu.org/58091'. - (and (stringp url) url))) - ((and (eq (ivy-state-collection ivy-last) #'read-file-name-internal) - (let ((inhibit-message t) - (ffap-machine-p-known 'reject)) - (run-hook-with-args-until-success 'file-name-at-point-functions)))) - ((let ((s (thing-at-point 'symbol))) - (and (stringp s) - (if (string-match "\\`[`']?\\(.*?\\)'?\\'" s) - (match-string 1 s) - s)))) - ((looking-at "(+\\(\\(?:\\sw\\|\\s_\\)+\\)\\_>") - (match-string-no-properties 1)) - (t - "")))) - -(defvar ivy-history nil - "History list of candidates entered in the minibuffer. - -Maximum length of the history list is determined by the value -of `history-length'.") - -(defvar ivy--directory nil - "Current directory when completing file names.") - -(defvar ivy--directory-hist nil - "Store the history of directories. -This allows RET to reverse consecutive DEL.") - -(defvar ivy--length 0 - "Store the amount of viable candidates.") - -(defvar ivy-text "" - "Store the user's string as it is typed in.") - -(defvar ivy-regex "" - "Store the regex value that corresponds to `ivy-text'.") - -(defvar ivy--regex-function #'ivy--regex - "Current function for building a regex.") - -(defun ivy-set-text (str) - "Set `ivy-text' to STR." - (setq ivy-text str) - (setq ivy-regex (funcall ivy--regex-function ivy-text))) - -(defvar ivy--index 0 - "Store the index of the current candidate.") - -(defvar ivy--window-index 0 - "Store the index of the current candidate in the minibuffer window. - -This means it's between 0 and `ivy-height'.") - -(defvar ivy-exit nil - "Store `done' if the completion was successfully selected. -Otherwise, store nil.") - -(defvar ivy--all-candidates nil - "Store the candidates passed to `ivy-read'.") - -(defvar ivy--extra-candidates '((original-source)) - "Store candidates added by the extra sources. - -This is an internal-use alist. Each key is a function name, or -original-source (which represents where the current dynamic -candidates should go). - -Each value is an evaluation of the function, in case of static -sources. These values will subsequently be filtered on `ivy-text'. - -This variable is set by `ivy-read' and used by `ivy--set-candidates'.") - -(defcustom ivy-use-ignore-default t - "The default policy for user-configured candidate filtering." - :type '(choice - (const :tag "Ignore ignored always" always) - (const :tag "Ignore ignored when others exist" t) - (const :tag "Don't ignore" nil))) - -(defvar ivy-use-ignore t - "Store policy for user-configured candidate filtering. -This may be changed dynamically by `ivy-toggle-ignore'. -Use `ivy-use-ignore-default' for a permanent configuration.") - -(defvar ivy--default nil - "Default initial input.") - -(defvar ivy--prompt nil - "Store the format-style prompt. -When non-nil, it should contain at least one %d.") - -(defvar ivy--prompt-extra "" - "Temporary modifications to the prompt.") - -(defvar ivy--old-re nil - "Store the old regexp. -Either a string or a list for `ivy-re-match'.") - -(defvar ivy--old-cands nil - "Store the candidates matched by `ivy--old-re'.") - -(defvar ivy--highlight-function 'ivy--highlight-default - "Current function for formatting the candidates.") - -(defvar ivy--subexps 0 - "Number of groups in the current `ivy--regex'.") - -(defvar ivy--full-length nil - "The total amount of candidates when :dynamic-collection is non-nil.") - -(defvar ivy--old-text "" - "Store old `ivy-text' for dynamic completion.") - -(defvar ivy--trying-to-resume-dynamic-collection nil - "Non-nil if resuming from a dynamic collection. -When non-nil, ivy will wait until the first chunk of asynchronous -candidates has been received before selecting the last -preselected candidate.") - -(defun ivy--set-index-dynamic-collection () - (when ivy--trying-to-resume-dynamic-collection - (let ((preselect-index - (ivy--preselect-index (ivy-state-preselect ivy-last) ivy--all-candidates))) - (when preselect-index - (ivy-set-index preselect-index))) - (setq ivy--trying-to-resume-dynamic-collection nil))) - -(defcustom ivy-case-fold-search-default - (if search-upper-case - 'auto - case-fold-search) - "The default value for `case-fold-search' in Ivy operations. -The special value `auto' means case folding is performed so long -as the entire input string comprises lower-case characters. This -corresponds to the default behaviour of most Emacs search -functionality, e.g. as seen in `isearch'." - :link '(info-link "(emacs)Lax Search") - :type '(choice - (const :tag "Auto" auto) - (const :tag "Always" t) - (const :tag "Never" nil))) - -(defvar ivy-case-fold-search ivy-case-fold-search-default - "Store the current overriding `case-fold-search'.") - -(defcustom ivy-more-chars-alist - '((t . 3)) - "Map commands to their minimum required input length. -That is the number of characters prompted for before fetching -candidates. The special key t is used as a fallback." - :type '(alist :key-type symbol :value-type integer)) - -(defun ivy-more-chars () - "Return two fake candidates prompting for at least N input. -N is obtained from `ivy-more-chars-alist'." - (let ((diff (- (ivy-alist-setting ivy-more-chars-alist) - (length ivy-text)))) - (when (> diff 0) - (list "" (format "%d chars more" diff))))) - -(defun ivy--case-fold-p (string) - "Return nil if STRING should be matched case-sensitively." - (if (eq ivy-case-fold-search 'auto) - (string= string (downcase string)) - ivy-case-fold-search)) - -(defun ivy--case-fold-string= (s1 s2) - "Like `string=', but obeys `case-fold-search'." - (eq t (compare-strings s1 nil nil s2 nil nil case-fold-search))) - -(defmacro ivy-quit-and-run (&rest body) - "Quit the minibuffer and run BODY afterwards." - (declare (indent 0)) - `(progn - (put 'quit 'error-message "") - (run-at-time nil nil - (lambda () - (put 'quit 'error-message "Quit") - (with-demoted-errors "Error: %S" - ,@body))) - (abort-recursive-edit))) - -(defun ivy-exit-with-action (action &optional exit-code) - "Quit the minibuffer and call ACTION afterwards." - (ivy-set-action - `(lambda (x) - (funcall ',action x) - (ivy-set-action ',(ivy-state-action ivy-last)))) - (setq ivy-exit (or exit-code 'done)) - (exit-minibuffer)) - -(defmacro with-ivy-window (&rest body) - "Execute BODY in the window from which `ivy-read' was called." - (declare (indent 0) - (debug t)) - `(with-selected-window (ivy--get-window ivy-last) - ,@body)) - -(defun ivy--expand-file-name (text) - (cond - ((eq (ivy-state-history ivy-last) 'grep-files-history) - text) - (ivy--directory - (if (and (string-match-p "^/" text) (file-remote-p ivy--directory)) - (let ((parts (split-string ivy--directory ":"))) - (concat (nth 0 parts) ":" (nth 1 parts) ":" text)) - (expand-file-name text ivy--directory))) - (t - text))) - -(defun ivy--done (text) - "Insert TEXT and exit minibuffer." - (if (member (ivy-state-prompt ivy-last) '("Create directory: " "Make directory: ")) - (ivy-immediate-done) - (when (stringp text) - (insert - (setf (ivy-state-current ivy-last) - (ivy--expand-file-name text)))) - (setq ivy-exit 'done) - (exit-minibuffer))) - -(defcustom ivy-use-selectable-prompt nil - "When non-nil, make the prompt line selectable like a candidate. - -The prompt line can be selected by calling `ivy-previous-line' when the first -regular candidate is selected. Both actions `ivy-done' and `ivy-alt-done', -when called on a selected prompt, are forwarded to `ivy-immediate-done', which -results to the same as calling `ivy-immediate-done' explicitly when a regular -candidate is selected. - -Note that if `ivy-wrap' is set to t, calling `ivy-previous-line' when the -prompt is selected wraps around to the last candidate, while calling -`ivy-next-line' on the last candidate wraps around to the first -candidate, not the prompt." - :type 'boolean) - -(defvar ivy--use-selectable-prompt nil - "Store the effective `ivy-use-selectable-prompt' for current session.") - -(defun ivy--prompt-selectable-p () - "Return t if the prompt line is selectable." - (and ivy-use-selectable-prompt - (or (memq (ivy-state-require-match ivy-last) - '(nil confirm confirm-after-completion)) - ;; :require-match is t, but "" is in the collection - (let ((coll (ivy-state-collection ivy-last))) - (and (listp coll) - (if (consp (car coll)) - (member '("") coll) - (member "" coll))))))) - -(defun ivy--prompt-selected-p () - "Return t if the prompt line is selected." - (and ivy--use-selectable-prompt - (= ivy--index -1))) - -;;; Commands - -(defun ivy-done () - "Exit the minibuffer with the selected candidate." - (interactive) - (if (ivy--prompt-selected-p) - (ivy-immediate-done) - (setq ivy-current-prefix-arg current-prefix-arg) - (let ((require-match (ivy-state-require-match ivy-last)) - (input (ivy--input))) - (delete-minibuffer-contents) - (cond ((and (= ivy--length 0) - (eq this-command 'ivy-dispatching-done)) - (ivy--done ivy-text)) - ((or (> ivy--length 0) - ;; the action from `ivy-dispatching-done' may not need a - ;; candidate at all - (eq this-command 'ivy-dispatching-done)) - (ivy--done (ivy-state-current ivy-last))) - ((string= " (confirm)" ivy--prompt-extra) - (ivy--done ivy-text)) - ((or (and (memq (ivy-state-collection ivy-last) - '(read-file-name-internal internal-complete-buffer)) - (eq confirm-nonexistent-file-or-buffer t)) - (and (functionp require-match) - (setq require-match (funcall require-match)))) - (setq ivy--prompt-extra " (confirm)") - (insert input) - (ivy--exhibit)) - ((memq require-match '(nil confirm confirm-after-completion)) - (ivy--done ivy-text)) - (t - (setq ivy--prompt-extra " (match required)") - (insert ivy-text) - (ivy--exhibit)))))) - -(defvar ivy-mouse-1-tooltip - "Exit the minibuffer with the selected candidate." - "The doc visible in the tooltip for mouse-1 binding in the minibuffer.") -(defvar ivy-mouse-3-tooltip - "Display alternative actions." - "The doc visible in the tooltip for mouse-3 binding in the minibuffer.") - -(make-obsolete-variable 'ivy-mouse-1-tooltip 'ivy-mouse-1-help - "0.15.0 (2024-01-14)") -(make-obsolete-variable 'ivy-mouse-3-tooltip 'ivy-mouse-3-help - "0.15.0 (2024-01-14)") - -(defvar ivy-mouse-1-help - (format (if (> emacs-major-version 28) "\\`%s': %s" "%s: %s") - "mouse-1" "Exit the minibuffer with the selected candidate") - "Tooltip doc for \\`mouse-1' binding in the minibuffer.") - -(defvar ivy-mouse-3-help - (format (if (> emacs-major-version 28) "\\`%s': %s" "%s: %s") - "mouse-3" "Display alternative actions") - "Tooltip doc for \\`mouse-3' binding in the minibuffer.") - -(defun ivy--help-echo (_win _obj _pos) - "Return a `help-echo' string for mouse bindings on minibuffer candidates." - (concat ivy-mouse-1-help (if tooltip-mode "\n" " ") ivy-mouse-3-help)) - -(defun ivy-mouse-offset (event) - "Compute the offset between the candidate at point and the selected one." - (if event - (let* ((line-number-at-point - (max 2 - (line-number-at-pos (posn-point (event-start event))))) - - (line-number-candidate ;; convert to 0 based index - (- line-number-at-point 2)) - (offset - (- line-number-candidate - ivy--window-index))) - offset) - nil)) - -(defun ivy-mouse-done (event) - (interactive "@e") - (let ((offset (ivy-mouse-offset event))) - (when offset - (ivy-next-line offset) - (ivy--exhibit) - (ivy-alt-done)))) - -(defun ivy-mouse-dispatching-done (event) - (interactive "@e") - (let ((offset (ivy-mouse-offset event))) - (when offset - (ivy-next-line offset) - (ivy--exhibit) - (ivy-dispatching-done)))) - -(defcustom ivy-read-action-format-function 'ivy-read-action-format-default - "Function used to transform the actions list into a docstring." - :type '(radio - (function-item ivy-read-action-format-default) - (function-item ivy-read-action-format-columns))) - -(defun ivy-read-action-format-default (actions) - "Create a docstring from ACTIONS. - -ACTIONS is a list. Each list item is a list of 3 items: -key (a string), cmd and doc (a string)." - (format "%s\n%s\n" - (if (eq this-command 'ivy-read-action) - "Select action: " - (ivy-state-current ivy-last)) - (mapconcat - (lambda (x) - (format "%s: %s" - (propertize - (car x) - 'face 'ivy-action) - (nth 2 x))) - actions - "\n"))) - -(defun ivy-read-action-format-columns (actions) - "Create a potentially multi-column docstring from ACTIONS. -Several columns are used as needed to preserve `ivy-height'. - -ACTIONS is a list with elements of the form (KEY COMMAND DOC), -where KEY and DOC are strings." - (let ((length (length actions)) - (i 0) - (max-rows (- ivy-height 1)) - rows cols col lwidth rwidth) - (while (< i length) - (setq col (cl-subseq actions i (min length (cl-incf i max-rows)))) - (setq lwidth (apply 'max (mapcar (lambda (x) - (length (nth 0 x))) - col))) - (setq rwidth (apply 'max (mapcar (lambda (x) - (length (nth 2 x))) - col))) - (setq col (mapcar (lambda (x) - (format (format "%%%ds: %%-%ds" lwidth rwidth) - (propertize (car x) 'face 'ivy-action) - (nth 2 x))) - col)) - (cond - ((null rows) - (setq rows (length col))) - ((< (length col) rows) - (setq col (append col (make-list (- rows (length col)) ""))))) - (push col cols)) - (format "%s\n%s\n" - (if (eq this-command 'ivy-read-action) - "Select action: " - (ivy-state-current ivy-last)) - (mapconcat 'identity - (apply 'cl-mapcar - (lambda (&rest args) - (mapconcat 'identity args " | ")) - (nreverse cols)) - "\n")))) - -(defcustom ivy-read-action-function #'ivy-read-action-by-key - "Function used to read an action." - :type '(radio - (function-item ivy-read-action-by-key) - (function-item ivy-read-action-ivy) - (function-item ivy-hydra-read-action))) - -(defun ivy-read-action () - "Change the action to one of the available ones. - -Return nil for `minibuffer-keyboard-quit' or wrong key during the -selection, non-nil otherwise." - (interactive) - (let ((actions (ivy-state-action ivy-last))) - (if (not (ivy--actionp actions)) - t - (let ((ivy--directory ivy--directory)) - (funcall ivy-read-action-function actions))))) - -(defvar set-message-function) - -(defun ivy-read-action-by-key (actions) - (let* ((set-message-function nil) - (hint (funcall ivy-read-action-format-function (cdr actions))) - (resize-mini-windows t) - (key "") - action-idx) - (while (and (setq action-idx (cl-position-if - (lambda (x) - (string-prefix-p key (car x))) - (cdr actions))) - (not (string= key (car (nth action-idx (cdr actions)))))) - (setq key (concat key (key-description (vector (read-key hint)))))) - ;; Ignore resize errors with minibuffer-only frames (#2726). - (ignore-errors (ivy-shrink-after-dispatching)) - (cond ((member key '("ESC" "C-g" "M-o")) - nil) - ((null action-idx) - (message "%s is not bound" key) - nil) - (t - (message "") - (setcar actions (1+ action-idx)) - (ivy-set-action actions))))) - -(defvar ivy-marked-candidates nil - "List of marked candidates. -Use `ivy-mark' to populate this. - -When this list is non-nil at the end of the session, the action -will be called for each element of this list.") - -(defun ivy-read-action-ivy (actions) - "Select an action from ACTIONS using Ivy." - (let ((enable-recursive-minibuffers t)) - (if (and (> (minibuffer-depth) 1) - (eq (ivy-state-caller ivy-last) 'ivy-read-action-ivy)) - (minibuffer-keyboard-quit) - (let ((ivy-marked-candidates ivy-marked-candidates)) - (ivy-read (format "action (%s): " (ivy-state-current ivy-last)) - (cl-mapcar - (lambda (a i) (cons (format "[%s] %s" (nth 0 a) (nth 2 a)) i)) - (cdr actions) (number-sequence 1 (length (cdr actions)))) - :action (lambda (a) - (setcar actions (cdr a)) - (ivy-set-action actions)) - :caller 'ivy-read-action-ivy))))) - -(defun ivy-shrink-after-dispatching () - "Shrink the window after dispatching when action list is too large." - (when (window-minibuffer-p) - (window-resize nil (- ivy-height (window-height))))) - -(defun ivy-dispatching-done () - "Select one of the available actions and call `ivy-done'." - (interactive) - (let ((ivy-exit 'ivy-dispatching-done)) - (when (ivy-read-action) - (ivy-done))) - (ivy-shrink-after-dispatching)) - -(defun ivy-dispatching-call () - "Select one of the available actions and call `ivy-call'." - (interactive) - (setq ivy-current-prefix-arg current-prefix-arg) - (let ((actions (copy-sequence (ivy-state-action ivy-last))) - (old-ivy-text ivy-text)) - (unwind-protect - (when (ivy-read-action) - (ivy-set-text old-ivy-text) - (ivy-call)) - (ivy-set-action actions))) - (ivy-shrink-after-dispatching)) - -(defun ivy-build-tramp-name (x) - "Reconstruct X into a path. -Is is a cons cell, related to `tramp-get-completion-function'." - (let ((user (car x)) - (domain (cadr x))) - (if user - (concat user "@" domain) - domain))) - -(declare-function Info-find-node "info") -(declare-function Info-read-node-name-1 "info") -(declare-function tramp-get-completion-function "tramp") - -(defcustom ivy-alt-done-functions-alist nil - "Customize what `ivy-alt-done' does per-collection." - :type '(alist :key-type symbol :value-type function)) - -(defun ivy--completing-fname-p () - (let ((meta (ignore-errors - (funcall (ivy-state-collection ivy-last) ivy-text nil 'metadata)))) - (and (consp meta) - (eq 'file (cdr (assoc 'category meta)))))) - -(defun ivy-alt-done (&optional arg) - "Exit the minibuffer with the selected candidate. -When ARG is t, exit with current text, ignoring the candidates. -When the current candidate during file name completion is a -directory, continue completion from within that directory instead -of exiting. This function is otherwise like `ivy-done'." - (interactive "P") - (setq ivy-current-prefix-arg current-prefix-arg) - (let (alt-done-fn) - (cond ((or arg (ivy--prompt-selected-p)) - (ivy-immediate-done)) - ((setq alt-done-fn (ivy-alist-setting ivy-alt-done-functions-alist)) - (funcall alt-done-fn)) - ((ivy--completing-fname-p) - (ivy--directory-done)) - (t - (ivy-done))))) - -(defun ivy--info-alt-done () - (if (member (ivy-state-current ivy-last) '("(./)" "(../)")) - (ivy-quit-and-run - (ivy-read "Go to file: " #'read-file-name-internal - :action (lambda (x) - (Info-find-node - (expand-file-name x ivy--directory) - "Top")))) - (ivy-done))) - -(defvar ivy-auto-select-single-candidate nil - "When non-nil, auto-select the candidate if it is the only one. -When t, it is the same as if the user were prompted and selected the candidate -by calling the default action. This variable has no use unless the collection -contains a single candidate.") - -(defun ivy--directory-enter () - (let (dir) - (when (and - (> ivy--length 0) - (not (string= (ivy-state-current ivy-last) "./")) - (setq dir (ivy-expand-file-if-directory (ivy-state-current ivy-last)))) - (ivy--cd dir) - (ivy--exhibit)))) - -(defun ivy--handle-directory (input) - "Detect the next directory based on special values of INPUT." - (cond ((string= input "/") - "/") - ((string= input "/sudo::") - (concat input ivy--directory)))) - -(defun ivy--tramp-candidates () - (let ((method (match-string 1 ivy-text)) - (user (match-string 2 ivy-text)) - (rest (match-string 3 ivy-text)) - res) - (dolist (x (tramp-get-completion-function method)) - (setq res (append res (funcall (car x) (cadr x))))) - (setq res (delq nil res)) - (when user - (dolist (x res) - (setcar x user))) - (setq res (delete-dups res)) - (let* ((old-ivy-last ivy-last) - (enable-recursive-minibuffers t) - (host (let ((ivy-auto-select-single-candidate nil)) - (ivy-read "user@host: " - (mapcar #'ivy-build-tramp-name res) - :initial-input rest)))) - (setq ivy-last old-ivy-last) - (when host - (setq ivy--directory "/") - (ivy--cd (concat "/" method ":" host ":/")))))) - -(defun ivy--directory-done () - "Handle exit from the minibuffer when completing file names." - (let ((dir (ivy--handle-directory ivy-text))) - (cond ((equal (ivy-state-current ivy-last) (ivy-state-def ivy-last)) - (ivy-done)) - ((and (ivy-state-require-match ivy-last) - (equal ivy-text "") - (null ivy--old-cands)) - (ivy-immediate-done)) - (dir - (let ((inhibit-message t)) - (ivy--cd dir))) - ((ivy--directory-enter)) - ((unless (string= ivy-text "") - ;; Obsolete since 26.1 and removed in 28.1. - (defvar tramp-completion-mode) - (with-no-warnings - (let* ((tramp-completion-mode t) - ;; Alternative to `tramp-completion-mode' in newer Tramp. - (non-essential t) - ;; Non-nil changes completion since Tramp 2.6.0.2. - (minibuffer-completing-file-name nil) - (file (expand-file-name - (if (> ivy--length 0) (ivy-state-current ivy-last) ivy-text) - ivy--directory))) - (when (ignore-errors (file-exists-p file)) - (if (file-directory-p file) - (ivy--cd (file-name-as-directory file)) - (ivy-done)) - ivy-text))))) - ((or (and (equal ivy--directory "/") - (string-match-p "\\`[^/]+:.*:.*\\'" ivy-text)) - (string-match-p "\\`/[^/]+:.*:.*\\'" ivy-text)) - (ivy-done)) - ((ivy--tramp-prefix-p) - (ivy--tramp-candidates)) - (t - (ivy-done))))) - -(defun ivy--tramp-prefix-p () - (or (and (equal ivy--directory "/") - (cond ((string-match - "\\`\\([^/]+?\\):\\(?:\\(.*\\)@\\)?\\(.*\\)\\'" - ivy-text) - (save-match-data - (ivy-set-text (ivy-state-current ivy-last)))) - ((string-match - "\\`\\([^/]+?\\):\\(?:\\(.*\\)@\\)?\\(.*\\)\\'" - (ivy-state-current ivy-last)) - (save-match-data - (ivy-set-text (ivy-state-current ivy-last)))))) - (string-match - "\\`/\\([^/]+?\\):\\(?:\\(.*\\)@\\)?\\(.*\\)\\'" - ivy-text))) - -(defun ivy-expand-file-if-directory (file-name) - "Expand FILE-NAME as directory. -When this directory doesn't exist, return nil." - (when (stringp file-name) - (let ((full-name - ;; Ignore host name must not match method "ssh" - (ignore-errors - (file-name-as-directory - (expand-file-name file-name ivy--directory))))) - (when (and full-name (file-directory-p full-name)) - full-name)))) - -(defcustom ivy-tab-space nil - "When non-nil, `ivy-partial-or-done' should insert a space." - :type 'boolean) - -(defun ivy-partial-or-done () - "Complete the minibuffer text as much as possible. -If the text hasn't changed as a result, forward to `ivy-alt-done'." - (interactive) - (cond - ((and (numberp completion-cycle-threshold) - (< (length ivy--all-candidates) completion-cycle-threshold)) - (let ((ivy-wrap t)) - (ivy-next-line))) - ((and (eq (ivy-state-collection ivy-last) #'read-file-name-internal) - (or (and (equal ivy--directory "/") - (string-match-p "\\`[^/]+:.*\\'" ivy-text)) - (= (string-to-char ivy-text) ?/))) - (let ((default-directory ivy--directory) - dir) - (minibuffer-complete) - (ivy-set-text (ivy--input)) - (when (setq dir (ivy-expand-file-if-directory ivy-text)) - (ivy--cd dir)))) - (t - (or (ivy-partial) - (when (or (eq this-command last-command) - (eq ivy--length 1)) - (ivy-alt-done)))))) - -(defun ivy--partial-cd-for-single-directory () - (when (and - (eq (ivy-state-collection ivy-last) #'read-file-name-internal) - (= 1 (length - (ivy--re-filter - (funcall ivy--regex-function - (concat "^" (string-remove-prefix "^" ivy-text))) - ivy--all-candidates))) - (let ((default-directory ivy--directory)) - (file-directory-p (ivy-state-current ivy-last)))) - (ivy--directory-done))) - -(defun ivy-partial () - "Complete the minibuffer text as much as possible." - (interactive) - (if (ivy-state-dynamic-collection ivy-last) - (let* ((bnd - (ignore-errors - (funcall - (ivy-state-collection ivy-last) - ivy-text nil (cons 'boundaries (buffer-substring (point) (line-end-position)))))) - (beg (+ (minibuffer-prompt-end) - (if bnd (cadr bnd) 0)))) - (delete-region beg (point-max)) - (insert - (ivy-state-current ivy-last)) - t) - (let* ((parts (or (ivy--split-spaces ivy-text) (list ""))) - (tail (last parts)) - (postfix (car tail)) - (case-fold-search (ivy--case-fold-p ivy-text)) - (completion-ignore-case case-fold-search) - (new (try-completion (string-remove-prefix "^" postfix) - (mapcar (lambda (str) - (let ((i (string-match-p postfix str))) - (and i (substring str i)))) - ivy--old-cands)))) - (cond - ((eq new t) nil) - ((string= new ivy-text) nil) - ((string= (car tail) (car (ivy--split-spaces new))) nil) - (new - (delete-region (minibuffer-prompt-end) (point-max)) - (setcar tail - (if (= (string-to-char postfix) ?^) - (concat "^" new) - new)) - (ivy-set-text - (concat - (mapconcat #'identity parts " ") - (and ivy-tab-space (not (= (length ivy--old-cands) 1)) " "))) - (insert ivy-text) - (ivy--partial-cd-for-single-directory) - t))))) - -(defvar ivy-completion-beg nil - "Completion bounds start.") - -(defvar ivy-completion-end nil - "Completion bounds end.") - -(defun ivy-immediate-done () - "Exit the minibuffer with current input instead of current candidate." - (interactive) - (delete-minibuffer-contents) - (setf (ivy-state-current ivy-last) - (cond ((or (not ivy--directory) - (eq (ivy-state-history ivy-last) 'grep-files-history)) - ivy-text) - ((and (string= ivy-text "") - (eq (ivy-state-collection ivy-last) - #'read-file-name-internal)) - (if (ivy-state-def ivy-last) - (if (and - (file-exists-p (ivy-state-def ivy-last)) - (/= (length ivy--directory) - (1+ (length (expand-file-name (ivy-state-def ivy-last)))))) - ivy--directory - (copy-sequence (ivy-state-def ivy-last))) - ivy--directory)) - (t - (expand-file-name ivy-text ivy--directory)))) - (insert (ivy-state-current ivy-last)) - (setq ivy-completion-beg ivy-completion-end) - (setq ivy-exit 'done) - (exit-minibuffer)) - -(defun ivy--restore-session (&optional session) - "Resume a recorded completion SESSION, if any exists." - (when ivy--sessions - (unless session - (setq session (intern - (let ((ivy-last ivy-last) - ivy--all-candidates - ivy-text) - (ivy-read "Choose ivy session: " - ivy--sessions - :require-match t))))) - (setq ivy-last (or (cdr (assq session ivy--sessions)) - ivy-last))) - (let ((data (plist-get (ivy-state-extra-props ivy-last) :ivy-data))) - (when data - (setq ivy--all-candidates (plist-get data :all-candidates)) - (setq ivy-text (plist-get data :text))))) - -;;;###autoload -(defun ivy-resume (&optional session) - "Resume the last completion session, or SESSION if non-nil. -With a prefix arg, try to restore a recorded completion session, -if one exists." - (interactive) - (when (or current-prefix-arg session) - (ivy--restore-session session)) - - (if (or (null (ivy-state-action ivy-last)) - (eq (ivy--get-action ivy-last) #'identity)) - (user-error "The last session isn't compatible with `ivy-resume'") - (when (memq (ivy-state-caller ivy-last) - '(swiper - swiper-isearch swiper-backward - swiper-isearch-backward - counsel-grep)) - (switch-to-buffer (ivy-state-buffer ivy-last))) - (with-current-buffer (ivy-state-buffer ivy-last) - (let ((default-directory (ivy-state-directory ivy-last)) - (ivy-use-ignore-default (ivy-state-ignore ivy-last))) - (ivy-read - (ivy-state-prompt ivy-last) - (ivy-state-collection ivy-last) - :predicate (ivy-state-predicate ivy-last) - :require-match (ivy-state-require-match ivy-last) - :initial-input ivy-text - :history (ivy-state-history ivy-last) - :preselect (ivy-state-current ivy-last) - :keymap (ivy-state-keymap ivy-last) - :update-fn (ivy-state-update-fn ivy-last) - :sort (ivy-state-sort ivy-last) - :action (ivy-state-action ivy-last) - :unwind (ivy-state-unwind ivy-last) - :re-builder (ivy-state-re-builder ivy-last) - :matcher (ivy-state-matcher ivy-last) - :dynamic-collection (ivy-state-dynamic-collection ivy-last) - :extra-props (ivy-state-extra-props ivy-last) - :caller (ivy-state-caller ivy-last)))))) - -(defvar-local ivy-calling nil - "When non-nil, call the current action when `ivy--index' changes.") - -(defun ivy-set-index (index) - "Set `ivy--index' to INDEX." - (setq ivy--index index) - (when ivy-calling - (ivy--exhibit) - (ivy-call))) - -(defun ivy-beginning-of-buffer () - "Select the first completion candidate." - (interactive) - (ivy-set-index 0)) - -(defun ivy-end-of-buffer () - "Select the last completion candidate." - (interactive) - (ivy-set-index (1- ivy--length))) - -(defun ivy-scroll-up-command () - "Scroll the candidates upward by the minibuffer height." - (interactive) - (ivy-set-index (min (1- (+ ivy--index ivy-height)) - (1- ivy--length)))) - -(defun ivy-scroll-down-command () - "Scroll the candidates downward by the minibuffer height." - (interactive) - (ivy-set-index (max (1+ (- ivy--index ivy-height)) - 0))) - -(defun ivy-next-line (&optional arg) - "Move cursor vertically down ARG candidates." - (interactive "p") - (setq arg (or arg 1)) - (let ((index (+ ivy--index arg))) - (if (> index (1- ivy--length)) - (if ivy-wrap - (ivy-beginning-of-buffer) - (ivy-set-index (1- ivy--length))) - (ivy-set-index index)))) - -(defun ivy-next-line-or-history (&optional arg) - "Move cursor vertically down ARG candidates. -If the input is empty, select the previous history element instead." - (interactive "p") - (let ((orig-index ivy--index)) - (ivy-next-line arg) - (when (and (string= ivy-text "") (= ivy--index orig-index)) - (ivy-previous-history-element 1)))) - -(defun ivy-previous-line (&optional arg) - "Move cursor vertically up ARG candidates." - (interactive "p") - (setq arg (or arg 1)) - (let ((index (- ivy--index arg)) - (min-index (if ivy--use-selectable-prompt -1 0))) - (if (< index min-index) - (if ivy-wrap - (ivy-end-of-buffer) - (ivy-set-index min-index)) - (ivy-set-index index)))) - -(defun ivy-previous-line-or-history (arg) - "Move cursor vertically up ARG candidates. -If the input is empty, select the previous history element instead." - (interactive "p") - (let ((orig-index ivy--index)) - (ivy-previous-line arg) - (when (and (string= ivy-text "") (= ivy--index orig-index)) - (ivy-previous-history-element 1)))) - -(defun ivy-toggle-calling () - "Flip `ivy-calling'." - (interactive) - (when (setq ivy-calling (not ivy-calling)) - (ivy-call))) - -(defun ivy-toggle-ignore () - "Toggle user-configured candidate filtering." - (interactive) - (setq ivy-use-ignore - (if ivy-use-ignore - nil - (or ivy-use-ignore-default t))) - (setf (ivy-state-ignore ivy-last) ivy-use-ignore) - ;; invalidate cache - (setq ivy--old-cands nil)) - -(defun ivy--get-action (state) - "Get the action function from STATE." - (let ((action (ivy-state-action state))) - (when action - (if (functionp action) - action - (cadr (nth (car action) action)))))) - -(defun ivy--get-multi-action (state) - "Get the multi-action function from STATE." - (let* ((action (ivy-state-action state)) - (multi-action - (and (listp action) - (not (eq (car action) 'lambda)) - (nth 3 (nth (car action) action))))) - (if multi-action - multi-action - (when (eq (car action) 1) - (ivy-state-multi-action state))))) - -(defun ivy--get-window (state) - "Get the window from STATE." - (if (ivy-state-p state) - (let ((window (ivy-state-window state))) - (if (window-live-p window) - window - (next-window))) - (selected-window))) - -(defun ivy--actionp (x) - "Return non-nil when X is a list of actions." - (and (consp x) (not (memq (car x) '(closure lambda))))) - -(defcustom ivy-action-wrap nil - "When non-nil, `ivy-next-action' and `ivy-prev-action' wrap." - :type 'boolean) - -(defun ivy-next-action () - "When the current action is a list, scroll it forwards." - (interactive) - (let ((action (ivy-state-action ivy-last))) - (when (ivy--actionp action) - (let ((len (1- (length action))) - (idx (car action))) - (if (>= idx len) - (when ivy-action-wrap - (setf (car action) 1)) - (cl-incf (car action))))))) - -(defun ivy-prev-action () - "When the current action is a list, scroll it backwards." - (interactive) - (let ((action (ivy-state-action ivy-last))) - (when (ivy--actionp action) - (if (<= (car action) 1) - (when ivy-action-wrap - (setf (car action) (1- (length action)))) - (cl-decf (car action)))))) - -(defun ivy-action-name () - "Return the name associated with the current action." - (let ((action (ivy-state-action ivy-last))) - (if (ivy--actionp action) - (format "[%d/%d] %s" - (car action) - (1- (length action)) - (nth 2 (nth (car action) action))) - "[1/1] default"))) - -(defvar ivy-inhibit-action nil - "When non-nil, `ivy-call' does nothing. - -Example use: - - (let* ((ivy-inhibit-action t) - (str (ivy-switch-buffer))) - ;; do whatever with str - the corresponding buffer will not be opened - )") - -(defun ivy-recursive-restore () - "Restore the above state when exiting the minibuffer. -See variable `ivy-recursive-restore' for further information." - (when (and ivy-recursive-last - ivy-recursive-restore - (not (eq ivy-last ivy-recursive-last))) - (ivy--reset-state (setq ivy-last ivy-recursive-last)))) - -(defvar ivy-mark-prefix ">" - "Prefix used by `ivy-mark'.") - -(defun ivy--call-marked (action) - (let* ((prefix-len (length ivy-mark-prefix)) - (marked-candidates - (mapcar - (lambda (s) - (let ((cand (substring s prefix-len))) - (if ivy--directory - (expand-file-name cand ivy--directory) - cand))) - ivy-marked-candidates)) - (multi-action (ivy--get-multi-action ivy-last))) - (if multi-action - (let ((default-directory (ivy-state-directory ivy-last))) - (funcall multi-action (mapcar #'ivy--call-cand marked-candidates))) - (dolist (c marked-candidates) - (let ((default-directory (ivy-state-directory ivy-last))) - (funcall action (ivy--call-cand c))))))) - -(defun ivy--call-cand (current) - (let ((collection (ivy-state-collection ivy-last))) - (cond - ;; Alist type. - ((and (consp (car-safe collection)) - ;; Previously, the cdr of the selected - ;; candidate would be returned. Now, the - ;; whole candidate is returned. - (let ((idx (get-text-property 0 'idx current))) - (if idx - (progn - (ivy--remove-props current 'idx) - (nth idx collection)) - (assoc current collection))))) - (ivy--directory - (expand-file-name current ivy--directory)) - ((equal current "") - ivy-text) - (t - current)))) - -(defun ivy-call () - "Call the current action without exiting completion." - (interactive) - ;; Testing with `ivy-with' seems to call `ivy-call' again, - ;; in which case `this-command' is nil; so check for this. - (unless (memq this-command '(nil - ivy-done - ivy-alt-done - ivy-dispatching-done)) - (setq ivy-current-prefix-arg current-prefix-arg)) - (let* ((action - (if (functionp ivy-inhibit-action) - ivy-inhibit-action - (and (not ivy-inhibit-action) - (ivy--get-action ivy-last)))) - (current (ivy-state-current ivy-last)) - (x (ivy--call-cand current)) - (res - (cond - ((null action) - current) - (t - (select-window (ivy--get-window ivy-last)) - (set-buffer (ivy-state-buffer ivy-last)) - (prog1 (unwind-protect - (if ivy-marked-candidates - (ivy--call-marked action) - (funcall action x)) - (ivy-recursive-restore)) - (unless (or (eq ivy-exit 'done) - (minibuffer-window-active-p (selected-window)) - (null (active-minibuffer-window))) - (select-window (active-minibuffer-window)))))))) - (if ivy-inhibit-action - res - current))) - -(defun ivy-call-and-recenter () - "Call action and recenter window according to the selected candidate." - (interactive) - (ivy-call) - (with-ivy-window - (recenter-top-bottom))) - -(defun ivy-next-line-and-call (&optional arg) - "Move cursor vertically down ARG candidates. -Call the permanent action if possible." - (interactive "p") - (ivy-next-line arg) - (ivy--exhibit) - (ivy-call)) - -(defun ivy-previous-line-and-call (&optional arg) - "Move cursor vertically up ARG candidates. -Call the permanent action if possible." - (interactive "p") - (ivy-previous-line arg) - (ivy--exhibit) - (ivy-call)) - -(defun ivy-previous-history-element (arg) - "Forward to `previous-history-element' with ARG." - (interactive "p") - (previous-history-element arg) - (ivy--cd-maybe) - (move-end-of-line 1) - (ivy--maybe-scroll-history)) - -(defun ivy--insert-symbol-boundaries () - (undo-boundary) - (beginning-of-line) - (insert "\\_<") - (end-of-line) - (insert "\\_>")) - -(defun ivy-next-history-element (arg) - "Forward to `next-history-element' with ARG." - (interactive "p") - (if (and (= minibuffer-history-position 0) - (equal ivy-text "")) - (progn - (when minibuffer-default - (setq ivy--default (car minibuffer-default))) - (insert ivy--default) - (when (and (with-ivy-window (derived-mode-p 'prog-mode)) - (eq (ivy-state-caller ivy-last) 'swiper) - (not (file-exists-p ivy--default)) - (not (ivy-ffap-url-p ivy--default)) - (not (ivy-state-dynamic-collection ivy-last)) - (> (point) (minibuffer-prompt-end))) - (ivy--insert-symbol-boundaries))) - (next-history-element arg)) - (ivy--cd-maybe) - (move-end-of-line 1) - (ivy--maybe-scroll-history)) - -(defvar ivy-ffap-url-functions nil - "List of functions that check if the point is on a URL.") - -(defun ivy--cd-maybe () - "Check if the current input points to a different directory. -If so, move to that directory, while keeping only the file name." - (when ivy--directory - (let ((input (ivy--input)) - url) - (if (setq url (or (ivy-ffap-url-p input) - (with-ivy-window - (cl-reduce - (lambda (a b) - (or a (funcall b))) - ivy-ffap-url-functions - :initial-value nil)))) - (ivy-exit-with-action - (lambda (_) - (ivy-ffap-url-fetcher url)) - 'no-update-history) - (setq input (expand-file-name input)) - (let ((file (file-name-nondirectory input)) - (dir (expand-file-name (file-name-directory input)))) - (if (string= dir ivy--directory) - (progn - (delete-minibuffer-contents) - (insert file)) - (ivy--cd dir) - (insert file))))))) - -(defun ivy--maybe-scroll-history () - "If the selected history element has an index, scroll there." - (let ((idx (ignore-errors - (get-text-property - (minibuffer-prompt-end) - 'ivy-index)))) - (when idx - (ivy--exhibit) - (ivy-set-index idx)))) - -(declare-function tramp-get-completion-methods "tramp") - -(defun ivy--cd (dir) - "When completing file names, move to directory DIR." - (if (ivy--completing-fname-p) - (progn - (push dir ivy--directory-hist) - (setq ivy--old-cands nil) - (setq ivy--old-re nil) - (ivy-set-index 0) - (setq ivy--all-candidates - (append - (ivy--sorted-files (setq ivy--directory dir)) - (when (and (string= dir "/") (featurep 'tramp)) - (sort - (mapcar - (lambda (s) (substring s 1)) - (tramp-get-completion-methods "")) - #'string<)))) - (ivy-set-text "") - (setf (ivy-state-directory ivy-last) dir) - (delete-minibuffer-contents)) - (error "Unexpected"))) - -(defun ivy--parent-dir (filename) - "Return parent directory of absolute FILENAME." - (file-name-directory (directory-file-name filename))) - -(defun ivy-backward-delete-char () - "Forward to `delete-backward-char'. -Call `ivy-on-del-error-function' if an error occurs, usually when -there is no more text to delete at the beginning of the -minibuffer." - (interactive) - (if (and ivy--directory (= (minibuffer-prompt-end) (point))) - (progn - (ivy--cd (ivy--parent-dir (expand-file-name ivy--directory))) - (ivy--exhibit)) - (setq prefix-arg current-prefix-arg) - (condition-case nil - (call-interactively #'delete-backward-char) - (error - (when ivy-on-del-error-function - (funcall ivy-on-del-error-function)))))) - -(defun ivy-delete-char (arg) - "Forward to `delete-char' ARG." - (interactive "p") - (unless (eolp) - (delete-char arg))) - -(defun ivy-forward-char (arg) - "Forward to `forward-char' ARG." - (interactive "p") - (unless (eolp) - (forward-char arg))) - -(defun ivy-kill-word (arg) - "Forward to `kill-word' ARG." - (interactive "p") - (unless (eolp) - (kill-word arg))) - -(defun ivy-kill-line () - "Forward to `kill-line'." - (interactive) - (if (eolp) - (progn - (kill-region (minibuffer-prompt-end) (point)) - (setq ivy--old-text (current-kill 0 t))) - (kill-line))) - -(defun ivy-kill-whole-line () - "Forward to `kill-whole-line'." - (interactive) - (kill-region (minibuffer-prompt-end) (line-end-position))) - -(defun ivy-backward-kill-word () - "Forward to `backward-kill-word'." - (interactive) - (if (and ivy--directory (= (minibuffer-prompt-end) (point))) - (progn - (ivy--cd (ivy--parent-dir (expand-file-name ivy--directory))) - (ivy--exhibit)) - (ignore-errors - (let ((pt (point)) - (last-command (if (eq last-command 'ivy-backward-kill-word) - 'kill-region - last-command))) - (forward-word -1) - (kill-region pt (point)))))) - -(defvar ivy--regexp-quote #'regexp-quote - "Store the regexp quoting state.") - -(defun ivy-toggle-regexp-quote () - "Toggle the regexp quoting." - (interactive) - (setq ivy--old-re nil) - (cl-rotatef ivy--regex-function ivy--regexp-quote) - (setq ivy--old-text "") - (setq ivy-regex (funcall ivy--regex-function ivy-text))) - -(defcustom ivy-format-functions-alist - '((t . ivy-format-function-default)) - "An alist of functions that transform the list of candidates into a string. -This string is inserted into the minibuffer." - :type '(alist - :key-type symbol - :value-type - (choice - (const :tag "Default" ivy-format-function-default) - (const :tag "Arrow prefix" ivy-format-function-arrow) - (const :tag "Full line" ivy-format-function-line) - (const :tag "Arrow prefix + full line" - ivy-format-function-arrow-line) - (function :tag "Custom function")))) - -(defun ivy-sort-file-function-default (x y) - "Compare two files X and Y. -Prioritize directories." - (let ((xdir (get-text-property 0 'ivy--dir x)) - (ydir (get-text-property 0 'ivy--dir y))) - (if xdir - (or (not ydir) (string< xdir ydir)) - (and (not ydir) (string< x y))))) - -(defun ivy-string< (x y) - "Like `string<', but operate on CARs when given cons cells." - (string< (if (consp x) (car x) x) - (if (consp y) (car y) y))) - -(define-obsolete-function-alias 'ivy-sort-file-function-using-ido - 'ido-file-extension-lessp "0.13.0 (2019-10-12)") - -(defcustom ivy-sort-functions-alist - '((t . ivy-string<)) - "An alist of sorting functions for each collection function. -Interactive functions that call completion fit in here as well. - -Nil means no sorting, which is useful to turn off the sorting for -functions that have candidates in the natural buffer order, like -`org-refile' or `Man-goto-section'. - -A list can be used to associate multiple sorting functions with a -collection. The car of the list is the current sort -function. This list can be rotated with `ivy-rotate-sort'. - -The entry associated with t is used for all fall-through cases. - -See also `ivy-sort-max-size'." - :type - '(alist - :key-type (choice - (const :tag "Fall-through" t) - (symbol :tag "Collection")) - :value-type (choice - (const :tag "Plain sort" ivy-string<) - (const :tag "File sort" ivy-sort-file-function-default) - (const :tag "File sort using Ido" ido-file-extension-lessp) - (const :tag "No sort" nil) - (function :tag "Custom function") - (repeat (function :tag "Custom function"))))) - -(defun ivy--sort-function (collection) - "Retrieve sort function for COLLECTION from `ivy-sort-functions-alist'." - (let ((entry (cdr (or (assq collection ivy-sort-functions-alist) - (assq (ivy-state-caller ivy-last) ivy-sort-functions-alist) - (assq t ivy-sort-functions-alist))))) - (and (or (functionp entry) - (functionp (setq entry (car-safe entry)))) - entry))) - -(defun ivy-rotate-sort () - "Rotate through sorting functions available for current collection. -This only has an effect if multiple sorting functions are -specified for the current collection in -`ivy-sort-functions-alist'." - (interactive) - (let ((cell (or (assq (ivy-state-collection ivy-last) ivy-sort-functions-alist) - (assq (ivy-state-caller ivy-last) ivy-sort-functions-alist) - (assq t ivy-sort-functions-alist)))) - (when (consp (cdr cell)) - (setcdr cell (nconc (cddr cell) (list (cadr cell)))) - (ivy--reset-state ivy-last)))) - -(defcustom ivy-index-functions-alist - '((t . ivy-recompute-index-zero)) - "An alist of index recomputing functions for each collection function. -When the input changes, the appropriate function returns an -integer - the index of the matched candidate that should be -selected." - :type '(alist :key-type symbol :value-type function)) - -(defvar ivy-re-builders-alist - '((t . ivy--regex-plus)) - "An alist of regex building functions for each collection function. - -Each key is (in order of priority): -1. The actual collection function, e.g. `read-file-name-internal'. -2. The symbol passed by :caller into `ivy-read'. -3. `this-command'. -4. t. - -Each value is a function that should take a string and return a -valid regex or a regex sequence (see below). - -Possible choices: `ivy--regex', `regexp-quote', -`ivy--regex-plus', `ivy--regex-fuzzy', `ivy--regex-ignore-order'. - -If a function returns a list, it should format like this: -\\='((\"matching-regexp\" . t) (\"non-matching-regexp\") ...). - -The matches will be filtered in a sequence, you can mix the -regexps that should match and that should not match as you -like.") - -(defvar ivy-highlight-functions-alist - '((ivy--regex-ignore-order . ivy--highlight-ignore-order) - (ivy--regex-fuzzy . ivy--highlight-fuzzy) - (ivy--regex-plus . ivy--highlight-default)) - "An alist of highlighting functions for each regex builder function.") - -(defcustom ivy-initial-inputs-alist - '((org-refile . "^") - (org-agenda-refile . "^") - (org-capture-refile . "^") - (Man-completion-table . "^") - (woman . "^")) - "An alist associating commands with their initial input. - -Each cdr is either a string or a function called in the context -of a call to `ivy-read'." - :type '(alist - :key-type (symbol) - :value-type (choice (string) (function)))) - -(defcustom ivy-hooks-alist nil - "An alist associating commands to setup functions. -Examples: `toggle-input-method', (lambda () (insert \"^\")), etc. -May supersede `ivy-initial-inputs-alist'." - :type '(alist :key-type symbol :value-type function)) - -(defvar ivy--occurs-list nil - "A list of custom occur generators per command.") - -(defun ivy-set-occur (cmd occur) - "Assign CMD a custom OCCUR function." - (setq ivy--occurs-list - (plist-put ivy--occurs-list cmd occur))) - -(defcustom ivy-update-fns-alist nil - "An alist associating commands to their :update-fn values." - :type '(alist - :key-type symbol - :value-type - (radio - (const :tag "Off" nil) - (const :tag "Call action on change" auto)))) - -(defcustom ivy-unwind-fns-alist nil - "An alist associating commands to their :unwind values." - :type '(alist :key-type symbol :value-type function)) - -(defcustom ivy-init-fns-alist nil - "An alist associating commands to their :init values. -An :init is a function with no arguments. -`ivy-read' calls it to initialize." - :type '(alist :key-type symbol :value-type function)) - -(defun ivy--alist-set (alist-sym key val) - (let ((curr-val (symbol-value alist-sym)) - (customized-val (get alist-sym 'customized-value)) - (default-val (eval (car (get alist-sym 'standard-value))))) - ;; when the value was set by `customize-set-variable', don't touch it - (unless customized-val - ;; only works if the value wasn't customized by the user - (when (or (null default-val) (equal curr-val default-val)) - (let ((cell (assoc key curr-val))) - (if cell - (setcdr cell val) - (set alist-sym (cons (cons key val) - (symbol-value alist-sym))))) - (when default-val - (put alist-sym 'standard-value - (list (list 'quote (symbol-value alist-sym))))))))) - -(declare-function counsel-set-async-exit-code "counsel") - -(defvar ivy--parents-alist nil - "Configure parent caller for child caller. -The child caller inherits and can override the settings of the parent.") - -(cl-defun ivy-configure (caller - &key - parent - initial-input - height - occur - update-fn - init-fn - unwind-fn - index-fn - sort-fn - sort-matches-fn - format-fn - display-fn - display-transformer-fn - alt-done-fn - more-chars - grep-p - exit-codes) - "Configure `ivy-read' params for CALLER." - (declare (indent 1)) - (when parent - (ivy--alist-set 'ivy--parents-alist caller parent)) - (when initial-input - (ivy--alist-set 'ivy-initial-inputs-alist caller initial-input)) - (when height - (ivy--alist-set 'ivy-height-alist caller height)) - (when occur - (ivy-set-occur caller occur)) - (when update-fn - (ivy--alist-set 'ivy-update-fns-alist caller update-fn)) - (when unwind-fn - (ivy--alist-set 'ivy-unwind-fns-alist caller unwind-fn)) - (when init-fn - (ivy--alist-set 'ivy-init-fns-alist caller init-fn)) - (when index-fn - (ivy--alist-set 'ivy-index-functions-alist caller index-fn)) - (when sort-fn - (ivy--alist-set 'ivy-sort-functions-alist caller sort-fn)) - (when sort-matches-fn - (ivy--alist-set 'ivy-sort-matches-functions-alist caller sort-matches-fn)) - (when format-fn - (ivy--alist-set 'ivy-format-functions-alist caller format-fn)) - (when display-fn - (ivy--alist-set 'ivy-display-functions-alist caller display-fn)) - (when display-transformer-fn - (ivy--alist-set 'ivy--display-transformers-alist caller display-transformer-fn)) - (when alt-done-fn - (ivy--alist-set 'ivy-alt-done-functions-alist caller alt-done-fn)) - (when more-chars - (ivy--alist-set 'ivy-more-chars-alist caller more-chars)) - (when grep-p - (cl-pushnew caller ivy-highlight-grep-commands)) - (when exit-codes - (let (code msg) - (while (and (setq code (pop exit-codes)) - (setq msg (pop exit-codes))) - (counsel-set-async-exit-code caller code msg))))) - -(defcustom ivy-sort-max-size 30000 - "Sorting won't be done for collections larger than this." - :type 'integer) - -(defalias 'ivy--dirname-p - ;; Added in Emacs 25.1. - (if (fboundp 'directory-name-p) - #'directory-name-p - (lambda (name) - "Return non-nil if NAME ends with a directory separator." - (string-suffix-p "/" name)))) - -(defalias 'ivy--string-search - (if (fboundp 'string-search) - #'string-search - (lambda (needle haystack) ;; Faster than `cl-search'. - (string-match-p (regexp-quote needle) haystack))) - "Compatibility shim for Emacs 28 `string-search'. -\n(fn NEEDLE HAYSTACK)") - -(defalias 'ivy--string-replace - (if (fboundp 'string-replace) - #'string-replace - (lambda (from to in) - (replace-regexp-in-string (regexp-quote from) to in t t))) - "Compatibility shim for Emacs 28 `string-replace'. -\n(fn FROM TO IN)") - -;; Moved to subr.el in Emacs 27.1. -(autoload 'xor "array") - -(defun ivy--sorted-files (dir) - "Return the list of files in DIR. -Directories come first." - (let* ((coll #'read-file-name-internal) - (sort-fn (ivy--sort-function coll)) - (dirs-first (eq sort-fn #'ivy-sort-file-function-default)) - (seq (cl-mapcan - (lambda (f) - (unless (member f '("./" "../")) - ;; FIXME: Use `substitute-in-file-name'? - ;; Re: #2012, #3060. - (setq f (ivy--string-replace "$$" "$" f)) - (list (if (and dirs-first (ivy--dirname-p f)) - (propertize f 'ivy--dir (directory-file-name f)) - f)))) - (condition-case nil - (let ((default-directory dir)) - (all-completions "" coll (ivy-state-predicate ivy-last))) - (error (directory-files - dir nil directory-files-no-dot-files-regexp)))))) - (when sort-fn - (setq seq (sort seq sort-fn))) - (dolist (extra ivy-extra-directories) - (push extra seq)) - (if (string= dir "/") - (cl-delete-if (lambda (s) (string-suffix-p ":" s)) (delete "../" seq)) - seq))) - -(defun ivy-alist-setting (alist &optional key) - "Return the value associated with KEY in ALIST, using `assq'. -KEY defaults to the last caller of `ivy-read'; if no entry is -found, it falls back to the key t." - (let ((caller (or key (ivy-state-caller ivy-last)))) - (or - (and caller (cdr (assq caller alist))) - (let ((parent (cdr (assq caller ivy--parents-alist)))) - (when parent - (ivy-alist-setting alist parent))) - (cdr (assq t alist))))) - -(defun ivy--height (caller) - (let ((v (or (ivy-alist-setting ivy-height-alist caller) - ivy-height))) - (if (integerp v) - v - (if (functionp v) - (funcall v caller) - (error "Unexpected value: %S" v))))) - -(defun ivy--remove-props (str &rest props) - "Return STR with text PROPS destructively removed." - (ignore-errors - (remove-list-of-text-properties 0 (length str) props str)) - str) - -(defun ivy--update-prompt (prompt) - (cond ((equal prompt "Keyword, C-h: ") - ;; auto-insert.el - "Keyword (C-M-j to end): ") - (t - ;; misearch.el - (ivy--string-replace "RET to end" "C-M-j to end" prompt)))) - -;;;; Entry Point - -;;;###autoload -(cl-defun ivy-read (prompt collection - &key - predicate require-match initial-input - history preselect def keymap update-fn sort - action multi-action - unwind re-builder matcher - dynamic-collection - extra-props - caller) - "Read a string in the minibuffer, with completion. - -PROMPT is a string, normally ending in a colon and a space. -`ivy-count-format' is prepended to PROMPT during completion. - -COLLECTION is either a list of strings, a function, an alist, or -a hash table, supplied for `minibuffer-completion-table'. - -PREDICATE is applied to filter out the COLLECTION immediately. -This argument is for compatibility with `completing-read'. - -When REQUIRE-MATCH is non-nil, only members of COLLECTION can be -selected. In can also be a lambda. - -If INITIAL-INPUT is non-nil, then insert that input in the -minibuffer initially. - -HISTORY is a name of a variable to hold the completion session -history. - -KEYMAP is composed with `ivy-minibuffer-map'. - -PRESELECT, when non-nil, determines which one of the candidates -matching INITIAL-INPUT to select initially. An integer stands -for the position of the desired candidate in the collection, -counting from zero. Otherwise, use the first occurrence of -PRESELECT in the collection. Comparison is first done with -`equal'. If that fails, and when applicable, match PRESELECT as -a regular expression. - -DEF is for compatibility with `completing-read'. - -UPDATE-FN is called each time the candidate list is re-displayed. - -When SORT is non-nil, `ivy-sort-functions-alist' determines how -to sort candidates before displaying them. - -ACTION is a function to call after selecting a candidate. -It takes one argument, the selected candidate. If COLLECTION is -an alist, the argument is a cons cell, otherwise it's a string. - -MULTI-ACTION, when non-nil, is called instead of ACTION when -there are marked candidates. It takes the list of candidates as -its only argument. When it's nil, ACTION is called on each marked -candidate. - -UNWIND is a function of no arguments to call before exiting. - -RE-BUILDER is a function transforming input text into a regex -pattern. - -MATCHER is a function which can override how candidates are -filtered based on user input. It takes a regex pattern and a -list of candidates, and returns the list of matching candidates. - -DYNAMIC-COLLECTION is a boolean specifying whether the list of -candidates is updated after each input by calling COLLECTION. - -EXTRA-PROPS is a plist that can be used to store -collection-specific session-specific data. - -CALLER is a symbol to uniquely identify the caller to `ivy-read'. -It is used, along with COLLECTION, to determine which -customizations apply to the current completion session." - (let ((init-fn (ivy-alist-setting ivy-init-fns-alist caller))) - (when init-fn - (funcall init-fn))) - ;; get un-stuck from an existing `read-key' overriding minibuffer keys - (when (equal overriding-local-map '(keymap)) - (keyboard-quit)) - (setq caller (or caller this-command)) - (let* ((ivy-recursive-last (and (active-minibuffer-window) ivy-last)) - (ivy--display-function - (when (or ivy-recursive-last - (not (window-minibuffer-p))) - (ivy-alist-setting ivy-display-functions-alist caller)))) - (setq update-fn (or update-fn (ivy-alist-setting ivy-update-fns-alist caller))) - (setq unwind (or unwind (ivy-alist-setting ivy-unwind-fns-alist caller))) - (setq ivy-last - (make-ivy-state - :prompt (ivy--update-prompt prompt) - :collection collection - :predicate predicate - :require-match require-match - :initial-input initial-input - :history history - :preselect preselect - :keymap keymap - :update-fn (if (eq update-fn 'auto) - (lambda () - (with-ivy-window - (funcall - (ivy--get-action ivy-last) - (if (consp (car-safe (ivy-state-collection ivy-last))) - (assoc (ivy-state-current ivy-last) - (ivy-state-collection ivy-last)) - (ivy-state-current ivy-last))))) - update-fn) - :sort sort - :action (ivy--compute-extra-actions action caller) - :multi-action multi-action - :frame (selected-frame) - :window (selected-window) - :buffer (current-buffer) - :unwind unwind - :re-builder re-builder - :matcher matcher - :dynamic-collection dynamic-collection - :display-transformer-fn (ivy-alist-setting ivy--display-transformers-alist caller) - :directory default-directory - :extra-props extra-props - :caller caller - :def def)) - (ivy--reset-state ivy-last) - (unwind-protect - (minibuffer-with-setup-hook - #'ivy--minibuffer-setup - (let* ((hist (or history 'ivy-history)) - (minibuffer-completion-table collection) - (minibuffer-completion-predicate predicate) - (ivy-height (ivy--height caller)) - (resize-mini-windows (unless (display-graphic-p) - 'grow-only))) - (if (and ivy-auto-select-single-candidate - ivy--all-candidates - (null (cdr ivy--all-candidates))) - (progn - (setf (ivy-state-current ivy-last) - (car ivy--all-candidates)) - (setq ivy-exit 'done)) - (condition-case err - (read-from-minibuffer - prompt - (ivy-state-initial-input ivy-last) - (make-composed-keymap keymap ivy-minibuffer-map) - nil - hist) - (error - (unless (equal err '(error "Selecting deleted buffer")) - (signal (car err) (cdr err)))))) - (when (eq ivy-exit 'done) - (ivy--update-history hist)))) - (let ((session (or (plist-get extra-props :session) - (unless (or (minibufferp) - (null (ivy-state-action ivy-last)) - (eq (ivy--get-action ivy-last) #'identity)) - caller)))) - (when session - (setf (ivy-state-extra-props ivy-last) - (plist-put extra-props :ivy-data `(:all-candidates ,ivy--all-candidates - :text ,ivy-text))) - (ivy--alist-set 'ivy--sessions session ivy-last))) - (ivy--cleanup)) - (ivy-call))) - -(defun ivy--update-history (hist) - (unless (eq hist t) - (let ((item - (if (or (string= ivy-text "") - (eq (plist-get (ivy-state-extra-props ivy-last) :caller) - #'ivy-completing-read) - (eq (ivy-state-history ivy-last) 'file-name-history)) - (ivy-state-current ivy-last) - ivy-text))) - (cond ((equal item "")) - ((stringp item) - (let ((history-delete-duplicates t)) - (add-to-history - hist (propertize item 'ivy-index ivy--index)))))))) - -(defun ivy--cleanup () - ;; Fixes a bug in ESS, #1660 - (put 'post-command-hook 'permanent-local nil) - (remove-hook 'post-command-hook #'ivy--queue-exhibit) - (remove-hook 'window-size-change-functions #'ivy--window-size-changed) - (let ((cleanup (ivy--display-function-prop :cleanup)) - (unwind (ivy-state-unwind ivy-last))) - (when (functionp cleanup) - (funcall cleanup)) - (when unwind - (funcall unwind))) - (ivy--pulse-cleanup) - (unless (eq ivy-exit 'done) - (ivy-recursive-restore))) - -(defun ivy--display-function-prop (prop) - "Return PROP associated with current `ivy--display-function'." - (plist-get (cdr (assq ivy--display-function - ivy-display-functions-props)) - prop)) - -(defvar Info-complete-menu-buffer) - -(defun ivy--alist-to-cands (alist) - "Transform ALIST to a list of strings." - (let ((i -1)) - (mapcar (lambda (x) - (propertize x 'idx (cl-incf i))) - (all-completions "" alist)))) - -(defvar ivy--minibuffer-metadata nil - "Store `completion-metadata'.") - -(defun ivy--reset-state (state) - "Reset the ivy to STATE. -This is useful for recursive `ivy-read'." - (setq ivy-marked-candidates nil) - (setq ivy--minibuffer-metadata nil) - (unless (equal (selected-frame) (ivy-state-frame state)) - (select-window (active-minibuffer-window))) - (let* ((prompt (or (ivy-state-prompt state) "")) - (collection (ivy-state-collection state)) - (predicate (ivy-state-predicate state)) - (history (ivy-state-history state)) - (preselect (ivy-state-preselect state)) - (re-builder (ivy-state-re-builder state)) - (dynamic-collection (ivy-state-dynamic-collection state)) - (require-match (ivy-state-require-match state)) - (caller (or (ivy-state-caller state) this-command)) - (sort (or (ivy-state-sort state) (assoc caller ivy-sort-functions-alist))) - (initial-input - (or (ivy-state-initial-input state) - (let ((init (ivy-alist-setting ivy-initial-inputs-alist caller))) - (if (functionp init) (funcall init) init)))) - (def (ivy-state-def state))) - (when (and (eq caller 'swiper-isearch) (buffer-modified-p)) - (setq preselect nil)) - (setq ivy--extra-candidates (ivy--compute-extra-candidates caller)) - (setq ivy--directory nil) - (setq ivy--directory-hist (list default-directory)) - (setq ivy-case-fold-search ivy-case-fold-search-default) - (setf (ivy-state-re-builder ivy-last) - (setq ivy--regex-function - (or re-builder - (and (functionp collection) - (cdr (assq collection ivy-re-builders-alist))) - (ivy-alist-setting ivy-re-builders-alist) - #'ivy--regex))) - (setq ivy--subexps 0) - (setq ivy--regexp-quote #'regexp-quote) - (setq ivy--old-text "") - (setq ivy--full-length nil) - (ivy-set-text (or initial-input "")) - (setq ivy--index 0) - (setq ivy-calling nil) - (setq ivy-use-ignore ivy-use-ignore-default) - (setf (ivy-state-ignore state) ivy-use-ignore) - (setq ivy--highlight-function - (or (cdr (assq (ivy-alist-setting ivy-re-builders-alist) - ivy-highlight-functions-alist)) - #'ivy--highlight-default)) - (let ((ivy-recursive-restore nil) - coll sort-fn) - (cond ((eq collection #'Info-read-node-name-1) - (setq coll - (if (equal (bound-and-true-p Info-current-file) "dir") - (mapcar (lambda (x) (format "(%s)" x)) - (delete-dups - (all-completions "(" collection predicate))) - (all-completions "" collection predicate)))) - ((memq collection '(read-file-name-internal ffap-read-file-or-url-internal)) - (require 'tramp) - (when (and (equal def initial-input) - (member "./" ivy-extra-directories)) - (setq def nil)) - (setq ivy--directory default-directory) - (when (and initial-input - (not (equal initial-input ""))) - (cond ((file-directory-p initial-input) - (when (equal (file-name-nondirectory initial-input) "") - (setf (ivy-state-preselect state) (setq preselect nil)) - (setq def nil)) - (setq ivy--directory (file-name-as-directory initial-input)) - (setq initial-input nil) - (when preselect - (let ((preselect-directory - (file-name-directory preselect))) - (when (and preselect-directory - (not (equal - (expand-file-name - preselect-directory) - (expand-file-name ivy--directory)))) - (setf (ivy-state-preselect state) - (setq preselect nil)))))) - ((ignore-errors - (file-exists-p (file-name-directory initial-input))) - (setq ivy--directory (file-name-directory initial-input)) - (setf (ivy-state-preselect state) - (file-name-nondirectory initial-input))))) - (require 'dired) - (when preselect - (let ((preselect-directory (ivy--parent-dir preselect))) - (when (and preselect-directory - (not (string= preselect-directory - default-directory))) - (setq ivy--directory preselect-directory)) - (setq preselect (file-relative-name preselect - preselect-directory)) - (setf (ivy-state-preselect state) preselect))) - (setq sort nil) - (setq coll (ivy--sorted-files ivy--directory)) - (when initial-input - (unless (or require-match - (equal initial-input default-directory) - (equal initial-input "")) - (setq coll (cons initial-input coll))) - (setq initial-input (file-name-nondirectory initial-input)))) - ((eq collection #'internal-complete-buffer) - (setq coll (ivy--buffer-list - "" - (and ivy-use-virtual-buffers - (member caller '(ivy-switch-buffer - ivy-switch-buffer-other-window - counsel-switch-buffer))) - predicate))) - (dynamic-collection - (setq ivy--minibuffer-metadata - (ignore-errors - (completion-metadata - "" - (ivy-state-collection ivy-last) - (ivy-state-predicate ivy-last)))) - (setq coll (if (and (eq this-command 'ivy-resume) (not (buffer-modified-p))) - ivy--all-candidates - (ivy--dynamic-collection-cands (or initial-input ""))))) - ((consp (car-safe collection)) - (setq collection (cl-remove-if-not predicate collection)) - (when (and sort (setq sort-fn (ivy--sort-function caller))) - (setq collection (sort (copy-sequence collection) sort-fn)) - (setq sort nil)) - (setf (ivy-state-collection ivy-last) collection) - (setq coll (ivy--alist-to-cands collection))) - ((or (functionp collection) - (byte-code-function-p collection) - (vectorp collection) - (hash-table-p collection) - (and (listp collection) (symbolp (car collection)))) - (let ((Info-complete-menu-buffer - ;; FIXME: This is a temporary workaround for issue #1803. - (or (bound-and-true-p Info-complete-menu-buffer) - (ivy-state-buffer state)))) - (setq coll (all-completions "" collection predicate)))) - (t - (setq coll (all-completions "" collection predicate)))) - (unless (ivy-state-dynamic-collection ivy-last) - (setq coll (delete "" coll))) - (when (and sort - (or (functionp collection) - (not (eq history 'org-refile-history))) - (setq sort-fn (ivy--sort-function - (if (functionp collection) collection caller))) - (listp coll) - (null (nthcdr ivy-sort-max-size coll))) - (setq coll (sort (copy-sequence coll) sort-fn))) - (when def - (cond ((stringp (car-safe def)) - (setq coll - (delete-dups - (append def coll)))) - ((and (stringp def) (not (member def coll))) - (push def coll)))) - (setq coll (ivy--set-candidates coll)) - (setq ivy--old-re nil) - (setq ivy--old-cands nil) - (when initial-input - ;; Needed for anchor to work - (setq ivy--old-cands coll) - (setq ivy--old-cands (ivy--filter initial-input coll))) - (unless (setq ivy--trying-to-resume-dynamic-collection - (and preselect dynamic-collection)) - (when (integerp preselect) - (setq ivy--old-re "") - (ivy-set-index preselect))) - (setq ivy--all-candidates coll) - (unless (integerp preselect) - (ivy-set-index (or - (and dynamic-collection - ivy--index) - (and preselect - (ivy--preselect-index - preselect - (if initial-input - ivy--old-cands - coll))) - 0)))) - (setq ivy-exit nil) - (setq ivy--default - (if (region-active-p) - (buffer-substring (region-beginning) (region-end)) - (ivy-thing-at-point))) - (setq ivy--prompt (ivy-add-prompt-count (ivy--quote-format-string prompt))) - (setq ivy--use-selectable-prompt (ivy--prompt-selectable-p)) - (setf (ivy-state-initial-input ivy-last) initial-input))) - -(defun ivy-add-prompt-count (prompt) - "Add count information to PROMPT." - (cond ((null ivy-count-format) - (error "`ivy-count-format' must not be nil; set it to \"\" instead")) - ((string-match "%d.*\\(%d\\)" ivy-count-format) - (let* ((w - (if (listp ivy--all-candidates) - (1+ (floor (log (max 1 (length ivy--all-candidates)) 10))) - 1)) - (s (replace-match (format "%%-%dd" w) t t ivy-count-format 1))) - (string-match "%d" s) - (concat (replace-match (format "%%%dd" w) t t s) - prompt))) - ((string-match-p "%.*d" ivy-count-format) - (concat ivy-count-format prompt)) - (t - prompt))) - -(defun ivy--quote-format-string (str) - "Make STR suitable for `format' with no extra arguments." - (ivy--string-replace "%" "%%" str)) - -;;;###autoload -(defun ivy-completing-read (prompt collection - &optional predicate require-match initial-input - history def inherit-input-method) - "Read a string in the minibuffer, with completion. - -This interface conforms to `completing-read' and can be used for -`completing-read-function'. - -PROMPT is a string that normally ends in a colon and a space. -COLLECTION is either a list of strings, an alist, an obarray, or a hash table. -PREDICATE limits completion to a subset of COLLECTION. -REQUIRE-MATCH is a boolean value or a symbol. See `completing-read'. -INITIAL-INPUT is a string inserted into the minibuffer initially. -HISTORY is a list of previously selected inputs. -DEF is the default value. -INHERIT-INPUT-METHOD is currently ignored." - (let ((handler - (and (< ivy-completing-read-ignore-handlers-depth (minibuffer-depth)) - (assq this-command ivy-completing-read-handlers-alist)))) - (if handler - (let ((completion-in-region-function #'completion--in-region) - (ivy-completing-read-ignore-handlers-depth (1+ (minibuffer-depth)))) - (funcall (cdr handler) - prompt collection - predicate require-match - initial-input history - def inherit-input-method)) - ;; See the doc of `completing-read'. - (when (consp history) - (when (numberp (cdr history)) - (setq initial-input (nth (1- (cdr history)) - (symbol-value (car history))))) - (setq history (car history))) - (when (consp def) - (setq def (car def))) - (let ((str (ivy-read - prompt collection - :predicate predicate - :require-match (and collection require-match) - :initial-input - (cond ((consp initial-input) - (car initial-input)) - ((and (stringp initial-input) - (not (eq collection #'read-file-name-internal))) - (ivy--string-replace "+" "\\+" initial-input)) - (initial-input)) - :preselect def - :def def - :history history - :keymap nil - :dynamic-collection ivy-completing-read-dynamic-collection - :extra-props '(:caller ivy-completing-read) - :caller (if (and collection (symbolp collection)) - collection - this-command)))) - (if (string= str "") - ;; For `completing-read' compat, return the first element of - ;; DEFAULT, if it is a list; "", if DEFAULT is nil; or DEFAULT. - (or def "") - str))))) - -(defun ivy-completing-read-with-empty-string-def - (prompt collection - &optional predicate require-match initial-input - history def inherit-input-method) - "Same as `ivy-completing-read' but with different handling of DEF. - -Specifically, if DEF is nil, it is treated the same as if DEF was -the empty string. This mimics the behavior of -`completing-read-default'. This function can therefore be used in -place of `ivy-completing-read' for commands that rely on this -behavior." - (ivy-completing-read - prompt collection predicate require-match initial-input - history (or def "") inherit-input-method)) - -(declare-function mc/all-fake-cursors "ext:multiple-cursors-core") - -;; Kludge: Try to retain original minibuffer completion data. -(defvar ivy--minibuffer-table) -(defvar ivy--minibuffer-pred) -(defvar ivy--minibuffer-try nil - "Store original `try-completion' result for sole completions.") - -(defun ivy-completion-in-region-action (str) - "Insert STR, erasing the previous one. -The previous string is between `ivy-completion-beg' and `ivy-completion-end'." - (when (consp str) - (setq str (cdr str))) - (when (stringp str) - (let ((fake-cursors (and (require 'multiple-cursors-core nil t) - (mc/all-fake-cursors))) - (pt (point)) - (beg ivy-completion-beg) - (end ivy-completion-end)) - (when beg - (delete-region beg end)) - (setq ivy-completion-beg (point)) - (insert (substring-no-properties str)) - (let ((minibuffer-completion-table (if (boundp 'ivy--minibuffer-table) - ivy--minibuffer-table - (ivy-state-collection ivy-last))) - (minibuffer-completion-predicate (if (boundp 'ivy--minibuffer-pred) - ivy--minibuffer-pred - (ivy-state-predicate ivy-last))) - (newstr (or (car-safe ivy--minibuffer-try) str))) - (completion--done newstr (cond ((eq ivy--minibuffer-try t) 'finished) - ((eq ivy-exit 'done) 'unknown) - ('exact)))) - (setq ivy-completion-end (point)) - (save-excursion - (dolist (cursor fake-cursors) - (goto-char (overlay-start cursor)) - (delete-region (+ (point) (- beg pt)) - (+ (point) (- end pt))) - (insert (substring-no-properties str)) - ;; manually move the fake cursor - (move-overlay cursor (point) (1+ (point))) - (set-marker (overlay-get cursor 'point) (point)) - (set-marker (overlay-get cursor 'mark) (point))))))) - -(defalias 'ivy--face-list-p - (if (fboundp 'face-list-p) - #'face-list-p - (lambda (face) - (and (listp face) - (listp (cdr face)) - (not (keywordp (car face)))))) - "Compatibility shim for Emacs 25 `face-list-p'.") - -;; FIXME: Should this return the smallest such index instead? -;; Usually the two are equal, but perhaps there exist more -;; exotic applications of `completions-first-difference'. -;; -;; Completing files under a directory foo/ can have a first difference at -;; index 0 in some Emacs versions, and no such property in other versions. -;; So perhaps this function should return 0 instead of (length str) when no -;; property is found? That still follows the 'largest index' definition. -(defun ivy-completion-common-length (str) - "Return the length of the completion-matching prefix of STR. - -That is, return the largest index into STR at which either the -`face' or `font-lock-face' property value contains the face -`completions-first-difference'. -If no such index is found, return the length of STR. - -Typically the completion-matching parts of STR have previously been -propertized by `completion-all-completions', but then the base-size -returned by that function should be preferred over -`ivy-completion-common-length'." - (declare (obsolete "it is no longer used." "0.15.1")) - (let* ((char-property-alias-alist '((face font-lock-face))) - (cmn (length str)) - (i cmn)) - (when (> i 0) - (while (if (let ((face (get-text-property (1- i) 'face str))) - (or (eq 'completions-first-difference face) - (and (ivy--face-list-p face) - (memq 'completions-first-difference face)))) - (ignore (setq cmn (1- i))) - (setq i (previous-single-property-change i 'face str))))) - cmn)) - -(defun ivy-completion-in-region (start end collection &optional predicate) - "An Ivy function suitable for `completion-in-region-function'. -The function completes the text between START and END using COLLECTION. -PREDICATE (a function called with no arguments) says when to exit. -See `completion-in-region' for further information." - (let* ((enable-recursive-minibuffers t) - (reg (- end start)) - (str (buffer-substring-no-properties start end)) - (completion-ignore-case (ivy--case-fold-p str)) - (md (completion-metadata str collection predicate)) - (try (completion-try-completion str collection predicate reg md)) - (comps (completion-all-completions str collection predicate reg md)) - (last (last comps)) - (base-size (or (cdr last) 0)) - (ivy--minibuffer-table collection) - (ivy--minibuffer-pred predicate)) - (when last (setcdr last ())) - ;; For no/sole match: - ;; give priority to boolean `try', falling back on `comps'. - (cond ((not (and try (or (eq try t) comps))) - (and (not completion-fail-discreetly) - completion-show-inline-help - (minibuffer-message "No matches")) - nil) - ((and try (or (eq try t) (equal (list str) comps))) - (goto-char end) - (let ((minibuffer-completion-table collection) - (minibuffer-completion-predicate predicate)) - (completion--done str 'finished "Sole match")) - t) - (t - (when (eq collection 'crm--collection-fn) - (setq comps (delete-dups comps))) - (let ((initial (substring str base-size)) - (base-pos (+ start base-size))) - (delete-region base-pos end) - (setq ivy-completion-beg base-pos) - (setq ivy-completion-end ivy-completion-beg) - (if (null (cdr comps)) - (let ((ivy--minibuffer-try try)) - (unless (minibuffer-window-active-p (selected-window)) - (setf (ivy-state-window ivy-last) (selected-window))) - (ivy-completion-in-region-action - (substring-no-properties (car comps)))) - (dolist (s comps) - ;; Remove face `completions-first-difference'. - (ivy--remove-props s 'face)) - (setq ivy--old-re nil) - (unless (ivy--filter initial comps) - (setq initial nil) - (setq predicate nil) - (setq collection comps)) - (unless (derived-mode-p #'emacs-lisp-mode) - (setq collection comps) - (setq predicate nil)) - (ivy-read (format "(%s): " str) collection - :predicate predicate - ;; FIXME: The anchor is intrusive and not easily - ;; configurable by `ivy-initial-inputs-alist' or - ;; `ivy-hooks-alist'. - :initial-input (concat - (and (derived-mode-p #'emacs-lisp-mode) - "^") - initial) - :action #'ivy-completion-in-region-action - :unwind (lambda () - (unless (eq ivy-exit 'done) - (goto-char ivy-completion-beg) - (when initial - (insert initial)))) - :caller 'ivy-completion-in-region))) - ;; Return value should be t on valid completion; - ;; see `completion-in-region'. - t)))) - -(defun ivy-completion-in-region-prompt () - "Prompt function for `ivy-completion-in-region'. -See `ivy-set-prompt'." - (and (window-minibuffer-p (ivy-state-window ivy-last)) - (ivy-add-prompt-count (ivy-state-prompt ivy-last)))) - -(ivy-set-prompt #'ivy-completion-in-region #'ivy-completion-in-region-prompt) - -(defcustom ivy-do-completion-in-region t - "When non-nil `ivy-mode' will set `completion-in-region-function'." - :type 'boolean) - -(defvar ivy--old-crf nil - "Store previous value of `completing-read-function'.") - -(defvar ivy--old-cirf nil - "Store previous value of `completion-in-region-function'.") - -;;;###autoload -(define-minor-mode ivy-mode - "Toggle Ivy mode on or off. -Turn Ivy mode on if ARG is positive, off otherwise. -Turning on Ivy mode sets `completing-read-function' to -`ivy-completing-read'. - -Global bindings: -\\{ivy-mode-map} - -Minibuffer bindings: -\\{ivy-minibuffer-map}" - :group 'ivy - :global t - :keymap ivy-mode-map - :lighter " ivy" - (if ivy-mode - (progn - (unless (eq completing-read-function #'ivy-completing-read) - (setq ivy--old-crf completing-read-function) - (setq completing-read-function #'ivy-completing-read)) - (when ivy-do-completion-in-region - (unless (eq completion-in-region-function #'ivy-completion-in-region) - (setq ivy--old-cirf completion-in-region-function) - (setq completion-in-region-function #'ivy-completion-in-region)))) - (when (eq completing-read-function #'ivy-completing-read) - (setq completing-read-function (or ivy--old-crf - #'completing-read-default)) - (setq ivy--old-crf nil)) - (when (eq completion-in-region-function #'ivy-completion-in-region) - (setq completion-in-region-function (or ivy--old-cirf - #'completion--in-region)) - (setq ivy--old-cirf nil)))) - -(defun ivy--preselect-index (preselect candidates) - "Return the index of PRESELECT in CANDIDATES." - (or (cond ((integerp preselect) - (if (integerp (car candidates)) - (cl-position preselect candidates) - preselect)) - ((cl-position preselect candidates :test #'equal)) - ((ivy--regex-p preselect) - (cl-position preselect candidates :test #'string-match-p))) - 0)) - -;;; Implementation -;;;; Regexp - -(defun ivy-re-match (re-seq str) - "Return non-nil if RE-SEQ is matched by STR. - -RE-SEQ is a list of (RE . MATCH-P). - -RE is a regular expression. - -MATCH-P is t when RE should match STR and nil when RE should not -match STR. - -Each element of RE-SEQ must match for the function to return true. - -This concept is used to generalize regular expressions for -`ivy--regex-plus' and `ivy--regex-ignore-order'." - (let ((res t)) - (while (let ((pair (pop re-seq))) - (and pair (setq res (xor (not (cdr pair)) - (string-match-p (car pair) str)))))) - res)) - -(defvar ivy--regex-hash - (make-hash-table :test #'equal) - "Store pre-computed regex.") - -(defvar ivy--input-garbage nil) - -(defun ivy--split (str) - "Split STR into list of substrings bounded by spaces. -Single spaces act as splitting points. Consecutive spaces -\"quote\" their preceding spaces, i.e., guard them from being -split. This allows the literal interpretation of N spaces by -inputting N+1 spaces. Any substring not constituting a valid -regexp is passed to `regexp-quote'." - (let ((len (length str)) - (i 0) - (start 0) - (res nil) - match-len - end - c) - (catch 'break - (while (< i len) - (setq c (aref str i)) - (cond ((= ?\[ c) - (if (setq end (ivy--match-regex-brackets - (substring str i))) - (cl-incf i end) - (setq ivy--input-garbage (substring str i)) - (throw 'break nil))) - ((= ?\\ c) - (if (and (< (1+ i) len) (= ?\( (aref str (1+ i)))) - (progn - (when (> i start) - (push (substring str start i) res)) - (if (eq (string-match "\\\\([^\0]*?\\\\)" str i) i) - (progn - (push (match-string 0 str) res) - (setq i (match-end 0)) - (setq start i)) - (setq ivy--input-garbage (substring str i)) - (throw 'break nil))) - (cl-incf i))) - ((= ?\s c) - (string-match " +" str i) - (setq match-len (- (match-end 0) (match-beginning 0))) - (if (= match-len 1) - (progn - (when (> i start) - (push (substring str start i) res)) - (setq start (1+ i))) - (setq str (replace-match - (make-string (1- match-len) ?\s) - nil nil str)) - (setq len (length str)) - (cl-incf i (1- match-len))) - (cl-incf i)) - (t - (cl-incf i))))) - (when (< start i) - (push (substring str start) res)) - (mapcar #'ivy--regex-or-literal (nreverse res)))) - -(defun ivy--match-regex-brackets (str) - (let ((len (length str)) - (i 1) - (open-count 1) - c) - (while (and (< i len) - (> open-count 0)) - (setq c (aref str i)) - (cond ((= c ?\[) - (cl-incf open-count)) - ((= c ?\]) - (cl-decf open-count))) - (cl-incf i)) - (when (= open-count 0) - (if (eq (string-match "[+*?]" str i) i) - (match-end 0) - i)))) - -(defun ivy--trim-trailing-re (regex) - "Trim incomplete REGEX. -If REGEX ends with \\|, trim it, since then it matches an empty string." - (if (string-match "\\`\\(.*\\)[\\]|\\'" regex) - (match-string 1 regex) - regex)) - -(defun ivy--regex (str &optional greedy) - "Re-build regex pattern from STR in case it has a space. -When GREEDY is non-nil, join words in a greedy way." - (let ((hashed (unless greedy - (gethash str ivy--regex-hash)))) - (if hashed - (progn - (setq ivy--subexps (car hashed)) - (cdr hashed)) - (when (string-match-p "\\(?:[^\\]\\|^\\)\\\\\\'" str) - (setq str (substring str 0 -1))) - (setq str (ivy--trim-trailing-re str)) - (cdr (puthash str - (let ((subs (ivy--split str))) - (if (= (length subs) 1) - (cons - (setq ivy--subexps 0) - (if (string-match-p "\\`\\.[^.]" (car subs)) - (concat "\\." (substring (car subs) 1)) - (car subs))) - (cons - (setq ivy--subexps (length subs)) - (replace-regexp-in-string - "\\.\\*\\??\\\\( " - "\\( " - (mapconcat - (lambda (x) - (if (string-match-p "\\`\\\\([^?][^\0]*\\\\)\\'" x) - x - (format "\\(%s\\)" x))) - subs - (if greedy ".*" ".*?")) - t t)))) - ivy--regex-hash))))) - -(defun ivy--regex-p (object) - "Return OBJECT if it is a valid regular expression, else nil." - (ignore-errors (ignore (string-match-p object "")) object)) - -(defun ivy--regex-or-literal (str) - "If STR isn't a legal regexp, escape it." - (or (ivy--regex-p str) (regexp-quote str))) - -(defun ivy--split-negation (str) - "Split STR into text before and after ! delimiter. -Do not split if the delimiter is escaped as \\!. - -Assumes there is at most one un-escaped delimiter and discards -text after delimiter if it is empty. Modifies match data." - (unless (string= str "") - (mapcar (lambda (split) - ;; Store "\!" as "!". - (ivy--string-replace "\\!" "!" split)) - (let ((delim "\\(?:\\`\\|[^\\]\\)\\(!\\)")) - (if (string-match delim str) - ;; Ignore everything past first un-escaped ! rather than - ;; crashing. We can't warn or error because the minibuffer is - ;; already active. - (let* ((i (match-beginning 1)) - (j (and (string-match delim str (1+ i)) - (match-beginning 1))) - (neg (substring str (1+ i) j))) - (cons (substring str 0 i) - (and (not (string= neg "")) - (list neg)))) - (list str)))))) - -(defun ivy--split-spaces (str) - "Split STR on spaces, unless they're preceded by \\. -No un-escaped spaces are left in the output. Any substring not -constituting a valid regexp is passed to `regexp-quote'." - (when str - (let ((i 0) ; End of last search. - (j 0) ; End of last delimiter. - parts) - (while (string-match "\\(\\\\ \\)\\| +" str i) - (setq i (match-end 0)) - (if (not (match-beginning 1)) - ;; Un-escaped space(s). - (let ((delim (match-beginning 0))) - (when (< j delim) - (push (substring str j delim) parts)) - (setq j i)) - ;; Store "\ " as " ". - (setq str (replace-match " " t t str 1)) - (setq i (1- i)))) - (when (< j (length str)) - (push (substring str j) parts)) - (mapcar #'ivy--regex-or-literal (nreverse parts))))) - -(defun ivy--regex-ignore-order (str) - "Re-build regex from STR by splitting at spaces and using ! for negation. - -Examples: -foo -> matches \"foo\" -foo bar -> matches if both \"foo\" and \"bar\" match (any order) -foo !bar -> matches if \"foo\" matches and \"bar\" does not match -foo !bar baz -> matches if \"foo\" matches and neither \"bar\" nor \"baz\" match -foo[a-z] -> matches \"foo[a-z]\" - -Escaping examples: -foo\\!bar -> matches \"foo!bar\" -foo\\ bar -> matches \"foo bar\" - -Returns a list suitable for `ivy-re-match'." - (setq str (ivy--trim-trailing-re str)) - (let* (regex-parts - (raw-parts (ivy--split-negation str))) - (dolist (part (ivy--split-spaces (car raw-parts))) - (push (cons part t) regex-parts)) - (when (cdr raw-parts) - (dolist (part (ivy--split-spaces (cadr raw-parts))) - (push (cons part nil) regex-parts))) - (if regex-parts (nreverse regex-parts) - ""))) - -(defun ivy--regex-plus (str) - "Build a regex sequence from STR. -Spaces are wild card characters, everything before \"!\" should -match. Everything after \"!\" should not match." - (let ((parts (ivy--split-negation str))) - (cl-case (length parts) - (0 - "") - (1 - (if (= (aref str 0) ?!) - (list (cons "" t) - (list (ivy--regex (car parts)))) - (ivy--regex (car parts)))) - (2 - (cons - (cons (ivy--regex (car parts)) t) - (mapcar #'list (split-string (cadr parts) " " t)))) - (t (error "Unexpected: use only one !"))))) - -(defun ivy--regex-fuzzy (str) - "Build a regex sequence from STR. -Insert .* between each char." - (setq str (ivy--trim-trailing-re str)) - (if (string-match "\\`\\(\\^?\\)\\(.*?\\)\\(\\$?\\)\\'" str) - (prog1 - (concat (match-string 1 str) - (let ((lst (string-to-list (match-string 2 str)))) - (apply #'concat - (cl-mapcar - #'concat - (cons "" (cdr (mapcar (lambda (c) (format "[^%c\n]*" c)) - lst))) - (mapcar (lambda (x) (format "\\(%s\\)" (regexp-quote (char-to-string x)))) - lst)))) - (match-string 3 str)) - (setq ivy--subexps (length (match-string 2 str)))) - str)) - -(defcustom ivy-fixed-height-minibuffer nil - "When non nil, fix the height of the minibuffer during ivy completion. -This effectively sets the minimum height at this level to `ivy-height' and -tries to ensure that it does not change depending on the number of candidates." - :type 'boolean) - -;;;; Rest - -(defcustom ivy-truncate-lines t - "Minibuffer setting for `truncate-lines'." - :type 'boolean) - -(defun ivy--minibuffer-setup () - "Setup ivy completion in the minibuffer." - ;; Guard for --without-x builds where `mwheel' is not preloaded. - (when (boundp 'mwheel-scroll-up-function) - (setq-local mwheel-scroll-up-function 'ivy-next-line)) - (when (boundp 'mwheel-scroll-down-function) - (setq-local mwheel-scroll-down-function 'ivy-previous-line)) - (setq-local completion-show-inline-help nil) - (setq-local line-spacing nil) - (setq-local minibuffer-default-add-function - (lambda () - (list ivy--default))) - (setq-local inhibit-field-text-motion nil) - (setq truncate-lines ivy-truncate-lines) - (setq-local max-mini-window-height ivy-height) - (let ((height (cond ((and ivy-fixed-height-minibuffer - (not (eq (ivy-state-caller ivy-last) - #'ivy-completion-in-region))) - (+ ivy-height (if ivy-add-newline-after-prompt 1 0))) - (ivy-add-newline-after-prompt 2)))) - (when height - (set-window-text-height nil height))) - (add-hook 'post-command-hook #'ivy--queue-exhibit nil t) - (add-hook 'window-size-change-functions #'ivy--window-size-changed nil t) - (let ((hook (ivy-alist-setting ivy-hooks-alist))) - (when (functionp hook) - (funcall hook)))) - -(defun ivy--input () - "Return the current minibuffer input." - ;; assume one-line minibuffer input - (save-excursion - (goto-char (minibuffer-prompt-end)) - (let ((inhibit-field-text-motion t)) - (buffer-substring-no-properties - (point) - (line-end-position))))) - -(defun ivy--minibuffer-cleanup () - "Delete the displayed completion candidates." - (save-excursion - (goto-char (minibuffer-prompt-end)) - (delete-region (line-end-position) (point-max)))) - -(defun ivy-cleanup-string (str) - "Destructively remove unwanted text properties from STR." - (ivy--remove-props str 'field)) - -(defvar ivy-set-prompt-text-properties-function - #'ivy-set-prompt-text-properties-default - "Function to set the text properties of the default ivy prompt. -Called with two arguments, PROMPT and PROPS, where PROMPT is the -string to be propertized and PROPS is a plist of default text -properties that may be applied to PROMPT. The function should -return the propertized PROMPT, which may be modified in-place.") - -(defun ivy-set-prompt-text-properties-default (prompt props) - "Propertize (confirm) and (match required) parts of PROMPT. -PROPS is a plist of default text properties to apply to these -parts beyond their respective faces `ivy-confirm-face' and -`ivy-match-required-face'." - (dolist (pair '(("confirm" . ivy-confirm-face) - ("match required" . ivy-match-required-face))) - (let* ((beg (ivy--string-search (car pair) prompt)) - (end (and beg (+ beg (length (car pair)))))) - (when beg - (add-face-text-property beg end (cdr pair) nil prompt) - (add-text-properties beg end props prompt)))) - prompt) - -(defun ivy-prompt () - "Return the current prompt." - (let* ((caller (ivy-state-caller ivy-last)) - (fn (plist-get ivy--prompts-list caller))) - (if fn - (condition-case err - (funcall fn) - (wrong-number-of-arguments - (lwarn 'ivy :error "%s - Prompt function set via `ivy-set-prompt' for caller `%s' - should take no arguments." - (error-message-string err) - caller) - ;; Old behavior. - (funcall fn (ivy-state-prompt ivy-last)))) - ivy--prompt))) - -(defun ivy--break-lines (str width) - "Break each line in STR with newlines to fit into WIDTH columns." - (if (<= width 0) - str - (let (lines) - (dolist (line (split-string str "\n")) - (while (and line (> (string-width line) width)) - (let ((prefix "") (extra 0)) - (while (string-empty-p prefix) - ;; Grow `width' until it fits at least one char from `line'. - (setq prefix (truncate-string-to-width line (+ width extra))) - (setq extra (1+ extra))) - ;; Avoid introducing spurious newline if `prefix' and `line' are - ;; equal, i.e., if `line' couldn't be truncated to `width'. - (setq line (and (> (length line) (length prefix)) - (substring line (length prefix)))) - (push prefix lines))) - (when line (push line lines))) - (string-join (nreverse lines) "\n")))) - -(defun ivy--propertize-prompt (prompt) - "Propertize PROMPT like `read-from-minibuffer' would. -Also handle `ivy-set-prompt-text-properties-function'." - (let ((len (length prompt)) - ;; Added unconditionally by `read-from-minibuffer'. - (props (list 'front-sticky t 'rear-nonsticky t 'field t)) - ;; Configurable. - (extras minibuffer-prompt-properties)) - ;; Filter out `face'; it is documented as being appended instead, and was - ;; historically excluded from `ivy-set-prompt-text-properties-function'. - (while extras - (let ((key (pop extras)) - (val (pop extras))) - (if (eq key 'face) - (add-face-text-property 0 len val t prompt) - (setq props (plist-put props key val))))) - (add-text-properties 0 len props prompt) - (funcall ivy-set-prompt-text-properties-function prompt props))) - -(defun ivy--insert-prompt () - "Update the prompt according to `ivy--prompt'." - (when (setq ivy--prompt (ivy-prompt)) - (unless (memq this-command '(ivy-done ivy-alt-done ivy-partial-or-done - counsel-find-symbol)) - (setq ivy--prompt-extra "")) - (let (head tail) - (if (string-match "\\(.*?\\)\\(:? ?\\)\\'" ivy--prompt) - (progn - (setq head (match-string 1 ivy--prompt)) - (setq tail (match-string 2 ivy--prompt))) - (setq head ivy--prompt) - (setq tail "")) - (let ((inhibit-read-only t) - (n-str - (concat - (and (bound-and-true-p minibuffer-depth-indicate-mode) - (> (minibuffer-depth) 1) - (format "[%d] " (minibuffer-depth))) - (let ((count (or (and (ivy-state-dynamic-collection ivy-last) - ivy--full-length) - ivy--length))) - (if (string-match-p "%d.*%d" ivy-count-format) - (format head (min (1+ ivy--index) count) count) - (format head count))) - ivy--prompt-extra - tail)) - (d-str (if ivy--directory - (abbreviate-file-name ivy--directory) - ""))) - (save-excursion - (goto-char (point-min)) - (delete-region (point-min) (minibuffer-prompt-end)) - (let ((wid-n (string-width n-str)) - (wid-d (string-width d-str)) - (ww (window-width))) - (setq n-str - (cond ((> (+ wid-n wid-d) ww) - (concat n-str "\n" d-str "\n")) - ((> (+ wid-n wid-d (string-width ivy-text)) ww) - (concat n-str d-str "\n")) - (t - (concat n-str d-str))))) - (when ivy-pre-prompt-function - (setq n-str (concat (funcall ivy-pre-prompt-function) n-str))) - (when ivy-add-newline-after-prompt - (setq n-str (concat n-str "\n"))) - (setq n-str (ivy--break-lines n-str (window-width))) - (insert (ivy--propertize-prompt n-str))) - ;; Mark prompt as selected if the user moves there or it is the only - ;; option left. Since the user input stays put, we have to manually - ;; remove the face as well. - (when ivy--use-selectable-prompt - (if (= ivy--index -1) - (add-face-text-property - (minibuffer-prompt-end) (line-end-position) 'ivy-prompt-match) - (remove-list-of-text-properties - (minibuffer-prompt-end) (line-end-position) '(face)))) - ;; get out of the prompt area - (constrain-to-field nil (point-max)))))) - -(defun ivy--sort-maybe (collection) - "Sort COLLECTION if needed." - (let ((sort (ivy-state-sort ivy-last))) - (if (and sort - (or (functionp sort) - (functionp (setq sort (ivy--sort-function - (ivy-state-collection ivy-last)))))) - (sort (copy-sequence collection) sort) - collection))) - -(defcustom ivy-magic-slash-non-match-action - 'ivy-magic-slash-non-match-cd-selected - "Action to take when a slash is appended to a nonexistent directory. -Possible choices are `ivy-magic-slash-non-match-cd-selected', -`ivy-magic-slash-non-match-create', or nil" - :type '(choice - (const :tag "Use currently selected directory" - ivy-magic-slash-non-match-cd-selected) - (const :tag "Create and use new directory" - ivy-magic-slash-non-match-create) - (const :tag "Do nothing" - nil))) - -(defun ivy--create-and-cd (dir) - "When completing file names, create directory DIR and move there." - (make-directory dir) - (ivy--cd dir)) - -(defun ivy--magic-file-doubleslash-directory () - "Return an appropriate directory for when two slashes are entered." - (let (remote) - (cond - ;; Windows - ;; ((string-match "\\`[[:alpha:]]:/" ivy--directory) - ;; (match-string 0 ivy--directory)) - ;; Remote root if on remote - ((setq remote (file-remote-p ivy--directory)) - (concat remote "/")) - ;; Local root - (t - "/")))) - -(defun ivy--magic-file-slash () - "Handle slash when completing file names." - (when (or (and (eq this-command #'self-insert-command) - (eolp)) - (eq this-command #'ivy-partial-or-done)) - (let ((canonical (expand-file-name ivy-text ivy--directory)) - (magic (not (string= ivy-text "/")))) - (cond ((member ivy-text ivy--all-candidates) - (ivy--cd canonical)) - ((and (eq system-type 'windows-nt) (string= ivy-text "//"))) - ((string-suffix-p "//" ivy-text) - (ivy--cd - (ivy--magic-file-doubleslash-directory))) - ((string-prefix-p "/ssh:" ivy-text) - (ivy--cd (file-name-directory ivy-text))) - ((string-match "[[:alpha:]]:/\\'" ivy-text) - (let ((drive-root (match-string 0 ivy-text))) - (when (file-exists-p drive-root) - (ivy--cd drive-root)))) - ((and magic (file-directory-p canonical)) - (ivy--cd canonical)) - ((let ((default-directory ivy--directory)) - (and (or (> ivy--index 0) - (= ivy--length 1) - magic) - (not (ivy--prompt-selected-p)) - (not (equal (ivy-state-current ivy-last) "")) - (file-directory-p (ivy-state-current ivy-last)) - (or (eq ivy-magic-slash-non-match-action - 'ivy-magic-slash-non-match-cd-selected) - (eq this-command #'ivy-partial-or-done)))) - (ivy--cd - (expand-file-name (ivy-state-current ivy-last) ivy--directory))) - ((and (eq ivy-magic-slash-non-match-action - 'ivy-magic-slash-non-match-create) - magic) - (ivy--create-and-cd canonical)))))) - -(defun ivy-magic-read-file-env () - "If reading filename, jump to environment variable location." - (interactive) - (if (and ivy--directory - (equal ivy-text "")) - (let* ((cands (cl-loop for pair in process-environment - for (var val) = (split-string pair "=" t) - if (and val (not (equal "" val))) - if (file-exists-p - (if (file-name-absolute-p val) - val - (setq val - (expand-file-name val ivy--directory)))) - collect (cons var val))) - (enable-recursive-minibuffers t) - (x (ivy-read "Env: " cands)) - (path (cdr (assoc x cands)))) - (insert (if (file-accessible-directory-p path) - (file-name-as-directory path) - path)) - (ivy--cd-maybe)) - (insert last-input-event))) - -(defun ivy-make-magic-action (caller key) - "Return a command that does the equivalent of `ivy-read-action' and KEY. -This happens only when the input is empty. -The intention is to bind the result to keys that are typically -bound to `self-insert-command'." - (let* ((alist (assoc key - (plist-get - ivy--actions-list - caller))) - (doc (format "%s (`%S')" - (nth 2 alist) - (nth 1 alist)))) - `(lambda (&optional arg) - ,doc - (interactive "p") - (if (string= "" ivy-text) - (execute-kbd-macro - (kbd ,(concat "M-o " key))) - (self-insert-command arg))))) - -(defcustom ivy-magic-tilde t - "When non-nil, ~ will move home when selecting files. -Otherwise, ~/ will move home." - :type 'boolean) - -(defcustom ivy-dynamic-exhibit-delay-ms 0 - "Delay in milliseconds before dynamic collections are refreshed." - :type 'integer) - -(defvar ivy--exhibit-timer nil - "Timer for debouncing calls to `ivy--exhibit'.") - -(defvar ivy--queue-last-input nil - "Value of `ivy--input' from last `post-command-hook'.") - -(defun ivy--queue-exhibit () - "Refresh Ivy completions display, with debouncing. -This is like `ivy--exhibit', but dynamic collections are delayed by -`ivy-dynamic-exhibit-delay-ms' to avoid issues with rapid refreshes. -Should be run via minibuffer `post-command-hook'." - (if (or (<= ivy-dynamic-exhibit-delay-ms 0) - (not (ivy-state-dynamic-collection ivy-last)) - (equal ivy--queue-last-input - (setq ivy--queue-last-input (ivy--input)))) - (ivy--exhibit) - (when ivy--exhibit-timer (cancel-timer ivy--exhibit-timer)) - (setq ivy--exhibit-timer - (run-with-timer (/ ivy-dynamic-exhibit-delay-ms 1000.0) - nil #'ivy--exhibit)))) - -(defalias 'ivy--file-local-name - (if (fboundp 'file-local-name) - #'file-local-name - (lambda (file) - (or (file-remote-p file 'localname) file))) - "Compatibility shim for `file-local-name'. -The function was added in Emacs 26.1.") - -(defun ivy--magic-tilde-directory (dir) - "Return an appropriate home for DIR for when ~ or ~/ are entered." - (file-name-as-directory - (expand-file-name - (let* ((home (expand-file-name (concat (file-remote-p dir) "~/"))) - (dir-path (ivy--file-local-name dir)) - (home-path (ivy--file-local-name home))) - (if (string= dir-path home-path) - "~" - home))))) - -(defun ivy-update-candidates (cands) - (ivy--insert-minibuffer - (ivy--format - (setq ivy--all-candidates cands)))) - -(defun ivy--exhibit () - "Insert Ivy completions display. -Should be run in the minibuffer." - (when (memq #'ivy--queue-exhibit post-command-hook) - (let ((inhibit-field-text-motion nil)) - (constrain-to-field nil (point-max))) - (ivy-set-text (ivy--input)) - (let ((new-minibuffer (ivy--update-minibuffer))) - (when new-minibuffer - (ivy--insert-minibuffer new-minibuffer))) - t)) - -(defun ivy--dynamic-collection-cands (input) - (let ((coll (condition-case nil - (funcall (ivy-state-collection ivy-last) input) - (error - (funcall (ivy-state-collection ivy-last) input nil t))))) - (if (listp coll) - (mapcar (lambda (x) (if (consp x) (car x) x)) coll) - coll))) - -(defun ivy--update-minibuffer () - (prog1 - (if (ivy-state-dynamic-collection ivy-last) - ;; while-no-input would cause annoying - ;; "Waiting for process to die...done" message interruptions - (let ((inhibit-message t) - coll in-progress) - (unless (or (equal ivy--old-text ivy-text) - (eq this-command 'ivy-resume)) - (while-no-input - (setq coll (ivy--dynamic-collection-cands ivy-text)) - (when (eq coll 0) - (setq coll nil) - (setq ivy--old-re nil) - (setq in-progress t)) - (setq ivy--all-candidates (ivy--sort-maybe coll)))) - (when (eq ivy--all-candidates 0) - (setq ivy--all-candidates nil) - (setq ivy--old-re nil) - (setq in-progress t)) - (when (or ivy--all-candidates - (not (or (get-process " *counsel*") - in-progress))) - (ivy--set-index-dynamic-collection) - (ivy--format ivy--all-candidates))) - (cond (ivy--directory - (cond ((or (string= "~/" ivy-text) - (and (string= "~" ivy-text) - ivy-magic-tilde)) - (ivy--cd (ivy--magic-tilde-directory ivy--directory))) - ((string-suffix-p "/" ivy-text) - (ivy--magic-file-slash)))) - ((eq (ivy-state-collection ivy-last) #'internal-complete-buffer) - (let ((spaced (= (string-to-char ivy-text) ?\s))) - (when (xor spaced (= (string-to-char ivy--old-text) ?\s)) - (setq ivy--all-candidates - (if spaced - (ivy--buffer-list " ") - (ivy--buffer-list "" ivy-use-virtual-buffers))) - (setq ivy--old-re nil))))) - (with-current-buffer (ivy-state-buffer ivy-last) - (ivy--format - (ivy--filter ivy-text ivy--all-candidates)))) - (setq ivy--old-text ivy-text))) - -(defun ivy-display-function-fallback (str) - (let ((buffer-undo-list t)) - (save-excursion - (forward-line 1) - (insert str)))) - -(defun ivy--insert-minibuffer (text) - "Insert TEXT into minibuffer with appropriate cleanup." - (let ((resize-mini-windows nil) - (update-fn (ivy-state-update-fn ivy-last)) - (old-mark (marker-position (mark-marker))) - (win (active-minibuffer-window)) - deactivate-mark) - (when win - (with-selected-window win - (ivy--minibuffer-cleanup) - (when update-fn - (funcall update-fn)) - (ivy--insert-prompt) - ;; Do nothing if while-no-input was aborted. - (when (stringp text) - (if ivy--display-function - (funcall ivy--display-function text) - (ivy-display-function-fallback text))) - (ivy--resize-minibuffer-to-fit) - ;; prevent region growing due to text remove/add - (when (region-active-p) - (set-mark old-mark)))))) - -(defvar ivy-auto-shrink-minibuffer nil - "When non-nil and the height < `ivy-height', auto-shrink the minibuffer.") - -(make-obsolete-variable 'ivy-auto-shrink-minibuffer - 'ivy-auto-shrink-minibuffer-alist - "0.13.2 (2020-04-28)") - -(defcustom ivy-auto-shrink-minibuffer-alist nil - "An alist to configure auto-shrinking of the minibuffer. - -Each key is a caller symbol. When the value is non-nil, and the -height < `ivy-height', auto-shrink the minibuffer." - :type '(alist - :key-type symbol - :value-type boolean)) - -(defun ivy--do-shrink-window () - (let ((h (save-excursion - (goto-char (minibuffer-prompt-end)) - (let ((inhibit-field-text-motion t)) - (line-number-at-pos))))) - (shrink-window (- - (/ (window-body-height nil t) - (frame-char-height)) - ivy--length h)))) - -(defun ivy--resize-minibuffer-to-fit () - "Resize the minibuffer window size to fit the text in the minibuffer." - (unless (or (frame-root-window-p (minibuffer-window)) - (memq this-command '(ivy-read-action - ivy-dispatching-done - ivy-dispatching-call))) - (with-selected-window (minibuffer-window) - (if (fboundp 'window-text-pixel-size) - (let ((text-height (cdr (window-text-pixel-size))) - (body-height (window-body-height nil t))) - (cond ((> text-height body-height) - ;; Note: the size increment needs to be at least - ;; frame-char-height, otherwise resizing won't do - ;; anything. - (let ((delta (max (- text-height body-height) - (frame-char-height)))) - (window-resize nil delta nil t t))) - ((and (or ivy-auto-shrink-minibuffer - (ivy-alist-setting - ivy-auto-shrink-minibuffer-alist)) - (< ivy--length ivy-height)) - (ivy--do-shrink-window)))) - (let ((text-height (count-screen-lines)) - (body-height (window-body-height))) - (when (> text-height body-height) - (window-resize nil (- text-height body-height) nil t))))))) - -(defun ivy--window-size-changed (&rest _) - "Resize ivy window to fit with current frame's size." - (when ivy-mode - (ivy--resize-minibuffer-to-fit))) - -(defun ivy--add-face (str face) - "Propertize STR with FACE." - (let ((len (length str))) - (condition-case nil - (progn - (colir-blend-face-background 0 len face str) - (let ((foreground (face-foreground face))) - (when foreground - (add-face-text-property - 0 len (list :foreground foreground) nil str)))) - (error - (ignore-errors - (font-lock-append-text-property 0 len 'face face str))))) - str) - -(declare-function flx-make-string-cache "ext:flx") -(declare-function flx-score "ext:flx") - -(defvar ivy--flx-cache nil) - -(with-eval-after-load 'flx - (setq ivy--flx-cache (flx-make-string-cache))) - -(defun ivy-toggle-case-fold () - "Toggle `case-fold-search' for Ivy operations. - -Instead of modifying `case-fold-search' directly, this command -toggles `ivy-case-fold-search', which can take on more values -than the former, between nil and either `auto' or t. See -`ivy-case-fold-search-default' for the meaning of these values. - -In any Ivy completion session, the case folding starts with -`ivy-case-fold-search-default'." - (interactive) - (setq ivy-case-fold-search - (and (not ivy-case-fold-search) - (or ivy-case-fold-search-default 'auto))) - ;; Reset cache so that the candidate list updates. - (setq ivy--old-re nil)) - -(defun ivy--re-filter (filter candidates &optional mkpred) - "Return all CANDIDATES matching FILTER, or nil on error. -FILTER is either a string or a list of (REGEXP . BOOLEAN). -The result includes those CANDIDATES which are matched by each REGEXP -whose BOOLEAN is non-nil, and not matched by any other REGEXP. -A string FILTER is equivalent to ((FILTER . t)). - -If MKPRED is non-nil, it is a function to be called on each REGEXP, -returning a unary predicate for filtering CANDIDATES which overrides -this function's default regexp matching behavior." - (if (member filter '("" ())) - candidates - (setq candidates (copy-sequence candidates)) - ;; Return nil (not candidates) on error, e.g., when we try to filter - ;; `swiper-isearch' numeric candidates with `string-match-p'. - (ignore-errors - (dolist (matcher (if (stringp filter) (list (cons filter t)) filter)) - (let* ((re (car matcher)) - (pred - (if mkpred - (funcall mkpred re) - (lambda (x) (string-match-p re x))))) - (setq candidates - (cl-delete nil candidates - (if (cdr matcher) :if-not :if) - pred)))) - candidates))) - -(defun ivy--filter (name candidates) - "Return all items that match NAME in CANDIDATES. -CANDIDATES are assumed to be static." - (let ((re (funcall ivy--regex-function name))) - (if (and - ivy--old-re - ivy--old-cands - (equal re ivy--old-re)) - ;; quick caching for "C-n", "C-p" etc. - ivy--old-cands - (let* ((re-str (ivy-re-to-str re)) - (matcher (ivy-state-matcher ivy-last)) - (case-fold-search (ivy--case-fold-p name)) - (cands (cond - (matcher - (funcall matcher re candidates)) - ((and ivy--old-re - (stringp re) - (stringp ivy--old-re) - (not (ivy--string-search "\\" ivy--old-re)) - (not (equal ivy--old-re "")) - (memq (ivy--string-search - (string-remove-suffix "\\)" ivy--old-re) - re) - '(0 2)) - ivy--old-cands - (ivy--re-filter re ivy--old-cands))) - (t - (ivy--re-filter re candidates))))) - (if (memq (cdr (assq (ivy-state-caller ivy-last) - ivy-index-functions-alist)) - '(ivy-recompute-index-swiper - ivy-recompute-index-swiper-async - ivy-recompute-index-swiper-async-backward - ivy-recompute-index-swiper-backward)) - (progn - (ivy--recompute-index re-str cands) - (setq ivy--old-cands (ivy--sort name cands))) - (setq ivy--old-cands (ivy--sort name cands)) - (ivy--recompute-index re-str ivy--old-cands)) - (setq ivy--old-re re) - ivy--old-cands)))) - -(defun ivy--set-candidates (x) - "Update `ivy--all-candidates' with X." - (let (res - ;; (ivy--recompute-index-inhibit t) - ) - (dolist (source ivy--extra-candidates) - (if (equal source '(original-source)) - (if (null res) - (setq res x) - (setq res (append x res))) - (setq ivy--old-re nil) - (setq res (append - (ivy--filter ivy-text (cadr source)) - res)))) - (setq ivy--all-candidates - (if (cdr ivy--extra-candidates) - (delete-dups res) - res)))) - -(eval-and-compile - (defconst ivy--new-sort-p - (condition-case nil - (with-no-warnings (sort [])) - (wrong-number-of-arguments)) - "Whether Emacs 30 `sort' calling convention is available.")) - -(defun ivy--shorter-matches-first (_name cands) - "Sort CANDS according to their length." - (if (nthcdr ivy-sort-max-size cands) - cands - (static-if (bound-and-true-p ivy--new-sort-p) - (sort cands :key #'length) - (cl-sort (copy-sequence cands) #'< :key #'length)))) - -(defcustom ivy-sort-matches-functions-alist - '((t . nil) - (ivy-completion-in-region . ivy--shorter-matches-first) - (ivy-switch-buffer . ivy-sort-function-buffer)) - "An alist of functions for sorting matching candidates. - -Unlike `ivy-sort-functions-alist', which is used to sort the -whole collection only once, this alist of functions are used to -sort only matching candidates after each change in input. - -The alist KEY is either a collection function or t to match -previously unmatched collection functions. - -The alist VAL is a sorting function with the signature of -`ivy--prefix-sort'." - :type '(alist - :key-type (choice - (const :tag "Fall-through" t) - (symbol :tag "Collection")) - :value-type - (choice - (const :tag "Don't sort" nil) - (const :tag "Put prefix matches ahead" ivy--prefix-sort) - (function :tag "Custom sort function")))) - -(defun ivy--sort-files-by-date (_name candidates) - "Re-sort CANDIDATES according to file modification date." - (let ((default-directory ivy--directory)) - (sort (copy-sequence candidates) #'file-newer-than-file-p))) - -(defvar ivy--flx-available-p) -(defun ivy--flx-available-p () - "Try to load package `flx' once; return non-nil on success." - (if (boundp 'ivy--flx-available-p) - ivy--flx-available-p - (setq ivy--flx-available-p (require 'flx nil t)))) - -(defun ivy--sort (name candidates) - "Re-sort candidates by NAME. -All CANDIDATES are assumed to match NAME." - (let (fun) - (cond ((setq fun (ivy-alist-setting ivy-sort-matches-functions-alist)) - (funcall fun name candidates)) - ((and (eq ivy--regex-function #'ivy--regex-fuzzy) - (ivy--flx-available-p)) - (ivy--flx-sort name candidates)) - (t - candidates)))) - -(defun ivy--prefix-sort (name candidates) - "Re-sort candidates by NAME. -All CANDIDATES are assumed to match NAME. -Prefix matches to NAME are put ahead of the list." - (if (or (string= name "") - (= (aref name 0) ?^)) - candidates - (let ((re-prefix (concat "\\`" (funcall ivy--regex-function name))) - res-prefix - res-noprefix) - (dolist (s candidates) - (push s (if (string-match-p re-prefix s) - res-prefix - res-noprefix))) - (nconc - (nreverse res-prefix) - (nreverse res-noprefix))))) - -(defvar ivy--virtual-buffers nil - "Store the virtual buffers alist.") - -(defun ivy-re-to-str (re) - "Transform RE to a string. - -Functions like `ivy--regex-ignore-order' return a cons list. -This function extracts a string from the cons list." - (if (consp re) (caar re) re)) - -(defun ivy-sort-function-buffer (name candidates) - "Re-sort candidates by NAME. -CANDIDATES is a list of buffer names each containing NAME. -Sort open buffers before virtual buffers, and prefix matches -before substring matches." - (if (or (string= name "") - (= (aref name 0) ?^)) - candidates - (let* ((base-re (ivy-re-to-str (funcall ivy--regex-function name))) - (re-prefix (concat "\\`\\*?" base-re)) - res-prefix - res-noprefix - res-virtual-prefix - res-virtual-noprefix) - (dolist (s candidates) - (let ((virtual (assoc s ivy--virtual-buffers)) - (prefixed (string-match-p re-prefix s))) - (push s (cond ((and virtual prefixed) res-virtual-prefix) - (virtual res-virtual-noprefix) - (prefixed res-prefix) - (t res-noprefix))))) - (nconc - (nreverse res-prefix) - (nreverse res-noprefix) - (nreverse res-virtual-prefix) - (nreverse res-virtual-noprefix))))) - -(defvar ivy-flx-limit 200 - "Used to conditionally turn off flx sorting. - -When the amount of matching candidates exceeds this limit, then -no sorting is done.") - -(defvar ivy--recompute-index-inhibit nil - "When non-nil, `ivy--recompute-index' is a no-op.") - -(defun ivy--recompute-index (re-str cands) - "Recompute index of selected candidate matching RE-STR. -CANDS are the current candidates." - (let ((caller (ivy-state-caller ivy-last)) - (func (or (ivy-alist-setting ivy-index-functions-alist) - #'ivy-recompute-index-zero)) - (case-fold-search (ivy--case-fold-p re-str)) - (preselect (ivy-state-preselect ivy-last)) - (current (ivy-state-current ivy-last)) - (empty (string= re-str ""))) - (unless (or (memq this-command '(ivy-resume ivy-partial-or-done)) - ivy--recompute-index-inhibit) - (let ((index (cond - ((or empty (string= re-str "^")) - (ivy--preselect-index preselect cands)) - ((and (> (length cands) 10000) (eq func #'ivy-recompute-index-zero)) - 0) - ((cl-position (string-remove-prefix "^" re-str) - cands - :test #'ivy--case-fold-string=)) - ((and (ivy--completing-fname-p) - (cl-position (concat re-str "/") - cands - :test #'ivy--case-fold-string=))) - ((and (eq caller 'ivy-switch-buffer) - (not empty)) - (or (cl-position current cands :test #'string=) - 0)) - ((and (not empty) - (not (eq caller 'swiper)) - (not (and (eq ivy--regex-function #'ivy--regex-fuzzy) - (ivy--flx-available-p) - ;; Limit to configured number of candidates - (null (nthcdr ivy-flx-limit cands)))) - ;; If there was a preselected candidate, don't try to - ;; keep it selected even if the regexp still matches it. - ;; See issue #1563. See also `ivy--preselect-index', - ;; which this logic roughly mirrors. - (not (or - (and (integerp preselect) - (= ivy--index preselect)) - (equal current preselect) - (and (ivy--regex-p preselect) - (stringp current) - (string-match-p preselect current)))) - ivy--old-cands - (cl-position current cands :test #'equal))) - ((funcall func re-str cands)) - (t 0)))) - (ivy-set-index index))))) - -(defun ivy-recompute-index-swiper (_re-str cands) - "Recompute index of selected candidate when using `swiper'. -CANDS are the current candidates." - (condition-case nil - (let ((tail (nthcdr ivy--index ivy--old-cands)) - idx) - (if (and tail ivy--old-cands (not (equal "^" ivy--old-re))) - (progn - (while (and tail (null idx)) - ;; Compare with eq to handle equal duplicates in cands - (setq idx (cl-position (pop tail) cands))) - (or - idx - (1- (length cands)))) - (if ivy--old-cands - ivy--index - ;; already in ivy-state-buffer - (let ((n (line-number-at-pos)) - (res 0) - (i 0)) - (dolist (c cands) - (when (eq n (get-text-property 0 'swiper-line-number c)) - (setq res i)) - (cl-incf i)) - res)))) - (error 0))) - -(defun ivy-recompute-index-swiper-backward (re-str cands) - "Recompute index of selected candidate when using `swiper-backward'. -CANDS are the current candidates." - (let ((idx (ivy-recompute-index-swiper re-str cands))) - (if (or (= idx -1) - (<= (get-text-property 0 'swiper-line-number (nth idx cands)) - (line-number-at-pos))) - idx - (- idx 1)))) - -(defun ivy-recompute-index-swiper-async (_re-str cands) - "Recompute index of selected candidate when using `swiper' asynchronously. -CANDS are the current candidates." - (if (null ivy--old-cands) - (let ((ln (with-ivy-window - (line-number-at-pos)))) - (or - ;; closest to current line going forwards - (cl-position-if (lambda (x) - (>= (string-to-number x) ln)) - cands) - ;; closest to current line going backwards - (1- (length cands)))) - (let ((tail (nthcdr ivy--index ivy--old-cands)) - idx) - (if (and tail ivy--old-cands (not (equal "^" ivy--old-re))) - (progn - (while (and tail (null idx)) - ;; Compare with `equal', since the collection is re-created - ;; each time with `split-string' - (setq idx (cl-position (pop tail) cands :test #'equal))) - (or idx 0)) - ivy--index)))) - -(defun ivy-recompute-index-swiper-async-backward (re-str cands) - "Recompute index of selected candidate when using `swiper-backward' -asynchronously. CANDS are the current candidates." - (if (= (length cands) 0) - 0 - (let ((idx (ivy-recompute-index-swiper-async re-str cands))) - (if - (<= (string-to-number (nth idx cands)) - (with-ivy-window (line-number-at-pos))) - idx - (- idx 1))))) - -(defun ivy-recompute-index-zero (_re-str _cands) - "Recompute index of selected candidate. -This function serves as a fallback when nothing else is available." - 0) - -(defcustom ivy-minibuffer-faces - '(ivy-minibuffer-match-face-1 - ivy-minibuffer-match-face-2 - ivy-minibuffer-match-face-3 - ivy-minibuffer-match-face-4) - "List of `ivy' faces for minibuffer group matches." - :type '(repeat :tag "Faces" - (choice - (const ivy-minibuffer-match-face-1) - (const ivy-minibuffer-match-face-2) - (const ivy-minibuffer-match-face-3) - (const ivy-minibuffer-match-face-4) - (face :tag "Other face")))) - -(defun ivy--minibuffer-face (n) - "Return Nth face from `ivy-minibuffer-faces'. -N wraps around, but skips the first element of the list." - (let ((tail (cdr ivy-minibuffer-faces))) - (nth (mod (+ n 2) (length tail)) tail))) - -(defun ivy--flx-propertize (x) - "X is (cons (flx-score STR ...) STR)." - (let ((str (copy-sequence (cdr x))) - (i 0) - (last-j -2)) - (dolist (j (cdar x)) - (unless (eq j (1+ last-j)) - (cl-incf i)) - (setq last-j j) - (add-face-text-property j (1+ j) (ivy--minibuffer-face i) nil str)) - str)) - -(defun ivy--flx-sort (name cands) - "Sort according to closeness to string NAME the string list CANDS." - (condition-case nil - (let* ((bolp (= (string-to-char name) ?^)) - ;; An optimized regex for fuzzy matching - ;; "abc" → "^[^a]*a[^b]*b[^c]*c" - (fuzzy-regex (concat "\\`" - (and bolp (regexp-quote (substring name 1 2))) - (mapconcat - (lambda (x) - (setq x (char-to-string x)) - (concat "[^" x "]*" (regexp-quote x))) - (if bolp (substring name 2) name) - ""))) - ;; Strip off the leading "^" for flx matching - (flx-name (if bolp (substring name 1) name)) - cands-left - cands-to-sort) - - ;; Filter out non-matching candidates - (dolist (cand cands) - (when (string-match-p fuzzy-regex cand) - (push cand cands-left))) - - ;; pre-sort the candidates by length before partitioning - (setq cands-left (static-if (bound-and-true-p ivy--new-sort-p) - (sort cands-left :key #'length :in-place t) - (cl-sort cands-left #'< :key #'length))) - - ;; partition the candidates into sorted and unsorted groups - (dotimes (_ (min (length cands-left) ivy-flx-limit)) - (push (pop cands-left) cands-to-sort)) - - (nconc - (static-if (bound-and-true-p ivy--new-sort-p) - (sort cands-to-sort :in-place t - :key (lambda (cand) - (let ((s (flx-score cand flx-name ivy--flx-cache))) - ;; Sort by decreasing score, increasing length. - (cons (- (car s)) (length cand))))) - ;; Compute all of the flx scores in one pass and sort. - (mapcar #'car - (sort (mapcar - (lambda (cand) - (cons cand - (car (flx-score cand flx-name - ivy--flx-cache)))) - cands-to-sort) - (lambda (c1 c2) - ;; Break ties by length - (if (/= (cdr c1) (cdr c2)) - (> (cdr c1) - (cdr c2)) - (< (length (car c1)) - (length (car c2)))))))) - - ;; Add the unsorted candidates - cands-left)) - (error cands))) - -(defun ivy--truncate-string (str width) - "Truncate STR to WIDTH." - (truncate-string-to-width str width nil nil t)) - -(defun ivy--format-function-generic (selected-fn other-fn cands separator) - "Transform candidates into a string for minibuffer. -SELECTED-FN is called for the selected candidate, OTHER-FN for the others. -Both functions take one string argument each. CANDS is a list of candidates -and SEPARATOR is used to join them." - (let ((i -1)) - (mapconcat - (lambda (str) - (let ((curr (eq (cl-incf i) ivy--window-index))) - (if curr - (funcall selected-fn str) - (funcall other-fn str)))) - cands - separator))) - -(defun ivy-format-function-default (cands) - "Transform CANDS into a multiline string for the minibuffer. -Add the face `ivy-current-match' to the selected candidate." - (ivy--format-function-generic - (lambda (str) - (ivy--add-face str 'ivy-current-match)) - #'identity - cands - "\n")) - -(defun ivy-format-function-arrow (cands) - "Transform CANDS into a multiline string for the minibuffer. -Like `ivy-format-function-default', but also prefix the selected -candidate with an arrow \">\"." - (ivy--format-function-generic - (lambda (str) - (concat "> " (ivy--add-face str 'ivy-current-match))) - (lambda (str) - (concat " " str)) - cands - "\n")) - -(defun ivy-format-function-line (cands) - "Transform CANDS into a multiline string for the minibuffer. -Like `ivy-format-function-default', but extend highlighting of -the selected candidate to the window edge. - -Note that since Emacs 27, `ivy-current-match' needs to have a -non-nil :extend attribute. This is the case by default, but it -also needs to be preserved by the current theme." - (ivy--format-function-generic - (lambda (str) - (ivy--add-face (concat str "\n") 'ivy-current-match)) - (lambda (str) - (concat str "\n")) - cands - "")) - -(defun ivy-format-function-arrow-line (cands) - "Transform CANDS into a multiline string for the minibuffer. -This combines the \">\" prefix of `ivy-format-function-arrow' -with the extended highlighting of `ivy-format-function-line'." - (ivy--format-function-generic - (lambda (str) - (concat "> " (ivy--add-face (concat str "\n") 'ivy-current-match))) - (lambda (str) - (concat " " str "\n")) - cands - "")) - -(defun ivy--highlight-ignore-order (str) - "Highlight STR, using the ignore-order method." - (when (consp ivy--old-re) - (let ((i 1)) - (dolist (re ivy--old-re) - (when (string-match (car re) str) - (add-face-text-property - (match-beginning 0) (match-end 0) - (ivy--minibuffer-face i) - nil str)) - (cl-incf i)))) - str) - -(defun ivy--highlight-fuzzy (str) - "Highlight STR, using the fuzzy method." - (if (and (eq (ivy-alist-setting ivy-re-builders-alist) #'ivy--regex-fuzzy) - (ivy--flx-available-p)) - (let ((flx-name (string-remove-prefix "^" ivy-text))) - (ivy--flx-propertize - (cons (flx-score str flx-name ivy--flx-cache) str))) - (ivy--highlight-default str))) - -(defcustom ivy-use-group-face-if-no-groups t - "If t, and the expression has no subgroups, highlight whole match as a group. - -It will then use the second face (first of the \"group\" faces) -of `ivy-minibuffer-faces'. Otherwise, always use the first face -in this case." - :type 'boolean) - -(defun ivy--positive-regexps () - "Return a list of the positive regexps in `ivy-regex'." - (let ((re ivy-regex)) - (if (listp re) - (cl-mapcan (lambda (x) (and (cdr x) (list (car x)))) re) - (list re)))) - -(defun ivy--highlight-default (str) - "Highlight STR, using the default method." - (let ((regexps (ivy--positive-regexps)) - start) - (dolist (re regexps) - (ignore-errors - (while (and (string-match re str start) - (> (- (match-end 0) (match-beginning 0)) 0)) - (setq start (match-end 0)) - (let ((i 0) - (n 0) - prev) - (while (<= i ivy--subexps) - (let ((beg (match-beginning i)) - (end (match-end i))) - (when (and beg end) - (unless (or (and prev (= prev beg)) - (zerop i)) - (cl-incf n)) - (let ((face - (cond ((and ivy-use-group-face-if-no-groups - (zerop ivy--subexps)) - (cadr ivy-minibuffer-faces)) - ((zerop i) - (car ivy-minibuffer-faces)) - (t - (ivy--minibuffer-face n))))) - (add-face-text-property beg end face nil str)) - (unless (zerop i) - (setq prev end)))) - (cl-incf i))))))) - str) - -(defun ivy--format-minibuffer-line (str &optional affix) - "Format line STR for use in minibuffer. -AFFIX is either the (PREFIX SUFFIX) cdr returned by -`affixation-function', or the result of `annotation-function'." - (let* ((str (ivy-cleanup-string (copy-sequence str))) - (str (cond - ((not (eq ivy-display-style 'fancy)) str) - ((memq (ivy-state-caller ivy-last) ivy-highlight-grep-commands) - (let* ((start (if (string-match "\\`[^:]+:\\(?:[^:]+:\\)?" str) - (match-end 0) 0)) - (file (substring str 0 start)) - (match (substring str start))) - (concat file (funcall ivy--highlight-function match)))) - ((funcall ivy--highlight-function str)))) - (mouse '( mouse-face ivy-minibuffer-match-highlight - help-echo ivy--help-echo))) - (add-text-properties 0 (length str) mouse str) - (cond ((consp affix) - (concat (nth 0 affix) str (nth 1 affix))) - (affix - ;; Existing face takes priority. - (unless (text-property-not-all 0 (length affix) 'face nil affix) - (setq affix (ivy-append-face affix 'ivy-completions-annotations))) - (concat str affix)) - (str)))) - -(defun ivy-read-file-transformer (str) - "Transform candidate STR when reading files." - (if (ivy--dirname-p str) - (propertize str 'face 'ivy-subdir) - str)) - -(defun ivy--minibuffer-index-bounds (idx len wnd-len) - (let* ((half-height (/ wnd-len 2)) - (start (max 0 - (min (- idx half-height) - (- len (1- wnd-len))))) - (end (min (+ start (1- wnd-len)) len))) - (list start end (- idx start)))) - -(defun ivy--format (cands) - "Return a string for CANDS suitable for display in the minibuffer. -CANDS is a list of candidates that :display-transformer can turn into strings." - (setq ivy--length (length cands)) - (when (>= ivy--index ivy--length) - (ivy-set-index (max (1- ivy--length) 0))) - (if (null cands) - (setf (ivy-state-current ivy-last) "") - (let ((cur (nth ivy--index cands))) - (setf (ivy-state-current ivy-last) (if (stringp cur) - (copy-sequence cur) - cur))) - (let* ((bnd (ivy--minibuffer-index-bounds - ivy--index ivy--length ivy-height)) - (wnd-cands (cl-subseq cands (car bnd) (cadr bnd))) - (case-fold-search (ivy--case-fold-p (ivy-re-to-str ivy-regex))) - transformer-fn) - (setq ivy--window-index (nth 2 bnd)) - (when (setq transformer-fn (ivy-state-display-transformer-fn ivy-last)) - (with-ivy-window - (with-current-buffer (ivy-state-buffer ivy-last) - (setq wnd-cands (mapcar transformer-fn wnd-cands))))) - (ivy--wnd-cands-to-str wnd-cands)))) - -(defalias 'ivy--metadata-get - (if (>= emacs-major-version 30) - #'completion-metadata-get - (lambda (metadata prop) - (or (completion-metadata-get metadata prop) - (plist-get completion-extra-properties - (or (get prop 'ivy--metadata-kwd) - (put prop 'ivy--metadata-kwd - (intern (concat ":" (symbol-name prop))))))))) - "Compatibility shim for Emacs 30 `completion-metadata-get'. -\n(fn METADATA PROP)") - -(defun ivy--wnd-cands-to-str (wnd-cands) - (let* ((metadata (unless (ivy-state-dynamic-collection ivy-last) - (completion-metadata "" minibuffer-completion-table - minibuffer-completion-predicate))) - (affix (ivy--metadata-get metadata 'affixation-function)) - (annot (or affix (ivy--metadata-get metadata 'annotation-function))) - (fmt (cond (affix - (lambda (triple) - (ivy--format-minibuffer-line (car triple) (cdr triple)))) - (annot - (lambda (cand) - (ivy--format-minibuffer-line cand (funcall annot cand)))) - (#'ivy--format-minibuffer-line))) - (str (funcall (ivy-alist-setting ivy-format-functions-alist) - (condition-case nil - (mapcar fmt (if affix (funcall affix wnd-cands) - wnd-cands)) - (error wnd-cands))))) - (concat "\n" (ivy--remove-props str 'read-only)))) - -(defvar recentf-list) -(defvar bookmark-alist) - -(defcustom ivy-virtual-abbreviate 'name - "The mode of abbreviation for virtual buffer names." - :type '(choice - (const :tag "Only name" name) - (const :tag "Abbreviated path" abbreviate) - (const :tag "Full path" full) - ;; eventually, uniquify - )) -(declare-function bookmark-maybe-load-default-file "bookmark") -(declare-function bookmark-get-filename "bookmark") - -(defun ivy--virtual-buffers () - "Adapted from `ido-add-virtual-buffers-to-list'." - (require 'bookmark) - (unless recentf-mode - (recentf-mode 1)) - (bookmark-maybe-load-default-file) - (let* ((vb-bkm (delete " - no file -" - (delq nil (mapcar #'bookmark-get-filename - bookmark-alist)))) - (vb-list (cond ((eq ivy-use-virtual-buffers 'recentf) - recentf-list) - ((eq ivy-use-virtual-buffers 'bookmarks) - vb-bkm) - (ivy-use-virtual-buffers - (append recentf-list vb-bkm)) - (t nil))) - virtual-buffers) - (dolist (head vb-list) - (let* ((file-name (if (stringp head) - head - (cdr head))) - (name (cond ((eq ivy-virtual-abbreviate 'name) - (file-name-nondirectory file-name)) - ((eq ivy-virtual-abbreviate 'abbreviate) - (abbreviate-file-name file-name)) - (t - (expand-file-name file-name))))) - (when (equal name "") - (setq name - (if (consp head) - (car head) - (file-name-nondirectory (directory-file-name file-name))))) - (unless (or (equal name "") - (get-file-buffer file-name) - (assoc name virtual-buffers)) - (push (cons (copy-sequence name) file-name) virtual-buffers)))) - (when virtual-buffers - (dolist (comp virtual-buffers) - (put-text-property 0 (length (car comp)) - 'face 'ivy-virtual - (car comp))) - (setq ivy--virtual-buffers (nreverse virtual-buffers)) - (mapcar #'car ivy--virtual-buffers)))) - -(defcustom ivy-ignore-buffers '("\\` " "\\`\\*tramp/") - "List of regexps or functions matching buffer names to ignore." - :type '(repeat (choice regexp function))) - -(defvar ivy-switch-buffer-faces-alist '((dired-mode . ivy-subdir) - (org-mode . ivy-org)) - "Store face customizations for `ivy-switch-buffer'. -Each KEY is `major-mode', each VALUE is a face name.") - -(defun ivy--buffer-list (str &optional virtual predicate) - "Return the buffers that match STR. -If VIRTUAL is non-nil, add virtual buffers. -If optional argument PREDICATE is non-nil, use it to test each -possible match. See `all-completions' for further information." - (delete-dups - (nconc - (all-completions str #'internal-complete-buffer predicate) - (and virtual - (ivy--virtual-buffers))))) - -(defvar ivy-views (and nil - `(("ivy + *scratch* {}" - (vert - (file ,(expand-file-name "ivy.el")) - (buffer "*scratch*"))) - ("swiper + *scratch* {}" - (horz - (file ,(expand-file-name "swiper.el")) - (buffer "*scratch*"))))) - "Store window configurations selectable by `ivy-switch-buffer'. - -The default value is given as an example. - -Each element is a list of (NAME VIEW). NAME is a string, it's -recommended to end it with a distinctive snippet e.g. \"{}\" so -that it's easy to distinguish the window configurations. - -VIEW is either a TREE or a window-configuration (see -`ivy--get-view-config'). - -TREE is a nested list with the following valid cars: -- vert: split the window vertically -- horz: split the window horizontally -- file: open the specified file -- buffer: open the specified buffer - -TREE can be nested multiple times to have multiple window splits.") - -(defun ivy-default-view-name () - "Return default name for new view." - (let* ((default-view-name - (concat "{} " - (mapconcat #'identity - (sort - (mapcar (lambda (w) - (let* ((b (window-buffer w)) - (f (buffer-file-name b))) - (if f - (file-name-nondirectory f) - (buffer-name b)))) - (window-list)) - #'string-lessp) - " "))) - (view-name-re (concat "\\`" - (regexp-quote default-view-name) - " \\([0-9]+\\)")) - old-view) - (cond ((setq old-view - (cl-find-if - (lambda (x) - (string-match view-name-re (car x))) - ivy-views)) - (format "%s %d" - default-view-name - (1+ (string-to-number - (match-string 1 (car old-view)))))) - ((assoc default-view-name ivy-views) - (concat default-view-name " 1")) - (t - default-view-name)))) - -(defun ivy--get-view-config () - "Get `current-window-configuration' for `ivy-views'." - (dolist (w (window-list)) - (set-window-parameter w 'ivy-view-data - (with-current-buffer (window-buffer w) - (cond (buffer-file-name - (list 'file buffer-file-name (point))) - ((eq major-mode 'dired-mode) - (list 'file default-directory (point))) - (t - (list 'buffer (buffer-name) (point))))))) - (let ((window-persistent-parameters - (append window-persistent-parameters - (list (cons 'ivy-view-data t))))) - (current-window-configuration))) - -(defun ivy-push-view (&optional arg) - "Push the current window tree on `ivy-views'. - -When ARG is non-nil, replace a selected item on `ivy-views'. - -Currently, the split configuration (i.e. horizontal or vertical) -and point positions are saved, but the split positions aren't. -Use `ivy-pop-view' to delete any item from `ivy-views'." - (interactive "P") - (let* ((view (ivy--get-view-config)) - (view-name - (if arg - (ivy-read "Update view: " ivy-views) - (ivy-read "Name view: " nil - :initial-input (ivy-default-view-name))))) - (when view-name - (let ((x (assoc view-name ivy-views))) - (if x - (setcdr x (list view)) - (push (list view-name view) ivy-views)))))) - -(defun ivy-pop-view-action (view) - "Delete VIEW from `ivy-views'." - (setq ivy-views (delete view ivy-views)) - (setq ivy--all-candidates - (delete (car view) ivy--all-candidates)) - (setq ivy--old-cands nil)) - -(defun ivy-pop-view () - "Delete a view to delete from `ivy-views'." - (interactive) - (ivy-read "Pop view: " ivy-views - :preselect (caar ivy-views) - :action #'ivy-pop-view-action - :caller 'ivy-pop-view)) - -(defun ivy-source-views () - "Return the name of the views saved in `ivy-views'." - (mapcar #'car ivy-views)) - -(ivy-set-sources - 'ivy-switch-buffer - '((original-source) - (ivy-source-views))) - -(defun ivy-set-view-recur (view) - "Set VIEW recursively." - (cond ((window-configuration-p view) - (set-window-configuration view) - (dolist (w (window-list)) - (with-selected-window w - (ivy-set-view-recur - (window-parameter w 'ivy-view-data))))) - ((eq (car view) 'vert) - (let* ((wnd1 (selected-window)) - (wnd2 (split-window-vertically)) - (views (cdr view)) - (v (pop views)) - (temp-wnd)) - (with-selected-window wnd1 - (ivy-set-view-recur v)) - (while (setq v (pop views)) - (with-selected-window wnd2 - (when views - (setq temp-wnd (split-window-vertically))) - (ivy-set-view-recur v) - (when views - (setq wnd2 temp-wnd)))))) - ((eq (car view) 'horz) - (let* ((wnd1 (selected-window)) - (wnd2 (split-window-horizontally)) - (views (cdr view)) - (v (pop views)) - (temp-wnd)) - (with-selected-window wnd1 - (ivy-set-view-recur v)) - (while (setq v (pop views)) - (with-selected-window wnd2 - (when views - (setq temp-wnd (split-window-horizontally))) - (ivy-set-view-recur v) - (when views - (setq wnd2 temp-wnd)))))) - ((eq (car view) 'file) - (let* ((name (nth 1 view)) - (virtual (assoc name ivy--virtual-buffers)) - buffer) - (cond ((setq buffer (get-buffer name)) - (switch-to-buffer buffer nil 'force-same-window)) - (virtual - (find-file (cdr virtual))) - ((file-exists-p name) - (find-file name)))) - (when (and (> (length view) 2) - (numberp (nth 2 view))) - (goto-char (nth 2 view)))) - ((eq (car view) 'buffer) - (switch-to-buffer (nth 1 view)) - (when (and (> (length view) 2) - (numberp (nth 2 view))) - (goto-char (nth 2 view)))) - ((eq (car view) 'sexp) - (eval (nth 1 view))))) - -(defun ivy--switch-buffer-action (buffer) - "Switch to BUFFER. -BUFFER may be a string or nil." - (if (zerop (length buffer)) - (switch-to-buffer - ivy-text nil 'force-same-window) - (let ((virtual (assoc buffer ivy--virtual-buffers)) - (view (assoc buffer ivy-views))) - (cond ((and virtual - (not (get-buffer buffer))) - (find-file (cdr virtual))) - (view - (delete-other-windows) - (let ( - ;; silence "Directory has changed on disk" - (inhibit-message t)) - (ivy-set-view-recur (cadr view)))) - (t - (switch-to-buffer - buffer nil 'force-same-window)))))) - -(defun ivy--switch-buffer-other-window-action (buffer) - "Switch to BUFFER in other window. -BUFFER may be a string or nil." - (if (zerop (length buffer)) - (switch-to-buffer-other-window ivy-text) - (let ((virtual (assoc buffer ivy--virtual-buffers))) - (if (and virtual - (not (get-buffer buffer))) - (find-file-other-window (cdr virtual)) - (switch-to-buffer-other-window buffer))))) - -(defun ivy--rename-buffer-action (buffer) - "Rename BUFFER." - (let ((new-name (read-string "Rename buffer (to new name): "))) - (with-current-buffer buffer - (rename-buffer new-name)))) - -(defun ivy--find-file-action (buffer) - "Find file from BUFFER's directory." - (let* ((virtual (assoc buffer ivy--virtual-buffers)) - (default-directory (if virtual - (file-name-directory (cdr virtual)) - (buffer-local-value 'default-directory - (or (get-buffer buffer) - (current-buffer)))))) - (call-interactively (if (functionp 'counsel-find-file) - #'counsel-find-file - #'find-file)))) - -(defun ivy--kill-buffer-or-virtual (buffer) - (if (get-buffer buffer) - (kill-buffer buffer) - (setq recentf-list (delete - (cdr (assoc buffer ivy--virtual-buffers)) - recentf-list)))) - -(defun ivy--kill-current-candidate () - (setf (ivy-state-preselect ivy-last) ivy--index) - (setq ivy--old-re nil) - (setq ivy--all-candidates (delete (ivy-state-current ivy-last) ivy--all-candidates)) - (let ((ivy--recompute-index-inhibit t)) - (ivy--exhibit))) - -(defun ivy--kill-current-candidate-buffer () - (setf (ivy-state-preselect ivy-last) ivy--index) - (setq ivy--old-re nil) - (setq ivy--all-candidates (ivy--buffer-list "" ivy-use-virtual-buffers - (ivy-state-predicate ivy-last))) - (let ((ivy--recompute-index-inhibit t)) - (ivy--exhibit))) - -(defun ivy--kill-buffer-action (buffer) - "Kill BUFFER." - (ivy--kill-buffer-or-virtual buffer) - (unless (buffer-live-p (ivy-state-buffer ivy-last)) - (setf (ivy-state-buffer ivy-last) - (with-ivy-window (current-buffer)))) - (ivy--kill-current-candidate-buffer)) - -(defvar ivy-switch-buffer-map - (let ((map (make-sparse-keymap))) - (ivy-define-key map (kbd "C-k") #'ivy-switch-buffer-kill) - map)) - -(defun ivy-switch-buffer-kill () - "When at end-of-line, kill the current buffer in `ivy-switch-buffer'. -Otherwise, forward to `ivy-kill-line'." - (interactive) - (if (not (eolp)) - (ivy-kill-line) - (ivy--kill-buffer-action - (ivy-state-current ivy-last)))) - -(ivy-set-actions - 'ivy-switch-buffer - '(("f" - ivy--find-file-action - "find file") - ("j" - ivy--switch-buffer-other-window-action - "other window") - ("k" - ivy--kill-buffer-action - "kill") - ("r" - ivy--rename-buffer-action - "rename"))) - -(ivy-set-actions - t - '(("i" ivy--action-insert "insert") - ("w" ivy--action-copy "copy"))) - -(defun ivy--trim-grep-line-number (x) - (if (string-match ":[0-9]+:" x) - (substring x (match-end 0)) - x)) - -(defun ivy--action-insert (x) - (insert - (if (stringp x) - (ivy--trim-grep-line-number x) - (car x)))) - -(defun ivy--action-copy (x) - (kill-new - (if (stringp x) - (ivy--trim-grep-line-number x) - (car x)))) - -(defun ivy--switch-buffer-matcher (regexp candidates) - "Return REGEXP matching CANDIDATES. -Skip buffers that match `ivy-ignore-buffers'." - (if (string-match-p "^:" ivy-text) - (delete-dups - (cl-delete-if-not - (lambda (s) - (when (/= (string-to-char s) ?*) - (let ((b (get-buffer s))) - (and b (string-match-p - regexp (buffer-local-value 'default-directory b)))))) - (copy-sequence candidates))) - (let ((res (ivy--re-filter regexp candidates))) - (if (or (null ivy-use-ignore) - (null ivy-ignore-buffers)) - res - (or (cl-remove-if - (lambda (buf) - (cl-find-if - (lambda (f-or-r) - (if (functionp f-or-r) - (funcall f-or-r buf) - (string-match-p f-or-r buf))) - ivy-ignore-buffers)) - res) - (and (eq ivy-use-ignore t) - res)))))) - -(defun ivy-append-face (str face) - "Append to STR the property FACE." - (when face - (setq str (copy-sequence str)) - (add-face-text-property 0 (length str) face t str)) - str) - -(defun ivy--remote-buffer-p (buffer) - "Return non-nil if BUFFER object is visiting a remote file. -If that is the case, value is a string identifying the remote -connection." - (let ((dir (buffer-local-value 'default-directory buffer))) - (ignore-errors (file-remote-p dir)))) - -(defun ivy-switch-buffer-transformer (str) - "Transform candidate STR when switching buffers." - (let ((buf (get-buffer str))) - (cond ((not buf) str) - ((let ((remote (ivy--remote-buffer-p buf))) - (when remote - (format "%s (%s)" (ivy-append-face str 'ivy-remote) remote)))) - ((not (verify-visited-file-modtime buf)) - (ivy-append-face str 'ivy-modified-outside-buffer)) - ((buffer-modified-p buf) - (ivy-append-face str 'ivy-modified-buffer)) - (t - (let* ((mode (buffer-local-value 'major-mode buf)) - (face (cdr (assq mode ivy-switch-buffer-faces-alist)))) - (ivy-append-face str face)))))) - -(defun ivy-switch-buffer-occur (cands) - "Occur function for `ivy-switch-buffer' using `ibuffer'. -CANDS are the candidates to be displayed." - (unless cands - (setq cands (all-completions ivy-text #'internal-complete-buffer))) - (ibuffer - nil (buffer-name) - `((or ,@(cl-mapcan - (lambda (cand) - (unless (eq (get-text-property 0 'face cand) 'ivy-virtual) - `((name . ,(format "\\_<%s\\_>" (regexp-quote cand)))))) - cands))))) - -;;;###autoload -(defun ivy-switch-buffer () - "Switch to another buffer." - (interactive) - (ivy-read "Switch to buffer: " #'internal-complete-buffer - :keymap ivy-switch-buffer-map - :preselect (buffer-name (other-buffer (current-buffer))) - :action #'ivy--switch-buffer-action - :matcher #'ivy--switch-buffer-matcher - :caller 'ivy-switch-buffer)) - -(ivy-configure 'ivy-switch-buffer - :parent 'internal-complete-buffer - :occur #'ivy-switch-buffer-occur) - -;;;###autoload -(defun ivy-switch-view () - "Switch to one of the window views stored by `ivy-push-view'." - (interactive) - (let ((ivy-initial-inputs-alist - '((ivy-switch-buffer . "{}")))) - (ivy-switch-buffer))) - -;;;###autoload -(defun ivy-switch-buffer-other-window () - "Switch to another buffer in another window." - (interactive) - (ivy-read "Switch to buffer in other window: " #'internal-complete-buffer - :matcher #'ivy--switch-buffer-matcher - :preselect (buffer-name (other-buffer (current-buffer))) - :action #'ivy--switch-buffer-other-window-action - :keymap ivy-switch-buffer-map - :caller 'ivy-switch-buffer-other-window)) - -(ivy-configure 'ivy-switch-buffer-other-window - :parent 'ivy-switch-buffer) - -(defun ivy--yank-handle-case-fold (text) - (if (and (> (length ivy-text) 0) - (string= (downcase ivy-text) ivy-text)) - (downcase text) - text)) - -(defun ivy--yank-by (fn &rest args) - "Pull buffer text from current line into search string. -The region to extract is determined by the respective values of -point before and after applying FN to ARGS." - (let (text) - (with-ivy-window - (let ((beg (point)) - (bol (line-beginning-position)) - (eol (line-end-position)) - end) - (unwind-protect - (progn (apply fn args) - (setq end (goto-char (max bol (min (point) eol)))) - (setq text (buffer-substring-no-properties beg end)) - (ivy--pulse-region beg end)) - (unless text - (goto-char beg))))) - (when text - (insert (replace-regexp-in-string - " +" " " - (ivy--yank-handle-case-fold text) - t t))))) - -(defun ivy-yank-word (&optional arg) - "Pull next word from buffer into search string. -If optional ARG is non-nil, pull in the next ARG -words (previous if ARG is negative)." - (interactive "p") - (ivy--yank-by #'forward-word arg)) - -(defun ivy-yank-symbol (&optional arg) - "Pull next symbol from buffer into search string. -If optional ARG is non-nil, pull in the next ARG -symbols (previous if ARG is negative)." - (interactive "p") - (ivy--yank-by #'forward-symbol (or arg 1))) - -(defun ivy-yank-char (&optional arg) - "Pull next character from buffer into search string. -If optional ARG is non-nil, pull in the next ARG -characters (previous if ARG is negative)." - (interactive "p") - (ivy--yank-by #'forward-char arg)) - -(defvar ivy--pulse-overlay nil - "Overlay used to highlight yanked word.") - -(defvar ivy--pulse-timer nil - "Timer used to dispose of `ivy--pulse-overlay'.") - -(defcustom ivy-pulse-delay 0.5 - "Number of seconds to display `ivy-yanked-word' highlight. -When nil, disable highlighting." - :type '(choice - (number :tag "Delay in seconds") - (const :tag "Disable" nil))) - -(defun ivy--pulse-region (start end) - "Temporarily highlight text between START and END. -The \"pulse\" duration is determined by `ivy-pulse-delay'." - (when ivy-pulse-delay - (if ivy--pulse-overlay - (let ((ostart (overlay-start ivy--pulse-overlay)) - (oend (overlay-end ivy--pulse-overlay))) - (when (< end start) - (cl-rotatef start end)) - ;; Extend the existing overlay's region to include START..END, - ;; but only if the two regions are contiguous. - (move-overlay ivy--pulse-overlay - (if (= start oend) ostart start) - (if (= end ostart) oend end))) - (setq ivy--pulse-overlay (make-overlay start end)) - (overlay-put ivy--pulse-overlay 'face 'ivy-yanked-word)) - (when ivy--pulse-timer - (cancel-timer ivy--pulse-timer)) - (setq ivy--pulse-timer - (run-at-time ivy-pulse-delay nil #'ivy--pulse-cleanup)))) - -(defun ivy--pulse-cleanup () - "Cancel `ivy--pulse-timer' and delete `ivy--pulse-overlay'." - (when ivy--pulse-timer - (cancel-timer ivy--pulse-timer) - (setq ivy--pulse-timer nil)) - (when ivy--pulse-overlay - (delete-overlay ivy--pulse-overlay) - (setq ivy--pulse-overlay nil))) - -(defun ivy-kill-ring-save () - "Save the current candidates in the kill ring. -If the region is active, forward to `kill-ring-save' instead." - (interactive) - (if (use-region-p) - (call-interactively #'kill-ring-save) - (kill-new (string-join ivy--old-cands "\n")))) - -(defun ivy-insert-current () - "Make the current candidate into current input. -Don't finish completion." - (interactive) - (delete-minibuffer-contents) - (let ((end (and ivy--directory - (ivy--dirname-p (ivy-state-current ivy-last)) - -1))) - (insert (substring-no-properties - (ivy-state-current ivy-last) 0 end)))) - -(defun ivy-insert-current-full () - "Insert the current directory into the minibuffer." - (interactive) - (insert ivy--directory)) - -(defcustom ivy-preferred-re-builders - '((ivy--regex-plus . "ivy") - (ivy--regex-ignore-order . "order") - (ivy--regex-fuzzy . "fuzzy")) - "Alist of preferred re-builders with display names. -This list can be rotated with `ivy-rotate-preferred-builders'." - :type '(alist :key-type function :value-type string)) - -(defun ivy-rotate-preferred-builders () - "Switch to the next re builder in `ivy-preferred-re-builders'." - (interactive) - (when ivy-preferred-re-builders - (setq ivy--old-re nil) - (setq ivy--regex-function - (let ((cell (assq ivy--regex-function ivy-preferred-re-builders))) - (car (or (cadr (memq cell ivy-preferred-re-builders)) - (car ivy-preferred-re-builders))))))) - -(defun ivy-toggle-fuzzy () - "Toggle the re builder between `ivy--regex-fuzzy' and `ivy--regex-plus'." - (interactive) - (setq ivy--old-re nil) - (if (eq ivy--regex-function 'ivy--regex-fuzzy) - (setq ivy--regex-function 'ivy--regex-plus) - (setq ivy--regex-function 'ivy--regex-fuzzy))) - -(defun ivy--label-and-delete-dups (entries) - "Label ENTRIES with history indices." - (let ((ht (and entries (make-hash-table :test #'equal))) - (idx 0) - entry - accum) - (while (setq entry (pop entries)) - (unless (gethash entry ht) - (puthash entry t ht) - (push `(,entry . ,idx) accum)) - (cl-incf idx)) - (nreverse accum))) - -(defvar ivy--reverse-i-search-history nil - "Store the minibuffer history variable.") - -(defun ivy-reverse-i-search-kill () - "Remove the current item from minibuffer history." - (interactive) - (if (not (eolp)) - (ivy-kill-line) - (let ((current (ivy-state-current ivy-last)) - (history ivy--reverse-i-search-history)) - (cond ((booleanp history)) - ((symbolp history) - (set history (delete current (symbol-value history)))) - ((ring-p history) - ;; `ring-p' is autoloaded. - (declare-function ring-member "ring") - (declare-function ring-remove "ring") - (ring-remove history (ring-member history current))))) - (ivy--kill-current-candidate))) - -(defvar ivy-reverse-i-search-map - (let ((map (make-sparse-keymap))) - (ivy-define-key map (kbd "C-k") #'ivy-reverse-i-search-kill) - map)) - -(defun ivy-history-contents (history) - "Copy contents of HISTORY. -A copy is necessary so that we don't clobber any string attributes. -Also set `ivy--reverse-i-search-history' to HISTORY." - (prog1 (ivy--label-and-delete-dups - (cond ((booleanp history) ()) - ((symbolp history) - (copy-sequence (symbol-value history))) - ((ring-p history) - ;; `ring-p' is autoloaded. - (declare-function ring-elements "ring") - (ring-elements history)) - ((sequencep history) - (copy-sequence history)) - ((error "Expected a symbol, ring, or sequence: %S" history)))) - (setq ivy--reverse-i-search-history history))) - -(defun ivy-reverse-i-search () - "Enter a recursive `ivy-read' session using the current history. -The selected history element will be inserted into the minibuffer. -\\ -You can also delete an element from history with \\[ivy-reverse-i-search-kill]." - (interactive) - (cond - ((= (minibuffer-depth) 0) - (user-error - "This command is intended to be called from within `ivy-read'")) - ;; don't recur - ((and (> (minibuffer-depth) 1) - (eq (ivy-state-caller ivy-last) 'ivy-reverse-i-search))) - (t - (let ((enable-recursive-minibuffers t) - (old-last ivy-last)) - (ivy-read "Reverse-i-search: " - (ivy-history-contents (ivy-state-history ivy-last)) - :keymap ivy-reverse-i-search-map - :action (lambda (x) - (ivy--reset-state - (setq ivy-last old-last)) - (delete-minibuffer-contents) - (insert (substring-no-properties (car x))) - (ivy--cd-maybe)) - :caller 'ivy-reverse-i-search))))) - -(defun ivy-restrict-to-matches () - "Restrict candidates to current input and erase input." - (interactive) - (delete-minibuffer-contents) - (if (ivy-state-dynamic-collection ivy-last) - (progn - ;; By disabling `ivy-state-dynamic-collection', we lose the ability - ;; to clearly differentiate between ternary programmed completion - ;; functions and Ivy's unary dynamic collections (short of using - ;; `func-arity' or otherwise redesigning things). So we must also - ;; update the dynamic binding of `minibuffer-completion-table' to no - ;; longer hold a dynamic collection. - (setq minibuffer-completion-table ivy--old-cands) - (setq ivy--all-candidates ivy--old-cands) - (setf (ivy-state-collection ivy-last) ivy--old-cands) - (setf (ivy-state-dynamic-collection ivy-last) nil)) - (setq ivy--all-candidates - (ivy--filter ivy-text ivy--all-candidates)))) - -;;; Occur - -(defvar-local ivy-occur-last nil - "Buffer-local value of `ivy-last'. -Can't re-use `ivy-last' because using e.g. `swiper' in the same -buffer would modify `ivy-last'.") - -(defvar ivy-occur-mode-map - (let ((map (make-sparse-keymap))) - (ivy-define-key map [mouse-1] #'ivy-occur-click) - (ivy-define-key map (kbd "RET") #'ivy-occur-press-and-switch) - (ivy-define-key map (kbd "j") #'ivy-occur-next-line) - (ivy-define-key map (kbd "k") #'ivy-occur-previous-line) - (define-key map (kbd "h") #'backward-char) - (define-key map (kbd "l") #'forward-char) - (ivy-define-key map (kbd "f") #'ivy-occur-press) - (ivy-define-key map (kbd "g") #'ivy-occur-revert-buffer) - (ivy-define-key map (kbd "a") #'ivy-occur-read-action) - (ivy-define-key map (kbd "o") #'ivy-occur-dispatch) - (ivy-define-key map (kbd "c") #'ivy-occur-toggle-calling) - (define-key map (kbd "q") #'quit-window) - (define-key map (kbd "R") #'read-only-mode) - (ivy-define-key map (kbd "C-d") #'ivy-occur-delete-candidate) - (ivy-define-key map (kbd "F") #'ivy-occur-flush-lines) - map) - "Keymap for Ivy Occur mode.") - -(defun ivy-occur-toggle-calling () - "Toggle `ivy-calling'." - (interactive) - (if (setq ivy-calling (not ivy-calling)) - (progn - (setq mode-name "Ivy-Occur [calling]") - (ivy-occur-press)) - (setq mode-name "Ivy-Occur")) - (force-mode-line-update)) - -(defun ivy--find-occur-buffer () - (let ((cb (current-buffer))) - (cl-find-if - (lambda (b) - (with-current-buffer b - (and (eq major-mode 'ivy-occur-grep-mode) - (equal cb (ivy-state-buffer ivy-occur-last))))) - (buffer-list)))) - -(defun ivy--select-occur-buffer () - (let* ((ob (ivy--find-occur-buffer)) - (ow (cl-find-if (lambda (w) (equal ob (window-buffer w))) - (window-list)))) - (if ow - (select-window ow) - (pop-to-buffer ob)))) - -(defun ivy-occur-next-line (&optional arg) - "Move the cursor down ARG lines. -When `ivy-calling' isn't nil, call `ivy-occur-press'." - (interactive "p") - (let ((offset (cond ((derived-mode-p 'ivy-occur-grep-mode) 5) - ((derived-mode-p 'ivy-occur-mode) 2)))) - (if offset - (progn - (if (< (line-number-at-pos) offset) - (progn - (goto-char (point-min)) - (forward-line (1- offset))) - (forward-line arg) - (when (eolp) - (forward-line -1))) - (when ivy-calling - (ivy-occur-press))) - (ivy--select-occur-buffer) - (ivy-occur-next-line arg) - (ivy-occur-press-and-switch)))) - -(defun ivy-occur-previous-line (&optional arg) - "Move the cursor up ARG lines. -When `ivy-calling' isn't nil, call `ivy-occur-press'." - (interactive "p") - (let ((offset (cond ((derived-mode-p 'ivy-occur-grep-mode) 5) - ((derived-mode-p 'ivy-occur-mode) 2)))) - (if offset - (progn - (forward-line (- arg)) - (when (< (line-number-at-pos) offset) - (goto-char (point-min)) - (forward-line (1- offset))) - (when ivy-calling - (ivy-occur-press))) - (ivy--select-occur-buffer) - (ivy-occur-previous-line arg) - (ivy-occur-press-and-switch)))) - -(defun ivy-occur-next-error (n &optional reset) - "A `next-error-function' for `ivy-occur-mode'." - (interactive "p") - (when reset - (goto-char (point-min))) - (setq n (or n 1)) - (let ((ivy-calling t)) - (cond ((< n 0) (ivy-occur-previous-line (- n))) - (t (ivy-occur-next-line n)))) - ;; The window's point overrides the buffer's point every time it's redisplayed - (dolist (window (get-buffer-window-list nil nil t)) - (set-window-point window (point)))) - -(define-derived-mode ivy-occur-mode fundamental-mode "Ivy-Occur" - "Major mode for output from \\[ivy-occur]. - -\\{ivy-occur-mode-map}" - (setq-local view-read-only nil)) - -(defvar ivy-occur-grep-mode-map - (let ((map (copy-keymap ivy-occur-mode-map))) - (ivy-define-key map (kbd "C-x C-q") 'ivy-wgrep-change-to-wgrep-mode) - (ivy-define-key map "w" 'ivy-wgrep-change-to-wgrep-mode) - map) - "Keymap for Ivy Occur Grep mode.") - -(defun ivy-occur-delete-candidate () - (interactive) - (let ((inhibit-read-only t)) - (delete-region (line-beginning-position) - (1+ (line-end-position))))) - -(defun ivy-occur-flush-lines () - "Delete lines matching regex." - (interactive) - (let ((inhibit-read-only t)) - (call-interactively 'flush-lines))) - -(define-derived-mode ivy-occur-grep-mode grep-mode "Ivy-Occur" - "Major mode for output from \\[ivy-occur]. - -\\{ivy-occur-grep-mode-map}" - (setq-local view-read-only nil) - (when (fboundp 'wgrep-setup) - (wgrep-setup))) - -(defun ivy--starts-with-dotslash (str) - (string-match-p "\\`\\.[/\\]" str)) - -(defun ivy--occur-insert-lines (cands) - "Insert CANDS into `ivy-occur' buffer." - (font-lock-mode -1) - (dolist (cand cands) - (setq cand - (if (string-match "\\`\\(.*:[0-9]+:\\)\\(.*\\)\\'" cand) - (let ((file-and-line (match-string 1 cand)) - (grep-line (match-string 2 cand))) - (concat - (propertize file-and-line 'face 'ivy-grep-info) - (ivy--highlight-fuzzy grep-line))) - (ivy--highlight-fuzzy (copy-sequence cand)))) - (add-text-properties - 0 (length cand) - '(mouse-face - highlight - help-echo "mouse-1: call ivy-action") - cand) - (insert (if (ivy--starts-with-dotslash cand) "" " ") - cand ?\n))) - -(defun ivy--occur-default (cands) - "Insert CANDS into the current occur buffer." - (unless cands - (let ((coll (ivy-state-collection ivy-last))) - (when (arrayp coll) - (setq coll (all-completions "" coll (ivy-state-predicate ivy-last)))) - (setq cands (ivy--filter (ivy-state-text ivy-last) coll)))) - (ivy-occur-mode) - (insert (format "%d candidates:\n" (length cands))) - (ivy--occur-insert-lines cands) - (read-only-mode)) - -(defun ivy-occur () - "Stop completion and put the current candidates into a new buffer. - -The new buffer remembers current action(s). - -While in the *ivy-occur* buffer, selecting a candidate with RET or -a mouse click will call the appropriate action for that candidate. - -There is no limit on the number of *ivy-occur* buffers." - (interactive) - (if (not (window-minibuffer-p)) - (user-error "No completion session is active") - (let* ((caller (ivy-state-caller ivy-last)) - (occur-fn (or (plist-get ivy--occurs-list caller) - #'ivy--occur-default)) - (buffer - (generate-new-buffer - (format "*ivy-occur%s \"%s\"*" - (if caller - (concat " " (prin1-to-string caller)) - "") - ivy-text)))) - (with-current-buffer buffer - (funcall occur-fn - (if (ivy-state-dynamic-collection ivy-last) - (funcall (ivy-state-collection ivy-last) ivy-text) - ivy--old-cands)) - (setf (ivy-state-text ivy-last) ivy-text) - (setq ivy-occur-last ivy-last)) - (ivy-exit-with-action - (lambda (_) - (pop-to-buffer buffer) - (setq next-error-last-buffer buffer) - (setq-local next-error-function #'ivy-occur-next-error)))))) - -(defun ivy-occur-revert-buffer () - "Refresh the buffer making it up-to date with the collection. - -Currently only works for `swiper'. In that specific case, the -*ivy-occur* buffer becomes nearly useless as the original buffer -is updated, since the line numbers no longer match. - -Calling this function is as if you called `ivy-occur' on the -updated original buffer." - (interactive) - (let ((caller (ivy-state-caller ivy-occur-last)) - (ivy-last ivy-occur-last)) - (let ((inhibit-read-only t) - (line (line-number-at-pos)) - (text (ivy-state-text ivy-last))) - (erase-buffer) - (ivy-set-text text) - (funcall (or (plist-get ivy--occurs-list caller) - #'ivy--occur-default) - (and (ivy-state-dynamic-collection ivy-last) - (funcall (ivy-state-collection ivy-last) - text))) - (goto-char (point-min)) - (forward-line (1- line))) - (setq ivy-occur-last ivy-last))) - -(declare-function wgrep-change-to-wgrep-mode "ext:wgrep") - -(defun ivy-wgrep-change-to-wgrep-mode () - "Forward to `wgrep-change-to-wgrep-mode'." - (interactive) - (if (require 'wgrep nil 'noerror) - (wgrep-change-to-wgrep-mode) - (error "Package wgrep isn't installed"))) - -(defun ivy-occur-read-action () - "Select one of the available actions as the current one." - (interactive) - (let ((ivy-last ivy-occur-last)) - (ivy-read-action))) - -(defun ivy-occur-dispatch () - "Call one of the available actions on the current item." - (interactive) - (let* ((state-action (ivy-state-action ivy-occur-last)) - (actions (if (symbolp state-action) - state-action - (copy-sequence state-action)))) - (unwind-protect - (progn - (ivy-occur-read-action) - (ivy-occur-press)) - (setf (ivy-state-action ivy-occur-last) actions)))) - -(defun ivy-occur-click (event) - "Execute action for the current candidate. -EVENT gives the mouse position." - (interactive "e") - (let ((window (posn-window (event-end event))) - (pos (posn-point (event-end event)))) - (with-current-buffer (window-buffer window) - (goto-char pos) - (ivy-occur-press)))) - -(declare-function swiper--cleanup "swiper") -(declare-function swiper--add-overlays "swiper") -(defvar ivy-occur-timer nil) - -(defun ivy--occur-press-update-window () - (cond - ((memq (ivy-state-caller ivy-occur-last) - (append '(swiper swiper-isearch) ivy-highlight-grep-commands)) - (let ((window (ivy-state-window ivy-occur-last)) - (buffer (ivy-state-buffer ivy-occur-last))) - (when (buffer-live-p buffer) - (cond ((or (not (window-live-p window)) - (equal window (selected-window))) - (save-selected-window - (setf (ivy-state-window ivy-occur-last) - (display-buffer buffer)))) - ((not (equal (window-buffer window) buffer)) - (with-selected-window window - (switch-to-buffer buffer))))))) - - ((memq (ivy-state-caller ivy-occur-last) - '(counsel-describe-function - counsel-describe-variable - counsel-describe-symbol)) - (setf (ivy-state-window ivy-occur-last) - (selected-window)) - (selected-window)))) - -(defun ivy--occur-press-buffer () - (let ((buffer (ivy-state-buffer ivy-last))) - (if (buffer-live-p buffer) - buffer - (current-buffer)))) - -(defun ivy-occur-press () - "Execute action for the current candidate." - (interactive) - (ivy--occur-press-update-window) - (when (save-excursion - (beginning-of-line) - (looking-at "\\(?:.[/\\]\\| \\)\\(.*\\)$")) - (let* ((ivy-last ivy-occur-last) - (ivy-text (ivy-state-text ivy-last)) - (str (match-string 1)) - (offset (or (get-text-property 0 'offset str) 0)) - (coll (ivy-state-collection ivy-last)) - (action (ivy--get-action ivy-last)) - (ivy-exit 'done)) - (with-ivy-window - (with-current-buffer (ivy--occur-press-buffer) - (save-restriction - (widen) - (funcall action - (if (and (consp coll) - (consp (car coll))) - (assoc str coll) - (substring str offset))))) - (if (memq (ivy-state-caller ivy-last) - (append '(swiper swiper-isearch) ivy-highlight-grep-commands)) - (with-current-buffer (window-buffer (selected-window)) - (swiper--cleanup) - (swiper--add-overlays - (ivy--regex ivy-text) - (line-beginning-position) - (line-end-position) - (selected-window)) - (when (timerp ivy-occur-timer) - (cancel-timer ivy-occur-timer)) - (setq ivy-occur-timer - (run-at-time 1.0 nil 'swiper--cleanup)))))))) - -(defun ivy-occur-press-and-switch () - "Execute action for the current candidate and switch window." - (interactive) - (ivy-occur-press) - (select-window (ivy--get-window ivy-occur-last))) - -(defun ivy--marked-p () - (member (ivy-state-current ivy-last) ivy-marked-candidates)) - -(defun ivy--unmark (cand) - (setcar (member cand ivy--all-candidates) - (setcar (member cand ivy--old-cands) - (substring cand (length ivy-mark-prefix)))) - (setq ivy-marked-candidates - (delete cand ivy-marked-candidates))) - -(defun ivy--mark (cand) - (let ((marked-cand (copy-sequence (concat ivy-mark-prefix cand)))) - ;; Primarily for preserving `idx'. FIXME: the mark - ;; prefix shouldn't become part of the candidate! - (add-text-properties 0 (length ivy-mark-prefix) - (text-properties-at 0 cand) - marked-cand) - (setcar (member cand ivy--all-candidates) - (setcar (member cand ivy--old-cands) marked-cand)) - (setq ivy-marked-candidates - (nconc ivy-marked-candidates (list marked-cand))))) - -(defun ivy-mark () - "Mark the selected candidate and move to the next one. - -In `ivy-call', :action will be called in turn for all marked -candidates. - -However, if :multi-action was supplied to `ivy-read', then it -will be called with `ivy-marked-candidates'. This way, it can -make decisions based on the whole marked list." - (interactive) - (unless (ivy--marked-p) - (ivy--mark (ivy-state-current ivy-last))) - (ivy-next-line)) - -(defun ivy-unmark () - "Unmark the selected candidate and move to the next one." - (interactive) - (when (ivy--marked-p) - (ivy--unmark (ivy-state-current ivy-last))) - (ivy-next-line)) - -(defun ivy-unmark-backward () - "Move to the previous candidate and unmark it." - (interactive) - (ivy-previous-line) - (ivy--exhibit) - (when (ivy--marked-p) - (ivy--unmark (ivy-state-current ivy-last)))) - -(defun ivy-toggle-marks () - "Toggle mark for all narrowed candidates." - (interactive) - (dolist (cand ivy--old-cands) - (if (member cand ivy-marked-candidates) - (ivy--unmark cand) - (ivy--mark cand)))) - -(defconst ivy-help-file (let ((default-directory - (if load-file-name - (file-name-directory load-file-name) - default-directory))) - (if (file-exists-p "ivy-help.org") - (expand-file-name "ivy-help.org") - (if (file-exists-p "doc/ivy-help.org") - (expand-file-name "doc/ivy-help.org")))) - "The file for `ivy-help'.") - -(defvar org-hide-emphasis-markers) - -(defun ivy-help () - "Help for `ivy'." - (interactive) - (let ((buf (get-buffer "*Ivy Help*")) - (inhibit-read-only t)) - (unless buf - (setq buf (get-buffer-create "*Ivy Help*")) - (cl-letf (((symbol-function #'help-buffer) (lambda () buf))) - (describe-mode)) - (with-current-buffer buf - (goto-char (point-min)) - (insert "* describe-mode\n") - (goto-char (point-min)) - (insert-file-contents ivy-help-file) - (org-mode) - (setq-local org-hide-emphasis-markers t) - (view-mode) - (goto-char (point-min)) - (let ((inhibit-message t)) - (org-cycle '(64))))) - (if (eq this-command 'ivy-help) - (switch-to-buffer buf) - (with-ivy-window - (pop-to-buffer buf))) - (view-mode) - (goto-char (point-min)))) - -(declare-function ffap-url-p "ffap") -(defvar ffap-url-fetcher) - -(defun ivy-ffap-url-p (string) - "Forward to `ffap-url-p'." - (require 'ffap) - (ffap-url-p string)) - -(defun ivy-ffap-url-fetcher (url) - "Calls `ffap-url-fetcher'." - (require 'ffap) - (funcall ffap-url-fetcher url)) - -(ivy-configure 'read-file-name-internal - :sort-fn #'ivy-sort-file-function-default - :display-transformer-fn #'ivy-read-file-transformer - :alt-done-fn #'ivy--directory-done) - -(ivy-configure 'internal-complete-buffer - :display-transformer-fn #'ivy-switch-buffer-transformer) - -(ivy-configure 'Info-read-node-name-1 - :alt-done-fn #'ivy--info-alt-done) - -(provide 'ivy) - -;;; ivy.el ends here diff --git a/.emacs.d/lisp/orderless.el b/.emacs.d/lisp/orderless.el new file mode 100644 index 0000000..1ff379e --- /dev/null +++ b/.emacs.d/lisp/orderless.el @@ -0,0 +1,672 @@ +;;; orderless.el --- Completion style for matching regexps in any order -*- lexical-binding: t; -*- + +;; Copyright (C) 2021-2025 Free Software Foundation, Inc. + +;; Author: Omar Antolín Camarena +;; Maintainer: Omar Antolín Camarena , Daniel Mendler +;; Keywords: matching, completion +;; Version: 1.5 +;; URL: https://github.com/oantolin/orderless +;; Package-Requires: ((emacs "27.1") (compat "30")) + +;; This file is part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This package provides an `orderless' completion style that divides +;; the pattern into components (space-separated by default), and +;; matches candidates that match all of the components in any order. + +;; Completion styles are used as entries in the variables +;; `completion-styles' and `completion-category-overrides', see their +;; documentation. + +;; To use this completion style you can use the following minimal +;; configuration: + +;; (setq completion-styles '(orderless basic)) + +;; You can customize the `orderless-component-separator' to decide how +;; the input pattern is split into component regexps. The default +;; splits on spaces. You might want to add hyphens and slashes, for +;; example, to ease completion of symbols and file paths, +;; respectively. + +;; Each component can match in any one of several matching styles: +;; literally, as a regexp, as an initialism, in the flex style, or as +;; word prefixes. It is easy to add new styles: they are functions +;; from strings to strings that map a component to a regexp to match +;; against. The variable `orderless-matching-styles' lists the +;; matching styles to be used for components, by default it allows +;; literal and regexp matching. + +;;; Code: + +(require 'compat) +(eval-when-compile (require 'cl-lib)) + +(defgroup orderless nil + "Completion method that matches space-separated regexps in any order." + :link '(info-link :tag "Info Manual" "(orderless)") + :link '(url-link :tag "Website" "https://github.com/oantolin/orderless") + :link '(emacs-library-link :tag "Library Source" "orderless.el") + :group 'minibuffer) + +(defface orderless-match-face-0 + '((default :weight bold) + (((class color) (min-colors 88) (background dark)) :foreground "#72a4ff") + (((class color) (min-colors 88) (background light)) :foreground "#223fbf") + (t :foreground "blue")) + "Face for matches of components numbered 0 mod 4.") + +(defface orderless-match-face-1 + '((default :weight bold) + (((class color) (min-colors 88) (background dark)) :foreground "#ed92f8") + (((class color) (min-colors 88) (background light)) :foreground "#8f0075") + (t :foreground "magenta")) + "Face for matches of components numbered 1 mod 4.") + +(defface orderless-match-face-2 + '((default :weight bold) + (((class color) (min-colors 88) (background dark)) :foreground "#90d800") + (((class color) (min-colors 88) (background light)) :foreground "#145a00") + (t :foreground "green")) + "Face for matches of components numbered 2 mod 4.") + +(defface orderless-match-face-3 + '((default :weight bold) + (((class color) (min-colors 88) (background dark)) :foreground "#f0ce43") + (((class color) (min-colors 88) (background light)) :foreground "#804000") + (t :foreground "yellow")) + "Face for matches of components numbered 3 mod 4.") + +(defcustom orderless-component-separator #'orderless-escapable-split-on-space + "Component separators for orderless completion. +This can either be a string, which is passed to `split-string', +or a function of a single string argument." + :type `(choice (const :tag "Spaces" " +") + (const :tag "Spaces, hyphen or slash" " +\\|[-/]") + (const :tag "Escapable space" + ,#'orderless-escapable-split-on-space) + (const :tag "Quotable spaces" ,#'split-string-and-unquote) + (regexp :tag "Custom regexp") + (function :tag "Custom function"))) + +(defcustom orderless-match-faces + [orderless-match-face-0 + orderless-match-face-1 + orderless-match-face-2 + orderless-match-face-3] + "Vector of faces used (cyclically) for component matches." + :type '(vector face)) + +(defcustom orderless-matching-styles + (list #'orderless-literal #'orderless-regexp) + "List of component matching styles. +If this variable is nil, regexp matching is assumed. + +A matching style is simply a function from strings to regexps. +The returned regexps can be either strings or s-expressions in +`rx' syntax. If the resulting regexp has no capturing groups, +the entire match is highlighted, otherwise just the captured +groups are. Several are provided with this package: try +customizing this variable to see a list of them." + :type '(repeat function) + :options (list #'orderless-regexp + #'orderless-literal + #'orderless-initialism + #'orderless-prefixes + #'orderless-flex)) + +(defcustom orderless-affix-dispatch-alist + `((?% . ,#'char-fold-to-regexp) + (?! . ,#'orderless-not) + (?& . ,#'orderless-annotation) + (?, . ,#'orderless-initialism) + (?= . ,#'orderless-literal) + (?^ . ,#'orderless-literal-prefix) + (?~ . ,#'orderless-flex)) + "Alist associating characters to matching styles. +The function `orderless-affix-dispatch' uses this list to +determine how to match a pattern component: if the component +either starts or ends with a character used as a key in this +alist, the character is removed from the component and the rest is +matched according the style associated to it." + :type `(alist + :key-type character + :value-type (choice + (const :tag "Annotation" ,#'orderless-annotation) + (const :tag "Literal" ,#'orderless-literal) + (const :tag "Without literal" ,#'orderless-without-literal) + (const :tag "Literal prefix" ,#'orderless-literal-prefix) + (const :tag "Regexp" ,#'orderless-regexp) + (const :tag "Not" ,#'orderless-not) + (const :tag "Flex" ,#'orderless-flex) + (const :tag "Initialism" ,#'orderless-initialism) + (const :tag "Prefixes" ,#'orderless-prefixes) + (const :tag "Ignore diacritics" ,#'char-fold-to-regexp) + (function :tag "Custom matching style")))) + +(defun orderless-affix-dispatch (component _index _total) + "Match COMPONENT according to the styles in `orderless-affix-dispatch-alist'. +If the COMPONENT starts or ends with one of the characters used +as a key in `orderless-affix-dispatch-alist', then that character +is removed and the remainder of the COMPONENT is matched in the +style associated to the character." + (let ((len (length component)) + (alist orderless-affix-dispatch-alist)) + (when (> len 0) + (cond + ;; Ignore single dispatcher character + ((and (= len 1) (alist-get (aref component 0) alist)) #'ignore) + ;; Prefix + ((when-let ((style (alist-get (aref component 0) alist))) + (cons style (substring component 1)))) + ;; Suffix + ((when-let ((style (alist-get (aref component (1- len)) alist))) + (cons style (substring component 0 -1)))))))) + +(defcustom orderless-style-dispatchers (list #'orderless-affix-dispatch) + "List of style dispatchers. +Style dispatchers are used to override the matching styles +based on the actual component and its place in the list of +components. A style dispatcher is a function that takes a string +and two integers as arguments, it gets called with a component, +the 0-based index of the component and the total number of +components. It can decide what matching styles to use for the +component and optionally replace the component with a different +string, or it can decline to handle the component leaving it for +future dispatchers. For details see `orderless--dispatch'. + +For example, a style dispatcher could arrange for the first +component to match as an initialism and subsequent components to +match as literals. As another example, a style dispatcher could +arrange for a component starting with `~' to match the rest of +the component in the `orderless-flex' style. See +`orderless-affix-dispatch' and `orderless-affix-dispatch-alist' +for such a configuration. For more information on how this +variable is used, see `orderless-compile'." + :type '(repeat function)) + +(defcustom orderless-smart-case t + "Whether to use smart case. +If this variable is t, then case-sensitivity is decided as +follows: if any component contains upper case letters, the +matches are case sensitive; otherwise case-insensitive. This +is like the behavior of `isearch' when `search-upper-case' is +non-nil. + +On the other hand, if this variable is nil, then case-sensitivity +is determined by the values of `completion-ignore-case', +`read-file-name-completion-ignore-case' and +`read-buffer-completion-ignore-case', as usual for completion." + :type 'boolean) + +(defcustom orderless-expand-substring 'prefix + "Whether to perform literal substring expansion. +This configuration option affects the behavior of some completion +interfaces when pressing TAB. If enabled `orderless-try-completion' +will first attempt literal substring expansion. If disabled, +expansion is only performed for single unique matches. For +performance reasons only `prefix' expansion is enabled by default. +Set the variable to `substring' for full substring expansion." + :type '(choice (const :tag "No expansion" nil) + (const :tag "Substring" substring) + (const :tag "Prefix (efficient)" prefix))) + +;;; Matching styles + +(defun orderless-regexp (component) + "Match COMPONENT as a regexp." + (condition-case nil + (progn (string-match-p component "") component) + (invalid-regexp nil))) + +(defun orderless-literal (component) + "Match COMPONENT as a literal string." + ;; Do not use (literal component) here, such that `delete-dups' in + ;; `orderless--compile-component' has a chance to delete duplicates for + ;; literal input. The default configuration of `orderless-matching-styles' + ;; with `orderless-regexp' and `orderless-literal' leads to duplicates. + (regexp-quote component)) + +(defun orderless-literal-prefix (component) + "Match COMPONENT as a literal prefix string." + `(seq bos (literal ,component))) + +(defun orderless--separated-by (sep rxs &optional before after) + "Return a regexp to match the rx-regexps RXS with SEP in between. +If BEFORE is specified, add it to the beginning of the rx +sequence. If AFTER is specified, add it to the end of the rx +sequence." + (declare (indent 1)) + `(seq + ,(or before "") + ,@(cl-loop for (sexp . more) on rxs + collect `(group ,sexp) + when more collect sep) + ,(or after ""))) + +(defun orderless-flex (component) + "Match a component in flex style. +This means the characters in COMPONENT must occur in the +candidate in that order, but not necessarily consecutively." + `(seq + ,@(cdr (cl-loop for char across component + append `((zero-or-more (not ,char)) (group ,char)))))) + +(defun orderless-initialism (component) + "Match a component as an initialism. +This means the characters in COMPONENT must occur in the +candidate, in that order, at the beginning of words." + (orderless--separated-by '(zero-or-more nonl) + (cl-loop for char across component collect `(seq word-start ,char)))) + +(defun orderless-prefixes (component) + "Match a component as multiple word prefixes. +The COMPONENT is split at word endings, and each piece must match +at a word boundary in the candidate. This is similar to the +`partial-completion' completion style." + (orderless--separated-by '(zero-or-more nonl) + (cl-loop for prefix in (split-string component "\\>") + collect `(seq word-boundary ,prefix)))) + +(defun orderless-without-literal (component) + "Match strings that do *not* contain COMPONENT as a literal match. +You may prefer to use the more general `orderless-not' instead +which can invert any predicate or regexp." + `(seq + (group string-start) ; highlight nothing! + (zero-or-more + (or ,@(cl-loop for i below (length component) + collect `(seq ,(substring component 0 i) + (or (not (any ,(aref component i))) + string-end))))) + string-end)) + +(defsubst orderless--match-p (pred regexp str) + "Return t if STR matches PRED and REGEXP." + (and str + (or (not pred) (funcall pred str)) + (or (not regexp) + (let ((case-fold-search completion-ignore-case)) + (string-match-p regexp str))))) + +(defun orderless-not (pred regexp) + "Match strings that do *not* match PRED and REGEXP." + (lambda (str) + (not (orderless--match-p pred regexp str)))) + +(defun orderless--metadata () + "Return completion metadata iff inside minibuffer." + (when-let (((minibufferp)) + (table minibuffer-completion-table)) + ;; Return non-nil metadata iff inside minibuffer + (or (completion-metadata (buffer-substring-no-properties + (minibuffer-prompt-end) (point)) + table minibuffer-completion-predicate) + '((nil . nil))))) + +(defun orderless-annotation (pred regexp) + "Match candidates where the annotation matches PRED and REGEXP." + (let ((md (orderless--metadata))) + (if-let ((fun (compat-call completion-metadata-get md 'affixation-function))) + (lambda (str) + (cl-loop for s in (cdar (funcall fun (list str))) + thereis (orderless--match-p pred regexp s))) + (when-let ((fun (compat-call completion-metadata-get md 'annotation-function))) + (lambda (str) (orderless--match-p pred regexp (funcall fun str))))))) + +;;; Highlighting matches + +(defun orderless--highlight (regexps ignore-case string) + "Destructively propertize STRING to highlight a match of each of the REGEXPS. +The search is case insensitive if IGNORE-CASE is non-nil." + (cl-loop with case-fold-search = ignore-case + with n = (length orderless-match-faces) + for regexp in regexps and i from 0 + when (string-match regexp string) do + (cl-loop + for (x y) on (let ((m (match-data))) (or (cddr m) m)) by #'cddr + when x do + (add-face-text-property + x y + (aref orderless-match-faces (mod i n)) + nil string))) + string) + +(defun orderless-highlight-matches (regexps strings) + "Highlight a match of each of the REGEXPS in each of the STRINGS. +Warning: only use this if you know all REGEXPs match all STRINGS! +For the user's convenience, if REGEXPS is a string, it is +converted to a list of regexps according to the value of +`orderless-matching-styles'." + (when (stringp regexps) + (setq regexps (cdr (orderless-compile regexps)))) + (cl-loop with ignore-case = (orderless--ignore-case-p regexps) + for str in strings + collect (orderless--highlight regexps ignore-case (substring str)))) + +;;; Compiling patterns to lists of regexps + +(defun orderless-escapable-split-on-space (string) + "Split STRING on spaces, which can be escaped with backslash." + (mapcar + (lambda (piece) (replace-regexp-in-string (string 0) " " piece)) + (split-string (replace-regexp-in-string + "\\\\\\\\\\|\\\\ " + (lambda (x) (if (equal x "\\ ") (string 0) x)) + string 'fixedcase 'literal) + " +"))) + +(defun orderless--dispatch (dispatchers default string index total) + "Run DISPATCHERS to compute matching styles for STRING. + +A style dispatcher is a function that takes a STRING, component +INDEX and the TOTAL number of components. It should either +return (a) nil to indicate the dispatcher will not handle the +string, (b) a new string to replace the current string and +continue dispatch, or (c) the matching styles to use and, if +needed, a new string to use in place of the current one (for +example, a dispatcher can decide which style to use based on a +suffix of the string and then it must also return the component +stripped of the suffix). + +More precisely, the return value of a style dispatcher can be of +one of the following forms: + +- nil (to continue dispatching) + +- a string (to replace the component and continue dispatching), + +- a matching style or non-empty list of matching styles to + return, + +- a `cons' whose `car' is either as in the previous case or + nil (to request returning the DEFAULT matching styles), and + whose `cdr' is a string (to replace the current one). + +This function tries all DISPATCHERS in sequence until one returns +a list of styles. When that happens it returns a `cons' of the +list of styles and the possibly updated STRING. If none of the +DISPATCHERS returns a list of styles, the return value will use +DEFAULT as the list of styles." + (cl-loop for dispatcher in dispatchers + for result = (funcall dispatcher string index total) + if (stringp result) + do (setq string result result nil) + else if (and (consp result) (null (car result))) + do (setf (car result) default) + else if (and (consp result) (stringp (cdr result))) + do (setq string (cdr result) result (car result)) + when result return (cons result string) + finally (return (cons default string)))) + +(defun orderless--compile-component (component index total styles dispatchers) + "Compile COMPONENT at INDEX of TOTAL components with STYLES and DISPATCHERS." + (cl-loop + with pred = nil + with (newsty . newcomp) = (orderless--dispatch dispatchers styles + component index total) + for style in (if (functionp newsty) (list newsty) newsty) + for res = (condition-case nil + (funcall style newcomp) + (wrong-number-of-arguments + (when-let ((res (orderless--compile-component + newcomp index total styles dispatchers))) + (funcall style (car res) (cdr res))))) + if (functionp res) do (cl-callf orderless--predicate-and pred res) + else if res collect (if (stringp res) `(regexp ,res) res) into regexps + finally return + (when (or pred regexps) + (cons pred (and regexps (rx-to-string `(or ,@(delete-dups regexps)) t)))))) + +(defun orderless-compile (pattern &optional styles dispatchers) + "Build regexps to match the components of PATTERN. +Split PATTERN on `orderless-component-separator' and compute +matching styles for each component. For each component the style +DISPATCHERS are run to determine the matching styles to be used; +they are called with arguments the component, the 0-based index +of the component and the total number of components. If the +DISPATCHERS decline to handle the component, then the list of +matching STYLES is used. See `orderless--dispatch' for details +on dispatchers. + +The STYLES default to `orderless-matching-styles', and the +DISPATCHERS default to `orderless-dipatchers'. Since nil gets +you the default, if you want no dispatchers to be run, use +\\='(ignore) as the value of DISPATCHERS. + +The return value is a pair of a predicate function and a list of +regexps. The predicate function can also be nil. It takes a +string as argument." + (unless styles (setq styles orderless-matching-styles)) + (unless dispatchers (setq dispatchers orderless-style-dispatchers)) + (cl-loop + with predicate = nil + with temp = (if (functionp orderless-component-separator) + (funcall orderless-component-separator pattern) + (split-string pattern orderless-component-separator)) + with components = (if (equal (car (last temp)) "") (nbutlast temp) temp) + with total = (length components) + for comp in components and index from 0 + for (pred . regexp) = (orderless--compile-component + comp index total styles dispatchers) + when regexp collect regexp into regexps + when pred do (cl-callf orderless--predicate-and predicate pred) + finally return (cons predicate regexps))) + +;;; Completion style implementation + +(defun orderless--predicate-normalized-and (p q) + "Combine two predicate functions P and Q with `and'. +The first function P is a completion predicate which can receive +up to two arguments. The second function Q always receives a +normalized string as argument." + (cond + ((and p q) + (lambda (k &rest v) ;; v for hash table + (when (if v (funcall p k (car v)) (funcall p k)) + (setq k (if (consp k) (car k) k)) ;; alist + (funcall q (if (symbolp k) (symbol-name k) k))))) + (q + (lambda (k &optional _) ;; _ for hash table + (setq k (if (consp k) (car k) k)) ;; alist + (funcall q (if (symbolp k) (symbol-name k) k)))) + (p))) + +(defun orderless--predicate-and (p q) + "Combine two predicate functions P and Q with `and'." + (or (and p q (lambda (x) (and (funcall p x) (funcall q x)))) p q)) + +(defun orderless--compile (string table pred) + "Compile STRING to a prefix and a list of regular expressions. +The predicate PRED is used to constrain the entries in TABLE." + (pcase-let* ((limit (car (completion-boundaries string table pred ""))) + (prefix (substring string 0 limit)) + (pattern (substring string limit)) + (`(,fun . ,regexps) (orderless-compile pattern))) + (list prefix regexps (orderless--ignore-case-p pattern) + (orderless--predicate-normalized-and pred fun)))) + +;; Thanks to @jakanakaevangeli for writing a version of this function: +;; https://github.com/oantolin/orderless/issues/79#issuecomment-916073526 +(defun orderless--literal-prefix-p (regexp) + "Determine if REGEXP is a quoted regexp anchored at the beginning. +If REGEXP is of the form \"\\`q\" for q = (regexp-quote u), +then return (cons REGEXP u); else return nil." + (when (and (string-prefix-p "\\`" regexp) + (not (string-match-p "[$*+.?[\\^]" + (replace-regexp-in-string + "\\\\[$*+.?[\\^]" "" regexp + 'fixedcase 'literal nil 2)))) + (cons regexp + (replace-regexp-in-string "\\\\\\([$*+.?[\\^]\\)" "\\1" + regexp 'fixedcase nil nil 2)))) + +(defun orderless--ignore-case-p (regexps) + "Return non-nil if case should be ignored for REGEXPS." + (if orderless-smart-case + (cl-loop for regexp in (ensure-list regexps) + always (isearch-no-upper-case-p regexp t)) + completion-ignore-case)) + +(defun orderless--filter (prefix regexps ignore-case table pred) + "Filter TABLE by PREFIX, REGEXPS and PRED. +The matching should be case-insensitive if IGNORE-CASE is non-nil." + ;; If there is a regexp of the form \`quoted-regexp then + ;; remove the first such and add the unquoted form to the prefix. + (pcase (cl-loop for r in regexps + thereis (orderless--literal-prefix-p r)) + (`(,regexp . ,literal) + (setq prefix (concat prefix literal) + regexps (remove regexp regexps)))) + (let ((completion-regexp-list regexps) + (completion-ignore-case ignore-case)) + (all-completions prefix table pred))) + +(defun orderless-filter (string table &optional pred) + "Split STRING into components and find entries TABLE matching all. +The predicate PRED is used to constrain the entries in TABLE." + (pcase-let ((`(,prefix ,regexps ,ignore-case ,pred) + (orderless--compile string table pred))) + (orderless--filter prefix regexps ignore-case table pred))) + +;;;###autoload +(defun orderless-all-completions (string table pred _point) + "Split STRING into components and find entries TABLE matching all. +The predicate PRED is used to constrain the entries in TABLE. The +matching portions of each candidate are highlighted. +This function is part of the `orderless' completion style." + (pcase-let ((`(,prefix ,regexps ,ignore-case ,pred) + (orderless--compile string table pred))) + (when-let ((completions (orderless--filter prefix regexps ignore-case table pred))) + (if completion-lazy-hilit + (setq completion-lazy-hilit-fn + (apply-partially #'orderless--highlight regexps ignore-case)) + (cl-loop for str in-ref completions do + (setf str (orderless--highlight regexps ignore-case (substring str))))) + (nconc completions (length prefix))))) + +;;;###autoload +(defun orderless-try-completion (string table pred point) + "Complete STRING to unique matching entry in TABLE. +This uses `orderless-all-completions' to find matches for STRING +in TABLE among entries satisfying PRED. If there is only one +match, it completes to that match. If there are no matches, it +returns nil. In any other case it \"completes\" STRING to +itself, without moving POINT. +This function is part of the `orderless' completion style." + (or + (pcase orderless-expand-substring + ('nil nil) + ('prefix (completion-emacs21-try-completion string table pred point)) + (_ (completion-substring-try-completion string table pred point))) + (catch 'orderless--many + (pcase-let ((`(,prefix ,regexps ,ignore-case ,pred) + (orderless--compile string table pred)) + (one nil)) + ;; Abuse all-completions/orderless--filter as a fast search loop. + ;; Should be almost allocation-free since our "predicate" is not + ;; called more than two times. + (orderless--filter + prefix regexps ignore-case table + (orderless--predicate-normalized-and + pred + (lambda (arg) + ;; Check if there is more than a single match (= many). + (when (and one (not (equal one arg))) + (throw 'orderless--many (cons string point))) + (setq one arg) + t))) + (when one + ;; Prepend prefix if the candidate does not already have the same + ;; prefix. This workaround is needed since the predicate may either + ;; receive an unprefixed or a prefixed candidate as argument. Most + ;; completion tables consistently call the predicate with unprefixed + ;; candidates, for example `completion-file-name-table'. In contrast, + ;; `completion-table-with-context' calls the predicate with prefixed + ;; candidates. This could be an unintended bug or oversight in + ;; `completion-table-with-context'. + (unless (or (equal prefix "") + (and (string-prefix-p prefix one) + (test-completion one table pred))) + (setq one (concat prefix one))) + (or (equal string one) ;; Return t for unique exact match + (cons one (length one)))))))) + +;;;###autoload +(add-to-list 'completion-styles-alist + '(orderless + orderless-try-completion orderless-all-completions + "Completion of multiple components, in any order.")) + +(defmacro orderless-define-completion-style + (name &optional docstring &rest configuration) + "Define an orderless completion style with given CONFIGURATION. +The CONFIGURATION should be a list of bindings that you could use +with `let' to configure orderless. You can include bindings for +`orderless-matching-styles' and `orderless-style-dispatchers', +for example. + +The completion style consists of two functions that this macro +defines for you, NAME-try-completion and NAME-all-completions. +This macro registers those in `completion-styles-alist' as +forming the completion style NAME. + +The optional DOCSTRING argument is used as the documentation +string for the completion style." + (declare (doc-string 2) (indent 1)) + (unless (stringp docstring) + (push docstring configuration) + (setq docstring nil)) + (let* ((fn-name (lambda (string) (intern (concat (symbol-name name) string)))) + (try-completion (funcall fn-name "-try-completion")) + (all-completions (funcall fn-name "-all-completions")) + (doc-fmt "`%s' function for the %s style. +This function delegates to `orderless-%s'. +The orderless configuration is locally modified +specifically for the %s style.") + (fn-doc (lambda (fn) (format doc-fmt fn name fn name name)))) + `(progn + (defun ,try-completion (string table pred point) + ,(funcall fn-doc "try-completion") + (let ,configuration + (orderless-try-completion string table pred point))) + (defun ,all-completions (string table pred point) + ,(funcall fn-doc "all-completions") + (let ,configuration + (orderless-all-completions string table pred point))) + (add-to-list 'completion-styles-alist + '(,name ,try-completion ,all-completions ,docstring))))) + +;;; Ivy integration + +;;;###autoload +(defun orderless-ivy-re-builder (str) + "Convert STR into regexps for use with ivy. +This function is for integration of orderless with ivy, use it as +a value in `ivy-re-builders-alist'." + (or (mapcar (lambda (x) (cons x t)) (cdr (orderless-compile str))) "")) + +(defvar ivy-regex) +(defun orderless-ivy-highlight (str) + "Highlight a match in STR of each regexp in `ivy-regex'. +This function is for integration of orderless with ivy." + (orderless--highlight (mapcar #'car ivy-regex) t str) str) + +(provide 'orderless) +;;; orderless.el ends here diff --git a/.emacs.d/lisp/swiper.el b/.emacs.d/lisp/swiper.el deleted file mode 100644 index c35180e..0000000 --- a/.emacs.d/lisp/swiper.el +++ /dev/null @@ -1,1818 +0,0 @@ -;;; swiper.el --- Isearch with an overview. Oh, man! -*- lexical-binding: t -*- - -;; Copyright (C) 2015-2025 Free Software Foundation, Inc. - -;; Author: Oleh Krehel -;; Maintainer: Basil L. Contovounesios -;; URL: https://github.com/abo-abo/swiper -;; Version: 0.15.1 -;; Package-Requires: ((emacs "24.5") (ivy "0.15.1")) -;; Keywords: matching - -;; This file is part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; For a full copy of the GNU General Public License -;; see . - -;;; Commentary: - -;; This package gives an overview of the current regex search -;; candidates. The search regex can be split into groups with a -;; space. Each group is highlighted with a different face. -;; -;; It can double as a quick `regex-builder', although only single -;; lines will be matched. - -;;; Code: - -(require 'cl-lib) -(require 'ivy) - -(eval-when-compile - (unless (fboundp 'static-if) - (defmacro static-if (condition then-form &rest else-forms) - "Expand to THEN-FORM or ELSE-FORMS based on compile-time CONDITION. -Polyfill for Emacs 30 `static-if'." - (declare (debug (sexp sexp &rest sexp)) (indent 2)) - (if (eval condition lexical-binding) - then-form - (macroexp-progn else-forms))))) - -(defgroup swiper nil - "`isearch' with an overview." - :group 'matching - :prefix "swiper-") - -(defface swiper-match-face-1 - '((t :inherit lazy-highlight)) - "The background face for `swiper' matches." - :group 'ivy-faces) - -(defface swiper-match-face-2 - '((t :inherit isearch)) - "Face for `swiper' matches modulo 1." - :group 'ivy-faces) - -(defface swiper-match-face-3 - '((t :inherit match)) - "Face for `swiper' matches modulo 2." - :group 'ivy-faces) - -(defface swiper-match-face-4 - '((t :inherit isearch-fail)) - "Face for `swiper' matches modulo 3." - :group 'ivy-faces) - -(defface swiper-background-match-face-1 - '((t :inherit swiper-match-face-1)) - "The background face for non-current `swiper' matches." - :group 'ivy-faces) - -(defface swiper-background-match-face-2 - '((t :inherit swiper-match-face-2)) - "Face for non-current `swiper' matches modulo 1." - :group 'ivy-faces) - -(defface swiper-background-match-face-3 - '((t :inherit swiper-match-face-3)) - "Face for non-current `swiper' matches modulo 2." - :group 'ivy-faces) - -(defface swiper-background-match-face-4 - '((t :inherit swiper-match-face-4)) - "Face for non-current `swiper' matches modulo 3." - :group 'ivy-faces) - -(defface swiper-line-face - '((t :inherit highlight)) - "Face for current `swiper' line." - :group 'ivy-faces) - -(defcustom swiper-faces '(swiper-match-face-1 - swiper-match-face-2 - swiper-match-face-3 - swiper-match-face-4) - "List of `swiper' faces for group matches." - :group 'ivy-faces - :type '(repeat face)) - -(defvar swiper-background-faces - '(swiper-background-match-face-1 - swiper-background-match-face-2 - swiper-background-match-face-3 - swiper-background-match-face-4) - "Like `swiper-faces', but used for all matches except the current one.") - -(defun swiper--recompute-background-faces () - (let ((faces '(swiper-background-match-face-1 - swiper-background-match-face-2 - swiper-background-match-face-3 - swiper-background-match-face-4)) - (colir-compose-method #'colir-compose-soft-light)) - (cl-mapc (lambda (f1 f2) - (let* ((bg (face-background f1)) - ;; FIXME: (colir-color-parse "color-22") is nil. - (bg (and bg (colir-color-parse bg)))) - (when bg - (setq bg (colir-blend bg (colir-color-parse "#ffffff"))) - (set-face-background f2 bg)))) - swiper-faces - faces))) -(swiper--recompute-background-faces) - -(defcustom swiper-min-highlight 2 - "Only highlight matches for regexps at least this long." - :type 'integer) - -(defcustom swiper-include-line-number-in-search nil - "Include line number in text of search candidates." - :type 'boolean - :group 'swiper) - -(defcustom swiper-goto-start-of-match nil - "When non-nil, go to the start of the match, not its end. -Treated as non-nil when searching backwards." - :type 'boolean - :group 'swiper) - -(defun swiper-C-s (&optional arg) - "Move cursor vertically down ARG candidates. -If the input is empty, select the previous history element instead." - (interactive "p") - (if (string= ivy-text "") - (ivy-previous-history-element 1) - (ivy-next-line arg))) - -(defvar swiper-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-s") #'swiper-C-s) - (define-key map (kbd "M-q") #'swiper-query-replace) - (define-key map (kbd "C-l") #'swiper-recenter-top-bottom) - (define-key map (kbd "C-'") #'swiper-avy) - (define-key map (kbd "C-7") #'swiper-mc) - (define-key map (kbd "C-c C-f") #'swiper-toggle-face-matching) - map) - "Keymap for swiper.") - -(defvar swiper--query-replace-overlays nil) - -(defun swiper--query-replace-updatefn () - (let ((lisp (ignore-errors (nth 2 (query-replace-compile-replacement ivy-text t))))) - (dolist (ov swiper--query-replace-overlays) - (overlay-put - ov 'after-string - (propertize - (condition-case nil - (with-current-buffer (overlay-buffer ov) - (set-match-data (overlay-get ov 'md)) - (if (consp lisp) - (eval lisp) - (match-substitute-replacement ivy-text))) - (error ivy-text)) - 'face 'error))))) - -(defun swiper--query-replace-cleanup () - (while swiper--query-replace-overlays - (delete-overlay (pop swiper--query-replace-overlays)))) - -(defun swiper--query-replace-setup () - (with-ivy-window - (let ((end (window-end (selected-window) t)) - (re (ivy-re-to-str ivy-regex))) - (save-excursion - (beginning-of-line) - (while (re-search-forward re end t) - (let ((ov (make-overlay (1- (match-end 0)) (match-end 0))) - (md (match-data t))) - (overlay-put - ov 'matches - (mapcar - (lambda (x) - (list `(match-string ,x) (match-string x))) - (number-sequence 0 (1- (/ (length md) 2))))) - (overlay-put ov 'md md) - (push ov swiper--query-replace-overlays)) - (unless (> (match-end 0) (match-beginning 0)) - (forward-char))))))) - -(defun swiper-query-replace () - "Start `query-replace' with string to replace from last search string." - (interactive) - (cond ((null (window-minibuffer-p)) - (user-error "Should only be called in the minibuffer through `swiper-map'")) - ((string= "" ivy-text) - (user-error "Empty input")) - (t - (swiper--query-replace-setup) - (unwind-protect - (let* ((enable-recursive-minibuffers t) - (from (ivy-re-to-str ivy-regex)) - (groups (number-sequence 1 ivy--subexps)) - (default - (list - (mapconcat (lambda (i) (format "\\%d" i)) groups " ") - (format "\\,(concat %s)" - (if (<= ivy--subexps 1) - "\\&" - (mapconcat - (lambda (i) (format "\\%d" i)) - groups - " \" \" "))))) - (to - (query-replace-compile-replacement - (ivy-read - (format "Query replace %s with: " from) nil - :def default - :caller 'swiper-query-replace) - t))) - (swiper--cleanup) - (ivy-exit-with-action - (lambda (_) - (with-ivy-window - (move-beginning-of-line 1) - (let ((inhibit-read-only t)) - (perform-replace from to - t t nil)))))) - (swiper--query-replace-cleanup))))) - -(ivy-configure 'swiper-query-replace - :update-fn #'swiper--query-replace-updatefn) -(function-put #'swiper-query-replace 'no-counsel-M-x t) - -(defvar inhibit-message) - -(defun swiper-all-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 `swiper-all-map'") - (let* ((enable-recursive-minibuffers t) - (from (ivy--regex ivy-text)) - (to (query-replace-read-to from "Query replace" t))) - (swiper--cleanup) - (ivy-exit-with-action - (lambda (_) - (let ((wnd-conf (current-window-configuration)) - (inhibit-message t)) - (unwind-protect - (dolist (cand ivy--old-cands) - (let ((buffer (get-text-property 0 'buffer cand))) - (switch-to-buffer buffer) - (goto-char (point-min)) - (perform-replace from to t t nil))) - (set-window-configuration wnd-conf)))))))) -(function-put #'swiper-all-query-replace 'no-counsel-M-x t) - -(defvar avy-all-windows) -(defvar avy-style) -(defvar avy-keys) -(declare-function avy--overlay-post "ext:avy") -(declare-function avy-action-goto "ext:avy") -(declare-function avy-candidate-beg "ext:avy") -(declare-function avy--done "ext:avy") -(declare-function avy--make-backgrounds "ext:avy") -(declare-function avy-window-list "ext:avy") -(declare-function avy-read "ext:avy") -(declare-function avy-read-de-bruijn "ext:avy") -(declare-function avy-tree "ext:avy") -(declare-function avy-push-mark "ext:avy") -(declare-function avy--remove-leading-chars "ext:avy") - -(defun swiper--avy-candidates () - (let* ((visible-overlays - (with-ivy-window (overlays-in (window-start) (window-end)))) - ;; We'll have overlapping overlays, so we sort all the - ;; overlays in the visible region by their start, and then - ;; throw out non-Swiper overlays or overlapping Swiper - ;; overlays. - (visible-overlays - (static-if (bound-and-true-p ivy--new-sort-p) - (sort visible-overlays :key #'overlay-start :in-place t) - (cl-sort visible-overlays #'< :key #'overlay-start))) - (min-overlay-start 0) - (overlays-for-avy - (cl-delete-if-not - (lambda (ov) - (when (and (>= (overlay-start ov) - min-overlay-start) - (memq (overlay-get ov 'face) - (append swiper-faces swiper-background-faces))) - (setq min-overlay-start (overlay-start ov)))) - visible-overlays)) - (offset (if (eq (ivy-state-caller ivy-last) 'swiper) 1 0))) - (nconc - (mapcar (lambda (ov) - (cons (overlay-start ov) - (overlay-get ov 'window))) - overlays-for-avy) - (save-excursion - (save-restriction - (narrow-to-region (window-start) (window-end)) - (goto-char (point-min)) - (forward-line) - (let ((win (selected-window)) - cands) - (while (not (eobp)) - (push (cons (+ (point) offset) win) - cands) - (forward-line)) - cands)))))) - -(defun swiper--avy-candidate () - (let ((candidates (swiper--avy-candidates)) - (avy-all-windows nil)) - (unwind-protect - (prog2 - (avy--make-backgrounds - (append (avy-window-list) - (list (ivy-state-window ivy-last)))) - (if (eq avy-style 'de-bruijn) - (avy-read-de-bruijn candidates avy-keys) - (avy-read (avy-tree candidates avy-keys) - #'avy--overlay-post - #'avy--remove-leading-chars)) - (avy-push-mark)) - (avy--done)))) - -(defun swiper--avy-index (pos) - "Return `ivy--index' for `avy' candidate at minibuffer POS." - ;; Position in original buffer. - (let ((opos (get-text-property pos 'point))) - (or - ;; Find `swiper-isearch' index based on buffer position. - (and opos (cl-position opos ivy--all-candidates)) - ;; Find `swiper' index based on line number. - (let ((nlines (count-lines (point-min) (point-max)))) - (+ (car (ivy--minibuffer-index-bounds - ivy--index ivy--length ivy-height)) - (line-number-at-pos pos) - (if (or (= nlines (1+ ivy-height)) - (< ivy--length ivy-height)) - 0 - (- ivy-height nlines)) - -2))))) - -(defun swiper--avy-goto (candidate) - (cond ((let ((win (cdr-safe candidate))) - (and win (window-minibuffer-p win))) - (setq ivy--index (swiper--avy-index (car candidate))) - (ivy--exhibit) - (ivy-done) - (ivy-call)) - ((or (consp candidate) - (number-or-marker-p candidate)) - (ivy-quit-and-run - (avy-action-goto (avy-candidate-beg candidate)))))) - -;;;###autoload -(defun swiper-avy () - "Jump to one of the current swiper candidates with `avy'." - (interactive) - (unless (require 'avy nil 'noerror) - (user-error "Package avy isn't installed")) - (cl-case (length ivy-text) - (0 - (user-error "Need at least one char of input")) - (1 - ;; FIXME: `swiper--update-input-ivy' expects string candidates, - ;; but `swiper-isearch' now uses buffer positions. - (when (stringp (ivy-state-current ivy-last)) - (let ((swiper-min-highlight 1)) - (swiper--update-input-ivy))))) - (swiper--avy-goto (swiper--avy-candidate))) - -(declare-function mc/create-fake-cursor-at-point "ext:multiple-cursors-core") -(declare-function multiple-cursors-mode "ext:multiple-cursors-core") - -(defun swiper-mc () - "Create a fake cursor for each `swiper' candidate. -Make sure `swiper-mc' is on `mc/cmds-to-run-once' list." - (interactive) - (unless (require 'multiple-cursors nil t) - (error "Multiple-cursors isn't installed")) - (unless (window-minibuffer-p) - (error "Call me only from `swiper'")) - (let ((cands (nreverse ivy--old-cands)) - (action (ivy--get-action ivy-last))) - (unless (string= ivy-text "") - (ivy-exit-with-action - (lambda (_) - (let (cand) - (while (setq cand (pop cands)) - (funcall action cand) - (when cands - (mc/create-fake-cursor-at-point)))) - (multiple-cursors-mode 1)))))) - -(defvar swiper--current-window-start nil - "Store `window-start' to restore it later. -This prevents a \"jumping\" behavior which occurs when variables -such as `scroll-conservatively' are set to a high value.") - -(defun swiper-recenter-top-bottom (&optional arg) - "Call (`recenter-top-bottom' ARG)." - (interactive "P") - (with-ivy-window - (recenter-top-bottom arg) - (setq swiper--current-window-start (window-start)))) - -(defvar swiper-font-lock-exclude - '(Man-mode - adoc-mode - bbdb-mode - bongo-library-mode - bongo-mode - bongo-playlist-mode - bookmark-bmenu-mode - circe-channel-mode - circe-query-mode - circe-server-mode - deadgrep-mode - debbugs-gnu-mode - dired-mode - elfeed-search-mode - elfeed-show-mode - emms-playlist-mode - emms-stream-mode - erc-mode - eshell-mode - eww-mode - forth-block-mode - forth-mode - fundamental-mode - gnus-article-mode - gnus-group-mode - gnus-summary-mode - help-mode - helpful-mode - jabber-chat-mode - magit-popup-mode - matrix-client-mode - matrix-client-room-list-mode - mu4e-headers-mode - mu4e-view-mode - nix-mode - notmuch-search-mode - notmuch-tree-mode - occur-edit-mode - occur-mode - org-agenda-mode - package-menu-mode - rcirc-mode - sauron-mode - sieve-mode - treemacs-mode - twittering-mode - vc-dir-mode - w3m-mode - woman-mode - xref--xref-buffer-mode) - "List of major-modes that are incompatible with `font-lock-ensure'.") - -(defun swiper-font-lock-ensure-p () - "Return non-nil if we should not `font-lock-ensure'." - (or (derived-mode-p 'magit-mode) - (bound-and-true-p magit-blame-mode) - (memq major-mode swiper-font-lock-exclude) - (not (derived-mode-p 'prog-mode)))) - -(defun swiper-font-lock-ensure () - "Ensure the entire buffer is highlighted." - (unless (or (swiper-font-lock-ensure-p) - (> (buffer-size) 100000) - (not font-lock-mode)) - (static-if (fboundp 'font-lock-ensure) - ;; Added in Emacs 25.1. - (font-lock-ensure) - (font-lock-fontify-buffer)))) - -(defvar swiper--format-spec "" - "Store the current candidates format spec.") - -(defvar swiper--width nil - "Store the number of digits needed for the longest line number.") - -(defvar swiper-use-visual-line nil - "When non-nil, use `line-move' instead of `forward-line'.") - -(defvar dired-isearch-filenames) -(declare-function dired-move-to-filename "dired") - -(defun swiper--line () - (let* ((beg (cond ((and (eq major-mode 'dired-mode) - (bound-and-true-p dired-isearch-filenames)) - (dired-move-to-filename) - (point)) - (swiper-use-visual-line - (save-excursion - (beginning-of-visual-line) - (point))) - (t - (point)))) - (end (if swiper-use-visual-line - (save-excursion - (end-of-visual-line) - (point)) - (line-end-position)))) - - (concat - " " - (buffer-substring beg end)))) - -(defvar swiper-use-visual-line-p - (lambda (n-lines) - (and visual-line-mode - ;; super-slow otherwise - (< (buffer-size) 20000) - (< n-lines 400))) - "A predicate that decides whether `line-move' or `forward-line' is used. -Note that `line-move' can be very slow.") - -(defun swiper--candidates (&optional numbers-width) - "Return a list of this buffer lines. - -NUMBERS-WIDTH, when specified, is used for width spec of line -numbers; replaces calculating the width from buffer line count." - (let* ((inhibit-field-text-motion t) - (n-lines (count-lines (point-min) (point-max)))) - (if (funcall swiper-use-visual-line-p n-lines) - (progn - (when (eq major-mode 'org-mode) - (require 'outline) - (if (fboundp 'outline-show-all) - ;; Added in Emacs 25.1. - (outline-show-all) - (with-no-warnings - (show-all)))) - (setq swiper-use-visual-line t)) - (setq swiper-use-visual-line nil)) - (unless (zerop n-lines) - (setq swiper--width (or numbers-width - (1+ (floor (log n-lines 10))))) - (setq swiper--format-spec - (format "%%-%dd " swiper--width)) - (let ((line-number 1) - (advancer (if swiper-use-visual-line - (lambda (arg) (line-move arg t)) - #'forward-line)) - candidates) - (save-excursion - (goto-char (point-min)) - (swiper-font-lock-ensure) - (while (< (point) (point-max)) - (when (swiper-match-usable-p) - (let ((str (swiper--line))) - (setq str (ivy-cleanup-string str)) - (let ((line-number-str - (format swiper--format-spec line-number))) - (if swiper-include-line-number-in-search - (setq str (concat line-number-str str)) - (put-text-property - 0 1 'display line-number-str str)) - (put-text-property - 0 1 'swiper-line-number line-number str)) - (push str candidates))) - (funcall advancer 1) - (cl-incf line-number)) - (nreverse candidates)))))) - -(defvar swiper--opoint nil - "Value of point when `swiper' or `swiper-isearch' starts.") - -;;;###autoload -(defun swiper-backward (&optional initial-input) - "`isearch-backward' with an overview. -When non-nil, INITIAL-INPUT is the initial search pattern." - (interactive) - (let ((ivy-index-functions-alist - '((swiper . ivy-recompute-index-swiper-backward)))) - (swiper initial-input))) - -;;;###autoload -(defun swiper-thing-at-point () - "`swiper' with `ivy-thing-at-point'." - (interactive) - (let ((thing (ivy-thing-at-point))) - (when (use-region-p) - (deactivate-mark)) - (swiper (regexp-quote thing)))) - -;;;###autoload -(defun swiper-all-thing-at-point () - "`swiper-all' with `ivy-thing-at-point'." - (interactive) - (let ((thing (ivy-thing-at-point))) - (when (use-region-p) - (deactivate-mark)) - (swiper-all (regexp-quote thing)))) - -(defun swiper--extract-matches (regex cands) - "Extract captured REGEX groups from CANDS." - (let (res) - (dolist (cand cands) - (setq cand (substring cand 1)) - (when (string-match regex cand) - (push (mapconcat (lambda (n) (match-string-no-properties n cand)) - (number-sequence - 1 - (/ (- (length (match-data)) 2) 2)) - " ") - res))) - (nreverse res))) - -(defun swiper--occur-cands (fname cands) - (when cands - (with-current-buffer (ivy-state-buffer ivy-last) - (when (eq (ivy-state-caller ivy-last) 'swiper-isearch) - (setq cands (mapcar #'swiper--line-at-point cands))) - (let* ((pt-min (point-min)) - (line-delta - (save-restriction - (widen) - (1- (line-number-at-pos pt-min)))) - (lines - (if (eq (ivy-state-caller ivy-last) 'swiper-isearch) - (swiper--isearch-occur-cands cands) - (mapcar (lambda (s) - (let ((n (swiper--line-number s))) - (setq s (substring s 1)) - (add-text-properties 0 1 (list 'swiper-line-number n) s) - (cons n s))) - cands))) - (offset (+ (length fname) 2))) - (mapcar (lambda (x) - (let ((nn (number-to-string - (+ (car x) line-delta)))) - (remove-text-properties 0 1 '(display) (cdr x)) - (put-text-property 0 (length nn) 'face 'ivy-grep-line-number nn) - (put-text-property 0 1 'offset (+ offset (length nn)) fname) - (format "%s:%s:%s" fname nn (cdr x)))) - lines))))) - -(defun swiper--isearch-occur-cands (cands) - (let* ((last-pt (get-text-property 0 'point (car cands))) - (line (1+ (line-number-at-pos last-pt))) - res pt) - (dolist (cand cands) - (setq pt (get-text-property 0 'point cand)) - (cl-incf line (1- (count-lines last-pt pt))) - (push (cons line cand) res) - (setq last-pt pt)) - (nreverse res))) - -(defun swiper--occur-insert-lines (cands) - (let ((inhibit-read-only 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 cands) - (goto-char (point-min)) - (forward-line 4))) - -(defun swiper--occur-buffer () - (let ((buffer (ivy-state-buffer ivy-last))) - (unless (buffer-live-p buffer) - (setq buffer - (setf (ivy-state-buffer ivy-last) - (find-file-noselect - (plist-get (ivy-state-extra-props ivy-last) :fname)))) - (save-selected-window - (pop-to-buffer buffer)) - (setf (ivy-state-window ivy-last) (selected-window))) - buffer)) - -(defun swiper-occur (&optional cands) - "Generate a custom occur buffer for `swiper'. -When capture groups are present in the input, print them instead of lines." - (setq cands (or ivy-marked-candidates cands)) - (let* ((buffer (swiper--occur-buffer)) - (fname (propertize - (with-ivy-window - (if (buffer-file-name buffer) - (file-name-nondirectory - (buffer-file-name buffer)) - (buffer-name buffer))) - 'face - 'ivy-grep-info)) - (re - (progn - (string-match "\"\\(.*\\)\"" (buffer-name)) - (ivy-set-text (match-string 1 (buffer-name))) - (mapconcat #'identity (ivy--split ivy-text) ".*?"))) - (cands - (swiper--occur-cands - fname - (or cands - (save-window-excursion - (switch-to-buffer buffer) - (if (eq (ivy-state-caller ivy-last) 'swiper) - (let ((ivy--regex-function 'swiper--re-builder)) - (setq ivy--old-re nil) - (ivy--filter re (swiper--candidates))) - (swiper-isearch-function ivy-text))))))) - (if (string-match-p "\\\\(" re) - (insert - (mapconcat #'identity - (swiper--extract-matches - re (with-current-buffer buffer - (swiper--candidates))) - "\n")) - (unless (eq major-mode 'ivy-occur-grep-mode) - (ivy-occur-grep-mode) - (font-lock-mode -1)) - (swiper--occur-insert-lines - (mapcar (lambda (cand) (concat "./" cand)) cands))))) - -(declare-function evil-set-jump "ext:evil-jumps") - -(defvar swiper--current-line nil) -(defvar swiper--current-match-start nil) -(defvar swiper--point-min nil) -(defvar swiper--point-max nil) -(defvar swiper--reveal-mode nil) - -(defun swiper--init () - "Perform initialization common to both completion methods." - (setq swiper--current-line nil) - (setq swiper--current-match-start nil) - (setq swiper--current-window-start nil) - (setq swiper--opoint (point)) - (setq swiper--point-min (point-min)) - (setq swiper--point-max (point-max)) - (when (setq swiper--reveal-mode - (bound-and-true-p reveal-mode)) - (reveal-mode -1)) - (lazy-highlight-cleanup t) - (setq isearch-opened-overlays nil) - (when (bound-and-true-p evil-mode) - (evil-set-jump))) - -(defun swiper--normalize-regex (re) - "Normalize the Swiper regexp RE. -Add a space after a leading `^' for `swiper', and apply -`search-default-mode' if bound in the original buffer." - (replace-regexp-in-string - "^\\(?:\\\\(\\)?\\^" - (concat "\\&" (if (eq 'swiper (ivy-state-caller ivy-last)) " " "")) - (let ((mode (with-ivy-window (bound-and-true-p search-default-mode)))) - (if (functionp mode) - (mapconcat - (lambda (x) - (if (string-match-p "\\`[^$\\^]+\\'" x) - (funcall mode x) - x)) - (split-string re "\\b") "") - re)) - t)) - -(defun swiper--re-builder (str) - "Transform STR into a swiper regex. -This is the regex used in the minibuffer where candidates have -line numbers. For the buffer, use `ivy--regex' instead." - (let* ((re-builder (ivy-alist-setting ivy-re-builders-alist)) - (str (ivy--string-replace "\\n" "\n" str)) - (re (funcall re-builder str))) - (if (consp re) - (mapcar - (lambda (x) - (cons (swiper--normalize-regex (car x)) - (cdr x))) - re) - (swiper--normalize-regex re)))) - -(defvar swiper-history nil - "History for `swiper'.") - -(defvar swiper-invocation-face nil - "The face at the point of invocation of `swiper'.") - -(defcustom swiper-stay-on-quit nil - "When non-nil don't go back to search start on abort." - :type 'boolean) - -;;;###autoload -(defun swiper (&optional initial-input) - "`isearch-forward' with an overview. -When non-nil, INITIAL-INPUT is the initial search pattern." - (interactive) - (let ((candidates (swiper--candidates))) - (swiper--init) - (setq swiper-invocation-face - (plist-get (text-properties-at (point)) 'face)) - (let ((preselect - (if (or swiper-use-visual-line (null search-invisible)) - (count-screen-lines - (point-min) - (save-excursion (beginning-of-visual-line) (point))) - (1- (line-number-at-pos)))) - (minibuffer-allow-text-properties t) - res) - (unwind-protect - (and - (setq res - (ivy-read - "Swiper: " - candidates - :initial-input initial-input - :keymap swiper-map - :preselect - (if initial-input - (cl-position-if - (lambda (x) - (<= (1+ preselect) (swiper--line-number x))) - (progn - (setq ivy--old-re nil) - (ivy--filter initial-input candidates))) - preselect) - :require-match t - :action #'swiper--action - :re-builder #'swiper--re-builder - :history 'swiper-history - :extra-props (list :fname (buffer-file-name)) - :caller 'swiper)) - (point)) - (unless (or res swiper-stay-on-quit) - (goto-char swiper--opoint)) - (isearch-clean-overlays) - (unless (or res (string= ivy-text "")) - (cl-pushnew ivy-text swiper-history)) - (setq swiper--current-window-start nil) - (when swiper--reveal-mode - (reveal-mode 1)))))) - -(ivy-configure 'swiper - :occur #'swiper-occur - :update-fn #'swiper--update-input-ivy - :unwind-fn #'swiper--cleanup - :index-fn #'ivy-recompute-index-swiper) - -(ivy-add-actions 'swiper - `(("w" ,#'swiper-action-copy "copy"))) - -(defun swiper-toggle-face-matching () - "Toggle matching only the candidates with `swiper-invocation-face'." - (interactive) - (setf (ivy-state-matcher ivy-last) - (if (ivy-state-matcher ivy-last) - nil - #'swiper--face-matcher)) - (setq ivy--old-re nil)) - -(defun swiper--face-matcher (regexp candidates) - "Return REGEXP matching CANDIDATES. -Matched candidates should have `swiper-invocation-face'." - (cl-remove-if-not - (lambda (x) - (and (string-match regexp x) - (let* ((s (match-string 0 x)) - (n (length s)) - (i 0)) - (while (and (< i n) - (text-property-any - i (1+ i) - 'face swiper-invocation-face - s)) - (cl-incf i)) - (= i n)))) - candidates)) - -(defun swiper--ensure-visible () - "Remove overlays hiding point." - (let ((overlays (overlays-at (1- (point)))) - ov expose) - (while (setq ov (pop overlays)) - (if (and (invisible-p (overlay-get ov 'invisible)) - (setq expose (overlay-get ov 'isearch-open-invisible))) - (funcall expose ov))))) - -(defvar swiper--overlays nil - "Store overlays.") - -(defvar swiper--isearch-highlight-timer nil - "This timer used by `swiper--delayed-add-overlays'.") - -(defun swiper--cleanup () - "Clean up the overlays." - (while swiper--overlays - (delete-overlay (pop swiper--overlays))) - ;; force cleanup unless it's :unwind - (lazy-highlight-cleanup - (if (eq ivy-exit 'done) lazy-highlight-cleanup t)) - (when (timerp swiper--isearch-highlight-timer) - (cancel-timer swiper--isearch-highlight-timer) - (setq swiper--isearch-highlight-timer nil))) - -(defun swiper--add-cursor-overlay (wnd) - (let* ((special (or (eolp) (looking-at "\t"))) - (ov (make-overlay (point) (if special (point) (1+ (point)))))) - (if special - (overlay-put ov 'after-string (propertize " " 'face 'ivy-cursor)) - (overlay-put ov 'face 'ivy-cursor)) - (overlay-put ov 'window wnd) - (overlay-put ov 'priority 2) - (push ov swiper--overlays))) - -(defun swiper--add-line-overlay (wnd) - (let ((beg (if visual-line-mode - (save-excursion - (beginning-of-visual-line) - (point)) - (line-beginning-position))) - (end (if visual-line-mode - (save-excursion - (end-of-visual-line) - (point)) - (1+ (line-end-position))))) - (push (swiper--make-overlay beg end 'swiper-line-face wnd 0) - swiper--overlays))) - -(defun swiper--make-overlay (beg end face wnd priority) - "Create an overlay bound by BEG and END. -FACE, WND and PRIORITY are properties corresponding to -the face, window and priority of the overlay." - (let ((overlay (make-overlay beg end))) - (overlay-put overlay 'face face) - (overlay-put overlay 'window wnd) - (overlay-put overlay 'priority priority) - overlay)) - -(defun swiper--recenter-p () - (or (display-graphic-p) - (not recenter-redisplay))) - -(defun swiper--update-input-ivy () - "Called when `ivy' input is updated." - (with-ivy-window - (swiper--cleanup) - (when (> (length (ivy-state-current ivy-last)) 0) - (let ((regexps (ivy--positive-regexps)) - (re-idx -1) - (case-fold-search (ivy--case-fold-p ivy-text))) - (dolist (re regexps) - (setq re-idx (1+ re-idx)) - (let* ((re (ivy--string-replace " " "\t" re)) - (num (swiper--line-number (ivy-state-current ivy-last)))) - (unless (memq this-command '(ivy-yank-word - ivy-yank-symbol - ivy-yank-char - scroll-other-window)) - (when (cl-plusp num) - (unless (if swiper--current-line - (eq swiper--current-line num) - (eq (line-number-at-pos) num)) - (goto-char swiper--point-min) - (if swiper-use-visual-line - (line-move (1- num)) - (forward-line (1- num)))) - (if (and (equal ivy-text "") - (<= (line-beginning-position) - swiper--opoint - (line-end-position))) - (goto-char swiper--opoint) - (if (eq swiper--current-line num) - (when swiper--current-match-start - (goto-char swiper--current-match-start)) - (setq swiper--current-line num)) - (when (re-search-forward re (line-end-position) t) - (setq swiper--current-match-start (match-beginning 0)))) - (funcall isearch-filter-predicate - (line-beginning-position) - (line-end-position)) - (swiper--maybe-recenter))) - (swiper--add-overlays - re - (max - (if (swiper--recenter-p) - (window-start) - (line-beginning-position (- (window-height)))) - swiper--point-min) - (min - (if (swiper--recenter-p) - (window-end (selected-window) t) - (line-end-position (window-height))) - swiper--point-max) - nil - re-idx))))))) - -(defun swiper--add-overlays (re &optional beg end wnd re-idx) - "Add overlays for RE regexp in visible part of the current buffer. -BEG and END, when specified, are the point bounds. -WND, when specified is the window." - (setq wnd (or wnd (ivy-state-window ivy-last))) - (swiper--add-line-overlay wnd) - (let* ((pt (point)) - (wh (window-height)) - (beg (or beg (save-excursion - (forward-line (- wh)) - (point)))) - (end (or end (save-excursion - (forward-line wh) - (point)))) - (case-fold-search (ivy--case-fold-p re))) - (when (>= (length re) swiper-min-highlight) - (save-excursion - (goto-char beg) - ;; RE can become an invalid regexp - (while (progn - (when (eolp) - (unless (eobp) - (forward-char))) - (and (ignore-errors (re-search-forward re end t)) - (> (- (match-end 0) (match-beginning 0)) 0))) - ;; Don't highlight a match if it spans multiple - ;; lines. `count-lines' returns 1 if the match is within a - ;; single line, even if it includes the newline, and 2 or - ;; greater otherwise. We hope that the inclusion of the - ;; newline will not ever be a problem in practice. - (when (< (count-lines (match-beginning 0) (match-end 0)) 2) - (let* ((faces (if (= (match-end 0) pt) - swiper-faces - swiper-background-faces)) - (adder-fn (lambda (beg end face priority) - (push (swiper--make-overlay beg end face wnd priority) - isearch-lazy-highlight-overlays)))) - (unless (and (consp ivy--old-re) - (null - (save-match-data - (ivy--re-filter ivy--old-re - (list - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position))))))) - (swiper--add-properties faces adder-fn re-idx))))))))) - -(defun swiper--add-properties (faces adder-fn &optional re-idx) - (let ((mb (match-beginning 0)) - (me (match-end 0))) - (unless (> (- me mb) 2017) - (funcall adder-fn - mb me - (if (and ivy-use-group-face-if-no-groups (zerop ivy--subexps)) - (nth (1+ (mod (or re-idx 0) (1- (length faces)))) faces) - (car faces)) - 0))) - (let ((i 1) - (j 0)) - (while (<= (cl-incf j) ivy--subexps) - (let ((bm (match-beginning j)) - (em (match-end j))) - (when (and (integerp em) - (integerp bm)) - (when (eq (ivy-alist-setting ivy-re-builders-alist t) #'ivy--regex-fuzzy) - (while (and (< j ivy--subexps) - (integerp (match-beginning (+ j 1))) - (= em (match-beginning (+ j 1)))) - (setq em (match-end (cl-incf j))))) - (funcall adder-fn - bm em - (nth (1+ (mod (+ i 2) (1- (length faces)))) - faces) - i) - (cl-incf i)))))) - -(defcustom swiper-action-recenter nil - "When non-nil, recenter after exiting `swiper'." - :type 'boolean) -(defvar evil-search-module) -(defvar evil-ex-search-pattern) -(defvar evil-ex-search-persistent-highlight) -(defvar evil-ex-search-direction) -(declare-function evil-ex-search-activate-highlight "ext:evil-search") - -(defun swiper--maybe-recenter () - (cond (swiper-action-recenter - (recenter)) - ((swiper--recenter-p) - (when swiper--current-window-start - (set-window-start (selected-window) swiper--current-window-start)) - (when (or - (< (point) (window-start)) - (> (point) (window-end (ivy-state-window ivy-last) t))) - (recenter)))) - (setq swiper--current-window-start (window-start))) - -(defun swiper--line-number (x) - (or (get-text-property 0 'swiper-line-number x) - (get-text-property 1 'swiper-line-number x))) - -(defcustom swiper-verbose t - "When non-nil, print more informational messages." - :type 'boolean) - -(defun swiper--push-mark () - (when (/= (point) swiper--opoint) - (unless (and transient-mark-mode mark-active) - (when (eq ivy-exit 'done) - (push-mark swiper--opoint t) - (when swiper-verbose - (message "Mark saved where search started")))))) - -(defun swiper--action (x) - "Goto line X." - (let ((ln (1- (swiper--line-number x))) - (re (ivy--regex ivy-text)) - (case-fold-search (ivy--case-fold-p ivy-text))) - (if (null x) - (user-error "No candidates") - (with-ivy-window - (unless (equal (current-buffer) - (ivy-state-buffer ivy-last)) - (switch-to-buffer (ivy-state-buffer ivy-last))) - (goto-char - (if (buffer-narrowed-p) - swiper--point-min - (point-min))) - (funcall (if swiper-use-visual-line - #'line-move - #'forward-line) - ln) - (when (and (re-search-forward re (line-end-position) t) - swiper-goto-start-of-match) - (goto-char (match-beginning 0))) - (swiper--ensure-visible) - (swiper--maybe-recenter) - (swiper--push-mark) - (swiper--remember-search-history re))))) - -(defun swiper--remember-search-history (re) - "Add the search pattern RE to the search history ring." - (add-to-history - 'regexp-search-ring - re - regexp-search-ring-max) - ;; integration with evil-mode's search - (when (bound-and-true-p evil-mode) - (when (eq evil-search-module 'isearch) - (setq isearch-string ivy-text)) - (when (eq evil-search-module 'evil-search) - (add-to-history 'evil-ex-search-history re) - (setq evil-ex-search-pattern (list re t t)) - (setq evil-ex-search-direction 'forward) - (when evil-ex-search-persistent-highlight - (evil-ex-search-activate-highlight evil-ex-search-pattern))))) - -(defun swiper-from-isearch () - "Invoke `swiper' from isearch." - (interactive) - (swiper (prog1 (if isearch-regexp - isearch-string - (regexp-quote isearch-string)) - (let ((search-nonincremental-instead nil)) - (isearch-exit))))) - -(defvar swiper-multi-buffers nil - "Store the current list of buffers.") - -(defvar swiper-multi-candidates nil - "Store the list of candidates for `swiper-multi'.") - -(defun swiper-multi-prompt () - "Return prompt for `swiper-multi'." - (format "Buffers (%s): " - (mapconcat #'identity swiper-multi-buffers ", "))) - -(defvar swiper-window-width 80) - -(defun swiper-multi () - "Select one or more buffers. -Run `swiper' for those buffers." - (interactive) - (setq swiper-multi-buffers nil) - (let ((ivy-use-virtual-buffers nil)) - (ivy-read (swiper-multi-prompt) - #'internal-complete-buffer - :action #'swiper-multi-action-1)) - (let ((swiper-window-width (- (- (frame-width) (if (display-graphic-p) 0 1)) 4))) - (ivy-read "Swiper: " swiper-multi-candidates - :action #'swiper-multi-action-2 - :caller 'swiper-multi))) - -(ivy-configure 'swiper-multi - :unwind-fn #'swiper--cleanup - :index-fn #'ivy-recompute-index-swiper - :format-fn #'swiper--all-format-function) - -(defun swiper-multi-action-1 (x) - "Add X to list of selected buffers `swiper-multi-buffers'. -If X is already part of the list, remove it instead. Quit the selection if -X is selected by either `ivy-done', `ivy-alt-done' or `ivy-immediate-done', -otherwise continue prompting for buffers." - (if (member x swiper-multi-buffers) - (progn - (setq swiper-multi-buffers (delete x swiper-multi-buffers))) - (unless (equal x "") - (setq swiper-multi-buffers (append swiper-multi-buffers (list x))))) - (let ((prompt (swiper-multi-prompt))) - (setf (ivy-state-prompt ivy-last) prompt) - (setq ivy--prompt (concat "%-4d " prompt))) - (cond ((memq this-command '(ivy-done - ivy-alt-done - ivy-immediate-done)) - (setq swiper-multi-candidates - (swiper--multi-candidates - (mapcar #'get-buffer swiper-multi-buffers)))) - ((eq this-command 'ivy-call) - (with-selected-window (active-minibuffer-window) - (delete-minibuffer-contents))))) - -(defun swiper-multi-action-2 (x) - "Move to candidate X from `swiper-multi'." - (when (> (length x) 0) - (let ((buffer-name (get-text-property 0 'buffer x))) - (when buffer-name - (with-ivy-window - (switch-to-buffer buffer-name) - (goto-char (point-min)) - (forward-line (1- (swiper--line-number x))) - (re-search-forward - (ivy--regex ivy-text) - (line-end-position) t) - (funcall isearch-filter-predicate - (line-beginning-position) - (line-end-position)) - (unless (eq ivy-exit 'done) - (swiper--cleanup) - (swiper--add-overlays (ivy--regex ivy-text)))))))) - -(defun swiper-all-buffer-p (buffer) - "Return non-nil if BUFFER should be considered by `swiper-all'." - (let ((mode (buffer-local-value 'major-mode (get-buffer buffer)))) - (cond - ;; Ignore TAGS buffers, they tend to add duplicate results. - ((eq mode #'tags-table-mode) nil) - ;; Always consider dired buffers, even though they're not backed - ;; by a file. - ((eq mode #'dired-mode) t) - ;; Always consider stash buffers too, as they may have - ;; interesting content not present in any buffers. We don't #' - ;; quote to satisfy the byte-compiler. - ((eq mode 'magit-stash-mode) t) - ;; Email buffers have no file, but are useful to search - ((eq mode 'gnus-article-mode) t) - ;; Otherwise, only consider the file if it's backed by a file. - (t (buffer-file-name buffer))))) - -;;; `swiper-all' - -(defun swiper-all-function (str) - "Search in all open buffers for STR." - (or - (ivy-more-chars) - (let* ((buffers (cl-delete-if-not #'swiper-all-buffer-p (buffer-list))) - (re-full ivy-regex) - re re-tail - cands match - (case-fold-search (ivy--case-fold-p str))) - (setq re (ivy-re-to-str re-full)) - (when (consp re-full) - (setq re-tail (cdr re-full))) - (dolist (buffer buffers) - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq match (if (memq major-mode '(org-mode dired-mode)) - (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)) - (buffer-substring - (line-beginning-position) - (line-end-position)))) - (put-text-property - 0 1 'buffer - (buffer-name) - match) - (put-text-property 0 1 'point (point) match) - (when (or (null re-tail) (ivy-re-match re-tail match)) - (push match cands)))))) - (setq ivy--old-re re-full) - (if (null cands) - (list "") - (setq ivy--old-cands (nreverse cands)))))) - -(defun swiper--all-format-function (cands) - "Format CANDS for `swiper-all'. -See `ivy-format-functions-alist' for further information." - (let* ((ww swiper-window-width) - (col2 1) - (cands-with-buffer - (mapcar (lambda (s) - (let ((buffer (get-text-property 0 'buffer s))) - (setq col2 (max col2 (length buffer))) - (cons s buffer))) cands)) - (col1 (- ww 4 col2))) - (setq cands - (mapcar (lambda (x) - (if (cdr x) - (let ((s (ivy--truncate-string (car x) col1))) - (concat - s - (make-string - (max 0 - (- ww (string-width s) (length (cdr x)))) - ?\ ) - (cdr x))) - (car x))) - cands-with-buffer)) - (ivy--format-function-generic - (lambda (str) - (ivy--add-face str 'ivy-current-match)) - (lambda (str) - str) - cands - "\n"))) - -(defvar swiper-all-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-q") #'swiper-all-query-replace) - map) - "Keymap for `swiper-all'.") - -;;;###autoload -(defun swiper-all (&optional initial-input) - "Run `swiper' for all open buffers." - (interactive) - (let ((swiper-window-width (- (frame-width) (if (display-graphic-p) 0 1)))) - (ivy-read "swiper-all: " 'swiper-all-function - :action #'swiper-all-action - :dynamic-collection t - :keymap swiper-all-map - :initial-input initial-input - :caller 'swiper-all))) - -(ivy-configure 'swiper-all - :update-fn 'auto - :unwind-fn #'swiper--cleanup - :format-fn #'swiper--all-format-function) - -(defun swiper-all-action (x) - "Move to candidate X from `swiper-all'." - (when (> (length x) 0) - (let ((buffer-name (get-text-property 0 'buffer x))) - (when buffer-name - (with-ivy-window - (switch-to-buffer buffer-name) - (goto-char (get-text-property 0 'point x)) - (funcall isearch-filter-predicate - (line-beginning-position) - (line-end-position)) - (unless (eq ivy-exit 'done) - (swiper--cleanup) - (swiper--add-overlays (ivy--regex ivy-text)))))))) - -(defun swiper--multi-candidates (buffers) - "Extract candidates from BUFFERS." - (let ((res nil)) - (dolist (buf buffers) - (with-current-buffer buf - (setq res - (nconc - (mapcar - (lambda (s) (put-text-property 0 1 'buffer (buffer-name) s) s) - (swiper--candidates 4)) - res)))) - res)) - -;;; `swiper-isearch' - -(defun swiper-isearch-function (str) - "Collect STR matches in the current buffer for `swiper-isearch'." - (with-ivy-window - (swiper--isearch-function str))) - -(defun swiper-match-usable-p () - (or search-invisible - (not (cl-find-if - (lambda (ov) - (invisible-p (overlay-get ov 'invisible))) - (overlays-at (point)))))) - -(defvar swiper--isearch-backward nil - "Non-nil when performing `swiper-isearch-backward'.") - -(defun swiper--isearch-function-1 (re backward) - (unless (string= re ".") - (let (cands) - (save-excursion - (goto-char (if backward (point-max) (point-min))) - (while (and (funcall (if backward #'re-search-backward #'re-search-forward) re nil t) - (not (and - (= (match-beginning 0) (match-end 0)) - (if backward (bobp) (eobp))))) - (when (swiper-match-usable-p) - (let ((pos (if (or backward swiper-goto-start-of-match) - (match-beginning 0) - (point)))) - (push pos cands))) - (when (= (match-beginning 0) (match-end 0)) - (if backward - (backward-char) - (forward-char))))) - (if backward - cands - (nreverse cands))))) - -(defun swiper--isearch-next-item (re cands) - (or (if swiper--isearch-backward - (save-excursion - ;; Match RE starting at each position in CANDS. - (setq re (concat "\\=\\(?:" re "\\)")) - (cl-position-if - (lambda (x) - (when (< x swiper--opoint) - (goto-char x) - ;; Note: Not quite the same as `looking-at' + `match-end'. - (re-search-forward re swiper--opoint t))) - cands - :from-end t)) - (cl-position swiper--opoint cands :test #'<)) - 0)) - -(defun swiper--isearch-filter-ignore-order (re-full cands) - (let (filtered-cands) - (dolist (re-cons re-full cands) - (save-excursion - (dolist (cand cands) - (goto-char cand) - (beginning-of-line) - (unless (if (re-search-forward (car re-cons) (line-end-position) t) - (not (cdr re-cons)) - (cdr re-cons)) - (push cand filtered-cands)))) - (setq cands (nreverse filtered-cands)) - (setq filtered-cands nil)))) - -(defun swiper--isearch-function (str) - (let ((re-full ivy-regex)) - (unless (equal re-full "") - (let* ((case-fold-search (ivy--case-fold-p str)) - (re - (if (stringp re-full) - re-full - (mapconcat - #'ivy--regex-or-literal - (delq nil (mapcar (lambda (x) (and (cdr x) (car x))) re-full)) - "\\|"))) - (cands (swiper--isearch-function-1 re swiper--isearch-backward))) - (when (consp re-full) - (setq cands (swiper--isearch-filter-ignore-order re-full cands))) - (setq ivy--old-re re) - (ivy-set-index (swiper--isearch-next-item re cands)) - (setq ivy--old-cands cands))))) - -(defcustom swiper-isearch-highlight-delay '(2 0.2) - "When `ivy-text' is too short, delay showing the overlay. - -The default value will delay showing the overlay by 0.2 seconds -if `ivy-text' is shorter than 2 characters. - -The aim is to reduce the visual clutter, since it's very rare -that we search only for one character." - :type '(list - (integer :tag "Text length") - (float :tag "Delay in seconds"))) - -(defun swiper--delayed-add-overlays () - (if (and swiper-isearch-highlight-delay - (< (length ivy-text) (car swiper-isearch-highlight-delay))) - (setq swiper--isearch-highlight-timer - (run-with-idle-timer - (cadr swiper-isearch-highlight-delay) nil - (lambda () - (with-ivy-window - (swiper--add-overlays (ivy--regex ivy-text)))))) - (dolist (re (ivy--positive-regexps)) - (swiper--add-overlays re)))) - -(defun swiper--isearch-candidate-pos (cand) - "Return the buffer position of `swiper-isearch' CAND, or nil." - (cond ((integer-or-marker-p cand) cand) - ((and (stringp cand) (> (length cand) 0)) - (get-text-property 0 'point cand)))) - -(defun swiper--isearch-candidate-string (cand) - "Return full match of `swiper-isearch' candidate CAND. -Signal an error on failure." - ;; FIXME: Better way of getting current candidate? - (or (let ((pos (swiper--isearch-candidate-pos cand)) - (re (ivy-re-to-str ivy-regex))) - (save-match-data - (save-excursion - (and pos (goto-char pos) - (if (or swiper--isearch-backward swiper-goto-start-of-match) - (looking-at re) - (looking-back re (point-min))) - (match-string 0))))) - (error "Could not extract `swiper-isearch' candidate: %S" cand))) - -(defun swiper-isearch-action (x) - "Move to X for `swiper-isearch'." - (if (setq x (swiper--isearch-candidate-pos x)) - (with-ivy-window - (goto-char x) - (when (and (or (eq this-command 'ivy-previous-line-or-history) - (and (eq this-command 'ivy-done) - (eq last-command 'ivy-previous-line-or-history))) - (looking-back ivy-regex (line-beginning-position))) - (goto-char (match-beginning 0))) - (funcall isearch-filter-predicate (point) (1+ (point))) - (swiper--maybe-recenter) - (if (or (eq ivy-exit 'done) - ;; FIXME: With the default action 'M-o o', `ivy-exit' remains - ;; nil for some reason, so check `this-command' instead to - ;; tell whether we're "done". - (eq this-command #'ivy-dispatching-done)) - (progn - (swiper--push-mark) - (swiper--remember-search-history (ivy--regex ivy-text))) - (swiper--cleanup) - (swiper--delayed-add-overlays) - (swiper--add-cursor-overlay - (ivy-state-window ivy-last)))) - (swiper--cleanup))) - -(defun swiper-action-copy (_x) - "Copy line at point and go back." - (kill-new - (buffer-substring-no-properties - (line-beginning-position) (line-end-position))) - (goto-char swiper--opoint)) - -(defun swiper-isearch-action-copy (cand) - "Save `swiper-isearch' candidate CAND to `kill-ring'. -Return to original position." - (unwind-protect - (kill-new (swiper--isearch-candidate-string cand)) - ;; In case of unexpected error. - (goto-char swiper--opoint))) - -(defun swiper-isearch-action-insert (cand) - "Insert `swiper-isearch' candidate CAND where invoked. -This cannot currently be called repeatedly without exiting -completion." - (goto-char swiper--opoint) - (unwind-protect - ;; FIXME: This seems to invalidate many cached buffer positions, thus - ;; breaking `ivy-dispatching-call'. - (insert (swiper--isearch-candidate-string cand)) - ;; In case of unexpected error. - (goto-char swiper--opoint))) - -(defun swiper--isearch-insert-current () - "Replace minibuffer contents with the current candidate. -Like `ivy-insert-current', but tailored for `swiper-isearch'." - (interactive) - (delete-minibuffer-contents) - (let ((cur (ivy-state-current ivy-last))) - (insert (with-ivy-window (swiper--isearch-candidate-string cur))))) - -(defun swiper--isearch-kill-ring-save () - "Save the current candidates in the kill ring. -If the region is active, forward to `kill-ring-save' instead. -Like `ivy-kill-ring-save', but tailored for `swiper-isearch'." - (interactive) - (if (use-region-p) - (call-interactively #'kill-ring-save) - (kill-new (with-ivy-window - (mapconcat #'swiper--line-at-point ivy--old-cands "\n"))))) - -(defun swiper-isearch-thing-at-point () - "Insert `symbol-at-point' into the minibuffer of `swiper-isearch'. -When not running `swiper-isearch' already, start it." - (interactive) - (if (window-minibuffer-p) - (let (bnd str regionp) - (with-ivy-window - (setq bnd - (if (setq regionp (region-active-p)) - (prog1 (cons (region-beginning) (region-end)) - (deactivate-mark)) - (bounds-of-thing-at-point 'symbol))) - (setq str (buffer-substring-no-properties (car bnd) (cdr bnd)))) - (insert str) - (unless regionp - (ivy--insert-symbol-boundaries))) - (let (thing) - (if (use-region-p) - (progn - (setq thing (buffer-substring-no-properties - (region-beginning) (region-end))) - (goto-char (region-beginning)) - (deactivate-mark)) - (let ((bnd (bounds-of-thing-at-point 'symbol))) - (when bnd - (goto-char (car bnd))) - (setq thing (ivy-thing-at-point)))) - (swiper-isearch thing)))) - -(defun swiper-isearch-C-r (&optional arg) - "Move cursor vertically up ARG candidates. -When the input is empty, browse the search history instead." - (interactive "p") - (if (string= ivy-text "") - (ivy-reverse-i-search) - (ivy-previous-line arg))) - -(defvar swiper-isearch-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map swiper-map) - (define-key map `[remap ,#'ivy-insert-current] - #'swiper--isearch-insert-current) - (define-key map `[remap ,#'ivy-kill-ring-save] - #'swiper--isearch-kill-ring-save) - (define-key map `[remap ,#'kill-ring-save] - #'swiper--isearch-kill-ring-save) - (define-key map (kbd "M-n") #'swiper-isearch-thing-at-point) - (define-key map (kbd "C-r") #'swiper-isearch-C-r) - map) - "Keymap for `swiper-isearch'.") - -(defun swiper--isearch-same-line-p (s1 s2) - "Check if S1 and S2 are equal and on the same line." - (and (equal s1 s2) - (<= (count-lines - (get-text-property 0 'point s2) - (get-text-property 0 'point s1)) - 1))) - -(defun swiper-isearch-format-function (cands) - (if (numberp (car-safe cands)) - (let ((re (ivy-re-to-str ivy-regex))) - (if (string= re "^$") - "" - (mapconcat - #'identity - (swiper--isearch-format - ivy--index ivy--length (or ivy--old-cands ivy--all-candidates) - re - (ivy-state-current ivy-last) - (ivy-state-buffer ivy-last)) - "\n"))) - (funcall - (ivy-alist-setting ivy-format-functions-alist t) - cands))) - -(defun swiper--line-at-point (pt) - (save-excursion - (goto-char pt) - (let ((s (buffer-substring - (line-beginning-position) - (line-end-position)))) - (if (string= s "") - s - (put-text-property 0 1 'point pt s) - (ivy-cleanup-string s))))) - -(defun swiper--isearch-highlight (str &optional current) - (let ((start 0) - (i 0) - (re (ivy-re-to-str ivy-regex))) - (catch 'done - (while (string-match re str start) - (if (= (match-beginning 0) (match-end 0)) - (throw 'done t) - (setq start (match-end 0))) - (swiper--add-properties - (if (eq current i) - swiper-faces - swiper-background-faces) - (lambda (beg end face _priority) - (add-face-text-property beg end face nil str))) - (cl-incf i))) - str)) - -(defun swiper--isearch-format (index length cands regex current buffer) - (let* ((half-height (/ ivy-height 2)) - (i (1- index)) - (j 0) - (len 0) - res s) - (with-current-buffer buffer - (while (and (>= i 0) - (swiper--isearch-same-line-p - (swiper--line-at-point (nth i cands)) - (swiper--line-at-point current))) - (cl-decf i) - (cl-incf j)) - (while (and (>= i 0) - (< len half-height)) - (setq s (swiper--line-at-point (nth i cands))) - (unless (swiper--isearch-same-line-p s (car res)) - (push (swiper--isearch-highlight s) res) - (cl-incf len)) - (cl-decf i)) - (setq res (nreverse res)) - (let ((current-str - (swiper--line-at-point current)) - (start 0)) - (dotimes (_ (1+ j)) - (string-match regex current-str start) - (setq start (match-end 0))) - (font-lock-prepend-text-property - 0 (length current-str) - 'face 'swiper-line-face current-str) - (swiper--isearch-highlight current-str j) - (push current-str res)) - (cl-incf len) - (setq i (1+ index)) - (while (and (< i length) - (swiper--isearch-same-line-p - (swiper--line-at-point (nth i cands)) - (swiper--line-at-point current))) - (cl-incf i)) - (while (and (< i length) - (< len ivy-height)) - (setq s (swiper--line-at-point (nth i cands))) - (unless (swiper--isearch-same-line-p s (car res)) - (push (swiper--isearch-highlight s) res) - (cl-incf len)) - (cl-incf i)) - (nreverse res)))) - -(defun swiper--isearch-init () - "Initialize `swiper-isearch'." - (swiper--init) - (swiper-font-lock-ensure)) - -(defun swiper--isearch-unwind () - (swiper--cleanup) - (unless (or (eq ivy-exit 'done) swiper-stay-on-quit) - (goto-char swiper--opoint)) - (isearch-clean-overlays) - (swiper--ensure-visible) - (unless (or (eq ivy-exit 'done) (string= ivy-text "")) - (cl-pushnew ivy-text swiper-history))) - -;;;###autoload -(defun swiper-isearch (&optional initial-input) - "A `swiper' that's not line-based." - (interactive) - (let ((ivy-fixed-height-minibuffer t) - (cursor-in-non-selected-windows nil) - (swiper-min-highlight 1)) - (ivy-read - "Swiper: " - #'swiper-isearch-function - :initial-input initial-input - :keymap swiper-isearch-map - :dynamic-collection t - :require-match t - :action #'swiper-isearch-action - :re-builder #'swiper--re-builder - :history 'swiper-history - :extra-props (list :fname (buffer-file-name)) - :caller 'swiper-isearch))) - -(ivy-configure 'swiper-isearch - :occur #'swiper-occur - :init-fn #'swiper--isearch-init - :update-fn 'auto - :unwind-fn #'swiper--isearch-unwind - :format-fn #'swiper-isearch-format-function) - -(ivy-add-actions 'swiper-isearch - `(("w" ,#'swiper-isearch-action-copy "copy") - ("i" ,#'swiper-isearch-action-insert "insert"))) - -;;;###autoload -(defun swiper-isearch-backward (&optional initial-input) - "Like `swiper-isearch' but the first result is before the point." - (interactive) - (let ((swiper--isearch-backward t)) - (swiper-isearch initial-input))) - -(defun swiper-isearch-toggle () - "Two-way toggle between `swiper-isearch' and isearch. -Intended to be bound in `isearch-mode-map' and `swiper-map'." - (interactive) - (if isearch-mode - (let ((query (if isearch-regexp - isearch-string - (regexp-quote isearch-string)))) - (isearch-exit) - (goto-char (or (and isearch-forward isearch-other-end) - (point))) - (swiper-isearch query)) - (ivy-exit-with-action - (lambda (_) - (when (looking-back (ivy-re-to-str ivy-regex) (line-beginning-position)) - (goto-char (match-beginning 0))) - (isearch-mode t) - (unless (string= ivy-text "") - (isearch-yank-string ivy-text)))))) - -(provide 'swiper) - -;;; swiper.el ends here diff --git a/.emacs.d/lisp/vertico.el b/.emacs.d/lisp/vertico.el new file mode 100644 index 0000000..a7b5f53 --- /dev/null +++ b/.emacs.d/lisp/vertico.el @@ -0,0 +1,749 @@ +;;; vertico.el --- VERTical Interactive COmpletion -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2025 Free Software Foundation, Inc. + +;; Author: Daniel Mendler +;; Maintainer: Daniel Mendler +;; Created: 2021 +;; Version: 2.6 +;; Package-Requires: ((emacs "29.1") (compat "30")) +;; URL: https://github.com/minad/vertico +;; Keywords: convenience, files, matching, completion + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Vertico provides a performant and minimalistic vertical completion UI +;; based on the default completion system. By reusing the built-in +;; facilities, Vertico achieves full compatibility with built-in Emacs +;; completion commands and completion tables. + +;;; Code: + +(require 'compat) +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) + +(defgroup vertico nil + "VERTical Interactive COmpletion." + :link '(info-link :tag "Info Manual" "(vertico)") + :link '(url-link :tag "Website" "https://github.com/minad/vertico") + :link '(url-link :tag "Wiki" "https://github.com/minad/vertico/wiki") + :link '(emacs-library-link :tag "Library Source" "vertico.el") + :group 'convenience + :group 'minibuffer + :prefix "vertico-") + +(defcustom vertico-count-format (cons "%-6s " "%s/%s") + "Format string used for the candidate count." + :type '(choice (const :tag "No candidate count" nil) (cons string string))) + +(defcustom vertico-group-format + (concat #(" " 0 4 (face vertico-group-separator)) + #(" %s " 0 4 (face vertico-group-title)) + #(" " 0 1 (face vertico-group-separator display (space :align-to (- right 1))))) + "Format string used for the group title." + :type '(choice (const :tag "No group titles" nil) string)) + +(defcustom vertico-count 10 + "Maximal number of candidates to show." + :type 'natnum) + +(defcustom vertico-preselect 'directory + "Configure if the prompt or first candidate is preselected. +- prompt: Always select the prompt. +- first: Select the first candidate, allow prompt selection. +- no-prompt: Like first, but forbid selection of the prompt entirely. +- directory: Like first, but select the prompt if it is a directory." + :type '(choice (const prompt) (const first) (const no-prompt) (const directory))) + +(defcustom vertico-scroll-margin 2 + "Number of lines at the top and bottom when scrolling. +The value should lie between 0 and vertico-count/2." + :type 'natnum) + +(defcustom vertico-resize resize-mini-windows + "How to resize the Vertico minibuffer window, see `resize-mini-windows'." + :type '(choice (const :tag "Fixed" nil) + (const :tag "Shrink and grow" t) + (const :tag "Grow-only" grow-only))) + +(defcustom vertico-cycle nil + "Enable cycling for `vertico-next' and `vertico-previous'." + :type 'boolean) + +(defcustom vertico-multiline + (cons #("↲" 0 1 (face vertico-multiline)) #("…" 0 1 (face vertico-multiline))) + "Replacements for multiline strings." + :type '(cons (string :tag "Newline") (string :tag "Truncation"))) + +(defcustom vertico-sort-function + (and (fboundp 'vertico-sort-history-length-alpha) 'vertico-sort-history-length-alpha) + "Default sorting function, used if no `display-sort-function' is specified." + :type '(choice + (const :tag "No sorting" nil) + (const :tag "By history, length and alpha" vertico-sort-history-length-alpha) + (const :tag "By history and alpha" vertico-sort-history-alpha) + (const :tag "By length and alpha" vertico-sort-length-alpha) + (const :tag "Alphabetically" vertico-sort-alpha) + (function :tag "Custom function"))) + +(defcustom vertico-sort-override-function nil + "Override sort function which overrides the `display-sort-function'." + :type '(choice (const nil) function)) + +(defgroup vertico-faces nil + "Faces used by Vertico." + :group 'vertico + :group 'faces) + +(defface vertico-multiline '((t :inherit shadow)) + "Face used to highlight multiline replacement characters.") + +(defface vertico-group-title '((t :inherit shadow :slant italic)) + "Face used for the title text of the candidate group headlines.") + +(defface vertico-group-separator '((t :inherit vertico-group-title :strike-through t)) + "Face used for the separator lines of the candidate groups.") + +(defface vertico-current '((t :inherit highlight :extend t)) + "Face used to highlight the currently selected candidate.") + +(defvar-keymap vertico-map + :doc "Vertico minibuffer keymap derived from `minibuffer-local-map'." + :parent minibuffer-local-map + " " #'vertico-first + " " #'vertico-first + " " #'vertico-last + " " #'vertico-scroll-down + " " #'vertico-scroll-up + " " #'vertico-next + " " #'vertico-previous + " " #'vertico-next + " " #'vertico-previous + " " #'vertico-previous-group + " " #'vertico-next-group + " " #'vertico-exit + " " #'vertico-save + "M-RET" #'vertico-exit-input + "TAB" #'vertico-insert + "" #'ignore) + +(defvar vertico--locals + '((scroll-margin . 0) + (completion-auto-help . nil) + (completion-show-inline-help . nil) + (pixel-scroll-precision-mode . nil)) + "Vertico minibuffer local variables.") + +(defvar-local vertico--hilit #'identity + "Lazy candidate highlighting function.") + +(defvar-local vertico--candidates-ov nil + "Overlay showing the candidates.") + +(defvar-local vertico--count-ov nil + "Overlay showing the number of candidates.") + +(defvar-local vertico--index -1 + "Index of current candidate or negative for prompt selection.") + +(defvar-local vertico--scroll 0 + "Scroll position.") + +(defvar-local vertico--input nil + "Cons of last minibuffer contents and point or t.") + +(defvar-local vertico--candidates nil + "List of candidates.") + +(defvar-local vertico--metadata nil + "Completion metadata.") + +(defvar-local vertico--base "" + "Base string, which is concatenated with the candidate.") + +(defvar-local vertico--total 0 + "Length of the candidate list `vertico--candidates'.") + +(defvar-local vertico--lock-candidate nil + "Lock-in current candidate.") + +(defvar-local vertico--lock-groups nil + "Lock-in current group order.") + +(defvar-local vertico--all-groups nil + "List of all group titles.") + +(defvar-local vertico--groups nil + "List of current group titles.") + +(defvar-local vertico--allow-prompt nil + "Prompt selection is allowed.") + +(defun vertico--affixate (cands) + "Annotate CANDS with annotation function." + (if-let ((aff (vertico--metadata-get 'affixation-function))) + (funcall aff cands) + (if-let ((ann (vertico--metadata-get 'annotation-function))) + (cl-loop for cand in cands collect + (let ((suff (or (funcall ann cand) ""))) + ;; The default completion UI adds the `completions-annotations' + ;; face if no other faces are present. + (unless (text-property-not-all 0 (length suff) 'face nil suff) + (setq suff (propertize suff 'face 'completions-annotations))) + (list cand "" suff))) + (cl-loop for cand in cands collect (list cand "" ""))))) + +(defun vertico--move-to-front (elem list) + "Move ELEM to front of LIST." + (if-let ((found (member elem list))) ;; No duplicates, compare with Corfu. + (nconc (list (car found)) (delq (setcar found nil) list)) + list)) + +(defun vertico--filter-completions (&rest args) + "Compute all completions for ARGS with lazy highlighting." + (dlet ((completion-lazy-hilit t) (completion-lazy-hilit-fn nil)) + (static-if (>= emacs-major-version 30) + (cons (apply #'completion-all-completions args) completion-lazy-hilit-fn) + (cl-letf* ((orig-pcm (symbol-function #'completion-pcm--hilit-commonality)) + (orig-flex (symbol-function #'completion-flex-all-completions)) + ((symbol-function #'completion-flex-all-completions) + (lambda (&rest args) + ;; Unfortunately for flex we have to undo the lazy highlighting, since flex uses + ;; the completion-score for sorting, which is applied during highlighting. + (cl-letf (((symbol-function #'completion-pcm--hilit-commonality) orig-pcm)) + (apply orig-flex args)))) + ((symbol-function #'completion-pcm--hilit-commonality) + (lambda (pattern cands) + (setq completion-lazy-hilit-fn + (lambda (x) + ;; `completion-pcm--hilit-commonality' sometimes throws an internal error + ;; for example when entering "/sudo:://u". + (condition-case nil + (car (completion-pcm--hilit-commonality pattern (list x))) + (t x)))) + cands)) + ((symbol-function #'completion-hilit-commonality) + (lambda (cands prefix &optional base) + (setq completion-lazy-hilit-fn + (lambda (x) (car (completion-hilit-commonality (list x) prefix base)))) + (and cands (nconc cands base))))) + (cons (apply #'completion-all-completions args) completion-lazy-hilit-fn))))) + +(defun vertico--metadata-get (prop) + "Return PROP from completion metadata." + (compat-call completion-metadata-get vertico--metadata prop)) + +(defun vertico--sort-function () + "Return the sorting function." + (or vertico-sort-override-function + (vertico--metadata-get 'display-sort-function) + vertico-sort-function)) + +(defun vertico--recompute (pt content) + "Recompute state given PT and CONTENT." + (pcase-let* ((table minibuffer-completion-table) + (pred minibuffer-completion-predicate) + (before (substring content 0 pt)) + (after (substring content pt)) + ;; bug#47678: `completion-boundaries' fails for `partial-completion' + ;; if the cursor is moved before the slashes of "~//". + ;; See also corfu.el which has the same issue. + (bounds (condition-case nil + (completion-boundaries before table pred after) + (t (cons 0 (length after))))) + (field (substring content (car bounds) (+ pt (cdr bounds)))) + ;; bug#75910: category instead of `minibuffer-completing-file-name' + (completing-file (eq 'file (vertico--metadata-get 'category))) + (`(,all . ,hl) (vertico--filter-completions content table pred pt vertico--metadata)) + (base (or (when-let ((z (last all))) (prog1 (cdr z) (setcdr z nil))) 0)) + (vertico--base (substring content 0 base)) + (def (or (car-safe minibuffer-default) minibuffer-default)) + (groups) (def-missing) (lock)) + ;; Filter the ignored file extensions. We cannot use modified predicate for this filtering, + ;; since this breaks the special casing in the `completion-file-name-table' for `file-exists-p' + ;; and `file-directory-p'. + (when completing-file (setq all (completion-pcm--filename-try-filter all))) + ;; Sort using the `display-sort-function' or the Vertico sort functions + (setq all (delete-consecutive-dups (funcall (or (vertico--sort-function) #'identity) all))) + ;; Move special candidates: "field" appears at the top, before "field/", before default value + (when (stringp def) + (setq all (vertico--move-to-front def all))) + (when (and completing-file (not (string-suffix-p "/" field))) + (setq all (vertico--move-to-front (concat field "/") all))) + (setq all (vertico--move-to-front field all)) + (when-let ((fun (and all (vertico--metadata-get 'group-function)))) + (setq groups (vertico--group-by fun all) all (car groups))) + (setq def-missing (and def (equal content "") (not (member def all))) + lock (and vertico--lock-candidate ;; Locked position of old candidate. + (if (< vertico--index 0) -1 + (seq-position all (nth vertico--index vertico--candidates))))) + `((vertico--base . ,vertico--base) + (vertico--metadata . ,vertico--metadata) + (vertico--candidates . ,all) + (vertico--total . ,(length all)) + (vertico--hilit . ,(or hl #'identity)) + (vertico--allow-prompt . ,(and (not (eq vertico-preselect 'no-prompt)) + (or def-missing (eq vertico-preselect 'prompt) + (memq minibuffer--require-match + '(nil confirm confirm-after-completion))))) + (vertico--lock-candidate . ,lock) + (vertico--groups . ,(cadr groups)) + (vertico--all-groups . ,(or (caddr groups) vertico--all-groups)) + (vertico--index . ,(or lock + (if (or def-missing (eq vertico-preselect 'prompt) (not all) + (and completing-file (eq vertico-preselect 'directory) + (= (length vertico--base) (length content)) + (test-completion content table pred))) + -1 0)))))) + +(defun vertico--hilit (cand) + "Highlight CAND string with lazy highlighting." + ;; bug#77754: Highlight unquoted string. + (funcall vertico--hilit (substring (or (get-text-property + 0 'completion--unquoted cand) cand)))) + +(defun vertico--cycle (list n) + "Rotate LIST to position N." + (nconc (copy-sequence (nthcdr n list)) (seq-take list n))) + +(defun vertico--group-by (fun elems) + "Group ELEMS by FUN." + (let ((ht (make-hash-table :test #'equal)) titles groups) + ;; Build hash table of groups + (cl-loop for elem on elems + for title = (funcall fun (car elem) nil) do + (if-let ((group (gethash title ht))) + (setcdr group (setcdr (cdr group) elem)) ;; Append to tail of group + (puthash title (cons elem elem) ht) ;; New group element (head . tail) + (push title titles))) + (setq titles (nreverse titles)) + ;; Cycle groups if `vertico--lock-groups' is set + (when-let ((vertico--lock-groups) + (group (seq-find (lambda (group) (gethash group ht)) + vertico--all-groups))) + (setq titles (vertico--cycle titles (seq-position titles group)))) + ;; Build group list + (dolist (title titles) + (push (gethash title ht) groups)) + ;; Unlink last tail + (setcdr (cdar groups) nil) + (setq groups (nreverse groups)) + ;; Link groups + (let ((link groups)) + (while (cdr link) + (setcdr (cdar link) (caadr link)) + (pop link))) + ;; Check if new groups are found + (dolist (group vertico--all-groups) + (remhash group ht)) + (list (caar groups) titles + (if (hash-table-empty-p ht) vertico--all-groups titles)))) + +(defun vertico--remote-p (path) + "Return t if PATH is a remote path." + (string-match-p "\\`/[^/|:]+:" (substitute-in-file-name path))) + +(defun vertico--update (&optional interruptible) + "Update state, optionally INTERRUPTIBLE." + (let* ((pt (max 0 (- (point) (minibuffer-prompt-end)))) + (content (minibuffer-contents-no-properties)) + (input (cons content pt))) + (unless (or (and interruptible (input-pending-p)) (equal vertico--input input)) + ;; Redisplay to make input immediately visible before expensive candidate + ;; recomputation (gh:minad/vertico#89). No redisplay during init because + ;; of flicker. + (when (and interruptible (consp vertico--input)) + ;; Prevent recursive exhibit from timer (`consult-vertico--refresh'). + (cl-letf (((symbol-function #'vertico--exhibit) #'ignore)) (redisplay))) + (pcase (let ((vertico--metadata (completion-metadata (substring content 0 pt) + minibuffer-completion-table + minibuffer-completion-predicate))) + ;; If Tramp is used, do not compute the candidates in an + ;; interruptible fashion, since this will break the Tramp + ;; password and user name prompts (See gh:minad/vertico#23). + (if (or (not interruptible) + (and (eq 'file (vertico--metadata-get 'category)) + (or (vertico--remote-p content) (vertico--remote-p default-directory)))) + (vertico--recompute pt content) + (let ((non-essential t)) + (while-no-input (vertico--recompute pt content))))) + ('nil (abort-recursive-edit)) + ((and state (pred consp)) + (setq vertico--input input) + (dolist (s state) (set (car s) (cdr s)))))))) + +(defun vertico--display-string (str) + "Return display STR without display and invisible properties." + (let ((end (length str)) (pos 0) chunks) + (while (< pos end) + (let ((nextd (next-single-property-change pos 'display str end)) + (disp (get-text-property pos 'display str))) + (if (stringp disp) + (let ((face (get-text-property pos 'face str))) + (when face + (add-face-text-property 0 (length disp) face t (setq disp (concat disp)))) + (setq pos nextd chunks (cons disp chunks))) + (while (< pos nextd) + (let ((nexti (next-single-property-change pos 'invisible str nextd))) + (unless (or (get-text-property pos 'invisible str) + (and (= pos 0) (= nexti end))) ;; full string -> no allocation + (push (substring str pos nexti) chunks)) + (setq pos nexti)))))) + (if chunks (apply #'concat (nreverse chunks)) str))) + +(defun vertico--window-width () + "Return minimum width of windows, which display the minibuffer." + (cl-loop for win in (get-buffer-window-list) minimize (window-width win))) + +(defun vertico--truncate-multiline (str max) + "Truncate multiline STR to MAX." + (let ((pos 0) (res "")) + (while (and (< (length res) (* 2 max)) (string-match "\\(\\S-+\\)\\|\\s-+" str pos)) + (setq res (concat res (if (match-end 1) (match-string 0 str) + (if (string-search "\n" (match-string 0 str)) + (car vertico-multiline) " "))) + pos (match-end 0))) + (truncate-string-to-width (string-trim res) max 0 nil (cdr vertico-multiline)))) + +(defun vertico--compute-scroll () + "Compute new scroll position." + (let ((off (max (min vertico-scroll-margin (/ vertico-count 2)) 0)) + (corr (if (= vertico-scroll-margin (/ vertico-count 2)) (1- (mod vertico-count 2)) 0))) + (setq vertico--scroll (min (max 0 (- vertico--total vertico-count)) + (max 0 (+ vertico--index off 1 (- vertico-count)) + (min (- vertico--index off corr) vertico--scroll)))))) + +(defun vertico--format-group-title (title cand) + "Format group TITLE given the current CAND." + ;; Copy candidate highlighting if title is a prefix of the candidate. + (when (string-prefix-p title cand) + (setq title (substring cand 0 (length title))) + (vertico--remove-face 0 (length title) 'completions-first-difference title)) + (setq title (substring title)) + (add-face-text-property 0 (length title) 'vertico-group-title t title) + (format (concat vertico-group-format "\n") title)) + +(defun vertico--format-count () + "Format the count string." + (format (car vertico-count-format) + (format (cdr vertico-count-format) + (cond ((>= vertico--index 0) (1+ vertico--index)) + (vertico--allow-prompt "*") + (t "!")) + vertico--total))) + +(defun vertico--display-count () + "Update count overlay `vertico--count-ov'." + (move-overlay vertico--count-ov (point-min) (point-min)) + (overlay-put vertico--count-ov 'before-string + (if vertico-count-format (vertico--format-count) ""))) + +(defun vertico--prompt-selection () + "Highlight the prompt if selected." + (let ((inhibit-modification-hooks t)) + (if (and (< vertico--index 0) vertico--allow-prompt) + (add-face-text-property (minibuffer-prompt-end) (point-max) 'vertico-current 'append) + (vertico--remove-face (minibuffer-prompt-end) (point-max) 'vertico-current)))) + +(defun vertico--remove-face (beg end face &optional obj) + "Remove FACE between BEG and END from OBJ." + (while (< beg end) + (let ((next (next-single-property-change beg 'face obj end))) + (when-let ((val (get-text-property beg 'face obj))) + (put-text-property beg next 'face (remq face (ensure-list val)) obj)) + (setq beg next)))) + +(defun vertico--debug (&rest _) + "Debugger used by `vertico--protect'." + (let ((inhibit-message t)) + (require 'backtrace) + (declare-function backtrace-to-string "backtrace") + (message "Vertico detected an error:\n%s" (backtrace-to-string))) + (let (message-log-max) + (message "%s %s" + (propertize "Vertico detected an error:" 'face 'error) + (substitute-command-keys "Press \\[view-echo-area-messages] to see the stack trace"))) + nil) + +(defun vertico--protect (fun) + "Protect FUN such that errors are caught. +If an error occurs, the FUN is retried with `debug-on-error' enabled and +the stack trace is shown in the *Messages* buffer." + (static-if (fboundp 'handler-bind) ;; Available on Emacs 30 + (ignore-errors + (handler-bind ((error #'vertico--debug)) + (funcall fun))) + (when (or debug-on-error (condition-case nil + (progn (funcall fun) nil) + (error t))) + (let ((debug-on-error t) + (debugger #'vertico--debug)) + (condition-case nil + (funcall fun) + ((debug error) nil)))))) + +(defun vertico--exhibit () + "Exhibit completion UI." + (vertico--protect + (lambda () + (let ((buffer-undo-list t)) ;; Overlays affect point position and undo list! + (vertico--update 'interruptible) + (vertico--prompt-selection) + (vertico--display-count) + (vertico--display-candidates (vertico--arrange-candidates)))))) + +(defun vertico--goto (index) + "Go to candidate with INDEX." + (setq vertico--index + (max (if (or vertico--allow-prompt (= 0 vertico--total)) -1 0) + (min index (1- vertico--total))) + vertico--lock-candidate (or (>= vertico--index 0) vertico--allow-prompt))) + +(defun vertico--candidate (&optional hl) + "Return current candidate string with optional highlighting if HL is non-nil." + (let ((content (or (car-safe vertico--input) (minibuffer-contents-no-properties)))) + (cond + ((>= vertico--index 0) + (let ((cand (substring (nth vertico--index vertico--candidates)))) + ;; XXX Drop the completions-common-part face which is added by the + ;; `completion--twq-all' hack. This should better be fixed in Emacs + ;; itself, the corresponding code is already marked as fixme. + (vertico--remove-face 0 (length cand) 'completions-common-part cand) + (concat vertico--base (if hl (vertico--hilit cand) cand)))) + ((and (equal content "") (or (car-safe minibuffer-default) minibuffer-default))) + (t content)))) + +(defun vertico--match-p (input) + "Return t if INPUT is a valid match." + (let ((rm minibuffer--require-match)) + (or (memq rm '(nil confirm-after-completion)) + (equal "" input) ;; Null completion, returns default value + (if (functionp rm) (funcall rm input) ;; require-match can be a function + (test-completion input minibuffer-completion-table minibuffer-completion-predicate)) + (if (eq rm 'confirm) (eq (ignore-errors (read-char "Confirm")) 13) + (minibuffer-message "Match required") nil)))) + +(cl-defgeneric vertico--format-candidate (cand prefix suffix index _start) + "Format CAND given PREFIX, SUFFIX and INDEX." + (setq cand (vertico--display-string (concat prefix cand suffix "\n"))) + (when (= index vertico--index) + (add-face-text-property 0 (length cand) 'vertico-current 'append cand)) + cand) + +(cl-defgeneric vertico--arrange-candidates () + "Arrange candidates." + (vertico--compute-scroll) + (let ((curr-line 0) lines) + ;; Compute group titles + (let* (title (index vertico--scroll) + (group-fun (and vertico-group-format (vertico--metadata-get 'group-function))) + (candidates + (vertico--affixate + (cl-loop repeat vertico-count for c in (nthcdr index vertico--candidates) + collect (vertico--hilit c))))) + (pcase-dolist ((and cand `(,str . ,_)) candidates) + (when-let ((new-title (and group-fun (funcall group-fun str nil)))) + (unless (equal title new-title) + (setq title new-title) + (push (vertico--format-group-title title str) lines)) + (setcar cand (funcall group-fun str 'transform))) + (when (= index vertico--index) + (setq curr-line (length lines))) + (push (cons index cand) lines) + (cl-incf index))) + ;; Drop excess lines + (setq lines (nreverse lines)) + (cl-loop for count from (length lines) above vertico-count do + (if (< curr-line (/ count 2)) + (nbutlast lines) + (setq curr-line (1- curr-line) lines (cdr lines)))) + ;; Format candidates + (let ((max-width (- (vertico--window-width) 4)) start) + (cl-loop for line on lines do + (pcase (car line) + (`(,index ,cand ,prefix ,suffix) + (setq start (or start index)) + (when (string-search "\n" cand) + (setq cand (vertico--truncate-multiline cand max-width))) + (setcar line (vertico--format-candidate cand prefix suffix index start)))))) + lines)) + +(cl-defgeneric vertico--display-candidates (lines) + "Update candidates overlay `vertico--candidates-ov' with LINES." + (move-overlay vertico--candidates-ov (point-max) (point-max)) + (overlay-put vertico--candidates-ov 'before-string + (apply #'concat #(" " 0 1 (cursor t)) (and lines "\n") lines)) + (vertico--resize-window (length lines))) + +(cl-defgeneric vertico--resize-window (height) + "Resize active minibuffer window to HEIGHT." + (setq-local truncate-lines (< (point) (* 0.8 (vertico--window-width))) + resize-mini-windows 'grow-only + max-mini-window-height 1.0) + (unless truncate-lines (set-window-hscroll nil 0)) + (unless (frame-root-window-p (active-minibuffer-window)) + (unless vertico-resize (setq height (max height vertico-count))) + (let ((dp (- (max (cdr (window-text-pixel-size)) + (* (default-line-height) (1+ height))) + (window-pixel-height)))) + (when (or (and (> dp 0) (/= height 0)) + (and (< dp 0) (eq vertico-resize t))) + (window-resize nil dp nil nil 'pixelwise))))) + +(cl-defgeneric vertico--prepare () + "Ensure that the state is prepared before running the next command." + (when-let ((cmd (and (symbolp this-command) (symbol-name this-command))) + ((string-prefix-p "vertico-" cmd)) + ((not (and vertico--metadata (string-prefix-p "vertico-directory-" cmd))))) + (vertico--update))) + +(cl-defgeneric vertico--setup () + "Setup completion UI." + (dolist (var vertico--locals) + (set (make-local-variable (car var)) (cdr var))) + (setq-local vertico--input t + vertico--candidates-ov (make-overlay (point-max) (point-max) nil t t) + vertico--count-ov (make-overlay (point-min) (point-min) nil t t)) + (overlay-put vertico--count-ov 'priority 1) ;; For `minibuffer-depth-indicate-mode' + (use-local-map vertico-map) + (add-hook 'pre-command-hook #'vertico--prepare nil 'local) + (add-hook 'post-command-hook #'vertico--exhibit nil 'local)) + +(cl-defgeneric vertico--advice (&rest app) + "Advice for completion function, apply APP." + (dlet ((completion-eager-display nil)) ;; Available on Emacs 31 + (minibuffer-with-setup-hook #'vertico--setup (apply app)))) + +(defun vertico-first () + "Go to first candidate, or to the prompt when the first candidate is selected." + (interactive) + (vertico--goto (if (> vertico--index 0) 0 -1))) + +(defun vertico-last () + "Go to last candidate." + (interactive) + (vertico--goto (1- vertico--total))) + +(defun vertico-scroll-down (&optional n) + "Go back by N pages." + (interactive "p") + (vertico--goto (max 0 (- vertico--index (* (or n 1) vertico-count))))) + +(defun vertico-scroll-up (&optional n) + "Go forward by N pages." + (interactive "p") + (vertico-scroll-down (- (or n 1)))) + +(defun vertico-next (&optional n) + "Go forward N candidates." + (interactive "p") + (let ((index (+ vertico--index (or n 1)))) + (vertico--goto + (cond + ((not vertico-cycle) index) + ((= vertico--total 0) -1) + (vertico--allow-prompt (1- (mod (1+ index) (1+ vertico--total)))) + (t (mod index vertico--total)))))) + +(defun vertico-previous (&optional n) + "Go backward N candidates." + (interactive "p") + (vertico-next (- (or n 1)))) + +(defun vertico-exit (&optional arg) + "Exit minibuffer with current candidate or input if prefix ARG is given." + (interactive "P") + (when (and (not arg) (>= vertico--index 0)) + (vertico-insert)) + (when (vertico--match-p (minibuffer-contents-no-properties)) + (exit-minibuffer))) + +(defun vertico-next-group (&optional n) + "Cycle N groups forward. +When the prefix argument is 0, the group order is reset." + (interactive "p") + (when (cdr vertico--groups) + (if (setq vertico--lock-groups (not (eq n 0))) + (setq vertico--groups (vertico--cycle vertico--groups + (let ((len (length vertico--groups))) + (- len (mod (- (or n 1)) len)))) + vertico--all-groups (vertico--cycle vertico--all-groups + (seq-position vertico--all-groups + (car vertico--groups)))) + (setq vertico--groups nil + vertico--all-groups nil)) + (setq vertico--lock-candidate nil + vertico--input nil))) + +(defun vertico-previous-group (&optional n) + "Cycle N groups backward. +When the prefix argument is 0, the group order is reset." + (interactive "p") + (vertico-next-group (- (or n 1)))) + +(defun vertico-exit-input () + "Exit minibuffer with input." + (interactive) + (vertico-exit t)) + +(defun vertico-save () + "Save current candidate to kill ring." + (interactive) + (if (or (use-region-p) (not transient-mark-mode)) + (call-interactively #'kill-ring-save) + (kill-new (substring-no-properties (vertico--candidate))))) + +(defun vertico-insert () + "Insert current candidate in minibuffer." + (interactive) + ;; XXX There is a small bug here, depending on interpretation. When completing + ;; "~/emacs/master/li|/calc" where "|" is the cursor, then the returned + ;; candidate only includes the prefix "~/emacs/master/lisp/", but not the + ;; suffix "/calc". Default completion has the same problem when selecting in + ;; the *Completions* buffer. See bug#48356. + (when (> vertico--total 0) + (let ((vertico--index (max 0 vertico--index))) + (insert (prog1 (vertico--candidate) (delete-minibuffer-contents)))))) + +;;;###autoload +(define-minor-mode vertico-mode + "VERTical Interactive COmpletion." + :global t :group 'vertico + (dolist (fun '(completing-read-default completing-read-multiple)) + (if vertico-mode + (advice-add fun :around #'vertico--advice) + (advice-remove fun #'vertico--advice)))) + +(defun vertico--command-p (_sym buffer) + "Return non-nil if Vertico is active in BUFFER." + (buffer-local-value 'vertico--input buffer)) + +;; Do not show Vertico commands in M-X +(dolist (sym '( vertico-next vertico-next-group vertico-previous vertico-previous-group + vertico-scroll-down vertico-scroll-up vertico-exit vertico-insert + vertico-exit-input vertico-save vertico-first vertico-last + vertico-repeat-next ;; autoloads in vertico-repeat.el + vertico-quick-jump vertico-quick-exit vertico-quick-insert ;; autoloads in vertico-quick.el + vertico-directory-up vertico-directory-enter ;; autoloads in vertico-directory.el + vertico-directory-delete-char vertico-directory-delete-word)) + (put sym 'completion-predicate #'vertico--command-p)) + +(provide 'vertico) +;;; vertico.el ends here diff --git a/.emacs.d/themes/bedroom-theme.el b/.emacs.d/themes/bedroom-theme.el index 53a9fdc..d3fef58 100644 --- a/.emacs.d/themes/bedroom-theme.el +++ b/.emacs.d/themes/bedroom-theme.el @@ -39,6 +39,10 @@ '(font-lock-type-face ((t (:foreground "#85B8DE")))) '(font-lock-warning-face ((t (:foreground "#FC2D07")))) + ;; Dired + '(dired-directory ((t (:foreground "#5FAFD7" :weight bold)))) + '(dired-symlink ((t (:foreground "#87919D")))) + ;; Custom/widget faces '(custom-group-tag ((t (:underline t :foreground "lightblue")))) '(custom-variable-tag ((t (:underline t :foreground "lightblue")))) diff --git a/.emacs.d/themes/focus-theme.el b/.emacs.d/themes/focus-theme.el index ae2c4ea..69a2067 100644 --- a/.emacs.d/themes/focus-theme.el +++ b/.emacs.d/themes/focus-theme.el @@ -87,14 +87,12 @@ '(flyspell-incorrect ((t (:underline (:style wave :color "#772222"))))) '(flyspell-duplicate ((t (:underline (:style wave :color "#986032"))))) - ;; Ivy - '(ivy-current-match ((t (:background "#1C4449" :foreground "#BFC9DB")))) - '(ivy-minibuffer-match-face-1 ((t (:foreground "#599999")))) - '(ivy-minibuffer-match-face-2 ((t (:foreground "#26B2B2" :weight bold)))) - '(ivy-minibuffer-match-face-3 ((t (:foreground "#E0AD82" :weight bold)))) - '(ivy-minibuffer-match-face-4 ((t (:foreground "#D699B5" :weight bold)))) - '(ivy-confirm-face ((t (:foreground "#227722")))) - '(ivy-match-required-face ((t (:foreground "#772222")))) + ;; Vertico + '(vertico-current ((t (:background "#1C4449" :foreground "#BFC9DB")))) + '(vertico-group-title ((t (:foreground "#599999")))) + '(vertico-group-separator ((t (:foreground "#3A4255")))) + '(completions-common-part ((t (:foreground "#26B2B2")))) + '(completions-first-difference ((t (:foreground "#E0AD82" :weight bold)))) ;; Dired '(dired-directory ((t (:foreground "#82AAA3")))) diff --git a/.emacs.d/themes/valigo-theme.el b/.emacs.d/themes/valigo-theme.el index e08b16c..f33b633 100644 --- a/.emacs.d/themes/valigo-theme.el +++ b/.emacs.d/themes/valigo-theme.el @@ -86,14 +86,12 @@ '(flyspell-incorrect ((t (:underline (:style wave :color "#ff6f6f"))))) '(flyspell-duplicate ((t (:underline (:style wave :color "#d09950"))))) - ;; Ivy - '(ivy-current-match ((t (:background "#503240" :foreground "#efd5c5")))) - '(ivy-minibuffer-match-face-1 ((t (:foreground "#8fcfd0")))) - '(ivy-minibuffer-match-face-2 ((t (:foreground "#ff9f0a" :weight bold)))) - '(ivy-minibuffer-match-face-3 ((t (:foreground "#ffaacf" :weight bold)))) - '(ivy-minibuffer-match-face-4 ((t (:foreground "#d0b0ff" :weight bold)))) - '(ivy-confirm-face ((t (:foreground "#51b04f")))) - '(ivy-match-required-face ((t (:foreground "#ff6f6f")))) + ;; Vertico + '(vertico-current ((t (:background "#503240" :foreground "#efd5c5")))) + '(vertico-group-title ((t (:foreground "#8fcfd0")))) + '(vertico-group-separator ((t (:foreground "#635850")))) + '(completions-common-part ((t (:foreground "#ff9f0a")))) + '(completions-first-difference ((t (:foreground "#ffaacf" :weight bold)))) ;; Dired '(dired-directory ((t (:foreground "#57b0ff"))))