Merge branch 'project-next'

7 files changed, 186 insertions, 154 deletions

diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 3aea67ad11b..5f0f0881210 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -849,7 +849,7 @@ to avoid corrupting the original LIST1 and LIST2.
                 (memq (car cl-list1) cl-list2))
               (push (car cl-list1) cl-res))
           (pop cl-list1))
-        cl-res))))
+        (nreverse cl-res)))))
 
 ;;;###autoload
 (defun cl-nset-difference (cl-list1 cl-list2 &rest cl-keys)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 8ea17b74ddb..a19542fb204 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -230,7 +230,7 @@ Blank lines separate paragraphs.  Semicolons start comments.
   :group 'lisp
   (defvar xref-find-function)
   (defvar xref-identifier-completion-table-function)
-  (defvar project-search-path-function)
+  (defvar project-library-roots-function)
   (lisp-mode-variables nil nil 'elisp)
   (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
   (setq-local electric-pair-text-pairs
@@ -242,7 +242,7 @@ Blank lines separate paragraphs.  Semicolons start comments.
   (setq-local xref-find-function #'elisp-xref-find)
   (setq-local xref-identifier-completion-table-function
               #'elisp--xref-identifier-completion-table)
-  (setq-local project-search-path-function #'elisp-search-path)
+  (setq-local project-library-roots-function #'elisp-library-roots)
   (add-hook 'completion-at-point-functions
             #'elisp-completion-at-point nil 'local))
 
@@ -801,7 +801,7 @@ non-nil result supercedes the xrefs produced by
 
     xrefs))
 
-(declare-function project-search-path "project")
+(declare-function project-library-roots "project")
 (declare-function project-current "project")
 
 (defun elisp--xref-find-references (symbol)
@@ -809,7 +809,10 @@ non-nil result supercedes the xrefs produced by
   (cl-mapcan
    (lambda (dir)
      (xref-collect-references symbol dir))
-   (project-search-path (project-current))))
+   (let ((pr (project-current t)))
+     (append
+      (project-roots pr)
+      (project-library-roots pr)))))
 
 (defun elisp--xref-find-apropos (regexp)
   (apply #'nconc
@@ -846,7 +849,7 @@ non-nil result supercedes the xrefs produced by
 (cl-defmethod xref-location-group ((l xref-elisp-location))
   (xref-elisp-location-file l))
 
-(defun elisp-search-path ()
+(defun elisp-library-roots ()
   (defvar package-user-dir)
   (cons package-user-dir load-path))
 
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 0d5fc3a3cd3..38c5cc2bdb6 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2098,7 +2098,10 @@ for \\[find-tag] (which see)."
   (cl-mapcan
    (lambda (dir)
      (xref-collect-references symbol dir))
-   (project-search-path (project-current))))
+   (let ((pr (project-current t)))
+     (append
+      (project-roots pr)
+      (project-library-roots pr)))))
 
 (defun etags--xref-find-definitions (pattern &optional regexp?)
   ;; This emulates the behaviour of `find-tag-in-order' but instead of
@@ -2154,7 +2157,7 @@ for \\[find-tag] (which see)."
   (with-slots (tag-info) l
     (nth 1 tag-info)))
 
-(defun etags-search-path ()
+(defun etags-library-roots ()
   (mapcar #'file-name-directory tags-table-list))
 
 
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 186840ae29b..0da6084a1e3 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -23,7 +23,7 @@
 ;; projects, and a number of public functions: finding the current
 ;; root, related project directories, search path, etc.
 ;;
-;; The goal is to make it easy for Lisp programs to operate on the
+;; The goal is to make it easier for Lisp programs to operate on the
 ;; current project, without having to know which package handles
 ;; detection of that project type, parsing its config files, etc.
 
@@ -31,63 +31,93 @@
 
 (require 'cl-generic)
 
-(defvar project-find-functions (list #'project-try-vc
-                                     #'project-ask-user)
+(defvar project-find-functions (list #'project-try-vc)
   "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.")
 
-(declare-function etags-search-path "etags" ())
-
-(defvar project-search-path-function #'etags-search-path
-  "Function that returns a list of source root directories.
+;; FIXME: Using the current approach, we don't have access to the
+;; "library 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 library".
+;;
+;; We can 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.
+(defvar project-library-roots-function 'etags-library-roots
+  "Function that returns a list of library roots.
 
-The directories in which we can recursively look for the
-declarations or other references to the symbols used in the
-current buffer.  Depending on the language, it should include the
-headers search path, load path, class path, or so on.
+It should return a list of directories that contain source files
+related to the current buffer.  Depending on the language, it
+should include the headers search path, load path, class path,
+and so on.
 
-The directory names should be absolute.  This variable is
-normally set by the major mode.  Used in the default
-implementation of `project-search-path'.")
+The directory names should be absolute.  Used in the default
+implementation of `project-library-roots'.")
 
 ;;;###autoload
-(defun project-current (&optional dir)
-  "Return the project instance in DIR or `default-directory'."
+(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."
   (unless dir (setq dir default-directory))
+  (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)
   (run-hook-with-args-until-success 'project-find-functions dir))
 
 ;; FIXME: Add MODE argument, like in `ede-source-paths'?
-(cl-defgeneric project-search-path (project)
-  "Return the list of source root directories.
-Any directory roots where source (or header, etc) files used by
-the current project may be found, inside or outside of the
-current project tree(s).  The directory names should be absolute.
-
-Unless it really knows better, a specialized implementation
-should take into account the value returned by
-`project-search-path-function' and call
-`project-prune-directories' on the result."
-  (project-prune-directories
-   (append
-    ;; We don't know the project layout, like where the sources are,
-    ;; so we simply include the roots.
-    (project-roots project)
-    (funcall project-search-path-function))))
+(cl-defgeneric project-library-roots (project)
+  "Return the list of library roots for PROJECT.
+
+It's the list of directories outside of the project that contain
+related source files.
+
+Project-specific version of `project-library-roots-function',
+which see.  Unless it knows better, a specialized implementation
+should use the value returned by that function."
+  (project-subtract-directories
+   (project-combine-directories
+    (funcall project-library-roots-function))
+   (project-roots project)))
 
 (cl-defgeneric project-roots (project)
-  "Return the list of directory roots related to the current project.
-It should include the current project root, as well as the roots
-of any other currently open projects, if they're meant to be
-edited together.  The directory names should be absolute.")
+  "Return the list of directory roots belonging to the current project.
+
+Most often it's just one directory, which contains the project
+file and everything else in the project.  But in more advanced
+configurations, a project can span multiple directories.
+
+The rule of tumb for whether to include a directory here, and not
+in `project-library-roots', is whether its contents are meant to
+be edited together with the rest of the project.
+
+The directory names should be absolute.")
 
 (cl-defgeneric project-ignores (_project _dir)
   "Return the list of glob patterns to ignore inside DIR.
 Patterns can match both regular files and directories.
 To root an entry, start it with `./'.  To match directories only,
-end it with `/'.  DIR must be either one of `project-roots', or
-an element of `project-search-path'."
+end it with `/'.  DIR must be one of `project-roots' or
+`project-library-roots'."
   (require 'grep)
   (defvar grep-find-ignored-files)
   (nconc
@@ -101,8 +131,8 @@ an element of `project-search-path'."
   "Project implementation using the VC package."
   :group 'tools)
 
-(defcustom project-vc-search-path nil
-  "List ot directories to include in `project-search-path'.
+(defcustom project-vc-library-roots nil
+  "List ot directories to include in `project-library-roots'.
 The file names can be absolute, or relative to the project root."
   :type '(repeat file)
   :safe 'listp)
@@ -121,13 +151,16 @@ The file names can be absolute, or relative to the project root."
 (cl-defmethod project-roots ((project (head vc)))
   (list (cdr project)))
 
-(cl-defmethod project-search-path ((project (head vc)))
-  (append
-   (let ((root (cdr project)))
-     (mapcar
-      (lambda (dir) (expand-file-name dir root))
-      (project--value-in-dir 'project-vc-search-path root)))
-   (cl-call-next-method)))
+(cl-defmethod project-library-roots ((project (head vc)))
+  (project-subtract-directories
+   (project-combine-directories
+    (append
+     (let ((root (cdr project)))
+       (mapcar
+        (lambda (dir) (file-name-as-directory (expand-file-name dir root)))
+        (project--value-in-dir 'project-vc-library-roots root)))
+     (funcall project-library-roots-function)))
+   (project-roots project)))
 
 (cl-defmethod project-ignores ((project (head vc)) dir)
   (let* ((root (cdr project))
@@ -144,19 +177,16 @@ The file names can be absolute, or relative to the project root."
      (project--value-in-dir 'project-vc-ignores root)
      (cl-call-next-method))))
 
-(defun project-ask-user (dir)
-  (cons 'user (read-directory-name "Project root: " dir nil t)))
-
-(cl-defmethod project-roots ((project (head user)))
-  (list (cdr project)))
-
-(defun project-prune-directories (dirs)
-  "Returns a copy of DIRS sorted, without subdirectories or non-existing ones."
+(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."
   (let* ((dirs (sort
                 (mapcar
                  (lambda (dir)
                    (file-name-as-directory (expand-file-name dir)))
-                 dirs)
+                 (apply #'append lists-of-dirs))
                 #'string<))
          (ref dirs))
     ;; Delete subdirectories from the list.
@@ -166,11 +196,66 @@ The file names can be absolute, or relative to the project root."
         (setq ref (cdr ref))))
     (cl-delete-if-not #'file-exists-p dirs)))
 
+(defun project-subtract-directories (files dirs)
+  "Return a list of elements from FILES that are outside of DIRS.
+DIRS must contain directory names."
+  ;; Sidestep the issue of expanded/abbreviated file names here.
+  (cl-set-difference files dirs :test #'file-in-directory-p))
+
 (defun project--value-in-dir (var dir)
   (with-temp-buffer
     (setq default-directory dir)
     (hack-dir-local-variables-non-file-buffer)
     (symbol-value var)))
 
+(declare-function grep-read-files "grep")
+(declare-function xref-collect-matches "xref")
+(declare-function xref--show-xrefs "xref")
+
+;;;###autoload
+(defun project-find-regexp (regexp)
+  "Find all matches for REGEXP in the current project.
+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)))
+  (let* ((pr (project-current t))
+         (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
+(defun project-or-libraries-find-regexp (regexp)
+  "Find all matches for REGEXP in the current project or libraries.
+With \\[universal-argument] prefix, you can specify the file name
+pattern to search for."
+  (interactive (list (project--read-regexp)))
+  (let* ((pr (project-current t))
+         (dirs (append
+                (project-roots pr)
+                (project-library-roots pr))))
+    (project--find-regexp-in dirs regexp pr)))
+
+(defun project--read-regexp ()
+  (defvar xref-identifier-at-point-function)
+  (require 'xref)
+  (read-regexp "Find regexp"
+               (funcall xref-identifier-at-point-function)))
+
+(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)))
+
 (provide 'project)
 ;;; project.el ends here
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index a222533936c..89a06046ca2 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -414,20 +414,6 @@ WINDOW controls how the buffer is displayed:
 (defvar-local xref--display-history nil
   "List of pairs (BUFFER . WINDOW), for temporarily displayed buffers.")
 
-(defvar-local xref--temporary-buffers nil
-  "List of buffers created by xref code.")
-
-(defvar-local xref--current nil
-  "Non-nil if this buffer was once current, except while displaying xrefs.
-Used for temporary buffers.")
-
-(defvar xref--inhibit-mark-current nil)
-
-(defun xref--mark-selected ()
-  (unless xref--inhibit-mark-current
-    (setq xref--current t))
-  (remove-hook 'buffer-list-update-hook #'xref--mark-selected t))
-
 (defun xref--save-to-history (buf win)
   (let ((restore (window-parameter win 'quit-restore)))
     ;; Save the new entry if the window displayed another buffer
@@ -449,15 +435,9 @@ Used for temporary buffers.")
 
 (defun xref--show-location (location)
   (condition-case err
-      (let ((bl (buffer-list))
-            (xref--inhibit-mark-current t)
-            (marker (xref-location-marker location)))
-        (let ((buf (marker-buffer marker)))
-          (unless (memq buf bl)
-            ;; Newly created.
-            (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)
-            (push buf xref--temporary-buffers))
-          (xref--display-position marker t buf)))
+      (let* ((marker (xref-location-marker location))
+             (buf (marker-buffer marker)))
+        (xref--display-position marker t buf))
     (user-error (message (error-message-string err)))))
 
 (defun xref-show-location-at-point ()
@@ -594,8 +574,7 @@ Used for temporary buffers.")
 (defun xref-quit (&optional kill)
   "Bury temporarily displayed buffers, then quit the current window.
 
-If KILL is non-nil, kill all buffers that were created in the
-process of showing xrefs, and also kill the current buffer.
+If KILL is non-nil, also kill the current buffer.
 
 The buffers that the user has otherwise interacted with in the
 meantime are preserved."
@@ -607,13 +586,6 @@ meantime are preserved."
       (when (and (window-live-p win)
                  (eq buf (window-buffer win)))
         (quit-window nil win)))
-    (when kill
-      (let ((xref--inhibit-mark-current t)
-            kill-buffer-query-functions)
-        (dolist (buf xref--temporary-buffers)
-          (unless (buffer-local-value 'xref--current buf)
-            (kill-buffer buf)))
-        (setq xref--temporary-buffers nil)))
     (quit-window kill window)))
 
 (defconst xref-buffer-name "*xref*"
@@ -687,15 +659,13 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
         (pop-to-buffer (current-buffer))
         (goto-char (point-min))
         (setq xref--window (assoc-default 'window alist))
-        (setq xref--temporary-buffers (assoc-default 'temporary-buffers alist))
-        (dolist (buf xref--temporary-buffers)
-          (with-current-buffer buf
-            (add-hook 'buffer-list-update-hook #'xref--mark-selected nil t)))
         (current-buffer)))))
 
 
 ;; This part of the UI seems fairly uncontroversial: it reads the
 ;; identifier and deals with the single definition case.
+;; (FIXME: do we really want this case to be handled like that in
+;; "find references" and "find regexp searches"?)
 ;;
 ;; The controversial multiple definitions case is handed off to
 ;; xref-show-xrefs-function.
@@ -707,21 +677,15 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
 
 (defvar xref--read-pattern-history nil)
 
-(defun xref--show-xrefs (input kind arg window)
-  (let* ((bl (buffer-list))
-         (xrefs (funcall xref-find-function kind arg))
-         (tb (cl-set-difference (buffer-list) bl)))
-    (cond
-     ((null xrefs)
-      (user-error "No %s found for: %s" (symbol-name kind) input))
-     ((not (cdr xrefs))
-      (xref-push-marker-stack)
-      (xref--pop-to-location (car xrefs) window))
-     (t
-      (xref-push-marker-stack)
-      (funcall xref-show-xrefs-function xrefs
-               `((window . ,window)
-                 (temporary-buffers . ,tb)))))))
+(defun xref--show-xrefs (xrefs window)
+  (cond
+   ((not (cdr xrefs))
+    (xref-push-marker-stack)
+    (xref--pop-to-location (car xrefs) window))
+   (t
+    (xref-push-marker-stack)
+    (funcall xref-show-xrefs-function xrefs
+             `((window . ,window))))))
 
 (defun xref--prompt-p (command)
   (or (eq xref-prompt-for-identifier t)
@@ -749,8 +713,14 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
 
 ;;; Commands
 
+(defun xref--find-xrefs (input kind arg window)
+  (let ((xrefs (funcall xref-find-function kind arg)))
+    (unless xrefs
+      (user-error "No %s found for: %s" (symbol-name kind) input))
+    (xref--show-xrefs xrefs window)))
+
 (defun xref--find-definitions (id window)
-  (xref--show-xrefs id 'definitions id window))
+  (xref--find-xrefs id 'definitions id window))
 
 ;;;###autoload
 (defun xref-find-definitions (identifier)
@@ -784,36 +754,7 @@ display the list in a buffer."
   "Find references to the identifier at point.
 With prefix argument, prompt for the identifier."
   (interactive (list (xref--read-identifier "Find references of: ")))
-  (xref--show-xrefs identifier 'references identifier nil))
-
-;; TODO: Rename and move to project-find-regexp, as soon as idiomatic
-;; usage of xref from other packages has stabilized.
-;;;###autoload
-(defun xref-find-regexp (regexp)
-  "Find all matches for REGEXP.
-With \\[universal-argument] prefix, you can specify the directory
-to search in, and the file name pattern to search for."
-  (interactive (list (xref--read-identifier "Find regexp: ")))
-  (require 'grep)
-  (let* ((proj (project-current))
-         (files (if current-prefix-arg
-                    (grep-read-files regexp)
-                  "*"))
-         (dirs (if current-prefix-arg
-                   (list (read-directory-name "Base directory: "
-                                              nil default-directory t))
-                 (project-prune-directories
-                  (append
-                   (project-roots proj)
-                   (project-search-path proj)))))
-         (xref-find-function
-          (lambda (_kind regexp)
-            (cl-mapcan
-             (lambda (dir)
-               (xref-collect-matches regexp files dir
-                                     (project-ignores proj dir)))
-             dirs))))
-    (xref--show-xrefs regexp 'matches regexp nil)))
+  (xref--find-xrefs identifier 'references identifier nil))
 
 (declare-function apropos-parse-pattern "apropos" (pattern))
 
@@ -825,7 +766,7 @@ The argument has the same meaning as in `apropos'."
                       "Search for pattern (word list or regexp): "
                       nil 'xref--read-pattern-history)))
   (require 'apropos)
-  (xref--show-xrefs pattern 'apropos
+  (xref--find-xrefs pattern 'apropos
                     (apropos-parse-pattern
                      (if (string-equal (regexp-quote pattern) pattern)
                          ;; Split into words
@@ -869,7 +810,6 @@ and just use etags."
 
 (declare-function semantic-symref-find-references-by-name "semantic/symref")
 (declare-function semantic-find-file-noselect "semantic/fw")
-(declare-function grep-read-files "grep")
 (declare-function grep-expand-template "grep")
 
 (defun xref-collect-references (symbol dir)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 28ddeb3d58b..efd816b4f0e 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1433,8 +1433,9 @@ Argument BACKEND is the backend you are using."
    (lambda (str)
      ;; Commented or empty lines.
      (string-match-p "\\`\\(?:#\\|[ \t\r\n]*\\'\\)" str))
-   (vc--read-lines
-    (vc-call-backend backend 'find-ignore-file file))))
+   (let ((file (vc-call-backend backend 'find-ignore-file file)))
+     (and (file-exists-p file)
+          (vc--read-lines file)))))
 
 (defun vc--read-lines (file)
   "Return a list of lines of FILE."
diff --git a/test/automated/cl-lib-tests.el b/test/automated/cl-lib-tests.el
index b31622fdc33..9b230db99e4 100644
--- a/test/automated/cl-lib-tests.el
+++ b/test/automated/cl-lib-tests.el
@@ -117,8 +117,8 @@
       (should (equal (cl-set-difference b b) e))
       ;; Note: this test (and others) is sensitive to the order of the
       ;; result, which is not documented.
-      (should (equal (cl-set-difference a b) (list c2 "x" "" nil 'a)))
-      (should (equal (cl-set-difference b a) (list 'x 'y)))
+      (should (equal (cl-set-difference a b) (list 'a  nil "" "x" c2)))
+      (should (equal (cl-set-difference b a) (list 'y 'x)))
 
       ;; We aren't testing whether this is really using `eq' rather than `eql'.
       (should (equal (cl-set-difference e e :test 'eq) e))
@@ -128,8 +128,8 @@
       (should (equal (cl-set-difference b e :test 'eq) b))
       (should (equal (cl-set-difference e b :test 'eq) e))
       (should (equal (cl-set-difference b b :test 'eq) e))
-      (should (equal (cl-set-difference a b :test 'eq) (list c2 "x" "" nil 'a)))
-      (should (equal (cl-set-difference b a :test 'eq) (list 'x 'y)))
+      (should (equal (cl-set-difference a b :test 'eq) (list 'a  nil "" "x" c2)))
+      (should (equal (cl-set-difference b a :test 'eq) (list 'y 'x)))
 
       (should (equal (cl-union e e) e))
       (should (equal (cl-union a e) a))