Source

chicken-git / git-lolevel.scm

Full commit
  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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; git-lolevel.scm - libgit2 bindings for Chicken Scheme
;;;
;;; Copyright (c) 2013, Evan Hanson
;;; See LICENSE for details
;;;
;;; See git.scm for a cleaner, high-level API.
;;;

(require-library foreigners lolevel srfi-13 srfi-69)

(module git-lolevel ()
  (import scheme foreigners lolevel srfi-69)
  (import foreign)
  (import (only srfi-13 string-index))
  (import (except chicken repository-path))
  (include "git-lolevel-exports.scm")

;; Errors are composite conditions of properties (exn git).
(define (git-error loc msg . args)
  (signal (make-composite-condition
            (make-property-condition 'git)
            (make-property-condition 'exn 'location  loc
                                          'message   msg
                                          'arguments args))))

;; Check the return value of an expression, signaling an error when nonzero.
(define-syntax guard-errors
  (syntax-rules ()
    ((_ <loc> <exp> . <arg>)
     (begin
       (error-clear)
       (let ((res <exp>))
         (if (< res 0)
             (git-error '<loc> (error-last))))))))

;; Create a foreign procedure whose return value should be checked as an
;; integer status.
(define-syntax foreign-lambda/retval
  (lambda (e . _)
    (let* ((name    (cadr e))
           (args    (cddr e))
           (formals (map (compose gensym ->string) args)))
      `(lambda ,formals
         (guard-errors ,name ((foreign-lambda int ,name ,@args) ,@formals) ,@formals)))))

;; Create a foreign procedure that allocates a location for its return
;; value.
(define-syntax foreign-lambda/allocate
  (lambda (e . _)
    (let* ((type    (cadr e))
           (name    (caddr e))
           (args    (cdddr e))
           (formals (map (compose gensym ->string) args))
           (type*   (if (list? type) (last type) type)))
      `(lambda ,formals
         ,(case type*
            ((oid)
             `(let ((oid (make-oid)))
                ((foreign-lambda/retval ,name ,type ,@args) oid ,@formals)
                (set-finalizer! oid oid-free)))
            ((strarray)
             `(let ((sa (make-strarray)))
                ((foreign-lambda/retval ,name ,type ,@args) sa ,@formals)
                (strarray-retrieve sa)))
            ((revspec)
             `(let ((revspec (make-revspec)))
                ((foreign-lambda/retval ,name ,type ,@args) revspec ,@formals)
                (set-finalizer! revspec revspec-free)))
            (else
             `(let-location ((object ,type*))
                ((foreign-lambda/retval ,name (c-pointer ,type) ,@args) (location object) ,@formals)
                object)))))))

;;;
;;; Callback management.
;;;
;;; We have to make sure procedures passed to C as callbacks aren't
;;; moved by the GC while in use, so we store them in a lookup table and
;;; pass pointer keys to the libgit2 functions that need them.
;;;

(define-values (callback-lookup callback-unregister! callback-register!)
  (let ((callback-index 1)
        (callback-table (make-hash-table)))
    (values
     (lambda (i) (hash-table-ref callback-table (pointer->address i)))
     (lambda (i) (hash-table-delete! callback-table (pointer->address i)))
     (lambda (c)
       (let ((index callback-index))
         (hash-table-set! callback-table index c)
         (set! callback-index (+ index 1))
         (address->pointer index))))))

(define (call-with-callback c proc)
  (let ((callback #f))
    (dynamic-wind
     (lambda () (set! callback (callback-register! c)))
     (lambda () (proc callback))
     (lambda () (callback-unregister! callback)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; git2.h

(foreign-declare "#include <git2.h>")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; types.h

(define-foreign-type unsigned-int16 unsigned-short)
(define-foreign-type time-t integer64)
(define-foreign-type off-t integer64)

(define-foreign-record-type (time git_time)
  (time-t time time-time)
  (int offset time-offset))

(define-foreign-record-type (signature git_signature)
  (c-string name signature-name)
  (c-string email signature-email)
  ((struct time) when signature-time))

(define-foreign-record-type (oid git_oid)
  (constructor: make-oid)
  (destructor: oid-free)
  (unsigned-char (id (foreign-value GIT_OID_RAWSZ int)) oid-id))

(define-foreign-record-type (index-time git_index_time)
  (time-t seconds index-time-seconds)
  (unsigned-int nanoseconds index-time-nanoseconds))

(define-foreign-record-type (index-entry git_index_entry)
  ((struct index-time) ctime index-entry-ctime)
  ((struct index-time) mtime index-entry-mtime)
  (unsigned-int dev index-entry-dev)
  (unsigned-int ino index-entry-ino)
  (unsigned-int mode index-entry-mode)
  (unsigned-int uid index-entry-uid)
  (unsigned-int gid index-entry-gid)
  (off-t file_size index-entry-size)
  ((struct oid) oid index-entry-oid)
  (unsigned-int flags index-entry-flags)
  (unsigned-int flags_extended index-entry-extended)
  (c-string path index-entry-path))

(define-foreign-enum-type (object-type int)
  (object-type->int int->object-type)
  ((any       object-type/any)       GIT_OBJ_ANY)
  ((bad       object-type/bad)       GIT_OBJ_BAD)
  ((ext1      object-type/ext1)      GIT_OBJ__EXT1)
  ((commit    object-type/commit)    GIT_OBJ_COMMIT)
  ((tree      object-type/tree)      GIT_OBJ_TREE)
  ((blob      object-type/blob)      GIT_OBJ_BLOB)
  ((tag       object-type/tag)       GIT_OBJ_TAG)
  ((ext2      object-type/ext2)      GIT_OBJ__EXT2)
  ((ofs-delta object-type/ofs-delta) GIT_OBJ_OFS_DELTA)
  ((ref-delta object-type/ref-delta) GIT_OBJ_REF_DELTA))

(define-foreign-enum-type (filemode int)
  (filemode->int int->filemode)
	((new         filemode/new)        GIT_FILEMODE_NEW)
	((tree        filemode/tree)       GIT_FILEMODE_TREE)
	((blob        filemode/blob)       GIT_FILEMODE_BLOB)
	((executable  filemode/executable) GIT_FILEMODE_BLOB_EXECUTABLE)
	((link        filemode/link)       GIT_FILEMODE_LINK)
	((commit      filemode/commit)     GIT_FILEMODE_COMMIT))

(define-foreign-type commit           (c-pointer "git_commit"))
(define-foreign-type config           (c-pointer "git_config"))
(define-foreign-type blob*            (c-pointer "git_blob")) ; clash w/ built-in
(define-foreign-type index            (c-pointer "git_index"))
(define-foreign-type object           (c-pointer "git_object"))
(define-foreign-type odb              (c-pointer "git_odb"))
(define-foreign-type odb-object       (c-pointer "git_odb_object"))
(define-foreign-type oid-shorten      (c-pointer "git_oid_shorten"))
(define-foreign-type push             (c-pointer "git_push"))
(define-foreign-type reference        (c-pointer "git_reference"))
(define-foreign-type refspec          (c-pointer "git_refspec"))
(define-foreign-type remote           (c-pointer "git_remote"))
(define-foreign-type remote-callbacks (c-pointer "git_remote_callbacks"))
(define-foreign-type remote-head      (c-pointer "git_remote_head"))
(define-foreign-type repository       (c-pointer "git_repository"))
(define-foreign-type revwalk          (c-pointer "git_revwalk"))
(define-foreign-type tag              (c-pointer "git_tag"))
(define-foreign-type tree             (c-pointer "git_tree"))
(define-foreign-type tree-entry       (c-pointer "git_tree_entry"))
(define-foreign-type tree-builder     (c-pointer "git_treebuilder"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; blob.h

(define blob*-lookup             (foreign-lambda/allocate blob* git_blob_lookup repository oid))
(define blob*-lookup-prefix      (foreign-lambda/allocate blob* git_blob_lookup_prefix repository oid unsigned-int))
(define blob*-create-fromdisk    (foreign-lambda/allocate oid git_blob_create_fromdisk repository nonnull-c-string))
(define blob*-create-fromworkdir (foreign-lambda/allocate oid git_blob_create_fromworkdir repository nonnull-c-string))
(define blob*-create-frombuffer  (foreign-lambda/allocate oid git_blob_create_frombuffer repository nonnull-c-string unsigned-int))
(define blob*-free               (foreign-lambda void git_blob_free blob*))
(define blob*-rawcontent         (foreign-lambda c-pointer git_blob_rawcontent blob*))
(define blob*-rawsize            (foreign-lambda size_t git_blob_rawsize blob*))
(define blob*-is-binary          (foreign-lambda bool git_blob_is_binary blob*))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; branch.h

(define-external GIT_BRANCH_ALL int
  (foreign-value "GIT_BRANCH_LOCAL | GIT_BRANCH_REMOTE" int))

(define-foreign-enum-type (branch-type unsigned-int)
  (branch-type->int int->branch-type)
  ((local   branch-type/local)  GIT_BRANCH_LOCAL)
  ((remote  branch-type/remote) GIT_BRANCH_REMOTE)
  ((all     branch-type/all)    GIT_BRANCH_ALL))

(define branch-lookup       (foreign-lambda/allocate reference git_branch_lookup repository nonnull-c-string branch-type))
(define branch-create       (foreign-lambda/allocate reference git_branch_create repository nonnull-c-string commit bool))
(define branch-move         (foreign-lambda/allocate reference git_branch_move reference nonnull-c-string bool))
(define branch-upstream     (foreign-lambda/allocate reference git_branch_upstream reference))
(define branch-name         (foreign-lambda/allocate (const c-string) git_branch_name reference))
(define branch-set-upstream (foreign-lambda/retval git_branch_set_upstream reference nonnull-c-string))
(define branch-delete       (foreign-lambda/retval git_branch_delete reference))
(define branch-is-head      (foreign-lambda bool git_branch_is_head reference))

(define-foreign-type branch-foreach-cb (function int ((const c-string) branch-type c-pointer)))
(define-external (branch_foreach_cb (c-string name) (branch-type type) (c-pointer fn)) int
  ((callback-lookup fn) name type) 0)

(define (branch-foreach repo flags fn)
  (call-with-callback fn
   (lambda (callback)
     (guard-errors git_branch_foreach
      ((foreign-safe-lambda int git_branch_foreach
        repository branch-type branch-foreach-cb            c-pointer)
        repo       flags       (location branch_foreach_cb) callback)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; commit.h

(define commit-lookup           (foreign-lambda/allocate commit git_commit_lookup repository oid))
(define commit-lookup-prefix    (foreign-lambda/allocate commit git_commit_lookup_prefix repository oid unsigned-int))
(define commit-tree             (foreign-lambda/allocate tree git_commit_tree commit))
(define commit-parent           (foreign-lambda/allocate commit git_commit_parent commit unsigned-int))
(define commit-nth-gen-ancestor (foreign-lambda/allocate commit git_commit_nth_gen_ancestor commit unsigned-int))
(define commit-free             (foreign-lambda void git_commit_free commit))
(define commit-id               (foreign-lambda oid git_commit_id commit))
(define commit-message          (foreign-lambda c-string git_commit_message commit))
(define commit-message-encoding (foreign-lambda c-string git_commit_message_encoding commit))
(define commit-time             (foreign-lambda time-t git_commit_time commit))
(define commit-time-offset      (foreign-lambda int git_commit_time_offset commit))
(define commit-committer        (foreign-lambda signature git_commit_committer commit))
(define commit-author           (foreign-lambda signature git_commit_author commit))
(define commit-tree-id          (foreign-lambda oid git_commit_tree_id commit))
(define commit-parentcount      (foreign-lambda unsigned-int git_commit_parentcount commit))
(define commit-parent-id        (foreign-lambda oid git_commit_parent_id commit unsigned-int))

(define (pack-commit-pointer-array ptrs)
  ((foreign-lambda* (c-pointer commit) ((scheme-object ptrs) (int len))
    "int i;
     C_word iter;
     git_commit **out = malloc(sizeof(git_commit *) * len);
     for(i = 0, iter = ptrs; i < len; i++, iter = C_u_i_cdr(iter))
       out[i] = (git_commit *) C_pointer_address(C_u_i_car(iter));
     C_return(out);")
    ptrs
    (length ptrs)))

(define (commit-create repo ref author commit msg tree parents)
  (let ((parents* #f))
    (dynamic-wind
     (lambda ()
       (set! parents* (pack-commit-pointer-array parents)))
     (lambda ()
       ((foreign-lambda/allocate oid git_commit_create
         repository c-string signature signature c-string nonnull-c-string tree int              (c-pointer (const commit)))
         repo       ref      author    commit    #f       msg              tree (length parents) parents*))
     (lambda ()
       (free parents*)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; common.h

(define-foreign-record-type (strarray git_strarray)
  (constructor: make-strarray)
  ((c-pointer c-string) strings %strarray-strings)
  (unsigned-int count strarray-count))

;; Get a GC'd list of strings from a strarray.
(define strarray-strings
  (foreign-lambda* c-string-list* ((strarray sa))
    "int i, l;
     char **t = malloc(sizeof(char *) * (sa->count + 1));
     for(i = 0; i < sa->count; i++) {
       t[i] = malloc((l = strlen(sa->strings[i]) + 1));
       strncpy(t[i], sa->strings[i], l);
     }
     t[i] = NULL;
     C_return(t);"))

(define strarray-free
  (foreign-lambda void git_strarray_free strarray))

(define (strarray-retrieve sa)
  (let ((lst (strarray-strings sa)))
    (strarray-free sa)
    lst))

(define (libgit2-version)
  (let-location ((major int) (minor int) (rev int))
    ((foreign-lambda void git_libgit2_version (c-pointer int) (c-pointer int) (c-pointer int))
     (location major)
     (location minor)
     (location rev))
    (vector major minor rev)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; clone.h

(define-foreign-type clone-options (c-pointer "git_clone_options"))

(define clone (foreign-lambda/allocate repository git_clone nonnull-c-string nonnull-c-string clone-options))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; config.h

(define-foreign-record-type (config-entry git_config_entry)
	((const c-string) name  config-entry-name)
	((const c-string) value config-entry-value)
  (unsigned-int     level config-entry-level))

(define config-free            (foreign-lambda void git_config_free config))
(define config-new             (foreign-lambda/allocate config git_config_new))
(define config-delete-entry    (foreign-lambda/retval git_config_delete_entry config nonnull-c-string))
(define config-add-file-ondisk (foreign-lambda/retval git_config_add_file_ondisk config nonnull-c-string unsigned-int int))
(define config-open-ondisk     (foreign-lambda/allocate config git_config_open_ondisk nonnull-c-string))
(define config-open-default    (foreign-lambda/allocate config git_config_open_default))

(define-syntax foreign-lambda/config-path
  (lambda (e . _)
    `(lambda ()
       (let* ((len (foreign-value GIT_PATH_MAX int))
              (str (make-string len)))
         ((foreign-lambda/retval ,(cadr e) scheme-pointer unsigned-int) str len)
         (substring str 0 (string-index str #\x00))))))

(define config-find-global (foreign-lambda/config-path git_config_find_global))
(define config-find-system (foreign-lambda/config-path git_config_find_system))
(define config-find-xdg    (foreign-lambda/config-path git_config_find_xdg))

(define-syntax foreign-lambda/config
  (syntax-rules (getter setter)
    ((_ getter (<qual> ... <type>) <cfun>)
     (lambda (cfg name)
       (let-location ((out <type>))
         ((foreign-lambda/retval <cfun> (c-pointer (<qual> ... <type>)) config (const nonnull-c-string))
                                        (location out)                  cfg    name)
         out)))
    ((_ getter <type> <cfun>)
     (lambda (cfg name)
       (let-location ((out <type>))
         ((foreign-lambda/retval <cfun> (c-pointer <type>) config (const nonnull-c-string))
                                        (location out)     cfg    name)
         out)))
    ((_ setter <type> <cfun>)
     (foreign-lambda/retval <cfun> config (const nonnull-c-string) <type>))))

(define config-get-entry  (foreign-lambda/config getter (const config-entry) git_config_get_entry))
(define config-get-string (foreign-lambda/config getter (const c-string)     git_config_get_string))
(define config-get-int32  (foreign-lambda/config getter integer32            git_config_get_int32))
(define config-get-int64  (foreign-lambda/config getter integer64            git_config_get_int64))
(define config-get-bool   (foreign-lambda/config getter bool                 git_config_get_bool))
(define config-set-string (foreign-lambda/config setter c-string             git_config_set_string))
(define config-set-int32  (foreign-lambda/config setter integer32            git_config_set_int32))
(define config-set-int64  (foreign-lambda/config setter integer64            git_config_set_int64))
(define config-set-bool   (foreign-lambda/config setter bool                 git_config_set_bool))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; diff.h

(define-foreign-type diff-list (c-pointer "git_diff_list"))
(define-foreign-type diff-file-fn (c-pointer "git_diff_file_fn"))

(define-foreign-enum-type (diff-line char)
  (diff-line->char char->diff-line)
  ((context   diff-line/context)   GIT_DIFF_LINE_CONTEXT)
  ((addition  diff-line/addition)  GIT_DIFF_LINE_ADDITION)
  ((deletion  diff-line/deletion)  GIT_DIFF_LINE_DELETION)
  ((add-eofnl diff-line/add-eofnl) GIT_DIFF_LINE_ADD_EOFNL)
  ((del-eofnl diff-line/del-eofnl) GIT_DIFF_LINE_DEL_EOFNL)
  ((file-hdr  diff-line/file-hdr)  GIT_DIFF_LINE_FILE_HDR)
  ((hunk-hdr  diff-line/hunk-hdr)  GIT_DIFF_LINE_HUNK_HDR)
  ((binary    diff-line/binary)    GIT_DIFF_LINE_BINARY))

(define-foreign-enum-type (delta int)
  (delta->int int->delta)
  ((modified  diff/unmodified) GIT_DELTA_UNMODIFIED)
  ((added     diff/added)      GIT_DELTA_ADDED)
  ((deleted   diff/deleted)    GIT_DELTA_DELETED)
  ((modified  diff/modified)   GIT_DELTA_MODIFIED)
  ((renamed   diff/renamed)    GIT_DELTA_RENAMED)
  ((copied    diff/copied)     GIT_DELTA_COPIED)
  ((ignored   diff/ignored)    GIT_DELTA_IGNORED)
  ((untracked diff/untracked)  GIT_DELTA_UNTRACKED))

(define-foreign-record-type (diff-options git_diff_options)
  (unsigned-int32    flags           diff-options-flags           diff-options-flags-set!)
  (unsigned-int16    context_lines   diff-options-context-lines   diff-options-context-lines-set!)
  (unsigned-int16    interhunk_lines diff-options-interhunk-lines diff-options-interhunk-lines-set!)
  (c-string          old_prefix      diff-options-old-prefix      diff-options-old-prefix-set!)
  (c-string          new_prefix      diff-options-new-prefix      diff-options-new-prefix-set!)
  ((struct strarray) pathspec        diff-options-pathspec        diff-options-pathspec-set!))

(define-foreign-record-type (diff-file git_diff_file)
  ((struct oid)   oid    diff-file-oid)
  (c-string       path   diff-file-path)
  (off-t          size   diff-file-size)
  (unsigned-int32 flags  diff-file-flags)
  (unsigned-int16 mode   diff-file-mode))

(define-foreign-record-type (diff-delta git_diff_delta)
  ((struct diff-file) old_file   diff-delta-old-file)
  ((struct diff-file) new_file   diff-delta-new-file)
  (delta              status     diff-delta-status)
  (unsigned-int32     similarity diff-delta-similarity)
  (unsigned-int32     flags      diff-delta-flags))

(define-foreign-record-type (diff-range git_diff_range)
  (int old_start diff-range-old-start)
  (int old_lines diff-range-old-lines)
  (int new_start diff-range-new-start)
  (int new_lines diff-range-new-lines))

(define diff-list-free (foreign-lambda void git_diff_list_free diff-list))
(define diff-merge     (foreign-lambda/retval git_diff_merge diff-list diff-list))

(define-syntax foreign-lambda/diff
  (lambda (e . _)
    (let* ((name  (cadr e))
           (types (cddr e))
           (args  (map gensym types)))
      `(lambda (repo ,@args)
         (let-location ((diffs diff-list))
           ((foreign-lambda/retval ,name
            (c-pointer diff-list) repository ,@types diff-options)
            (location diffs)      repo       ,@args  #f)
           (set-finalizer! diffs diff-list-free))))))

(define diff-tree-to-tree     (foreign-lambda/diff git_diff_tree_to_tree tree tree))
(define diff-tree-to-index    (foreign-lambda/diff git_diff_tree_to_index tree index))
(define diff-index-to-workdir (foreign-lambda/diff git_diff_index_to_workdir index))
(define diff-tree-to-workdir  (foreign-lambda/diff git_diff_tree_to_workdir tree))

;; (define-foreign-type diff-file-cb (c-pointer "git_diff_file_cb"))
(define-foreign-type diff-file-cb (function int ((const diff-delta) float c-pointer)))
(define-external (diff_file_cb (diff-delta diff) (float progress) (c-pointer fn)) int
  ((callback-lookup fn) diff progress) 0)

;; (define-foreign-type diff-hunk-cb (c-pointer "git_diff_hunk_cb"))
(define-foreign-type diff-hunk-cb (function int ((const diff-delta) (const diff-range) (const c-string) size_t c-pointer)))
(define-external (diff_hunk_cb (diff-delta diff) (diff-range range) (float progress) (c-pointer fn)) int
  ((callback-lookup fn) diff range) 0)

;; (define-foreign-type diff-data-cb (c-pointer "git_diff_data_cb"))
(define-foreign-type diff-data-cb (function int ((const diff-delta) (const diff-range) char (const c-string) size_t c-pointer)))
(define-external (diff_data_cb (diff-delta diff) (diff-range range) (char line) (c-string content) (size_t len) (c-pointer fn)) int
  ((callback-lookup fn) diff range line content) 0)

(define (diff-foreach fn diffs)
  (call-with-callback fn
   (lambda (callback)
     (guard-errors git_diff_foreach
      ((foreign-safe-lambda int git_diff_foreach
        diff-list diff-file-cb            diff-hunk-cb diff-data-cb c-pointer)
        diffs     (location diff_file_cb) #f           #f           callback)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; errors.h

(define-foreign-record-type (error git_error)
  (c-string message error-message)
  (int      klass   error-class))

(define-foreign-enum-type (generic-error int)
  (generic-error->int int->generic-error)
  ((ok             err/ok)             GIT_OK)
  ((error          err/error)          GIT_ERROR)
  ((notfound       err/notfound)       GIT_ENOTFOUND)
  ((exists         err/exists)         GIT_EEXISTS)
  ((ambiguous      err/ambiguous)      GIT_EAMBIGUOUS)
  ((bufs           err/bufs)           GIT_EBUFS)
  ((user           err/user)           GIT_EUSER)
  ((barerepo       err/barerepo)       GIT_EBAREREPO)
  ((orphanedhead   err/orphanedhead)   GIT_EORPHANEDHEAD)
  ((nonfastforward err/nonfastforward) GIT_ENONFASTFORWARD)
  ((invalidspec    err/invalidspec)    GIT_EINVALIDSPEC)
  ((mergeconflict  err/mergeconflict)  GIT_EMERGECONFLICT)
  ((passthrough    err/passthrough)    GIT_PASSTHROUGH)
  ((iterover       err/iterover)       GIT_ITEROVER))

(define-foreign-enum-type (error-type int)
  (error-type->int int->error-type)
  ((nomemory   err/nomemory)   GITERR_NOMEMORY)
  ((os         err/os)         GITERR_OS)
  ((invalid    err/invalid)    GITERR_INVALID)
  ((reference  err/reference)  GITERR_REFERENCE)
  ((zlib       err/zlib)       GITERR_ZLIB)
  ((repository err/repository) GITERR_REPOSITORY)
  ((config     err/config)     GITERR_CONFIG)
  ((regex      err/regex)      GITERR_REGEX)
  ((odb        err/odb)        GITERR_ODB)
  ((index      err/index)      GITERR_INDEX)
  ((object     err/object)     GITERR_OBJECT)
  ((net        err/net)        GITERR_NET)
  ((tag        err/tag)        GITERR_TAG)
  ((tree       err/tree)       GITERR_TREE)
  ((indexer    err/indexer)    GITERR_INDEXER)
  ((ssl        err/ssl)        GITERR_SSL)
  ((submodule  err/submodule)  GITERR_SUBMODULE)
  ((thread     err/thread)     GITERR_THREAD)
  ((stash      err/stash)      GITERR_STASH)
  ((checkout   err/checkout)   GITERR_CHECKOUT)
  ((fetchhead  err/fetchhead)  GITERR_FETCHHEAD)
  ((merge      err/merge)      GITERR_MERGE))

(define error-clear (foreign-lambda void giterr_clear))

(define (error-last)
  (and-let* ((err ((foreign-lambda (c-pointer error) giterr_last))))
    (error-message err)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; index.h

(define index-open             (foreign-lambda/allocate index git_index_open nonnull-c-string))
(define index-write-tree       (foreign-lambda/allocate oid git_index_write_tree index))
(define index-write-tree-to    (foreign-lambda/allocate oid git_index_write_tree_to index repository))
(define index-read             (foreign-lambda/retval git_index_read index))
(define index-write            (foreign-lambda/retval git_index_write index))
(define index-add              (foreign-lambda/retval git_index_add index index-entry))
(define index-add-bypath       (foreign-lambda/retval git_index_add_bypath index nonnull-c-string))
(define index-remove           (foreign-lambda/retval git_index_remove index nonnull-c-string int))
(define index-remove-directory (foreign-lambda/retval git_index_remove_directory index nonnull-c-string int))
(define index-owner            (foreign-lambda repository git_index_owner index))
(define index-clear            (foreign-lambda void git_index_clear index))
(define index-free             (foreign-lambda void git_index_free index))
(define index-find             (foreign-lambda int git_index_find (c-pointer size_t) index nonnull-c-string))
(define index-get-bypath       (foreign-lambda index-entry git_index_get_bypath index nonnull-c-string int))
(define index-get-byindex      (foreign-lambda index-entry git_index_get_byindex index size_t))
(define index-entrycount       (foreign-lambda unsigned-int git_index_entrycount index))
(define index-entry-stage      (foreign-lambda int git_index_entry_stage index-entry))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; indexer.h

(define-foreign-record-type (transfer-progress git_transfer_progress)
  (unsigned-int total_objects    transfer-progress-total-objects)
  (unsigned-int indexed_objects  transfer-progress-indexed-objects)
  (unsigned-int received_objects transfer-progress-received-objects)
  (size_t       received_bytes   transfer-progress-received-bytes))

(define-foreign-type transfer-progress-cb (function int ((const transfer-progress) c-pointer)))
(define-external (transfer_progress_cb (transfer-progress stats) (c-pointer fn)) int
  ((callback-lookup fn) stats) 0)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; merge.h

(define merge-base (foreign-lambda/allocate oid git_merge_base repository oid oid))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; object.h

(define object-lookup      (foreign-lambda/allocate object git_object_lookup repository oid object-type))
(define object-id          (foreign-lambda oid git_object_id object))
(define object-free        (foreign-lambda void git_object_free object))
(define object-owner       (foreign-lambda repository git_object_owner object))
(define object-type        (foreign-lambda object-type git_object_type object))
(define object-type2string (foreign-lambda object-type git_object_type2string object-type))
(define object-string2type (foreign-lambda object-type git_object_string2type nonnull-c-string))
(define object-typeisloose (foreign-lambda bool git_object_typeisloose object-type))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; odb_backend.h
;;
;; TODO

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; odb.h
;;
;; TODO git_odb_add_backend git_odb_add_alternate git_odb_read_header
;;      git_odb_open_wstream git_odb_open_rstream

(define odb-new          (foreign-lambda/allocate odb git_odb_new))
(define odb-open         (foreign-lambda/allocate odb git_odb_open nonnull-c-string))
(define odb-read         (foreign-lambda/allocate odb-object git_odb_read odb oid))
(define odb-read-prefix  (foreign-lambda/allocate odb-object git_odb_read_prefix odb oid unsigned-int))
(define odb-write        (foreign-lambda/allocate oid git_odb_write odb scheme-pointer size_t object-type))
(define odb-hash         (foreign-lambda/allocate oid git_odb_hash scheme-pointer size_t object-type))
(define odb-free         (foreign-lambda void git_odb_free odb))
(define odb-exists       (foreign-lambda bool git_odb_exists odb oid))
(define odb-object-free  (foreign-lambda void git_odb_object_free odb-object))
(define odb-object-id    (foreign-lambda oid git_odb_object_id odb-object))
(define odb-object-data  (foreign-lambda c-pointer git_odb_object_data odb-object))
(define odb-object-size  (foreign-lambda size_t git_odb_object_size odb-object))
(define odb-object-type  (foreign-lambda object-type git_odb_object_type odb-object))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; oid.h

(define oid-fromstr      (foreign-lambda/allocate oid git_oid_fromstr nonnull-c-string))
(define oid-shorten-add  (foreign-lambda/retval git_oid_shorten_add oid-shorten nonnull-c-string))
(define oid-cpy          (foreign-lambda void git_oid_cpy oid oid))
(define oid-cmp          (foreign-lambda int git_oid_cmp oid oid))
(define oid-ncmp         (foreign-lambda int git_oid_ncmp oid oid unsigned-int))
(define oid-equal        (foreign-lambda bool git_oid_equal oid oid))
(define oid-iszero       (foreign-lambda bool git_oid_iszero oid))
(define oid-shorten-new  (foreign-lambda oid-shorten git_oid_shorten_new size_t))
(define oid-shorten-free (foreign-lambda void git_oid_shorten_free oid-shorten))
(define oid-allocfmt     (foreign-lambda c-string git_oid_allocfmt oid))

(define (oid-fmt oid)
  (let ((str (make-string 40)))
    ((foreign-lambda void git_oid_fmt scheme-pointer oid) str oid)
    str))

(define (oid-pathfmt oid)
  (let ((str (make-string 41)))
    ((foreign-lambda void git_oid_pathfmt scheme-pointer oid) str oid)
    str))

(define (oid-tostr n id)
  (let ((str (make-string (max n 1))))
    ((foreign-lambda c-string git_oid_tostr
      scheme-pointer size_t  oid)
      str            (+ n 1) id)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; reflog.h
;;
;; TODO

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; refs.h

(define-external GIT_REF_ALL int
  (foreign-value "GIT_REF_OID | GIT_REF_SYMBOLIC" int))

(define-foreign-enum-type (reference-type int)
  (ref-type->int int->ref-type)
  ((invalid  reference-type/invalid)  GIT_REF_INVALID)
  ((oid      reference-type/oid)      GIT_REF_OID)
  ((symbolic reference-type/symbolic) GIT_REF_SYMBOLIC)
  ((all      reference-type/all)      GIT_REF_ALL))

(define reference-list                (foreign-lambda/allocate strarray git_reference_list repository))
(define reference-lookup              (foreign-lambda/allocate reference git_reference_lookup repository nonnull-c-string))
(define reference-dwim                (foreign-lambda/allocate reference git_reference_dwim repository nonnull-c-string))
(define reference-symbolic-create     (foreign-lambda/allocate reference git_reference_symbolic_create repository nonnull-c-string nonnull-c-string bool))
(define reference-create              (foreign-lambda/allocate reference git_reference_create repository nonnull-c-string oid bool))
(define reference-resolve             (foreign-lambda/allocate reference git_reference_resolve reference))
(define reference-rename              (foreign-lambda/allocate reference git_reference_rename reference nonnull-c-string bool))
(define reference-set-target          (foreign-lambda/allocate reference git_reference_set_target reference oid))
(define reference-symbolic-set-target (foreign-lambda/allocate reference git_reference_symbolic_set_target reference nonnull-c-string))
(define reference-delete              (foreign-lambda/retval git_reference_delete reference))
(define reference-target              (foreign-lambda oid git_reference_target reference))
(define reference-free                (foreign-lambda void git_reference_free reference))
(define reference-type                (foreign-lambda reference-type git_reference_type reference))
(define reference-name                (foreign-lambda c-string git_reference_name reference))
(define reference-owner               (foreign-lambda repository git_reference_owner reference))
(define reference-is-branch           (foreign-lambda bool git_reference_is_branch reference))
(define reference-is-remote           (foreign-lambda bool git_reference_is_remote reference))

(define-foreign-type reference-foreach-name-cb (function int ((const c-string) c-pointer)))
(define-external (reference_foreach_name_cb (c-string name) (c-pointer fn)) int
  ((callback-lookup fn) name) 0)

(define (reference-foreach-name repo fn)
  (call-with-callback fn
   (lambda (callback)
     (guard-errors git_reference_foreach_name
      ((foreign-safe-lambda int git_reference_foreach_name
        repository reference-foreach-name-cb            c-pointer)
        repo       (location reference_foreach_name_cb) callback)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; refspec.h

(define-foreign-enum-type (direction int)
  (direction->int int->direction)
  ((fetch dir/fetch) GIT_DIRECTION_FETCH)
  ((push  dir/push)  GIT_DIRECTION_PUSH))

(define refspec-src         (foreign-lambda c-string git_refspec_src refspec))
(define refspec-dst         (foreign-lambda c-string git_refspec_dst refspec))
(define refspec-string      (foreign-lambda c-string git_refspec_string refspec))
(define refspec-direction   (foreign-lambda direction git_refspec_direction refspec))
(define refspec-force       (foreign-lambda bool git_refspec_force refspec))
(define refspec-src-matches (foreign-lambda bool git_refspec_src_matches refspec nonnull-c-string))
(define refspec-dst-matches (foreign-lambda bool git_refspec_dst_matches refspec nonnull-c-string))

;; TODO git_refspec_transform

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
;; repository.h

(define repository-open          (foreign-lambda/allocate repository git_repository_open nonnull-c-string))
(define repository-init          (foreign-lambda/allocate repository git_repository_init nonnull-c-string bool))
(define repository-index         (foreign-lambda/allocate index git_repository_index repository))
(define repository-odb           (foreign-lambda/allocate odb git_repository_odb repository))
(define repository-head          (foreign-lambda/allocate reference git_repository_head repository))
(define repository-config        (foreign-lambda/allocate config git_repository_config repository))
(define repository-free          (foreign-lambda void git_repository_free repository))
(define repository-is-empty      (foreign-lambda bool git_repository_is_empty repository))
(define repository-is-bare       (foreign-lambda bool git_repository_is_bare repository))
(define repository-path          (foreign-lambda c-string git_repository_path repository))
(define repository-workdir       (foreign-lambda c-string git_repository_workdir repository))
(define repository-head-detached (foreign-lambda bool git_repository_head_detached repository))
(define repository-head-orphan   (foreign-lambda bool git_repository_head_orphan repository))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; remote.h/net.h

(define-foreign-record-type (remote-head git_remote_head)
  (bool         local remote-head-local?)
  ((struct oid) oid   remote-head-id)
  ((struct oid) loid  remote-head-local-id)
  (c-string     name  remote-head-name))

(define remote-list                 (foreign-lambda/allocate strarray git_remote_list repository))
(define remote-get-push-refspecs    (foreign-lambda/allocate strarray git_remote_get_push_refspecs remote))
(define remote-get-fetch-refspecs   (foreign-lambda/allocate strarray git_remote_get_fetch_refspecs remote))
(define remote-load                 (foreign-lambda/allocate remote git_remote_load repository nonnull-c-string))
(define remote-create               (foreign-lambda/allocate remote git_remote_create repository nonnull-c-string nonnull-c-string))
(define remote-create-inmemory      (foreign-lambda/allocate remote git_remote_create_inmemory repository nonnull-c-string nonnull-c-string))
(define remote-get-refspec          (foreign-lambda refspec git_remote_get_refspec remote int))
(define remote-connect              (foreign-lambda/retval git_remote_connect remote direction))
(define remote-save                 (foreign-lambda/retval git_remote_save remote))
(define remote-set-url              (foreign-lambda/retval git_remote_set_url remote nonnull-c-string))
(define remote-set-pushurl          (foreign-lambda/retval git_remote_set_pushurl remote nonnull-c-string))
(define remote-update-tips          (foreign-lambda/retval git_remote_update_tips remote))
(define remote-update-fetchhead     (foreign-lambda/retval git_remote_update_fetchhead remote))
(define remote-remove-refspec       (foreign-lambda/retval git_remote_remove_refspec remote int))
(define remote-clear-refspecs       (foreign-lambda void git_remote_clear_refspec remote))
(define remote-refspec-count        (foreign-lambda int git_remote_refspec_count remote))
(define remote-stats                (foreign-lambda transfer-progress git_remote_stats remote))
(define remote-free                 (foreign-lambda void git_remote_free remote))
(define remote-stop                 (foreign-lambda void git_remote_stop remote))
(define remote-disconnect           (foreign-lambda void git_remote_disconnect remote))
(define remote-check-cert           (foreign-lambda void git_remote_check_cert remote bool))
(define remote-set-update-fetchhead (foreign-lambda void git_remote_set_update_fetchhead remote bool))
(define remote-name                 (foreign-lambda c-string git_remote_name remote))
(define remote-url                  (foreign-lambda c-string git_remote_url remote))
(define remote-pushurl              (foreign-lambda c-string git_remote_pushurl remote))
(define remote-connected            (foreign-lambda bool git_remote_connected remote))
(define remote-valid-url            (foreign-lambda bool git_remote_valid_url nonnull-c-string))
(define remote-supported-url        (foreign-lambda bool git_remote_supported_url nonnull-c-string))

(define (remote-download remote fn)
  (if (not fn)
      ((foreign-lambda/retval git_remote_download remote transfer-progress-cb c-pointer) remote #f #f)
      (call-with-callback fn
       (lambda (cb)
         (guard-errors git_remote_download
          ((foreign-safe-lambda int git_remote_download
            remote transfer-progress-cb            c-pointer)
            remote (location transfer_progress_cb) cb))))))

(define-foreign-type remote-rename-problem-cb (function int ((const c-string) c-pointer)))
(define-external (remote_rename_problem_cb (c-string path) (c-pointer fn)) int
  ((callback-lookup fn) path) 0)

(define (remote-rename remote name fn)
  (if (not fn)
      ((foreign-lambda/retval git_remote_rename remote nonnull-c-string remote-rename-problem-cb c-pointer) remote name #f #f)
      (call-with-callback fn
       (lambda (cb)
         ((foreign-safe-lambda int git_remote_rename
           remote nonnull-c-string remote-rename-problem-cb            c-pointer)
           remote name             (location remote_rename_problem_cb) cb)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; revwalk.h

(define-foreign-enum-type (sort int)
  (sort->int int->sort)
  ((none sort/none) GIT_SORT_NONE)
  ((topo sort/topo) GIT_SORT_TOPOLOGICAL)
  ((time sort/time) GIT_SORT_TIME)
  ((rev  sort/rev)  GIT_SORT_REVERSE))

(define revwalk-new         (foreign-lambda/allocate revwalk git_revwalk_new repository))
(define revwalk-next        (foreign-lambda/allocate oid git_revwalk_next revwalk))
(define revwalk-push        (foreign-lambda/retval git_revwalk_push revwalk oid))
(define revwalk-push-glob   (foreign-lambda/retval git_revwalk_push_glob revwalk nonnull-c-string))
(define revwalk-push-head   (foreign-lambda/retval git_revwalk_push_head revwalk))
(define revwalk-push-ref    (foreign-lambda/retval git_revwalk_push_ref revwalk nonnull-c-string))
(define revwalk-hide        (foreign-lambda/retval git_revwalk_hide revwalk oid))
(define revwalk-hide-glob   (foreign-lambda/retval git_revwalk_hide_glob revwalk nonnull-c-string))
(define revwalk-hide-head   (foreign-lambda/retval git_revwalk_hide_head revwalk))
(define revwalk-hide-ref    (foreign-lambda/retval git_revwalk_hide_ref revwalk nonnull-c-string))
(define revwalk-free        (foreign-lambda void git_revwalk_free revwalk))
(define revwalk-reset       (foreign-lambda void git_revwalk_reset revwalk))
(define revwalk-sorting     (foreign-lambda void git_revwalk_sorting revwalk sort))
(define revwalk-repository  (foreign-lambda repository git_revwalk_repository revwalk))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; revparse.h

(define-foreign-record-type (revspec git_revspec)
  (constructor: make-revspec)
  (destructor: revspec-free)
  (object from revspec-from)
  (object to revspec-to)
  (unsigned-int flags revspec-flags))

(define revparse-single (foreign-lambda/allocate object git_revparse_single repository nonnull-c-string))
(define revparse        (foreign-lambda/allocate revspec git_revparse repository nonnull-c-string))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; signature.h

(define signature-new  (foreign-lambda/allocate signature git_signature_new nonnull-c-string nonnull-c-string time-t int))
(define signature-now  (foreign-lambda/allocate signature git_signature_now nonnull-c-string nonnull-c-string))
(define signature-dup  (foreign-lambda signature git_signature_dup signature))
(define signature-free (foreign-lambda void git_signature_free signature))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; status.h

(define-foreign-enum-type (status unsigned-int #f)
  (status->int int->status)
  ((current           status/current)           GIT_STATUS_CURRENT)
  ((index/new         status/index/new)         GIT_STATUS_INDEX_NEW)
  ((index/modified    status/index/modified)    GIT_STATUS_INDEX_MODIFIED)
  ((index/deleted     status/index/deleted)     GIT_STATUS_INDEX_DELETED)
  ((worktree/new      status/worktree/new)      GIT_STATUS_WT_NEW)
  ((worktree/modified status/worktree/modified) GIT_STATUS_WT_MODIFIED)
  ((worktree/deleted  status/worktree/deleted)  GIT_STATUS_WT_DELETED)
  ((ignored           status/ignored)           GIT_STATUS_IGNORED))

;; Unroll compound integer status values into lists of status symbols.
(define-foreign-type status unsigned-int status->int
  (let ((int->status int->status))
    (lambda (val)
      (or (int->status val)
          (let lp ((int (foreign-value GIT_STATUS_IGNORED int))
                   (acc '()))
            (if (eq? int 0)
                acc
                (lp (fx/ int 2)
                    (if (= (bitwise-and val int) int)
                        (cons (int->status int) acc)
                        acc))))))))

(define status-file          (foreign-lambda/allocate status git_status_file repository nonnull-c-string))
(define status-should-ignore (foreign-lambda/allocate bool git_status_should_ignore repository nonnull-c-string))

(define-foreign-type status-foreach-cb (function int ((const c-string) status c-pointer)))
(define-external (status_foreach_cb (c-string path) (status value) (c-pointer fn)) int
  ((callback-lookup fn) path value) 0)

(define (status-foreach fn repo)
  (call-with-callback fn
   (lambda (callback)
     (guard-errors git_status_foreach
      ((foreign-safe-lambda int git_status_foreach
        repository status-foreach-cb            c-pointer)
        repo       (location status_foreach_cb) callback)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; tag.h

(define tag-list       (foreign-lambda/allocate strarray git_tag_list repository))
(define tag-create     (foreign-lambda/allocate oid git_tag_create repository c-string object signature c-string bool))
(define tag-lookup     (foreign-lambda/allocate tag git_tag_lookup repository oid))
(define tag-target     (foreign-lambda/allocate object git_tag_target tag))
(define tag-peel       (foreign-lambda/allocate object git_tag_peel tag))
(define tag-delete     (foreign-lambda/retval git_tag_delete repository nonnull-c-string))
(define tag-free       (foreign-lambda void git_tag_free tag))
(define tag-id         (foreign-lambda oid git_tag_id tag))
(define tag-name       (foreign-lambda c-string git_tag_name tag))
(define tag-tagger     (foreign-lambda signature git_tag_tagger tag))
(define tag-message    (foreign-lambda c-string git_tag_message tag))

(define-foreign-type tag-foreach-cb (function int ((const c-string) oid c-pointer)))
(define-external (tag_foreach_cb (c-string name) (oid oid) (c-pointer fn)) int
  ((callback-lookup fn) name oid) 0)

(define (tag-foreach fn repo)
  (call-with-callback fn
   (lambda (callback)
     (guard-errors git_tag_foreach
      ((foreign-safe-lambda int git_tag_foreach
        repository tag-foreach-cb            c-pointer)
        repo       (location tag_foreach_cb) callback)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; tree.h

(define-foreign-enum-type (treewalk-mode int)
  (treewalk-mode->int int->treewalk-mode)
  ((pre  treewalk-mode/pre)  GIT_TREEWALK_PRE)
  ((post treewalk-mode/post) GIT_TREEWALK_POST))

(define tree-lookup           (foreign-lambda/allocate tree git_tree_lookup repository oid))
(define tree-lookup-prefix    (foreign-lambda/allocate tree git_tree_lookup_prefix repository oid unsigned-int))
(define tree-entry-to-object  (foreign-lambda/allocate object git_tree_entry_to_object repository tree-entry))
(define tree-entry-bypath     (foreign-lambda/allocate tree-entry git_tree_entry_bypath tree nonnull-c-string))
(define tree-builder-create   (foreign-lambda/allocate tree-builder git_treebuilder_create tree))
(define tree-builder-insert   (foreign-lambda/allocate (const tree-entry) git_treebuilder_insert tree-builder c-string oid unsigned-int))
(define tree-builder-write    (foreign-lambda/allocate oid git_treebuilder_write repository tree-builder))
(define tree-builder-remove   (foreign-lambda/retval git_treebuilder_remove tree-builder nonnull-c-string))
(define tree-free             (foreign-lambda void git_tree_free tree))
(define tree-id               (foreign-lambda oid git_tree_id tree))
(define tree-entrycount       (foreign-lambda unsigned-int git_tree_entrycount tree))
(define tree-entry-byname     (foreign-lambda tree-entry git_tree_entry_byname tree nonnull-c-string))
(define tree-entry-byindex    (foreign-lambda tree-entry git_tree_entry_byindex tree size_t))
(define tree-entry-byoid      (foreign-lambda tree-entry git_tree_entry_byoid tree oid))
(define tree-entry-name       (foreign-lambda c-string git_tree_entry_name tree-entry))
(define tree-entry-id         (foreign-lambda oid git_tree_entry_id tree-entry))
(define tree-entry-type       (foreign-lambda object-type git_tree_entry_type tree-entry))
(define tree-entry-dup        (foreign-lambda tree-entry git_tree_entry_dup tree-entry))
(define tree-entry-free       (foreign-lambda void git_tree_entry_free tree-entry))
(define tree-builder-free     (foreign-lambda void git_treebuilder_free tree-builder))
(define tree-builder-clear    (foreign-lambda void git_treebuilder_clear tree-builder))
(define tree-builder-get      (foreign-lambda tree-entry git_treebuilder_get tree-builder nonnull-c-string))

;; (define-foreign-type treewalk-cb (c-pointer "git_treewalk_cb"))
(define-foreign-type treewalk-cb (function int ((const c-string) (const tree-entry) c-pointer)))
(define-external (treewalk_cb (c-string root) (tree-entry entry) (c-pointer fn)) int
  ((callback-lookup fn) root entry) 0)

(define (tree-walk tree fn mode)
  (call-with-callback fn
   (lambda (callback)
     (guard-errors git_tree_walk
      ((foreign-safe-lambda int git_tree_walk
        (const tree) treewalk-mode treewalk-cb            c-pointer)
        tree         mode          (location treewalk_cb) callback))))))