From 12788edc7bc447aaf913bd8760f6a3c36ecf720b Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Thu, 13 Aug 2026 17:40:48 +0200 Subject: [PATCH] config functionality extended --- README.md | 4 ++ main.rkt | 109 +++++++++++++++++++++++++++--------------- scribblings/git.scrbl | 9 +++- 3 files changed, 82 insertions(+), 40 deletions(-) diff --git a/README.md b/README.md index acb0dbe..ea47b65 100644 --- a/README.md +++ b/README.md @@ -55,10 +55,14 @@ See the Scribble documentation for command-specific behavior and return values. `git config` has a small Racket-oriented interface: ```racket +(git 'config '--all) (git 'config 'get '--all) +(git 'config '--global 'get '--all) +(git 'config 'get '--global "user.email") (git 'config 'get '--all "credential.helper") (git 'config 'get "credential.helper") (git 'config 'set! "user.email" "hans@example.invalid") +(git 'config '--global 'set! "user.email" "hans@example.invalid") (git 'config 'set! '--global "user.email" "hans@example.invalid") ``` diff --git a/main.rkt b/main.rkt index 7d63cb2..46c30a5 100644 --- a/main.rkt +++ b/main.rkt @@ -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. diff --git a/scribblings/git.scrbl b/scribblings/git.scrbl index f8393b5..27e8cf0 100644 --- a/scribblings/git.scrbl +++ b/scribblings/git.scrbl @@ -94,7 +94,10 @@ Provides a Racket-oriented interface to @tt{git config}. The same interface is available through @racket[git] with command @racket['config]. @racketblock[ +(git 'config '--all) (git 'config 'get '--all) +(git 'config '--global 'get '--all) +(git 'config 'get '--global '--all) ] returns all visible configuration entries as key/value items: @@ -122,11 +125,13 @@ Configuration values can be written with @racket['set!]: @racketblock[ (git 'config 'set! "user.email" "hans@example.invalid") +(git 'config '--global 'set! "user.email" "hans@example.invalid") (git 'config 'set! '--global "user.email" "hans@example.invalid") ] -The optional write scope can be @tt{--global}, @tt{--local}, or @tt{--system}. -A successful write returns @racket[#t]. +The optional scope can be @tt{--global}, @tt{--local}, or @tt{--system}. It may +appear directly after @racket['config] or directly after @racket['get] / +@racket['set!]. A successful write returns @racket[#t]. } @defproc[(git-branch [argument any/c] ...) boolean?]{