1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
;;; Guile-Git --- GNU Guile bindings of libgit2
;;; Copyright © 2016 Amirouche Boubekki <amirouche@hypermove.net>
;;; Copyright © 2016 Erik Edrosa <erik.edrosa@gmail.com>
;;; Copyright © 2019 Marius Bakke <marius@devup.no>
;;;
;;; This file is part of Guile-Git.
;;;
;;; Guile-Git is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Guile-Git is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Guile-Git. If not, see <http://www.gnu.org/licenses/>.
(define-module (git clone)
#:use-module (rnrs bytevectors)
#:use-module (system foreign)
#:use-module (git bindings)
#:use-module (git fetch)
#:use-module (git structs)
#:use-module (git types)
#:use-module (git repository)
#:export (clone
clone-init-options ;deprecated!
make-clone-options))
;;; clone https://libgit2.github.com/libgit2/#HEAD/group/clone
(define CLONE-OPTIONS-VERSION 1)
(define clone
(let ((proc (libgit2->procedure* "git_clone" '(* * * *))))
(lambda* (url directory
#:optional (clone-options (make-clone-options)))
"Clones a remote repository found at URL into DIRECTORY. An
authentication method from (git auth) can be passed optionally if the
repository is protected. Returns the repository on success or throws an error
on failure."
(let ((out (make-double-pointer)))
(proc out
(string->pointer url)
(string->pointer directory)
(clone-options->pointer clone-options))
(pointer->repository! (dereference-pointer out))))))
(define make-clone-options
(let ((proc (libgit2->procedure* "git_clone_init_options"
`(* ,unsigned-int))))
(lambda* (#:key (fetch-options (make-fetch-options)))
(let ((clone-options (make-clone-options-bytestructure)))
(proc (clone-options->pointer clone-options) CLONE-OPTIONS-VERSION)
(set-clone-options-fetch-opts! clone-options fetch-options)
clone-options))))
(define clone-init-options
;; Deprecated alias for compatibility with 0.2.
make-clone-options)
|
