From 6b027534b9191d1c741d7b0e11509fb12fbdcd0f Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Thu, 13 Aug 2026 17:33:06 +0200 Subject: [PATCH] git config added --- README.md | 20 +++++++- main.rkt | 106 ++++++++++++++++++++++++++++++++++++++++++ scribblings/git.scrbl | 43 ++++++++++++++++- 3 files changed, 166 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 5ba4de5..acb0dbe 100644 --- a/README.md +++ b/README.md @@ -42,14 +42,30 @@ credentials, SSH keys, pull strategy, and other repository configuration. ## Commands The package currently registers commands including `status`, `add`, `commit`, -`push`, `pull`, `fetch`, `branch`, `switch`, `clone`, `tag`, `log`, +`push`, `pull`, `fetch`, `config`, `branch`, `switch`, `clone`, `tag`, `log`, `rev-list`, `diff`, `show`, `grep`, `help`, `version`, and `new-version`. Most are also exported as direct procedures such as `git-status`, `git-add`, -`git-fetch`, `git-switch`, `git-tag`, `git-log`, `git-diff`, and `git-show`. +`git-fetch`, `git-config`, `git-switch`, `git-tag`, `git-log`, `git-diff`, and `git-show`. See the Scribble documentation for command-specific behavior and return values. +## Git configuration + +`git config` has a small Racket-oriented interface: + +```racket +(git 'config 'get '--all) +(git 'config 'get '--all "credential.helper") +(git 'config 'get "credential.helper") +(git 'config 'set! "user.email" "hans@example.invalid") +(git 'config 'set! '--global "user.email" "hans@example.invalid") +``` + +`get --all` without a key returns `(key value)` items. `get --all key` +returns all values for one key. `get key` returns one string or `#f` when the +key is absent. `set!` returns `#t` after a successful write. + ## Low-level Git execution `run-git` can be used when direct access to Git's stdin/stdout protocol is diff --git a/main.rkt b/main.rkt index 86e9cc2..7d63cb2 100644 --- a/main.rkt +++ b/main.rkt @@ -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. diff --git a/scribblings/git.scrbl b/scribblings/git.scrbl index c44667a..f8393b5 100644 --- a/scribblings/git.scrbl +++ b/scribblings/git.scrbl @@ -19,7 +19,8 @@ read credentials or other answers from the terminal. Runs a registered Git @racket[command]. The arguments are passed to the command. Registered command symbols are @racket['status], @racket['add], @racket['commit], @racket['push], @racket['pull], @racket['fetch], -@racket['branch], @racket['switch], @racket['clone], @racket['tag], +@racket['config], @racket['branch], @racket['switch], @racket['clone], +@racket['tag], @racket['log], @racket['rev-list], @racket['diff], @racket['show], @racket['grep], @racket['help], @racket['version], and @racket['new-version]. @@ -88,6 +89,46 @@ For example: ] } +@defproc[(git-config [argument any/c] ...) any/c]{ +Provides a Racket-oriented interface to @tt{git config}. The same interface is +available through @racket[git] with command @racket['config]. + +@racketblock[ +(git 'config 'get '--all) +] + +returns all visible configuration entries as key/value items: + +@racketblock[ +'(("user.name" "Hans Dijkema") + ("user.email" "hans@example.invalid") + ("credential.helper" "manager")) +] + +@racketblock[ +(git 'config 'get "credential.helper") +] + +returns one value as a string, or @racket[#f] when the key is absent. + +@racketblock[ +(git 'config 'get '--all "credential.helper") +] + +returns all values for one key as a list. An absent key produces the empty +list. + +Configuration values can be written with @racket['set!]: + +@racketblock[ +(git 'config '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]. +} + @defproc[(git-branch [argument any/c] ...) boolean?]{ Runs @tt{git branch} with the supplied arguments. This can be used to list, create, rename, or delete branches according to the options supported by the