diff --git a/gitto/Makefile b/gitto/Makefile index e9422aa..6d8f92d 100644 --- a/gitto/Makefile +++ b/gitto/Makefile @@ -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)) diff --git a/gitto/config.scm b/gitto/config.scm new file mode 100644 index 0000000..26b2dce --- /dev/null +++ b/gitto/config.scm @@ -0,0 +1,86 @@ +;; -*- coding: utf-8; -*- +;; gitto -- Keep track of your git repositories +;; Copyright (C) 2012 Tom Willemsen + +;; 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 . + +(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))) diff --git a/gitto/main.scm b/gitto/main.scm index efd1cee..34f9866 100644 --- a/gitto/main.scm +++ b/gitto/main.scm @@ -18,6 +18,7 @@ ;; along with gitto. If not, see . (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"))