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
2021-01-08 19:32:30 +01:00
parent ce8f24d28a
commit f5649dceab
467 changed files with 26642 additions and 22487 deletions
Download Patch File Download Diff File Expand all files Collapse all files

364
lisp/counsel.el
View File

@@ -4,8 +4,8 @@
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; URL: https://github.com/abo-abo/swiper
;; Package-Version: 20200619.1030
;; Package-Commit: d951004c7f3ebf98d55fc5a80a3471ec95b6db05
;; Package-Version: 20201227.1327
;; Package-Commit: 71c59aecf669142ebe264fac8ff7b440c0c71712
;; Version: 0.13.0
;; Package-Requires: ((emacs "24.5") (swiper "0.13.0"))
;; Keywords: convenience, matching, tools
@@ -116,17 +116,25 @@ complex regexes."
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)
"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."
(unless (and (stringp cmd) (string-match-p "^ " cmd))
(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 ""))
(executable-find program))
(counsel--executable-find program t))
(user-error "Required program \"%s\" not found in your path" program)))))
(declare-function eshell-split-path "esh-util")
@@ -1094,17 +1102,17 @@ See `describe-buffer-bindings' for further information."
(describe-buffer-bindings buffer prefix))
(goto-char (point-min))
;; Skip the "Key translations" section
(re-search-forward " ")
(forward-char 1)
(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 re-exclude key)
(string-match-p re-exclude key)
(not (or (commandp (setq cmd (intern-soft fun)))
(member fun '("Prefix Command")))))
(equal fun "Prefix Command"))))
(push
(cons (format
"%-15s %s"
@@ -1112,7 +1120,7 @@ See `describe-buffer-bindings' for further information."
fun)
(cons key cmd))
res))))
(forward-line 1)))
(forward-line)))
(nreverse res)))
(defcustom counsel-descbinds-function #'describe-function
@@ -1188,6 +1196,15 @@ back to the face of the character after point, and finally the
"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")
@@ -1232,7 +1249,8 @@ selected face."
(ivy-set-actions
'counsel-faces
'(("c" counsel-customize-face "customize")
("C" counsel-customize-face-other-window "customize other window")))
("C" counsel-customize-face-other-window "customize other window")
("h" counsel-highlight-with-face "highlight")))
;;* Git
;;** `counsel-git'
@@ -1791,10 +1809,17 @@ currently checked out."
(let ((map (make-sparse-keymap)))
(define-key map (kbd "C-DEL") 'counsel-up-directory)
(define-key map (kbd "C-<backspace>") 'counsel-up-directory)
(define-key map (kbd "`") (ivy-make-magic-action 'counsel-find-file "b"))
(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)))
(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))
@@ -1963,15 +1988,14 @@ Skip some dotfiles unless `ivy-text' requires them."
(defun counsel-find-file-action (x)
"Find file X."
(with-ivy-window
(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))))))
(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.
@@ -2520,13 +2544,13 @@ can use `C-x r j i' to open that file."
;;** `counsel-locate'
(defcustom counsel-locate-cmd (cond ((memq system-type '(darwin berkeley-unix))
'counsel-locate-cmd-noregex)
#'counsel-locate-cmd-noregex)
((and (eq system-type 'windows-nt)
(executable-find "es.exe"))
'counsel-locate-cmd-es)
#'counsel-locate-cmd-es)
(t
'counsel-locate-cmd-default))
"The function for producing a locate command string from the input.
#'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."
@@ -2534,7 +2558,8 @@ string - the full shell command to run."
(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)))
(const :tag "everything" counsel-locate-cmd-es)
(function :tag "Custom")))
(ivy-set-actions
'counsel-locate
@@ -2569,33 +2594,33 @@ string - the full shell command to run."
(dired-jump nil x))
(defun counsel-locate-cmd-default (input)
"Return a shell command based on INPUT."
"Return a `locate' shell command based on regexp INPUT."
(counsel-require-program "locate")
(format "locate -i --regex '%s'"
(counsel--elisp-to-pcre
(ivy--regex input))))
(format "locate -i --regex %s"
(shell-quote-argument
(counsel--elisp-to-pcre
(ivy--regex input)))))
(defun counsel-locate-cmd-noregex (input)
"Return a shell command based on INPUT."
"Return a `locate' shell command based on INPUT."
(counsel-require-program "locate")
(format "locate -i '%s'" input))
(format "locate -i %s" (shell-quote-argument input)))
(defun counsel-locate-cmd-mdfind (input)
"Return a shell command based on INPUT."
"Return a `mdfind' shell command based on INPUT."
(counsel-require-program "mdfind")
(format "mdfind -name '%s'" input))
(defvar w32-ansi-code-page)
(format "mdfind -name %s" (shell-quote-argument input)))
(defun counsel-locate-cmd-es (input)
"Return a shell command based on 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 don't use Unicode by default, so we encode search command
;; to local codepage to support searching filename contains non-ASCII
;; characters.
;; 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
@@ -2603,7 +2628,7 @@ string - the full shell command to run."
raw-string)))
(defun counsel-locate-function (input)
"Call the \"locate\" shell command with INPUT."
"Call a \"locate\" style shell command with INPUT."
(or
(ivy-more-chars)
(progn
@@ -2617,10 +2642,7 @@ string - the full shell command to run."
(defun counsel-file-stale-p (fname seconds)
"Return non-nil if FNAME was modified more than SECONDS ago."
(> (time-to-seconds
(time-subtract
(current-time)
(nth 5 (file-attributes fname))))
(> (float-time (time-subtract nil (nth 5 (file-attributes fname))))
seconds))
(defun counsel--locate-updatedb ()
@@ -2635,7 +2657,7 @@ string - the full shell command to run."
;;;###autoload
(defun counsel-locate (&optional initial-input)
"Call the \"locate\" shell command.
"Call a \"locate\" style shell command.
INITIAL-INPUT can be given as the initial minibuffer input."
(interactive)
(counsel--locate-updatedb)
@@ -2966,24 +2988,33 @@ 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 the current 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.
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 string, if non-nil, is appended to `counsel-ag-base-command'.
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'."
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)))))
(when current-prefix-arg
(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: "))))
" in directory: ")))))
(when (>= arg 16)
(setq extra-ag-args
(or extra-ag-args
(read-from-minibuffer (format "%s args: " prog-name)))))
@@ -3056,10 +3087,12 @@ Works for `counsel-git-grep', `counsel-ag', etc."
(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)))
(counsel--ag-extra-switches regex)
(when extra-switches
(split-string extra-switches))
(list
(counsel--grep-smart-case-flag)
regex))))
@@ -3762,7 +3795,7 @@ include attachments of other Org buffers."
(let (dirs)
(save-excursion
(goto-char (point-min))
(while (re-search-forward "^:\\(ATTACH_DIR\\|ID\\):[\t ]+\\(.*\\)$" nil t)
(while (re-search-forward ":\\(?:ATTACH_DIR\\|ID\\):[\t ]+.*$" nil t)
(let ((dir (org-attach-dir)))
(when dir
(push dir dirs)))))
@@ -3828,18 +3861,28 @@ include attachments of other Org buffers."
(interactive)
(require 'org-capture)
(ivy-read "Capture template: "
(delq nil
(mapcar
(lambda (x)
(when (> (length x) 2)
(format "%-5s %s" (nth 0 x) (nth 1 x))))
;; We build the list of capture templates as in
;; `org-capture-select-template':
(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")))))
;; 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))))
@@ -3987,7 +4030,7 @@ This variable has no effect unless
;; Misc. Emacs
;;** `counsel-mark-ring'
(defface counsel--mark-ring-highlight
'((t (:inherit highlight)))
'((t :inherit highlight))
"Face for current `counsel-mark-ring' line."
:group 'ivy-faces)
@@ -4037,7 +4080,7 @@ Obeys `widen-automatically', which see."
(cons (copy-marker (mark-marker)) marks)))
(candidates (counsel-mark--get-candidates marks)))
(if candidates
(counsel-mark--ivy-read candidates 'counsel-mark-ring)
(counsel-mark--ivy-read "Mark: " candidates 'counsel-mark-ring)
(message "Mark ring is empty"))))
(defun counsel-mark--get-candidates (marks)
@@ -4061,7 +4104,7 @@ point to indicarte where the candidate mark is."
(propertize (format fmt linum line) 'point (point))))
marks))))))
(defun counsel-mark--ivy-read (candidates caller)
(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 string displayed by ivy and the `cdr' being the point that
@@ -4069,7 +4112,7 @@ mark should take you to.
NOTE This has been abstracted out into it's own method so it can
be used by both `counsel-mark-ring' and `counsel-evil-marks'"
(ivy-read "Mark: " candidates
(ivy-read prompt candidates
:require-match t
:update-fn #'counsel--mark-ring-update-fn
:action (lambda (cand)
@@ -4150,8 +4193,8 @@ When ARG is non-nil, display all active evil registers."
(let* ((counsel--mark-ring-calling-point (point))
(candidates (counsel-mark--get-evil-candidates arg)))
(if candidates
(counsel-mark--ivy-read candidates 'counsel-evil-marks)
(message "no evil marks are active")))
(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'
@@ -4211,7 +4254,8 @@ Additional actions:\\<ivy-minibuffer-map>
:history 'counsel-package-history
:caller 'counsel-package))
(cl-pushnew '(counsel-package . "^+") ivy-initial-inputs-alist :key #'car)
(ivy-configure 'counsel-package
:initial-input "^+")
(defun counsel-package-action (package)
"Delete or install PACKAGE."
@@ -4387,13 +4431,18 @@ Signal a `buffer-read-only' error if called from a read-only
buffer position."
(with-ivy-window
(barf-if-buffer-read-only)
(setq last-command 'yank)
(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
;; Avoid unexpected additions to `kill-ring'
(let (interprogram-paste-function)
(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))
@@ -4538,7 +4587,7 @@ matching the register's value description against a regexp in
;;** `counsel-evil-registers'
(defface counsel-evil-register-face
'((t (:inherit counsel-outline-1)))
'((t :inherit counsel-outline-1))
"Face for highlighting `evil' registers in ivy."
:group 'ivy-faces)
@@ -4723,9 +4772,11 @@ An extra action allows to switch to the process buffer."
(defvar eshell-history-index)
(defvar slime-repl-input-history-position)
(defvar counsel-esh--index-last)
(defvar counsel-shell-history--index-last)
(defvar counsel-slime-repl-history--index-last)
(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)))
@@ -4736,9 +4787,12 @@ An extra action allows to switch to the process buffer."
(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
(setq slime-repl-input-history-position snd
counsel-slime-repl-history--index-last snd)))
nil))
(ivy-completion-in-region-action (car pair))))
(cl-defun counsel--browse-history (ring &key caller)
@@ -4761,9 +4815,6 @@ An extra action allows to switch to the process buffer."
(defvar eshell-history-ring)
(defvar eshell-matching-input-from-input-string)
(defvar counsel-esh--index-last nil
"Index corresponding to last selection with `counsel-esh-history'.")
;;;###autoload
(defun counsel-esh-history ()
"Browse Eshell history."
@@ -4783,9 +4834,6 @@ An extra action allows to switch to the process buffer."
(defvar comint-input-ring)
(defvar comint-matching-input-from-input-string)
(defvar counsel-shell-history--index-last nil
"Index corresponding to last selection with `counsel-shell-history'.")
;;;###autoload
(defun counsel-shell-history ()
"Browse shell history."
@@ -4804,9 +4852,6 @@ An extra action allows to switch to the process buffer."
(defvar slime-repl-input-history)
(defvar counsel-slime-repl-history--index-last nil
"Index corresponding to last selection with `counsel-slime-repl-history'.")
;;;###autoload
(defun counsel-slime-repl-history ()
"Browse Slime REPL history."
@@ -4816,7 +4861,9 @@ An extra action allows to switch to the process buffer."
:caller #'counsel-slime-repl-history))
;; TODO: add advice for slime-repl-input-previous/next to properly
;; reassign the ring index and match string
;; 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)
@@ -5854,6 +5901,7 @@ as arguments."
(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")))
@@ -5928,7 +5976,9 @@ 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 exec 45)
(ivy--truncate-string
(replace-regexp-in-string "env +[^ ]+ +" "" exec)
45)
'face 'counsel-application-name)
name
(if comment
@@ -5957,6 +6007,16 @@ EXEC is the command to launch the application."
"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).
@@ -6087,7 +6147,7 @@ Any desktop entries that fail to parse are recorded in
"Launch a Linux desktop application, similar to Alt-<F2>.
When ARG is non-nil, ignore NoDisplay property in *.desktop files."
(interactive "P")
(ivy-read "Run a command: " (counsel-linux-apps-list)
(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))
@@ -6279,7 +6339,8 @@ Use the presence of a `dir-locals-file' to determine the root."
(defvar counsel-compile-local-builds
'(counsel-compile-get-filtered-history
counsel-compile-get-build-directories
counsel-compile-get-make-invocation)
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
@@ -6319,26 +6380,30 @@ list is passed to `compilation-environment'."
(defvar counsel-compile-phony-pattern "^\\.PHONY:[\t ]+\\(.+\\)$"
"Regexp for extracting phony targets from Makefiles.")
;; This is loosely based on the Bash Make completion code
(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 an empty list is 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."
(let ((default-directory dir)
(targets nil))
(with-temp-buffer
;; 0 = no-rebuild, -q & 1 needs rebuild, 2 error (for GNUMake at
;; least)
(when (< (call-process "make" nil t nil "-nqp") 2)
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)
(setq targets
(nconc targets (split-string
(match-string-no-properties 1)))))))
(sort targets #'string-lessp)))
(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\".
@@ -6349,12 +6414,13 @@ text with FACE."
'font-lock-warning-face)
(propertize text 'face face)))
(defun counsel--compile-get-make-targets (srcdir &optional blddir)
"Return a list of Make targets for a given SRCDIR/BLDDIR combination.
(defun counsel--compile-get-make-targets (probe-fn srcdir &optional blddir)
"Return propertized make targets returned by PROBE-FN in SRCDIR.
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
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))
@@ -6371,7 +6437,7 @@ The resulting strings are tagged with properties that
(setq target (concat (format fmt target) suffix build-env))
(add-text-properties 0 (length target) props target)
target)
(counsel-compile--probe-make-targets (or blddir srcdir)))))
(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.
@@ -6381,7 +6447,41 @@ 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 srcdir blddir))))
(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."
@@ -6495,9 +6595,36 @@ specified by the `blddir' property."
(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."
"Call `compile' completing with smart suggestions, optionally for DIR.
Additional actions:
\\{counsel-compile-map}"
(interactive)
(setq counsel-compile--current-build-dir (or dir
(counsel--compile-root)
@@ -6505,6 +6632,7 @@ specified by the `blddir' property."
(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
@@ -6679,7 +6807,7 @@ We update it in the callback with `ivy-update-candidates'."
(browse-url
(concat
(nth 2 (assoc counsel-search-engine counsel-search-engines-alist))
x)))
(url-hexify-string x))))
(defun counsel-search ()
"Ivy interface for dynamically querying a search engine."