Preliminary git blame parsing.

This commit is contained in:
Dominik Pantůček 2023-05-13 19:31:55 +02:00
parent 408b2b2143
commit 1f41a7ea64
2 changed files with 29 additions and 14 deletions

View file

@ -353,8 +353,8 @@ SPECIFICATION-SOURCES=specification.scm cal-period.import.scm
specification.o: specification.import.scm specification.o: specification.import.scm
specification.import.scm: $(SPECIFICATION-SOURCES) specification.import.scm: $(SPECIFICATION-SOURCES)
UTIL-GIT-SOURCES=util-git.scm util-io.import.scm \ UTIL-GIT-SOURCES=util-git.scm util-io.import.scm \
util-dict-list.import.scm util-dict-list.import.scm util-parser.import.scm
util-git.o: util-git.import.scm util-git.o: util-git.import.scm
util-git.import.scm: $(UTIL-GIT-SOURCES) util-git.import.scm: $(UTIL-GIT-SOURCES)

View file

@ -34,8 +34,10 @@
(import scheme (import scheme
(chicken base) (chicken base)
(chicken string)
util-io util-io
util-dict-list) util-dict-list
util-parser)
;; Valid git operating modes ;; Valid git operating modes
(define git-modes (define git-modes
@ -102,19 +104,32 @@
;; Returns detailed file annotation with each line being represented ;; Returns detailed file annotation with each line being represented
;; by dictionary with keys from git output ;; by dictionary with keys from git output
(define (git-blame repo fname) (define (git-blame repo fname)
(let loop ((lines ((git repo) 'annotate '--porcelain fname)) (let loop ((lines ((git repo) 'blame '--line-porcelain fname))
(blame (make-ldict))
(blames '())) (blames '()))
(if (null? lines) (if (null? lines)
blames (reverse (if (ldict-empty? blame)
(let ((line (car lines)) blames
(rblames (if (null? blames) (cons blame blames)))
'() (let ((line (car lines)))
(cdr blames))) (cond ((ldict-empty? blame)
(blame (if (null? blames) ;; First row - commit
(let ((ll (string-split line)))
(loop (cdr lines)
(ldict-set blame 'commit (car ll))
blames)))
((eq? (string-ref line 0) #\space)
;; Actual line with data
(let ((rline (substring line 8)))
(loop (cdr lines)
(make-ldict) (make-ldict)
(car blames)))) (cons (ldict-set blame 'line rline)
(loop (cdr lines) blames))))
(cons blame (else
rblames)))))) ;; Any header
(let ((kv (parser-parse-line line)))
(loop (cdr lines)
(ldict-set blame (car kv) (cdr kv))
blames))))))))
) )