;;;; Copyright (C) 2020 Julien Lepiller ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. ;;;; ;;;; This library 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 ;;;; Lesser General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; (define-module (gitile git) #:use-module (bytestructures guile) #:use-module (git) #:use-module (git types) #:use-module (srfi srfi-9) #:use-module ((system foreign) #:select (make-pointer pointer->string procedure->pointer set-pointer-finalizer! %null-pointer)) #:use-module ((system foreign) #:prefix foreign:) #:export (config-entry-name config-entry-value config-entry-include-depth config-entry-level config-foreach)) (define pointer->bytestructure (@@ (git structs) pointer->bytestructure)) (define bytestructure->pointer (@@ (git structs) bytestructure->pointer)) (define tree-entry-type (let ((proc (libgit2->procedure int "git_tree_entry_type" '(*)))) (lambda (entry) (proc (tree-entry->pointer entry))))) (define %config-entry (bs:struct `((name ,(bs:pointer uint8)) ; char * (value ,(bs:pointer uint8)) ; char * (include-depth ,uint64) (level ,int) ; git_config_level_t (free ,(bs:pointer int)) (payload ,(bs:pointer int))))) (define-record-type (%make-config-entry bytestructure) config-entry? (bytestructure config-entry-bytestructure)) (define (pointer->config-entry pointer) (%make-config-entry (pointer->bytestructure pointer %config-entry))) (define (config-entry->pointer entry) (bytestructure->pointer (config-entry-bytestructure entry))) (define (config-entry-name entry) (pointer->string (make-pointer (bytestructure-ref (config-entry-bytestructure entry) 'name)))) (define (config-entry-value entry) (pointer->string (make-pointer (bytestructure-ref (config-entry-bytestructure entry) 'value)))) (define (config-entry-include-depth entry) (bytestructure-ref (config-entry-bytestructure entry) 'include-depth)) (define (config-entry-level entry) (bytestructure-ref (config-entry-bytestructure entry) 'level)) (define %config-entry-free (libgit2->pointer "git_config_entry_free")) (define (pointer->config-entry! pointer) (set-pointer-finalizer! pointer %config-entry-free) (pointer->config-entry pointer)) (define config-foreach (let ((proc (libgit2->procedure* "git_config_foreach" '(* * *)))) (lambda (config callback) (let ((callback* (procedure->pointer foreign:int (lambda (entry _) (callback (pointer->config-entry entry))) (list '* '*)))) (proc (config->pointer config) callback* %null-pointer)))))