git config added
This commit is contained in:
@@ -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.
|
||||
|
||||
Reference in New Issue
Block a user