code.delx.au - gnu-emacs/blob - lisp/progmodes/project.el

   1 ;;; project.el --- Operations on the current project  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   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.
  11
  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.
  16
  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/>.
  19
  20 ;;; Commentary:
  21
  22 ;; This file contains generic infrastructure for dealing with
  23 ;; projects, and a number of public functions: finding the current
  24 ;; root, related project directories, search path, etc.
  25 ;;
  26 ;; The goal is to make it easy 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.
  29
  30 ;;; Code:
  31
  32 (require 'cl-generic)
  33
  34 (defvar project-find-functions (list #'project-try-vc
  35                                      #'project-ask-user)
  36   "Special hook to find the project containing a given directory.
  37 Each functions on this hook is called in turn with one
  38 argument (the directory) and should return either nil to mean
  39 that it is not applicable, or a project instance.")
  40
  41 (declare-function etags-search-path "etags" ())
  42
  43 (defvar project-search-path-function #'etags-search-path
  44   "Function that returns a list of source root directories.
  45
  46 The directories in which we can recursively look for the
  47 declarations or other references to the symbols used in the
  48 current buffer.  Depending on the language, it should include the
  49 headers search path, load path, class path, or so on.
  50
  51 The directory names should be absolute.  This variable is
  52 normally set by the major mode.  Used in the default
  53 implementation of `project-search-path'.")
  54
  55 ;;;###autoload
  56 (defun project-current (&optional dir)
  57   "Return the project instance in DIR or `default-directory'."
  58   (unless dir (setq dir default-directory))
  59   (run-hook-with-args-until-success 'project-find-functions dir))
  60
  61 ;; FIXME: Add MODE argument, like in `ede-source-paths'?
  62 (cl-defgeneric project-search-path (project)
  63   "Return the list of source root directories.
  64 Any directory roots where source (or header, etc) files used by
  65 the current project may be found, inside or outside of the
  66 current project tree(s).  The directory names should be absolute.
  67
  68 Unless it really knows better, a specialized implementation
  69 should take into account the value returned by
  70 `project-search-path-function' and call
  71 `project-prune-directories' on the result."
  72   (project-prune-directories
  73    (append
  74     ;; We don't know the project layout, like where the sources are,
  75     ;; so we simply include the roots.
  76     (project-roots project)
  77     (funcall project-search-path-function))))
  78
  79 (cl-defgeneric project-roots (project)
  80   "Return the list of directory roots related to the current project.
  81 It should include the current project root, as well as the roots
  82 of any other currently open projects, if they're meant to be
  83 edited together.  The directory names should be absolute.")
  84
  85 (cl-defgeneric project-ignores (_project _dir)
  86   "Return the list of glob patterns to ignore inside DIR.
  87 Patterns can match both regular files and directories.
  88 To root an entry, start it with `./'.  To match directories only,
  89 end it with `/'.  DIR must be either one of `project-roots', or
  90 an element of `project-search-path'."
  91   (require 'grep)
  92   (defvar grep-find-ignored-files)
  93   (nconc
  94    (mapcar
  95     (lambda (dir)
  96       (concat dir "/"))
  97     vc-directory-exclusion-list)
  98    grep-find-ignored-files))
  99
 100 (defgroup project-vc nil
 101   "Project implementation using the VC package."
 102   :group 'tools)
 103
 104 (defcustom project-vc-search-path nil
 105   "List ot directories to include in `project-search-path'.
 106 The file names can be absolute, or relative to the project root."
 107   :type '(repeat file)
 108   :safe 'listp)
 109
 110 (defcustom project-vc-ignores nil
 111   "List ot patterns to include in `project-ignores'."
 112   :type '(repeat string)
 113   :safe 'listp)
 114
 115 (defun project-try-vc (dir)
 116   (let* ((backend (ignore-errors (vc-responsible-backend dir)))
 117          (root (and backend (ignore-errors
 118                               (vc-call-backend backend 'root dir)))))
 119     (and root (cons 'vc root))))
 120
 121 (cl-defmethod project-roots ((project (head vc)))
 122   (list (cdr project)))
 123
 124 (cl-defmethod project-search-path ((project (head vc)))
 125   (append
 126    (let ((root (cdr project)))
 127      (mapcar
 128       (lambda (dir) (expand-file-name dir root))
 129       (project--value-in-dir 'project-vc-search-path root)))
 130    (cl-call-next-method)))
 131
 132 (cl-defmethod project-ignores ((project (head vc)) dir)
 133   (let* ((root (cdr project))
 134           backend)
 135     (append
 136      (when (file-equal-p dir root)
 137        (setq backend (vc-responsible-backend root))
 138        (mapcar
 139         (lambda (entry)
 140           (if (string-match "\\`/" entry)
 141               (replace-match "./" t t entry)
 142             entry))
 143         (vc-call-backend backend 'ignore-completion-table root)))
 144      (project--value-in-dir 'project-vc-ignores root)
 145      (cl-call-next-method))))
 146
 147 (defun project-ask-user (dir)
 148   (cons 'user (read-directory-name "Project root: " dir nil t)))
 149
 150 (cl-defmethod project-roots ((project (head user)))
 151   (list (cdr project)))
 152
 153 (defun project-prune-directories (dirs)
 154   "Returns a copy of DIRS sorted, without subdirectories or non-existing ones."
 155   (let* ((dirs (sort
 156                 (mapcar
 157                  (lambda (dir)
 158                    (file-name-as-directory (expand-file-name dir)))
 159                  dirs)
 160                 #'string<))
 161          (ref dirs))
 162     ;; Delete subdirectories from the list.
 163     (while (cdr ref)
 164       (if (string-prefix-p (car ref) (cadr ref))
 165           (setcdr ref (cddr ref))
 166         (setq ref (cdr ref))))
 167     (cl-delete-if-not #'file-exists-p dirs)))
 168
 169 (defun project--value-in-dir (var dir)
 170   (with-temp-buffer
 171     (setq default-directory dir)
 172     (hack-dir-local-variables-non-file-buffer)
 173     (symbol-value var)))
 174
 175 (provide 'project)
 176 ;;; project.el ends here