brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Git status wrapper.

Browse source
This commit is contained in:
Dominik Pantůček 2023-04-16 21:24:17 +02:00
parent afeaa4f28b
commit fccdf37014
2 changed files with 19 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/Makefile
View file

@ -356,7 +356,8 @@ SPECIFICATION-SOURCES=specification.scm 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-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)

18
src/util-git.scm
View file

@ -33,7 +33,8 @@
(import scheme (import scheme
(chicken base) (chicken base)
util-io) util-io
util-dict-list)
;; Valid git operating modes ;; Valid git operating modes
(define git-modes (define git-modes
@ -71,13 +72,26 @@
(lambda args (lambda args
(invoke-git repo args)))))) (invoke-git repo args))))))
;; Known status types
(define git-status-types
'((" M" 'modified)
("??" 'untracked)))
;; Returns a dictionary of unknown, modified, deleted and added files ;; Returns a dictionary of unknown, modified, deleted and added files
(define (git-status repo) (define (git-status repo)
(let loop ((lines ((git repo) 'status '--porcelain)) (let loop ((lines ((git repo) 'status '--porcelain))
(res (make-ldict))) (res (make-ldict)))
(if (null? lines) (if (null? lines)
res res
(let* ((line (car lines))
(st (substring line 0 2))
(fname (substring line 4))
(status (or (assoc st git-status-types)
'unknown)))
(loop (cdr lines) (loop (cdr lines)
res)))) (ldict-set res
status
(cons fname
(ldict-ref res status '()))))))))
) )