diff --git a/src/Makefile b/src/Makefile index fd8e21d..53f8c2b 100644 --- a/src/Makefile +++ b/src/Makefile @@ -353,8 +353,8 @@ SPECIFICATION-SOURCES=specification.scm cal-period.import.scm specification.o: specification.import.scm specification.import.scm: $(SPECIFICATION-SOURCES) -UTIL-GIT-SOURCES=util-git.scm util-io.import.scm \ - util-dict-list.import.scm +UTIL-GIT-SOURCES=util-git.scm util-io.import.scm \ + util-dict-list.import.scm util-parser.import.scm util-git.o: util-git.import.scm util-git.import.scm: $(UTIL-GIT-SOURCES) diff --git a/src/util-git.scm b/src/util-git.scm index f217e5c..cb7bd96 100644 --- a/src/util-git.scm +++ b/src/util-git.scm @@ -34,8 +34,10 @@ (import scheme (chicken base) + (chicken string) util-io - util-dict-list) + util-dict-list + util-parser) ;; Valid git operating modes (define git-modes @@ -102,19 +104,32 @@ ;; Returns detailed file annotation with each line being represented ;; by dictionary with keys from git output (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 '())) (if (null? lines) - blames - (let ((line (car lines)) - (rblames (if (null? blames) - '() - (cdr blames))) - (blame (if (null? blames) + (reverse (if (ldict-empty? blame) + blames + (cons blame blames))) + (let ((line (car lines))) + (cond ((ldict-empty? blame) + ;; 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) - (car blames)))) - (loop (cdr lines) - (cons blame - rblames)))))) + (cons (ldict-set blame 'line rline) + blames)))) + (else + ;; Any header + (let ((kv (parser-parse-line line))) + (loop (cdr lines) + (ldict-set blame (car kv) (cdr kv)) + blames)))))))) )