config functionality extended

This commit is contained in:
2026-08-13 17:40:48 +02:00
parent 6b027534b9
commit 12788edc7b
3 changed files with 82 additions and 40 deletions
+71 -38
View File
@@ -143,46 +143,79 @@
; 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"))))
(define (scope? x)
(member x '(--global --local --system)))
((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"))))
(define (split-scope args)
(cond
((and (pair? args) (scope? (car args)))
(values (car args) (cdr args)))
(else
(values #f args))))
(let-values (((scope args*) (split-scope args)))
(cond
;; Short form: (git 'config '--all)
((and (not scope)
(= (length args*) 1)
(eq? (car args*) '--all))
(hash-set! info 'config-operation 'all)
'(--list))
((null? args*)
(error 'git-config "Expected get or set!"))
(else
(let ((action (car args*))
(rest (cdr args*)))
(cond
((eq? action 'get)
;; Also accept scope directly after get.
(let-values (((scope* rest*) (split-scope rest)))
(let ((effective-scope (or scope scope*)))
(when (and scope scope*)
(error 'git-config "Configuration scope specified twice"))
(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)
(append (if effective-scope (list effective-scope) '())
'(--list)))
((null? (cddr rest*))
(hash-set! info 'config-operation 'get-all)
(append (if effective-scope (list effective-scope) '())
(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)
(append (if effective-scope (list effective-scope) '())
(list '--get (car rest*))))
(else
(error 'git-config "Too many arguments for config get"))))))
((eq? action 'set!)
;; Also accept scope directly after set!.
(let-values (((scope* rest*) (split-scope rest)))
(let ((effective-scope (or scope scope*)))
(when (and scope scope*)
(error 'git-config "Configuration scope specified twice"))
(if (= (length rest*) 2)
(begin
(hash-set! info 'config-operation 'set)
(append (if effective-scope (list effective-scope) '())
rest*))
(error 'git-config "Expected config set! [scope] key value")))))
(else
(error 'git-config "Expected get or set!"))))))))
(else
(error 'git-config "Expected get or set!"))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Process the result of the Racket-oriented git config interface.