Personal emacs config
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

5060 lines
211 KiB

  1. ;;; projectile.el --- Manage and navigate projects in Emacs easily -*- lexical-binding: t -*-
  2. ;; Copyright © 2011-2020 Bozhidar Batsov <bozhidar@batsov.com>
  3. ;; Author: Bozhidar Batsov <bozhidar@batsov.com>
  4. ;; URL: https://github.com/bbatsov/projectile
  5. ;; Package-Version: 2.3.0
  6. ;; Package-Commit: 18f694931f0afe8b33e34731914e8bae81107b55
  7. ;; Keywords: project, convenience
  8. ;; Version: 2.3.0
  9. ;; Package-Requires: ((emacs "25.1") (pkg-info "0.4"))
  10. ;; This file is NOT part of GNU Emacs.
  11. ;; This program is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 3, or (at your option)
  14. ;; any later version.
  15. ;;
  16. ;; This program is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19. ;; GNU General Public License for more details.
  20. ;;
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING. If not, write to the
  23. ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24. ;; Boston, MA 02110-1301, USA.
  25. ;;; Commentary:
  26. ;;
  27. ;; This library provides easy project management and navigation. The
  28. ;; concept of a project is pretty basic - just a folder containing
  29. ;; special file. Currently git, mercurial and bazaar repos are
  30. ;; considered projects by default. If you want to mark a folder
  31. ;; manually as a project just create an empty .projectile file in
  32. ;; it. See the README for more details.
  33. ;;
  34. ;;; Code:
  35. (require 'cl-lib)
  36. (require 'thingatpt)
  37. (require 'ibuffer)
  38. (require 'ibuf-ext)
  39. (require 'compile)
  40. (require 'grep)
  41. (eval-when-compile
  42. (require 'find-dired)
  43. (require 'subr-x))
  44. (eval-when-compile
  45. (defvar ido-mode)
  46. (defvar ivy-mode)
  47. (defvar helm-mode)
  48. (defvar ag-ignore-list)
  49. (defvar ggtags-completion-table)
  50. (defvar tags-completion-table)
  51. (defvar tags-loop-scan)
  52. (defvar tags-loop-operate)
  53. (defvar eshell-buffer-name)
  54. (defvar explicit-shell-file-name))
  55. (declare-function tags-completion-table "etags")
  56. (declare-function make-term "term")
  57. (declare-function term-mode "term")
  58. (declare-function term-char-mode "term")
  59. (declare-function term-ansi-make-term "term")
  60. (declare-function eshell-search-path "esh-ext")
  61. (declare-function vc-dir "vc-dir")
  62. (declare-function vc-dir-busy "vc-dir")
  63. (declare-function string-trim "subr-x")
  64. (declare-function fileloop-continue "fileloop")
  65. (declare-function fileloop-initialize-replace "fileloop")
  66. (declare-function tramp-archive-file-name-p "tramp-archive")
  67. (declare-function ggtags-ensure-project "ext:ggtags")
  68. (declare-function ggtags-update-tags "ext:ggtags")
  69. (declare-function pkg-info-version-info "ext:pkg-info")
  70. (declare-function ripgrep-regexp "ext:ripgrep")
  71. (declare-function vterm "ext:vterm")
  72. (declare-function vterm-send-return "ext:vterm")
  73. (declare-function vterm-send-string "ext:vterm")
  74. (defvar grep-files-aliases)
  75. (defvar grep-find-ignored-directories)
  76. (defvar grep-find-ignored-files)
  77. ;;; Customization
  78. (defgroup projectile nil
  79. "Manage and navigate projects easily."
  80. :group 'tools
  81. :group 'convenience
  82. :link '(url-link :tag "GitHub" "https://github.com/bbatsov/projectile")
  83. :link '(url-link :tag "Online Manual" "https://docs.projectile.mx/")
  84. :link '(emacs-commentary-link :tag "Commentary" "projectile"))
  85. (defcustom projectile-indexing-method (if (eq system-type 'windows-nt) 'native 'alien)
  86. "Specifies the indexing method used by Projectile.
  87. There are three indexing methods - native, hybrid and alien.
  88. The native method is implemented in Emacs Lisp (therefore it is
  89. native to Emacs). Its advantage is that it is portable and will
  90. work everywhere that Emacs does. Its disadvantage is that it is a
  91. bit slow (especially for large projects). Generally it's a good
  92. idea to pair the native indexing method with caching.
  93. The hybrid indexing method uses external tools (e.g. git, find,
  94. etc) to speed up the indexing process. Still, the files will be
  95. post-processed by Projectile for sorting/filtering purposes.
  96. In this sense that approach is a hybrid between native indexing
  97. and alien indexing.
  98. The alien indexing method optimizes to the limit the speed
  99. of the hybrid indexing method. This means that Projectile will
  100. not do any processing of the files returned by the external
  101. commands and you're going to get the maximum performance
  102. possible. This behaviour makes a lot of sense for most people,
  103. as they'd typically be putting ignores in their VCS config and
  104. won't care about any additional ignores/unignores/sorting that
  105. Projectile might also provide.
  106. The disadvantage of the hybrid and alien methods is that they are not well
  107. supported on Windows systems. That's why by default alien indexing is the
  108. default on all operating systems, except Windows."
  109. :group 'projectile
  110. :type '(radio
  111. (const :tag "Native" native)
  112. (const :tag "Hybrid" hybrid)
  113. (const :tag "Alien" alien)))
  114. (defcustom projectile-enable-caching (eq projectile-indexing-method 'native)
  115. "When t enables project files caching.
  116. Project caching is automatically enabled by default if you're
  117. using the native indexing method."
  118. :group 'projectile
  119. :type 'boolean)
  120. (defcustom projectile-kill-buffers-filter 'kill-all
  121. "Determine which buffers are killed by `projectile-kill-buffers'.
  122. When the kill-all option is selected, kills each buffer.
  123. When the kill-only-files option is selected, kill only the buffer
  124. associated to a file.
  125. Otherwise, it should be a predicate that takes one argument: the buffer to
  126. be killed."
  127. :group 'projectile
  128. :type '(radio
  129. (const :tag "All project buffers" kill-all)
  130. (const :tag "Project file buffers" kill-only-files)
  131. (function :tag "Predicate")))
  132. (defcustom projectile-file-exists-local-cache-expire nil
  133. "Number of seconds before the local file existence cache expires.
  134. Local refers to a file on a local file system.
  135. A value of nil disables this cache.
  136. See `projectile-file-exists-p' for details."
  137. :group 'projectile
  138. :type '(choice (const :tag "Disabled" nil)
  139. (integer :tag "Seconds")))
  140. (defcustom projectile-file-exists-remote-cache-expire (* 5 60)
  141. "Number of seconds before the remote file existence cache expires.
  142. Remote refers to a file on a remote file system such as tramp.
  143. A value of nil disables this cache.
  144. See `projectile-file-exists-p' for details."
  145. :group 'projectile
  146. :type '(choice (const :tag "Disabled" nil)
  147. (integer :tag "Seconds")))
  148. (defcustom projectile-files-cache-expire nil
  149. "Number of seconds before project files list cache expires.
  150. A value of nil means the cache never expires."
  151. :group 'projectile
  152. :type '(choice (const :tag "Disabled" nil)
  153. (integer :tag "Seconds")))
  154. (defcustom projectile-auto-discover t
  155. "Whether to discover projects when `projectile-mode' is activated."
  156. :group 'projectile
  157. :type 'boolean
  158. :package-version '(projectile . "2.3.0"))
  159. (defcustom projectile-auto-update-cache t
  160. "Whether the cache should automatically be updated when files are opened or deleted."
  161. :group 'projectile
  162. :type 'boolean)
  163. (defcustom projectile-require-project-root 'prompt
  164. "Require the presence of a project root to operate when true.
  165. When set to 'prompt Projectile will ask you to select a project
  166. directory if you're not in a project.
  167. When nil Projectile will consider the current directory the project root."
  168. :group 'projectile
  169. :type '(choice (const :tag "No" nil)
  170. (const :tag "Yes" t)
  171. (const :tag "Prompt for project" prompt)))
  172. (defcustom projectile-completion-system 'auto
  173. "The completion system to be used by Projectile."
  174. :group 'projectile
  175. :type '(radio
  176. (const :tag "Auto-detect" auto)
  177. (const :tag "Ido" ido)
  178. (const :tag "Helm" helm)
  179. (const :tag "Ivy" ivy)
  180. (const :tag "Default" default)
  181. (function :tag "Custom function")))
  182. (defcustom projectile-keymap-prefix nil
  183. "Projectile keymap prefix."
  184. :group 'projectile
  185. :type 'string)
  186. (make-obsolete-variable 'projectile-keymap-prefix "Use (define-key projectile-mode-map (kbd ...) 'projectile-command-map) instead." "2.0.0")
  187. (defcustom projectile-cache-file
  188. (expand-file-name "projectile.cache" user-emacs-directory)
  189. "The name of Projectile's cache file."
  190. :group 'projectile
  191. :type 'string)
  192. (defcustom projectile-tags-file-name "TAGS"
  193. "The tags filename Projectile's going to use."
  194. :group 'projectile
  195. :type 'string)
  196. (defcustom projectile-tags-command "ctags -Re -f \"%s\" %s \"%s\""
  197. "The command Projectile's going to use to generate a TAGS file."
  198. :group 'projectile
  199. :type 'string)
  200. (defcustom projectile-tags-backend 'auto
  201. "The tag backend that Projectile should use.
  202. If set to 'auto', `projectile-find-tag' will automatically choose
  203. which backend to use. Preference order is ggtags -> xref
  204. -> etags-select -> `find-tag'. Variable can also be set to specify which
  205. backend to use. If selected backend is unavailable, fall back to
  206. `find-tag'.
  207. If this variable is set to 'auto' and ggtags is available, or if
  208. set to 'ggtags', then ggtags will be used for
  209. `projectile-regenerate-tags'. For all other settings
  210. `projectile-tags-command' will be used."
  211. :group 'projectile
  212. :type '(radio
  213. (const :tag "auto" auto)
  214. (const :tag "xref" xref)
  215. (const :tag "ggtags" ggtags)
  216. (const :tag "etags" etags-select)
  217. (const :tag "standard" find-tag))
  218. :package-version '(projectile . "0.14.0"))
  219. (defcustom projectile-sort-order 'default
  220. "The sort order used for a project's files.
  221. Note that files aren't sorted if `projectile-indexing-method'
  222. is set to 'alien'."
  223. :group 'projectile
  224. :type '(radio
  225. (const :tag "Default (no sorting)" default)
  226. (const :tag "Recently opened files" recentf)
  227. (const :tag "Recently active buffers, then recently opened files" recently-active)
  228. (const :tag "Access time (atime)" access-time)
  229. (const :tag "Modification time (mtime)" modification-time)))
  230. (defcustom projectile-verbose t
  231. "Echo messages that are not errors."
  232. :group 'projectile
  233. :type 'boolean)
  234. (defcustom projectile-buffers-filter-function nil
  235. "A function used to filter the buffers in `projectile-project-buffers'.
  236. The function should accept and return a list of Emacs buffers.
  237. Two example filter functions are shipped by default -
  238. `projectile-buffers-with-file' and
  239. `projectile-buffers-with-file-or-process'."
  240. :group 'projectile
  241. :type 'function)
  242. (defcustom projectile-project-name nil
  243. "If this value is non-nil, it will be used as project name.
  244. It has precedence over function `projectile-project-name-function'."
  245. :group 'projectile
  246. :type 'string
  247. :package-version '(projectile . "0.14.0"))
  248. (defcustom projectile-project-name-function 'projectile-default-project-name
  249. "A function that receives the project-root and returns the project name.
  250. If variable `projectile-project-name' is non-nil, this function will not be used."
  251. :group 'projectile
  252. :type 'function
  253. :package-version '(projectile . "0.14.0"))
  254. (defcustom projectile-project-root-files
  255. '(
  256. "GTAGS" ; GNU Global tags
  257. "TAGS" ; etags/ctags are usually in the root of project
  258. "configure.ac" ; autoconf new style
  259. "configure.in" ; autoconf old style
  260. "cscope.out" ; cscope
  261. )
  262. "A list of files considered to mark the root of a project.
  263. The topmost match has precedence.
  264. See `projectile-register-project-type'."
  265. :group 'projectile
  266. :type '(repeat string))
  267. (defcustom projectile-project-root-files-bottom-up
  268. '(".projectile" ; projectile project marker
  269. ".git" ; Git VCS root dir
  270. ".hg" ; Mercurial VCS root dir
  271. ".fslckout" ; Fossil VCS root dir
  272. "_FOSSIL_" ; Fossil VCS root DB on Windows
  273. ".bzr" ; Bazaar VCS root dir
  274. "_darcs" ; Darcs VCS root dir
  275. )
  276. "A list of files considered to mark the root of a project.
  277. The bottommost (parentmost) match has precedence."
  278. :group 'projectile
  279. :type '(repeat string))
  280. (defcustom projectile-project-root-files-top-down-recurring
  281. '(".svn" ; Svn VCS root dir
  282. "CVS" ; Csv VCS root dir
  283. "Makefile")
  284. "A list of files considered to mark the root of a project.
  285. The search starts at the top and descends down till a directory
  286. that contains a match file but its parent does not. Thus, it's a
  287. bottommost match in the topmost sequence of directories
  288. containing a root file."
  289. :group 'projectile
  290. :type '(repeat string))
  291. (defcustom projectile-project-root-files-functions
  292. '(projectile-root-local
  293. projectile-root-bottom-up
  294. projectile-root-top-down
  295. projectile-root-top-down-recurring)
  296. "A list of functions for finding project roots."
  297. :group 'projectile
  298. :type '(repeat function))
  299. (defcustom projectile-dirconfig-comment-prefix
  300. nil
  301. "Projectile config file (.projectile) comment start marker.
  302. If specified, starting a line in a project's .projectile file with this
  303. character marks that line as a comment instead of a pattern.
  304. Similar to '#' in .gitignore files."
  305. :group 'projectile
  306. :type 'character
  307. :package-version '(projectile . "2.2.0"))
  308. (defcustom projectile-globally-ignored-files
  309. (list projectile-tags-file-name)
  310. "A list of files globally ignored by projectile."
  311. :group 'projectile
  312. :type '(repeat string))
  313. (defcustom projectile-globally-unignored-files nil
  314. "A list of files globally unignored by projectile.
  315. Regular expressions can be used."
  316. :group 'projectile
  317. :type '(repeat string)
  318. :package-version '(projectile . "0.14.0"))
  319. (defcustom projectile-globally-ignored-file-suffixes
  320. nil
  321. "A list of file suffixes globally ignored by projectile."
  322. :group 'projectile
  323. :type '(repeat string))
  324. (defcustom projectile-globally-ignored-directories
  325. '(".idea"
  326. ".vscode"
  327. ".ensime_cache"
  328. ".eunit"
  329. ".git"
  330. ".hg"
  331. ".fslckout"
  332. "_FOSSIL_"
  333. ".bzr"
  334. "_darcs"
  335. ".tox"
  336. ".svn"
  337. ".stack-work"
  338. ".ccls-cache"
  339. ".cache"
  340. ".clangd")
  341. "A list of directories globally ignored by projectile.
  342. Regular expressions can be used."
  343. :safe (lambda (x) (not (remq t (mapcar #'stringp x))))
  344. :group 'projectile
  345. :type '(repeat string))
  346. (defcustom projectile-globally-unignored-directories nil
  347. "A list of directories globally unignored by projectile."
  348. :group 'projectile
  349. :type '(repeat string)
  350. :package-version '(projectile . "0.14.0"))
  351. (defcustom projectile-globally-ignored-modes
  352. '("erc-mode"
  353. "help-mode"
  354. "completion-list-mode"
  355. "Buffer-menu-mode"
  356. "gnus-.*-mode"
  357. "occur-mode")
  358. "A list of regular expressions for major modes ignored by projectile.
  359. If a buffer is using a given major mode, projectile will ignore
  360. it for functions working with buffers."
  361. :group 'projectile
  362. :type '(repeat string))
  363. (defcustom projectile-globally-ignored-buffers nil
  364. "A list of buffer-names ignored by projectile.
  365. You can use either exact buffer names or regular expressions.
  366. If a buffer is in the list projectile will ignore it for
  367. functions working with buffers."
  368. :group 'projectile
  369. :type '(repeat string)
  370. :package-version '(projectile . "0.12.0"))
  371. (defcustom projectile-find-file-hook nil
  372. "Hooks run when a file is opened with `projectile-find-file'."
  373. :group 'projectile
  374. :type 'hook)
  375. (defcustom projectile-find-dir-hook nil
  376. "Hooks run when a directory is opened with `projectile-find-dir'."
  377. :group 'projectile
  378. :type 'hook)
  379. (defcustom projectile-switch-project-action 'projectile-find-file
  380. "Action invoked after switching projects with `projectile-switch-project'.
  381. Any function that does not take arguments will do."
  382. :group 'projectile
  383. :type 'function)
  384. (defcustom projectile-find-dir-includes-top-level nil
  385. "If true, add top-level dir to options offered by `projectile-find-dir'."
  386. :group 'projectile
  387. :type 'boolean)
  388. (defcustom projectile-use-git-grep nil
  389. "If true, use `vc-git-grep' in git projects."
  390. :group 'projectile
  391. :type 'boolean)
  392. (defcustom projectile-grep-finished-hook nil
  393. "Hooks run when `projectile-grep' finishes."
  394. :group 'projectile
  395. :type 'hook
  396. :package-version '(projectile . "0.14.0"))
  397. (defcustom projectile-test-prefix-function 'projectile-test-prefix
  398. "Function to find test files prefix based on PROJECT-TYPE."
  399. :group 'projectile
  400. :type 'function)
  401. (defcustom projectile-test-suffix-function 'projectile-test-suffix
  402. "Function to find test files suffix based on PROJECT-TYPE."
  403. :group 'projectile
  404. :type 'function)
  405. (defcustom projectile-related-files-fn-function 'projectile-related-files-fn
  406. "Function to find related files based on PROJECT-TYPE."
  407. :group 'projectile
  408. :type 'function)
  409. (defcustom projectile-dynamic-mode-line t
  410. "If true, update the mode-line dynamically.
  411. Only file buffers are affected by this, as the update happens via
  412. `find-file-hook'.
  413. See also `projectile-mode-line-function' and `projectile-update-mode-line'."
  414. :group 'projectile
  415. :type 'boolean
  416. :package-version '(projectile . "2.0.0"))
  417. (defcustom projectile-mode-line-function 'projectile-default-mode-line
  418. "The function to use to generate project-specific mode-line.
  419. The default function adds the project name and type to the mode-line.
  420. See also `projectile-update-mode-line'."
  421. :group 'projectile
  422. :type 'function
  423. :package-version '(projectile . "2.0.0"))
  424. ;;; Idle Timer
  425. (defvar projectile-idle-timer nil
  426. "The timer object created when `projectile-enable-idle-timer' is non-nil.")
  427. (defcustom projectile-idle-timer-seconds 30
  428. "The idle period to use when `projectile-enable-idle-timer' is non-nil."
  429. :group 'projectile
  430. :type 'number)
  431. (defcustom projectile-idle-timer-hook '(projectile-regenerate-tags)
  432. "The hook run when `projectile-enable-idle-timer' is non-nil."
  433. :group 'projectile
  434. :type '(repeat symbol))
  435. (defcustom projectile-enable-idle-timer nil
  436. "Enables idle timer hook `projectile-idle-timer-functions'.
  437. When `projectile-enable-idle-timer' is non-nil, the hook
  438. `projectile-idle-timer-hook' is run each time Emacs has been idle
  439. for `projectile-idle-timer-seconds' seconds and we're in a
  440. project."
  441. :group 'projectile
  442. :set (lambda (symbol value)
  443. (set symbol value)
  444. (when projectile-idle-timer
  445. (cancel-timer projectile-idle-timer))
  446. (setq projectile-idle-timer nil)
  447. (when projectile-enable-idle-timer
  448. (setq projectile-idle-timer (run-with-idle-timer
  449. projectile-idle-timer-seconds t
  450. (lambda ()
  451. (when (projectile-project-p)
  452. (run-hooks 'projectile-idle-timer-hook)))))))
  453. :type 'boolean)
  454. (defvar projectile-projects-cache nil
  455. "A hashmap used to cache project file names to speed up related operations.")
  456. (defvar projectile-projects-cache-time nil
  457. "A hashmap used to record when we populated `projectile-projects-cache'.")
  458. (defvar projectile-project-root-cache (make-hash-table :test 'equal)
  459. "Cached value of function `projectile-project-root`.")
  460. (defvar projectile-project-type-cache (make-hash-table :test 'equal)
  461. "A hashmap used to cache project type to speed up related operations.")
  462. (defvar projectile-known-projects nil
  463. "List of locations where we have previously seen projects.
  464. The list of projects is ordered by the time they have been accessed.
  465. See also `projectile-remove-known-project',
  466. `projectile-cleanup-known-projects' and `projectile-clear-known-projects'.")
  467. (defvar projectile-known-projects-on-file nil
  468. "List of known projects reference point.
  469. Contains a copy of `projectile-known-projects' when it was last
  470. synchronized with `projectile-known-projects-file'.")
  471. (defcustom projectile-known-projects-file
  472. (expand-file-name "projectile-bookmarks.eld"
  473. user-emacs-directory)
  474. "Name and location of the Projectile's known projects file."
  475. :group 'projectile
  476. :type 'string)
  477. (defcustom projectile-ignored-projects nil
  478. "A list of projects not to be added to `projectile-known-projects'."
  479. :group 'projectile
  480. :type '(repeat :tag "Project list" directory)
  481. :package-version '(projectile . "0.11.0"))
  482. (defcustom projectile-ignored-project-function nil
  483. "Function to decide if a project is added to `projectile-known-projects'.
  484. Can be either nil, or a function that takes the truename of the
  485. project root as argument and returns non-nil if the project is to
  486. be ignored or nil otherwise.
  487. This function is only called if the project is not listed in
  488. `projectile-ignored-projects'.
  489. A suitable candidate would be `file-remote-p' to ignore remote
  490. projects."
  491. :group 'projectile
  492. :type '(choice
  493. (const :tag "Nothing" nil)
  494. (const :tag "Remote files" file-remote-p)
  495. function)
  496. :package-version '(projectile . "0.13.0"))
  497. (defcustom projectile-track-known-projects-automatically t
  498. "Controls whether Projectile will automatically register known projects.
  499. When set to nil you'll have always add projects explicitly with
  500. `projectile-add-known-project'."
  501. :group 'projectile
  502. :type 'boolean
  503. :package-version '(projectile . "1.0.0"))
  504. (defcustom projectile-project-search-path nil
  505. "List of folders where projectile is automatically going to look for projects.
  506. You can think of something like $PATH, but for projects instead of executables.
  507. Examples of such paths might be ~/projects, ~/work, etc."
  508. :group 'projectile
  509. :type 'list
  510. :package-version '(projectile . "1.0.0"))
  511. (defcustom projectile-git-command "git ls-files -zco --exclude-standard"
  512. "Command used by projectile to get the files in a git project."
  513. :group 'projectile
  514. :type 'string)
  515. (defcustom projectile-git-submodule-command "git submodule --quiet foreach 'echo $path' | tr '\\n' '\\0'"
  516. "Command used by projectile to list submodules of a given git repository.
  517. Set to nil to disable listing submodules contents."
  518. :group 'projectile
  519. :type 'string)
  520. (defcustom projectile-git-ignored-command "git ls-files -zcoi --exclude-standard"
  521. "Command used by projectile to get the ignored files in a git project."
  522. :group 'projectile
  523. :type 'string
  524. :package-version '(projectile . "0.14.0"))
  525. (defcustom projectile-hg-command "hg locate -f -0 -I ."
  526. "Command used by projectile to get the files in a hg project."
  527. :group 'projectile
  528. :type 'string)
  529. (defcustom projectile-fossil-command (concat "fossil ls | "
  530. (when (string-equal system-type
  531. "windows-nt")
  532. "dos2unix | ")
  533. "tr '\\n' '\\0'")
  534. "Command used by projectile to get the files in a fossil project."
  535. :group 'projectile
  536. :type 'string)
  537. (defcustom projectile-bzr-command "bzr ls -R --versioned -0"
  538. "Command used by projectile to get the files in a bazaar project."
  539. :group 'projectile
  540. :type 'string)
  541. (defcustom projectile-darcs-command "darcs show files -0 . "
  542. "Command used by projectile to get the files in a darcs project."
  543. :group 'projectile
  544. :type 'string)
  545. (defcustom projectile-svn-command "svn list -R . | grep -v '$/' | tr '\\n' '\\0'"
  546. "Command used by projectile to get the files in a svn project."
  547. :group 'projectile
  548. :type 'string)
  549. (defcustom projectile-generic-command
  550. (if (executable-find "fd")
  551. "fd . -0 --type f --color=never"
  552. "find . -type f -print0")
  553. "Command used by projectile to get the files in a generic project."
  554. :group 'projectile
  555. :type 'string)
  556. (defcustom projectile-vcs-dirty-state '("edited" "unregistered" "needs-update" "needs-merge" "unlocked-changes" "conflict")
  557. "List of states checked by `projectile-browse-dirty-projects'.
  558. Possible checked states are:
  559. \"edited\", \"unregistered\", \"needs-update\", \"needs-merge\",
  560. \"unlocked-changes\" and \"conflict\",
  561. as defined in `vc.el'."
  562. :group 'projectile
  563. :type '(repeat (string))
  564. :package-version '(projectile . "1.0.0"))
  565. (defcustom projectile-other-file-alist
  566. '( ;; handle C/C++ extensions
  567. ("cpp" . ("h" "hpp" "ipp"))
  568. ("ipp" . ("h" "hpp" "cpp"))
  569. ("hpp" . ("h" "ipp" "cpp" "cc"))
  570. ("cxx" . ("h" "hxx" "ixx"))
  571. ("ixx" . ("h" "hxx" "cxx"))
  572. ("hxx" . ("h" "ixx" "cxx"))
  573. ("c" . ("h"))
  574. ("m" . ("h"))
  575. ("mm" . ("h"))
  576. ("h" . ("c" "cc" "cpp" "ipp" "hpp" "cxx" "ixx" "hxx" "m" "mm"))
  577. ("cc" . ("h" "hh" "hpp"))
  578. ("hh" . ("cc"))
  579. ;; OCaml extensions
  580. ("ml" . ("mli"))
  581. ("mli" . ("ml" "mll" "mly"))
  582. ("mll" . ("mli"))
  583. ("mly" . ("mli"))
  584. ("eliomi" . ("eliom"))
  585. ("eliom" . ("eliomi"))
  586. ;; vertex shader and fragment shader extensions in glsl
  587. ("vert" . ("frag"))
  588. ("frag" . ("vert"))
  589. ;; handle files with no extension
  590. (nil . ("lock" "gpg"))
  591. ("lock" . (""))
  592. ("gpg" . (""))
  593. )
  594. "Alist of extensions for switching to file with the same name,
  595. using other extensions based on the extension of current
  596. file."
  597. :type 'alist)
  598. (defcustom projectile-create-missing-test-files nil
  599. "During toggling, if non-nil enables creating test files if not found.
  600. When not-nil, every call to projectile-find-implementation-or-test-*
  601. creates test files if not found on the file system. Defaults to nil.
  602. It assumes the test/ folder is at the same level as src/."
  603. :group 'projectile
  604. :type 'boolean)
  605. (defcustom projectile-after-switch-project-hook nil
  606. "Hooks run right after project is switched."
  607. :group 'projectile
  608. :type 'hook)
  609. (defcustom projectile-before-switch-project-hook nil
  610. "Hooks run when right before project is switched."
  611. :group 'projectile
  612. :type 'hook)
  613. (defcustom projectile-current-project-on-switch 'remove
  614. "Determines whether to display current project when switching projects.
  615. When set to 'remove current project is not included, 'move-to-end
  616. will display current project and the end of the list of known
  617. projects, 'keep will leave the current project at the default
  618. position."
  619. :group 'projectile
  620. :type '(radio
  621. (const :tag "Remove" remove)
  622. (const :tag "Move to end" move-to-end)
  623. (const :tag "Keep" keep)))
  624. (defcustom projectile-max-file-buffer-count nil
  625. "Maximum number of file buffers per project that are kept open.
  626. If the value is nil, there is no limit to the opend buffers count."
  627. :group 'projectile
  628. :type 'integer
  629. :package-version '(projectile . "2.2.0"))
  630. ;;; Version information
  631. ;;;###autoload
  632. (defun projectile-version (&optional show-version)
  633. "Get the Projectile version as string.
  634. If called interactively or if SHOW-VERSION is non-nil, show the
  635. version in the echo area and the messages buffer.
  636. The returned string includes both, the version from package.el
  637. and the library version, if both a present and different.
  638. If the version number could not be determined, signal an error,
  639. if called interactively, or if SHOW-VERSION is non-nil, otherwise
  640. just return nil."
  641. (interactive (list t))
  642. (if (require 'pkg-info nil t)
  643. (let ((version (pkg-info-version-info 'projectile)))
  644. (when show-version
  645. (message "Projectile %s" version))
  646. version)
  647. (error "Cannot determine version without package pkg-info")))
  648. ;;; Misc utility functions
  649. (defun projectile-difference (list1 list2)
  650. (cl-remove-if
  651. (lambda (x) (member x list2))
  652. list1))
  653. (defun projectile-unixy-system-p ()
  654. "Check to see if unixy text utilities are installed."
  655. (cl-every
  656. (lambda (x) (executable-find x))
  657. '("grep" "cut" "uniq")))
  658. (defun projectile-symbol-or-selection-at-point ()
  659. "Get the symbol or selected text at point."
  660. (if (use-region-p)
  661. (buffer-substring-no-properties (region-beginning) (region-end))
  662. (projectile-symbol-at-point)))
  663. (defun projectile-symbol-at-point ()
  664. "Get the symbol at point and strip its properties."
  665. (substring-no-properties (or (thing-at-point 'symbol) "")))
  666. (defun projectile-generate-process-name (process make-new)
  667. "Infer the buffer name for PROCESS or generate a new one if MAKE-NEW is true."
  668. (let* ((project (projectile-acquire-root))
  669. (base-name (format "*%s %s*" process (projectile-project-name project))))
  670. (if make-new
  671. (generate-new-buffer-name base-name)
  672. base-name)))
  673. ;;; Serialization
  674. (defun projectile-serialize (data filename)
  675. "Serialize DATA to FILENAME.
  676. The saved data can be restored with `projectile-unserialize'."
  677. (when (file-writable-p filename)
  678. (with-temp-file filename
  679. (insert (let (print-length) (prin1-to-string data))))))
  680. (defun projectile-unserialize (filename)
  681. "Read data serialized by `projectile-serialize' from FILENAME."
  682. (with-demoted-errors
  683. "Error during file deserialization: %S"
  684. (when (file-exists-p filename)
  685. (with-temp-buffer
  686. (insert-file-contents filename)
  687. ;; this will blow up if the contents of the file aren't
  688. ;; lisp data structures
  689. (read (buffer-string))))))
  690. ;;; Caching
  691. (defvar projectile-file-exists-cache
  692. (make-hash-table :test 'equal)
  693. "Cached `projectile-file-exists-p' results.")
  694. (defvar projectile-file-exists-cache-timer nil
  695. "Timer for scheduling`projectile-file-exists-cache-cleanup'.")
  696. (defun projectile-file-exists-cache-cleanup ()
  697. "Removed timed out cache entries and reschedules or remove the
  698. timer if no more items are in the cache."
  699. (let ((now (current-time)))
  700. (maphash (lambda (key value)
  701. (if (time-less-p (cdr value) now)
  702. (remhash key projectile-file-exists-cache)))
  703. projectile-file-exists-cache)
  704. (setq projectile-file-exists-cache-timer
  705. (if (> (hash-table-count projectile-file-exists-cache) 0)
  706. (run-with-timer 10 nil 'projectile-file-exists-cache-cleanup)))))
  707. (defun projectile-file-exists-p (filename)
  708. "Return t if file FILENAME exist.
  709. A wrapper around `file-exists-p' with additional caching support."
  710. (let* ((file-remote (file-remote-p filename))
  711. (expire-seconds
  712. (if file-remote
  713. (and projectile-file-exists-remote-cache-expire
  714. (> projectile-file-exists-remote-cache-expire 0)
  715. projectile-file-exists-remote-cache-expire)
  716. (and projectile-file-exists-local-cache-expire
  717. (> projectile-file-exists-local-cache-expire 0)
  718. projectile-file-exists-local-cache-expire)))
  719. (remote-file-name-inhibit-cache (if expire-seconds
  720. expire-seconds
  721. remote-file-name-inhibit-cache)))
  722. (if (not expire-seconds)
  723. (file-exists-p filename)
  724. (let* ((current-time (current-time))
  725. (cached (gethash filename projectile-file-exists-cache))
  726. (cached-value (if cached (car cached)))
  727. (cached-expire (if cached (cdr cached)))
  728. (cached-expired (if cached (time-less-p cached-expire current-time) t))
  729. (value (or (and (not cached-expired) cached-value)
  730. (if (file-exists-p filename) 'found 'notfound))))
  731. (when (or (not cached) cached-expired)
  732. (puthash filename
  733. (cons value (time-add current-time (seconds-to-time expire-seconds)))
  734. projectile-file-exists-cache))
  735. (unless projectile-file-exists-cache-timer
  736. (setq projectile-file-exists-cache-timer
  737. (run-with-timer 10 nil 'projectile-file-exists-cache-cleanup)))
  738. (equal value 'found)))))
  739. ;;;###autoload
  740. (defun projectile-invalidate-cache (prompt)
  741. "Remove the current project's files from `projectile-projects-cache'.
  742. With a prefix argument PROMPT prompts for the name of the project whose cache
  743. to invalidate."
  744. (interactive "P")
  745. (let ((project-root
  746. (if prompt
  747. (completing-read "Remove cache for: "
  748. (hash-table-keys projectile-projects-cache))
  749. (projectile-acquire-root))))
  750. (setq projectile-project-root-cache (make-hash-table :test 'equal))
  751. (remhash project-root projectile-project-type-cache)
  752. (remhash project-root projectile-projects-cache)
  753. (remhash project-root projectile-projects-cache-time)
  754. (projectile-serialize-cache)
  755. (when projectile-verbose
  756. (message "Invalidated Projectile cache for %s."
  757. (propertize project-root 'face 'font-lock-keyword-face))))
  758. (when (fboundp 'recentf-cleanup)
  759. (recentf-cleanup)))
  760. (defun projectile-time-seconds ()
  761. "Return the number of seconds since the unix epoch."
  762. (cl-destructuring-bind (high low _usec _psec) (current-time)
  763. (+ (lsh high 16) low)))
  764. (defun projectile-cache-project (project files)
  765. "Cache PROJECTs FILES.
  766. The cache is created both in memory and on the hard drive."
  767. (when projectile-enable-caching
  768. (puthash project files projectile-projects-cache)
  769. (puthash project (projectile-time-seconds) projectile-projects-cache-time)
  770. (projectile-serialize-cache)))
  771. ;;;###autoload
  772. (defun projectile-purge-file-from-cache (file)
  773. "Purge FILE from the cache of the current project."
  774. (interactive
  775. (list (projectile-completing-read
  776. "Remove file from cache: "
  777. (projectile-current-project-files))))
  778. (let* ((project-root (projectile-project-root))
  779. (project-cache (gethash project-root projectile-projects-cache)))
  780. (if (projectile-file-cached-p file project-root)
  781. (progn
  782. (puthash project-root (remove file project-cache) projectile-projects-cache)
  783. (projectile-serialize-cache)
  784. (when projectile-verbose
  785. (message "%s removed from cache" file)))
  786. (error "%s is not in the cache" file))))
  787. ;;;###autoload
  788. (defun projectile-purge-dir-from-cache (dir)
  789. "Purge DIR from the cache of the current project."
  790. (interactive
  791. (list (projectile-completing-read
  792. "Remove directory from cache: "
  793. (projectile-current-project-dirs))))
  794. (let* ((project-root (projectile-project-root))
  795. (project-cache (gethash project-root projectile-projects-cache)))
  796. (puthash project-root
  797. (cl-remove-if (lambda (str) (string-prefix-p dir str)) project-cache)
  798. projectile-projects-cache)))
  799. (defun projectile-file-cached-p (file project)
  800. "Check if FILE is already in PROJECT cache."
  801. (member file (gethash project projectile-projects-cache)))
  802. ;;;###autoload
  803. (defun projectile-cache-current-file ()
  804. "Add the currently visited file to the cache."
  805. (interactive)
  806. (let ((current-project (projectile-project-root)))
  807. (when (and (buffer-file-name) (gethash (projectile-project-root) projectile-projects-cache))
  808. (let* ((abs-current-file (file-truename (buffer-file-name)))
  809. (current-file (file-relative-name abs-current-file current-project)))
  810. (unless (or (projectile-file-cached-p current-file current-project)
  811. (projectile-ignored-directory-p (file-name-directory abs-current-file))
  812. (projectile-ignored-file-p abs-current-file))
  813. (puthash current-project
  814. (cons current-file (gethash current-project projectile-projects-cache))
  815. projectile-projects-cache)
  816. (projectile-serialize-cache)
  817. (message "File %s added to project %s cache."
  818. (propertize current-file 'face 'font-lock-keyword-face)
  819. (propertize current-project 'face 'font-lock-keyword-face)))))))
  820. ;; cache opened files automatically to reduce the need for cache invalidation
  821. (defun projectile-cache-files-find-file-hook ()
  822. "Function for caching files with `find-file-hook'."
  823. (let ((project-root (projectile-project-p)))
  824. (when (and projectile-enable-caching
  825. project-root
  826. (not (projectile-ignored-project-p project-root)))
  827. (projectile-cache-current-file))))
  828. (defun projectile-track-known-projects-find-file-hook ()
  829. "Function for caching projects with `find-file-hook'."
  830. (when (and projectile-track-known-projects-automatically (projectile-project-p))
  831. (projectile-add-known-project (projectile-project-root))))
  832. (defun projectile-maybe-invalidate-cache (force)
  833. "Invalidate if FORCE or project's dirconfig newer than cache."
  834. (when (or force (file-newer-than-file-p (projectile-dirconfig-file)
  835. projectile-cache-file))
  836. (projectile-invalidate-cache nil)))
  837. ;;;###autoload
  838. (defun projectile-discover-projects-in-directory (directory)
  839. "Discover any projects in DIRECTORY and add them to the projectile cache.
  840. This function is not recursive and only adds projects with roots
  841. at the top level of DIRECTORY."
  842. (interactive
  843. (list (read-directory-name "Starting directory: ")))
  844. (let ((subdirs (directory-files directory t)))
  845. (mapcar
  846. (lambda (dir)
  847. (when (and (file-directory-p dir)
  848. (not (member (file-name-nondirectory dir) '(".." "."))))
  849. (when (projectile-project-p dir)
  850. (projectile-add-known-project dir))))
  851. subdirs)))
  852. ;;;###autoload
  853. (defun projectile-discover-projects-in-search-path ()
  854. "Discover projects in `projectile-project-search-path'.
  855. Invoked automatically when `projectile-mode' is enabled."
  856. (interactive)
  857. (mapcar #'projectile-discover-projects-in-directory projectile-project-search-path))
  858. (defun delete-file-projectile-remove-from-cache (filename &optional _trash)
  859. (if (and projectile-enable-caching projectile-auto-update-cache (projectile-project-p))
  860. (let* ((project-root (projectile-project-root))
  861. (true-filename (file-truename filename))
  862. (relative-filename (file-relative-name true-filename project-root)))
  863. (if (projectile-file-cached-p relative-filename project-root)
  864. (projectile-purge-file-from-cache relative-filename)))))
  865. ;;; Project root related utilities
  866. (defun projectile-parent (path)
  867. "Return the parent directory of PATH.
  868. PATH may be a file or directory and directory paths may end with a slash."
  869. (directory-file-name (file-name-directory (directory-file-name (expand-file-name path)))))
  870. (defun projectile-locate-dominating-file (file name)
  871. "Look up the directory hierarchy from FILE for a directory containing NAME.
  872. Stop at the first parent directory containing a file NAME,
  873. and return the directory. Return nil if not found.
  874. Instead of a string, NAME can also be a predicate taking one argument
  875. \(a directory) and returning a non-nil value if that directory is the one for
  876. which we're looking."
  877. ;; copied from files.el (stripped comments) emacs-24 bzr branch 2014-03-28 10:20
  878. (setq file (abbreviate-file-name file))
  879. (let ((root nil)
  880. try)
  881. (while (not (or root
  882. (null file)
  883. (string-match locate-dominating-stop-dir-regexp file)))
  884. (setq try (if (stringp name)
  885. (projectile-file-exists-p (expand-file-name name file))
  886. (funcall name file)))
  887. (cond (try (setq root file))
  888. ((equal file (setq file (file-name-directory
  889. (directory-file-name file))))
  890. (setq file nil))))
  891. (and root (expand-file-name (file-name-as-directory root)))))
  892. (defvar-local projectile-project-root nil
  893. "Defines a custom Projectile project root.
  894. This is intended to be used as a file local variable.")
  895. (defun projectile-root-local (_dir)
  896. "A simple wrapper around `projectile-project-root'."
  897. projectile-project-root)
  898. (defun projectile-root-top-down (dir &optional list)
  899. "Identify a project root in DIR by top-down search for files in LIST.
  900. If LIST is nil, use `projectile-project-root-files' instead.
  901. Return the first (topmost) matched directory or nil if not found."
  902. (projectile-locate-dominating-file
  903. dir
  904. (lambda (dir)
  905. (cl-find-if (lambda (f) (projectile-file-exists-p (expand-file-name f dir)))
  906. (or list projectile-project-root-files)))))
  907. (defun projectile-root-bottom-up (dir &optional list)
  908. "Identify a project root in DIR by bottom-up search for files in LIST.
  909. If LIST is nil, use `projectile-project-root-files-bottom-up' instead.
  910. Return the first (bottommost) matched directory or nil if not found."
  911. (cl-some (lambda (name) (projectile-locate-dominating-file dir name))
  912. (or list projectile-project-root-files-bottom-up)))
  913. (defun projectile-root-top-down-recurring (dir &optional list)
  914. "Identify a project root in DIR by recurring top-down search for files in LIST.
  915. If LIST is nil, use `projectile-project-root-files-top-down-recurring'
  916. instead. Return the last (bottommost) matched directory in the
  917. topmost sequence of matched directories. Nil otherwise."
  918. (cl-some
  919. (lambda (f)
  920. (projectile-locate-dominating-file
  921. dir
  922. (lambda (dir)
  923. (and (projectile-file-exists-p (expand-file-name f dir))
  924. (or (string-match locate-dominating-stop-dir-regexp (projectile-parent dir))
  925. (not (projectile-file-exists-p (expand-file-name f (projectile-parent dir)))))))))
  926. (or list projectile-project-root-files-top-down-recurring)))
  927. (defun projectile-project-root (&optional dir)
  928. "Retrieves the root directory of a project if available.
  929. If DIR is not supplied its set to the current directory by default."
  930. ;; the cached value will be 'none in the case of no project root (this is to
  931. ;; ensure it is not reevaluated each time when not inside a project) so use
  932. ;; cl-subst to replace this 'none value with nil so a nil value is used
  933. ;; instead
  934. (let ((dir (or dir default-directory)))
  935. ;; Back out of any archives, the project will live on the outside and
  936. ;; searching them is slow.
  937. (when (and (fboundp 'tramp-archive-file-name-archive)
  938. (tramp-archive-file-name-p dir))
  939. (setq dir (file-name-directory (tramp-archive-file-name-archive dir))))
  940. (cl-subst nil 'none
  941. ;; The `is-local' and `is-connected' variables are
  942. ;; used to fix the behavior where Emacs hangs
  943. ;; because of Projectile when you open a file over
  944. ;; TRAMP. It basically prevents Projectile from
  945. ;; trying to find information about files for which
  946. ;; it's not possible to get that information right
  947. ;; now.
  948. (or (let ((is-local (not (file-remote-p dir))) ;; `true' if the file is local
  949. (is-connected (file-remote-p dir nil t))) ;; `true' if the file is remote AND we are connected to the remote
  950. (when (or is-local is-connected)
  951. (cl-some
  952. (lambda (func)
  953. (let* ((cache-key (format "%s-%s" func dir))
  954. (cache-value (gethash cache-key projectile-project-root-cache)))
  955. (if (and cache-value (file-exists-p cache-value))
  956. cache-value
  957. (let ((value (funcall func (file-truename dir))))
  958. (puthash cache-key value projectile-project-root-cache)
  959. value))))
  960. projectile-project-root-files-functions)))
  961. ;; set cached to none so is non-nil so we don't try
  962. ;; and look it up again
  963. 'none))))
  964. (defun projectile-ensure-project (dir)
  965. "Ensure that DIR is non-nil.
  966. Useful for commands that expect the presence of a project.
  967. Controlled by `projectile-require-project-root'."
  968. (if dir
  969. dir
  970. (cond
  971. ((eq projectile-require-project-root 'prompt) (projectile-completing-read
  972. "Switch to project: " projectile-known-projects))
  973. (projectile-require-project-root (error "Projectile can't find a project definition in %s" dir))
  974. (t default-directory))))
  975. (defun projectile-acquire-root (&optional dir)
  976. "Find the current project root, and prompts the user for it if that fails.
  977. Provides the common idiom (projectile-ensure-root (projectile-project-root)).
  978. Starts the search for the project with DIR."
  979. (projectile-ensure-project (projectile-project-root dir)))
  980. (defun projectile-project-p (&optional dir)
  981. "Check if DIR is a project.
  982. Defaults to the current directory if not provided
  983. explicitly."
  984. (projectile-project-root (or dir default-directory)))
  985. (defun projectile-default-project-name (project-root)
  986. "Default function used create project name to be displayed based on the value of PROJECT-ROOT."
  987. (file-name-nondirectory (directory-file-name project-root)))
  988. (defun projectile-project-name (&optional project)
  989. "Return project name.
  990. If PROJECT is not specified acts on the current project."
  991. (or projectile-project-name
  992. (let ((project-root (or project (projectile-project-root))))
  993. (if project-root
  994. (funcall projectile-project-name-function project-root)
  995. "-"))))
  996. ;;; Project indexing
  997. (defun projectile-get-project-directories (project-dir)
  998. "Get the list of PROJECT-DIR directories that are of interest to the user."
  999. (mapcar (lambda (subdir) (concat project-dir subdir))
  1000. (or (nth 0 (projectile-parse-dirconfig-file)) '(""))))
  1001. (defun projectile--directory-p (directory)
  1002. "Checks if DIRECTORY is a string designating a valid directory."
  1003. (and (stringp directory) (file-directory-p directory)))
  1004. (defun projectile-dir-files (directory)
  1005. "List the files in DIRECTORY and in its sub-directories.
  1006. Files are returned as relative paths to DIRECTORY."
  1007. (unless (projectile--directory-p directory)
  1008. (error "Directory %S does not exist" directory))
  1009. ;; check for a cache hit first if caching is enabled
  1010. (let ((files-list (and projectile-enable-caching
  1011. (gethash directory projectile-projects-cache))))
  1012. ;; cache disabled or cache miss
  1013. (or files-list
  1014. (let ((vcs (projectile-project-vcs directory)))
  1015. (pcase projectile-indexing-method
  1016. ('native (projectile-dir-files-native directory))
  1017. ;; use external tools to get the project files
  1018. ('hybrid (projectile-adjust-files directory vcs (projectile-dir-files-alien directory)))
  1019. ('alien (projectile-dir-files-alien directory))
  1020. (_ (user-error "Unsupported indexing method `%S'" projectile-indexing-method)))))))
  1021. ;;; Native Project Indexing
  1022. ;;
  1023. ;; This corresponds to `projectile-indexing-method' being set to native.
  1024. (defun projectile-dir-files-native (directory)
  1025. "Get the files for ROOT under DIRECTORY using just Emacs Lisp."
  1026. (let ((progress-reporter
  1027. (make-progress-reporter
  1028. (format "Projectile is indexing %s"
  1029. (propertize directory 'face 'font-lock-keyword-face)))))
  1030. ;; we need the files with paths relative to the project root
  1031. (mapcar (lambda (file) (file-relative-name file directory))
  1032. (projectile-index-directory directory (projectile-filtering-patterns)
  1033. progress-reporter))))
  1034. (defun projectile-index-directory (directory patterns progress-reporter &optional ignored-files ignored-directories)
  1035. "Index DIRECTORY taking into account PATTERNS.
  1036. The function calls itself recursively until all sub-directories
  1037. have been indexed. The PROGRESS-REPORTER is updated while the
  1038. function is executing. The list of IGNORED-FILES and
  1039. IGNORED-DIRECTORIES may optionally be provided."
  1040. ;; we compute the ignored files and directories only once and then we reuse the
  1041. ;; pre-computed values in the subsequent recursive invocations of the function
  1042. (let ((ignored-files (or ignored-files (projectile-ignored-files)))
  1043. (ignored-directories (or ignored-directories (projectile-ignored-directories))))
  1044. (apply #'append
  1045. (mapcar
  1046. (lambda (f)
  1047. (unless (or (and patterns (projectile-ignored-rel-p f directory patterns))
  1048. (member (file-name-nondirectory (directory-file-name f))
  1049. '("." ".." ".svn" ".cvs")))
  1050. (progress-reporter-update progress-reporter)
  1051. (if (file-directory-p f)
  1052. (unless (projectile-ignored-directory-p
  1053. (file-name-as-directory f)
  1054. ignored-directories)
  1055. (projectile-index-directory
  1056. f patterns progress-reporter ignored-files ignored-directories))
  1057. (unless (projectile-ignored-file-p f ignored-files)
  1058. (list f)))))
  1059. (directory-files directory t)))))
  1060. ;;; Alien Project Indexing
  1061. ;;
  1062. ;; This corresponds to `projectile-indexing-method' being set to hybrid or alien.
  1063. ;; The only difference between the two methods is that alien doesn't do
  1064. ;; any post-processing of the files obtained via the external command.
  1065. (defun projectile-dir-files-alien (directory)
  1066. "Get the files for DIRECTORY using external tools."
  1067. (let ((vcs (projectile-project-vcs directory)))
  1068. (cond
  1069. ((eq vcs 'git)
  1070. (nconc (projectile-files-via-ext-command directory (projectile-get-ext-command vcs))
  1071. (projectile-get-sub-projects-files directory vcs)))
  1072. (t (projectile-files-via-ext-command directory (projectile-get-ext-command vcs))))))
  1073. (define-obsolete-function-alias 'projectile-dir-files-external 'projectile-dir-files-alien "2.0.0")
  1074. (define-obsolete-function-alias 'projectile-get-repo-files 'projectile-dir-files-alien "2.0.0")
  1075. (defun projectile-get-ext-command (vcs)
  1076. "Determine which external command to invoke based on the project's VCS.
  1077. Fallback to a generic command when not in a VCS-controlled project."
  1078. (pcase vcs
  1079. ('git projectile-git-command)
  1080. ('hg projectile-hg-command)
  1081. ('fossil projectile-fossil-command)
  1082. ('bzr projectile-bzr-command)
  1083. ('darcs projectile-darcs-command)
  1084. ('svn projectile-svn-command)
  1085. (_ projectile-generic-command)))
  1086. (defun projectile-get-sub-projects-command (vcs)
  1087. "Get the sub-projects command for VCS.
  1088. Currently that's supported just for Git (sub-projects being Git
  1089. sub-modules there)."
  1090. (pcase vcs
  1091. ('git projectile-git-submodule-command)
  1092. (_ "")))
  1093. (defun projectile-get-ext-ignored-command (vcs)
  1094. "Determine which external command to invoke based on the project's VCS."
  1095. (pcase vcs
  1096. ('git projectile-git-ignored-command)
  1097. ;; TODO: Add support for other VCS
  1098. (_ nil)))
  1099. (defun projectile-flatten (lst)
  1100. "Take a nested list LST and return its contents as a single, flat list."
  1101. (if (and (listp lst) (listp (cdr lst)))
  1102. (cl-mapcan 'projectile-flatten lst)
  1103. (list lst)))
  1104. (defun projectile-get-all-sub-projects (project)
  1105. "Get all sub-projects for a given project.
  1106. PROJECT is base directory to start search recursively."
  1107. (let ((submodules (projectile-get-immediate-sub-projects project)))
  1108. (cond
  1109. ((null submodules)
  1110. nil)
  1111. (t
  1112. (nconc submodules (projectile-flatten
  1113. ;; recursively get sub-projects of each sub-project
  1114. (mapcar (lambda (s)
  1115. (projectile-get-all-sub-projects s)) submodules)))))))
  1116. (defun projectile-get-immediate-sub-projects (path)
  1117. "Get immediate sub-projects for a given project without recursing.
  1118. PATH is the vcs root or project root from which to start
  1119. searching, and should end with an appropriate path delimiter, such as
  1120. '/' or a '\\'.
  1121. If the vcs get-sub-projects query returns results outside of path,
  1122. they are excluded from the results of this function."
  1123. (let* ((vcs (projectile-project-vcs path))
  1124. ;; search for sub-projects under current project `project'
  1125. (submodules (mapcar
  1126. (lambda (s)
  1127. (file-name-as-directory (expand-file-name s path)))
  1128. (projectile-files-via-ext-command path (projectile-get-sub-projects-command vcs))))
  1129. (project-child-folder-regex
  1130. (concat "\\`"
  1131. (regexp-quote path))))
  1132. ;; If project root is inside of an VCS folder, but not actually an
  1133. ;; VCS root itself, submodules external to the project will be
  1134. ;; included in the VCS get sub-projects result. Let's remove them.
  1135. (cl-remove-if-not
  1136. (lambda (submodule)
  1137. (string-match-p project-child-folder-regex
  1138. submodule))
  1139. submodules)))
  1140. (defun projectile-get-sub-projects-files (project-root _vcs)
  1141. "Get files from sub-projects for PROJECT-ROOT recursively."
  1142. (projectile-flatten
  1143. (mapcar (lambda (sub-project)
  1144. (let ((project-relative-path
  1145. (file-name-as-directory (file-relative-name
  1146. sub-project project-root))))
  1147. (mapcar (lambda (file)
  1148. (concat project-relative-path file))
  1149. ;; TODO: Seems we forgot git hardcoded here
  1150. (projectile-files-via-ext-command sub-project projectile-git-command))))
  1151. (projectile-get-all-sub-projects project-root))))
  1152. (defun projectile-get-repo-ignored-files (project vcs)
  1153. "Get a list of the files ignored in the PROJECT using VCS."
  1154. (let ((cmd (projectile-get-ext-ignored-command vcs)))
  1155. (when cmd
  1156. (projectile-files-via-ext-command project cmd))))
  1157. (defun projectile-get-repo-ignored-directory (project dir vcs)
  1158. "Get a list of the files ignored in the PROJECT in the directory DIR.
  1159. VCS is the VCS of the project."
  1160. (let ((cmd (projectile-get-ext-ignored-command vcs)))
  1161. (when cmd
  1162. (projectile-files-via-ext-command project (concat cmd " " dir)))))
  1163. (defun projectile-files-via-ext-command (root command)
  1164. "Get a list of relative file names in the project ROOT by executing COMMAND.
  1165. If `command' is nil or an empty string, return nil.
  1166. This allows commands to be disabled."
  1167. (when (stringp command)
  1168. (let ((default-directory root))
  1169. (split-string (shell-command-to-string command) "\0" t))))
  1170. (defun projectile-adjust-files (project vcs files)
  1171. "First remove ignored files from FILES, then add back unignored files."
  1172. (projectile-add-unignored project vcs (projectile-remove-ignored files)))
  1173. (defun projectile-remove-ignored (files)
  1174. "Remove ignored files and folders from FILES.
  1175. If ignored directory prefixed with '*', then ignore all
  1176. directories/subdirectories with matching filename,
  1177. otherwise operates relative to project root."
  1178. (let ((ignored-files (projectile-ignored-files-rel))
  1179. (ignored-dirs (projectile-ignored-directories-rel)))
  1180. (cl-remove-if
  1181. (lambda (file)
  1182. (or (cl-some
  1183. (lambda (f)
  1184. (string= f (file-name-nondirectory file)))
  1185. ignored-files)
  1186. (cl-some
  1187. (lambda (dir)
  1188. ;; if the directory is prefixed with '*' then ignore all directories matching that name
  1189. (if (string-prefix-p "*" dir)
  1190. ;; remove '*' and trailing slash from ignored directory name
  1191. (let ((d (substring dir 1 (if (equal (substring dir -1) "/") -1 nil))))
  1192. (cl-some
  1193. (lambda (p)
  1194. (string= d p))
  1195. ;; split path by '/', remove empty strings, and check if any subdirs match name 'd'
  1196. (delete "" (split-string (or (file-name-directory file) "") "/"))))
  1197. (string-prefix-p dir file)))
  1198. ignored-dirs)
  1199. (cl-some
  1200. (lambda (suf)
  1201. (string-suffix-p suf file t))
  1202. projectile-globally-ignored-file-suffixes)))
  1203. files)))
  1204. (defun projectile-keep-ignored-files (project vcs files)
  1205. "Filter FILES to retain only those that are ignored."
  1206. (when files
  1207. (cl-remove-if-not
  1208. (lambda (file)
  1209. (cl-some (lambda (f) (string-prefix-p f file)) files))
  1210. (projectile-get-repo-ignored-files project vcs))))
  1211. (defun projectile-keep-ignored-directories (project vcs directories)
  1212. "Get ignored files within each of DIRECTORIES."
  1213. (when directories
  1214. (let (result)
  1215. (dolist (dir directories result)
  1216. (setq result (append result
  1217. (projectile-get-repo-ignored-directory project dir vcs))))
  1218. result)))
  1219. (defun projectile-add-unignored (project vcs files)
  1220. "This adds unignored files to FILES.
  1221. Useful because the VCS may not return ignored files at all. In
  1222. this case unignored files will be absent from FILES."
  1223. (let ((unignored-files (projectile-keep-ignored-files
  1224. project
  1225. vcs
  1226. (projectile-unignored-files-rel)))
  1227. (unignored-paths (projectile-remove-ignored
  1228. (projectile-keep-ignored-directories
  1229. project
  1230. vcs
  1231. (projectile-unignored-directories-rel)))))
  1232. (append files unignored-files unignored-paths)))
  1233. (defun projectile-buffers-with-file (buffers)
  1234. "Return only those BUFFERS backed by files."
  1235. (cl-remove-if-not (lambda (b) (buffer-file-name b)) buffers))
  1236. (defun projectile-buffers-with-file-or-process (buffers)
  1237. "Return only those BUFFERS backed by files or processes."
  1238. (cl-remove-if-not (lambda (b) (or (buffer-file-name b)
  1239. (get-buffer-process b))) buffers))
  1240. (defun projectile-project-buffers (&optional project)
  1241. "Get a list of a project's buffers.
  1242. If PROJECT is not specified the command acts on the current project."
  1243. (let* ((project-root (or project (projectile-project-root)))
  1244. (all-buffers (cl-remove-if-not
  1245. (lambda (buffer)
  1246. (projectile-project-buffer-p buffer project-root))
  1247. (buffer-list))))
  1248. (if projectile-buffers-filter-function
  1249. (funcall projectile-buffers-filter-function all-buffers)
  1250. all-buffers)))
  1251. (defun projectile-process-current-project-buffers (action)
  1252. "Process the current project's buffers using ACTION."
  1253. (let ((project-buffers (projectile-project-buffers)))
  1254. (dolist (buffer project-buffers)
  1255. (funcall action buffer))))
  1256. (defun projectile-process-current-project-buffers-current (action)
  1257. "Invoke ACTION on every project buffer with that buffer current.
  1258. ACTION is called without arguments."
  1259. (let ((project-buffers (projectile-project-buffers)))
  1260. (dolist (buffer project-buffers)
  1261. (with-current-buffer buffer
  1262. (funcall action)))))
  1263. (defun projectile-project-buffer-files (&optional project)
  1264. "Get a list of a project's buffer files.
  1265. If PROJECT is not specified the command acts on the current project."
  1266. (let ((project-root (or project (projectile-project-root))))
  1267. (mapcar
  1268. (lambda (buffer)
  1269. (file-relative-name
  1270. (buffer-file-name buffer)
  1271. project-root))
  1272. (projectile-buffers-with-file
  1273. (projectile-project-buffers project)))))
  1274. (defun projectile-project-buffer-p (buffer project-root)
  1275. "Check if BUFFER is under PROJECT-ROOT."
  1276. (with-current-buffer buffer
  1277. (and (not (string-prefix-p " " (buffer-name buffer)))
  1278. (not (projectile-ignored-buffer-p buffer))
  1279. default-directory
  1280. (string-equal (file-remote-p default-directory)
  1281. (file-remote-p project-root))
  1282. (not (string-match-p "^http\\(s\\)?://" default-directory))
  1283. (string-prefix-p project-root (file-truename default-directory) (eq system-type 'windows-nt)))))
  1284. (defun projectile-ignored-buffer-p (buffer)
  1285. "Check if BUFFER should be ignored.
  1286. Regular expressions can be use."
  1287. (or
  1288. (with-current-buffer buffer
  1289. (cl-some
  1290. (lambda (name)
  1291. (string-match-p name (buffer-name)))
  1292. projectile-globally-ignored-buffers))
  1293. (with-current-buffer buffer
  1294. (cl-some
  1295. (lambda (mode)
  1296. (string-match-p (concat "^" mode "$")
  1297. (symbol-name major-mode)))
  1298. projectile-globally-ignored-modes))))
  1299. (defun projectile-recently-active-files ()
  1300. "Get list of recently active files.
  1301. Files are ordered by recently active buffers, and then recently
  1302. opened through use of recentf."
  1303. (let ((project-buffer-files (projectile-project-buffer-files)))
  1304. (append project-buffer-files
  1305. (projectile-difference
  1306. (projectile-recentf-files)
  1307. project-buffer-files))))
  1308. (defun projectile-project-buffer-names ()
  1309. "Get a list of project buffer names."
  1310. (mapcar #'buffer-name (projectile-project-buffers)))
  1311. (defun projectile-prepend-project-name (string)
  1312. "Prepend the current project's name to STRING."
  1313. (format "[%s] %s" (projectile-project-name) string))
  1314. (defun projectile-read-buffer-to-switch (prompt)
  1315. "Read the name of a buffer to switch to, prompting with PROMPT.
  1316. This function excludes the current buffer from the offered
  1317. choices."
  1318. (projectile-completing-read
  1319. prompt
  1320. (delete (buffer-name (current-buffer))
  1321. (projectile-project-buffer-names))))
  1322. ;;;###autoload
  1323. (defun projectile-switch-to-buffer ()
  1324. "Switch to a project buffer."
  1325. (interactive)
  1326. (switch-to-buffer
  1327. (projectile-read-buffer-to-switch "Switch to buffer: ")))
  1328. ;;;###autoload
  1329. (defun projectile-switch-to-buffer-other-window ()
  1330. "Switch to a project buffer and show it in another window."
  1331. (interactive)
  1332. (switch-to-buffer-other-window
  1333. (projectile-read-buffer-to-switch "Switch to buffer: ")))
  1334. ;;;###autoload
  1335. (defun projectile-switch-to-buffer-other-frame ()
  1336. "Switch to a project buffer and show it in another frame."
  1337. (interactive)
  1338. (switch-to-buffer-other-frame
  1339. (projectile-read-buffer-to-switch "Switch to buffer: ")))
  1340. ;;;###autoload
  1341. (defun projectile-display-buffer ()
  1342. "Display a project buffer in another window without selecting it."
  1343. (interactive)
  1344. (display-buffer
  1345. (projectile-completing-read
  1346. "Display buffer: "
  1347. (projectile-project-buffer-names))))
  1348. ;;;###autoload
  1349. (defun projectile-project-buffers-other-buffer ()
  1350. "Switch to the most recently selected buffer project buffer.
  1351. Only buffers not visible in windows are returned."
  1352. (interactive)
  1353. (switch-to-buffer (car (projectile-project-buffers-non-visible))) nil t)
  1354. (defun projectile-project-buffers-non-visible ()
  1355. "Get a list of non visible project buffers."
  1356. (cl-remove-if-not
  1357. (lambda (buffer)
  1358. (not (get-buffer-window buffer 'visible)))
  1359. (projectile-project-buffers)))
  1360. ;;;###autoload
  1361. (defun projectile-multi-occur (&optional nlines)
  1362. "Do a `multi-occur' in the project's buffers.
  1363. With a prefix argument, show NLINES of context."
  1364. (interactive "P")
  1365. (let ((project (projectile-acquire-root)))
  1366. (multi-occur (projectile-project-buffers project)
  1367. (car (occur-read-primary-args))
  1368. nlines)))
  1369. (defun projectile-normalise-paths (patterns)
  1370. "Remove leading `/' from the elements of PATTERNS."
  1371. (delq nil (mapcar (lambda (pat) (and (string-prefix-p "/" pat)
  1372. ;; remove the leading /
  1373. (substring pat 1)))
  1374. patterns)))
  1375. (defun projectile-expand-paths (paths)
  1376. "Expand the elements of PATHS.
  1377. Elements containing wildcards are expanded and spliced into the
  1378. resulting paths. The returned PATHS are absolute, based on the
  1379. projectile project root."
  1380. (let ((default-directory (projectile-project-root)))
  1381. (projectile-flatten (mapcar
  1382. (lambda (pattern)
  1383. (or (file-expand-wildcards pattern t)
  1384. (projectile-expand-root pattern)))
  1385. paths))))
  1386. (defun projectile-normalise-patterns (patterns)
  1387. "Remove paths from PATTERNS."
  1388. (cl-remove-if (lambda (pat) (string-prefix-p "/" pat)) patterns))
  1389. (defun projectile-make-relative-to-root (files)
  1390. "Make FILES relative to the project root."
  1391. (let ((project-root (projectile-project-root)))
  1392. (mapcar (lambda (f) (file-relative-name f project-root)) files)))
  1393. (defun projectile-ignored-directory-p
  1394. (directory &optional ignored-directories)
  1395. "Check if DIRECTORY should be ignored.
  1396. Regular expressions can be used. A pre-computed list of
  1397. IGNORED-DIRECTORIES may optionally be provided."
  1398. (cl-some
  1399. (lambda (name)
  1400. (string-match-p name directory))
  1401. (or ignored-directories (projectile-ignored-directories))))
  1402. (defun projectile-ignored-file-p (file &optional ignored-files)
  1403. "Check if FILE should be ignored.
  1404. Regular expressions can be used. A pre-computed list of
  1405. IGNORED-FILES may optionally be provided."
  1406. (cl-some
  1407. (lambda (name)
  1408. (string-match-p name file))
  1409. (or ignored-files (projectile-ignored-files))))
  1410. (defun projectile-check-pattern-p (file pattern)
  1411. "Check if FILE meets PATTERN."
  1412. (or (string-suffix-p (directory-file-name pattern)
  1413. (directory-file-name file))
  1414. (member file (file-expand-wildcards pattern t))))
  1415. (defun projectile-ignored-rel-p (file directory patterns)
  1416. "Check if FILE should be ignored relative to DIRECTORY
  1417. according to PATTERNS: (ignored . unignored)"
  1418. (let ((default-directory directory))
  1419. (and (cl-some
  1420. (lambda (pat) (projectile-check-pattern-p file pat))
  1421. (car patterns))
  1422. (cl-notany
  1423. (lambda (pat) (projectile-check-pattern-p file pat))
  1424. (cdr patterns)))))
  1425. (defun projectile-ignored-files ()
  1426. "Return list of ignored files."
  1427. (projectile-difference
  1428. (mapcar
  1429. #'projectile-expand-root
  1430. (append
  1431. projectile-globally-ignored-files
  1432. (projectile-project-ignored-files)))
  1433. (projectile-unignored-files)))
  1434. (defun projectile-ignored-directories ()
  1435. "Return list of ignored directories."
  1436. (projectile-difference
  1437. (mapcar
  1438. #'file-name-as-directory
  1439. (mapcar
  1440. #'projectile-expand-root
  1441. (append
  1442. projectile-globally-ignored-directories
  1443. (projectile-project-ignored-directories))))
  1444. (projectile-unignored-directories)))
  1445. (defun projectile-ignored-directories-rel ()
  1446. "Return list of ignored directories, relative to the root."
  1447. (projectile-make-relative-to-root (projectile-ignored-directories)))
  1448. (defun projectile-ignored-files-rel ()
  1449. "Return list of ignored files, relative to the root."
  1450. (projectile-make-relative-to-root (projectile-ignored-files)))
  1451. (defun projectile-project-ignored-files ()
  1452. "Return list of project ignored files.
  1453. Unignored files are not included."
  1454. (cl-remove-if 'file-directory-p (projectile-project-ignored)))
  1455. (defun projectile-project-ignored-directories ()
  1456. "Return list of project ignored directories.
  1457. Unignored directories are not included."
  1458. (cl-remove-if-not 'file-directory-p (projectile-project-ignored)))
  1459. (defun projectile-paths-to-ignore ()
  1460. "Return a list of ignored project paths."
  1461. (projectile-normalise-paths (nth 1 (projectile-parse-dirconfig-file))))
  1462. (defun projectile-patterns-to-ignore ()
  1463. "Return a list of relative file patterns."
  1464. (projectile-normalise-patterns (nth 1 (projectile-parse-dirconfig-file))))
  1465. (defun projectile-project-ignored ()
  1466. "Return list of project ignored files/directories.
  1467. Unignored files/directories are not included."
  1468. (let ((paths (projectile-paths-to-ignore)))
  1469. (projectile-expand-paths paths)))
  1470. (defun projectile-unignored-files ()
  1471. "Return list of unignored files."
  1472. (mapcar
  1473. #'projectile-expand-root
  1474. (append
  1475. projectile-globally-unignored-files
  1476. (projectile-project-unignored-files))))
  1477. (defun projectile-unignored-directories ()
  1478. "Return list of unignored directories."
  1479. (mapcar
  1480. #'file-name-as-directory
  1481. (mapcar
  1482. #'projectile-expand-root
  1483. (append
  1484. projectile-globally-unignored-directories
  1485. (projectile-project-unignored-directories)))))
  1486. (defun projectile-unignored-directories-rel ()
  1487. "Return list of unignored directories, relative to the root."
  1488. (projectile-make-relative-to-root (projectile-unignored-directories)))
  1489. (defun projectile-unignored-files-rel ()
  1490. "Return list of unignored files, relative to the root."
  1491. (projectile-make-relative-to-root (projectile-unignored-files)))
  1492. (defun projectile-project-unignored-files ()
  1493. "Return list of project unignored files."
  1494. (cl-remove-if 'file-directory-p (projectile-project-unignored)))
  1495. (defun projectile-project-unignored-directories ()
  1496. "Return list of project unignored directories."
  1497. (cl-remove-if-not 'file-directory-p (projectile-project-unignored)))
  1498. (defun projectile-paths-to-ensure ()
  1499. "Return a list of unignored project paths."
  1500. (projectile-normalise-paths (nth 2 (projectile-parse-dirconfig-file))))
  1501. (defun projectile-files-to-ensure ()
  1502. (projectile-flatten (mapcar (lambda (pat) (file-expand-wildcards pat t))
  1503. (projectile-patterns-to-ensure))))
  1504. (defun projectile-patterns-to-ensure ()
  1505. "Return a list of relative file patterns."
  1506. (projectile-normalise-patterns (nth 2 (projectile-parse-dirconfig-file))))
  1507. (defun projectile-filtering-patterns ()
  1508. (cons (projectile-patterns-to-ignore)
  1509. (projectile-patterns-to-ensure)))
  1510. (defun projectile-project-unignored ()
  1511. "Return list of project ignored files/directories."
  1512. (delete-dups (append (projectile-expand-paths (projectile-paths-to-ensure))
  1513. (projectile-expand-paths (projectile-files-to-ensure)))))
  1514. (defun projectile-dirconfig-file ()
  1515. "Return the absolute path to the project's dirconfig file."
  1516. (expand-file-name ".projectile" (projectile-project-root)))
  1517. (defun projectile-parse-dirconfig-file ()
  1518. "Parse project ignore file and return directories to ignore and keep.
  1519. The return value will be a list of three elements, the car being
  1520. the list of directories to keep, the cadr being the list of files
  1521. or directories to ignore, and the caddr being the list of files
  1522. or directories to ensure.
  1523. Strings starting with + will be added to the list of directories
  1524. to keep, and strings starting with - will be added to the list of
  1525. directories to ignore. For backward compatibility, without a
  1526. prefix the string will be assumed to be an ignore string."
  1527. (let (keep ignore ensure (dirconfig (projectile-dirconfig-file)))
  1528. (when (projectile-file-exists-p dirconfig)
  1529. (with-temp-buffer
  1530. (insert-file-contents dirconfig)
  1531. (while (not (eobp))
  1532. (pcase (char-after)
  1533. ;; ignore comment lines if prefix char has been set
  1534. ((pred (lambda (leading-char)
  1535. (and projectile-dirconfig-comment-prefix
  1536. (eql leading-char
  1537. projectile-dirconfig-comment-prefix))))
  1538. nil)
  1539. (?+ (push (buffer-substring (1+ (point)) (line-end-position)) keep))
  1540. (?- (push (buffer-substring (1+ (point)) (line-end-position)) ignore))
  1541. (?! (push (buffer-substring (1+ (point)) (line-end-position)) ensure))
  1542. (_ (push (buffer-substring (point) (line-end-position)) ignore)))
  1543. (forward-line)))
  1544. (list (mapcar (lambda (f) (file-name-as-directory (string-trim f)))
  1545. (delete "" (reverse keep)))
  1546. (mapcar #'string-trim
  1547. (delete "" (reverse ignore)))
  1548. (mapcar #'string-trim
  1549. (delete "" (reverse ensure)))))))
  1550. (defun projectile-expand-root (name)
  1551. "Expand NAME to project root.
  1552. Never use on many files since it's going to recalculate the
  1553. project-root for every file."
  1554. (expand-file-name name (projectile-project-root)))
  1555. (cl-defun projectile-completing-read (prompt choices &key initial-input action)
  1556. "Present a project tailored PROMPT with CHOICES."
  1557. (let ((prompt (projectile-prepend-project-name prompt))
  1558. res)
  1559. (setq res
  1560. (pcase (if (eq projectile-completion-system 'auto)
  1561. (cond
  1562. ((bound-and-true-p ido-mode) 'ido)
  1563. ((bound-and-true-p helm-mode) 'helm)
  1564. ((bound-and-true-p ivy-mode) 'ivy)
  1565. (t 'default))
  1566. projectile-completion-system)
  1567. ('default (completing-read prompt choices nil nil initial-input))
  1568. ('ido (ido-completing-read prompt choices nil nil initial-input))
  1569. ('helm
  1570. (if (and (fboundp 'helm)
  1571. (fboundp 'helm-make-source))
  1572. (helm :sources
  1573. (helm-make-source "Projectile" 'helm-source-sync
  1574. :candidates choices
  1575. :action (if action
  1576. (prog1 action
  1577. (setq action nil))
  1578. #'identity))
  1579. :prompt prompt
  1580. :input initial-input
  1581. :buffer "*helm-projectile*")
  1582. (user-error "Please install helm")))
  1583. ('ivy
  1584. (if (fboundp 'ivy-read)
  1585. (ivy-read prompt choices
  1586. :initial-input initial-input
  1587. :action (prog1 action
  1588. (setq action nil))
  1589. :caller 'projectile-completing-read)
  1590. (user-error "Please install ivy")))
  1591. (_ (funcall projectile-completion-system prompt choices))))
  1592. (if action
  1593. (funcall action res)
  1594. res)))
  1595. (defun projectile-project-files (project-root)
  1596. "Return a list of files for the PROJECT-ROOT."
  1597. (let (files)
  1598. ;; If the cache is too stale, don't use it.
  1599. (when projectile-files-cache-expire
  1600. (let ((cache-time
  1601. (gethash project-root projectile-projects-cache-time)))
  1602. (when (or (null cache-time)
  1603. (< (+ cache-time projectile-files-cache-expire)
  1604. (projectile-time-seconds)))
  1605. (remhash project-root projectile-projects-cache)
  1606. (remhash project-root projectile-projects-cache-time))))
  1607. ;; Use the cache, if requested and available.
  1608. (when projectile-enable-caching
  1609. (setq files (gethash project-root projectile-projects-cache)))
  1610. ;; Calculate the list of files.
  1611. (when (null files)
  1612. (when projectile-enable-caching
  1613. (message "Projectile is initializing cache for %s ..." project-root))
  1614. (setq files
  1615. (if (eq projectile-indexing-method 'alien)
  1616. ;; In alien mode we can just skip reading
  1617. ;; .projectile and find all files in the root dir.
  1618. (projectile-dir-files-alien project-root)
  1619. ;; If a project is defined as a list of subfolders
  1620. ;; then we'll have the files returned for each subfolder,
  1621. ;; so they are relative to the project root.
  1622. ;;
  1623. ;; TODO: That's pretty slow and we need to improve it.
  1624. ;; One options would be to pass explicitly the subdirs
  1625. ;; to commands like `git ls-files` which would return
  1626. ;; files paths relative to the project root.
  1627. (cl-mapcan
  1628. (lambda (dir)
  1629. (mapcar (lambda (f)
  1630. (file-relative-name (concat dir f)
  1631. project-root))
  1632. (projectile-dir-files dir)))
  1633. (projectile-get-project-directories project-root))))
  1634. ;; Save the cached list.
  1635. (when projectile-enable-caching
  1636. (projectile-cache-project project-root files)))
  1637. ;;; Sorting
  1638. ;;
  1639. ;; Files can't be cached in sorted order as some sorting schemes
  1640. ;; require dynamic data. Sorting is ignored completely when in
  1641. ;; alien mode.
  1642. (if (eq projectile-indexing-method 'alien)
  1643. files
  1644. (projectile-sort-files files))))
  1645. (defun projectile-current-project-files ()
  1646. "Return a list of the files in the current project."
  1647. (projectile-project-files (projectile-project-root)))
  1648. (defun projectile-process-current-project-files (action)
  1649. "Process the current project's files using ACTION."
  1650. (let ((project-files (projectile-current-project-files))
  1651. (default-directory (projectile-project-root)))
  1652. (dolist (filename project-files)
  1653. (funcall action filename))))
  1654. (defun projectile-project-dirs (project)
  1655. "Return a list of dirs for PROJECT."
  1656. (delete-dups
  1657. (delq nil
  1658. (mapcar #'file-name-directory
  1659. (projectile-project-files project)))))
  1660. (defun projectile-current-project-dirs ()
  1661. "Return a list of dirs for the current project."
  1662. (projectile-project-dirs (projectile-acquire-root)))
  1663. (defun projectile-get-other-files (file-name &optional flex-matching)
  1664. "Return a list of other files for FILE-NAME.
  1665. The list depends on `:related-files-fn' project option and
  1666. `projectile-other-file-alist'. For the latter, FLEX-MATCHING can be used
  1667. to match any basename."
  1668. (if-let ((plist (projectile--related-files-plist-by-kind file-name :other)))
  1669. (projectile--related-files-from-plist plist)
  1670. (projectile--other-extension-files file-name
  1671. (projectile-current-project-files)
  1672. flex-matching)))
  1673. (defun projectile--find-other-file (&optional flex-matching ff-variant)
  1674. "Switch between files with the same name but different extensions.
  1675. With FLEX-MATCHING, match any file that contains the base name of current file.
  1676. Other file extensions can be customized with the variable
  1677. `projectile-other-file-alist'. With FF-VARIANT set to a defun, use that
  1678. instead of `find-file'. A typical example of such a defun would be
  1679. `find-file-other-window' or `find-file-other-frame'"
  1680. (let ((ff (or ff-variant #'find-file))
  1681. (other-files (projectile-get-other-files (buffer-file-name) flex-matching)))
  1682. (if other-files
  1683. (let ((file-name (projectile--choose-from-candidates other-files)))
  1684. (funcall ff (expand-file-name file-name
  1685. (projectile-project-root))))
  1686. (error "No other file found"))))
  1687. ;;; Interactive commands
  1688. ;;;###autoload
  1689. (defun projectile-find-other-file (&optional flex-matching)
  1690. "Switch between files with the same name but different extensions.
  1691. With FLEX-MATCHING, match any file that contains the base name of current file.
  1692. Other file extensions can be customized with the variable `projectile-other-file-alist'."
  1693. (interactive "P")
  1694. (projectile--find-other-file flex-matching))
  1695. ;;;###autoload
  1696. (defun projectile-find-other-file-other-window (&optional flex-matching)
  1697. "Switch between files with the same name but different extensions in other window.
  1698. With FLEX-MATCHING, match any file that contains the base name of current file.
  1699. Other file extensions can be customized with the variable `projectile-other-file-alist'."
  1700. (interactive "P")
  1701. (projectile--find-other-file flex-matching
  1702. #'find-file-other-window))
  1703. ;;;###autoload
  1704. (defun projectile-find-other-file-other-frame (&optional flex-matching)
  1705. "Switch between files with the same name but different extensions in other frame.
  1706. With FLEX-MATCHING, match any file that contains the base name of current file.
  1707. Other file extensions can be customized with the variable `projectile-other-file-alist'."
  1708. (interactive "P")
  1709. (projectile--find-other-file flex-matching
  1710. #'find-file-other-frame))
  1711. (defun projectile--file-name-sans-extensions (file-name)
  1712. "Return FILE-NAME sans any extensions.
  1713. The extensions, in a filename, are what follows the first '.', with the exception of a leading '.'"
  1714. (setq file-name (file-name-nondirectory file-name))
  1715. (substring file-name 0 (string-match "\\..*" file-name 1)))
  1716. (defun projectile--file-name-extensions (file-name)
  1717. "Return FILE-NAME's extensions.
  1718. The extensions, in a filename, are what follows the first '.', with the exception of a leading '.'"
  1719. ;;would it make sense to return nil instead of an empty string if no extensions are found?
  1720. (setq file-name (file-name-nondirectory file-name))
  1721. (let (extensions-start)
  1722. (substring file-name
  1723. (if (setq extensions-start (string-match "\\..*" file-name 1))
  1724. (1+ extensions-start)
  1725. (length file-name)))))
  1726. (defun projectile-associated-file-name-extensions (file-name)
  1727. "Return projectile-other-file-extensions associated to FILE-NAME's extensions.
  1728. If no associated other-file-extensions for the complete (nested) extension are found, remove subextensions from FILENAME's extensions until a match is found."
  1729. (let ((current-extensions (projectile--file-name-extensions (file-name-nondirectory file-name)))
  1730. associated-extensions)
  1731. (catch 'break
  1732. (while (not (string= "" current-extensions))
  1733. (if (setq associated-extensions (cdr (assoc current-extensions projectile-other-file-alist)))
  1734. (throw 'break associated-extensions))
  1735. (setq current-extensions (projectile--file-name-extensions current-extensions))))))
  1736. (defun projectile--other-extension-files (current-file project-file-list &optional flex-matching)
  1737. "Narrow to files with the same names but different extensions.
  1738. Returns a list of possible files for users to choose.
  1739. With FLEX-MATCHING, match any file that contains the base name of current file"
  1740. (let* ((file-ext-list (projectile-associated-file-name-extensions current-file))
  1741. (fulldirname (if (file-name-directory current-file)
  1742. (file-name-directory current-file) "./"))
  1743. (dirname (file-name-nondirectory (directory-file-name fulldirname)))
  1744. (filename (regexp-quote (projectile--file-name-sans-extensions current-file)))
  1745. (file-list (mapcar (lambda (ext)
  1746. (if flex-matching
  1747. (concat ".*" filename ".*" "\." ext "\\'")
  1748. (concat "^" filename
  1749. (unless (equal ext "")
  1750. (concat "\." ext))
  1751. "\\'")))
  1752. file-ext-list))
  1753. (candidates (cl-remove-if-not
  1754. (lambda (project-file)
  1755. (string-match filename project-file))
  1756. project-file-list))
  1757. (candidates
  1758. (projectile-flatten (mapcar
  1759. (lambda (file)
  1760. (cl-remove-if-not
  1761. (lambda (project-file)
  1762. (string-match file
  1763. (concat (file-name-base project-file)
  1764. (unless (equal (file-name-extension project-file) nil)
  1765. (concat "\." (file-name-extension project-file))))))
  1766. candidates))
  1767. file-list)))
  1768. (candidates
  1769. (cl-remove-if-not (lambda (file) (not (backup-file-name-p file))) candidates))
  1770. (candidates
  1771. (cl-sort (copy-sequence candidates)
  1772. (lambda (file _)
  1773. (let ((candidate-dirname (file-name-nondirectory (directory-file-name (file-name-directory file)))))
  1774. (unless (equal fulldirname (file-name-directory file))
  1775. (equal dirname candidate-dirname)))))))
  1776. candidates))
  1777. (defun projectile-select-files (project-files &optional invalidate-cache)
  1778. "Select a list of files based on filename at point.
  1779. With a prefix arg INVALIDATE-CACHE invalidates the cache first."
  1780. (projectile-maybe-invalidate-cache invalidate-cache)
  1781. (let* ((file (if (region-active-p)
  1782. (buffer-substring (region-beginning) (region-end))
  1783. (or (thing-at-point 'filename) "")))
  1784. (file (if (string-match "\\.?\\./" file)
  1785. (file-relative-name (file-truename file) (projectile-project-root))
  1786. file))
  1787. (files (if file
  1788. (cl-remove-if-not
  1789. (lambda (project-file)
  1790. (string-match file project-file))
  1791. project-files)
  1792. nil)))
  1793. files))
  1794. (defun projectile--find-file-dwim (invalidate-cache &optional ff-variant)
  1795. "Jump to a project's files using completion based on context.
  1796. With a INVALIDATE-CACHE invalidates the cache first.
  1797. With FF-VARIANT set to a defun, use that instead of `find-file'.
  1798. A typical example of such a defun would be `find-file-other-window' or
  1799. `find-file-other-frame'
  1800. Subroutine for `projectile-find-file-dwim' and
  1801. `projectile-find-file-dwim-other-window'"
  1802. (let* ((project-root (projectile-project-root))
  1803. (project-files (projectile-project-files project-root))
  1804. (files (projectile-select-files project-files invalidate-cache))
  1805. (file (cond ((= (length files) 1)
  1806. (car files))
  1807. ((> (length files) 1)
  1808. (projectile-completing-read "Switch to: " files))
  1809. (t
  1810. (projectile-completing-read "Switch to: " project-files))))
  1811. (ff (or ff-variant #'find-file)))
  1812. (funcall ff (expand-file-name file project-root))
  1813. (run-hooks 'projectile-find-file-hook)))
  1814. ;;;###autoload
  1815. (defun projectile-find-file-dwim (&optional invalidate-cache)
  1816. "Jump to a project's files using completion based on context.
  1817. With a prefix arg INVALIDATE-CACHE invalidates the cache first.
  1818. If point is on a filename, Projectile first tries to search for that
  1819. file in project:
  1820. - If it finds just a file, it switches to that file instantly. This works even
  1821. if the filename is incomplete, but there's only a single file in the current project
  1822. that matches the filename at point. For example, if there's only a single file named
  1823. \"projectile/projectile.el\" but the current filename is \"projectile/proj\" (incomplete),
  1824. `projectile-find-file-dwim' still switches to \"projectile/projectile.el\" immediately
  1825. because this is the only filename that matches.
  1826. - If it finds a list of files, the list is displayed for selecting. A list of
  1827. files is displayed when a filename appears more than one in the project or the
  1828. filename at point is a prefix of more than two files in a project. For example,
  1829. if `projectile-find-file-dwim' is executed on a filepath like \"projectile/\", it lists
  1830. the content of that directory. If it is executed on a partial filename like
  1831. \"projectile/a\", a list of files with character 'a' in that directory is presented.
  1832. - If it finds nothing, display a list of all files in project for selecting."
  1833. (interactive "P")
  1834. (projectile--find-file-dwim invalidate-cache))
  1835. ;;;###autoload
  1836. (defun projectile-find-file-dwim-other-window (&optional invalidate-cache)
  1837. "Jump to a project's files using completion based on context in other window.
  1838. With a prefix arg INVALIDATE-CACHE invalidates the cache first.
  1839. If point is on a filename, Projectile first tries to search for that
  1840. file in project:
  1841. - If it finds just a file, it switches to that file instantly. This works even
  1842. if the filename is incomplete, but there's only a single file in the current project
  1843. that matches the filename at point. For example, if there's only a single file named
  1844. \"projectile/projectile.el\" but the current filename is \"projectile/proj\" (incomplete),
  1845. `projectile-find-file-dwim-other-window' still switches to \"projectile/projectile.el\"
  1846. immediately because this is the only filename that matches.
  1847. - If it finds a list of files, the list is displayed for selecting. A list of
  1848. files is displayed when a filename appears more than one in the project or the
  1849. filename at point is a prefix of more than two files in a project. For example,
  1850. if `projectile-find-file-dwim-other-window' is executed on a filepath like \"projectile/\", it lists
  1851. the content of that directory. If it is executed on a partial filename
  1852. like \"projectile/a\", a list of files with character 'a' in that directory
  1853. is presented.
  1854. - If it finds nothing, display a list of all files in project for selecting."
  1855. (interactive "P")
  1856. (projectile--find-file-dwim invalidate-cache #'find-file-other-window))
  1857. ;;;###autoload
  1858. (defun projectile-find-file-dwim-other-frame (&optional invalidate-cache)
  1859. "Jump to a project's files using completion based on context in other frame.
  1860. With a prefix arg INVALIDATE-CACHE invalidates the cache first.
  1861. If point is on a filename, Projectile first tries to search for that
  1862. file in project:
  1863. - If it finds just a file, it switches to that file instantly. This works even
  1864. if the filename is incomplete, but there's only a single file in the current project
  1865. that matches the filename at point. For example, if there's only a single file named
  1866. \"projectile/projectile.el\" but the current filename is \"projectile/proj\" (incomplete),
  1867. `projectile-find-file-dwim-other-frame' still switches to \"projectile/projectile.el\"
  1868. immediately because this is the only filename that matches.
  1869. - If it finds a list of files, the list is displayed for selecting. A list of
  1870. files is displayed when a filename appears more than one in the project or the
  1871. filename at point is a prefix of more than two files in a project. For example,
  1872. if `projectile-find-file-dwim-other-frame' is executed on a filepath like \"projectile/\", it lists
  1873. the content of that directory. If it is executed on a partial filename
  1874. like \"projectile/a\", a list of files with character 'a' in that directory
  1875. is presented.
  1876. - If it finds nothing, display a list of all files in project for selecting."
  1877. (interactive "P")
  1878. (projectile--find-file-dwim invalidate-cache #'find-file-other-frame))
  1879. (defun projectile--find-file (invalidate-cache &optional ff-variant)
  1880. "Jump to a project's file using completion.
  1881. With INVALIDATE-CACHE invalidates the cache first. With FF-VARIANT set to a
  1882. defun, use that instead of `find-file'. A typical example of such a defun
  1883. would be `find-file-other-window' or `find-file-other-frame'"
  1884. (interactive "P")
  1885. (projectile-maybe-invalidate-cache invalidate-cache)
  1886. (let* ((project-root (projectile-acquire-root))
  1887. (file (projectile-completing-read "Find file: "
  1888. (projectile-project-files project-root)))
  1889. (ff (or ff-variant #'find-file)))
  1890. (when file
  1891. (funcall ff (expand-file-name file project-root))
  1892. (run-hooks 'projectile-find-file-hook))))
  1893. ;;;###autoload
  1894. (defun projectile-find-file (&optional invalidate-cache)
  1895. "Jump to a project's file using completion.
  1896. With a prefix arg INVALIDATE-CACHE invalidates the cache first."
  1897. (interactive "P")
  1898. (projectile--find-file invalidate-cache))
  1899. ;;;###autoload
  1900. (defun projectile-find-file-other-window (&optional invalidate-cache)
  1901. "Jump to a project's file using completion and show it in another window.
  1902. With a prefix arg INVALIDATE-CACHE invalidates the cache first."
  1903. (interactive "P")
  1904. (projectile--find-file invalidate-cache #'find-file-other-window))
  1905. ;;;###autoload
  1906. (defun projectile-find-file-other-frame (&optional invalidate-cache)
  1907. "Jump to a project's file using completion and show it in another frame.
  1908. With a prefix arg INVALIDATE-CACHE invalidates the cache first."
  1909. (interactive "P")
  1910. (projectile--find-file invalidate-cache #'find-file-other-frame))
  1911. ;;;###autoload
  1912. (defun projectile-toggle-project-read-only ()
  1913. "Toggle project read only."
  1914. (interactive)
  1915. (let ((inhibit-read-only t)
  1916. (val (not buffer-read-only))
  1917. (default-directory (projectile-acquire-root)))
  1918. (add-dir-local-variable nil 'buffer-read-only val)
  1919. (save-buffer)
  1920. (kill-buffer)
  1921. (when buffer-file-name
  1922. (read-only-mode (if val +1 -1))
  1923. (message "[%s] read-only-mode is %s" (projectile-project-name) (if val "on" "off")))))
  1924. ;;;; Sorting project files
  1925. (defun projectile-sort-files (files)
  1926. "Sort FILES according to `projectile-sort-order'."
  1927. (cl-case projectile-sort-order
  1928. (default files)
  1929. (recentf (projectile-sort-by-recentf-first files))
  1930. (recently-active (projectile-sort-by-recently-active-first files))
  1931. (modification-time (projectile-sort-by-modification-time files))
  1932. (access-time (projectile-sort-by-access-time files))))
  1933. (defun projectile-sort-by-recentf-first (files)
  1934. "Sort FILES by a recent first scheme."
  1935. (let ((project-recentf-files (projectile-recentf-files)))
  1936. (append project-recentf-files
  1937. (projectile-difference files project-recentf-files))))
  1938. (defun projectile-sort-by-recently-active-first (files)
  1939. "Sort FILES by most recently active buffers or opened files."
  1940. (let ((project-recently-active-files (projectile-recently-active-files)))
  1941. (append project-recently-active-files
  1942. (projectile-difference files project-recently-active-files))))
  1943. (defun projectile-sort-by-modification-time (files)
  1944. "Sort FILES by modification time."
  1945. (let ((default-directory (projectile-project-root)))
  1946. (cl-sort
  1947. (copy-sequence files)
  1948. (lambda (file1 file2)
  1949. (let ((file1-mtime (nth 5 (file-attributes file1)))
  1950. (file2-mtime (nth 5 (file-attributes file2))))
  1951. (not (time-less-p file1-mtime file2-mtime)))))))
  1952. (defun projectile-sort-by-access-time (files)
  1953. "Sort FILES by access time."
  1954. (let ((default-directory (projectile-project-root)))
  1955. (cl-sort
  1956. (copy-sequence files)
  1957. (lambda (file1 file2)
  1958. (let ((file1-atime (nth 4 (file-attributes file1)))
  1959. (file2-atime (nth 4 (file-attributes file2))))
  1960. (not (time-less-p file1-atime file2-atime)))))))
  1961. ;;;; Find directory in project functionality
  1962. (defun projectile--find-dir (invalidate-cache &optional dired-variant)
  1963. "Jump to a project's directory using completion.
  1964. With INVALIDATE-CACHE invalidates the cache first. With DIRED-VARIANT set to a
  1965. defun, use that instead of `dired'. A typical example of such a defun would be
  1966. `dired-other-window' or `dired-other-frame'"
  1967. (projectile-maybe-invalidate-cache invalidate-cache)
  1968. (let* ((project (projectile-acquire-root))
  1969. (dir (projectile-complete-dir project))
  1970. (dired-v (or dired-variant #'dired)))
  1971. (funcall dired-v (expand-file-name dir project))
  1972. (run-hooks 'projectile-find-dir-hook)))
  1973. ;;;###autoload
  1974. (defun projectile-find-dir (&optional invalidate-cache)
  1975. "Jump to a project's directory using completion.
  1976. With a prefix arg INVALIDATE-CACHE invalidates the cache first."
  1977. (interactive "P")
  1978. (projectile--find-dir invalidate-cache))
  1979. ;;;###autoload
  1980. (defun projectile-find-dir-other-window (&optional invalidate-cache)
  1981. "Jump to a project's directory in other window using completion.
  1982. With a prefix arg INVALIDATE-CACHE invalidates the cache first."
  1983. (interactive "P")
  1984. (projectile--find-dir invalidate-cache #'dired-other-window))
  1985. ;;;###autoload
  1986. (defun projectile-find-dir-other-frame (&optional invalidate-cache)
  1987. "Jump to a project's directory in other frame using completion.
  1988. With a prefix arg INVALIDATE-CACHE invalidates the cache first."
  1989. (interactive "P")
  1990. (projectile--find-dir invalidate-cache #'dired-other-frame))
  1991. (defun projectile-complete-dir (project)
  1992. (let ((project-dirs (projectile-project-dirs project)))
  1993. (projectile-completing-read
  1994. "Find dir: "
  1995. (if projectile-find-dir-includes-top-level
  1996. (append '("./") project-dirs)
  1997. project-dirs))))
  1998. ;;;###autoload
  1999. (defun projectile-find-test-file (&optional invalidate-cache)
  2000. "Jump to a project's test file using completion.
  2001. With a prefix arg INVALIDATE-CACHE invalidates the cache first."
  2002. (interactive "P")
  2003. (projectile-maybe-invalidate-cache invalidate-cache)
  2004. (let ((file (projectile-completing-read "Find test file: "
  2005. (projectile-current-project-test-files))))
  2006. (find-file (expand-file-name file (projectile-project-root)))))
  2007. (defun projectile-test-files (files)
  2008. "Return only the test FILES."
  2009. (cl-remove-if-not 'projectile-test-file-p files))
  2010. (defun projectile--merge-related-files-fns (related-files-fns)
  2011. "Merge multiple RELATED-FILES-FNS into one function."
  2012. (lambda (path)
  2013. (let (merged-plist)
  2014. (dolist (fn related-files-fns merged-plist)
  2015. (let ((plist (funcall fn path)))
  2016. (cl-loop for (key value) on plist by #'cddr
  2017. do (let ((values (if (consp value) value (list value))))
  2018. (if (plist-member merged-plist key)
  2019. (nconc (plist-get merged-plist key) values)
  2020. (setq merged-plist (plist-put merged-plist key values))))))))))
  2021. (defun projectile--related-files-plist (project-root file)
  2022. "Return a plist containing all related files information for FILE in PROJECT-ROOT."
  2023. (if-let ((rel-path (if (file-name-absolute-p file)
  2024. (file-relative-name file project-root)
  2025. file))
  2026. (custom-function (funcall projectile-related-files-fn-function (projectile-project-type))))
  2027. (funcall (cond ((functionp custom-function)
  2028. custom-function)
  2029. ((consp custom-function)
  2030. (projectile--merge-related-files-fns custom-function))
  2031. (t
  2032. (error "Unsupported value type of :related-files-fn")))
  2033. rel-path)))
  2034. (defun projectile--related-files-plist-by-kind (file kind)
  2035. "Return a plist containing :paths and/or :predicate of KIND for FILE."
  2036. (if-let ((project-root (projectile-project-root))
  2037. (plist (projectile--related-files-plist project-root file))
  2038. (has-kind? (plist-member plist kind)))
  2039. (let* ((kind-value (plist-get plist kind))
  2040. (values (if (cl-typep kind-value '(or string function))
  2041. (list kind-value)
  2042. kind-value))
  2043. (paths (delete-dups (cl-remove-if-not 'stringp values)))
  2044. (predicates (delete-dups (cl-remove-if-not 'functionp values))))
  2045. (append
  2046. ;; Make sure that :paths exists even with nil if there is no predicates
  2047. (when (or paths (null predicates))
  2048. (list :paths (cl-remove-if-not
  2049. (lambda (f)
  2050. (projectile-file-exists-p (expand-file-name f project-root)))
  2051. paths)))
  2052. (when predicates
  2053. (list :predicate (if (= 1 (length predicates))
  2054. (car predicates)
  2055. (lambda (other-file)
  2056. (cl-some (lambda (predicate)
  2057. (funcall predicate other-file))
  2058. predicates)))))))))
  2059. (defun projectile--related-files-from-plist (plist)
  2060. "Return a list of files matching to PLIST from current project files."
  2061. (let* ((predicate (plist-get plist :predicate))
  2062. (paths (plist-get plist :paths)))
  2063. (delete-dups (append
  2064. paths
  2065. (when predicate
  2066. (cl-remove-if-not predicate (projectile-current-project-files)))))))
  2067. (defun projectile--related-files-kinds(file)
  2068. "Return a list o keywords meaning available related kinds for FILE."
  2069. (if-let ((project-root (projectile-project-root))
  2070. (plist (projectile--related-files-plist project-root file)))
  2071. (cl-loop for key in plist by #'cddr
  2072. collect key)))
  2073. (defun projectile--related-files (file kind)
  2074. "Return a list of related files of KIND for FILE."
  2075. (projectile--related-files-from-plist (projectile--related-files-plist-by-kind file kind)))
  2076. (defun projectile--find-related-file (file &optional kind)
  2077. "Choose a file from files related to FILE as KIND.
  2078. If KIND is not provided, a list of possible kinds can be chosen."
  2079. (unless kind
  2080. (if-let ((available-kinds (projectile--related-files-kinds file)))
  2081. (setq kind (if (= (length available-kinds) 1)
  2082. (car available-kinds)
  2083. (intern (projectile-completing-read "Kind :" available-kinds))))
  2084. (error "No related files found")))
  2085. (if-let ((candidates (projectile--related-files file kind)))
  2086. (projectile-expand-root (projectile--choose-from-candidates candidates))
  2087. (error
  2088. "No matching related file as `%s' found for project type `%s'"
  2089. kind (projectile-project-type))))
  2090. ;;;###autoload
  2091. (defun projectile-find-related-file-other-window ()
  2092. "Open related file in other window."
  2093. (interactive)
  2094. (find-file-other-window
  2095. (projectile--find-related-file (buffer-file-name))))
  2096. ;;;###autoload
  2097. (defun projectile-find-related-file-other-frame ()
  2098. "Open related file in other frame."
  2099. (interactive)
  2100. (find-file-other-frame
  2101. (projectile--find-related-file (buffer-file-name))))
  2102. ;;;###autoload
  2103. (defun projectile-find-related-file()
  2104. "Open related file."
  2105. (interactive)
  2106. (find-file
  2107. (projectile--find-related-file (buffer-file-name))))
  2108. ;;;###autoload
  2109. (defun projectile-related-files-fn-groups(kind groups)
  2110. "Generate a related-files-fn which relates as KIND for files in each of GROUPS."
  2111. (lambda (path)
  2112. (if-let ((group-found (cl-find-if (lambda (group)
  2113. (member path group))
  2114. groups)))
  2115. (list kind (cl-remove path group-found :test 'equal)))))
  2116. ;;;###autoload
  2117. (defun projectile-related-files-fn-extensions(kind extensions)
  2118. "Generate a related-files-fn which relates as KIND for files having EXTENSIONS."
  2119. (lambda (path)
  2120. (let* ((ext (file-name-extension path))
  2121. (basename (file-name-base path))
  2122. (basename-regexp (regexp-quote basename)))
  2123. (when (member ext extensions)
  2124. (list kind (lambda (other-path)
  2125. (and (string-match-p basename-regexp other-path)
  2126. (equal basename (file-name-base other-path))
  2127. (let ((other-ext (file-name-extension other-path)))
  2128. (and (member other-ext extensions)
  2129. (not (equal other-ext ext)))))))))))
  2130. ;;;###autoload
  2131. (defun projectile-related-files-fn-test-with-prefix(extension test-prefix)
  2132. "Generate a related-files-fn which relates tests and impl for files with EXTENSION based on TEST-PREFIX."
  2133. (lambda (path)
  2134. (when (equal (file-name-extension path) extension)
  2135. (let* ((file-name (file-name-nondirectory path))
  2136. (find-impl? (string-prefix-p test-prefix file-name))
  2137. (file-name-to-find (if find-impl?
  2138. (substring file-name (length test-prefix))
  2139. (concat test-prefix file-name))))
  2140. (list (if find-impl? :impl :test)
  2141. (lambda (other-path)
  2142. (and (string-suffix-p file-name-to-find other-path)
  2143. (equal (file-name-nondirectory other-path) file-name-to-find))))))))
  2144. ;;;###autoload
  2145. (defun projectile-related-files-fn-test-with-suffix(extension test-suffix)
  2146. "Generate a related-files-fn which relates tests and impl for files with EXTENSION based on TEST-SUFFIX."
  2147. (lambda (path)
  2148. (when (equal (file-name-extension path) extension)
  2149. (let* ((file-name (file-name-nondirectory path))
  2150. (dot-ext (concat "." extension))
  2151. (suffix-ext (concat test-suffix dot-ext))
  2152. (find-impl? (string-suffix-p suffix-ext file-name))
  2153. (file-name-to-find (if find-impl?
  2154. (concat (substring file-name 0 (- (length suffix-ext)))
  2155. dot-ext)
  2156. (concat (substring file-name 0 (- (length dot-ext)))
  2157. suffix-ext))))
  2158. (list (if find-impl? :impl :test)
  2159. (lambda (other-path)
  2160. (and (string-suffix-p file-name-to-find other-path)
  2161. (equal (file-name-nondirectory other-path) file-name-to-find))))))))
  2162. (defun projectile-test-file-p (file)
  2163. "Check if FILE is a test file."
  2164. (let ((kinds (projectile--related-files-kinds file)))
  2165. (cond ((member :impl kinds) t)
  2166. ((member :test kinds) nil)
  2167. (t (or (cl-some (lambda (pat) (string-prefix-p pat (file-name-nondirectory file)))
  2168. (delq nil (list (funcall projectile-test-prefix-function (projectile-project-type)))))
  2169. (cl-some (lambda (pat) (string-suffix-p pat (file-name-sans-extension (file-name-nondirectory file))))
  2170. (delq nil (list (funcall projectile-test-suffix-function (projectile-project-type))))))))))
  2171. (defun projectile-current-project-test-files ()
  2172. "Return a list of test files for the current project."
  2173. (projectile-test-files (projectile-current-project-files)))
  2174. (defvar projectile-project-types nil
  2175. "An alist holding all project types that are known to Projectile.
  2176. The project types are symbols and they are linked to plists holding
  2177. the properties of the various project types.")
  2178. (cl-defun projectile-register-project-type
  2179. (project-type marker-files &key project-file compilation-dir configure compile install package test run test-suffix test-prefix src-dir test-dir related-files-fn)
  2180. "Register a project type with projectile.
  2181. A project type is defined by PROJECT-TYPE, a set of MARKER-FILES,
  2182. and optional keyword arguments:
  2183. PROJECT-FILE the main project file in the root project directory.
  2184. COMPILATION-DIR the directory to run the tests- and compilations in,
  2185. CONFIGURE which specifies a command that configures the project
  2186. `%s' in the command will be substituted with (projectile-project-root)
  2187. before the command is run,
  2188. COMPILE which specifies a command that builds the project,
  2189. TEST which specified a command that tests the project,
  2190. RUN which specifies a command that runs the project,
  2191. TEST-SUFFIX which specifies test file suffix, and
  2192. TEST-PREFIX which specifies test file prefix.
  2193. SRC-DIR which specifies the path to the source relative to the project root.
  2194. TEST-DIR which specifies the path to the tests relative to the project root.
  2195. RELATED-FILES-FN which specifies a custom function to find the related files such as
  2196. test/impl/other files as below:
  2197. CUSTOM-FUNCTION accepts FILE as relative path from the project root and returns
  2198. a plist containing :test, :impl or :other as key and the relative path/paths or
  2199. predicate as value. PREDICATE accepts a relative path as the input."
  2200. (let ((project-plist (list 'marker-files marker-files
  2201. 'project-file project-file
  2202. 'compilation-dir compilation-dir
  2203. 'configure-command configure
  2204. 'compile-command compile
  2205. 'test-command test
  2206. 'install-command install
  2207. 'package-command package
  2208. 'run-command run)))
  2209. ;; There is no way for the function to distinguish between an
  2210. ;; explicit argument of nil and an omitted argument. However, the
  2211. ;; body of the function is free to consider nil an abbreviation
  2212. ;; for some other meaningful value
  2213. (when (and project-file (not (member project-file projectile-project-root-files)))
  2214. (add-to-list 'projectile-project-root-files project-file))
  2215. (when test-suffix
  2216. (plist-put project-plist 'test-suffix test-suffix))
  2217. (when test-prefix
  2218. (plist-put project-plist 'test-prefix test-prefix))
  2219. (when src-dir
  2220. (plist-put project-plist 'src-dir src-dir))
  2221. (when test-dir
  2222. (plist-put project-plist 'test-dir test-dir))
  2223. (when related-files-fn
  2224. (plist-put project-plist 'related-files-fn related-files-fn))
  2225. (setq projectile-project-types
  2226. (cons `(,project-type . ,project-plist)
  2227. projectile-project-types))))
  2228. (defun projectile-cabal-project-p ()
  2229. "Check if a project contains *.cabal files but no stack.yaml file."
  2230. (and (projectile-verify-file-wildcard "?*.cabal")
  2231. (not (projectile-verify-file "stack.yaml"))))
  2232. (defun projectile-dotnet-project-p ()
  2233. "Check if a project contains a .NET project marker."
  2234. (or (projectile-verify-file-wildcard "?*.csproj")
  2235. (projectile-verify-file-wildcard "?*.fsproj")))
  2236. (defun projectile-go-project-p ()
  2237. "Check if a project contains Go source files."
  2238. (or (projectile-verify-file "go.mod")
  2239. (projectile-verify-file-wildcard "*.go")))
  2240. (defcustom projectile-go-project-test-function #'projectile-go-project-p
  2241. "Function to determine if project's type is go."
  2242. :group 'projectile
  2243. :type 'function
  2244. :package-version '(projectile . "1.0.0"))
  2245. ;;; Project type registration
  2246. ;;
  2247. ;; Project type detection happens in a reverse order with respect to
  2248. ;; project type registration (invocations of `projectile-register-project-type').
  2249. ;;
  2250. ;; As function-based project type detection is pretty slow, so it
  2251. ;; should be tried at the end if everything else failed (meaning here
  2252. ;; it should be listed first).
  2253. ;;
  2254. ;; Ideally common project types should be checked earlier than exotic ones.
  2255. ;; Function-based detection project type
  2256. (projectile-register-project-type 'haskell-cabal #'projectile-cabal-project-p
  2257. :compile "cabal build"
  2258. :test "cabal test"
  2259. :run "cabal run"
  2260. :test-suffix "Spec")
  2261. (projectile-register-project-type 'dotnet #'projectile-dotnet-project-p
  2262. :compile "dotnet build"
  2263. :run "dotnet run"
  2264. :test "dotnet test")
  2265. (projectile-register-project-type 'go projectile-go-project-test-function
  2266. :compile "go build"
  2267. :test "go test ./..."
  2268. :test-suffix "_test")
  2269. ;; File-based detection project types
  2270. ;; Universal
  2271. (projectile-register-project-type 'scons '("SConstruct")
  2272. :project-file "SConstruct"
  2273. :compile "scons"
  2274. :test "scons test"
  2275. :test-suffix "test")
  2276. (projectile-register-project-type 'meson '("meson.build")
  2277. :project-file "meson.build"
  2278. :compilation-dir "build"
  2279. :configure "meson %s"
  2280. :compile "ninja"
  2281. :test "ninja test")
  2282. (projectile-register-project-type 'nix '("default.nix")
  2283. :project-file "default.nix"
  2284. :compile "nix-build"
  2285. :test "nix-build")
  2286. (projectile-register-project-type 'bazel '("WORKSPACE")
  2287. :project-file "WORKSPACE"
  2288. :compile "bazel build"
  2289. :test "bazel test"
  2290. :run "bazel run")
  2291. ;; Make & CMake
  2292. (projectile-register-project-type 'make '("Makefile")
  2293. :project-file "Makefile"
  2294. :compile "make"
  2295. :test "make test"
  2296. :install "make install")
  2297. (projectile-register-project-type 'cmake '("CMakeLists.txt")
  2298. :project-file "CMakeLists.txt"
  2299. :compilation-dir "build"
  2300. :configure "cmake %s -B %s"
  2301. :compile "cmake --build ."
  2302. :test "ctest"
  2303. :install "cmake --build . --target install"
  2304. :package "cmake --build . --target package")
  2305. ;; PHP
  2306. (projectile-register-project-type 'php-symfony '("composer.json" "app" "src" "vendor")
  2307. :project-file "composer.json"
  2308. :compile "app/console server:run"
  2309. :test "phpunit -c app "
  2310. :test-suffix "Test")
  2311. ;; Erlang & Elixir
  2312. (projectile-register-project-type 'rebar '("rebar.config")
  2313. :project-file "rebar.config"
  2314. :compile "rebar"
  2315. :test "rebar eunit"
  2316. :test-suffix "_SUITE")
  2317. (projectile-register-project-type 'elixir '("mix.exs")
  2318. :project-file "mix.exs"
  2319. :compile "mix compile"
  2320. :src-dir "lib/"
  2321. :test "mix test"
  2322. :test-suffix "_test")
  2323. ;; JavaScript
  2324. (projectile-register-project-type 'grunt '("Gruntfile.js")
  2325. :project-file "Gruntfile.js"
  2326. :compile "grunt"
  2327. :test "grunt test")
  2328. (projectile-register-project-type 'gulp '("gulpfile.js")
  2329. :project-file "gulpfile.js"
  2330. :compile "gulp"
  2331. :test "gulp test")
  2332. (projectile-register-project-type 'npm '("package.json")
  2333. :project-file "package.json"
  2334. :compile "npm install"
  2335. :test "npm test"
  2336. :test-suffix ".test")
  2337. ;; Angular
  2338. (projectile-register-project-type 'angular '("angular.json" ".angular-cli.json")
  2339. :project-file "angular.json"
  2340. :compile "ng build"
  2341. :run "ng serve"
  2342. :test "ng test"
  2343. :test-suffix ".spec")
  2344. ;; Python
  2345. (projectile-register-project-type 'django '("manage.py")
  2346. :project-file "manage.py"
  2347. :compile "python manage.py runserver"
  2348. :test "python manage.py test"
  2349. :test-prefix "test_"
  2350. :test-suffix"_test")
  2351. (projectile-register-project-type 'python-pip '("requirements.txt")
  2352. :project-file "requirements.txt"
  2353. :compile "python setup.py build"
  2354. :test "python -m unittest discover"
  2355. :test-prefix "test_"
  2356. :test-suffix"_test")
  2357. (projectile-register-project-type 'python-pkg '("setup.py")
  2358. :project-file "setup.py"
  2359. :compile "python setup.py build"
  2360. :test "python -m unittest discover"
  2361. :test-prefix "test_"
  2362. :test-suffix"_test")
  2363. (projectile-register-project-type 'python-tox '("tox.ini")
  2364. :project-file "tox.ini"
  2365. :compile "tox -r --notest"
  2366. :test "tox"
  2367. :test-prefix "test_"
  2368. :test-suffix"_test")
  2369. (projectile-register-project-type 'python-pipenv '("Pipfile")
  2370. :project-file "Pipfile"
  2371. :compile "pipenv run build"
  2372. :test "pipenv run test"
  2373. :test-prefix "test_"
  2374. :test-suffix "_test")
  2375. (projectile-register-project-type 'python-poetry '("poetry.lock")
  2376. :project-file "poetry.lock"
  2377. :compile "poetry build"
  2378. :test "poetry run python -m unittest discover"
  2379. :test-prefix "test_"
  2380. :test-suffix "_test")
  2381. ;; Java & friends
  2382. (projectile-register-project-type 'maven '("pom.xml")
  2383. :project-file "pom.xml"
  2384. :compile "mvn clean install"
  2385. :test "mvn test"
  2386. :test-suffix "Test"
  2387. :src-dir "main/src/"
  2388. :test-dir "main/test/")
  2389. (projectile-register-project-type 'gradle '("build.gradle")
  2390. :project-file "build.gradle"
  2391. :compile "gradle build"
  2392. :test "gradle test"
  2393. :test-suffix "Spec")
  2394. (projectile-register-project-type 'gradlew '("gradlew")
  2395. :project-file "gradlew"
  2396. :compile "./gradlew build"
  2397. :test "./gradlew test"
  2398. :test-suffix "Spec")
  2399. (projectile-register-project-type 'grails '("application.properties" "grails-app")
  2400. :project-file "application.properties"
  2401. :compile "grails package"
  2402. :test "grails test-app"
  2403. :test-suffix "Spec")
  2404. ;; Scala
  2405. (projectile-register-project-type 'sbt '("build.sbt")
  2406. :project-file "build.sbt"
  2407. :compile "sbt compile"
  2408. :test "sbt test"
  2409. :test-suffix "Spec")
  2410. (projectile-register-project-type 'mill '("build.sc")
  2411. :project-file "build.sc"
  2412. :compile "mill all __.compile"
  2413. :test "mill all __.test"
  2414. :test-suffix "Test")
  2415. ;; Clojure
  2416. (projectile-register-project-type 'lein-test '("project.clj")
  2417. :project-file "project.clj"
  2418. :compile "lein compile"
  2419. :test "lein test"
  2420. :test-suffix "_test")
  2421. (projectile-register-project-type 'lein-midje '("project.clj" ".midje.clj")
  2422. :project-file "project.clj"
  2423. :compile "lein compile"
  2424. :test "lein midje"
  2425. :test-prefix "t_")
  2426. (projectile-register-project-type 'boot-clj '("build.boot")
  2427. :project-file "build.boot"
  2428. :compile "boot aot"
  2429. :test "boot test"
  2430. :test-suffix "_test")
  2431. (projectile-register-project-type 'clojure-cli '("deps.edn")
  2432. :project-file "deps.edn"
  2433. :test-suffix "_test")
  2434. (projectile-register-project-type 'bloop '(".bloop")
  2435. :project-file ".bloop"
  2436. :compile "bloop compile root"
  2437. :test "bloop test --propagate --reporter scalac root"
  2438. :src-dir "src/main/"
  2439. :test-dir "src/test/"
  2440. :test-suffix "Spec")
  2441. ;; Ruby
  2442. (projectile-register-project-type 'ruby-rspec '("Gemfile" "lib" "spec")
  2443. :project-file "Gemfile"
  2444. :compile "bundle exec rake"
  2445. :src-dir "lib/"
  2446. :test "bundle exec rspec"
  2447. :test-dir "spec/"
  2448. :test-suffix "_spec")
  2449. (projectile-register-project-type 'ruby-test '("Gemfile" "lib" "test")
  2450. :project-file "Gemfile"
  2451. :compile"bundle exec rake"
  2452. :src-dir "lib/"
  2453. :test "bundle exec rake test"
  2454. :test-suffix "_test")
  2455. ;; Rails needs to be registered after npm, otherwise `package.json` makes it `npm`.
  2456. ;; https://github.com/bbatsov/projectile/pull/1191
  2457. (projectile-register-project-type 'rails-test '("Gemfile" "app" "lib" "db" "config" "test")
  2458. :project-file "Gemfile"
  2459. :compile "bundle exec rails server"
  2460. :src-dir "lib/"
  2461. :test "bundle exec rake test"
  2462. :test-suffix "_test")
  2463. (projectile-register-project-type 'rails-rspec '("Gemfile" "app" "lib" "db" "config" "spec")
  2464. :project-file "Gemfile"
  2465. :compile "bundle exec rails server"
  2466. :src-dir "lib/"
  2467. :test "bundle exec rspec"
  2468. :test-dir "spec/"
  2469. :test-suffix "_spec")
  2470. ;; Crystal
  2471. (projectile-register-project-type 'crystal-spec '("shard.yml")
  2472. :project-file "shard.yml"
  2473. :src-dir "src/"
  2474. :test "crystal spec"
  2475. :test-dir "spec/"
  2476. :test-suffix "_spec")
  2477. ;; Emacs
  2478. (projectile-register-project-type 'emacs-cask '("Cask")
  2479. :project-file "Cask"
  2480. :compile "cask install"
  2481. :test-prefix "test-"
  2482. :test-suffix "-test")
  2483. (projectile-register-project-type 'emacs-eldev (lambda () (or (projectile-verify-file "Eldev")
  2484. (projectile-verify-file "Eldev-local")))
  2485. :project-file "Eldev"
  2486. :compile "eldev compile"
  2487. :test "eldev test"
  2488. :run "eldev emacs"
  2489. :package "eldev package")
  2490. ;; R
  2491. (projectile-register-project-type 'r '("DESCRIPTION")
  2492. :project-file "DESCRIPTION"
  2493. :compile "R CMD INSTALL --with-keep.source ."
  2494. :test (concat "R CMD check -o " temporary-file-directory " ."))
  2495. ;; Haskell
  2496. (projectile-register-project-type 'haskell-stack '("stack.yaml")
  2497. :project-file "stack.yaml"
  2498. :compile "stack build"
  2499. :test "stack build --test"
  2500. :test-suffix "Spec")
  2501. ;; Rust
  2502. (projectile-register-project-type 'rust-cargo '("Cargo.toml")
  2503. :project-file "Cargo.toml"
  2504. :compile "cargo build"
  2505. :test "cargo test"
  2506. :run "cargo run")
  2507. ;; Racket
  2508. (projectile-register-project-type 'racket '("info.rkt")
  2509. :project-file "info.rkt"
  2510. :test "raco test .")
  2511. ;; Dart
  2512. (projectile-register-project-type 'dart '("pubspec.yaml")
  2513. :project-file "pubspec.yaml"
  2514. :compile "pub get"
  2515. :test "pub run test"
  2516. :run "dart"
  2517. :test-suffix "_test.dart")
  2518. ;; OCaml
  2519. (projectile-register-project-type 'ocaml-dune '("dune-project")
  2520. :project-file "dune-project"
  2521. :compile "dune build"
  2522. :test "dune runtest")
  2523. (defvar-local projectile-project-type nil
  2524. "Buffer local var for overriding the auto-detected project type.
  2525. Normally you'd set this from .dir-locals.el.")
  2526. (put 'projectile-project-type 'safe-local-variable #'symbolp)
  2527. (defun projectile-detect-project-type ()
  2528. "Detect the type of the current project.
  2529. Fallsback to a generic project type when the type can't be determined."
  2530. (let ((project-type
  2531. (or (car (cl-find-if
  2532. (lambda (project-type-record)
  2533. (let ((project-type (car project-type-record))
  2534. (marker (plist-get (cdr project-type-record) 'marker-files)))
  2535. (if (functionp marker)
  2536. (and (funcall marker) project-type)
  2537. (and (projectile-verify-files marker) project-type))))
  2538. projectile-project-types))
  2539. 'generic)))
  2540. (puthash (projectile-project-root) project-type projectile-project-type-cache)
  2541. project-type))
  2542. (defun projectile-project-type (&optional dir)
  2543. "Determine a project's type based on its structure.
  2544. When DIR is specified it checks it, otherwise it acts
  2545. on the current project.
  2546. The project type is cached for improved performance."
  2547. (if projectile-project-type
  2548. projectile-project-type
  2549. (let* ((dir (or dir default-directory))
  2550. (project-root (projectile-project-root dir)))
  2551. (if project-root
  2552. (or (gethash project-root projectile-project-type-cache)
  2553. (projectile-detect-project-type))
  2554. ;; if we're not in a project we just return nil
  2555. nil))))
  2556. ;;;###autoload
  2557. (defun projectile-project-info ()
  2558. "Display info for current project."
  2559. (interactive)
  2560. (message "Project dir: %s ## Project VCS: %s ## Project type: %s"
  2561. (projectile-project-root)
  2562. (projectile-project-vcs)
  2563. (projectile-project-type)))
  2564. (defun projectile-verify-files (files)
  2565. "Check whether all FILES exist in the current project."
  2566. (cl-every #'projectile-verify-file files))
  2567. (defun projectile-verify-file (file)
  2568. "Check whether FILE exists in the current project."
  2569. (file-exists-p (projectile-expand-root file)))
  2570. (defun projectile-verify-file-wildcard (file)
  2571. "Check whether FILE exists in the current project.
  2572. Expands wildcards using `file-expand-wildcards' before checking."
  2573. (file-expand-wildcards (projectile-expand-root file)))
  2574. (defun projectile-project-vcs (&optional project-root)
  2575. "Determine the VCS used by the project if any.
  2576. PROJECT-ROOT is the targeted directory. If nil, use
  2577. `projectile-project-root'."
  2578. (or project-root (setq project-root (projectile-project-root)))
  2579. (cond
  2580. ((projectile-file-exists-p (expand-file-name ".git" project-root)) 'git)
  2581. ((projectile-file-exists-p (expand-file-name ".hg" project-root)) 'hg)
  2582. ((projectile-file-exists-p (expand-file-name ".fslckout" project-root)) 'fossil)
  2583. ((projectile-file-exists-p (expand-file-name "_FOSSIL_" project-root)) 'fossil)
  2584. ((projectile-file-exists-p (expand-file-name ".bzr" project-root)) 'bzr)
  2585. ((projectile-file-exists-p (expand-file-name "_darcs" project-root)) 'darcs)
  2586. ((projectile-file-exists-p (expand-file-name ".svn" project-root)) 'svn)
  2587. ((projectile-locate-dominating-file project-root ".git") 'git)
  2588. ((projectile-locate-dominating-file project-root ".hg") 'hg)
  2589. ((projectile-locate-dominating-file project-root ".fslckout") 'fossil)
  2590. ((projectile-locate-dominating-file project-root "_FOSSIL_") 'fossil)
  2591. ((projectile-locate-dominating-file project-root ".bzr") 'bzr)
  2592. ((projectile-locate-dominating-file project-root "_darcs") 'darcs)
  2593. ((projectile-locate-dominating-file project-root ".svn") 'svn)
  2594. (t 'none)))
  2595. (defun projectile--test-name-for-impl-name (impl-file-path)
  2596. "Determine the name of the test file for IMPL-FILE-PATH."
  2597. (let* ((project-type (projectile-project-type))
  2598. (impl-file-name (file-name-sans-extension (file-name-nondirectory impl-file-path)))
  2599. (impl-file-ext (file-name-extension impl-file-path))
  2600. (test-prefix (funcall projectile-test-prefix-function project-type))
  2601. (test-suffix (funcall projectile-test-suffix-function project-type)))
  2602. (cond
  2603. (test-prefix (concat test-prefix impl-file-name "." impl-file-ext))
  2604. (test-suffix (concat impl-file-name test-suffix "." impl-file-ext))
  2605. (t (error "Project type `%s' not supported!" project-type)))))
  2606. (defun projectile-create-test-file-for (impl-file-path)
  2607. "Create a test file for IMPL-FILE-PATH."
  2608. (let* ((test-file (projectile--test-name-for-impl-name impl-file-path))
  2609. (project-root (projectile-project-root))
  2610. (relative-dir (file-name-directory (file-relative-name impl-file-path project-root)))
  2611. (src-dir-name (projectile-src-directory (projectile-project-type)))
  2612. (test-dir-name (projectile-test-directory (projectile-project-type)))
  2613. (test-dir (expand-file-name (replace-regexp-in-string src-dir-name test-dir-name relative-dir) project-root))
  2614. (test-path (expand-file-name test-file test-dir)))
  2615. (unless (file-exists-p test-path)
  2616. (progn (unless (file-exists-p test-dir)
  2617. (make-directory test-dir :create-parents))
  2618. test-path))))
  2619. (defun projectile-find-implementation-or-test (file-name)
  2620. "Given a FILE-NAME return the matching implementation or test filename.
  2621. If `projectile-create-missing-test-files' is non-nil, create the missing
  2622. test file."
  2623. (unless file-name (error "The current buffer is not visiting a file"))
  2624. (if (projectile-test-file-p file-name)
  2625. ;; find the matching impl file
  2626. (let ((impl-file (projectile-find-matching-file file-name)))
  2627. (if impl-file
  2628. (projectile-expand-root impl-file)
  2629. (error
  2630. "No matching source file found for project type `%s'"
  2631. (projectile-project-type))))
  2632. ;; find the matching test file
  2633. (let ((test-file (projectile-find-matching-test file-name)))
  2634. (if test-file
  2635. (projectile-expand-root test-file)
  2636. (if projectile-create-missing-test-files
  2637. (projectile-create-test-file-for file-name)
  2638. (error "No matching test file found for project type `%s'"
  2639. (projectile-project-type)))))))
  2640. ;;;###autoload
  2641. (defun projectile-find-implementation-or-test-other-window ()
  2642. "Open matching implementation or test file in other window."
  2643. (interactive)
  2644. (find-file-other-window
  2645. (projectile-find-implementation-or-test (buffer-file-name))))
  2646. ;;;###autoload
  2647. (defun projectile-find-implementation-or-test-other-frame ()
  2648. "Open matching implementation or test file in other frame."
  2649. (interactive)
  2650. (find-file-other-frame
  2651. (projectile-find-implementation-or-test (buffer-file-name))))
  2652. ;;;###autoload
  2653. (defun projectile-toggle-between-implementation-and-test ()
  2654. "Toggle between an implementation file and its test file."
  2655. (interactive)
  2656. (find-file
  2657. (projectile-find-implementation-or-test (buffer-file-name))))
  2658. (defun projectile-project-type-attribute (project-type key &optional default-value)
  2659. "Return the value of some PROJECT-TYPE attribute identified by KEY.
  2660. Fallback to DEFAULT-VALUE for missing attributes."
  2661. (let ((project (alist-get project-type projectile-project-types)))
  2662. (if (and project (plist-member project key))
  2663. (plist-get project key)
  2664. default-value)))
  2665. (defun projectile-test-prefix (project-type)
  2666. "Find default test files prefix based on PROJECT-TYPE."
  2667. (projectile-project-type-attribute project-type 'test-prefix))
  2668. (defun projectile-test-suffix (project-type)
  2669. "Find default test files suffix based on PROJECT-TYPE."
  2670. (projectile-project-type-attribute project-type 'test-suffix))
  2671. (defun projectile-related-files-fn (project-type)
  2672. "Find relative file based on PROJECT-TYPE."
  2673. (projectile-project-type-attribute project-type 'related-files-fn))
  2674. (defun projectile-src-directory (project-type)
  2675. "Find default src directory based on PROJECT-TYPE."
  2676. (projectile-project-type-attribute project-type 'src-dir "src/"))
  2677. (defun projectile-test-directory (project-type)
  2678. "Find default test directory based on PROJECT-TYPE."
  2679. (projectile-project-type-attribute project-type 'test-dir "test/"))
  2680. (defun projectile-dirname-matching-count (a b)
  2681. "Count matching dirnames ascending file paths in A and B."
  2682. (setq a (reverse (split-string (or (file-name-directory a) "") "/" t))
  2683. b (reverse (split-string (or (file-name-directory b) "") "/" t)))
  2684. (let ((common 0))
  2685. (while (and a b (string-equal (pop a) (pop b)))
  2686. (setq common (1+ common)))
  2687. common))
  2688. (defun projectile-group-file-candidates (file candidates)
  2689. "Group file candidates by dirname matching count."
  2690. (cl-sort (copy-sequence
  2691. (let (value result)
  2692. (while (setq value (pop candidates))
  2693. (let* ((key (projectile-dirname-matching-count file value))
  2694. (kv (assoc key result)))
  2695. (if kv
  2696. (setcdr kv (cons value (cdr kv)))
  2697. (push (list key value) result))))
  2698. (mapcar (lambda (x)
  2699. (cons (car x) (nreverse (cdr x))))
  2700. (nreverse result))))
  2701. (lambda (a b) (> (car a) (car b)))))
  2702. (defun projectile--best-or-all-candidates-based-on-parents-dirs (file candidates)
  2703. "Return a list containing the best one one for FILE from CANDIDATES or all CANDIDATES."
  2704. (let ((grouped-candidates (projectile-group-file-candidates file candidates)))
  2705. (if (= (length (car grouped-candidates)) 2)
  2706. (list (car (last (car grouped-candidates))))
  2707. (apply #'append (mapcar #'cdr grouped-candidates)))))
  2708. (defun projectile--impl-to-test-predicate (impl-file)
  2709. "Return a predicate, which returns t for any test files for IMPL-FILE."
  2710. (let* ((basename (file-name-sans-extension (file-name-nondirectory impl-file)))
  2711. (test-prefix (funcall projectile-test-prefix-function (projectile-project-type)))
  2712. (test-suffix (funcall projectile-test-suffix-function (projectile-project-type)))
  2713. (prefix-name (when test-prefix (concat test-prefix basename)))
  2714. (suffix-name (when test-suffix (concat basename test-suffix))))
  2715. (lambda (current-file)
  2716. (let ((name (file-name-sans-extension (file-name-nondirectory current-file))))
  2717. (or (string-equal prefix-name name)
  2718. (string-equal suffix-name name))))))
  2719. (defun projectile--find-matching-test (impl-file)
  2720. "Return a list of test files for IMPL-FILE."
  2721. (if-let ((plist (projectile--related-files-plist-by-kind impl-file :test)))
  2722. (projectile--related-files-from-plist plist)
  2723. (if-let ((predicate (projectile--impl-to-test-predicate impl-file)))
  2724. (projectile--best-or-all-candidates-based-on-parents-dirs
  2725. impl-file (cl-remove-if-not predicate (projectile-current-project-files))))))
  2726. (defun projectile--test-to-impl-predicate (test-file)
  2727. "Return a predicate, which returns t for any impl files for TEST-FILE."
  2728. (let* ((basename (file-name-sans-extension (file-name-nondirectory test-file)))
  2729. (test-prefix (funcall projectile-test-prefix-function (projectile-project-type)))
  2730. (test-suffix (funcall projectile-test-suffix-function (projectile-project-type))))
  2731. (lambda (current-file)
  2732. (let ((name (file-name-nondirectory (file-name-sans-extension current-file))))
  2733. (or (when test-prefix (string-equal (concat test-prefix name) basename))
  2734. (when test-suffix (string-equal (concat name test-suffix) basename)))))))
  2735. (defun projectile--find-matching-file (test-file)
  2736. "Return a list of impl files tested by TEST-FILE."
  2737. (if-let ((plist (projectile--related-files-plist-by-kind test-file :impl)))
  2738. (projectile--related-files-from-plist plist)
  2739. (if-let ((predicate (projectile--test-to-impl-predicate test-file)))
  2740. (projectile--best-or-all-candidates-based-on-parents-dirs
  2741. test-file (cl-remove-if-not predicate (projectile-current-project-files))))))
  2742. (defun projectile--choose-from-candidates (candidates)
  2743. "Choose one item from CANDIDATES."
  2744. (if (= (length candidates) 1)
  2745. (car candidates)
  2746. (projectile-completing-read "Switch to: " candidates)))
  2747. (defun projectile-find-matching-test (impl-file)
  2748. "Compute the name of the test matching IMPL-FILE."
  2749. (if-let ((candidates (projectile--find-matching-test impl-file)))
  2750. (projectile--choose-from-candidates candidates)))
  2751. (defun projectile-find-matching-file (test-file)
  2752. "Compute the name of a file matching TEST-FILE."
  2753. (if-let ((candidates (projectile--find-matching-file test-file)))
  2754. (projectile--choose-from-candidates candidates)))
  2755. (defun projectile-grep-default-files ()
  2756. "Try to find a default pattern for `projectile-grep'.
  2757. This is a subset of `grep-read-files', where either a matching entry from
  2758. `grep-files-aliases' or file name extension pattern is returned."
  2759. (when buffer-file-name
  2760. (let* ((fn (file-name-nondirectory buffer-file-name))
  2761. (default-alias
  2762. (let ((aliases (remove (assoc "all" grep-files-aliases)
  2763. grep-files-aliases))
  2764. alias)
  2765. (while aliases
  2766. (setq alias (car aliases)
  2767. aliases (cdr aliases))
  2768. (if (string-match (mapconcat
  2769. #'wildcard-to-regexp
  2770. (split-string (cdr alias) nil t)
  2771. "\\|")
  2772. fn)
  2773. (setq aliases nil)
  2774. (setq alias nil)))
  2775. (cdr alias)))
  2776. (default-extension
  2777. (let ((ext (file-name-extension fn)))
  2778. (and ext (concat "*." ext)))))
  2779. (or default-alias default-extension))))
  2780. (defun projectile--globally-ignored-file-suffixes-glob ()
  2781. "Return ignored file suffixes as a list of glob patterns."
  2782. (mapcar (lambda (pat) (concat "*" pat)) projectile-globally-ignored-file-suffixes))
  2783. (defun projectile--read-search-string-with-default (prefix-label)
  2784. (let* ((prefix-label (projectile-prepend-project-name prefix-label))
  2785. (default-value (projectile-symbol-or-selection-at-point))
  2786. (default-label (if (or (not default-value)
  2787. (string= default-value ""))
  2788. ""
  2789. (format " (default %s)" default-value))))
  2790. (read-string (format "%s%s: " prefix-label default-label) nil nil default-value)))
  2791. (defvar projectile-grep-find-ignored-paths)
  2792. (defvar projectile-grep-find-unignored-paths)
  2793. (defvar projectile-grep-find-ignored-patterns)
  2794. (defvar projectile-grep-find-unignored-patterns)
  2795. (defun projectile-rgrep-default-command (regexp files dir)
  2796. "Compute the command for \\[rgrep] to use by default.
  2797. Extension of the Emacs 25.1 implementation of `rgrep-default-command', with
  2798. which it shares its arglist."
  2799. (require 'find-dired) ; for `find-name-arg'
  2800. (grep-expand-template
  2801. grep-find-template
  2802. regexp
  2803. (concat (shell-quote-argument "(")
  2804. " " find-name-arg " "
  2805. (mapconcat
  2806. #'shell-quote-argument
  2807. (split-string files)
  2808. (concat " -o " find-name-arg " "))
  2809. " "
  2810. (shell-quote-argument ")"))
  2811. dir
  2812. (concat
  2813. (and grep-find-ignored-directories
  2814. (concat "-type d "
  2815. (shell-quote-argument "(")
  2816. ;; we should use shell-quote-argument here
  2817. " -path "
  2818. (mapconcat
  2819. #'identity
  2820. (delq nil (mapcar
  2821. #'(lambda (ignore)
  2822. (cond ((stringp ignore)
  2823. (shell-quote-argument
  2824. (concat "*/" ignore)))
  2825. ((consp ignore)
  2826. (and (funcall (car ignore) dir)
  2827. (shell-quote-argument
  2828. (concat "*/"
  2829. (cdr ignore)))))))
  2830. grep-find-ignored-directories))
  2831. " -o -path ")
  2832. " "
  2833. (shell-quote-argument ")")
  2834. " -prune -o "))
  2835. (and grep-find-ignored-files
  2836. (concat (shell-quote-argument "!") " -type d "
  2837. (shell-quote-argument "(")
  2838. ;; we should use shell-quote-argument here
  2839. " -name "
  2840. (mapconcat
  2841. #'(lambda (ignore)
  2842. (cond ((stringp ignore)
  2843. (shell-quote-argument ignore))
  2844. ((consp ignore)
  2845. (and (funcall (car ignore) dir)
  2846. (shell-quote-argument
  2847. (cdr ignore))))))
  2848. grep-find-ignored-files
  2849. " -o -name ")
  2850. " "
  2851. (shell-quote-argument ")")
  2852. " -prune -o "))
  2853. (and projectile-grep-find-ignored-paths
  2854. (concat (shell-quote-argument "(")
  2855. " -path "
  2856. (mapconcat
  2857. (lambda (ignore) (shell-quote-argument
  2858. (concat "./" ignore)))
  2859. projectile-grep-find-ignored-paths
  2860. " -o -path ")
  2861. " "
  2862. (shell-quote-argument ")")
  2863. " -prune -o "))
  2864. (and projectile-grep-find-ignored-patterns
  2865. (concat (shell-quote-argument "(")
  2866. (and (or projectile-grep-find-unignored-paths
  2867. projectile-grep-find-unignored-patterns)
  2868. (concat " "
  2869. (shell-quote-argument "(")))
  2870. " -path "
  2871. (mapconcat
  2872. (lambda (ignore)
  2873. (shell-quote-argument
  2874. (if (string-prefix-p "*" ignore) ignore
  2875. (concat "*/" ignore))))
  2876. projectile-grep-find-ignored-patterns
  2877. " -o -path ")
  2878. (and (or projectile-grep-find-unignored-paths
  2879. projectile-grep-find-unignored-patterns)
  2880. (concat " "
  2881. (shell-quote-argument ")")
  2882. " -a "
  2883. (shell-quote-argument "!")
  2884. " "
  2885. (shell-quote-argument "(")
  2886. (and projectile-grep-find-unignored-paths
  2887. (concat " -path "
  2888. (mapconcat
  2889. (lambda (ignore) (shell-quote-argument
  2890. (concat "./" ignore)))
  2891. projectile-grep-find-unignored-paths
  2892. " -o -path ")))
  2893. (and projectile-grep-find-unignored-paths
  2894. projectile-grep-find-unignored-patterns
  2895. " -o")
  2896. (and projectile-grep-find-unignored-patterns
  2897. (concat " -path "
  2898. (mapconcat
  2899. (lambda (ignore)
  2900. (shell-quote-argument
  2901. (if (string-prefix-p "*" ignore) ignore
  2902. (concat "*/" ignore))))
  2903. projectile-grep-find-unignored-patterns
  2904. " -o -path ")))
  2905. " "
  2906. (shell-quote-argument ")")))
  2907. " "
  2908. (shell-quote-argument ")")
  2909. " -prune -o ")))))
  2910. ;;;###autoload
  2911. (defun projectile-grep (&optional regexp arg)
  2912. "Perform rgrep in the project.
  2913. With a prefix ARG asks for files (globbing-aware) which to grep in.
  2914. With prefix ARG of `-' (such as `M--'), default the files (without prompt),
  2915. to `projectile-grep-default-files'.
  2916. With REGEXP given, don't query the user for a regexp."
  2917. (interactive "i\nP")
  2918. (require 'grep) ;; for `rgrep'
  2919. (let* ((roots (projectile-get-project-directories (projectile-acquire-root)))
  2920. (search-regexp (or regexp
  2921. (projectile--read-search-string-with-default "Grep for")))
  2922. (files (and arg (or (and (equal current-prefix-arg '-)
  2923. (projectile-grep-default-files))
  2924. (read-string (projectile-prepend-project-name "Grep in: ")
  2925. (projectile-grep-default-files))))))
  2926. (dolist (root-dir roots)
  2927. (require 'vc-git) ;; for `vc-git-grep'
  2928. ;; in git projects users have the option to use `vc-git-grep' instead of `rgrep'
  2929. (if (and (eq (projectile-project-vcs) 'git)
  2930. projectile-use-git-grep
  2931. (fboundp 'vc-git-grep))
  2932. (vc-git-grep search-regexp (or files "") root-dir)
  2933. ;; paths for find-grep should relative and without trailing /
  2934. (let ((grep-find-ignored-files
  2935. (cl-union (projectile--globally-ignored-file-suffixes-glob)
  2936. grep-find-ignored-files))
  2937. (projectile-grep-find-ignored-paths
  2938. (append (mapcar (lambda (f) (directory-file-name (file-relative-name f root-dir)))
  2939. (projectile-ignored-directories))
  2940. (mapcar (lambda (file)
  2941. (file-relative-name file root-dir))
  2942. (projectile-ignored-files))))
  2943. (projectile-grep-find-unignored-paths
  2944. (append (mapcar (lambda (f) (directory-file-name (file-relative-name f root-dir)))
  2945. (projectile-unignored-directories))
  2946. (mapcar (lambda (file)
  2947. (file-relative-name file root-dir))
  2948. (projectile-unignored-files))))
  2949. (projectile-grep-find-ignored-patterns (projectile-patterns-to-ignore))
  2950. (projectile-grep-find-unignored-patterns (projectile-patterns-to-ensure)))
  2951. (grep-compute-defaults)
  2952. (cl-letf (((symbol-function 'rgrep-default-command) #'projectile-rgrep-default-command))
  2953. (rgrep search-regexp (or files "* .*") root-dir)
  2954. (when (get-buffer "*grep*")
  2955. ;; When grep is using a global *grep* buffer rename it to be
  2956. ;; scoped to the current root to allow multiple concurrent grep
  2957. ;; operations, one per root
  2958. (with-current-buffer "*grep*"
  2959. (rename-buffer (concat "*grep <" root-dir ">*"))))))))
  2960. (run-hooks 'projectile-grep-finished-hook)))
  2961. ;;;###autoload
  2962. (defun projectile-ag (search-term &optional arg)
  2963. "Run an ag search with SEARCH-TERM in the project.
  2964. With an optional prefix argument ARG SEARCH-TERM is interpreted as a
  2965. regular expression."
  2966. (interactive
  2967. (list (projectile--read-search-string-with-default
  2968. (format "Ag %ssearch for" (if current-prefix-arg "regexp " "")))
  2969. current-prefix-arg))
  2970. (if (require 'ag nil 'noerror)
  2971. (let ((ag-command (if arg 'ag-regexp 'ag))
  2972. (ag-ignore-list (delq nil
  2973. (delete-dups
  2974. (append
  2975. ag-ignore-list
  2976. (projectile--globally-ignored-file-suffixes-glob)
  2977. ;; ag supports git ignore files directly
  2978. (unless (eq (projectile-project-vcs) 'git)
  2979. (append (projectile-ignored-files-rel)
  2980. (projectile-ignored-directories-rel)
  2981. grep-find-ignored-files
  2982. grep-find-ignored-directories
  2983. '()))))))
  2984. ;; reset the prefix arg, otherwise it will affect the ag-command
  2985. (current-prefix-arg nil))
  2986. (funcall ag-command search-term (projectile-project-root)))
  2987. (error "Package 'ag' is not available")))
  2988. ;;;###autoload
  2989. (defun projectile-ripgrep (search-term &optional arg)
  2990. "Run a Ripgrep search with `SEARCH-TERM' at current project root.
  2991. With an optional prefix argument ARG SEARCH-TERM is interpreted as a
  2992. regular expression."
  2993. (interactive
  2994. (list (projectile--read-search-string-with-default
  2995. (format "Ripgrep %ssearch for" (if current-prefix-arg "regexp " "")))
  2996. current-prefix-arg))
  2997. (if (require 'ripgrep nil 'noerror)
  2998. (let ((args (mapcar (lambda (val) (concat "--glob !" val))
  2999. (append projectile-globally-ignored-files
  3000. projectile-globally-ignored-directories))))
  3001. (ripgrep-regexp search-term
  3002. (projectile-project-root)
  3003. (if arg
  3004. args
  3005. (cons "--fixed-strings" args))))
  3006. (error "Package `ripgrep' is not available")))
  3007. (defun projectile-tags-exclude-patterns ()
  3008. "Return a string with exclude patterns for ctags."
  3009. (mapconcat (lambda (pattern) (format "--exclude=\"%s\""
  3010. (directory-file-name pattern)))
  3011. (projectile-ignored-directories-rel) " "))
  3012. ;;;###autoload
  3013. (defun projectile-regenerate-tags ()
  3014. "Regenerate the project's [e|g]tags."
  3015. (interactive)
  3016. (if (and (boundp 'ggtags-mode)
  3017. (memq projectile-tags-backend '(auto ggtags)))
  3018. (progn
  3019. (let* ((ggtags-project-root (projectile-acquire-root))
  3020. (default-directory ggtags-project-root))
  3021. (ggtags-ensure-project)
  3022. (ggtags-update-tags t)))
  3023. (let* ((project-root (projectile-acquire-root))
  3024. (tags-exclude (projectile-tags-exclude-patterns))
  3025. (default-directory project-root)
  3026. (tags-file (expand-file-name projectile-tags-file-name))
  3027. (command (format projectile-tags-command
  3028. tags-file
  3029. tags-exclude
  3030. ;; Use directory file name for MSYS2 compatibility.
  3031. ;; See https://github.com/bbatsov/projectile/issues/1377 for more details
  3032. (directory-file-name default-directory)))
  3033. shell-output exit-code)
  3034. (with-temp-buffer
  3035. (setq exit-code
  3036. (call-process-shell-command command nil (current-buffer))
  3037. shell-output (string-trim
  3038. (buffer-substring (point-min) (point-max)))))
  3039. (unless (zerop exit-code)
  3040. (error shell-output))
  3041. (visit-tags-table tags-file)
  3042. (message "Regenerated %s" tags-file))))
  3043. (defun projectile-visit-project-tags-table ()
  3044. "Visit the current project's tags table."
  3045. (when (projectile-project-p)
  3046. (let ((tags-file (projectile-expand-root projectile-tags-file-name)))
  3047. (when (file-exists-p tags-file)
  3048. (with-demoted-errors "Error loading tags-file: %s"
  3049. (visit-tags-table tags-file t))))))
  3050. (defun projectile-determine-find-tag-fn ()
  3051. "Determine which function to use for a call to `projectile-find-tag'."
  3052. (or
  3053. (cond
  3054. ((eq projectile-tags-backend 'auto)
  3055. (cond
  3056. ((fboundp 'ggtags-find-tag-dwim)
  3057. 'ggtags-find-tag-dwim)
  3058. ((fboundp 'xref-find-definitions)
  3059. 'xref-find-definitions)
  3060. ((fboundp 'etags-select-find-tag)
  3061. 'etags-select-find-tag)))
  3062. ((eq projectile-tags-backend 'xref)
  3063. (when (fboundp 'xref-find-definitions)
  3064. 'xref-find-definitions))
  3065. ((eq projectile-tags-backend 'ggtags)
  3066. (when (fboundp 'ggtags-find-tag-dwim)
  3067. 'ggtags-find-tag-dwim))
  3068. ((eq projectile-tags-backend 'etags-select)
  3069. (when (fboundp 'etags-select-find-tag)
  3070. 'etags-select-find-tag)))
  3071. 'find-tag))
  3072. ;;;###autoload
  3073. (defun projectile-find-tag ()
  3074. "Find tag in project."
  3075. (interactive)
  3076. (projectile-visit-project-tags-table)
  3077. ;; Auto-discover the user's preference for tags
  3078. (let ((find-tag-fn (projectile-determine-find-tag-fn)))
  3079. (call-interactively find-tag-fn)))
  3080. (defmacro projectile-with-default-dir (dir &rest body)
  3081. "Invoke in DIR the BODY."
  3082. (declare (debug t) (indent 1))
  3083. `(let ((default-directory ,dir))
  3084. ,@body))
  3085. ;;;###autoload
  3086. (defun projectile-run-command-in-root ()
  3087. "Invoke `execute-extended-command' in the project's root."
  3088. (interactive)
  3089. (projectile-with-default-dir (projectile-acquire-root)
  3090. (call-interactively #'execute-extended-command)))
  3091. ;;;###autoload
  3092. (defun projectile-run-shell-command-in-root ()
  3093. "Invoke `shell-command' in the project's root."
  3094. (interactive)
  3095. (projectile-with-default-dir (projectile-acquire-root)
  3096. (call-interactively #'shell-command)))
  3097. ;;;###autoload
  3098. (defun projectile-run-async-shell-command-in-root ()
  3099. "Invoke `async-shell-command' in the project's root."
  3100. (interactive)
  3101. (projectile-with-default-dir (projectile-acquire-root)
  3102. (call-interactively #'async-shell-command)))
  3103. ;;;###autoload
  3104. (defun projectile-run-gdb ()
  3105. "Invoke `gdb' in the project's root."
  3106. (interactive)
  3107. (projectile-with-default-dir (projectile-acquire-root)
  3108. (call-interactively 'gdb)))
  3109. ;;;###autoload
  3110. (defun projectile-run-shell (&optional arg)
  3111. "Invoke `shell' in the project's root.
  3112. Switch to the project specific shell buffer if it already exists.
  3113. Use a prefix argument ARG to indicate creation of a new process instead."
  3114. (interactive "P")
  3115. (projectile-with-default-dir (projectile-acquire-root)
  3116. (shell (projectile-generate-process-name "shell" arg))))
  3117. ;;;###autoload
  3118. (defun projectile-run-eshell (&optional arg)
  3119. "Invoke `eshell' in the project's root.
  3120. Switch to the project specific eshell buffer if it already exists.
  3121. Use a prefix argument ARG to indicate creation of a new process instead."
  3122. (interactive "P")
  3123. (projectile-with-default-dir (projectile-acquire-root)
  3124. (let ((eshell-buffer-name (projectile-generate-process-name "eshell" arg)))
  3125. (eshell))))
  3126. ;;;###autoload
  3127. (defun projectile-run-ielm (&optional arg)
  3128. "Invoke `ielm' in the project's root.
  3129. Switch to the project specific ielm buffer if it already exists.
  3130. Use a prefix argument ARG to indicate creation of a new process instead."
  3131. (interactive "P")
  3132. (let* ((project (projectile-acquire-root))
  3133. (ielm-buffer-name (projectile-generate-process-name "ielm" arg)))
  3134. (if (get-buffer ielm-buffer-name)
  3135. (switch-to-buffer ielm-buffer-name)
  3136. (projectile-with-default-dir project
  3137. (ielm))
  3138. ;; ielm's buffer name is hardcoded, so we have to rename it after creation
  3139. (rename-buffer ielm-buffer-name))))
  3140. ;;;###autoload
  3141. (defun projectile-run-term (&optional arg)
  3142. "Invoke `term' in the project's root.
  3143. Switch to the project specific term buffer if it already exists.
  3144. Use a prefix argument ARG to indicate creation of a new process instead."
  3145. (interactive "P")
  3146. (let ((project (projectile-acquire-root))
  3147. (buffer-name (projectile-generate-process-name "term" arg))
  3148. (default-program (or explicit-shell-file-name
  3149. (getenv "ESHELL")
  3150. (getenv "SHELL")
  3151. "/bin/sh")))
  3152. (unless (get-buffer buffer-name)
  3153. (require 'term)
  3154. (let ((program (read-from-minibuffer "Run program: " default-program)))
  3155. (projectile-with-default-dir project
  3156. (set-buffer (term-ansi-make-term buffer-name program))
  3157. (term-mode)
  3158. (term-char-mode))))
  3159. (switch-to-buffer buffer-name)))
  3160. ;;;###autoload
  3161. (defun projectile-run-vterm (&optional arg)
  3162. "Invoke `vterm' in the project's root.
  3163. Switch to the project specific term buffer if it already exists.
  3164. Use a prefix argument ARG to indicate creation of a new process instead."
  3165. (interactive "P")
  3166. (let* ((project (projectile-acquire-root))
  3167. (buffer (projectile-generate-process-name "vterm" arg)))
  3168. (unless (buffer-live-p (get-buffer buffer))
  3169. (unless (require 'vterm nil 'noerror)
  3170. (error "Package 'vterm' is not available"))
  3171. (projectile-with-default-dir project
  3172. (vterm buffer)))
  3173. (switch-to-buffer buffer)))
  3174. (defun projectile-files-in-project-directory (directory)
  3175. "Return a list of files in DIRECTORY."
  3176. (let* ((project (projectile-acquire-root))
  3177. (dir (file-relative-name (expand-file-name directory)
  3178. project)))
  3179. (cl-remove-if-not
  3180. (lambda (f) (string-prefix-p dir f))
  3181. (projectile-project-files project))))
  3182. (defun projectile-files-from-cmd (cmd directory)
  3183. "Use a grep-like CMD to search for files within DIRECTORY.
  3184. CMD should include the necessary search params and should output
  3185. equivalently to grep -HlI (only unique matching filenames).
  3186. Returns a list of expanded filenames."
  3187. (let ((default-directory directory))
  3188. (mapcar (lambda (str)
  3189. (concat directory
  3190. (if (string-prefix-p "./" str)
  3191. (substring str 2)
  3192. str)))
  3193. (split-string
  3194. (string-trim (shell-command-to-string cmd))
  3195. "\n+"
  3196. t))))
  3197. (defvar projectile-files-with-string-commands
  3198. '((rg . "rg -lF --no-heading --color never -- ")
  3199. (ag . "ag --literal --nocolor --noheading -l -- ")
  3200. (ack . "ack --literal --nocolor -l -- ")
  3201. (git . "git grep -HlI ")
  3202. ;; -r: recursive
  3203. ;; -H: show filename for each match
  3204. ;; -l: show only file names with matches
  3205. ;; -I: no binary files
  3206. (grep . "grep -rHlI %s .")))
  3207. (defun projectile-files-with-string (string directory)
  3208. "Return a list of all files containing STRING in DIRECTORY.
  3209. Tries to use rg, ag, ack, git-grep, and grep in that order. If those
  3210. are impossible (for instance on Windows), returns a list of all
  3211. files in the project."
  3212. (if (projectile-unixy-system-p)
  3213. (let* ((search-term (shell-quote-argument string))
  3214. (cmd (cond ((executable-find "rg")
  3215. (concat (cdr (assoc 'rg projectile-files-with-string-commands))
  3216. search-term))
  3217. ((executable-find "ag")
  3218. (concat (cdr (assoc 'ag projectile-files-with-string-commands))
  3219. search-term))
  3220. ((executable-find "ack")
  3221. (concat (cdr (assoc 'ack projectile-files-with-string-commands))
  3222. search-term))
  3223. ((and (executable-find "git")
  3224. (eq (projectile-project-vcs) 'git))
  3225. (concat (cdr (assoc 'git projectile-files-with-string-commands)) search-term))
  3226. (t
  3227. (format (cdr (assoc 'grep projectile-files-with-string-commands)) search-term)))))
  3228. (projectile-files-from-cmd cmd directory))
  3229. ;; we have to reject directories as a workaround to work with git submodules
  3230. (cl-remove-if
  3231. #'file-directory-p
  3232. (mapcar #'projectile-expand-root (projectile-dir-files directory)))))
  3233. ;;;###autoload
  3234. (defun projectile-replace (&optional arg)
  3235. "Replace literal string in project using non-regexp `tags-query-replace'.
  3236. With a prefix argument ARG prompts you for a directory on which
  3237. to run the replacement."
  3238. (interactive "P")
  3239. (let* ((directory (if arg
  3240. (file-name-as-directory
  3241. (read-directory-name "Replace in directory: "))
  3242. (projectile-acquire-root)))
  3243. (old-text (read-string
  3244. (projectile-prepend-project-name "Replace: ")
  3245. (projectile-symbol-or-selection-at-point)))
  3246. (new-text (read-string
  3247. (projectile-prepend-project-name
  3248. (format "Replace %s with: " old-text))))
  3249. (files (projectile-files-with-string old-text directory)))
  3250. (if (fboundp #'fileloop-continue)
  3251. ;; Emacs 27+
  3252. (progn (fileloop-initialize-replace old-text new-text files 'default)
  3253. (fileloop-continue))
  3254. ;; Emacs 25 and 26
  3255. ;;
  3256. ;; Adapted from `tags-query-replace' for literal strings (not regexp)
  3257. (with-no-warnings
  3258. (setq tags-loop-scan
  3259. `(let ,(unless (equal old-text (downcase old-text))
  3260. '((case-fold-search nil)))
  3261. (if (search-forward ',old-text nil t)
  3262. ;; When we find a match, move back to
  3263. ;; the beginning of it so
  3264. ;; perform-replace will see it.
  3265. (goto-char (match-beginning 0)))))
  3266. (setq tags-loop-operate
  3267. `(perform-replace ',old-text ',new-text t nil nil
  3268. nil multi-query-replace-map))
  3269. (tags-loop-continue (or (cons 'list files) t))))))
  3270. ;;;###autoload
  3271. (defun projectile-replace-regexp (&optional arg)
  3272. "Replace a regexp in the project using `tags-query-replace'.
  3273. With a prefix argument ARG prompts you for a directory on which
  3274. to run the replacement."
  3275. (interactive "P")
  3276. (let* ((directory (if arg
  3277. (file-name-as-directory
  3278. (read-directory-name "Replace regexp in directory: "))
  3279. (projectile-acquire-root)))
  3280. (old-text (read-string
  3281. (projectile-prepend-project-name "Replace regexp: ")
  3282. (projectile-symbol-or-selection-at-point)))
  3283. (new-text (read-string
  3284. (projectile-prepend-project-name
  3285. (format "Replace regexp %s with: " old-text))))
  3286. (files
  3287. ;; We have to reject directories as a workaround to work with git submodules.
  3288. ;;
  3289. ;; We can't narrow the list of files with
  3290. ;; `projectile-files-with-string' because those regexp tools
  3291. ;; don't support Emacs regular expressions.
  3292. (cl-remove-if
  3293. #'file-directory-p
  3294. (mapcar #'projectile-expand-root (projectile-dir-files directory)))))
  3295. ;; FIXME: Probably would fail on Emacs 27+, fourth argument is gone.
  3296. (with-no-warnings (tags-query-replace old-text new-text nil (cons 'list files)))))
  3297. ;;;###autoload
  3298. (defun projectile-kill-buffers ()
  3299. "Kill project buffers.
  3300. The buffer are killed according to the value of
  3301. `projectile-kill-buffers-filter'."
  3302. (interactive)
  3303. (let* ((project (projectile-acquire-root))
  3304. (project-name (projectile-project-name project))
  3305. (buffers (projectile-project-buffers project)))
  3306. (when (yes-or-no-p
  3307. (format "Are you sure you want to kill %s buffers for '%s'? "
  3308. (length buffers) project-name))
  3309. (dolist (buffer buffers)
  3310. (when (and
  3311. ;; we take care not to kill indirect buffers directly
  3312. ;; as we might encounter them after their base buffers are killed
  3313. (not (buffer-base-buffer buffer))
  3314. (if (functionp projectile-kill-buffers-filter)
  3315. (funcall projectile-kill-buffers-filter buffer)
  3316. (pcase projectile-kill-buffers-filter
  3317. ('kill-all t)
  3318. ('kill-only-files (buffer-file-name buffer))
  3319. (_ (user-error "Invalid projectile-kill-buffers-filter value: %S" projectile-kill-buffers-filter)))))
  3320. (kill-buffer buffer))))))
  3321. ;;;###autoload
  3322. (defun projectile-save-project-buffers ()
  3323. "Save all project buffers."
  3324. (interactive)
  3325. (let* ((project (projectile-acquire-root))
  3326. (project-name (projectile-project-name project))
  3327. (modified-buffers (cl-remove-if-not (lambda (buf)
  3328. (and (buffer-file-name buf)
  3329. (buffer-modified-p buf)))
  3330. (projectile-project-buffers project))))
  3331. (if (null modified-buffers)
  3332. (message "[%s] No buffers need saving" project-name)
  3333. (dolist (buf modified-buffers)
  3334. (with-current-buffer buf
  3335. (save-buffer)))
  3336. (message "[%s] Saved %d buffers" project-name (length modified-buffers)))))
  3337. ;;;###autoload
  3338. (defun projectile-dired ()
  3339. "Open `dired' at the root of the project."
  3340. (interactive)
  3341. (dired (projectile-acquire-root)))
  3342. ;;;###autoload
  3343. (defun projectile-dired-other-window ()
  3344. "Open `dired' at the root of the project in another window."
  3345. (interactive)
  3346. (dired-other-window (projectile-acquire-root)))
  3347. ;;;###autoload
  3348. (defun projectile-dired-other-frame ()
  3349. "Open `dired' at the root of the project in another frame."
  3350. (interactive)
  3351. (dired-other-frame (projectile-acquire-root)))
  3352. ;;;###autoload
  3353. (defun projectile-vc (&optional project-root)
  3354. "Open `vc-dir' at the root of the project.
  3355. For git projects `magit-status-internal' is used if available.
  3356. For hg projects `monky-status' is used if available.
  3357. If PROJECT-ROOT is given, it is opened instead of the project
  3358. root directory of the current buffer file. If interactively
  3359. called with a prefix argument, the user is prompted for a project
  3360. directory to open."
  3361. (interactive (and current-prefix-arg
  3362. (list
  3363. (projectile-completing-read
  3364. "Open project VC in: "
  3365. projectile-known-projects))))
  3366. (or project-root (setq project-root (projectile-project-root)))
  3367. (let ((vcs (projectile-project-vcs project-root)))
  3368. (cl-case vcs
  3369. (git
  3370. (cond ((fboundp 'magit-status-internal)
  3371. (magit-status-internal project-root))
  3372. ((fboundp 'magit-status)
  3373. (with-no-warnings (magit-status project-root)))
  3374. (t
  3375. (vc-dir project-root))))
  3376. (hg
  3377. (if (fboundp 'monky-status)
  3378. (monky-status project-root)
  3379. (vc-dir project-root)))
  3380. (t (vc-dir project-root)))))
  3381. ;;;###autoload
  3382. (defun projectile-recentf ()
  3383. "Show a list of recently visited files in a project."
  3384. (interactive)
  3385. (if (boundp 'recentf-list)
  3386. (find-file (projectile-expand-root
  3387. (projectile-completing-read
  3388. "Recently visited files: "
  3389. (projectile-recentf-files))))
  3390. (message "recentf is not enabled")))
  3391. (defun projectile-recentf-files ()
  3392. "Return a list of recently visited files in a project."
  3393. (and (boundp 'recentf-list)
  3394. (let ((project-root (projectile-acquire-root)))
  3395. (mapcar
  3396. (lambda (f) (file-relative-name f project-root))
  3397. (cl-remove-if-not
  3398. (lambda (f) (string-prefix-p project-root (expand-file-name f)))
  3399. recentf-list)))))
  3400. (defun projectile-serialize-cache ()
  3401. "Serializes the memory cache to the hard drive."
  3402. (projectile-serialize projectile-projects-cache projectile-cache-file))
  3403. (defvar projectile-configure-cmd-map
  3404. (make-hash-table :test 'equal)
  3405. "A mapping between projects and the last configure command used on them.")
  3406. (defvar projectile-compilation-cmd-map
  3407. (make-hash-table :test 'equal)
  3408. "A mapping between projects and the last compilation command used on them.")
  3409. (defvar projectile-install-cmd-map
  3410. (make-hash-table :test 'equal)
  3411. "A mapping between projects and the last install command used on them.")
  3412. (defvar projectile-package-cmd-map
  3413. (make-hash-table :test 'equal)
  3414. "A mapping between projects and the last package command used on them.")
  3415. (defvar projectile-test-cmd-map
  3416. (make-hash-table :test 'equal)
  3417. "A mapping between projects and the last test command used on them.")
  3418. (defvar projectile-run-cmd-map
  3419. (make-hash-table :test 'equal)
  3420. "A mapping between projects and the last run command used on them.")
  3421. (defvar projectile-project-configure-cmd nil
  3422. "The command to use with `projectile-configure-project'.
  3423. It takes precedence over the default command for the project type when set.
  3424. Should be set via .dir-locals.el.")
  3425. (defvar projectile-project-compilation-cmd nil
  3426. "The command to use with `projectile-compile-project'.
  3427. It takes precedence over the default command for the project type when set.
  3428. Should be set via .dir-locals.el.")
  3429. (defvar projectile-project-compilation-dir nil
  3430. "The directory to use with `projectile-compile-project'.
  3431. The directory path is relative to the project root.
  3432. Should be set via .dir-locals.el.")
  3433. (defvar projectile-project-test-cmd nil
  3434. "The command to use with `projectile-test-project'.
  3435. It takes precedence over the default command for the project type when set.
  3436. Should be set via .dir-locals.el.")
  3437. (defvar projectile-project-install-cmd nil
  3438. "The command to use with `projectile-install-project'.
  3439. It takes precedence over the default command for the project type when set.
  3440. Should be set via .dir-locals.el.")
  3441. (defvar projectile-project-package-cmd nil
  3442. "The command to use with `projectile-package-project'.
  3443. It takes precedence over the default command for the project type when set.
  3444. Should be set via .dir-locals.el.")
  3445. (defvar projectile-project-run-cmd nil
  3446. "The command to use with `projectile-run-project'.
  3447. It takes precedence over the default command for the project type when set.
  3448. Should be set via .dir-locals.el.")
  3449. (defun projectile-default-generic-command (project-type command-type)
  3450. "Generic retrieval of COMMAND-TYPEs default cmd-value for PROJECT-TYPE.
  3451. If found, checks if value is symbol or string. In case of symbol
  3452. resolves to function `funcall's. Return value of function MUST
  3453. be string to be executed as command."
  3454. (let ((command (plist-get (alist-get project-type projectile-project-types) command-type)))
  3455. (cond
  3456. ((not command) nil)
  3457. ((stringp command) command)
  3458. ((functionp command)
  3459. (if (fboundp command)
  3460. (funcall (symbol-function command))))
  3461. (t
  3462. (error "The value for: %s in project-type: %s was neither a function nor a string" command-type project-type)))))
  3463. (defun projectile-default-configure-command (project-type)
  3464. "Retrieve default configure command for PROJECT-TYPE."
  3465. (projectile-default-generic-command project-type 'configure-command))
  3466. (defun projectile-default-compilation-command (project-type)
  3467. "Retrieve default compilation command for PROJECT-TYPE."
  3468. (projectile-default-generic-command project-type 'compile-command))
  3469. (defun projectile-default-compilation-dir (project-type)
  3470. "Retrieve default compilation directory for PROJECT-TYPE."
  3471. (projectile-default-generic-command project-type 'compilation-dir))
  3472. (defun projectile-default-test-command (project-type)
  3473. "Retrieve default test command for PROJECT-TYPE."
  3474. (projectile-default-generic-command project-type 'test-command))
  3475. (defun projectile-default-install-command (project-type)
  3476. "Retrieve default install command for PROJECT-TYPE."
  3477. (projectile-default-generic-command project-type 'install-command))
  3478. (defun projectile-default-package-command (project-type)
  3479. "Retrieve default package command for PROJECT-TYPE."
  3480. (projectile-default-generic-command project-type 'package-command))
  3481. (defun projectile-default-run-command (project-type)
  3482. "Retrieve default run command for PROJECT-TYPE."
  3483. (projectile-default-generic-command project-type 'run-command))
  3484. (defun projectile-configure-command (compile-dir)
  3485. "Retrieve the configure command for COMPILE-DIR.
  3486. The command is determined like this:
  3487. - first we check `projectile-configure-cmd-map' for the last
  3488. configure command that was invoked on the project
  3489. - then we check for `projectile-project-configure-cmd' supplied
  3490. via .dir-locals.el
  3491. - finally we check for the default configure command for a
  3492. project of that type"
  3493. (or (gethash compile-dir projectile-configure-cmd-map)
  3494. projectile-project-configure-cmd
  3495. (let ((cmd-format-string (projectile-default-configure-command (projectile-project-type))))
  3496. (when cmd-format-string
  3497. (format cmd-format-string (projectile-project-root) compile-dir)))))
  3498. (defun projectile-compilation-buffer-name (compilation-mode)
  3499. "Meant to be used for `compilation-buffer-name-function`.
  3500. Argument COMPILATION-MODE is the name of the major mode used for the compilation buffer."
  3501. (concat "*" (downcase compilation-mode) "*"
  3502. (if (projectile-project-p) (concat "<" (projectile-project-name) ">") "")))
  3503. (defun projectile-current-project-buffer-p ()
  3504. "Meant to be used for `compilation-save-buffers-predicate`.
  3505. This indicates whether the current buffer is in the same project as the current
  3506. window (including returning true if neither is in a project)."
  3507. (let ((root (with-current-buffer (window-buffer) (projectile-project-root))))
  3508. (or (not root)
  3509. (projectile-project-buffer-p (current-buffer) root))))
  3510. (defun projectile-compilation-command (compile-dir)
  3511. "Retrieve the compilation command for COMPILE-DIR.
  3512. The command is determined like this:
  3513. - first we check `projectile-compilation-cmd-map' for the last
  3514. compile command that was invoked on the project
  3515. - then we check for `projectile-project-compilation-cmd' supplied
  3516. via .dir-locals.el
  3517. - finally we check for the default compilation command for a
  3518. project of that type"
  3519. (or (gethash compile-dir projectile-compilation-cmd-map)
  3520. projectile-project-compilation-cmd
  3521. (projectile-default-compilation-command (projectile-project-type))))
  3522. (defun projectile-test-command (compile-dir)
  3523. "Retrieve the test command for COMPILE-DIR.
  3524. The command is determined like this:
  3525. - first we check `projectile-test-cmd-map' for the last
  3526. test command that was invoked on the project
  3527. - then we check for `projectile-project-test-cmd' supplied
  3528. via .dir-locals.el
  3529. - finally we check for the default test command for a
  3530. project of that type"
  3531. (or (gethash compile-dir projectile-test-cmd-map)
  3532. projectile-project-test-cmd
  3533. (projectile-default-test-command (projectile-project-type))))
  3534. (defun projectile-install-command (compile-dir)
  3535. "Retrieve the install command for COMPILE-DIR.
  3536. The command is determined like this:
  3537. - first we check `projectile-install-cmd-map' for the last
  3538. install command that was invoked on the project
  3539. - then we check for `projectile-project-install-cmd' supplied
  3540. via .dir-locals.el
  3541. - finally we check for the default install command for a
  3542. project of that type"
  3543. (or (gethash compile-dir projectile-install-cmd-map)
  3544. projectile-project-install-cmd
  3545. (projectile-default-install-command (projectile-project-type))))
  3546. (defun projectile-package-command (compile-dir)
  3547. "Retrieve the pacakge command for COMPILE-DIR.
  3548. The command is determined like this:
  3549. - first we check `projectile-packgage-cmd-map' for the last
  3550. install command that was invoked on the project
  3551. - then we check for `projectile-project-package-cmd' supplied
  3552. via .dir-locals.el
  3553. - finally we check for the default package command for a
  3554. project of that type"
  3555. (or (gethash compile-dir projectile-package-cmd-map)
  3556. projectile-project-package-cmd
  3557. (projectile-default-package-command (projectile-project-type))))
  3558. (defun projectile-run-command (compile-dir)
  3559. "Retrieve the run command for COMPILE-DIR.
  3560. The command is determined like this:
  3561. - first we check `projectile-run-cmd-map' for the last
  3562. run command that was invoked on the project
  3563. - then we check for `projectile-project-run-cmd' supplied
  3564. via .dir-locals.el
  3565. - finally we check for the default run command for a
  3566. project of that type"
  3567. (or (gethash compile-dir projectile-run-cmd-map)
  3568. projectile-project-run-cmd
  3569. (projectile-default-run-command (projectile-project-type))))
  3570. (defun projectile-read-command (prompt command)
  3571. "Adapted from `compilation-read-command'."
  3572. (let ((compile-history
  3573. ;; fetch the command history for the current project
  3574. (ring-elements (projectile--get-command-history (projectile-acquire-root)))))
  3575. (read-shell-command prompt command
  3576. (if (equal (car compile-history) command)
  3577. '(compile-history . 1)
  3578. 'compile-history))))
  3579. (defun projectile-compilation-dir ()
  3580. "Retrieve the compilation directory for this project."
  3581. (let* ((type (projectile-project-type))
  3582. (directory (or projectile-project-compilation-dir
  3583. (projectile-default-compilation-dir type))))
  3584. (if directory
  3585. (file-truename
  3586. (concat (file-name-as-directory (projectile-project-root))
  3587. (file-name-as-directory directory)))
  3588. (projectile-project-root))))
  3589. (defun projectile-maybe-read-command (arg default-cmd prompt)
  3590. "Prompt user for command unless DEFAULT-CMD is an Elisp function."
  3591. (if (and (or (stringp default-cmd) (null default-cmd))
  3592. (or compilation-read-command arg))
  3593. (projectile-read-command prompt default-cmd)
  3594. default-cmd))
  3595. (defun projectile-run-compilation (cmd)
  3596. "Run external or Elisp compilation command CMD."
  3597. (if (functionp cmd)
  3598. (funcall cmd)
  3599. (compile cmd)))
  3600. (defvar projectile-project-command-history (make-hash-table :test 'equal)
  3601. "The history of last executed project commands, per project.
  3602. Projects are indexed by their project-root value.")
  3603. (defun projectile--get-command-history (project-root)
  3604. (or (gethash project-root projectile-project-command-history)
  3605. (puthash project-root
  3606. (make-ring 16)
  3607. projectile-project-command-history)))
  3608. (cl-defun projectile--run-project-cmd
  3609. (command command-map &key show-prompt prompt-prefix save-buffers)
  3610. "Run a project COMMAND, typically a test- or compile command.
  3611. Cache the COMMAND for later use inside the hash-table COMMAND-MAP.
  3612. Normally you'll be prompted for a compilation command, unless
  3613. variable `compilation-read-command'. You can force the prompt
  3614. by setting SHOW-PROMPT. The prompt will be prefixed with PROMPT-PREFIX.
  3615. If SAVE-BUFFERS is non-nil save all projectile buffers before
  3616. running the command.
  3617. The command actually run is returned."
  3618. (let* ((project-root (projectile-project-root))
  3619. (default-directory (projectile-compilation-dir))
  3620. (command (projectile-maybe-read-command show-prompt
  3621. command
  3622. prompt-prefix)))
  3623. (when command-map
  3624. (puthash default-directory command command-map)
  3625. (ring-insert (projectile--get-command-history project-root) command))
  3626. (when save-buffers
  3627. (save-some-buffers (not compilation-ask-about-save)
  3628. (lambda ()
  3629. (projectile-project-buffer-p (current-buffer)
  3630. project-root))))
  3631. (unless (file-directory-p default-directory)
  3632. (mkdir default-directory))
  3633. (projectile-run-compilation command)
  3634. command))
  3635. ;;;###autoload
  3636. (defun projectile-configure-project (arg)
  3637. "Run project configure command.
  3638. Normally you'll be prompted for a compilation command, unless
  3639. variable `compilation-read-command'. You can force the prompt
  3640. with a prefix ARG."
  3641. (interactive "P")
  3642. (let ((command (projectile-configure-command (projectile-compilation-dir))))
  3643. (projectile--run-project-cmd command projectile-configure-cmd-map
  3644. :show-prompt arg
  3645. :prompt-prefix "Configure command: "
  3646. :save-buffers t)))
  3647. ;;;###autoload
  3648. (defun projectile-compile-project (arg)
  3649. "Run project compilation command.
  3650. Normally you'll be prompted for a compilation command, unless
  3651. variable `compilation-read-command'. You can force the prompt
  3652. with a prefix ARG."
  3653. (interactive "P")
  3654. (let ((command (projectile-compilation-command (projectile-compilation-dir))))
  3655. (projectile--run-project-cmd command projectile-compilation-cmd-map
  3656. :show-prompt arg
  3657. :prompt-prefix "Compile command: "
  3658. :save-buffers t)))
  3659. ;;;###autoload
  3660. (defun projectile-test-project (arg)
  3661. "Run project test command.
  3662. Normally you'll be prompted for a compilation command, unless
  3663. variable `compilation-read-command'. You can force the prompt
  3664. with a prefix ARG."
  3665. (interactive "P")
  3666. (let ((command (projectile-test-command (projectile-compilation-dir))))
  3667. (projectile--run-project-cmd command projectile-test-cmd-map
  3668. :show-prompt arg
  3669. :prompt-prefix "Test command: "
  3670. :save-buffers t)))
  3671. ;;;###autoload
  3672. (defun projectile-install-project (arg)
  3673. "Run project install command.
  3674. Normally you'll be prompted for a compilation command, unless
  3675. variable `compilation-read-command'. You can force the prompt
  3676. with a prefix ARG."
  3677. (interactive "P")
  3678. (let ((command (projectile-install-command (projectile-compilation-dir))))
  3679. (projectile--run-project-cmd command projectile-install-cmd-map
  3680. :show-prompt arg
  3681. :prompt-prefix "Install command: "
  3682. :save-buffers t)))
  3683. ;;;###autoload
  3684. (defun projectile-package-project (arg)
  3685. "Run project package command.
  3686. Normally you'll be prompted for a compilation command, unless
  3687. variable `compilation-read-command'. You can force the prompt
  3688. with a prefix ARG."
  3689. (interactive "P")
  3690. (let ((command (projectile-package-command (projectile-compilation-dir))))
  3691. (projectile--run-project-cmd command projectile-package-cmd-map
  3692. :show-prompt arg
  3693. :prompt-prefix "Package command: "
  3694. :save-buffers t)))
  3695. ;;;###autoload
  3696. (defun projectile-run-project (arg)
  3697. "Run project run command.
  3698. Normally you'll be prompted for a compilation command, unless
  3699. variable `compilation-read-command'. You can force the prompt
  3700. with a prefix ARG."
  3701. (interactive "P")
  3702. (let ((command (projectile-run-command (projectile-compilation-dir))))
  3703. (projectile--run-project-cmd command projectile-run-cmd-map
  3704. :show-prompt arg
  3705. :prompt-prefix "Run command: ")))
  3706. ;;;###autoload
  3707. (defun projectile-repeat-last-command (show-prompt)
  3708. "Run last projectile external command.
  3709. External commands are: `projectile-configure-project',
  3710. `projectile-compile-project', `projectile-test-project',
  3711. `projectile-install-project', `projectile-package-project',
  3712. and `projectile-run-project'.
  3713. If the prefix argument SHOW_PROMPT is non nil, the command can be edited."
  3714. (interactive "P")
  3715. (let* ((project-root (projectile-acquire-root))
  3716. (command-history (projectile--get-command-history project-root))
  3717. (command (car-safe (ring-elements command-history)))
  3718. (compilation-read-command show-prompt)
  3719. executed-command)
  3720. (unless command
  3721. (user-error "No command has been run yet for this project"))
  3722. (setq executed-command
  3723. (projectile--run-project-cmd command
  3724. nil
  3725. :save-buffers t
  3726. :prompt-prefix "Execute command: "))
  3727. (unless (string= command executed-command)
  3728. (ring-insert command-history executed-command))))
  3729. (defun compilation-find-file-projectile-find-compilation-buffer (orig-fun marker filename directory &rest formats)
  3730. "Try to find a buffer for FILENAME, if we cannot find it,
  3731. fallback to the original function."
  3732. (when (and (not (file-exists-p (expand-file-name filename)))
  3733. (projectile-project-p))
  3734. (let* ((root (projectile-project-root))
  3735. (dirs (cons "" (projectile-current-project-dirs)))
  3736. (new-filename (car (cl-remove-if-not
  3737. #'file-exists-p
  3738. (mapcar
  3739. (lambda (f)
  3740. (expand-file-name
  3741. filename
  3742. (expand-file-name f root)))
  3743. dirs)))))
  3744. (when new-filename
  3745. (setq filename new-filename))))
  3746. (apply orig-fun `(,marker ,filename ,directory ,@formats)))
  3747. (defun projectile-open-projects ()
  3748. "Return a list of all open projects.
  3749. An open project is a project with any open buffers."
  3750. (delete-dups
  3751. (delq nil
  3752. (mapcar (lambda (buffer)
  3753. (with-current-buffer buffer
  3754. (when (projectile-project-p)
  3755. (abbreviate-file-name (projectile-project-root)))))
  3756. (buffer-list)))))
  3757. (defun projectile--remove-current-project (projects)
  3758. "Remove the current project (if any) from the list of PROJECTS."
  3759. (if-let ((project (projectile-project-root)))
  3760. (projectile-difference projects
  3761. (list (abbreviate-file-name project)))
  3762. projects))
  3763. (defun projectile--move-current-project-to-end (projects)
  3764. "Move current project (if any) to the end of list in the list of PROJECTS."
  3765. (if-let ((project (projectile-project-root)))
  3766. (append
  3767. (projectile--remove-current-project projects)
  3768. (list (abbreviate-file-name project)))
  3769. projects))
  3770. (defun projectile-relevant-known-projects ()
  3771. "Return a list of known projects."
  3772. (pcase projectile-current-project-on-switch
  3773. ('remove (projectile--remove-current-project projectile-known-projects))
  3774. ('move-to-end (projectile--move-current-project-to-end projectile-known-projects))
  3775. ('keep projectile-known-projects)))
  3776. (defun projectile-relevant-open-projects ()
  3777. "Return a list of open projects."
  3778. (let ((open-projects (projectile-open-projects)))
  3779. (pcase projectile-current-project-on-switch
  3780. ('remove (projectile--remove-current-project open-projects))
  3781. ('move-to-end (projectile--move-current-project-to-end open-projects))
  3782. ('keep open-projects))))
  3783. ;;;###autoload
  3784. (defun projectile-switch-project (&optional arg)
  3785. "Switch to a project we have visited before.
  3786. Invokes the command referenced by `projectile-switch-project-action' on switch.
  3787. With a prefix ARG invokes `projectile-commander' instead of
  3788. `projectile-switch-project-action.'"
  3789. (interactive "P")
  3790. (let ((projects (projectile-relevant-known-projects)))
  3791. (if projects
  3792. (projectile-completing-read
  3793. "Switch to project: " projects
  3794. :action (lambda (project)
  3795. (projectile-switch-project-by-name project arg)))
  3796. (user-error "There are no known projects"))))
  3797. ;;;###autoload
  3798. (defun projectile-switch-open-project (&optional arg)
  3799. "Switch to a project we have currently opened.
  3800. Invokes the command referenced by `projectile-switch-project-action' on switch.
  3801. With a prefix ARG invokes `projectile-commander' instead of
  3802. `projectile-switch-project-action.'"
  3803. (interactive "P")
  3804. (let ((projects (projectile-relevant-open-projects)))
  3805. (if projects
  3806. (projectile-completing-read
  3807. "Switch to open project: " projects
  3808. :action (lambda (project)
  3809. (projectile-switch-project-by-name project arg)))
  3810. (user-error "There are no open projects"))))
  3811. (defun projectile-switch-project-by-name (project-to-switch &optional arg)
  3812. "Switch to project by project name PROJECT-TO-SWITCH.
  3813. Invokes the command referenced by `projectile-switch-project-action' on switch.
  3814. With a prefix ARG invokes `projectile-commander' instead of
  3815. `projectile-switch-project-action.'"
  3816. (unless (projectile-project-p project-to-switch)
  3817. (projectile-remove-known-project project-to-switch)
  3818. (error "Directory %s is not a project" project-to-switch))
  3819. (let ((switch-project-action (if arg
  3820. 'projectile-commander
  3821. projectile-switch-project-action)))
  3822. (run-hooks 'projectile-before-switch-project-hook)
  3823. (let ((default-directory project-to-switch))
  3824. ;; use a temporary buffer to load PROJECT-TO-SWITCH's dir-locals before calling SWITCH-PROJECT-ACTION
  3825. (with-temp-buffer
  3826. (hack-dir-local-variables-non-file-buffer))
  3827. ;; Normally the project name is determined from the current
  3828. ;; buffer. However, when we're switching projects, we want to
  3829. ;; show the name of the project being switched to, rather than
  3830. ;; the current project, in the minibuffer. This is a simple hack
  3831. ;; to tell the `projectile-project-name' function to ignore the
  3832. ;; current buffer and the caching mechanism, and just return the
  3833. ;; value of the `projectile-project-name' variable.
  3834. (let ((projectile-project-name (funcall projectile-project-name-function
  3835. project-to-switch)))
  3836. (funcall switch-project-action)))
  3837. (run-hooks 'projectile-after-switch-project-hook)))
  3838. ;;;###autoload
  3839. (defun projectile-find-file-in-directory (&optional directory)
  3840. "Jump to a file in a (maybe regular) DIRECTORY.
  3841. This command will first prompt for the directory the file is in."
  3842. (interactive "DFind file in directory: ")
  3843. (unless (projectile--directory-p directory)
  3844. (user-error "Directory %S does not exist" directory))
  3845. (let ((default-directory directory))
  3846. (if (projectile-project-p)
  3847. ;; target directory is in a project
  3848. (let ((file (projectile-completing-read "Find file: "
  3849. (projectile-dir-files directory))))
  3850. (find-file (expand-file-name file directory))
  3851. (run-hooks 'projectile-find-file-hook))
  3852. ;; target directory is not in a project
  3853. (projectile-find-file))))
  3854. (defun projectile-all-project-files ()
  3855. "Get a list of all files in all projects."
  3856. (cl-mapcan
  3857. (lambda (project)
  3858. (when (file-exists-p project)
  3859. (mapcar (lambda (file)
  3860. (expand-file-name file project))
  3861. (projectile-project-files project))))
  3862. projectile-known-projects))
  3863. ;;;###autoload
  3864. (defun projectile-find-file-in-known-projects ()
  3865. "Jump to a file in any of the known projects."
  3866. (interactive)
  3867. (find-file (projectile-completing-read "Find file in projects: " (projectile-all-project-files))))
  3868. (defun projectile-keep-project-p (project)
  3869. "Determine whether we should cleanup (remove) PROJECT or not.
  3870. It handles the case of remote projects as well.
  3871. See `projectile--cleanup-known-projects'."
  3872. ;; Taken from from `recentf-keep-default-predicate'
  3873. (cond
  3874. ((file-remote-p project nil t) (file-readable-p project))
  3875. ((file-remote-p project))
  3876. ((file-readable-p project))))
  3877. (defun projectile--cleanup-known-projects ()
  3878. "Remove known projects that don't exist anymore and return a list of projects removed."
  3879. (projectile-merge-known-projects)
  3880. (let ((projects-kept (cl-remove-if-not #'projectile-keep-project-p projectile-known-projects))
  3881. (projects-removed (cl-remove-if #'projectile-keep-project-p projectile-known-projects)))
  3882. (setq projectile-known-projects projects-kept)
  3883. (projectile-merge-known-projects)
  3884. projects-removed))
  3885. ;;;###autoload
  3886. (defun projectile-cleanup-known-projects ()
  3887. "Remove known projects that don't exist anymore."
  3888. (interactive)
  3889. (if-let ((projects-removed (projectile--cleanup-known-projects)))
  3890. (message "Projects removed: %s"
  3891. (mapconcat #'identity projects-removed ", "))
  3892. (message "No projects needed to be removed.")))
  3893. ;;;###autoload
  3894. (defun projectile-clear-known-projects ()
  3895. "Clear both `projectile-known-projects' and `projectile-known-projects-file'."
  3896. (interactive)
  3897. (setq projectile-known-projects nil)
  3898. (projectile-save-known-projects))
  3899. ;;;###autoload
  3900. (defun projectile-remove-known-project (&optional project)
  3901. "Remove PROJECT from the list of known projects."
  3902. (interactive (list (projectile-completing-read
  3903. "Remove from known projects: " projectile-known-projects
  3904. :action 'projectile-remove-known-project)))
  3905. (unless (called-interactively-p 'any)
  3906. (setq projectile-known-projects
  3907. (cl-remove-if
  3908. (lambda (proj) (string= project proj))
  3909. projectile-known-projects))
  3910. (projectile-merge-known-projects)
  3911. (when projectile-verbose
  3912. (message "Project %s removed from the list of known projects." project))))
  3913. ;;;###autoload
  3914. (defun projectile-remove-current-project-from-known-projects ()
  3915. "Remove the current project from the list of known projects."
  3916. (interactive)
  3917. (projectile-remove-known-project (abbreviate-file-name (projectile-project-root))))
  3918. (defun projectile-ignored-projects ()
  3919. "A list of projects that should not be save in `projectile-known-projects'."
  3920. (mapcar #'file-truename projectile-ignored-projects))
  3921. (defun projectile-ignored-project-p (project-root)
  3922. "Return t if PROJECT-ROOT should not be added to `projectile-known-projects'."
  3923. (or (member project-root (projectile-ignored-projects))
  3924. (and (functionp projectile-ignored-project-function)
  3925. (funcall projectile-ignored-project-function project-root))))
  3926. ;;;###autoload
  3927. (defun projectile-add-known-project (project-root)
  3928. "Add PROJECT-ROOT to the list of known projects."
  3929. (interactive (list (read-directory-name "Add to known projects: ")))
  3930. (unless (projectile-ignored-project-p project-root)
  3931. (setq projectile-known-projects
  3932. (delete-dups
  3933. (cons (file-name-as-directory (abbreviate-file-name project-root))
  3934. projectile-known-projects)))
  3935. (projectile-merge-known-projects)))
  3936. (defun projectile-load-known-projects ()
  3937. "Load saved projects from `projectile-known-projects-file'.
  3938. Also set `projectile-known-projects'."
  3939. (setq projectile-known-projects
  3940. (projectile-unserialize projectile-known-projects-file))
  3941. (setq projectile-known-projects-on-file
  3942. (and (sequencep projectile-known-projects)
  3943. (copy-sequence projectile-known-projects))))
  3944. (defun projectile-save-known-projects ()
  3945. "Save PROJECTILE-KNOWN-PROJECTS to PROJECTILE-KNOWN-PROJECTS-FILE."
  3946. (projectile-serialize projectile-known-projects
  3947. projectile-known-projects-file)
  3948. (setq projectile-known-projects-on-file
  3949. (and (sequencep projectile-known-projects)
  3950. (copy-sequence projectile-known-projects))))
  3951. (defun projectile-merge-known-projects ()
  3952. "Merge any change from `projectile-known-projects-file' and save to disk.
  3953. This enables multiple Emacs processes to make changes without
  3954. overwriting each other's changes."
  3955. (let* ((known-now projectile-known-projects)
  3956. (known-on-last-sync projectile-known-projects-on-file)
  3957. (known-on-file
  3958. (projectile-unserialize projectile-known-projects-file))
  3959. (removed-after-sync (projectile-difference known-on-last-sync known-now))
  3960. (removed-in-other-process
  3961. (projectile-difference known-on-last-sync known-on-file))
  3962. (result (delete-dups
  3963. (projectile-difference
  3964. (append known-now known-on-file)
  3965. (append removed-after-sync removed-in-other-process)))))
  3966. (setq projectile-known-projects result)
  3967. (projectile-save-known-projects)))
  3968. ;;; IBuffer integration
  3969. (define-ibuffer-filter projectile-files
  3970. "Show Ibuffer with all buffers in the current project."
  3971. (:reader (read-directory-name "Project root: " (projectile-project-root))
  3972. :description nil)
  3973. (with-current-buffer buf
  3974. (let ((directory (file-name-as-directory (expand-file-name qualifier))))
  3975. (and (projectile-project-buffer-p buf directory)
  3976. (equal directory
  3977. (projectile-project-root))))))
  3978. (defun projectile-ibuffer-by-project (project-root)
  3979. "Open an IBuffer window showing all buffers in PROJECT-ROOT."
  3980. (let ((project-name (funcall projectile-project-name-function project-root)))
  3981. (ibuffer nil (format "*%s Buffers*" project-name)
  3982. (list (cons 'projectile-files project-root)))))
  3983. ;;;###autoload
  3984. (defun projectile-ibuffer (prompt-for-project)
  3985. "Open an IBuffer window showing all buffers in the current project.
  3986. Let user choose another project when PROMPT-FOR-PROJECT is supplied."
  3987. (interactive "P")
  3988. (let ((project-root (if prompt-for-project
  3989. (projectile-completing-read
  3990. "Project name: "
  3991. (projectile-relevant-known-projects))
  3992. (projectile-acquire-root))))
  3993. (projectile-ibuffer-by-project project-root)))
  3994. ;;;; projectile-commander
  3995. (defconst projectile-commander-help-buffer "*Projectile Commander Help*")
  3996. (defvar projectile-commander-methods nil
  3997. "List of file-selection methods for the `projectile-commander' command.
  3998. Each element is a list (KEY DESCRIPTION FUNCTION).
  3999. DESCRIPTION is a one-line description of what the key selects.")
  4000. ;;;###autoload
  4001. (defun projectile-commander ()
  4002. "Execute a Projectile command with a single letter.
  4003. The user is prompted for a single character indicating the action to invoke.
  4004. The `?' character describes then
  4005. available actions.
  4006. See `def-projectile-commander-method' for defining new methods."
  4007. (interactive)
  4008. (let* ((choices (mapcar #'car projectile-commander-methods))
  4009. (prompt (concat "Select Projectile command [" choices "]: "))
  4010. (ch (read-char-choice prompt choices))
  4011. (fn (nth 2 (assq ch projectile-commander-methods))))
  4012. (funcall fn)))
  4013. (defmacro def-projectile-commander-method (key description &rest body)
  4014. "Define a new `projectile-commander' method.
  4015. KEY is the key the user will enter to choose this method.
  4016. DESCRIPTION is a one-line sentence describing how the method.
  4017. BODY is a series of forms which are evaluated when the find
  4018. is chosen."
  4019. (let ((method `(lambda ()
  4020. ,@body)))
  4021. `(setq projectile-commander-methods
  4022. (cl-sort (copy-sequence
  4023. (cons (list ,key ,description ,method)
  4024. (assq-delete-all ,key projectile-commander-methods)))
  4025. (lambda (a b) (< (car a) (car b)))))))
  4026. (def-projectile-commander-method ?? "Commander help buffer."
  4027. (ignore-errors (kill-buffer projectile-commander-help-buffer))
  4028. (with-current-buffer (get-buffer-create projectile-commander-help-buffer)
  4029. (insert "Projectile Commander Methods:\n\n")
  4030. (dolist (met projectile-commander-methods)
  4031. (insert (format "%c:\t%s\n" (car met) (cadr met))))
  4032. (goto-char (point-min))
  4033. (help-mode)
  4034. (display-buffer (current-buffer) t))
  4035. (projectile-commander))
  4036. (defun projectile-commander-bindings ()
  4037. "Setup the keybindings for the Projectile Commander."
  4038. (def-projectile-commander-method ?f
  4039. "Find file in project."
  4040. (projectile-find-file))
  4041. (def-projectile-commander-method ?T
  4042. "Find test file in project."
  4043. (projectile-find-test-file))
  4044. (def-projectile-commander-method ?b
  4045. "Switch to project buffer."
  4046. (projectile-switch-to-buffer))
  4047. (def-projectile-commander-method ?d
  4048. "Find directory in project."
  4049. (projectile-find-dir))
  4050. (def-projectile-commander-method ?D
  4051. "Open project root in dired."
  4052. (projectile-dired))
  4053. (def-projectile-commander-method ?v
  4054. "Open project root in vc-dir or magit."
  4055. (projectile-vc))
  4056. (def-projectile-commander-method ?V
  4057. "Browse dirty projects"
  4058. (projectile-browse-dirty-projects))
  4059. (def-projectile-commander-method ?r
  4060. "Replace a string in the project."
  4061. (projectile-replace))
  4062. (def-projectile-commander-method ?R
  4063. "Regenerate the project's [e|g]tags."
  4064. (projectile-regenerate-tags))
  4065. (def-projectile-commander-method ?g
  4066. "Run grep on project."
  4067. (projectile-grep))
  4068. (def-projectile-commander-method ?a
  4069. "Run ag on project."
  4070. (call-interactively #'projectile-ag))
  4071. (def-projectile-commander-method ?s
  4072. "Switch project."
  4073. (projectile-switch-project))
  4074. (def-projectile-commander-method ?o
  4075. "Run multi-occur on project buffers."
  4076. (projectile-multi-occur))
  4077. (def-projectile-commander-method ?j
  4078. "Find tag in project."
  4079. (projectile-find-tag))
  4080. (def-projectile-commander-method ?k
  4081. "Kill all project buffers."
  4082. (projectile-kill-buffers))
  4083. (def-projectile-commander-method ?e
  4084. "Find recently visited file in project."
  4085. (projectile-recentf)))
  4086. ;;; Dirty (modified) project check related functionality
  4087. (defun projectile-check-vcs-status (&optional project-path)
  4088. "Check the status of the current project.
  4089. If PROJECT-PATH is a project, check this one instead."
  4090. (let ((project-path (or project-path (projectile-project-root)))
  4091. (project-status nil))
  4092. (save-excursion
  4093. (vc-dir project-path)
  4094. ;; wait until vc-dir is done
  4095. (while (vc-dir-busy) (sleep-for 0 100))
  4096. ;; check for status
  4097. (save-excursion
  4098. (save-match-data
  4099. (dolist (check projectile-vcs-dirty-state)
  4100. (goto-char (point-min))
  4101. (when (search-forward check nil t)
  4102. (setq project-status (cons check project-status))))))
  4103. (kill-buffer)
  4104. project-status)))
  4105. (defvar projectile-cached-dirty-projects-status nil
  4106. "Cache of the last dirty projects check.")
  4107. (defun projectile-check-vcs-status-of-known-projects ()
  4108. "Return the list of dirty projects.
  4109. The list is composed of sublists~: (project-path, project-status).
  4110. Raise an error if their is no dirty project."
  4111. (save-window-excursion
  4112. (message "Checking for modifications in known projects...")
  4113. (let ((projects projectile-known-projects)
  4114. (status ()))
  4115. (dolist (project projects)
  4116. (when (and (projectile-keep-project-p project) (not (string= 'none (projectile-project-vcs project))))
  4117. (let ((tmp-status (projectile-check-vcs-status project)))
  4118. (when tmp-status
  4119. (setq status (cons (list project tmp-status) status))))))
  4120. (when (= (length status) 0)
  4121. (message "No dirty projects have been found"))
  4122. (setq projectile-cached-dirty-projects-status status)
  4123. status)))
  4124. ;;;###autoload
  4125. (defun projectile-browse-dirty-projects (&optional cached)
  4126. "Browse dirty version controlled projects.
  4127. With a prefix argument, or if CACHED is non-nil, try to use the cached
  4128. dirty project list."
  4129. (interactive "P")
  4130. (let ((status (if (and cached projectile-cached-dirty-projects-status)
  4131. projectile-cached-dirty-projects-status
  4132. (projectile-check-vcs-status-of-known-projects)))
  4133. (mod-proj nil))
  4134. (while (not (= (length status) 0))
  4135. (setq mod-proj (cons (car (pop status)) mod-proj)))
  4136. (projectile-completing-read "Select project: " mod-proj
  4137. :action 'projectile-vc)))
  4138. ;;; Find next/previous project buffer
  4139. (defun projectile--repeat-until-project-buffer (orig-fun &rest args)
  4140. "Repeat ORIG-FUN with ARGS until the current buffer is a project buffer."
  4141. (if (projectile-project-root)
  4142. (let* ((other-project-buffers (make-hash-table :test 'eq))
  4143. (projectile-project-buffers (projectile-project-buffers))
  4144. (max-iterations (length (buffer-list)))
  4145. (counter 0))
  4146. (dolist (buffer projectile-project-buffers)
  4147. (unless (eq buffer (current-buffer))
  4148. (puthash buffer t other-project-buffers)))
  4149. (when (cdr-safe projectile-project-buffers)
  4150. (while (and (< counter max-iterations)
  4151. (not (gethash (current-buffer) other-project-buffers)))
  4152. (apply orig-fun args)
  4153. (cl-incf counter))))
  4154. (apply orig-fun args)))
  4155. (defun projectile-next-project-buffer ()
  4156. "In selected window switch to the next project buffer.
  4157. If the current buffer does not belong to a project, call `next-buffer'."
  4158. (interactive)
  4159. (projectile--repeat-until-project-buffer #'next-buffer))
  4160. (defun projectile-previous-project-buffer ()
  4161. "In selected window switch to the previous project buffer.
  4162. If the current buffer does not belong to a project, call `previous-buffer'."
  4163. (interactive)
  4164. (projectile--repeat-until-project-buffer #'previous-buffer))
  4165. ;;; Editing a project's .dir-locals
  4166. (defun projectile-read-variable ()
  4167. "Prompt for a variable and return its name."
  4168. (completing-read "Variable: "
  4169. obarray
  4170. (lambda (v)
  4171. (and (boundp v) (not (keywordp v))))
  4172. t))
  4173. (define-skeleton projectile-skel-variable-cons
  4174. "Insert a variable-name and a value in a cons-cell."
  4175. "Value: "
  4176. "("
  4177. (projectile-read-variable)
  4178. " . "
  4179. str
  4180. ")")
  4181. (define-skeleton projectile-skel-dir-locals
  4182. "Insert a .dir-locals.el template."
  4183. nil
  4184. "((nil . ("
  4185. ("" '(projectile-skel-variable-cons) \n)
  4186. resume:
  4187. ")))")
  4188. ;;;###autoload
  4189. (defun projectile-edit-dir-locals ()
  4190. "Edit or create a .dir-locals.el file of the project."
  4191. (interactive)
  4192. (let ((file (expand-file-name ".dir-locals.el" (projectile-acquire-root))))
  4193. (find-file file)
  4194. (when (not (file-exists-p file))
  4195. (unwind-protect
  4196. (projectile-skel-dir-locals)
  4197. (save-buffer)))))
  4198. ;;; Projectile Minor mode
  4199. (define-obsolete-variable-alias 'projectile-mode-line-lighter 'projectile-mode-line-prefix)
  4200. (defcustom projectile-mode-line-prefix
  4201. " Projectile"
  4202. "Mode line lighter prefix for Projectile.
  4203. It's used by `projectile-default-mode-line'
  4204. when using dynamic mode line lighter and is the only
  4205. thing shown in the mode line otherwise."
  4206. :group 'projectile
  4207. :type 'string
  4208. :package-version '(projectile . "0.12.0"))
  4209. (defvar-local projectile--mode-line projectile-mode-line-prefix)
  4210. (defun projectile-default-mode-line ()
  4211. "Report project name and type in the modeline."
  4212. (let ((project-name (projectile-project-name))
  4213. (project-type (projectile-project-type)))
  4214. (format "%s[%s%s]"
  4215. projectile-mode-line-prefix
  4216. (or project-name "-")
  4217. (if project-type
  4218. (format ":%s" project-type)
  4219. ""))))
  4220. (defun projectile-update-mode-line ()
  4221. "Update the Projectile mode-line."
  4222. (let ((mode-line (funcall projectile-mode-line-function)))
  4223. (setq projectile--mode-line mode-line))
  4224. (force-mode-line-update))
  4225. (defvar projectile-command-map
  4226. (let ((map (make-sparse-keymap)))
  4227. (define-key map (kbd "4 a") #'projectile-find-other-file-other-window)
  4228. (define-key map (kbd "4 b") #'projectile-switch-to-buffer-other-window)
  4229. (define-key map (kbd "4 C-o") #'projectile-display-buffer)
  4230. (define-key map (kbd "4 d") #'projectile-find-dir-other-window)
  4231. (define-key map (kbd "4 D") #'projectile-dired-other-window)
  4232. (define-key map (kbd "4 f") #'projectile-find-file-other-window)
  4233. (define-key map (kbd "4 g") #'projectile-find-file-dwim-other-window)
  4234. (define-key map (kbd "4 t") #'projectile-find-implementation-or-test-other-window)
  4235. (define-key map (kbd "5 a") #'projectile-find-other-file-other-frame)
  4236. (define-key map (kbd "5 b") #'projectile-switch-to-buffer-other-frame)
  4237. (define-key map (kbd "5 d") #'projectile-find-dir-other-frame)
  4238. (define-key map (kbd "5 D") #'projectile-dired-other-frame)
  4239. (define-key map (kbd "5 f") #'projectile-find-file-other-frame)
  4240. (define-key map (kbd "5 g") #'projectile-find-file-dwim-other-frame)
  4241. (define-key map (kbd "5 t") #'projectile-find-implementation-or-test-other-frame)
  4242. (define-key map (kbd "!") #'projectile-run-shell-command-in-root)
  4243. (define-key map (kbd "&") #'projectile-run-async-shell-command-in-root)
  4244. (define-key map (kbd "a") #'projectile-find-other-file)
  4245. (define-key map (kbd "b") #'projectile-switch-to-buffer)
  4246. (define-key map (kbd "C") #'projectile-configure-project)
  4247. (define-key map (kbd "c") #'projectile-compile-project)
  4248. (define-key map (kbd "d") #'projectile-find-dir)
  4249. (define-key map (kbd "D") #'projectile-dired)
  4250. (define-key map (kbd "e") #'projectile-recentf)
  4251. (define-key map (kbd "E") #'projectile-edit-dir-locals)
  4252. (define-key map (kbd "f") #'projectile-find-file)
  4253. (define-key map (kbd "g") #'projectile-find-file-dwim)
  4254. (define-key map (kbd "F") #'projectile-find-file-in-known-projects)
  4255. (define-key map (kbd "i") #'projectile-invalidate-cache)
  4256. (define-key map (kbd "I") #'projectile-ibuffer)
  4257. (define-key map (kbd "j") #'projectile-find-tag)
  4258. (define-key map (kbd "k") #'projectile-kill-buffers)
  4259. (define-key map (kbd "K") #'projectile-package-project)
  4260. (define-key map (kbd "l") #'projectile-find-file-in-directory)
  4261. (define-key map (kbd "L") #'projectile-install-project)
  4262. (define-key map (kbd "m") #'projectile-commander)
  4263. (define-key map (kbd "o") #'projectile-multi-occur)
  4264. (define-key map (kbd "p") #'projectile-switch-project)
  4265. (define-key map (kbd "q") #'projectile-switch-open-project)
  4266. (define-key map (kbd "P") #'projectile-test-project)
  4267. (define-key map (kbd "r") #'projectile-replace)
  4268. (define-key map (kbd "R") #'projectile-regenerate-tags)
  4269. (define-key map (kbd "s g") #'projectile-grep)
  4270. (define-key map (kbd "s r") #'projectile-ripgrep)
  4271. (define-key map (kbd "s s") #'projectile-ag)
  4272. (define-key map (kbd "S") #'projectile-save-project-buffers)
  4273. (define-key map (kbd "t") #'projectile-toggle-between-implementation-and-test)
  4274. (define-key map (kbd "T") #'projectile-find-test-file)
  4275. (define-key map (kbd "u") #'projectile-run-project)
  4276. (define-key map (kbd "v") #'projectile-vc)
  4277. (define-key map (kbd "V") #'projectile-browse-dirty-projects)
  4278. (define-key map (kbd "x e") #'projectile-run-eshell)
  4279. (define-key map (kbd "x i") #'projectile-run-ielm)
  4280. (define-key map (kbd "x t") #'projectile-run-term)
  4281. (define-key map (kbd "x s") #'projectile-run-shell)
  4282. (define-key map (kbd "x g") #'projectile-run-gdb)
  4283. (define-key map (kbd "x v") #'projectile-run-vterm)
  4284. (define-key map (kbd "z") #'projectile-cache-current-file)
  4285. (define-key map (kbd "<left>") #'projectile-previous-project-buffer)
  4286. (define-key map (kbd "<right>") #'projectile-next-project-buffer)
  4287. (define-key map (kbd "ESC") #'projectile-project-buffers-other-buffer)
  4288. map)
  4289. "Keymap for Projectile commands after `projectile-keymap-prefix'.")
  4290. (fset 'projectile-command-map projectile-command-map)
  4291. (defvar projectile-mode-map
  4292. (let ((map (make-sparse-keymap)))
  4293. (when projectile-keymap-prefix
  4294. (define-key map projectile-keymap-prefix 'projectile-command-map))
  4295. (easy-menu-define projectile-mode-menu map
  4296. "Menu for Projectile"
  4297. '("Projectile"
  4298. ["Find file" projectile-find-file]
  4299. ["Find file in known projects" projectile-find-file-in-known-projects]
  4300. ["Find test file" projectile-find-test-file]
  4301. ["Find directory" projectile-find-dir]
  4302. ["Find file in directory" projectile-find-file-in-directory]
  4303. ["Find other file" projectile-find-other-file]
  4304. ["Switch to buffer" projectile-switch-to-buffer]
  4305. ["Jump between implementation file and test file" projectile-toggle-between-implementation-and-test]
  4306. ["Kill project buffers" projectile-kill-buffers]
  4307. ["Save project buffers" projectile-save-project-buffers]
  4308. ["Recent files" projectile-recentf]
  4309. ["Previous buffer" projectile-previous-project-buffer]
  4310. ["Next buffer" projectile-next-project-buffer]
  4311. "--"
  4312. ["Toggle project wide read-only" projectile-toggle-project-read-only]
  4313. ["Edit .dir-locals.el" projectile-edit-dir-locals]
  4314. "--"
  4315. ["Switch to project" projectile-switch-project]
  4316. ["Switch to open project" projectile-switch-open-project]
  4317. ["Discover projects in directory" projectile-discover-projects-in-directory]
  4318. ["Browse dirty projects" projectile-browse-dirty-projects]
  4319. ["Open project in dired" projectile-dired]
  4320. "--"
  4321. ["Search in project (grep)" projectile-grep]
  4322. ["Search in project (ag)" projectile-ag]
  4323. ["Replace in project" projectile-replace]
  4324. ["Multi-occur in project" projectile-multi-occur]
  4325. "--"
  4326. ["Run GDB" projectile-run-gdb]
  4327. "--"
  4328. ["Run shell" projectile-run-shell]
  4329. ["Run eshell" projectile-run-eshell]
  4330. ["Run ielm" projectile-run-ielm]
  4331. ["Run term" projectile-run-term]
  4332. "--"
  4333. ["Cache current file" projectile-cache-current-file]
  4334. ["Invalidate cache" projectile-invalidate-cache]
  4335. ["Regenerate [e|g]tags" projectile-regenerate-tags]
  4336. "--"
  4337. ["Configure project" projectile-configure-project]
  4338. ["Compile project" projectile-compile-project]
  4339. ["Test project" projectile-test-project]
  4340. ["Install project" projectile-install-project]
  4341. ["Package project" projectile-package-project]
  4342. ["Run project" projectile-run-project]
  4343. ["Repeat last external command" projectile-repeat-last-command]
  4344. "--"
  4345. ["Project info" projectile-project-info]
  4346. ["About" projectile-version]))
  4347. map)
  4348. "Keymap for Projectile mode.")
  4349. (defun projectile-find-file-hook-function ()
  4350. "Called by `find-file-hook' when `projectile-mode' is on.
  4351. The function does pretty much nothing when triggered on remote files
  4352. as all the operations it normally performs are extremely slow over
  4353. tramp."
  4354. (projectile-maybe-limit-project-file-buffers)
  4355. (unless (file-remote-p default-directory)
  4356. (when projectile-dynamic-mode-line
  4357. (projectile-update-mode-line))
  4358. (when projectile-auto-update-cache
  4359. (projectile-cache-files-find-file-hook))
  4360. (projectile-track-known-projects-find-file-hook)
  4361. (projectile-visit-project-tags-table)))
  4362. (defun projectile-maybe-limit-project-file-buffers ()
  4363. "Limit the opened file buffers for a project.
  4364. The function simply kills the last buffer, as it's normally called
  4365. when opening new files."
  4366. (when projectile-max-file-buffer-count
  4367. (let ((project-buffers (projectile-project-buffer-files)))
  4368. (when (> (length project-buffers) projectile-max-file-buffer-count)
  4369. (kill-buffer (car (last project-buffers)))))))
  4370. ;;;###autoload
  4371. (define-minor-mode projectile-mode
  4372. "Minor mode to assist project management and navigation.
  4373. When called interactively, toggle `projectile-mode'. With prefix
  4374. ARG, enable `projectile-mode' if ARG is positive, otherwise disable
  4375. it.
  4376. When called from Lisp, enable `projectile-mode' if ARG is omitted,
  4377. nil or positive. If ARG is `toggle', toggle `projectile-mode'.
  4378. Otherwise behave as if called interactively.
  4379. \\{projectile-mode-map}"
  4380. :lighter projectile--mode-line
  4381. :keymap projectile-mode-map
  4382. :group 'projectile
  4383. :require 'projectile
  4384. :global t
  4385. (cond
  4386. (projectile-mode
  4387. ;; setup the commander bindings
  4388. (projectile-commander-bindings)
  4389. ;; initialize the projects cache if needed
  4390. (unless projectile-projects-cache
  4391. (setq projectile-projects-cache
  4392. (or (projectile-unserialize projectile-cache-file)
  4393. (make-hash-table :test 'equal))))
  4394. (unless projectile-projects-cache-time
  4395. (setq projectile-projects-cache-time
  4396. (make-hash-table :test 'equal)))
  4397. ;; load the known projects
  4398. (projectile-load-known-projects)
  4399. ;; update the list of known projects
  4400. (projectile--cleanup-known-projects)
  4401. (when projectile-auto-discover
  4402. (projectile-discover-projects-in-search-path))
  4403. (add-hook 'find-file-hook 'projectile-find-file-hook-function)
  4404. (add-hook 'projectile-find-dir-hook #'projectile-track-known-projects-find-file-hook t)
  4405. (add-hook 'dired-before-readin-hook #'projectile-track-known-projects-find-file-hook t t)
  4406. (advice-add 'compilation-find-file :around #'compilation-find-file-projectile-find-compilation-buffer)
  4407. (advice-add 'delete-file :before #'delete-file-projectile-remove-from-cache))
  4408. (t
  4409. (remove-hook 'find-file-hook #'projectile-find-file-hook-function)
  4410. (remove-hook 'dired-before-readin-hook #'projectile-track-known-projects-find-file-hook t)
  4411. (advice-remove 'compilation-find-file #'compilation-find-file-projectile-find-compilation-buffer)
  4412. (advice-remove 'delete-file #'delete-file-projectile-remove-from-cache))))
  4413. ;;;###autoload
  4414. (define-obsolete-function-alias 'projectile-global-mode 'projectile-mode "1.0")
  4415. (provide 'projectile)
  4416. ;;; projectile.el ends here