git: Find git tracked files from HEAD, not from index.

The index is the staging area. We really only want to look at files
already committed into the git repository. In addition, a pleasant
side-effect is that this gets rid of many of the additional bindings
from libgit2.

* tissue/git.scm: Import only %null-pointer from (system foreign). Do
not import (bytestructures guile).
(pointer->bytestructure, bytestructure->pointer, pointer->index-time,
pointer->index-entry, repository-index, index-version,
index-entry-count, index-entry, index-entries): Delete functions.
(%oid, %index-time, %index-entry): Delete variables.
(<index-time>, <index-entry>): Delete types.
(head-tree): New function.
(git-tracked-files): Find git tracked files from HEAD, not from index.

1 files changed, 11 insertions, 133 deletions

diff --git a/tissue/git.scm b/tissue/git.scm
index 67e1695..c7b1fcc 100644
--- a/tissue/git.scm
+++ b/tissue/git.scm
@@ -27,19 +27,7 @@
   #:use-module (ice-9 match)
   #:use-module (git)
   #:use-module (git types)
-  ;; There are many name conflicts between (system foreign). So, we
-  ;; carefully select a few and prefix the rest.
-  #:use-module ((system foreign) #:select (%null-pointer
-                                           null-pointer?
-                                           pointer->string
-                                           make-pointer
-                                           dereference-pointer))
-  #:use-module ((system foreign) #:prefix foreign:)
-  #:use-module ((bytestructures guile) #:select (bs:pointer
-                                                 bs:struct
-                                                 bs:vector
-                                                 bytestructure-ref))
-  #:use-module ((bytestructures guile) #:prefix bs:)
+  #:use-module ((system foreign) #:select (%null-pointer))
   #:use-module (tissue utils)
   #:export (git-top-level
             current-git-repository
@@ -50,121 +38,6 @@
 ;; We bind additional functions from libgit2 that are not already
 ;; bound in guile-git. TODO: Contribute them to guile-git.
 
-(define pointer->bytestructure
-  (@@ (git structs) pointer->bytestructure))
-
-(define bytestructure->pointer
-  (@@ (git structs) bytestructure->pointer))
-
-(define %oid
-  (bs:vector 20 bs:uint8))
-
-(define %index-time
-  (bs:struct `((seconds ,bs:int32)
-               (nanoseconds ,bs:uint32))))
-
-(define %index-entry
-  (bs:struct `((ctime ,%index-time)
-               (mtime ,%index-time)
-               (dev ,bs:uint32)
-               (ino ,bs:uint32)
-               (mode ,bs:uint32)
-               (uid ,bs:uint32)
-               (gid ,bs:uint32)
-               (file-size ,bs:uint32)
-               (id ,%oid)
-               (flags ,bs:uint16)
-               (flags-extended ,bs:uint16)
-               (path ,(bs:pointer bs:uint8)))))
-
-(define-record-type <index-time>
-  (%make-index-time seconds nanoseconds)
-  index-time?
-  (seconds index-time-seconds)
-  (nanoseconds index-time-nanoseconds))
-
-(define (pointer->index-time pointer)
-  (if (null-pointer? pointer)
-      #f
-      (let ((bs (pointer->bytestructure pointer %index-time)))
-        (%make-index-time
-         (bytestructure-ref bs 'seconds)
-         (bytestructure-ref bs 'nanoseconds)))))
-
-(define-record-type <index-entry>
-  (%make-index-entry ctime mtime dev ino mode uid gid file-size id flags path)
-  index-entry?
-  (ctime index-entry-ctime)
-  (mtime index-entry-mtime)
-  (dev index-entry-dev)
-  (ino index-entry-ino)
-  (mode index-entry-mode)
-  (uid index-entry-uid)
-  (gid index-entry-gid)
-  (file-size index-entry-file-size)
-  (id index-entry-id)
-  (flags index-entry-flags)
-  (path index-entry-path))
-
-(define (pointer->index-entry pointer)
-  (if (null-pointer? pointer)
-      #f
-      (let* ((bs (pointer->bytestructure pointer %index-entry))
-             (flags (bytestructure-ref bs 'flags)))
-        (%make-index-entry
-         (pointer->index-time
-          (bytestructure->pointer (bytestructure-ref bs 'ctime)))
-         (pointer->index-time
-          (bytestructure->pointer (bytestructure-ref bs 'mtime)))
-         (bytestructure-ref bs 'dev)
-         (bytestructure-ref bs 'ino)
-         (bytestructure-ref bs 'mode)
-         (bytestructure-ref bs 'uid)
-         (bytestructure-ref bs 'gid)
-         (bytestructure-ref bs 'file-size)
-         (pointer->oid
-          (bytestructure->pointer (bytestructure-ref bs 'id)))
-         (if (zero? (logand flags
-                            (bitwise-arithmetic-shift 1 15)))
-             (list)
-             (list 'assume-valid))
-         (pointer->string
-          (make-pointer (bytestructure-ref bs 'path))
-          (bitwise-and flags (bitwise-not (bitwise-arithmetic-shift 1 13))))))))
-
-;; The repository-index function in guile-git has a bug. See
-;; https://gitlab.com/guile-git/guile-git/-/merge_requests/34 . To
-;; work around this, we redefine it here.
-(define repository-index
-  (let ((proc (libgit2->procedure* "git_repository_index" (list '* '*))))
-    (lambda (repository)
-      (let ((out (make-double-pointer)))
-        (proc out (repository->pointer repository))
-        (pointer->index (dereference-pointer out))))))
-
-(define index-version
-  (let ((proc (libgit2->procedure foreign:unsigned-int "git_index_version" (list '*))))
-    (lambda (index)
-      (proc (index->pointer index)))))
-
-(define index-entry-count
-  (compose (libgit2->procedure foreign:size_t "git_index_entrycount" (list '*))
-           index->pointer))
-
-(define index-entry
-  (let ((proc (libgit2->procedure '* "git_index_get_byindex" (list '* foreign:size_t))))
-    (lambda (index n)
-      (unless (= (index-version index) 2)
-        (error "Unsupported git index version:" (index-version index)))
-      (pointer->index-entry (proc (index->pointer index) n)))))
-
-(define (index-entries index)
-  "Return the list of all entries in INDEX, a <git-index> object. The
-return value is a list of <index-entry> objects."
-  (map (lambda (i)
-         (index-entry index i))
-       (iota (index-entry-count index))))
-
 (define diff-find-similar!
   (let ((proc (libgit2->procedure* "git_diff_find_similar" '(* *))))
     (lambda (diff)
@@ -187,6 +60,12 @@ repository."
   "Return the current git repository."
   (repository-open (git-top-level)))
 
+(define (head-tree repository)
+  "Return tree of HEAD in REPOSITORY."
+  (commit-tree
+   (commit-lookup repository
+                  (reference-name->oid repository "HEAD"))))
+
 (define (commit-date commit)
   (time-monotonic->date
    (make-time time-monotonic
@@ -195,11 +74,10 @@ repository."
    (* 60 (commit-time-offset commit))))
 
 (define* (git-tracked-files #:optional (repository (current-git-repository)))
-  "Return a list of all files tracked in REPOSITORY. The returned
-filenames are relative to the top-level directory of REPOSITORY and do
-not have a leading slash."
-  (map index-entry-path
-       (index-entries (repository-index repository))))
+  "Return a list of all files and directories tracked in REPOSITORY. The
+returned paths are relative to the top-level directory of REPOSITORY
+and do not have a leading slash."
+  (tree-list (head-tree repository)))
 
 (define (commit-deltas repository commit)
   "Return the list of <diff-delta> objects created by COMMIT with