hans/git-cli
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added git-grep and git-diff

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-12 22:28:27 +02:00
parent e4e37d2214
commit aebd420c3c
5 changed files with 179 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files
main.rkt
+88 -10
View File
@@ -3,8 +3,10 @@
(require "private/git-provider.rkt"
"private/git-commands.rkt"
"private/config.rkt"
"private/diff.rkt"
simple-log
racket/string
net/sendurl
)
(provide git
@@ -31,16 +33,18 @@
)
)
(define (add-porcelain args . f)
(if (has-git-arg? args '--porcelain)
(if (null? f) args ((car f) args))
(if (null? f) (cons '--porcelain args)
((car f) (cons '--porcelain args)))))
(define (add-porcelain args info . f)
(let ((m (has-git-arg? args #px"^[-][-]porcelain([=](.*))?"))
(g (if (null? f) (λ (x) x) (car f)))
)
(if m
(g args)
(g (cons '--porcelain=v1 args)))))
(define-syntax def-cmd
(syntax-rules ()
((_ cmd cmd* cmd-sym)
(def-cmd cmd cmd* cmd-sym (λ (args) args) std-process-git-result))
(def-cmd cmd cmd* cmd-sym (λ (args info) args) std-process-git-result))
((_ cmd cmd* cmd-sym pre-code)
(def-cmd cmd cmd* cmd-sym pre-code std-process-git-result))
((_ cmd cmd* cmd-sym pre-code process-result)
@@ -54,10 +58,9 @@
)
(def-cmd git-status cmd-git-status 'status
(λ (args) (if (has-git-arg? args '-s)
args
(cons '-s args)))
(λ (cmd exit-code result output out)
add-porcelain
(λ (cmd exit-code result output out info)
(dbg-git (format "~a" output))
(if (= exit-code 0)
(if result
(map (λ (line)
@@ -84,9 +87,84 @@
(def-cmd git-add cmd-git-add 'add)
(def-cmd git-commit cmd-git-commit 'commit
(λ (args) (check-git-args 'commit args '((-m 1 "A commit message is mandatory"))))
(λ (cmd exit-code result output out)
(cond
((= exit-code 1) (git-displ out) #t)
(std-process-git-result cmd exit-code result output out)))
)
(def-cmd git-push cmd-git-push 'push add-porcelain)
(def-cmd git-pull cmd-git-pull 'pull)
(def-cmd git-branch cmd-git-branch 'branch)
(def-cmd git-clone cmd-git-clone 'clone)
(def-cmd git-log cmd-git-log 'log)
(def-cmd git-rev-list cmd-git-rev-list 'rev-list)
(def-cmd git-diff cmd-git-diff 'diff
(λ (args info) args)
(λ (cmd exit-code result output out info)
(if (and (zero? exit-code)
result)
(let ((diff (string-join
(filter (λ (line)
(not (string-prefix? (string-downcase line) "warning:")))
out)
"\n")))
(diff->html diff)
#t)
#f)))
(def-cmd git-grep cmd-git-grep 'grep
(λ (args info)
(let ((matches #f)
(line-nr #f)
)
(let ((nargs (map
(λ (e)
(let ((o (format "~a" e)))
(cond
((string=? o "-c") (set! matches #t))
((string=? o "-n") (set! line-nr #t))))
e)
(map (λ (x) (if (eq? x '-i) "-i" x)) args))))
(when (eq? line-nr #f)
(set! nargs (cons "-n" nargs))) ;; add line numbers / counts for pattern recognition
(hash-set! info 'matches matches)
(hash-set! info 'line-nr (if matches #f line-nr))
nargs)))
(λ (cmd exit-code result output out info)
(with-handlers ([exn:fail? (λ (e)
(err-git (string-join (map cadr output) "\n"))
(raise e))])
(if (and result
(or (= exit-code 0) (= exit-code 1)))
(let ((re #px"([^:]+)[:]([^:]+)([:](.*))?"))
(map (λ (line)
(let ((m (regexp-match re line)))
(let ((line-nr (if (hash-ref info 'line-nr #f)
(if (eq? m #f)
#f
(string->number (caddr m)))
#f))
(matches (if (hash-ref info 'matches #f)
(if (eq? m #f)
#f
(string->number (caddr m)))
#f))
)
(if m
(list (cadr m) line-nr matches (cadddr (cdr m)))
(list line #f #f #f)))))
out))
(begin
(err-git (string-join (map cadr output) "\n"))
#f))))
)
(def-cmd git-help cmd-git-help 'help)