project.el 11.3 KB
Newer Older
Dmitry Gutov's avatar
Dmitry Gutov committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
;;; project.el --- Operations on the current project  -*- lexical-binding: t; -*-

;; Copyright (C) 2015 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file contains generic infrastructure for dealing with
23 24
;; projects, some utility functions, and commands using that
;; infrastructure.
25
;;
26
;; The goal is to make it easier for Lisp programs to operate on the
27 28
;; current project, without having to know which package handles
;; detection of that project type, parsing its config files, etc.
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
;;
;; Infrastructure:
;;
;; Function `project-current', to determine the current project
;; instance, and 3 (at the moment) generic functions that act on it.
;; This list is to be extended in future versions.
;;
;; Utils:
;;
;; `project-combine-directories' and `project-subtract-directories',
;; mainly for use in the aborementioned generics' implementations.
;;
;; Commands:
;;
;; `project-find-regexp' and `project-or-external-find-regexp' use the
;; current API, and thus will work in any project that has an adapter.

;;; TODO:

;; * Commands `project-find-file' and `project-or-external-find-file'.
;;   Currently blocked on adding a new completion style that would let
;;   the user enter just the base file name (or a part of it), and get
;;   it expanded to the absolute file name.
;;
;; * Build tool related functionality.  Start with a `project-build'
;;   command, which should provide completions on tasks to run, and
;;   maybe allow entering some additional arguments.  This might
;;   be handled better with a separate API, though.  Then we won't
;;   force every project backend to be aware of the build tool(s) the
;;   project is using.
;;
;; * Command to (re)build the tag files in all project roots.  To that
;;   end, we might need to add a way to limit etags to certain files
;;   (e.g. have a whitelist, in addition to the blacklist provided by
;;   ignores), and/or allow specifying additional tag regexps.
;;
;; * UI for the user to be able to pick the current project for the
;;   whole Emacs session, independent of the current directory.  Or,
;;   in the more advanced case, open a set of projects, and have some
;;   project-related commands to use them all.  E.g., have a command
;;   to search for a regexp across all open projects.  Provide a
;;   history of projects that were opened in the past (storing it as a
;;   list of directories should suffice).
Dmitry Gutov's avatar
Dmitry Gutov committed
72 73 74 75 76

;;; Code:

(require 'cl-generic)

77
(defvar project-find-functions (list #'project-try-vc)
Dmitry Gutov's avatar
Dmitry Gutov committed
78 79 80 81 82 83
  "Special hook to find the project containing a given directory.
Each functions on this hook is called in turn with one
argument (the directory) and should return either nil to mean
that it is not applicable, or a project instance.")

;;;###autoload
84 85 86 87
(defun project-current (&optional maybe-prompt dir)
  "Return the project instance in DIR or `default-directory'.
When no project found in DIR, and MAYBE-PROMPT is non-nil, ask
the user for a different directory to look in."
Dmitry Gutov's avatar
Dmitry Gutov committed
88
  (unless dir (setq dir default-directory))
89 90 91 92 93 94 95 96 97 98 99
  (let ((pr (project--find-in-directory dir)))
    (cond
     (pr)
     (maybe-prompt
      (setq dir (read-directory-name "Choose the project directory: " dir nil t)
            pr (project--find-in-directory dir))
      (unless pr
        (user-error "No project found in `%s'" dir))))
    pr))

