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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
;;; Guile-Git --- GNU Guile bindings of libgit2
;;; Copyright © 2016, 2017 Erik Edrosa <erik.edrosa@gmail.com>
;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@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 tag)
#:use-module (rnrs bytevectors)
#:use-module (system foreign)
#:use-module (git bindings)
#:use-module (git types)
#:use-module (git structs)
#:export (tag-lookup
tag-lookup-prefix
tag-id
tag-target-id
tag-message
tag-name
tag-create
tag-create!
tag-create-lightweight
tag-create-lightweight!
tag-foreach
tag-fold))
(define %tag-free (libgit2->pointer "git_tag_free"))
(define (pointer->tag! pointer)
(set-pointer-finalizer! pointer %tag-free)
(pointer->tag pointer))
(define tag-lookup
(let ((proc (libgit2->procedure* "git_tag_lookup" '(* * *))))
(lambda (repository oid)
(let ((out (make-double-pointer)))
(proc out (repository->pointer repository) (oid->pointer oid))
(pointer->tag! (dereference-pointer out))))))
(define tag-lookup-prefix
(let ((proc (libgit2->procedure* "git_tag_lookup_prefix" `(* * * ,size_t))))
(lambda (repository oid length)
(let ((out (make-double-pointer)))
(proc out (repository->pointer repository) (oid->pointer oid) length)
(pointer->tag! (dereference-pointer out))))))
(define tag-id
(let ((proc (libgit2->procedure '* "git_tag_id" '(*))))
(lambda (tag)
(pointer->oid (proc (tag->pointer tag))))))
(define tag-target-id
(let ((proc (libgit2->procedure '* "git_tag_target_id" '(*))))
(lambda (tag)
(pointer->oid (proc (tag->pointer tag))))))
(define tag-message
(let ((proc (libgit2->procedure '* "git_tag_message" '(*))))
(lambda (tag)
(pointer->string (proc (tag->pointer tag))))))
(define tag-name
(let ((proc (libgit2->procedure '* "git_tag_name" '(*))))
(lambda (tag)
(pointer->string (proc (tag->pointer tag))))))
(define tag-create
(let ((proc (libgit2->procedure* "git_tag_create" `(* * * * * * ,int))))
(lambda* (repository name target tagger message #:optional (force? #f))
(let ((oid (make-oid-pointer)))
(proc oid
(repository->pointer repository)
(string->pointer name)
(object->pointer target)
(signature->pointer tagger)
(string->pointer message)
(if force? 1 0))
(pointer->oid oid)))))
(define tag-create!
(lambda (repository name target tagger message)
(tag-create repository name target tagger message #t)))
(define tag-create-lightweight
(let ((proc (libgit2->procedure* "git_tag_create_lightweight"
`(* * * * ,int))))
(lambda* (repository name target #:optional (force? #f))
(let ((oid (make-oid-pointer)))
(proc oid
(repository->pointer repository)
(string->pointer name)
(object->pointer target)
(if force? 1 0))
(pointer->oid oid)))))
(define tag-create-lightweight!
(lambda (repository name target)
(tag-create-lightweight repository name target #t)))
(define tag-foreach
(let ((proc (libgit2->procedure* "git_tag_foreach"
`(* * *))))
(lambda (repository callback)
(let ((callback* (procedure->pointer int
(lambda (name oid _)
(callback
(pointer->string name)
(pointer->oid oid)))
'(* * *))))
(proc (repository->pointer repository) callback* %null-pointer)))))
(define (tag-fold proc knil repository)
(let ((out knil))
(tag-foreach
repository
(lambda (name oid)
(set! out (proc name oid out))
0))
out))
|
