ryuslash/gitto
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Add config management commands

Browse source 
These commands parse the git configuration file and, merge settings
defined in the rc.scm and print out the resulting configuration.
This commit is contained in:
Tom Willemse 2013-05-12 20:38:58 +02:00
parent 964756b730
commit d2db2dfb53
3 changed files with 126 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
gitto/Makefile
View file

@ -3,7 +3,8 @@ SITEDIR = $(shell pkg-config guile-2.0 --variable=sitedir \
--define-variable=prefix=$(DESTDIR))
COMPDIR = $(DESTDIR)/lib/guile/2.0/site-ccache
objects = git.scm git.go main.scm main.go path.scm path.go
objects = config.scm config.go git.scm git.go main.scm main.go path.scm \
path.go
install-objects = $(addprefix install-,$(objects))
uninstall-objects = $(addprefix uninstall-,$(objects))

86
gitto/config.scm Normal file
View file

@ -0,0 +1,86 @@
;; -*- coding: utf-8; -*-
;; gitto -- Keep track of your git repositories
;; Copyright (C) 2012 Tom Willemsen <tom at ryuslash dot org>
;; This file is part of gitto.
;; gitto is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; gitto is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; 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 (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 #\=)))
(list (cons (string-trim-both (substring line 0 idx))
(string-trim-both (substring line (1+ idx)))))))
(define (read-config repo-location)
(let ((port (open-input-file
(string-append repo-location "/.git/config")))
(config '())
(current-section #f)
(assign-pos #f))
(do ((line (read-line port) (read-line port)))
((eof-object? line))
(cond ((string= line "[" 0 1)
(let ((section (cons (string-trim-both
line (char-set #\[ #\])) '())))
(set! config (append config (list section)))
(set! current-section section)))
((string-contains line "=")
(set-cdr! current-section
(append (cdr current-section)
(parse-setting line))))))
(close-port port)
config))
(define* (write-config config #:optional (file #f))
(let ((thunk (lambda () (for-each write-section config))))
(if file
(with-output-to-file file thunk)
(thunk))))
(define (write-section section)
(format #t "[~a]~%" (car section))
(for-each write-setting (cdr section)))
(define (write-setting setting)
(format #t "~8t~a = ~a~%" (car setting) (cdr setting)))

45
gitto/main.scm
View file

@ -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,14 +135,38 @@ 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))
(register (single-char #\r) (value #t) (predicate ,git-dir?))
(remove (single-char #\R) (value #t) (predicate ,known?))
(repositories (single-char #\l))
(purge (single-char #\p))
(check (single-char #\c) (value #t))))
`((version (single-char #\v))
(help (single-char #\h))
(register (single-char #\r) (value #t) (predicate ,git-dir?))
(remove (single-char #\R) (value #t) (predicate ,known?))
(repositories (single-char #\l))
(purge (single-char #\p))
(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"))