diff options
Diffstat (limited to 'tissue/git.scm')
| -rw-r--r-- | tissue/git.scm | 98 |
1 files changed, 46 insertions, 52 deletions
diff --git a/tissue/git.scm b/tissue/git.scm index 764fba2..70f0de9 100644 --- a/tissue/git.scm +++ b/tissue/git.scm @@ -1,5 +1,5 @@ ;;; tissue --- Text based issue tracker -;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of tissue. ;;; @@ -45,9 +45,9 @@ commit-author-date git-tracked-file? git-tracked-files - call-with-file-in-git file-modification-table - clone-options)) + clone-options + call-with-temporary-checkout)) ;; We bind additional functions from libgit2 that are not already ;; bound in guile-git. TODO: Contribute them to guile-git. @@ -93,7 +93,11 @@ directory." (define (git-top-level) "Return the top-level directory of the current git repository." - (dirname (repository-directory (current-git-repository)))) + (let ((repository-directory + (repository-directory (current-git-repository)))) + (if (repository-bare? (current-git-repository)) + repository-directory + (dirname repository-directory)))) (define (head-tree repository) "Return tree of HEAD in REPOSITORY." @@ -122,35 +126,15 @@ directory." path))) (define* (git-tracked-files #:optional (repository (current-git-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." + "Return a list of all files and directories tracked in +@var{repository}. The returned paths are relative to the top-level +directory of @var{repository} and do not have a leading slash." (tree-list (head-tree repository))) -(define (call-with-file-in-git repository path proc) - "Call PROC on an input port reading contents of PATH. PATH may refer -to a file on the filesystem or in REPOSITORY." - (let ((file-path (if (absolute-file-name? path) - ;; Treat absolute paths verbatim. - path - ;; Treat relative paths as relative to the - ;; top-level of the git repository. - (string-append (dirname (repository-directory repository)) - "/" path)))) - (if (file-exists? file-path) - ;; If file exists on the filesystem, read it. - (call-with-input-file file-path proc) - ;; Else, read the file from the repository. - (let* ((path-tree-entry (tree-entry-bypath (head-tree repository) - path)) - (path-object (tree-entry->object repository path-tree-entry)) - (blob (blob-lookup repository (object-id path-object)))) - (call-with-port (open-bytevector-input-port (blob-content blob)) - proc))))) - -(define (commit-deltas repository commit) - "Return the list of <diff-delta> objects created by COMMIT with -respect to its first parent in REPOSITORY." +(define (commit-file-changes repository commit) + "Return a list of pairs describing files modified by COMMIT with +respect to its first parent in REPOSITORY. Each pair maps the old +filename before COMMIT to the new filename after COMMIT." (match (commit-parents commit) ((parent _ ...) (let ((diff (diff-tree-to-tree repository @@ -158,7 +142,9 @@ respect to its first parent in REPOSITORY." (commit-tree commit)))) (diff-find-similar! diff) (diff-fold (lambda (delta progress result) - (cons delta result)) + (cons (cons (diff-file-path (diff-delta-old-file delta)) + (diff-file-path (diff-delta-new-file delta))) + result)) (lambda (delta binary result) result) (lambda (delta hunk result) @@ -167,7 +153,9 @@ respect to its first parent in REPOSITORY." result) (list) diff))) - (() (list)))) + (() (map (lambda (file) + (cons file file)) + (tree-list (commit-tree commit)))))) (define (file-modification-table repository) "Return a hashtable mapping files to the list of commits in REPOSITORY @@ -176,25 +164,21 @@ that modified them." (renames (make-hashtable string-hash string=?))) (fold-commits (lambda (commit _) - (map (lambda (delta) - ;; Map old filename to current filename if they are - ;; different. Note that this manner of following renames - ;; requires a linear git history and will not work with - ;; branch merges. - (unless (string=? (diff-file-path (diff-delta-old-file delta)) - (diff-file-path (diff-delta-new-file delta))) - (hashtable-set! renames - (diff-file-path (diff-delta-old-file delta)) - (diff-file-path (diff-delta-new-file delta)))) - (hashtable-update! result - ;; If necessary, translate old - ;; filename to current filename. - (hashtable-ref renames - (diff-file-path (diff-delta-old-file delta)) - (diff-file-path (diff-delta-old-file delta))) - (cut cons commit <>) - (list))) - (commit-deltas repository commit))) + (map (match-lambda + ((old-file . new-file) + ;; Map old filename to current filename if they are + ;; different. Note that this manner of following renames + ;; requires a linear git history and will not work with + ;; branch merges. + (unless (string=? old-file new-file) + (hashtable-set! renames old-file new-file)) + (hashtable-update! result + ;; If necessary, translate old + ;; filename to current filename. + (hashtable-ref renames old-file old-file) + (cut cons commit <>) + (list)))) + (commit-file-changes repository commit))) #f repository) result)) @@ -206,3 +190,13 @@ that modified them." 'bare (if bare? 1 0)) clone-options)) + +(define (call-with-temporary-checkout repository proc) + "Call PROC with a temporary checkout of REPOSITORY, and delete the +checkout when PROC returns or exits non-locally." + (call-with-temporary-directory + (lambda (temporary-checkout) + (clone repository temporary-checkout) + (proc temporary-checkout)) + ;; The system-dependent temporary directory + (dirname (tmpnam)))) |