gnu: emacs-org: Update to 9.4.

[jackhill/guix/guix.git] / guix / git.scm

diff --git a/guix/git.scm b/guix/git.scm
index 19c1cb5..637936c 100644 (file)
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -39,6 +39,7 @@
   #:export (%repository-cache-directory
             honor-system-x509-certificates!
 
+            url-cache-directory
             with-repository
             with-git-error-handling
             false-if-git-not-found
@@ -150,47 +151,52 @@ of SHA1 string."
     (last (string-split url #\/)) ".git" "")
    "-" (string-take sha1 7)))
 
+(define (resolve-reference repository ref)
+  "Resolve the branch, commit or tag specified by REF, and return the
+corresponding Git object."
+  (let resolve ((ref ref))
+    (match ref
+      (('branch . branch)
+       (let ((oid (reference-target
+                   (branch-lookup repository branch BRANCH-REMOTE))))
+         (object-lookup repository oid)))
+      (('commit . commit)
+       (let ((len (string-length commit)))
+         ;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we
+         ;; can't be sure it's available.  Furthermore, 'string->oid' used to
+         ;; read out-of-bounds when passed a string shorter than 40 chars,
+         ;; which is why we delay calls to it below.
+         (if (< len 40)
+             (if (module-defined? (resolve-interface '(git object))
+                                  'object-lookup-prefix)
+                 (object-lookup-prefix repository (string->oid commit) len)
+                 (raise (condition
+                         (&message
+                          (message "long Git object ID is required")))))
+             (object-lookup repository (string->oid commit)))))
+      (('tag-or-commit . str)
+       (if (or (> (string-length str) 40)
+               (not (string-every char-set:hex-digit str)))
+           (resolve `(tag . ,str))              ;definitely a tag
+           (catch 'git-error
+             (lambda ()
+               (resolve `(tag . ,str)))
+             (lambda _
+               ;; There's no such tag, so it must be a commit ID.
+               (resolve `(commit . ,str))))))
+      (('tag    . tag)
+       (let ((oid (reference-name->oid repository
+                                       (string-append "refs/tags/" tag))))
+         ;; OID may point to a "tag" object, but it can also point directly
+         ;; to a "commit" object, as surprising as it may seem.  Return that
+         ;; object, whatever that is.
+         (object-lookup repository oid))))))
+
 (define (switch-to-ref repository ref)
   "Switch to REPOSITORY's branch, commit or tag specified by REF.  Return the
 OID (roughly the commit hash) corresponding to REF."
   (define obj
-    (let resolve ((ref ref))
-      (match ref
-        (('branch . branch)
-         (let ((oid (reference-target
-                     (branch-lookup repository branch BRANCH-REMOTE))))
-           (object-lookup repository oid)))
-        (('commit . commit)
-         (let ((len (string-length commit)))
-           ;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we
-           ;; can't be sure it's available.  Furthermore, 'string->oid' used to
-           ;; read out-of-bounds when passed a string shorter than 40 chars,
-           ;; which is why we delay calls to it below.
-           (if (< len 40)
-               (if (module-defined? (resolve-interface '(git object))
-                                    'object-lookup-prefix)
-                   (object-lookup-prefix repository (string->oid commit) len)
-                   (raise (condition
-                           (&message
-                            (message "long Git object ID is required")))))
-               (object-lookup repository (string->oid commit)))))
-        (('tag-or-commit . str)
-         (if (or (> (string-length str) 40)
-                 (not (string-every char-set:hex-digit str)))
-             (resolve `(tag . ,str))              ;definitely a tag
-             (catch 'git-error
-               (lambda ()
-                 (resolve `(tag . ,str)))
-               (lambda _
-                 ;; There's no such tag, so it must be a commit ID.
-                 (resolve `(commit . ,str))))))
-        (('tag    . tag)
-         (let ((oid (reference-name->oid repository
-                                         (string-append "refs/tags/" tag))))
-           ;; OID may point to a "tag" object, but it can also point directly
-           ;; to a "commit" object, as surprising as it may seem.  Return that
-           ;; object, whatever that is.
-           (object-lookup repository oid))))))
+    (resolve-reference repository ref))
 
   (reset repository obj RESET_HARD)
   (object-id obj))
@@ -287,6 +293,7 @@ definitely available in REPOSITORY, false otherwise."
                                  #:key
                                  (ref '(branch . "master"))
                                  recursive?
+                                 (check-out? #t)
                                  starting-commit
                                  (log-port (%make-void-port "w"))
                                  (cache-directory
@@ -301,7 +308,10 @@ provided) as returned by 'commit-relation'.
 REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value
 the associated data: [<branch name> | <sha1> | <tag name> | <string>].
 
-When RECURSIVE? is true, check out submodules as well, if any."
+When RECURSIVE? is true, check out submodules as well, if any.
+
+When CHECK-OUT? is true, reset the cached working tree to REF; otherwise leave
+it unchanged."
   (define canonical-ref
     ;; We used to require callers to specify "origin/" for each branch, which
     ;; made little sense since the cache should be transparent to them.  So
@@ -332,7 +342,10 @@ When RECURSIVE? is true, check out submodules as well, if any."
 
      ;; Note: call 'commit-relation' from here because it's more efficient
      ;; than letting users re-open the checkout later on.
-     (let* ((oid      (switch-to-ref repository canonical-ref))
+     (let* ((oid      (if check-out?
+                          (switch-to-ref repository canonical-ref)
+                          (object-id
+                           (resolve-reference repository canonical-ref))))
             (new      (and starting-commit
                            (commit-lookup repository oid)))
             (old      (and starting-commit