daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2022-01-03 21:18:11 +01:00
parent a3155953d6
commit 4c740d6f8d
89 changed files with 5691 additions and 1653 deletions
Download Patch File Download Diff File Expand all files Collapse all files

308
lisp/counsel.el
View File

@@ -1,13 +1,13 @@
;;; counsel.el --- Various completion functions using Ivy -*- lexical-binding: t -*-
;; Copyright (C) 2015-2019 Free Software Foundation, Inc.
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; URL: https://github.com/abo-abo/swiper
;; Package-Version: 20201227.1327
;; Package-Commit: 71c59aecf669142ebe264fac8ff7b440c0c71712
;; Version: 0.13.0
;; Package-Requires: ((emacs "24.5") (swiper "0.13.0"))
;; Package-Version: 20211230.1909
;; Package-Commit: c97ea72285f2428ed61b519269274d27f2b695f9
;; Version: 0.13.4
;; Package-Requires: ((emacs "24.5") (ivy "0.13.4") (swiper "0.13.4"))
;; Keywords: convenience, matching, tools
;; This file is part of GNU Emacs.
@@ -42,6 +42,7 @@
;;; Code:
(require 'ivy)
(require 'swiper)
(require 'compile)
@@ -124,10 +125,11 @@ complex regexes."
(executable-find command)))
"Compatibility shim for `executable-find'.")
(defun counsel-require-program (cmd)
(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."
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)
@@ -135,7 +137,8 @@ To skip the `executable-find' check, start the string with a space."
(or (and (stringp program)
(not (string= program ""))
(counsel--executable-find program t))
(user-error "Required program \"%s\" not found in your path" program)))))
(unless noerror
(user-error "Required program \"%s\" not found in your path" program))))))
(declare-function eshell-split-path "esh-util")
@@ -424,7 +427,8 @@ Update the minibuffer with the amount of lines collected every
(cons (concat (car x) (irony-completion-annotation x))
(car x)))
(add-to-list 'ivy-display-functions-alist '(counsel-irony . ivy-display-function-overlay))
(ivy-configure #'counsel-irony
:display-fn #'ivy-display-function-overlay)
;;* Elisp symbols
;;** `counsel-describe-variable'
@@ -622,29 +626,35 @@ to `ivy-highlight-face'."
(defun counsel-read-setq-expression (sym)
"Read and eval a setq expression for SYM."
(setq this-command 'eval-expression)
(let* ((minibuffer-completing-symbol t)
(sym-value (symbol-value sym))
(expr (minibuffer-with-setup-hook
(lambda ()
;; Functions `elisp-eldoc-documentation-function' and
;; `elisp-completion-at-point' added in Emacs 25.1.
(add-function :before-until (local 'eldoc-documentation-function)
#'elisp-eldoc-documentation-function)
(add-hook 'completion-at-point-functions #'elisp-completion-at-point nil t)
(run-hooks 'eval-expression-minibuffer-setup-hook)
(goto-char (minibuffer-prompt-end))
(forward-char 6)
(insert (format "%S " sym)))
(read-from-minibuffer "Eval: "
(format
(if (and sym-value (or (consp sym-value)
(symbolp sym-value)))
"(setq '%S)"
"(setq %S)")
sym-value)
read-expression-map t
'read-expression-history))))
expr))
(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.
@@ -875,6 +885,26 @@ packages are, in order of precedence, `amx' and `smex'."
(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)
@@ -920,12 +950,8 @@ when available, in that order of precedence."
(let ((externs (counsel--M-x-externs)))
(ivy-read (counsel--M-x-prompt) (or externs obarray)
:predicate (if externs
(lambda (x)
(not (get (intern x) 'no-counsel-M-x)))
(lambda (sym)
(and (commandp sym)
(not (get sym 'byte-obsolete-info))
(not (get sym 'no-counsel-M-x)))))
#'counsel--M-x-externs-predicate
(counsel--M-x-make-predicate))
:require-match t
:history 'counsel-M-x-history
:action #'counsel-M-x-action
@@ -1818,7 +1844,7 @@ currently checked out."
"Switch to `counsel-file-jump' from `counsel-find-file'."
(interactive)
(ivy-quit-and-run
(counsel-file-jump ivy-text)))
(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)
@@ -1947,7 +1973,7 @@ but the leading dot is a lot faster."
(const :tag "None" nil)
(const :tag "Dotfiles and Lockfiles" "\\(?:\\`\\|[/\\]\\)\\(?:[#.]\\)")
(const :tag "Ignored Extensions"
,(regexp-opt completion-ignored-extensions))
,(concat (regexp-opt completion-ignored-extensions) "\\'"))
(regexp :tag "Regex")))
(defvar counsel--find-file-predicate nil
@@ -2028,14 +2054,15 @@ The preselect behavior can be customized via user options
:caller caller)))
;;;###autoload
(defun counsel-find-file (&optional initial-input)
(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)
(counsel--find-file-1
"Find file: " initial-input
#'counsel-find-file-action
'counsel-find-file))
(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
@@ -2188,34 +2215,34 @@ See variable `counsel-up-directory-level'."
(defun counsel-github-url-p ()
"Return a Github issue URL at point."
(counsel-require-program "git")
(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))))))))
(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."
(counsel-require-program "git")
(let ((url (counsel-at-git-issue-p)))
(when url
(let ((origin (shell-command-to-string
"git remote get-url origin")))
(when (string-match "git.sv.gnu.org:/srv/git/emacs.git" origin)
(format "https://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s"
(substring url 1)))))))
(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")))
(when (string-match "git.sv.gnu.org:/srv/git/emacs.git" origin)
(format "https://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s"
(substring url 1))))))))
(defvar counsel-url-expansions-alist nil
"Map of regular expressions to expansions.
@@ -2466,7 +2493,8 @@ By default `counsel-bookmark' opens a dired buffer for directories."
(ivy-set-actions
'counsel-bookmark
`(("d" bookmark-delete "delete")
`(("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)
@@ -2593,18 +2621,27 @@ string - the full shell command to run."
"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."
(counsel-require-program "locate")
(format "locate -i --regex %s"
"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."
(counsel-require-program "locate")
(format "locate -i %s" (shell-quote-argument 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."
@@ -2660,6 +2697,8 @@ string - the full shell command to run."
"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
@@ -2843,6 +2882,18 @@ FZF-PROMPT, if non-nil, is passed as `ivy-read' prompt argument."
: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.
@@ -2863,6 +2914,7 @@ INITIAL-DIRECTORY, if non-nil, is used as the root directory for search."
: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
@@ -2908,14 +2960,24 @@ INITIAL-DIRECTORY, if non-nil, is used as the root directory for search."
(define-key map (kbd "C-x C-d") 'counsel-cd)
map))
(defcustom counsel-ag-base-command "ag --vimgrep %s"
"Format string to use in `counsel-ag-function' to construct the command.
The %s will be replaced by optional extra ag arguments followed by the
regex string."
:type '(radio
(const "ag --vimgrep %s")
(const "ag --nocolor --nogroup %s")
(string :tag "custom")))
(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)
@@ -2973,11 +3035,11 @@ NEEDLE is the search string."
(ivy-more-chars))
(let* ((default-directory (ivy-state-directory ivy-last))
(regex (counsel--grep-regex search-term))
(switches (concat (car command-args)
(counsel--ag-extra-switches regex)
(if (ivy--case-fold-p string)
(switches (concat (if (ivy--case-fold-p string)
" -i "
" -s "))))
" -s ")
(counsel--ag-extra-switches regex)
(car command-args))))
(counsel--async-command (counsel--format-ag-command
switches
(funcall (if (listp counsel-ag-command) #'identity
@@ -2988,9 +3050,10 @@ NEEDLE is the search string."
;;;###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.
"Grep for a string in a root directory using `ag'.
By default, the root directory is the first directory containing a .git subdirectory.
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.
@@ -3041,7 +3104,9 @@ prompt additionally for EXTRA-AG-ARGS."
:exit-codes '(1 "No matches found"))
(defun counsel-read-directory-name (prompt &optional default)
"Read a directory name from user, a (partial) replacement of `read-directory-name'."
"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
@@ -3080,8 +3145,9 @@ Works for `counsel-git-grep', `counsel-ag', etc."
(ivy-occur-grep-mode)
(setq default-directory (ivy-state-directory ivy-last)))
(ivy-set-text
(and (string-match "\"\\(.*\\)\"" (buffer-name))
(match-string 1 (buffer-name))))
(if (string-match "\"\\(.*\\)\"" (buffer-name))
(match-string 1 (buffer-name))
(ivy-state-text ivy-occur-last)))
(let* ((cmd
(if (functionp cmd-template)
(funcall cmd-template ivy-text)
@@ -3157,19 +3223,23 @@ This uses `counsel-ag' with `counsel-ack-base-command' replacing
initial-input nil nil nil
:caller 'counsel-ack)))
;;** `counsel-rg'
(defcustom counsel-rg-base-command
(split-string
(if (memq system-type '(ms-dos windows-nt))
"rg -M 240 --with-filename --no-heading --line-number --color never %s --path-separator / ."
"rg -M 240 --with-filename --no-heading --line-number --color never %s"))
"Alternative to `counsel-ag-base-command' using ripgrep.
`("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 regex."
:type '(choice
(repeat :tag "List to be used in `process-file'." string)
(string :tag "String to be used in `shell-command-to-string'.")))
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."
@@ -3186,7 +3256,7 @@ Note: don't use single quotes for the regex."
;;;###autoload
(defun counsel-rg (&optional initial-input initial-directory extra-rg-args rg-prompt)
"Grep for a string in the current directory using rg.
"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'.
@@ -4522,6 +4592,8 @@ Note: Duplicate elements of `kill-ring' are always deleted."
:action #'counsel-yank-pop-action
:caller 'counsel-yank-pop)))
(put #'counsel-yank-pop 'delete-selection 'yank)
(ivy-configure 'counsel-yank-pop
:height 5
:format-fn #'counsel--yank-pop-format-function)
@@ -4764,6 +4836,7 @@ An extra action allows to switch to the process buffer."
(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)))
@@ -5188,7 +5261,7 @@ the face to apply."
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)
(ivy-read "Switch to buffer: " (counsel--ibuffer-get-buffers)
:history 'counsel-ibuffer-history
:action #'counsel-ibuffer-visit-buffer
:caller 'counsel-ibuffer))
@@ -5198,8 +5271,10 @@ NAME specifies the name of the buffer (defaults to \"*Ibuffer*\")."
(declare-function ibuffer-forward-line "ibuffer")
(defvar ibuffer-movement-cycle)
(defun counsel-ibuffer--get-buffers ()
"Return list of buffer-related lines in Ibuffer as strings."
(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.
@@ -5229,11 +5304,11 @@ NAME specifies the name of the buffer (defaults to \"*Ibuffer*\")."
(defun counsel-ibuffer-visit-buffer (x)
"Switch to buffer of candidate X."
(switch-to-buffer (cdr 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 (cdr x)))
(switch-to-buffer-other-window (or (cdr-safe x) x)))
(defun counsel-ibuffer-visit-ibuffer (_)
"Switch to Ibuffer buffer."
@@ -5398,6 +5473,9 @@ Return nil if NAME does not designate a valid 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.
@@ -5566,8 +5644,9 @@ value of a macro, using them for a new macro."
(defun counsel--kmacro-candidates ()
"Create the list of keyboard macros used by `counsel-kmacro'.
This is a combination of `kmacro-ring' and, together in a list, `last-kbd-macro',
`kmacro-counter-format-start', and `kmacro-counter-value-start'."
This is a combination of `kmacro-ring' and, together in a list,
`last-kbd-macro', `kmacro-counter-format-start', and
`kmacro-counter-value-start'."
(mapcar
(lambda (kmacro)
(cons
@@ -5628,7 +5707,10 @@ to 0."
(kmacro-set-counter number)))
(defun counsel-kmacro-action-copy-counter-format-for-new-macro (x)
"Set `kmacro-default-counter-format' to an existing keyboard macro's counter format.
"Set the default keyboard macro counter format.
This sets `kmacro-default-counter-format' to the counter format
of an existing keyboard macro.
This will apply to the next macro a user defines."
(let* ((actual-kmacro (cdr x))
(format (nth 2 actual-kmacro)))