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" ()) +;; 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. -(defvar project-search-path-function #'etags-search-path - "Function that returns a list of source root directories. +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 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. - -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. +(cl-defgeneric project-library-roots (project) + "Return the list of library roots for PROJECT. -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)))) +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))