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 ;;; Code:
  27
  28 (require 'cl-generic)
  29
  30 (defvar project-find-functions (list #'project-try-vc
  31                                      #'project-ask-user)
  32   "Special hook to find the project containing a given directory.
  33 Each functions on this hook is called in turn with one
  34 argument (the directory) and should return either nil to mean
  35 that it is not applicable, or a project instance.")
  36
  37 (declare-function etags-search-path "etags" ())
  38
  39 (defvar project-search-path-function #'etags-search-path
  40   "Function that returns a list of source root directories.
  41
  42 The directories in which we can recursively look for the
  43 declarations or other references to the symbols used in the
  44 current buffer.  Depending on the language, it should include the
  45 headers search path, load path, class path, or so on.
  46
  47 The directory names should be absolute.  This variable is
  48 normally set by the major mode.  Used in the default
  49 implementation of `project-search-path'.")
  50
  51 ;;;###autoload
  52 (defun project-current (&optional dir)
  53   "Return the project instance in DIR or `default-directory'."
  54   (unless dir (setq dir default-directory))
  55   (run-hook-with-args-until-success 'project-find-functions dir))
  56
  57 ;; FIXME: Add MODE argument, like in `ede-source-paths'?
  58 (cl-defgeneric project-search-path (project)
  59   "Return the list of source root directories.
  60 Any directory roots where source (or header, etc) files used by
  61 the current project may be found, inside or outside of the
  62 current project tree(s).  The directory names should be absolute.
  63
  64 Unless it really knows better, a specialized implementation
  65 should take into account the value returned by
  66 `project-search-path-function' and call
  67 `project-prune-directories' on the result."
  68   (project-prune-directories
  69    (append
  70     ;; We don't know the project layout, like where the sources are,
  71     ;; so we simply include the roots.
  72     (project-roots project)
  73     (funcall project-search-path-function))))
  74
  75 (cl-defgeneric project-roots (project)
  76   "Return the list of directory roots related to the current project.
  77 It should include the current project root, as well as the roots
  78 of any other currently open projects, if they're meant to be
  79 edited together.  The directory names should be absolute.")
  80
  81 (cl-defgeneric project-ignores (_project)
  82   "Return the list of glob patterns that match ignored files.
  83 To root an entry, start it with `./'.  To match directories only,
  84 end it with `/'."
  85   (require 'grep)
  86   (defvar grep-find-ignored-files)
  87   (nconc
  88    (mapcar
  89     (lambda (dir)
  90       (concat dir "/"))
  91     vc-directory-exclusion-list)
  92    grep-find-ignored-files))
  93
  94 (defun project-try-vc (dir)
  95   (let* ((backend (ignore-errors (vc-responsible-backend dir)))
  96          (root (and backend (ignore-errors
  97                               (vc-call-backend backend 'root dir)))))
  98     (and root (cons 'vc root))))
  99
 100 (cl-defmethod project-roots ((project (head vc)))
 101   (list (cdr project)))
 102
 103 (cl-defmethod project-ignores ((project (head vc)))
 104   (nconc
 105    (let* ((dir (cdr project))
 106           (backend (vc-responsible-backend dir)))
 107      (mapcar
 108       (lambda (entry)
 109         (if (string-match "\\`/" entry)
 110             (replace-match "./" t t entry)
 111           entry))
 112       (vc-call-backend backend 'ignore-completion-table dir)))
 113    (cl-call-next-method)))
 114
 115 (defun project-ask-user (dir)
 116   (cons 'user (read-directory-name "Project root: " dir nil t)))
 117
 118 (cl-defmethod project-roots ((project (head user)))
 119   (list (cdr project)))
 120
 121 (defun project-prune-directories (dirs)
 122   "Returns a copy of DIRS sorted, without subdirectories or non-existing ones."
 123   (let* ((dirs (sort
 124                 (mapcar
 125                  (lambda (dir)
 126                    (file-name-as-directory (expand-file-name dir)))
 127                  dirs)
 128                 #'string<))
 129          (ref dirs))
 130     ;; Delete subdirectories from the list.
 131     (while (cdr ref)
 132       (if (string-prefix-p (car ref) (cadr ref))
 133           (setcdr ref (cddr ref))
 134         (setq ref (cdr ref))))
 135     (cl-delete-if-not #'file-exists-p dirs)))
 136
 137 (provide 'project)
 138 ;;; project.el ends here