git config added

This commit is contained in:
2026-08-13 17:33:06 +02:00
parent 135938f75a
commit 6b027534b9
3 changed files with 166 additions and 3 deletions
+106
View File
@@ -20,6 +20,7 @@
git-fetch
git-switch
git-tag
git-config
git-log
git-grep
git-branch
@@ -123,6 +124,101 @@
(string-contains? line* "no changes added to commit"))))
out))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Convert one git config --list output line to a key/value item.
; pre : line is one line produced by git config --list.
; post : line has only been inspected.
; result : A list containing the configuration key and value.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (config-line->item line)
(let ((m (regexp-match #px"^([^=]+)=(.*)$" line)))
(if m
(list (cadr m) (caddr m))
(list line ""))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Translate the Racket-oriented config interface to git config arguments.
; pre : args starts with get or set! and follows one of the supported forms.
; post : info contains the config operation used to process Git's result.
; result : Arguments accepted by git config.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-config-args args info)
(if (null? args)
(error 'git-config "Expected get or set!")
(let ((action (car args))
(rest (cdr args)))
(cond
((eq? action 'get)
(cond
((null? rest)
(error 'git-config "Expected a configuration key or --all"))
((eq? (car rest) '--all)
(cond
((null? (cdr rest))
(hash-set! info 'config-operation 'all)
'(--list))
((null? (cddr rest))
(hash-set! info 'config-operation 'get-all)
(list '--get-all (cadr rest)))
(else
(error 'git-config "Too many arguments for config get --all"))))
((null? (cdr rest))
(hash-set! info 'config-operation 'get)
(list '--get (car rest)))
(else
(error 'git-config "Too many arguments for config get"))))
((eq? action 'set!)
(cond
((= (length rest) 2)
(hash-set! info 'config-operation 'set)
rest)
((and (= (length rest) 3)
(member (car rest) '(--global --local --system)))
(hash-set! info 'config-operation 'set)
rest)
(else
(error 'git-config
"Expected config set! [--global|--local|--system] key value"))))
(else
(error 'git-config "Expected get or set!"))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Process the result of the Racket-oriented git config interface.
; pre : info contains the operation selected by git-config-args.
; post : Successful query output has been converted to Racket data.
; result : Config data, #f for a missing single key, or #t after set!.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (process-git-config-result cmd exit-code result output out info)
(let* ((operation (hash-ref info 'config-operation))
(stdout (map cadr
(filter (λ (entry) (eq? (car entry) 'stdout))
output))))
(cond
((eq? operation 'all)
(if (= exit-code 0)
(map config-line->item stdout)
(std-process-git-result cmd exit-code result output out info)))
((eq? operation 'get-all)
(cond
((= exit-code 0) stdout)
((= exit-code 1) '())
(else
(std-process-git-result cmd exit-code result output out info))))
((eq? operation 'get)
(cond
((= exit-code 0)
(if (null? stdout) #f (car stdout)))
((= exit-code 1) #f)
(else
(std-process-git-result cmd exit-code result output out info))))
(else
(std-process-git-result cmd exit-code result output out info)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Command definition macro
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -233,6 +329,16 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-fetch cmd-git-fetch 'fetch)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Read or write Git configuration through a Racket-oriented interface.
; pre : Arguments follow one of the supported get/set! forms.
; post : Git config has completed or an exception has been raised.
; result : Structured config data, #f for a missing key, or #t after set!.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-config cmd-git-config 'config
git-config-args
process-git-config-result)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : List, create or delete branches.