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 ;;; 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 directories.
  41
  42 The directories in which we can look for the declarations or
  43 other references to the symbols used in the current buffer.
  44 Depending on the language, it should include the headers search
  45 path, load path, class path, and so on.
  46
  47 The directory names should be absolute.  Normally set by the
  48 major mode.  Used in the default implementation of
  49 `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 (cl-defgeneric project-root (project)
  58   "Return the root directory of the current project.
  59 The directory name should be absolute.")
  60
  61 (cl-defgeneric project-search-path (project)
  62   "Return the list of source directories.
  63 Including any where source (or header, etc) files used by the
  64 current project may be found, inside or outside of the project
  65 tree.  The directory names should be absolute.
  66
  67 A specialized implementation should use the value
  68 `project-search-path-function', or, better yet, call and combine
  69 the results from the functions that this value is set to by all
  70 major modes used in the project.  Alternatively, it can return a
  71 user-configurable value."
  72   (project--prune-directories
  73    (nconc (funcall project-search-path-function)
  74           ;; Include these, because we don't know any better.
  75           ;; But a specialized implementation may include only some of
  76           ;; the project's subdirectories, if there are no source
  77           ;; files at the top level.
  78           (project-directories project))))
  79
  80 (cl-defgeneric project-directories (project)
  81   "Return the list of directories related to the current project.
  82 It should include the current project root, as well as the roots
  83 of any currently open related projects, if they're meant to be
  84 edited together.  The directory names should be absolute."
  85   (list (project-root project)))
  86
  87 (cl-defgeneric project-ignores (_project)
  88   "Return the list of glob patterns that match ignored files.
  89 To root an entry, start it with `./'.  To match directories only,
  90 end it with `/'."
  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 (defun project-try-vc (dir)
 101   (let* ((backend (ignore-errors (vc-responsible-backend dir)))
 102          (root (and backend (ignore-errors
 103                               (vc-call-backend backend 'root dir)))))
 104     (and root (cons 'vc root))))
 105
 106 (cl-defmethod project-root ((project (head vc)))
 107   (cdr project))
 108
 109 (cl-defmethod project-ignores ((project (head vc)))
 110   (nconc
 111    (cl-call-next-method)
 112    (let* ((dir (cdr project))
 113           (backend (vc-responsible-backend dir)))
 114      (mapcar
 115       (lambda (entry)
 116         (if (string-match "\\`/" entry)
 117             (replace-match "./" t t entry)
 118           entry))
 119       (vc-call-backend backend 'ignore-completion-table dir)))))
 120
 121 (defun project-ask-user (dir)
 122   (cons 'user (read-directory-name "Project root: " dir nil t)))
 123
 124 (cl-defmethod project-root ((project (head user)))
 125   (cdr project))
 126
 127 (defun project--prune-directories (dirs)
 128   "Returns a copy of DIRS sorted, without subdirectories or non-existing ones."
 129   (let* ((dirs (sort
 130                 (mapcar
 131                  (lambda (dir)
 132                    (file-name-as-directory (expand-file-name dir)))
 133                  dirs)
 134                 #'string<))
 135          (ref dirs))
 136     ;; Delete subdirectories from the list.
 137     (while (cdr ref)
 138       (if (string-prefix-p (car ref) (cadr ref))
 139           (setcdr ref (cddr ref))
 140         (setq ref (cdr ref))))
 141     (cl-delete-if-not #'file-exists-p dirs)))
 142
 143 (provide 'project)
 144 ;;; project.el ends here