;;; projectile.el --- Manage and navigate projects in Emacs easily -*- lexical-binding: t -*- ;; Copyright © 2011-2026 Bozhidar Batsov ;; Author: Bozhidar Batsov ;; URL: https://github.com/bbatsov/projectile ;; Keywords: project, convenience ;; Package-Version: 20260824.913 ;; Package-Revision: f60f47f2f72d ;; Package-Requires: ((emacs "28.1") (compat "30")) ;; This file is NOT 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, 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 GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; ;; Projectile is a project interaction library for Emacs. ;; It provides a powerful set of features operating at the project ;; level, as well as simple heuristics to identify projects. ;; ;; See the README and https://docs.projectile.mx for more details. ;; ;;; Code: (require 'cl-lib) (require 'compat) (require 'seq) (require 'thingatpt) (require 'ibuffer) (require 'ibuf-ext) (require 'compile) (require 'grep) (require 'fileloop) (require 'filenotify) (require 'outline) (eval-when-compile ;; `transient' is bundled with Emacs 28.1+ (Projectile's minimum), but ;; it's only needed once `projectile-dispatch' is invoked, so it's ;; loaded lazily at run time (see `projectile-dispatch') and required ;; here only for macro expansion during byte-compilation. (require 'transient) (require 'find-dired) (require 'subr-x)) ;; All calls run after the lazy `(require 'transient)' in ;; `projectile-dispatch' (or are otherwise guarded). (declare-function transient-args "transient" (prefix)) (declare-function transient-setup "transient" (&optional name layout edit &rest params)) (declare-function transient-prefix "transient") (declare-function transient--default-infix-command "transient") (declare-function transient--suffix-only "transient") ;; Newer transient versions emit different internals from the ;; `transient-define-prefix' expansion; declare them as they appear so ;; byte-compiling against Emacs snapshots stays warning-free. (declare-function transient--set-layout "transient") ;;; Declarations ;; ;; A bunch of variable and function declarations ;; needed to appease the byte-compiler. (defvar ag-ignore-list) (defvar eshell-buffer-name) (defvar explicit-shell-file-name) (defvar grep-files-aliases) (defvar grep-find-ignored-directories) (defvar grep-find-ignored-files) (defvar eat-buffer-name) (defvar ghostel-buffer-name) (declare-function make-term "term") (declare-function term-mode "term") (declare-function term-char-mode "term") (declare-function term-ansi-make-term "term") (declare-function eshell-search-path "esh-ext") (declare-function vc-dir "vc-dir") (declare-function vc-dir-busy "vc-dir") (declare-function vc-git-grep "vc-git") (declare-function tramp-archive-file-name-p "tramp-archive") (declare-function tramp-archive-file-name-archive "tramp-archive") (declare-function helm-grep-get-file-extensions "helm-grep") (declare-function ripgrep-regexp "ext:ripgrep") (declare-function rg-run "ext:rg") (declare-function vterm "ext:vterm") (declare-function vterm-other-window "ext:vterm") (declare-function vterm-send-return "ext:vterm") (declare-function vterm-send-string "ext:vterm") (declare-function eat "ext:eat") (declare-function eat-other-window "ext:eat") (declare-function ghostel "ext:ghostel") (declare-function xref-show-xrefs "xref") (declare-function xref-matches-in-directory "xref") ;; Only available on Emacs 29+ built with tree-sitter support; every call ;; site is guarded at runtime (see `projectile-run-test-at-point'). (declare-function treesit-available-p "treesit.c") (declare-function treesit-parser-list "treesit.c") (declare-function treesit-node-at "treesit") (declare-function treesit-node-parent "treesit.c") (declare-function treesit-node-type "treesit.c") (declare-function treesit-node-child "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") (declare-function treesit-node-prev-sibling "treesit.c") (declare-function treesit-node-children "treesit") (declare-function treesit-node-text "treesit") ;;; Customization (defgroup projectile nil "Manage and navigate projects easily." :group 'tools :group 'convenience :link '(url-link :tag "GitHub" "https://github.com/bbatsov/projectile") :link '(url-link :tag "Online Manual" "https://docs.projectile.mx/") :link '(emacs-commentary-link :tag "Commentary" "projectile")) (defcustom projectile-indexing-method (if (eq system-type 'windows-nt) 'native 'alien) "Specifies the indexing method used by Projectile. There are three indexing methods - native, hybrid and alien. The native method is implemented in Emacs Lisp (therefore it is native to Emacs). Its advantage is that it is portable and will work everywhere that Emacs does. Its disadvantage is that it is a bit slow (especially for large projects). Generally it's a good idea to pair the native indexing method with caching. The hybrid indexing method uses external tools (e.g. git, find, etc) to speed up the indexing process. Still, the files will be post-processed by Projectile for sorting/filtering purposes. In this sense that approach is a hybrid between native indexing and alien indexing. The alien indexing method optimizes to the limit the speed of the hybrid indexing method. This means that Projectile will not post-process the files returned by the external commands and you're going to get the maximum performance possible. Projectile's ignore rules are still respected - they are handed to the external tool as exclusion arguments where it understands them, and applied in Emacs Lisp only for the few tools that can't express them (see `projectile-alien-honors-ignores'). Sorting is never applied. The disadvantage of the hybrid and alien methods is that they are not well supported on Windows systems. That's why by default alien indexing is the default on all operating systems, except Windows." :group 'projectile :type '(choice (const :tag "Native" native) (const :tag "Hybrid" hybrid) (const :tag "Alien" alien)) :safe (lambda (x) (memq x '(native hybrid alien))) :package-version '(projectile . "2.0.0")) (defcustom projectile-alien-honors-ignores t "Whether `alien' indexing applies Projectile's own ignore rules. The `alien' indexing method delegates the directory walk to an external tool (`git ls-files', `fd', `find', ...), which knows nothing about Projectile's ignore configuration: `projectile-globally-ignored-files', `projectile-globally-ignored-directories', `projectile-globally-ignored-file-suffixes' and the `-' entries of a project's dirconfig file (see `projectile-dirconfig-file'). When this is non-nil those rules are honored. Tools that can express exclusions themselves (`git ls-files' via pathspecs, `fd' via `--exclude') are handed the rules as arguments, so the filtering still happens outside Emacs and alien indexing stays fast. For the few tools that can't (svn, fossil, bzr, darcs, pijul, and the plain `find' fallback) the rules are applied to the tool's output in Emacs Lisp instead. Set this to nil to get the raw listing back and defer entirely to the external tool's own ignore rules (`.gitignore' and friends), which is how alien indexing behaved before Projectile 3.3. Note that dirconfig `+' keep entries and `!' unignore entries are a separate mechanism and remain `hybrid'/`native' only." :group 'projectile :type 'boolean :package-version '(projectile . "3.3.0")) (defcustom projectile-enable-caching (eq projectile-indexing-method 'native) "When t enables project files caching. Normally the cache lasts for the duration of your Emacs session. If you want the cache to persist between Emacs sessions you should set this option to `persistent'. Project caching is automatically enabled by default if you're using the native indexing method." :group 'projectile :type '(choice (const :tag "Disabled" nil) (const :tag "Transient" t) (const :tag "Persistent" persistent)) :package-version '(projectile . "2.9.0")) (defcustom projectile-async-index-sentinel-timeout 1.0 "Seconds to wait for a finished index's result before collecting it. The asynchronous indexer hands its result over from the indexing process's sentinel. Once that process has exited, Emacs is expected to run the sentinel promptly - but it isn't guaranteed to while a command is waiting for it, and Projectile then used to wait forever (issue #2118). After this many seconds Projectile parses the finished command's output itself instead. There's no correctness difference; the timeout only decides how long to let Emacs do it first." :group 'projectile :type 'number :package-version '(projectile . "3.3.0")) (defcustom projectile-async-indexing t "Whether to index projects without freezing Emacs. When non-nil, the external-command indexing methods (`alien' and `hybrid') run their indexing command asynchronously and wait for it in a way that keeps Emacs responsive to redisplay and `keyboard-quit' (\\[keyboard-quit]), instead of blocking until the command finishes. This matters most on large projects and on remote (TRAMP) hosts, where a cold `projectile-find-file' could otherwise freeze Emacs for seconds. The resulting file list is identical to the synchronous path; only the responsiveness during indexing differs. Has no effect under `native' indexing (the Emacs Lisp directory walk cannot run off the main thread), in batch mode, or while a keyboard macro is executing - those fall back to synchronous indexing." :group 'projectile :type 'boolean :package-version '(projectile . "3.0.0")) (defcustom projectile-kill-buffers-filter 'kill-all "Determine which buffers are killed by `projectile-kill-buffers'. When the kill-all option is selected, kills each buffer. When the kill-only-files option is selected, kill only the buffer associated to a file. It can also be a list of conditions, in which case a buffer is killed when it satisfies any of them. This is a composable DSL modeled on project.el's `project-kill-buffer-conditions'. Each condition is either: - a regular expression, matched against the buffer name, - a predicate function that takes the buffer as its argument and returns non-nil if it should be killed, - a cons cell whose car says how to interpret the cdr: * `major-mode' - kill if the buffer's major mode is `eq' to the cdr, * `derived-mode' - kill if the buffer's major mode is derived from it, * `not' - the cdr is a single negated condition, * `and' - the cdr is a list of conditions that must all match, * `or' - the cdr is a list of conditions, any of which match. An empty list (or nil) matches no buffers, so nothing is killed. For example, to kill only file-visiting buffers and dired buffers: (setq projectile-kill-buffers-filter \\='(buffer-file-name (derived-mode . dired-mode))) Otherwise, it should be a predicate that takes one argument: the buffer to be killed." :group 'projectile :type '(choice (const :tag "All project buffers" kill-all) (const :tag "Project file buffers" kill-only-files) (function :tag "Predicate") (repeat :tag "Conditions" (choice regexp function symbol (cons :tag "Major mode" (const major-mode) symbol) (cons :tag "Derived mode" (const derived-mode) symbol) (cons :tag "Negation" (const not) sexp) (cons :tag "Conjunction" (const and) sexp) (cons :tag "Disjunction" (const or) sexp)))) :package-version '(projectile . "2.0.0")) (defcustom projectile-file-exists-local-cache-expire nil "Number of seconds before the local file existence cache expires. Local refers to a file on a local file system. A value of nil disables this cache. See `projectile-file-exists-p' for details." :group 'projectile :type '(choice (const :tag "Disabled" nil) (natnum :tag "Seconds")) :package-version '(projectile . "0.11.0")) (defcustom projectile-file-exists-remote-cache-expire (* 5 60) "Number of seconds before the remote file existence cache expires. Remote refers to a file on a remote file system such as tramp. A value of nil disables this cache. See `projectile-file-exists-p' for details." :group 'projectile :type '(choice (const :tag "Disabled" nil) (natnum :tag "Seconds")) :package-version '(projectile . "0.11.0")) (defcustom projectile-files-cache-expire nil "Number of seconds before project files list cache expires. A value of nil means the cache never expires." :group 'projectile :type '(choice (const :tag "Never expires" nil) (natnum :tag "Seconds")) :package-version '(projectile . "1.0.0")) (define-obsolete-variable-alias 'projectile-auto-discover 'projectile-auto-discover-projects "3.4.0") (defcustom projectile-auto-discover-projects t "Whether to discover projects under `projectile-project-search-path'. When non-nil, the projects under the search path are discovered and remembered the first time a project-switching command runs in an Emacs session (see `projectile-discover-projects-in-search-path'). This has no effect unless `projectile-project-search-path' is set, so the default is harmless out of the box; point the search path at your projects directory and they'll be picked up automatically. See also `projectile-project-search-path'." :group 'projectile :type 'boolean :package-version '(projectile . "3.1.0")) (defcustom projectile-auto-cleanup-known-projects nil "Whether to cleanup projects when project switching commands are invoked. See also `projectile-cleanup-known-projects'." :group 'projectile :type 'boolean :package-version '(projectile . "2.9.0")) (defcustom projectile-auto-update-cache t "Whether cache is automatically updated when files are opened or deleted." :group 'projectile :type 'boolean :package-version '(projectile . "2.0.0")) (defcustom projectile-auto-update-cache-with-watches nil "When non-nil, watch project directories to keep the files cache fresh. Experimental. When enabled (and `projectile-enable-caching' is non-nil), Projectile registers filesystem notification watches (via `file-notify-add-watch') for the directories of a project whenever the project's file list is cached. Files created, deleted or renamed outside Emacs then update the cached file list automatically, largely removing the need for manual `projectile-invalidate-cache' calls. Emacs file notifications are not recursive, so this costs one watch per directory; projects spanning more directories than `projectile-watch-directory-limit' are not watched. Remote (TRAMP) projects are never watched. When an event cannot be applied incrementally the project's cache is invalidated instead and rebuilt lazily on the next file listing, which also re-arms the watches. Change this via Customize (or `setopt'): disabling it then drops all active watches immediately, and enabling it arms watches for the projects that are already cached. With plain `setq' the new value only takes effect the next time a project's file list is cached." :group 'projectile :type 'boolean :set (lambda (symbol value) (set-default symbol value) ;; The watch machinery is defined further down in this file, so ;; guard against the initial `defcustom' evaluation at load time. (if value ;; Only arm watches when the mode is on; otherwise they'd have no ;; mode-disable teardown to fire and would linger until Emacs exits. (when (and (bound-and-true-p projectile-mode) (fboundp 'projectile--watch-all-cached-projects)) (projectile--watch-all-cached-projects)) (when (fboundp 'projectile--teardown-all-watches) (projectile--teardown-all-watches)))) :package-version '(projectile . "3.1.0")) (defcustom projectile-watch-directory-limit 512 "Maximum number of file-notify watches to register per project. File notifications are not recursive, so watching a project costs one watch (and, on most backends, one file descriptor) per directory. Projects whose cached file list spans more directories than this are not watched at all; when `projectile-verbose' is non-nil a message is emitted once per project. Directories created inside a watched project count against the same limit. Only relevant when `projectile-auto-update-cache-with-watches' is enabled." :group 'projectile :type 'natnum :package-version '(projectile . "3.1.0")) (defcustom projectile-require-project-root 'prompt "Require the presence of a project root to operate when true. When set to `prompt' Projectile will ask you to select a project directory if you're not in a project. When nil Projectile will consider the current directory the project root." :group 'projectile :type '(choice (const :tag "No" nil) (const :tag "Yes" t) (const :tag "Prompt for project" prompt)) :package-version '(projectile . "2.0.0")) (defcustom projectile-completion-system 'default "The completion system to be used by Projectile. Either `default' (Emacs's built-in `completing-read', which works with Vertico, Consult, Fido, `ido-completing-read+', etc.) or a custom function accepting a prompt and a list of choices. Note: the dedicated `ido', `helm' and `ivy' options were removed - those frameworks are used through `completing-read' (or their own Projectile integration packages, `helm-projectile' / `counsel-projectile'), so any of those legacy values now behaves like `default'." :group 'projectile :type '(choice (const :tag "Default (completing-read)" default) (function :tag "Custom function")) :package-version '(projectile . "3.0.0")) (defcustom projectile-keymap-prefix nil "The key sequence `projectile-command-map' is bound to, if any. A key sequence in the form `kbd' returns, e.g. (kbd \"C-c p\"). There is no prefix by default - Projectile binds none of its commands until you ask for it. The value is read once, when `projectile-mode-map' is built as Projectile loads, so it has to be set before that - which rules out Customize and `setopt'. Binding the map directly works whenever: (define-key projectile-mode-map (kbd \"C-c p\") \\='projectile-command-map)" :group 'projectile :type '(choice (const :tag "None" nil) (key-sequence :tag "Prefix")) :package-version '(projectile . "0.7")) (defcustom projectile-cache-file ".projectile-cache.eld" "The name of Projectile's cache. It's relative to the project root." :group 'projectile :type 'string :package-version '(projectile . "2.9.0")) ;; Remove in 4.0. This was only ever read to seed the default of ;; `projectile-globally-ignored-files' as this file loaded, so setting it ;; from an init file never did anything; that list now names TAGS itself. (defvar projectile-tags-file-name "TAGS" "The name of the tags file Projectile excludes from indexing.") (make-obsolete-variable 'projectile-tags-file-name "add the file name to `projectile-globally-ignored-files' instead." "3.4.0") (defcustom projectile-sort-order 'default "The sort order used for a project's files. It can also be set to a function that takes the list of project files (as relative paths) and returns them in the desired order. Note that files aren't sorted if `projectile-indexing-method' is set to `alien'." :group 'projectile :type '(choice (const :tag "Default (no sorting)" default) (const :tag "Recently opened files" recentf) (const :tag "Recently active buffers, then recently opened files" recently-active) (const :tag "Access time (atime)" access-time) (const :tag "Modification time (mtime)" modification-time) (function :tag "Custom sort function")) :package-version '(projectile . "3.1.0")) (defcustom projectile-verbose t "Whether to echo the messages Projectile emits without being asked. This covers what Projectile says as a side effect of something else - caching a file you just opened, a background index that had something to report, a session file it had to skip. Commands you invoke still say what they did whatever this is set to: turning it off makes Projectile quieter, not mute." :group 'projectile :type 'boolean :package-version '(projectile . "0.12.0")) (defconst projectile--message-prefix "[Projectile] " "What Projectile puts in front of the messages it emits unprompted. Bracketed rather than `Projectile: \\=', which is the form eglot uses and which stays legible when the message itself contains a colon - several do. Direct answers to a command you just invoked go unprefixed: you know who is talking, and the echo area is narrow.") (defun projectile--message (format-string &rest args) "Report FORMAT-STRING with ARGS as coming from Projectile, if permitted. For what Projectile says off its own bat - a background index, a watch that gave up, a file cached behind a `find-file\\='. Such a message is prefixed, so it is clear where it came from when nothing was asked of Projectile, and suppressed entirely when `projectile-verbose\\=' is nil. See `projectile--message-always\\=' for the messages that must not be suppressed." (when projectile-verbose (apply #'projectile--message-always format-string args))) (defun projectile--message-always (format-string &rest args) "Report FORMAT-STRING with ARGS as coming from Projectile. The prefix without the `projectile-verbose\\=' gate, for the messages that answer for something you did ask for but arrive later, out of a process sentinel or a timer - by then the prefix is the only thing saying which package is talking." (message "%s%s" projectile--message-prefix (apply #'format format-string args))) (defcustom projectile-buffers-filter-function nil "A function used to filter the buffers in `projectile-project-buffers'. The function should accept and return a list of Emacs buffers. Two example filter functions are shipped by default - `projectile-buffers-with-file' and `projectile-buffers-with-file-or-process'." :group 'projectile :type '(choice (const :tag "No filtering" nil) (function :tag "Filter function")) :package-version '(projectile . "0.11.0")) (defcustom projectile-project-name nil "If this value is non-nil, it will be used as project name. It has precedence over function `projectile-project-name-function'." :group 'projectile :type '(choice (const :tag "Derive from the project root" nil) (string :tag "Name")) :safe (lambda (v) (or (null v) (and (stringp v) (not (string-blank-p v))))) :package-version '(projectile . "0.14.0")) (defcustom projectile-project-name-function 'projectile-default-project-name "A function that receives the project-root and returns the project name. If variable `projectile-project-name' is non-nil, this function will not be used." :group 'projectile :type 'function :package-version '(projectile . "0.14.0")) (defcustom projectile-project-root-files '( "GTAGS" ; GNU Global tags "TAGS" ; etags/ctags are usually in the root of project "configure.ac" ; autoconf new style "configure.in" ; autoconf old style "cscope.out" ; cscope ) "A list of files considered to mark the root of a project. The topmost match has precedence. See `projectile-register-project-type'." :group 'projectile :type '(repeat string) :package-version '(projectile . "0.10.0")) (defcustom projectile-project-root-files-bottom-up '(".git" ; Git VCS root dir ".hg" ; Mercurial VCS root dir ".fslckout" ; Fossil VCS root dir "_FOSSIL_" ; Fossil VCS root DB on Windows ".bzr" ; Bazaar VCS root dir "_darcs" ; Darcs VCS root dir ".pijul" ; Pijul VCS root dir ".sl" ; Sapling VCS root dir ".jj" ; Jujutsu VCS root dir ) "A list of files considered to mark the root of a project. The bottommost (parentmost) match has precedence. This list holds only VCS markers (plus whatever you add yourself). Per-language project manifests are deliberately *not* included, so an enclosing VC root wins over a manifest sitting in a subdirectory - the behavior most users and IDEs expect (the git repository is the project). In a polyglot or monorepo layout where you want a deeper subproject to win instead, drop a `.projectile' file in it; `projectile-root-marked' runs before `projectile-root-bottom-up', so the marked subproject takes precedence over the outer VC root." :group 'projectile :type '(repeat string) :package-version '(projectile . "0.11.0")) (defcustom projectile-project-root-files-top-down-recurring '(".svn" ; Svn VCS root dir "CVS" ; CVS VCS root dir ".osc" ; osc (openSUSE Build Service) checkout dir "Makefile") "A list of files considered to mark the root of a project. The search starts at the top and descends down till a directory that contains a match file but its parent does not. Thus, it's a bottommost match in the topmost sequence of directories containing a root file." :group 'projectile :type '(repeat string) :package-version '(projectile . "3.1.0")) (defcustom projectile-project-root-functions '(projectile-root-local projectile-root-marked projectile-root-bottom-up projectile-root-top-down projectile-root-top-down-recurring) "A list of functions for finding project root folders. The functions will be run until one of them returns a project folder. Reordering the default functions will alter the project discovery algorithm." :group 'projectile :type '(repeat function) :package-version '(projectile . "2.4.0")) (defcustom projectile-dirconfig-file ".projectile" "The file which serves both as a project marker and configuration file. The mere presence of this file in a directory marks that directory as a Projectile project root, even when the file is empty. When the file has content, it is parsed by `projectile-parse-dirconfig-file' to drive `+' keep / `-' ignore / `!' ensure rules; see the manual for the full format. This should _not_ be set via .dir-locals.el." :group 'projectile :type 'file :package-version '(projectile . "2.7.0")) (defcustom projectile-dirconfig-comment-prefix nil "`projectile-dirconfig-file' comment start marker. If specified, starting a line in a project's .projectile file with this character marks that line as a comment instead of a pattern. Similar to '#' in .gitignore files." :group 'projectile :type '(choice (const :tag "No comment syntax" nil) (character :tag "Comment character")) :package-version '(projectile . "2.2.0")) (defcustom projectile-warn-on-prefixless-dirconfig-lines t "Whether to warn about deprecated prefix-less ignore entries. Lines in `.projectile' that start with no `+'/`-'/`!' prefix are still accepted as ignore patterns for backward compatibility, but the implicit form is being phased out. When this option is non-nil, a one-time warning is shown per project that uses any such line, listing the offending entries." :group 'projectile :type 'boolean :package-version '(projectile . "3.0.0")) ;; The options below hold nothing but a list of names, patterns or regexps, ;; and none of them can do more than widen or narrow a listing - so a project ;; is free to set any of them from its .dir-locals.el. (defcustom projectile-globally-ignored-files (list "TAGS" projectile-cache-file) "A list of files globally ignored by projectile. Entries are gitignore patterns: a plain name matches a file with that name at any depth, a name containing a slash is anchored at the project root, and `*', `**', `?' and `[...]' are the usual wildcards. See `projectile-globally-ignored-directories' for the full pattern language." :group 'projectile :type '(repeat string) :safe #'list-of-strings-p :package-version '(projectile . "3.0.0")) (defcustom projectile-globally-unignored-files nil "A list of files globally unignored by projectile. Entries cancel out the matching `projectile-globally-ignored-files' entries." :group 'projectile :type '(repeat string) :safe #'list-of-strings-p :package-version '(projectile . "0.14.0")) (defcustom projectile-globally-ignored-file-suffixes nil "A list of file suffixes globally ignored by projectile. Each suffix is matched at the end of a file name at any depth, as if it were the gitignore pattern `*SUFFIX' (e.g. \".elc\" ignores every `.elc' file in the project)." :group 'projectile :type '(repeat string) :safe #'list-of-strings-p :package-version '(projectile . "0.12.0")) (defcustom projectile-globally-ignored-directories '(;; editors ".idea" ".vscode" ".ccls-cache" ".cache" ".clangd" ;; version control ".git" ".hg" ".fslckout" "_FOSSIL_" ".bzr" "_darcs" ".pijul" ".svn" ".sl" ".jj" ".osc" ;; dependencies and build output ;; ;; These are all directories a tool generates and a project doesn't ;; commit. Under `alien' they're usually excluded by the VCS anyway; ;; the point of listing them is `native' and `hybrid' indexing, and ;; projects that aren't under version control at all. Names that some ;; projects do commit - `vendor', `build', `dist', `public' - are ;; deliberately not here. "node_modules" "target" "_build" ".gradle" ".stack-work" ".build" "elm-stuff" ".dart_tool" ".zig-cache" "zig-out" "__pycache__" "*.egg-info" ".venv" ".tox" ".mypy_cache" ".pytest_cache" ".ruff_cache" ".next" ".nuxt" ".svelte-kit" ".astro" ".turbo" ".parcel-cache" "_site" ".terraform" ".direnv") "A list of directories globally ignored by projectile. Entries are gitignore patterns, matched against paths relative to the project root and applied by every indexing method alike: - a pattern without a slash matches a directory with that name at any depth, so \"tmp\" ignores both ./tmp and ./src/tmp - a pattern containing a slash is anchored at the project root, so \"/tmp\" and \"doc/frotz\" only match there - `*' is a wildcard within a path segment, `**' spans segments, `?' matches a single non-slash character and `[...]'/`[!...]' are character classes Matching is case-sensitive. Note that a leading `*' is a plain wildcard - it used to be a marker meaning \"at any depth\", which is now the default for every slashless pattern. Besides the editor and version control directories, the default value covers the dependency and build output directories of the common ecosystems - `node_modules', `target', `__pycache__' and so on. Add an entry to `projectile-globally-unignored-directories' to get one of them back, or a `!' line to a project's `.projectile' to get it back for that project only. See also `projectile-globally-ignored-file-regexps'." :group 'projectile :type '(repeat string) :safe #'list-of-strings-p :package-version '(projectile . "3.3.0")) (defcustom projectile-globally-unignored-directories nil "A list of directories globally unignored by projectile. Entries cancel out the matching `projectile-globally-ignored-directories' entries." :group 'projectile :type '(repeat string) :safe #'list-of-strings-p :package-version '(projectile . "0.14.0")) (define-obsolete-variable-alias 'projectile-global-ignore-file-patterns 'projectile-globally-ignored-file-regexps "3.4.0") (defcustom projectile-globally-ignored-file-regexps nil "A list of regexps matching files ignored by Projectile. Unlike `projectile-globally-ignored-files' and `projectile-globally-ignored-directories', which speak gitignore patterns, the entries here are Emacs regexps, matched against absolute file names. They complement the pattern-based options; because they can't be handed to an external tool, nor expressed as globs, they are only applied by `native' indexing. See also `projectile-ignored-file-p' and `projectile-ignored-directory-p'." :group 'projectile :type '(repeat string) :safe #'list-of-strings-p :package-version '(projectile . "2.9.0")) (defcustom projectile-globally-ignored-modes '("erc-mode" "help-mode" "completion-list-mode" "Buffer-menu-mode" "gnus-.*-mode" "occur-mode") "A list of regular expressions for major modes ignored by projectile. If a buffer is using a given major mode, projectile will ignore it for functions working with buffers. Each entry is matched against the whole mode name, so \"occur-mode\" ignores that mode and nothing else, while \"gnus-.*-mode\" ignores a family of them." :group 'projectile :type '(repeat regexp) :safe #'list-of-strings-p :package-version '(projectile . "0.10.0")) (defcustom projectile-globally-ignored-buffers '("\\*scratch\\*" "\\*lsp-log\\*") "A list of buffer names ignored by projectile. If a buffer matches one of these, projectile will ignore it for functions working with buffers. Each entry is a regular expression, matched anywhere in the buffer name - unlike `projectile-globally-ignored-modes', which matches whole mode names. Anchor an entry yourself when you mean an exact name. Note that the `*' of a buffer name like `*scratch*' has to be escaped to be matched literally, as in the default value; unescaped it is a repetition operator." :group 'projectile :type '(repeat regexp) :safe #'list-of-strings-p :package-version '(projectile . "0.12.0")) (defcustom projectile-find-file-hook nil "Hooks run when a file is opened with `projectile-find-file'." :group 'projectile :type 'hook :package-version '(projectile . "0.10.0")) (defcustom projectile-find-dir-hook nil "Hooks run when a directory is opened with `projectile-find-dir'." :group 'projectile :type 'hook :package-version '(projectile . "0.10.0")) (defcustom projectile-switch-project-action 'projectile-find-file "Action invoked after switching projects with `projectile-switch-project'. Any function that does not take arguments will do." :group 'projectile :type 'function :package-version '(projectile . "0.10.0")) (defcustom projectile-switch-project-other-window-action 'projectile-find-file-other-window "Action run by `projectile-switch-project-other-window' after switching. Like `projectile-switch-project-action', but for the other-window variant. Any function that does not take arguments will do." :group 'projectile :type 'function :package-version '(projectile . "3.0.0")) (defcustom projectile-switch-project-other-frame-action 'projectile-find-file-other-frame "Action run by `projectile-switch-project-other-frame' after switching. Like `projectile-switch-project-action', but for the other-frame variant. Any function that does not take arguments will do." :group 'projectile :type 'function :package-version '(projectile . "3.0.0")) (defcustom projectile-find-dir-includes-top-level nil "If true, add top-level dir to options offered by `projectile-find-dir'." :group 'projectile :type 'boolean :package-version '(projectile . "0.10.0")) (defcustom projectile-use-git-grep nil "Whether `projectile-grep' delegates to `vc-git-grep' in git projects. Only affects `projectile-grep'; the other search commands and the backends of `projectile-search' ignore this." :group 'projectile :type 'boolean :package-version '(projectile . "0.11.0")) (defcustom projectile-search-backend 'auto "The backend `projectile-search' uses to search the project. Either a backend name registered in `projectile-search-backends' \(`grep', `ripgrep', `ag', or one you registered yourself with `projectile-register-search-backend'), `auto' to pick the first available backend (favouring ripgrep, then grep), or `prompt' to be asked which backend to use each time." :group 'projectile :type '(choice (const :tag "Automatic" auto) (const :tag "Prompt each time" prompt) (const :tag "grep" grep) (const :tag "ripgrep" ripgrep) (const :tag "ag" ag) (symbol :tag "Other registered backend")) :package-version '(projectile . "3.0.0")) (defcustom projectile-shell-backend 'eshell "The backend `projectile-run' uses to open a shell/REPL/terminal. Either a backend name registered in `projectile-shell-backends' \(`shell', `eshell', `ielm', `term', `vterm', `eat', `ghostel', or one you registered yourself with `projectile-register-shell-backend'), `auto' to pick the first available backend, or `prompt' to be asked each time." :group 'projectile :type '(choice (const :tag "Automatic" auto) (const :tag "Prompt each time" prompt) (const :tag "shell" shell) (const :tag "eshell" eshell) (const :tag "ielm" ielm) (const :tag "term" term) (const :tag "vterm" vterm) (const :tag "eat" eat) (const :tag "ghostel" ghostel) (symbol :tag "Other registered backend")) :package-version '(projectile . "3.0.0")) (defcustom projectile-grep-finished-hook nil "Hooks run when `projectile-grep' finishes." :group 'projectile :type 'hook :package-version '(projectile . "0.14.0")) (defcustom projectile-test-prefix-function 'projectile-test-prefix "Function to find test files prefix based on PROJECT-TYPE." :group 'projectile :type 'function :package-version '(projectile . "0.11.0")) (defcustom projectile-test-suffix-function 'projectile-test-suffix "Function to find test files suffix based on PROJECT-TYPE." :group 'projectile :type 'function :package-version '(projectile . "0.11.0")) (define-obsolete-variable-alias 'projectile-related-files-fn-function 'projectile-related-files-function "3.4.0") (defcustom projectile-related-files-function 'projectile-related-files-fn "Function to find related files based on PROJECT-TYPE." :group 'projectile :type 'function :package-version '(projectile . "2.1.0")) (defcustom projectile-dynamic-mode-line t "If true, update the mode-line dynamically. The mode-line is updated when files are opened via `find-file-hook' and when the window configuration changes. Change the value via Customize or `setopt' so it takes effect immediately; a plain `setq' only takes effect before `projectile-mode' is enabled. See also `projectile-mode-line-function' and `projectile-update-mode-line'." :group 'projectile :type 'boolean :set (lambda (symbol value) (set-default symbol value) (when (bound-and-true-p projectile-mode) (if value (add-hook 'window-configuration-change-hook #'projectile-update-mode-line-on-window-change) (remove-hook 'window-configuration-change-hook #'projectile-update-mode-line-on-window-change)))) :package-version '(projectile . "2.0.0")) (defcustom projectile-mode-line-function 'projectile-default-mode-line "The function to use to generate project-specific mode-line. The default function adds the project name and type to the mode-line. See also `projectile-update-mode-line'." :group 'projectile :type 'function :package-version '(projectile . "2.0.0")) (defcustom projectile-default-src-directory "src/" "The default value of a project's src-dir property. It's used as a fallback in the case the property is not set for a project type when `projectile-toggle-between-implementation-and-test' is used." :group 'projectile :type 'string :package-version '(projectile . "2.6.0")) (defcustom projectile-default-test-directory "test/" "The default value of a project's test-dir property. It's used as a fallback in the case the property is not set for a project type when `projectile-toggle-between-implementation-and-test' is used." :group 'projectile :type 'string :package-version '(projectile . "2.6.0")) ;;; Per-project cache registry ;; ;; Projectile keeps a growing set of per-project caches. Every one of ;; them has to be dropped when a project is invalidated and isolated in ;; the test sandbox; forgetting either wiring is a silent bug. Caches ;; defined through `projectile-define-project-cache' get both for free, ;; and cleanups that aren't a simple table entry (killing a process, ;; deleting a file) can be attached with ;; `projectile--register-project-cache-cleanup'. (defvar projectile--project-cache-vars nil "Hash-table variables holding per-project caches. Collected by `projectile-define-project-cache'. The test sandbox rebinds each of these to a fresh table for isolation.") (defvar projectile--project-cache-cleanups nil "Alist of NAME to cleanup function, run when a project is invalidated. Each function is called with the project root being invalidated. Keyed by name so that reloading projectile doesn't accumulate duplicate cleanups.") (defun projectile--register-project-cache-cleanup (name function) "Register FUNCTION under NAME to run when a project is invalidated. FUNCTION is called with the project root. Registering under an existing NAME replaces the previous cleanup." (setf (alist-get name projectile--project-cache-cleanups) function)) (defmacro projectile-define-project-cache (name docstring &rest props) "Define NAME as a per-project cache table documented by DOCSTRING. The table is keyed by project root (with test `equal') and is wired into `projectile--invalidate-project-cache' and the test sandbox automatically. PROPS may contain `:prefix-keyed t' for tables whose keys are directories under a project rather than the root itself; invalidation then drops every entry under the invalidated root." (declare (indent 1) (doc-string 2)) `(progn (defvar ,name (make-hash-table :test 'equal) ,docstring) (add-to-list 'projectile--project-cache-vars ',name) (projectile--register-project-cache-cleanup ',name ,(if (plist-get props :prefix-keyed) `(lambda (project-root) (dolist (key (hash-table-keys ,name)) (when (string-prefix-p project-root key) (remhash key ,name)))) `(lambda (project-root) (remhash project-root ,name)))) ',name)) (projectile-define-project-cache projectile-projects-cache "A hashmap used to cache project file names to speed up related operations.") (projectile-define-project-cache projectile-projects-cache-time "A hashmap used to record when we populated `projectile-projects-cache'.") (defvar projectile--async-index-processes (make-hash-table :test 'equal) "Map of project root -> in-flight async indexing process. Used to avoid running more than one background index for the same project at a time, and to discard a stale background result whose project cache was invalidated while it was still running.") ;; Cancel any in-flight background index for an invalidated project so ;; its now-stale result can't repopulate the cache we just cleared. (projectile--register-project-cache-cleanup 'projectile--async-index-processes (lambda (project-root) (when-let* ((proc (gethash project-root projectile--async-index-processes))) (when (process-live-p proc) (delete-process proc)) (remhash project-root projectile--async-index-processes)))) (defvar projectile-project-root-cache (make-hash-table :test 'equal) "Cached value of function `projectile-project-root'.") ;;; Project path spelling helpers ;; ;; A "project root" string is spelled in exactly two canonical ways across ;; the code base, and mixing them up is a recurring source of subtle cache ;; bugs (a root looked up in one spelling never matching a key stored in the ;; other). The two spellings are: ;; ;; - The *cache-key* spelling: what `projectile-project-root' returns, i.e. ;; an absolute, symlink-resolved (its search starts from `file-truename'), ;; directory name ending in a slash. This is what every per-project cache ;; table (`projectile-projects-cache', the frecency table, the watch ;; registry, ...) is keyed by. Never re-abbreviate or re-expand such a ;; value before using it as a key - it is already canonical. ;; ;; - The *known-projects* spelling: the abbreviated form persisted in ;; `projectile-known-projects' and shown to the user. Produce it only via ;; `projectile--known-project-root' so every entry is spelled identically ;; (abbreviated, trailing slash), which is what removal and membership ;; checks rely on. ;; ;; `projectile--project-relative-name' owns the third boundary: turning an ;; absolute path into a root-relative one. (defun projectile--project-relative-name (path root) "Return PATH spelled relative to project ROOT. ROOT must be spelled as `projectile-project-root' returns it (absolute, symlink-resolved, trailing slash) and PATH must share that spelling \(e.g. already run through `file-truename' / `expand-file-name' the same way). When the two spellings diverge - PATH reached through a symlink or abbreviation the root wasn't - the result gains leading `../' segments; callers that cache the result should reject a value starting with \"..\" rather than store a bogus entry. This is a thin wrapper around `file-relative-name' whose sole purpose is to give that boundary a single, documented owner." (file-relative-name path root)) (defun projectile--known-project-root (root) "Return ROOT in the canonical spelling used inside `projectile-known-projects'. Entries are stored abbreviated (via `abbreviate-file-name') and with a trailing slash so that membership and removal checks compare equal regardless of how the root was originally obtained." (file-name-as-directory (abbreviate-file-name root))) (defun projectile--directory-key (path) "Return PATH in a spelling two references to one directory always share. Symlink-resolved and slash-terminated, so it can be compared with `equal' or used as a hash key regardless of how each reference was spelled." (file-truename (file-name-as-directory path))) (projectile-define-project-cache projectile-project-type-cache "A hashmap used to cache project type to speed up related operations. Keyed by project root, and also by subproject root for the types `projectile-subproject-type' detects - hence `:prefix-keyed', so invalidating a repository drops its members' entries along with its own." :prefix-keyed t) (projectile-define-project-cache projectile-project-vcs-cache "Cache of `projectile-project-vcs' results keyed by directory. Cleared by `projectile-invalidate-cache' and `projectile-discard-root-cache'. Entries are VCS symbols (or `none' for projects with no detected VCS).") (projectile-define-project-cache projectile--dirconfig-cache "Cache for parsed dirconfig files, keyed by project root. Each value is a list of (DIRCONFIG-PATH MTIME PARSED-RESULT); a cache hit requires both DIRCONFIG-PATH and MTIME to match the current file, so changing `projectile-dirconfig-file' mid-session naturally invalidates the entry.") (projectile-define-project-cache projectile--git-submodules-cache "Cache of raw git submodule listings, keyed by directory. Each value is a list of (GITMODULES-PATH MTIME COMMAND SUBMODULES); a cache hit requires the `.gitmodules' path, its modification time and `projectile-git-submodule-command' to all match, so editing `.gitmodules' (or changing the command mid-session) naturally invalidates the entry. Alien/hybrid indexing lists submodules on every file listing and the `git submodule foreach' shell-out dominates its runtime (see issue #1953); a stat of `.gitmodules' is practically free in comparison." :prefix-keyed t) (defvar projectile--pending-cache-flush-timers (make-hash-table :test 'equal) "Map of project root to a pending idle-timer that will serialize its cache. Used by `projectile-cache-current-file' to coalesce rapid file additions into a single delayed disk write per project.") ;; Cancel a pending flush for an invalidated project - if it fired ;; after invalidation it would serialize the now-empty in-memory state, ;; recreating the cache file we just deleted with nil contents. (projectile--register-project-cache-cleanup 'projectile--pending-cache-flush-timers (lambda (project-root) (when-let* ((timer (gethash project-root projectile--pending-cache-flush-timers))) (cancel-timer timer) (remhash project-root projectile--pending-cache-flush-timers)))) ;; Deliberately a plain defvar rather than a `projectile-define-project-cache': ;; the descriptors in this table are live OS resources, so the test sandbox ;; must not rebind it to a fresh table (that would orphan active watches). ;; Invalidation goes through `projectile--unwatch-project' instead, which ;; removes the watches before dropping the registry entries. (defvar projectile--project-watches (make-hash-table :test 'equal) "Map of project root to its registered file-notify watches. Each value is a list of (DESCRIPTOR . DIRECTORY) conses, DIRECTORY being the watched directory as an absolute name with a trailing slash. Only populated when `projectile-auto-update-cache-with-watches' is enabled; see `projectile--watch-project'.") ;; Drop an invalidated project's file-notify watches along with their ;; queued events; they re-arm the next time the cache is filled (see ;; `projectile-cache-project'). (projectile--register-project-cache-cleanup 'projectile--project-watches (lambda (project-root) (projectile--unwatch-project project-root))) (defvar projectile--watch-pending-events (make-hash-table :test 'equal) "Map of project root to its queued (not yet processed) file-notify events. Events are pushed by `projectile--handle-watch-event' (so the list is in reverse arrival order) and drained by `projectile--process-watch-events' once the debounce timer fires.") (defvar projectile--watch-debounce-timers (make-hash-table :test 'equal) "Map of project root to the pending debounce timer for its watch events.") (defvar projectile--watch-debounce-delay 0.5 "Seconds to wait after a file-notify event before processing the batch. Coalesces event bursts (e.g. a `git checkout' touching many files) into a single pass over the project's cached file list.") (defvar projectile--watch-skipped-projects (make-hash-table :test 'equal) "Set of project roots already reported as too big (or unable) to watch. Used to emit the `projectile-watch-directory-limit' message only once per project and session.") (defvar projectile--prefixless-dirconfig-warned-projects (make-hash-table :test 'equal) "Set of project roots already warned about prefix-less dirconfig entries.") (defvar projectile--glob-keep-warned-projects (make-hash-table :test 'equal) "Set of project roots already warned about glob patterns in + keep entries.") (defvar projectile-known-projects nil "List of locations where we have previously seen projects. The list of projects is ordered by the time they have been accessed. See also `projectile-remove-known-project', `projectile-cleanup-known-projects' and `projectile-clear-known-projects'.") (defvar projectile-known-projects-on-file nil "List of known projects reference point. Contains a copy of `projectile-known-projects' when it was last synchronized with `projectile-known-projects-file'.") (defcustom projectile-known-projects-file (locate-user-emacs-file "projectile-bookmarks.eld") "Name and location of the Projectile's known projects file. Resolved with `locate-user-emacs-file\\=', so it lands beside the rest of your Emacs state wherever that is - including `~/.config/emacs\\=' for a configuration kept there, which a hand-rolled `user-emacs-directory\\=' path would have missed." :group 'projectile :type 'file :package-version '(projectile . "3.4.0")) (defcustom projectile-ignored-projects nil "A list of projects not to be added to `projectile-known-projects'." :group 'projectile :type '(repeat :tag "Project list" directory) :package-version '(projectile . "0.11.0")) (defcustom projectile-ignored-project-patterns nil "Regexps matching projects not to be added to `projectile-known-projects'. The pattern-matching sibling of `projectile-ignored-projects', which takes exact paths, and `projectile-ignored-project-function', which takes a predicate. Each entry is matched against the project root with `string-match-p', so keeping the scratch areas of a machine out of the known projects is a line of configuration rather than a lambda: (setq projectile-ignored-project-patterns \\='(\"\\\\`/tmp/\" \"/Downloads/\"))" :group 'projectile :type '(repeat :tag "Regexps" regexp) :package-version '(projectile . "3.4.0")) (defcustom projectile-ignored-project-function nil "Function to decide if a project is added to `projectile-known-projects'. Can be either nil, or a function that takes the truename of the project root as argument and returns non-nil if the project is to be ignored or nil otherwise. This function is only called if the project is not listed in the variable `projectile-ignored-projects' and matches none of `projectile-ignored-project-patterns'. A suitable candidate would be `file-remote-p' to ignore remote projects." :group 'projectile :type '(choice (const :tag "Nothing" nil) (const :tag "Remote files" file-remote-p) function) :package-version '(projectile . "0.13.0")) (defcustom projectile-track-known-projects-automatically t "Controls whether Projectile will automatically register known projects. When set to nil you'll always have to add projects explicitly with `projectile-add-known-project'." :group 'projectile :type 'boolean :package-version '(projectile . "1.0.0")) (defcustom projectile-project-search-path nil "List of folders where projectile is automatically going to look for projects. You can think of something like $PATH, but for projects instead of executables. Examples of such paths might be ~/projects, ~/work, (~/github . 1) etc. For elements of form (DIRECTORY . DEPTH), DIRECTORY has to be a directory and DEPTH an integer that specifies the depth at which to look for projects. A DEPTH of 0 means check DIRECTORY. A depth of 1 means check all the subdirectories of DIRECTORY. Etc." :group 'projectile :type '(repeat (choice directory (cons directory (integer :tag "Depth")))) :package-version '(projectile . "1.0.0")) (defcustom projectile-fd-executable (cond ((executable-find "fdfind") "fdfind") ((executable-find "fd") "fd")) "Path or name of fd executable used by Projectile if enabled. Nil means fd is not installed or should not be used. Note: this variable holds the locally-detected executable. For projects on a TRAMP host fd is detected separately on the remote (and cached per host), since whatever is on the local box may not exist on the remote. See `projectile-fd-executable-for'." :group 'projectile :type '(choice (const :tag "Don't use fd" nil) (string :tag "Path or name")) :package-version '(projectile . "2.8.0")) (defvar projectile--remote-fd-executable-cache (make-hash-table :test 'equal) "Per-host cache of fd availability on remote (TRAMP) hosts. Keys are the prefixes returned by `file-remote-p' (e.g. `/ssh:user@host:'); values are either the executable name (a string) or nil for hosts where neither `fd' nor `fdfind' is available. The sentinel `unset' distinguishes \"never looked up\" from \"looked up and unavailable\".") (defun projectile--remote-fd-executable (remote) "Return the fd executable available on REMOTE, or nil. REMOTE is a TRAMP file name prefix as returned by `file-remote-p'. The lookup is performed once per host and cached in `projectile--remote-fd-executable-cache' to avoid the round-trip on every indexing call." (let ((cached (gethash remote projectile--remote-fd-executable-cache 'unset))) (if (not (eq cached 'unset)) cached (let* ((default-directory remote) (found (or (executable-find "fdfind" t) (executable-find "fd" t))) (program (and found (file-name-nondirectory found)))) (puthash remote program projectile--remote-fd-executable-cache) program)))) (defun projectile-fd-executable-for (directory) "Return the fd executable to use for DIRECTORY. For local directories returns `projectile-fd-executable'. For remote directories looks up `fd'/`fdfind' on the remote (cached per host) and returns the bare program name, or nil when fd is not available there." (if-let* ((remote (file-remote-p directory))) (projectile--remote-fd-executable remote) projectile-fd-executable)) (defcustom projectile-git-use-fd (when projectile-fd-executable t) "Non-nil means use fd to implement git ls-files. This may change Projectile's performance in large Git repositories depending on your system, but it will also work around the Git behavior that causes deleted files to still be shown in Projectile listings until their deletions are staged." :group 'projectile :type 'boolean :package-version '(projectile . "2.8.0")) (defcustom projectile-git-command "git ls-files -zco --exclude-standard" "Command used by projectile to get the files in a git project." :group 'projectile :type 'string :package-version '(projectile . "0.9.0")) (defcustom projectile-git-fd-args "-H -0 -E .git -tf --strip-cwd-prefix -c never" "Arguments to fd used to re-implement `git ls-files'. This is used with `projectile-fd-executable' when `projectile-git-use-fd' is non-nil." :group 'projectile :type 'string :package-version '(projectile . "2.8.0")) (defconst projectile--default-git-submodule-command "git submodule --quiet foreach 'echo $displaypath' | tr '\\n' '\\0'" "Default value of `projectile-git-submodule-command'. When the variable still has this value the command is never actually run; the submodules are listed by invoking git directly instead (see `projectile--git-submodule-paths').") (defcustom projectile-git-submodule-command projectile--default-git-submodule-command "Command used by projectile to list submodules of a given git repository. Set to nil to disable listing submodules contents. The default listing no longer shells out: when this variable has its default value the submodules are listed by running git directly, with no shell involved (see issue #1600). Customizing the variable switches back to running it as a shell command." :group 'projectile :type '(choice (const :tag "Don't list submodules" nil) (string :tag "Command")) :package-version '(projectile . "0.12.0")) (defcustom projectile-git-ignored-command "git ls-files -zcoi --exclude-standard" "Command used by projectile to get the ignored files in a git project." :group 'projectile :type 'string :package-version '(projectile . "0.14.0")) (defcustom projectile-hg-command "hg locate -f -0 -I ." "Command used by projectile to get the files in a hg project." :group 'projectile :type 'string :package-version '(projectile . "0.9.0")) (defcustom projectile-hg-ignored-command "hg status -in0 ." "Command used by projectile to get the ignored files in a hg project." :group 'projectile :type 'string :package-version '(projectile . "3.0.0")) (defcustom projectile-jj-command "jj file list -T 'path ++ \"\\0\"' --no-pager ." "Command used by projectile to get the files in a Jujutsu project." :group 'projectile :type 'string :package-version '(projectile . "2.9.0")) (defcustom projectile-sapling-command "sl locate -0 -I ." "Command used by projectile to get the files in a Sapling project." :group 'projectile :type 'string :package-version '(projectile . "2.9.0")) (defcustom projectile-fossil-command (concat "fossil ls | " (when (eq system-type 'windows-nt) "dos2unix | ") "tr '\\n' '\\0'") "Command used by projectile to get the files in a fossil project." :group 'projectile :type 'string :package-version '(projectile . "0.9.2")) (defcustom projectile-bzr-command "bzr ls -R --versioned -0" "Command used by projectile to get the files in a bazaar project." :group 'projectile :type 'string :package-version '(projectile . "0.9.0")) (defcustom projectile-darcs-command "darcs show files -0 ." "Command used by projectile to get the files in a darcs project." :group 'projectile :type 'string :package-version '(projectile . "0.9.0")) (defcustom projectile-pijul-command "pijul list | tr '\\n' '\\0'" "Command used by projectile to get the files in a pijul project." :group 'projectile :type 'string :package-version '(projectile . "2.6.0")) (defcustom projectile-svn-command "svn list -R . | grep -v '/$' | tr '\\n' '\\0'" "Command used by projectile to get the files in a svn project. `svn list -R' reports directories too, with a trailing slash, so they are filtered out - the project files are what Projectile is after. The command runs non-interactively (its output is piped), so `svn' can't prompt for credentials. For projects on an authenticated remote you need to have your credentials cached first (e.g. by running `svn' once interactively and letting it store them), otherwise the command fails with an authentication error. See URL `https://github.com/bbatsov/projectile/issues/1638'." :group 'projectile :type 'string :package-version '(projectile . "0.9.0")) (defcustom projectile-svn-ignored-command "svn status --no-ignore | grep '^I' | cut -c9- | tr '\\n' '\\0'" "Command used by projectile to get the ignored files in a svn project." :group 'projectile :type 'string :package-version '(projectile . "3.0.0")) (defcustom projectile-generic-command (cond ;; we prefer fd over find ;; note that --strip-cwd-prefix is only available in version 8.3.0+ (projectile-fd-executable (format "%s . -0 --type f --color=never --strip-cwd-prefix" projectile-fd-executable)) ;; with find we have to be careful to strip the ./ from the paths ;; see https://stackoverflow.com/questions/2596462/how-to-strip-leading-in-unix-find (t "find . -type f | cut -c3- | tr '\\n' '\\0'")) "Command used by projectile to get the files in a generic project." :group 'projectile :type 'string :package-version '(projectile . "2.8.0")) (defcustom projectile-other-file-alist '( ;; handle C/C++ extensions ("cpp" . ("h" "hpp" "ipp")) ("ipp" . ("h" "hpp" "cpp")) ("hpp" . ("h" "ipp" "cpp" "cc")) ("cxx" . ("h" "hxx" "ixx")) ("ixx" . ("h" "hxx" "cxx")) ("hxx" . ("h" "ixx" "cxx")) ("c" . ("h")) ("m" . ("h")) ("mm" . ("h")) ("h" . ("c" "cc" "cpp" "ipp" "hpp" "cxx" "ixx" "hxx" "m" "mm")) ("cc" . ("h" "hh" "hpp")) ("hh" . ("cc")) ;; OCaml extensions ("ml" . ("mli")) ("mli" . ("ml" "mll" "mly")) ("mll" . ("mli")) ("mly" . ("mli")) ("eliomi" . ("eliom")) ("eliom" . ("eliomi")) ;; vertex shader and fragment shader extensions in glsl ("vert" . ("frag")) ("frag" . ("vert")) ;; handle files with no extension (nil . ("lock" "gpg")) ("lock" . ("")) ("gpg" . ("")) ) "Alist of extensions to try when switching to a file's counterpart. Keys and values are extensions without the leading dot; the key nil stands for a file with no extension at all. Each value lists the extensions `projectile-find-other-file' offers for a file with that key's extension, in the order they are tried." :group 'projectile :type '(alist :key-type (choice (string :tag "Extension") (const :tag "No extension" nil)) :value-type (repeat (string :tag "Extension"))) :package-version '(projectile . "0.12.0")) (defcustom projectile-create-missing-test-files nil "During toggling, if non-nil enables creating test files if not found. When not-nil, every call to projectile-find-implementation-or-test-* creates test files if not found on the file system. Defaults to nil. It assumes the test/ folder is at the same level as src/." :group 'projectile :type 'boolean :package-version '(projectile . "0.13.0")) (defcustom projectile-compilation-buffer-scope nil "What a lifecycle command's compilation buffer is named after. Compiling, testing and running a project all use `compilation-mode' and therefore share one buffer, so running the tests discards the build output and vice versa - across projects as well as within one. Qualifying the buffer name keeps them apart. The value is a list of: - `project' - the project name (`*compilation*'), so two projects don't overwrite each other's output. This also narrows the buffers offered for saving before a command runs to the project's own. - `command' - the lifecycle command (`*compilation*'), so a build and a test run don't overwrite each other. The two compose: with both, the buffer is `*compilation*'. Setting this to t is the same as naming both. With nil there's a single shared compilation buffer, as in plain Emacs." :group 'projectile :type '(choice (const :tag "One shared buffer" nil) (const :tag "Project and command" t) (set :tag "Selected aspects" (const :tag "Project" project) (const :tag "Lifecycle command" command))) :package-version '(projectile . "3.4.0")) ;; Remove in 4.0. Superseded by `projectile-compilation-buffer-scope', which ;; folds them in - setting both booleans is what its two-element list means. (defvar projectile-per-project-compilation-buffer nil "When non-nil, each project gets its own compilation buffer.") (defvar projectile-per-command-compilation-buffer nil "When non-nil, each lifecycle command gets its own compilation buffer.") (dolist (var '(projectile-per-project-compilation-buffer projectile-per-command-compilation-buffer)) (make-obsolete-variable var "use `projectile-compilation-buffer-scope' instead." "3.4.0")) (defcustom projectile-after-switch-project-hook nil "Hooks run right after project is switched." :group 'projectile :type 'hook :package-version '(projectile . "0.13.0")) (defcustom projectile-before-switch-project-hook nil "Hooks run right before project is switched." :group 'projectile :type 'hook :package-version '(projectile . "0.13.0")) (defcustom projectile-project-changed-functions nil "Functions to run when the current project changes. Each function is called with two arguments - the new project root and the project root it changed from (nil when there was none). Unlike `projectile-after-switch-project-hook', which only runs on `projectile-switch-project', these functions also run when the project changes implicitly, e.g. by visiting a file or directory of another project. Moving to a buffer outside any project is not a change; the functions run again only when another project is entered." :group 'projectile :type 'hook :package-version '(projectile . "3.1.0")) (defcustom projectile-current-project-on-switch 'remove "Determines whether to display current project when switching projects. When set to `remove' current project is not included, `move-to-end' will display current project and the end of the list of known projects, `keep' will leave the current project at the default position." :group 'projectile :type '(choice (const :tag "Remove" remove) (const :tag "Move to end" move-to-end) (const :tag "Keep" keep)) :package-version '(projectile . "2.0.0")) (defcustom projectile-max-file-buffer-count nil "Maximum number of file buffers per project that are kept open. If the value is nil, there is no limit to the opened buffers count." :group 'projectile :type '(choice (const :tag "No limit" nil) (natnum :tag "Buffers")) :package-version '(projectile . "2.2.0")) (define-obsolete-variable-alias 'projectile-cmd-hist-ignoredups 'projectile-command-history-ignore-duplicates "3.4.0") (defcustom projectile-command-history-ignore-duplicates t "Controls when inputs are added to projectile's command history. A value of t means consecutive duplicates are ignored. A value of `erase' means only the last duplicate is kept. A value of nil means nothing is ignored." :group 'projectile :type '(choice (const :tag "Don't ignore anything" nil) (const :tag "Ignore consecutive duplicates" t) (const :tag "Only keep last duplicate" erase)) :package-version '(projectile . "2.9.0")) (defcustom projectile-command-history-scope 'repository "How widely a project's command history is shared. - `repository' - every checkout of one repository shares a history. Two git worktrees, or two clones of the same upstream, are the same project on two branches: the commands you build and test it with are the same ones, so a worktree made this morning already knows them (issue #1786). - `project' - each project root keeps its own history, so checkouts of one repository start empty and learn separately. This is a single choice, not a list of aspects like the other options whose names end in `-scope': one value replaces the other. What gets shared is the history you browse - the list behind \\[previous-history-element] at a command prompt. Two things stay this checkout's own, because both act without asking and a remembered command can carry absolute paths back into the checkout it was typed in: what a prompt is pre-filled with, and what `projectile-repeat-last-command' replays. Sharing needs the repository to be identifiable (see `projectile-repo-identity'); a project Projectile can say nothing about keeps its own history whatever this is set to." :group 'projectile :type '(choice (const :tag "Share across checkouts of one repository" repository) (const :tag "Keep a history per project root" project)) :safe (lambda (value) (memq value '(repository project))) :package-version '(projectile . "3.4.0")) (defvar projectile-project-test-suffix nil "Use this variable to override the current project's test-suffix property. It takes precedence over the test-suffix for the project type when set. Should be set via .dir-locals.el.") (put 'projectile-project-test-suffix 'safe-local-variable #'stringp) (defvar projectile-project-test-prefix nil "Use this variable to override the current project's test-prefix property. It takes precedence over the test-prefix for the project type when set. Should be set via .dir-locals.el.") (put 'projectile-project-test-prefix 'safe-local-variable #'stringp) (defvar projectile-project-related-files-fn nil "Use this variable to override the current project's related-files-fn property. It takes precedence over the related-files-fn attribute for the project type when set. Should be set via .dir-locals.el.") (defvar projectile-project-src-dir nil "Use this variable to override the current project's src-dir property. It takes precedence over the src-dir for the project type when set. Should be set via .dir-locals.el.") (put 'projectile-project-src-dir 'safe-local-variable #'stringp) (defvar projectile-project-test-dir nil "Use this variable to override the current project's test-dir property. It takes precedence over the test-dir for the project type when set. Should be set via .dir-locals.el.") (put 'projectile-project-test-dir 'safe-local-variable #'stringp) ;;; Version information (defconst projectile-version "3.5.0-snapshot" "The current version of Projectile.") (defun projectile--pkg-version () "Extract Projectile's package version from its package metadata." ;; Use `cond' below to avoid a compiler unused return value warning ;; when `package-get-version' returns nil. See #3181. (cond ((package-get-version)))) ;;;###autoload (defun projectile-version (&optional show-version) "Get the Projectile version as string. If called interactively or if SHOW-VERSION is non-nil, show the version in the echo area and the messages buffer. The returned string includes both, the version from package.el and the library version, if both are present and different. If the version number could not be determined, signal an error, if called interactively, or if SHOW-VERSION is non-nil, otherwise just return nil." (interactive (list t)) (let ((version (or (projectile--pkg-version) projectile-version))) (if show-version (message "Projectile %s" version) version))) ;;; Misc utility functions (defun projectile--collect-from-functions (functions root key-function what) "Call each of FUNCTIONS with ROOT and collect their results. The lists come back concatenated in the order FUNCTIONS were given, de-duplicated by KEY-FUNCTION, so the first function to report an item is the one whose version of it survives and the earlier functions' findings are offered first. Items KEY-FUNCTION returns nil for are dropped. A function that signals is reported and skipped rather than taking the whole lookup down with it; WHAT names the kind of function in that message." (let ((seen (make-hash-table :test 'equal)) results) (dolist (fn functions) (dolist (item (condition-case err (funcall fn root) (error (projectile--message "%s function %s failed: %s" what fn (error-message-string err)) nil))) (when-let* ((key (funcall key-function item)) ((not (gethash key seen)))) (puthash key t seen) (push item results)))) (nreverse results))) (defun projectile-unixy-system-p () "Check to see if unixy text utilities are installed." (seq-every-p (lambda (x) (executable-find x)) '("grep" "cut" "uniq"))) (defun projectile-symbol-or-selection-at-point () "Get the symbol or selected text at point." (if (use-region-p) (buffer-substring-no-properties (region-beginning) (region-end)) (projectile-symbol-at-point))) (defun projectile-symbol-at-point () "Get the symbol at point and strip its properties." (substring-no-properties (or (thing-at-point 'symbol) ""))) (defun projectile-generate-process-name (process make-new &optional project) "Infer the buffer name for PROCESS or generate a new one if MAKE-NEW is true. The function operates on the current project by default, but you can also specify a project explicitly via the optional PROJECT param." (let* ((project (or project (projectile-acquire-root))) (name (projectile-project-name project)) (base-name (format "*%s %s*" process name)) ;; When a buffer with the same name already exists but belongs to a ;; different project root, disambiguate using the project path. (base-name (if (and (not make-new) (let ((buf (get-buffer base-name))) (and buf (not (string= (with-current-buffer buf default-directory) project))))) (format "*%s %s*" process (abbreviate-file-name project)) base-name))) (if make-new (generate-new-buffer-name base-name) base-name))) ;;; Serialization (defun projectile-serialize (data filename) "Serialize DATA to FILENAME. The saved data can be restored with `projectile-unserialize'." (if (file-writable-p filename) (with-temp-file filename (insert (let (print-length) (prin1-to-string data)))) (display-warning 'projectile (format "Cache file '%s' is not writable" filename) :warning))) (defun projectile-unserialize (filename) "Read data serialized by `projectile-serialize' from FILENAME." (with-demoted-errors "Error during file deserialization: %S" (when (file-exists-p filename) (with-temp-buffer (insert-file-contents filename) ;; this will blow up if the contents of the file aren't ;; lisp data structures (read (buffer-string)))))) ;;; Caching (defvar projectile-file-exists-cache (make-hash-table :test 'equal) "Cached `projectile-file-exists-p' results.") (defvar projectile-file-exists-cache-timer nil "Timer for scheduling `projectile-file-exists-cache-cleanup'.") (defun projectile-file-exists-cache-cleanup () "Remove timed out cache entries. Also reschedule or remove the timer if no more items are in the cache." (let ((now (current-time))) (maphash (lambda (key value) (if (time-less-p (cdr value) now) (remhash key projectile-file-exists-cache))) projectile-file-exists-cache) (setq projectile-file-exists-cache-timer (if (> (hash-table-count projectile-file-exists-cache) 0) (run-with-timer 10 nil 'projectile-file-exists-cache-cleanup))))) (defun projectile-file-exists-p (filename) "Return t if file FILENAME exists. A wrapper around `file-exists-p' with additional caching support." (let* ((file-remote (file-remote-p filename)) (expire-seconds (if file-remote (and projectile-file-exists-remote-cache-expire (> projectile-file-exists-remote-cache-expire 0) projectile-file-exists-remote-cache-expire) (and projectile-file-exists-local-cache-expire (> projectile-file-exists-local-cache-expire 0) projectile-file-exists-local-cache-expire))) (remote-file-name-inhibit-cache (if expire-seconds expire-seconds remote-file-name-inhibit-cache))) (if (not expire-seconds) (file-exists-p filename) (let* ((current-time (current-time)) (cached (gethash filename projectile-file-exists-cache)) (cached-value (if cached (car cached))) (cached-expire (if cached (cdr cached))) (cached-expired (if cached (time-less-p cached-expire current-time) t)) (value (or (and (not cached-expired) cached-value) (if (file-exists-p filename) 'found 'notfound)))) (when (or (not cached) cached-expired) (puthash filename (cons value (time-add current-time (seconds-to-time expire-seconds))) projectile-file-exists-cache)) (unless projectile-file-exists-cache-timer (setq projectile-file-exists-cache-timer (run-with-timer 10 nil 'projectile-file-exists-cache-cleanup))) (equal value 'found))))) (defsubst projectile-persistent-cache-p () (eq projectile-enable-caching 'persistent)) ;; Delete the invalidated project's on-disk cache file, when ;; persistent caching is enabled. (projectile--register-project-cache-cleanup 'projectile-project-cache-file (lambda (project-root) (when (projectile-persistent-cache-p) (let ((cache-file (projectile-project-cache-file project-root))) (when (file-exists-p cache-file) (delete-file cache-file)))))) (defun projectile--invalidate-project-cache (project-root) "Drop all of Projectile's per-project caches for PROJECT-ROOT. Runs every cleanup in `projectile--project-cache-cleanups': the tables defined via `projectile-define-project-cache' plus the ad-hoc cleanups (cancelling in-flight background indexing and pending cache flushes, removing file-notify watches, deleting the on-disk cache file)." (dolist (entry projectile--project-cache-cleanups) (funcall (cdr entry) project-root))) ;;;###autoload (defun projectile-invalidate-cache (prompt) "Remove the current project's files from `projectile-projects-cache'. With a prefix argument PROMPT prompts for the name of the project whose cache to invalidate. The global (project-independent) cache for checking which project a file belongs to, is also cleared. Therefore this function is still useful even when not operating on a specific project, and as such only the global cache is cleared when there is no current project (unless you give a prefix argument)." (interactive "P") (setq projectile-project-root-cache (make-hash-table :test 'equal)) ;; Drop the file-existence cache too - otherwise, after the user ;; creates a project marker (`.projectile', `.git', etc.) over TRAMP, ;; the negative entries cached during earlier root-walks would keep ;; reporting "not found" for up to `projectile-file-exists-remote-cache-expire' ;; seconds even though the project root walk has been invalidated. (clrhash projectile-file-exists-cache) (when-let* ((project-root (if prompt (completing-read "Remove cache for: " (hash-table-keys projectile-projects-cache)) (projectile-project-root)))) (projectile--invalidate-project-cache project-root) (projectile--message "Invalidated cache for %s" (propertize project-root 'face 'font-lock-keyword-face))) (when (fboundp 'recentf-cleanup) (recentf-cleanup))) ;;;###autoload (defun projectile-invalidate-cache-all () "Invalidate the caches of every known project. Runs the same per-project invalidation as `projectile-invalidate-cache' over all projects in `projectile-known-projects' (plus any project that only has an entry in `projectile-projects-cache'), and also clears the global project root and file-existence caches. When persistent caching is enabled the projects' on-disk cache files are deleted too. Remote (TRAMP) projects are skipped, as touching each one could mean a slow connection round-trip per project; invalidate those individually with `projectile-invalidate-cache'." (interactive) (setq projectile-project-root-cache (make-hash-table :test 'equal)) (clrhash projectile-file-exists-cache) (let ((roots (seq-remove #'file-remote-p (delete-dups (append (projectile-known-projects) (hash-table-keys projectile-projects-cache)))))) (dolist (project-root roots) (projectile--invalidate-project-cache project-root)) (projectile--message "Invalidated the caches of %d project(s)" (length roots))) (when (fboundp 'recentf-cleanup) (recentf-cleanup))) ;;;###autoload (defun projectile-discard-root-cache () "Clear `projectile-project-root-cache' without touching other caches. Useful after creating, removing, or moving a project marker (e.g. `.projectile' or `.git') - Projectile would otherwise keep returning its previously cached answer for that directory. See also `projectile-invalidate-cache', which does this and also drops the per-project file list and project-type caches." (interactive) (setq projectile-project-root-cache (make-hash-table :test 'equal)) ;; The file-existence cache holds the negative answers gathered ;; while walking up looking for project markers; without clearing it ;; here, a freshly-created `.projectile' over TRAMP wouldn't be ;; visible until the entries time out (see ;; `projectile-file-exists-remote-cache-expire'). (clrhash projectile-file-exists-cache) (projectile--message "Cleared the project root cache")) (defun projectile-time-seconds () "Return the number of seconds since the unix epoch." (time-convert nil 'integer)) (defun projectile-cache-project (project files) "Cache PROJECTs FILES. The cache is created both in memory and on the hard drive." (puthash project files projectile-projects-cache) (puthash project (projectile-time-seconds) projectile-projects-cache-time) (when (projectile-persistent-cache-p) (projectile-serialize files (projectile-project-cache-file project))) (projectile--maybe-watch-project project files)) (defun projectile-load-project-cache (project-root) "Load the cache file for PROJECT-ROOT in memory." (when-let* ((cache-file (projectile-project-cache-file project-root))) (when (file-exists-p cache-file) (when-let* ((data (projectile-unserialize cache-file))) (puthash project-root data projectile-projects-cache) ;; Seed the cache time from the file's mtime so the TTL check in ;; `projectile-project-files' can decide whether the loaded data is ;; already stale, and so the in-memory entry isn't evicted on the ;; next call just because no time was recorded. (puthash project-root (time-convert (file-attribute-modification-time (file-attributes cache-file)) 'integer) projectile-projects-cache-time) ;; Loading the persistent cache fills the in-memory file list just ;; like a fresh index does, so arm the watches here too. (projectile--maybe-watch-project project-root data) data)))) ;;;###autoload (defun projectile-purge-file-from-cache (file) "Purge FILE from the cache of the current project." (interactive (list (projectile-completing-read "Remove file from cache: " (projectile-current-project-files) :caller 'projectile-read-file))) (let* ((project-root (projectile-project-root)) (project-cache (gethash project-root projectile-projects-cache))) (if (projectile-file-cached-p file project-root) (let ((new-cache (remove file project-cache))) (puthash project-root new-cache projectile-projects-cache) (when (projectile-persistent-cache-p) (projectile-serialize new-cache (projectile-project-cache-file project-root))) ;; Re-derive watches from the shrunken cache, otherwise the purged ;; file's directory keeps being watched and a later create-event ;; there re-adds the entries we just removed. (projectile--maybe-watch-project project-root new-cache) (projectile--message "%s removed from cache" file)) (user-error "%s is not in the cache" file)))) ;;;###autoload (defun projectile-purge-dir-from-cache (dir) "Purge DIR from the cache of the current project." (interactive (list (projectile-completing-read "Remove directory from cache: " (projectile-current-project-dirs) :caller 'projectile-read-directory))) (let* ((project-root (projectile-project-root)) (project-cache (gethash project-root projectile-projects-cache)) (new-cache (seq-remove (lambda (str) (string-prefix-p dir str)) project-cache))) (puthash project-root new-cache projectile-projects-cache) (when (projectile-persistent-cache-p) (projectile-serialize new-cache (projectile-project-cache-file project-root))) ;; Re-derive watches so the purged directory is no longer watched (and its ;; files don't get re-added by a later create-event). (projectile--maybe-watch-project project-root new-cache))) (defun projectile-file-cached-p (file project) "Check if FILE is already in PROJECT cache." (member file (gethash project projectile-projects-cache))) (defun projectile--schedule-cache-flush (project) "Arrange for PROJECT's in-memory cache to be serialized after Emacs is idle. A pending flush for the same PROJECT is cancelled and rescheduled, so that adding several files in quick succession only results in a single disk write, and the write always uses the latest in-memory contents." (when-let* ((existing (gethash project projectile--pending-cache-flush-timers))) (cancel-timer existing)) (puthash project (run-with-idle-timer 30 nil (lambda () (remhash project projectile--pending-cache-flush-timers) (projectile-serialize (gethash project projectile-projects-cache) (projectile-project-cache-file project)))) projectile--pending-cache-flush-timers)) ;;; Automatic cache updates via file-notify watches ;; ;; Opt-in machinery (see `projectile-auto-update-cache-with-watches') that ;; keeps `projectile-projects-cache' in sync with the filesystem. Emacs ;; file notifications are not recursive, so a watched project gets one ;; watch per directory, derived from the cached file list and bounded by ;; `projectile-watch-directory-limit'. Events are debounced per project ;; and applied incrementally; anything that can't be applied safely falls ;; back to invalidating the project's cache, which rebuilds lazily and ;; re-arms the watches on the next cache fill. (defun projectile--maybe-watch-project (project files) "Arm file-notify watches for PROJECT, whose cached file list is FILES. No-op unless both `projectile-auto-update-cache-with-watches' and `projectile-enable-caching' are non-nil. Remote (TRAMP) projects are never watched: registering one watch per directory would mean a remote round-trip each, and most remote handlers don't support file notifications anyway." (when (and projectile-auto-update-cache-with-watches projectile-enable-caching (not (file-remote-p project))) (projectile--watch-project project files))) (defun projectile--watch-directories (project files) "Return the directories of PROJECT to watch, derived from cached FILES. The result contains the project root and the directory chain of every cached file, as absolute names with trailing slashes. Directories with no cached files below them (e.g. empty directories) are not included, so files that later appear in them go unnoticed until the next full re-index." (let ((dirs (make-hash-table :test 'equal))) (puthash (file-name-as-directory (expand-file-name project)) t dirs) (dolist (file files) (dolist (dir (projectile--directory-ancestors file)) (puthash (expand-file-name dir project) t dirs))) (hash-table-keys dirs))) (defun projectile--watch-make-callback (project) "Return a file-notify callback that queues events for PROJECT." (lambda (event) (projectile--handle-watch-event project event))) (defun projectile--watch-skipped-once (project format-string &rest args) "Report (via FORMAT-STRING and ARGS) that PROJECT won't be watched. The message is only emitted when `projectile-verbose' is non-nil, and only once per project and session." (unless (gethash project projectile--watch-skipped-projects) (puthash project t projectile--watch-skipped-projects) (apply #'projectile--message format-string args))) (defun projectile--watch-project (project files) "Register file-notify watches for PROJECT, whose cached files are FILES. One watch per directory, into `projectile--project-watches'. Any watches already registered for PROJECT are replaced. Does nothing beyond a one-time message when the project spans more directories than `projectile-watch-directory-limit' or when the platform provides no usable file notification backend." (projectile--unwatch-project project) (let ((dirs (projectile--watch-directories project files))) (if (> (length dirs) projectile-watch-directory-limit) (projectile--watch-skipped-once project "Not watching %s: %d directories exceed `projectile-watch-directory-limit' (%d)" project (length dirs) projectile-watch-directory-limit) (let ((callback (projectile--watch-make-callback project)) (failed nil) watches) (dolist (dir dirs) (unless failed (condition-case nil (when (file-directory-p dir) (push (cons (file-notify-add-watch dir '(change) callback) dir) watches)) (error (setq failed t))))) (if (not failed) (puthash project watches projectile--project-watches) ;; No usable backend, or the OS ran out of watches: roll back the ;; partial registration and don't retry noisily on every cache fill. (dolist (entry watches) (ignore-errors (file-notify-rm-watch (car entry)))) (projectile--watch-skipped-once project "Cannot watch %s (no file notification backend, or watch registration failed)" project)))))) (defun projectile--unwatch-project (project) "Remove all file-notify watches registered for PROJECT. Queued events and the pending debounce timer are discarded too." (dolist (entry (gethash project projectile--project-watches)) (ignore-errors (file-notify-rm-watch (car entry)))) ;; Unconditional: a nil registry value (no watches left) must still be ;; removed, or it would survive `projectile--teardown-all-watches'. (remhash project projectile--project-watches) (when-let* ((timer (gethash project projectile--watch-debounce-timers))) (cancel-timer timer) (remhash project projectile--watch-debounce-timers)) (remhash project projectile--watch-pending-events)) (defun projectile--teardown-all-watches () "Drop the file-notify watches of every watched project. Runs when `projectile-mode' is disabled, when `projectile-auto-update-cache-with-watches' is customized to nil, and on `kill-emacs'." (dolist (project (hash-table-keys projectile--project-watches)) (projectile--unwatch-project project))) (defun projectile--watch-all-cached-projects () "Arm watches for every project that already has a cached file list. Used when `projectile-auto-update-cache-with-watches' is enabled mid-session, so already-cached projects don't have to wait for their next cache fill." (maphash #'projectile--maybe-watch-project projectile-projects-cache)) (defun projectile--handle-watch-event (project event) "Queue file-notify EVENT for PROJECT and start the debounce timer. Events from descriptors no longer in `projectile--project-watches' are dropped; in particular the `stopped' event that `file-notify-rm-watch' itself generates on some backends can't re-trigger processing after the project was unwatched." (when (assoc (car event) (gethash project projectile--project-watches)) (push event (gethash project projectile--watch-pending-events)) (unless (gethash project projectile--watch-debounce-timers) (puthash project (run-with-timer projectile--watch-debounce-delay nil #'projectile--process-watch-events project) projectile--watch-debounce-timers)))) (defvar projectile--watch-added-files nil "Paths the watch batch in progress has added to the cache. Bound by `projectile--process-watch-events\\=' so the whole batch can be put to the VCS in one go; nil outside one.") (defun projectile--vcs-ignored-subset (root relatives) "Return the members of RELATIVES that the VCS at ROOT ignores. One `git check-ignore\\=' answers for the whole list, which is what makes this usable from the watch path - a process per file would not be. Returns nil for anything but git, and for a git that fails; treating the answer as \"nothing is ignored\" is conservative, since the only cost is the drift this exists to remove. `call-process-region\\=' rather than a TRAMP-aware call because watches are never armed for a remote project in the first place." (when (and relatives (eq (projectile-project-vcs root) 'git)) (let ((default-directory root)) (with-temp-buffer ;; Exit status 1 means "none of them are ignored", which is an ;; answer rather than a failure; only 0 produces output. (when (eq 0 (ignore-errors (call-process-region (mapconcat #'identity relatives "\0") nil "git" nil t nil "check-ignore" "-z" "--stdin"))) (split-string (buffer-string) "\0" t)))))) (defun projectile--watch-drop-vcs-ignored (project added) "Remove from PROJECT\\='s cache the ADDED paths its VCS ignores. The watch path applies Projectile\\='s own ignore rules, which know nothing about a `.gitignore\\='; under `alien\\=' and `hybrid\\=' indexing the VCS is what produced the file list, so without this a watched project slowly gains files a re-index would never have listed (see issue #1075, which fixed the same hole for files opened by hand). Returns non-nil when the cache was changed." (when (memq projectile-indexing-method '(alien hybrid)) (when-let* ((ignored (projectile--vcs-ignored-subset project added))) (let ((set (make-hash-table :test 'equal :size (length ignored)))) (dolist (file ignored) (puthash file t set)) (puthash project (seq-remove (lambda (file) (gethash file set)) (gethash project projectile-projects-cache)) projectile-projects-cache) t)))) (defun projectile--process-watch-events (project) "Apply PROJECT's queued file-notify events to its cached file list. Runs from the debounce timer. If any event can't be applied incrementally the whole batch falls back to `projectile--invalidate-project-cache' - correctness beats cleverness; the cache rebuilds lazily on the next file listing, re-arming the watches. After successful mutations the persistent cache flush is scheduled via `projectile--schedule-cache-flush'." (remhash project projectile--watch-debounce-timers) (let ((events (nreverse (gethash project projectile--watch-pending-events)))) (remhash project projectile--watch-pending-events) (when (and events (gethash project projectile--project-watches)) ;; The cache entry can vanish without an invalidation (e.g. the ;; `projectile-files-cache-expire' TTL drops it directly), leaving the ;; watches orphaned. Mutating an absent cache would fabricate a bogus ;; one-file project, so just drop the watches; they re-arm when the ;; cache is next filled. A present-but-empty file list is different: ;; that project is still watched and its events still apply. (if (eq (gethash project projectile-projects-cache 'projectile--none) 'projectile--none) (projectile--unwatch-project project) (let* ((mutated nil) (projectile--watch-added-files nil) (fallback (catch 'projectile--watch-fallback (dolist (event events) (when (projectile--watch-apply-event project event) (setq mutated t))) nil))) ;; One question to the VCS for everything the batch added, rather ;; than one per file as the opened-file path can afford. (when (and (not fallback) (projectile--watch-drop-vcs-ignored project projectile--watch-added-files)) (setq mutated t)) (cond (fallback (projectile--message "Invalidating the cache of %s (%s)" project fallback) ;; Also drops the watches (and any events queued meanwhile). (projectile--invalidate-project-cache project)) ((and mutated (projectile-persistent-cache-p)) (projectile--schedule-cache-flush project)))))))) (defun projectile--watch-apply-event (project event) "Apply one file-notify EVENT to PROJECT's cached file list. Returns non-nil when the cached list was mutated. Throws `projectile--watch-fallback' (with a reason string) when the event cannot be applied incrementally." (pcase-let ((`(,descriptor ,action ,file . ,rest) event)) (pcase action ('created (projectile--watch-handle-created project file)) ('deleted (projectile--watch-handle-deleted project file)) ;; A rename is a deletion at the old name plus a creation at the new ;; one. `or' would short-circuit the second handler, so evaluate both. ('renamed (let ((removed (projectile--watch-handle-deleted project file)) (added (and (car rest) (projectile--watch-handle-created project (car rest))))) (or removed added))) ('stopped (projectile--watch-handle-stopped project descriptor)) ;; `changed' / `attribute-changed' don't affect the file list. (_ nil)))) (defun projectile--watch-transient-file-p (file) "Return non-nil when FILE is an editor artifact that shouldn't be cached. Matches lockfiles (.#foo), auto-save files (#foo#), backup files (foo~) and the project's own persistent cache file - all of them appear and vanish as a side effect of editing and would otherwise churn the cache (the cache file would even schedule a flush that touches itself)." (let ((name (file-name-nondirectory (directory-file-name file)))) (or (string-prefix-p ".#" name) (and (string-prefix-p "#" name) (string-suffix-p "#" name)) (string-suffix-p "~" name) (string= name projectile-cache-file)))) (defun projectile--watch-keep-file-p (project file) "Return non-nil when FILE (relative to PROJECT) belongs in the file list. Runs FILE through the same dirconfig and globally-ignored filtering the native and hybrid indexers use, and respects dirconfig `+' keep entries. VCS-level ignores (e.g. `.gitignore') are not consulted, so under alien indexing a watched project can temporarily gain entries the VCS would have excluded, until the next full re-index." (let ((default-directory project)) (and (projectile-remove-ignored (list file)) (let ((dirs (projectile-get-project-directories project))) (or (member project dirs) (let ((absolute (expand-file-name file project))) (seq-some (lambda (dir) (string-prefix-p dir absolute)) dirs))))))) (defun projectile--watch-handle-created (project file) "Handle the creation of FILE (absolute) inside PROJECT. Regular files go through the ignore filter into the cached file list; directories are adopted via `projectile--watch-adopt-directory'. Returns non-nil when the cached list was mutated." (cond ;; A `renamed' event can carry a destination outside the project (the ;; file was moved away, not renamed in place); caching it would insert ;; a bogus ../ entry into the file list. ((not (string-prefix-p (file-name-as-directory (expand-file-name project)) (expand-file-name file))) nil) ((projectile--watch-transient-file-p file) nil) ((file-directory-p file) (projectile--watch-adopt-directory project file)) ((file-regular-p file) (let ((relative (file-relative-name file project))) (when (and (not (member relative (gethash project projectile-projects-cache))) (projectile--watch-keep-file-p project relative)) (push relative projectile--watch-added-files) (puthash project (cons relative (gethash project projectile-projects-cache)) projectile-projects-cache) t))) ;; The path is already gone (created and deleted within one debounce ;; window), or something exotic like a socket: nothing to cache. (t nil))) (defun projectile--watch-adopt-directory (project dir) "Watch DIR, a directory newly created inside PROJECT, and cache its files. DIR may already have contents - e.g. a populated directory moved into the project generates a single `created' event - so its entries are enumerated: regular files are handed to `projectile--watch-handle-created' and subdirectories are adopted recursively. Ignored directories are skipped entirely. Returns non-nil when the cached file list was mutated. Throws `projectile--watch-fallback' when DIR can't be watched (the watch limit was reached, or the backend refused)." (let* ((dir (file-name-as-directory (expand-file-name dir))) (relative (file-relative-name dir project)) (watches (gethash project projectile--project-watches))) (cond ;; Already watched (duplicate or overlapping events): nothing to do. ((rassoc dir watches) nil) ;; Don't descend into ignored directories. ((let ((default-directory project)) (null (projectile-remove-ignored (list relative)))) nil) ((>= (length watches) projectile-watch-directory-limit) (throw 'projectile--watch-fallback (format "new directory %s would exceed `projectile-watch-directory-limit'" relative))) (t (let ((descriptor (condition-case err (file-notify-add-watch dir '(change) (projectile--watch-make-callback project)) (error (throw 'projectile--watch-fallback (error-message-string err)))))) (puthash project (cons (cons descriptor dir) watches) projectile--project-watches)) (let ((mutated nil)) ;; Enumerating the new directory races against whatever is still ;; populating (or already removing) it; an IO error here must not ;; leave the batch half-applied, so convert it into the fallback. ;; A nested `projectile--watch-fallback' throw is not an error ;; condition and passes through untouched. (condition-case err (dolist (entry (directory-files dir t directory-files-no-dot-files-regexp t)) (when (projectile--watch-handle-created project entry) (setq mutated t))) (error (throw 'projectile--watch-fallback (error-message-string err)))) mutated))))) (defun projectile--watch-handle-deleted (project file) "Handle the deletion of FILE (absolute) inside PROJECT. FILE no longer exists, so whether it was a file or a directory can't be queried; cached entries at the path and below it are removed, and so are the watches of any directories below it. Returns non-nil when the cached list was mutated. Throws `projectile--watch-fallback' when FILE is the project root itself - there is nothing left to watch, so the whole cache is invalidated instead." (let* ((relative (file-relative-name file project)) (dir-absolute (file-name-as-directory (expand-file-name file))) (dir-relative (file-name-as-directory relative)) (files (gethash project projectile-projects-cache))) (when (string= dir-absolute (file-name-as-directory (expand-file-name project))) (throw 'projectile--watch-fallback "the project root itself was deleted")) ;; Drop the watches under the deleted path. Their backends may emit a ;; `stopped' event on removal; by then the descriptors are no longer ;; registered, so `projectile--handle-watch-event' discards it. (let ((watches (gethash project projectile--project-watches)) (remaining nil)) (dolist (entry watches) (if (string-prefix-p dir-absolute (cdr entry)) (ignore-errors (file-notify-rm-watch (car entry))) (push entry remaining))) ;; `remaining' always contains at least the root watch here (only a ;; root deletion prunes everything, and that threw above), but never ;; store nil: a nil registry value would read as "not watched". (if remaining (puthash project (nreverse remaining) projectile--project-watches) (remhash project projectile--project-watches))) (let ((new-files (seq-remove (lambda (f) (or (string= f relative) (string-prefix-p dir-relative f))) files))) (unless (= (length new-files) (length files)) (puthash project new-files projectile-projects-cache) t)))) (defun projectile--watch-handle-stopped (project descriptor) "Handle DESCRIPTOR's watch stopping in PROJECT. When the watched directory is gone this is just the tail end of a deletion that the parent directory's watch already reported, so only the bookkeeping entry is dropped. When the directory still exists the watch died under us (backend hiccup, event queue overflow) and the cache can no longer be trusted, so throw to trigger invalidation. Always returns nil - the cached file list itself is not touched." (let* ((watches (gethash project projectile--project-watches)) (entry (assoc descriptor watches))) (when entry (let ((remaining (delq entry watches))) (if remaining (puthash project remaining projectile--project-watches) ;; Never store nil - it would read as "not watched". (remhash project projectile--project-watches))) ;; The root has no watched parent to report its deletion, so a stopped ;; root watch always invalidates, whether the directory survived or not. (when (or (file-directory-p (cdr entry)) (string= (cdr entry) (file-name-as-directory (expand-file-name project)))) (throw 'projectile--watch-fallback (format "the watch on %s stopped unexpectedly" (cdr entry)))))) nil) ;;;###autoload (defun projectile-cache-current-file (&optional project-root) "Add the currently visited file to the cache. PROJECT-ROOT defaults to the current project." (interactive) (let ((current-project (or project-root (projectile-project-root)))) (when (and (buffer-file-name) (file-exists-p (buffer-file-name)) (gethash current-project projectile-projects-cache)) (let* ((abs-current-file (file-truename (buffer-file-name))) (current-file (file-relative-name abs-current-file current-project))) (unless (or (projectile-file-cached-p current-file current-project) ;; A file under an ignored directory is ignored too, so ;; the single file check covers its parents as well. (projectile-ignored-file-p abs-current-file current-project) ;; Projectile's own rules don't know what the VCS ;; ignores, and under `alien'/`hybrid' the VCS is what ;; produced the file list - so caching an opened file it ;; ignores would put something in the cache that indexing ;; never would (issue #1075). `native' walks the tree ;; itself and lists such files anyway, so it's left alone. (and (memq projectile-indexing-method '(alien hybrid)) (projectile-vcs-ignored-file-p abs-current-file current-project))) (let ((project-files (cons current-file (gethash current-project projectile-projects-cache)))) (puthash current-project project-files projectile-projects-cache) ;; Defer the disk write until Emacs is idle to avoid freezing the ;; UI immediately after the new file was created. (when (projectile-persistent-cache-p) (projectile--schedule-cache-flush current-project))) (if (called-interactively-p 'interactive) (message "Added %s to the cache of %s" (propertize current-file 'face 'font-lock-keyword-face) (propertize current-project 'face 'font-lock-keyword-face)) (projectile--message "Added %s to the cache of %s" (propertize current-file 'face 'font-lock-keyword-face) (propertize current-project 'face 'font-lock-keyword-face)))))))) ;; cache opened files automatically to reduce the need for cache invalidation (defun projectile-cache-files-find-file-hook (&optional project-root) "Function for caching files with `find-file-hook'. PROJECT-ROOT defaults to the current project." (let ((project-root (or project-root (projectile-project-p)))) (when (and projectile-enable-caching project-root (not (projectile-ignored-project-p project-root))) (projectile-cache-current-file project-root)))) (defun projectile-track-known-projects-find-file-hook (&optional project-root) "Function for caching projects with `find-file-hook'. PROJECT-ROOT defaults to the current project." (when projectile-track-known-projects-automatically (when-let* ((project-root (or project-root (projectile-project-p)))) (projectile-add-known-project project-root)))) (defvar projectile--current-project nil "The project root `projectile-project-changed-functions' last saw.") (defun projectile--maybe-run-project-changed-functions (&optional project-root) "Run `projectile-project-changed-functions' when the project changed. PROJECT-ROOT defaults to the current project. The last seen project is tracked in `projectile--current-project'." (when projectile-project-changed-functions (when-let* ((project-root (or project-root (projectile-project-p)))) (unless (equal project-root projectile--current-project) (let ((previous projectile--current-project)) (setq projectile--current-project project-root) (run-hook-with-args 'projectile-project-changed-functions project-root previous)))))) (defun projectile-maybe-invalidate-cache (force) "Invalidate if FORCE or project's dirconfig newer than cache." (when (or force (file-newer-than-file-p (projectile-dirconfig-file) (projectile-project-cache-file))) (projectile-invalidate-cache nil))) ;;; File frecency ;; ;; Tracks which project files are visited and how often, so that ;; `projectile-find-file' (and friends) can rank the files you actually ;; work with first. The ranking is applied through completion metadata ;; (`display-sort-function'), so it works with any completion UI that ;; honors it (the default completion UI, Vertico, Icomplete, ...) and ;; under every indexing method, including `alien'. (defcustom projectile-enable-frecency t "When non-nil, rank project files by frecency in completion. Projectile records file visits per project and sorts completion candidates by a combination of visit frequency and recency, so the files you work with the most show up first in `projectile-find-file' and related commands. The history is persisted in `projectile-frecency-file'." :group 'projectile :type 'boolean :package-version '(projectile . "3.1.0")) (defcustom projectile-frecency-file (locate-user-emacs-file "projectile-frecency.eld") "File where Projectile persists the per-project file visit history." :group 'projectile :type 'file :package-version '(projectile . "3.4.0")) (defcustom projectile-frecency-max-files 200 "Maximum number of files tracked per project. When the limit is exceeded, the lowest-ranking entries are dropped." :group 'projectile :type 'natnum :package-version '(projectile . "3.1.0")) (defcustom projectile-frecency-max-projects 100 "Maximum number of projects whose frecency history is kept. When the store holds more roots than this, the least recently active ones are dropped on save, so the history can't grow without bound as projects come and go." :group 'projectile :type 'natnum :package-version '(projectile . "3.2.0")) (defvar projectile--frecency-table nil "Hash of project root to a hash of relative file name to (COUNT . TIME). TIME is the last visit in seconds since the epoch. nil until loaded from `projectile-frecency-file' by `projectile--frecency-data'.") (defvar projectile--frecency-dirty nil "Non-nil when the frecency data changed since it was last saved.") (defun projectile--frecency-data () "Return the frecency table, loading it from disk on first use. A malformed history file yields an empty table with a warning; it must never break `find-file' (the recording hook would re-signal on every file visit otherwise)." (or projectile--frecency-table (setq projectile--frecency-table (condition-case err (let ((table (make-hash-table :test 'equal))) (dolist (project (projectile-unserialize projectile-frecency-file)) (let ((files (make-hash-table :test 'equal))) (dolist (entry (cdr project)) (pcase-let ((`(,file ,count ,time) entry)) (puthash file (cons count time) files))) (puthash (car project) files table))) table) (error (display-warning 'projectile (format "Malformed frecency file '%s' ignored (%s)" projectile-frecency-file (error-message-string err)) :warning) (make-hash-table :test 'equal)))))) (defun projectile--frecency-score (entry now) "Compute the frecency score of ENTRY (COUNT . TIME) at time NOW. The visit count decays with a half-life of two weeks, so a file visited often long ago eventually ranks below one visited recently." (let ((age-days (/ (max 0 (- now (cdr entry))) 86400.0))) (* (car entry) (expt 0.5 (/ age-days 14.0))))) (defun projectile--frecency-prune (files) "Drop the lowest-scoring entries of FILES down to the configured limit." (let ((now (projectile-time-seconds)) (entries nil)) (maphash (lambda (file entry) (push (cons file (projectile--frecency-score entry now)) entries)) files) (dolist (victim (nthcdr projectile-frecency-max-files (seq-sort-by #'cdr #'> entries))) (remhash (car victim) files)))) (defun projectile--frecency-record (project-root) "Record a visit to the current buffer's file under PROJECT-ROOT. Remote projects are not tracked, to keep the visit hook free of TRAMP round-trips." (when (and projectile-enable-frecency project-root buffer-file-name (not (file-remote-p project-root))) ;; `projectile-project-root' is symlink-resolved, so resolve the ;; visited file the same way; otherwise a project reached through a ;; symlink produces a `../'-relative name and tracking is dropped for ;; the whole project. The recorded name then also matches the ;; completion candidates, which are relative to the resolved root. (let ((file (projectile--project-relative-name (file-truename buffer-file-name) project-root))) ;; Still skip anything genuinely outside the project. (unless (string-prefix-p ".." file) (let* ((table (projectile--frecency-data)) (files (or (gethash project-root table) (puthash project-root (make-hash-table :test 'equal) table))) (entry (gethash file files))) (puthash file (cons (1+ (or (car entry) 0)) (projectile-time-seconds)) files) (setq projectile--frecency-dirty t) (when (> (hash-table-count files) (* 2 projectile-frecency-max-files)) (projectile--frecency-prune files))))))) (defun projectile--frecency-sort-function (project-root) "Return a completion sort function ranking PROJECT-ROOT's files, or nil. The returned function puts tracked files first, ordered by `projectile--frecency-score', and preserves the order of the rest. Return nil when frecency is disabled or nothing is tracked yet." (when (and projectile-enable-frecency project-root) (when-let* ((files (gethash project-root (projectile--frecency-data)))) (when (> (hash-table-count files) 0) (let ((scores (make-hash-table :test 'equal :size (hash-table-count files))) (now (projectile-time-seconds))) (maphash (lambda (file entry) (puthash file (projectile--frecency-score entry now) scores)) files) (lambda (candidates) (let (frecent rest) (dolist (cand candidates) (if (gethash cand scores) (push cand frecent) (push cand rest))) (nconc (sort (nreverse frecent) (lambda (a b) (> (gethash a scores) (gethash b scores)))) (nreverse rest))))))))) (defun projectile--frecency-merge-from-disk () "Merge newer on-disk frecency entries into the in-memory table. Another Emacs session may have saved since we loaded, so a plain overwrite would discard its data (the same reason `projectile-merge-known-projects' exists). For each file present in both, the higher visit count and the later timestamp win." (let ((disk-table (let ((projectile--frecency-table nil)) (projectile--frecency-data))) (table projectile--frecency-table)) (maphash (lambda (root disk-files) (let ((files (or (gethash root table) (puthash root (make-hash-table :test 'equal) table)))) (maphash (lambda (file disk-entry) (let ((entry (gethash file files))) (puthash file (if entry (cons (max (car entry) (car disk-entry)) (max (cdr entry) (cdr disk-entry))) disk-entry) files))) disk-files))) disk-table))) (defun projectile--frecency-cap-projects (data) "Return DATA capped at `projectile-frecency-max-projects' roots. DATA is an alist of (ROOT . FILE-ENTRIES), each FILE-ENTRY a \(FILE COUNT TIME) list. The most recently active roots (highest file timestamp) are kept and the rest dropped, so the store can't accumulate dead roots without bound." (if (<= (length data) projectile-frecency-max-projects) data (let ((ranked (sort (copy-sequence data) (lambda (a b) (> (apply #'max 0 (mapcar (lambda (fe) (or (nth 2 fe) 0)) (cdr a))) (apply #'max 0 (mapcar (lambda (fe) (or (nth 2 fe) 0)) (cdr b)))))))) (seq-take ranked projectile-frecency-max-projects)))) (defun projectile--frecency-save () "Persist the frecency data to `projectile-frecency-file'. Merges with the data on disk first, so concurrent Emacs sessions don't wipe out each other's history. The dirty flag is kept when the file isn't writable, so a later save can retry." (when (and projectile--frecency-dirty projectile--frecency-table) (if (not (file-writable-p projectile-frecency-file)) (display-warning 'projectile (format "Frecency file '%s' is not writable" projectile-frecency-file) :warning) (projectile--frecency-merge-from-disk) (let (data) (maphash (lambda (root files) (projectile--frecency-prune files) (when (> (hash-table-count files) 0) (let (file-entries) (maphash (lambda (file entry) (push (list file (car entry) (cdr entry)) file-entries)) files) (push (cons root file-entries) data)))) projectile--frecency-table) (projectile-serialize (projectile--frecency-cap-projects data) projectile-frecency-file)) (setq projectile--frecency-dirty nil)))) ;;;###autoload (defun projectile-discover-projects-in-directory (directory &optional depth) "Discover any projects in DIRECTORY and add them to the projectile cache. If DEPTH is non-nil recursively descend exactly DEPTH levels below DIRECTORY and discover projects there." (interactive (list (read-directory-name "Starting directory: "))) ;; set a default value for depth (setq depth (or depth 1)) (if (file-directory-p directory) (if (and (numberp depth) (> depth 0)) ;; Ignore errors when listing files in the directory, because ;; sometimes that directory is an unreadable one at the root of a ;; volume. This is the case, for example, on macOS with the ;; .Spotlight-V100 directory. (let ((progress-reporter (make-progress-reporter (format "Projectile is discovering projects in %s..." (propertize directory 'face 'font-lock-keyword-face))))) (progress-reporter-update progress-reporter) (dolist (dir (ignore-errors (directory-files directory t directory-files-no-dot-files-regexp))) (when (and (file-directory-p dir) ;; Don't walk into remote trees during discovery - ;; that would issue a TRAMP round-trip per directory. (not (file-remote-p dir))) (projectile-discover-projects-in-directory dir (1- depth)))) (progress-reporter-done progress-reporter)) (when (projectile-project-p directory) (let ((dir (projectile--known-project-root (projectile-project-root directory)))) (unless (member dir projectile-known-projects) (projectile-add-known-project dir))))) (if (called-interactively-p 'interactive) (message "Search path directory %s doesn't exist" directory) (projectile--message "Search path directory %s doesn't exist" directory)))) (defvar projectile--search-path-discovered nil "Non-nil once `projectile-project-search-path' has been auto-discovered. Used to run automatic discovery once per session instead of on every project-switch command.") (defun projectile-discover-projects-in-search-path () "Discover projects in `projectile-project-search-path'. When called interactively, always re-scans; the automatic scan (see `projectile-auto-discover-projects') runs this once per session." (interactive) (setq projectile--search-path-discovered t) (dolist (path projectile-project-search-path) ;; Skip remote entries: discovery would walk them over TRAMP. (unless (file-remote-p (if (consp path) (car path) path)) (if (consp path) (projectile-discover-projects-in-directory (car path) (cdr path)) (projectile-discover-projects-in-directory path 1))))) (defun delete-file-projectile-remove-from-cache (filename &optional _trash) (if (and projectile-enable-caching projectile-auto-update-cache (projectile-project-p)) (let* ((project-root (projectile-project-root)) (true-filename (file-truename filename)) (relative-filename (file-relative-name true-filename project-root))) (if (projectile-file-cached-p relative-filename project-root) (projectile-purge-file-from-cache relative-filename))))) ;;; Project root related utilities (defun projectile-parent (path) "Return the parent directory of PATH. PATH may be a file or directory and directory paths may end with a slash." (directory-file-name (file-name-directory (directory-file-name (expand-file-name path))))) (defun projectile--directory-entry-set (directory) "Return a hash set of the immediate entry names of DIRECTORY, or nil. A single `directory-files' call replaces one `file-exists-p' per candidate name - over TRAMP that turns N sequential remote round-trips into one. Returns nil when DIRECTORY can't be listed (missing or permission denied) or contains no entries. Note: membership is by directory entry, not `file-exists-p', so a broken symlink named like a marker counts as present here (the old per-candidate `file-exists-p' followed the link and returned nil). This is harmless in practice - a project marker that is a dangling symlink is a pathological setup." (when-let* ((entries (ignore-errors (directory-files directory nil directory-files-no-dot-files-regexp t)))) (let ((set (make-hash-table :test 'equal :size (length entries)))) (dolist (entry entries) (puthash entry t set)) set))) (defun projectile--wildcard-p (name) "Return non-nil if NAME has a shell wildcard character in it." (string-match-p "[][*?]" name)) (defun projectile--read-json-file (file &rest args) "Read FILE as JSON, passing ARGS to `json-parse-buffer'. Returns nil when FILE doesn't exist, or when this Emacs was built without native JSON support." (when (and (functionp 'json-parse-buffer) (file-exists-p file)) (with-temp-buffer (insert-file-contents file) (goto-char (point-min)) (apply #'json-parse-buffer args)))) (defun projectile--directory-marker (directory markers &optional files-only) "Return the first of MARKERS present in DIRECTORY, or nil. DIRECTORY is listed once with `projectile--directory-entry-set' and the plain-name markers are answered from that listing, so probing N candidates costs one round-trip instead of N - which matters both for long marker lists and for remote projects. A marker carrying a path separator or a wildcard can't be answered from a basename listing and is probed directly. With FILES-ONLY non-nil a marker naming a directory doesn't count as present." (let ((entries nil) (listed nil)) (seq-find (lambda (marker) (cond ((not (stringp marker)) nil) ((or (string-search "/" marker) (projectile--wildcard-p marker)) (let ((expanded (projectile-expand-file-name-wildcard marker directory))) (and (projectile-file-exists-p expanded) (or (not files-only) (not (file-directory-p expanded)))))) (t (unless listed (setq entries (projectile--directory-entry-set directory) listed t)) (and entries (gethash marker entries) (or (not files-only) (not (file-directory-p (expand-file-name marker directory)))))))) markers))) (defun projectile--locate-dominating-file (file name first-match-only) "Walk up from FILE looking for NAME and return the matching directory. NAME is either a filename (matched via `projectile-file-exists-p' in each candidate directory) or a predicate of one argument (the candidate directory). When FIRST-MATCH-ONLY is non-nil, return the bottommost (closest to FILE) match; otherwise keep walking and return the topmost match. Returns nil when no match is found." ;; The walk skeleton was originally copied from files.el; the bottom-up ;; / top-down split was previously two near-identical functions. (setq file (abbreviate-file-name file)) (let ((root nil) try) (while (and file (not (string-match locate-dominating-stop-dir-regexp file)) (not (and first-match-only root))) (setq try (if (stringp name) (projectile-file-exists-p (projectile-expand-file-name-wildcard name file)) (funcall name file))) (when try (setq root file)) (let ((parent (file-name-directory (directory-file-name file)))) (setq file (and (not (equal file parent)) parent)))) (and root (expand-file-name (file-name-as-directory root))))) (defun projectile-locate-dominating-file (file name) "Look up the directory hierarchy from FILE for a directory containing NAME. Stop at the first parent directory containing a file NAME, and return the directory. Return nil if not found. Instead of a string, NAME can also be a predicate taking one argument \(a directory) and returning a non-nil value if that directory is the one for which we're looking." (projectile--locate-dominating-file file name t)) (defun projectile-locate-dominating-file-top-down (file name) "Look up the directory hierarchy from FILE for a directory containing NAME. Unlike `projectile-locate-dominating-file' which returns the first (bottommost) match, this returns the topmost match. Return nil if not found. Instead of a string, NAME can also be a predicate taking one argument \(a directory) and returning a non-nil value if that directory is the one for which we're looking." (projectile--locate-dominating-file file name nil)) (defvar-local projectile-project-root nil "Defines a custom Projectile project root. This is intended to be used as a file local variable.") (defun projectile-root-local (_dir) "A simple wrapper around the variable `projectile-project-root'." projectile-project-root) (defun projectile-root-top-down (dir &optional list) "Identify a project root in DIR by top-down search for files in LIST. If LIST is nil, use `projectile-project-root-files' instead. Return the first (topmost) matched directory or nil if not found." (let ((markers (or list projectile-project-root-files))) (projectile-locate-dominating-file-top-down dir ;; A root file has to be a file, not a directory - `src' being a ;; marker of some project type mustn't make every `src' a root. (lambda (dir) (projectile--directory-marker dir markers 'files-only))))) (defun projectile-root-marked (dir) "Identify a project root in DIR by search for `projectile-dirconfig-file'." (projectile-root-bottom-up dir (list projectile-dirconfig-file))) (defun projectile-root-bottom-up (dir &optional list) "Identify a project root in DIR by bottom-up search for files in LIST. If LIST is nil, use `projectile-project-root-files-bottom-up' instead. Return the first (bottommost) matched directory or nil if not found." (let ((markers (or list projectile-project-root-files-bottom-up))) (projectile-locate-dominating-file dir (if (and (null (cdr markers)) (stringp (car markers)) (not (string-match-p "/" (car markers)))) ;; With a single marker a directory listing can't beat one stat ;; per level, so probe it directly. `projectile-root-marked' ;; (which runs on every root resolution) is this case. (lambda (directory) (projectile-file-exists-p (expand-file-name (car markers) directory))) ;; Probe each level with a single `directory-files' listing rather ;; than one `file-exists-p' per marker. A VCS marker is a directory, ;; so unlike the top-down search this one doesn't filter those out. (lambda (directory) (projectile--directory-marker directory markers)))))) (defun projectile-root-top-down-recurring (dir &optional list) "Identify a project root in DIR by recurring top-down search for files in LIST. If LIST is nil, use `projectile-project-root-files-top-down-recurring' instead. Return the last (bottommost) matched directory in the topmost sequence of matched directories. Nil otherwise." (seq-some (lambda (f) (projectile-locate-dominating-file dir (lambda (dir) (and (projectile-file-exists-p (projectile-expand-file-name-wildcard f dir)) (or (string-match locate-dominating-stop-dir-regexp (projectile-parent dir)) (not (projectile-file-exists-p (projectile-expand-file-name-wildcard f (projectile-parent dir))))))))) (or list projectile-project-root-files-top-down-recurring))) (defvar projectile--root-override nil "Directory `projectile-project-root' answers with while this is non-nil. Bound while detecting a subproject's type (see `projectile-subproject-type'). Eleven of the registered project types - `go', `make', `terraform', `xcode' and the rest - identify themselves with a predicate rather than a list of marker file names, and those predicates resolve their paths through `projectile-expand-root', which walks up to the enclosing project. Inside a monorepo that walk lands on the repository, so a Go module in a subdirectory would be asked whether the *repository* has a `go.mod'. Pinning the root for the duration of the detection asks the question about the member instead.") (defun projectile-project-root (&optional dir) "Return the root directory of the project containing DIR, or nil. If DIR is not supplied it defaults to `default-directory'. While `projectile--root-override' is non-nil that directory is returned instead, whatever DIR is. Each function in `projectile-project-root-functions' is tried in order; the first non-nil result wins. Results - including failures - are memoized in `projectile-project-root-cache' (see the Project root cache section in the manual). Use `projectile-invalidate-cache' to reset. Special cases: - Tramp archive paths (e.g. inside a `.zip') are unwrapped to the directory that contains the archive before searching. - Remote files reached via TRAMP whose host is not currently connected return nil without caching, so reconnecting works without manual cache invalidation." ;; `default-directory' can be nil in some buffers; short-circuit to nil so ;; callers get "no project" instead of a `(wrong-type-argument stringp nil)' ;; from `file-remote-p' and friends below (#1829). (or projectile--root-override (when-let* ((dir (or dir default-directory))) ;; Back out of any archives, the project will live on the outside and ;; searching them is slow. (when (and (fboundp 'tramp-archive-file-name-p) (tramp-archive-file-name-p dir)) (setq dir (file-name-directory (tramp-archive-file-name-archive dir)))) ;; The cached value is 'none when no project root was found (so we don't ;; reevaluate every time when not inside a project); we map that back to ;; nil for callers. Cache keys are conses: (FUNC . DIR) for per-function ;; results, ('none . DIR) for the overall failure marker. (let ((result (or ;; if we've already failed to find a project dir for this ;; dir, and cached that failure, don't recompute (gethash (cons 'none dir) projectile-project-root-cache) ;; if the file isn't local, and we're not connected, don't try to ;; find a root now, but don't cache failure, as we might ;; re-connect. The `is-local' and `is-connected' variables are ;; used to fix the behavior where Emacs hangs because of ;; Projectile when you open a file over TRAMP. It basically ;; prevents Projectile from trying to find information about ;; files for which it's not possible to get that information ;; right now. (let ((is-local (not (file-remote-p dir))) ;; `true' if the file is local (is-connected (file-remote-p dir nil t))) ;; `true' if the file is remote AND we are connected to the remote (unless (or is-local is-connected) 'none)) ;; if the file is local or we're connected to it via TRAMP, run ;; through the project root functions until we find a project dir. ;; `projectile-root-local' reads a buffer-local variable rather ;; than inspecting DIR, so its result must not be cached - two ;; buffers in the same directory can legitimately disagree. ;; For other functions, both successes and per-function failures ;; (stored as the 'none sentinel) are memoized, so functions ;; earlier in the list that returned nil aren't re-walked on ;; every call. ;; ;; `true-dir-cell' lazily memoizes `(file-truename dir)' across ;; the loop so we pay the (potentially remote) symlink resolution ;; at most once per `projectile-project-root' call instead of ;; once per project-root-function on cache miss. (let ((true-dir-cell (list nil))) (seq-some (lambda (func) (if (eq func 'projectile-root-local) (funcall func dir) (let* ((cache-key (cons func dir)) (cache-value (gethash cache-key projectile-project-root-cache))) (cond ((eq cache-value 'none) nil) ;; Use `projectile-file-exists-p' so the remote ;; stat is cached (per `projectile-file-exists-remote-cache-expire') ;; instead of round-tripping on every call. ((and cache-value (projectile-file-exists-p cache-value)) cache-value) (t (let ((value (funcall func (or (car true-dir-cell) (setcar true-dir-cell (file-truename dir)))))) (puthash cache-key (or value 'none) projectile-project-root-cache) value)))))) projectile-project-root-functions)) ;; if we get here, we have failed to find a root by all ;; conventional means, and we assume the failure isn't transient ;; / network related, so cache the failure (puthash (cons 'none dir) 'none projectile-project-root-cache)))) (unless (eq result 'none) result))))) (defun projectile-ensure-project (dir) "Ensure that DIR is non-nil. Useful for commands that expect the presence of a project. Controlled by `projectile-require-project-root'. See also `projectile-acquire-root'." (if dir dir (cond ((eq projectile-require-project-root 'prompt) (projectile-completing-read "Switch to project: " (projectile-known-projects) :category 'projectile-project :caller 'projectile-read-project)) (projectile-require-project-root (user-error "Projectile cannot find a project definition in %s" default-directory)) (t default-directory)))) (defun projectile-acquire-root (&optional dir) "Find the current project root, and prompts the user for it if that fails. Provides the common idiom (projectile-ensure-project (projectile-project-root)). Starts the search for the project with DIR." (projectile-ensure-project (projectile-project-root dir))) (defun projectile-project-p (&optional dir) "Check if DIR is a project. Defaults to the current directory if not provided explicitly." (projectile-project-root (or dir default-directory))) (defun projectile-default-project-name (project-root) "Default function used to create the project name. The project name is based on the value of PROJECT-ROOT." (file-name-nondirectory (directory-file-name project-root))) (defun projectile-project-name (&optional project) "Return project name. If PROJECT is not specified acts on the current project." (or projectile-project-name (let ((project-root (or project (projectile-project-root)))) (if project-root (funcall projectile-project-name-function project-root) "-")))) (defun projectile-uniquify-dirname-transform (dirname) "Project-aware transform for `uniquify-dirname-transform'. When DIRNAME is inside a project, return a path with the project name spliced in, so buffers visiting same-named files in different projects get distinct, project-qualified names. Outside a project DIRNAME is returned unchanged. To enable, set `uniquify-dirname-transform' to this function: (setq uniquify-dirname-transform #\\='projectile-uniquify-dirname-transform)" (if-let* ((root (projectile-project-root dirname))) (expand-file-name (file-name-concat (file-name-directory root) (projectile-project-name root) (file-relative-name dirname root))) dirname)) ;;; Project indexing (defun projectile-get-project-directories (project-dir) "Get the list of PROJECT-DIR directories that are of interest to the user. When the dirconfig file has no `+' keep entries, return a single- element list with PROJECT-DIR itself." (let* ((cfg (projectile-parse-dirconfig-file (expand-file-name project-dir))) (keep (and cfg (projectile-dirconfig-keep cfg)))) (if keep (mapcar (lambda (subdir) (concat project-dir subdir)) keep) (list project-dir)))) (defun projectile--directory-p (directory) "Checks if DIRECTORY is a string designating a valid directory." (and (stringp directory) (file-directory-p directory))) (defun projectile-dir-files (directory &optional root) "List the files in DIRECTORY and in its sub-directories. Files are returned as relative paths to DIRECTORY. ROOT names the project whose ignore rules apply, defaulting to DIRECTORY itself - pass it when DIRECTORY is a subdirectory of the project being listed." (unless (projectile--directory-p directory) (user-error "Directory %S does not exist" directory)) ;; check for a cache hit first if caching is enabled (let ((files-list (and projectile-enable-caching (gethash directory projectile-projects-cache)))) ;; cache disabled or cache miss (or files-list (pcase projectile-indexing-method ('native (projectile-dir-files-native directory root)) ;; use external tools to get the project files ('hybrid (let ((vcs (projectile-project-vcs directory))) (projectile-adjust-files (or root directory) vcs (projectile-dir-files-alien directory vcs)))) ('alien (projectile-dir-files-alien directory)) (_ (user-error "Unsupported indexing method `%S'" projectile-indexing-method)))))) ;;; Native Project Indexing ;; ;; This corresponds to `projectile-indexing-method' being set to native. (defun projectile-dir-files-native (directory &optional root) "Get the files under DIRECTORY using just Emacs Lisp. ROOT names the project whose ignore rules apply, defaulting to DIRECTORY itself." (let ((progress-reporter (make-progress-reporter (format "Projectile is indexing %s" (propertize directory 'face 'font-lock-keyword-face)))) ;; The walker returns absolute paths that all share DIRECTORY as a ;; literal prefix - `directory-files-and-attributes' expands each ;; entry against the expanded directory. Stripping that prefix with ;; a single `substring' is equivalent to `file-relative-name' here ;; but avoids its per-file `expand-file-name'/`abbreviate-file-name' ;; cost, which otherwise dominates the post-walk step on large trees. (prefix-len (length (file-name-as-directory (expand-file-name directory))))) ;; we need the files with paths relative to the project root (mapcar (lambda (file) (substring file prefix-len)) (projectile-index-directory directory (projectile-filtering-patterns (expand-file-name (or root directory))) progress-reporter)))) (defun projectile--global-ignore-regexp-p (path) "Return non-nil when PATH matches `projectile-globally-ignored-file-regexps'. PATH is an absolute file name. Those patterns are Emacs regexps rather than globs, which is why they are a separate mechanism from the ignore patterns proper; matching is case-sensitive." (seq-some (lambda (re) (let ((case-fold-search nil)) (string-match-p re path))) projectile-globally-ignored-file-regexps)) (defun projectile--glob-to-regexp (glob) "Translate the dirconfig GLOB into a regexp fragment. `*' matches within a path segment, `**' spans segments, `?' matches a single non-slash character and `[...]'/`[!...]' character classes pass through (with `!' translated to `^')." (let ((i 0) (n (length glob)) (fragments nil)) (while (< i n) (let ((c (aref glob i))) (cond ((eq c ?*) (if (and (< (1+ i) n) (eq (aref glob (1+ i)) ?*)) (progn (push ".*" fragments) (setq i (1+ i))) (push "[^/]*" fragments))) ((eq c ??) (push "[^/]" fragments)) ((eq c ?\[) ;; Copy a character class through, translating glob's [!...] ;; negation; an unterminated class is treated literally. (if-let* ((end (string-search "]" glob (+ i 2)))) (progn (push (if (and (< (1+ i) n) (eq (aref glob (1+ i)) ?!)) (concat "[^" (substring glob (+ i 2) (1+ end))) (substring glob i (1+ end))) fragments) (setq i end)) (push "\\[" fragments))) (t (push (regexp-quote (char-to-string c)) fragments)))) (setq i (1+ i))) (apply #'concat (nreverse fragments)))) (defun projectile--ignore-pattern-to-regexp (pattern) "Translate an ignore/ensure PATTERN into a regexp. The regexp matches root-relative paths using gitignore rules: a pattern without a slash matches the file name or any directory segment anywhere in the tree, while a pattern containing a slash is anchored at the project root (a leading `/' anchors without naming a directory of its own). A trailing slash restricts the match to directories (and thus everything below them). Directories must be matched with a trailing slash appended." (let* ((dir-only (string-suffix-p "/" pattern)) (pattern (string-remove-suffix "/" pattern)) (floating (string-prefix-p "**/" pattern)) (pattern (if floating (substring pattern 3) pattern)) (rooted (string-prefix-p "/" pattern)) (pattern (if rooted (substring pattern 1) pattern)) (anchored (or rooted (string-search "/" pattern)))) (concat (cond (floating "\\`\\(?:.*/\\)?") (anchored "\\`") (t "\\(?:\\`\\|/\\)")) (projectile--glob-to-regexp pattern) (if dir-only "/" "\\(?:/\\|\\'\\)")))) (defun projectile--compile-ignore-patterns (patterns) "Compile the gitignore-style PATTERNS into a single regexp. Return nil when PATTERNS is empty. The regexp matches a root-relative path when any of PATTERNS does; pass directory paths with a trailing slash so directory-only patterns can match them." (when patterns (mapconcat #'projectile--ignore-pattern-to-regexp patterns "\\|"))) (defun projectile-index-directory (directory patterns progress-reporter) "Index DIRECTORY taking into account PATTERNS. PATTERNS is a cons of the ignore and the ensure patterns, as returned by `projectile-filtering-patterns'; both are compiled into a single regexp each, so the per-entry check is one regexp match regardless of how many rules there are. The PROGRESS-REPORTER is updated while the function is executing." (let* (;; Ignore patterns match root-relative paths, so when DIRECTORY ;; is a subdirectory of the project (a dirconfig `+' keep entry) ;; the paths matched must stay relative to the project root, not ;; to the walked directory. Fall back to DIRECTORY when it isn't ;; under the current project. (walk-base (file-name-as-directory (expand-file-name directory))) (project-root (projectile-project-p directory)) (match-base (if (and project-root (string-prefix-p (file-name-as-directory (expand-file-name project-root)) walk-base)) (file-name-as-directory (expand-file-name project-root)) walk-base)) (rules (list :ignore-re (projectile--compile-ignore-patterns (car patterns)) :ensure-re (projectile--compile-ignore-patterns (cdr patterns)) :match-base-len (length match-base))) ;; A 1-element list whose car is the accumulator. Using a ;; mutable cell lets the recursive walker push results onto a ;; single shared list (O(N) total) instead of `apply append'-ing ;; per-level results (O(N*depth)). (acc-cell (list nil))) (projectile--index-directory-walk directory progress-reporter rules acc-cell) (nreverse (car acc-cell)))) (defun projectile--index-directory-walk (directory progress-reporter rules acc-cell) "Recursive walker for `projectile-index-directory'. DIRECTORY, PROGRESS-REPORTER and RULES carry the same state as the public entry point. ACC-CELL is a 1-element list whose car accumulates discovered file paths in reverse order. Ignore matching is case-sensitive, so `case-fold-search' is pinned off for the regexps matched below." ;; Use ignore-errors to skip unreadable directories (e.g. ;; .Spotlight-V100 on macOS) instead of aborting the entire indexing ;; operation. ;; `directory-files-no-dot-files-regexp' filters out . and .. at the ;; C level so we don't have to do it again in the loop. ;; `directory-files-and-attributes' (rather than plain `directory-files') ;; gives us each entry's type in the same listing call, so we can tell ;; files from directories without a `file-directory-p' stat per entry - ;; that stat is a separate filesystem round-trip each, which dominates the ;; walk on large or remote (TRAMP) trees. (let* ((case-fold-search nil) (entries (ignore-errors (directory-files-and-attributes directory t directory-files-no-dot-files-regexp nil 'integer))) (ignore-re (plist-get rules :ignore-re)) (ensure-re (plist-get rules :ensure-re)) (match-base-len (plist-get rules :match-base-len))) (dolist (entry entries) (let* ((f (car entry)) ;; The type field is t for a directory, a string (the link ;; target) for a symlink, and nil for a regular file. For a ;; symlink we still defer to `file-directory-p' so that a link ;; pointing at a directory is traversed, matching the previous ;; follow-symlink behaviour; that extra stat only happens for ;; the rare symlink entry, not for every file. (type (file-attribute-type (cdr entry))) (directory-p (if (stringp type) (file-directory-p f) (eq type t))) ;; Ignore patterns match against the root-relative path, with ;; a trailing slash appended for directories so that ;; directory-only patterns (trailing `/') can match. (match-name (and ignore-re (concat (substring f match-base-len) (and directory-p "/"))))) (unless (or (and match-name (string-match-p ignore-re match-name) (not (and ensure-re (string-match-p ensure-re match-name)))) (projectile--global-ignore-regexp-p f)) (progress-reporter-update progress-reporter) (if directory-p (projectile--index-directory-walk f progress-reporter rules acc-cell) (setcar acc-cell (cons f (car acc-cell))))))))) ;;; Alien Project Indexing ;; ;; This corresponds to `projectile-indexing-method' being set to hybrid or alien. ;; The only difference between the two methods is that alien doesn't do ;; any post-processing of the files obtained via the external command. ;; ;; Projectile's own ignore rules are still honored under alien (see ;; `projectile-alien-honors-ignores'), but they are pushed down into the ;; external tool as exclusion arguments rather than applied to its output, so ;; alien keeps doing no Lisp-side filtering. Only the tools that can't express ;; exclusions fall back to filtering in Emacs. (defun projectile--fd-command-p (command) "Return non-nil when COMMAND is one of Projectile's `fd' recipes. Recognised by the `--strip-cwd-prefix' flag Projectile puts in them, the same way `projectile--ext-command-line' does. COMMAND may be nil, which is how Projectile spells \"external-command indexing is disabled\"." (and command (string-match-p "--strip-cwd-prefix\\b" command))) (defun projectile--alien-exclude-glob (glob style) "Translate GLOB into an exclusion pattern of the given STYLE. GLOB is an entry as produced by `projectile--project-ignore-globs', i.e. a gitignore pattern: any slash other than a trailing one anchors it at the project root, a trailing `/' means it names a directory (so its whole subtree is excluded), and a pattern without a slash matches at any depth. STYLE is `git' for a `git ls-files' pathspec body (wildmatch semantics, where `**' crosses directory separators) or `fd' for an `fd --exclude' pattern (gitignore semantics, where a leading `/' anchors to the search root)." (let* ((dirp (string-suffix-p "/" glob)) (body (if dirp (substring glob 0 -1) glob)) (rooted (string-search "/" body)) (body (string-remove-prefix "/" body))) (pcase style ;; A pathspec is anchored at the pathspec root already, so an ;; any-depth pattern is the one that needs the `**/' prefix. ('git (concat (unless rooted "**/") body (when dirp "/**"))) ('fd (concat (when rooted "/") body (when dirp "/"))) (_ (error "Unknown exclusion style `%S'" style))))) (defun projectile--alien-exclude-args (vcs command globs) "Return exclusion arguments appending GLOBS to COMMAND, or nil. Returns nil when GLOBS is empty, or when COMMAND's tool has no way to express exclusions - the caller then has to filter the output in Emacs Lisp instead (see `projectile--maybe-remove-ignored'). VCS is the project's version-control system as returned by `projectile-project-vcs'." (when globs (cond ;; `fd' takes repeated `--exclude' globs. Checked before VCS because ;; git projects use fd too when `projectile-git-use-fd' is on. ((projectile--fd-command-p command) (mapconcat (lambda (glob) (concat "-E " (shell-quote-argument (projectile--alien-exclude-glob glob 'fd)))) globs " ")) ;; `git ls-files' takes exclude pathspecs. A pathspec list made up ;; entirely of exclusions still lists everything else, so there's no ;; need to add a positive pathspec alongside them. ((eq vcs 'git) (concat "-- " (mapconcat (lambda (glob) (shell-quote-argument (concat ":(exclude,glob)" (projectile--alien-exclude-glob glob 'git)))) globs " "))) (t nil)))) (defun projectile--alien-ext-command (vcs directory) "Return the external listing command for DIRECTORY, honoring ignore rules. Like `projectile-get-ext-command', but with Projectile's ignore rules folded in as exclusion arguments when the tool understands them and `projectile-alien-honors-ignores' is non-nil." (let ((command (projectile-get-ext-command vcs directory))) (if-let* ((command) (projectile-alien-honors-ignores) ;; Only alien pushes the rules down; hybrid applies them to ;; the output itself. Both speak the same rules now, so ;; doing both would just be wasted work. ((eq projectile-indexing-method 'alien)) ((projectile--alien-command-excludes-p vcs command directory)) (globs (projectile--project-ignore-globs directory)) (args (projectile--alien-exclude-args vcs command globs))) (concat command " " args) command))) (defun projectile--alien-command-excludes-p (vcs command &optional directory) "Return non-nil when COMMAND for VCS can carry the ignore rules itself. When it can't, the ignore rules have to be applied to the command's output instead. Besides the tools that have no way to express exclusions at all, that's also the case for a project whose dirconfig has `!' ensure entries: an exclusion argument can't be taken back (neither a git exclude pathspec nor `fd --exclude' has a way to un-exclude a path), so such a project is filtered in Lisp, where the ensure patterns can rescue the files the ignore patterns matched. DIRECTORY is the project root the ensure entries are read from; it defaults to `default-directory'." (and (or (projectile--fd-command-p command) (eq vcs 'git)) (null (projectile--ensure-patterns directory)) t)) (defun projectile--maybe-remove-ignored (project-root files) "Remove PROJECT-ROOT's ignored entries from FILES, honoring the option. A no-op when `projectile-alien-honors-ignores' is nil. FILES are paths relative to PROJECT-ROOT, which is bound as `default-directory' so the ignore configuration is read for the right project." (if (not projectile-alien-honors-ignores) files (let ((default-directory project-root)) (projectile-remove-ignored files)))) (defun projectile--alien-apply-ignores (project-root vcs files) "Apply PROJECT-ROOT's ignore rules to the alien listing FILES. Does nothing when the external command for VCS already excluded them itself, which is the fast path (see `projectile--alien-exclude-args')." (if (projectile--alien-command-excludes-p vcs (projectile-get-ext-command vcs project-root) project-root) files (projectile--maybe-remove-ignored project-root files))) (defun projectile-dir-files-alien (directory &optional vcs subdirs) "Get the files for DIRECTORY using external tools. VCS, when supplied, must be the project's VCS as returned by `projectile-project-vcs'. It is computed from DIRECTORY when omitted; callers that already resolved the VCS can pass it in to avoid the redundant work. SUBDIRS, when non-nil, is a list of subdirectory paths (relative to DIRECTORY) restricting the listing. The external command receives them as positional arguments and submodule files are filtered to those falling under one of the subdirectories. This is how dirconfig `+' keep entries are honoured by hybrid indexing without shelling out per kept directory." (let ((vcs (or vcs (projectile-project-vcs directory)))) (cond ((eq vcs 'git) (let* ((fd (and projectile-git-use-fd (projectile-fd-executable-for directory))) (files (nconc (projectile-files-via-ext-command directory (projectile--alien-ext-command vcs directory) subdirs) ;; Submodules are listed by their own `git ls-files' ;; runs, which never saw our exclusions, so those ;; files have to be filtered here. (projectile--maybe-remove-ignored directory (projectile--restricted-sub-projects-files directory vcs subdirs)))) ;; When using git ls-files (not fd), deleted but unstaged ;; files are still reported. Remove them. Note that the ;; fd-availability check is per-DIRECTORY: a project may be ;; on a remote host where fd isn't installed even though it ;; is locally. (deleted (unless fd (projectile-git-deleted-files directory)))) (if deleted (let ((deleted-set (make-hash-table :test 'equal :size (length deleted)))) (dolist (f deleted) (puthash f t deleted-set)) (seq-remove (lambda (f) (gethash f deleted-set)) files)) files))) (t (projectile-files-via-ext-command directory (projectile--alien-ext-command vcs directory) subdirs))))) (defun projectile-vcs-ignored-file-p (file &optional project-root vcs) "Return non-nil if FILE is ignored by the project's version control system. This is what Projectile's own ignore rules can't answer: under `alien' and `hybrid' indexing the file list comes from the version control system, so a file that VCS ignores is not part of the project even though nothing in `projectile-globally-ignored-directories' or the project's `.projectile' mentions it (issue #1075). PROJECT-ROOT and VCS default to the current project's. Only git is consulted - for any other system the answer is nil, i.e. the file is treated as part of the project, which is what Projectile did for every system before." (let* ((root (or project-root (projectile-project-root))) (vcs (or vcs (and root (projectile-project-vcs root))))) (when (and root (eq vcs 'git)) (let ((default-directory root)) ;; `git check-ignore' answers for one path without listing the ;; repository: exit code 0 means ignored, 1 means not. (equal 0 (process-file "git" nil nil nil "check-ignore" "-q" "--" (file-relative-name file root))))))) (defun projectile--restrict-to-subdirs (files subdirs) "Keep only the FILES that live under one of SUBDIRS. FILES and SUBDIRS are both relative to the project root. Returns FILES unchanged when SUBDIRS is nil." (if (null subdirs) files (let ((normalized (mapcar #'file-name-as-directory subdirs))) (seq-filter (lambda (f) (seq-some (lambda (sd) (string-prefix-p sd f)) normalized)) files)))) (defun projectile--restricted-sub-projects-files (project-root vcs subdirs) "Return git submodule files under PROJECT-ROOT, optionally restricted to SUBDIRS. SUBDIRS is a list of paths relative to PROJECT-ROOT; when non-nil only files whose project-relative path starts with one of those subdirectories are returned. When nil, behaves exactly like `projectile-get-sub-projects-files'." (projectile--restrict-to-subdirs (projectile-get-sub-projects-files project-root vcs) subdirs)) (defun projectile-git-deleted-files (directory) "Get a list of deleted but unstaged files in DIRECTORY." (projectile-files-via-ext-command directory "git ls-files -zd")) (defun projectile-get-ext-command (vcs &optional directory) "Determine which external command to invoke based on the project's VCS. Fallback to a generic command when not in a VCS-controlled project. DIRECTORY, when supplied, is used to pick the right fd executable for the git case: for remote projects the local `projectile-fd-executable' may not exist on the remote host, so fd is detected per-host (see `projectile-fd-executable-for'). When DIRECTORY is omitted the current `default-directory' is used, preserving backward compatibility for callers that don't yet thread it through." (let* ((directory (or directory default-directory)) (fd (and projectile-git-use-fd (projectile-fd-executable-for directory)))) (pcase vcs ('git (if fd (concat fd " " projectile-git-fd-args) projectile-git-command)) ('hg projectile-hg-command) ('fossil projectile-fossil-command) ('bzr projectile-bzr-command) ('darcs projectile-darcs-command) ('pijul projectile-pijul-command) ('svn projectile-svn-command) ('sapling projectile-sapling-command) ('jj projectile-jj-command) (_ projectile-generic-command)))) (defun projectile-get-sub-projects-command (vcs) "Get the sub-projects command for VCS. Currently that's supported just for Git (sub-projects being Git sub-modules there)." (pcase vcs ('git projectile-git-submodule-command) (_ nil))) (defun projectile-get-ext-ignored-command (vcs) "Determine which external command to invoke based on the project's VCS." (pcase vcs ('git projectile-git-ignored-command) ('hg projectile-hg-ignored-command) ('svn projectile-svn-ignored-command) (_ nil))) (defun projectile-get-all-sub-projects (project) "Get all sub-projects for a given project. PROJECT is base directory to start search recursively." (let ((submodules (projectile-get-immediate-sub-projects project))) (cond ((null submodules) nil) (t (append submodules (flatten-tree ;; recursively get sub-projects of each sub-project (mapcar (lambda (s) (projectile-get-all-sub-projects s)) submodules))))))) (defun projectile-get-immediate-sub-projects (path) "Get immediate sub-projects for a given project without recursing. PATH is the vcs root or project root from which to start searching, and should end with an appropriate path delimiter, such as '/' or a '\\'. If the vcs get-sub-projects query returns results outside of path, they are excluded from the results of this function." (let* ((vcs (projectile-project-vcs path)) (listing (if (eq vcs 'git) (projectile--git-submodules path) (projectile-files-via-ext-command path (projectile-get-sub-projects-command vcs)))) (submodules (mapcar (lambda (s) (file-name-as-directory (expand-file-name s path))) listing)) (project-child-folder-regex (concat "\\`" (regexp-quote path)))) ;; If project root is inside of an VCS folder, but not ;; actually an VCS root itself, submodules external to the ;; project will be included in the VCS get sub-projects ;; result. Let's remove them. (seq-filter (lambda (submodule) (string-match-p project-child-folder-regex submodule)) submodules))) (defun projectile--git-submodule-paths (gitmodules-dir) "List the populated submodule paths of the Git repo at GITMODULES-DIR. Reads `.gitmodules' with `git config' run via `process-file' - no shell is involved, so the listing works regardless of the local shell (the old shell-out relied on Unix single quotes and `tr', which broke on Windows - see issue #1600) and still goes through TRAMP for remote projects. Submodules that are registered but not checked out (no `.git' in their directory) are omitted, matching what `git submodule foreach' used to report. The returned paths are relative to GITMODULES-DIR." (let ((default-directory gitmodules-dir) paths) (with-temp-buffer (process-file "git" nil '(t nil) nil "config" "-z" "--file" ".gitmodules" "--get-regexp" "\\.path$") ;; Each NUL-separated record is "submodule..path\n"; ;; git has already unquoted the value for us. (dolist (record (split-string (buffer-string) "\0" t)) (when-let* ((separator (string-search "\n" record))) (let ((path (substring record (1+ separator)))) (when (file-exists-p (expand-file-name ".git" (expand-file-name path gitmodules-dir))) (push path paths)))))) (nreverse paths))) (defun projectile--git-submodules (path) "Return the raw submodule listing for the Git repo containing PATH. The result is a list of submodule paths relative to PATH. With `projectile-git-submodule-command' at its default value the listing is produced without a shell by `projectile--git-submodule-paths' \(see issue #1600); when the variable is customized it is honored as a shell command, and when nil submodules are disabled. For Git projects without a `.gitmodules' file there are no submodules to find, so the listing is skipped altogether. PATH may be inside a Git repo without being its toplevel \(e.g. a subproject of an outer repo) so `.gitmodules' is looked up at the toplevel of the repo containing PATH - the nearest parent with a `.git' entry - which is where git itself resolves it. Stopping at the repo boundary also means a populated submodule doesn't pick up its superproject's `.gitmodules'. Alien/hybrid indexing calls this on every file listing, so the result is cached in `projectile--git-submodules-cache' and recomputed only when `.gitmodules' changes on disk - a stat is far cheaper than the listing (see issue #1953). `projectile-invalidate-cache' also drops the cached listing." (when-let* ((gitmodules-dir (locate-dominating-file path ".git")) (gitmodules (expand-file-name ".gitmodules" gitmodules-dir)) ;; A plain `_' binding trips "variable `_' not left unused" ;; in the Emacs 28/29 byte-compilers. (gitmodules-exists (file-exists-p gitmodules))) (let* ((mtime (file-attribute-modification-time (file-attributes gitmodules))) (command (projectile-get-sub-projects-command 'git)) (cached (gethash path projectile--git-submodules-cache))) (pcase-let ((`(,cached-gitmodules ,cached-mtime ,cached-command ,cached-result) cached)) (if (and cached (equal cached-gitmodules gitmodules) (equal cached-mtime mtime) (equal cached-command command)) cached-result (let ((submodules (cond ;; nil disables submodule listing altogether. ((null command) nil) ;; The stock command is never actually run: list the ;; submodules shell-free instead (issue #1600). ((equal command projectile--default-git-submodule-command) (let ((dir (file-name-as-directory (expand-file-name gitmodules-dir))) (paths (projectile--git-submodule-paths gitmodules-dir))) (if (equal dir (file-name-as-directory (expand-file-name path))) paths ;; PATH is below the `.gitmodules' dir: rebase the ;; listing so it stays relative to PATH. (mapcar (lambda (submodule) (file-relative-name (expand-file-name submodule dir) path)) paths)))) ;; A customized command is still run through the shell. (t (projectile-files-via-ext-command path command))))) (puthash path (list gitmodules mtime command submodules) projectile--git-submodules-cache) submodules)))))) (defun projectile-get-sub-projects-files (project-root vcs) "Get files from sub-projects for PROJECT-ROOT recursively. VCS is the version control system of the project." (flatten-tree (mapcar (lambda (sub-project) (let ((project-relative-path (file-name-as-directory (file-relative-name sub-project project-root)))) (mapcar (lambda (file) (concat project-relative-path file)) (projectile-files-via-ext-command sub-project (projectile-get-ext-command vcs sub-project))))) (projectile-get-all-sub-projects project-root)))) (defun projectile-get-repo-ignored-files (project vcs) "Get a list of the files ignored in the PROJECT using VCS." (let ((cmd (projectile-get-ext-ignored-command vcs))) (when cmd (projectile-files-via-ext-command project cmd)))) (defun projectile-get-repo-ignored-directory (project dir vcs) "Get a list of the files ignored in the PROJECT in the directory DIR. VCS is the VCS of the project." (let ((cmd (projectile-get-ext-ignored-command vcs))) (when cmd (projectile-files-via-ext-command project (concat cmd " " dir))))) (defun projectile--command-accepts-pathspecs-p (command) "Return non-nil when COMMAND can take trailing path arguments. Several of the indexing commands Projectile ships are shell pipelines: the svn, fossil and pijul recipes, and the plain find fallback, all end in a `tr' stage. Appending a path to one of those hands it to that last stage rather than to the lister, which fails outright instead of restricting the listing, so the caller has to filter the command output itself (see `projectile--restrict-to-subdirs')." (and command (not (string-match-p "|" command)))) (defun projectile--ext-command-line (command pathspecs) "Return COMMAND with PATHSPECS appended as shell-quoted positional arguments. PATHSPECS may be nil, in which case COMMAND is returned unchanged. Shared by the synchronous and asynchronous indexing-command runners. Most indexing tools (`git ls-files', `find', `hg locate', ...) accept trailing path arguments to restrict the listing. `fd' is the exception: its positional grammar is `[pattern] [path...]', so a trailing path would be taken as the search pattern, and `fd' 9+ additionally rejects `--strip-cwd-prefix' whenever an explicit path is given (see #2005). So for `fd' commands we drop `--strip-cwd-prefix' (Projectile strips the `./' prefix from the output anyway) and pass the directories via `--search-path', which is unambiguous regardless of whether the command already carries a search pattern. `fd' commands are recognised by the `--strip-cwd-prefix' flag Projectile puts in its default `fd' recipes." (if (not pathspecs) command (if (string-match-p "--strip-cwd-prefix\\b" command) (concat (projectile--strip-fd-cwd-prefix-flag command) " " (mapconcat (lambda (path) (concat "--search-path " (shell-quote-argument path))) pathspecs " ")) (concat command " " (mapconcat #'shell-quote-argument pathspecs " "))))) (defun projectile--strip-fd-cwd-prefix-flag (command) "Remove fd's `--strip-cwd-prefix' flag (with any `=' value) from COMMAND. Also drops the space that preceded it, so the remaining command stays tidy." (replace-regexp-in-string " ?--strip-cwd-prefix\\(=[^ ]*\\)?" "" command t t)) (defun projectile--ext-command-output-files () "Parse an indexing command's stdout in the current buffer into a file list. Splits the output on NUL, drops empty records, and strips a leading \"./\" from each path. Shared by `projectile-files-via-ext-command' and its asynchronous counterpart so both produce identical results." (let ((shell-output (buffer-substring (point-min) (point-max)))) (mapcar (lambda (f) (string-remove-prefix "./" f)) (split-string (string-trim shell-output) "\0" t)))) (defun projectile--surface-ext-command-errors (errors-file) "Copy ERRORS-FILE's contents into the `*projectile-files-errors*' buffer. Return non-nil when ERRORS-FILE held any text. Shared by the synchronous and asynchronous indexing-command runners so a failing command's stderr is available for inspection." (with-current-buffer (get-buffer-create "*projectile-files-errors*") (let ((inhibit-read-only t)) (erase-buffer) (ignore-errors (insert-file-contents errors-file)) (> (buffer-size) 0)))) (defun projectile-files-via-ext-command (root command &optional pathspecs) "Get a list of relative file names in the project ROOT by executing COMMAND. PATHSPECS, when non-nil, is a list of subdirectories (relative to ROOT) appended to COMMAND as positional arguments. Each entry is shell-quoted before being appended. All of the indexing commands shipped with Projectile (`git ls-files', `fd', `find', `hg locate' etc.) accept additional path arguments at the end of the command line; users with heavily customised commands that don't should either not rely on `+' keep entries in `.projectile' or arrange their command to accept positional paths. If `command' is nil or an empty string, return nil. This allows commands to be disabled. When COMMAND exits non-zero but still produced output, that output is used: external listers such as `fd' routinely exit non-zero on benign conditions (e.g. an unreadable directory encountered mid-traversal) while having listed everything else. A `user-error' is signalled only when a non-zero exit produced no output at all, so a genuinely broken command (most commonly a binary like `fd' or `git' missing on a remote host) surfaces immediately instead of being mistaken for an empty project. Either way COMMAND's stderr is captured into the `*projectile-files-errors*' buffer. Only text sent to standard output is taken into account." (when (and (stringp command) (not (string-empty-p command))) (let* ((default-directory root) ;; A pipeline can't take the pathspecs; run it unrestricted and ;; filter its output below instead. (pathspecs-on-command (and (projectile--command-accepts-pathspecs-p command) pathspecs)) (full-command (projectile--ext-command-line command pathspecs-on-command)) (errors-file (make-temp-file "projectile-files-errors"))) (unwind-protect (with-temp-buffer ;; `process-file-shell-command' goes through TRAMP for remote ;; roots and returns a reliable exit code. Stderr is collected ;; into a temp file and copied into `*projectile-files-errors*' ;; only when the command fails, so we don't pollute the buffer ;; on the happy path. (let ((exit-code (process-file-shell-command full-command nil (list t errors-file))) (files (projectile--ext-command-output-files))) (when (and (numberp exit-code) (not (zerop exit-code))) (let ((had-stderr (projectile--surface-ext-command-errors errors-file))) (cond ;; Non-zero exit but we still got a listing: trust it. Only ;; mention it (quietly) when there was stderr worth seeing. (files (when had-stderr (projectile--message "`%s' exited with code %d but produced output; using it (see *projectile-files-errors*)" full-command exit-code))) ;; Non-zero exit and nothing on stdout: a real failure. (t (user-error "Projectile indexing command failed with exit code %d: %s\n\ See the *projectile-files-errors* buffer for details" exit-code full-command))))) (if pathspecs-on-command files (projectile--restrict-to-subdirs files pathspecs)))) (when (file-exists-p errors-file) (delete-file errors-file)))))) (defun projectile--posix-shell () "Return the POSIX shell the asynchronous indexer should run under, or nil. The async runner wraps the command in POSIX-sh syntax (the `{ ...; } 2>file' grouping in `projectile-files-via-ext-command-async'), so it needs a POSIX shell rather than the user's interactive `shell-file-name', which may be csh/tcsh/fish (see #2042). On Unix that is always `/bin/sh'. On Windows there is no guaranteed one, so we look for `sh' on the executable search path (e.g. the `sh.exe' shipped with Git for Windows or MSYS) and return nil when none is found - the caller then falls back to the synchronous runner, which drives cmd.exe without any POSIX syntax \(see #2116)." (if (memq system-type '(windows-nt ms-dos)) (executable-find "sh") "/bin/sh")) (defun projectile-files-via-ext-command-async (root command callback &optional pathspecs) "Asynchronously list relative file names in project ROOT by running COMMAND. Like `projectile-files-via-ext-command', but spawns COMMAND with `make-process' so Emacs is not blocked while it runs. The output is parsed with the very same logic, so the result is identical to the synchronous command. CALLBACK is funcalled with two arguments when COMMAND finishes: the list of files (nil on failure) and an error description string (nil on success). As in `projectile-files-via-ext-command', a non-zero exit that still produced output is treated as success (the output is passed to CALLBACK); only a non-zero exit with no output is reported as an error. Either way the command's stderr is copied into the `*projectile-files-errors*' buffer. PATHSPECS is handled exactly as in `projectile-files-via-ext-command'. Returns the process object, or nil when COMMAND is nil or empty (CALLBACK is then invoked with an empty list and no error, so callers don't have to special-case disabled commands) or when a remote file-name handler declines to start the process (CALLBACK is invoked with an error). Remote ROOTs are handled via TRAMP (`make-process' is given a non-nil `:file-handler')." (if (not (and (stringp command) (not (string-empty-p command)))) (progn (funcall callback nil nil) nil) (let* ((default-directory root) ;; Capture stderr in a temp file on the *same host* as the ;; command (local file locally, remote file over TRAMP) and ;; redirect the whole command group into it, mirroring the ;; synchronous runner's stderr handling without relying on ;; `make-process' :stderr support over TRAMP. (errors-file (make-nearby-temp-file "projectile-files-errors")) (errors-localname (or (file-remote-p errors-file 'localname) errors-file)) ;; See the synchronous runner: a pipeline can't take the pathspecs, ;; so it runs unrestricted and its output is filtered instead. (pathspecs-on-command (and (projectile--command-accepts-pathspecs-p command) pathspecs)) (restrict (unless pathspecs-on-command pathspecs)) (full-command (concat "{ " (projectile--ext-command-line command pathspecs-on-command) "; } 2>" (shell-quote-argument errors-localname))) (stdout-buffer (generate-new-buffer " *projectile-async-index*")) ;; A POSIX shell to run the wrapper under (see ;; `projectile--posix-shell' for why we don't use `shell-file-name'); ;; nil on Windows without `sh', in which case we decline below and ;; the caller falls back to the synchronous runner (see #2116). (shell (projectile--posix-shell)) ;; The result is delivered by this function rather than ;; straight from the sentinel, so a caller waiting on the ;; process can also deliver it (see ;; `projectile--dir-files-alien-await' and issue #2118). It ;; runs at most once, whoever gets there first. (finished nil) (finish (lambda (proc) (unless finished (setq finished t) (unwind-protect ;; A consumer that gives up on the wait (e.g. a C-g during ;; `projectile--dir-files-alien-await') marks the process ;; aborted and kills it. Killing fires the sentinel with a ;; `signal' status, but we must not then report a bogus ;; failure or clobber the errors buffer - just clean up. (unless (process-get proc 'projectile-aborted) (let ((exit-code (process-exit-status proc)) (files (projectile--restrict-to-subdirs (with-current-buffer stdout-buffer (projectile--ext-command-output-files)) restrict))) (cond ;; Clean exit: pass the listing through. ((and (numberp exit-code) (zerop exit-code)) (funcall callback files nil)) ;; Non-zero exit but we still got a listing: trust it, ;; mirroring the synchronous runner. Surface stderr ;; and mention it quietly when there's anything to see. (files (when (projectile--surface-ext-command-errors errors-file) (projectile--message "`%s' exited with code %s but produced output; using it (see *projectile-files-errors*)" command exit-code)) (funcall callback files nil)) ;; Non-zero exit and nothing on stdout: a real failure. (t (projectile--surface-ext-command-errors errors-file) (funcall callback nil (format "exit code %s: %s" exit-code command)))))) (when (buffer-live-p stdout-buffer) (kill-buffer stdout-buffer)) (when (file-exists-p errors-file) (ignore-errors (delete-file errors-file))))))) (proc (when shell (condition-case nil (make-process :name "projectile-index" :buffer stdout-buffer :command (list shell "-c" full-command) :connection-type 'pipe :noquery t :file-handler t :sentinel (lambda (proc _event) (when (memq (process-status proc) '(exit signal)) (funcall finish proc)))) ;; A failed spawn (e.g. Windows can't exec the shell, #2116) ;; signals `file-error'; trap it and decline so the caller ;; falls back to the synchronous runner, rather than letting ;; it escape from indexing. (file-error nil))))) ;; Hand the delivery function to whoever waits on the process, so a ;; sentinel that doesn't get run can't strand them (see #2118). (when (processp proc) (process-put proc 'projectile-finish finish)) ;; No process: either no POSIX shell was found (Windows without `sh', ;; see #2116), a spawn error was trapped above, or a file-name handler ;; declined (e.g. a remote host that doesn't support `make-process'). ;; In every case the sentinel never fires, so honour the callback ;; contract and clean up; the caller then falls back to the synchronous ;; runner. (unless proc (when (buffer-live-p stdout-buffer) (kill-buffer stdout-buffer)) (when (file-exists-p errors-file) (ignore-errors (delete-file errors-file))) (funcall callback nil "could not start the indexing process")) proc))) (defun projectile-dir-files-alien-async (directory callback &optional vcs subdirs) "Asynchronous counterpart of `projectile-dir-files-alien'. Runs the project's main indexing command for DIRECTORY without blocking and funcalls CALLBACK with (FILES ERROR) - the same convention as `projectile-files-via-ext-command-async'. VCS and SUBDIRS are interpreted exactly as in `projectile-dir-files-alien'. For git projects the cheap auxiliary steps (collecting submodule files and removing deleted-but-unstaged files) run synchronously once the main command finishes, inside the sentinel - off the caller's critical path - so the assembled result matches the synchronous function. Returns the main command's process." (let* ((vcs (or vcs (projectile-project-vcs directory))) (command (projectile--alien-ext-command vcs directory))) (if (eq vcs 'git) (let ((fd (and projectile-git-use-fd (projectile-fd-executable-for directory)))) (projectile-files-via-ext-command-async directory command (lambda (files err) (if err (funcall callback nil err) (let* ((all (nconc files ;; Submodules run their own `git ls-files', ;; which never saw our exclusions. (projectile--maybe-remove-ignored directory (projectile--restricted-sub-projects-files directory vcs subdirs)))) (deleted (unless fd (projectile-git-deleted-files directory)))) (funcall callback (if deleted (let ((deleted-set (make-hash-table :test 'equal :size (length deleted)))) (dolist (f deleted) (puthash f t deleted-set)) (seq-remove (lambda (f) (gethash f deleted-set)) all)) all) nil)))) subdirs)) (projectile-files-via-ext-command-async directory command callback subdirs)))) ;;;###autoload (defun projectile-index-project-async (&optional project-root) "Index PROJECT-ROOT in the background and populate the files cache. This warms `projectile-projects-cache' without blocking Emacs, so a later `projectile-find-file' (or any command that lists project files) finds the cache already populated instead of indexing synchronously. Only the external-command indexing methods (`alien' and `hybrid') can be warmed this way; under `native' indexing this is a no-op with a message, since the Elisp directory walk cannot run off the main thread. Warming also requires caching to be enabled. When PROJECT-ROOT is omitted the current project is used. Returns the indexing process, or nil when nothing was started." (interactive) (let ((root (or project-root (projectile-acquire-root)))) (cond ((eq projectile-indexing-method 'native) (projectile--message-always "Async indexing needs the `alien'/`hybrid' method; `native' cannot be warmed") nil) ((not projectile-enable-caching) (projectile--message-always "Async indexing has no effect while caching is disabled") nil) ((let ((proc (gethash root projectile--async-index-processes))) (and proc (process-live-p proc))) (projectile--message-always "Already indexing %s" root) nil) (t (projectile--message-always "Indexing %s in the background..." root) ;; The callback needs to know which process it belongs to so it can ;; tell whether it is still the active index for ROOT when it ;; finishes (a re-trigger or `projectile-invalidate-cache' replaces ;; or clears the registry entry). But the process object is the ;; return value of the very call the callback is passed to, so we ;; thread it through a mutable cell that is filled in below, before ;; the (asynchronous) sentinel can ever run. (let* ((proc-cell (list nil)) (proc (projectile-dir-files-alien-async root (lambda (files err) ;; Ignore a stale result whose registry entry was ;; replaced (re-trigger) or removed (invalidation) while ;; we were running, so it can't resurrect a cache that ;; has since moved on. (when (eq (gethash root projectile--async-index-processes) (car proc-cell)) (remhash root projectile--async-index-processes) (if err (projectile--message-always "Background indexing of %s failed: %s" root err) (projectile-cache-project root files) (projectile--message-always "Finished indexing %s (%d files)" root (length files)))))))) (setcar proc-cell proc) (when (processp proc) (puthash root proc projectile--async-index-processes)) proc))))) (defun projectile--dir-files-alien-await (directory &optional vcs subdirs) "Like `projectile-dir-files-alien' for DIRECTORY but without freezing Emacs. Runs the asynchronous indexer and waits for it with `accept-process-output' so redisplay keeps happening and `keyboard-quit' (\\[keyboard-quit]) stays live; on a quit the indexing process is killed and the quit is re-signalled. The returned list is the same one `projectile-dir-files-alien' would produce. VCS and SUBDIRS are interpreted exactly as in `projectile-dir-files-alien'. Falls back to the synchronous function when the asynchronous process can't be started (e.g. a remote host whose handler doesn't support `make-process'). Note that waiting pumps the event loop, so process filters, sentinels and timers (but not interactive commands) may run while we wait." (let* (done files err (proc (projectile-dir-files-alien-async directory (lambda (fs e) (setq done t files fs err e)) vcs subdirs))) (cond ;; The async indexer didn't spawn a process. Either the command was ;; empty - in which case the callback already ran synchronously and we ;; just return its (empty) result - or a remote handler declined ;; make-process, in which case we fall back to the synchronous, ;; TRAMP-safe path. ((null proc) (if (and done (null err)) files (projectile-dir-files-alien directory vcs subdirs))) ;; A genuine process is running: wait for it without freezing. (t (let ((reporter (make-progress-reporter (format "Projectile is indexing %s" (propertize (abbreviate-file-name directory) 'face 'font-lock-keyword-face))))) (unwind-protect (progn (while (and (not done) (process-live-p proc)) (accept-process-output proc 0.1) (progress-reporter-update reporter)) ;; The command is done, but the result reaches us from the ;; process sentinel, and that isn't guaranteed to have run: ;; `accept-process-output' on a process that has already ;; exited returns without running it, and the status change ;; may not be noticed until Emacs is back in its command ;; loop. That used to leave this loop spinning forever with ;; the progress reporter turning (issue #2118). Pump the ;; event loop briefly - `sit-for', unlike ;; `accept-process-output', does run pending sentinels - and ;; if the result still hasn't arrived, deliver it here. (unless done (let ((deadline (+ (projectile-time-seconds) projectile-async-index-sentinel-timeout))) (while (and (not done) (< (projectile-time-seconds) deadline)) (sit-for 0.02) (progress-reporter-update reporter))) (unless done (when-let* ((finish (process-get proc 'projectile-finish))) (funcall finish proc))))) ;; Runs on normal completion and on `keyboard-quit': make sure we ;; never leave the indexing process running behind us. Mark it ;; aborted first so its sentinel skips the failure path (killing ;; it fires the sentinel with a `signal' status) and just cleans ;; up - a quit must stay a clean quit. (when (process-live-p proc) (process-put proc 'projectile-aborted t) (delete-process proc))) (progress-reporter-done reporter)) (cond (err (user-error "Projectile indexing failed: %s. \ See the *projectile-files-errors* buffer for details" err)) (done files) ;; Neither the sentinel nor we could deliver a result - rather than ;; report an empty project, index the old (blocking) way. (t (projectile-dir-files-alien directory vcs subdirs))))))) (defun projectile--dir-files-alien-maybe-async (directory &optional vcs subdirs) "Return alien-indexed files for DIRECTORY, without freezing when possible. Dispatches to the responsive asynchronous indexer \(`projectile--dir-files-alien-await') when `projectile-async-indexing' is enabled and we're in an interactive context, and to the synchronous `projectile-dir-files-alien' otherwise (batch mode, keyboard macros, or when the option is disabled). Both return the same list." (if (and projectile-async-indexing (not noninteractive) (not executing-kbd-macro)) (projectile--dir-files-alien-await directory vcs subdirs) (projectile-dir-files-alien directory vcs subdirs))) (defun projectile-project-files-producer (&optional project-root) "Describe how to list PROJECT-ROOT's files with an external command. Return a plist exposing the pieces an external file finder (for example an asynchronous, streaming one built on `consult' or `affe') needs to run Projectile's own indexing command itself: :directory the directory the command should run in (the project root) :vcs the detected version-control system, a symbol (or `none') :command the shell command that lists the files, NUL-separated, or nil when external-command indexing is disabled. Carries Projectile's ignore rules as exclusion arguments when the tool understands them (see `projectile-alien-honors-ignores'); for the tools that don't, the caller has to apply `projectile-remove-ignored' to the output itself :separator the string that separates records in the command's output The command's output is exactly what `projectile-files-via-ext-command' parses. Note that for git projects Projectile additionally folds in submodule files and drops deleted-but-unstaged ones (see `projectile-dir-files-alien'); a finder that wants byte-for-byte the same set as `projectile-find-file' should drive `projectile-dir-files-alien-async' rather than running :command directly. PROJECT-ROOT defaults to the current project." (let* ((root (or project-root (projectile-acquire-root))) (vcs (projectile-project-vcs root))) (list :directory root :vcs vcs :command (projectile--alien-ext-command vcs root) :separator "\0"))) (defun projectile-adjust-files (project vcs files) "First remove ignored files from FILES, then add back unignored files." (projectile-add-unignored project vcs (projectile-remove-ignored files project))) (defun projectile-remove-ignored (files &optional root) "Remove ignored files and folders from FILES. FILES are paths relative to the project root. They are matched against the project's ignore patterns (see `projectile--ignore-patterns'), the same gitignore-style rules the native indexer and the alien push-down apply; `!' ensure patterns rescue files from them. ROOT names the project whose rules apply, defaulting to the current one. Pass it whenever the files being filtered belong to a project other than the one you are visiting - listing another project's files otherwise filters them by the rules of the project you happen to be in, and with caching on stores that wrong answer under the other project's key." (let* (;; Ignore matching is case-sensitive; `string-match-p' would ;; otherwise fold case, since `case-fold-search' defaults to t. (case-fold-search nil) (filtering-patterns (projectile-filtering-patterns root)) (ignore-re (projectile--compile-ignore-patterns (car filtering-patterns))) (ensure-re (projectile--compile-ignore-patterns (cdr filtering-patterns)))) (if (null ignore-re) files (seq-remove (lambda (file) (and (string-match-p ignore-re file) (not (and ensure-re (string-match-p ensure-re file))))) files)))) (defun projectile-keep-ignored-files (project vcs files) "Filter FILES to retain only those that are ignored." (when files (seq-filter (lambda (file) (seq-some (lambda (f) (string-prefix-p f file)) files)) (projectile-get-repo-ignored-files project vcs)))) (defun projectile-keep-ignored-directories (project vcs directories) "Get ignored files within each of DIRECTORIES." (when directories (let (result) (dolist (dir directories result) (setq result (append result (projectile-get-repo-ignored-directory project dir vcs)))) result))) (defun projectile-add-unignored (project vcs files) "This adds unignored files to FILES. Useful because the VCS may not return ignored files at all. In this case unignored files will be absent from FILES." (let ((unignored-files (projectile-keep-ignored-files project vcs (projectile-unignored-files-rel))) (unignored-paths (projectile-remove-ignored (projectile-keep-ignored-directories project vcs (projectile-unignored-directories-rel)) project))) (append files unignored-files unignored-paths))) (defun projectile-buffers-with-file (buffers) "Return only those BUFFERS backed by files." (seq-filter (lambda (b) (buffer-file-name b)) buffers)) (defun projectile-buffers-with-file-or-process (buffers) "Return only those BUFFERS backed by files or processes." (seq-filter (lambda (b) (or (buffer-file-name b) (get-buffer-process b))) buffers)) ;;; Project buffers ;; ;; Which of Emacs's buffers belong to the project, and the filtering that ;; decides it. Consumed by the buffer-switching, killing and saving ;; commands, and by the ibuffer integration. (defun projectile-project-buffers (&optional project) "Get a list of a project's buffers. If PROJECT is not specified the command acts on the current project." (let* ((project-root (or project (projectile-acquire-root))) (truename-cache (make-hash-table :test 'equal)) (all-buffers (seq-filter (lambda (buffer) (projectile-project-buffer-p buffer project-root truename-cache)) (buffer-list)))) (if projectile-buffers-filter-function (funcall projectile-buffers-filter-function all-buffers) all-buffers))) (defun projectile-process-current-project-buffers (action) "Process the current project's buffers using ACTION." (let ((project-buffers (projectile-project-buffers))) (dolist (buffer project-buffers) (funcall action buffer)))) (defun projectile-process-current-project-buffers-current (action) "Invoke ACTION on every project buffer with that buffer current. ACTION is called without arguments." (let ((project-buffers (projectile-project-buffers))) (dolist (buffer project-buffers) (with-current-buffer buffer (funcall action))))) (defun projectile-project-buffer-files (&optional project) "Get a list of a project's buffer files. If PROJECT is not specified the command acts on the current project." (let ((project-root (or project (projectile-project-root)))) (mapcar (lambda (buffer) (file-relative-name (buffer-file-name buffer) project-root)) (projectile-buffers-with-file (projectile-project-buffers project))))) (defun projectile-project-buffer-p (buffer project-root &optional truename-cache) "Check if BUFFER is under PROJECT-ROOT. Optional TRUENAME-CACHE is a hash table used to memoize `file-truename' calls when checking multiple buffers against the same project root. For buffers visiting remote (TRAMP) files we skip the `file-truename' call: each such call is a remote round-trip, and resolving symlinks across a TRAMP boundary is rarely what users want. The downside is that a remote project reached via two different symlinked paths won't be matched - we trade that edge case for not stalling `projectile-project-buffers' on networks with high latency." (with-current-buffer buffer (let ((directory (if buffer-file-name (file-name-directory buffer-file-name) default-directory))) (and (not (string-prefix-p " " (buffer-name buffer))) (not (projectile-ignored-buffer-p buffer)) directory (string-equal (file-remote-p directory) (file-remote-p project-root)) (not (string-match-p "^http\\(s\\)?://" directory)) (let ((compare-dir (cond ((file-remote-p directory) directory) (truename-cache (or (gethash directory truename-cache) (puthash directory (file-truename directory) truename-cache))) (t (file-truename directory))))) (string-prefix-p project-root compare-dir (eq system-type 'windows-nt))))))) (defun projectile-ignored-buffer-p (buffer) "Check if BUFFER should be ignored." (or (with-current-buffer buffer (seq-some (lambda (name) (string-match-p name (buffer-name))) projectile-globally-ignored-buffers)) (with-current-buffer buffer (seq-some (lambda (mode) (string-match-p (concat "^" mode "$") (symbol-name major-mode))) projectile-globally-ignored-modes)))) (defun projectile-recently-active-files () "Get list of recently active files. Files are ordered by recently active buffers, and then recently opened through use of recentf." (let ((project-buffer-files (projectile-project-buffer-files))) (append project-buffer-files (seq-difference (projectile-recentf-files) project-buffer-files)))) (defun projectile-project-buffer-names () "Get a list of project buffer names." (mapcar #'buffer-name (projectile-project-buffers))) (defun projectile-prepend-project-name (string) "Prepend the current project's name to STRING." (format "[%s] %s" (projectile-project-name) string)) (defun projectile-read-buffer-to-switch (prompt) "Read the name of a buffer to switch to, prompting with PROMPT. This function excludes the current buffer from the offered choices." (projectile-completing-read prompt (delete (buffer-name (current-buffer)) (projectile-project-buffer-names)) :category 'buffer :caller 'projectile-read-buffer)) ;;; Other window/frame display variants ;; ;; Most Projectile commands that display a buffer come with -other-window ;; and -other-frame variants (bound under the `4' and `5' prefixes in ;; `projectile-command-map'). They are all generated by the macro below; ;; the bodies only differ in the display function they hand to the shared ;; subroutine. See also `projectile-other-window-command' and ;; `projectile-other-frame-command', which provide the same functionality ;; for *any* command without needing a dedicated wrapper. (eval-and-compile (defun projectile--substitute-in-symbols (form from to) "Return a copy of FORM with FROM replaced by TO in every symbol name." (cond ((consp form) (cons (projectile--substitute-in-symbols (car form) from to) (projectile--substitute-in-symbols (cdr form) from to))) ((and form (symbolp form) (string-match-p (regexp-quote from) (symbol-name form))) (intern (string-replace from to (symbol-name form)))) (t form)))) (defmacro projectile--define-display-variants (base arglist docstring &rest body) "Define other-window/other-frame variants of the Projectile command BASE. Defines the commands `BASE-other-window' and `BASE-other-frame'. Each takes ARGLIST as its argument list; when ARGLIST is non-empty the commands read the raw prefix argument (all such variants mirror a base command with an (interactive \"P\") spec). DOCSTRING is a format string; every `%s' in it is filled in with \"window\" or \"frame\". BODY is the body of the other-window variant. The other-frame variant is derived from it by replacing \"other-window\" with \"other-frame\" inside every symbol, so bodies reference display functions like `find-file-other-window' and get the frame flavor for free. If BODY starts with the keyword :places followed by a list, only the variants for the listed places are defined, e.g. (window) for commands that have no other-frame counterpart." (declare (indent 2) (doc-string 3)) (let ((places '(window frame))) (when (eq (car body) :places) (setq places (cadr body) body (cddr body))) `(progn ,@(mapcar (lambda (place) (let ((name (intern (format "%s-other-%s" base place))) (body (if (eq place 'window) body (projectile--substitute-in-symbols body "other-window" "other-frame"))) (%-count (1- (length (split-string docstring "%s"))))) `(defun ,name ,arglist ,(apply #'format docstring (make-list %-count place)) (interactive ,@(when arglist '("P"))) ,@body))) places)))) (defun projectile--switch-to-buffer (switch-fn) "Read a project buffer and display it with SWITCH-FN. SWITCH-FN is a `switch-to-buffer'-like command; passing `switch-to-buffer-other-window' or `switch-to-buffer-other-frame' yields the other-window/-frame variants." (funcall switch-fn (projectile-read-buffer-to-switch "Switch to buffer: "))) ;;;###autoload (defun projectile-switch-to-buffer () "Switch to a project buffer." (interactive) (projectile--switch-to-buffer #'switch-to-buffer)) ;;;###autoload (autoload 'projectile-switch-to-buffer-other-window "projectile" nil t) ;;;###autoload (autoload 'projectile-switch-to-buffer-other-frame "projectile" nil t) (projectile--define-display-variants projectile-switch-to-buffer () "Switch to a project buffer and show it in another %s." (projectile--switch-to-buffer #'switch-to-buffer-other-window)) ;;;###autoload (defun projectile-display-buffer () "Display a project buffer in another window without selecting it." (interactive) (display-buffer (projectile-completing-read "Display buffer: " (projectile-project-buffer-names) :category 'buffer :caller 'projectile-read-buffer))) ;;;###autoload (defun projectile-project-buffers-other-buffer () "Switch to the most recently selected buffer project buffer. Only buffers not visible in windows are returned." (interactive) (switch-to-buffer (car (projectile-project-buffers-non-visible)) nil t)) (defun projectile-project-buffers-non-visible () "Get a list of non visible project buffers." (seq-filter (lambda (buffer) (not (get-buffer-window buffer 'visible))) (projectile-project-buffers))) ;;;###autoload (defun projectile-multi-occur (&optional nlines) "Do a `multi-occur' in the project's buffers. With a prefix argument, show NLINES of context." (interactive "P") (let ((project (projectile-acquire-root))) (multi-occur (projectile-project-buffers project) (car (occur-read-primary-args)) nlines))) ;;; Ignore and ensure rules ;; ;; Which paths a project's commands may touch. The rules come from the ;; globally ignored lists and from the `-'/`!' entries of the dirconfig, and ;; are normalised here into the gitignore-style patterns every indexing ;; method and every external tool Projectile drives is configured from. (defun projectile-normalise-paths (patterns) "Remove leading `/' from the elements of PATTERNS." ;; TODO: Replace delq+mapcar with seq-keep when Emacs 29.1 is the minimum version (delq nil (mapcar (lambda (pat) (and (string-prefix-p "/" pat) ;; remove the leading / (substring pat 1))) patterns))) (defun projectile-expand-paths (paths) "Expand the elements of PATHS. Elements containing wildcards are expanded and spliced into the resulting paths. The returned PATHS are absolute, based on the projectile project root." (let ((default-directory (projectile-project-root))) (flatten-tree (mapcar (lambda (pattern) (or (file-expand-wildcards pattern t) (projectile-expand-root pattern))) paths)))) (defun projectile-normalise-patterns (patterns) "Remove paths from PATTERNS." (seq-remove (lambda (pat) (string-prefix-p "/" pat)) patterns)) (defun projectile-make-relative-to-root (files) "Make FILES relative to the project root." (let ((project-root (projectile-project-root))) (mapcar (lambda (f) (projectile--project-relative-name f project-root)) files))) (defun projectile--ignored-path-p (path root directory-p) "Return non-nil when PATH is ignored in the project at ROOT. PATH is an absolute file name and DIRECTORY-P says whether it names a directory, in which case directory-only patterns (those with a trailing slash) can match it. ROOT defaults to the current project's root. The check is the one indexing performs: PATH's root-relative name is matched against `projectile--ignore-patterns', `!' ensure patterns rescue it, and `projectile-globally-ignored-file-regexps' is applied to the absolute name. Because an ignored directory covers its whole subtree, a path inside one is reported as ignored too." (let* ((path (expand-file-name path)) (root (file-name-as-directory (expand-file-name (or root (projectile-project-root))))) (relative-name (projectile--project-relative-name path root)) (relative-name (if directory-p (file-name-as-directory relative-name) relative-name)) (patterns (projectile-filtering-patterns root)) (ignore-re (projectile--compile-ignore-patterns (car patterns))) (ensure-re (projectile--compile-ignore-patterns (cdr patterns))) ;; Ignore matching is case-sensitive. (case-fold-search nil)) (or (projectile--global-ignore-regexp-p path) (and ignore-re (string-match-p ignore-re relative-name) (not (and ensure-re (string-match-p ensure-re relative-name))) t)))) (defun projectile-ignored-directory-p (directory &optional root) "Check if DIRECTORY should be ignored. DIRECTORY is an absolute directory name and ROOT is the project root it belongs to, defaulting to the current project's. The answer is the one indexing gives - see `projectile--ignored-path-p'." (projectile--ignored-path-p directory root t)) (defun projectile-ignored-file-p (file &optional root) "Check if FILE should be ignored. FILE is an absolute file name and ROOT is the project root it belongs to, defaulting to the current project's. The answer is the one indexing gives - see `projectile--ignored-path-p'. A file inside an ignored directory counts as ignored." (projectile--ignored-path-p file root nil)) (defun projectile-globally-ignored-directory-names () "Return list of ignored directory names." (seq-difference projectile-globally-ignored-directories projectile-globally-unignored-directories)) (defun projectile--dirconfig-ignore (&optional root) "Return the IGNORE entries from ROOT's dirconfig, or nil." (when-let* ((cfg (projectile-parse-dirconfig-file root))) (projectile-dirconfig-ignore cfg))) (defun projectile--dirconfig-ensure (&optional root) "Return the ENSURE entries from ROOT's dirconfig, or nil." (when-let* ((cfg (projectile-parse-dirconfig-file root))) (projectile-dirconfig-ensure cfg))) (defun projectile-unignored-files () "Return list of unignored files." (mapcar #'projectile-expand-root (append projectile-globally-unignored-files (projectile-project-unignored-files)))) (defun projectile-unignored-directories () "Return list of unignored directories." (mapcar #'file-name-as-directory (mapcar #'projectile-expand-root (append projectile-globally-unignored-directories (projectile-project-unignored-directories))))) (defun projectile-unignored-directories-rel () "Return list of unignored directories, relative to the root." (projectile-make-relative-to-root (projectile-unignored-directories))) (defun projectile-unignored-files-rel () "Return list of unignored files, relative to the root." (projectile-make-relative-to-root (projectile-unignored-files))) (defun projectile-project-unignored-files () "Return list of project unignored files." (seq-remove 'file-directory-p (projectile-project-unignored))) (defun projectile-project-unignored-directories () "Return list of project unignored directories." (seq-filter 'file-directory-p (projectile-project-unignored))) (defun projectile-paths-to-ensure () "Return a list of unignored project paths." (projectile-normalise-paths (projectile--dirconfig-ensure))) (defun projectile-files-to-ensure () (let ((default-directory (projectile-project-root))) (flatten-tree (mapcar #'file-expand-wildcards (projectile-patterns-to-ensure))))) (defun projectile-patterns-to-ensure () "Return a list of relative file patterns." (projectile-normalise-patterns (projectile--dirconfig-ensure))) (defun projectile--ignore-patterns (&optional root) "Return ROOT's ignore rules as a list of gitignore-style patterns. This is Projectile's single source of ignore patterns: every indexing method and every external tool Projectile drives is configured from this list, so they all apply the same rules the same way. It merges - `projectile-globally-ignored-directories', as directory-only patterns \(a trailing `/' is appended) - `projectile-globally-ignored-files', as-is - `projectile-globally-ignored-file-suffixes', as `*SUFFIX' globs - the `-' (ignore) entries of the project's dirconfig, which are already written in this language The `projectile-globally-unignored-*' options cancel out the matching entries. `projectile-globally-ignored-file-regexps' is deliberately not part of this: those are Emacs regexps, not patterns, and can't be handed to an external tool. ROOT defaults to the current project's root and only matters for the dirconfig entries; outside a project the global patterns are returned on their own. See `projectile--ignore-pattern-to-regexp' for the matching rules." (append (mapcar (lambda (name) (concat (directory-file-name name) "/")) (projectile-globally-ignored-directory-names)) (seq-difference projectile-globally-ignored-files projectile-globally-unignored-files) (projectile--globally-ignored-file-suffixes-glob) (projectile--dirconfig-ignore root))) (defun projectile--ensure-patterns (&optional root) "Return ROOT's ensure rules as a list of gitignore-style patterns. These are the `!' entries of the project's dirconfig; a path they match is kept even when `projectile--ignore-patterns' also matches it." (projectile--dirconfig-ensure root)) (defun projectile-filtering-patterns (&optional root) "Return ROOT's ignore and ensure patterns as a cons cell." (cons (projectile--ignore-patterns root) (projectile--ensure-patterns root))) (defun projectile-project-unignored () "Return list of project ignored files/directories." (seq-uniq (append (projectile-expand-paths (projectile-paths-to-ensure)) (projectile-expand-paths (projectile-files-to-ensure))))) ;;; The dirconfig file ;; ;; Reading and parsing a project's `.projectile': classifying its lines into ;; keep/ignore/ensure entries, caching the parse against the file's mtime, ;; and warning about the entry forms that no longer mean what they look like. (defun projectile-dirconfig-file (&optional root) "Return the absolute path to ROOT's dirconfig file. ROOT defaults to the current project's root." (expand-file-name projectile-dirconfig-file (or root (projectile-project-root)))) (cl-defstruct projectile-dirconfig "Parsed contents of a project's dirconfig file. KEEP is the list of subdirectories to restrict the project to (as returned with a trailing slash). IGNORE and ENSURE are the lists of files or directories to ignore and to forcibly include, respectively. PREFIXLESS-IGNORE is the subset of IGNORE entries that arrived without a leading `+'/`-'/`!'/comment marker; they are accepted for backward compatibility but recorded separately so callers can flag the deprecated syntax. All slots default to nil." (keep nil) (ignore nil) (ensure nil) (prefixless-ignore nil)) (defun projectile--maybe-warn-glob-keep-entries (project-root cfg) "Warn once per session about glob patterns in + keep entries. PROJECT-ROOT identifies the warned-projects set; CFG is the parsed `projectile-dirconfig' struct. The `+' prefix is for subdirectories only; the parser silently coerces each entry to a directory, so a glob pattern would never match." (when (and cfg (not (gethash project-root projectile--glob-keep-warned-projects))) (when-let* ((globbed (seq-filter (lambda (entry) (string-match-p "[][*?]" entry)) (projectile-dirconfig-keep cfg)))) (puthash project-root t projectile--glob-keep-warned-projects) (display-warning 'projectile (format "%s contains `+' entries with glob metacharacters: %s. \ The `+' prefix is for subdirectory paths only; globs are not expanded \ and the entries are silently coerced to directory names. Use a plain \ directory or move the pattern to a `-'/`!' rule." (expand-file-name projectile-dirconfig-file project-root) (mapconcat (lambda (s) (format "`%s'" s)) globbed ", ")) :warning)))) (defun projectile--dirconfig-classify-line (line) "Classify LINE from a dirconfig file. Return a cons (BUCKET . VALUE) where BUCKET is one of `:keep', `:ignore', `:ensure', `:legacy-ignore', or `:comment'. Return nil for a blank line. Leading whitespace is skipped before dispatch so an accidental space or tab before the prefix does not change classification. `:legacy-ignore' is reserved for prefix-less lines, which are still treated as ignore patterns for backward compatibility but are tracked separately so callers can warn." (let* ((trimmed (string-trim-left line)) (first-char (and (> (length trimmed) 0) (aref trimmed 0)))) (cond ((null first-char) nil) ((and projectile-dirconfig-comment-prefix (eql first-char projectile-dirconfig-comment-prefix)) (cons :comment nil)) ((eql first-char ?+) (cons :keep (string-trim (substring trimmed 1)))) ((eql first-char ?-) (cons :ignore (string-trim (substring trimmed 1)))) ((eql first-char ?!) (cons :ensure (string-trim (substring trimmed 1)))) (t (cons :legacy-ignore (string-trim trimmed)))))) (defun projectile--parse-dirconfig-string (text) "Parse TEXT (a dirconfig file's contents) into a `projectile-dirconfig'." (let (keep ignore ensure prefixless) (dolist (line (split-string text "\n")) (pcase (projectile--dirconfig-classify-line line) (`(:keep . ,v) (unless (string-empty-p v) (push v keep))) (`(:ignore . ,v) (unless (string-empty-p v) (push v ignore))) (`(:ensure . ,v) (unless (string-empty-p v) (push v ensure))) (`(:legacy-ignore . ,v) (unless (string-empty-p v) (push v ignore) (push v prefixless))))) (make-projectile-dirconfig :keep (mapcar #'file-name-as-directory (nreverse keep)) :ignore (nreverse ignore) :ensure (nreverse ensure) :prefixless-ignore (nreverse prefixless)))) (defun projectile--parse-dirconfig-file-uncached (&optional root) "Parse ROOT's dirconfig file without caching. Return a `projectile-dirconfig' or nil if the file doesn't exist. ROOT defaults to the current project." (let ((dirconfig (projectile-dirconfig-file root))) (when (projectile-file-exists-p dirconfig) (projectile--parse-dirconfig-string (with-temp-buffer (insert-file-contents dirconfig) (buffer-string)))))) (defun projectile--maybe-warn-prefixless-entries (project-root cfg) "Warn once per session about prefix-less ignore entries in CFG for PROJECT-ROOT. CFG is a `projectile-dirconfig' struct." (when (and projectile-warn-on-prefixless-dirconfig-lines cfg (projectile-dirconfig-prefixless-ignore cfg) (not (gethash project-root projectile--prefixless-dirconfig-warned-projects))) (puthash project-root t projectile--prefixless-dirconfig-warned-projects) (display-warning 'projectile (format "%s contains entries without a `+'/`-'/`!' prefix: %s. \ The implicit form is treated as an ignore rule for backward \ compatibility but is being phased out — please prefix the lines \ explicitly. Set `projectile-warn-on-prefixless-dirconfig-lines' \ to nil to silence this warning." (expand-file-name projectile-dirconfig-file project-root) (mapconcat (lambda (s) (format "`%s'" s)) (projectile-dirconfig-prefixless-ignore cfg) ", ")) :warning))) (defun projectile-parse-dirconfig-file (&optional root) "Parse ROOT's ignore file and return its rules. ROOT defaults to the current project; pass it to read the rules of a project you are not visiting, which is what listing the files of several projects at once needs. The return value is a `projectile-dirconfig' struct with three slots: KEEP (subdirectories to restrict the project to), IGNORE (files or directories to skip), and ENSURE (files or directories to forcibly include even when otherwise ignored). When the file does not exist, the return value is nil. Lines are dispatched on their first non-whitespace character: + add to the keep list - add to the ignore list ! add to the ensure list Without a prefix, the line is assumed to be an ignore pattern, for backward compatibility. When `projectile-dirconfig-comment-prefix' is non-nil, lines whose first non-whitespace character matches it are treated as comments. Results are cached per project root and invalidated when the dirconfig file's modification time changes." (let* ((project-root (or root (projectile-project-root))) (dirconfig (projectile-dirconfig-file project-root)) (cached (gethash project-root projectile--dirconfig-cache)) (attrs (file-attributes dirconfig)) (mtime (when attrs (file-attribute-modification-time attrs))) (result (pcase-let ((`(,cached-dirconfig ,cached-mtime ,cached-result) cached)) (if (and cached mtime (equal cached-dirconfig dirconfig) (equal cached-mtime mtime)) cached-result (let ((parsed (projectile--parse-dirconfig-file-uncached project-root))) (when mtime (puthash project-root (list dirconfig mtime parsed) projectile--dirconfig-cache)) parsed))))) (projectile--maybe-warn-prefixless-entries project-root result) (projectile--maybe-warn-glob-keep-entries project-root result) result)) ;;; Path expansion and completion (defun projectile-expand-root (name &optional dir) "Expand NAME to project root. When DIR is specified it uses DIR's project, otherwise it acts on the current project. Never use on many files since it's going to recalculate the project-root for every file." (expand-file-name name (projectile-project-root dir))) (cl-defun projectile-completing-read (prompt choices &key initial-input action caller sort-function annotation-function (category 'project-file)) "Present a project tailored PROMPT with CHOICES. Reads with `completing-read', unless `projectile-completion-system' is a function, in which case that function is called with PROMPT and CHOICES. INITIAL-INPUT is passed to `completing-read'. ACTION, when non-nil, is called on the selected candidate and its result returned. SORT-FUNCTION, when non-nil, is exposed as the completion metadata's `display-sort-function' and `cycle-sort-function', so completion UIs that honor metadata present the candidates in that order. ANNOTATION-FUNCTION, when non-nil, is exposed as the metadata's `annotation-function', so UIs that honor metadata show a suffix next to each candidate. Use it when the candidate string alone doesn't identify what's being picked - a worktree's path doesn't say which branch it has checked out, for instance. CATEGORY is the completion metadata category advertised to UIs like marginalia and embark so they annotate and act on the candidates appropriately; it defaults to `project-file' (the candidates are project files) and should be overridden when they are not - e.g. `buffer' for a buffer switch or `file' for a directory. A nil CATEGORY omits it. CALLER is accepted for backward compatibility but no longer used." (ignore caller) (let* ((prompt (projectile-prepend-project-name prompt)) (res (if (functionp projectile-completion-system) (funcall projectile-completion-system prompt choices) (completing-read prompt (lambda (string pred action) ;; The completion category lets packages like marginalia ;; and embark enhance how candidates are presented. (if (eq action 'metadata) `(metadata ,@(when category `((category . ,category))) ,@(when annotation-function `((annotation-function . ,annotation-function))) ,@(when sort-function `((display-sort-function . ,sort-function) (cycle-sort-function . ,sort-function)))) (complete-with-action action choices string pred))) nil nil initial-input)))) (if action (funcall action res) res))) ;;; Listing a project's files and directories (defun projectile-project-files (project-root) "Return a list of files for the PROJECT-ROOT." (let (files) ;; If the cache is too stale, don't use it. (when projectile-files-cache-expire (let ((cache-time (gethash project-root projectile-projects-cache-time))) (when (or (null cache-time) (< (+ cache-time projectile-files-cache-expire) (projectile-time-seconds))) (remhash project-root projectile-projects-cache) (remhash project-root projectile-projects-cache-time)))) ;; Use the cache, if requested and available. (when projectile-enable-caching (setq files (or (gethash project-root projectile-projects-cache) ;; load the cache from disk only if persistent cache is ;; enabled (and (eq projectile-enable-caching 'persistent) (projectile-load-project-cache project-root))))) ;; Calculate the list of files. (when (null files) (when projectile-enable-caching (message "Indexing %s..." project-root)) (setq files (if (eq projectile-indexing-method 'alien) ;; In alien mode the external tool does the walking. The ;; ignore rules ride along as exclusion arguments on the ;; command; dirconfig `+' keep entries ride along as ;; pathspecs (or, for a tool that can't take them, as a ;; filter over its output). Only the tools that can't ;; express the ignores need a further pass here. (let* ((vcs (projectile-project-vcs project-root)) (dirs (projectile-get-project-directories project-root)) (subdirs (unless (equal dirs (list project-root)) (mapcar (lambda (d) (file-relative-name d project-root)) dirs)))) (projectile--alien-apply-ignores project-root vcs (projectile--dir-files-alien-maybe-async project-root vcs subdirs))) (let ((dirs (projectile-get-project-directories project-root))) (cond ((and (eq projectile-indexing-method 'hybrid) (cdr dirs)) ;; Hybrid + dirconfig `+' keep entries: batch the ;; external command into a single invocation with ;; the kept subdirectories as pathspecs, then run ;; projectile-adjust-files once over the combined ;; result. Avoids one shell-out per kept directory. (let* ((vcs (projectile-project-vcs project-root)) (subdirs (mapcar (lambda (d) (file-relative-name d project-root)) dirs))) (projectile-adjust-files project-root vcs (projectile--dir-files-alien-maybe-async project-root vcs subdirs)))) (t ;; Native, or hybrid without keep entries: walk each ;; project directory. For native this is the only ;; implementation; for hybrid+single-dir it's ;; equivalent to the batched call above. (mapcan (lambda (dir) (let ((files (projectile-dir-files dir project-root))) ;; `projectile-dir-files' already returns paths ;; relative to DIR, so when DIR is the project root ;; itself (the single-directory case - native, or ;; hybrid without keep entries) re-relativising every ;; path against PROJECT-ROOT is a no-op. Skip it ;; rather than pay a `file-relative-name' per file. (if (string= dir project-root) files (mapcar (lambda (f) (file-relative-name (concat dir f) project-root)) files)))) dirs)))))) ;; Save the cached list. (when projectile-enable-caching (projectile-cache-project project-root files) ;; Close the `Indexing...' notice opened above. The manual asks ;; for this pairing, and without it a long index leaves the echo ;; area claiming to still be working. (message "Indexing %s...done" project-root))) ;;; Sorting ;; ;; Files can't be cached in sorted order as some sorting schemes ;; require dynamic data. Sorting is ignored completely when in ;; alien mode. (if (eq projectile-indexing-method 'alien) files (projectile-sort-files files)))) (defun projectile-current-project-files () "Return a list of the files in the current project." (projectile-project-files (projectile-acquire-root))) (defun projectile-process-current-project-files (action) "Process the current project's files using ACTION." (let ((project-files (projectile-current-project-files)) (default-directory (projectile-project-root))) (dolist (filename project-files) (funcall action filename)))) (defun projectile-project-dirs (project) "Return a list of dirs for PROJECT." (seq-uniq (delq nil (mapcan #'projectile--directory-ancestors (projectile-project-files project))))) (defun projectile--directory-ancestors (path) "Return a list of the directory of PATH and all its ancestor directories. For example, \"src/foo/bar.el\" returns (\"src/\" \"src/foo/\")." (let ((dir (file-name-directory path)) result) (while (and dir (not (equal dir ""))) (push dir result) (let ((parent (file-name-directory (directory-file-name dir)))) (setq dir (unless (equal parent dir) parent)))) result)) (defun projectile-current-project-dirs () "Return a list of dirs for the current project." (projectile-project-dirs (projectile-acquire-root))) (defun projectile-get-other-files (file-name &optional flex-matching) "Return a list of other files for FILE-NAME. The list depends on `:related-files-fn' project option and `projectile-other-file-alist'. For the latter, FLEX-MATCHING can be used to match any basename." (if-let* ((plist (projectile--related-files-plist-by-kind file-name :other))) (projectile--related-files-from-plist plist) (projectile--other-extension-files file-name (projectile-current-project-files) flex-matching))) (defun projectile--find-other-file (&optional flex-matching ff-variant) "Switch between files with the same name but different extensions. With FLEX-MATCHING, match any file that contains the base name of current file. Other file extensions can be customized with the variable `projectile-other-file-alist'. With FF-VARIANT set to a defun, use that instead of `find-file'. A typical example of such a defun would be `find-file-other-window' or `find-file-other-frame'" (let ((ff (or ff-variant #'find-file)) (other-files (projectile-get-other-files (buffer-file-name) flex-matching))) (if other-files (let ((file-name (projectile--choose-from-candidates other-files :caller 'projectile-read-file))) (funcall ff (expand-file-name file-name (projectile-project-root)))) (user-error "No other file found")))) ;;; Interactive commands ;;;###autoload (defun projectile-find-other-file (&optional flex-matching) "Switch between files with the same name but different extensions. With FLEX-MATCHING, match any file that contains the base name of current file. Other file extensions can be customized with the variable `projectile-other-file-alist'." (interactive "P") (projectile--find-other-file flex-matching)) ;;;###autoload (autoload 'projectile-find-other-file-other-window "projectile" nil t) ;;;###autoload (autoload 'projectile-find-other-file-other-frame "projectile" nil t) (projectile--define-display-variants projectile-find-other-file (&optional flex-matching) "Switch between files with different extensions in other %s. Switch between files with the same name but different extensions in another %s. With FLEX-MATCHING, match any file that contains the base name of current file. Other file extensions can be customized with the variable `projectile-other-file-alist'." (projectile--find-other-file flex-matching #'find-file-other-window)) (defun projectile--file-name-sans-extensions (file-name) "Return FILE-NAME sans any extensions. The extensions, in a filename, are what follows the first '.', with the exception of a leading '.'" (setq file-name (file-name-nondirectory file-name)) (substring file-name 0 (string-match "\\..*" file-name 1))) (defun projectile--file-name-extensions (file-name) "Return FILE-NAME's extensions. The extensions, in a filename, are what follows the first '.', with the exception of a leading '.'" ;;would it make sense to return nil instead of an empty string if no extensions are found? (setq file-name (file-name-nondirectory file-name)) (let (extensions-start) (substring file-name (if (setq extensions-start (string-match "\\..*" file-name 1)) (1+ extensions-start) (length file-name))))) (defun projectile-associated-file-name-extensions (file-name) "Return projectile-other-file-extensions associated to FILE-NAME's extensions. If no associated other-file-extensions for the complete (nested) extension are found, remove subextensions from FILENAME's extensions until a match is found." (let ((current-extensions (projectile--file-name-extensions (file-name-nondirectory file-name))) associated-extensions) (catch 'break (while (not (string= "" current-extensions)) (if (setq associated-extensions (alist-get current-extensions projectile-other-file-alist nil nil #'equal)) (throw 'break associated-extensions)) (setq current-extensions (projectile--file-name-extensions current-extensions)))))) (defun projectile--other-extension-files (current-file project-file-list &optional flex-matching) "Narrow to files with the same names but different extensions. Returns a list of possible files for users to choose. With FLEX-MATCHING, match any file that contains the base name of current file" (let* ((file-ext-list (projectile-associated-file-name-extensions current-file)) (fulldirname (if (file-name-directory current-file) (file-name-directory current-file) "./")) (dirname (file-name-nondirectory (directory-file-name fulldirname))) (filename (regexp-quote (projectile--file-name-sans-extensions current-file))) (file-list (mapcar (lambda (ext) (if flex-matching (concat ".*" filename ".*" "\\." ext "\\'") (concat "^" filename (unless (equal ext "") (concat "\\." ext)) "\\'"))) file-ext-list)) (candidates (seq-filter (lambda (project-file) (string-match filename project-file)) project-file-list)) (candidates (flatten-tree (mapcar (lambda (file) (seq-filter (lambda (project-file) (string-match file (concat (file-name-base project-file) (when (file-name-extension project-file) (concat "." (file-name-extension project-file)))))) candidates)) file-list))) (candidates (seq-filter (lambda (file) (not (backup-file-name-p file))) candidates)) (sibling-dir-p (lambda (file) (let ((candidate-dirname (file-name-nondirectory (directory-file-name (or (file-name-directory file) "./"))))) (and (not (equal fulldirname (file-name-directory file))) (equal dirname candidate-dirname))))) (candidates (append (seq-filter sibling-dir-p candidates) (seq-remove sibling-dir-p candidates)))) candidates)) (defun projectile-select-files (project-files &optional invalidate-cache) "Select a list of files based on filename at point. With a prefix arg INVALIDATE-CACHE invalidates the cache first." (projectile-maybe-invalidate-cache invalidate-cache) (let* ((file (if (region-active-p) (buffer-substring (region-beginning) (region-end)) (or (thing-at-point 'filename) ""))) (file (if (string-match "\\.?\\./" file) (file-relative-name (file-truename file) (projectile-project-root)) file)) (files (if file (seq-filter (lambda (project-file) (string-search file project-file)) project-files) nil))) files)) (defun projectile--find-file-dwim (invalidate-cache &optional ff-variant) "Jump to a project's files using completion based on context. With a INVALIDATE-CACHE invalidates the cache first. With FF-VARIANT set to a defun, use that instead of `find-file'. A typical example of such a defun would be `find-file-other-window' or `find-file-other-frame' Subroutine for `projectile-find-file-dwim' and `projectile-find-file-dwim-other-window'" (let* ((project-root (projectile-acquire-root)) (project-files (projectile-project-files project-root)) (files (projectile-select-files project-files invalidate-cache)) (sort-function (projectile--frecency-sort-function project-root)) (file (cond ((= (length files) 1) (car files)) ((length> files 1) (projectile-completing-read "Switch to: " files :caller 'projectile-read-file :sort-function sort-function)) (t (projectile-completing-read "Switch to: " project-files :caller 'projectile-read-file :sort-function sort-function)))) (ff (or ff-variant #'find-file))) (funcall ff (expand-file-name file project-root)) (run-hooks 'projectile-find-file-hook))) ;;;###autoload (defun projectile-find-file-dwim (&optional invalidate-cache) "Jump to a project's files using completion based on context. With a prefix arg INVALIDATE-CACHE invalidates the cache first. If point is on a filename, Projectile first tries to search for that file in project: - If it finds just a file, it switches to that file instantly. This works even if the filename is incomplete, but there's only a single file in the current project that matches the filename at point. For example, if there's only a single file named \"projectile/projectile.el\" but the current filename is \"projectile/proj\" (incomplete), `projectile-find-file-dwim' still switches to \"projectile/projectile.el\" immediately because this is the only filename that matches. - If it finds a list of files, the list is displayed for selecting. A list of files is displayed when a filename appears more than one in the project or the filename at point is a prefix of more than two files in a project. For example, if `projectile-find-file-dwim' is executed on a filepath like \"projectile/\", it lists the content of that directory. If it is executed on a partial filename like \"projectile/a\", a list of files with character \"a\" in that directory is presented. - If it finds nothing, display a list of all files in project for selecting." (interactive "P") (projectile--find-file-dwim invalidate-cache)) ;;;###autoload (autoload 'projectile-find-file-dwim-other-window "projectile" nil t) ;;;###autoload (autoload 'projectile-find-file-dwim-other-frame "projectile" nil t) (projectile--define-display-variants projectile-find-file-dwim (&optional invalidate-cache) "Jump to a project's files based on context, opening them in another %s. With a prefix arg INVALIDATE-CACHE invalidates the cache first. See `projectile-find-file-dwim' for the details of how the file at point is used to narrow down the candidates." (projectile--find-file-dwim invalidate-cache #'find-file-other-window)) (defun projectile--find-file (invalidate-cache &optional ff-variant) "Jump to a project's file using completion. With INVALIDATE-CACHE invalidates the cache first. With FF-VARIANT set to a defun, use that instead of `find-file'. A typical example of such a defun would be `find-file-other-window' or `find-file-other-frame'" (interactive "P") (projectile-maybe-invalidate-cache invalidate-cache) (let* ((project-root (projectile-acquire-root)) (file (projectile-completing-read "Find file: " (projectile-project-files project-root) :caller 'projectile-read-file :sort-function (projectile--frecency-sort-function project-root))) (ff (or ff-variant #'find-file))) (when file (funcall ff (expand-file-name file project-root)) (run-hooks 'projectile-find-file-hook)))) ;;;###autoload (defun projectile-find-file (&optional invalidate-cache) "Jump to a project's file using completion. With a prefix arg INVALIDATE-CACHE invalidates the cache first." (interactive "P") (projectile--find-file invalidate-cache)) ;;;###autoload (autoload 'projectile-find-file-other-window "projectile" nil t) ;;;###autoload (autoload 'projectile-find-file-other-frame "projectile" nil t) (projectile--define-display-variants projectile-find-file (&optional invalidate-cache) "Jump to a project's file using completion and show it in another %s. With a prefix arg INVALIDATE-CACHE invalidates the cache first." (projectile--find-file invalidate-cache #'find-file-other-window)) ;;;###autoload (defun projectile-find-file-all () "Jump to any file in the project, ignoring VCS and projectile ignore rules. This lists all files under the project root using a generic file listing command (fd or find), bypassing `.gitignore', `.projectile', and other ignore mechanisms." (interactive) (let* ((project-root (projectile-acquire-root)) (all-files (projectile-files-via-ext-command project-root projectile-generic-command)) (file (projectile-completing-read "Find file (all): " all-files :caller 'projectile-read-file))) (when file (find-file (expand-file-name file project-root)) (run-hooks 'projectile-find-file-hook)))) ;;;###autoload (defun projectile-toggle-project-read-only () "Toggle project read only." (interactive) (let ((inhibit-read-only t) (val (not buffer-read-only)) (default-directory (projectile-acquire-root))) (save-selected-window (add-dir-local-variable nil 'buffer-read-only val) (save-buffer) (kill-buffer)) (when buffer-file-name (read-only-mode (if val +1 -1)) (message "[%s] read-only-mode is %s" (projectile-project-name) (if val "on" "off"))))) ;;;###autoload (defun projectile-add-dir-local-variable (mode variable value) "Run `add-dir-local-variable' with .dir-locals.el in root of project. Parameters MODE VARIABLE VALUE are passed directly to `add-dir-local-variable'." (let ((inhibit-read-only t) (default-directory (projectile-acquire-root))) (save-selected-window (add-dir-local-variable mode variable value) (save-buffer) (kill-buffer)))) ;;;###autoload (defun projectile-delete-dir-local-variable (mode variable) "Run `delete-dir-local-variable' with .dir-locals.el in root of project. Parameters MODE VARIABLE VALUE are passed directly to `delete-dir-local-variable'." (let ((inhibit-read-only t) (default-directory (projectile-acquire-root))) (save-selected-window (delete-dir-local-variable mode variable) (save-buffer) (kill-buffer)))) ;;;; Sorting project files (defun projectile-sort-files (files) "Sort FILES according to `projectile-sort-order'." (pcase projectile-sort-order ('default files) ('recentf (projectile-sort-by-recentf-first files)) ('recently-active (projectile-sort-by-recently-active-first files)) ('modification-time (projectile-sort-by-modification-time files)) ('access-time (projectile-sort-by-access-time files)) ((pred functionp) (funcall projectile-sort-order files)) ;; An unrecognized value must not return nil - that would present ;; the project as empty. (_ files))) (defun projectile--sort-prioritized-first (prioritized files) "Return FILES with the members of PRIORITIZED first, in order. Membership is tracked in a hash set, so the cost stays linear in the length of FILES." (let ((seen (make-hash-table :test 'equal :size (length prioritized)))) (dolist (file prioritized) (puthash file t seen)) (append prioritized (seq-remove (lambda (file) (gethash file seen)) files)))) (defun projectile-sort-by-recentf-first (files) "Sort FILES by a recent first scheme." (projectile--sort-prioritized-first (projectile-recentf-files) files)) (defun projectile-sort-by-recently-active-first (files) "Sort FILES by most recently active buffers or opened files." (projectile--sort-prioritized-first (projectile-recently-active-files) files)) (defun projectile-sort-by-modification-time (files) "Sort FILES by modification time." (let ((default-directory (projectile-project-root)) (mtimes (make-hash-table :test 'equal :size (length files)))) (dolist (file files) (let ((attrs (file-attributes file))) (puthash file (if attrs (file-attribute-modification-time attrs) 0) mtimes))) (seq-sort (lambda (file1 file2) (not (time-less-p (gethash file1 mtimes) (gethash file2 mtimes)))) files))) (defun projectile-sort-by-access-time (files) "Sort FILES by access time." (let ((default-directory (projectile-project-root)) (atimes (make-hash-table :test 'equal :size (length files)))) (dolist (file files) (let ((attrs (file-attributes file))) (puthash file (if attrs (file-attribute-access-time attrs) 0) atimes))) (seq-sort (lambda (file1 file2) (not (time-less-p (gethash file1 atimes) (gethash file2 atimes)))) files))) ;;;; Find directory in project functionality (defun projectile--find-dir (invalidate-cache &optional dired-variant) "Jump to a project's directory using completion. With INVALIDATE-CACHE invalidates the cache first. With DIRED-VARIANT set to a defun, use that instead of `dired'. A typical example of such a defun would be `dired-other-window' or `dired-other-frame'" (projectile-maybe-invalidate-cache invalidate-cache) (let* ((project (projectile-acquire-root)) (dir (projectile-complete-dir project)) (dired-v (or dired-variant #'dired))) (funcall dired-v (expand-file-name dir project)) (run-hooks 'projectile-find-dir-hook))) ;;;###autoload (defun projectile-find-dir (&optional invalidate-cache) "Jump to a project's directory using completion. With a prefix arg INVALIDATE-CACHE invalidates the cache first." (interactive "P") (projectile--find-dir invalidate-cache)) ;;;###autoload (autoload 'projectile-find-dir-other-window "projectile" nil t) ;;;###autoload (autoload 'projectile-find-dir-other-frame "projectile" nil t) (projectile--define-display-variants projectile-find-dir (&optional invalidate-cache) "Jump to a project's directory in other %s using completion. With a prefix arg INVALIDATE-CACHE invalidates the cache first." (projectile--find-dir invalidate-cache #'dired-other-window)) (defun projectile-complete-dir (project) (let ((project-dirs (projectile-project-dirs project))) (projectile-completing-read "Find dir: " (if projectile-find-dir-includes-top-level (append '("./") project-dirs) project-dirs) :caller 'projectile-read-directory))) ;;;###autoload (defun projectile-find-test-file (&optional invalidate-cache) "Jump to a project's test file using completion. With a prefix arg INVALIDATE-CACHE invalidates the cache first." (interactive "P") (projectile-maybe-invalidate-cache invalidate-cache) (let ((file (projectile-completing-read "Find test file: " (projectile-current-project-test-files) :caller 'projectile-read-file))) (find-file (expand-file-name file (projectile-project-root))))) (defun projectile-test-files (files) "Return only the test FILES." (seq-filter 'projectile-test-file-p files)) (defun projectile--merge-related-files-fns (related-files-fns) "Merge multiple RELATED-FILES-FNS into one function." (lambda (path) (let (merged-plist) (dolist (fn related-files-fns merged-plist) (let ((plist (funcall fn path))) (cl-loop for (key value) on plist by #'cddr do (let ((values (if (consp value) value (list value)))) (setq merged-plist (plist-put merged-plist key (append (plist-get merged-plist key) values)))))))))) (defun projectile--related-files-plist (project-root file) "Return a plist containing all related files information for FILE. PROJECT-ROOT is the project root." (if-let* ((rel-path (if (file-name-absolute-p file) (file-relative-name file project-root) file)) (custom-function (funcall projectile-related-files-function (projectile-project-type)))) (funcall (cond ((functionp custom-function) custom-function) ((consp custom-function) (projectile--merge-related-files-fns custom-function)) (t (error "Unsupported value type of :related-files-fn"))) rel-path))) (defun projectile--related-files-plist-by-kind (file kind) "Return a plist containing :paths and/or :predicate of KIND for FILE." (if-let* ((project-root (projectile-project-root)) (plist (projectile--related-files-plist project-root file)) (has-kind? (plist-member plist kind))) (let* ((kind-value (plist-get plist kind)) (values (if (or (stringp kind-value) (functionp kind-value)) (list kind-value) kind-value)) (paths (seq-uniq (seq-filter 'stringp values))) (predicates (seq-uniq (seq-filter 'functionp values)))) (append ;; Make sure that :paths exists even with nil if there is no predicates (when (or paths (null predicates)) (list :paths (seq-filter (lambda (f) (projectile-file-exists-p (projectile-expand-file-name-wildcard f project-root))) paths))) (when predicates (list :predicate (if (= 1 (length predicates)) (car predicates) (lambda (other-file) (seq-some (lambda (predicate) (funcall predicate other-file)) predicates))))))))) (defun projectile--related-files-from-plist (plist) "Return a list of files matching to PLIST from current project files." (let* ((predicate (plist-get plist :predicate)) (paths (plist-get plist :paths))) (seq-uniq (append paths (when predicate (seq-filter predicate (projectile-current-project-files))))))) (defun projectile--related-files-kinds(file) "Return a list of keywords meaning available related kinds for FILE." (if-let* ((project-root (projectile-project-root)) (plist (projectile--related-files-plist project-root file))) (cl-loop for key in plist by #'cddr collect key))) (defun projectile--related-files (file kind) "Return a list of related files of KIND for FILE." (projectile--related-files-from-plist (projectile--related-files-plist-by-kind file kind))) (defun projectile--find-related-file (file &optional kind) "Choose a file from files related to FILE as KIND. If KIND is not provided, a list of possible kinds can be chosen." (unless kind (if-let* ((available-kinds (projectile--related-files-kinds file))) (setq kind (if (= (length available-kinds) 1) (car available-kinds) (intern (projectile-completing-read "Kind :" available-kinds :caller 'projectile-read-file)))) (user-error "No related files found"))) (if-let* ((candidates (projectile--related-files file kind))) (projectile-expand-root (projectile--choose-from-candidates candidates :caller 'projectile-read-file)) (error "No matching related file as `%s' found for project type `%s'" kind (projectile-project-type)))) ;;;###autoload (autoload 'projectile-find-related-file-other-window "projectile" nil t) ;;;###autoload (autoload 'projectile-find-related-file-other-frame "projectile" nil t) (projectile--define-display-variants projectile-find-related-file () "Open related file in other %s." (find-file-other-window (projectile--find-related-file (buffer-file-name)))) ;;;###autoload (defun projectile-find-related-file() "Open related file." (interactive) (find-file (projectile--find-related-file (buffer-file-name)))) ;;;###autoload (defun projectile-related-files-fn-groups(kind groups) "Generate a related-files-fn which relates as KIND for files in each of GROUPS." (lambda (path) (if-let* ((group-found (seq-find (lambda (group) (member path group)) groups))) (list kind (remove path group-found))))) ;;;###autoload (defun projectile-related-files-fn-extensions(kind extensions) "Generate a related-files-fn which relates as KIND for files having EXTENSIONS." (lambda (path) (let* ((ext (file-name-extension path)) (basename (file-name-base path)) (basename-regexp (regexp-quote basename))) (when (member ext extensions) (list kind (lambda (other-path) (and (string-match-p basename-regexp other-path) (equal basename (file-name-base other-path)) (let ((other-ext (file-name-extension other-path))) (and (member other-ext extensions) (not (equal other-ext ext))))))))))) ;;;###autoload (defun projectile-related-files-fn-test-with-prefix(extension test-prefix) "Generate a related-files-fn which relates tests and impl. Use files with EXTENSION based on TEST-PREFIX." (lambda (path) (when (equal (file-name-extension path) extension) (let* ((file-name (file-name-nondirectory path)) (find-impl? (string-prefix-p test-prefix file-name)) (file-name-to-find (if find-impl? (substring file-name (length test-prefix)) (concat test-prefix file-name)))) (list (if find-impl? :impl :test) (lambda (other-path) (and (string-suffix-p file-name-to-find other-path) (equal (file-name-nondirectory other-path) file-name-to-find)))))))) ;;;###autoload (defun projectile-related-files-fn-test-with-suffix(extension test-suffix) "Generate a related-files-fn which relates tests and impl. Use files with EXTENSION based on TEST-SUFFIX." (lambda (path) (when (equal (file-name-extension path) extension) (let* ((file-name (file-name-nondirectory path)) (dot-ext (concat "." extension)) (suffix-ext (concat test-suffix dot-ext)) (find-impl? (string-suffix-p suffix-ext file-name)) (file-name-to-find (if find-impl? (concat (substring file-name 0 (- (length suffix-ext))) dot-ext) (concat (substring file-name 0 (- (length dot-ext))) suffix-ext)))) (list (if find-impl? :impl :test) (lambda (other-path) (and (string-suffix-p file-name-to-find other-path) (equal (file-name-nondirectory other-path) file-name-to-find)))))))) ;;; File kinds ;; ;; A "file kind" is a declarative description of one category of files a ;; project type has - Rails models, controllers and views; Django models, ;; views and urls; and so on. Kinds are declared with the `:file-kinds' ;; keyword of `projectile-register-project-type' as an alist of (KIND-NAME ;; . SPEC), where KIND-NAME is a keyword (e.g. `:model') and SPEC is a plist ;; describing which files belong to the kind and how to derive a shared ;; "resource key" from a file's path. Two files of different kinds are ;; *related* when their keys are equal, which is what powers ;; `projectile-toggle-related-file'; `projectile-find-file-of-kind' uses just ;; the membership test. The whole thing compiles down to an ordinary ;; related-files-fn (see `projectile--file-kinds-related-files-fn'), so it ;; rides on the existing kind-agnostic related-files machinery. (defun projectile--singularize (word) "Naively singularize the English noun WORD. Only the regular cases are handled: a trailing -ies becomes -y, a trailing -ses/-xes/-zes/-ches/-shes drops the -es, and any other trailing -s (but not -ss) is dropped. Irregular nouns (person/people, child/children, ...) and uncountables are returned unchanged, so this is adequate for deriving resource keys from Rails-style file names but is not a general-purpose inflector." (cond ((string-suffix-p "ies" word) (concat (substring word 0 -3) "y")) ((string-match-p "\\(s\\|x\\|z\\|ch\\|sh\\)es\\'" word) (substring word 0 -2)) ((and (string-suffix-p "s" word) (not (string-suffix-p "ss" word))) (substring word 0 -1)) (t word))) (defun projectile--pluralize (word) "Naively pluralize the English noun WORD. The mirror of `projectile--singularize', handling only the regular cases: a consonant followed by -y becomes -ies, an -s/-x/-z/-ch/-sh ending gains -es, and everything else gains -s. Irregular nouns are not handled." (cond ((string-match-p "[^aeiou]y\\'" word) (concat (substring word 0 -1) "ies")) ((string-match-p "\\(s\\|x\\|z\\|ch\\|sh\\)\\'" word) (concat word "es")) (t (concat word "s")))) ;;;; Reference file-kinds tables (Rails, Django) (defun projectile--rails-resource-key (rel-path prefix suffix) "Return the namespaced singular Rails resource key of REL-PATH. PREFIX is the resource root (e.g. \"app/controllers/\") and SUFFIX the file suffix (e.g. \"_controller.rb\"). Rails names controllers, helpers and views after the *plural* resource (e.g. \"users_controller.rb\"), while models use the singular (\"user.rb\"); singularizing the stripped name makes them share the model's key. Any namespace directories under PREFIX are preserved, so \"app/controllers/admin/users_controller.rb\" keys as \"admin/user\" and does not collide with a top-level \"users_controller.rb\". The singularizer is naive (see `projectile--singularize'), so irregular resource names will not relate correctly." (when (and (string-prefix-p prefix rel-path) (string-suffix-p suffix (file-name-nondirectory rel-path))) (let* ((subpath (substring rel-path (length prefix))) (dir (or (file-name-directory subpath) "")) (base (file-name-nondirectory subpath)) (resource (substring base 0 (- (length suffix))))) (concat dir (projectile--singularize resource))))) (defun projectile--rails-controller-key (rel-path) "Return the namespaced singular Rails resource key of the controller REL-PATH." (projectile--rails-resource-key rel-path "app/controllers/" "_controller.rb")) (defun projectile--rails-helper-key (rel-path) "Return the namespaced singular Rails resource key of the helper REL-PATH." (projectile--rails-resource-key rel-path "app/helpers/" "_helper.rb")) (defun projectile--rails-view-key (rel-path) "Return the namespaced singular Rails resource key of the view file REL-PATH. Rails views live in a per-resource directory (e.g. \"app/views/users/\"), so the key is that directory's path with its final segment singularized; \"app/views/admin/users/index.html.erb\" keys as \"admin/user\"." (when (string-prefix-p "app/views/" rel-path) (let ((rest (substring rel-path (length "app/views/")))) (when-let* (((string-match-p "/" rest)) (resource-dir (directory-file-name (file-name-directory rest)))) (concat (or (file-name-directory resource-dir) "") (projectile--singularize (file-name-nondirectory resource-dir))))))) (defun projectile--django-app-key (rel-path) "Return the Django app directory of REL-PATH. This is REL-PATH's parent directory (without a trailing slash), so \"polls/models.py\" keys as \"polls\" and a nested \"apps/polls/models.py\" keys as \"apps/polls\" without colliding with a different \"polls\" app." (when-let* ((dir (file-name-directory rel-path))) (directory-file-name dir))) (defun projectile--parent-directory-key (rel-path) "Return REL-PATH\\='s parent directory, without a trailing slash. A key for the frameworks that group a resource\\='s files in a directory rather than naming them after it, so \"polls/models.py\" keys as \"polls\" and a nested \"apps/polls/models.py\" as \"apps/polls\", without the two colliding." (when-let* ((dir (file-name-directory rel-path))) (directory-file-name dir))) (defalias 'projectile--django-app-key #'projectile--parent-directory-key "Return the Django app directory of a path. An alias for `projectile--parent-directory-key\\=', kept because the Django reference table named it.") (defun projectile--basename-key (rel-path suffix) "Return REL-PATH\\='s basename with SUFFIX removed, ignoring its directory. For the frameworks that name a resource\\='s files after it but scatter them across directories, so the directory can\\='t be part of the key." (let ((name (file-name-nondirectory rel-path))) (when (string-suffix-p suffix name) (substring name 0 (- (length suffix)))))) (defun projectile--phoenix-controller-key (rel-path) "Return the Phoenix resource key of the controller REL-PATH." (projectile--basename-key rel-path "_controller.ex")) (defun projectile--phoenix-html-key (rel-path) "Return the Phoenix resource key of the HTML module REL-PATH." (projectile--basename-key rel-path "_html.ex")) (defun projectile--phoenix-json-key (rel-path) "Return the Phoenix resource key of the JSON module REL-PATH." (projectile--basename-key rel-path "_json.ex")) (defun projectile--phoenix-view-key (rel-path) "Return the Phoenix resource key of the view REL-PATH (Phoenix 1.6)." (projectile--basename-key rel-path "_view.ex")) (defun projectile--phoenix-live-key (rel-path) "Return the Phoenix resource key of the LiveView REL-PATH." (projectile--basename-key rel-path "_live.ex")) (defvar projectile--phoenix-file-kinds '((:controller . (:suffix "_controller.ex" :key-fn projectile--phoenix-controller-key)) (:html . (:suffix "_html.ex" :key-fn projectile--phoenix-html-key)) (:json . (:suffix "_json.ex" :key-fn projectile--phoenix-json-key)) (:view . (:suffix "_view.ex" :key-fn projectile--phoenix-view-key)) (:live . (:suffix "_live.ex" :key-fn projectile--phoenix-live-key))) "Reference `:file-kinds\\=' table for Phoenix applications. Relates the modules of a resource by the name they share - user_controller.ex, user_html.ex, user_json.ex, user_live.ex - wherever under `lib/\\=' they live, since the web directory is named after the application. `:view\\=' is the Phoenix 1.6 spelling that `:html\\=' replaced in 1.7; a project will have one or the other.") (defun projectile--laravel-model-key (rel-path) "Return the Laravel resource key of the model REL-PATH." (projectile--basename-key rel-path ".php")) (defun projectile--laravel-controller-key (rel-path) "Return the Laravel resource key of the controller REL-PATH." (projectile--basename-key rel-path "Controller.php")) (defun projectile--laravel-factory-key (rel-path) "Return the Laravel resource key of the factory REL-PATH." (projectile--basename-key rel-path "Factory.php")) (defun projectile--laravel-seeder-key (rel-path) "Return the Laravel resource key of the seeder REL-PATH." (projectile--basename-key rel-path "Seeder.php")) (defun projectile--laravel-policy-key (rel-path) "Return the Laravel resource key of the policy REL-PATH." (projectile--basename-key rel-path "Policy.php")) (defvar projectile--laravel-file-kinds '((:model . (:path "app/Models/" :suffix ".php" :key-fn projectile--laravel-model-key)) (:controller . (:path "app/Http/Controllers/" :suffix "Controller.php" :key-fn projectile--laravel-controller-key)) (:factory . (:path "database/factories/" :suffix "Factory.php" :key-fn projectile--laravel-factory-key)) (:seeder . (:path "database/seeders/" :suffix "Seeder.php" :key-fn projectile--laravel-seeder-key)) (:policy . (:path "app/Policies/" :suffix "Policy.php" :key-fn projectile--laravel-policy-key))) "Reference `:file-kinds\\=' table for the Laravel project type. Relates the files named after an Eloquent model - User.php, UserController.php, UserFactory.php, UserSeeder.php, UserPolicy.php - by that class name. Blade views are deliberately left out: they live in snake_case plural directories while the classes are StudlyCase singular, so relating them would need inflection and case conversion, and would guess wrong often enough not to be worth it.") (defvar projectile--nextjs-file-kinds '((:page . (:prefix "page." :key-fn projectile--parent-directory-key)) (:layout . (:prefix "layout." :key-fn projectile--parent-directory-key)) (:loading . (:prefix "loading." :key-fn projectile--parent-directory-key)) (:error . (:prefix "error." :key-fn projectile--parent-directory-key)) (:route . (:prefix "route." :key-fn projectile--parent-directory-key))) "Reference `:file-kinds\\=' table for Next.js applications. The app router gives a route\\='s files fixed names in a shared directory - page, layout, loading, error, route - so the directory is the key. Each kind matches on the name plus its dot rather than a whole file name, so it covers whichever of .js, .jsx, .ts or .tsx the project uses without also matching something like `pageant.tsx\\='.") (defvar projectile--rails-file-kinds '((:model . (:path "app/models/")) (:controller . (:path "app/controllers/" :suffix "_controller.rb" :key-fn projectile--rails-controller-key)) (:view . (:path "app/views/" :key-fn projectile--rails-view-key)) (:helper . (:path "app/helpers/" :suffix "_helper.rb" :key-fn projectile--rails-helper-key))) "Reference `:file-kinds' table for Rails project types. Relates a resource's model, controller, views and helper by a shared singular key (e.g. app/models/user.rb, app/controllers/users_controller.rb, app/views/users/*, app/helpers/users_helper.rb). Plural-to-singular mapping is naive; see `projectile--singularize'.") (defvar projectile--django-file-kinds '((:model . (:suffix "models.py" :key-fn projectile--django-app-key)) (:view . (:suffix "views.py" :key-fn projectile--django-app-key)) (:urls . (:suffix "urls.py" :key-fn projectile--django-app-key)) (:admin . (:suffix "admin.py" :key-fn projectile--django-app-key)) (:tests . (:suffix "tests.py" :key-fn projectile--django-app-key))) "Reference `:file-kinds' table for the Django project type. Relates the per-app files of a Django application by the app directory name (e.g. polls/models.py, polls/views.py, polls/urls.py); no inflection is needed.") (defun projectile--file-kind-member-p (rel-path spec) "Return non-nil when REL-PATH belongs to the file kind described by SPEC. REL-PATH is a path relative to the project root. Membership holds when REL-PATH lives under SPEC's `:path' prefix (if any) and its basename matches SPEC's `:prefix' and `:suffix' (if any)." (let ((path (plist-get spec :path)) (prefix (plist-get spec :prefix)) (suffix (plist-get spec :suffix)) (name (file-name-nondirectory rel-path))) ;; `:path' is matched as a directory prefix, so \"app/models/\" does ;; not also match \"app/models_archive/x.rb\". (and (or (null path) (string-prefix-p (file-name-as-directory path) rel-path)) (or (null prefix) (string-prefix-p prefix name)) (or (null suffix) (string-suffix-p suffix name))))) (defun projectile--file-kind-default-key (rel-path spec) "Derive the default resource key of REL-PATH for the kind SPEC. The key is REL-PATH taken relative to SPEC's `:path', with the final component's `:suffix' (or, lacking that, its file extension) and `:prefix' stripped. Any namespace directories under `:path' are kept, so files that differ only by subdirectory get distinct keys. Return nil for an empty result." (let* ((path (plist-get spec :path)) (subpath (if (and path (string-prefix-p (file-name-as-directory path) rel-path)) (substring rel-path (length (file-name-as-directory path))) rel-path)) (dir (or (file-name-directory subpath) "")) (name (file-name-nondirectory subpath)) (prefix (plist-get spec :prefix)) (suffix (plist-get spec :suffix))) (when (and suffix (string-suffix-p suffix name)) (setq name (substring name 0 (- (length suffix))))) (unless suffix (setq name (file-name-sans-extension name))) (when (and prefix (string-prefix-p prefix name)) (setq name (substring name (length prefix)))) (unless (string-empty-p name) (concat dir name)))) (defun projectile--file-kind-key (rel-path spec) "Return REL-PATH's resource key for the kind SPEC, or nil. Uses SPEC's `:key-fn' when set, otherwise `projectile--file-kind-default-key'. A `:key-fn' that signals an error is treated as no match (nil), so one misbehaving user-supplied key-fn can't break related-file navigation for the whole project type." (if-let* ((key-fn (plist-get spec :key-fn))) (condition-case nil (funcall key-fn rel-path) (error nil)) (projectile--file-kind-default-key rel-path spec))) (defun projectile--file-kind-match (rel-path spec) "Return REL-PATH's resource key for the kind SPEC, or nil. REL-PATH matches the kind only when it is a member (see `projectile--file-kind-member-p') and its derived key is a non-empty string (so a `:key-fn' returning nil, an empty string or a non-string value simply doesn't match, rather than relating unrelated files)." (when (projectile--file-kind-member-p rel-path spec) (let ((key (projectile--file-kind-key rel-path spec))) (and (stringp key) (not (string-empty-p key)) key)))) (defun projectile--file-kinds-related-files-fn (file-kinds) "Compile FILE-KINDS into a related-files-fn. FILE-KINDS is an alist of (KIND . SPEC). KIND is a keyword and SPEC is a plist with the following optional properties: :path a root-relative directory prefix (e.g. \"app/models/\"). :prefix a basename prefix the file must have. :suffix a basename suffix the file must have (e.g. \"_controller.rb\"). :key-fn a function of the file's relative path returning its resource key string, or nil when the file is not of this kind. When omitted the key is derived by `projectile--file-kind-default-key'. The returned function, given a relative path, finds the first kind the path belongs to and emits, for every *other* kind, an entry \(:KIND PREDICATE) whose PREDICATE matches files of that kind sharing the same resource key." (lambda (rel-path) (let (this-kind this-key) (cl-dolist (entry file-kinds) (when-let* ((key (projectile--file-kind-match rel-path (cdr entry)))) (setq this-kind (car entry) this-key key) (cl-return))) (when this-kind (let (result) (dolist (entry file-kinds) (let ((kind (car entry)) (spec (cdr entry))) (unless (eq kind this-kind) (setq result (plist-put result kind (lambda (other-path) (equal this-key (projectile--file-kind-match other-path spec)))))))) result))))) (defun projectile--file-kinds () "Return the current project type's `:file-kinds' alist." (projectile-project-type-attribute (projectile-project-type) 'file-kinds)) (defun projectile--related-file-candidates (rel-path &optional file-kinds project-files) "Return an ordered alist of (KIND . FILE) related to REL-PATH. Each entry is a project file of a *different* kind than REL-PATH's own whose resource key equals REL-PATH's, listed in FILE-KINDS table order. FILE-KINDS defaults to the current project type's kinds and PROJECT-FILES to `projectile-current-project-files'. Return nil when REL-PATH is not of any known kind or has no related files." (let* ((file-kinds (or file-kinds (projectile--file-kinds))) (project-files (or project-files (projectile-current-project-files))) this-kind this-key candidates) (cl-dolist (entry file-kinds) (when-let* ((key (projectile--file-kind-match rel-path (cdr entry)))) (setq this-kind (car entry) this-key key) (cl-return))) (when this-kind (dolist (entry file-kinds (nreverse candidates)) (let ((kind (car entry)) (spec (cdr entry))) (unless (eq kind this-kind) (when-let* ((match (seq-find (lambda (f) (and (not (equal f rel-path)) (equal this-key (projectile--file-kind-match f spec)))) project-files))) (push (cons kind match) candidates)))))))) (defun projectile--related-file-ring (rel-path &optional file-kinds project-files) "Return the stable ring of files sharing REL-PATH's resource key. The ring holds one file per kind that has a match, in FILE-KINDS table order, with REL-PATH itself standing in for its own kind. Its order does not depend on which file in the ring REL-PATH is, so advancing from REL-PATH's position cycles through the related kinds deterministically. FILE-KINDS defaults to the current project type's kinds and PROJECT-FILES to `projectile-current-project-files'. Return nil when REL-PATH is not of any known kind." (let* ((file-kinds (or file-kinds (projectile--file-kinds))) (project-files (or project-files (projectile-current-project-files))) this-kind this-key ring) (cl-dolist (entry file-kinds) (when-let* ((key (projectile--file-kind-match rel-path (cdr entry)))) (setq this-kind (car entry) this-key key) (cl-return))) (when this-kind (dolist (entry file-kinds (nreverse ring)) (let ((kind (car entry)) (spec (cdr entry))) (if (eq kind this-kind) (push rel-path ring) (when-let* ((match (seq-find (lambda (f) (and (not (equal f rel-path)) (equal this-key (projectile--file-kind-match f spec)))) project-files))) (push match ring)))))))) (defun projectile--file-kind-name (kind) "Return the human-readable name of the file KIND keyword." (substring (symbol-name kind) 1)) (defun projectile--read-file-kind (prompt) "Read one of the current project type's file kinds using PROMPT. Return the chosen (KIND . SPEC) entry." (let ((file-kinds (projectile--file-kinds))) (unless file-kinds (user-error "Project type `%s' defines no file kinds" (projectile-project-type))) (let* ((names (mapcar (lambda (entry) (projectile--file-kind-name (car entry))) file-kinds)) (choice (projectile-completing-read prompt names :caller 'projectile-find-file-of-kind))) (assq (intern (concat ":" choice)) file-kinds)))) (defun projectile--find-file-of-kind (kind-entry &optional ff-variant) "Complete over project files of KIND-ENTRY and open the chosen one. KIND-ENTRY is a (KIND . SPEC) pair. With FF-VARIANT set to a defun, use that instead of `find-file' (e.g. `find-file-other-window')." (let* ((project-root (projectile-acquire-root)) (spec (cdr kind-entry)) (files (seq-filter (lambda (f) (projectile--file-kind-member-p f spec)) (projectile-project-files project-root))) (file (projectile-completing-read (format "Find %s: " (projectile--file-kind-name (car kind-entry))) files :caller 'projectile-find-file-of-kind :sort-function (projectile--frecency-sort-function project-root))) (ff (or ff-variant #'find-file))) (when file (funcall ff (expand-file-name file project-root)) (run-hooks 'projectile-find-file-hook)))) ;;;###autoload (defun projectile-find-file-of-kind (&optional invalidate-cache) "Jump to a project file of a chosen file kind using completion. Prompt for one of the current project type's file kinds (see the `:file-kinds' keyword of `projectile-register-project-type') and then complete over all project files belonging to that kind. With a prefix arg INVALIDATE-CACHE invalidates the cache first." (interactive "P") (projectile-maybe-invalidate-cache invalidate-cache) (projectile--find-file-of-kind (projectile--read-file-kind "Find file of kind: "))) ;;;###autoload (autoload 'projectile-find-file-of-kind-other-window "projectile" nil t) ;;;###autoload (autoload 'projectile-find-file-of-kind-other-frame "projectile" nil t) (projectile--define-display-variants projectile-find-file-of-kind () "Jump to a project file of a chosen file kind and show it in another %s." (projectile--find-file-of-kind (projectile--read-file-kind "Find file of kind: ") #'find-file-other-window)) (defun projectile--read-related-file-target (rel-path) "Prompt for one of REL-PATH's related file kinds and return its file." (let* ((candidates (projectile--related-file-candidates rel-path)) (names (mapcar (lambda (c) (projectile--file-kind-name (car c))) candidates)) (choice (projectile-completing-read "Related file kind: " names :caller 'projectile-toggle-related-file))) (alist-get (intern (concat ":" choice)) candidates))) ;;;###autoload (defun projectile-toggle-related-file () "Jump between the current file and its related files of other kinds. This is the file-kinds generalization of `projectile-toggle-between-implementation-and-test'. The current file's kind and resource key are detected from the project type's `:file-kinds' declaration and its related files (files of other kinds sharing the same key) are collected in table order. When exactly one related kind exists it is opened immediately; when several exist the first invocation prompts for the kind, and repeated invocations cycle through them in table order." (interactive) (let ((file (buffer-file-name))) (unless file (user-error "The current buffer is not visiting a file")) (let* ((project-root (projectile-acquire-root)) ;; Spell the file the same way as the root (symlink-resolved), so a ;; project reached through a symlinked root doesn't yield a bogus ;; `../'-prefixed relative name and a spurious "no related files". (rel-path (projectile--project-relative-name (file-truename file) project-root)) (ring (projectile--related-file-ring rel-path)) (others (remove rel-path ring))) (unless others (user-error "No related files found for `%s'" (file-name-nondirectory file))) (let ((target (cond ;; A single related kind: jump straight to it. ((= (length others) 1) (car others)) ;; Repeated invocation: cycle to the next kind in table order. ((eq last-command this-command) (let ((pos (or (seq-position ring rel-path) 0))) (nth (mod (1+ pos) (length ring)) ring))) ;; Several kinds, first invocation: let the user choose. (t (projectile--read-related-file-target rel-path))))) (find-file (expand-file-name target project-root)))))) (defun projectile-test-file-p (file) "Check if FILE is a test file." (let ((kinds (projectile--related-files-kinds file))) (cond ((member :impl kinds) t) ((member :test kinds) nil) (t (or (seq-some (lambda (pat) (string-prefix-p pat (file-name-nondirectory file))) (delq nil (list (funcall projectile-test-prefix-function (projectile-project-type))))) (seq-some (lambda (pat) (string-suffix-p pat (file-name-sans-extension (file-name-nondirectory file)))) (delq nil (list (funcall projectile-test-suffix-function (projectile-project-type)))))))))) (defun projectile-current-project-test-files () "Return a list of test files for the current project." (projectile-test-files (projectile-current-project-files))) ;;; Project types ;; ;; What a project type is - a set of markers that recognise it plus the ;; commands and conventions that follow - and the machinery for declaring ;; one. The types Projectile ships with are registered further down, in ;; their own section. (defvar projectile-project-types nil "An alist holding all project types that are known to Projectile. The project types are symbols and they are linked to plists holding the properties of the various project types.") (defun projectile--combine-plists (&rest plists) "Create a single property list from all plists in PLISTS. The process starts by copying the first list, and then setting properties from the other lists. Settings in the last list are the most significant ones and overrule settings in the other lists." (let ((rtn (copy-sequence (pop plists))) p v ls) (while plists (setq ls (pop plists)) (while ls (setq p (pop ls) v (pop ls)) (setq rtn (plist-put rtn p v)))) rtn)) (defun projectile--any-marker-p (marker) "Return non-nil when MARKER is an alternatives clause. Such a clause has the form (:any FILE...) and is satisfied by any one of its FILEs; see `projectile-register-project-type'." (and (consp marker) (eq (car marker) :any))) (defun projectile--marker-clauses (marker-files) "Return MARKER-FILES as a plain list of alternative-lists. A marker specification mixes two shapes - a bare file name and an \\(:any FILE...) clause - and every consumer used to take that apart for itself, which is how the project-file derivation came to understand a clause only in the first position. This is the one place that knows the shapes: it answers with a list whose every element is a list of names, any one of which satisfies that position. Returns nil for a predicate marker, which has no file names to give." (unless (functionp marker-files) (mapcar (lambda (clause) (if (projectile--any-marker-p clause) (cdr clause) (list clause))) (ensure-list marker-files)))) (cl-defun projectile--build-project-plist (marker-files &key project-file compilation-dir configure compile install package test run test-suffix test-prefix src-dir test-dir src-extension test-extension related-files-fn file-kinds tasks) "Return a project type plist built from MARKER-FILES and the keyword arguments. This is the shape a registered project type takes; the arguments, and what each of them means, are documented on `projectile-register-project-type', which is the entry point users call and where the description belongs. Both take the same keywords, so keeping a second copy here only bought two descriptions that could disagree - and by the time this was written, they already did." ;; When PROJECT-FILE isn't given explicitly, derive it from the first ;; marker file - that's the project's primary manifest in every ;; file-based registration, so callers needn't repeat it. Function ;; markers (a symbol or lambda) have no list to derive from. Passing ;; the symbol `none' opts out of both the derivation and the root-file ;; seeding below, for types (e.g. bloop) whose only marker also shows ;; up outside real projects and so must not anchor a project root. (let* ((project-file (cond ((eq project-file 'none) nil) ;; An alternatives clause is a marker shape, so accept it ;; here too and keep the plain list of names the rest of ;; the code expects. ((projectile--any-marker-p project-file) (cdr project-file)) (project-file project-file) ;; Otherwise the first marker position is the project file - ;; all of its alternatives, so each can anchor a root. (t (let ((first (car (projectile--marker-clauses marker-files)))) (cond ((null first) nil) ((cdr first) first) ((stringp (car first)) (car first))))))) (project-plist (list 'marker-files marker-files 'project-file project-file 'compilation-dir compilation-dir 'configure-command configure 'compile-command compile 'test-command test 'install-command install 'package-command package 'run-command run)) (project-files (if (listp project-file) project-file (list project-file)))) (dolist (project-file project-files) (when (and project-file (not (member project-file projectile-project-root-files))) (add-to-list 'projectile-project-root-files project-file))) (when test-suffix (plist-put project-plist 'test-suffix test-suffix)) (when test-prefix (plist-put project-plist 'test-prefix test-prefix)) (when src-dir (plist-put project-plist 'src-dir src-dir)) (when test-dir (plist-put project-plist 'test-dir test-dir)) (when src-extension (plist-put project-plist 'src-extension src-extension)) (when test-extension (plist-put project-plist 'test-extension test-extension)) (when related-files-fn (plist-put project-plist 'related-files-fn related-files-fn)) (when file-kinds (plist-put project-plist 'file-kinds file-kinds)) (when tasks (plist-put project-plist 'tasks tasks)) project-plist)) (cl-defun projectile-register-project-type (project-type marker-files &key project-file compilation-dir configure compile install package test run test-suffix test-prefix src-dir test-dir src-extension test-extension related-files-fn file-kinds tasks) "Register a project type with projectile. A project type is defined by PROJECT-TYPE, a set of MARKER-FILES, and optional keyword arguments. MARKER-FILES is either a list of files or a predicate function. When it is a list, ALL of the listed files must be present in the project root for the type to match (logical AND) - so a single-file marker like `(\"Foo\")' is the common case. A list element may itself be an alternatives clause of the form (:any FILE...), which is satisfied when any one of its FILEs is present, so `((:any \"build.gradle\" \"build.gradle.kts\"))' matches a project with either of them. For anything more involved, don't pass a list; use a predicate function instead. The predicate is called with the project root as its single argument and should return non-nil when the project is of this type. The optional keyword arguments are: PROJECT-FILE the main project file in the root project directory. It may be a single file or a list of possible files. When omitted it defaults to the first marker file, or to all the alternatives of the first marker clause. Pass the symbol `none' to opt out, so the type is detected but contributes no project-root marker (e.g. when its marker also appears outside real projects). COMPILATION-DIR the directory to run the tests- and compilations in, CONFIGURE which specifies a command that configures the project `%s' in the command will be substituted with (projectile-project-root) before the command is run, COMPILE which specifies a command that builds the project, INSTALL which specifies a command to install the project. PACKAGE which specifies a command to package the project. TEST which specifies a command that tests the project, RUN which specifies a command that runs the project, TEST-SUFFIX which specifies test file suffix, and TEST-PREFIX which specifies test file prefix. SRC-DIR which specifies the path to the source relative to the project root. TEST-DIR which specifies the path to the tests relative to the project root. SRC-EXTENSION which specifies the file extension implementation files use, when it differs from the one their tests use. TEST-EXTENSION which specifies the file extension test files use, when it differs from the implementation's (Elixir tests are scripts: `foo.ex\\=' is tested by `foo_test.exs\\='). RELATED-FILES-FN which specifies a custom function to find the related files such as test/impl/other files as below: CUSTOM-FUNCTION accepts FILE as relative path from the project root and returns a plist containing :test, :impl or :other as key and the relative path/paths or predicate as value. PREDICATE accepts a relative path as the input. FILE-KINDS an alist of (KIND . SPEC) declaratively describing the kinds of files the project type has (e.g. Rails models, controllers and views), used by `projectile-find-file-of-kind' and `projectile-toggle-related-file'. KIND is a keyword and SPEC is a plist; see `projectile--file-kinds-related-files-fn' for the supported properties. When both FILE-KINDS and RELATED-FILES-FN are set they are combined, so declarative and hand-written relations coexist. TASKS an alist of named tasks of the form (TASK-NAME . COMMAND) run via `projectile-run-task'; see `projectile-tasks' for the exact shape. All command strings (CONFIGURE, COMPILE, INSTALL, PACKAGE, TEST, RUN, and TASKS commands) support `%p' as a placeholder that will be replaced with the project name at execution time." (setq projectile-project-types (cons `(,project-type . ,(projectile--build-project-plist marker-files :project-file project-file :compilation-dir compilation-dir :configure configure :compile compile :install install :package package :test test :run run :test-suffix test-suffix :test-prefix test-prefix :src-dir src-dir :test-dir test-dir :src-extension src-extension :test-extension test-extension :related-files-fn related-files-fn :file-kinds file-kinds :tasks tasks)) projectile-project-types))) (cl-defun projectile-update-project-type (project-type &key precedence (marker-files nil marker-files-specified) (project-file nil project-file-specified) (compilation-dir nil compilation-dir-specified) (configure nil configure-specified) (compile nil compile-specified) (install nil install-specified) (package nil package-specified) (test nil test-specified) (run nil run-specified) (test-suffix nil test-suffix-specified) (test-prefix nil test-prefix-specified) (src-dir nil src-dir-specified) (test-dir nil test-dir-specified) (src-extension nil src-extension-specified) (test-extension nil test-extension-specified) (related-files-fn nil related-files-fn-specified) (file-kinds nil file-kinds-specified) (tasks nil tasks-specified)) "Update an existing projectile project type. Passed items will override existing values for the project type given by PROJECT-TYPE. nil can be used to remove a project type attribute. Raise an error if PROJECT-TYPE is not already registered with projectile. This function may also take the keyword argument PRECEDENCE which when set to `high' will make projectile prioritise this project type over other clashing project types, and a value of `low' will make projectile prefer (all) other project types by default. The remaining arguments - MARKER-FILES and the optional keyword arguments - have the same meaning as for `projectile-register-project-type', which see." (let* ((existing-project-plist (or (seq-find (lambda (p) (eq project-type (car p))) projectile-project-types) (error "No existing project found for: %s" project-type))) (new-plist (append (when marker-files-specified `(marker-files ,marker-files)) (when project-file-specified `(project-file ,project-file)) (when compilation-dir-specified `(compilation-dir ,compilation-dir)) (when configure-specified `(configure-command ,configure)) (when compile-specified `(compile-command ,compile)) (when test-specified `(test-command ,test)) (when install-specified `(install-command ,install)) (when package-specified `(package-command ,package)) (when run-specified `(run-command ,run)) (when test-suffix-specified `(test-suffix ,test-suffix)) (when test-prefix-specified `(test-prefix ,test-prefix)) (when src-dir-specified `(src-dir ,src-dir)) (when test-dir-specified `(test-dir ,test-dir)) (when src-extension-specified `(src-extension ,src-extension)) (when test-extension-specified `(test-extension ,test-extension)) (when related-files-fn-specified `(related-files-fn ,related-files-fn)) (when file-kinds-specified `(file-kinds ,file-kinds)) (when tasks-specified `(tasks ,tasks)))) (merged-plist (projectile--combine-plists (cdr existing-project-plist) new-plist)) (project-type-elt (cons project-type merged-plist))) (cl-flet* ((project-filter (p) (eq project-type (car p))) (project-map (p) (if (project-filter p) project-type-elt p))) (setq projectile-project-types (if precedence (let ((filtered-types (seq-remove #'project-filter projectile-project-types))) (setq projectile-project-type-cache (make-hash-table :test 'equal)) (cond ((eq precedence 'high) (cons project-type-elt filtered-types)) ((eq precedence 'low) (append filtered-types (list project-type-elt))) (t (error "Precedence must be one of '(high low)")))) (mapcar #'project-map projectile-project-types)))))) (defun projectile-remove-project-type (project-type) "Remove PROJECT-TYPE from the list of registered project types. This is the supported way to stop Projectile from auto-detecting a project type. Clearing the type's marker files instead does not work: an empty marker set is vacuously satisfied, so the type would match every project rather than none. Raise an error if PROJECT-TYPE is not currently registered. The project type cache is reset so the change takes effect immediately." (unless (seq-find (lambda (p) (eq project-type (car p))) projectile-project-types) (error "No existing project found for: %s" project-type)) (setq projectile-project-types (seq-remove (lambda (p) (eq project-type (car p))) projectile-project-types)) (setq projectile-project-type-cache (make-hash-table :test 'equal))) (defun projectile-eldev-project-p (&optional dir) "Check if a project contains eldev files. When DIR is specified it checks DIR's project, otherwise it acts on the current project." (or (projectile-verify-file "Eldev" dir) (projectile-verify-file "Eldev-local" dir))) (defun projectile-expand-file-name-wildcard (name-pattern dir) "Expand the maybe-wildcard-containing NAME-PATTERN in DIR. If there are results expanding a wildcard, get the first result, otherwise expand NAME-PATTERN in DIR ignoring wildcards." (let ((expanded (expand-file-name name-pattern dir))) (or (if (string-match-p "[[*?]" name-pattern) (car (ignore-errors (file-expand-wildcards expanded)))) expanded))) (defun projectile-cabal-project-p (&optional dir) "Check if a project contains *.cabal files but no stack.yaml file. When DIR is specified it checks DIR's project, otherwise it acts on the current project." (and (projectile-verify-file-wildcard "?*.cabal" dir) (not (projectile-verify-file "stack.yaml" dir)))) (defun projectile-dotnet-project-p (&optional dir) "Check if a project contains a .NET project marker. When DIR is specified it checks DIR's project, otherwise it acts on the current project." (or (projectile-verify-file-wildcard "?*.csproj" dir) (projectile-verify-file-wildcard "?*.fsproj" dir))) (defun projectile-dotnet-sln-project-p (&optional dir) "Check if a project contains a .NET solution project marker. When DIR is specified it checks DIR's project, otherwise it acts on the current project." (or (projectile-verify-file-wildcard "?*.sln" dir) (projectile-verify-file-wildcard "?*.slnx" dir))) (defun projectile-go-project-p (&optional dir) "Check if a project contains Go source files. When DIR is specified it checks DIR's project, otherwise it acts on the current project." (or (projectile-verify-file "go.mod" dir) (projectile-verify-file-wildcard "*.go" dir))) (defun projectile-make-project-p (&optional dir) "Check if a project contains a Makefile. Both `Makefile' and the lowercase `makefile' GNU make also reads are recognized. When DIR is specified it checks DIR's project, otherwise it acts on the current project." (or (projectile-verify-file "Makefile" dir) (projectile-verify-file "makefile" dir))) (defun projectile-mill-project-p (&optional dir) "Check if a project contains a mill build file. When DIR is specified it checks DIR's project, otherwise it acts on the current project." (or (projectile-verify-file "build.mill" dir) (projectile-verify-file "build.sc" dir))) ;; Remove in 4.0. The only project type with a detection hook of its own, ;; and only read when the `go' type was registered as this file loaded. ;; Re-registering the type is how every other type is customized. (defvar projectile-go-project-test-function #'projectile-go-project-p "Function to determine if project's type is go.") (make-obsolete-variable 'projectile-go-project-test-function "re-register the `go' project type with your own predicate instead." "3.4.0") (defun projectile-terraform-project-p (&optional dir) "Check if a project contains Terraform configuration files. When DIR is specified it checks DIR's project, otherwise it acts on the current project." (projectile-verify-file-wildcard "?*.tf" dir)) (defun projectile-xcode-project-p (&optional dir) "Check if a project contains an Xcode project or workspace. When DIR is specified it checks DIR's project, otherwise it acts on the current project." (or (projectile-verify-file-wildcard "?*.xcworkspace" dir) (projectile-verify-file-wildcard "?*.xcodeproj" dir))) (defun projectile-flutter-project-p (&optional dir) "Check if a project is a Flutter project. That's a Dart project whose `pubspec.yaml' depends on the Flutter SDK. When DIR is specified it checks DIR's project, otherwise it acts on the current project." (let ((pubspec (projectile-expand-root "pubspec.yaml" dir))) (and (projectile-file-exists-p pubspec) (with-temp-buffer (insert-file-contents pubspec) (and (re-search-forward "^[ \t]*sdk:[ \t]*flutter[ \t]*$" nil t) t))))) (defun projectile-nimble-project-p (&optional dir) "Check if a project contains a Nimble project marker. Nim projects that use Nimble contain a .nimble file. When DIR is specified it checks DIR's project, otherwise it acts on the current project." (projectile-verify-file-wildcard "?*.nimble" dir)) ;;;; Constant signifying opting out of CMake preset commands. (defconst projectile--cmake-no-preset "*no preset*") (defun projectile--cmake-version () "Compute CMake version." (let* ((string (shell-command-to-string "cmake --version")) (match (string-match "^cmake version \\([0-9]+\\.[0-9]+\\.[0-9]+\\).*$" string))) (when match (version-to-list (match-string 1 string))))) (defun projectile--cmake-check-version (version) "Check if CMake version is at least VERSION." (and (version-list-<= version (projectile--cmake-version)))) (defconst projectile--cmake-command-presets-minimum-version-alist '((:configure-command . (3 19)) (:compile-command . (3 20)) (:test-command . (3 20)) (:package-command . (3 19)) (:install-command . (3 20)))) (defun projectile--cmake-command-presets-supported (command-type) "Check if CMake supports presets for COMMAND-TYPE." (let ((minimum-version (alist-get command-type projectile--cmake-command-presets-minimum-version-alist))) (projectile--cmake-check-version minimum-version))) (defun projectile--cmake-read-preset (filename) "Read CMake preset from FILENAME." (projectile--read-json-file filename :array-type 'list)) (defconst projectile--cmake-command-preset-array-id-alist '((:configure-command . "configurePresets") (:compile-command . "buildPresets") (:test-command . "testPresets") (:package-command . "packagePresets") (:install-command . "buildPresets"))) (defun projectile--cmake-command-preset-array-id (command-type) "Map from COMMAND-TYPE to id of command preset array in CMake preset." (alist-get command-type projectile--cmake-command-preset-array-id-alist)) (defun projectile--cmake-command-presets-shallow (filename command-type) "Get CMake COMMAND-TYPE presets from FILENAME." (when-let* ((preset (projectile--cmake-read-preset (projectile-expand-root filename)))) (seq-remove (lambda (preset) (equal (gethash "hidden" preset) t)) (gethash (projectile--cmake-command-preset-array-id command-type) preset)))) (defun projectile--cmake-command-presets (filename command-type) "Get CMake COMMAND-TYPE presets from FILENAME. Follows included files." ;; Anchor FILENAME to the project root before taking its directory: ;; the top-level call passes a relative name, whose `file-name-directory' ;; is nil, and included files must resolve relative to the file that ;; includes them - not to `default-directory'. (let ((filename (projectile-expand-root filename))) (when-let* ((preset (projectile--cmake-read-preset filename))) (append (projectile--cmake-command-presets-shallow filename command-type) (mapcan (lambda (included-file) (projectile--cmake-command-presets (expand-file-name included-file (file-name-directory filename)) command-type)) (gethash "include" preset)))))) (defun projectile--cmake-all-command-presets (command-type) "Get CMake user and system COMMAND-TYPE presets." (flatten-tree (mapcar (lambda (filename) (projectile--cmake-command-presets filename command-type)) '("CMakeUserPresets.json" "CMakePresets.json")))) (defun projectile--cmake-command-preset-names (command-type) "Get names of CMake user and system COMMAND-TYPE presets." (mapcar (lambda (preset) (gethash "name" preset)) (projectile--cmake-all-command-presets command-type))) (defcustom projectile-enable-cmake-presets nil "Whether CMake projects use presets for their lifecycle commands. When non-nil, CMake projects are configured, built and tested through the presets their `CMakePresets.json' and `CMakeUserPresets.json' declare, rather than through Projectile's own default commands." :group 'projectile :type 'boolean :package-version '(projectile . "2.4.0")) (defun projectile--cmake-use-command-presets (command-type) "Test whether or not to use command presets for COMMAND-TYPE. Presets are used if `projectile-enable-cmake-presets' is non-nil, and CMake supports presets for COMMAND-TYPE, and `json-parse-buffer' is available." (and projectile-enable-cmake-presets (projectile--cmake-command-presets-supported command-type) (functionp 'json-parse-buffer))) (defun projectile--cmake-select-command (command-type) "Select a CMake command preset or a manual CMake command. The selection is done like this: - If `projectile--cmake-use-commands-presets' for COMMAND-TYPE returns true, and there is at least one preset available for COMMAND-TYPE, the user is prompted to select a name of a command preset, or opt a manual command by selecting `projectile--cmake-no-preset'. - Else `projectile--cmake-no-preset' is used." (if-let* ((use-presets (projectile--cmake-use-command-presets command-type)) (preset-names (projectile--cmake-command-preset-names command-type))) (projectile-completing-read "Use preset: " (append preset-names `(,projectile--cmake-no-preset)) :caller nil) projectile--cmake-no-preset)) (defconst projectile--cmake-manual-command-alist '((:configure-command . "cmake -S . -B build") (:compile-command . "cmake --build build") (:test-command . "cmake --build build --target test") (:package-command . "cmake --build build --target package") (:install-command . "cmake --build build --target install"))) (defun projectile--cmake-manual-command (command-type) "Create manual CMake COMMAND-TYPE command." (alist-get command-type projectile--cmake-manual-command-alist)) (defconst projectile--cmake-preset-command-alist '((:configure-command . "cmake . --preset %s") (:compile-command . "cmake --build --preset %s") (:test-command . "ctest --preset %s") (:package-command . "cpack --preset %s") (:install-command . "cmake --build --preset %s --target install"))) (defun projectile--cmake-preset-command (command-type preset) "Create CMake COMMAND-TYPE command using PRESET." (format (alist-get command-type projectile--cmake-preset-command-alist) preset)) (defun projectile--cmake-command (command-type) "Create a CMake COMMAND-TYPE command. The command is created like this: - If `projectile--cmake-select-command' returns `projectile--cmake-no-preset' a manual COMMAND-TYPE command is created with `projectile--cmake-manual-command'. - Else a preset COMMAND-TYPE command using the selected preset is created with `projectile--cmake-preset-command'." (let ((maybe-preset (projectile--cmake-select-command command-type))) (if (equal maybe-preset projectile--cmake-no-preset) (projectile--cmake-manual-command command-type) (projectile--cmake-preset-command command-type maybe-preset)))) (defun projectile--cmake-configure-command () "CMake configure command." (projectile--cmake-command :configure-command)) (defun projectile--cmake-compile-command () "CMake compile command." (projectile--cmake-command :compile-command)) (defun projectile--cmake-test-command () "CMake test command." (projectile--cmake-command :test-command)) (defun projectile--cmake-install-command () "CMake install command." (projectile--cmake-command :install-command)) (defun projectile--cmake-package-command () "CMake package command." (projectile--cmake-command :package-command)) (defconst projectile--justfile-names '("justfile" ".justfile" "Justfile") "The file names `just' reads its recipes from.") (defconst projectile--taskfile-names '("Taskfile.yml" "Taskfile.yaml" "Taskfile.dist.yml" "Taskfile.dist.yaml") "The file names go-task reads its tasks from.") (defconst projectile--makefile-names '("Makefile" "makefile" "GNUmakefile") "The file names GNU make reads its targets from.") (defconst projectile--rakefile-names '("Rakefile" "rakefile" "Rakefile.rb" "rakefile.rb") "The file names rake accepts as a project's main task file.") (defconst projectile--rake-task-directories '("rakelib" "tasks" "lib/tasks") "Directories a project keeps its extra `.rake' files in. `rakelib' is rake's own convention, `lib/tasks' is Rails\\='s, and `tasks' is what a lot of gems use.") (defconst projectile--deno-config-names '("deno.json" "deno.jsonc") "The file names Deno reads its configuration from.") (defconst projectile--bun-lock-names '("bun.lock" "bun.lockb") "The lock file names Bun writes - the text one and the older binary one.") ;;; The project types Projectile ships with ;; ;; Project type detection happens in a reverse order with respect to ;; project type registration (invocations of `projectile-register-project-type'). ;; ;; As function-based project type detection is pretty slow, it ;; should be tried at the end if everything else failed (meaning here ;; it should be listed first). ;; ;; Ideally common project types should be checked earlier than exotic ones. ;; Function-based detection project type (projectile-register-project-type 'haskell-cabal #'projectile-cabal-project-p :compile "cabal build" :test "cabal test" :run "cabal run" :test-suffix "Spec") (projectile-register-project-type 'dotnet #'projectile-dotnet-project-p :project-file '("?*.csproj" "?*.fsproj") :compile "dotnet build" :run "dotnet run" :test "dotnet test") (projectile-register-project-type 'dotnet-sln #'projectile-dotnet-sln-project-p :project-file '("?*.sln" "?*.slnx") :compile "dotnet build" :run "dotnet run" :test "dotnet test") (projectile-register-project-type 'terraform #'projectile-terraform-project-p :project-file "?*.tf" :configure "terraform init" :compile "terraform plan" :run "terraform apply" :test "terraform validate") (projectile-register-project-type 'xcode #'projectile-xcode-project-p :project-file '("?*.xcworkspace" "?*.xcodeproj") :compile "xcodebuild build" :test "xcodebuild test") (projectile-register-project-type 'nim-nimble #'projectile-nimble-project-p :project-file "?*.nimble" :compile "nimble --noColor build --colors:off" :install "nimble --noColor install --colors:off" :test "nimble --noColor test -d:nimUnittestColor:off --colors:off" :run "nimble --noColor run --colors:off" :src-dir "src" :test-dir "tests") ;; File-based detection project types ;; Infrastructure as code ;; ;; These are registered first, and so checked last: a repository that ;; deploys itself with Helm or Compose is usually some other kind of ;; project first, and only falls back to these when nothing else matched. (projectile-register-project-type 'docker-compose '((:any "compose.yaml" "compose.yml" "docker-compose.yaml" "docker-compose.yml")) :compile "docker compose build" :run "docker compose up") (projectile-register-project-type 'ansible '("ansible.cfg") :test "ansible-lint") (projectile-register-project-type 'helm '("Chart.yaml") :compile "helm template ." :install "helm install" :test "helm lint") (projectile-register-project-type 'pulumi '("Pulumi.yaml") :compile "pulumi preview" :run "pulumi up") ;; Generic task runners ;; ;; Like the infrastructure types these are a fallback: a justfile or a ;; mise config usually sits next to a project's real build tool, which ;; should win. (projectile-register-project-type 'mise '((:any "mise.toml" ".mise.toml")) :compile "mise run build" :test "mise run test") (projectile-register-project-type 'just `((:any ,@projectile--justfile-names)) :compile "just build" :test "just test") ;; Universal (projectile-register-project-type 'xmake '("xmake.lua") :compile "xmake build" :test "xmake test" :run "xmake run" :install "xmake install") (projectile-register-project-type 'scons '("SConstruct") :compile "scons" :test "scons test" :test-suffix "test") (projectile-register-project-type 'meson '("meson.build") :compilation-dir "build" :configure "meson %s" :compile "ninja" :test "ninja test") (projectile-register-project-type 'nix '("default.nix") :compile "nix-build" :test "nix-build") (projectile-register-project-type 'nix-flake '("flake.nix") :compile "nix build" :test "nix flake check" :run "nix run") ;; `MODULE.bazel' is what Bazel 8+ uses by default (bzlmod); `WORKSPACE' ;; and `WORKSPACE.bazel' are the older, now removed, dependency model. (projectile-register-project-type 'bazel '((:any "MODULE.bazel" "WORKSPACE" "WORKSPACE.bazel")) :compile "bazel build //..." :test "bazel test //..." :run "bazel run") (projectile-register-project-type 'buck2 '(".buckconfig") :compile "buck2 build //..." :test "buck2 test //...") (projectile-register-project-type 'pants '("pants.toml") :compile "pants package ::" :test "pants test ::") (projectile-register-project-type 'debian '("debian/control") :compile "debuild -uc -us") ;; Make & CMake ;; The Makefile/makefile alternatives predate the `(:any ...)' marker ;; clause and still go through a predicate, since that predicate is part ;; of the public API. The explicit :project-file keeps "Makefile" ;; registered as a root file, as the marker list used to do. (projectile-register-project-type 'make #'projectile-make-project-p :project-file "Makefile" :compile "make" :test "make test" :install "make install") (projectile-register-project-type 'gnumake '("GNUmakefile") :compile "make" :test "make test" :install "make install") (projectile-register-project-type 'cmake '("CMakeLists.txt") :configure #'projectile--cmake-configure-command :compile #'projectile--cmake-compile-command :test #'projectile--cmake-test-command :install #'projectile--cmake-install-command :package #'projectile--cmake-package-command) ;; go-task/task (projectile-register-project-type 'go-task `((:any ,@projectile--taskfile-names)) :compile "task build" :test "task test" :install "task install") ;; Go should take higher precedence than Make because Go projects often have a Makefile. (projectile-register-project-type 'go #'projectile-go-project-p ;; The type is detected by predicate (a ;; project can be Go without a go.mod), but ;; the module file is still what marks a Go ;; project's root - and its subprojects. :project-file "go.mod" :compile "go build" :test "go test ./..." :test-suffix "_test") ;; Erlang & Elixir (projectile-register-project-type 'rebar '("rebar.config") :compile "rebar3 compile" :test "rebar3 do eunit,ct" :run "rebar3 shell" :install "rebar3 release" :package "rebar3 tar" :src-dir "src/" :test-dir "test/" :test-suffix "_SUITE") ;; erlang.mk is the other common Erlang build tool; it drives everything ;; through make, so the commands are make targets. (projectile-register-project-type 'erlang-mk '("erlang.mk") :compile "make" :test "make tests" :run "make run" :src-dir "src/" :test-dir "test/" :test-suffix "_SUITE") (projectile-register-project-type 'elixir '("mix.exs") :file-kinds projectile--phoenix-file-kinds :compile "mix compile" :src-dir "lib/" :test "mix test" :test-suffix "_test" ;; ExUnit tests are scripts, so `lib/foo.ex' ;; is tested by `test/foo_test.exs'. :src-extension "ex" :test-extension "exs") ;; Gleam (projectile-register-project-type 'gleam '("gleam.toml") :compile "gleam build" :test "gleam test" :run "gleam run" :src-dir "src/" :test-dir "test/" :test-suffix "_test") ;; JavaScript ;; A bare `package.json' with no lock file next to it is still a Node ;; project - this is the fallback for all the more specific types below. (projectile-register-project-type 'node '("package.json") :compile "npm install" :test "npm test" :run "npm start" :test-suffix ".test") (projectile-register-project-type 'grunt '("Gruntfile.js") :compile "grunt" :test "grunt test") (projectile-register-project-type 'gulp '("gulpfile.js") :compile "gulp" :test "gulp test") (projectile-register-project-type 'npm '("package.json" "package-lock.json") :compile "npm install && npm run build" :test "npm test" :test-suffix ".test") (projectile-register-project-type 'yarn '("package.json" "yarn.lock") :compile "yarn && yarn build" :test "yarn test" :test-suffix ".test") (projectile-register-project-type 'pnpm '("package.json" "pnpm-lock.yaml") :compile "pnpm install && pnpm build" :test "pnpm test" :test-suffix ".test") ;; `bun.lockb' is the binary lock file Bun used before 1.2, `bun.lock' the ;; text one it writes now. (projectile-register-project-type 'bun `("package.json" (:any ,@projectile--bun-lock-names)) :compile "bun install" :test "bun test" :run "bun run start" :test-suffix ".test") (projectile-register-project-type 'deno `((:any ,@projectile--deno-config-names)) :compile "deno check ." :test "deno test" :run "deno task start" :test-suffix "_test") ;; Angular ;; `angular.json' is Angular 6+, `.angular-cli.json' the older spelling - ;; a project has one or the other, never both. (projectile-register-project-type 'angular '((:any "angular.json" ".angular-cli.json")) :compile "ng build" :run "ng serve" :test "ng test" :test-suffix ".spec") ;; JavaScript monorepo tools, which sit on top of one of the package ;; managers above and are what you actually build and test through. (projectile-register-project-type 'nextjs '((:any "next.config.js" "next.config.mjs" "next.config.ts")) :compile "next build" :test "npm test" :run "next dev" :test-suffix ".test" :file-kinds projectile--nextjs-file-kinds) (projectile-register-project-type 'nx '("nx.json") :compile "npx nx run-many -t build" :test "npx nx run-many -t test" :test-suffix ".spec") (projectile-register-project-type 'turborepo '("turbo.json") :compile "turbo build" :test "turbo test" :test-suffix ".test") ;; PHP ;; Like Rails, these have to be registered after the JavaScript types - ;; a PHP application ships a package.json for its front-end assets, which ;; would otherwise make it a Node project. (projectile-register-project-type 'php-composer '("composer.json") :compile "composer install" :test "vendor/bin/phpunit" :src-dir "src/" :test-dir "tests/" :test-suffix "Test") ;; Symfony 3 dropped the `app' directory and moved the console to `bin', ;; and `vendor' is only there once someone has run composer, so neither ;; can be required. The console is what tells a Symfony project apart ;; from any other composer one. (projectile-register-project-type 'php-symfony '("composer.json" (:any "bin/console" "app/console")) :compile "composer install" :run "symfony serve" :test "vendor/bin/phpunit" :src-dir "src/" :test-dir "tests/" :test-suffix "Test") (projectile-register-project-type 'php-laravel '("composer.json" "artisan") :file-kinds projectile--laravel-file-kinds :compile "composer install" :run "php artisan serve" :test "php artisan test" :src-dir "app/" :test-dir "tests/" :test-suffix "Test") ;; Static site and documentation generators ;; These come after the JavaScript types, as a site's asset pipeline ;; often brings a package.json along. (projectile-register-project-type 'jekyll '("_config.yml") :compile "bundle exec jekyll build" :run "bundle exec jekyll serve") ;; Zola's marker is a plain `config.toml', which is far too common a file ;; name to let it anchor a project root on its own. (projectile-register-project-type 'zola '("config.toml" "content") :project-file 'none :compile "zola build" :run "zola serve") (projectile-register-project-type 'hugo '((:any "hugo.toml" "hugo.yaml" "hugo.json")) :compile "hugo" :run "hugo server") (projectile-register-project-type 'mkdocs '("mkdocs.yml") :compile "mkdocs build" :run "mkdocs serve") (projectile-register-project-type 'quarto '("_quarto.yml") :compile "quarto render" :run "quarto preview") ;; Python ;; ;; Nearly every Python project carries a `pyproject.toml' these days, and ;; most carry a `requirements.txt' or a `setup.py' too, so the generic ;; manifests are registered first (and thus checked last). What tells ;; the projects apart is the tool-specific lock file on top, and the ;; framework beats the packaging tool. (projectile-register-project-type 'python-pip '("requirements.txt") :compile "pip install -r requirements.txt" :test "python -m unittest discover" :test-prefix "test_" :test-suffix "_test") (projectile-register-project-type 'python-pkg '("setup.py") :compile "python -m build" :test "python -m unittest discover" :test-prefix "test_" :test-suffix "_test") (projectile-register-project-type 'python-toml '("pyproject.toml") :compile "python -m build" :test "python -m unittest discover" :test-prefix "test_" :test-suffix "_test") (projectile-register-project-type 'python-tox '("tox.ini") :compile "tox -r --notest" :test "tox" :test-prefix "test_" :test-suffix "_test") (projectile-register-project-type 'python-pipenv '("Pipfile") :compile "pipenv run build" :test "pipenv run test" :test-prefix "test_" :test-suffix "_test") (projectile-register-project-type 'python-poetry '("poetry.lock") :compile "poetry build" :test "poetry run pytest" :test-prefix "test_" :test-suffix "_test") (projectile-register-project-type 'python-pdm '("pdm.lock") :compile "pdm build" :install "pdm install" :test "pdm run pytest" :test-prefix "test_" :test-suffix "_test") (projectile-register-project-type 'python-uv '("uv.lock") :compile "uv build" :install "uv sync" :test "uv run pytest" :test-prefix "test_" :test-suffix "_test") (projectile-register-project-type 'django '("manage.py") :compile "python manage.py collectstatic" :run "python manage.py runserver" :test "python manage.py test" :test-prefix "test_" :test-suffix "_test" :file-kinds projectile--django-file-kinds) ;; Java & friends (projectile-register-project-type 'maven '("pom.xml") :compile "mvn -B clean install" :test "mvn -B test" :test-suffix "Test" :src-dir "src/main/" :test-dir "src/test/") ;; The Kotlin DSL (`.kts') is what new Gradle builds use, and the root of ;; a multi-project build may carry only a settings file. (projectile-register-project-type 'gradle '((:any "build.gradle" "build.gradle.kts" "settings.gradle" "settings.gradle.kts")) :compile "gradle build" :test "gradle test" :test-suffix "Spec") (projectile-register-project-type 'gradlew '("gradlew") :compile "./gradlew build" :test "./gradlew test" :test-suffix "Spec") (projectile-register-project-type 'grails '("application.yml" "grails-app") :compile "grails package" :test "grails test-app" :test-suffix "Spec") ;; Scala (projectile-register-project-type 'sbt '("build.sbt") :src-dir "main" :test-dir "test" :compile "sbt compile" :test "sbt test" :test-suffix "Spec") (projectile-register-project-type 'mill #'projectile-mill-project-p :project-file '("build.sc" "build.mill") :src-dir "src/" :test-dir "test/src/" :compile "mill __.compile" :test "mill __.test" :test-suffix "Test") ;; Bloop drops a `.bloop/bloop.settings.json' in the project, but its ;; server also keeps one in `$HOME', so the marker must not anchor a ;; project root (see #1901) - only drive type detection. (projectile-register-project-type 'bloop '(".bloop/bloop.settings.json") :project-file 'none :compile "bloop compile root" :test "bloop test --propagate --reporter scalac root" :src-dir "src/main/" :test-dir "src/test/" :test-suffix "Spec") (projectile-register-project-type 'scala-cli '("project.scala") :compile "scala-cli compile ." :test "scala-cli test ." :run "scala-cli run ." :test-suffix "Test") ;; Clojure (projectile-register-project-type 'lein-test '("project.clj") :compile "lein compile" :test "lein test" :test-suffix "_test") (projectile-register-project-type 'lein-midje '("project.clj" ".midje.clj") :compile "lein compile" :test "lein midje" :test-prefix "t_") (projectile-register-project-type 'boot-clj '("build.boot") :compile "boot aot" :test "boot test" :test-suffix "_test") (projectile-register-project-type 'clojure-cli '("deps.edn") :test-suffix "_test") ;; Babashka's tasks are project-specific, so there are no commands to ;; default to - `bb tasks' lists whatever a project defines. (projectile-register-project-type 'babashka '("bb.edn") :src-dir "src/" :test-dir "test/" :test-suffix "_test") ;; Ruby (projectile-register-project-type 'ruby-rspec '("Gemfile" "lib" "spec") :compile "bundle exec rake" :src-dir "lib/" :test "bundle exec rspec" :test-dir "spec/" :test-suffix "_spec") (projectile-register-project-type 'ruby-test '("Gemfile" "lib" "test") :compile "bundle exec rake" :src-dir "lib/" :test "bundle exec rake test" :test-suffix "_test") ;; Rails needs to be registered after npm, otherwise `package.json` makes it `npm`. ;; https://github.com/bbatsov/projectile/pull/1191 (projectile-register-project-type 'rails-test '("Gemfile" "app" "lib" "db" "config" "test") :compile "bundle exec rake" :run "bundle exec rails server" :src-dir "app/" :test "bundle exec rake test" :test-suffix "_test" :file-kinds projectile--rails-file-kinds) (projectile-register-project-type 'rails-rspec '("Gemfile" "app" "lib" "db" "config" "spec") :compile "bundle exec rake" :run "bundle exec rails server" :src-dir "app/" :test "bundle exec rspec" :test-dir "spec/" :test-suffix "_spec" :file-kinds projectile--rails-file-kinds) ;; Crystal (projectile-register-project-type 'crystal-spec '("shard.yml") :src-dir "src/" :test "crystal spec" :test-dir "spec/" :test-suffix "_spec") ;; Emacs (projectile-register-project-type 'emacs-cask '("Cask") :compile "cask install" :test-prefix "test-" :test-suffix "-test") (projectile-register-project-type 'emacs-eask '("Eask") :compile "eask install" :test "eask test" :test-prefix "test-" :test-suffix "-test") (projectile-register-project-type 'emacs-eldev #'projectile-eldev-project-p :project-file "Eldev" :compile "eldev compile" :test "eldev test" :run "eldev emacs" :package "eldev package") ;; R (projectile-register-project-type 'r '("DESCRIPTION") :compile "R CMD INSTALL --with-keep.source ." :test (concat "R CMD check -o " temporary-file-directory " .")) ;; Haskell (projectile-register-project-type 'haskell-stack '("stack.yaml") :compile "stack build" :test "stack build --test" :test-suffix "Spec") ;; Rust (projectile-register-project-type 'rust-cargo '("Cargo.toml") :compile "cargo build" :test "cargo test" :run "cargo run") ;; Racket (projectile-register-project-type 'racket '("info.rkt") :test "raco test ." :install "raco pkg install" :package "raco pkg create --source $(pwd)") ;; Dart (projectile-register-project-type 'dart '("pubspec.yaml") :compile "dart pub get" :test "dart test" :run "dart run" :src-dir "lib/" :test-dir "test/" :test-suffix "_test.dart") ;; Flutter projects are Dart projects, so this has to come after `dart'. (projectile-register-project-type 'flutter #'projectile-flutter-project-p :project-file "pubspec.yaml" :compile "flutter build" :test "flutter test" :run "flutter run" :src-dir "lib/" :test-dir "test/" :test-suffix "_test") ;; Elm (projectile-register-project-type 'elm '("elm.json") :compile "elm make") ;; Julia (projectile-register-project-type 'julia '("Project.toml") :compile "julia --project=@. -e 'import Pkg; Pkg.precompile(); Pkg.build()'" :test "julia --project=@. -e 'import Pkg; Pkg.test()' --check-bounds=yes" :src-dir "src" :test-dir "test") ;; OCaml (projectile-register-project-type 'ocaml-dune '("dune-project") :compile "dune build" :test "dune runtest" :run "dune exec" :install "dune install" :package "dune build @install" :src-dir "lib/" :test-dir "test/") ;; Zig ;; `build.zig' is the build script; `build.zig.zon' only shows up once a ;; project declares dependencies or a package name. (projectile-register-project-type 'zig '((:any "build.zig" "build.zig.zon")) :compile "zig build" :test "zig build test" :run "zig build run") ;; Swift (projectile-register-project-type 'swift-spm '("Package.swift") :compile "swift build" :test "swift test" :run "swift run") ;; D (projectile-register-project-type 'dub '((:any "dub.json" "dub.sdl")) :compile "dub build" :test "dub test" :run "dub run" :src-dir "source/") ;; Fortran (projectile-register-project-type 'fpm '("fpm.toml") :compile "fpm build" :test "fpm test" :run "fpm run" :src-dir "src/" :test-dir "test/") ;; Ada (projectile-register-project-type 'alire '("alire.toml") :compile "alr build" :test "alr test" :run "alr run" :src-dir "src/" :test-dir "tests/") ;; Solidity (projectile-register-project-type 'foundry '("foundry.toml") :compile "forge build" :test "forge test" :src-dir "src/" :test-dir "test/" :test-suffix ".t") ;; Godot (projectile-register-project-type 'godot '("project.godot") :run "godot --path .") ;; Embedded (projectile-register-project-type 'platformio '("platformio.ini") :compile "pio run" :install "pio run -t upload" :test "pio test" :src-dir "src/" :test-dir "test/") (defvar-local projectile-project-type nil "Buffer local var for overriding the auto-detected project type. Normally you'd set this from .dir-locals.el.") (put 'projectile-project-type 'safe-local-variable #'symbolp) (defun projectile-detect-project-type (&optional dir project-root) "Detect the type of the project. When DIR is specified it detects its project type, otherwise it acts on the current project. PROJECT-ROOT, if provided, is used for caching instead of re-resolving via `projectile-project-root'. Fallback to a generic project type when the type can't be determined." ;; Resolve the root up front so function markers receive it (they used to ;; get DIR, which is nil when detecting the current project's type - see ;; #1909) and so the cache key below reuses the same value. (let* ((project-root (or project-root (projectile-project-root dir))) ;; List the root once and answer plain-name markers from the ;; listing. Detection walks every registered type (50+), and the ;; vast majority use plain-name markers in the root, so this turns ;; "one stat per marker per type" into a single `directory-files' ;; call - a big win on the first detection of a remote project. (entry-set (and project-root (projectile--directory-entry-set project-root))) (project-type (or (car (seq-find (lambda (project-type-record) (let ((project-type (car project-type-record)) (marker (plist-get (cdr project-type-record) 'marker-files))) (if (functionp marker) (and (funcall marker project-root) project-type) ;; An empty marker set is vacuously satisfied by ;; `projectile-verify-files' (`seq-every-p' over nil ;; is t), which would make the type match every ;; project. Guard against it so clearing a type's ;; markers disables detection instead of inverting it. (and marker (projectile-verify-files marker dir entry-set) project-type)))) projectile-project-types)) 'generic))) (puthash project-root project-type projectile-project-type-cache) project-type)) (defun projectile-project-type (&optional dir) "Determine a project's type based on its structure. When DIR is specified it checks it, otherwise it acts on the current project. The project type is cached for improved performance." (or (and (not dir) projectile-project-type) (if-let* ((project-root (projectile-project-root dir))) (or (gethash project-root projectile-project-type-cache) (projectile-detect-project-type dir project-root))))) ;;;###autoload (defun projectile-project-info () "Display info for current project." (interactive) (message "Project: %s (%s, %s)" (projectile-acquire-root) (projectile-project-type) (projectile-project-vcs))) (defun projectile-verify-files (files &optional dir entry-set) "Check whether all FILES exist in the project. An element of FILES may also be an alternatives clause of the form \(:any FILE...), which is satisfied when any one of its FILEs exists. When DIR is specified it checks DIR's project, otherwise it acts on the current project. ENTRY-SET, when non-nil, is a hash set of the project root's immediate entries (see `projectile--directory-entry-set') used to answer plain-name FILES without a filesystem round-trip each." (seq-every-p (lambda (alternatives) (seq-some (lambda (file) (projectile-verify-file file dir entry-set)) alternatives)) (projectile--marker-clauses files))) (defun projectile-verify-file (file &optional dir entry-set) "Check whether FILE exists in the current project. When DIR is specified it checks DIR's project, otherwise it acts on the current project. ENTRY-SET, when non-nil, is a hash set of the project root's immediate entries. A plain-name FILE (one sitting directly in the root) is then answered by membership in ENTRY-SET instead of a filesystem stat; a FILE carrying a path separator can't be and falls back to `projectile-file-exists-p'." (if (and entry-set (not (string-match-p "/" file))) (and (gethash file entry-set) t) (projectile-file-exists-p (projectile-expand-root file dir)))) (defun projectile-verify-file-wildcard (file &optional dir) "Check whether FILE exists in the current project. When DIR is specified it checks DIR's project, otherwise it acts on the current project. Expands wildcards using `file-expand-wildcards' before checking." (file-expand-wildcards (projectile-expand-root file dir))) (define-obsolete-variable-alias 'projectile--vcs-markers 'projectile-vcs-markers "3.1.0") (defcustom projectile-vcs-markers '((".git" . git) (".hg" . hg) (".fslckout" . fossil) ("_FOSSIL_" . fossil) (".bzr" . bzr) ("_darcs" . darcs) (".pijul" . pijul) (".svn" . svn) (".sl" . sapling) (".jj" . jj) (".osc" . osc)) "Alist of (MARKER . VCS) pairs probed by `projectile-project-vcs'. The order only breaks ties between markers in the same directory - during the upward walk the nearest marker directory always wins. The main reason to customize this is colocated repositories: a repository created with `jj git init' contains both `.jj' and `.git', and moving `.jj' first makes such projects detect as `jj'. Unknown VCS symbols are fine - file listing falls back to the generic command and `projectile-vc' to `vc-dir' - so new markers can be added here without any other configuration. VCS detection is cached per project; run `projectile-invalidate-cache' after changing this for it to affect already-visited projects." :group 'projectile :type '(alist :key-type (string :tag "Marker") :value-type (symbol :tag "VCS")) :package-version '(projectile . "3.1.0")) (defun projectile--vcs-from-directory-listing (directory) "Return the VCS symbol matching a marker directly inside DIRECTORY. Issues a single `directory-files' call rather than one `file-exists-p' per marker - over TRAMP that turns 10 sequential remote round-trips into one." (when-let* ((entry-set (projectile--directory-entry-set directory))) (cl-some (lambda (cell) (and (gethash (car cell) entry-set) (cdr cell))) projectile-vcs-markers))) (defun projectile-project-vcs (&optional project-root) "Determine the VCS used by the project if any. PROJECT-ROOT is the targeted directory. If nil, use the variable `projectile-project-root'. Results are cached in `projectile-project-vcs-cache' (cleared by `projectile-invalidate-cache')." (or project-root (setq project-root (projectile-acquire-root))) (let ((cached (gethash project-root projectile-project-vcs-cache 'unset))) (if (not (eq cached 'unset)) cached (let ((vcs (or ;; first we check for a VCS marker in the project root itself (projectile--vcs-from-directory-listing project-root) ;; then we check if there's a VCS marker up the directory tree ;; that covers the case when a project is part of a ;; multi-project repository - in those cases you can still ;; use the VCS to get a list of files for the project in ;; question. All markers are checked together via a single ;; predicate so each ancestor directory is listed at most ;; once instead of up to 10 times. (let ((found nil)) (projectile-locate-dominating-file project-root (lambda (dir) (setq found (projectile--vcs-from-directory-listing dir)))) found) 'none))) (puthash project-root vcs projectile-project-vcs-cache) vcs)))) ;;; Git helpers ;; ;; Reading git for things other than the file listing: which files differ, ;; which branch a checkout is on, where the repository's shared directory ;; is. These are consumed by the repository identity, the worktree lookup, ;; the dashboard and `projectile-find-changed-file' alike, which is why they ;; live next to the VCS detection rather than inside any one of them. (defun projectile--git (root &rest args) "Run git with ARGS in ROOT and return its output, or nil when it fails. No shell is involved, and the call would go through TRAMP for a remote ROOT - which is why the callers make sure never to reach here with one. `--no-optional-locks' keeps a dashboard opened on project switch from taking the index lock and rewriting the index behind the user's back." (let ((default-directory root)) (with-temp-buffer (when (eql 0 (ignore-errors (apply #'process-file "git" nil '(t nil) nil "--no-optional-locks" args))) (buffer-string))))) (defun projectile--git-toplevel (root) "Return the toplevel of the git repository containing ROOT, or nil." (when-let* ((top (projectile--git root "rev-parse" "--show-toplevel"))) (file-name-as-directory (file-truename (string-trim top))))) (defun projectile--git-relativize (paths root toplevel) "Return PATHS, given relative to TOPLEVEL, relative to ROOT instead. Git reports porcelain and diff paths relative to the repository root regardless of where it was run, so a project sitting below that root needs them translated - and anything outside the project dropped." (if (equal (file-truename root) toplevel) paths (delq nil (mapcar (lambda (path) (let ((absolute (expand-file-name path toplevel)) (root (file-truename root))) (when (string-prefix-p root absolute) (file-relative-name absolute root)))) paths)))) (defun projectile--git-status-changed-files (root) "Return the paths git reports as changed in ROOT\\='s working tree. Covers staged, unstaged and untracked files, as repository-relative paths. A rename occupies two NUL-separated fields - the new name and then the old one - so those are consumed in step rather than the old name being mistaken for another changed file." (when-let* ((output (projectile--git root "status" "--porcelain" "-z" "--untracked-files=all"))) (let ((records (split-string output "\0" t)) files) (while records (let ((record (pop records))) ;; "XY PATH", with X and Y the index and worktree status codes. (when (> (length record) 3) (let ((status (substring record 0 2)) (path (substring record 3))) (push path files) ;; A rename or copy carries the source path in the next field. (when (string-match-p "[RC]" status) (pop records)))))) (nreverse files)))) (defun projectile-git-changed-files (root &optional base) "Return the files changed in the project at ROOT, relative to it. Without BASE that is the working tree: everything staged, unstaged or untracked. With BASE - a branch, tag or any other revision - it is everything that differs from it, plus the files not yet tracked at all, which is what \"show me what this branch changed\" usually means. Only git is supported; any other version control system returns nil." (when (eq (projectile-project-vcs root) 'git) (when-let* ((toplevel (projectile--git-toplevel root))) (let ((paths (if base (append (when-let* ((diff (projectile--git root "diff" "--name-only" "-z" base))) (split-string diff "\0" t)) (when-let* ((new (projectile--git root "ls-files" "-z" "--others" "--exclude-standard"))) (split-string new "\0" t))) (projectile--git-status-changed-files root)))) (seq-uniq (projectile--git-relativize paths root toplevel)))))) (defun projectile--read-git-ref (root) "Read a git revision to compare against, completing over ROOT\\='s branches." (let ((branches (when-let* ((output (projectile--git root "for-each-ref" "--format=%(refname:short)" "refs/heads" "refs/remotes"))) (split-string output "\n" t)))) (completing-read "Compare against: " branches nil nil nil nil (car (member "main" branches))))) ;;;###autoload (defun projectile-find-changed-file (&optional arg) "Jump to a file changed in the current project. That is everything git reports as staged, unstaged or untracked. With a prefix ARG you are asked for a revision to compare against instead - a branch, say - and the candidates become everything that differs from it, which is the \"what did this branch touch\" list. Only git projects are supported." (interactive "P") (let* ((root (projectile-acquire-root)) (base (when arg (projectile--read-git-ref root)))) (unless (eq (projectile-project-vcs root) 'git) (user-error "`projectile-find-changed-file' needs a git project")) (let ((files (projectile-git-changed-files root base))) (unless files (user-error "No changed files in %s%s" root (if base (format " compared to %s" base) ""))) (find-file (expand-file-name (projectile-completing-read (if base (format "Changed vs %s: " base) "Changed file: ") files :caller 'projectile-find-changed-file) root)) (run-hooks 'projectile-find-file-hook)))) ;;; Implementation and test counterparts ;; ;; Finding the test that goes with a source file and back again. A project ;; type can describe the correspondence by prefix/suffix, by source and test ;; directories, or with a `:related-files-fn' of its own; the fallbacks below ;; are what runs when it describes nothing. (defun projectile--test-name-for-impl-name (impl-file-path) "Determine the name of the test file for IMPL-FILE-PATH. IMPL-FILE-PATH may be an absolute path, relative path or a file name." (let* ((project-type (projectile-project-type)) (impl-file-name (file-name-sans-extension (file-name-nondirectory impl-file-path))) (impl-file-ext (file-name-extension impl-file-path)) (test-prefix (funcall projectile-test-prefix-function project-type)) (test-suffix (funcall projectile-test-suffix-function project-type)) ;; A test usually carries the implementation's extension; a type ;; that says otherwise (Elixir's scripts) is taken at its word. (test-file-ext (or (projectile-test-extension project-type) impl-file-ext))) (cond (test-prefix (concat test-prefix impl-file-name "." test-file-ext)) (test-suffix (concat impl-file-name test-suffix "." test-file-ext)) (t (user-error "Cannot determine a test file name, one of \"test-suffix\" or \"test-prefix\" must be set for project type `%s'" project-type))))) (defun projectile--impl-name-for-test-name (test-file-path) "Determine the name of the implementation file for TEST-FILE-PATH. TEST-FILE-PATH may be an absolute path, relative path or a file name." (let* ((project-type (projectile-project-type)) (test-file-name (file-name-sans-extension (file-name-nondirectory test-file-path))) (test-file-ext (file-name-extension test-file-path)) (test-prefix (funcall projectile-test-prefix-function project-type)) (test-suffix (funcall projectile-test-suffix-function project-type)) (impl-file-ext (or (projectile-src-extension project-type) test-file-ext))) (cond (test-prefix (concat (string-remove-prefix test-prefix test-file-name) "." impl-file-ext)) (test-suffix (concat (string-remove-suffix test-suffix test-file-name) "." impl-file-ext)) (t (user-error "Cannot determine an implementation file name, one of \"test-suffix\" or \"test-prefix\" must be set for project type `%s'" project-type))))) (defun projectile--test-to-impl-dir (test-dir-path) "Return the directory path of an impl file with test file in TEST-DIR-PATH. Occurrences of the current project type's test-dir property (which should be a string) are replaced with the current project type's src-dir property (which should be a string) to obtain the new directory. Nil is returned if either the src-dir or test-dir properties are not strings." (let* ((project-type (projectile-project-type)) (test-dir (projectile-test-directory project-type)) (impl-dir (projectile-src-directory project-type))) (when (and (stringp test-dir) (stringp impl-dir)) (if (not (string-match-p test-dir (file-name-directory test-dir-path))) (user-error "Attempted to find a implementation file by switching this project type's (%s) test-dir property \"%s\" with this project type's src-dir property \"%s\", but %s does not contain \"%s\"" project-type test-dir impl-dir test-dir-path test-dir) (projectile-complementary-dir test-dir-path test-dir impl-dir))))) (defun projectile--impl-to-test-dir-fallback (impl-dir-path) "Return the test file for IMPL-DIR-PATH by guessing a test directory. Occurrences of the `projectile-default-src-directory' in the directory of IMPL-DIR-PATH are replaced with `projectile-default-test-directory'. Nil is returned if `projectile-default-src-directory' is not a substring of IMPL-DIR-PATH." (when-let* ((file (projectile--complementary-file impl-dir-path (lambda (f) (when (string-match-p projectile-default-src-directory f) (projectile-complementary-dir impl-dir-path projectile-default-src-directory projectile-default-test-directory))) #'projectile--test-name-for-impl-name))) (projectile--project-relative-name file (projectile-project-root)))) (defun projectile--test-to-impl-dir-fallback (test-dir-path) "Return the impl file for TEST-DIR-PATH by guessing a source directory. Occurrences of `projectile-default-test-directory' in the directory of TEST-DIR-PATH are replaced with `projectile-default-src-directory'. Nil is returned if `projectile-default-test-directory' is not a substring of TEST-DIR-PATH." (when-let* ((file (projectile--complementary-file test-dir-path (lambda (f) (when (string-match-p projectile-default-test-directory f) (projectile-complementary-dir test-dir-path projectile-default-test-directory projectile-default-src-directory))) #'projectile--impl-name-for-test-name))) (projectile--project-relative-name file (projectile-project-root)))) (defun projectile--impl-to-test-dir (impl-dir-path) "Return the directory path of a test whose impl file resides in IMPL-DIR-PATH. Occurrences of the current project type's src-dir property (which should be a string) are replaced with the current project type's test-dir property (which should be a string) to obtain the new directory. If the src-dir property is set and IMPL-DIR-PATH does not contain (as a substring) the src-dir property of the current project type, an error is signalled. Nil is returned if either the src-dir or test-dir properties are not strings." (let* ((project-type (projectile-project-type)) (test-dir (projectile-test-directory project-type)) (impl-dir (projectile-src-directory project-type))) (when (and (stringp test-dir) (stringp impl-dir)) (if (not (string-match-p impl-dir (file-name-directory impl-dir-path))) (user-error "Attempted to find a test file by switching this project type's (%s) src-dir property \"%s\" with this project type's test-dir property \"%s\", but %s does not contain \"%s\"" project-type impl-dir test-dir impl-dir-path impl-dir) (projectile-complementary-dir impl-dir-path impl-dir test-dir))))) (defun projectile-complementary-dir (dir-path string replacement) "Return the \"complementary\" directory of DIR-PATH. Replace STRING in DIR-PATH with REPLACEMENT." (let* ((project-root (projectile-project-root)) (relative-dir (file-name-directory (projectile--project-relative-name dir-path project-root)))) (projectile-expand-root (string-replace string replacement relative-dir)))) (defun projectile--create-directories-for (path) "Create directories necessary for PATH." (unless (file-exists-p path) (make-directory (if (file-directory-p path) path (file-name-directory path)) :create-parents))) (defun projectile-find-implementation-or-test (file-name) "Given a FILE-NAME return the matching implementation or test filename. If `projectile-create-missing-test-files' is non-nil, create the missing test file." (unless file-name (user-error "The current buffer is not visiting a file")) (unless (projectile-project-type) (projectile-ensure-project nil)) (if (projectile-test-file-p file-name) ;; find the matching impl file (let ((impl-file (projectile-find-matching-file file-name))) (if impl-file (projectile-expand-root impl-file) (error "No matching source file found for project type `%s'" (projectile-project-type)))) ;; find the matching test file (let* ((error-msg (format "No matching test file found for project type `%s'" (projectile-project-type))) (test-file (or (projectile-find-matching-test file-name) (error error-msg))) (expanded-test-file (projectile-expand-root test-file))) (cond ((file-exists-p expanded-test-file) expanded-test-file) (projectile-create-missing-test-files (projectile--create-directories-for expanded-test-file) expanded-test-file) (t (user-error "Determined test file to be \"%s\", which does not exist. Set `projectile-create-missing-test-files' to allow `projectile-find-implementation-or-test' to create new files" test-file)))))) (defun projectile--find-implementation-or-test-in (ff-variant) "Open the matching implementation or test file using FF-VARIANT. FF-VARIANT is a `find-file'-like command; passing `find-file-other-window' or `find-file-other-frame' yields the corresponding display variants." (funcall ff-variant (projectile-find-implementation-or-test (buffer-file-name)))) ;;;###autoload (autoload 'projectile-find-implementation-or-test-other-window "projectile" nil t) ;;;###autoload (autoload 'projectile-find-implementation-or-test-other-frame "projectile" nil t) (projectile--define-display-variants projectile-find-implementation-or-test () "Open matching implementation or test file in other %s. See the documentation of `projectile--find-matching-file' and `projectile--find-matching-test' for how implementation and test files are determined." (projectile--find-implementation-or-test-in #'find-file-other-window)) ;;;###autoload (defun projectile-toggle-between-implementation-and-test () "Toggle between an implementation file and its test file. See the documentation of `projectile--find-matching-file' and `projectile--find-matching-test' for how implementation and test files are determined." (interactive) (find-file (projectile-find-implementation-or-test (buffer-file-name)))) (defun projectile-project-type-attribute (project-type key &optional default-value) "Return the value of some PROJECT-TYPE attribute identified by KEY. Fallback to DEFAULT-VALUE for missing attributes." (let ((project (alist-get project-type projectile-project-types))) (if (and project (plist-member project key)) (plist-get project key) default-value))) (defun projectile-test-prefix (project-type) "Find default test files prefix based on PROJECT-TYPE." (or projectile-project-test-prefix (projectile-project-type-attribute project-type 'test-prefix))) (defun projectile-test-suffix (project-type) "Find default test files suffix based on PROJECT-TYPE." (or projectile-project-test-suffix (projectile-project-type-attribute project-type 'test-suffix))) (defun projectile-test-extension (project-type) "Find the extension test files use in PROJECT-TYPE, or nil. Nil means a test file carries the same extension as the implementation it belongs to, which is true of most languages - Elixir, whose tests are scripts (`.exs\\=') beside sources (`.ex\\='), is why this exists." (projectile-project-type-attribute project-type 'test-extension)) (defun projectile-src-extension (project-type) "Find the extension implementation files use in PROJECT-TYPE, or nil. The counterpart of `projectile-test-extension\\=', for naming the implementation belonging to a test." (projectile-project-type-attribute project-type 'src-extension)) (defun projectile-related-files-fn (project-type) "Find relative file based on PROJECT-TYPE. Combines the type's hand-written `related-files-fn' (or the `projectile-project-related-files-fn' override) with a related-files-fn compiled from its `file-kinds' declaration, if any. When both are present they are merged into a list of functions so declarative and hand-written relations coexist." (let ((custom (or projectile-project-related-files-fn (projectile-project-type-attribute project-type 'related-files-fn))) (file-kinds (projectile-project-type-attribute project-type 'file-kinds))) (if (null file-kinds) custom (let ((kinds-fn (projectile--file-kinds-related-files-fn file-kinds))) (cond ((null custom) kinds-fn) ((functionp custom) (list custom kinds-fn)) ((consp custom) (append custom (list kinds-fn))) (t (error "Unsupported value type of :related-files-fn"))))))) (defun projectile-src-directory (project-type) "Find default src directory based on PROJECT-TYPE." (or projectile-project-src-dir (projectile-project-type-attribute project-type 'src-dir))) (defun projectile-test-directory (project-type) "Find default test directory based on PROJECT-TYPE." (or projectile-project-test-dir (projectile-project-type-attribute project-type 'test-dir))) (defun projectile-dirname-matching-count (a b) "Count matching dirnames ascending file paths in A and B." (setq a (reverse (split-string (or (file-name-directory a) "") "/" t)) b (reverse (split-string (or (file-name-directory b) "") "/" t))) (let ((common 0)) (while (and a b (string-equal (pop a) (pop b))) (setq common (1+ common))) common)) (defun projectile-group-file-candidates (file candidates) "Group file candidates by dirname matching count." (seq-sort (lambda (a b) (> (car a) (car b))) (let (value result) (while (setq value (pop candidates)) (let* ((key (projectile-dirname-matching-count file value)) (kv (assoc key result))) (if kv (setcdr kv (cons value (cdr kv))) (push (list key value) result)))) (mapcar (lambda (x) (cons (car x) (nreverse (cdr x)))) (nreverse result))))) (defun projectile--best-or-all-candidates-based-on-parents-dirs (file candidates) "Return a list of the best one for FILE from CANDIDATES or all CANDIDATES." (let ((grouped-candidates (projectile-group-file-candidates file candidates))) (if (= (length (car grouped-candidates)) 2) (list (car (last (car grouped-candidates)))) (apply #'append (mapcar #'cdr grouped-candidates))))) (defun projectile--impl-to-test-predicate (impl-file) "Return a predicate, which returns t for any test files for IMPL-FILE." (let* ((basename (file-name-sans-extension (file-name-nondirectory impl-file))) (test-prefix (funcall projectile-test-prefix-function (projectile-project-type))) (test-suffix (funcall projectile-test-suffix-function (projectile-project-type))) (prefix-name (when test-prefix (concat test-prefix basename))) (suffix-name (when test-suffix (concat basename test-suffix)))) (lambda (current-file) (let ((name (file-name-sans-extension (file-name-nondirectory current-file)))) (or (string-equal prefix-name name) (string-equal suffix-name name)))))) (defun projectile--complementary-file (file-path dir-fn filename-fn) "Apply DIR-FN and FILENAME-FN to the directory and name of FILE-PATH. More specifically, return DIR-FN applied to the directory of FILE-PATH concatenated with FILENAME-FN applied to the file name of FILE-PATH. If either function returns nil, return nil." (let ((filename (file-name-nondirectory file-path))) (when-let* ((complementary-filename (funcall filename-fn filename)) (dir (funcall dir-fn (file-name-directory file-path)))) (concat (file-name-as-directory dir) complementary-filename)))) (defun projectile--impl-file-from-src-dir-str (file-name) "Get the relative path of the implementation file FILE-NAME. Return a path relative to the project root for the impl file of FILE-NAME using the src-dir and test-dir properties of the current project type which should be strings, nil returned if this is not the case." (when-let* ((complementary-file (projectile--complementary-file file-name #'projectile--test-to-impl-dir #'projectile--impl-name-for-test-name))) (projectile--project-relative-name complementary-file (projectile-project-root)))) (defun projectile--test-file-from-test-dir-str (file-name) "Get the relative path of the test file FILE-NAME. Return a path relative to the project root for the test file of FILE-NAME using the src-dir and test-dir properties of the current project type which should be strings, nil returned if this is not the case." (when-let* ((complementary-file (projectile--complementary-file file-name #'projectile--impl-to-test-dir #'projectile--test-name-for-impl-name))) (projectile--project-relative-name complementary-file (projectile-project-root)))) (defun projectile--impl-file-from-src-dir-fn (test-file) "Get the relative path to the implementation file corresponding to TEST-FILE. Return the implementation file path for the absolute path TEST-FILE relative to the project root in the case the current project type's src-dir has been set to a custom function, return nil if this is not the case or the path points to a file that does not exist." (when-let* ((src-dir (projectile-src-directory (projectile-project-type)))) (when (functionp src-dir) (let ((impl-file (projectile--complementary-file test-file src-dir #'projectile--impl-name-for-test-name))) (when (file-exists-p impl-file) (file-relative-name impl-file (projectile-project-root))))))) (defun projectile--test-file-from-test-dir-fn (impl-file) "Get the relative path to the test file corresponding to IMPL-FILE. Return the test file path for the absolute path IMPL-FILE relative to the project root, in the case the current project type's test-dir has been set to a custom function, else return nil." (when-let* ((test-dir (projectile-test-directory (projectile-project-type)))) (when (functionp test-dir) (file-relative-name (projectile--complementary-file impl-file test-dir #'projectile--test-name-for-impl-name) (projectile-project-root))))) (defmacro projectile--acond (&rest clauses) "Like `cond', but the result of each condition is bound to `it'. The variable `it' is available within the remainder of each of CLAUSES. CLAUSES are otherwise as documented for `cond'. This is copied from anaphora.el." (declare (debug cond)) (if (null clauses) nil (let ((cl1 (car clauses)) (sym (gensym))) `(let ((,sym ,(car cl1))) (if ,sym (if (null ',(cdr cl1)) ,sym (let ((it ,sym)) ,@(cdr cl1))) (projectile--acond ,@(cdr clauses))))))) (defun projectile--find-matching-test (impl-file) "Return a list of test files for IMPL-FILE. The precedence for determining test files to return is: 1. Use the project type's test-dir property if it's set to a function 2. Use the project type's related-files-fn property if set 3. Use the project type's test-dir property if it's set to a string 4. Attempt to find a file by matching all project files against `projectile--impl-to-test-predicate' 5. Fallback to swapping \"src\" for \"test\" in IMPL-FILE if \"src\" is a substring of IMPL-FILE." (projectile--acond ((projectile--test-file-from-test-dir-fn impl-file) (list it)) ((projectile--related-files-plist-by-kind impl-file :test) (projectile--related-files-from-plist it)) ((projectile--test-file-from-test-dir-str impl-file) (list it)) ((projectile--best-or-all-candidates-based-on-parents-dirs impl-file (seq-filter (projectile--impl-to-test-predicate impl-file) (projectile-current-project-files))) it) ((projectile--impl-to-test-dir-fallback impl-file) (list it)))) (defun projectile--test-to-impl-predicate (test-file) "Return a predicate, which returns t for any impl files for TEST-FILE." (let* ((basename (file-name-sans-extension (file-name-nondirectory test-file))) (test-prefix (funcall projectile-test-prefix-function (projectile-project-type))) (test-suffix (funcall projectile-test-suffix-function (projectile-project-type)))) (lambda (current-file) (let ((name (file-name-nondirectory (file-name-sans-extension current-file)))) (or (when test-prefix (string-equal (concat test-prefix name) basename)) (when test-suffix (string-equal (concat name test-suffix) basename))))))) (defun projectile--find-matching-file (test-file) "Return a list of impl files tested by TEST-FILE. The precedence for determining implementation files to return is: 1. Use the project type's src-dir property if it's set to a function 2. Use the project type's related-files-fn property if set 3. Use the project type's src-dir property if it's set to a string 4. Default to a fallback which matches all project files against `projectile--test-to-impl-predicate' 5. Fallback to swapping \"test\" for \"src\" in TEST-FILE if \"test\" is a substring of TEST-FILE." (projectile--acond ((projectile--impl-file-from-src-dir-fn test-file) (list it)) ((projectile--related-files-plist-by-kind test-file :impl) (projectile--related-files-from-plist it)) ((projectile--impl-file-from-src-dir-str test-file) (list it)) ((projectile--best-or-all-candidates-based-on-parents-dirs test-file (seq-filter (projectile--test-to-impl-predicate test-file) (projectile-current-project-files))) it) ((projectile--test-to-impl-dir-fallback test-file) (list it)))) (defun projectile--choose-from-candidates (candidates &key caller) "Choose one item from CANDIDATES." (if (= (length candidates) 1) (car candidates) (projectile-completing-read "Switch to: " candidates :caller caller))) (defun projectile-find-matching-test (impl-file) "Compute the name of the test matching IMPL-FILE." (when-let* ((candidates (projectile--find-matching-test impl-file))) (projectile--choose-from-candidates candidates :caller 'projectile-read-file))) (defun projectile-find-matching-file (test-file) "Compute the name of a file matching TEST-FILE." (when-let* ((candidates (projectile--find-matching-file test-file))) (projectile--choose-from-candidates candidates :caller 'projectile-read-file))) ;;; Search prompt and file-spec helpers ;; ;; Odds and ends the search and grep commands need: the default file ;; specification `projectile-grep' offers, the ignored-suffix globs, and the ;; faces and reader behind the search prompt. (defun projectile-grep-default-files () "Try to find a default pattern for `projectile-grep'. This is a subset of `grep-read-files', where either a matching entry from `grep-files-aliases' or file name extension pattern is returned." (when buffer-file-name (let* ((fn (file-name-nondirectory buffer-file-name)) (default-alias (let ((aliases (remove (assoc "all" grep-files-aliases) grep-files-aliases)) alias) (while aliases (setq alias (car aliases) aliases (cdr aliases)) (if (string-match (mapconcat #'wildcard-to-regexp (split-string (cdr alias) nil t) "\\|") fn) (setq aliases nil) (setq alias nil))) (cdr alias))) (default-extension (let ((ext (file-name-extension fn))) (and ext (concat "*." ext))))) (or default-alias default-extension)))) (defun projectile--globally-ignored-file-suffixes-glob () "Return ignored file suffixes as a list of glob patterns." (mapcar (lambda (pat) (concat "*" pat)) projectile-globally-ignored-file-suffixes)) (defface projectile-search-prompt-tool '((t :inherit font-lock-function-name-face :weight bold)) "Face for the tool/backend highlighted in Projectile's search prompts." :group 'projectile :package-version '(projectile . "3.2.0")) (defface projectile-search-prompt-default '((t :inherit font-lock-constant-face)) "Face for the default value highlighted in Projectile's search prompts." :group 'projectile :package-version '(projectile . "3.2.0")) (defun projectile--search-tool-tag (tool) "Return a faced `[TOOL]' tag for a search prompt. TOOL is the backend, given as a symbol or a string: `projectile-search' passes the backend name symbol while the reviewable search passes a \"ripgrep\"/\"elisp\" string. Used where the backend varies so the prompt makes clear which tool will run." (format "[%s]" (propertize (format "%s" tool) 'face 'projectile-search-prompt-tool))) (defun projectile--read-search-string-with-default (prompt-label) "Read a search string, defaulting to the symbol or region at point. PROMPT-LABEL is the action shown in the prompt (already carrying any faced tool tag its caller wants). The default value, when there is one, is appended and faced as `(default VALUE)'." (let* ((prompt-label (projectile-prepend-project-name prompt-label)) (default-value (projectile-symbol-or-selection-at-point)) (default-label (if (or (not default-value) (string= default-value "")) "" (format " (default: %s)" (propertize default-value 'face 'projectile-search-prompt-default))))) (read-string (format "%s%s: " prompt-label default-label) nil nil default-value))) ;;; Grep command construction ;; ;; Turning Projectile's ignore rules into the arguments `rgrep' and friends ;; expect, which is fiddly enough to be worth keeping in one place. (defvar projectile-grep-find-ignored-paths) (defvar projectile-grep-find-unignored-paths) (defvar projectile-grep-find-ignored-patterns) (defvar projectile-grep-find-unignored-patterns) (defun projectile--grep-find-specs (patterns) "Split gitignore-style PATTERNS into specs for the `find'-based grep. Return a cons of the root-anchored patterns, spelled relative to the project root, and the floating ones, which match at any depth. Trailing slashes are dropped: `find' sees directory entries without one, and pruning a directory takes its whole subtree with it anyway." (let (anchored floating) (dolist (pattern patterns) (let ((body (string-remove-suffix "/" pattern))) (cond ((string-empty-p body)) ((string-prefix-p "**/" body) (push (substring body 3) floating)) ((string-prefix-p "/" body) (push (substring body 1) anchored)) ((string-search "/" body) (push body anchored)) (t (push body floating))))) (cons (nreverse anchored) (nreverse floating)))) (defun projectile--grep-rebase-paths (paths project-root root-dir) "Respell root-anchored PATHS relative to ROOT-DIR. PATHS are relative to PROJECT-ROOT, while `find' is started in ROOT-DIR - either the project root itself or one of the dirconfig `+' keep subdirectories. A path that doesn't live under ROOT-DIR can't match anything the search will see, so it is dropped." (let ((prefix (file-relative-name (file-name-as-directory (expand-file-name root-dir)) (file-name-as-directory (expand-file-name project-root))))) (if (member prefix '("./" "" ".")) paths (delq nil (mapcar (lambda (path) (and (string-prefix-p prefix path) (substring path (length prefix)))) paths))))) (defun projectile--grep-find-path-tests (anchored floating) "Return `find' -path tests matching the ANCHORED and FLOATING patterns. An anchored pattern is spelled `./PATH', so it only matches from the directory `find' was started in; a floating one gets a `*/' prefix, so it matches at any depth. Return nil when both lists are empty. The one place this can't be exact is that `*' in a `find' -path glob crosses `/', where a gitignore `*' stays within a path segment, so an anchored pattern like `/*.txt' also prunes deeper matches here." (when-let* ((globs (append (mapcar (lambda (pattern) (concat "./" pattern)) anchored) (mapcar (lambda (pattern) (if (string-prefix-p "*" pattern) pattern (concat "*/" pattern))) floating)))) (concat " -path " (mapconcat #'shell-quote-argument globs " -o -path ")))) (defun projectile--grep-find-prune-clause () "Return the `find' prune expression for Projectile's ignore configuration. Built from the four `projectile-grep-find-*' variables `projectile--grep' binds around the `rgrep' call. The `!' ensure entries are subtracted from the whole ignore expression, so they rescue an anchored path just like they rescue a floating pattern - and just like they do when indexing." (when-let* ((ignore-tests (projectile--grep-find-path-tests projectile-grep-find-ignored-paths projectile-grep-find-ignored-patterns))) (let ((unignore-tests (projectile--grep-find-path-tests projectile-grep-find-unignored-paths projectile-grep-find-unignored-patterns))) (concat (shell-quote-argument "(") (if unignore-tests (concat " " (shell-quote-argument "(") ignore-tests " " (shell-quote-argument ")") " -a " (shell-quote-argument "!") " " (shell-quote-argument "(") unignore-tests " " (shell-quote-argument ")")) ignore-tests) " " (shell-quote-argument ")") " -prune -o ")))) (defun projectile-rgrep-default-command (regexp files dir) "Compute the command for \\[rgrep] to use by default. Extension of the Emacs 25.1 implementation of `rgrep-default-command', with which it shares its arglist." (require 'find-dired) ; for `find-name-arg' (grep-expand-template grep-find-template regexp (concat (shell-quote-argument "(") " " find-name-arg " " (mapconcat #'shell-quote-argument (split-string files) (concat " -o " find-name-arg " ")) " " (shell-quote-argument ")")) dir (concat (and grep-find-ignored-directories (concat "-type d " (shell-quote-argument "(") ;; we should use shell-quote-argument here " -path " (mapconcat #'identity ;; TODO: Replace delq+mapcar with seq-keep when Emacs 29.1 is the minimum version (delq nil (mapcar (lambda (ignore) (cond ((stringp ignore) (shell-quote-argument (concat "*/" ignore))) ((consp ignore) (and (funcall (car ignore) dir) (shell-quote-argument (concat "*/" (cdr ignore))))))) grep-find-ignored-directories)) " -o -path ") " " (shell-quote-argument ")") " -prune -o ")) (and grep-find-ignored-files (concat (shell-quote-argument "!") " -type d " (shell-quote-argument "(") ;; we should use shell-quote-argument here " -name " (mapconcat #'(lambda (ignore) (cond ((stringp ignore) (shell-quote-argument ignore)) ((consp ignore) (and (funcall (car ignore) dir) (shell-quote-argument (cdr ignore)))))) grep-find-ignored-files " -o -name ") " " (shell-quote-argument ")") " -prune -o ")) (projectile--grep-find-prune-clause)))) ;;; Project search ;; ;; `projectile-search' runs a text search over the project using a pluggable ;; backend. Backends live in `projectile-search-backends' and are selected via ;; `projectile-search-backend'; register your own (deadgrep, consult-ripgrep, ;; ...) with `projectile-register-search-backend'. The registry helpers below ;; are deliberately family-agnostic so the same mechanism can drive other ;; command families later on. ;;;; Generic backend registry (defun projectile-register-backend (registry-symbol name &rest plist) "Register backend NAME (a symbol) into REGISTRY-SYMBOL's alist. REGISTRY-SYMBOL names a variable holding an alist of (NAME . PLIST) descriptors; an existing entry for NAME is replaced. PLIST properties are family-specific, but `:description' (a string) and `:available' (a zero-argument predicate, or nil for \"always available\") are understood by the resolution helpers below." (set registry-symbol (cons (cons name plist) (assq-delete-all name (symbol-value registry-symbol))))) (defun projectile--backend-available-p (backend) "Return non-nil when BACKEND, a (NAME . PLIST) descriptor, is usable." (let ((predicate (plist-get (cdr backend) :available))) (or (null predicate) (funcall predicate)))) (defun projectile--resolve-backend (backends preference family) "Return a usable backend from BACKENDS, honouring PREFERENCE. BACKENDS is an alist of (NAME . PLIST). PREFERENCE is a backend name, or `auto' to pick the first available backend, or `prompt' to ask. FAMILY is a noun used in prompts and errors, e.g. \"search\". Signals a `user-error' when no suitable backend is available." (let ((available (seq-filter #'projectile--backend-available-p backends))) (cond ((null available) (user-error "No %s backend is available" family)) ((eq preference 'auto) (car available)) ((eq preference 'prompt) (assq (intern (completing-read (format "%s backend: " (capitalize family)) (mapcar (lambda (b) (symbol-name (car b))) available) nil t)) backends)) (t (let ((backend (assq preference backends))) (cond ((null backend) (user-error "Unknown %s backend: %s" family preference)) ((projectile--backend-available-p backend) backend) (t (user-error "The %s backend `%s' is not available" family preference)))))))) ;;;; Search engines (defun projectile--grep (search-regexp &optional files) "Run rgrep (or `vc-git-grep') for SEARCH-REGEXP across the project. FILES, when non-nil, is an rgrep files specification restricting the search. Honours Projectile's ignore configuration and runs `projectile-grep-finished-hook' when done." (require 'grep) ;; for `rgrep' (let* ((project-root (projectile-acquire-root)) (roots (projectile-get-project-directories project-root)) ;; The ignore and ensure rules are the project's, so they're read ;; once and respelled per root below. (ignore-specs (projectile--grep-find-specs (projectile--ignore-patterns project-root))) (ensure-specs (projectile--grep-find-specs (projectile--ensure-patterns project-root)))) (dolist (root-dir roots) (require 'vc-git) ;; for `vc-git-grep' ;; in git projects users have the option to use `vc-git-grep' instead of `rgrep' (if (and (eq (projectile-project-vcs) 'git) projectile-use-git-grep) (vc-git-grep search-regexp (or files "") root-dir) (let ((projectile-grep-find-ignored-paths (projectile--grep-rebase-paths (car ignore-specs) project-root root-dir)) (projectile-grep-find-ignored-patterns (cdr ignore-specs)) (projectile-grep-find-unignored-paths (projectile--grep-rebase-paths (car ensure-specs) project-root root-dir)) (projectile-grep-find-unignored-patterns (cdr ensure-specs))) (grep-compute-defaults) (cl-letf (((symbol-function 'rgrep-default-command) #'projectile-rgrep-default-command)) (rgrep search-regexp (or files "* .*") root-dir) (when (get-buffer "*grep*") ;; When grep is using a global *grep* buffer rename it to be ;; scoped to the current root to allow multiple concurrent grep ;; operations, one per root (with-current-buffer "*grep*" (rename-buffer (concat "*grep <" root-dir ">*") t))))))) (run-hooks 'projectile-grep-finished-hook))) (defun projectile--ag-ignore-patterns () "Return `ag-ignore-list' entries for the project's ignore patterns. They come from `projectile--ignore-patterns'. `ag' takes plain globs with no notion of anchoring, so the gitignore markers it wouldn't make sense of - a leading `/' or `**/', a trailing `/' - are stripped; what's left matches at any depth, which is as close as `ag' gets." (seq-remove #'string-empty-p (mapcar (lambda (pattern) (let ((body (string-remove-suffix "/" pattern))) (cond ((string-prefix-p "**/" body) (substring body 3)) ((string-prefix-p "/" body) (substring body 1)) (t body)))) (projectile--ignore-patterns)))) (defun projectile--ag (search-term &optional regexp) "Run an `ag' search for SEARCH-TERM in the project. When REGEXP is non-nil, SEARCH-TERM is treated as a regular expression. Requires the `ag' Emacs package." (unless (require 'ag nil 'noerror) (user-error "Package `ag' is not available")) (let ((ag-command (if regexp 'ag-regexp 'ag)) (ag-ignore-list (delq nil (seq-uniq (append ag-ignore-list (projectile--ag-ignore-patterns) ;; ag supports git ignore files directly (unless (eq (projectile-project-vcs) 'git) (append grep-find-ignored-files grep-find-ignored-directories '())))))) ;; reset the prefix arg, otherwise it will affect the ag-command (current-prefix-arg nil)) (funcall ag-command search-term (projectile-acquire-root)))) (defun projectile--ripgrep-ignore-globs () "Return ripgrep `--glob' exclusions for the project's ignore patterns. The patterns come from `projectile--ignore-patterns' and are passed to ripgrep as they are - ripgrep's globs follow gitignore rules too. Uses the `--glob=!PATTERN' form rather than `--glob \\='!PATTERN\\='', whose surrounding single quotes are only stripped by POSIX shells - on Windows `cmd' they become part of the pattern and the exclusion silently fails \(see #1946)." (mapcar (lambda (val) (concat "--glob=!" val)) (projectile--ignore-patterns))) (defun projectile--ripgrep (search-term &optional regexp) "Run a ripgrep (rg) search for SEARCH-TERM in the project. When REGEXP is non-nil, SEARCH-TERM is treated as a regular expression. Requires the `ripgrep' or `rg' Emacs package." (let ((args (projectile--ripgrep-ignore-globs))) ;; we rely on the external packages ripgrep and rg for the actual search (cond ((require 'ripgrep nil 'noerror) (ripgrep-regexp search-term (projectile-acquire-root) (if regexp args (cons "--fixed-strings --hidden" args)))) ((require 'rg nil 'noerror) (rg-run search-term "*" ;; all files (projectile-acquire-root) (not regexp) ;; literal search? nil ;; no need to confirm args)) (t (user-error "Packages `ripgrep' and `rg' are not available"))))) ;;;; Search backends registry (defvar projectile-search-backends nil "Alist of registered `projectile-search' backends. Each entry is (NAME . PLIST); see `projectile-register-search-backend'.") (defun projectile-register-search-backend (name &rest plist) "Register NAME as a `projectile-search' backend with PLIST properties. Recognised PLIST keys: :description a human-readable string shown in prompts; :available a zero-argument predicate returning non-nil when the backend can be used (omit for an always-available one); :search a function called as (SEARCH-TERM REGEXP) to run the search, REGEXP being non-nil when the term is a regular expression. Use this to plug in your own search tool, e.g.: (projectile-register-search-backend \\='deadgrep :description \"deadgrep\" :available (lambda () (require \\='deadgrep nil t)) :search (lambda (term _regexp) (deadgrep term (projectile-acquire-root))))" (apply #'projectile-register-backend 'projectile-search-backends name plist)) ;; Built-ins. Registered so the `auto' preference favours ripgrep, then grep ;; (which is always available); ag is only used when explicitly selected. (projectile-register-search-backend 'ag :description "the Silver Searcher (ag)" :available (lambda () (require 'ag nil 'noerror)) :search #'projectile--ag) (projectile-register-search-backend 'grep :description "grep (rgrep / git-grep)" :search (lambda (term _regexp) (projectile--grep term))) (projectile-register-search-backend 'ripgrep :description "ripgrep (rg)" :available (lambda () (or (require 'ripgrep nil 'noerror) (require 'rg nil 'noerror))) :search #'projectile--ripgrep) ;;;###autoload (defun projectile-search (&optional search-term regexp) "Search the project for SEARCH-TERM using `projectile-search-backend'. With a prefix argument treat SEARCH-TERM as a regular expression (for the backends that distinguish literal from regexp searches). The backend is chosen from `projectile-search-backends' according to `projectile-search-backend'; register new ones with `projectile-register-search-backend'." (interactive (list nil current-prefix-arg)) ;; Fail fast (with a friendly error) before prompting when not in a project. (projectile-acquire-root) (let* ((backend (projectile--resolve-backend projectile-search-backends projectile-search-backend "search")) (term (or search-term (projectile--read-search-string-with-default (format "Search %s%s for" (projectile--search-tool-tag (car backend)) (if regexp " regexp" "")))))) (funcall (plist-get (cdr backend) :search) term regexp))) ;;;###autoload (defun projectile-grep (&optional regexp arg) "Perform rgrep in the project (the grep `projectile-search' backend). With a prefix ARG asks for files (globbing-aware) which to grep in. With prefix ARG of `-' (such as `M--'), default the files (without prompt), to `projectile-grep-default-files'. With REGEXP given, don't query the user for a regexp." (interactive "i\nP") ;; Fail fast (with a friendly error) before prompting when not in a project. (projectile-acquire-root) (let ((search-regexp (or regexp (projectile--read-search-string-with-default (format "Search %s for" (projectile--search-tool-tag "grep"))))) (files (and arg (or (and (equal current-prefix-arg '-) (projectile-grep-default-files)) (read-string (projectile-prepend-project-name "Grep in: ") (projectile-grep-default-files)))))) (projectile--grep search-regexp files))) ;;;###autoload (defun projectile-ag (search-term &optional arg) "Run an ag search with SEARCH-TERM in the project. This is `projectile-search' with the ag backend. With an optional prefix argument ARG SEARCH-TERM is interpreted as a regular expression." (interactive (list (projectile--read-search-string-with-default (format "Search %s%s for" (projectile--search-tool-tag "ag") (if current-prefix-arg " regexp" ""))) current-prefix-arg)) (let ((projectile-search-backend 'ag)) (projectile-search search-term arg))) ;;;###autoload (defun projectile-ripgrep (search-term &optional arg) "Run a ripgrep (rg) search with SEARCH-TERM in the project. This is `projectile-search' with the ripgrep backend. With an optional prefix argument ARG SEARCH-TERM is interpreted as a regular expression. This command depends on the Emacs packages ripgrep or rg being installed to work." (interactive (list (projectile--read-search-string-with-default (format "Search %s%s for" (projectile--search-tool-tag "ripgrep") (if current-prefix-arg " regexp" ""))) current-prefix-arg)) (let ((projectile-search-backend 'ripgrep)) (projectile-search search-term arg))) (defun projectile--project-ignore-globs (root) "Return ROOT's ignore patterns as gitignore globs. That's `projectile--ignore-patterns' verbatim: gitignore syntax is exactly what the tools Projectile hands these to speak (`fd --exclude', `git ls-files' exclude pathspecs, `rg --glob')." (projectile--ignore-patterns root)) (defun projectile--project-el-ignore-glob (glob) "Translate the gitignore GLOB into project.el's `project-ignores' format. There a root-anchored pattern is spelled with a leading `./' instead of gitignore's leading `/' (or an interior slash), and everything else matches at any depth." (let ((body (string-remove-suffix "/" glob))) (if (string-search "/" body) (concat "./" (string-remove-prefix "/" glob)) glob))) (defun projectile-find-references (&optional symbol) "Find textual references to SYMBOL across the current project. SYMBOL defaults to the active region or the symbol at point. The search is scoped to the project root and honours Projectile's ignore configuration (`.projectile' and the globally-ignored files and directories), like Projectile's other search commands. This is a backend-agnostic textual search (it greps the project for SYMBOL). For semantic references from a language server or tags table, use the built-in `xref-find-references', which is scoped to the Projectile project too when `projectile-mode' is enabled." (interactive) (require 'xref) (let* ((project-root (projectile-acquire-root)) (symbol (or symbol (read-string (projectile-prepend-project-name "Find references to: ") (projectile-symbol-or-selection-at-point)))) ;; `xref-matches-in-directory' reads its IGNORES in project.el's ;; format, not gitignore's. (ignores (mapcar #'projectile--project-el-ignore-glob (projectile--project-ignore-globs project-root))) ;; `xref-matches-in-directory' greps for the pattern (honouring ;; IGNORES) and re-matches it in-buffer to pin down columns, so a ;; plain quoted symbol is the portable choice: symbol/word-boundary ;; constructs (`\\_<', `\\b') don't survive the translation to the ;; platform grep. (regexp (regexp-quote symbol)) (fetcher (lambda () (xref-matches-in-directory regexp "*" project-root ignores)))) (xref-show-xrefs fetcher nil))) (defmacro projectile-with-default-dir (dir &rest body) "Invoke in DIR the BODY." (declare (debug t) (indent 1)) `(let ((default-directory ,dir)) ,@body)) ;;;###autoload (defun projectile-run-command-in-root () "Invoke `execute-extended-command' in the project's root." (interactive) (projectile-with-default-dir (projectile-acquire-root) (call-interactively #'execute-extended-command))) ;;;###autoload (defun projectile-run-shell-command-in-root (command &optional output-buffer error-buffer) "Invoke `shell-command' in the project's root." (interactive (list (read-shell-command "Shell command: "))) (projectile-with-default-dir (projectile-acquire-root) (shell-command command output-buffer error-buffer))) ;;;###autoload (defun projectile-run-async-shell-command-in-root (command &optional output-buffer error-buffer) "Invoke `async-shell-command' in the project's root." (interactive (list (read-shell-command "Async shell command: "))) (projectile-with-default-dir (projectile-acquire-root) (async-shell-command command output-buffer error-buffer))) ;;;###autoload (defun projectile-run-gdb () "Invoke `gdb' in the project's root." (interactive) (projectile-with-default-dir (projectile-acquire-root) (call-interactively 'gdb))) ;;; Shells, REPLs and terminals ;; ;; `projectile-run' launches a shell, REPL or terminal in the project root ;; using a pluggable backend (built on the generic registry defined for ;; `projectile-search'). Register your own with ;; `projectile-register-shell-backend'. ;;;; Engines for the built-in shells (always available) (defun projectile--run-shell (new-process &optional _other-window) "Invoke `shell' in the project's root. NEW-PROCESS forces creation of a new process instead of reusing an existing buffer." (let ((project (projectile-acquire-root))) (projectile-with-default-dir project (shell (projectile-generate-process-name "shell" new-process project))))) (defun projectile--run-eshell (new-process &optional _other-window) "Invoke `eshell' in the project's root. NEW-PROCESS forces creation of a new process instead of reusing an existing buffer." (let ((project (projectile-acquire-root))) (projectile-with-default-dir project (let ((eshell-buffer-name (projectile-generate-process-name "eshell" new-process project))) (eshell))))) (defun projectile--run-ielm (new-process &optional _other-window) "Invoke `ielm' in the project's root. NEW-PROCESS forces creation of a new process instead of reusing an existing buffer." (let* ((project (projectile-acquire-root)) (ielm-buffer-name (projectile-generate-process-name "ielm" new-process project))) (if (get-buffer ielm-buffer-name) (switch-to-buffer ielm-buffer-name) (projectile-with-default-dir project (ielm)) ;; ielm's buffer name is hardcoded, so we have to rename it after creation (rename-buffer ielm-buffer-name)))) (defun projectile--run-term (new-process &optional _other-window) "Invoke `term' in the project's root. NEW-PROCESS forces creation of a new process instead of reusing an existing buffer." (let* ((project (projectile-acquire-root)) (buffer-name (projectile-generate-process-name "term" new-process project)) (default-program (or explicit-shell-file-name (getenv "ESHELL") (getenv "SHELL") "/bin/sh"))) (unless (get-buffer buffer-name) (require 'term) (let ((program (read-from-minibuffer "Run program: " default-program))) (projectile-with-default-dir project (set-buffer (term-ansi-make-term buffer-name program)) (term-mode) (term-char-mode)))) (switch-to-buffer buffer-name))) ;;;; Engines for the package-backed terminals (defun projectile--vterm (&optional new-process other-window) "Invoke `vterm' in the project's root. Use argument NEW-PROCESS to indicate creation of a new process instead. Use argument OTHER-WINDOW to indicate whether the buffer should be displayed in a different window. Switch to the project specific term buffer if it already exists." (let* ((project (projectile-acquire-root)) (buffer (projectile-generate-process-name "vterm" new-process project))) (unless (require 'vterm nil 'noerror) (user-error "Package 'vterm' is not available")) (if (buffer-live-p (get-buffer buffer)) (if other-window (switch-to-buffer-other-window buffer) (switch-to-buffer buffer)) (projectile-with-default-dir project (if other-window (vterm-other-window buffer) (vterm buffer)))))) (defun projectile--eat (&optional new-process other-window) "Invoke `eat' in the project's root. Use argument NEW-PROCESS to indicate creation of a new process instead. Use argument OTHER-WINDOW to indicate whether the buffer should be displayed in a different window. Switch to the project specific eat buffer if it already exists." (let* ((project (projectile-acquire-root)) (eat-buffer-name (projectile-generate-process-name "eat" new-process project))) (unless (require 'eat nil 'noerror) (user-error "Package 'eat' is not available")) (projectile-with-default-dir project (if other-window (eat-other-window nil new-process) (eat nil new-process))))) (defun projectile--ghostel (&optional new-process other-window) "Invoke `ghostel' in the project's root. Use argument NEW-PROCESS to indicate creation of a new process instead. Use argument OTHER-WINDOW to indicate whether the buffer should be displayed in a different window. Switch to the project specific ghostel buffer if it already exists." (unless (require 'ghostel nil 'noerror) (user-error "Package 'ghostel' is not available")) (let* ((project (projectile-acquire-root)) (ghostel-buffer-name (projectile-generate-process-name "ghostel" new-process project)) (display-buffer-overriding-action (and other-window '((display-buffer-pop-up-window))))) (projectile-with-default-dir project (ghostel)))) ;;;; Shell backend registry (defvar projectile-shell-backends nil "Alist of registered `projectile-run' shell/REPL/terminal backends. Each entry is (NAME . PLIST); see `projectile-register-shell-backend'.") (defun projectile-register-shell-backend (name &rest plist) "Register NAME as a `projectile-run' backend with PLIST properties. Recognised PLIST keys: :description a human-readable string shown in prompts; :available a zero-argument predicate returning non-nil when the backend can be used (omit for an always-available one); :run a function called as (NEW-PROCESS OTHER-WINDOW) that launches the shell/REPL/terminal in the project root. NEW-PROCESS is the command's prefix argument (start a fresh process); OTHER-WINDOW requests display in another window (honoured by the terminals that support it). Use this to plug in your own terminal, e.g.: (projectile-register-shell-backend \\='mistty :description \"mistty\" :available (lambda () (require \\='mistty nil t)) :run (lambda (_new-process _other-window) (mistty-in-project)))" (apply #'projectile-register-backend 'projectile-shell-backends name plist)) (projectile-register-shell-backend 'shell :description "shell" :run #'projectile--run-shell) (projectile-register-shell-backend 'eshell :description "eshell" :run #'projectile--run-eshell) (projectile-register-shell-backend 'ielm :description "ielm (Emacs Lisp REPL)" :run #'projectile--run-ielm) (projectile-register-shell-backend 'term :description "term" :run #'projectile--run-term) (projectile-register-shell-backend 'vterm :description "vterm" :available (lambda () (require 'vterm nil 'noerror)) :run #'projectile--vterm) (projectile-register-shell-backend 'eat :description "eat" :available (lambda () (require 'eat nil 'noerror)) :run #'projectile--eat) (projectile-register-shell-backend 'ghostel :description "ghostel" :available (lambda () (require 'ghostel nil 'noerror)) :run #'projectile--ghostel) (defun projectile--run (preference new-process other-window) "Launch the shell backend PREFERENCE, passing NEW-PROCESS and OTHER-WINDOW. PREFERENCE is resolved against `projectile-shell-backends' the same way `projectile-search-backend' is (a name, `auto', or `prompt')." (funcall (plist-get (cdr (projectile--resolve-backend projectile-shell-backends preference "shell")) :run) new-process other-window)) ;;;###autoload (defun projectile-run (&optional arg) "Run a shell, REPL or terminal in the project root. The backend is chosen from `projectile-shell-backends' according to `projectile-shell-backend'; register new ones with `projectile-register-shell-backend'. With a prefix ARG, start a fresh process instead of reusing an existing one." (interactive "P") (projectile--run projectile-shell-backend arg nil)) ;;;###autoload (defun projectile-run-shell (&optional arg) "Invoke `shell' in the project's root (the shell `projectile-run' backend). Use a prefix argument ARG to indicate creation of a new process instead." (interactive "P") (projectile--run 'shell arg nil)) ;;;###autoload (defun projectile-run-eshell (&optional arg) "Invoke `eshell' in the project's root (the eshell `projectile-run' backend). Use a prefix argument ARG to indicate creation of a new process instead." (interactive "P") (projectile--run 'eshell arg nil)) ;;;###autoload (defun projectile-run-ielm (&optional arg) "Invoke `ielm' in the project's root (the ielm `projectile-run' backend). Use a prefix argument ARG to indicate creation of a new process instead." (interactive "P") (projectile--run 'ielm arg nil)) ;;;###autoload (defun projectile-run-term (&optional arg) "Invoke `term' in the project's root (the term `projectile-run' backend). Use a prefix argument ARG to indicate creation of a new process instead." (interactive "P") (projectile--run 'term arg nil)) ;;;###autoload (defun projectile-run-vterm (&optional arg) "Invoke `vterm' in the project's root (the vterm `projectile-run' backend). Use a prefix argument ARG to indicate creation of a new process instead." (interactive "P") (projectile--run 'vterm arg nil)) ;;;###autoload (autoload 'projectile-run-vterm-other-window "projectile" nil t) (projectile--define-display-variants projectile-run-vterm (&optional arg) "Invoke `vterm' in the project's root, displayed in another %s. Use a prefix argument ARG to indicate creation of a new process instead." :places (window) (projectile--run 'vterm arg t)) ;;;###autoload (defun projectile-run-eat (&optional arg) "Invoke `eat' in the project's root (the eat `projectile-run' backend). Use a prefix argument ARG to indicate creation of a new process instead." (interactive "P") (projectile--run 'eat arg nil)) ;;;###autoload (autoload 'projectile-run-eat-other-window "projectile" nil t) (projectile--define-display-variants projectile-run-eat (&optional arg) "Invoke `eat' in the project's root, displayed in another %s. Use a prefix argument ARG to indicate creation of a new process instead." :places (window) (projectile--run 'eat arg t)) ;;;###autoload (defun projectile-run-ghostel (&optional arg) "Invoke `ghostel' in the project's root (the ghostel `projectile-run' backend). Use a prefix argument ARG to indicate creation of a new process instead." (interactive "P") (projectile--run 'ghostel arg nil)) ;;;###autoload (autoload 'projectile-run-ghostel-other-window "projectile" nil t) (projectile--define-display-variants projectile-run-ghostel (&optional arg) "Invoke `ghostel' in the project's root, displayed in another %s. Use a prefix argument ARG to indicate creation of a new process instead." :places (window) (projectile--run 'ghostel arg t)) (defun projectile-files-from-cmd (cmd directory) "Use a grep-like CMD to search for files within DIRECTORY. CMD should include the necessary search params and should output equivalently to grep -HlI (only unique matching filenames). Returns a list of expanded filenames." (let ((default-directory directory)) (mapcar (lambda (str) ;; `expand-file-name' (rather than `concat') so the results ;; are in canonical form even when DIRECTORY is abbreviated ;; (e.g. "~/project/"), and thus comparable with other ;; expanded file names (#1115). (expand-file-name str directory)) (split-string (string-trim (shell-command-to-string cmd)) "\n+" t)))) ;; The listing is case-insensitive on purpose: it's only used to narrow ;; down the files to visit, and the actual (case-sensitive or smart-case) ;; matching happens in Emacs afterwards. A case-sensitive listing would ;; silently drop files that a case-insensitive replacement should have ;; touched (#1115). ;; ;; This alist is the customizable source of each tool's *base* command. ;; How the optional file-extension filter is layered on top lives in ;; `projectile--search-tool-descriptors', and both are combined by ;; `projectile--construct-files-with-string-command'. (defvar projectile-files-with-string-commands '((rg . "rg -liF --no-heading --color never ") (ag . "ag --literal --ignore-case --nocolor --noheading -l ") (ack . "ack --literal --ignore-case --nocolor -l ") (git . "git grep -HlIiF ") ;; -r: recursive ;; -H: show filename for each match ;; -l: show only file names with matches ;; -I: no binary files ;; -i: ignore case ;; -F: interpret pattern as fixed string, not regexp (grep . "grep -rHlIiF %s ."))) ;; One descriptor per search tool, capturing how the (optional) file ;; extension filter is expressed. Combined with the tool's base command ;; from `projectile-files-with-string-commands', this drives ;; `projectile--construct-files-with-string-command' so the five ;; per-tool constructors need not repeat the same skeleton. Keys: ;; ;; :kind how the filter attaches to the base command -- ;; `prefix' inserts it between the base and the search term ;; (rg, ag); `suffix' appends it after the whole command ;; (git, grep); `pipe' feeds a separate file listing into ;; the base command (ack). ;; :ext-regexp when non-nil, the extension glob is turned into an ;; anchored regexp via `projectile--search-glob-to-regexp' ;; (ag, ack) rather than passed through verbatim. ;; :ext-open text emitted just before the extension. ;; :ext-close text emitted just after the extension. ;; :term-format when non-nil, the base command is a format string whose ;; %s is the search term (grep) rather than a prefix the ;; term is concatenated onto. (defvar projectile--search-tool-descriptors '((rg . (:kind prefix :ext-open "-g '" :ext-close "' ")) (ag . (:kind prefix :ext-regexp t :ext-open "-G " :ext-close "$ ")) (ack . (:kind pipe :ext-regexp t)) (git . (:kind suffix :ext-open " -- '" :ext-close "'")) (grep . (:kind suffix :term-format t :ext-open " --include '" :ext-close "'")))) (defun projectile--search-glob-to-regexp (file-ext) "Turn extension glob FILE-EXT into the regexp body used by ag/ack. Dots are escaped and \"*\" wildcards dropped, e.g. \"*.el\" becomes \"\\.el\"; the caller anchors it with a trailing \"$\"." (replace-regexp-in-string "\\*" "" (replace-regexp-in-string "\\." "\\\\." file-ext))) (defun projectile--construct-files-with-string-command (tool search-term &optional file-ext) "Build TOOL's files-with-string command for SEARCH-TERM. The base command comes from `projectile-files-with-string-commands' and, when FILE-EXT is a string, the extension filter described by `projectile--search-tool-descriptors' is layered on top." (let* ((base (alist-get tool projectile-files-with-string-commands)) (desc (alist-get tool projectile--search-tool-descriptors)) (term-format (plist-get desc :term-format)) ;; the plain, no-extension command, shared by every :kind (core (if term-format (format base search-term) (concat base search-term)))) (if (not (stringp file-ext)) core (let ((ext (if (plist-get desc :ext-regexp) (projectile--search-glob-to-regexp file-ext) file-ext)) (open (plist-get desc :ext-open)) (close (plist-get desc :ext-close))) (pcase (plist-get desc :kind) ('prefix (concat base open ext close search-term)) ('suffix (concat core open ext close)) ('pipe (concat "ack -g '" ext "$' | " base "-x " search-term))))))) (defun projectile--rg-construct-command (search-term &optional file-ext) "Construct Rg option to search files by the extension FILE-EXT." (projectile--construct-files-with-string-command 'rg search-term file-ext)) (defun projectile--ag-construct-command (search-term &optional file-ext) "Construct Ag option to search files by the extension FILE-EXT." (projectile--construct-files-with-string-command 'ag search-term file-ext)) (defun projectile--ack-construct-command (search-term &optional file-ext) "Construct Ack option to search files by the extension FILE-EXT." (projectile--construct-files-with-string-command 'ack search-term file-ext)) (defun projectile--git-grep-construct-command (search-term &optional file-ext) "Construct Grep option to search files by the extension FILE-EXT." (projectile--construct-files-with-string-command 'git search-term file-ext)) (defun projectile--grep-construct-command (search-term &optional file-ext) "Construct Grep option to search files by the extension FILE-EXT." (projectile--construct-files-with-string-command 'grep search-term file-ext)) (defun projectile-files-with-string (string directory &optional file-ext) "Return a list of all files containing STRING in DIRECTORY. Tries to use rg, ag, ack, git-grep, and grep in that order. If those are impossible (for instance on Windows), returns a list of all files in the project." (if (projectile-unixy-system-p) (let* ((search-term (shell-quote-argument string)) (cmd (cond ((executable-find "rg") (projectile--rg-construct-command search-term file-ext)) ((executable-find "ag") (projectile--ag-construct-command search-term file-ext)) ((executable-find "ack") (projectile--ack-construct-command search-term file-ext)) ((and (executable-find "git") ;; DIRECTORY's VCS, not the current project's - ;; a group search asks about each member in turn (eq (projectile-project-vcs directory) 'git)) (projectile--git-grep-construct-command search-term file-ext)) (t (projectile--grep-construct-command search-term file-ext))))) (projectile-files-from-cmd cmd directory)) ;; we have to reject directories as a workaround to work with git submodules (seq-remove #'file-directory-p (mapcar #'(lambda (file) (expand-file-name file directory)) (projectile-dir-files directory))))) (defun projectile--replace-in-files (from to files) "Query-replace matches of the regexp FROM with TO in FILES. Buffers that are already visiting one of FILES are scanned from the beginning of the buffer; older Emacsen (< 28.1) would otherwise resume the scan from point in such buffers and silently skip any matches before it (#1677)." (dolist (file files) (when-let* ((buffer (get-file-buffer file))) (with-current-buffer buffer (goto-char (point-min))))) (fileloop-initialize-replace from to files 'default) (fileloop-continue)) ;;;###autoload (defun projectile-replace (&optional arg) "Replace a literal string in the project's files. With a prefix argument ARG prompts you for a directory and file name patterns on which to run the replacement." (interactive "P") (let* ((directory (if arg (file-name-as-directory (read-directory-name "Replace in directory: ")) (projectile-acquire-root))) (file-ext (if arg (if (fboundp #'helm-grep-get-file-extensions) (car (helm-grep-get-file-extensions (list directory))) (read-string (projectile-prepend-project-name "With file extension (empty string means all files): "))) nil)) (old-text (read-string (projectile-prepend-project-name "Replace: ") (projectile-symbol-or-selection-at-point))) (new-text (read-string (projectile-prepend-project-name (format "Replace %s with: " old-text)))) (files (projectile-files-with-string old-text directory file-ext)) ;; Filter results through the project's file list so that files ;; ignored via .projectile or other ignore rules are excluded. (project-files (mapcar (lambda (file) (expand-file-name file directory)) (projectile-dir-files directory))) (filtered-files (seq-filter (lambda (f) (member f project-files)) files))) (projectile--replace-in-files (regexp-quote old-text) new-text filtered-files))) ;;;###autoload (defun projectile-replace-regexp (&optional arg) "Replace a regexp in the project's files. With a prefix argument ARG prompts you for a directory on which to run the replacement." (interactive "P") (let* ((directory (if arg (file-name-as-directory (read-directory-name "Replace regexp in directory: ")) (projectile-acquire-root))) (old-text (read-string (projectile-prepend-project-name "Replace regexp: ") (projectile-symbol-or-selection-at-point))) (new-text (read-string (projectile-prepend-project-name (format "Replace regexp %s with: " old-text)))) (files ;; We have to reject directories as a workaround to work with git submodules. ;; We also reject nonexistent files to avoid errors during replacement. ;; ;; We can't narrow the list of files with ;; `projectile-files-with-string' because those regexp tools ;; don't support Emacs regular expressions. (seq-remove (lambda (f) (or (file-directory-p f) (not (file-exists-p f)))) (mapcar #'(lambda (file) (expand-file-name file directory)) (projectile-dir-files directory))))) (projectile--replace-in-files old-text new-text files))) ;;; Reviewable project-wide find-and-replace ;; ;; `projectile-replace' and `projectile-replace-regexp' above drive a ;; blocking, sequential query-replace walk with no preview. The commands ;; below add a results-buffer flow instead: gather every match up front, ;; render them in a read-only buffer where each match can be toggled on or ;; off, and apply only the enabled ones (in any order). Answers #1924. ;; ;; Matches are gathered in pure Emacs Lisp (not via grep) so that Emacs ;; regexp semantics are preserved for the regexp command and so the preview ;; reflects the exact text that will be edited, including unsaved changes in ;; already-open buffers. ;; ;; The write-back and buffer-refresh structure borrows from the GPL-3 ;; packages wgrep (`wgrep-commit-file') and color-rg (`color-rg-apply-changed'): ;; edits are applied from the highest buffer position downwards so earlier ;; edits don't invalidate later match offsets, live buffers are edited in ;; place under a single `atomic-change-group', and buffers modified since the ;; scan are skipped rather than corrupted. (define-obsolete-variable-alias 'projectile-replace-max-matches 'projectile-search-max-matches "3.4.0") (defcustom projectile-search-max-matches 5000 "Upper bound on how many matches a review buffer collects. Applies to `projectile-search-review' and `projectile-replace-review' alike. When a search would exceed this, only the first that many matches are shown and a note is displayed." :group 'projectile :type 'natnum :package-version '(projectile . "3.2.0")) (defcustom projectile-search-whole-word nil "Whether the reviewable search/replace start in whole-word mode. Seeds `projectile-replace--word' for a fresh `projectile-search-review' or `projectile-replace-review'; you can still toggle it per search with `w' in the results buffer, and the `projectile-dispatch' `--word' switch binds it for a single invocation." :group 'projectile :type 'boolean :package-version '(projectile . "3.2.0")) (define-obsolete-variable-alias 'projectile-replace-async 'projectile-search-async "3.4.0") (defcustom projectile-search-async t "Whether the reviewable search/replace commands scan asynchronously. When non-nil (the default) `projectile-replace-review', `projectile-search-review' and their in-buffer re-scan commands (`g', `c', `x') scan candidate files in timer-yielded chunks: the results buffer is shown right away, matches stream in as they are found, Emacs stays responsive, and the scan can be canceled (`q', \\`C-g', or by killing the buffer). While a scan is still running, applying (`!') and exporting (`e') refuse until it finishes so the write-back never runs against a partial match set. When nil the scan runs synchronously in one blocking pass instead. Regardless of this setting, in batch mode (`noninteractive') the scan is always synchronous so scripted runs stay deterministic. The final match set is identical whether scanning runs asynchronously or synchronously; async only changes when and how matches are delivered." :group 'projectile :type 'boolean :package-version '(projectile . "3.2.0")) (defcustom projectile-search-use-ripgrep t "Whether `projectile-search-review' accelerates literal search with ripgrep. When non-nil (the default) a literal `projectile-search-review' scan uses ripgrep (`rg') to find matches when the `rg' executable is available, which returns near-instantly even on a large project; otherwise, and always for the regexp search command and for every part of the replace reviewer, the portable pure-Emacs-Lisp scan is used. The ripgrep fast-path's result set follows ripgrep's own ignore rules \(`.gitignore', `.ignore', hidden-file handling, and so on) plus Projectile's ignore globs (`.projectile' and the globally-ignored files and directories, passed to `rg' via `--glob'), and skips matches in files that aren't valid UTF-8, so it can differ slightly from the pure-elisp path's `projectile-dir-files' set (for example in how hidden files or symlinks are treated). This is an accepted trade-off for speed; set this to nil to force the elisp scan, whose result set matches Projectile's ignore configuration exactly. The regexp search command always uses the elisp scan (ripgrep's regex syntax is not Emacs regexp syntax), and the whole replace reviewer always uses the elisp scan (its write-back needs the exact buffer positions the elisp scan records). A command that knows a ripgrep-syntax equivalent of its Emacs regexp can opt into the fast-path anyway, which is what `projectile-todos' does. In batch mode (`noninteractive') the elisp scan is used so scripted runs stay deterministic." :group 'projectile :type 'boolean :package-version '(projectile . "3.2.0")) (defcustom projectile-todo-keywords '("TODO" "FIXME" "HACK" "XXX" "BUG" "NOTE") "Annotation keywords `projectile-todos' collects across the project. Each keyword is matched as a whole word, case-sensitively, and must be followed by a colon, by whitespace or by the end of the line - so `TODO:' and `FIXME ' are hits while `TODOS' and `MASTODON' are not. Add your own project's conventions here (`REVIEW', `OPTIMIZE', `DEPRECATED', ...); `projectile-todos' with a prefix argument prompts for which of these to search for. The keywords are not required to sit in a comment: neither the pure-elisp scan nor the ripgrep fast-path parses the language, so an annotation in a string or in prose is reported too." :group 'projectile :type '(repeat string) :package-version '(projectile . "3.3.0")) (define-obsolete-variable-alias 'projectile-replace-scan-chunk-size 'projectile-search-scan-chunk-size "3.4.0") (defcustom projectile-search-scan-chunk-size 24 "Number of candidate files scanned per async chunk before yielding. Each chunk scans this many files, delivers the matches into the results buffer and re-renders, then yields to redisplay via a zero-delay timer before the next chunk. Larger values scan faster but redisplay less often; smaller values keep Emacs more responsive." :group 'projectile :type 'natnum :package-version '(projectile . "3.2.0")) (defface projectile-replace-file '((t :inherit font-lock-function-name-face :weight bold)) "Face for the per-file header lines in the replace results buffer." :group 'projectile :package-version '(projectile . "3.2.0")) (defface projectile-replace-match '((t :inherit match)) "Face for a matched span shown without a pending replacement." :group 'projectile :package-version '(projectile . "3.2.0")) (defface projectile-replace-old '((t :inherit diff-removed :strike-through t)) "Face for the old text of a match with a pending replacement." :group 'projectile :package-version '(projectile . "3.2.0")) (defface projectile-replace-new '((t :inherit diff-added)) "Face for the new text of a match with a pending replacement." :group 'projectile :package-version '(projectile . "3.2.0")) (defface projectile-replace-line-number '((t :inherit shadow)) "Face for the LINE:COL locator of each match." :group 'projectile :package-version '(projectile . "3.2.0")) (defface projectile-replace-header '((t :inherit font-lock-keyword-face :weight bold)) "Face for the status header line of the replace results buffer." :group 'projectile :package-version '(projectile . "3.2.0")) (defvar projectile-replace-buffer-name "*projectile-replace*" "Name of the buffer used by `projectile-replace-review'.") (cl-defstruct (projectile-replace--match (:constructor projectile-replace--match-create) (:copier nil)) "A single match collected for the reviewable replace UI." file ; absolute file name buffer ; live buffer visiting FILE, or nil when scanned from disk tick ; `buffer-chars-modified-tick' of BUFFER at scan time (or nil) line ; 1-based line number of the match column ; 0-based character offset of the match within its line beg ; buffer position of the match start (in BUFFER or a disk re-read) end ; buffer position of the match end string ; the matched text match-data ; copy of `(match-data t)' for the match (positions only) groups ; list of matched-group strings, index 0 = whole match context ; the whole line the match sits on enabled) ; non-nil when the match will be applied ;; Buffer-local state of a `*projectile-replace*' buffer. (defcustom projectile-search-render-interval 0.1 "Seconds to leave between redraws while search results stream in. The results buffer is redrawn from scratch, so a redraw costs time proportional to the matches found so far - about 1 ms at a hundred matches and 70 ms at five thousand. Redrawing on every chunk therefore costs roughly the number of chunks times the number of matches, which on a large search is most of the run rather than a detail of it. The redraw at the end of a scan is unconditional, so this only delays intermediate states. Set it to nil to redraw on every chunk." :group 'projectile :type '(choice (const :tag "Redraw on every chunk" nil) (number :tag "Seconds between redraws")) :package-version '(projectile . "3.5.0")) (defvar-local projectile-replace--last-render 0.0 "When this results buffer was last redrawn, as a `float-time'. Zero in a freshly seeded buffer, so the first chunk always draws.") (defvar-local projectile-replace--root nil "Directory the current results buffer's file names are shown relative to. For an ordinary search that is the project root; for a search over a group of projects it is the innermost directory containing all of them, so each match is labelled with the project it came from.") (defvar-local projectile-replace--projects nil "Project roots the current results buffer was gathered from. Always a list - a one-element one for an ordinary single-project search. This, not `projectile-replace--root', is what a re-scan re-reads, so re-searching a group of projects covers the same group again.") (defvar-local projectile-replace--term nil "Raw search term the current results buffer was gathered with.") (defvar-local projectile-replace--search nil "Emacs regexp actually searched for (the term, `regexp-quote'd if literal).") (defvar-local projectile-replace--replacement nil "Pending replacement string for the current results buffer.") (defvar-local projectile-replace--literal nil "Non-nil when the current results buffer is a literal (not regexp) replace.") (defvar-local projectile-replace--case-fold nil "Non-nil when the current search ignores case. Initialized from `case-fold-search' at the first search and bound around every (re-)gather so it drives which matches are collected.") (defvar-local projectile-replace--word nil "Non-nil when the current search only matches whole words. Initialized from `projectile-search-whole-word' at the first search; the scan regexp is fenced with word boundaries (and ripgrep gets `--word-regexp') while it holds.") (defvar-local projectile-replace--rg-pattern nil "A ripgrep-syntax equivalent of this buffer's search, or nil. Set by commands that build a non-literal search from a pattern they can also express in ripgrep's regex syntax (`projectile-todos'), so the read-only search reviewer's ripgrep fast-path can run for them too. Nil means the fast-path is only available to a literal search. Cleared when the search changes shape (the literal/regexp toggle), since the new search has no known ripgrep equivalent.") (defvar-local projectile-replace--matches nil "List of `projectile-replace--match' structs shown in the results buffer.") (defvar-local projectile-replace--truncated nil "Non-nil when the match list was capped at `projectile-search-max-matches'.") (defvar-local projectile-replace--filtered nil "Non-nil when the shown match list was pruned by a filter command. Re-searching (\\\\[projectile-replace--refresh]) gathers from scratch and clears this.") (defvar-local projectile-replace--scanning nil "Non-nil while an asynchronous scan is still filling this results buffer. While set, matches are streaming in, the header shows a progress note, and applying and exporting refuse (the write-back must never run against a partial match set). Cleared when the scan finishes or is canceled.") (defvar-local projectile-replace--scan-timer nil "The in-flight async scan timer for this results buffer, or nil. Held so a re-scan, a quit, or killing the buffer can cancel a scan that is still running.") (defvar-local projectile-replace--scan-process nil "The in-flight ripgrep subprocess filling this results buffer, or nil. Only the read-only search reviewer's ripgrep fast-path uses this; the pure-elisp async scan uses `projectile-replace--scan-timer' instead. Held so a re-scan, a quit, or killing the buffer can kill a scan that is still running, leaving no orphaned process.") (defvar-local projectile-replace--scan-generation 0 "Monotonic token identifying the current async scan of this buffer. Every (re-)scan and every cancel bumps it; a chunk timer carries the generation it was scheduled under and no-ops when it no longer matches. This way a timer that already fired and is waiting to run can't append to a newer scan's match list if it is superseded in the meantime.") (defvar-local projectile-replace--render-function #'projectile-replace--render "Function that redraws the current results buffer from its state. The scanning, navigation, filter and toggle machinery is shared between the replace reviewer and the read-only search reviewer (`projectile-search-mode'); this buffer-local seam lets those shared commands redraw with the current mode's renderer. It defaults to the replace renderer and search mode rebinds it to its own.") (defun projectile-replace--expand (replacement groups literal) "Expand REPLACEMENT for a match whose group strings are GROUPS. GROUPS is a list of matched substrings, index 0 being the whole match. When LITERAL is non-nil REPLACEMENT is returned verbatim; otherwise \\N and \\& references are expanded from GROUPS (\\\\ yields a backslash). The same expansion drives both the preview and the actual write-back so the two can never diverge." (if literal replacement (let ((result "") (i 0) (len (length replacement))) (while (< i len) (let ((ch (aref replacement i))) (if (and (eq ch ?\\) (< (1+ i) len)) (let ((next (aref replacement (1+ i)))) (cond ((eq next ?&) (setq result (concat result (or (nth 0 groups) "")))) ((and (>= next ?0) (<= next ?9)) (setq result (concat result (or (nth (- next ?0) groups) "")))) ((eq next ?\\) (setq result (concat result "\\"))) (t (setq result (concat result (char-to-string next))))) (setq i (+ i 2))) (setq result (concat result (char-to-string ch))) (setq i (1+ i))))) result))) (defun projectile-replace--capture-groups () "Return the matched-group strings for the last search in this buffer. Index 0 is the whole match; unmatched optional groups are nil." (let ((n (/ (length (match-data)) 2)) (groups nil)) (dotimes (i n) (push (match-string i) groups)) (nreverse groups))) (defun projectile-replace--binary-p () "Return non-nil when the current buffer looks like binary content. Only the leading portion is inspected, which is enough to skip files whose NUL bytes would make an in-buffer replacement meaningless." (save-excursion (goto-char (point-min)) (search-forward "\0" (min (point-max) (+ (point-min) 8000)) t))) (defun projectile-replace--scan-region (file buffer regexp budget) "Collect up to BUDGET matches of REGEXP in the current buffer. Each match is recorded as a `projectile-replace--match' tagged with FILE and BUFFER (nil when scanning a disk re-read)." (let ((matches nil) (count 0) (done nil) (tick (and buffer (buffer-chars-modified-tick buffer)))) (save-excursion (goto-char (point-min)) (while (and (not done) (< count budget) (re-search-forward regexp nil t)) (if (= (match-beginning 0) (match-end 0)) ;; A regexp that can match the empty string (e.g. `^', `a*') ;; leaves point put; advance past it, but at end-of-buffer there ;; is nowhere to advance, so stop rather than spin forever. (if (eobp) (setq done t) (forward-char 1)) (let ((beg (match-beginning 0)) (end (match-end 0)) (md (match-data t)) (groups (projectile-replace--capture-groups)) line lstart col context) (save-excursion (goto-char beg) (setq line (line-number-at-pos) lstart (line-beginning-position) col (- beg lstart) context (buffer-substring-no-properties lstart (line-end-position)))) (push (projectile-replace--match-create :file file :buffer buffer :tick tick :line line :column col :beg beg :end end :string (buffer-substring-no-properties beg end) :match-data md :groups groups :context context :enabled t) matches) (cl-incf count))))) (nreverse matches))) (defun projectile-replace--scan-file (file regexp budget) "Return up to BUDGET matches of REGEXP in FILE. A file visited in a live buffer is scanned from that buffer's current text (so the preview matches what will be edited, even when the buffer has unsaved changes); otherwise it is read from disk into a temp buffer. Binary-looking and unreadable files are skipped." ;; Capture the intended `case-fold-search' (bound dynamically around the ;; gather) before entering a live buffer, then re-establish it there: some ;; major modes make `case-fold-search' buffer-local, which would otherwise ;; shadow the dynamic binding and make the case toggle a no-op for that file. (let ((buffer (get-file-buffer file)) (fold case-fold-search)) (if buffer (with-current-buffer buffer (let ((case-fold-search fold)) (projectile-replace--scan-region file buffer regexp budget))) (condition-case nil (with-temp-buffer ;; Read what is on disk. `insert-file-contents' dispatches ;; through `file-name-handler-alist', so jka-compr decompresses ;; every archive in the candidate set and EPA decrypts every ;; `.gpg' - work thrown away a line later when the result is ;; classified as binary, and which on an encrypted file can stop ;; the whole search on a passphrase prompt. Only those two ;; handlers are inhibited, so a remote project still reads ;; through TRAMP. (let ((inhibit-file-name-handlers (append '(jka-compr-handler epa-file-handler) inhibit-file-name-handlers)) (inhibit-file-name-operation 'insert-file-contents)) (insert-file-contents file)) (unless (projectile-replace--binary-p) (let ((case-fold-search fold)) (projectile-replace--scan-region file nil regexp budget)))) (error nil))))) (defun projectile-replace--gather (candidates regexp) "Scan CANDIDATES for REGEXP, capped at `projectile-search-max-matches'. Return a plist with `:matches' (the collected structs, in file order) and `:truncated' (non-nil when the cap was hit)." (let ((all nil) (budget projectile-search-max-matches) (truncated nil)) (dolist (file candidates) (if (> budget 0) (let ((ms (projectile-replace--scan-file file regexp budget))) (setq all (append all ms) budget (- budget (length ms)))) ;; a candidate was left unscanned because the cap was already hit (setq truncated t))) (list :matches all :truncated truncated))) ;;; Asynchronous, cancelable scanning ;; ;; The synchronous `projectile-replace--gather' above stays the primitive that ;; batch runs and the tests drive. The async driver below reuses the very same ;; per-file `projectile-replace--scan-file', so the structs it produces are ;; identical to what `--gather' would produce over the same candidate list and ;; regexp - only the DELIVERY changes: files are scanned in timer-yielded ;; chunks, matches stream into the results buffer as they are found, and the ;; scan can be canceled. The `case-fold-search' that `--scan-file' reads is ;; re-established from the buffer's `projectile-replace--case-fold' inside each ;; chunk (the dynamic binding used by the sync path is gone once we run from a ;; timer). (defun projectile-replace--async-p () "Return non-nil when scanning should run asynchronously. True when `projectile-search-async' is set and we are interactive; batch (`noninteractive') always scans synchronously so scripted runs stay deterministic." (and projectile-search-async (not noninteractive))) (defun projectile-replace--cancel-scan () "Cancel any in-flight async scan in the current results buffer. Kills the pending chunk timer (if any) and clears the scanning flag, so no timer is left dangling. Safe to call when nothing is scanning; used on re-scan, on quit, and from `kill-buffer-hook'." (when projectile-replace--scan-timer (cancel-timer projectile-replace--scan-timer)) (when (process-live-p projectile-replace--scan-process) ;; drop our sentinel first so killing it doesn't run the finish handler (set-process-sentinel projectile-replace--scan-process #'ignore) (delete-process projectile-replace--scan-process)) ;; Bump the generation so a chunk timer that already fired and is queued ;; behind us no-ops rather than resurrecting this scan. (cl-incf projectile-replace--scan-generation) (setq projectile-replace--scan-timer nil projectile-replace--scan-process nil projectile-replace--scanning nil)) (defun projectile-replace--gather-async (candidates regexp buffer on-done) "Scan CANDIDATES for REGEXP into BUFFER incrementally, then call ON-DONE. Resets BUFFER's match list and scanning state, then processes CANDIDATES in `projectile-search-scan-chunk-size' batches, each batch delivering its matches and re-rendering before yielding to redisplay via a zero-delay timer. Matches accumulate in file order, so the final list is identical to `projectile-replace--gather' over the same CANDIDATES and REGEXP; `projectile-search-max-matches' and the `:truncated' note are honored the same way. ON-DONE (or nil) is called in BUFFER once the scan finishes. A scan already running in BUFFER should be canceled first (see `projectile-replace--cancel-scan')." (let ((generation (with-current-buffer buffer (setq projectile-replace--matches nil projectile-replace--truncated nil projectile-replace--filtered nil projectile-replace--scanning t projectile-replace--scan-timer nil) (cl-incf projectile-replace--scan-generation)))) (projectile-replace--scan-step buffer candidates regexp projectile-search-max-matches on-done generation))) (defun projectile-replace--scan-step (buffer remaining regexp budget on-done generation) "Scan one chunk of REMAINING candidates for REGEXP into BUFFER. BUDGET is the remaining match allowance. GENERATION is the scan token this chunk belongs to; the step no-ops when it no longer matches BUFFER's current `projectile-replace--scan-generation' (i.e. the scan was superseded or canceled). Delivers this chunk's matches into BUFFER and re-renders; while candidates and budget remain it schedules itself for the next chunk via a zero-delay timer, otherwise it finishes: clears the scanning state, does a final render and calls ON-DONE. Guarded against a killed BUFFER (leaving no work behind) and against \\`C-g' during a chunk \(which cancels the scan cleanly)." (when (and (buffer-live-p buffer) (= generation (buffer-local-value 'projectile-replace--scan-generation buffer))) (condition-case nil (let ((fold (buffer-local-value 'projectile-replace--case-fold buffer)) (count 0) (new nil) (truncated nil) (stop nil)) ;; scan up to a chunk of files, mirroring the sync `--gather' loop: ;; a file is scanned while budget remains; the first file reached ;; with the budget exhausted marks the list truncated and stops. (while (and remaining (not stop) (< count projectile-search-scan-chunk-size)) (if (> budget 0) (let ((ms (let ((case-fold-search fold)) (projectile-replace--scan-file (car remaining) regexp budget)))) (setq new (append new ms) budget (- budget (length ms)) remaining (cdr remaining))) (setq truncated t stop t)) (cl-incf count)) (with-current-buffer buffer (when new (setq projectile-replace--matches (append projectile-replace--matches new))) (when truncated (setq projectile-replace--truncated t))) (if (and remaining (not stop)) ;; more to do: show progress and yield to redisplay (with-current-buffer buffer ;; schedule the next chunk BEFORE rendering, so a render error ;; can't strand the scan with the flag set and no pending timer (setq projectile-replace--scan-timer (run-with-timer 0 nil #'projectile-replace--scan-step buffer remaining regexp budget on-done generation)) (projectile-replace--render-progress)) ;; finished (or budget-truncated): settle and hand off (with-current-buffer buffer (setq projectile-replace--scanning nil projectile-replace--scan-timer nil) (projectile-replace--render-preserve) (when on-done (funcall on-done buffer))))) (quit (when (buffer-live-p buffer) (with-current-buffer buffer (projectile-replace--cancel-scan) (funcall projectile-replace--render-function))))))) (defun projectile-replace--ensure-not-scanning () "Refuse with a `user-error' when the results buffer is still scanning. The write-back and export must never run against a partial match set." (when projectile-replace--scanning (user-error "Still searching; wait for the scan to finish"))) (defun projectile-replace--candidates (term literal case-fold directories) "Return the files under DIRECTORIES worth scanning for TERM. DIRECTORIES is a project root, or a list of them for a search spanning a group of projects, in which case each contributes its own file list and the result is de-duplicated - two members of a group can nest (a monorepo and a project inside it), and a file scanned twice would be replaced twice, corrupting it. For a case-sensitive LITERAL search this narrows to files that contain TERM, via `projectile-files-with-string' - which matches case-insensitively, so the narrowed set is a safe superset that the scan then filters exactly - intersected with the project's ignore-aware file list. For a regexp search, or a case-insensitive literal search, it returns the whole ignore-aware file list, since those can't be narrowed by an external grep this way." (delete-dups (mapcan (lambda (directory) (let ((project-files (mapcar (lambda (f) (expand-file-name f directory)) (projectile-dir-files directory)))) (if (and literal (not case-fold)) (seq-filter (lambda (f) (member f project-files)) (projectile-files-with-string term directory)) (seq-remove (lambda (f) (or (file-directory-p f) (not (file-exists-p f)))) project-files)))) ;; a recorded group can name a directory that has since been moved away (seq-filter #'projectile--directory-p (ensure-list directories))))) ;;; Results buffer rendering (defun projectile-replace--file-header (file root count) "Return a propertized header line for FILE relative to ROOT with COUNT matches." (propertize (concat (propertize (file-relative-name file root) 'face 'projectile-replace-file) (format " (%d)\n" count)) 'projectile-replace-file file)) (defun projectile-replace--render-line (m replacement literal) "Return the propertized results line for match M. When REPLACEMENT is non-empty and M is enabled the matched text is shown struck out followed by the expanded replacement; LITERAL selects verbatim vs. capture-group expansion. The whole line carries the match struct under the `projectile-replace-match' text property." (let* ((enabled (projectile-replace--match-enabled m)) (col (projectile-replace--match-column m)) (ctx (projectile-replace--match-context m)) (mstr (projectile-replace--match-string m)) (before (substring ctx 0 (min col (length ctx)))) (after (if (<= (+ col (length mstr)) (length ctx)) (substring ctx (+ col (length mstr))) "")) (has-repl (and replacement (not (string-empty-p replacement)))) (highlight (if (and enabled has-repl) (concat (propertize mstr 'face 'projectile-replace-old) (propertize (projectile-replace--expand replacement (projectile-replace--match-groups m) literal) 'face 'projectile-replace-new)) (propertize mstr 'face 'projectile-replace-match))) (indicator (if enabled " [X] " " [ ] ")) (locator (propertize (format "%d:%d: " (projectile-replace--match-line m) (1+ col)) 'face 'projectile-replace-line-number)) (line (concat indicator locator before highlight after "\n"))) (propertize line 'projectile-replace-match m))) (defun projectile-replace--header-string () "Return the propertized status header for the results buffer. Shows the term, the replacement (or \"(none)\"), the match and file counts, the mode flags (regexp/literal and case), and a note when the list has been filtered. The header carries no `projectile-replace-match' property, so match navigation skips it." (let* ((matches projectile-replace--matches) (nmatches (length matches)) (seen (make-hash-table :test 'equal)) (repl (if (and projectile-replace--replacement (not (string-empty-p projectile-replace--replacement))) (format "%S" projectile-replace--replacement) "(none)")) nfiles flags) (dolist (m matches) (puthash (projectile-replace--match-file m) t seen)) (setq nfiles (hash-table-count seen) flags (concat (if projectile-replace--literal "[literal]" "[regexp]") " " (if projectile-replace--case-fold "[ignore-case]" "[case-sensitive]") (if projectile-replace--word " [word]" "") (if projectile-replace--filtered " filtered" "") (projectile-replace--scanning-note nmatches))) (propertize (format "Replace %S with %s\n%d match%s in %d file%s %s\n" projectile-replace--term repl nmatches (if (= nmatches 1) "" "es") nfiles (if (= nfiles 1) "" "s") flags) 'face 'projectile-replace-header))) (defun projectile-replace--scanning-note (nmatches) "Return a progress note for a results buffer still scanning, else \"\". NMATCHES is the count found so far. Shown in the status header while an async scan streams matches in." (if projectile-replace--scanning (format " Searching... %d match%s so far" nmatches (if (= nmatches 1) "" "es")) "")) (defun projectile-replace--render () "Redraw the current results buffer from its buffer-local state." (let ((inhibit-read-only t) (root projectile-replace--root) (replacement projectile-replace--replacement) (literal projectile-replace--literal) (matches projectile-replace--matches) (counts (make-hash-table :test 'equal)) (prev-file nil)) (dolist (m matches) (cl-incf (gethash (projectile-replace--match-file m) counts 0))) (erase-buffer) (insert (projectile-replace--header-string)) (insert (substitute-command-keys (concat "\\" "\\[projectile-replace--toggle] toggle " "\\[projectile-replace--toggle-file] toggle file " "\\[projectile-replace--set-replacement] set replacement " "\\[projectile-replace--apply] apply " "\\[projectile-replace--export] export " "\\[projectile-replace--refresh] re-search " "\\[projectile-replace--visit] visit " "\\[projectile-replace--quit] quit\n" "\\[projectile-replace--toggle-case] case " "\\[projectile-replace--toggle-regexp] regexp/literal " "\\[projectile-replace--toggle-word] word " "\\[projectile-replace--keep-matches]/\\[projectile-replace--flush-matches] keep/flush line " "\\[projectile-replace--keep-files]/\\[projectile-replace--flush-files] keep/flush file\n\n"))) (if (null matches) (insert "No matches.\n") (dolist (m matches) (let ((file (projectile-replace--match-file m))) (unless (equal prev-file file) (when prev-file (insert "\n")) (setq prev-file file) (insert (projectile-replace--file-header file root (gethash file counts)))) (insert (projectile-replace--render-line m replacement literal))))) (when projectile-replace--truncated (insert (format "\n(showing the first %d matches)\n" projectile-search-max-matches))) (goto-char (point-min)))) (defun projectile-replace--render-preserve () "Redraw the results buffer, keeping point on the same line. Restoring by line rather than by position is what makes this safe while a scan is streaming: matches are appended and a file header keeps its line count when its tally grows, so the lines already on screen do not move." (let ((line (line-number-at-pos))) (funcall projectile-replace--render-function) (goto-char (point-min)) (forward-line (1- line)))) ;;; Results buffer commands (defun projectile-replace--match-at-point () "Return the match struct on the current line, or nil." (get-text-property (line-beginning-position) 'projectile-replace-match)) (defun projectile-replace--goto-next-match () "Move point to the next match line." (interactive) (let ((start (point))) (forward-line 1) (while (and (not (eobp)) (not (projectile-replace--match-at-point))) (forward-line 1)) (if (projectile-replace--match-at-point) (beginning-of-line) (goto-char start) (message "No more matches")))) (defun projectile-replace--goto-prev-match () "Move point to the previous match line." (interactive) (let ((start (point))) (forward-line -1) (while (and (not (bobp)) (not (projectile-replace--match-at-point))) (forward-line -1)) (if (projectile-replace--match-at-point) (beginning-of-line) (goto-char start) (message "No previous matches")))) (defun projectile-replace--goto-next-file () "Move point to the next file header." (interactive) (let ((start (point))) (forward-line 1) (while (and (not (eobp)) (not (get-text-property (line-beginning-position) 'projectile-replace-file))) (forward-line 1)) (if (get-text-property (line-beginning-position) 'projectile-replace-file) (beginning-of-line) (goto-char start) (message "No more files")))) (defun projectile-replace--goto-prev-file () "Move point to the previous file header." (interactive) (let ((start (point))) (forward-line -1) (while (and (not (bobp)) (not (get-text-property (line-beginning-position) 'projectile-replace-file))) (forward-line -1)) (if (get-text-property (line-beginning-position) 'projectile-replace-file) (beginning-of-line) (goto-char start) (message "No previous files")))) (defun projectile-replace--visit () "Visit the match on the current line in another window." (interactive) (let ((m (projectile-replace--match-at-point))) (unless m (user-error "No match on this line")) (let ((buf (or (projectile-replace--match-buffer m) (find-file-noselect (projectile-replace--match-file m)))) (line (projectile-replace--match-line m)) (col (projectile-replace--match-column m))) (switch-to-buffer-other-window buf) (goto-char (point-min)) (forward-line (1- line)) (forward-char (min col (- (line-end-position) (point))))))) (defun projectile-replace--toggle () "Toggle whether the match on the current line will be applied." (interactive) (let ((m (projectile-replace--match-at-point))) (unless m (user-error "No match on this line")) (setf (projectile-replace--match-enabled m) (not (projectile-replace--match-enabled m))) (projectile-replace--render-preserve))) (defun projectile-replace--toggle-file () "Toggle all matches in the file of the match on the current line. If any of the file's matches are enabled they are all disabled; otherwise they are all enabled." (interactive) (let ((m (projectile-replace--match-at-point))) (unless m (user-error "No match on this line")) (let* ((file (projectile-replace--match-file m)) (fmatches (cl-remove-if-not (lambda (x) (equal (projectile-replace--match-file x) file)) projectile-replace--matches)) (target (not (cl-every #'projectile-replace--match-enabled fmatches)))) (dolist (x fmatches) (setf (projectile-replace--match-enabled x) target))) (projectile-replace--render-preserve))) (defun projectile-replace--set-replacement () "Re-read the replacement string and re-render the previews." (interactive) (setq projectile-replace--replacement (read-string (format "Replace %s with: " projectile-replace--term) projectile-replace--replacement)) (projectile-replace--render-preserve)) (defun projectile-replace--regather () "Re-run the search from scratch into the buffer-local match list. Cancels any in-flight scan first, then re-scans (asynchronously when `projectile-replace--async-p' holds, else synchronously) with `case-fold-search' honoring `projectile-replace--case-fold', clearing any active filter because the list is rebuilt from every match in the project. Because the match list is rebuilt, every match comes back enabled: re-scanning (via `g', the case toggle, or the regexp toggle) resets any per-match include or exclude toggles you had set. Use the filter commands instead to prune the list while preserving the survivors' state. The re-render happens from the (streaming) scan, so callers need not render again." (let* ((term projectile-replace--term) (literal projectile-replace--literal) (case-fold projectile-replace--case-fold) (projects projectile-replace--projects) (candidates (lambda () (projectile-replace--candidates term literal case-fold projects)))) (setq projectile-replace--filtered nil) (projectile-replace--start (current-buffer) candidates projectile-replace--search nil))) (defun projectile-replace--refresh () "Re-run the search and redraw the results buffer. This gathers from scratch, so any filtering is undone and matches removed by a filter command reappear." (interactive) (projectile-replace--regather)) (defun projectile-replace--toggle-case () "Toggle case sensitivity of the search, re-scan, and re-render." (interactive) (setq projectile-replace--case-fold (not projectile-replace--case-fold)) (projectile-replace--regather) (message "%s" (projectile-prepend-project-name (if projectile-replace--case-fold "search now ignores case" "search now case-sensitive")))) (defun projectile-replace--valid-regexp-p (regexp) "Return non-nil when REGEXP is a valid Emacs regexp." (condition-case nil (progn (string-match-p regexp "") t) (error nil))) (defun projectile-replace--toggle-regexp () "Toggle between literal and regexp search, re-scan, and re-render. Switching to regexp mode with a term that is not a valid regexp is refused with a message so the buffer stays usable rather than erroring." (interactive) (let ((new-literal (not projectile-replace--literal))) (if (and (not new-literal) (not (projectile-replace--valid-regexp-p projectile-replace--term))) (message "%s" (projectile-prepend-project-name (format "%S is not a valid regexp; staying literal" projectile-replace--term))) (setq projectile-replace--literal new-literal projectile-replace--search (if new-literal (regexp-quote projectile-replace--term) projectile-replace--term) ;; the ripgrep equivalent (if any) described the old search projectile-replace--rg-pattern nil) (projectile-replace--regather) (message "%s" (projectile-prepend-project-name (if new-literal "literal search" "regexp search")))))) (defun projectile-replace--toggle-word () "Toggle whole-word matching of the search, re-scan, and re-render." (interactive) (setq projectile-replace--word (not projectile-replace--word)) (projectile-replace--regather) (message "%s" (projectile-prepend-project-name (if projectile-replace--word "search now matches whole words only" "search now matches anywhere")))) (defun projectile-replace--filter-by (predicate) "Keep only matches satisfying PREDICATE, mark the list filtered, re-render. The removed matches are recoverable by re-searching (\\\\[projectile-replace--refresh]), which gathers from scratch. Refused while a scan is still streaming in, since a later chunk would append past the filter and leave an incoherent list." (projectile-replace--ensure-not-scanning) (setq projectile-replace--matches (cl-remove-if-not predicate projectile-replace--matches) projectile-replace--filtered t) (funcall projectile-replace--render-function)) (defun projectile-replace--line-matches-p (m regexp) "Return non-nil when match M's context line matches REGEXP. Honors the buffer's case setting." (let ((case-fold-search projectile-replace--case-fold)) (string-match-p regexp (projectile-replace--match-context m)))) (defun projectile-replace--file-matches-p (m regexp) "Return non-nil when match M's project-relative file matches REGEXP. Honors the buffer's case setting." (let ((case-fold-search projectile-replace--case-fold)) (string-match-p regexp (file-relative-name (projectile-replace--match-file m) projectile-replace--root)))) (defun projectile-replace--keep-matches (regexp) "Keep only matches whose context line matches REGEXP." (interactive (list (read-regexp "Keep matches whose line matches regexp"))) (projectile-replace--filter-by (lambda (m) (projectile-replace--line-matches-p m regexp)))) (defun projectile-replace--flush-matches (regexp) "Remove matches whose context line matches REGEXP." (interactive (list (read-regexp "Flush matches whose line matches regexp"))) (projectile-replace--filter-by (lambda (m) (not (projectile-replace--line-matches-p m regexp))))) (defun projectile-replace--keep-files (regexp) "Keep only matches whose project-relative file matches REGEXP." (interactive (list (read-regexp "Keep matches whose file matches regexp"))) (projectile-replace--filter-by (lambda (m) (projectile-replace--file-matches-p m regexp)))) (defun projectile-replace--flush-files (regexp) "Remove matches whose project-relative file matches REGEXP." (interactive (list (read-regexp "Flush matches whose file matches regexp"))) (projectile-replace--filter-by (lambda (m) (not (projectile-replace--file-matches-p m regexp))))) ;;; Applying the enabled matches (defun projectile-replace--do-one (m replacement literal) "Replace match M in the current buffer with the expansion of REPLACEMENT. LITERAL selects verbatim vs. capture-group expansion. M's stored `match-data' must still be valid for the current buffer." (set-match-data (projectile-replace--match-match-data m)) (replace-match (projectile-replace--expand replacement (projectile-replace--match-groups m) literal) t t)) (defun projectile-replace--positions-valid-p (matches) "Return non-nil when every match in MATCHES still spans its recorded text. Checked against the current buffer. This is the authoritative guard against stale positions: if the file changed on disk, or the live buffer was edited, since the scan, the recorded spans no longer hold the matched text and applying them would corrupt unrelated bytes." (cl-every (lambda (m) (let ((beg (projectile-replace--match-beg m)) (end (projectile-replace--match-end m))) (and (integerp beg) (integerp end) (<= (point-min) beg end (point-max)) (string= (buffer-substring-no-properties beg end) (projectile-replace--match-string m))))) matches)) (defun projectile-replace--skip (name reason) "Warn that NAME is skipped for REASON and return the symbol `skipped'." (message "%s" (projectile-prepend-project-name (format "skipping %s (%s)" name reason))) 'skipped) (cl-defstruct (projectile-replace--undo-edit (:constructor projectile-replace--undo-edit-create) (:copier nil)) "One replacement that was actually written, recorded so it can be reverted." beg ; position of the written text, with every earlier edit in the file in old ; the text that was there before new) ; the text the replace wrote (cl-defstruct (projectile-replace--undo-record (:constructor projectile-replace--undo-record-create) (:copier nil)) "Everything needed to revert one applied project-wide replace." root ; project root the replace ran in term ; the search term it ran with replacement ; the replacement it wrote files) ; alist of (FILE . list of `projectile-replace--undo-edit') (defvar projectile-replace--last-apply nil "Record of the most recent applied replace, or nil when there is none. Holds a `projectile-replace--undo-record' describing exactly what `projectile-replace--apply' wrote - files it skipped contribute nothing - which is what `projectile-replace-undo' reverts. Deliberately one global record rather than a per-project stack: this is insurance against the last replace going wrong, not a history. Every apply that writes something supersedes it, a fully successful undo clears it, and it lives only for the current Emacs session.") (defun projectile-replace--undo-edits (matches replacement literal) "Return the undo edits produced by applying MATCHES with REPLACEMENT. MATCHES all belong to one file or buffer. Each edit records where its written text ends up once every edit before it in the same file has been made, so reverting them from the bottom up needs no rescan. LITERAL selects verbatim vs. capture-group expansion, so the recorded text is exactly what `projectile-replace--do-one' writes." (let ((ascending (sort (copy-sequence matches) (lambda (a b) (< (projectile-replace--match-beg a) (projectile-replace--match-beg b))))) (offset 0) (edits nil)) (dolist (m ascending) (let ((old (projectile-replace--match-string m)) (new (projectile-replace--expand replacement (projectile-replace--match-groups m) literal))) (push (projectile-replace--undo-edit-create :beg (+ (projectile-replace--match-beg m) offset) :old old :new new) edits) (setq offset (+ offset (- (length new) (length old)))))) (nreverse edits))) (defun projectile-replace--apply-file (file matches replacement literal) "Apply MATCHES in FILE and return its undo edits, or the symbol `skipped'. Edits run from the highest buffer position downwards so earlier edits don't shift later matches. The live buffer visiting FILE (if any) is re-resolved now rather than trusted from scan time, so a file opened since the scan is edited in its buffer instead of being clobbered on disk, and a scan-time buffer that has since been killed is handled. In either case the recorded positions are verified to still span the matched text; if not (the file or buffer changed since the scan) the file is skipped rather than corrupted. A clean buffer is saved; a buffer with unsaved changes is edited but left for the user to save. The returned edits describe what was really written, and feed `projectile-replace-undo'." (let* ((descending (sort (copy-sequence matches) (lambda (a b) (> (projectile-replace--match-beg a) (projectile-replace--match-beg b))))) (buffer (get-file-buffer file))) (if (buffer-live-p buffer) (with-current-buffer buffer (if (not (projectile-replace--positions-valid-p descending)) (projectile-replace--skip (buffer-name buffer) "changed since scan") (let ((was-modified (buffer-modified-p))) (save-excursion (save-restriction (widen) (atomic-change-group (dolist (m descending) (projectile-replace--do-one m replacement literal))))) ;; don't silently save a buffer that already had unsaved edits (unless was-modified (let ((require-final-newline nil)) (save-buffer))) (projectile-replace--undo-edits matches replacement literal)))) (with-temp-buffer (insert-file-contents file) (let ((coding last-coding-system-used)) (if (not (projectile-replace--positions-valid-p descending)) (projectile-replace--skip (file-name-nondirectory file) "changed on disk since scan") (dolist (m descending) (projectile-replace--do-one m replacement literal)) (let ((coding-system-for-write coding)) (write-region (point-min) (point-max) file nil 'no-message)) (projectile-replace--undo-edits matches replacement literal))))))) (defun projectile-replace--apply () "Apply every enabled match, grouped by file, then re-run the search. What actually got written is recorded in `projectile-replace--last-apply' so `projectile-replace-undo' can revert it." (interactive) (projectile-replace--ensure-not-scanning) (let ((enabled (cl-remove-if-not #'projectile-replace--match-enabled projectile-replace--matches)) (replacement projectile-replace--replacement) (literal projectile-replace--literal) (root projectile-replace--root) (term projectile-replace--term) (groups (make-hash-table :test 'equal)) (order nil) (applied nil) (nfiles 0) (nrepl 0) (skipped 0)) (when (null enabled) (user-error "No matches are enabled")) ;; group the enabled matches by file, preserving first-seen order (dolist (m enabled) (let ((file (projectile-replace--match-file m))) (unless (gethash file groups) (push file order)) (push m (gethash file groups)))) (dolist (file (nreverse order)) ;; isolate each file: a read-only file or a write error must not abort ;; the batch (leaving earlier files edited and no summary shown) (let ((result (condition-case err (projectile-replace--apply-file file (gethash file groups) replacement literal) (error (projectile-replace--skip (file-name-nondirectory file) (error-message-string err)))))) (if (eq result 'skipped) (cl-incf skipped) (push (cons file result) applied) (cl-incf nfiles) (cl-incf nrepl (length result))))) ;; an apply that wrote nothing leaves the previous record alone - there's ;; nothing new to undo, and dropping it would lose a still-valid undo (when applied (setq projectile-replace--last-apply (projectile-replace--undo-record-create :root root :term term :replacement replacement :files (nreverse applied)))) (message "%s" (projectile-prepend-project-name (format "Replaced %d occurrence%s in %d file%s%s" nrepl (if (= nrepl 1) "" "s") nfiles (if (= nfiles 1) "" "s") (if (> skipped 0) (format " (skipped %d file%s)" skipped (if (= skipped 1) "" "s")) "")))) (projectile-replace--refresh))) ;;; Undoing the last applied replace (defun projectile-replace--undo-valid-p (edits) "Return non-nil when EDITS still span exactly the text the replace wrote. Checked against the current buffer. This is the guard that keeps an undo from corrupting a file that moved on since the replace: unless every recorded span still holds the written text, verbatim, the file is left alone." (cl-every (lambda (e) (let* ((beg (projectile-replace--undo-edit-beg e)) (new (projectile-replace--undo-edit-new e)) (end (+ beg (length new)))) (and (<= (point-min) beg end (point-max)) (string= (buffer-substring-no-properties beg end) new)))) edits)) (defun projectile-replace--undo-one (e) "Put back the text edit E replaced, in the current buffer." (let ((beg (projectile-replace--undo-edit-beg e))) (goto-char beg) (delete-region beg (+ beg (length (projectile-replace--undo-edit-new e)))) (insert (projectile-replace--undo-edit-old e)))) (defun projectile-replace--undo-file (file edits) "Revert EDITS in FILE and return the count, or the symbol `skipped'. Mirrors `projectile-replace--apply-file' in every respect: edits are reverted from the highest position downwards, the live buffer visiting FILE is re-resolved now (so an undo never writes a file behind the back of a buffer visiting it), a clean buffer is saved and a modified one is left for the user, and closed files are rewritten with their own coding system. A file is reverted only if all of its edits still verify, so it comes back whole or not at all." (let ((descending (sort (copy-sequence edits) (lambda (a b) (> (projectile-replace--undo-edit-beg a) (projectile-replace--undo-edit-beg b))))) (buffer (get-file-buffer file))) (if (buffer-live-p buffer) (with-current-buffer buffer (if (not (projectile-replace--undo-valid-p descending)) (projectile-replace--skip (buffer-name buffer) "changed since the replace") (let ((was-modified (buffer-modified-p))) (save-excursion (save-restriction (widen) (atomic-change-group (mapc #'projectile-replace--undo-one descending)))) ;; same rule as applying: a buffer that had unsaved changes of ;; its own is edited but not saved on the user's behalf (unless was-modified (let ((require-final-newline nil)) (save-buffer))) (length edits)))) (with-temp-buffer (insert-file-contents file) (let ((coding last-coding-system-used)) (if (not (projectile-replace--undo-valid-p descending)) (projectile-replace--skip (file-name-nondirectory file) "changed on disk since the replace") (mapc #'projectile-replace--undo-one descending) (let ((coding-system-for-write coding)) (write-region (point-min) (point-max) file nil 'no-message)) (length edits))))))) ;;;###autoload (defun projectile-replace-undo () "Revert the last project-wide replace applied from the replace reviewer. Only replaces applied with \\\\[projectile-replace--apply] in a `*projectile-replace*' buffer are recorded, and only the most recent one: this is a safety net for the single most destructive thing Projectile does, not an edit history. The record lives in memory, so it is gone after restarting Emacs. Each file is reverted only when the text the replace wrote is still exactly there; a file edited, reverted, deleted or rewritten by a branch switch in the meantime is reported and left alone rather than corrupted. Files that were reverted are dropped from the record, so undoing twice can never apply anything twice, while files that were skipped stay undoable once you have sorted them out." (interactive) (let ((record projectile-replace--last-apply)) (unless record (user-error "No applied project-wide replace to undo")) (let ((nedits 0) (nfiles 0) (remaining nil)) (dolist (entry (projectile-replace--undo-record-files record)) (let* ((file (car entry)) (result (condition-case err (projectile-replace--undo-file file (cdr entry)) (error (projectile-replace--skip (file-name-nondirectory file) (error-message-string err)))))) (if (eq result 'skipped) (push entry remaining) (cl-incf nfiles) (cl-incf nedits result)))) (setq remaining (nreverse remaining)) (setf (projectile-replace--undo-record-files record) remaining) (unless remaining (setq projectile-replace--last-apply nil)) (message "%s" (format "[%s] Reverted %d replacement%s of %s in %d file%s%s" (projectile-project-name (projectile-replace--undo-record-root record)) nedits (if (= nedits 1) "" "s") (projectile-replace--undo-record-term record) nfiles (if (= nfiles 1) "" "s") (if remaining (format " (skipped %d changed file%s)" (length remaining) (if (= (length remaining) 1) "" "s")) "")))))) ;;; Exporting to a grep-mode buffer for wgrep / grep-edit-mode (defvar projectile--grep-export-buffer-name "*projectile-grep*" "Name of the `grep-mode' buffer produced by `projectile-replace--export'. Shared by the replace and search reviewers, hence the neutral name.") (defun projectile-replace--grep-line (m root) "Format match M as a RELPATH:LINE:CONTEXT grep hit relative to ROOT." (format "%s:%d:%s" (file-relative-name (projectile-replace--match-file m) root) (projectile-replace--match-line m) (projectile-replace--match-context m))) (defun projectile-replace--export-guidance () "Message how to make the exported grep buffer editable. The wording adapts to what's installed: wgrep, Emacs 31's `grep-edit-mode', or neither. Returns the message string." (let ((msg (projectile-prepend-project-name (cond ((fboundp 'wgrep-change-to-wgrep-mode) "exported to grep buffer; press C-c C-p to edit with wgrep, then C-c C-c to write back") ((fboundp 'grep-edit-mode) "exported to grep buffer; run M-x grep-edit-mode to edit, then C-c C-c to write back") (t "exported to a read-only grep buffer for navigation; install wgrep from MELPA to edit and write back"))))) (message "%s" msg) msg)) (defun projectile-replace--export () "Export the enabled matches to a `grep-mode' buffer for editing with wgrep. Renders the matches Projectile's own apply command would act on (the enabled matches from the reviewed and filtered list; ones toggled off are excluded, just as they are by apply) as standard RELPATH:LINE:CONTEXT grep hits in a `*projectile-grep*' buffer whose `default-directory' is the project root, so the relative paths resolve. The buffer is a real `grep-mode' buffer navigable with `next-error' and RET, so wgrep (`wgrep-change-to-wgrep-mode', bound to \\`C-c C-p') or Emacs 31's `grep-edit-mode' can turn it editable and write your edits back to the files. This is the bridge for people who prefer the grep/wgrep workflow; Projectile's own apply command (\\\\[projectile-replace--apply]) is the no-dependency path and needs no external package." (interactive) (projectile-replace--ensure-not-scanning) (require 'grep) (let ((matches (cl-remove-if-not #'projectile-replace--match-enabled projectile-replace--matches)) (root projectile-replace--root) ;; label the export by which reviewer it came from (read here, before ;; switching to the grep buffer, so `major-mode' is the source buffer's) (kind (if (derived-mode-p 'projectile-search-mode) "search" "replace")) (buf (get-buffer-create projectile--grep-export-buffer-name))) (when (null matches) (user-error "No enabled matches to export")) (with-current-buffer buf (let ((inhibit-read-only t)) (erase-buffer) (setq default-directory root) (insert (format "-*- mode: grep; default-directory: %S -*-\n\n" root)) ;; No colon before a value here: the search term could be `10:30' and ;; would otherwise parse as a phantom `file:line:' grep hit. (insert (format "Projectile %s (%d match%s)\n\n" kind (length matches) (if (= (length matches) 1) "" "es"))) (dolist (m matches) (insert (projectile-replace--grep-line m root) "\n")) (insert (format "\nProjectile %s export finished\n" kind))) (grep-mode) ;; keep the root as default-directory so the relative hits resolve (setq default-directory root) ;; let wgrep hook up its keys if the user has it; strictly optional (when (fboundp 'wgrep-setup) (wgrep-setup)) (goto-char (point-min))) (pop-to-buffer buf) (projectile-replace--export-guidance) buf)) (defvar projectile-replace-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") #'projectile-replace--visit) (define-key map (kbd "n") #'projectile-replace--goto-next-match) (define-key map (kbd "p") #'projectile-replace--goto-prev-match) (define-key map (kbd "M-n") #'projectile-replace--goto-next-file) (define-key map (kbd "M-p") #'projectile-replace--goto-prev-file) (define-key map (kbd "t") #'projectile-replace--toggle) (define-key map (kbd "SPC") #'projectile-replace--toggle) (define-key map (kbd "f") #'projectile-replace--toggle-file) (define-key map (kbd "r") #'projectile-replace--set-replacement) (define-key map (kbd "c") #'projectile-replace--toggle-case) (define-key map (kbd "x") #'projectile-replace--toggle-regexp) (define-key map (kbd "w") #'projectile-replace--toggle-word) (define-key map (kbd "k") #'projectile-replace--keep-matches) (define-key map (kbd "d") #'projectile-replace--flush-matches) (define-key map (kbd "K") #'projectile-replace--keep-files) (define-key map (kbd "D") #'projectile-replace--flush-files) (define-key map (kbd "e") #'projectile-replace--export) (define-key map (kbd "!") #'projectile-replace--apply) (define-key map (kbd "C-c C-c") #'projectile-replace--apply) (define-key map (kbd "g") #'projectile-replace--refresh) (define-key map (kbd "q") #'projectile-replace--quit) map) "Keymap for `projectile-replace-mode'.") (define-derived-mode projectile-replace-mode special-mode "Projectile-Replace" "Major mode for reviewing and applying a project-wide replacement. Each match starts enabled and can be toggled on or off; only the enabled matches are applied. Besides toggling and applying, the search itself can be reshaped without leaving the buffer: toggle case sensitivity (\\\\[projectile-replace--toggle-case]), literal/regexp matching (\\[projectile-replace--toggle-regexp]) or whole-word matching (\\[projectile-replace--toggle-word]) to re-scan, and narrow the shown matches by keeping or flushing them against a regexp matched on the context line (\\[projectile-replace--keep-matches] / \\[projectile-replace--flush-matches]) or the file name (\\[projectile-replace--keep-files] / \\[projectile-replace--flush-files]). Re-searching (\\[projectile-replace--refresh]) rebuilds the list from scratch, undoing any filtering. Applying with \\[projectile-replace--apply] needs no external package. If you prefer the grep/wgrep workflow, \\[projectile-replace--export] exports the shown matches to a `grep-mode' buffer that wgrep or Emacs 31's `grep-edit-mode' can turn editable and write back to the files. \\{projectile-replace-mode-map}" (setq-local truncate-lines t) ;; killing the buffer mid-scan must not leave a dangling chunk timer (add-hook 'kill-buffer-hook #'projectile-replace--cancel-scan nil t) (buffer-disable-undo)) (defun projectile-replace--seed (buf mode root term regexp replacement literal case-fold &optional word rg-pattern projects) "Put BUF in MODE and seed its results-buffer state, with no matches yet. ROOT, TERM, REGEXP, REPLACEMENT, LITERAL, CASE-FOLD, WORD and RG-PATTERN seed the search parameters; the match list starts empty, ready for a \(sync or async) scan to fill it. PROJECTS is the list of project roots searched, defaulting to just ROOT." (with-current-buffer buf (funcall mode) (setq projectile-replace--projects (or projects (list root)) projectile-replace--root root projectile-replace--term term projectile-replace--search regexp projectile-replace--replacement replacement projectile-replace--literal literal projectile-replace--case-fold case-fold projectile-replace--word word projectile-replace--rg-pattern rg-pattern projectile-replace--matches nil projectile-replace--truncated nil projectile-replace--filtered nil projectile-replace--scanning nil projectile-replace--scan-timer nil projectile-replace--scan-process nil))) ;;; Ripgrep fast-path for the read-only literal search reviewer ;; ;; An optional accelerator for `projectile-search-review': when the search is ;; literal, `rg' is installed and `projectile-search-use-ripgrep' is on, the ;; candidate scan runs `rg --json' as a subprocess and parses its NDJSON match ;; stream into the very same `projectile-replace--match' structs the elisp scan ;; produces, streaming them into the results buffer. Only the fields the ;; search reviewer renders are filled (file, line, character column, matched ;; string, context line); the write-back-only fields (`beg'/`end'/`match-data'/ ;; `groups') stay nil because the search->replace bridge re-gathers via elisp. ;; This path is deliberately narrow: the interactive regexp search command ;; keeps the elisp scan (rg's Rust regex is not Emacs regexp) and the whole ;; replace reviewer keeps the elisp scan (its apply needs exact buffer ;; positions). A command that builds its own pattern and can also spell it in ;; rg's syntax may pass that spelling as `projectile-replace--rg-pattern' and ;; get the fast-path for a non-literal search too - `projectile-todos' does. ;; The elisp scan stays the default and the fallback; rg is purely additive. (defun projectile-search--rg-executable () "Return the ripgrep executable name if available, else nil." (and (executable-find "rg") "rg")) (defun projectile-search--rg-fastpath-p (literal &optional rg-pattern) "Return non-nil when the search reviewer should use the ripgrep fast-path. True for a LITERAL search, or for a non-literal one that supplied RG-PATTERN (a ripgrep-syntax equivalent of its Emacs regexp), when `projectile-search-use-ripgrep' is set, `rg' is available, and we are interactive; batch (`noninteractive') keeps the deterministic elisp scan." (and projectile-search-use-ripgrep (or literal rg-pattern) (not noninteractive) (projectile-search--rg-executable) t)) (defun projectile-search--rg-command (term case-fold word globs &optional pattern) "Build the `rg --json' command line searching for literal TERM. When PATTERN is non-nil it is searched for as a ripgrep-syntax regexp instead, and TERM is ignored. CASE-FOLD selects case-insensitive matching; WORD restricts matches to whole words (`--word-regexp'); GLOBS is a list of ignore patterns (from `projectile--project-ignore-globs') passed as `--glob' exclusions so Projectile's ignores narrow ripgrep's own ignore rules. They are gitignore patterns, which is what ripgrep's globs are, so they need no translation - but a root-anchored one only resolves against the project root when the searched path is relative, which is why the search path below is `./' and the caller must run the process with `default-directory' bound to the project root." (append (list (projectile-search--rg-executable) "--json" "--line-number" "--column" "--color" "never" (if case-fold "--ignore-case" "--case-sensitive")) (unless pattern (list "--fixed-strings")) (when word (list "--word-regexp")) (mapcan (lambda (g) (list "--glob" (concat "!" g))) globs) ;; `--' terminates options so a TERM starting with `-' is not misread. (list "--" (or pattern term) "./"))) (defun projectile-search--rg-json-get (obj &rest keys) "Walk KEYS through nested hash-table OBJ, returning the leaf or nil. OBJ is a `json-parse-string' object (a hash-table with string keys)." (dolist (k keys obj) (setq obj (and (hash-table-p obj) (gethash k obj))))) (defun projectile-search--rg-byte->char-column (line byte) "Return the 0-based character column for BYTE offset into LINE. BYTE is a UTF-8 byte offset into the line text (as ripgrep reports submatch offsets); LINE is the already-decoded line string. The prefix is re-encoded to UTF-8 and its BYTE-long head decoded back, so multibyte characters before the match count as one column each, not one per byte." (if (or (null byte) (<= byte 0)) 0 (let* ((bytes (encode-coding-string line 'utf-8)) (n (min byte (length bytes)))) (length (decode-coding-string (substring bytes 0 n) 'utf-8))))) (defun projectile-search--rg-parse-line (line root) "Parse one ripgrep NDJSON LINE into a list of match structs under ROOT. Returns nil for non-\"match\" records (begin/end/summary/context) and for records without decodable path or line text. A line with several submatches yields one struct per submatch, in order." (condition-case nil (let ((obj (json-parse-string line))) (when (equal (gethash "type" obj) "match") (let* ((data (gethash "data" obj)) (path (projectile-search--rg-json-get data "path" "text")) (line-no (projectile-search--rg-json-get data "line_number")) (text (projectile-search--rg-json-get data "lines" "text")) (subs (gethash "submatches" data)) (context (and (stringp text) (replace-regexp-in-string "\r?\n\\'" "" text))) (result nil)) (when (and (stringp path) (integerp line-no) (stringp text) subs) (let ((file (expand-file-name path root))) (dotimes (i (length subs)) (let* ((sub (aref subs i)) (start (gethash "start" sub)) (mstr (projectile-search--rg-json-get sub "match" "text"))) (when (stringp mstr) (push (projectile-replace--match-create :file file :buffer nil :tick nil :line line-no :column (projectile-search--rg-byte->char-column text start) :beg nil :end nil :string mstr :match-data nil :groups nil :context context :enabled t) result)))))) (nreverse result)))) (error nil))) (defun projectile-search--rg-ingest (buffer lines root) "Parse rg NDJSON LINES into BUFFER's match list, render, honor the cap. Appends up to `projectile-search-max-matches' matches in arrival order; when the cap is reached the surplus is dropped and the truncated flag is set. Returns non-nil when the cap has been reached, so the caller can finish the scan." (with-current-buffer buffer (if projectile-replace--truncated t (let ((new nil)) (dolist (l lines) (unless (string-empty-p l) (setq new (nconc new (projectile-search--rg-parse-line l root))))) (let ((room (- projectile-search-max-matches (length projectile-replace--matches)))) (when (> (length new) room) (setq new (take (max 0 room) new) projectile-replace--truncated t)) (when new (setq projectile-replace--matches (append projectile-replace--matches new))) (projectile-replace--render-progress) projectile-replace--truncated))))) (defun projectile-search--rg-finish (buffer on-done) "Settle BUFFER after its ripgrep scan ends and call ON-DONE. Kills the scan process if still live (dropping its sentinel first), clears the scanning state, does a final render and calls ON-DONE. Safe against a killed BUFFER." (when (buffer-live-p buffer) (with-current-buffer buffer (when (process-live-p projectile-replace--scan-process) (set-process-sentinel projectile-replace--scan-process #'ignore) (delete-process projectile-replace--scan-process)) (setq projectile-replace--scanning nil projectile-replace--scan-process nil projectile-replace--scan-timer nil) (projectile-replace--render-preserve) (when on-done (funcall on-done buffer))))) (defun projectile-search--gather-rg (buffer term on-done) "Scan for literal TERM into BUFFER via `rg --json', then call ON-DONE. When BUFFER carries a `projectile-replace--rg-pattern', that ripgrep-syntax regexp is searched for instead of the literal TERM. Resets BUFFER's match list and scanning state, then walks `projectile-replace--projects' one project at a time, streaming parsed matches into the buffer as ripgrep emits them and re-rendering per output chunk. One `rg' per project rather than one `rg' over the group, because the ignore globs are root-anchored: they only mean what they say when ripgrep runs inside the project that wrote them. The runs are sequential, so a single process is live at a time and cancellation stays as simple as it was for one project. `projectile-search-max-matches' is honored across the whole group (the run stops when the cap is hit) and the scan is cancelable and kill-safe exactly like the elisp async engine: the live process is registered in `projectile-replace--scan-process' so `projectile-replace--cancel-scan' \(re-search, quit, kill-buffer) can kill it, leaving no orphan. ON-DONE \(or nil) is called in BUFFER when the last project has been scanned." (with-current-buffer buffer (setq projectile-replace--matches nil projectile-replace--truncated nil projectile-replace--filtered nil projectile-replace--scanning t projectile-replace--scan-timer nil projectile-replace--scan-process nil)) (projectile-search--rg-scan-roots buffer term (buffer-local-value 'projectile-replace--projects buffer) (buffer-local-value 'projectile-replace--scan-generation buffer) on-done)) (defun projectile-search--rg-scan-roots (buffer term roots generation on-done) "Run `rg' for TERM over the first of ROOTS, chaining to the rest on exit. Matches accumulate in BUFFER across the whole of ROOTS. GENERATION is `projectile-replace--scan-generation' as it stood when the scan began, so a process outliving a cancelled scan cannot resume the chain. Calls `projectile-search--rg-finish' with ON-DONE once ROOTS is exhausted or the match cap is hit." (if (or (null roots) (not (buffer-live-p buffer))) (projectile-search--rg-finish buffer on-done) (let* (;; a group may be spelled with `~'; ripgrep needs a real working ;; directory, and the parsed paths have to carry the absolute ;; spelling the results buffer relativises against (root (file-name-as-directory (expand-file-name (car roots)))) (case-fold (buffer-local-value 'projectile-replace--case-fold buffer)) (word (buffer-local-value 'projectile-replace--word buffer)) (pattern (buffer-local-value 'projectile-replace--rg-pattern buffer)) (globs (projectile--project-ignore-globs root)) (command (projectile-search--rg-command term case-fold word globs pattern)) (pending "") (continue (lambda () (projectile-search--rg-scan-roots buffer term (cdr roots) generation on-done)))) (let* (;; run rg IN the project root so the relative `./' search path and ;; the `/'-anchored ignore globs resolve against it (default-directory root) ;; keep rg's stderr out of the JSON stream, so a diagnostic line ;; (e.g. an unreadable directory) can't split a match across filter ;; chunks and get silently dropped (stderr-buffer (get-buffer-create " *projectile-search-rg-stderr*")) (_ (with-current-buffer stderr-buffer (erase-buffer))) (proc (make-process :name "projectile-search-rg" :buffer nil :command command :connection-type 'pipe :noquery t :stderr stderr-buffer :coding 'utf-8-unix :filter (lambda (_proc output) (when (buffer-live-p buffer) (with-current-buffer buffer (unless projectile-replace--truncated (setq pending (concat pending output)) (let ((parts (split-string pending "\n"))) ;; the last element is the (possibly empty) partial line (setq pending (car (last parts))) (when (projectile-search--rg-ingest buffer (butlast parts) root) (projectile-search--rg-finish buffer on-done))))))) :sentinel (lambda (proc _event) (when (and (buffer-live-p buffer) (memq (process-status proc) '(exit signal))) (with-current-buffer buffer (when (and (eq proc projectile-replace--scan-process) (= generation projectile-replace--scan-generation)) (if (or projectile-replace--truncated (projectile-search--rg-ingest buffer (list pending) root)) (projectile-search--rg-finish buffer on-done) (funcall continue))))))))) (with-current-buffer buffer (setq projectile-replace--scan-process proc)) proc)))) (defun projectile-replace--word-boundary-regexp (regexp) "Fence REGEXP with word boundaries so it only matches whole words. The pattern is shy-grouped and wrapped in `\\<'/`\\>', mirroring what ripgrep's `--word-regexp' does, so the elisp scan and the ripgrep fast-path agree on what counts as a whole-word match." (concat "\\<\\(?:" regexp "\\)\\>")) (defun projectile-replace--effective-regexp (regexp) "Return REGEXP as the current results buffer will actually match it. Fences it with word boundaries when `projectile-replace--word' is set, otherwise returns REGEXP unchanged." (if projectile-replace--word (projectile-replace--word-boundary-regexp regexp) regexp)) (defun projectile-replace--resolve-candidates (candidates) "Return CANDIDATES as a list, calling it first when it is a function. Only the elisp scanner reads the candidate list; the ripgrep fast-path asks ripgrep to walk the tree itself and never looks at it. Callers that might take either path therefore pass a function, so the walk - which shells out per project - is paid for only when something is going to scan its result." (if (functionp candidates) (funcall candidates) candidates)) (defun projectile-replace--render-progress () "Redraw the current results buffer, subject to throttling. Redraws no more often than `projectile-search-render-interval'. For use while a scan is streaming; the redraw that settles a finished scan is unconditional, so a skipped intermediate draw is never the last word." (let ((now (float-time))) (when (or (null projectile-search-render-interval) (>= (- now projectile-replace--last-render) projectile-search-render-interval)) (setq projectile-replace--last-render now) (projectile-replace--render-preserve)))) (defun projectile-replace--start (buffer candidates regexp on-done) "Fill BUFFER's match list by scanning CANDIDATES for REGEXP. Cancels any in-flight scan in BUFFER first, then scans with the async chunked driver when `projectile-replace--async-p' holds and otherwise synchronously (always in batch), so the final match list is identical either way - only delivery differs. BUFFER is re-rendered when done and ON-DONE (or nil) is called in it. As an optional accelerator, a read-only search-reviewer BUFFER doing a literal search (or one carrying a `projectile-replace--rg-pattern') takes the ripgrep fast-path (`projectile-search--gather-rg') when `projectile-search--rg-fastpath-p' holds; the replace reviewer and the plain regexp search always take the elisp path below. A search spanning several projects takes it too - `projectile-search--gather-rg' runs one `rg' per project in turn." (with-current-buffer buffer (projectile-replace--cancel-scan)) (cond ((with-current-buffer buffer (and (derived-mode-p 'projectile-search-mode) (projectile-search--rg-fastpath-p projectile-replace--literal projectile-replace--rg-pattern))) (projectile-search--gather-rg buffer (buffer-local-value 'projectile-replace--term buffer) on-done)) ((projectile-replace--async-p) (projectile-replace--gather-async (projectile-replace--resolve-candidates candidates) (with-current-buffer buffer (projectile-replace--effective-regexp regexp)) buffer on-done)) (t (with-current-buffer buffer (let* ((case-fold-search projectile-replace--case-fold) (result (projectile-replace--gather (projectile-replace--resolve-candidates candidates) (projectile-replace--effective-regexp regexp)))) (setq projectile-replace--matches (plist-get result :matches) projectile-replace--truncated (plist-get result :truncated) projectile-replace--scanning nil projectile-replace--scan-timer nil)) (funcall projectile-replace--render-function) (when on-done (funcall on-done buffer)))))) (defun projectile-replace--open-finish (buffer) "Announce truncation once the scan filling BUFFER has finished." (with-current-buffer buffer (when projectile-replace--truncated (message "%s" (projectile-prepend-project-name (format "showing the first %d matches" projectile-search-max-matches)))))) (defun projectile-replace--open (mode buf-name root term regexp replacement literal case-fold candidates no-match-msg &optional word rg-pattern projects) "Open BUF-NAME in MODE and scan CANDIDATES for REGEXP into it. When scanning is asynchronous the buffer is shown immediately and matches stream in; when synchronous (always in batch) the scan completes first and, to preserve the pre-async behavior, no buffer is shown when nothing matched - NO-MATCH-MSG is issued instead. Returns the results buffer, or nil on the synchronous no-match path. ROOT, TERM, REGEXP, REPLACEMENT, LITERAL, CASE-FOLD, WORD, RG-PATTERN and PROJECTS seed the buffer state." ;; re-running the command must not orphan a scan still filling an earlier ;; instance of the buffer (re-seeding resets its buffer-locals) (when-let* ((existing (get-buffer buf-name))) (with-current-buffer existing (projectile-replace--cancel-scan))) (if (or (projectile-replace--async-p) ;; the read-only search reviewer's ripgrep fast-path is inherently ;; async, so it opens the streaming buffer even when the elisp async ;; engine is off (`projectile-search-async' nil); `--start' then ;; dispatches it to ripgrep (and (eq mode #'projectile-search-mode) (projectile-search--rg-fastpath-p literal rg-pattern))) (let ((buf (get-buffer-create buf-name))) (projectile-replace--seed buf mode root term regexp replacement literal case-fold word rg-pattern projects) (with-current-buffer buf (setq projectile-replace--scanning t) (funcall projectile-replace--render-function)) (pop-to-buffer buf) (projectile-replace--start buf candidates regexp #'projectile-replace--open-finish) buf) (let* ((case-fold-search case-fold) (scan-regexp (if word (projectile-replace--word-boundary-regexp regexp) regexp)) (result (projectile-replace--gather (projectile-replace--resolve-candidates candidates) scan-regexp)) (matches (plist-get result :matches)) (truncated (plist-get result :truncated))) (if (null matches) (progn (when no-match-msg (message "%s" no-match-msg)) nil) (let ((buf (get-buffer-create buf-name))) (projectile-replace--seed buf mode root term regexp replacement literal case-fold word rg-pattern projects) (with-current-buffer buf (setq projectile-replace--matches matches projectile-replace--truncated truncated) (funcall projectile-replace--render-function)) (when truncated (message "%s" (projectile-prepend-project-name (format "showing the first %d matches" projectile-search-max-matches)))) (pop-to-buffer buf) buf))))) (defun projectile-replace--quit () "Cancel any in-flight scan and quit the results window." (interactive) (projectile-replace--cancel-scan) (quit-window)) (defun projectile-replace--review (literal) "Gather matches for a project-wide replacement and pop the results buffer. LITERAL non-nil runs a literal replace; otherwise the search term is an Emacs regexp and the replacement may reference capture groups." (let* ((root (projectile-acquire-root)) (term (read-string (projectile-prepend-project-name (if literal "Replace: " "Replace regexp: ")) (projectile-symbol-or-selection-at-point))) (replacement (read-string (projectile-prepend-project-name (format "Replace %s with: " term)))) (regexp (if literal (regexp-quote term) term)) (case-fold case-fold-search) (word projectile-search-whole-word) (candidates (projectile-replace--candidates term literal case-fold root))) (projectile-replace--open #'projectile-replace-mode projectile-replace-buffer-name root term regexp replacement literal case-fold candidates (projectile-prepend-project-name (format "No matches for %s" term)) word))) ;;;###autoload (defun projectile-replace-review () "Review and apply a literal project-wide replacement. Prompts for a literal search string and a replacement, gathers every match across the project into a `*projectile-replace*' buffer, and lets you toggle which matches to apply before committing them. This is a non-blocking, previewable alternative to `projectile-replace'." (interactive) (projectile-replace--review t)) ;;;###autoload (defun projectile-replace-regexp-review () "Review and apply a project-wide regexp replacement. Like `projectile-replace-review', but the search term is an Emacs regexp and the replacement may reference capture groups (\\1, \\&). This is a non-blocking, previewable alternative to `projectile-replace-regexp'." (interactive) (projectile-replace--review nil)) ;;; Reviewable read-only project-content search ;; ;; A search-only sibling of the reviewable replace UI above. It reuses the ;; same pure "find matches" machinery (`projectile-replace--candidates', ;; `--gather', `--scan-file', the match struct and its accessors) and the ;; same navigation, filter, case/regexp-toggle, visit and grep-export ;; commands, but renders the matches into a read-only `*projectile-search*' ;; buffer with no before->after preview, no per-match enable/disable toggle, ;; and no apply. It is a distinct major mode (`projectile-search-mode', a ;; sibling of `projectile-replace-mode', not a shared base) so its keymap can ;; simply omit every write-back key rather than disable it; the shared code ;; lives under the `projectile-replace--' prefix (where it already was) and ;; the two modes share the results-buffer buffer-locals. A `replace these' ;; bridge hands the current search off to the replace reviewer. (defvar projectile-search-buffer-name "*projectile-search*" "Name of the buffer used by `projectile-search-review'.") (defun projectile-search--header-string () "Return the propertized status header for the search results buffer. Shows the term, the match and file counts, the mode flags \(regexp/literal and case), and a note when the list has been filtered. Carries no `projectile-replace-match' property, so match navigation skips it." (let* ((matches projectile-replace--matches) (nmatches (length matches)) (seen (make-hash-table :test 'equal)) nfiles flags) (dolist (m matches) (puthash (projectile-replace--match-file m) t seen)) (setq nfiles (hash-table-count seen) flags (concat (if projectile-replace--literal "[literal]" "[regexp]") " " (if projectile-replace--case-fold "[ignore-case]" "[case-sensitive]") (if projectile-replace--word " [word]" "") (if projectile-replace--filtered " filtered" "") (projectile-replace--scanning-note nmatches))) (propertize (format "Search %S\n%d match%s in %d file%s %s\n" projectile-replace--term nmatches (if (= nmatches 1) "" "es") nfiles (if (= nfiles 1) "" "s") flags) 'face 'projectile-replace-header))) (defun projectile-search--render-line (m) "Return the propertized results line for match M. The line is `LINE:COL: CONTEXT' with the matched span highlighted; there is no replacement preview and no enable/disable indicator. The whole line carries the match struct under the `projectile-replace-match' text property so the shared navigation, visit and filter commands find it." (let* ((col (projectile-replace--match-column m)) (ctx (projectile-replace--match-context m)) (mstr (projectile-replace--match-string m)) (before (substring ctx 0 (min col (length ctx)))) (after (if (<= (+ col (length mstr)) (length ctx)) (substring ctx (+ col (length mstr))) "")) (highlight (propertize mstr 'face 'projectile-replace-match)) (locator (propertize (format "%d:%d: " (projectile-replace--match-line m) (1+ col)) 'face 'projectile-replace-line-number)) (line (concat locator before highlight after "\n"))) (propertize line 'projectile-replace-match m))) (defun projectile-search--render () "Redraw the current search results buffer from its buffer-local state." (let ((inhibit-read-only t) (root projectile-replace--root) (matches projectile-replace--matches) (counts (make-hash-table :test 'equal)) (prev-file nil)) (dolist (m matches) (cl-incf (gethash (projectile-replace--match-file m) counts 0))) (erase-buffer) (insert (projectile-search--header-string)) (insert (substitute-command-keys (concat "\\" "\\[projectile-replace--visit] visit " "\\[projectile-replace--refresh] re-search " "\\[projectile-search--to-replace] replace these " "\\[projectile-replace--export] export " "\\[projectile-replace--quit] quit\n" "\\[projectile-replace--toggle-case] case " "\\[projectile-replace--toggle-regexp] regexp/literal " "\\[projectile-replace--toggle-word] word " "\\[projectile-replace--keep-matches]/\\[projectile-replace--flush-matches] keep/flush line " "\\[projectile-replace--keep-files]/\\[projectile-replace--flush-files] keep/flush file\n\n"))) (if (null matches) (insert "No matches.\n") (dolist (m matches) (let ((file (projectile-replace--match-file m))) (unless (equal prev-file file) (when prev-file (insert "\n")) (setq prev-file file) (insert (projectile-replace--file-header file root (gethash file counts)))) (insert (projectile-search--render-line m))))) (when projectile-replace--truncated (insert (format "\n(showing the first %d matches)\n" projectile-search-max-matches))) (goto-char (point-min)))) (defun projectile-search--to-replace () "Hand the current search to the reviewable replace UI. Carries over the same term, literal-ness and case setting and prompts only for the replacement. The project is re-scanned from scratch (so any filtering is undone and every match comes back enabled), mirroring `projectile-replace-review'." (interactive) (let* ((root projectile-replace--root) (projects projectile-replace--projects) (term projectile-replace--term) (literal projectile-replace--literal) (case-fold projectile-replace--case-fold) (word projectile-replace--word) (regexp projectile-replace--search) (replacement (read-string (projectile-prepend-project-name (format "Replace %s with: " term)))) (candidates (projectile-replace--candidates term literal case-fold projects))) (projectile-replace--open #'projectile-replace-mode projectile-replace-buffer-name root term regexp replacement literal case-fold candidates (projectile-prepend-project-name (format "No matches for %s" term)) word nil projects))) (defvar projectile-search-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") #'projectile-replace--visit) (define-key map (kbd "n") #'projectile-replace--goto-next-match) (define-key map (kbd "p") #'projectile-replace--goto-prev-match) (define-key map (kbd "M-n") #'projectile-replace--goto-next-file) (define-key map (kbd "M-p") #'projectile-replace--goto-prev-file) (define-key map (kbd "c") #'projectile-replace--toggle-case) (define-key map (kbd "x") #'projectile-replace--toggle-regexp) (define-key map (kbd "w") #'projectile-replace--toggle-word) (define-key map (kbd "k") #'projectile-replace--keep-matches) (define-key map (kbd "d") #'projectile-replace--flush-matches) (define-key map (kbd "K") #'projectile-replace--keep-files) (define-key map (kbd "D") #'projectile-replace--flush-files) (define-key map (kbd "e") #'projectile-replace--export) (define-key map (kbd "r") #'projectile-search--to-replace) (define-key map (kbd "g") #'projectile-replace--refresh) (define-key map (kbd "q") #'projectile-replace--quit) map) "Keymap for `projectile-search-mode'.") (define-derived-mode projectile-search-mode special-mode "Projectile-Search" "Major mode for reviewing project-wide search matches, read-only. A search-only sibling of `projectile-replace-mode': the buffer is a read-only listing of every match, grouped by file, with no replacement preview and no way to edit the files from here. Navigate with \\\\[projectile-replace--goto-next-match] / \\[projectile-replace--goto-prev-match] (match) and \\[projectile-replace--goto-next-file] / \\[projectile-replace--goto-prev-file] (file), and \\[projectile-replace--visit] visits the match under point. The search can be reshaped in place: \\[projectile-replace--toggle-case] toggles case sensitivity, \\[projectile-replace--toggle-regexp] toggles literal/regexp matching and \\[projectile-replace--toggle-word] toggles whole-word matching, each re-scanning; \\[projectile-replace--keep-matches] / \\[projectile-replace--flush-matches] keep or flush matches by line and \\[projectile-replace--keep-files] / \\[projectile-replace--flush-files] by file; \\[projectile-replace--refresh] re-runs the search, undoing any filtering. \\[projectile-search--to-replace] hands the current search off to the reviewable replace UI \(prompting only for the replacement), and \\[projectile-replace--export] exports the shown matches to a `grep-mode' buffer for wgrep or Emacs 31's `grep-edit-mode'. \\{projectile-search-mode-map}" (setq-local truncate-lines t) (setq-local projectile-replace--render-function #'projectile-search--render) ;; killing the buffer mid-scan must not leave a dangling chunk timer (add-hook 'kill-buffer-hook #'projectile-replace--cancel-scan nil t) (buffer-disable-undo)) (defun projectile-search--review (literal) "Gather matches for a project-wide search and pop the read-only results buffer. LITERAL non-nil searches for a literal string; otherwise the term is an Emacs regexp. There is no replacement prompt. This is `projectile-search-in-projects' over the one project you are in; the prompt is built here because only the single-project case can name the tool that will do the scanning." (projectile-search-in-projects (list (projectile-acquire-root)) literal (format "Search %s%s for" (projectile--search-tool-tag (if (and literal (projectile-search--rg-fastpath-p t)) "ripgrep" "elisp")) (if literal "" " regexp")))) ;;;###autoload (defun projectile-search-review () "Search the project for a literal string and review the matches read-only. Prompts for a literal search string (defaulting to the symbol or region at point), gathers every match across the project into a read-only `*projectile-search*' buffer grouped by file, and lets you navigate, filter and reshape the search. Use \\\\[projectile-search--to-replace] to turn it into a reviewable replacement. This is the read-only sibling of `projectile-replace-review'." (interactive) (projectile-search--review t)) ;;;###autoload (defun projectile-search-regexp-review () "Search the project for an Emacs regexp and review the matches read-only. Like `projectile-search-review', but the search term is an Emacs regexp, so full Emacs regexp syntax (e.g. symbol boundaries like `\\_') is honored." (interactive) (projectile-search--review nil)) ;;; Project-wide TODO/FIXME annotations ;; ;; `projectile-todos' is a thin command on top of the read-only search ;; reviewer above: it builds one regexp out of `projectile-todo-keywords' and ;; opens the very same `*projectile-search*' buffer, so grouping by file, ;; navigation, the keep/flush filters, re-search, the grep-mode export and the ;; hand-off to the replace reviewer all come for free. ;; ;; The keyword regexp is fenced the way hl-todo and magit-todos fence theirs: ;; the keyword must start at a word boundary and be followed by a colon, ;; whitespace or the end of the line, so `TODO:' and `FIXME ' are hits while ;; `TODOS' and `MASTODON' are not. Requiring a comment character in front is ;; deliberately NOT done: neither scan parses the language, and the comment ;; syntax would have to be guessed per file type, so an annotation in a string ;; or in prose is reported too (cheap to filter out with `d' in the buffer). ;; ;; Because a big repo is exactly where a pure-elisp scan hurts, the command ;; also hands the reviewer a ripgrep-syntax spelling of the same pattern ;; (`projectile-replace--rg-pattern'), which lets the otherwise literal-only ;; ripgrep fast-path run for this non-literal search. The two spellings agree ;; except at underscores (rg's `\b' counts `_' as a word character, Emacs' ;; word boundaries do not), which only shows up for identifiers like ;; `TODO_LIST'. (defun projectile-todos--rg-quote (keyword) "Quote KEYWORD for ripgrep's regex syntax. Every character that is not alphanumeric or an underscore is escaped, so a keyword carrying punctuation (`@TODO', `TODO?') stays literal in Rust regex syntax, where more characters are special than in Emacs'." (replace-regexp-in-string "[^[:alnum:]_]" "\\\\\\&" keyword t)) (defun projectile-todos--regexp (keywords) "Return the Emacs regexp matching any annotation keyword in KEYWORDS. The keyword must begin at a word boundary and be followed by a colon, by whitespace or by the end of the line." (concat "\\<" (regexp-opt keywords) "\\>\\(?::\\|[[:blank:]]\\|$\\)")) (defun projectile-todos--rg-pattern (keywords) "Return the ripgrep-syntax equivalent of `projectile-todos--regexp'. KEYWORDS is the list of annotation keywords to match." (concat "\\b(?:" (mapconcat #'projectile-todos--rg-quote keywords "|") ")\\b(?::|[[:blank:]]|$)")) (defun projectile-todos--read-keywords () "Read which of `projectile-todo-keywords' to search for. Several keywords can be given, comma separated, and a keyword that is not in the list can be typed in for a one-off search." (let ((keywords (delete "" (completing-read-multiple (projectile-prepend-project-name "TODO keywords: ") projectile-todo-keywords)))) (or keywords (user-error "No annotation keywords given")))) ;;;###autoload (defun projectile-todos (&optional arg) "Collect the project's TODO-style annotations and review them read-only. Searches every project file for the annotation keywords in `projectile-todo-keywords' (`TODO', `FIXME', `HACK', ... - customize the list to match your own conventions) and gathers the hits into the same read-only `*projectile-search*' buffer `projectile-search-review' uses, grouped by file, so all of its navigation, filtering, re-search, export and hand-off commands apply. A keyword only counts when it stands as a whole word followed by a colon, by whitespace or by the end of the line, so `TODO:' and `FIXME ' are found while `TODOS' and `MASTODON' are not. Matching is case-sensitive \(annotation keywords are uppercase by convention); toggle that with `c' in the results buffer. The keyword does not have to sit in a comment. With a prefix argument ARG, prompt for which keywords to search for instead of using all of them." (interactive "P") (projectile--todos (list (projectile-acquire-root)) arg)) (defun projectile--todos (projects &optional arg) "Collect the TODO-style annotations of PROJECTS into the search reviewer. With ARG non-nil, prompt for which keywords to search for. PROJECTS is a list of project roots, so one project and a whole group take the same path; see `projectile-search-in-projects' for what changes when there is more than one." (let* ((projects (projectile--project-group projects "projects")) (keywords (or (if arg (projectile-todos--read-keywords) projectile-todo-keywords) (user-error "`projectile-todo-keywords' is empty"))) (regexp (projectile-todos--regexp keywords)) (rg-pattern (projectile-todos--rg-pattern keywords)) ;; the term IS the regexp, so the in-buffer toggles keep working (case-fold nil) (candidates (lambda () (projectile-replace--candidates regexp nil case-fold projects)))) (projectile-replace--open #'projectile-search-mode projectile-search-buffer-name (or (projectile--common-parent projects) "/") regexp regexp nil nil case-fold candidates (projectile-prepend-project-name (format "No %s annotations found" (string-join keywords "/"))) ;; The pattern is already word-fenced and ends in a delimiter, so the ;; whole-word fence could never match; whole-word mode is not seeded here. nil rg-pattern projects))) ;;; Project buffer commands ;; ;; Acting on the buffers that belong to the project - killing them, saving ;; them - and the condition language `projectile-kill-buffers-filter' uses to ;; decide which ones are in scope. (defun projectile--buffer-matches-conditions (buffer conditions) "Return non-nil if BUFFER satisfies any condition in CONDITIONS. CONDITIONS is a list using the DSL documented in `projectile-kill-buffers-filter'. Modeled on project.el's `project--buffer-check'." (catch 'match (dolist (c conditions) (when (cond ((stringp c) (string-match-p c (buffer-name buffer))) ((functionp c) (funcall c buffer)) ((eq (car-safe c) 'major-mode) (eq (buffer-local-value 'major-mode buffer) (cdr c))) ((eq (car-safe c) 'derived-mode) (provided-mode-derived-p (buffer-local-value 'major-mode buffer) (cdr c))) ((eq (car-safe c) 'not) (not (projectile--buffer-matches-conditions buffer (cdr c)))) ((eq (car-safe c) 'or) (projectile--buffer-matches-conditions buffer (cdr c))) ((eq (car-safe c) 'and) (seq-every-p (apply-partially #'projectile--buffer-matches-conditions buffer) (mapcar #'list (cdr c))))) (throw 'match t))))) (defun projectile-buffer-killed-p (buffer) "Return non-nil if BUFFER should be killed by `projectile-kill-buffers'. The decision follows `projectile-kill-buffers-filter'." (cond ((functionp projectile-kill-buffers-filter) (funcall projectile-kill-buffers-filter buffer)) ((eq projectile-kill-buffers-filter 'kill-all) t) ((eq projectile-kill-buffers-filter 'kill-only-files) (buffer-file-name buffer)) ((listp projectile-kill-buffers-filter) (projectile--buffer-matches-conditions buffer projectile-kill-buffers-filter)) (t (user-error "Invalid projectile-kill-buffers-filter value: %S" projectile-kill-buffers-filter)))) ;;;###autoload (defun projectile-kill-buffers () "Kill project buffers. The buffers are killed according to the value of `projectile-kill-buffers-filter'." (interactive) (let* ((project (projectile-acquire-root)) (project-name (projectile-project-name project)) (buffers (projectile-project-buffers project))) (when (yes-or-no-p (format "Are you sure you want to kill %s buffers for '%s'? " (length buffers) project-name)) (dolist (buffer buffers) (when (and ;; we take care not to kill indirect buffers directly ;; as we might encounter them after their base buffers are killed (not (buffer-base-buffer buffer)) (projectile-buffer-killed-p buffer)) (kill-buffer buffer)))))) ;;;###autoload (defun projectile-save-project-buffers () "Save all project buffers." (interactive) (let* ((project (projectile-acquire-root)) (project-name (projectile-project-name project)) (modified-buffers (seq-filter (lambda (buf) (and (buffer-file-name buf) (buffer-modified-p buf))) (projectile-project-buffers project)))) (if (null modified-buffers) (message "[%s] No buffers need saving" project-name) (dolist (buf modified-buffers) (with-current-buffer buf (save-buffer))) (message "[%s] Saved %d buffers" project-name (length modified-buffers))))) ;;; Dired, version control and recent files ;; ;; Commands that hand the project root to something else: Dired, the VC ;; interface, and `recentf' filtered down to the project. The path of a ;; project's on-disk cache file is worked out at the end of it, having ;; nowhere better to live. (defun projectile--dired (dired-fn &optional arg) "Open the project root in dired using DIRED-FN. DIRED-FN is a `dired'-like command; passing `dired-other-window' or `dired-other-frame' yields the other-window/-frame variants. With ARG, prompt for a known project to open instead of the current one." (funcall dired-fn (if arg (projectile-completing-read "Dired in project: " (projectile-relevant-known-projects) :category 'projectile-project :caller 'projectile-read-project) (projectile-acquire-root)))) ;;;###autoload (defun projectile-dired (&optional arg) "Open `dired' at the root of the project. With a prefix argument ARG, prompt for a known project to open in dired." (interactive "P") (projectile--dired #'dired arg)) ;;;###autoload (autoload 'projectile-dired-other-window "projectile" nil t) ;;;###autoload (autoload 'projectile-dired-other-frame "projectile" nil t) (projectile--define-display-variants projectile-dired (&optional arg) "Open `dired' at the root of the project in another %s. With a prefix argument ARG, prompt for a known project to open in dired." (projectile--dired #'dired-other-window arg)) ;;;###autoload (defun projectile-vc (&optional project-root) "Open `vc-dir' at the root of the project. For git projects `magit-status-internal' is used if available. For hg projects `monky-status' is used if available. If PROJECT-ROOT is given, it is opened instead of the project root directory of the current buffer file. If interactively called with a prefix argument, the user is prompted for a project directory to open." (interactive (and current-prefix-arg (list (projectile-completing-read "Open project VC in: " (projectile-known-projects) :category 'projectile-project :caller 'projectile-read-project)))) (unless project-root (setq project-root (projectile-acquire-root))) (let ((vcs (projectile-project-vcs project-root))) (pcase vcs ('git (cond ((fboundp 'magit-status-internal) (magit-status-internal project-root)) ((fboundp 'magit-status) (with-no-warnings (magit-status project-root))) (t (vc-dir project-root)))) ('hg (if (fboundp 'monky-status) (monky-status project-root) (vc-dir project-root))) (_ (vc-dir project-root))))) ;;;###autoload (defun projectile-recentf () "Show a list of recently visited files in a project." (interactive) (if (boundp 'recentf-list) (find-file (projectile-expand-root (projectile-completing-read "Recently visited files: " (projectile-recentf-files) :caller 'projectile-read-file))) (message "recentf is not enabled"))) (defun projectile-recentf-files () "Return a list of recently visited files in a project." (and (boundp 'recentf-list) (let ((project-root (file-truename (projectile-acquire-root)))) (mapcar (lambda (f) (file-relative-name f project-root)) (seq-filter (lambda (f) (string-prefix-p project-root (expand-file-name f))) recentf-list))))) (defun projectile-project-cache-file (&optional project-root) "The path to a project's cache file for PROJECT-ROOT. Acts on the current project if not specified explicitly." (if project-root (expand-file-name projectile-cache-file project-root) (projectile-expand-root projectile-cache-file))) ;;; Lifecycle command plumbing ;; ;; What the configure/compile/test/install/package/run commands are made of, ;; as opposed to the commands themselves (see `;;; Lifecycle commands'): the ;; per-project caches of the last command used, the dirconfig overrides, and ;; the phase descriptors that tie the two together. (defvar projectile-configure-cmd-map (make-hash-table :test 'equal) "A mapping between projects and the last configure command used on them.") (defvar projectile-compilation-cmd-map (make-hash-table :test 'equal) "A mapping between projects and the last compilation command used on them.") (defvar projectile-install-cmd-map (make-hash-table :test 'equal) "A mapping between projects and the last install command used on them.") (defvar projectile-package-cmd-map (make-hash-table :test 'equal) "A mapping between projects and the last package command used on them.") (defvar projectile-test-cmd-map (make-hash-table :test 'equal) "A mapping between projects and the last test command used on them.") (defvar projectile-run-cmd-map (make-hash-table :test 'equal) "A mapping between projects and the last run command used on them.") (defconst projectile--lifecycle-phases '((:name configure :prompt "Configure command: " :save-buffers t :cmd-map projectile-configure-cmd-map :dir-local-var projectile-project-configure-cmd :default-fn projectile--expand-configure-command :command-fn projectile-configure-command) (:name compile :prompt "Compile command: " :save-buffers t :cmd-map projectile-compilation-cmd-map :dir-local-var projectile-project-compilation-cmd :default-fn projectile-default-compilation-command :command-fn projectile-compilation-command) (:name test :prompt "Test command: " :save-buffers t :cmd-map projectile-test-cmd-map :dir-local-var projectile-project-test-cmd :default-fn projectile-default-test-command :command-fn projectile-test-command) (:name install :prompt "Install command: " :save-buffers t :cmd-map projectile-install-cmd-map :dir-local-var projectile-project-install-cmd :default-fn projectile-default-install-command :command-fn projectile-install-command) (:name package :prompt "Package command: " :save-buffers t :cmd-map projectile-package-cmd-map :dir-local-var projectile-project-package-cmd :default-fn projectile-default-package-command :command-fn projectile-package-command) (:name run :prompt "Run command: " :save-buffers nil :cmd-map projectile-run-cmd-map :dir-local-var projectile-project-run-cmd :default-fn projectile-default-run-command :command-fn projectile-run-command)) "Descriptors for the project lifecycle phases. Each entry is a plist with the phase symbol (`:name', also used as the command type for the per-type command history), the variable caching the last command per project (`:cmd-map'), the .dir-locals.el override variable (`:dir-local-var'), a function of the project type returning the default command (`:default-fn'), the public command resolver \(`:command-fn'), the prompt prefix (`:prompt') and whether to save the project's buffers before running the command (`:save-buffers').") (defun projectile--phase-descriptor (phase) "Return the lifecycle descriptor for PHASE (a symbol like `compile')." (or (seq-find (lambda (descriptor) (eq (plist-get descriptor :name) phase)) projectile--lifecycle-phases) (error "Unknown project lifecycle phase `%s'" phase))) ;;;###autoload (defun projectile-discard-command-cache () "Discard the cached lifecycle commands for the current project. Projectile caches the last command used for each of the configure, compile, test, install, package, and run actions and prefers it over the value from `.dir-locals.el' or the project type's default. After editing those, run this command so the next invocation re-reads them. Handy on `after-save-hook' for `.dir-locals.el' buffers. This only clears the cached commands, not the command history offered at the prompt. See also `projectile-discard-root-cache'." (interactive) (let ((root (projectile-acquire-root))) (dolist (descriptor projectile--lifecycle-phases) (let ((command-map (symbol-value (plist-get descriptor :cmd-map)))) (dolist (dir (hash-table-keys command-map)) (when (string-prefix-p root dir) (remhash dir command-map))))) ;; Give feedback when invoked interactively; stay quiet when used ;; programmatically (e.g. from `after-save-hook') unless verbose. (if (called-interactively-p 'interactive) (message "Discarded the command cache for %s" root) (projectile--message "Discarded the command cache for %s" root)))) (defvar projectile-project-enable-cmd-caching t "Enables command caching for the project. Set to nil to disable. Should be set via .dir-locals.el.") (put 'projectile-project-enable-cmd-caching 'safe-local-variable #'booleanp) (defun projectile--cache-project-commands-p () "Whether to cache project commands. The variable `projectile-project-enable-cmd-caching' is typically set via .dir-locals.el, which applies it buffer-locally in file buffers." projectile-project-enable-cmd-caching) (defvar projectile-project-configure-cmd nil "The command to use with `projectile-configure-project'. It takes precedence over the default command for the project type when set. Should be set via .dir-locals.el.") (put 'projectile-project-configure-cmd 'safe-local-variable #'stringp) (defvar projectile-project-compilation-cmd nil "The command to use with `projectile-compile-project'. It takes precedence over the default command for the project type when set. Should be set via .dir-locals.el.") (put 'projectile-project-compilation-cmd 'safe-local-variable #'stringp) (defvar projectile-project-compilation-dir nil "The directory to use with `projectile-compile-project'. The directory path is relative to the project root. Should be set via .dir-locals.el.") (put 'projectile-project-compilation-dir 'safe-local-variable #'stringp) (defvar projectile-project-test-cmd nil "The command to use with `projectile-test-project'. It takes precedence over the default command for the project type when set. Should be set via .dir-locals.el.") (put 'projectile-project-test-cmd 'safe-local-variable #'stringp) (defvar projectile-project-install-cmd nil "The command to use with `projectile-install-project'. It takes precedence over the default command for the project type when set. Should be set via .dir-locals.el.") (put 'projectile-project-install-cmd 'safe-local-variable #'stringp) (defvar projectile-project-package-cmd nil "The command to use with `projectile-package-project'. It takes precedence over the default command for the project type when set. Should be set via .dir-locals.el.") (put 'projectile-project-package-cmd 'safe-local-variable #'stringp) (defvar projectile-project-run-cmd nil "The command to use with `projectile-run-project'. It takes precedence over the default command for the project type when set. Should be set via .dir-locals.el.") (put 'projectile-project-run-cmd 'safe-local-variable #'stringp) ;;; Project tasks ;; ;; A project's named tasks, both the ones configured in `projectile-tasks' ;; and the ones discovered from the build tool. Running them lives in ;; `;;; Tasks, and repeating what you ran last'. (defun projectile-tasks-safe-p (value) "Return non-nil if VALUE is a safe directory-local `projectile-tasks'. Only an alist mapping task-name strings to command strings is considered safe. Function commands are rejected: a .dir-locals.el travels with the project, so a function value could execute arbitrary code the moment a task is run." (let ((safe t)) (while (and safe (consp value)) (let ((entry (car value))) (setq safe (and (consp entry) (stringp (car entry)) (stringp (cdr entry))))) (setq value (cdr value))) (and safe (null value)))) (defcustom projectile-tasks nil "An alist of named tasks that can be run with `projectile-run-task'. Each entry has the form (TASK-NAME . COMMAND), where TASK-NAME is a string and COMMAND is either a shell command string or a function called with no arguments (and `default-directory' set to the project root) that returns such a string. Command strings support the same `%p' placeholder as the lifecycle commands; it's replaced with the project name at execution time. The variable can be set globally, per project type (see the `:tasks' keyword of `projectile-register-project-type'), or per project via .dir-locals.el, which makes the tasks shareable through your VCS. Entries here override same-named tasks defined by the project type \(see `projectile-project-tasks'). Note that only string commands are safe as a directory-local value; tasks with function commands have to be defined globally or via a project type." :group 'projectile :type '(alist :key-type (string :tag "Task name") :value-type (choice (string :tag "Shell command") (function :tag "Function returning a shell command"))) :safe #'projectile-tasks-safe-p :package-version '(projectile . "3.1.0")) ;;;; Task discovery ;; ;; Most projects already describe their tasks somewhere - npm scripts, ;; Makefile targets, justfile recipes - and retyping those into ;; `projectile-tasks' is busy-work. A provider reads one such file and ;; turns it into tasks, which are offered alongside the configured ones. ;; ;; Providers are deliberately simple readers rather than full parsers: ;; they only need the task names, and they must not shell out (that ;; would make `projectile-run-task' pay for a process launch, and go ;; wrong over TRAMP). (defcustom projectile-discover-tasks t "Whether to offer the tasks a project's own tooling defines. When non-nil `projectile-run-task' also lists the tasks found by `projectile-task-providers' - npm scripts, Makefile targets and so on - in addition to the tasks configured via `projectile-tasks' and the project type. Discovered tasks are named after the tool that defines them (e.g. `npm:build'), so they never collide with configured ones." :group 'projectile :type 'boolean :package-version '(projectile . "3.3.0")) (defcustom projectile-task-providers '(projectile-tasks-from-npm projectile-tasks-from-deno projectile-tasks-from-composer projectile-tasks-from-just projectile-tasks-from-taskfile projectile-tasks-from-rake projectile-tasks-from-make) "Functions that discover the tasks a project's tooling defines. Each function is called with the project root and should return an alist of (TASK-NAME . COMMAND), both strings, or nil when the project has nothing it recognizes. A function that signals is ignored, so a malformed manifest can't break `projectile-run-task'. Task names should carry a tool prefix (`npm:build', `make:test'), which is what keeps the providers from colliding with each other and with the configured tasks." :group 'projectile :type '(repeat function) :package-version '(projectile . "3.3.0")) (defvar projectile--task-entry-set nil "Entries of the project root being scanned for tasks, or nil. Bound by `projectile-discovered-tasks' so the providers can answer \"is this manifest here?\" from a single directory listing instead of stat-ing every candidate name (see `projectile--directory-entry-set').") (defun projectile--task-file (project-root name) "Return NAME under PROJECT-ROOT when it exists as a readable file." (when (or (null projectile--task-entry-set) (gethash name projectile--task-entry-set)) (let ((file (expand-file-name name project-root))) (and (file-readable-p file) (not (file-directory-p file)) file)))) (defun projectile--first-task-file (project-root names) "Return the first of NAMES that exists under PROJECT-ROOT." (seq-some (lambda (name) (projectile--task-file project-root name)) names)) (defun projectile--tasks-named (names prefix command-format) "Turn NAMES into tasks called `PREFIX:NAME'. Each task runs COMMAND-FORMAT with the name substituted for its `%s'." (mapcar (lambda (name) (cons (format "%s:%s" prefix name) (format command-format name))) names)) (defun projectile--json-tasks (file key prefix command-format) "Return the tasks under KEY in the JSON object in FILE. Each key of that object becomes a task named `PREFIX:KEY', running COMMAND-FORMAT with the key substituted for its `%s'." (when-let* ((json (projectile--read-json-file file :object-type 'alist :array-type 'list :null-object nil :false-object nil)) ;; A JSON document that isn't an object parses to something ;; `alist-get' would choke on. (object (and (consp json) json)) (entries (alist-get key object))) (projectile--tasks-named (mapcar (lambda (entry) (symbol-name (car entry))) entries) prefix command-format))) (defun projectile--npm-runner (project-root) "Return the package manager command to use in PROJECT-ROOT. Derived from the lock file present, so it holds regardless of which project type won detection." (cond ((projectile--task-file project-root "pnpm-lock.yaml") "pnpm") ((projectile--task-file project-root "yarn.lock") "yarn") ((projectile--first-task-file project-root projectile--bun-lock-names) "bun") (t "npm"))) (defun projectile-tasks-from-npm (project-root) "Return the npm scripts of the project in PROJECT-ROOT as tasks. The scripts run through whichever package manager the project's lock file points at." (when-let* ((file (projectile--task-file project-root "package.json"))) (let ((runner (projectile--npm-runner project-root))) (projectile--json-tasks file 'scripts runner (concat runner " run %s"))))) (defun projectile-tasks-from-deno (project-root) "Return the Deno tasks of the project in PROJECT-ROOT." (when-let* ((file (projectile--first-task-file project-root projectile--deno-config-names))) (projectile--json-tasks file 'tasks "deno" "deno task %s"))) (defun projectile-tasks-from-composer (project-root) "Return the Composer scripts of the project in PROJECT-ROOT." (when-let* ((file (projectile--task-file project-root "composer.json"))) (projectile--json-tasks file 'scripts "composer" "composer run-script %s"))) (defun projectile--matches-in-file (file regexp) "Return the first capture group of every match of REGEXP in FILE. Matching is case-sensitive and the results keep their order, with duplicates dropped." (let (names) (with-temp-buffer (insert-file-contents file) (goto-char (point-min)) (let ((case-fold-search nil)) (while (re-search-forward regexp nil t) (let ((name (match-string 1))) (unless (member name names) (push name names)))))) (nreverse names))) (defun projectile-tasks-from-just (project-root) "Return the recipes of the justfile in PROJECT-ROOT as tasks." (when-let* ((file (projectile--first-task-file project-root projectile--justfile-names))) ;; A recipe starts in column zero, may be marked quiet with `@' and ;; may take parameters. The lookahead keeps `:=', which is an ;; assignment, from reading as a recipe. (projectile--tasks-named (projectile--matches-in-file file "^@?\\([a-zA-Z_][a-zA-Z0-9_-]*\\)[^:\n]*:\\(?:[^=\n]\\|$\\)") "just" "just %s"))) (defun projectile--taskfile-task-names (file) "Return the keys of the top-level `tasks:' mapping in the Taskfile FILE. Those are the lines indented exactly one level under it; anything deeper belongs to a task rather than naming one." (with-temp-buffer (insert-file-contents file) (goto-char (point-min)) (let ((case-fold-search nil) names) (when (re-search-forward "^tasks:[ \t]*$" nil t) (forward-line 1) (let ((indent (current-indentation))) (while (and (not (eobp)) (or (looking-at-p "^[ \t]*$") (< 0 (current-indentation)))) (when (and (= (current-indentation) indent) (looking-at "[ \t]+\\([a-zA-Z0-9_.:-]+\\):")) (let ((name (match-string 1))) (unless (member name names) (push name names)))) (forward-line 1)))) (nreverse names)))) (defun projectile-tasks-from-taskfile (project-root) "Return the tasks of the go-task Taskfile in PROJECT-ROOT." (when-let* ((file (projectile--first-task-file project-root projectile--taskfile-names))) (projectile--tasks-named (projectile--taskfile-task-names file) "task" "task %s"))) (defun projectile-tasks-from-make (project-root) "Return the targets of the Makefile in PROJECT-ROOT as tasks. Only plain named targets are offered - pattern rules, file targets and the special dot-targets aren't things you'd run by hand." (when-let* ((file (projectile--first-task-file project-root projectile--makefile-names))) (projectile--tasks-named (projectile--matches-in-file file "^\\([a-zA-Z0-9][a-zA-Z0-9_-]*\\)[ \t]*:\\(?:[^=\n]\\|$\\)") "make" "make %s"))) (defun projectile--rake-task-files (project-root) "Return the files rake tasks may be defined in under PROJECT-ROOT. That's the project's Rakefile plus the `.rake' files in the usual task directories (see `projectile--rake-task-directories'). Returns nil when the project has no Rakefile, since without one there's nothing for rake to run - which also keeps this provider free for non-Ruby projects." (when-let* ((rakefile (projectile--first-task-file project-root projectile--rakefile-names))) (cons rakefile (mapcan (lambda (dir) (let ((dir (expand-file-name dir project-root))) (when (file-directory-p dir) (ignore-errors (directory-files dir t "\\.rake\\'" 'nosort))))) projectile--rake-task-directories)))) (defun projectile--rake-task-names (file) "Return the names of the rake tasks defined in FILE. Only tasks whose name is written out literally are returned: a name built from a variable (`task type, [:id]') can't be known without running rake, which this deliberately doesn't do. Names are qualified with the `namespace' blocks they sit in, so a task is returned under the name you'd actually invoke it by." (let ((names nil) ;; Stack of (INDENT . NAME) for the `namespace' blocks we're in. (namespaces nil)) (with-temp-buffer (insert-file-contents file) (goto-char (point-min)) (let ((case-fold-search nil)) (while (not (eobp)) (let ((indent (current-indentation))) (cond ;; Leaving a block: drop the namespace it opened, if any. ((looking-at "[ \t]*end\\_>") (when (and namespaces (<= indent (caar namespaces))) (pop namespaces))) ((looking-at "[ \t]*namespace[ \t]+[:'\"]?\\([a-zA-Z0-9_][a-zA-Z0-9_-]*\\)") (push (cons indent (match-string 1)) namespaces)) ;; `task' followed by whitespace - not `task.files = ...', ;; which is a method call on a block argument. ((looking-at (concat "[ \t]*\\(?:multi\\)?task[ \t]+" ;; :symbol | 'string' | "string" | bare-word: "\\(?::\\([a-zA-Z0-9_][a-zA-Z0-9_:-]*\\)" "\\|[\"']\\([^\"'\n]+\\)[\"']" "\\|\\([a-zA-Z0-9_][a-zA-Z0-9_-]*\\):\\)")) (let* ((name (or (match-string 1) (match-string 2) (match-string 3))) (qualified (string-join (append (reverse (mapcar #'cdr namespaces)) (list name)) ":"))) (unless (member qualified names) (push qualified names)))))) (forward-line 1)))) (nreverse names))) (defun projectile-tasks-from-rake (project-root) "Return the rake tasks of the project in PROJECT-ROOT. The tasks are read out of the project's Rakefile and `.rake' files rather than by running `rake -T', which would load the whole application." (when-let* ((files (projectile--rake-task-files project-root))) (let ((runner (if (projectile--task-file project-root "Gemfile") "bundle exec rake" "rake"))) (projectile--tasks-named (delete-dups (mapcan #'projectile--rake-task-names files)) "rake" (concat runner " %s"))))) (defun projectile-discovered-tasks (&optional project-root) "Return the tasks discovered in the project at PROJECT-ROOT. PROJECT-ROOT defaults to the current project's root. The tasks come from `projectile-task-providers'; a provider that signals is skipped." (when projectile-discover-tasks (when-let* ((root (or project-root (projectile-project-root))) ;; One listing of the root answers every provider's ;; "does this manifest exist?" question. (projectile--task-entry-set (projectile--directory-entry-set root))) (seq-mapcat (lambda (provider) (condition-case err (funcall provider root) (error (projectile--message "Task provider %s failed: %s" provider (error-message-string err)) nil))) projectile-task-providers)))) (defun projectile--merge-tasks (&rest task-lists) "Merge TASK-LISTS into one alist, earlier lists winning on name." (let (merged) (dolist (tasks task-lists) (dolist (task tasks) (unless (assoc (car task) merged) (push task merged)))) (nreverse merged))) (defun projectile-project-tasks (&optional project-type project-root) "Return the effective tasks alist for the current project. That's the PROJECT-TYPE's `:tasks' table (PROJECT-TYPE defaults to the current project's type) merged with `projectile-tasks', whose entries - set globally or per project via .dir-locals.el - override same-named project-type tasks, and with the tasks discovered in PROJECT-ROOT by `projectile-task-providers', which lose to both." (let ((type-tasks (projectile-project-type-attribute (or project-type (projectile-project-type)) 'tasks))) (projectile--merge-tasks projectile-tasks type-tasks (projectile-discovered-tasks project-root)))) (defun projectile-default-generic-command (project-type command-type) "Generic retrieval of COMMAND-TYPEs default cmd-value for PROJECT-TYPE. If found, checks if value is symbol or string. In case of symbol resolves to function `funcall's. Return value of function MUST be string to be executed as command." (let ((command (plist-get (alist-get project-type projectile-project-types) command-type))) (cond ((not command) nil) ((stringp command) command) ((functionp command) (funcall command)) (t (error "The value for: %s in project-type: %s was neither a function nor a string" command-type project-type))))) (defun projectile-default-configure-command (project-type) "Retrieve default configure command for PROJECT-TYPE." (projectile-default-generic-command project-type 'configure-command)) (defun projectile-default-compilation-command (project-type) "Retrieve default compilation command for PROJECT-TYPE." (projectile-default-generic-command project-type 'compile-command)) (defun projectile-default-compilation-dir (project-type) "Retrieve default compilation directory for PROJECT-TYPE." (projectile-default-generic-command project-type 'compilation-dir)) (defun projectile-default-test-command (project-type) "Retrieve default test command for PROJECT-TYPE." (projectile-default-generic-command project-type 'test-command)) (defun projectile-default-install-command (project-type) "Retrieve default install command for PROJECT-TYPE." (projectile-default-generic-command project-type 'install-command)) (defun projectile-default-package-command (project-type) "Retrieve default package command for PROJECT-TYPE." (projectile-default-generic-command project-type 'package-command)) (defun projectile-default-run-command (project-type) "Retrieve default run command for PROJECT-TYPE." (projectile-default-generic-command project-type 'run-command)) (defun projectile--expand-configure-command (project-type) "Default configure command for PROJECT-TYPE with the project root filled in. The command may contain a `%s' placeholder which is replaced with the project root." (when-let* ((cmd-format-string (projectile-default-configure-command project-type))) (format cmd-format-string (projectile-project-root)))) (defun projectile--phase-command (phase compile-dir) "Resolve the command to run for lifecycle PHASE in COMPILE-DIR. Checks the phase's command cache first, then its .dir-locals.el override variable and finally the default command for the current project type." (let ((descriptor (projectile--phase-descriptor phase))) (or (gethash compile-dir (symbol-value (plist-get descriptor :cmd-map))) (symbol-value (plist-get descriptor :dir-local-var)) (funcall (plist-get descriptor :default-fn) (projectile-project-type))))) (defun projectile-configure-command (compile-dir) "Retrieve the configure command for COMPILE-DIR. Checks `projectile-configure-cmd-map' for the last configure command that was invoked on the project, then `projectile-project-configure-cmd' supplied via .dir-locals.el and finally the default configure command for a project of that type." (projectile--phase-command 'configure compile-dir)) ;;; Compilation buffers, and resolving a command ;; ;; Where a lifecycle command's output goes and what it's called, plus the ;; per-phase readers that resolve which command to run. (defvar projectile--compilation-command-type nil "Lifecycle command type of the compilation being started, or nil. Bound by `projectile--run-project-cmd' for the duration of the call, so `projectile-compilation-buffer-name' - which `compile' calls with nothing but the mode name - can tell a test run from a build.") (defun projectile-compilation-buffer-scope () "Return the aspects a compilation buffer's name is qualified by. A list of `project' and/or `command'. Normalizes the t shorthand of `projectile-compilation-buffer-scope' and folds in the two obsolete booleans it replaced, for a configuration that still sets one." (let ((scope (if (eq projectile-compilation-buffer-scope t) '(project command) projectile-compilation-buffer-scope))) (with-no-warnings (append (unless (memq 'project scope) (and projectile-per-project-compilation-buffer '(project))) (unless (memq 'command scope) (and projectile-per-command-compilation-buffer '(command))) scope)))) (defun projectile-compilation-buffer-name (compilation-mode) "Meant to be used for `compilation-buffer-name-function'. Argument COMPILATION-MODE is the name of the major mode used for the compilation buffer. The name is qualified by the project and/or the lifecycle command type, according to `projectile-compilation-buffer-scope'." (let* ((scope (projectile-compilation-buffer-scope)) (qualifiers (delq nil (list (and (memq 'project scope) (projectile-project-p) (projectile-project-name)) (and (memq 'command scope) projectile--compilation-command-type (symbol-name projectile--compilation-command-type)))))) (concat "*" (downcase compilation-mode) "*" (if qualifiers (concat "<" (string-join qualifiers ":") ">") "")))) (defun projectile-current-project-buffer-p () "Meant to be used for `compilation-save-buffers-predicate`. This indicates whether the current buffer is in the same project as the current window (including returning true if neither is in a project)." (let ((root (with-current-buffer (window-buffer) (projectile-project-root)))) (or (not root) (projectile-project-buffer-p (current-buffer) root)))) (defun projectile-compilation-command (compile-dir) "Retrieve the compilation command for COMPILE-DIR. Checks `projectile-compilation-cmd-map' for the last compile command that was invoked on the project, then `projectile-project-compilation-cmd' supplied via .dir-locals.el and finally the default compilation command for a project of that type." (projectile--phase-command 'compile compile-dir)) (defun projectile-test-command (compile-dir) "Retrieve the test command for COMPILE-DIR. Checks `projectile-test-cmd-map' for the last test command that was invoked on the project, then `projectile-project-test-cmd' supplied via .dir-locals.el and finally the default test command for a project of that type." (projectile--phase-command 'test compile-dir)) (defun projectile-install-command (compile-dir) "Retrieve the install command for COMPILE-DIR. Checks `projectile-install-cmd-map' for the last install command that was invoked on the project, then `projectile-project-install-cmd' supplied via .dir-locals.el and finally the default install command for a project of that type." (projectile--phase-command 'install compile-dir)) (defun projectile-package-command (compile-dir) "Retrieve the package command for COMPILE-DIR. Checks `projectile-package-cmd-map' for the last package command that was invoked on the project, then `projectile-project-package-cmd' supplied via .dir-locals.el and finally the default package command for a project of that type." (projectile--phase-command 'package compile-dir)) (defun projectile-run-command (compile-dir) "Retrieve the run command for COMPILE-DIR. Checks `projectile-run-cmd-map' for the last run command that was invoked on the project, then `projectile-project-run-cmd' supplied via .dir-locals.el and finally the default run command for a project of that type." (projectile--phase-command 'run compile-dir)) (defun projectile-read-command (prompt command &optional command-type) "Adapted from the function `compilation-read-command'. COMMAND-TYPE, when non-nil, selects the per-type command history \(see `projectile--get-command-history') as the minibuffer history." (let ((compile-history ;; fetch the command history for the current project (ring-elements (projectile--get-command-history (projectile-acquire-root) command-type)))) (read-shell-command prompt command (if (equal (car compile-history) command) '(compile-history . 1) 'compile-history)))) ;;; Subprojects ;; ;; A monorepo is one project as far as version control (and therefore ;; Projectile) is concerned, but its parts each have a manifest of their ;; own - a crate, a package, a module. Those are subprojects: Projectile ;; keeps treating the repository as the project, and these commands let ;; you work on the part you're in. (defcustom projectile-subproject-markers nil "File names that mark a subproject inside a project. When nil (the default) the markers are derived from the registered project types - every type's `:project-file' - so registering a project type also teaches Projectile to recognize its manifest inside a monorepo. Set this to an explicit list to narrow things down, e.g. to the manifests of the languages you actually work in. Derived markers never include the wildcard patterns some types use \(`?*.csproj' and friends), nor names with a directory component." :group 'projectile :type '(choice (const :tag "Derive from the registered project types" nil) (repeat string)) :package-version '(projectile . "3.3.0")) (defun projectile--subproject-markers () "Return the file names that mark a subproject. See `projectile-subproject-markers'." (or projectile-subproject-markers (let (markers) (dolist (record projectile-project-types) (dolist (file (ensure-list (plist-get (cdr record) 'project-file))) (when (and (stringp file) ;; A wildcard would have to be expanded per ;; directory, and a name with a directory component ;; (`debian/control') isn't a plain marker. (not (projectile--wildcard-p file)) (not (string-search "/" file)) (not (member file markers))) (push file markers)))) markers))) (defcustom projectile-subproject-functions '(projectile-subprojects-from-manifest projectile-subprojects-from-scan) "Functions consulted by `projectile-project-subprojects'. Each is called with a project root and should return the project's subprojects as directory names relative to it, each ending in a slash. They are tried in order and the first non-empty answer wins - so the list runs from the most authoritative source to the most general, the way `projectile-project-root-functions' does. The default asks the workspace manifest first and falls back to scanning for manifests. Put `projectile-subprojects-from-scan' first to always scan, or add your own function for a workspace format Projectile cannot read." :group 'projectile :type '(repeat function) :package-version '(projectile . "3.5.0")) (defun projectile--expand-member-globs (root patterns) "Expand PATTERNS relative to ROOT into a list of relative directory names. PATTERNS are workspace member globs (`packages/*', `crates/core'). Only existing directories survive, and each comes back with a trailing slash. Negated patterns - pnpm allows a leading `!' - are dropped rather than subtracted, which can only leave the answer too generous, never too narrow." (let ((default-directory root) (dirs nil)) (dolist (pattern patterns) (unless (string-prefix-p "!" pattern) ;; Two arguments only: the third is REGEXP, not a dotfile flag, and ;; passing it makes a glob be read as a regular expression. (dolist (hit (file-expand-wildcards (directory-file-name pattern))) (when (file-directory-p (expand-file-name hit root)) (push (file-name-as-directory hit) dirs))))) (sort (delete-dups dirs) #'string<))) (defun projectile--workspace-member-patterns (root) "Return ROOT's declared workspace member patterns, or nil. Reads the manifest of the workspace formats Projectile can parse statically - pnpm, npm/yarn/bun, Cargo and Go - and returns the raw globs. Formats whose member list is computed rather than declared \(Gradle builds it in a Kotlin or Groovy program, Bazel in Starlark) have no answer here and fall through to scanning." (let ((pnpm (expand-file-name "pnpm-workspace.yaml" root)) (npm (expand-file-name "package.json" root)) (cargo (expand-file-name "Cargo.toml" root)) (gowork (expand-file-name "go.work" root))) (cond ((file-readable-p pnpm) (projectile--pnpm-workspace-patterns pnpm)) ((file-readable-p npm) (projectile--npm-workspace-patterns npm)) ((file-readable-p cargo) (projectile--cargo-workspace-patterns cargo)) ((file-readable-p gowork) (projectile--go-work-patterns gowork))))) (defun projectile--file-contents (file) "Return the contents of FILE as a string." (with-temp-buffer (insert-file-contents file) (buffer-string))) (defun projectile--pnpm-workspace-patterns (file) "Return the `packages:' entries of the pnpm workspace manifest FILE. A deliberately small YAML reader: it takes the list items under the top-level `packages:' key and stops at the next top-level key, which is all this file shape needs (`catalog:' and friends live alongside it)." (let ((lines (split-string (projectile--file-contents file) "\n")) (in-packages nil) (patterns nil)) (dolist (line lines) (cond ((string-match "\\`packages:[[:space:]]*\\'" line) (setq in-packages t)) ;; any other unindented, non-comment line ends the block ((and in-packages (string-match-p "\\`[^[:space:]#-]" line)) (setq in-packages nil)) ((and in-packages (string-match "\\`[[:space:]]*-[[:space:]]*['\"]?\\([^'\"#]+?\\)['\"]?[[:space:]]*\\'" line)) (push (match-string 1 line) patterns)))) (nreverse patterns))) (defun projectile--npm-workspace-patterns (file) "Return the `workspaces' globs declared by the package.json at FILE. Both the plain array form and the `{\"packages\": [...]}' form yarn uses are understood." (when (fboundp 'json-parse-string) (let* ((json (ignore-errors (json-parse-string (projectile--file-contents file) :object-type 'alist :array-type 'list))) (workspaces (alist-get 'workspaces json))) (cond ((and (listp workspaces) (stringp (car workspaces))) workspaces) ((listp workspaces) (alist-get 'packages workspaces)))))) (defun projectile--toml-string-array (text key) "Return the strings of the TOML array assigned to KEY in TEXT, or nil. Comments are stripped first, so the `# Internal' notes Cargo manifests carry inside their member list don't end up in the result." (when (string-match (concat "^[[:space:]]*" (regexp-quote key) "[[:space:]]*=[[:space:]]*\\[\\(\\(?:.\\|\n\\)*?\\)\\]") text) (let ((body (replace-regexp-in-string "#[^\n]*" "" (match-string 1 text))) (out nil) (start 0)) (while (string-match "\"\\([^\"]*\\)\"" body start) (push (match-string 1 body) out) (setq start (match-end 0))) (nreverse out)))) (defun projectile--cargo-workspace-patterns (file) "Return the `[workspace]' members declared by the Cargo manifest at FILE. `exclude' entries are removed, so a fuzzing crate the workspace keeps out of the build is not reported as a member." (let* ((text (projectile--file-contents file)) (members (projectile--toml-string-array text "members")) (excluded (projectile--toml-string-array text "exclude"))) (seq-remove (lambda (m) (member m excluded)) members))) (defun projectile--go-work-patterns (file) "Return the module directories a Go workspace file FILE puts to use. Both the parenthesised `use (...)' block and single-line `use ./dir' are understood." (let ((text (projectile--file-contents file)) (out nil)) (when (string-match "use[[:space:]]*(\\([^)]*\\))" text) (dolist (line (split-string (match-string 1 text) "\n" t)) (let ((entry (string-trim (replace-regexp-in-string "//.*" "" line)))) (unless (string-empty-p entry) (push entry out))))) (let ((start 0)) (while (string-match "^[[:space:]]*use[[:space:]]+\\([^(\n]+\\)$" text start) (push (string-trim (match-string 1 text)) out) (setq start (match-end 0)))) (nreverse out))) (defun projectile-subprojects-from-manifest (root) "Return the subprojects ROOT's workspace manifest declares, or nil. The member list a workspace declares is the workspace's own answer to what its parts are, so it is preferred over looking for manifests: it leaves out the ones that are deliberately not members - test fixtures carrying a package.json, a scaffolding template, an excluded fuzzing crate - which scanning cannot tell apart from the real thing." (when-let* ((patterns (projectile--workspace-member-patterns root))) (projectile--expand-member-globs root patterns))) (defun projectile-subprojects-from-scan (root) "Return the directories below ROOT that hold a project manifest. What counts as a manifest comes from `projectile-subproject-markers'. The file listing of ROOT is what gets scanned, so the ignore rules apply as usual - the manifest of a vendored dependency does not turn it into a subproject. This finds every manifest there is, which is the right answer when nothing declares the members and too generous when something does; see `projectile-subprojects-from-manifest'." (let* ((markers (projectile--subproject-markers)) (marker-set (make-hash-table :test 'equal)) (dirs (make-hash-table :test 'equal))) (dolist (marker markers) (puthash marker t marker-set)) (dolist (file (projectile-project-files root)) ;; The marker test first: it's a hash lookup against a name we ;; already have, while `file-name-directory' allocates - and this ;; runs over every file in the project. A manifest sitting in the ;; root itself has no directory part, which is the project rather ;; than a subproject. (when (gethash (file-name-nondirectory file) marker-set) (when-let* ((dir (file-name-directory file))) (puthash dir t dirs)))) (sort (hash-table-keys dirs) #'string<))) (defun projectile-project-subprojects (&optional project-root) "Return the subprojects of the project at PROJECT-ROOT. A subproject is a part of a monorepo that has a project of its own - a crate, a package, a module. The result is a sorted list of directory names relative to the root, each ending in a slash. Where the list comes from is `projectile-subproject-functions': by default the workspace manifest if there is one Projectile can read, and otherwise a scan for manifests." (let ((root (or project-root (projectile-acquire-root)))) (run-hook-with-args-until-success 'projectile-subproject-functions root))) (defun projectile-subproject-type (&optional subproject-root) "Return the project type of the subproject at SUBPROJECT-ROOT. Detection is rooted at the subproject instead of at the repository, so a crate inside a JavaScript monorepo comes back as `rust-cargo' rather than as one more `node' directory. SUBPROJECT-ROOT defaults to the subproject containing the current file (see `projectile-subproject-root'). This is what separates a subproject from a plain subdirectory: the repository stays the project - find-file, search and switching are still repository-wide - while the lifecycle commands under the `c m' prefix run the member's own build. Promoting members to projects outright (by adding their manifests to `projectile-project-root-files-bottom-up') is the other way to get their commands right, at the cost of the repository no longer being a project." (let* ((root (or subproject-root (projectile-subproject-root))) ;; Resolve the repository's own type first, before the override is ;; in force. (repo-type (projectile-project-type)) (detected (let ((projectile--root-override root)) (or (gethash root projectile-project-type-cache) (projectile-detect-project-type root root))))) ;; A member of a JavaScript workspace holds a `package.json' and nothing ;; else, so on its own it looks like a plain `node' project - and running ;; `npm test' inside a pnpm or yarn workspace is worse than what the ;; repository would have run. The repository's type is the more specific ;; one whenever both are identified by the same manifest, so keep it and ;; only switch when the member is genuinely a different toolchain. (if (projectile--same-manifest-type-p detected repo-type) repo-type detected))) (defun projectile--same-manifest-type-p (a b) "Return non-nil when project types A and B are declared by the same manifest. Both `node' and `pnpm' are identified by `package.json', for instance, so one is a less specific reading of the other rather than a different kind of project." (and a b (let ((fa (projectile-project-type-attribute a 'project-file)) (fb (projectile-project-type-attribute b 'project-file))) (and fa fb (equal fa fb))))) (defun projectile-subproject-root (&optional dir) "Find the root of the nearest subproject containing DIR. Walk up from DIR (the current file's directory by default) looking for one of `projectile-subproject-markers', stopping at the project root. Returns the directory containing the nearest marker, or signals an error if no subproject is found between DIR and the project root." (let* ((project-root (projectile-acquire-root)) (markers (projectile--subproject-markers)) (dir (or dir (file-name-directory (or (buffer-file-name) default-directory)))) (result nil)) ;; Walk up from current directory, stop at (but include) project root. ;; Each level costs one directory listing rather than one stat per ;; marker, which matters here - the derived marker set is long. (while (and (not result) dir (string-prefix-p project-root dir)) (when (projectile--directory-marker dir markers 'files-only) (setq result dir)) (let ((parent (file-name-directory (directory-file-name dir)))) (setq dir (unless (string= parent dir) parent)))) (or result (user-error "No subproject found between current directory and project root")))) ;;;###autoload (defun projectile-find-file-in-subproject () "Jump to a file in one of the current project's subprojects. Prompts for the subproject first, so the file completion only covers that part of the repository." (interactive) (let* ((project-root (projectile-acquire-root)) (subprojects (projectile-project-subprojects project-root))) (unless subprojects (user-error "No subprojects found in %s" project-root)) (let* ((subproject (projectile-completing-read "Subproject: " subprojects)) ;; Narrow the project's own listing rather than indexing the ;; subdirectory afresh: it's already there, and indexing the ;; subdirectory as if it were a project of its own would drop ;; the project's ignore rules. (files (projectile--restrict-to-subdirs (projectile-project-files project-root) (list subproject))) (file (projectile-completing-read "Find file: " files :caller 'projectile-read-file))) (find-file (expand-file-name file project-root)) (run-hooks 'projectile-find-file-hook)))) ;;; Lifecycle commands ;; ;; Configure, compile, test, install, package and run: the six phases a ;; project is driven through from Projectile. Each resolves its command ;; the same way (cache, then .dir-locals.el, then the project type's ;; default), remembers what you ran, and hands it to `compile'. The ;; subproject variants at the end of the section are the same six, scoped ;; to the part of a monorepo you're in. (defun projectile-compilation-dir (&optional base) "Retrieve the compilation directory for this project. BASE, when non-nil, is the directory the project type's compilation directory is resolved against instead of the project root - a subproject's root, say, so a Meson module builds in its own `build' directory rather than the repository's." (let* ((base (or base (projectile-acquire-root))) (type (projectile-project-type base)) (comp-dir (or projectile-project-compilation-dir (projectile-default-compilation-dir type)))) (if comp-dir (expand-file-name (file-name-as-directory comp-dir) base) base))) (defun projectile-maybe-read-command (arg default-cmd prompt &optional command-type) "Prompt user for command unless DEFAULT-CMD is an Elisp function. COMMAND-TYPE is forwarded to `projectile-read-command' to pick the per-type command history." (if (and (or (stringp default-cmd) (null default-cmd)) (or compilation-read-command arg)) (projectile-read-command prompt default-cmd command-type) default-cmd)) (defun projectile-run-compilation (cmd &optional use-comint-mode) "Run external or Elisp compilation command CMD." (if (functionp cmd) (funcall cmd) (compile cmd use-comint-mode))) (defvar projectile-project-command-history (make-hash-table :test 'equal) "The history of last executed project commands, per project. Indexed by whatever `projectile--command-history-key' makes of a project root, which is the repository the project is a checkout of when that can be established and the root itself otherwise.") (defun projectile--command-history-key (project-root) "Return the key PROJECT-ROOT's command history is stored under. That's PROJECT-ROOT itself, unless `projectile-command-history-scope' asks for a repository-wide history and the repository can be identified - then it's a spelling of the repository, so that every checkout of it reaches the same history. The upstream is preferred over the repository directory because it is the broader of the two: worktrees of one repository agree on it, and so do separate clones, which is the same arrangement done by hand. A repository with no upstream falls back to the directory its checkouts share, which still covers its worktrees. Two consequences worth knowing. The key follows the remote, so pointing a repository at a new upstream moves it to a fresh history. And this picks one of the two keys where `projectile-same-repo-p' accepts either, so checkouts that disagree about having a remote at all - an `hg share' working directory whose source configures a `default' path and which doesn't - are one repository for switching purposes but keep separate histories." (or (and (eq projectile-command-history-scope 'repository) (let ((identity (projectile-repo-identity project-root))) (or (plist-get identity :remote) (plist-get identity :repo)))) project-root)) (defun projectile--get-command-history (project-root &optional command-type) "Return the command history ring for PROJECT-ROOT. With COMMAND-TYPE non-nil (one of the lifecycle command type symbols, e.g. `compile' or `test', or a (task . TASK-NAME) cons for named tasks) return the history specific to that command type, so histories of different types don't bleed into each other's prompts. With COMMAND-TYPE nil return the combined history, which is what `projectile-repeat-last-command' reads. Which history that is depends on `projectile--command-history-key' - by default the repository's rather than this one checkout's." (let* ((root-key (if command-type (cons project-root command-type) project-root)) (key (if command-type ;; The per-type histories are the ones you browse at a ;; prompt, so sharing them is all upside: pressing M-p in ;; a fresh worktree offers the commands this project is ;; actually built with. (cons (projectile--command-history-key project-root) command-type) ;; The combined history stays this checkout's own. ;; `projectile-repeat-last-command' replays its most recent ;; entry without asking, and a command typed in another ;; checkout can carry absolute paths back into it - being ;; handed somebody else's build unasked is no fun. project-root))) (or (gethash key projectile-project-command-history) ;; The per-type histories used to be keyed by root, and they're ;; persisted, so an upgrade would otherwise walk into a project you ;; have been building for years with nothing in hand. Adopt this ;; root's history as the repository's instead. (unless (equal key root-key) (when-let* ((inherited (gethash root-key projectile-project-command-history))) (remhash root-key projectile-project-command-history) (puthash key inherited projectile-project-command-history))) (puthash key (make-ring 16) projectile-project-command-history)))) (defun projectile--command-history-insert (history command) "Insert COMMAND into the ring HISTORY. Duplicates are handled according to `projectile-command-history-ignore-duplicates'." (cond ((eq projectile-command-history-ignore-duplicates t) (unless (string= (car-safe (ring-elements history)) command) (ring-insert history command))) ((eq projectile-command-history-ignore-duplicates 'erase) (let ((idx (ring-member history command))) (while idx (ring-remove history idx) (setq idx (ring-member history command)))) (ring-insert history command)) (t (ring-insert history command)))) (cl-defun projectile--run-project-cmd (command command-map &key command-type directory show-prompt prompt-prefix save-buffers use-comint-mode buffer-name-function no-cache) "Run a project COMMAND, typically a test- or compile command. Cache the COMMAND for later use inside the hash-table COMMAND-MAP. With NO-CACHE non-nil the command is not stored in COMMAND-MAP (though its result still enters the command history) unless the user edited it at the prompt. This is for function-derived commands, which must be re-resolved on every run so they can prompt again - but an edit is the user overriding that function, and overriding it once shouldn't have to be repeated on every run (issue #2097). COMMAND-TYPE, when non-nil, is the lifecycle command type symbol \(e.g. `compile' or `test') and is used to keep a per-type command history for the prompt, in addition to the combined per-project one. DIRECTORY, when non-nil, is where the command runs; it defaults to `projectile-compilation-dir'. The caller passes it when it has already resolved the directory, so the command it looked up and the directory it runs in can't diverge. Normally you'll be prompted for a compilation command, unless variable `compilation-read-command'. You can force the prompt by setting SHOW-PROMPT. The prompt will be prefixed with PROMPT-PREFIX. If SAVE-BUFFERS is non-nil save all projectile buffers before running the command. BUFFER-NAME-FUNCTION, when non-nil, is used as the `compilation-buffer-name-function' for the compilation, taking precedence over the `projectile-compilation-buffer-scope' naming. The placeholder `%p' in COMMAND is replaced with the project name. The command actually run is returned." (let* ((project-root (projectile-acquire-root)) (default-directory (or directory (projectile-compilation-dir))) ;; What the caller resolved, before the user got a say - the two ;; differing is how we know the command was edited at the prompt. (derived-command command) (command (projectile-maybe-read-command show-prompt command prompt-prefix command-type)) (compilation-buffer-name-function compilation-buffer-name-function) (compilation-save-buffers-predicate compilation-save-buffers-predicate) ;; `compile' calls the buffer-name function with just the mode ;; name, so the command type has to reach it this way. (projectile--compilation-command-type command-type)) (when command-map ;; A function-derived command (NO-CACHE) is re-resolved on every run so ;; it can prompt again (e.g. a CMake preset picker); don't freeze its ;; result in the cache, only feed it to the history below. An edit at ;; the prompt is a different matter: the user has overridden the ;; function, so remember that instead of offering the function's ;; answer again next time (issue #2097). `projectile-discard-command-cache' ;; hands the project back to the function. (unless (and no-cache (equal command derived-command)) (puthash default-directory command command-map)) ;; Record into the combined per-project history (read by ;; `projectile-repeat-last-command') and, when known, into the ;; per-type history used for this command's prompt. (projectile--command-history-insert (projectile--get-command-history project-root) command) (when command-type (projectile--command-history-insert (projectile--get-command-history project-root command-type) command))) (when save-buffers (save-some-buffers (not compilation-ask-about-save) (lambda () (projectile-project-buffer-p (current-buffer) project-root)))) (let ((scope (projectile-compilation-buffer-scope))) (when (memq 'project scope) (setq compilation-save-buffers-predicate #'projectile-current-project-buffer-p)) (cond (buffer-name-function (setq compilation-buffer-name-function buffer-name-function)) (scope (setq compilation-buffer-name-function #'projectile-compilation-buffer-name)))) (unless command (user-error "No %scommand configured for project type `%s'" (or prompt-prefix "") (projectile-project-type))) (unless (file-directory-p default-directory) (mkdir default-directory)) ;; Substitute placeholders: %p -> project name (when (string-match-p "%p" command) (setq command (string-replace "%p" (projectile-project-name project-root) command))) (projectile-run-compilation command use-comint-mode) command)) (defcustom projectile-use-comint-mode nil "Which of the commands Projectile runs get an interactive output buffer. Projectile reports through `compilation-mode', which is read-only. For a command covered here it uses `comint-mode' instead, so a build that asks a question, a test runner that drops into a debugger, or a task that wants a sudo password can be typed at. The value is nil (nothing is interactive), t (everything is), or a list naming what is - the lifecycle phases `configure', `compile', `test', `install', `package' and `run', and `task' for the named tasks run by `projectile-run-task'." :group 'projectile :type '(choice (const :tag "Nothing" nil) (const :tag "Everything" t) (set :tag "Selected commands" (const :tag "Configure" configure) (const :tag "Compile" compile) (const :tag "Test" test) (const :tag "Install" install) (const :tag "Package" package) (const :tag "Run" run) (const :tag "Tasks" task))) :package-version '(projectile . "3.4.0")) ;; Remove in 4.0, this block and the fallback in ;; `projectile-use-comint-mode-p' together. Superseded by the single ;; `projectile-use-comint-mode', which folds them in. (defvar projectile-configure-use-comint-mode nil "Make the output buffer of `projectile-configure-project' interactive.") (defvar projectile-compile-use-comint-mode nil "Make the output buffer of `projectile-compile-project' interactive.") (defvar projectile-test-use-comint-mode nil "Make the output buffer of `projectile-test-project' interactive.") (defvar projectile-install-use-comint-mode nil "Make the output buffer of `projectile-install-project' interactive.") (defvar projectile-package-use-comint-mode nil "Make the output buffer of `projectile-package-project' interactive.") (defvar projectile-run-use-comint-mode nil "Make the output buffer of `projectile-run-project' interactive.") (defconst projectile--obsolete-comint-vars '((configure . projectile-configure-use-comint-mode) (compile . projectile-compile-use-comint-mode) (test . projectile-test-use-comint-mode) (install . projectile-install-use-comint-mode) (package . projectile-package-use-comint-mode) (run . projectile-run-use-comint-mode)) "The per-phase option `projectile-use-comint-mode' replaced, by phase.") (dolist (var projectile--obsolete-comint-vars) (make-obsolete-variable (cdr var) "use `projectile-use-comint-mode' instead." "3.4.0")) (defun projectile-use-comint-mode-p (phase) "Return non-nil when PHASE's output buffer should be interactive. PHASE is a lifecycle phase symbol such as `compile', or `task' for the named tasks - which run through the same machinery and are covered by the same option (see issue #2156). Reads `projectile-use-comint-mode', falling back to the obsolete per-phase option it replaced for a configuration that still sets one; the tasks never had one of those." ;; Normalized to a boolean: `memq' would otherwise hand the caller the ;; tail of the option's list, which then travels all the way into ;; `compile' as its COMINT argument. (and (or (eq projectile-use-comint-mode t) (memq phase projectile-use-comint-mode) (when-let* ((var (alist-get phase projectile--obsolete-comint-vars))) (symbol-value var))) t)) (defun projectile--phase-command-dynamic-p (phase) "Non-nil when PHASE's command comes from a function for the current project. A project type can register a lifecycle command as a function (e.g. the CMake preset pickers, or a user's own `:test'/`:run' function). Such a command is meant to be re-invoked - and may prompt - on every run, so its result must not be frozen in the command cache after the first run. A `.dir-locals.el' override always wins and is a plain string, so it is never treated as dynamic." (let ((descriptor (projectile--phase-descriptor phase))) (and (not (symbol-value (plist-get descriptor :dir-local-var))) (functionp (plist-get (alist-get (projectile-project-type) projectile-project-types) (intern (format "%s-command" phase))))))) (defun projectile--lifecycle-prompt (descriptor base) "Return the command prompt for the lifecycle phase DESCRIPTOR. When BASE is non-nil the command runs somewhere other than the project root, and the prompt says where - there's no other way to tell a subproject build from a whole-project one at the prompt." (let ((prompt (plist-get descriptor :prompt))) (if (null base) prompt (format "%s in %s: " (string-trim-right prompt "[ :]+") (file-relative-name base (projectile-acquire-root)))))) (defun projectile--run-lifecycle-phase (phase show-prompt &optional base) "Run the current project's command for lifecycle PHASE. PHASE is a symbol naming an entry of `projectile--lifecycle-phases'. With SHOW-PROMPT non-nil force prompting for the command, as in `projectile--run-project-cmd'. BASE, when non-nil, is the directory the phase's compilation directory is resolved against instead of the project root (see `projectile-compilation-dir')." (let* ((descriptor (projectile--phase-descriptor phase)) (directory (projectile-compilation-dir base)) (command (funcall (plist-get descriptor :command-fn) directory)) (command-map (if (projectile--cache-project-commands-p) (symbol-value (plist-get descriptor :cmd-map))))) (projectile--run-project-cmd command command-map :command-type phase :directory directory :show-prompt show-prompt :prompt-prefix (projectile--lifecycle-prompt descriptor base) :save-buffers (plist-get descriptor :save-buffers) :no-cache (projectile--phase-command-dynamic-p phase) :use-comint-mode (projectile-use-comint-mode-p phase)))) ;;;###autoload (defun projectile-configure-project (arg) "Run project configure command. Normally you'll be prompted for a compilation command, unless variable `compilation-read-command'. You can force the prompt with a prefix ARG." (interactive "P") (projectile--run-lifecycle-phase 'configure arg)) ;;;###autoload (defun projectile-compile-project (arg) "Run project compilation command. Normally you'll be prompted for a compilation command, unless variable `compilation-read-command'. You can force the prompt with a prefix ARG. Per project default command can be set through `projectile-project-compilation-cmd'." (interactive "P") (projectile--run-lifecycle-phase 'compile arg)) ;;;###autoload (defun projectile-test-project (arg) "Run project test command. Normally you'll be prompted for a compilation command, unless variable `compilation-read-command'. You can force the prompt with a prefix ARG." (interactive "P") (projectile--run-lifecycle-phase 'test arg)) ;;;###autoload (defun projectile-install-project (arg) "Run project install command. Normally you'll be prompted for a compilation command, unless variable `compilation-read-command'. You can force the prompt with a prefix ARG." (interactive "P") (projectile--run-lifecycle-phase 'install arg)) ;;;###autoload (defun projectile-package-project (arg) "Run project package command. Normally you'll be prompted for a compilation command, unless variable `compilation-read-command'. You can force the prompt with a prefix ARG." (interactive "P") (projectile--run-lifecycle-phase 'package arg)) ;;;###autoload (defun projectile-run-project (arg) "Run project run command. Normally you'll be prompted for a compilation command, unless variable `compilation-read-command'. You can force the prompt with a prefix ARG." (interactive "P") (projectile--run-lifecycle-phase 'run arg)) (defun projectile--run-subproject-phase (phase show-prompt) "Run lifecycle PHASE in the nearest subproject of the current file. SHOW-PROMPT is as in `projectile--run-lifecycle-phase', which does the actual work - the subproject is just the directory the phase resolves its compilation directory against." (let* ((subproject (projectile-subproject-root)) ;; `projectile--phase-command' falls back to the default command ;; for `(projectile-project-type)'; bind it to the member's own ;; type so a Rust crate in a JavaScript repo runs `cargo test' ;; rather than the repository's `npm test'. The dir-local ;; override and the per-directory command cache still win over it. (projectile-project-type (projectile-subproject-type subproject))) (projectile--run-lifecycle-phase phase show-prompt subproject))) (defmacro projectile--define-subproject-commands (&rest phases) "Define a subproject variant of the lifecycle command of each of PHASES. Each variant runs the phase command in the nearest subproject rather than at the project root; see `projectile--run-subproject-phase'." `(progn ,@(mapcar (lambda (phase) (let ((name (intern (format "projectile-%s-subproject" phase)))) `(defun ,name (arg) ,(format "Run the %s command of the project in the nearest subproject. Find the closest project manifest (e.g. pom.xml, Cargo.toml) between the current directory and the project root, and run the command there instead of over the whole repository. In a monorepo that is the module being worked on. The command itself is unchanged - only the directory it runs in - so a project type that builds in a subdirectory (Meson in `build', say) still does, relative to the subproject. Normally you will be prompted for the command, unless variable `compilation-read-command'. You can force the prompt with a prefix ARG." phase) (interactive "P") (projectile--run-subproject-phase ',phase arg)))) phases))) ;;;###autoload (autoload 'projectile-configure-subproject "projectile" nil t) ;;;###autoload (autoload 'projectile-compile-subproject "projectile" nil t) ;;;###autoload (autoload 'projectile-test-subproject "projectile" nil t) ;;;###autoload (autoload 'projectile-install-subproject "projectile" nil t) ;;;###autoload (autoload 'projectile-package-subproject "projectile" nil t) ;;;###autoload (autoload 'projectile-run-subproject "projectile" nil t) (projectile--define-subproject-commands configure compile test install package run) ;;; Running the test at point ;; ;; Run just the test the cursor is in, rather than the whole suite. A rule ;; per major mode says how to recognise a test in that language's syntax ;; tree and how to name it on the command line; `projectile-test-at-point-rules' ;; ties them together and is where a language gets added. (defun projectile-test-at-point-python-name (node) "Return the test name for the Python `function_definition' NODE. Return nil unless the function's name starts with \"test_\"." (when-let* ((name-node (treesit-node-child-by-field-name node "name")) (name (treesit-node-text name-node t))) (when (string-prefix-p "test_" name) name))) (defun projectile-test-at-point-python-command (test-name file-name) "Return a pytest command running TEST-NAME in FILE-NAME. TEST-NAME and FILE-NAME are shell-quoted: a test name comes from the buffer's own source and a file name from the repository, so an unquoted interpolation would let a hostile project inject shell code." (format "python -m pytest %s::%s" (shell-quote-argument file-name) (shell-quote-argument test-name))) (defun projectile-test-at-point-go-name (node) "Return the test name for the Go `function_declaration' NODE. Return nil unless the function's name is one `go test' would run: \"Test\" followed by a non-lowercase character (or nothing)." (when-let* ((name-node (treesit-node-child-by-field-name node "name")) (name (treesit-node-text name-node t))) (let ((case-fold-search nil)) (when (string-match-p "\\`Test\\([^[:lower:]]\\|\\'\\)" name) name)))) (defun projectile-test-at-point-go-command (test-name file-name) "Return a `go test' command running TEST-NAME from FILE-NAME's package. The command targets exactly the package containing FILE-NAME (e.g. `./pkg/foo' for `pkg/foo/foo_test.go'); the recursive `./pkg/foo/...' form would also build every nested package and run any same-named tests they contain." (let ((dir (file-name-directory file-name))) ;; TEST-NAME and the package directory are shell-quoted to keep a ;; hostile repository from injecting shell code. The `^...$' ;; regexp anchors stay inside the quoting so `-run' still gets one ;; anchored pattern. (format "go test -run %s %s" (shell-quote-argument (concat "^" test-name "$")) (shell-quote-argument (if dir (concat "./" (directory-file-name dir)) "."))))) (defun projectile-test-at-point-jest-name (node) "Return the test name for the JS/TS `call_expression' NODE. Matches `it'/`test'/`describe' calls (including member calls like `it.only' or `test.each') whose first argument is a string literal, returning that string without the surrounding quotes. Return nil otherwise." (let* ((fn (treesit-node-child-by-field-name node "function")) (fn-name (when fn (pcase (treesit-node-type fn) ("identifier" (treesit-node-text fn t)) ("member_expression" (when-let* ((object (treesit-node-child-by-field-name fn "object"))) (when (equal (treesit-node-type object) "identifier") (treesit-node-text object t)))))))) (when (member fn-name '("it" "test" "describe")) (when-let* ((args (treesit-node-child-by-field-name node "arguments")) (arg (treesit-node-child args 0 t))) (when (member (treesit-node-type arg) '("string" "template_string")) ;; Strip the surrounding quotes/backticks. (substring (treesit-node-text arg t) 1 -1)))))) (defun projectile-test-at-point-jest-command (test-name file-name) "Return a jest command running TEST-NAME in FILE-NAME. TEST-NAME and FILE-NAME are shell-quoted: the test name is arbitrary source text (JS strings can contain any character), so an unquoted interpolation would let a hostile project inject shell code." (format "npx jest %s -t %s" (shell-quote-argument file-name) (shell-quote-argument test-name))) (defun projectile-test-at-point-ruby-name (node) "Return the test name for the Ruby NODE at point. Handles both dialects: an RSpec `it'/`describe' call whose first argument is a string, and a Minitest `def test_foo' method." (pcase (treesit-node-type node) ("method" (when-let* ((name-node (treesit-node-child-by-field-name node "name")) (name (treesit-node-text name-node t))) (when (string-prefix-p "test_" name) name))) ((or "call" "method_call") (when-let* ((method (treesit-node-child-by-field-name node "method")) (method-name (treesit-node-text method t))) (when (member method-name '("it" "describe" "context" "specify")) (when-let* ((args (treesit-node-child-by-field-name node "arguments")) (arg (treesit-node-child args 0 t))) (when (equal (treesit-node-type arg) "string") ;; Strip the surrounding quotes. (let ((text (treesit-node-text arg t))) (if (> (length text) 1) (substring text 1 -1) text))))))))) (defun projectile-test-at-point-ruby-command (test-name file-name) "Return a command running Ruby\\='s TEST-NAME in FILE-NAME. Which runner to use is decided by the project type rather than by the buffer, since both dialects are written in the same major mode: an `rspec\\=' project gets `rspec -e\\=', anything else the Minitest invocation. TEST-NAME and FILE-NAME are shell-quoted, as a test name is arbitrary source text." (if (memq (projectile-project-type) '(rails-rspec ruby-rspec)) (format "bundle exec rspec %s -e %s" (shell-quote-argument file-name) (shell-quote-argument test-name)) (format "bundle exec ruby -Itest %s -n %s" (shell-quote-argument file-name) (shell-quote-argument test-name)))) (defun projectile-test-at-point-rust-name (node) "Return the test name for the Rust `function_item' NODE. Return nil unless the function carries a `#[test]\\=' (or `#[tokio::test]\\=', and friends) attribute, since an ordinary function isn\\='t something `cargo test\\=' would run." (when-let* ((name-node (treesit-node-child-by-field-name node "name")) (name (treesit-node-text name-node t))) ;; Attributes are siblings preceding the function item. (let ((sibling (treesit-node-prev-sibling node)) (test nil)) (while (and sibling (equal (treesit-node-type sibling) "attribute_item")) (when (projectile--test-at-point-annotated-p (treesit-node-text sibling t) '("test")) (setq test t)) (setq sibling (treesit-node-prev-sibling sibling))) (when test name)))) (defun projectile-test-at-point-rust-command (test-name _file-name) "Return a `cargo test\\=' command running TEST-NAME. Cargo selects tests by name filter rather than by file, so the file isn\\='t part of the command. `--\\=' separates the filter from cargo\\='s own arguments and `--exact\\=' keeps a short name from also matching longer ones." (format "cargo test -- --exact %s" (shell-quote-argument test-name))) (defun projectile-test-at-point-elixir-name (node) "Return the test name for the Elixir `call' NODE. Matches an ExUnit `test\\='/`describe\\=' call whose first argument is a string." (when-let* ((target (treesit-node-child-by-field-name node "target")) (target-name (treesit-node-text target t))) (when (member target-name '("test" "describe")) (when-let* ((args (treesit-node-child-by-field-name node "arguments")) (arg (treesit-node-child args 0 t))) (when (equal (treesit-node-type arg) "string") (let ((text (treesit-node-text arg t))) (if (> (length text) 1) (substring text 1 -1) text))))))) (defun projectile-test-at-point-elixir-command (_test-name file-name) "Return a `mix test\\=' command running the test at point in FILE-NAME. ExUnit has no way to select a test by name from the command line, so it is addressed by line instead - the `FILE:LINE\\=' form. The line is the one point is on, which is where the test was found in the first place." (format "mix test %s" (shell-quote-argument (format "%s:%d" file-name (line-number-at-pos))))) (defun projectile-test-at-point-java-name (node) "Return the test name for the Java `method_declaration' NODE. Return nil unless the method carries a `@Test\\=' annotation (JUnit\\='s `@ParameterizedTest\\=' and `@RepeatedTest\\=' count too)." (when-let* ((name-node (treesit-node-child-by-field-name node "name")) (name (treesit-node-text name-node t)) (modifiers (treesit-node-child node 0 t))) (when (and (equal (treesit-node-type modifiers) "modifiers") (projectile--test-at-point-annotated-p (treesit-node-text modifiers t) '("Test" "ParameterizedTest" "RepeatedTest"))) name))) (defun projectile-test-at-point-java-command (test-name file-name) "Return a command running Java\\='s TEST-NAME from FILE-NAME. JUnit addresses a test as `Class#method\\=', and Java requires the public class to be named after its file, so the class comes from FILE-NAME. Gradle and Maven spell the selector differently, so the project type decides which one to emit." (let ((class (file-name-base file-name))) (if (memq (projectile-project-type) '(gradle gradlew)) (format "./gradlew test --tests %s" (shell-quote-argument (format "%s.%s" class test-name))) (format "mvn test -Dtest=%s" (shell-quote-argument (format "%s#%s" class test-name)))))) (defun projectile--test-at-point-annotated-p (text names) "Return non-nil when TEXT mentions one of NAMES as a whole word. Deliberately not the symbol-boundary operators: those consult the buffer's syntax table, under which the `<' and `>' of an F# `[]' count as part of the symbol, so the boundary never matches. Bracketing on non-alphanumerics is the same test without the dependency." (string-match-p (format "\\(?:^\\|[^[:alnum:]_]\\)\\(?:%s\\)\\(?:$\\|[^[:alnum:]_]\\)" (mapconcat #'regexp-quote names "\\|")) text)) (defun projectile-test-at-point-erlang-name (node) "Return the test name for the Erlang `fun_decl\\=' NODE. EUnit picks up functions whose name ends in `_test\\=' (a plain test) or `_test_\\=' (a test generator), which is the only thing marking one out from any other function." (when-let* ((clause (treesit-node-child-by-field-name node "clause")) (name-node (treesit-node-child-by-field-name clause "name")) (name (treesit-node-text name-node t))) (when (or (string-suffix-p "_test" name) (string-suffix-p "_test_" name)) name))) (defun projectile-test-at-point-erlang-command (test-name file-name) "Return a `rebar3 eunit\\=' command running TEST-NAME from FILE-NAME. EUnit addresses a test as `module:function\\=', and an Erlang module is named after its file, so the module comes from FILE-NAME." (format "rebar3 eunit --test=%s" (shell-quote-argument (format "%s:%s" (file-name-base file-name) test-name)))) (defun projectile-test-at-point-fsharp-name (node) "Return the test name for the F# `function_or_value_defn\\=' NODE. Return nil unless the binding carries a test attribute - xUnit\\='s `[]\\=' or `[]\\=', NUnit\\='s `[]\\=' or FsCheck\\='s `[]\\='. The attributes are a sibling of the definition under its enclosing `declaration_expression\\=', not a child of it. A name written between double backticks - which is how F# tests usually get readable names - is returned without them, since that is what the test framework sees." (when-let* ((parent (treesit-node-parent node)) ;; `attributes' is a positional child of the enclosing ;; `declaration_expression', not a field of it. (attributes (seq-find (lambda (child) (equal (treesit-node-type child) "attributes")) (treesit-node-children parent t)))) (when (projectile--test-at-point-annotated-p (treesit-node-text attributes t) '("Fact" "Theory" "Test" "TestCase" "Property")) (when-let* ((left (treesit-node-child node 0 t)) (name (treesit-node-text (treesit-node-child left 0 t) t))) (if (and (string-prefix-p "``" name) (string-suffix-p "``" name)) (substring name 2 -2) name))))) (defun projectile-test-at-point-fsharp-command (test-name _file-name) "Return a `dotnet test\\=' command running TEST-NAME. The .NET test runners select by a filter expression rather than by file, so the file plays no part. `FullyQualifiedName~\\=' matches on a substring, which keeps the filter working without the namespace." (format "dotnet test --filter %s" (shell-quote-argument (format "FullyQualifiedName~%s" test-name)))) (defcustom projectile-test-at-point-rules (let ((jest-rule '(:node-types ("call_expression") :name-fn projectile-test-at-point-jest-name :command-fn projectile-test-at-point-jest-command))) `((python-ts-mode :node-types ("function_definition") :name-fn projectile-test-at-point-python-name :command-fn projectile-test-at-point-python-command) (go-ts-mode :node-types ("function_declaration") :name-fn projectile-test-at-point-go-name :command-fn projectile-test-at-point-go-command) (js-ts-mode ,@jest-rule) (typescript-ts-mode ,@jest-rule) (tsx-ts-mode ,@jest-rule) (ruby-ts-mode ;; RSpec examples are calls, Minitest cases are methods. :node-types ("call" "method_call" "method") :name-fn projectile-test-at-point-ruby-name :command-fn projectile-test-at-point-ruby-command) (rust-ts-mode :node-types ("function_item") :name-fn projectile-test-at-point-rust-name :command-fn projectile-test-at-point-rust-command) (elixir-ts-mode :node-types ("call") :name-fn projectile-test-at-point-elixir-name :command-fn projectile-test-at-point-elixir-command) (java-ts-mode :node-types ("method_declaration") :name-fn projectile-test-at-point-java-name :command-fn projectile-test-at-point-java-command) (erlang-ts-mode :node-types ("fun_decl") :name-fn projectile-test-at-point-erlang-name :command-fn projectile-test-at-point-erlang-command) (fsharp-ts-mode :node-types ("function_or_value_defn") :name-fn projectile-test-at-point-fsharp-name :command-fn projectile-test-at-point-fsharp-command))) "Rules telling `projectile-run-test-at-point' how to run a single test. An alist keyed by major mode symbol. The current buffer's mode is matched against the keys with `derived-mode-p', so a rule keyed on a mode also applies to modes derived from it. Each value is a plist with the following keys: `:node-types' - a list of tree-sitter node type strings; walking up the parse tree from point, only nodes of these types are considered. `:name-fn' - a function called with a matching tree-sitter node that returns the test name string, or nil if the node isn't a test (in which case the walk continues upward). `:command-fn' - a function called with the test name and the file name (relative to the directory the command runs in, normally the project root) that returns the shell command to run." :group 'projectile :type '(alist :key-type (symbol :tag "Major mode") :value-type (plist :tag "Rule")) :package-version '(projectile . "3.1.0")) (defun projectile--test-at-point-rule () "Return the `projectile-test-at-point-rules' rule for the current buffer. The buffer's major mode is matched against the rule keys with `derived-mode-p'. Return nil when no rule matches." (cdr (seq-find (lambda (rule) (derived-mode-p (car rule))) projectile-test-at-point-rules))) (defun projectile--test-at-point-name (rule) "Return the name of the test around point according to RULE, or nil. Walk up the tree-sitter parse tree from the node at point; for every enclosing node whose type is in RULE's `:node-types', call the rule's `:name-fn' with the node and return its first non-nil result." (let ((node-types (plist-get rule :node-types)) (name-fn (plist-get rule :name-fn)) (node (treesit-node-at (point))) name) (while (and node (null name)) (when (member (treesit-node-type node) node-types) (setq name (funcall name-fn node))) (setq node (treesit-node-parent node))) name)) ;;;###autoload (defun projectile-run-test-at-point (arg) "Run the test around point, if any. The test is located by walking up the buffer's tree-sitter parse tree according to the rule for the buffer's major mode in `projectile-test-at-point-rules', which also determines the command used to run it. Requires Emacs 29+ built with tree-sitter support and a tree-sitter major mode (e.g. `python-ts-mode'). The command runs like `projectile-test-project' does (same working directory and buffer-saving behavior), but it is not recorded as the project's test command and doesn't touch the command history. With a prefix ARG you can edit the command before it's run." (interactive "P") (unless (and (fboundp 'treesit-available-p) (treesit-available-p)) (user-error "This command requires Emacs 29+ built with tree-sitter support")) (unless (treesit-parser-list) (user-error "No tree-sitter parser in this buffer; use a tree-sitter major mode (e.g. `python-ts-mode')")) (unless buffer-file-name (user-error "The current buffer is not visiting a file")) (let ((rule (projectile--test-at-point-rule))) (unless rule (user-error "No test-at-point rule for `%s'; see `projectile-test-at-point-rules'" major-mode)) (let ((test-name (projectile--test-at-point-name rule))) (unless test-name (user-error "No test found at point")) ;; The command runs in the compilation directory, so the file ;; name is made relative to it as spelled - not through ;; `file-truename', which would escape the project for a file ;; under a symlinked subdirectory and yield a useless `../..' path. (let ((command (funcall (plist-get rule :command-fn) test-name (file-relative-name buffer-file-name (projectile-compilation-dir)))) ;; The command was derived from the test at point, so the ;; usual `compilation-read-command' prompt doesn't apply; ;; prompt only when explicitly asked to with a prefix arg. (compilation-read-command nil)) ;; A nil command-map keeps the project's cached test command and ;; command history untouched - the command type is still declared, ;; so this shares the test compilation buffer and the test history ;; at the prompt. (projectile--run-project-cmd command nil :command-type 'test :show-prompt arg :prompt-prefix "Test at point command: " :save-buffers t :use-comint-mode (projectile-use-comint-mode-p 'test)))))) ;;; Tasks, and repeating what you ran last ;; ;; Tasks are the commands a project's own tooling defines - npm scripts, ;; rake tasks, a Makefile's targets - discovered rather than configured. ;; `projectile-repeat-last-command' sits here too: it re-runs the last ;; command of any kind, lifecycle phase or task alike. ;;;###autoload (defun projectile-repeat-last-command (show-prompt) "Run last projectile external command. External commands are: `projectile-configure-project', `projectile-compile-project', `projectile-test-project', `projectile-install-project', `projectile-package-project', `projectile-run-project' and the named tasks run via `projectile-run-task' (which also feed the combined history this command reads). If the prefix argument SHOW-PROMPT is non nil, the command can be edited." (interactive "P") (let* ((project-root (projectile-acquire-root)) (command-history (projectile--get-command-history project-root)) (command (car-safe (ring-elements command-history))) (compilation-read-command show-prompt) executed-command) (unless command (user-error "No command has been run yet for this project")) (setq executed-command (projectile--run-project-cmd command nil :save-buffers t :prompt-prefix "Execute command: ")) ;; `command-map' is nil above, so `projectile--run-project-cmd' doesn't ;; record anything; we record here instead. This command is ;; type-agnostic (it repeats the last command of any type), so it only ;; updates the combined history, not the per-type ones. (unless (string= command executed-command) (ring-insert command-history executed-command)))) (defvar projectile-last-task-map (make-hash-table :test 'equal) "The last task run per project, indexed by project root. Each value is a cons of the task name and the command that was run, which is what `projectile-repeat-last-task' re-runs.") (defun projectile--run-task (task-name command show-prompt &optional confirmed) "Run TASK-NAME's COMMAND for the current project. COMMAND is a shell command string, or a function returning one, called with `default-directory' set to the project root. With SHOW-PROMPT non-nil the command can always be edited before it's run; otherwise the command is offered for confirmation when `compilation-read-command' is non-nil (the default), like the other lifecycle commands, unless CONFIRMED says the user already confirmed this exact command (the repeat case). Task commands can come from a checked-out project's `.dir-locals.el', whose `projectile-tasks' entries are accepted without the risky-local-variable prompt - that is only acceptable because this run-time confirmation is guaranteed, the same trade-off Emacs's `compile-command' makes. The command is executed like the other lifecycle commands (see `projectile--run-project-cmd'), except that the output goes to a per-task compilation buffer. Return the command that was run, with the `%p' placeholder still intact." (let* ((project-root (projectile-acquire-root)) (command (if (functionp command) (let ((default-directory project-root)) (funcall command)) command)) ;; keyed like the per-type lifecycle histories, but per task (history-key (cons 'task task-name))) (unless (stringp command) (user-error "The command of task `%s' must be a string or a function returning one" task-name)) (when (or show-prompt (and compilation-read-command (not confirmed))) (setq command (projectile-read-command (format "Task [%s] command: " task-name) command history-key))) ;; Any prompting already happened above, so bind ;; `compilation-read-command' to nil to stop ;; `projectile--run-project-cmd' from prompting a second time. (let ((compilation-read-command nil) (buffer-name (concat "*projectile-task: " task-name "*" (when (memq 'project (projectile-compilation-buffer-scope)) (concat "<" (projectile-project-name project-root) ">"))))) (projectile--run-project-cmd command nil :save-buffers t :use-comint-mode (projectile-use-comint-mode-p 'task) :buffer-name-function (lambda (_mode) buffer-name))) ;; `command-map' is nil above, so `projectile--run-project-cmd' records ;; nothing; record the command - before `%p' expansion, like the other ;; lifecycle commands - into the combined per-project history (which ;; `projectile-repeat-last-command' reads) and the per-task one here. (projectile--command-history-insert (projectile--get-command-history project-root) command) (projectile--command-history-insert (projectile--get-command-history project-root history-key) command) (puthash project-root (cons task-name command) projectile-last-task-map) command)) ;;;###autoload (defun projectile-run-task (arg) "Run one of the current project's named tasks. The task is picked with completion among the tasks of the project's type, those in `projectile-tasks' (which win for same-named tasks) and the ones discovered in the project's own tooling - npm scripts, Makefile targets and the like, named after the tool that defines them (see `projectile-project-tasks' and `projectile-task-providers'). With a prefix ARG the task's command can be edited before it's run, e.g. to pass it ad-hoc arguments. The command runs through the same machinery as `projectile-compile-project' - in `projectile-compilation-dir', with `%p' expanded to the project name - but its output goes to a per-task compilation buffer named after the task." (interactive "P") ;; Establish we're in a project before prompting, so the task menu ;; doesn't pop up (with globally-defined tasks) outside one. (let ((tasks (projectile-project-tasks nil (projectile-acquire-root)))) (unless tasks (user-error "No tasks defined for the current project")) (let* ((task-name (projectile-completing-read "Run task: " (mapcar #'car tasks))) (task (assoc task-name tasks))) (unless task (user-error "No task named `%s' in the current project" task-name)) (projectile--run-task task-name (cdr task) arg)))) ;;;###autoload (defun projectile-repeat-last-task (arg) "Re-run the last task executed in the current project. This re-runs the exact command the task ran last time, including any ad-hoc edits made then. With a prefix ARG the command can be edited again before it's run." (interactive "P") (let* ((project-root (projectile-acquire-root)) (last-task (gethash project-root projectile-last-task-map))) (unless last-task (user-error "No task has been run yet for this project")) ;; The stored command was confirmed when it first ran, so re-running ;; doesn't prompt again (like `projectile-repeat-last-command'). (projectile--run-task (car last-task) (cdr last-task) arg 'confirmed))) (defun compilation-find-file-projectile-find-compilation-buffer (orig-fun marker filename directory &rest formats) "Advice around compilation-find-file. We enhance its functionality by appending the current project's directories to its search path. This way when filenames in compilation buffers can't be found by compilation's normal logic they are searched for in project directories." ;; If the file already exists, don't bother running the extra logic as the ;; project directories might be massive (i.e. Unreal-sized). (if (file-exists-p filename) (apply orig-fun `(,marker ,filename ,directory ,@formats)) (let* ((root (projectile-project-root)) (compilation-search-path (if (projectile-project-p) (let ((dirs (append compilation-search-path (list root) (mapcar (lambda (f) (expand-file-name f root)) (projectile-current-project-dirs))))) ;; If the file can be found relative to the project root, ;; add its parent directory to the search path. This ;; handles directories that contain only subdirectories ;; and no files directly. (let ((candidate (expand-file-name filename root))) (when (file-exists-p candidate) (push (file-name-directory candidate) dirs))) dirs) compilation-search-path))) (apply orig-fun `(,marker ,filename ,directory ,@formats))))) ;;; Known projects, and switching between them ;; ;; The list of projects Projectile has seen, how it's kept (loaded, merged ;; between Emacsen, pruned of directories that have gone away) and the ;; commands that move you from one to another. (defun projectile-open-projects () "Return a list of all open projects. An open project is a project with any open buffers." (let ((truename-cache (make-hash-table :test 'equal))) (seq-uniq ;; TODO: Replace delq+mapcar with seq-keep when Emacs 29.1 is the minimum version (delq nil (mapcar (lambda (buffer) (with-current-buffer buffer (when-let* ((project-root (projectile-project-root))) (when (projectile-project-buffer-p buffer project-root truename-cache) (abbreviate-file-name project-root))))) (buffer-list)))))) (defun projectile--remove-current-project (projects) "Remove the current project (if any) from the list of PROJECTS." (if-let* ((project (projectile-project-root))) (seq-difference projects (list (abbreviate-file-name project))) projects)) (defun projectile--move-current-project-to-end (projects) "Move current project (if any) to the end of the list of PROJECTS." (if-let* ((project (projectile-project-root))) (append (projectile--remove-current-project projects) (list (abbreviate-file-name project))) projects)) (defun projectile-known-projects () "Initialize the known projects. This might potentially clean up redundant projects and discover new ones if `projectile-auto-cleanup-known-projects' or `projectile-auto-discover-projects' are enabled." ;; load the known projects (unless projectile-known-projects (projectile-load-known-projects)) (when projectile-auto-cleanup-known-projects (projectile--cleanup-known-projects)) (when (and projectile-auto-discover-projects projectile-project-search-path (not projectile--search-path-discovered)) (projectile-discover-projects-in-search-path)) ;; return the list of known projects projectile-known-projects) (defun projectile-relevant-known-projects () "Return a list of known projects. Projects matched by `projectile-ignored-projects' or `projectile-ignored-project-function' are excluded, even if they were added to the known projects before being ignored (see #1663). It factors the value of `projectile-current-project-on-switch'." (let ((known-projects (projectile-known-projects))) ;; Only filter when there's actually some ignore configuration, so the ;; common case doesn't pay for a `file-truename' per known project. (when (or projectile-ignored-projects projectile-ignored-project-function) (setq known-projects (seq-remove #'projectile-ignored-project-p known-projects))) (pcase projectile-current-project-on-switch ('remove (projectile--remove-current-project known-projects)) ('move-to-end (projectile--move-current-project-to-end known-projects)) ('keep known-projects)))) (defun projectile-relevant-open-projects () "Return a list of open projects." (let ((open-projects (projectile-open-projects))) (pcase projectile-current-project-on-switch ('remove (projectile--remove-current-project open-projects)) ('move-to-end (projectile--move-current-project-to-end open-projects)) ('keep open-projects)))) (defvar projectile-most-recent-project nil "Root of the project that was current before the most recent project switch. Updated by `projectile-switch-project-by-name', so it only tracks switches made through Projectile's switch-project commands (not project changes that happen merely by visiting a file or buffer in another project). Use `projectile-switch-to-most-recent-project' to jump to it.") ;;;###autoload (defun projectile-switch-project (&optional arg) "Switch to a project we have visited before. Invokes the command referenced by `projectile-switch-project-action' on switch. With a prefix ARG invokes `projectile-dispatch' instead of `projectile-switch-project-action'." (interactive "P") (let ((projects (projectile-relevant-known-projects))) (if projects (projectile-completing-read "Switch to project: " projects :action (lambda (project) (projectile-switch-project-by-name project arg)) :category 'projectile-project :caller 'projectile-read-project) (user-error "There are no known projects")))) ;;;###autoload (defun projectile-switch-open-project (&optional arg) "Switch to a project we have currently opened. Invokes the command referenced by `projectile-switch-project-action' on switch. With a prefix ARG invokes `projectile-dispatch' instead of `projectile-switch-project-action'." (interactive "P") (let ((projects (projectile-relevant-open-projects))) (if projects (projectile-completing-read "Switch to open project: " projects :action (lambda (project) (projectile-switch-project-by-name project arg)) :category 'projectile-project :caller 'projectile-read-project) (user-error "There are no open projects")))) ;; The other-window/-frame switch commands reuse `projectile-switch-project' ;; wholesale (so the dir-locals dance, prefix-arg dispatch, and most-recent ;; tracking all stay in one place) and just rebind the post-switch action ;; around it. This relies on the completion framework invoking its action ;; synchronously, which the supported ones (default, vertico, ivy, helm) do. ;;;###autoload (autoload 'projectile-switch-project-other-window "projectile" nil t) ;;;###autoload (autoload 'projectile-switch-project-other-frame "projectile" nil t) (projectile--define-display-variants projectile-switch-project (&optional arg) "Switch to a project we have visited before; display it in another %s. Like `projectile-switch-project', but runs `projectile-switch-project-other-%s-action' (by default `projectile-find-file-other-%s') after switching, so the project is shown in another %s. With a prefix ARG invokes `projectile-dispatch' instead." (let ((projectile-switch-project-action projectile-switch-project-other-window-action)) (projectile-switch-project arg))) ;;;###autoload (defun projectile-switch-to-most-recent-project (&optional arg) "Switch to the project recorded in `projectile-most-recent-project'. That's the project that was current before the most recent project switch, so calling this from a buffer in the switched-to project takes you back where you came from. With a prefix ARG invokes `projectile-dispatch' instead of `projectile-switch-project-action'." (interactive "P") (if projectile-most-recent-project (projectile-switch-project-by-name projectile-most-recent-project arg) (user-error "No most recent project recorded yet"))) (defun projectile--transient-command-p (command) "Return non-nil if COMMAND is a transient prefix. Such commands (e.g. `projectile-dispatch') pop a menu and run the chosen suffix command asynchronously, after the caller has already returned. Detected via the `transient--prefix' symbol property that `transient-define-prefix' sets, which is also how `transient' itself recognises its prefixes." (and (symbolp command) (fboundp command) (get command 'transient--prefix))) (defun projectile--dispatch-in-directory (directory action) "Run transient ACTION with DIRECTORY as the project context. ACTION (e.g. `projectile-dispatch') is a transient prefix, so its suffix commands run after this function returns; a dynamic `default-directory' binding (or a temporary buffer) would be unwound by then. Instead set the current buffer's `default-directory' to DIRECTORY (the buffer that is current now is the one the suffix commands run in) for the lifetime of the transient, restoring it once the menu exits. This makes commands picked from the menu - like `projectile-find-file' - target the switched-to project." (let ((buffer (current-buffer)) (original-directory default-directory)) (setq default-directory directory) (letrec ((restore (lambda () (when (buffer-live-p buffer) (with-current-buffer buffer (setq default-directory original-directory))) (remove-hook 'transient-exit-hook restore)))) (add-hook 'transient-exit-hook restore)) ;; A transient prefix is an interactive-only command, so invoke it via ;; `call-interactively'. (call-interactively action))) (defun projectile-switch-project-by-name (project-to-switch &optional arg) "Switch to project by project name PROJECT-TO-SWITCH. Invokes the command referenced by `projectile-switch-project-action' on switch. With a prefix ARG invokes `projectile-dispatch' instead of `projectile-switch-project-action'." ;; let's make sure that the target directory exists and is actually a project ;; we ignore remote folders, as the check breaks for TRAMP unless already connected (unless (or (file-remote-p project-to-switch) (projectile-project-p project-to-switch)) (projectile-remove-known-project project-to-switch) (user-error "Directory %s is not a project" project-to-switch)) ;; Record the project we're leaving so `projectile-most-recent-project' ;; points at it after the switch (captured before `default-directory' is ;; rebound below). (let ((previous-project (projectile-project-root)) (action (if arg 'projectile-dispatch projectile-switch-project-action))) (run-hooks 'projectile-before-switch-project-hook) (if (projectile--transient-command-p action) ;; A transient action (e.g. `projectile-dispatch', whether reached ;; via the prefix argument or set as `projectile-switch-project-action' ;; directly) runs its suffix commands *after* this function returns, ;; so a dynamic `default-directory' binding (or the temporary buffer ;; below) would be gone by the time the chosen command runs. Hand off ;; to a helper that keeps PROJECT-TO-SWITCH current for the lifetime of ;; the menu instead. (projectile--dispatch-in-directory project-to-switch action) (let* ((default-directory project-to-switch) (switched-buffer ;; use a temporary buffer to load PROJECT-TO-SWITCH's dir-locals ;; before calling the switch-project action (with-temp-buffer (hack-dir-local-variables-non-file-buffer) ;; Normally the project name is determined from the current ;; buffer. However, when we're switching projects, we want to ;; show the name of the project being switched to, rather than ;; the current project, in the minibuffer. This is a simple hack ;; to tell the `projectile-project-name' function to ignore the ;; current buffer and the caching mechanism, and just return the ;; value of the `projectile-project-name' variable. (let ((projectile-project-name (funcall projectile-project-name-function project-to-switch))) (funcall action) (current-buffer))))) ;; If the action switched buffers then with-temp-buffer will ;; have lost that change, so switch back to the correct buffer. (when (buffer-live-p switched-buffer) (switch-to-buffer switched-buffer)))) ;; Don't record the project we just came from if it's the same one we ;; switched to. Compare with `file-equal-p' for local paths (handles ;; symlinks/abbreviation), but fall back to a plain string compare when ;; either side is remote, so we don't trigger a TRAMP round-trip (and ;; possible hang) for an unconnected remote project - the very thing the ;; remote skip above guards against. (when (and previous-project (not (if (or (file-remote-p previous-project) (file-remote-p project-to-switch)) (string-equal (file-name-as-directory previous-project) (file-name-as-directory project-to-switch)) (file-equal-p previous-project project-to-switch)))) (setq projectile-most-recent-project previous-project)) ;; The switch action usually visits a file or directory, which already ;; runs the project-changed functions; this covers actions that don't. ;; Resolving the root of an unconnected remote project would trigger a ;; TRAMP connection, so leave remote detection to the next file visit. (unless (file-remote-p project-to-switch) (projectile--maybe-run-project-changed-functions (projectile-project-root project-to-switch))) (run-hooks 'projectile-after-switch-project-hook))) ;;;###autoload (defun projectile-find-file-in-directory (&optional directory) "Jump to a file in a (maybe regular) DIRECTORY. This command will first prompt for the directory the file is in." (interactive "DFind file in directory: ") (unless (projectile--directory-p directory) (user-error "Directory %S does not exist" directory)) (let ((default-directory directory)) (if (projectile-project-p) ;; target directory is in a project (let ((file (projectile-completing-read "Find file: " (projectile-dir-files directory) :caller 'projectile-read-file))) (find-file (expand-file-name file directory)) (run-hooks 'projectile-find-file-hook)) ;; target directory is not in a project (projectile-find-file)))) (defun projectile-all-project-files () "Get a list of all files in all projects." (projectile-project-group-files (projectile-known-projects))) ;;;###autoload (defun projectile-find-file-in-known-projects () "Jump to a file in any of the known projects. This is `projectile-find-file-in-projects' over every project you have ever visited." (interactive) (projectile-find-file-in-projects (projectile-known-projects) "Find file in projects: ")) (defun projectile-keep-project-p (project) "Determine whether we should cleanup (remove) PROJECT or not. It handles the case of remote projects as well. See `projectile--cleanup-known-projects'. Remote projects are always kept regardless of connection state. Previously a remote project that *was* connected was tested with `file-readable-p', which is a remote round-trip per project - and since `projectile--cleanup-known-projects' may be called every time the user invokes a switch-project command (when `projectile-auto-cleanup-known-projects' is on), that turned project switching into a sequence of network stats. The user can still explicitly drop dead remote projects via `projectile-remove-known-project'." ;; Taken from `recentf-keep-default-predicate' (cond ((file-remote-p project)) ((file-readable-p project)))) (defun projectile--cleanup-known-projects () "Remove known projects that don't exist anymore. Return a list of projects removed." (projectile-merge-known-projects) (let ((projects-kept (seq-filter #'projectile-keep-project-p projectile-known-projects)) (projects-removed (seq-remove #'projectile-keep-project-p projectile-known-projects))) (setq projectile-known-projects projects-kept) (projectile-merge-known-projects) projects-removed)) ;;;###autoload (defun projectile-cleanup-known-projects () "Remove known projects that don't exist anymore." (interactive) (if-let* ((projects-removed (projectile--cleanup-known-projects))) (message "Projects removed: %s" (mapconcat #'identity projects-removed ", ")) (message "No projects needed to be removed."))) ;;;###autoload (defalias 'projectile-forget-zombie-projects #'projectile-cleanup-known-projects "Forget known projects that don't exist any more. An alias for `projectile-cleanup-known-projects', provided for discoverability and parity with project.el's `project-forget-zombie-projects'.") ;;;###autoload (defun projectile-forget-projects-under (directory &optional recursive) "Remove known projects located under DIRECTORY. Interactively, prompt for DIRECTORY. With optional argument RECURSIVE non-nil (interactively, the prefix argument), remove projects nested at any depth under DIRECTORY; otherwise only remove projects that are immediate children of DIRECTORY. Matching is lexical (after `file-truename' expansion for local paths, which is skipped for remote ones to avoid a round-trip), so projects are removed even when DIRECTORY has already been deleted. Mirrors project.el's `project-forget-projects-under'. Return the number of projects removed." (interactive "DForget projects under directory: \nP") (let* ((expand (lambda (path) (file-name-as-directory (if (file-remote-p path) path (file-truename path))))) (directory (funcall expand directory)) (projects-removed (seq-filter (lambda (project) (let ((project (funcall expand project))) (if recursive (string-prefix-p directory project) (string= (file-name-directory (directory-file-name project)) directory)))) projectile-known-projects))) (setq projectile-known-projects (seq-difference projectile-known-projects projects-removed)) (projectile-merge-known-projects) (if projects-removed (message "Projects removed: %s" (mapconcat #'identity projects-removed ", ")) (message "No projects found under %s." (abbreviate-file-name directory))) (length projects-removed))) ;;;###autoload (defun projectile-clear-known-projects () "Clear both `projectile-known-projects' and `projectile-known-projects-file'." (interactive) (setq projectile-known-projects nil) (projectile-save-known-projects)) ;;;###autoload (defun projectile-reset-known-projects () "Clear known projects and rediscover." (interactive) (projectile-clear-known-projects) (projectile-discover-projects-in-search-path)) ;;;###autoload (defun projectile-remove-known-project (&optional project) "Remove PROJECT from the list of known projects." (interactive (list (projectile-completing-read "Remove from known projects: " (projectile-known-projects) :action 'projectile-remove-known-project :category 'projectile-project :caller 'projectile-read-project))) (unless (called-interactively-p 'any) (setq projectile-known-projects (seq-remove (lambda (proj) (string= project proj)) projectile-known-projects)) ;; Known projects are stored abbreviated while the watch registry is ;; keyed by the cache key (usually expanded), so try both forms. (when project (projectile--unwatch-project project) (projectile--unwatch-project (expand-file-name project))) (projectile-merge-known-projects) (projectile--message "Removed %s from the known projects" project))) ;;;###autoload (defun projectile-remove-current-project-from-known-projects () "Remove the current project from the list of known projects." (interactive) (projectile-remove-known-project (projectile--known-project-root (projectile-acquire-root)))) (defun projectile-ignored-projects () "A list of projects that should not be saved in `projectile-known-projects'. Local entries are canonicalized via `file-truename'; remote entries are returned as-is to avoid a remote round-trip per entry on every lookup (see `projectile-ignored-project-p')." (mapcar (lambda (project) (if (file-remote-p project) project (file-truename project))) projectile-ignored-projects)) (defun projectile-ignored-project-p (project-root) "Return t if PROJECT-ROOT should not be added to `projectile-known-projects'. For remote (TRAMP) paths the symlink-resolution step is skipped: `file-truename' would round-trip to the remote, and matching against `projectile-ignored-projects' for a remote project is uncommon enough that requiring exact paths is acceptable. Local behavior is unchanged." (let ((project-root (if (file-remote-p project-root) project-root (file-truename project-root)))) (or (member project-root (projectile-ignored-projects)) (seq-some (lambda (pattern) (string-match-p pattern project-root)) projectile-ignored-project-patterns) (and (functionp projectile-ignored-project-function) (funcall projectile-ignored-project-function project-root))))) ;;;###autoload (defun projectile-add-known-project (project-root) "Add PROJECT-ROOT to the list of known projects." (interactive (list (read-directory-name "Add to known projects: "))) (unless (projectile-ignored-project-p project-root) (push (projectile--known-project-root project-root) projectile-known-projects) (setq projectile-known-projects (seq-uniq projectile-known-projects)) (projectile-merge-known-projects))) ;;;###autoload (defun projectile-add-and-switch-project (project-root) "Add PROJECT-ROOT to the list of known projects and switch to it. This combines `projectile-add-known-project' and `projectile-switch-project-by-name' into a single command." (interactive (list (read-directory-name "Add and switch to project: "))) (projectile-add-known-project project-root) (projectile-switch-project-by-name (file-name-as-directory project-root))) (defun projectile-load-known-projects () "Load saved projects from `projectile-known-projects-file'. Also set `projectile-known-projects'. An unreadable file is moved aside rather than silently overwritten on the next save, and the fact is reported - losing a list of projects built up over years to a stray byte is worse than being told about it." (let ((data (projectile--read-known-projects-file))) (if (eq data 'unreadable) (progn (projectile--quarantine-known-projects-file) (setq projectile-known-projects nil)) (setq projectile-known-projects data)) (setq projectile-known-projects-on-file (and (sequencep projectile-known-projects) (copy-sequence projectile-known-projects))))) (defun projectile-save-known-projects () "Save PROJECTILE-KNOWN-PROJECTS to PROJECTILE-KNOWN-PROJECTS-FILE. Text properties are stripped on the way out: a propertized string serializes to `#(\"...\" 0 3 (face ...))\\=', whose properties can hold objects that don\\='t read back, which is how the file gets corrupted in the first place (see issue #1927)." (projectile-serialize (mapcar (lambda (project) ;; Anything that isn't a string is left ;; alone: refusing to save at all would be ;; a worse failure than the one being ;; guarded against. (if (stringp project) (substring-no-properties project) project)) projectile-known-projects) projectile-known-projects-file) (setq projectile-known-projects-on-file (and (sequencep projectile-known-projects) (copy-sequence projectile-known-projects)))) (defun projectile--quarantine-known-projects-file () "Move an unreadable known projects file aside and say so. Returns non-nil when a file was moved. Overwriting it would throw away whatever it holds, and merging against \"nothing\" would look exactly like every project having been removed elsewhere - so the file is kept under a `.corrupt\\=' name and the list carries on from memory." (let ((file projectile-known-projects-file)) (when (file-exists-p file) (let ((backup (concat file ".corrupt"))) (ignore-errors (rename-file file backup t)) (display-warning 'projectile (format "Couldn't read %s, so it was moved to %s. \ Projectile is carrying on with the projects known to this session; \ the file will be written afresh." file backup) :warning) t)))) (defun projectile--read-known-projects-file () "Return the known projects on disk, or the symbol `unreadable\\='. Distinguishing the two matters: an absent file legitimately means no projects, while an unreadable one means the list on disk is unknown - and treating unknown as empty is how a corrupt file used to take the known projects with it (see issue #1927)." (let ((file projectile-known-projects-file)) (cond ((not (file-exists-p file)) nil) (t (condition-case nil (let ((data (with-temp-buffer (insert-file-contents file) (read (buffer-string))))) (if (proper-list-p data) data 'unreadable)) (error 'unreadable)))))) (defun projectile-merge-known-projects () "Merge any change from `projectile-known-projects-file' and save to disk. This enables multiple Emacs processes to make changes without overwriting each other's changes." (let* ((known-now projectile-known-projects) (known-on-file-raw (projectile--read-known-projects-file)) (unreadable (eq known-on-file-raw 'unreadable)) (known-on-last-sync projectile-known-projects-on-file) (known-on-file (if unreadable nil known-on-file-raw)) (removed-after-sync (seq-difference known-on-last-sync known-now)) ;; An unreadable file says nothing about what another process ;; removed. Reading it as "nothing is on disk" is precisely how a ;; corrupt file used to look like every project having been removed ;; elsewhere, taking the session's list down with it (issue #1927). (removed-in-other-process (unless unreadable (seq-difference known-on-last-sync known-on-file))) (result (seq-uniq (seq-difference (append known-now known-on-file) (append removed-after-sync removed-in-other-process))))) (when unreadable (projectile--quarantine-known-projects-file)) (setq projectile-known-projects result) (projectile-save-known-projects))) ;;; Repository identity ;; ;; Projectile treats every checkout as a project of its own: a git worktree ;; and the checkout it was linked from have their own roots, their own file ;; listings and usually their own branches, so that's the right call. It ;; does mean that "take me to my other checkout of this" needs a notion of ;; identity that outlives any single root, which is what ;; `projectile-repo-identity' provides. Its two keys answer progressively ;; weaker questions: ;; ;; :repo the directory the checkouts share - git's common dir, the ;; store an `hg share' points at. Equal `:repo' means one ;; repository checked out more than once, which is what a ;; worktree is. ;; :remote the upstream they were cloned from, normalized so that the ;; scp-like and URL spellings of one remote compare equal. ;; Equal `:remote' means separate clones of one project - the ;; hand-rolled version of worktrees, and just as common. ;; :owner the account, organization or directory that upstream hangs ;; off. Equal `:owner' means nothing about the code, but it's ;; the strongest signal there is that two projects belong to ;; one effort (see `projectile-sibling-projects'). ;; ;; The first two are both needed: `:repo' alone would miss separate clones ;; entirely, and `:remote' alone would miss the worktrees of a repository ;; that doesn't have a remote at all. (projectile-define-project-cache projectile-repo-identity-cache "Cache of `projectile-repo-identity' results keyed by project root. Cleared by `projectile-invalidate-cache'.") (defconst projectile--repo-url-scheme-regexp "\\`[a-zA-Z][a-zA-Z0-9+.-]*://\\(?:[^@/]*@\\)?\\([^/:]+\\)\\(?::[0-9]+\\)?/+\\(.+\\)\\'" "Match a `scheme://[user@]host[:port]/path' remote URL. Group 1 is the host, group 2 the path.") (defconst projectile--repo-url-scp-regexp "\\`\\(?:[^@/]*@\\)?\\([^/:]\\{2,\\}\\):\\(.+\\)\\'" "Match git's scp-like `[user@]host:path' remote syntax. Group 1 is the host, group 2 the path. The host has to be at least two characters long so that a Windows path like `c:/src/repo' isn't read as one; that's the same ambiguity, resolved the same way, as in git itself.") (defun projectile--normalize-repo-path (path) "Return PATH without its trailing slashes or its `.git' suffix. Those are the two ways one repository path gets spelled differently." (string-remove-suffix ".git" (string-trim-right path "/+"))) (defun projectile--normalize-repo-url (url) "Return a canonical identity for the remote URL, or nil when there's none. One repository can be addressed in several ways - `git@host:owner/repo.git', `https://host/owner/repo', `ssh://git@host:22/owner/repo/' - and all of them have to compare equal for two clones of it to be recognized as checkouts of the same thing. The identity is `HOST/PATH' without the user, port, trailing slashes or `.git' suffix, downcased because hosts are case-insensitive and so, in practice, are the forges' paths. A URL that addresses a local repository (a bare path, or a `file://' URL) normalizes to that path, left in its original case since local file systems are not reliably case-insensitive." (when (and url (not (string-blank-p url))) (let ((url (string-trim url))) (cond ;; A `file://' URL addresses a local repository, same as a bare path. ((string-prefix-p "file:///" url) (projectile--normalize-repo-path (string-remove-prefix "file://" url))) ((or (string-match projectile--repo-url-scheme-regexp url) ;; The scp-like syntax has no scheme, so anything carrying one ;; has already had its chance above and isn't a host:path. (and (not (string-match-p "://" url)) (string-match projectile--repo-url-scp-regexp url))) (downcase (concat (match-string 1 url) "/" (projectile--normalize-repo-path (replace-regexp-in-string "\\`/+" "" (match-string 2 url)))))) (t (projectile--normalize-repo-path (expand-file-name url))))))) (defun projectile--repo-url-owner (remote) "Return the owner of the normalized REMOTE, or nil when it has none. That's everything but the last segment: the account or organization a forge hangs the repository off, or the directory a local repository sits in. A remote with a single path segment (`host/repo') has no owner worth the name - the host isn't one - so it gets nil rather than something that would put every repository on that host in one group." (when (and remote (string-match "\\`\\(.*/.+\\)/[^/]+\\'" remote)) (match-string 1 remote))) ;; Everything below reads git's own files rather than running git. Identity ;; is computed for every known project when looking for the other checkouts ;; of one, and a subprocess apiece would be seconds of latency on a machine ;; with a hundred projects - the same reason `projectile--hg-default-path' ;; parses `.hg/hgrc' directly. The layout being read is stable and ;; documented in gitrepository-layout(5). (defun projectile--git-dir (root) "Return the git directory belonging to the checkout at ROOT, or nil. That's `/.git' when it is a directory, and the directory named by the `gitdir:' line when it is the file a linked worktree gets instead. Nil when ROOT holds no `.git' at all, which is what distinguishes a checkout from a directory inside one: `projectile-project-vcs' deliberately answers `git' for a project below a repository root too, so that file listing can still go through git, but the worktrees of the enclosing repository are not other copies of such a project." (let ((dot-git (expand-file-name ".git" root))) (cond ((file-directory-p dot-git) (file-name-as-directory dot-git)) ((file-readable-p dot-git) (with-temp-buffer (insert-file-contents dot-git) (goto-char (point-min)) (when (looking-at "gitdir:[ \t]*\\(.+?\\)[ \t]*$") (file-name-as-directory (expand-file-name (match-string 1) root)))))))) (defun projectile--git-common-dir (git-dir) "Return the directory GIT-DIR shares with the repository's other checkouts. A linked worktree's git directory carries a `commondir' file naming that shared directory; the main checkout's git directory is the shared directory itself." (if-let* ((common (projectile--file-contents-trimmed (expand-file-name "commondir" git-dir)))) (file-name-as-directory (expand-file-name common git-dir)) git-dir)) (defun projectile--git-config-remote-url (config-file) "Return the URL of the upstream remote configured in CONFIG-FILE, or nil. That's `origin' when it's there, since it's what cloning sets up and what two checkouts of one repository will therefore agree on; a repository wired up by hand may use another name, so fall back to whichever remote comes first rather than giving up." (when (file-readable-p config-file) (with-temp-buffer (insert-file-contents config-file) (goto-char (point-min)) (let (remotes) (while (re-search-forward "^[ \t]*\\[remote[ \t]+\"\\([^\"]+\\)\"\\]" nil t) (let ((name (match-string 1)) (section-end (save-excursion (if (re-search-forward "^[ \t]*\\[" nil t) (match-beginning 0) (point-max))))) (when (re-search-forward "^[ \t]*url[ \t]*=[ \t]*\\(.+?\\)[ \t]*$" section-end t) (push (cons name (match-string 1)) remotes)))) (setq remotes (nreverse remotes)) (or (cdr (assoc "origin" remotes)) (cdar remotes)))))) (defun projectile--git-head-branch (git-dir) "Return the branch checked out in GIT-DIR, or nil when HEAD is detached." (let ((head (expand-file-name "HEAD" git-dir))) (when (file-readable-p head) (with-temp-buffer (insert-file-contents head) (goto-char (point-min)) (when (looking-at "ref:[ \t]*refs/heads/\\(.+?\\)[ \t]*$") (match-string 1)))))) (defun projectile--git-dir-identity (git-dir) "Return the repository identity plist for the repository at GIT-DIR." (let ((git-dir (file-name-as-directory git-dir))) (list :repo (file-truename git-dir) :remote (projectile--normalize-repo-url (projectile--git-config-remote-url (expand-file-name "config" git-dir)))))) (defun projectile--git-repo-identity (root) "Return the repository identity plist for the git checkout at ROOT." (when-let* ((git-dir (projectile--git-dir root))) (projectile--git-dir-identity (projectile--git-common-dir git-dir)))) (defun projectile--file-contents-trimmed (file) "Return the trimmed contents of FILE, or nil when it can't be read. The version control systems all record their cross-references as a path on a line of its own in a small file, so this is the shape of every one of those reads." (when (file-readable-p file) (with-temp-buffer (insert-file-contents file) (string-trim (buffer-string))))) (defun projectile--jj-repo-dir (root) "Return the `.jj/repo' directory the Jujutsu workspace at ROOT uses, or nil. Jujutsu lays its workspaces out the way git lays out worktrees: the first one holds the directory itself, and every one added later holds a file naming it." (let ((repo (expand-file-name ".jj/repo" root))) (if (file-directory-p repo) (file-name-as-directory repo) (when-let* ((target (projectile--file-contents-trimmed repo)) ((not (string-empty-p target)))) (file-name-as-directory (expand-file-name target (file-name-directory repo))))))) (defun projectile--jj-repo-identity (root) "Return the repository identity plist for the Jujutsu workspace at ROOT." (when-let* ((repo-dir (projectile--jj-repo-dir root))) ;; A git-backed repository - which is every one `jj git init' makes - ;; names the git directory holding its commits, relative to the store ;; rather than to the repository. Resolving to that instead of to ;; `.jj' makes a workspace and the colocated git checkout agree on ;; which repository they are, rather than each insisting on its own ;; answer, and it gets the remote for free. (let ((store (expand-file-name "store/" repo-dir))) (if-let* ((target (projectile--file-contents-trimmed (expand-file-name "git_target" store))) (path (expand-file-name target store))) (projectile--git-dir-identity ;; The target is usually a git directory, but a submodule ;; checkout or a linked worktree has a `.git' *file* pointing at ;; the real one, and either can be a linked worktree's git ;; directory rather than the shared one. (projectile--git-common-dir (if (file-directory-p path) (file-name-as-directory path) (or (projectile--git-dir (file-name-directory path)) (file-name-as-directory path))))) (list :repo (file-truename repo-dir)))))) (defun projectile--hg-repo-identity (root) "Return the repository identity plist for the Mercurial project at ROOT. A working directory created by `hg share' keeps its store elsewhere and records where in `.hg/sharedpath', which makes that path the Mercurial equivalent of git\\='s common dir." (let* ((hg-dir (expand-file-name ".hg" root)) (store (or (projectile--file-contents-trimmed (expand-file-name "sharedpath" hg-dir)) hg-dir))) (list :repo (when (file-exists-p store) (file-truename store)) :remote (projectile--normalize-repo-url (projectile--hg-default-path root))))) (defun projectile--hg-default-path (root) "Return the Mercurial `default' path configured for ROOT, or nil. That's the upstream a repository was cloned from, so it plays the same role as git\\='s `origin' remote. Read out of `.hg/hgrc' directly rather than by running hg, which would cost a process launch per project." (let ((hgrc (expand-file-name ".hg/hgrc" root))) (when (file-readable-p hgrc) (with-temp-buffer (insert-file-contents hgrc) (goto-char (point-min)) (when (re-search-forward "^[ \t]*default[ \t]*=[ \t]*\\(.+?\\)[ \t]*$" nil t) (match-string 1)))))) (defun projectile-repo-identity (&optional project-root) "Return a plist identifying the repository PROJECT-ROOT is a checkout of. The plist has two keys, either of which may be nil: `:repo', the directory every checkout of this very repository shares, and `:remote', a canonical identity for the upstream it was cloned from. See `projectile-same-repo-p' for comparing two of these. Returns nil for a project that isn't under a version control system Projectile can answer this for (only git, Mercurial and Jujutsu carry the notion), and for a remote project, where every probe would be a TRAMP round trip. Results are cached in `projectile-repo-identity-cache' (cleared by `projectile-invalidate-cache')." (let ((root (or project-root (projectile-acquire-root)))) (unless (file-remote-p root) (let ((cached (gethash root projectile-repo-identity-cache 'unset))) (if (not (eq cached 'unset)) cached (let ((identity (pcase (projectile-project-vcs root) ('git (projectile--git-repo-identity root)) ('hg (projectile--hg-repo-identity root)) ('jj (projectile--jj-repo-identity root))))) ;; An identity with nothing in it says as little as no identity ;; at all, and storing it as nil keeps the callers from having ;; to test both. (if (not (or (plist-get identity :repo) (plist-get identity :remote))) (setq identity nil) ;; The owner falls out of the remote, so derive it here rather ;; than in every backend. (setq identity (plist-put identity :owner (projectile--repo-url-owner (plist-get identity :remote))))) (puthash root identity projectile-repo-identity-cache) identity)))))) (defun projectile-same-repo-p (a b) "Return non-nil when identities A and B describe one repository. Either sharing the repository directory (worktrees of each other) or sharing an upstream (clones of each other) is enough. Missing keys never match, so two projects that Projectile knows nothing about aren't silently declared identical." (or (when-let* ((repo (plist-get a :repo))) (equal repo (plist-get b :repo))) (when-let* ((remote (plist-get a :remote))) (equal remote (plist-get b :remote))))) ;;; Worktrees ;; ;; A worktree, in the sense this section means it, is another directory ;; holding the same repository: a real `git worktree', or simply a second ;; clone, which is how the same workflow gets done without the plumbing. ;; `projectile-switch-worktree' offers both, because from where the user ;; sits they're the same thing - the other place this project is checked ;; out, on another branch. ;; ;; Worktrees are found by `projectile-worktree-functions', which is a list ;; so that a version control system Projectile can enumerate directly ;; doesn't have to go through the generic fallback. Each entry takes a ;; project root and returns a list of plists with `:path' (mandatory), ;; `:label' and `:prunable'. (defcustom projectile-worktree-functions '(projectile-worktrees-from-git projectile-worktrees-from-jj projectile-worktrees-from-known-projects) "Functions consulted by `projectile-project-worktrees'. Each is called with a project root and should return a list of plists, one per checkout of that project\\='s repository, with the keys `:path' (the checkout\\='s directory, mandatory), `:label' (what tells this checkout apart from the others - a branch, a workspace name - if that\\='s known) and `:prunable' (non-nil when the checkout is registered but no longer on disk). Results from all the functions are merged and de-duplicated by path, so a checkout found twice is listed once, and a function that has nothing to say should return nil. The default set covers git worktrees and Jujutsu workspaces, both of which the version control system enumerates itself, and anything else via the known projects (see `projectile-worktrees-from-known-projects')." :group 'projectile :type '(repeat function) :package-version '(projectile . "3.4.0")) (defun projectile--parse-git-worktree-list (output) "Parse the `git worktree list --porcelain' OUTPUT into worktree plists. Records are separated by blank lines and each opens with a `worktree' line. Bare repositories are skipped: they have no working tree, so there\\='s nothing there to switch to." (delq nil (mapcar (lambda (record) (let ((lines (split-string record "\n" t))) (unless (member "bare" lines) (let ((worktree (list :path (file-name-as-directory (string-remove-prefix "worktree " (car lines)))))) ;; `HEAD' and `detached' say nothing a switch needs, and ;; `locked' doesn't stop one, so they're all skipped here. (dolist (line (cdr lines) worktree) (cond ((string-prefix-p "branch " line) (plist-put worktree :label (string-remove-prefix "refs/heads/" (string-remove-prefix "branch " line)))) ((string-prefix-p "prunable" line) (plist-put worktree :prunable t)))))))) (split-string output "\n\n" t)))) (defun projectile-worktrees-from-git (root) "Return the git worktrees of the project at ROOT. Git registers them itself, so this finds worktrees that have never been visited in this Emacs session - which the known projects can't do." (when-let* (((eq (projectile-project-vcs root) 'git)) ((not (file-remote-p root))) ;; Only a checkout's own top level has worktrees. ROOT can ;; just as well be a directory *inside* one - a project marked ;; out by its own `.projectile' in a corner of a bigger ;; repository, say, which `projectile-project-vcs' still calls ;; git because it walks up to find the repository. Git would ;; happily list the enclosing repository's worktrees, but none ;; of them is another copy of *this* project. ((projectile--git-dir root)) (output (projectile--git root "worktree" "list" "--porcelain"))) (projectile--parse-git-worktree-list output))) (defun projectile--jj (root &rest args) "Run jj with ARGS in ROOT and return its output, or nil when it fails. `--no-pager' because a pager would hang a batch invocation, `--ignore-working-copy' so that merely listing workspaces doesn\\='t snapshot the working copy behind the user\\='s back, and `--color=never' because jj colorizes template output too and a user with `ui.color = \"always\"' would otherwise get paths wrapped in escape sequences." (let ((default-directory root)) (with-temp-buffer (when (eql 0 (ignore-errors (apply #'process-file "jj" nil '(t nil) nil "--no-pager" "--color=never" "--ignore-working-copy" args))) (buffer-string))))) (defun projectile-worktrees-from-jj (root) "Return the Jujutsu workspaces of the project at ROOT. Gated on a `.jj' directory rather than on `projectile-project-vcs' answering `jj', because a colocated repository (`jj git init --colocate') holds both markers and is reported as git by default - see `projectile-vcs-markers'. Such a repository has git worktrees *and* Jujutsu workspaces, and both belong on the list. The workspace root is asked for through a template. Jujutsu only started recording it in 0.38: an older *workspace* renders as nothing and is skipped rather than becoming a bogus candidate, while an older *binary* rejects the template outright and simply reports nothing. The remote check comes first, before anything touches the file system, so that a remote project costs no TRAMP round trip." (when-let* (((not (file-remote-p root))) ((file-directory-p (expand-file-name ".jj" root))) ((executable-find "jj")) (output (projectile--jj root "workspace" "list" "-T" "self.name() ++ \"\\t\" ++ self.root() ++ \"\\n\""))) (delq nil (mapcar (lambda (line) ;; Only the name is escaped and quoted by jj, so a tab ;; in the output can only have come from the path - ;; hence splitting once, at the first one. (let* ((parts (split-string line "\t")) (name (car parts)) (path (string-join (cdr parts) "\t"))) (unless (string-empty-p path) (list :path (file-name-as-directory path) ;; A name that isn't a bare identifier comes ;; back quoted; the quotes aren't part of it. :label (string-trim name "\"" "\""))))) (split-string output "\n" t))))) (defun projectile-worktrees-from-known-projects (root) "Return the known projects that are checkouts of ROOT\\='s repository. This is how everything git can\\='t enumerate gets found: a Mercurial working directory sharing another\\='s store, and - the case that turns up far more often than the plumbing suggests - a second clone of the same upstream, which is the same workflow done by hand. Only projects Projectile already knows about can be found this way, since there\\='s nothing else to enumerate." (when-let* ((identity (projectile-repo-identity root))) (delq nil (mapcar (lambda (project) (let ((project (file-name-as-directory (expand-file-name project)))) (when (and (not (file-remote-p project)) (file-directory-p project) (not (projectile-ignored-project-p project)) (projectile-same-repo-p identity (projectile-repo-identity project))) (list :path project :label (projectile--checkout-branch project))))) (projectile-known-projects))))) (defun projectile--checkout-branch (root) "Return the branch checked out at ROOT, or nil when that isn't knowable. Read out of the checkout's own files rather than by running the version control system, since this is asked once per candidate checkout." (pcase (projectile-project-vcs root) ('git (when-let* ((git-dir (projectile--git-dir root))) (projectile--git-head-branch git-dir))))) (defun projectile-project-worktrees (&optional project-root) "Return the checkouts of PROJECT-ROOT\\='s repository, including itself. Every function in `projectile-worktree-functions' is consulted in turn and their results merged, de-duplicated by resolved path so that a worktree both git and the known projects report is listed once - the first function to report it wins, which is why the one that knows the most about a checkout should come first. The plists that come back carry `:path', and `:label'/`:prunable' when whoever found them knew." (projectile--collect-from-functions projectile-worktree-functions (or project-root (projectile-acquire-root)) (lambda (worktree) (when-let* ((path (plist-get worktree :path))) (projectile--directory-key path))) "Worktree")) (defun projectile--worktree-annotation (worktree) "Return the completion annotation describing WORKTREE, or nil. That's whatever tells this checkout apart from the others - the branch for git and Mercurial, the workspace name for Jujutsu - which is the thing a path alone doesn't say and the whole reason for picking one checkout over another." (when-let* ((label (plist-get worktree :label))) (format " (%s)" label))) ;;;###autoload (defun projectile-switch-worktree (&optional arg) "Switch to another checkout of the current project\\='s repository. That's the project\\='s git worktrees, plus any other clone of the same upstream that Projectile already knows about - both are the same thing in practice, the place this project is checked out on another branch. Invokes the command referenced by `projectile-switch-project-action' on switch. With a prefix ARG invokes `projectile-dispatch' instead." (interactive "P") (let* ((root (projectile-acquire-root)) (worktrees (seq-remove (lambda (worktree) ;; The checkout we're already in is not somewhere to ;; switch to, and one that's been deleted from under ;; its registration can't be switched to at all. (or (plist-get worktree :prunable) (file-equal-p (plist-get worktree :path) root))) (projectile-project-worktrees root))) ;; Offered in the spelling every other switch command uses, so a ;; worktree looks the same here as in `projectile-switch-project'. (by-path (mapcar (lambda (worktree) (cons (projectile--known-project-root (plist-get worktree :path)) worktree)) worktrees))) (unless worktrees ;; Say which of the two it is: nothing to switch to, or nothing ;; Projectile is able to look at. They call for different responses ;; and the same message for both sends people hunting for a bug. (cond ((file-remote-p root) (user-error "Projectile doesn't look for the checkouts of a remote project")) ((projectile-repo-identity root) (user-error "No other checkout of %s found" (projectile-project-name root))) (t (user-error "Cannot tell what %s is a checkout of - only git, Mercurial and Jujutsu say. Try `projectile-switch-sibling-project'" (projectile-project-name root))))) (projectile-completing-read "Switch to worktree: " (mapcar #'car by-path) :action (lambda (path) (projectile-switch-project-by-name path arg)) :annotation-function (lambda (path) (projectile--worktree-annotation (cdr (assoc path by-path)))) :category 'projectile-worktree))) ;;; Sibling projects ;; ;; Plenty of work spans several repositories: a library and the app using ;; it, a tool and its documentation site, the handful of packages that make ;; up one project. They're separate projects and should stay that way, but ;; moving between them shouldn't mean going through every project on the ;; machine. `projectile-switch-sibling-project' offers just the ones ;; related to the project you're in. ;; ;; Which ones those are comes from `projectile-sibling-project-functions', ;; consulted in order, from the most reliable signal to the least: ;; ;; 1. Groups you configured yourself, which are always right. ;; 2. The owner of the upstream remote - the account or organization the ;; repositories hang off. This is by far the best of the inferred ;; signals: it relates projects whose names have nothing in common, ;; which no amount of looking at directory names ever will. ;; 3. The leading word of the directory name, which is all that's left ;; for a repository with no remote at all. ;; ;; Inference is a heuristic, so it's bounded: a group covering more than ;; `projectile-sibling-max-group-share' of the known projects is dropped ;; rather than offered. A group that most of your projects belong to isn't ;; telling you anything - if everything you own lives under one account, ;; "same account" doesn't relate anything to anything. (defcustom projectile-project-groups nil "Named groups of projects that belong together. An alist mapping a group name to the list of project directories in it. A project may appear in several groups, and the groups of every one it belongs to are offered together by `projectile-switch-sibling-project'. This is the one signal that's never guessed, so it's consulted first. Use it for the projects that belong together for reasons nothing about them can reveal: (setq projectile-project-groups \\='((\"editor\" . (\"~/src/editor\" \"~/src/editor-docs\")) (\"infra\" . (\"~/src/deploy\" \"~/src/terraform\")))) To describe a single project's siblings from its own directory, set `projectile-project-siblings' in its `.dir-locals.el' instead." :group 'projectile :type '(alist :key-type (string :tag "Group") :value-type (repeat directory)) :package-version '(projectile . "3.4.0")) (defvar projectile-project-siblings nil "Projects to treat as siblings of the current one. A list of project directories. Use this to describe one project's siblings from the project itself; it should be set via .dir-locals.el. `projectile-project-groups' is the equivalent for describing whole groups centrally.") (put 'projectile-project-siblings 'safe-local-variable (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) (defcustom projectile-sibling-max-group-share 0.25 "How much of the known projects an inferred sibling group may cover. A number between 0 and 1, or nil to never discard a group. Inference that relates most of your projects to each other has found nothing: if every repository you own lives under one account then \"same account\" tells you nothing, and offering that group is just `projectile-switch-project' with extra steps. Such a group is dropped so the next signal gets its turn. Groups of two always survive, and the cap doesn't apply at all until there are `projectile--sibling-cap-min-projects' known projects to take a share of. Configured groups (`projectile-project-groups') are never subject to this - you meant those." :group 'projectile :type '(choice (const :tag "Never discard a group" nil) (number :tag "Share of known projects")) :package-version '(projectile . "3.4.0")) (defcustom projectile-sibling-project-functions '(projectile-siblings-from-groups projectile-siblings-from-owner projectile-siblings-from-name) "Functions consulted by `projectile-sibling-projects'. Each is called with a project root and should return a list of project directories related to it. They're consulted in order and their results concatenated, so the most trustworthy signal should come first; a project found by more than one is offered once, in the position the first function to report it put it. Adding your own is the intended way to teach Projectile a grouping it can't infer - a workspace manifest, say. Note that `projectile-sibling-max-group-share' is applied inside the two built-in inferred signals rather than to this list, so a function you add is never capped: it is trusted the way a configured group is." :group 'projectile :type '(repeat function) :package-version '(projectile . "3.4.0")) (defconst projectile--sibling-cap-min-projects 10 "How many known projects there must be before the share cap applies. Below this `projectile-sibling-max-group-share' is ignored: a share of a handful of projects measures nothing, and relating three of your four projects to each other is a fine answer.") (defvar projectile--sibling-project-pool nil "The known projects a sibling lookup is choosing from. Bound by `projectile-sibling-projects' so that every signal function shares one walk of the known projects and one pass of the ignore filtering, instead of each of them paying for both.") (defun projectile--sibling-candidate-projects () "Return the known projects a sibling signal may draw on." (or projectile--sibling-project-pool (let ((projects (projectile-known-projects))) ;; Only filter when there's ignore configuration to apply, so the ;; common case doesn't pay for a `file-truename' per known project. (if (or projectile-ignored-projects projectile-ignored-project-patterns projectile-ignored-project-function) (seq-remove #'projectile-ignored-project-p projects) projects)))) (defun projectile--siblings-by-key (root key-function) "Return the known projects KEY-FUNCTION gives the same answer for as ROOT. Nil when ROOT has no key, and nil when so many projects share it that the answer says nothing - see `projectile-sibling-max-group-share'. This is the shape every inferred signal takes: some property of a project root, and everything else that has it too." (when-let* ((key (funcall key-function root))) (let* ((projects (projectile--sibling-candidate-projects)) (matches (seq-filter (lambda (project) (equal key (funcall key-function project))) projects))) (unless (and projectile-sibling-max-group-share ;; A share of a handful of projects isn't a measurement ;; of anything, and the switch list is short enough not ;; to need narrowing, so the cap only starts applying ;; once "most of them" means something. (>= (length projects) projectile--sibling-cap-min-projects) (> (length matches) (max 2 (floor (* projectile-sibling-max-group-share (length projects)))))) matches)))) (defun projectile-siblings-from-groups (root) "Return the projects grouped with ROOT by configuration. That's the groups in `projectile-project-groups' that ROOT is a member of, plus whatever `projectile-project-siblings' names. The latter is a buffer-local setting describing the project you're in, so it's only consulted when that's the project being asked about. Configured groups are never subject to `projectile-sibling-max-group-share': however many projects you put in a group, you meant to." (let ((key (projectile--directory-key root))) (append (when-let* ((current (ignore-errors (projectile-project-root))) ((equal key (projectile--directory-key current)))) projectile-project-siblings) (seq-mapcat #'cdr (seq-filter (lambda (group) (seq-some (lambda (member) (equal key (projectile--directory-key member))) (cdr group))) projectile-project-groups))))) (defun projectile-siblings-from-owner (root) "Return the known projects whose upstream has the same owner as ROOT\\='s. The account or organization a repository hangs off is the strongest hint there is that two projects are part of one effort, and the only one that relates projects whose names have nothing in common." (projectile--siblings-by-key root (lambda (project) (plist-get (projectile-repo-identity project) :owner)))) (defun projectile--project-leading-token (path) "Return the first word of PATH\\='s directory name, or nil. Single characters aren't words worth grouping on, so they're skipped." (seq-find (lambda (token) (>= (length token) 2)) (split-string (downcase (file-name-nondirectory (directory-file-name path))) "[-_. ]+" t))) (defun projectile-siblings-from-name (root) "Return the known projects whose directory name starts like ROOT\\='s. Only the leading word counts. Matching on any shared word instead reads far more into a name than is there - it relates every `*-mode' to every other, and every `docs.*' site to the rest - whereas a shared first word is nearly always a deliberate family (`rubocop', `rubocop-ast'). This is the signal of last resort: it's the only one left for a repository with no remote at all, and the only one that will ever relate two projects belonging to different owners." (projectile--siblings-by-key root #'projectile--project-leading-token)) (defun projectile-sibling-projects (&optional project-root) "Return the projects related to PROJECT-ROOT, including itself. Every function in `projectile-sibling-project-functions' is consulted in turn and their results concatenated, de-duplicated by resolved path, so the ordering runs from the most trustworthy signal to the least. The projects come back in the spelling the other switch commands use." (let* ((root (or project-root (projectile-acquire-root))) ;; Walk the known projects once for all the signal functions. (projectile--sibling-project-pool (projectile--sibling-candidate-projects))) (mapcar #'projectile--known-project-root (projectile--collect-from-functions projectile-sibling-project-functions root #'projectile--directory-key "Sibling")))) ;;;###autoload (defun projectile-switch-sibling-project (&optional arg) "Switch to a project related to the current one. Related means grouped with it in `projectile-project-groups', or sharing the owner of its upstream remote, or - failing both - starting with the same word. See `projectile-sibling-project-functions'. Invokes the command referenced by `projectile-switch-project-action' on switch. With a prefix ARG invokes `projectile-dispatch' instead." (interactive "P") (let* ((root (projectile-acquire-root)) (siblings (seq-remove (lambda (project) ;; The project we're in isn't somewhere to switch to, ;; and a configured group can name one that has since ;; been moved away. (or (file-equal-p project root) (not (file-directory-p project)))) (projectile-sibling-projects root)))) (unless siblings ;; Nothing inferred is a perfectly ordinary outcome - it's what the ;; share cap does when a signal relates too much - so point at the ;; setting that always works rather than just reporting the miss. (user-error "No projects related to %s found - see `projectile-project-groups'" (projectile-project-name root))) (projectile-completing-read "Switch to sibling project: " siblings :action (lambda (project) (projectile-switch-project-by-name project arg)) :category 'projectile-project))) ;;; Commands over a group of projects ;; ;; Everything above works on the project you're in. These two work on a set ;; of projects handed to them, because those are the two questions a group ;; actually raises: which of them was that file in, and which of them mention ;; this string. ;; ;; They're plain functions taking the list, so a command for a new kind of ;; group is a two-line wrapper. The known-projects and sibling commands are ;; exactly that, and so is anything you write yourself. (defun projectile--common-parent (directories) "Return the innermost directory containing every one of DIRECTORIES. Nil when they share no ancestor at all: a group mixing local and remote \(TRAMP) projects has none, and neither do two remote projects on different hosts. Nil for an empty DIRECTORIES too." (when directories (let ((parent (file-name-as-directory (expand-file-name (car directories))))) (dolist (dir (cdr directories) parent) (let ((other (file-name-as-directory (expand-file-name dir)))) (while (and parent (not (string-prefix-p parent other))) ;; climb until PARENT contains OTHER too, giving up at the root (let ((up (file-name-directory (directory-file-name parent)))) (setq parent (unless (equal up parent) up))))))))) (defun projectile--project-group (projects what) "Return the members of PROJECTS that are still on disk. WHAT names the kind of group in the error signalled when none are." (or (seq-filter #'projectile--directory-p projects) (user-error "No %s to search" what))) (defun projectile-project-group-files (projects) "Return every file in PROJECTS, as absolute paths. Projects that no longer exist are skipped rather than erroring: a group can name a directory that has since been moved away. The result is de-duplicated, since two members of a group can nest." (delete-dups (mapcan (lambda (project) (mapcar (lambda (file) (expand-file-name file project)) (projectile-project-files project))) (seq-filter #'projectile--directory-p projects)))) ;;;###autoload (defun projectile-find-file-in-projects (projects &optional prompt) "Jump to a file in any of PROJECTS. PROMPT overrides the completion prompt." (find-file (projectile-completing-read (or prompt "Find file in projects: ") (projectile-project-group-files (projectile--project-group projects "projects")) :caller 'projectile-read-file))) ;;;###autoload (defun projectile-search-in-projects (projects &optional literal prompt) "Search PROJECTS for a term and review the matches read-only. LITERAL non-nil searches for a literal string, otherwise the term is an Emacs regexp. PROMPT overrides the label the term is read with. This is `projectile-search-review' widened to a group, and that command is the single-project case of it: matches from every project land in one `*projectile-search*' buffer, grouped by file and named relative to the innermost directory containing the group, so each one is labelled with the project it came from. Everything that buffer does - filtering, re-search, the hand-off to the replace reviewer - then covers the whole group. Each member of the group is filtered by its own ignore rules, wherever you happen to be sitting, and a literal search runs `rg' over each of them in turn when ripgrep is available." (let* ((projects (projectile--project-group projects "projects")) (term (projectile--read-search-string-with-default (or prompt (format "Search %d project%s%s for" (length projects) (if (cdr projects) "s" "") (if literal "" " regexp"))))) (regexp (if literal (regexp-quote term) term)) (case-fold case-fold-search) (candidates (lambda () (projectile-replace--candidates term literal case-fold projects)))) (projectile-replace--open #'projectile-search-mode projectile-search-buffer-name (or (projectile--common-parent projects) "/") term regexp nil literal case-fold candidates (projectile-prepend-project-name (format "No matches for %s" term)) projectile-search-whole-word nil projects))) (defun projectile-project-group-buffers (projects) "Return the live buffers belonging to any of PROJECTS. De-duplicated, since two members of a group can nest and a buffer under both would otherwise be offered twice." (delete-dups (mapcan #'projectile-project-buffers projects))) ;;;###autoload (defun projectile-switch-to-buffer-in-projects (projects &optional prompt) "Switch to a buffer belonging to any of PROJECTS. PROMPT overrides the completion prompt. The current buffer is left out of the choices, as `projectile-switch-to-buffer' does." (switch-to-buffer (projectile-completing-read (or prompt "Switch to buffer: ") (delete (buffer-name (current-buffer)) (mapcar #'buffer-name (projectile-project-group-buffers projects))) :category 'buffer :caller 'projectile-read-buffer))) (defun projectile--sibling-group () "Return the projects to treat as a group with the current one. That is `projectile-sibling-projects', which includes the project you are in - unlike switching, working across a family of projects is something you want the project at hand to be part of - minus any member that has been moved away, so a prompt never counts projects it cannot search." (let ((root (projectile-acquire-root))) (or (seq-filter #'projectile--directory-p (projectile-sibling-projects root)) (user-error "No projects related to %s found - see `projectile-project-groups'" (projectile-project-name root))))) ;;;###autoload (defun projectile-find-file-in-sibling-projects () "Jump to a file in the current project or any related to it. Related is what `projectile-switch-sibling-project' means by it." (interactive) (projectile-find-file-in-projects (projectile--sibling-group) "Find file in sibling projects: ")) ;;;###autoload (defun projectile-search-in-sibling-projects (&optional regexp) "Search the current project and the ones related to it, reviewing the matches. Related is what `projectile-switch-sibling-project' means by it. With a prefix argument REGEXP the search term is an Emacs regexp rather than a literal string." (interactive "P") (let ((siblings (projectile--sibling-group))) (projectile-search-in-projects siblings (not regexp) (format "Search %d sibling project%s%s for" (length siblings) (if (cdr siblings) "s" "") (if regexp " regexp" ""))))) ;;;###autoload (defun projectile-switch-to-buffer-in-sibling-projects () "Switch to a buffer of the current project or of one related to it. Related is what `projectile-switch-sibling-project' means by it." (interactive) (projectile-switch-to-buffer-in-projects (projectile--sibling-group) "Switch to sibling buffer: ")) ;;;###autoload (defun projectile-multi-occur-in-sibling-projects (&optional nlines) "Do a `multi-occur' in the buffers of the current project and related ones. Related is what `projectile-switch-sibling-project' means by it. With a prefix argument, show NLINES of context. Note this searches the buffers you have open, not the projects on disk - `projectile-search-in-sibling-projects' is the one that reads files." (interactive "P") (multi-occur (projectile-project-group-buffers (projectile--sibling-group)) (car (occur-read-primary-args)) nlines)) ;;;###autoload (defun projectile-todos-in-sibling-projects () "Collect TODO-style annotations across the current project and related ones. Related is what `projectile-switch-sibling-project' means by it. See `projectile-todos' for what counts as an annotation." (interactive) (projectile--todos (projectile--sibling-group))) ;;; Project bookmarks ;; ;; Project-scoped bookmarks on top of the built-in `bookmark.el'. There's ;; no separate storage and no separate persistence: a Projectile bookmark ;; is an ordinary Emacs bookmark, so it shows up in `list-bookmarks', ;; survives restarts and honours `bookmark-save-flag' for free. All ;; Projectile adds is a project scope - the commands below only ever offer ;; you the current project's bookmarks - and a project-prefixed default ;; name, so the entries stay identifiable in the global list. ;; `bookmark' is built in, but only its commands are autoloaded - the ;; accessors and `bookmark-alist' used below are not. (require 'bookmark) (defcustom projectile-bookmark-scope 'both "How a bookmark is recognised as belonging to a project. Emacs bookmarks are global, so Projectile has to decide which of them belong to the project at hand. There are two ways to tell, each with a different failure mode: - `file' - the bookmark's recorded file lives under the project root. Robust (it survives renaming the bookmark, and catches bookmarks made with plain `bookmark-set'), but blind to bookmarks that record no file, e.g. those of Info or Man buffers. - `name' - the bookmark's name starts with the project's name followed by a colon and a space, which is how `projectile-bookmark-set' names bookmarks by default. Covers bookmarks without a file, but breaks as soon as the bookmark (or the project directory) is renamed. - `both' - the default: a bookmark belongs to the project when either test says so." :group 'projectile :type '(choice (const :tag "Recorded file lives under the project root" file) (const :tag "Name starts with the project name" name) (const :tag "Either of the two" both)) :package-version '(projectile . "3.3.0")) (defun projectile-bookmark--name-prefix (&optional project) "Return the bookmark name prefix for PROJECT. PROJECT is a project root and defaults to the current project." (format "%s: " (projectile-project-name project))) (defun projectile-bookmark--under-root-p (filename root) "Return non-nil when FILENAME is a file under ROOT. ROOT is expected to be a true name already; FILENAME is resolved to one, so a symlinked path into the project still matches. FILENAME need not exist - a bookmark whose file was deleted still belongs to the project that file was in." (and filename ;; A remote file can't be under a local root (and the other way ;; around). Answer that from the names alone: resolving a remote ;; name would open a TRAMP connection, and a single stale remote ;; bookmark would then stall every bookmark prompt. (equal (file-remote-p filename) (file-remote-p root)) (let ((non-essential t)) (string-prefix-p root (file-truename (expand-file-name filename)))))) (defun projectile-bookmark--belongs-p (bookmark root) "Return non-nil when BOOKMARK belongs to the project at ROOT. BOOKMARK is a bookmark record and ROOT the project root's true name, ending in a slash. Which test is applied is governed by `projectile-bookmark-scope'." (or (and (memq projectile-bookmark-scope '(file both)) (projectile-bookmark--under-root-p (bookmark-get-filename bookmark) root) t) (and (memq projectile-bookmark-scope '(name both)) (string-prefix-p (projectile-bookmark--name-prefix root) (bookmark-name-from-full-record bookmark))))) (defun projectile-bookmark-names (&optional root) "Return the names of the bookmarks belonging to the project at ROOT. ROOT defaults to the current project. See `projectile-bookmark-scope' for what makes a bookmark the project's." (let ((root (file-name-as-directory (file-truename (or root (projectile-acquire-root)))))) (bookmark-maybe-load-default-file) (delq nil (mapcar (lambda (bookmark) (and (projectile-bookmark--belongs-p bookmark root) (bookmark-name-from-full-record bookmark))) bookmark-alist)))) (defun projectile-bookmark--default-name (root) "Return the suggested name for a new bookmark at point in ROOT. That's the name `bookmark-make-record' suggests (normally the file or buffer name), prefixed with the project's name. Buffers `bookmark.el' cannot record at all (those visiting neither a file nor a directory, unless their mode knows how to bookmark itself) are refused with a `user-error' rather than with a bare error and a backtrace." (concat (projectile-bookmark--name-prefix root) ;; Without this binding the record's name falls back to that of ;; the bookmark last used, which has nothing to do with the ;; location being bookmarked now. (let ((bookmark-current-bookmark nil)) (condition-case err (bookmark-name-from-full-record (bookmark-make-record)) (user-error (signal (car err) (cdr err))) (error (user-error "%s" (error-message-string err))))))) (defun projectile-bookmark--record (name) "Return the bookmark record named NAME. Signals a `user-error' when there is no such bookmark - the completion prompts don't require a match, and `bookmark.el' answers a name it doesn't know with a bare error (or, in the case of `bookmark-delete', with a cheerful nothing at all)." (or (bookmark-get-bookmark name t) (user-error "No bookmark named `%s'" name))) (defun projectile-bookmark--read (prompt &optional root) "Read one of the project's bookmark names with PROMPT. ROOT defaults to the current project. Signals a `user-error' when the project has no bookmarks yet." (let* ((root (or root (projectile-acquire-root))) (names (projectile-bookmark-names root))) (unless names (user-error "%s" (projectile-prepend-project-name "No bookmarks in this project"))) (projectile-completing-read prompt names :category 'bookmark))) ;;;###autoload (defun projectile-bookmark-set (name) "Set a bookmark named NAME at point, scoped to the current project. The bookmark is a regular Emacs bookmark - it lands in `bookmark-alist', shows up in `list-bookmarks' and is persisted by `bookmark.el' itself. The only Projectile touch is the suggested NAME: the name `bookmark-set' would suggest, prefixed with the project's name (e.g. \"projectile: projectile.el\"), so the project's bookmarks are easy to spot in the global list. You're free to edit the name - a bookmark on a file inside the project is recognised as the project's even without the prefix (see `projectile-bookmark-scope')." (interactive (let ((default (projectile-bookmark--default-name (projectile-acquire-root)))) (list (read-string "Set bookmark: " default 'bookmark-history default)))) (bookmark-set name)) ;;;###autoload (defun projectile-bookmark-jump (name) "Jump to the project bookmark named NAME. Only the current project's bookmarks are offered for completion - see `projectile-bookmark-scope' for how that's decided. When the bookmark's file has been deleted in the meantime this refuses with a friendly error instead of dragging you through the relocation prompt of `bookmark.el'. Use `projectile-bookmark-delete' to get rid of such a stale bookmark." (interactive (list (projectile-bookmark--read "Jump to bookmark: "))) (let* ((record (projectile-bookmark--record name)) (file (bookmark-get-filename record))) ;; A bookmark with a handler of its own may keep something else ;; entirely in `filename', so only vet the ones `bookmark.el' will ;; resolve as a file itself. (when (and file (not (bookmark-get-handler record)) (not (file-readable-p file))) (user-error "The file of bookmark `%s' is gone (%s)" name file))) (bookmark-jump name)) ;;;###autoload (defun projectile-bookmark-delete (name) "Delete the project bookmark named NAME. Only the current project's bookmarks are offered for completion - see `projectile-bookmark-scope' for how that's decided." (interactive (list (projectile-bookmark--read "Delete bookmark: "))) (projectile-bookmark--record name) (bookmark-delete name) (message "Deleted bookmark `%s'" name)) ;;; IBuffer integration (define-ibuffer-filter projectile-files "Show Ibuffer with all buffers in the current project." (:reader (read-directory-name "Project root: " (projectile-project-root)) :description nil) (with-current-buffer buf (let ((directory (file-name-as-directory (expand-file-name qualifier)))) (and (projectile-project-buffer-p buf directory) (equal directory (projectile-project-root)))))) (defun projectile-ibuffer-by-project (project-root) "Open an IBuffer window showing all buffers in PROJECT-ROOT." (let ((project-name (funcall projectile-project-name-function project-root))) (ibuffer nil (format "*%s Buffers*" project-name) (list (cons 'projectile-files project-root))))) ;;;###autoload (defun projectile-ibuffer (prompt-for-project) "Open an IBuffer window showing all buffers in the current project. Let user choose another project when PROMPT-FOR-PROJECT is supplied." (interactive "P") (let ((project-root (if prompt-for-project (projectile-completing-read "Project name: " (projectile-relevant-known-projects) :category 'projectile-project :caller 'projectile-read-project) (projectile-acquire-root)))) (projectile-ibuffer-by-project project-root))) ;;; Find next/previous project buffer (defun projectile--repeat-until-project-buffer (orig-fun &rest args) "Repeat ORIG-FUN with ARGS until the current buffer is a project buffer." (if (projectile-project-root) (let* ((other-project-buffers (make-hash-table :test 'eq)) (projectile-project-buffers (projectile-project-buffers)) (max-iterations (length (buffer-list))) (counter 0)) (dolist (buffer projectile-project-buffers) (unless (eq buffer (current-buffer)) (puthash buffer t other-project-buffers))) (when (cdr-safe projectile-project-buffers) (while (and (< counter max-iterations) (not (gethash (current-buffer) other-project-buffers))) (apply orig-fun args) (setq counter (1+ counter))))) (apply orig-fun args))) (defun projectile-next-project-buffer () "In selected window switch to the next project buffer. If the current buffer does not belong to a project, call `next-buffer'." (interactive) (projectile--repeat-until-project-buffer #'next-buffer)) (defun projectile-previous-project-buffer () "In selected window switch to the previous project buffer. If the current buffer does not belong to a project, call `previous-buffer'." (interactive) (projectile--repeat-until-project-buffer #'previous-buffer)) ;;; Editing a project's .dir-locals (defun projectile-read-variable () "Prompt for a variable and return its name as a string. Return nil on empty input, which ends the variable-entry loop of `projectile-skel-dir-locals' while keeping the entries made so far." (let ((var (completing-read "Variable (RET when done): " obarray (lambda (v) (and (boundp v) (not (keywordp v)))) t))) (unless (string-empty-p var) var))) (define-skeleton projectile-skel-variable-cons "Insert a variable-name and a value in a cons-cell." (projectile-read-variable) "(" str " . " (skeleton-read "Value: " nil t) ")") (define-skeleton projectile-skel-dir-locals "Insert a .dir-locals.el template. The variable-entry loop ends when an empty variable name is entered, keeping the entries made so far." nil "((nil . (" ((projectile-read-variable) "(" str " . " (skeleton-read "Value: " nil t) ")" \n) resume: ")))") ;;;###autoload (defun projectile-edit-dir-locals () "Edit or create a .dir-locals.el file of the project." (interactive) (let ((file (expand-file-name ".dir-locals.el" (projectile-acquire-root)))) (find-file file) (when (not (file-exists-p file)) (projectile-skel-dir-locals) (save-buffer)))) ;;; Project diagnostics (the doctor) ;; ;; `projectile-doctor' renders what Projectile thinks is going on in the ;; current project - and why - into a plain, copy-pasteable buffer. It ;; computes nothing new: every value shown comes from the same accessor ;; the rest of Projectile uses. ;; ;; A note on side effects, since a diagnostic that changes what it ;; diagnoses is worse than useless. The doctor reports the caches as it ;; finds them: it never populates and never invalidates ;; `projectile-projects-cache'. When a project's file list isn't cached ;; yet, the doctor indexes it with caching bound off, times that run and ;; labels it a fresh index in the report - so running the doctor can't ;; turn a cold project warm (or a warm one cold) behind your back. The ;; dirconfig is read with the uncached parser for the same reason. The ;; project root and VCS caches are the exception: those are populated by ;; merely asking, exactly as any other command would. ;; ;; Anything whose cost is unknown - indexing, `executable-find', listing ;; the project root - is skipped for remote (TRAMP) projects and marked ;; as skipped in the report, so the doctor can't hang on a slow host. ;;;; Shared rendering for the report buffers ;; ;; The doctor and the dashboard are both label/value reports, and they ;; share their look. Two rules keep them honest: ;; ;; - Every face here only inherits, so themes style them without knowing ;; Projectile exists, and a terminal without colors degrades to plain ;; text rather than to something unreadable. ;; - The buffer text stays plain ASCII. Faces are a display layer on top ;; of it, so what you see and what you yank are the same characters - ;; which matters because a doctor report's destination is usually a bug ;; report (see `projectile-report-copy'). (defface projectile-report-section '((t :inherit font-lock-function-name-face :weight bold)) "Face for the section headers of the doctor and dashboard buffers." :group 'projectile :package-version '(projectile . "3.4.0")) (defface projectile-report-label '((t :inherit shadow)) "Face for the field labels of the doctor and dashboard buffers. Labels are dimmed so the values they introduce carry the eye." :group 'projectile :package-version '(projectile . "3.4.0")) (defface projectile-report-value '((t :inherit font-lock-string-face)) "Face for the values that identify a project - its root, type and name." :group 'projectile :package-version '(projectile . "3.4.0")) (defface projectile-report-ok '((t :inherit success)) "Face for a finding that reports something is fine, and for `on'/`present'." :group 'projectile :package-version '(projectile . "3.4.0")) (defface projectile-report-warning '((t :inherit warning)) "Face for a finding that suggests a change, and for `missing'." :group 'projectile :package-version '(projectile . "3.4.0")) (defface projectile-report-info '((t :inherit shadow)) "Face for a purely informational finding." :group 'projectile :package-version '(projectile . "3.4.0")) (defface projectile-report-hint '((t :inherit shadow :slant italic)) "Face for the key hints at the foot of a report buffer." :group 'projectile :package-version '(projectile . "3.4.0")) (defun projectile--report-face (string face) "Return STRING propertized with FACE." (propertize string 'face face)) (defun projectile--report-title (title &optional char) "Insert TITLE underlined with CHAR (`=' by default). The rule is kept as text rather than expressed with a face, so a yanked report reads the same as the rendered one - but it is dimmed, so the title carries the emphasis rather than competing with its own underline." (insert (projectile--report-face title 'projectile-report-section) "\n" (projectile--report-face (make-string (length title) (or char ?=)) 'projectile-report-label) "\n")) (defun projectile--report-section (title) "Insert the header of a report section titled TITLE." (insert "\n") (projectile--report-title title ?-)) (defun projectile--report-label (label width) "Insert LABEL, dimmed and padded out to WIDTH." (insert (projectile--report-face label 'projectile-report-label) (make-string (max 1 (- width (length label))) ?\s))) (defun projectile--report-status-face (value) "Return the face for the status word VALUE, or nil when it isn't one. Only the words whose polarity is unambiguous are colored." (cond ((member value '("on" "present" "yes")) 'projectile-report-ok) ((member value '("missing")) 'projectile-report-warning) ((member value '("off" "skipped" "none")) 'projectile-report-info))) (defun projectile--report-hints (bindings) "Insert a dimmed footer line describing BINDINGS. BINDINGS is an alist of (COMMAND . DESCRIPTION). The key is looked up with `substitute-command-keys', so the hint tells the truth even when the buffer\\='s map has been rebound - the trick Flycheck\\='s verify buffer uses." (insert "\n" (projectile--report-face (mapconcat (lambda (binding) (format "%s %s" (substitute-command-keys (format "\\[%s]" (car binding))) (cdr binding))) bindings " ") 'projectile-report-hint) "\n")) (defun projectile--report-setup-outline () "Make the report\\='s sections collapsible with `outline-minor-mode'. Section titles are capitalized and start in column zero, while every field label is lowercase, so that one distinction is the whole heading regexp - no dependency on `magit-section' needed to fold a long report." (setq-local outline-regexp "[A-Z]") (setq-local outline-level (lambda () 1)) (outline-minor-mode 1)) ;;;###autoload (defun projectile-report-copy () "Copy the current report buffer to the kill ring as plain text. Strips the faces and buttons, so what lands in the clipboard is exactly the text of the report - ready to paste into an issue, an email or a chat window without dragging Emacs\\='s text properties along." (interactive) (unless (derived-mode-p 'projectile-doctor-mode 'projectile-dashboard-mode) (user-error "Not in a Projectile report buffer")) (let ((text (buffer-substring-no-properties (point-min) (point-max)))) (kill-new text) (message "Copied %d lines of %s to the kill ring" (count-lines (point-min) (point-max)) (if (derived-mode-p 'projectile-doctor-mode) "the report" "the dashboard")))) (defconst projectile-doctor-buffer-name "*projectile-doctor*" "The name of the buffer `projectile-doctor' renders its report in.") (defconst projectile-doctor--large-project 10000 "File count above which a project is considered large by the doctor.") (defconst projectile-doctor--huge-project 50000 "File count above which the doctor suspects the ignore rules.") (defconst projectile-doctor--label-width 22 "Column width of the labels in a doctor report.") (defvar-local projectile-doctor--directory nil "The directory a doctor report was generated from. Used by the report buffer's `revert-buffer' to regenerate it.") (defun projectile-doctor--root-function (dir) "Return the `projectile-project-root-functions' entry that roots DIR. That is the first function in the list to return a project root for DIR, which is the one whose answer function `projectile-project-root' used. Returns nil when no function claims DIR." (let ((true-dir (ignore-errors (file-truename dir)))) (seq-find (lambda (func) (ignore-errors (funcall func (if (eq func 'projectile-root-local) dir (or true-dir dir))))) projectile-project-root-functions))) (defun projectile-doctor--root-marker (func root) "Return the marker file in ROOT that made FUNC report it as a root. Returns nil for a root function with no marker list of its own (e.g. `projectile-root-local', which reads a buffer-local variable) or when no marker can be pinned down." (when-let* ((markers (pcase func ('projectile-root-marked (list projectile-dirconfig-file)) ('projectile-root-bottom-up projectile-project-root-files-bottom-up) ('projectile-root-top-down projectile-project-root-files) ('projectile-root-top-down-recurring projectile-project-root-files-top-down-recurring)))) (seq-find (lambda (marker) (ignore-errors (projectile-file-exists-p (projectile-expand-file-name-wildcard marker root)))) markers))) (defun projectile-doctor--type-marker (type) "Return the registered marker files of the project TYPE, or nil." (when-let* ((record (assq type projectile-project-types))) (plist-get (cdr record) 'marker-files))) (defun projectile-doctor--executable (name remote) "Report the availability of the NAME executable. Returns `present', `missing', or `skipped' when the project is REMOTE and looking the program up would mean a TRAMP round-trip." (cond (remote 'skipped) ((and name (executable-find name)) 'present) (t 'missing))) (defun projectile-doctor--index-command (root vcs) "Return the external indexing command Projectile would run in ROOT. VCS is the project's version-control system. Returns nil under the `native' indexing method, which shells out to nothing." (unless (eq projectile-indexing-method 'native) (let ((default-directory root)) (ignore-errors (projectile--alien-ext-command vcs root))))) (defun projectile-doctor--file-info (root remote) "Return a plist describing ROOT's file list and how it was obtained. The cached list is used when there is one. Otherwise the project is indexed with caching bound off, so the doctor doesn't warm a cache the user didn't ask it to warm, and the timing of that run is reported. Indexing is skipped altogether when the project is REMOTE." (let ((cached (gethash root projectile-projects-cache))) (cond (cached (list :file-count (length cached) :files-source 'cache)) (remote (list :files-source 'skipped)) (t (let* ((start (float-time)) (files (condition-case err ;; Index without touching the cache: no entry is ;; stored, no stale entry is evicted, no file ;; watch is armed. (let ((projectile-enable-caching nil) (projectile-files-cache-expire nil)) (projectile-project-files root)) (error (cons 'error (error-message-string err)))))) (if (eq (car-safe files) 'error) (list :files-source 'error :files-error (cdr files)) (list :file-count (length files) :index-time (- (float-time) start) :files-source 'fresh))))))) (defun projectile-doctor--excluded-entries (root patterns) "Return ROOT's immediate entries excluded by the ignore PATTERNS. Directories are returned with a trailing slash, the way the patterns match them." (when-let* ((re (projectile--compile-ignore-patterns patterns)) (entries (ignore-errors (directory-files root t directory-files-no-dot-files-regexp)))) (let ((case-fold-search nil)) (delq nil (mapcar (lambda (entry) (let ((rel (concat (file-name-nondirectory entry) (if (file-directory-p entry) "/" "")))) (and (string-match-p re rel) rel))) entries))))) (defun projectile-doctor--collect (&optional dir) "Collect the diagnostic data for DIR's project as a plist. DIR defaults to `default-directory'. Outside a project the plist has a nil `:root' and the rendering degrades to saying so." (let* ((dir (or dir default-directory)) (root (ignore-errors (projectile-project-root dir)))) (if (null root) (list :dir dir :root nil) (let* ((remote (file-remote-p root)) ;; The doctor reports prefix-less dirconfig lines as a ;; finding; it shouldn't also pop up the warning buffer over ;; the report it's about to show. (projectile-warn-on-prefixless-dirconfig-lines nil) (default-directory root) (vcs (ignore-errors (projectile-project-vcs root))) (type (ignore-errors (projectile-project-type))) (root-func (projectile-doctor--root-function dir)) (ignore-patterns (ignore-errors (projectile--ignore-patterns root))) (cache-time (gethash root projectile-projects-cache-time))) (append (list :dir dir :root root :remote remote :root-function root-func :root-marker (and root-func (projectile-doctor--root-marker root-func root)) :name (ignore-errors (projectile-project-name root)) :name-source (if projectile-project-name 'local-variable projectile-project-name-function) :type type :type-source (if projectile-project-type 'local-variable 'detected) :type-marker (unless projectile-project-type (projectile-doctor--type-marker type)) :vcs vcs :indexing-method projectile-indexing-method :async-indexing projectile-async-indexing :index-command (projectile-doctor--index-command root vcs) :git (projectile-doctor--executable "git" remote) :fd (projectile-doctor--executable (ignore-errors (projectile-fd-executable-for root)) remote) :rg (projectile-doctor--executable "rg" remote) :git-use-fd projectile-git-use-fd :caching projectile-enable-caching :cache-time cache-time :cache-age (and cache-time (- (projectile-time-seconds) cache-time)) :cache-expire projectile-files-cache-expire :cache-file (and (projectile-persistent-cache-p) (not remote) (let ((file (projectile-project-cache-file root))) (and (file-exists-p file) file))) :dirconfig-file (projectile-dirconfig-file) ;; The uncached parser, so the doctor doesn't seed the ;; dirconfig cache as a side effect of looking. :dirconfig (ignore-errors (projectile--parse-dirconfig-file-uncached)) :ignore-patterns ignore-patterns :ensure-patterns (ignore-errors (projectile--ensure-patterns root)) :excluded-entries (unless remote (projectile-doctor--excluded-entries root ignore-patterns)) :projectile-mode (bound-and-true-p projectile-mode)) (projectile-doctor--file-info root remote)))))) ;;;; Doctor findings (defun projectile-doctor--finding (severity message &optional action-label action) "Return a finding of SEVERITY described by MESSAGE. SEVERITY is one of `ok\\=', `warn\\=' or `info\\='. ACTION, when given, is a function of no arguments that does something about the finding, and ACTION-LABEL is what to call it in the report. The report renders such a finding with a button, so the fix sits next to the diagnosis rather than in a sentence telling you what to go and type." (list :severity severity :message message :action-label action-label :action action)) (defun projectile-doctor--enable-mode () "Turn `projectile-mode\\=' on." (projectile-mode 1) (projectile--message-always "`projectile-mode' enabled")) (defun projectile-doctor--set-option (option value) "Set OPTION to VALUE for this session, the way Customize would. Says so, since the change doesn\\='t outlive Emacs unless it\\='s saved." (customize-set-variable option value) (projectile--message-always "`%s' set to %s for this session - use %s to keep it" option value (substitute-command-keys "\\[customize-save-variable]"))) (defun projectile-doctor--visit-dirconfig () "Visit the current project\\='s dirconfig file, creating it if need be." (find-file (expand-file-name projectile-dirconfig-file (projectile-acquire-root)))) (defun projectile-doctor--findings (data) "Return the list of findings for the report DATA. Each finding is a plist built by `projectile-doctor--finding\\='." (let* ((remote (plist-get data :remote)) (method (plist-get data :indexing-method)) (external (memq method '(alien hybrid))) (count (plist-get data :file-count)) (cfg (plist-get data :dirconfig)) (findings nil)) (push (if (eq (plist-get data :type) 'generic) (projectile-doctor--finding 'warn (concat "Project type not detected (generic). " "Register a type with " "`projectile-register-project-type', or set " "`projectile-project-type' in .dir-locals.el.") "edit .dir-locals.el" #'projectile-edit-dir-locals) (projectile-doctor--finding 'ok (format "Project type detected: %s." (plist-get data :type)))) findings) (when (and external (eq (plist-get data :vcs) 'git)) (push (pcase (plist-get data :git) ('present (projectile-doctor--finding 'ok "git is installed and lists the project files.")) ('skipped (projectile-doctor--finding 'info "git availability not checked (remote project).")) (_ (projectile-doctor--finding 'warn (concat "git is not installed, but this is a git " "project - indexing falls back to `find'.")))) findings)) (when external (push (pcase (plist-get data :fd) ('present (projectile-doctor--finding 'ok "fd is installed and used for fast indexing.")) ('skipped (projectile-doctor--finding 'info "fd availability not checked (remote project).")) (_ (projectile-doctor--finding 'warn (concat "fd is not installed. Installing it speeds " "up indexing noticeably on large projects " "(see `projectile-git-use-fd').")))) findings)) (when (and (eq (plist-get data :rg) 'missing) (not remote)) (push (projectile-doctor--finding 'info (concat "ripgrep (rg) is not installed; " "`projectile-ripgrep' and the fast path of the " "search reviewer need it.")) findings)) (when (integerp count) (cond ((>= count projectile-doctor--huge-project) (push (projectile-doctor--finding 'warn (format (concat "%d files indexed. That's a lot - " "check the ignore rules above, a " "build or vendor directory may be " "sneaking in.") count) "edit ignores" #'projectile-doctor--visit-dirconfig) findings)) ((and (>= count projectile-doctor--large-project) (not (plist-get data :caching))) (push (projectile-doctor--finding 'warn (format (concat "%d files indexed with caching " "disabled. Set " "`projectile-enable-caching' to t " "(or `persistent').") count) "enable caching" (lambda () (projectile-doctor--set-option 'projectile-enable-caching t))) findings)) (t (push (projectile-doctor--finding 'ok (format "%d files indexed." count)) findings)))) (when (and remote (not (plist-get data :async-indexing))) (push (projectile-doctor--finding 'warn (concat "Remote project with `projectile-async-indexing' " "off - indexing will block Emacs for as long as " "the remote takes.") "enable async indexing" (lambda () (projectile-doctor--set-option 'projectile-async-indexing t))) findings)) (when cfg (when (projectile-dirconfig-keep cfg) (push (projectile-doctor--finding 'info (format (concat "The dirconfig has %d `+' keep " "entries, so the project is " "restricted to those subdirectories " "- everything else is invisible to " "Projectile.") (length (projectile-dirconfig-keep cfg))) "open dirconfig" #'projectile-doctor--visit-dirconfig) findings)) (when (projectile-dirconfig-prefixless-ignore cfg) (push (projectile-doctor--finding 'warn (concat "The dirconfig has lines without a " "`+'/`-'/`!' prefix. They are treated as " "ignore rules for now, but the implicit form " "is being phased out - prefix them with `-'.") "open dirconfig" #'projectile-doctor--visit-dirconfig) findings))) (unless (plist-get data :projectile-mode) (push (projectile-doctor--finding 'warn (concat "`projectile-mode' is not enabled; " "Projectile's keymap and mode line are " "inactive.") "enable" #'projectile-doctor--enable-mode) findings)) (nreverse findings))) ;;;; Doctor report rendering (defun projectile-doctor--field (label value &optional face) "Insert a LABEL/VALUE line into the report. VALUE is rendered with `%s'; a nil or empty one reads as \"n/a\". FACE, when given, is applied to the value; otherwise a value that is an unambiguous status word is colored by its polarity." (projectile--report-label label projectile-doctor--label-width) (let* ((value (if (or (null value) (equal value "")) "n/a" (format "%s" value))) (face (or face (projectile--report-status-face value)))) (insert (if face (projectile--report-face value face) value) "\n"))) (defun projectile-doctor--section (title) "Insert the header of a report section titled TITLE." (projectile--report-section title)) (defun projectile-doctor--list-field (label items) "Insert LABEL followed by ITEMS, one per line." (if (null items) (projectile-doctor--field label "none") (projectile-doctor--field label (car items)) (dolist (item (cdr items)) (insert (make-string projectile-doctor--label-width ?\s) item "\n")))) (defun projectile-doctor--executable-string (status) "Return the human-readable rendering of an executable STATUS." (pcase status ('present "present") ('missing "missing") (_ "not checked (remote)"))) (defun projectile-doctor--files-string (data) "Return the file-count line of the report DATA." (pcase (plist-get data :files-source) ('cache (format "%d (from the cache)" (plist-get data :file-count))) ('fresh (format "%d (fresh index, %.2fs - not cached by the doctor)" (plist-get data :file-count) (plist-get data :index-time))) ('skipped "not indexed (skipped for a remote project)") ('error (format "indexing failed: %s" (plist-get data :files-error))) (_ "n/a"))) (defun projectile-doctor--cache-string (data) "Return the cache-state line of the report DATA." (let ((age (plist-get data :cache-age)) (expire (plist-get data :cache-expire))) (cond ((null age) "not cached") (expire (format "cached %ds ago (expires after %ds)" age expire)) (t (format "cached %ds ago (never expires)" age))))) (defun projectile-doctor--render-no-project (data) "Render the no-project report for DATA." (projectile-doctor--section "Project") (projectile-doctor--field "directory" (plist-get data :dir)) (projectile-doctor--field "root" "none - not inside a project") (projectile-doctor--list-field "root functions tried" (mapcar #'symbol-name projectile-project-root-functions)) (insert (format " None of the functions above found a project marker at or above that directory. To make it a project, create a `%s' file in it (an empty one will do) or put it under version control. If you did that already and nothing changed, run `projectile-invalidate-cache' first - the \"not a project\" answer is cached too. " projectile-dirconfig-file))) (defun projectile-doctor--render (data) "Render the report described by DATA into the current buffer." (projectile--report-title "Projectile doctor report") (insert (projectile--report-face (format "projectile %s, Emacs %s, %s\n" projectile-version emacs-version system-type) 'projectile-report-label)) (if (null (plist-get data :root)) (projectile-doctor--render-no-project data) (projectile-doctor--section "Project") (projectile-doctor--field "root" (plist-get data :root) 'projectile-report-value) (projectile-doctor--field "detected by" (when-let* ((func (plist-get data :root-function))) (concat (symbol-name func) (if-let* ((marker (plist-get data :root-marker))) (format " (marker: %s)" marker) "")))) (projectile-doctor--field "name" (format "%s (%s)" (plist-get data :name) (if (eq (plist-get data :name-source) 'local-variable) "from the `projectile-project-name' variable" (format "via %s" (plist-get data :name-source))))) (projectile-doctor--field "remote" (or (plist-get data :remote) "no (local project)")) (projectile-doctor--field "projectile-mode" (if (plist-get data :projectile-mode) "on" "off")) (projectile-doctor--section "Type") (projectile-doctor--field "type" (format "%s (%s)" (plist-get data :type) (if (eq (plist-get data :type-source) 'local-variable) "from the `projectile-project-type' variable" "auto-detected"))) (projectile-doctor--field "marker" (when-let* ((marker (plist-get data :type-marker))) (if (functionp marker) (format "%s (predicate)" marker) ;; Every position is a list of alternatives once normalized, so ;; rendering doesn't need to know the shapes: `|' separates what ;; would satisfy one position, a space separates the positions. (mapconcat (lambda (alternatives) (string-join alternatives "|")) (projectile--marker-clauses marker) " ")))) (projectile-doctor--field "vcs" (plist-get data :vcs)) (when (eq (plist-get data :type) 'generic) (insert " No registered project type matched this project's files. That only affects the type-specific commands (compile, test, run, related files); file listing and search work regardless. Set `projectile-project-type' in .dir-locals.el to pin a type, or register one with `projectile-register-project-type'. ")) (projectile-doctor--section "Indexing") (projectile-doctor--field "method" (plist-get data :indexing-method)) (projectile-doctor--field "async indexing" (if (plist-get data :async-indexing) "on" "off")) (projectile-doctor--field "command" (or (plist-get data :index-command) "none (native indexing walks the tree in Lisp)")) (projectile-doctor--field "git" (projectile-doctor--executable-string (plist-get data :git))) (projectile-doctor--field "fd" (concat (projectile-doctor--executable-string (plist-get data :fd)) (unless (plist-get data :git-use-fd) " (not used - projectile-git-use-fd is nil)"))) (projectile-doctor--field "rg" (projectile-doctor--executable-string (plist-get data :rg))) (projectile-doctor--section "Files") (projectile-doctor--field "files" (projectile-doctor--files-string data)) (projectile-doctor--field "caching" (pcase (plist-get data :caching) ('nil "disabled") ('persistent "persistent") (_ "enabled (this session)"))) (projectile-doctor--field "cache state" (projectile-doctor--cache-string data)) (projectile-doctor--field "cache file" (plist-get data :cache-file)) (projectile-doctor--section "Ignores") (let ((cfg (plist-get data :dirconfig))) (projectile-doctor--field "dirconfig" (if cfg (format "%s (keep %d, ignore %d, ensure %d)" (plist-get data :dirconfig-file) (length (projectile-dirconfig-keep cfg)) (length (projectile-dirconfig-ignore cfg)) (length (projectile-dirconfig-ensure cfg))) (format "%s (absent)" (plist-get data :dirconfig-file)))) (when cfg (projectile-doctor--list-field "keep (+)" (projectile-dirconfig-keep cfg)) (projectile-doctor--list-field "ignore (-)" (projectile-dirconfig-ignore cfg)) (projectile-doctor--list-field "ensure (!)" (projectile-dirconfig-ensure cfg)))) (projectile-doctor--list-field "ignore patterns" (plist-get data :ignore-patterns)) (projectile-doctor--list-field "ensure patterns" (plist-get data :ensure-patterns)) (projectile-doctor--list-field "ignored in root" (if (plist-get data :remote) (list "not checked (remote)") (plist-get data :excluded-entries))) (projectile-doctor--section "Findings") ;; Anything that wants action first - a report is read top-down and a ;; lone warning shouldn't be buried among a dozen `ok' lines. (dolist (finding (projectile-doctor--sort-findings (projectile-doctor--findings data))) (pcase-let* ((`(,label . ,face) (pcase (plist-get finding :severity) ('ok '("ok" . projectile-report-ok)) ('warn '("warn" . projectile-report-warning)) (_ '("info" . projectile-report-info))))) (insert (projectile--report-face (format "%-6s" label) face) (plist-get finding :message) "\n") ;; Put the fix under the diagnosis rather than describing it. Its ;; own line, because findings are long and a button at the end of ;; one sits past the window edge where nobody will find it. (when-let* ((action (plist-get finding :action))) (insert (make-string 6 ?\s)) (insert-text-button (format "[%s]" (plist-get finding :action-label)) 'type 'projectile-doctor-action 'projectile-action action) (insert "\n")))) (projectile--report-hints '((forward-button . "next action") (revert-buffer . "refresh") (projectile-report-copy . "copy") (outline-toggle-children . "fold") (quit-window . "quit"))))) (defun projectile-doctor--sort-findings (findings) "Return FINDINGS ordered warnings first, then info, then `ok'. The order within each severity is preserved, so the report still reads in the order the checks are written." (let ((rank (lambda (finding) (pcase (plist-get finding :severity) ('warn 0) ('ok 2) (_ 1))))) (sort (copy-sequence findings) (lambda (a b) (< (funcall rank a) (funcall rank b)))))) (defun projectile-doctor--run-action (button) "Run the action BUTTON stands for, then regenerate the report. Regenerating is the point: the finding that prompted the action should answer for itself once it has been dealt with." (let ((action (button-get button 'projectile-action))) (funcall action) (when (derived-mode-p 'projectile-doctor-mode) (revert-buffer)))) (define-button-type 'projectile-doctor-action 'action #'projectile-doctor--run-action 'follow-link t 'help-echo "mouse-1, RET: do something about this finding") (defvar projectile-doctor-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "q") #'quit-window) (define-key map (kbd "w") #'projectile-report-copy) ;; The findings carry action buttons, so moving between them is worth ;; a key - as is folding a report that runs past a screenful. (define-key map (kbd "TAB") #'forward-button) (define-key map (kbd "") #'backward-button) (define-key map (kbd "n") #'forward-button) (define-key map (kbd "p") #'backward-button) (define-key map (kbd "f") #'outline-toggle-children) map) "Keymap for `projectile-doctor-mode'.") (define-derived-mode projectile-doctor-mode special-mode "Projectile-Doctor" "Major mode for the `projectile-doctor' report, read-only. The report is deliberately plain text, so it can be pasted verbatim into a bug report. \\\\[revert-buffer] regenerates it for the same directory and \\[quit-window] buries it. \\{projectile-doctor-mode-map}" (setq-local revert-buffer-function (lambda (&rest _) (projectile-doctor--report projectile-doctor--directory))) (projectile--report-setup-outline)) (defun projectile-doctor--report (dir) "Render a doctor report for DIR into the report buffer and return it." (let ((data (projectile-doctor--collect dir)) (buffer (get-buffer-create projectile-doctor-buffer-name))) (with-current-buffer buffer (let ((inhibit-read-only t)) (erase-buffer) (projectile-doctor-mode) (setq-local projectile-doctor--directory dir) (projectile-doctor--render data) (goto-char (point-min)))) buffer)) ;;;###autoload (defun projectile-doctor () "Diagnose Projectile's view of the current project. Open a read-only report describing the project Projectile sees around `default-directory': its root and which of `projectile-project-root-functions' found it, the detected project type and the marker that matched, the indexing method and the very command that will be run, which external tools are available, the file count and the cache state, the ignore rules in effect, and a list of findings - things that look fine and things worth changing. Outside a project the report says so and explains how to mark the directory as one. The report is plain text, meant to be pasted into a bug report. The doctor doesn't change what it measures: it never populates and never invalidates the file cache. A project that isn't cached yet is indexed with caching switched off and that run is reported as a fresh index. On remote projects indexing and program lookups are skipped rather than risking a hang, and the report says so." (interactive) (pop-to-buffer (projectile-doctor--report default-directory))) ;;; Project dashboard ;; ;; `projectile-dashboard' summarises a project in one buffer: what the ;; project is, what its VCS thinks of it, the files you keep coming back ;; to, and what you can run in it. Every interesting entry is a button, ;; so the dashboard doubles as a launcher - which is what makes it a ;; usable `projectile-switch-project-action'. ;; ;; Being a switch action is what shapes the whole thing. It runs right ;; after a switch, on a project that is very likely cold, and it must not ;; make the switch feel slow. So it reports only what is already there: ;; it never indexes, and an uncached project is shown as "not indexed ;; yet" rather than indexed on the spot, which would both cost seconds ;; and warm a cache the user didn't ask for. Like the doctor, it neither ;; populates nor invalidates `projectile-projects-cache'. ;; ;; The only external process it runs is git - two short commands, and ;; only on a local git project. `git rev-parse' is constant time, and ;; `git status --porcelain' rides the index stat cache and doesn't ;; recurse into untracked directories. On a remote (TRAMP) project the ;; VCS section is skipped outright: even `rev-parse' means a round-trip ;; over the wire, and the frecency history isn't tracked for remote ;; projects anyway, so the recent files list is empty there too. Every ;; other VCS degrades to its bare name. ;; ;; Lifecycle commands and tasks whose command is a function (the CMake ;; preset pickers, say) are listed but never resolved - resolving one can ;; pop up a prompt, and a dashboard that opens a minibuffer on project ;; switch would be intolerable. (defcustom projectile-dashboard-sections '(project links vcs recent tasks commands) "The sections `projectile-dashboard' renders, in order. Each element is one of the symbols `project' (name, root, type, file and buffer counts, ignore rules), `links' (the project's README, changelog, license, manifest and Projectile configuration, when it has them), `vcs' \(version-control system, branch and working tree status), `recent' (the project files you visit most, ranked by frecency), `tasks' (the project's named tasks) and `commands' (the configured lifecycle commands). Dropping a section skips both its rendering and the work needed to fill it in." :group 'projectile :type '(repeat (choice (const :tag "Project summary" project) (const :tag "Notable files" links) (const :tag "Version control" vcs) (const :tag "Recently visited files" recent) (const :tag "Tasks" tasks) (const :tag "Lifecycle commands" commands))) :package-version '(projectile . "3.3.0")) (defcustom projectile-dashboard-recent-files 10 "How many recently visited files `projectile-dashboard' lists. The files are ranked by frecency, so this is the length of the \"what was I working on\" list, not a history limit - that's `projectile-frecency-max-files'." :group 'projectile :type 'natnum :package-version '(projectile . "3.3.0")) (defconst projectile-dashboard-buffer-name "*projectile-dashboard*" "The name of the buffer `projectile-dashboard' renders into.") (defconst projectile-dashboard--label-width 16 "Column width of the labels in the dashboard.") (defvar-local projectile-dashboard--directory nil "The directory the dashboard in this buffer was generated from. Used by the buffer's `revert-buffer' to regenerate it.") (defun projectile-dashboard--section-p (section) "Return non-nil when SECTION is enabled in `projectile-dashboard-sections'." (memq section projectile-dashboard-sections)) ;;;; Dashboard data collection (defun projectile-dashboard--git-status (root) "Return the git branch and working tree counts for ROOT as a plist. The branch comes from a single `git rev-parse' and the counts from a single `git status --porcelain', which rides git's index stat cache and reports an untracked directory as one entry instead of recursing into it - that's what keeps this cheap enough to run on a project switch. The status is scoped to ROOT, since a project can sit below the git root \(see `projectile-project-vcs') and the whole repository's counts would be meaningless for it. The plist's `:vcs-state' is `ok' when both answered, `partial' when only the branch could be determined and `unavailable' when git couldn't answer at all (not installed, no commits yet, a broken repository)." (if-let* ((branch (projectile--git root "rev-parse" "--abbrev-ref" "HEAD"))) (let ((status (projectile--git root "status" "--porcelain" "--untracked-files=normal" "--" ".")) (modified 0) (untracked 0)) (dolist (line (and status (split-string status "\n" t))) (if (string-prefix-p "??" line) (setq untracked (1+ untracked)) (setq modified (1+ modified)))) (list :vcs-state (if status 'ok 'partial) ;; `--abbrev-ref' prints "HEAD" itself when the head is ;; detached, which would read as a branch named HEAD. :branch (let ((branch (string-trim branch))) (if (equal branch "HEAD") "detached HEAD" branch)) :modified modified :untracked untracked)) (list :vcs-state 'unavailable))) (defun projectile-dashboard--vcs-info (root vcs remote) "Return the version control data for the project at ROOT as a plist. VCS is the project's version-control system and REMOTE is non-nil for a TRAMP root. Only git is queried, and only locally, so the dashboard never blocks on a network round-trip or on a status command whose cost we can't vouch for; everything else degrades to the bare VCS name." (cond ((not (eq vcs 'git)) (list :vcs-state 'unsupported)) (remote (list :vcs-state 'skipped)) (t (projectile-dashboard--git-status root)))) (defun projectile-dashboard--recent-files (root) "Return ROOT's most frecent files, best first. This is the ranking `projectile-find-file' completion uses (see `projectile--frecency-score'), capped at `projectile-dashboard-recent-files'. The history outlives the files it tracks, so candidates are checked for existence as they are taken - which normally means one check per file shown, and never more than the tracked history. The check is skipped for a remote ROOT, where each one would be a round-trip (nothing is tracked for remote projects in the first place)." (when projectile-enable-frecency (when-let* ((files (gethash root (projectile--frecency-data)))) (let ((now (projectile-time-seconds)) entries) (maphash (lambda (file entry) (push (cons file (projectile--frecency-score entry now)) entries)) files) (let ((ranked (seq-sort-by #'cdr #'> entries)) (remote (file-remote-p root)) (taken 0) recent) (while (and ranked (< taken projectile-dashboard-recent-files)) (let ((entry (pop ranked))) (when (or remote (file-exists-p (expand-file-name (car entry) root))) (push entry recent) (setq taken (1+ taken))))) (nreverse recent)))))) (defun projectile-dashboard--commands (root) "Return the configured lifecycle commands of the project at ROOT. Each element is a cons of the phase symbol and the shell command that would run, or nil for a phase whose command is a function. Those are listed but never resolved: resolving one can pop up a prompt, which is the last thing to do in somebody's project-switch action." (let ((compile-dir (or (ignore-errors (projectile-compilation-dir)) root))) (delq nil (mapcar (lambda (descriptor) (let ((phase (plist-get descriptor :name))) (if (projectile--phase-command-dynamic-p phase) (cons phase nil) (when-let* ((command (ignore-errors (funcall (plist-get descriptor :command-fn) compile-dir)))) (cons phase command))))) projectile--lifecycle-phases)))) (defcustom projectile-dashboard-link-files '("README" "CHANGELOG" "CONTRIBUTING" "LICENSE" "COPYING") "Base names the dashboard offers as links when the project has them. Matched case-insensitively and ignoring any extension, so \"README\" finds `README.md\\=' as well as `README.rst\\='. The project\\='s own marker file (`package.json\\=', `Cargo.toml\\=', ...) and its `.projectile\\=' are always offered when present, without being listed here." :group 'projectile :type '(repeat string) :package-version '(projectile . "3.4.0")) (defun projectile-dashboard--links (root type) "Return the notable files of the project at ROOT of TYPE, as relative names. Answered from a single listing of the project root, so this costs one `directory-files\\=' however many names are looked for." (when-let* ((entries (projectile--directory-entry-set root))) (let ((found nil)) ;; The docs a human looks for, matched without their extension. (dolist (base projectile-dashboard-link-files) (when-let* ((hit (seq-find (lambda (entry) (string-equal (downcase base) (downcase (file-name-base entry)))) (sort (hash-table-keys entries) #'string<)))) (push hit found))) ;; The project\\='s own manifest, and its Projectile configuration. (dolist (name (append (ensure-list (projectile-project-type-attribute type 'project-file)) (list projectile-dirconfig-file ".dir-locals.el"))) (when (and (stringp name) (not (projectile--wildcard-p name)) (gethash name entries) (not (member name found))) (push name found))) (nreverse found)))) (defun projectile-dashboard--ignore-summary (root) "Return a one-line summary of the ignore rules in effect at ROOT. Counting compiled patterns is free - they are derived from the configuration and the project\\='s dirconfig, both of which are cached." (ignore-errors (let* ((default-directory root) ;; Reads the project's dirconfig; the parser caches it, so this ;; costs nothing the rest of Projectile isn't paying anyway. (cfg (projectile-parse-dirconfig-file)) (local (if cfg (+ (length (projectile-dirconfig-ignore cfg)) (length (projectile-dirconfig-ensure cfg))) 0)) (global (+ (length projectile-globally-ignored-directories) (length projectile-globally-ignored-files) (length projectile-globally-ignored-file-suffixes)))) (if (zerop local) (format "%d global patterns" global) (format "%d global patterns, %d from %s" global local projectile-dirconfig-file))))) (defun projectile-dashboard--collect-in-project (dir root) "Collect the dashboard data for the project at ROOT, reached from DIR. Must run in a buffer that has ROOT's directory-local variables applied - see `projectile-dashboard--collect', which arranges that." (let* ((remote (file-remote-p root)) (vcs (ignore-errors (projectile-project-vcs root))) (cached (gethash root projectile-projects-cache 'uncached)) (project (projectile-dashboard--section-p 'project))) (append (list :dir dir :root root :remote remote :vcs vcs :frecency projectile-enable-frecency :name (when project (ignore-errors (projectile-project-name root))) :type (when project (ignore-errors (projectile-project-type))) :file-count (unless (eq cached 'uncached) (length cached)) :buffer-count (length (ignore-errors (projectile-project-buffers root))) :links (when project (ignore-errors (projectile-dashboard--links root (ignore-errors (projectile-project-type))))) :ignores (when project (projectile-dashboard--ignore-summary root)) :recent-files (when (projectile-dashboard--section-p 'recent) (projectile-dashboard--recent-files root)) :tasks (when (projectile-dashboard--section-p 'tasks) (ignore-errors (projectile-project-tasks nil root))) :commands (when (projectile-dashboard--section-p 'commands) (ignore-errors (projectile-dashboard--commands root)))) (when (projectile-dashboard--section-p 'vcs) (projectile-dashboard--vcs-info root vcs remote))))) (defun projectile-dashboard--collect (&optional dir) "Collect the dashboard data for DIR's project as a plist. DIR defaults to `default-directory'. Outside a project the plist has a nil `:root' and the rendering degrades to saying so. The data is collected in a temporary buffer with the project's directory-local variables applied, the way `projectile-switch-project-by-name' runs the switch action. The project type, its tasks and its lifecycle commands can all come from .dir-locals.el, and the dashboard buffer has none of them - without this a refresh would quietly render a different project than the first pass. Nothing here indexes the project or touches the file cache: an uncached project is reported as not indexed rather than indexed on the spot, so that the dashboard stays cheap enough to be a `projectile-switch-project-action'." (let* ((dir (or dir default-directory)) (root (ignore-errors (projectile-project-root dir)))) (if (null root) (list :dir dir :root nil) (with-temp-buffer (setq default-directory root) (hack-dir-local-variables-non-file-buffer) (projectile-dashboard--collect-in-project dir root))))) ;;;; Dashboard buttons (defun projectile-dashboard--visit-file (button) "Visit the project file BUTTON stands for." (find-file (expand-file-name (button-get button 'projectile-file) (button-get button 'projectile-root)))) (defun projectile-dashboard--run-task (button) "Run the project task BUTTON stands for." (let ((default-directory (button-get button 'projectile-root))) (projectile--run-task (button-get button 'projectile-task) (button-get button 'projectile-command) nil))) (defun projectile-dashboard--run-command (button) "Run the lifecycle command BUTTON stands for." (let ((default-directory (button-get button 'projectile-root))) (call-interactively (button-get button 'projectile-command)))) (defun projectile-dashboard--open-vc (button) "Open the VC interface of the project BUTTON stands for." (projectile-vc (button-get button 'projectile-root))) (defun projectile-dashboard--open-dired (button) "Open the root of the project BUTTON stands for in Dired." (dired (button-get button 'projectile-root))) (defun projectile-dashboard--index (button) "Index the project BUTTON stands for, then refresh the dashboard." (let ((root (button-get button 'projectile-root))) (projectile-index-project-async root) (projectile--message-always "Indexing %s - press %s to refresh when it finishes" root (substitute-command-keys "\\[revert-buffer]")))) (define-button-type 'projectile-dashboard-file 'action #'projectile-dashboard--visit-file 'follow-link t 'help-echo "mouse-1, RET: visit this file") (define-button-type 'projectile-dashboard-task 'action #'projectile-dashboard--run-task 'follow-link t 'help-echo "mouse-1, RET: run this task") (define-button-type 'projectile-dashboard-command 'action #'projectile-dashboard--run-command 'follow-link t 'help-echo "mouse-1, RET: run this command") (define-button-type 'projectile-dashboard-vc 'action #'projectile-dashboard--open-vc 'follow-link t 'help-echo "mouse-1, RET: open the project's VC interface") (define-button-type 'projectile-dashboard-dired 'action #'projectile-dashboard--open-dired 'follow-link t 'help-echo "mouse-1, RET: open the project root in Dired") (define-button-type 'projectile-dashboard-index 'action #'projectile-dashboard--index 'follow-link t 'help-echo "mouse-1, RET: index this project in the background") ;;;; Dashboard rendering (defun projectile-dashboard--label (label) "Insert LABEL padded out to the dashboard's label column." (projectile--report-label label projectile-dashboard--label-width)) (defun projectile-dashboard--field (label value &optional face) "Insert a LABEL/VALUE line into the dashboard. VALUE is rendered with `%s'; a nil or empty one reads as \"n/a\". FACE, when given, is applied to the value." (projectile-dashboard--label label) (let ((value (if (or (null value) (equal value "")) "n/a" (format "%s" value)))) (insert (if face (projectile--report-face value face) value) "\n"))) (defun projectile-dashboard--section (title) "Insert the header of a dashboard section titled TITLE." (projectile--report-section title)) (defun projectile-dashboard--button (label type root &rest properties) "Insert a button labelled LABEL of button TYPE for the project at ROOT. PROPERTIES are any additional button properties, as a plist." (apply #'insert-text-button label 'type type 'projectile-root root properties)) (defun projectile-dashboard--entry (label type root &rest properties) "Insert an indented list entry button, padded to the value column. LABEL, TYPE, ROOT and PROPERTIES are as in `projectile-dashboard--button'." (insert " ") (apply #'projectile-dashboard--button label type root properties) (insert (make-string (max 1 (- projectile-dashboard--label-width 2 (length label))) ?\s))) (defun projectile-dashboard--phase-command (phase) "Return the interactive command running lifecycle PHASE. The lifecycle commands are named after their phase by construction (see `projectile--lifecycle-phases')." (intern (format "projectile-%s-project" phase))) (defun projectile-dashboard--render-project (data) "Render DATA's project summary." (let ((root (plist-get data :root))) (projectile-dashboard--section "Project") (projectile-dashboard--field "name" (plist-get data :name)) (projectile-dashboard--label "root") (projectile-dashboard--button root 'projectile-dashboard-dired root) (insert "\n") (projectile-dashboard--field "type" (plist-get data :type) 'projectile-report-value) (projectile-dashboard--label "files") (if-let* ((count (plist-get data :file-count))) (insert (format "%d (cached)\n" count)) ;; The dashboard never indexes on its own - but it can offer to. (insert "not indexed yet ") (projectile-dashboard--button "[index now]" 'projectile-dashboard-index root) (insert "\n")) (when-let* ((buffers (plist-get data :buffer-count))) (unless (zerop buffers) (projectile-dashboard--field "buffers" (format "%d open" buffers)))) (when-let* ((ignores (plist-get data :ignores))) (projectile-dashboard--field "ignores" ignores)) (when (plist-get data :remote) (projectile-dashboard--field "remote" (plist-get data :remote))))) (defun projectile-dashboard--render-vcs (data) "Render DATA's version control summary." (let ((root (plist-get data :root)) (vcs (plist-get data :vcs))) (projectile-dashboard--section "Version control") (projectile-dashboard--field "vcs" vcs) (pcase (plist-get data :vcs-state) ((and (or 'ok 'partial) state) (projectile-dashboard--label "branch") (projectile-dashboard--button (plist-get data :branch) 'projectile-dashboard-vc root) (insert "\n") (let ((modified (plist-get data :modified)) (untracked (plist-get data :untracked))) (projectile-dashboard--field "status" (if (eq state 'partial) "unavailable" (format "%d modified, %d untracked" modified untracked)) (unless (eq state 'partial) (if (and (zerop modified) (zerop untracked)) 'projectile-report-ok 'projectile-report-warning))))) ('skipped (projectile-dashboard--field "status" "not checked (remote project)")) ('unavailable (projectile-dashboard--field "status" "unavailable (no commits yet?)")) (_ (unless (memq vcs '(nil none)) (projectile-dashboard--label "vc") (projectile-dashboard--button "open the VC interface" 'projectile-dashboard-vc root) (insert "\n")))))) (defun projectile-dashboard--render-links (data) "Render DATA's notable project files." (let ((root (plist-get data :root)) (links (plist-get data :links))) (projectile-dashboard--section "Notable files") (if (null links) (insert " none found\n") (dolist (file links) (projectile-dashboard--entry file 'projectile-dashboard-file root 'projectile-file file) (insert "\n"))))) (defun projectile-dashboard--render-recent (data) "Render DATA's recently visited files." (let ((root (plist-get data :root)) (files (plist-get data :recent-files))) (projectile-dashboard--section "Recent files") (if (null files) (insert (if (plist-get data :frecency) "Nothing visited in this project yet.\n" "Frecency tracking is off (`projectile-enable-frecency').\n")) (dolist (entry files) (insert " ") (projectile-dashboard--button (car entry) 'projectile-dashboard-file root 'projectile-file (car entry)) (insert "\n"))))) (defun projectile-dashboard--render-tasks (data) "Render DATA's project tasks." (let ((root (plist-get data :root)) (tasks (plist-get data :tasks))) (projectile-dashboard--section "Tasks") (if (null tasks) (insert "No tasks defined for this project (see `projectile-tasks').\n") (dolist (task tasks) (projectile-dashboard--entry (car task) 'projectile-dashboard-task root 'projectile-task (car task) 'projectile-command (cdr task)) (insert (if (stringp (cdr task)) (cdr task) "computed at run time") "\n"))))) (defun projectile-dashboard--render-commands (data) "Render DATA's configured lifecycle commands." (let ((root (plist-get data :root)) (commands (plist-get data :commands))) (projectile-dashboard--section "Lifecycle commands") (if (null commands) (insert "No lifecycle commands configured for this project type.\n") (dolist (entry commands) (projectile-dashboard--entry (symbol-name (car entry)) 'projectile-dashboard-command root 'projectile-command (projectile-dashboard--phase-command (car entry))) (insert (or (cdr entry) "computed at run time") "\n"))))) (defun projectile-dashboard--render-no-project (data) "Render the no-project dashboard for DATA." (projectile-dashboard--section "Project") (projectile-dashboard--field "directory" (plist-get data :dir)) (projectile-dashboard--field "root" "none - not inside a project") (insert (format " There's no project around that directory, so there's nothing to show. Create a `%s' file in it (an empty one will do) or put it under version control, then press `g' to try again. `M-x projectile-doctor' lists the root functions that were tried and explains why none of them claimed the directory. " projectile-dirconfig-file))) (defun projectile-dashboard--render (data) "Render the dashboard described by DATA into the current buffer." (projectile--report-title (if-let* ((name (plist-get data :name))) (format "Projectile dashboard: %s" name) "Projectile dashboard")) (if (null (plist-get data :root)) (projectile-dashboard--render-no-project data) (dolist (section projectile-dashboard-sections) (pcase section ('project (projectile-dashboard--render-project data)) ('links (projectile-dashboard--render-links data)) ('vcs (projectile-dashboard--render-vcs data)) ('recent (projectile-dashboard--render-recent data)) ('tasks (projectile-dashboard--render-tasks data)) ('commands (projectile-dashboard--render-commands data)))) (projectile--report-hints '((push-button . "act on entry") (forward-button . "next entry") (revert-buffer . "refresh") (projectile-report-copy . "copy") (quit-window . "bury"))))) ;;;; The dashboard buffer (defvar projectile-dashboard-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "TAB") #'forward-button) (define-key map (kbd "") #'backward-button) ;; The buffer is a list of entries, so moving by entry is more useful ;; here than the `next-line'/`previous-line' these shadow. (define-key map (kbd "n") #'forward-button) (define-key map (kbd "p") #'backward-button) (define-key map (kbd "w") #'projectile-report-copy) map) "Keymap for `projectile-dashboard-mode'.") (define-derived-mode projectile-dashboard-mode special-mode "Projectile-Dashboard" "Major mode for the `projectile-dashboard' buffer, read-only. The files, tasks, lifecycle commands and the current branch are buttons. RET acts on the one at point; \\\\[forward-button] and \\[backward-button] (also `n' and `p') move between them. \\[revert-buffer] refreshes the dashboard and \\[quit-window] buries it. \\{projectile-dashboard-mode-map}" (setq-local revert-buffer-function (lambda (&rest _) (projectile-dashboard--refresh projectile-dashboard--directory))) (projectile--report-setup-outline)) (defun projectile-dashboard--refresh (dir) "Render the dashboard for DIR into the dashboard buffer and return it." (let ((data (projectile-dashboard--collect dir)) (buffer (get-buffer-create projectile-dashboard-buffer-name))) (with-current-buffer buffer (let ((inhibit-read-only t)) (erase-buffer) (projectile-dashboard-mode) (setq-local projectile-dashboard--directory dir) ;; The buffer is reused across projects, so point it at the one it ;; currently shows - otherwise commands invoked in it (and the mode ;; line) would keep targeting whichever project opened it first. (setq-local default-directory (or (plist-get data :root) dir)) (projectile-dashboard--render data) (goto-char (point-min)))) buffer)) ;;;###autoload (defun projectile-dashboard () "Show a dashboard summarising the project around `default-directory'. The dashboard covers the project's name, root, type and file count, the version control system with the current branch and how many files are modified or untracked, the project files you visit most (ranked by frecency, the same ranking `projectile-find-file' uses), the project's tasks and its configured lifecycle commands. Everything worth acting on is a button, so the buffer doubles as a launcher: RET on a file visits it, on a task or a lifecycle command runs it, on the branch opens the project's VC interface, and on the root opens it in Dired. TAB moves to the next button, `g' refreshes the dashboard and `q' buries it. The command is cheap on purpose, so that it can serve as a `projectile-switch-project-action'. It never indexes the project and never touches the file cache - an uncached project is reported as not indexed rather than indexed on the spot. The branch and status come from two short git commands, run only on a local git project; on a remote project, or under any other VCS, that section says so instead. `projectile-dashboard-sections' controls which sections are shown." (interactive) (pop-to-buffer (projectile-dashboard--refresh default-directory))) ;;; Projectile Minor mode (defvar-local projectile--mode-line nil "The mode-line lighter Projectile shows in this buffer. Seeded from `projectile-mode-line-prefix' and replaced by `projectile-update-mode-line' once the buffer's project is known. A buffer that never gets that far keeps the prefix: that is every buffer when `projectile-dynamic-mode-line' is off, and remote ones always, since both update paths skip them to avoid a TRAMP round trip.") (defcustom projectile-mode-line-prefix " Projectile" "Mode line lighter prefix for Projectile. It's used by `projectile-default-mode-line' when using dynamic mode line lighter and is the only thing shown in the mode line otherwise. Change the value via Customize or `setopt' so it takes effect immediately; a plain `setq' only reaches buffers whose lighter is recomputed later, and none are when `projectile-dynamic-mode-line' is off." :group 'projectile :type 'string :set (lambda (symbol value) (set-default symbol value) ;; The lighter is a variable, not a computation, so buffers that ;; never recompute it - all of them with `projectile-dynamic-mode-line' ;; off - would otherwise keep displaying whatever the prefix was ;; when Projectile loaded. (setq-default projectile--mode-line value) (force-mode-line-update t)) :package-version '(projectile . "0.12.0")) (defcustom projectile-show-menu t "Controls whether to display Projectile's menu." :group 'projectile :type 'boolean :package-version '(projectile . "2.6.0")) (defun projectile-default-mode-line () "Report project name and type in the modeline." (let ((project-name (projectile-project-name)) (project-type (projectile-project-type))) (format "%s[%s%s]" projectile-mode-line-prefix (or project-name "-") (if project-type (format ":%s" project-type) "")))) (defun projectile-update-mode-line () "Update the Projectile mode-line." (let ((mode-line (funcall projectile-mode-line-function))) (setq projectile--mode-line mode-line)) (force-mode-line-update)) (defun projectile-update-mode-line-on-window-change () "Update the mode-line when the window configuration changes. This ensures the mode-line is correct in non-file buffers like Magit that don't trigger `find-file-hook'." (when projectile-dynamic-mode-line (unless (file-remote-p default-directory) (projectile-update-mode-line)))) (defvar projectile-command-map (let ((map (make-sparse-keymap))) (define-key map (kbd "4 4") #'projectile-other-window-command) (define-key map (kbd "4 a") #'projectile-find-other-file-other-window) (define-key map (kbd "4 b") #'projectile-switch-to-buffer-other-window) (define-key map (kbd "4 C-o") #'projectile-display-buffer) (define-key map (kbd "4 d") #'projectile-find-dir-other-window) (define-key map (kbd "4 D") #'projectile-dired-other-window) (define-key map (kbd "4 f") #'projectile-find-file-other-window) (define-key map (kbd "4 g") #'projectile-find-file-dwim-other-window) (define-key map (kbd "4 j") #'projectile-find-file-of-kind-other-window) (define-key map (kbd "4 p") #'projectile-switch-project-other-window) (define-key map (kbd "4 t") #'projectile-find-implementation-or-test-other-window) (define-key map (kbd "5 5") #'projectile-other-frame-command) (define-key map (kbd "5 a") #'projectile-find-other-file-other-frame) (define-key map (kbd "5 b") #'projectile-switch-to-buffer-other-frame) (define-key map (kbd "5 d") #'projectile-find-dir-other-frame) (define-key map (kbd "5 D") #'projectile-dired-other-frame) (define-key map (kbd "5 f") #'projectile-find-file-other-frame) (define-key map (kbd "5 g") #'projectile-find-file-dwim-other-frame) (define-key map (kbd "5 j") #'projectile-find-file-of-kind-other-frame) (define-key map (kbd "5 p") #'projectile-switch-project-other-frame) (define-key map (kbd "5 t") #'projectile-find-implementation-or-test-other-frame) (define-key map (kbd "!") #'projectile-run-shell-command-in-root) (define-key map (kbd "&") #'projectile-run-async-shell-command-in-root) (define-key map (kbd "?") #'projectile-find-references) (define-key map (kbd "a") #'projectile-find-other-file) (define-key map (kbd "A") #'projectile-add-known-project) (define-key map (kbd "b") #'projectile-switch-to-buffer) ;; project-scoped bookmarks (see `projectile-bookmark-set') (define-key map (kbd "B s") #'projectile-bookmark-set) (define-key map (kbd "B j") #'projectile-bookmark-jump) (define-key map (kbd "B d") #'projectile-bookmark-delete) (define-key map (kbd "C") #'projectile-find-changed-file) (define-key map (kbd "d") #'projectile-find-dir) (define-key map (kbd "D") #'projectile-dired) (define-key map (kbd "e") #'projectile-recentf) (define-key map (kbd "E") #'projectile-edit-dir-locals) (define-key map (kbd "f") #'projectile-find-file) (define-key map (kbd "g") #'projectile-find-file-dwim) (define-key map (kbd "F") #'projectile-find-file-in-known-projects) ;; the h key is reserved for helm-projectile ;; the binding below will be added when helm-projectile is enabled ;; (define-key projectile-command-map (kbd "h") #'helm-projectile) (define-key map (kbd "i") #'projectile-invalidate-cache) (define-key map (kbd "I") #'projectile-ibuffer) (define-key map (kbd "j") #'projectile-find-file-of-kind) (define-key map (kbd "J") #'projectile-toggle-related-file) (define-key map (kbd "k") #'projectile-kill-buffers) (define-key map (kbd "l") #'projectile-find-file-in-directory) (define-key map (kbd "m") #'projectile-dispatch) ;; projects related to this one, in other repositories - the keys ;; mirror the project-wide ones a level down, as `c m' does (define-key map (kbd "n p") #'projectile-switch-sibling-project) (define-key map (kbd "n f") #'projectile-find-file-in-sibling-projects) (define-key map (kbd "n s") #'projectile-search-in-sibling-projects) (define-key map (kbd "n b") #'projectile-switch-to-buffer-in-sibling-projects) (define-key map (kbd "n o") #'projectile-multi-occur-in-sibling-projects) (define-key map (kbd "n t") #'projectile-todos-in-sibling-projects) (define-key map (kbd "o") #'projectile-multi-occur) (define-key map (kbd "p") #'projectile-switch-project) (define-key map (kbd "q") #'projectile-switch-open-project) (define-key map (kbd "r") #'projectile-replace) (define-key map (kbd "R") #'projectile-replace-review) (define-key map (kbd "u") #'projectile-replace-undo) (define-key map (kbd "s s") #'projectile-search) (define-key map (kbd "s g") #'projectile-grep) (define-key map (kbd "s r") #'projectile-ripgrep) (define-key map (kbd "s a") #'projectile-ag) (define-key map (kbd "s x") #'projectile-find-references) (define-key map (kbd "s R") #'projectile-search-review) (define-key map (kbd "s X") #'projectile-search-regexp-review) (define-key map (kbd "s t") #'projectile-todos) (define-key map (kbd "S") #'projectile-save-project-buffers) (define-key map (kbd "t") #'projectile-toggle-between-implementation-and-test) (define-key map (kbd "T") #'projectile-find-test-file) (define-key map (kbd "v") #'projectile-vc) ;; per-project sessions (see `projectile-session-mode') (define-key map (kbd "w s") #'projectile-session-save) (define-key map (kbd "w S") #'projectile-session-save-all) (define-key map (kbd "w r") #'projectile-session-restore) (define-key map (kbd "w R") #'projectile-session-restore-all) (define-key map (kbd "w f") #'projectile-session-forget) (define-key map (kbd "w b") #'projectile-session-switch-to-buffer) ;; other checkouts of the current project's repository (define-key map (kbd "W") #'projectile-switch-worktree) ;; project lifecycle external commands (define-key map (kbd "c o") #'projectile-configure-project) (define-key map (kbd "c c") #'projectile-compile-project) (define-key map (kbd "c p") #'projectile-package-project) (define-key map (kbd "c i") #'projectile-install-project) (define-key map (kbd "c t") #'projectile-test-project) (define-key map (kbd "c .") #'projectile-run-test-at-point) (define-key map (kbd "c r") #'projectile-run-project) ;; subprojects (see `projectile-project-subprojects') - the keys ;; mirror the project-wide ones a level down (define-key map (kbd "c m f") #'projectile-find-file-in-subproject) (define-key map (kbd "c m o") #'projectile-configure-subproject) (define-key map (kbd "c m c") #'projectile-compile-subproject) (define-key map (kbd "c m t") #'projectile-test-subproject) (define-key map (kbd "c m i") #'projectile-install-subproject) (define-key map (kbd "c m p") #'projectile-package-subproject) (define-key map (kbd "c m r") #'projectile-run-subproject) (define-key map (kbd "c x") #'projectile-run-task) (define-key map (kbd "c X") #'projectile-repeat-last-task) ;; integration with utilities (define-key map (kbd "x r") #'projectile-run) (define-key map (kbd "x e") #'projectile-run-eshell) (define-key map (kbd "x i") #'projectile-run-ielm) (define-key map (kbd "x t") #'projectile-run-term) (define-key map (kbd "x s") #'projectile-run-shell) (define-key map (kbd "x g") #'projectile-run-gdb) (define-key map (kbd "x v") #'projectile-run-vterm) (define-key map (kbd "x 4 v") #'projectile-run-vterm-other-window) (define-key map (kbd "x x") #'projectile-run-eat) (define-key map (kbd "x 4 x") #'projectile-run-eat-other-window) (define-key map (kbd "x G") #'projectile-run-ghostel) (define-key map (kbd "x 4 G") #'projectile-run-ghostel-other-window) ;; misc (define-key map (kbd "H") #'projectile-doctor) (define-key map (kbd "P") #'projectile-dashboard) (define-key map (kbd "z") #'projectile-cache-current-file) (define-key map (kbd "") #'projectile-previous-project-buffer) (define-key map (kbd "") #'projectile-next-project-buffer) (define-key map (kbd "ESC") #'projectile-project-buffers-other-buffer) map) "Keymap for Projectile commands after `projectile-keymap-prefix'.") (fset 'projectile-command-map projectile-command-map) ;;; Prefix commands for other-window/-frame display ;; ;; These are Projectile's take on the Emacs 28 `other-window-prefix' and ;; `other-frame-prefix' commands (C-x 4 4 and C-x 5 5): they arrange for ;; the buffer displayed by the *next* command to go to another window or ;; frame, and additionally keep `projectile-command-map' active for the ;; next key sequence. So `4 4 f' (after the Projectile prefix) opens a ;; project file in another window, and the same trick works for commands ;; that never had a dedicated -other-window variant, e.g. `4 4 x s' runs ;; a project shell in another window. (defun projectile--obey-display-actions-for-next-command () "Cover `switch-to-buffer'-based commands in the next-command override. Emacs 29 made `display-buffer-override-next-command' temporarily enable `switch-to-buffer-obey-display-actions', so that the display override armed by `other-window-prefix'/`other-frame-prefix' also applies to commands that display buffers with `switch-to-buffer'. Emacs 28 lacks that, so arrange for it here: enable the option and restore the user's setting once the next command is done (mirroring the teardown conditions of window.el's own post-command function)." (when (< emacs-major-version 29) (let* ((obey-display switch-to-buffer-obey-display-actions) (command this-command) (depth (minibuffer-depth)) (restore (make-symbol "projectile--restore-obey-display-actions"))) (setq switch-to-buffer-obey-display-actions t) (fset restore (lambda () ;; Stay armed while reading from the minibuffer and while ;; the command that armed us is still in progress. (unless (or (> (minibuffer-depth) depth) (eq this-command command)) (setq switch-to-buffer-obey-display-actions obey-display) (remove-hook 'post-command-hook restore)))) (add-hook 'post-command-hook restore)))) ;;;###autoload (defun projectile-other-window-command () "Show the buffer of the next Projectile command in another window. Set up the next command's buffer to be displayed in a new window (via `other-window-prefix') and keep `projectile-command-map' active for the next key sequence, so any Projectile key typed right after this command gets the other-window treatment without re-typing the Projectile prefix. Any non-Projectile command works as well; commands that use `switch-to-buffer' are covered too, by temporarily enabling `switch-to-buffer-obey-display-actions'." (interactive) (other-window-prefix) (projectile--obey-display-actions-for-next-command) (set-transient-map projectile-command-map) (message "Display buffer of next (Projectile) command in a new window...")) ;;;###autoload (defun projectile-other-frame-command () "Show the buffer of the next Projectile command in another frame. Set up the next command's buffer to be displayed in a new frame (via `other-frame-prefix') and keep `projectile-command-map' active for the next key sequence, so any Projectile key typed right after this command gets the other-frame treatment without re-typing the Projectile prefix. Any non-Projectile command works as well; commands that use `switch-to-buffer' are covered too, by temporarily enabling `switch-to-buffer-obey-display-actions'." (interactive) (other-frame-prefix) (projectile--obey-display-actions-for-next-command) (set-transient-map projectile-command-map) (message "Display buffer of next (Projectile) command in a new frame...")) ;;; projectile-dispatch modifiers ;; ;; `projectile-dispatch' (below) exposes a handful of command modifiers as ;; transient switches: `--invalidate-cache', `--regexp', `--new-process' and a ;; `--display' target (this window / other window / other frame). Several ;; Projectile commands already honour these via a prefix argument, and the ;; other-window/-frame behaviour is provided by dedicated command variants. ;; The switches are wired to the commands through the thin wrapper commands ;; generated below: each reads the active switches and either dispatches to the ;; right display variant or sets `current-prefix-arg' accordingly. ;; ;; These wrappers are plain commands (usable without `transient' loaded, they ;; simply see no active switches then), so they're defined unconditionally, ;; unlike the transient prefix itself. (defun projectile-dispatch--args () "Return the active `projectile-dispatch' switches, or nil. Only returns switches while a transient suffix is executing; a wrapper invoked outside the menu sees none." (and (bound-and-true-p transient-current-command) (transient-args transient-current-command))) (defmacro projectile-dispatch--define (name command &rest props) "Define command NAME as a `projectile-dispatch' wrapper around COMMAND. PROPS is a plist of: :other-window CMD, :other-frame CMD command variants selected by the `--display' switch; :prefix-arg SWITCH set `current-prefix-arg' to a plain prefix when SWITCH is active." (declare (indent 2)) (let ((ow (plist-get props :other-window)) (of (plist-get props :other-frame)) (switch (plist-get props :prefix-arg))) `(defun ,name () ,(format "A `projectile-dispatch' wrapper honouring its modifier switches.\nRuns `%s'." command) (interactive) (let* ((projectile-dispatch--switches (projectile-dispatch--args)) (current-prefix-arg ,(if switch `(if (member ,switch projectile-dispatch--switches) '(4) current-prefix-arg) 'current-prefix-arg)) (command ,(if ow `(cond ((member "--display=frame" projectile-dispatch--switches) #',of) ((member "--display=window" projectile-dispatch--switches) #',ow) (t #',command)) `#',command))) (call-interactively command))))) ;; Display + cache (projectile-dispatch--define projectile-dispatch-find-file projectile-find-file :other-window projectile-find-file-other-window :other-frame projectile-find-file-other-frame :prefix-arg "--invalidate-cache") (projectile-dispatch--define projectile-dispatch-find-file-dwim projectile-find-file-dwim :other-window projectile-find-file-dwim-other-window :other-frame projectile-find-file-dwim-other-frame :prefix-arg "--invalidate-cache") (projectile-dispatch--define projectile-dispatch-find-dir projectile-find-dir :other-window projectile-find-dir-other-window :other-frame projectile-find-dir-other-frame :prefix-arg "--invalidate-cache") ;; Display only (projectile-dispatch--define projectile-dispatch-find-other-file projectile-find-other-file :other-window projectile-find-other-file-other-window :other-frame projectile-find-other-file-other-frame) (projectile-dispatch--define projectile-dispatch-find-file-of-kind projectile-find-file-of-kind :other-window projectile-find-file-of-kind-other-window :other-frame projectile-find-file-of-kind-other-frame) (projectile-dispatch--define projectile-dispatch-dired projectile-dired :other-window projectile-dired-other-window :other-frame projectile-dired-other-frame) (projectile-dispatch--define projectile-dispatch-switch-to-buffer projectile-switch-to-buffer :other-window projectile-switch-to-buffer-other-window :other-frame projectile-switch-to-buffer-other-frame) (projectile-dispatch--define projectile-dispatch-switch-project projectile-switch-project :other-window projectile-switch-project-other-window :other-frame projectile-switch-project-other-frame) (projectile-dispatch--define projectile-dispatch-impl-or-test projectile-toggle-between-implementation-and-test :other-window projectile-find-implementation-or-test-other-window :other-frame projectile-find-implementation-or-test-other-frame) ;; Cache only (projectile-dispatch--define projectile-dispatch-find-test-file projectile-find-test-file :prefix-arg "--invalidate-cache") ;; Regexp search (projectile-dispatch--define projectile-dispatch-search projectile-search :prefix-arg "--regexp") (projectile-dispatch--define projectile-dispatch-ag projectile-ag :prefix-arg "--regexp") (projectile-dispatch--define projectile-dispatch-ripgrep projectile-ripgrep :prefix-arg "--regexp") (defun projectile-dispatch-search-review () "Reviewable search honouring the `--regexp' and `--case-sensitive' switches. `--regexp' runs the Emacs-regexp reviewer, `--case-sensitive' seeds the search case-sensitive; all can still be flipped (`x'/`c'/`w') in the results buffer." (interactive) (let ((switches (projectile-dispatch--args))) (let ((case-fold-search (if (member "--case-sensitive" switches) nil case-fold-search)) (projectile-search-whole-word (if (member "--word" switches) t projectile-search-whole-word))) (call-interactively (if (member "--regexp" switches) #'projectile-search-regexp-review #'projectile-search-review))))) (defun projectile-dispatch-search-siblings () "Sibling-project search honouring the search switches. `--regexp' reads the term as an Emacs regexp, `--case-sensitive' seeds the search case-sensitive and `--word' matches whole words; all can still be flipped (`x'/`c'/`w') in the results buffer." (interactive) (let* ((switches (projectile-dispatch--args)) (case-fold-search (if (member "--case-sensitive" switches) nil case-fold-search)) (projectile-search-whole-word (if (member "--word" switches) t projectile-search-whole-word))) (projectile-search-in-sibling-projects (and (member "--regexp" switches) t)))) (defun projectile-dispatch-replace-review () "Reviewable replace honouring the `--regexp' and `--case-sensitive' switches. Like `projectile-dispatch-search-review', but for the replace reviewer." (interactive) (let ((switches (projectile-dispatch--args))) (let ((case-fold-search (if (member "--case-sensitive" switches) nil case-fold-search)) (projectile-search-whole-word (if (member "--word" switches) t projectile-search-whole-word))) (call-interactively (if (member "--regexp" switches) #'projectile-replace-regexp-review #'projectile-replace-review))))) ;; New process (projectile-dispatch--define projectile-dispatch-run projectile-run :prefix-arg "--new-process") (projectile-dispatch--define projectile-dispatch-run-eshell projectile-run-eshell :prefix-arg "--new-process") (projectile-dispatch--define projectile-dispatch-run-shell projectile-run-shell :prefix-arg "--new-process") (projectile-dispatch--define projectile-dispatch-run-ielm projectile-run-ielm :prefix-arg "--new-process") (projectile-dispatch--define projectile-dispatch-run-term projectile-run-term :prefix-arg "--new-process") (projectile-dispatch--define projectile-dispatch-run-vterm projectile-run-vterm :prefix-arg "--new-process") (projectile-dispatch--define projectile-dispatch-run-eat projectile-run-eat :prefix-arg "--new-process") (projectile-dispatch--define projectile-dispatch-run-ghostel projectile-run-ghostel :prefix-arg "--new-process") ;; `projectile-dispatch' is a transient menu mirroring `projectile-command-map'. ;; The menu keys deliberately match the `projectile-command-map' bindings. ;; The transient prefix is defined lazily: loading `transient' costs a few ;; milliseconds and some memory for every session, while the menu is only ;; needed once invoked. `projectile-dispatch' below is a stub that loads ;; `transient', evaluates the real definition (replacing itself), and ;; re-invokes it; `transient' is required at compile time (see the top of ;; the file) so the macro still expands during byte-compilation. (defun projectile--dispatch-define () "Define the `projectile-dispatch' transient prefix, replacing the stub." (transient-define-prefix projectile-dispatch () "Dispatch menu for Projectile commands. The switches in the Modifiers group tweak how the commands below run: `--invalidate-cache' rebuilds the file cache first (file/dir commands), `--regexp' searches for a regexp (the ag/ripgrep search and the reviewable search/replace), `--case-sensitive' seeds the reviewable search/replace case-sensitive, `--word' makes it match whole words, `--new-process' starts a fresh process (shells), and `--display' opens the result in another window or frame (file/buffer/project commands)." ["Modifiers" ("-i" "invalidate cache" "--invalidate-cache") ("-r" "regexp search" "--regexp") ("-c" "case-sensitive search" "--case-sensitive") ("-w" "whole-word search" "--word") ("-n" "new process" "--new-process") ("-d" "display in" "--display=" :class transient-switches :argument-format "--display=%s" :argument-regexp "\\(--display=\\(window\\|frame\\)\\)" :choices ("window" "frame"))] [["Find" ("f" "file" projectile-dispatch-find-file) ("g" "file dwim" projectile-dispatch-find-file-dwim) ("a" "other file" projectile-dispatch-find-other-file) ("l" "file in dir" projectile-find-file-in-directory) ("C" "changed file" projectile-find-changed-file) ("F" "file in known projects" projectile-find-file-in-known-projects) ("nf" "file in sibling projects" projectile-find-file-in-sibling-projects) ("d" "dir" projectile-dispatch-find-dir) ("D" "dired" projectile-dispatch-dired) ("e" "recentf" projectile-recentf) ("E" "edit .dir-locals" projectile-edit-dir-locals) ("T" "test file" projectile-dispatch-find-test-file) ("t" "toggle impl/test" projectile-dispatch-impl-or-test) ("j" "file of kind" projectile-dispatch-find-file-of-kind) ("J" "toggle related" projectile-toggle-related-file)] ["Buffers" ("b" "switch buffer" projectile-dispatch-switch-to-buffer) ("nb" "buffer in siblings" projectile-switch-to-buffer-in-sibling-projects) ("C-o" "display buffer" projectile-display-buffer) ("I" "ibuffer" projectile-ibuffer) ("k" "kill buffers" projectile-kill-buffers) ("S" "save buffers" projectile-save-project-buffers)] ["Bookmarks" ("Bs" "set bookmark" projectile-bookmark-set) ("Bj" "jump to bookmark" projectile-bookmark-jump) ("Bd" "delete bookmark" projectile-bookmark-delete)] ["Search / Replace" ("ss" "search" projectile-dispatch-search) ("sg" "grep" projectile-grep) ("sr" "ripgrep" projectile-dispatch-ripgrep) ("sa" "ag" projectile-dispatch-ag) ("sx" "references" projectile-find-references) ("sR" "search (review)" projectile-dispatch-search-review) ("ns" "search siblings" projectile-dispatch-search-siblings) ("no" "multi-occur siblings" projectile-multi-occur-in-sibling-projects) ("nt" "todos in siblings" projectile-todos-in-sibling-projects) ("st" "todos" projectile-todos) ("o" "multi-occur" projectile-multi-occur) ("r" "replace" projectile-replace) ("R" "replace (review)" projectile-dispatch-replace-review) ("u" "undo last replace" projectile-replace-undo)]] [["Project" ("p" "switch project" projectile-dispatch-switch-project) ("q" "switch open project" projectile-switch-open-project) ("W" "switch worktree" projectile-switch-worktree) ("np" "switch sibling project" projectile-switch-sibling-project) ("A" "add known project" projectile-add-known-project) ("v" "vc" projectile-vc) ("P" "dashboard" projectile-dashboard) ("H" "doctor" projectile-doctor)] ["Lifecycle" ("cc" "compile" projectile-compile-project) ("ct" "test" projectile-test-project) ("c." "test at point" projectile-run-test-at-point) ("cr" "run" projectile-run-project) ("co" "configure" projectile-configure-project) ("ci" "install" projectile-install-project) ("cp" "package" projectile-package-project) ("cx" "run task" projectile-run-task) ("cX" "repeat last task" projectile-repeat-last-task)] ["Subproject" ("cmf" "find file" projectile-find-file-in-subproject) ("cmc" "compile" projectile-compile-subproject) ("cmt" "test" projectile-test-subproject) ("cmr" "run" projectile-run-subproject) ("cmo" "configure" projectile-configure-subproject) ("cmi" "install" projectile-install-subproject) ("cmp" "package" projectile-package-subproject)] ["Shells / Run" ("xr" "run" projectile-dispatch-run) ("xe" "eshell" projectile-dispatch-run-eshell) ("xs" "shell" projectile-dispatch-run-shell) ("xt" "term" projectile-dispatch-run-term) ("xi" "ielm" projectile-dispatch-run-ielm) ("xg" "gdb" projectile-run-gdb) ("xv" "vterm" projectile-dispatch-run-vterm) ("xx" "eat" projectile-dispatch-run-eat) ("xG" "ghostel" projectile-dispatch-run-ghostel) ("!" "shell command" projectile-run-shell-command-in-root) ("&" "async shell command" projectile-run-async-shell-command-in-root)] ["Session" ("ws" "save session" projectile-session-save) ("wS" "save all sessions" projectile-session-save-all) ("wr" "restore session" projectile-session-restore) ("wR" "restore all sessions" projectile-session-restore-all) ("wf" "forget session" projectile-session-forget) ("wb" "switch project buffer" projectile-session-switch-to-buffer)] ["Cache" ("i" "invalidate cache" projectile-invalidate-cache) ("z" "cache current file" projectile-cache-current-file)]])) (defun projectile-dispatch () "Dispatch menu for Projectile commands. The switches in the Modifiers group tweak how the commands below run: `--invalidate-cache' rebuilds the file cache first (file/dir commands), `--regexp' searches for a regexp (the ag/ripgrep search and the reviewable search/replace), `--case-sensitive' seeds the reviewable search/replace case-sensitive, `--word' makes it match whole words, `--new-process' starts a fresh process (shells), and `--display' opens the result in another window or frame (file/buffer/project commands)." (interactive) ;; Loading `transient' is deferred until the menu is first used; this ;; stub is replaced by the real transient prefix on that first call. (require 'transient) (projectile--dispatch-define) (call-interactively 'projectile-dispatch)) ;; Mark the stub as a transient prefix so `projectile--transient-command-p' ;; recognizes it before the first invocation replaces the stub (and this ;; property) with the real definition. (put 'projectile-dispatch 'transient--prefix t) (defvar projectile-mode-map (let ((map (make-sparse-keymap))) (when projectile-keymap-prefix (define-key map projectile-keymap-prefix 'projectile-command-map)) (easy-menu-define projectile-mode-menu map "Menu for Projectile" '("Projectile" :visible projectile-show-menu ("Find..." ["Find file" projectile-find-file] ["Find file (all, ignoring rules)" projectile-find-file-all] ["Find file in known projects" projectile-find-file-in-known-projects] ["Find file in sibling projects" projectile-find-file-in-sibling-projects] ["Find test file" projectile-find-test-file] ["Find directory" projectile-find-dir] ["Find file in directory" projectile-find-file-in-directory] ["Find file in subproject" projectile-find-file-in-subproject] ["Find changed file" projectile-find-changed-file] ["Find other file" projectile-find-other-file] ["Find file of kind" projectile-find-file-of-kind] ["Jump between implementation file and test file" projectile-toggle-between-implementation-and-test] ["Toggle between related files" projectile-toggle-related-file]) ("Buffers" ["Switch to buffer" projectile-switch-to-buffer] ["Switch to buffer in sibling projects" projectile-switch-to-buffer-in-sibling-projects] ["Kill project buffers" projectile-kill-buffers] ["Save project buffers" projectile-save-project-buffers] ["Recent files" projectile-recentf] ["Previous buffer" projectile-previous-project-buffer] ["Next buffer" projectile-next-project-buffer]) ("Bookmarks" ["Set bookmark" projectile-bookmark-set] ["Jump to bookmark" projectile-bookmark-jump] ["Delete bookmark" projectile-bookmark-delete]) ("Projects" ["Add known project" projectile-add-known-project] ["Add and switch to project" projectile-add-and-switch-project] "--" ["Switch to project" projectile-switch-project] ["Switch to open project" projectile-switch-open-project] ["Switch to sibling project" projectile-switch-sibling-project] ["Switch to worktree" projectile-switch-worktree] "--" ["Discover projects in directory" projectile-discover-projects-in-directory] ["Discover projects in search path" projectile-discover-projects-in-search-path] ["Clear known projects" projectile-clear-known-projects] ["Reset known projects" projectile-reset-known-projects] "--" ["Open project in dired" projectile-dired] "--" "--" ["Cache current file" projectile-cache-current-file] ["Invalidate cache" projectile-invalidate-cache] ["Invalidate all project caches" projectile-invalidate-cache-all] ["Discard project root cache" projectile-discard-root-cache] "--" ["Toggle project wide read-only" projectile-toggle-project-read-only] ["Edit .dir-locals.el" projectile-edit-dir-locals] ["Project info" projectile-project-info] ["Project dashboard" projectile-dashboard] ["Project diagnostics (doctor)" projectile-doctor]) ("Search" ["Search (default backend)" projectile-search] ["Search with grep" projectile-grep] ["Search with ripgrep" projectile-ripgrep] ["Search with ag" projectile-ag] ["Search in sibling projects" projectile-search-in-sibling-projects] ["TODOs in sibling projects" projectile-todos-in-sibling-projects] ["Multi-occur in sibling projects" projectile-multi-occur-in-sibling-projects] ["Project TODOs (review)" projectile-todos] ["Replace in project" projectile-replace] ["Replace in project (review)" projectile-replace-review] ["Replace regexp in project (review)" projectile-replace-regexp-review] ["Undo last project-wide replace" projectile-replace-undo :enable projectile-replace--last-apply] ["Multi-occur in project" projectile-multi-occur] ["Find references in project" projectile-find-references]) ("Run..." ["Run (default backend)" projectile-run] "--" ["Run shell" projectile-run-shell] ["Run eshell" projectile-run-eshell] ["Run ielm" projectile-run-ielm] ["Run term" projectile-run-term] ["Run vterm" projectile-run-vterm] ["Run eat" projectile-run-eat] ["Run ghostel" projectile-run-ghostel] "--" ["Run GDB" projectile-run-gdb]) ("Build" ["Configure project" projectile-configure-project] ["Compile project" projectile-compile-project] ["Test project" projectile-test-project] ["Run test at point" projectile-run-test-at-point] ["Install project" projectile-install-project] ["Package project" projectile-package-project] ["Run project" projectile-run-project] "--" ["Run task" projectile-run-task] ["Repeat last task" projectile-repeat-last-task] "--" ["Configure subproject" projectile-configure-subproject] ["Compile subproject" projectile-compile-subproject] ["Test subproject" projectile-test-subproject] ["Install subproject" projectile-install-subproject] ["Package subproject" projectile-package-subproject] ["Run subproject" projectile-run-subproject] "--" ["Repeat last build command" projectile-repeat-last-command]) ("Session" ["Save session" projectile-session-save] ["Save all sessions" projectile-session-save-all] ["Restore session" projectile-session-restore] ["Restore all sessions" projectile-session-restore-all] ["Forget session" projectile-session-forget] "--" ["Switch to project buffer" projectile-session-switch-to-buffer]) "--" ["About" projectile-version])) map) "Keymap for Projectile mode.") (defun projectile-find-file-hook-function () "Called by `find-file-hook' when `projectile-mode' is on. For remote (TRAMP) buffers the slow operations are skipped: the mode-line update probes many project-type markers on cold cache. The cheap operations - caching the visited file, registering the project as a known project, and the open-buffer-count cap - run regardless of remoteness; they were previously skipped only because the original blanket guard was overly broad." (let ((remote (file-remote-p default-directory)) ;; Resolve the project root once and thread it through the ;; sub-hooks, so a single `find-file' doesn't repeat the lookup. (project-root (projectile-project-p))) (projectile-maybe-limit-project-file-buffers project-root) (when projectile-auto-update-cache (projectile-cache-files-find-file-hook project-root)) (projectile-track-known-projects-find-file-hook project-root) (projectile--maybe-run-project-changed-functions project-root) (projectile--frecency-record project-root) (unless remote (when projectile-dynamic-mode-line (projectile-update-mode-line))))) (defun projectile-maybe-limit-project-file-buffers (&optional project-root) "Limit the opened file buffers for a project. The function simply kills the last buffer, as it's normally called when opening new files. PROJECT-ROOT defaults to the current project." (when projectile-max-file-buffer-count (let ((project-buffers (projectile-project-buffer-files project-root))) (when (length> project-buffers projectile-max-file-buffer-count) (kill-buffer (car (last project-buffers))))))) ;;;; project.el integration ;; ;; Projectile will become the default provider for ;; project.el project and project files lookup when ;; projectile-mode is enabled. ;; ;; The integration can also be manually enabled like this: ;; ;; (add-hook 'project-find-functions #'project-projectile) ;; ;; See https://github.com/bbatsov/projectile/issues/1591 for ;; more details. ;; it's safe to require this directly, as it was added in Emacs 25.1 (require 'project) ;; Only define an override for project-root if the method exists. For versions ;; before emacs 28, project.el provided project-roots instead of project-root. (if (fboundp 'project-root) (cl-defmethod project-root ((project (head projectile))) (cdr project))) (cl-defmethod project-files ((project (head projectile)) &optional _dirs) (let ((root (project-root project))) ;; Make paths absolute and ignore the optional dirs argument, ;; see https://github.com/bbatsov/projectile/issues/1591#issuecomment-896423965 ;; That's needed because Projectile uses relative paths for project files ;; and project.el expects them to be absolute. ;; ;; Measured rather than feared: this is 4 ms for 50k files and 20 ms for ;; 200k, a rounding error next to the listing it is prepending to. ;; `expand-file-name' would be the obvious alternative and is 18 times ;; slower, since it consults the filesystem's notion of the default ;; directory; the paths here are already absolute once the root is on ;; the front, so `concat' is both correct and the cheap option. (mapcar (lambda (f) (concat root f)) (projectile-project-files root)))) (cl-defmethod project-name ((project (head projectile))) (projectile-project-name (cdr project))) (cl-defmethod project-buffers ((project (head projectile))) (projectile-project-buffers (cdr project))) (cl-defmethod project-ignores ((project (head projectile)) _dir) "Return a list of glob patterns to ignore in PROJECT. The patterns are Projectile's own ignore patterns (see `projectile--ignore-patterns'), converted to the format project.el expects (see `project-ignores'): a pattern anchored at the project root is spelled with a leading `./' there, the rest match at any depth." ;; PROJECT is Projectile's own `(projectile . root)' representation, so read ;; the root straight from the cdr rather than going through `project-root'. (mapcar #'projectile--project-el-ignore-glob (projectile--project-ignore-globs (cdr project)))) ;;;###autoload (defun project-projectile (dir) "Return Projectile project of form ('projectile . root-dir) for DIR." (let ((root (projectile-project-root dir))) (when root (cons 'projectile root)))) ;;;###autoload (define-minor-mode projectile-mode "Minor mode to assist project management and navigation. When called interactively, toggle `projectile-mode'. With prefix ARG, enable `projectile-mode' if ARG is positive, otherwise disable it. When called from Lisp, enable `projectile-mode' if ARG is omitted, nil or positive. If ARG is `toggle', toggle `projectile-mode'. Otherwise behave as if called interactively. \\{projectile-mode-map}" :lighter projectile--mode-line :keymap projectile-mode-map :group 'projectile :require 'projectile :global t (cond (projectile-mode (add-hook 'project-find-functions #'project-projectile) (add-hook 'find-file-hook 'projectile-find-file-hook-function) (add-hook 'projectile-find-dir-hook #'projectile-track-known-projects-find-file-hook t) (add-hook 'dired-before-readin-hook #'projectile-track-known-projects-find-file-hook t) (add-hook 'dired-before-readin-hook #'projectile--maybe-run-project-changed-functions t) (add-hook 'kill-emacs-hook #'projectile--frecency-save) (when projectile-dynamic-mode-line (add-hook 'window-configuration-change-hook #'projectile-update-mode-line-on-window-change)) (add-hook 'kill-emacs-hook #'projectile--teardown-all-watches) ;; Disabling the mode tears the watches down, so re-enabling it has to ;; re-arm them - a warm cache would otherwise never trigger a cache fill. (projectile--watch-all-cached-projects) (advice-add 'compilation-find-file :around #'compilation-find-file-projectile-find-compilation-buffer) (advice-add 'delete-file :before #'delete-file-projectile-remove-from-cache)) (t (remove-hook 'project-find-functions #'project-projectile) (remove-hook 'find-file-hook #'projectile-find-file-hook-function) (remove-hook 'projectile-find-dir-hook #'projectile-track-known-projects-find-file-hook) (remove-hook 'dired-before-readin-hook #'projectile-track-known-projects-find-file-hook) (remove-hook 'dired-before-readin-hook #'projectile--maybe-run-project-changed-functions) (projectile--frecency-save) (remove-hook 'kill-emacs-hook #'projectile--frecency-save) (remove-hook 'window-configuration-change-hook #'projectile-update-mode-line-on-window-change) (remove-hook 'kill-emacs-hook #'projectile--teardown-all-watches) (projectile--teardown-all-watches) ;; Forget the last-seen project so re-enabling the mode fires ;; `projectile-project-changed-functions' on the first re-entry. (setq projectile--current-project nil) (advice-remove 'compilation-find-file #'compilation-find-file-projectile-find-compilation-buffer) (advice-remove 'delete-file #'delete-file-projectile-remove-from-cache)))) ;;; savehist-mode - When `savehist-mode' is t, projectile-project-command-history will be saved. ;; See https://github.com/bbatsov/projectile/issues/1637 for more details (defvar savehist-additional-variables nil) (defun projectile--register-savehist-variables () "Add Projectile's persistable history variables to savehist." (add-to-list 'savehist-additional-variables 'projectile-project-command-history) ;; So `projectile-repeat-last-task' survives restarts, like ;; `projectile-repeat-last-command' does via the command history. (add-to-list 'savehist-additional-variables 'projectile-last-task-map)) (if (bound-and-true-p savehist-loaded) (projectile--register-savehist-variables) (add-hook 'savehist-mode-hook #'projectile--register-savehist-variables)) ;;; Per-project sessions ;; ;; `projectile-session-mode' gives every project its own `tab-bar' tab. ;; Each project tab is a native tab-bar tab, so it keeps its own window ;; layout for free, and is bound to a project by stamping the project ;; root onto a tab parameter (`projectile-root'). Switching to a project ;; selects its existing tab (restoring that project's layout) when one is ;; open, or otherwise opens a fresh, project-named tab and populates it. ;; ;; This milestone only deals with live, in-session tabs; persisting the ;; tabs to disk and restoring them across restarts is planned for a ;; follow-up, hence the deliberately storage-neutral naming. ;; `tab-bar' is built in since Emacs 27.1, comfortably below Projectile's ;; floor, so it's always available. (require 'tab-bar) (defcustom projectile-session-default-action 'projectile-find-file "Action used to populate a project's freshly created tab. Called with no arguments by `projectile-session-switch-project-action' when a project is switched to for the first time (and thus gets a new tab). Any command that takes no arguments will do." :group 'projectile :type 'function :package-version '(projectile . "3.2.0")) (defcustom projectile-session-tab-name-function 'projectile-session-default-tab-name "Function computing the tab name for a project. It is called with the project root and must return a string. The default, `projectile-session-default-tab-name', names the tab after the project and disambiguates same-named projects with a parent-directory component." :group 'projectile :type 'function :package-version '(projectile . "3.2.0")) (defcustom projectile-session-directory (locate-user-emacs-file "projectile-sessions/") "Directory under which per-project session files are stored. Each project's saved layout and buffers live in a single file here, named after the project (see `projectile-session--file')." :group 'projectile :type 'directory :package-version '(projectile . "3.4.0")) (defcustom projectile-session-restore-on-switch t "Whether switching to a project restores its saved session. When non-nil and the project being switched to has no open tab but does have a session saved on disk, `projectile-session-switch-project-action' restores that session (recreating its buffers and layout) instead of running `projectile-session-default-action'." :group 'projectile :type 'boolean :package-version '(projectile . "3.2.0")) (defcustom projectile-session-restore-on-startup nil "Whether to reopen every saved project session when Emacs starts. When non-nil and `projectile-session-mode' is enabled, a handler added to `emacs-startup-hook' runs `projectile-session-restore-all' once, reopening each saved project into its own tab after your init files have finished loading. Because that hook is installed on mode enable and `emacs-startup-hook' fires only once, right after startup, enabling the mode *after* Emacs has finished starting never triggers a restore." :group 'projectile :type 'boolean :package-version '(projectile . "3.2.0")) (defcustom projectile-session-autosave nil "Whether `projectile-session-mode' saves sessions automatically. When non-nil, the outgoing project's session is saved when you switch away from it, and every open project's session is saved when Emacs exits. Degenerate layouts with no serializable buffer are skipped." :group 'projectile :type 'boolean :package-version '(projectile . "3.2.0")) (defcustom projectile-session-buffer-serializers '((dired-mode . (projectile-session--serialize-dired . projectile-session--deserialize-dired)) (t . (projectile-session--serialize-file . projectile-session--deserialize-file))) "How buffers are turned into readable records and back. An alist whose entries have the shape (KEY SERIALIZE . DESERIALIZE), i.e. KEY mapped to a (SERIALIZE . DESERIALIZE) pair: KEY selects which buffers an entry handles. It is one of: - a major-mode symbol - matches buffers whose mode is (derived from) it; - the symbol t - matches any buffer visiting a file (keep it last, so mode-specific handlers win); - a predicate function of one argument (the buffer). SERIALIZE is called with the buffer current and returns a readable record \(any `read'-able sexp), or nil to decline the buffer. DESERIALIZE is called with such a record and must recreate and return the live buffer, or nil when it cannot (e.g. the file is gone), in which case the buffer's window is dropped on restore rather than erroring. The first entry whose KEY matches and whose SERIALIZE returns non-nil wins. Buffers no entry handles are skipped, not saved. Handlers keyed by a major-mode symbol or by t round-trip cleanly: restore dispatches on that key. A record produced by a predicate-keyed handler is stored under the buffer's major mode and, on restore, is handled by the first predicate-keyed entry that has a DESERIALIZE; so if you register several predicate handlers, give them distinct major-mode keys instead when they must restore differently. To persist e.g. Magit or eshell buffers, add an entry keyed by their major mode, for instance: (add-to-list \\='projectile-session-buffer-serializers \\='(magit-status-mode . (my-serialize-magit . my-deserialize-magit)))" :group 'projectile :type '(alist :key-type sexp :value-type sexp) :package-version '(projectile . "3.2.0")) (defconst projectile-session--format-version 1 "Format version stamped into session files written on disk. Session files whose version does not match are ignored on restore.") (defvar projectile-session--saved-switch-action nil "The `projectile-switch-project-action' saved when the mode was enabled. Restored when `projectile-session-mode' is disabled.") (defvar projectile-session--closing-tab nil "A project tab currently being closed, or nil. Bound while re-simplifying survivor names from `projectile-session--on-tab-close' (the pre-close hook, where the closing tab is still present in the tab list) so `projectile-session--project-tabs' omits it and its name no longer counts as a clash.") (declare-function dired-noselect "dired") (defun projectile-session--current-tab () "Return the current tab of the selected frame." (assq 'current-tab (tab-bar-tabs))) (defun projectile-session--tab-root (tab) "Return the project root stamped on TAB, or nil when it holds no project." (alist-get 'projectile-root (cdr tab))) (defun projectile-session--set-tab-root (tab root) "Stamp TAB with project ROOT." (setf (alist-get 'projectile-root (cdr tab)) root)) (defun projectile-session--set-tab-name (tab name) "Give TAB the explicit NAME. `explicit-name' is set so `tab-bar' doesn't overwrite NAME with its own automatic naming. NAME is also recorded in the `projectile-auto-name' tab parameter so `projectile-session--refresh-tab-names' can tell a name Projectile assigned from one the user set with `tab-bar-rename-tab'." (setf (alist-get 'name (cdr tab)) name) (setf (alist-get 'explicit-name (cdr tab)) t) (setf (alist-get 'projectile-auto-name (cdr tab)) name)) (defun projectile-session--same-root-p (a b) "Return non-nil when project roots A and B denote the same directory. Identical paths match directly. Otherwise local paths are compared with `file-equal-p' (so symlinks and abbreviations still match); remote paths never reach `file-equal-p', so an unconnected host doesn't trigger a TRAMP round-trip." (and a b (let ((a (file-name-as-directory a)) (b (file-name-as-directory b))) (or (string-equal a b) (and (not (or (file-remote-p a) (file-remote-p b))) (file-equal-p a b)))))) (defun projectile-session--project-tabs () "Return the open tabs that are bound to a project. The tab held in `projectile-session--closing-tab' (one being closed) is omitted, so survivor names recomputed from the pre-close hook don't still treat the closing tab as an open clash." (seq-filter (lambda (tab) (and (not (eq tab projectile-session--closing-tab)) (projectile-session--tab-root tab))) (tab-bar-tabs))) (defun projectile-session--project-tab (root) "Return the open tab bound to project ROOT, or nil when there is none." (seq-find (lambda (tab) (projectile-session--same-root-p (projectile-session--tab-root tab) root)) (tab-bar-tabs))) (defun projectile-session--project-name (root) "Return the project name for ROOT. Unlike `projectile-project-name', the name is always derived from ROOT via `projectile-project-name-function', so it stays correct while the dynamic `projectile-project-name' is bound during a project switch." (funcall projectile-project-name-function root)) (defun projectile-session--parent-components (root) "Return ROOT's ancestor directory names, nearest parent first." (let ((components (split-string (directory-file-name (expand-file-name root)) "/" t))) ;; drop ROOT's own final component; reverse so the nearest parent leads (reverse (butlast components)))) (defun projectile-session--name-with-parents (root name depth) "Return NAME prefixed with ROOT's DEPTH nearest parent directories. With DEPTH 0 the plain NAME is returned; with DEPTH 1 the immediate parent is prepended (e.g. \"shared/foo\"), and so on, in path order." (let ((prefix (reverse (seq-take (projectile-session--parent-components root) depth)))) (if prefix (concat (string-join prefix "/") "/" name) name))) (defun projectile-session-default-tab-name (root) "Return the tab name for the project rooted at ROOT. Use the project's name, prepending as many parent-directory components as it takes to stay distinct from every other open project tab that shares the name, so same-named checkouts (even ones whose immediate parent also matches) remain distinguishable." (let* ((name (projectile-session--project-name root)) ;; roots of the other open project tabs that share this name; ;; `delq'/`mapcar' rather than `seq-keep', which is Emacs 29.1+ (clashers (delq nil (mapcar (lambda (tab) (let ((other (projectile-session--tab-root tab))) (and (not (projectile-session--same-root-p other root)) (equal (projectile-session--project-name other) name) other))) (projectile-session--project-tabs))))) (if (null clashers) name (let ((max-depth (length (projectile-session--parent-components root))) (depth 1)) (while (and (< depth max-depth) (let ((candidate (projectile-session--name-with-parents root name depth))) (seq-some (lambda (other) (equal candidate (projectile-session--name-with-parents other name depth))) clashers))) (setq depth (1+ depth))) (projectile-session--name-with-parents root name depth))))) (defun projectile-session--refresh-tab-names () "Recompute and apply names for every open project tab. Naming every project tab (not just the newest) lets same-named projects become disambiguated the moment a clash appears. Tabs the user renamed by hand are left alone: a tab is only renamed while its current name still matches the one Projectile last assigned it (its `projectile-auto-name' parameter), which a manual `tab-bar-rename-tab' breaks." (dolist (tab (projectile-session--project-tabs)) (let ((auto (alist-get 'projectile-auto-name (cdr tab))) (current (alist-get 'name (cdr tab)))) (when (or (null auto) (equal auto current)) (projectile-session--set-tab-name tab (funcall projectile-session-tab-name-function (projectile-session--tab-root tab)))))) (force-mode-line-update t)) (defun projectile-session--on-tab-close (tab &optional _last) "Re-simplify survivor tab names after project TAB is closed. Wired onto `tab-bar-tab-pre-close-functions', so a project tab that was disambiguated only because of TAB (e.g. \"work/foo\" beside TAB's \"home/foo\") reverts to its plain name once TAB goes away. That hook fires while TAB is still in the tab list, so TAB is bound as `projectile-session--closing-tab' to exclude it from the recomputation. It is used rather than a post-close hook because Emacs has no post-close tab hook at Projectile's 28.1 floor (`tab-bar-tab-pre-close-functions' dates to 27.1; `tab-bar-tab-post-close-functions' does not exist), which keeps this 28.1-safe." (when (projectile-session--tab-root tab) (let ((projectile-session--closing-tab tab)) ;; never let a naming error (e.g. a custom `projectile-session-tab-name-function' ;; that signals) escape this pre-close hook and abort the tab close (ignore-errors (projectile-session--refresh-tab-names))))) (defun projectile-session--make-project-tab (root) "Create and select a fresh tab bound to project ROOT. The new tab is stamped with ROOT and named; populating it is left to the caller." (tab-bar-new-tab) (projectile-session--set-tab-root (projectile-session--current-tab) root) (projectile-session--refresh-tab-names)) (defun projectile-session--current-tab-index () "Return the 1-based index of the selected frame's current tab." (1+ (or (cl-position 'current-tab (tab-bar-tabs) :key #'car :test #'eq) 0))) (defun projectile-session--select-tab-by-root (root) "Select the open project tab bound to ROOT, if any. Returns non-nil when a tab was selected. Resolves the tab to a 1-based index in a single pass and selects by index, so it is robust to `tab-bar-select-tab' rebuilding tab cons cells as it switches away from the current tab (a captured cons would go stale mid-loop)." (let ((index 0) (target nil)) (dolist (tab (tab-bar-tabs)) (setq index (1+ index)) (when (and (not target) (projectile-session--same-root-p (projectile-session--tab-root tab) root)) (setq target index))) (when target (tab-bar-select-tab target) t))) (defun projectile-session--select-tab (tab) "Select TAB, restoring the project layout it holds. Selection goes through the tab's project root, so it stays correct even after other tabs' cons cells have been rebuilt." (let ((root (projectile-session--tab-root tab))) (when root (projectile-session--select-tab-by-root root)))) (defun projectile-session--adopt-current-tab () "Bind the current tab to the current project, when there is one. Called on mode enable so the tab you're already sitting on is adopted rather than left unowned." (when-let* ((root (projectile-project-root)) (tab (projectile-session--current-tab))) (unless (projectile-session--tab-root tab) (projectile-session--set-tab-root tab root) (projectile-session--refresh-tab-names)))) (defun projectile-session-switch-project-action () "Tab-aware switch action installed by `projectile-session-mode'. When the target project already has a tab, select it and restore its live window layout instead of re-running the switch action. Otherwise create a new tab for the project and either restore its saved session (see `projectile-session-restore-on-switch') or populate it by calling `projectile-session-default-action'." (let* ((root (projectile-project-root)) (tab (and root (projectile-session--project-tab root)))) (cond (tab (projectile-session--select-tab tab)) (root (projectile-session--make-project-tab root) ;; Bind `default-directory' so the populate action lists the new ;; project regardless of what buffer `tab-bar-new-tab' left current ;; (e.g. a non-default `tab-bar-new-tab-choice'). (let ((default-directory root)) (unless (and projectile-session-restore-on-switch (projectile-session--saved-p root) (projectile-session-restore root)) (funcall projectile-session-default-action)))) (t (funcall projectile-session-default-action))))) ;;;###autoload (defun projectile-session-switch-to-buffer () "Switch to a buffer belonging to the current tab's project. Complete over just the buffers of the project bound to the current tab. When the current tab holds no project, fall back to the plain `switch-to-buffer'." (interactive) (let ((root (projectile-session--tab-root (projectile-session--current-tab)))) (if root (switch-to-buffer (projectile-completing-read "Switch to project buffer: " (mapcar #'buffer-name (projectile-project-buffers root)))) (call-interactively #'switch-to-buffer)))) ;;; Session persistence ;; ;; A project's live layout is a native tab, but tabs don't survive an Emacs ;; restart. To persist one we write a small readable sexp per project: the ;; window layout as `window-state-get' with the WRITABLE flag (so it stays a ;; plain, re-readable sexp) plus a manifest of the buffers it shows, each ;; turned into a record by `projectile-session-buffer-serializers'. Restoring ;; recreates the buffers first (window-state only references them by name and ;; won't recreate them) and then puts the layout back, replacing any buffer it ;; couldn't recreate with a placeholder so the restore never errors. (defun projectile-session--buffer-matches-p (key buffer) "Return non-nil when serializer KEY applies to BUFFER. KEY is a major-mode symbol, the symbol t (any file-visiting buffer), or a predicate function of one argument." (cond ((eq key t) (and (buffer-file-name buffer) t)) ((symbolp key) (with-current-buffer buffer (derived-mode-p key))) (t (funcall key buffer)))) (defun projectile-session--buffer-kind (key buffer) "Return the symbol under which BUFFER's record is stored for serializer KEY. A symbol KEY (a mode or t) is its own kind and restore dispatches on it; a predicate KEY falls back to BUFFER's major mode." (if (symbolp key) key (buffer-local-value 'major-mode buffer))) (defun projectile-session--readable-p (object) "Return non-nil when OBJECT survives a `prin1'/`read' round-trip. Guards against a custom serializer returning a record that embeds a live object (buffer, marker, window) which can't be read back. Binds `print-circle' so shared or circular structure prints, and reads, finitely rather than hanging." (ignore-errors (let ((print-circle t)) (read (prin1-to-string object)) t))) (defun projectile-session--serialize-buffer (buffer) "Serialize BUFFER via the first matching entry of the serializer registry. Return a cons (KIND . RECORD), or nil when no entry handles BUFFER. Each registry entry is tried in isolation: a matcher or serializer that errors, or that yields a non-readable record, is skipped rather than aborting the whole session save." (catch 'done (dolist (entry projectile-session-buffer-serializers) (ignore-errors (let ((key (car entry)) (serialize (cadr entry))) (when (projectile-session--buffer-matches-p key buffer) (let ((record (with-current-buffer buffer (funcall serialize buffer)))) (when (and record (projectile-session--readable-p record)) (throw 'done (cons (projectile-session--buffer-kind key buffer) record)))))))) nil)) (defun projectile-session--deserializer (kind) "Return the deserialize function able to restore a record of KIND. Prefer an entry whose key is exactly KIND (a mode symbol or t). Records produced by a predicate-keyed serializer are stored under the buffer's major mode, which no `assq' can match, so fall back to the first predicate-keyed entry that carries a deserializer." (let ((exact (assq kind projectile-session-buffer-serializers))) (if exact (cddr exact) (catch 'found (dolist (entry projectile-session-buffer-serializers) (when (and (functionp (car entry)) (cddr entry)) (throw 'found (cddr entry)))) nil)))) (defun projectile-session--recreate-buffer (saved) "Recreate the buffer described by SAVED, a (KIND . RECORD) cons. Return the live buffer, or nil when no deserializer handles KIND or the deserializer declines (e.g. the underlying file is gone)." (let ((deserialize (projectile-session--deserializer (car saved)))) (when deserialize (funcall deserialize (cdr saved))))) (defun projectile-session--serialize-file (buffer) "Serialize file-visiting BUFFER as a (:file PATH :point N) record." (when (buffer-file-name buffer) (list :file (buffer-file-name buffer) :point (point)))) (defun projectile-session--deserialize-file (record) "Recreate the file buffer described by RECORD, or nil when the file is gone. The file is visited non-interactively - large-file warnings and unsafe file-local-variable prompts are suppressed - so restoring a session (in particular on startup) never blocks Emacs on a `yes-or-no-p'." (let ((file (plist-get record :file))) (when (and file (file-exists-p file)) (let* ((large-file-warning-threshold nil) (enable-local-variables :safe) (buffer (find-file-noselect file))) (when (buffer-live-p buffer) (let ((point (plist-get record :point))) (when (integerp point) (with-current-buffer buffer (goto-char (min point (point-max)))))) buffer))))) (defun projectile-session--serialize-dired (buffer) "Serialize dired BUFFER as a (:dir DIRECTORY) record." (with-current-buffer buffer (when (derived-mode-p 'dired-mode) (list :dir (expand-file-name default-directory))))) (defun projectile-session--deserialize-dired (record) "Recreate the dired buffer described by RECORD, or nil when it's gone." (let ((dir (plist-get record :dir))) (when (and dir (file-directory-p dir)) (dired-noselect dir)))) (defun projectile-session--placeholder-buffer () "Return a live placeholder buffer for windows whose buffer is missing." (get-buffer-create " *projectile-session-placeholder*")) (defun projectile-session--sanitize-window-state (state) "Return a copy of window STATE with missing buffers replaced. Any window referencing a buffer that isn't live is pointed at a placeholder buffer instead, so `window-state-put' can't error out. This is the Emacs 28 substitute for `window-restore-killed-buffer-windows' \(added in Emacs 30)." (cond ((and (consp state) (eq (car state) 'buffer) (stringp (cadr state)) (not (get-buffer (cadr state)))) (cons 'buffer (cons (buffer-name (projectile-session--placeholder-buffer)) (cddr state)))) ((consp state) (cons (projectile-session--sanitize-window-state (car state)) (projectile-session--sanitize-window-state (cdr state)))) (t state))) (defun projectile-session--file (root) "Return the absolute session file name for project ROOT. The name pairs a readable, filesystem-safe project name with a hash of ROOT's canonical path, so distinct roots never collide and the same root maps to the same file across restarts." (let* ((canonical (directory-file-name ;; Canonicalize with `file-truename' so a symlinked root ;; and its target map to the same file, matching M1's ;; `projectile-session--same-root-p'. Skip it for remote ;; roots to avoid a TRAMP round-trip. (if (file-remote-p root) (expand-file-name root) (file-truename root)))) (name (projectile-session--project-name root)) (safe (replace-regexp-in-string "[^A-Za-z0-9_.-]" "_" (or name "project"))) (hash (md5 canonical))) (expand-file-name (concat safe "-" hash ".eld") projectile-session-directory))) (defun projectile-session--saved-p (root) "Return non-nil when project ROOT has a session saved on disk." (file-exists-p (projectile-session--file root))) (defun projectile-session--write (root data) "Write session DATA for project ROOT, creating the session directory. Return non-nil only when the file was actually written, so callers don't report success for an unwritable session directory. Binds `print-circle' so shared or circular structure in a record can't hang the write." (let ((file (projectile-session--file root))) (ignore-errors (make-directory (file-name-directory file) t)) (and (file-writable-p file) (progn (let ((print-circle t)) (projectile-serialize data file)) (file-exists-p file))))) (defun projectile-session--read-file (file) "Read and return the session data stored in FILE, or nil. Data that isn't a well-formed session plist of the current version is ignored, so an unreadable or stale file is skipped rather than erroring. A real session file written by an incompatible format version is skipped with a message, so the user learns why nothing was restored." (let ((data (projectile-unserialize file))) (cond ((and (consp data) (equal (plist-get data :projectile-session-version) projectile-session--format-version) data)) ((and (consp data) (plist-member data :projectile-session-version)) ;; `projectile-session-restore-all' can walk a directory full of these ;; at startup, so this is exactly the kind of thing that shouldn't ;; announce itself once per file. (projectile--message "Ignoring session file %s: format version %s (expected %s)" file (plist-get data :projectile-session-version) projectile-session--format-version) nil)))) (defun projectile-session--read (root) "Read and return project ROOT's session data, or nil. Data whose format version doesn't match is ignored." (projectile-session--read-file (projectile-session--file root))) (defun projectile-session--saved-roots () "Return the roots of every project with a session saved on disk. Scan `projectile-session-directory' for session files, read each (skipping any that is unreadable or of a mismatched version, via `projectile-session--read-file'), and collect the `:root' it stores. The result is sorted so `projectile-session-restore-all' reopens tabs in a stable order across calls and restarts." (let ((dir projectile-session-directory) (roots '())) (when (file-directory-p dir) (dolist (file (directory-files dir t "\\.eld\\'")) (let ((data (ignore-errors (projectile-session--read-file file)))) ;; require a string root: a corrupt/hand-edited file with a ;; non-string `:root' would otherwise crash the `sort' below and ;; (via the startup handler's guard) silently disable all restore (when-let* ((root (plist-get data :root)) ((stringp root))) (push root roots))))) (sort roots #'string-lessp))) (defun projectile-session--frame-buffers () "Return the distinct buffers shown in the selected frame's windows." (delete-dups (mapcar #'window-buffer (window-list nil 'nomini)))) ;;;###autoload (defun projectile-session-save (&optional project) "Save the current window layout and buffers as PROJECT's session. PROJECT defaults to the current project's root. The layout is captured from the selected frame, so this saves whichever project's tab is current. Buffers are recorded via `projectile-session-buffer-serializers'; a layout with no serializable buffer is not saved. Return non-nil on a successful save." (interactive) (let ((root (or project (projectile-project-root)))) (unless root (user-error "Not in a project")) (let* ((buffers (projectile-session--frame-buffers)) (records (delq nil (mapcar #'projectile-session--serialize-buffer buffers)))) (cond ((null records) (when (called-interactively-p 'any) (message "No serializable buffers to save for %s" root)) nil) ((projectile-session--write root (list :projectile-session-version projectile-session--format-version :root root :buffers records :window-state (window-state-get (frame-root-window) t))) (when (called-interactively-p 'any) (message "Saved session for %s" root)) t) (t (when (called-interactively-p 'any) (message "Could not write session for %s" root)) nil))))) ;;;###autoload (defun projectile-session-restore (&optional project) "Restore PROJECT's saved session into the selected frame. PROJECT defaults to the current project's root. Buffers are recreated first, then the saved window layout is put back; windows whose buffer can't be recreated fall back to a placeholder. Return non-nil when a session was restored." (interactive) (let* ((root (or project (projectile-project-root))) (data (and root (projectile-session--read root)))) (cond (data (let ((recreated nil)) (dolist (saved (plist-get data :buffers)) (when (ignore-errors (buffer-live-p (projectile-session--recreate-buffer saved))) (setq recreated t))) (cond (recreated (let ((state (plist-get data :window-state))) (when state ;; A hand-edited or corrupt :window-state that still passes the ;; version check shouldn't abort the whole restore - fall through ;; to the recreated buffers instead, matching the buffer-recreation ;; guard above and the file-read robustness elsewhere here. (condition-case err (window-state-put (projectile-session--sanitize-window-state state) (frame-root-window) 'safe) (error (message "projectile-session: could not restore window layout: %S" err))))) t) ;; Nothing could be recreated (every saved file is gone, say); ;; return nil so `restore-on-switch' falls back to populating the ;; tab instead of leaving the user in an all-placeholder frame. (t (when (called-interactively-p 'any) (message "No buffers could be restored for %s" (or root "current project"))) nil)))) ((called-interactively-p 'any) (user-error "No saved session for %s" (or root "current project")))))) ;;;###autoload (defun projectile-session-forget (&optional project) "Delete PROJECT's saved session file. PROJECT defaults to the current project's root." (interactive) (let ((root (or project (projectile-project-root)))) (unless root (user-error "Not in a project")) (let ((file (projectile-session--file root))) (when (file-exists-p file) (delete-file file) (when (called-interactively-p 'any) (message "Forgot session for %s" root)))))) (defun projectile-session--maybe-autosave () "Save the current project's session when autosave is enabled. Wired onto `projectile-before-switch-project-hook', where the current project is still the one being switched away from." (when projectile-session-autosave (ignore-errors (projectile-session-save)))) (defun projectile-session--save-all-tabs () "Save the session of every open project tab, selecting each in turn. Each project tab is selected so its own window layout is what gets saved, then the originally-selected tab is restored. Tabs are re-resolved by root on each iteration rather than by a cons captured up front, because `tab-bar-select-tab' rebuilds cons cells as it switches tabs (a stale cons would save the wrong layout under a project's root). The per-tab body is guarded so a tab that can't be selected or saved (its root gone, say) neither abandons the remaining projects nor lets an error escape (this also matters on `kill-emacs-hook'). Return the number of tabs whose session was actually written." (let ((origin (projectile-session--current-tab-index)) (roots (delq nil (mapcar #'projectile-session--tab-root (projectile-session--project-tabs)))) (saved 0)) (dolist (root roots) (ignore-errors (when (and (projectile-session--select-tab-by-root root) (projectile-session-save root)) (setq saved (1+ saved))))) (ignore-errors (tab-bar-select-tab origin)) saved)) ;;;###autoload (defun projectile-session-save-all () "Save the session of every open project in one go. Every open project tab's window layout and buffers are saved (see `projectile-session-save'); a tab whose layout has no serializable buffer is skipped. Unlike autosave, this runs regardless of `projectile-session-autosave'. When called interactively, report how many sessions were saved." (interactive) ;; `--save-all-tabs' selects each project tab in turn and restores the ;; originally-selected one afterwards. (let ((saved (projectile-session--save-all-tabs))) (when (called-interactively-p 'any) (message "Saved %d project session%s" saved (if (= saved 1) "" "s"))) saved)) ;;;###autoload (defun projectile-session-restore-all () "Reopen every saved project's session into its own tab. For each project with a session saved on disk (see `projectile-session--saved-roots'): when a tab for it is already open, leave it be rather than duplicating it; otherwise create a fresh project tab and restore the saved session into it. A session whose files are all gone recreates nothing, so its just-created empty tab is closed again and it is not counted, keeping restore-all from littering the frame with empty tabs. Tabs are re-resolved by root, never by a cons captured before a selection, since `tab-bar-select-tab' rebuilds cons cells as it switches. End on the first successfully restored project's tab (falling back to the starting tab when nothing was restored) rather than wherever the iteration left off. When called interactively, report how many sessions were restored. Return that count." (interactive) (let ((origin (projectile-session--current-tab-index)) (first-root nil) (restored 0)) (dolist (root (projectile-session--saved-roots)) (unless (projectile-session--project-tab root) (projectile-session--make-project-tab root) (if (ignore-errors (projectile-session-restore root)) (progn (setq restored (1+ restored)) (unless first-root (setq first-root root))) ;; nothing recreated (the project's files are gone): drop the ;; empty tab `--make-project-tab' just created and selected (ignore-errors (tab-bar-close-tab))))) ;; Land the user somewhere deterministic. When we restored something, ;; go to the first restored project; otherwise return to where we ;; started (any tabs we made for stale sessions were closed again, so ;; the starting index still points at the same tab). (if first-root (projectile-session--select-tab-by-root first-root) (ignore-errors (tab-bar-select-tab origin))) (when (called-interactively-p 'any) (message "Restored %d project session%s" restored (if (= restored 1) "" "s"))) restored)) (defun projectile-session--autosave-on-kill () "Save every open project's session when autosave is enabled. Wired onto `kill-emacs-hook'; the frame is going away, so the tab left selected by `projectile-session--save-all-tabs' does not matter." (when projectile-session-autosave (projectile-session--save-all-tabs))) (defun projectile-session--maybe-restore-on-startup () "Reopen all saved sessions at startup when configured to. Wired onto `emacs-startup-hook' while `projectile-session-mode' is on; the restore is gated on `projectile-session-restore-on-startup'. Errors are swallowed so a restore problem can't abort the rest of Emacs startup." (when projectile-session-restore-on-startup (ignore-errors (projectile-session-restore-all)))) ;;;###autoload (define-minor-mode projectile-session-mode "Global minor mode giving each project its own `tab-bar' tab. When enabled, `tab-bar-mode' is turned on and project switching becomes tab-aware: switching to a project selects its existing tab, restoring that project's live window layout, when one is open; otherwise it opens a fresh tab dedicated to the project and populates it via `projectile-session-default-action'. Each project tab is stamped with its root and named after the project (see `projectile-session-tab-name-function'). If the mode is enabled from inside a project, the tab you're already on is adopted so it isn't left unowned. Disabling the mode restores `projectile-switch-project-action' to the value it had when the mode was enabled; it leaves `tab-bar-mode' and any existing tabs untouched." :group 'projectile :global t :require 'projectile (cond (projectile-session-mode (unless (bound-and-true-p tab-bar-mode) (tab-bar-mode 1)) ;; Guard the save so re-enabling an already-on mode (config re-eval, a ;; startup hook, `custom-set' plus code) can't capture our own action as ;; the "saved" value and lose the user's real one on the next disable. (unless (eq projectile-switch-project-action #'projectile-session-switch-project-action) (setq projectile-session--saved-switch-action projectile-switch-project-action)) (setq projectile-switch-project-action #'projectile-session-switch-project-action) ;; Autosave wiring. `add-hook' is idempotent for an `eq' function, so a ;; double enable can't stack duplicates; the actual saving is gated on ;; `projectile-session-autosave' inside the hook functions. (add-hook 'projectile-before-switch-project-hook #'projectile-session--maybe-autosave) (add-hook 'kill-emacs-hook #'projectile-session--autosave-on-kill) ;; Restore-on-startup wiring. The handler is gated on ;; `projectile-session-restore-on-startup' and `emacs-startup-hook' fires ;; once, right after init, so setting the mode plus the defcustom in init ;; restores after startup; enabling the mode later simply never fires it. ;; `add-hook' is idempotent for an `eq' function, so a double enable can't ;; stack duplicates. (add-hook 'emacs-startup-hook #'projectile-session--maybe-restore-on-startup) ;; Re-simplify a survivor's name when its same-named sibling tab is ;; closed. `add-hook' is idempotent for an `eq' function, so a double ;; enable can't stack duplicates. (add-hook 'tab-bar-tab-pre-close-functions #'projectile-session--on-tab-close) (projectile-session--adopt-current-tab)) (t (when (eq projectile-switch-project-action #'projectile-session-switch-project-action) (setq projectile-switch-project-action projectile-session--saved-switch-action)) (setq projectile-session--saved-switch-action nil) (remove-hook 'projectile-before-switch-project-hook #'projectile-session--maybe-autosave) (remove-hook 'kill-emacs-hook #'projectile-session--autosave-on-kill) (remove-hook 'emacs-startup-hook #'projectile-session--maybe-restore-on-startup) (remove-hook 'tab-bar-tab-pre-close-functions #'projectile-session--on-tab-close)))) ;;; Optional Embark / Marginalia integration ;; ;; Gated behind `with-eval-after-load' so Embark and Marginalia stay soft, ;; opt-in enhancements rather than dependencies. Two Embark wins on top of the ;; completion categories Projectile already advertises: ;; ;; 1. A transformer that expands a `project-file' candidate (which Projectile ;; presents project-relative) to an absolute path against the Projectile ;; root, so Embark's file actions hit the right file regardless of ;; `default-directory'. ;; 2. A `projectile-project' action keymap, so acting on a project candidate ;; offers project operations (switch, vc, dired, remove) instead of only ;; generic file actions. Marginalia keeps annotating those candidates via ;; the built-in file annotator (they are directory paths). ;; ;; The `projectile-worktree' category gets the same Embark actions but is ;; deliberately left out of the Marginalia registry: those candidates carry ;; their own `annotation-function' naming what each worktree has checked ;; out, and a registered annotator would take precedence over it. (defun projectile--embark-project-file-target (target) "Resolve a `project-file' TARGET to an absolute path under the Projectile root. Return (file . ABSOLUTE) only when TARGET actually exists under the current Projectile project root, otherwise nil so the caller can defer to Embark's own `project-file' handling. The existence guard keeps the integration from ever misresolving a `project-file' candidate that is not Projectile's - worst case it does nothing and Embark behaves as before." (when-let* ((root (projectile-project-root)) (full (expand-file-name target root)) ((file-exists-p full))) (cons 'file full))) (defun projectile-embark-switch-project (project) "Switch to PROJECT. An Embark action for a project candidate." (interactive "sProject: ") (projectile-switch-project-by-name project)) (defun projectile-embark-vc (project) "Open the VC interface for PROJECT. An Embark action for a project candidate." (interactive "sProject: ") (projectile-vc project)) (defvar projectile--embark-project-file-prev-transform nil "The `project-file' transformer Embark had before Projectile augmented it. Preserved so `projectile--embark-project-file-transform' can defer to it for candidates that don't belong to the current Projectile project.") (defun projectile--embark-project-file-transform (type target) "Embark `project-file' transformer augmenting Embark's own with Projectile. Resolves TARGET against the Projectile root when it lives there, otherwise defers to the transformer Embark had before (or leaves TYPE/TARGET unchanged), so non-Projectile completions are unaffected." (or (projectile--embark-project-file-target target) (and projectile--embark-project-file-prev-transform (funcall projectile--embark-project-file-prev-transform type target)) (cons type target))) (defvar projectile-embark-project-map (let ((map (make-sparse-keymap))) (define-key map (kbd "s") #'projectile-embark-switch-project) (define-key map (kbd "v") #'projectile-embark-vc) (define-key map (kbd "d") #'dired) (define-key map (kbd "D") #'projectile-remove-known-project) map) "Embark action keymap for Projectile `projectile-project' candidates.") (defvar embark-transformer-alist) (defvar embark-keymap-alist) (defvar embark-general-map) (defun projectile--embark-setup () "Wire Projectile's transformer and action keymap into Embark. Run from a `with-eval-after-load' on Embark, and idempotent so loading Projectile again doesn't stack wrappers." ;; inherit Embark's generic actions (collect, export, ...) (set-keymap-parent projectile-embark-project-map embark-general-map) ;; Augment - never replace - Embark's `project-file' handling. Our ;; transformer only claims a candidate that actually lives under the ;; Projectile root; anything else defers to whatever transformer Embark ;; already had, so non-Projectile `project-file' completions are unaffected. ;; The `eq' guard keeps re-loading Projectile from wrapping our own wrapper. (let ((prev (alist-get 'project-file embark-transformer-alist))) (unless (eq prev #'projectile--embark-project-file-transform) (setq projectile--embark-project-file-prev-transform prev) (setf (alist-get 'project-file embark-transformer-alist) #'projectile--embark-project-file-transform))) (add-to-list 'embark-keymap-alist '(projectile-project . projectile-embark-project-map)) ;; A worktree candidate is a project directory too, so the same actions ;; apply to it. (add-to-list 'embark-keymap-alist '(projectile-worktree . projectile-embark-project-map))) (with-eval-after-load 'embark (projectile--embark-setup)) (defun projectile--marginalia-setup () "Teach Marginalia how to annotate `projectile-project' candidates. They are directory paths, so the built-in file annotator fits and the candidates look exactly like they did under the `file' category. The registry is `marginalia-annotators' these days and was `marginalia-annotator-registry' in older releases, so register with whichever one the installed Marginalia has." (dolist (registry '(marginalia-annotators marginalia-annotator-registry)) (when (boundp registry) (add-to-list registry '(projectile-project marginalia-annotate-file builtin none))))) (with-eval-after-load 'marginalia (projectile--marginalia-setup)) (provide 'projectile) ;;; projectile.el ends here