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

Added git show functionality

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-13 12:01:21 +02:00
parent f4f2c76ec6
commit d7b0520530
3 changed files with 246 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files
main.rkt
+83
View File
@@ -22,6 +22,7 @@
git-clone
git-rev-list
git-diff
git-show
git-help
git-version
git-new-version
@@ -307,6 +308,88 @@
(std-process-git-result cmd exit-code result output out info)))
(std-process-git-result cmd exit-code result output out info))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Show a Git object, render a commit diff as HTML or return structured output.
; pre : The supplied arguments are valid for git show; --list/-l and
; --output=html/--output=-/--output=string are git-cli options.
; post : Git show has completed successfully or an exception has been raised.
; result : Structured Racket data with --list/-l, a string with --output=string,
; otherwise #t.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-show cmd-git-show 'show
(λ (args info)
(let* ((list-output (ormap (λ (e) (member (format "~a" e) '("--list" "-l"))) args))
(output-html (has-git-arg? args #px"^[-][-]output[=]html$"))
(output-stdout (has-git-arg? args #px"^[-][-]output[=][-]$"))
(output-string (has-git-arg? args #px"^[-][-]output[=]string$"))
(name-only (has-git-arg? args #px"^[-][-]name-only$"))
(name-status (has-git-arg? args #px"^[-][-]name-status$"))
(stat (has-git-arg? args #px"^[-][-]stat([=](.*))?$"))
(no-patch (or (has-git-arg? args #px"^[-][-]no-patch$")
(has-git-arg? args "-s")))
(list-formats (filter (λ (x) x)
(list (if name-only 'name-only #f)
(if name-status 'name-status #f)
(if stat 'stat #f)))))
(when (and list-output (or output-html output-stdout output-string))
(error 'git-show "--list/-l cannot be combined with --output=..."))
(when (and list-output (> (length list-formats) 1))
(error 'git-show "--list/-l accepts only one of --stat, --name-only or --name-status"))
(hash-set! info 'scheme-format list-output)
(hash-set! info 'show-list-format (if (null? list-formats) 'stat (car list-formats)))
(hash-set! info 'show-output
(cond (output-html 'html)
(output-stdout 'stdout)
(output-string 'string)
((or stat name-only name-status no-patch) 'stdout)
(else 'html)))
(let ((nargs (filter (λ (e)
(not (member (format "~a" e)
'("--list" "-l"
"--output=html" "--output=-" "--output=string"))))
args)))
(if (and list-output (null? list-formats))
(cons '--stat nargs)
nargs))))
(λ (cmd exit-code result output out info)
(if (and (zero? exit-code) result)
(cond
((hash-ref info 'scheme-format #f)
(let ((lines (filter (λ (line) (not (string=? (string-trim line) ""))) out)))
(case (hash-ref info 'show-list-format 'stat)
((name-only) lines)
((name-status) (map (λ (line) (string-split line "\t")) lines))
((stat)
(let ((file-re #px"^\\s*(.*?)\\s+[|]\\s+([0-9]+)\\s+([+\\-]+)$")
(total-re #px"^([0-9]+) files? changed(, ([0-9]+) insertions?\\(\\+\\))?(, ([0-9]+) deletions?\\(-\\))?$"))
(map (λ (line)
(let* ((trimmed (string-trim line))
(fm (regexp-match file-re line))
(tm (regexp-match total-re trimmed)))
(cond
(fm (list 'file (cadr fm) (string->number (caddr fm)) (cadddr fm)))
(tm (list 'total
(string->number (cadr tm))
(if (cadddr tm) (string->number (cadddr tm)) 0)
(if (list-ref tm 5) (string->number (list-ref tm 5)) 0)))
(else (list 'info line)))))
lines))))))
((eq? (hash-ref info 'show-output 'html) 'string)
(string-join out "\n"))
((eq? (hash-ref info 'show-output 'html) 'html)
(show->html
(string-join
(filter (λ (line) (not (string-prefix? (string-downcase line) "warning:"))) out)
"\n"))
#t)
(else (std-process-git-result cmd exit-code result output out info)))
(std-process-git-result cmd exit-code result output out info))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Search tracked files for a pattern.
; pre : The supplied arguments are valid for git grep.