diff --git a/README.md b/README.md index a9e60f1..325aa9a 100644 --- a/README.md +++ b/README.md @@ -86,6 +86,18 @@ All the code fetched using `my-repo-pins` will end up in this root directory. A For instance, after checking out https://git.savannah.gnu.org/git/emacs/org-mode.git, the source code will live in the my-repo-pins-code-root/git.savannah.gnu.org/git/emacs/org-mode/ local directory +### my-repo-pins-max-depth + +Maximum search depth starting from the `my-repo-pins-code-root` directory. + +Set this variable to nil if you don't want any limit. + +This is a performance stop gap. It'll prevent my repo pins from accidentally walking too deep if it fails to detect a project boundary. + +By default, this limit is set to 2 to materialize the `/` directories that are supposed to contain the projects. + +We won't search further once we reach this limit. A warning message is issued to the `*Messages*` buffer to warn the user the limit has been reached. + ### my-repo-pins-git-bin Path pointing to the git binary. By default, it'll look for git in the current `$PATH`. diff --git a/my-repo-pins-tests.el b/my-repo-pins-tests.el index aee417d..e4c6567 100644 --- a/my-repo-pins-tests.el +++ b/my-repo-pins-tests.el @@ -114,6 +114,36 @@ For reference: test-root-2 looks like this: (my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example2.tld/user1/proj1")) (funcall func temp-dir))))) +(defun my-repo-pins--tests-run-on-nested-testroot (func) + "Run the FUNC function on testroot2. + +FUNC is called with the directory cotaining test root 2 as parameter. + +For reference: test-root-2 looks like this: + test-root-2 + ├── example1.tld + │ ├── user1 + │ │ ├── proj1 + │ │ ├── nested + │ │ │ └── repo + │ │ └── nested2 + │ │ └── git + │ │ └── repo + │ └── user2 + │ └── proj1 + └── example2.tld + └── user1 + └── proj1" + (my-repo-pins--tests-with-temp-dir + (lambda (temp-dir) + (progn + (my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/proj1")) + (my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/nested/repo")) + (my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user1/nested2/git/repo")) + (my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example1.tld/user2/proj1")) + (my-repo-pins--tests-init-fake-git-repo (concat temp-dir "example2.tld/user1/proj1")) + (funcall func temp-dir))))) + (defun my-repo-pins--tests-run-on-empty-testroot (func) "Run the FUNC function on testroot1. @@ -134,7 +164,7 @@ For reference: a empty test root looks like this: "Test the `my-repo-pins--get-code-root-projects with test-root-1 setup." (let ((results - (my-repo-pins--tests-run-on-testroot-1 (lambda (root) (my-repo-pins--get-code-root-projects root)))) + (my-repo-pins--tests-run-on-testroot-1 (lambda (root) (my-repo-pins--get-code-root-projects root 3)))) ) (should (member "example1.tld/user1/proj1" results)) (should (member "example1.tld/user1/proj2" results)) @@ -151,7 +181,7 @@ For reference: a empty test root looks like this: (my-repo-pins--tests-run-on-testroot-1 (lambda (root) (progn (setq r root) - (my-repo-pins--find-git-dirs-recursively root)))))) + (my-repo-pins--find-git-dirs-recursively root 3)))))) (should (member (concat r "example1.tld/user1/proj1/") results)) (should (member (concat r "example1.tld/user1/proj2/") results)) (should (member (concat r "example1.tld/user2/proj1/") results)) @@ -162,13 +192,49 @@ For reference: a empty test root looks like this: "Test the `my-repo-pins--get-code-root-projects with test-root-2 setup." (let ((results - (my-repo-pins--tests-run-on-testroot-2 (lambda (root) (my-repo-pins--get-code-root-projects root)))) + (my-repo-pins--tests-run-on-testroot-2 (lambda (root) (my-repo-pins--get-code-root-projects root 3)))) ) (should (member "example1.tld/user1/proj1" results)) (should (member "example1.tld/user2/proj1" results)) (should (member "example2.tld/user1/proj1" results)) (should (eq (length results) 3)))) +(ert-deftest my-repo-pins--tests-get-code-root-projects-nested-coderoot-max-depth-2 () + "Test the `my-repo-pins--get-code-root-projects with nested-test-root setup." + (let + ((results + (my-repo-pins--tests-run-on-nested-testroot (lambda (root) (my-repo-pins--get-code-root-projects root 2)))) + ) + (should (member "example1.tld/user1/proj1" results)) + (should (member "example1.tld/user2/proj1" results)) + (should (member "example2.tld/user1/proj1" results)) + (should (eq (length results) 3)))) + +(ert-deftest my-repo-pins--tests-get-code-root-projects-nested-coderoot-max-depth-3 () + "Test the `my-repo-pins--get-code-root-projects with nested-test-root setup." + (let + ((results + (my-repo-pins--tests-run-on-nested-testroot (lambda (root) (my-repo-pins--get-code-root-projects root 3)))) + ) + (should (member "example1.tld/user1/proj1" results)) + (should (member "example1.tld/user2/proj1" results)) + (should (member "example2.tld/user1/proj1" results)) + (should (member "example1.tld/user1/nested/repo" results)) + (should (not (member "example1.tld/user1/nested2/git/repo" results))) + (should (eq (length results) 4)))) + +(ert-deftest my-repo-pins--tests-get-code-root-projects-nested-coderoot-max-depth-no-limit () + "Test the `my-repo-pins--get-code-root-projects with nested-test-root setup." + (let + ((results + (my-repo-pins--tests-run-on-nested-testroot (lambda (root) (my-repo-pins--get-code-root-projects root nil))))) + (should (member "example1.tld/user1/proj1" results)) + (should (member "example1.tld/user2/proj1" results)) + (should (member "example2.tld/user1/proj1" results)) + (should (member "example1.tld/user1/nested/repo" results)) + (should (member "example1.tld/user1/nested2/git/repo" results)) + (should (eq (length results) 5)))) + (ert-deftest my-repo-pins--tests-find-git-dirs-recursively-coderoot-2 () "Test the `my-repo-pins--get-code-root-projects with test-root-2 setup." (let* @@ -177,7 +243,7 @@ For reference: a empty test root looks like this: (my-repo-pins--tests-run-on-testroot-2 (lambda (root) (progn (setq r root) - (my-repo-pins--find-git-dirs-recursively root)))))) + (my-repo-pins--find-git-dirs-recursively root 3)))))) (should (member (concat r "example1.tld/user1/proj1/") results)) (should (member (concat r "example1.tld/user2/proj1/") results)) (should (member (concat r "example2.tld/user1/proj1/") results)) @@ -187,7 +253,7 @@ For reference: a empty test root looks like this: "Test the `my-repo-pins--get-code-root-projects with a empty coderoot." (let ((results - (my-repo-pins--tests-run-on-empty-testroot (lambda (root) (my-repo-pins--get-code-root-projects root)))) + (my-repo-pins--tests-run-on-empty-testroot (lambda (root) (my-repo-pins--get-code-root-projects root 3)))) ) (should (seq-empty-p results)))) @@ -195,14 +261,14 @@ For reference: a empty test root looks like this: "Test the `my-repo-pins--get-code-root-projects with a empty coderoot." (let ((results - (my-repo-pins--tests-run-on-empty-testroot (lambda (root) (my-repo-pins--find-git-dirs-recursively root)))) + (my-repo-pins--tests-run-on-empty-testroot (lambda (root) (my-repo-pins--find-git-dirs-recursively root 3)))) ) (should (seq-empty-p results)))) (ert-deftest my-repo-pins--tests-get-code-root-projects-no-coderoot () "Test the `my-repo-pins--get-code-root-projects with a non-existing coderoot." (let - ((results (my-repo-pins--get-code-root-projects "/does/not/exist"))) + ((results (my-repo-pins--get-code-root-projects "/does/not/exist" 3))) (should (seq-empty-p results)))) diff --git a/my-repo-pins.el b/my-repo-pins.el index 8a1f580..097ce1e 100644 --- a/my-repo-pins.el +++ b/my-repo-pins.el @@ -3,7 +3,7 @@ ;;; Copyright (C) 2022 Félix Baylac Jacqué ;;; Author: Félix Baylac Jacqué ;;; Maintainer: Félix Baylac Jacqué -;;; Version: 0.1 +;;; Version: 0.2 ;;; Homepage: https://alternativebit.fr/projects/my-repo-pins/ ;;; Package-Requires: ((emacs "26.1")) ;;; License: @@ -22,7 +22,6 @@ ;; along with this program. If not, see ;; ;;; Commentary: -;; ;; Open source developers often have to jump between projects, either ;; to read code, or to craft patches. My Repo Pins reduces the ;; friction so that it becomes trivial to do so. @@ -197,6 +196,26 @@ A ongoing/failed lookup will also be represented by an entry in this alist: (make-mutex "my-repo-pins-ui-mutex") "Mutex in charge of preventing several fetchers to update the state concurently.") +(defcustom my-repo-pins-max-depth + 2 + "Maximum search depth starting from the ‘my-repo-pins-code-root’ directory. + +Set this variable to nil if you don't want any limit. + +This is a performance stop gap. It'll prevent my repo pins from +accidentally walking too deep if it fails to detect a project +boundary. + +By default, this limit is set to 2 to materialize the +/ directories that are supposed to contain the +projects. + +We won't search further once we reach this limit. A warning message is +issued to the *Messages* buffer to warn the user the limit has been +reached." + :type 'integer + :group 'my-repo-pins-group) + ;; Sourcehut Fetcher (defun my-repo-pins--query-sourcehut-owner-repo (instance-url user-name repo-name callback) "Query the INSTANCE-URL Sourcehut instance and retrieve some infos about a repo. @@ -424,7 +443,7 @@ Errors out if ‘my-repo-pins-code-root’ has not been set yet." (expand-file-name (file-name-as-directory my-repo-pins-code-root))) -(defun my-repo-pins--find-git-dirs-recursively (dir) +(defun my-repo-pins--find-git-dirs-recursively (dir max-depth) "Vendored, slightly modified version of ‘directory-files-recursively’. This library isn't available for Emacs > 25.1. Vendoring it for @@ -438,30 +457,52 @@ recursively. Files are returned in \"depth first\" order, and files from each directory are sorted in alphabetical order. Each file name appears in the returned list in its absolute form. -By default, the returned list excludes directories, but if -optional argument INCLUDE-DIRECTORIES is non-nil, they are -included." - (let* ((projects nil) - (recur-result nil) - (dir (directory-file-name dir))) - (dolist (file (sort (file-name-all-completions "" dir) - 'string<)) - (unless (member file '("./" "../")) - (if (directory-name-p file) - ;; Don't follow symlinks to other directories. - (let ((full-file (concat dir "/" file))) - (when (not (file-symlink-p full-file)) - (if (file-directory-p (concat full-file ".git")) - ;; It's a git repo, let's stop here. - (setq projects (nconc projects (list full-file))) - ;; It's not a git repo, let's recurse into it. - (setq recur-result - (nconc recur-result - (my-repo-pins--find-git-dirs-recursively full-file))))))))) - (nconc recur-result (nreverse projects)))) - - -(defun my-repo-pins--get-code-root-projects (code-root) +The recursion will halt once MAX-DEPTH is reached. In that case, a +information message will be written to the message buffer. + +If MAX-DEPTH is set to nil, do not use any recursion stop gap." + (cl-labels + ((recurse-in-dir + (dir depth) + (let* ((projects nil) + (recur-result nil) + (dir (directory-file-name dir))) + (dolist (file (sort (file-name-all-completions "" dir) + 'string<)) + (unless (member file '("./" "../")) + (if (directory-name-p file) + (let ((full-file (concat dir "/" file))) + ;; Don't follow symlinks to other directories. + (when (not (file-symlink-p full-file)) + (if (file-directory-p (concat full-file ".git")) + ;; It's a git repo, let's stop here. + (setq projects (nconc projects (list full-file))) + ;; It's not a git repo, let's recurse into it. + (if max-depth + ;; if we didn't reach the max depth yet, recurse. + (if (not (> (+ depth 1) max-depth)) + (setq recur-result + (nconc recur-result + (recurse-in-dir full-file (+ depth 1)))) + ;; we reached the max depth limit, issue a info message + (message + (concat + "my-repo-pins: max depth reached for " + "%s, we won't search for projects in that directory. " + "We might miss some projects. " + "Increase the my-repo-pins-max-depth variable value if " + "you want to look for projects in that directory.") + full-file)) + ;; There's no max depth, let's recurse. + (setq recur-result + (nconc recur-result + (recurse-in-dir full-file nil)))))))))) + (nconc recur-result (nreverse projects))))) + (if max-depth + (recurse-in-dir dir 0) + (recurse-in-dir dir nil)))) + +(defun my-repo-pins--get-code-root-projects (code-root max-depth) "Retrieve the projects contained in the CODE-ROOT directory. We're going to make some hard assumptions about how the ‘my-repo-pins-code-root’ directory should look like. First of all, if @@ -471,6 +512,10 @@ considered as a project root. It means that after encountering a git repository, we won't recurse any further. +We also won't recurse for directories nested deeper than MAX-DEPTH. + +If MAX-DEPTH is set to -1, do not use any recursion stop gap. + If the directory pointed by ‘my-repo-pins-code-root’ does not exists yet, returns an empty list." (if (not (file-directory-p code-root)) @@ -480,7 +525,7 @@ yet, returns an empty list." (lambda (path) (let ((path-without-prefix (string-remove-prefix code-root path))) (substring path-without-prefix 0 (1- (length path-without-prefix)))))) - (projects-absolute-path (my-repo-pins--find-git-dirs-recursively code-root)) + (projects-absolute-path (my-repo-pins--find-git-dirs-recursively code-root max-depth)) (projects-relative-to-code-root (mapcar remove-code-root-prefix-and-trailing-slash projects-absolute-path))) projects-relative-to-code-root))) @@ -774,7 +819,7 @@ available forge sources." (let ((user-query (my-repo-pins--completing-read-or-custom "Jump to project: " - (my-repo-pins--get-code-root-projects (my-repo-pins--safe-get-code-root))))) + (my-repo-pins--get-code-root-projects (my-repo-pins--safe-get-code-root) my-repo-pins-max-depth)))) (cond ((equal (car user-query) 'in-collection) (let ((selected-project-absolute-path (concat (my-repo-pins--safe-get-code-root) (cdr user-query))))