my-repo-pins--get-code-root-projects: add max-depth stop gap
We currently discriminate a regular directory from a project by looking for a .git directory. This heuristics works reasonably well but isn't perfect. It'll fail for non-git projects, git worktree, etc. We were recursing through the code root until we reached a project. If the project detection heuristics fails, we'll recurse way too deep. This can create some serious performance issues. We introduce a maximum recursion depth to prevent the tree walker from recursing too deep. We set this maximum to 2 by default to reflect the expected <forge>/<user>/<project> scheme. We expose this maximum depth via a customization variable. If set to nil, there won't be any limit. Kudos to Marcin S. aka. m-cat for the help. Bug report: https://github.com/NinjaTrappeur/my-repo-pins/issues/7
This commit is contained in:
parent
939a4dfd1c
commit
23419e5cc5
12
README.md
12
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 `<forge>/<username>` 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`.
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -22,7 +22,6 @@
|
|||
;; along with this program. If not, see <https://www.gnu.org/licenses/>
|
||||
;;
|
||||
;;; 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
|
||||
<forge>/<username> 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))))
|
||||
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)
|
||||
(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))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue