diff options
author | Ludovic Courtès <ludo@gnu.org> | 2024-03-31 23:16:30 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2024-04-15 22:36:41 +0200 |
commit | a57518484e5437b29496e1c132c6566e1eb437e8 (patch) | |
tree | b38925af1c45780127dbddf86e8b1ccaac9fe2af /guix/git.scm | |
parent | 3cadb61963b2116d35a0f9b989223cf19155bec6 (diff) | |
download | guix-patches-a57518484e5437b29496e1c132c6566e1eb437e8.tar guix-patches-a57518484e5437b29496e1c132c6566e1eb437e8.tar.gz |
git: Add ‘repository-info’ and use it in (guix channels).
* guix/git.scm (repository-info): New procedure.
* guix/channels.scm (repository->guix-channel): Use it instead of local
code.
Change-Id: I74c758c73a22e16031571ca4271cc9cab0492f6e
Diffstat (limited to 'guix/git.scm')
-rw-r--r-- | guix/git.scm | 19 |
1 files changed, 18 insertions, 1 deletions
diff --git a/guix/git.scm b/guix/git.scm index cbcdb1904b..760b064a9c 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com> -;;; Copyright © 2018-2023 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018-2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2021 Marius Bakke <marius@gnu.org> ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> @@ -59,6 +59,7 @@ with-repository with-git-error-handling false-if-git-not-found + repository-info update-cached-checkout url+commit->name latest-repository-commit @@ -330,6 +331,22 @@ dynamic extent of EXP." (lambda (key err) (report-git-error err)))) +(define (repository-info directory) + "Open the Git repository in DIRECTORY or one of its parent and return three +values: the working directory of that repository, its checked out commit ID, +and its checked out reference (such as a branch name). Return #f (three +values) if DIRECTORY does not hold a readable Git repository." + (catch 'git-error + (lambda () + (with-repository (repository-discover directory) repository + (let* ((head (repository-head repository)) + (commit (oid->string (reference-target head)))) + (values (repository-working-directory repository) + commit + (reference-shorthand head))))) + (lambda _ + (values #f #f #f)))) + (define* (update-submodules repository #:key (log-port (current-error-port)) (fetch-options #f)) |