(defun project--find-in-directory (dir)
Dmitry Gutov's avatar
Dmitry Gutov committed
100 101
  (run-hook-with-args-until-success 'project-find-functions dir))

102 103
(cl-defgeneric project-roots (project)
  "Return the list of directory roots of the current project.
104

105 106 107
Most often it's just one directory which contains the project
build file and everything else in the project.  But in more
advanced configurations, a project can span multiple directories.
108

109
The directory names should be absolute.")
110

111 112 113
;; FIXME: Add MODE argument, like in `ede-source-paths'?
(cl-defgeneric project-external-roots (_project)
  "Return the list of external roots for PROJECT.
114

115 116 117 118
It's the list of directories outside of the project that are
still related to it.  If the project deals with source code then,
depending on the languages used, this list should include the
headers search path, load path, class path, and so on.
119

120 121 122 123
The rule of thumb for whether to include a directory here, and
not in `project-roots', is whether its contents are meant to be
edited together with the rest of the project."
  nil)
Dmitry Gutov's avatar
Dmitry Gutov committed
124

125 126 127
(cl-defgeneric project-ignores (_project _dir)
  "Return the list of glob patterns to ignore inside DIR.
Patterns can match both regular files and directories.
Dmitry Gutov's avatar
Dmitry Gutov committed
128
To root an entry, start it with `./'.  To match directories only,
129
end it with `/'.  DIR must be one of `project-roots' or
130
`project-external-roots'."
Dmitry Gutov's avatar
Dmitry Gutov committed
131 132 133 134 135 136 137 138 139
  (require 'grep)
  (defvar grep-find-ignored-files)
  (nconc
   (mapcar
    (lambda (dir)
      (concat dir "/"))
    vc-directory-exclusion-list)
   grep-find-ignored-files))

140 141 142 143 144 145 146 147 148
(defgroup project-vc nil
  "Project implementation using the VC package."
  :group 'tools)

(defcustom project-vc-ignores nil
  "List ot patterns to include in `project-ignores'."
  :type '(repeat string)
  :safe 'listp)

149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183
;; FIXME: Using the current approach, major modes are supposed to set
;; this variable to a buffer-local value.  So we don't have access to
;; the "external roots" of language A from buffers of language B, which
;; seems desirable in multi-language projects, at least for some
;; potential uses, like "jump to a file in project or external dirs".
;;
;; We could add a second argument to this function: a file extension,
;; or a language name.  Some projects will know the set of languages
;; used in them; for others, like VC-based projects, we'll need
;; auto-detection.  I see two options:
;;
;; - That could be implemented as a separate second hook, with a
;;   list of functions that return file extensions.
;;
;; - This variable will be turned into a hook with "append" semantics,
;;   and each function in it will perform auto-detection when passed
;;   nil instead of an actual file extension.  Then this hook will, in
;;   general, be modified globally, and not from major mode functions.
;;
;; The second option seems simpler, but the first one has the
;; advantage that the user could override the list of languages used
;; in a project via a directory-local variable, thus skipping
;; languages they're not working on personally (in a big project), or
;; working around problems in language detection (the detection logic
;; might be imperfect for the project in question, or it might work
;; too slowly for the user's taste).
(defvar project-vc-external-roots-function (lambda () tags-table-list)
  "Function that returns a list of external roots.

It should return a list of directory roots that contain source
files related to the current buffer.

The directory names should be absolute.  Used in the VC project
backend implementation of `project-external-roots'.")

Dmitry Gutov's avatar
Dmitry Gutov committed
184 185 186 187 188 189
(defun project-try-vc (dir)
  (let* ((backend (ignore-errors (vc-responsible-backend dir)))
         (root (and backend (ignore-errors
                              (vc-call-backend backend 'root dir)))))
    (and root (cons 'vc root))))

190 191
(cl-defmethod project-roots ((project (head vc)))
  (list (cdr project)))
Dmitry Gutov's avatar
Dmitry Gutov committed
192

193
(cl-defmethod project-external-roots ((project (head vc)))
194 195
  (project-subtract-directories
   (project-combine-directories
196 197 198
    (mapcar
     #'file-name-as-directory
     (funcall project-vc-external-roots-function)))
199
   (project-roots project)))
200

201
(cl-defmethod project-ignores ((project (head vc)) dir)
202
  (let* ((root (cdr project))
203
          backend)
204
    (append
205 206 207 208 209 210 211
     (when (file-equal-p dir root)
       (setq backend (vc-responsible-backend root))
       (mapcar
        (lambda (entry)
          (if (string-match "\\`/" entry)
              (replace-match "./" t t entry)
            entry))
212 213 214
        (vc-call-backend backend 'ignore-completion-table root)))
     (project--value-in-dir 'project-vc-ignores root)
     (cl-call-next-method))))
Dmitry Gutov's avatar
Dmitry Gutov committed
215

216 217 218 219 220
(defun project-combine-directories (&rest lists-of-dirs)
  "Return a sorted and culled list of directory names.
Appends the elements of LISTS-OF-DIRS together, removes
non-existing directories, as well as directories a parent of
whose is already in the list."
Dmitry Gutov's avatar
Dmitry Gutov committed
221 222 223 224
  (let* ((dirs (sort
                (mapcar
                 (lambda (dir)
                   (file-name-as-directory (expand-file-name dir)))
225
                 (apply #'append lists-of-dirs))
Dmitry Gutov's avatar
Dmitry Gutov committed
226 227 228 229 230 231 232 233 234
                #'string<))
         (ref dirs))
    ;; Delete subdirectories from the list.
    (while (cdr ref)
      (if (string-prefix-p (car ref) (cadr ref))
          (setcdr ref (cddr ref))
        (setq ref (cdr ref))))
    (cl-delete-if-not #'file-exists-p dirs)))

235 236 237
(defun project-subtract-directories (files dirs)
  "Return a list of elements from FILES that are outside of DIRS.
DIRS must contain directory names."
238 239
  ;; Sidestep the issue of expanded/abbreviated file names here.
  (cl-set-difference files dirs :test #'file-in-directory-p))
240

241 242 243 244 245 246
(defun project--value-in-dir (var dir)
  (with-temp-buffer
    (setq default-directory dir)
    (hack-dir-local-variables-non-file-buffer)
    (symbol-value var)))

247 248 249
(declare-function grep-read-files "grep")
(declare-function xref-collect-matches "xref")
(declare-function xref--show-xrefs "xref")
250
(declare-function xref-backend-identifier-at-point "xref")
251 252 253

;;;###autoload
(defun project-find-regexp (regexp)
254
  "Find all matches for REGEXP in the current project's roots.
255 256 257
With \\[universal-argument] prefix, you can specify the directory
to search in, and the file name pattern to search for."
  (interactive (list (project--read-regexp)))
258
  (let* ((pr (project-current t))
259 260 261 262 263 264 265
         (dirs (if current-prefix-arg
                   (list (read-directory-name "Base directory: "
                                              nil default-directory t))
                 (project-roots pr))))
    (project--find-regexp-in dirs regexp pr)))

;;;###autoload
266 267
(defun project-or-external-find-regexp (regexp)
  "Find all matches for REGEXP in the project roots or external roots.
268 269 270
With \\[universal-argument] prefix, you can specify the file name
pattern to search for."
  (interactive (list (project--read-regexp)))
271
  (let* ((pr (project-current t))
272 273
         (dirs (append
                (project-roots pr)
274
                (project-external-roots pr))))
275 276 277 278
    (project--find-regexp-in dirs regexp pr)))

(defun project--read-regexp ()
  (read-regexp "Find regexp"
279
               (xref-backend-identifier-at-point (xref-find-backend))))
280 281 282 283 284 285 286 287 288 289 290 291 292 293 294

(defun project--find-regexp-in (dirs regexp project)
  (require 'grep)
  (let* ((files (if current-prefix-arg
                    (grep-read-files regexp)
                  "*"))
         (xrefs (cl-mapcan
                 (lambda (dir)
                   (xref-collect-matches regexp files dir
                                         (project-ignores project dir)))
                 dirs)))
    (unless xrefs
      (user-error "No matches for: %s" regexp))
    (xref--show-xrefs xrefs nil)))

Dmitry Gutov's avatar
Dmitry Gutov committed
295 296
(provide 'project)
;;; project.el ends here