1 ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software: you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22 ;; This file contains generic infrastructure for dealing with
23 ;; projects, some utility functions, and commands using that
26 ;; The goal is to make it easier for Lisp programs to operate on the
27 ;; current project, without having to know which package handles
28 ;; detection of that project type, parsing its config files, etc.
30 ;; NOTE: The project API is still experimental and can change in major,
31 ;; backward-incompatible ways. Everyone is encouraged to try it, and
32 ;; report to us any problems or use cases we hadn't anticipated, by
33 ;; sending an email to emacs-devel, or `M-x report-emacs-bug'.
37 ;; Function `project-current', to determine the current project
38 ;; instance, and 3 (at the moment) generic functions that act on it.
39 ;; This list is to be extended in future versions.
43 ;; `project-combine-directories' and `project-subtract-directories',
44 ;; mainly for use in the abovementioned generics' implementations.
48 ;; `project-find-regexp' and `project-or-external-find-regexp' use the
49 ;; current API, and thus will work in any project that has an adapter.
53 ;; * Reliably cache the list of files in the project, probably using
54 ;; filenotify.el (if supported) to invalidate. And avoiding caching
55 ;; if it's not available (manual cache invalidation is not nice).
57 ;; * Allow the backend to override the file-listing logic? Maybe also
58 ;; to delegate file name completion to an external tool.
60 ;; * Build tool related functionality. Start with a `project-build'
61 ;; command, which should provide completions on tasks to run, and
62 ;; maybe allow entering some additional arguments. This might
63 ;; be handled better with a separate API, though. Then we won't
64 ;; force every project backend to be aware of the build tool(s) the
67 ;; * Command to (re)build the tag files in all project roots. To that
68 ;; end, we might need to add a way to provide file whitelist
69 ;; wildcards for each root to limit etags to certain files (in
70 ;; addition to the blacklist provided by ignores), and/or allow
71 ;; specifying additional tag regexps.
73 ;; * UI for the user to be able to pick the current project for the
74 ;; whole Emacs session, independent of the current directory. Or,
75 ;; in the more advanced case, open a set of projects, and have some
76 ;; project-related commands to use them all. E.g., have a command
77 ;; to search for a regexp across all open projects. Provide a
78 ;; history of projects that were opened in the past (storing it as a
79 ;; list of directories should suffice).
81 ;; * Support for project-local variables: a UI to edit them, and a
82 ;; utility function to retrieve a value. Probably useless without
83 ;; support in various built-in commands. In the API, we might get
84 ;; away with only adding a `project-configuration-directory' method,
85 ;; defaulting to the project root the current file/buffer is in.
86 ;; And prompting otherwise. How to best mix that with backends that
87 ;; want to set/provide certain variables themselves, is up for
94 (defvar project-find-functions (list #'project-try-vc)
95 "Special hook to find the project containing a given directory.
96 Each functions on this hook is called in turn with one
97 argument (the directory) and should return either nil to mean
98 that it is not applicable, or a project instance.")
101 (defun project-current (&optional maybe-prompt dir)
102 "Return the project instance in DIR or `default-directory'.
103 When no project found in DIR, and MAYBE-PROMPT is non-nil, ask
104 the user for a different directory to look in. If that directory
105 is not a part of a detectable project either, return a
106 `transient' project instance rooted in it."
107 (unless dir (setq dir default-directory))
108 (let ((pr (project--find-in-directory dir)))
112 (setq dir (read-directory-name "Choose the project directory: " dir nil t)
113 pr (project--find-in-directory dir))
115 (message "Using '%s' as a transient project root" dir)
116 (setq pr (cons 'transient dir)))))
119 (defun project--find-in-directory (dir)
120 (run-hook-with-args-until-success 'project-find-functions dir))
122 (cl-defgeneric project-roots (project)
123 "Return the list of directory roots of the current project.
125 Most often it's just one directory which contains the project
126 build file and everything else in the project. But in more
127 advanced configurations, a project can span multiple directories.
129 The directory names should be absolute.")
131 ;; FIXME: Add MODE argument, like in `ede-source-paths'?
132 (cl-defgeneric project-external-roots (_project)
133 "Return the list of external roots for PROJECT.
135 It's the list of directories outside of the project that are
136 still related to it. If the project deals with source code then,
137 depending on the languages used, this list should include the
138 headers search path, load path, class path, and so on.
140 The rule of thumb for whether to include a directory here, and
141 not in `project-roots', is whether its contents are meant to be
142 edited together with the rest of the project."
145 (cl-defgeneric project-ignores (_project _dir)
146 "Return the list of glob patterns to ignore inside DIR.
147 Patterns can match both regular files and directories.
148 To root an entry, start it with `./'. To match directories only,
149 end it with `/'. DIR must be one of `project-roots' or
150 `project-external-roots'."
152 (defvar grep-find-ignored-files)
157 vc-directory-exclusion-list)
158 grep-find-ignored-files))
160 (cl-defgeneric project-file-completion-table (project dirs)
161 "Return a completion table for files in directories DIRS in PROJECT.
162 DIRS is a list of absolute directories; it should be some
163 subset of the project roots and external roots.
165 The default implementation uses `grep-find-program'. PROJECT is used
166 to find the list of ignores for each directory."
167 ;; FIXME: Uniquely abbreviate the roots?
173 (format "%s %s %s -type f -print0"
176 (xref--find-ignores-arguments
177 (project-ignores project dir)
178 (expand-file-name dir)))))
179 (split-string (shell-command-to-string command) "\0" t)))
181 (lambda (string pred action)
183 ((eq action 'metadata)
184 '(metadata . ((category . project-file))))
186 (complete-with-action action all-files string pred))))))
188 (cl-defmethod project-roots ((project (head transient)))
189 (list (cdr project)))
191 (defgroup project-vc nil
192 "Project implementation using the VC package."
196 (defcustom project-vc-ignores nil
197 "List of patterns to include in `project-ignores'."
198 :type '(repeat string)
201 ;; FIXME: Using the current approach, major modes are supposed to set
202 ;; this variable to a buffer-local value. So we don't have access to
203 ;; the "external roots" of language A from buffers of language B, which
204 ;; seems desirable in multi-language projects, at least for some
205 ;; potential uses, like "jump to a file in project or external dirs".
207 ;; We could add a second argument to this function: a file extension,
208 ;; or a language name. Some projects will know the set of languages
209 ;; used in them; for others, like VC-based projects, we'll need
210 ;; auto-detection. I see two options:
212 ;; - That could be implemented as a separate second hook, with a
213 ;; list of functions that return file extensions.
215 ;; - This variable will be turned into a hook with "append" semantics,
216 ;; and each function in it will perform auto-detection when passed
217 ;; nil instead of an actual file extension. Then this hook will, in
218 ;; general, be modified globally, and not from major mode functions.
220 ;; The second option seems simpler, but the first one has the
221 ;; advantage that the user could override the list of languages used
222 ;; in a project via a directory-local variable, thus skipping
223 ;; languages they're not working on personally (in a big project), or
224 ;; working around problems in language detection (the detection logic
225 ;; might be imperfect for the project in question, or it might work
226 ;; too slowly for the user's taste).
227 (defvar project-vc-external-roots-function (lambda () tags-table-list)
228 "Function that returns a list of external roots.
230 It should return a list of directory roots that contain source
231 files related to the current buffer.
233 The directory names should be absolute. Used in the VC project
234 backend implementation of `project-external-roots'.")
236 (defun project-try-vc (dir)
237 (let* ((backend (ignore-errors (vc-responsible-backend dir)))
238 (root (and backend (ignore-errors
239 (vc-call-backend backend 'root dir)))))
240 (and root (cons 'vc root))))
242 (cl-defmethod project-roots ((project (head vc)))
243 (list (cdr project)))
245 (cl-defmethod project-external-roots ((project (head vc)))
246 (project-subtract-directories
247 (project-combine-directories
249 #'file-name-as-directory
250 (funcall project-vc-external-roots-function)))
251 (project-roots project)))
253 (cl-defmethod project-ignores ((project (head vc)) dir)
254 (let* ((root (cdr project))
257 (when (file-equal-p dir root)
258 (setq backend (vc-responsible-backend root))
261 (if (string-match "\\`/" entry)
262 (replace-match "./" t t entry)
264 (vc-call-backend backend 'ignore-completion-table root)))
265 (project--value-in-dir 'project-vc-ignores root)
266 (cl-call-next-method))))
268 (defun project-combine-directories (&rest lists-of-dirs)
269 "Return a sorted and culled list of directory names.
270 Appends the elements of LISTS-OF-DIRS together, removes
271 non-existing directories, as well as directories a parent of
272 whose is already in the list."
276 (file-name-as-directory (expand-file-name dir)))
277 (apply #'append lists-of-dirs))
280 ;; Delete subdirectories from the list.
282 (if (string-prefix-p (car ref) (cadr ref))
283 (setcdr ref (cddr ref))
284 (setq ref (cdr ref))))
285 (cl-delete-if-not #'file-exists-p dirs)))
287 (defun project-subtract-directories (files dirs)
288 "Return a list of elements from FILES that are outside of DIRS.
289 DIRS must contain directory names."
290 ;; Sidestep the issue of expanded/abbreviated file names here.
291 (cl-set-difference files dirs :test #'file-in-directory-p))
293 (defun project--value-in-dir (var dir)
295 (setq default-directory dir)
296 (let ((enable-local-variables :all))
297 (hack-dir-local-variables-non-file-buffer))
300 (declare-function grep-read-files "grep")
301 (declare-function xref--show-xrefs "xref")
302 (declare-function xref-backend-identifier-at-point "xref")
303 (declare-function xref--find-ignores-arguments "xref")
306 (defun project-find-regexp (regexp)
307 "Find all matches for REGEXP in the current project's roots.
308 With \\[universal-argument] prefix, you can specify the directory
309 to search in, and the file name pattern to search for."
310 (interactive (list (project--read-regexp)))
311 (let* ((pr (project-current t))
312 (dirs (if current-prefix-arg
313 (list (read-directory-name "Base directory: "
314 nil default-directory t))
315 (project-roots pr))))
316 (project--find-regexp-in dirs regexp pr)))
319 (defun project-or-external-find-regexp (regexp)
320 "Find all matches for REGEXP in the project roots or external roots.
321 With \\[universal-argument] prefix, you can specify the file name
322 pattern to search for."
323 (interactive (list (project--read-regexp)))
324 (let* ((pr (project-current t))
327 (project-external-roots pr))))
328 (project--find-regexp-in dirs regexp pr)))
330 (defun project--read-regexp ()
331 (let ((id (xref-backend-identifier-at-point (xref-find-backend))))
332 (read-regexp "Find regexp" (and id (regexp-quote id)))))
334 (defun project--find-regexp-in (dirs regexp project)
336 (let* ((files (if current-prefix-arg
337 (grep-read-files regexp)
341 (xref-collect-matches regexp files dir
342 (project-ignores project dir)))
345 (user-error "No matches for: %s" regexp))
346 (xref--show-xrefs xrefs nil)))
349 (defun project-find-file ()
350 "Visit a file (with completion) in the current project's roots.
351 The completion default is the filename at point, if one is
354 (let* ((pr (project-current t))
355 (dirs (project-roots pr)))
356 (project-find-file-in (thing-at-point 'filename) dirs pr)))
359 (defun project-or-external-find-file ()
360 "Visit a file (with completion) in the current project's roots or external roots.
361 The completion default is the filename at point, if one is
364 (let* ((pr (project-current t))
367 (project-external-roots pr))))
368 (project-find-file-in (thing-at-point 'filename) dirs pr)))
370 (defun project-find-file-in (filename dirs project)
371 "Complete FILENAME in DIRS in PROJECT and visit the result."
372 (let* ((table (project-file-completion-table project dirs))
373 (file (project--completing-read-strict
374 "Find file" table nil nil
376 (if (string= file "")
377 (user-error "You didn't specify the file")
380 (defun project--completing-read-strict (prompt
381 collection &optional predicate
382 hist default inherit-input-method)
383 ;; Tried both expanding the default before showing the prompt, and
384 ;; removing it when it has no matches. Neither seems natural
385 ;; enough. Removal is confusing; early expansion makes the prompt
387 (let* ((new-prompt (if default
388 (format "%s (default %s): " prompt default)
389 (format "%s: " prompt)))
390 (res (completing-read new-prompt
391 collection predicate t
392 nil hist default inherit-input-method)))
393 (if (and (equal res default)
394 (not (test-completion res collection predicate)))
395 (completing-read (format "%s: " prompt)
396 collection predicate t res hist nil
397 inherit-input-method)
401 ;;; project.el ends here