Add config management commands
This commit is contained in:
parent
d61e3814a5
commit
fb1977fc83
2 changed files with 65 additions and 8 deletions
|
@ -18,8 +18,34 @@
|
|||
;; along with gitto. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gitto config)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:export (read-config write-config))
|
||||
#:export (global-config
|
||||
|
||||
merge-config
|
||||
read-config
|
||||
write-config))
|
||||
|
||||
(define global-config '())
|
||||
|
||||
(define (merge-config repo-name x y)
|
||||
(let ((lst (if x (list-copy x) '())))
|
||||
(for-each
|
||||
(lambda (s)
|
||||
(let ((b-sec (assoc (car s) lst)))
|
||||
(set! lst (assoc-set!
|
||||
lst (car s) (merge-settings
|
||||
repo-name (if b-sec (cdr b-sec) #f) (cdr s))))))
|
||||
y)
|
||||
lst))
|
||||
|
||||
(define (merge-settings repo-name x y)
|
||||
(let ((lst (if x (list-copy x) '())))
|
||||
(for-each (lambda (v)
|
||||
(set! lst (assoc-set!
|
||||
lst (car v) (format #f (cdr v) repo-name))))
|
||||
y)
|
||||
lst))
|
||||
|
||||
(define (parse-setting line)
|
||||
(let ((idx (string-index line #\=)))
|
||||
|
|
|
@ -18,6 +18,7 @@
|
|||
;; along with gitto. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gitto main)
|
||||
#:use-module (gitto config)
|
||||
#:use-module (gitto git)
|
||||
#:use-module (gitto path)
|
||||
#:use-module (ice-9 format)
|
||||
|
@ -134,6 +135,27 @@ gitto [options]
|
|||
repositories))
|
||||
(save-repositories-list))
|
||||
|
||||
(define (show-global-config)
|
||||
(write-config global-config))
|
||||
|
||||
(define (show-config)
|
||||
(for-each (lambda (repo)
|
||||
(display (string-upcase (repo-name repo)))
|
||||
(newline)
|
||||
(write-config (read-config (repo-location repo)))
|
||||
(newline)
|
||||
(newline))
|
||||
repositories))
|
||||
|
||||
(define (update-config)
|
||||
(for-each (lambda (repo)
|
||||
(write-config
|
||||
(merge-config (repo-name repo)
|
||||
(read-config (repo-location repo))
|
||||
global-config)
|
||||
(string-append (repo-location repo) "/.git/config")))
|
||||
repositories))
|
||||
|
||||
(define option-spec
|
||||
`((version (single-char #\v))
|
||||
(help (single-char #\h))
|
||||
|
@ -141,7 +163,10 @@ gitto [options]
|
|||
(remove (single-char #\R) (value #t) (predicate ,known?))
|
||||
(repositories (single-char #\l))
|
||||
(purge (single-char #\p))
|
||||
(check (single-char #\c) (value #t))))
|
||||
(check (single-char #\c) (value #t))
|
||||
(config (single-char #\C))
|
||||
(global-config)
|
||||
(update-config)))
|
||||
|
||||
(define (main args)
|
||||
"Parse the command line options and run the appropriate functions."
|
||||
|
@ -153,6 +178,9 @@ gitto [options]
|
|||
(list? (option-ref options 'repositories #f))
|
||||
(purge? (option-ref options 'purge #f))
|
||||
(check? (option-ref options 'check #f))
|
||||
(config? (option-ref options 'config #f))
|
||||
(global-config? (option-ref options 'global-config #f))
|
||||
(update-config? (option-ref options 'update-config #f))
|
||||
(cfg (config-file "rc.scm")))
|
||||
(when (file-exists? cfg)
|
||||
(save-module-excursion
|
||||
|
@ -167,6 +195,9 @@ gitto [options]
|
|||
(list? (list-repository-locations))
|
||||
(purge? (purge))
|
||||
(check? => repository-registered?)
|
||||
(config? (show-config))
|
||||
(global-config? (show-global-config))
|
||||
(update-config? (update-config))
|
||||
(#t (list-repositories)))))
|
||||
|
||||
(define repositories-file (data-file "repos.scm"))
|
||||
|
|
Loading…
Reference in a new issue