Add Makefiles, utility

Change the directory structure and add a bunch of Makefiles to make it
easy to install gitto. Also add a utility to run gitto in its current
state.

3 files changed, 148 insertions, 0 deletions

diff --git a/gitto/.gitignore b/gitto/.gitignore
new file mode 100644
index 0000000..e796b66
--- /dev/null
+++ b/gitto/.gitignore
@@ -0,0 +1 @@
+*.go
diff --git a/gitto/Makefile b/gitto/Makefile
new file mode 100644
index 0000000..4c4f95e
--- /dev/null
+++ b/gitto/Makefile
@@ -0,0 +1,25 @@
+DESTDIR ?= /usr/local
+
+objects = main.go main.scm
+install-objects = $(addprefix install-,$(objects))
+uninstall-objects = $(addprefix uninstall-,$(objects))
+
+$(filter %.go,$(objects)): %.go: %.scm
+	guile-tools compile -o $@ $^
+
+.PHONY: install $(install-objects) uninstall $(uninstall-objects)
+
+install: $(install-objects)
+uninstall: $(uninstall-objects)
+
+$(filter %.go,$(install-objects)): install-%:
+	install -Dm 644 $* $(DESTDIR)/lib/guile/2.0/ccache/gitto/$*
+
+$(filter %.scm,$(install-objects)): install-%:
+	install -Dm 644 $* $(DESTDIR)/share/guile/2.0/gitto/$*
+
+$(filter %.go,$(uninstall-objects)): uninstall-%:
+	rm -f $(DESTDIR)/lib/guile/2.0/ccache/gitto/$*
+
+$(filter %.scm,$(uninstall-objects)): uninstall-%:
+	rm -f $(DESTDIR)/share/guile/2.0/gitto/$*
diff --git a/gitto/main.scm b/gitto/main.scm
new file mode 100644
index 0000000..e6624e4
--- /dev/null
+++ b/gitto/main.scm
@@ -0,0 +1,122 @@
+(define-module (gitto main)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 getopt-long)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:export (main))
+
+(define data-dir
+  (let ((xdg (getenv "XGD_DATA_HOME"))
+        (name "gitto"))
+    (if xdg
+        (string-append xdg "/" name)
+        (string-append (getenv "HOME") "/." name))))
+
+(define repositories-file
+  (string-append data-dir "/repos.scm"))
+
+(define repositories
+  (if (file-exists? repositories-file)
+      (let* ((port (open-input-file repositories-file))
+             (result (read port)))
+        (close-port port)
+        result)
+      '()))
+
+(define (version)
+  "Display version information"
+  (display "gitto version 0.1\n"))
+
+(define (help)
+  "Display some help."
+  (display "\
+gitto [options]
+  -r, --register REPO  Register a new repository directory
+  -R, --remove REPO    Repmove a repository directory
+  -v, --version        Display version
+  -h, --help           Display this help
+"))
+
+(define (git-dir? dir)
+  "Check whether or not DIR/.git exists"
+  (let ((dir (string-append dir "/.git")))
+    (if (file-exists? dir)
+        (let ((dirstat (stat dir)))
+          (eq? (stat:type dirstat) 'directory))
+        #f)))
+
+(define (save-repositories-list)
+  "Save the list of repositories."
+  (if (not (file-exists? data-dir))
+      (mkdir data-dir))
+
+  (let ((port (open-output-file repositories-file)))
+    (write repositories port)
+    (close-port port)))
+
+(define (register-repository repository)
+  (if (not (member repository repositories))
+      (begin
+        (set! repositories (append `(,repository) repositories))
+        (save-repositories-list)
+        (simple-format #t "Repository ~A registered." repository))
+      (display "Repository already registered."))
+  (newline))
+
+(define (remove-repository repository)
+  (if (member repository repositories)
+      (begin
+        (set! repositories (delete repository repositories))
+        (save-repositories-list)
+        (simple-format #t "Repository ~A removed." repository))
+      (display "Not a registered repository."))
+  (newline))
+
+(define (git-revs-to-push)
+  (let* ((pp (open-input-pipe "git log --pretty=oneline @{u}.. | wc -l"))
+         (num (string->number (read-line pp))))
+    (close-pipe pp)
+    num))
+
+(define (git-revs-to-pull)
+  (let* ((pp (open-input-pipe "git log --pretty=oneline ..@{u} | wc -l"))
+         (num (string->number (read-line pp))))
+    (close-pipe pp)
+    num))
+
+(define (git-clean?)
+  (let* ((pipe (open-input-pipe "git status -suno"))
+         (clean? (eof-object? (read-delimited "" pipe))))
+    (close-pipe pipe)
+    clean?))
+
+(define (list-repositories)
+  (for-each (lambda (repo)
+              (chdir repo)
+              (let ((numup (git-revs-to-push))
+                    (numdown (git-revs-to-pull))
+                    (clean? (git-clean?)))
+                (format #t "~a: ~d to push, ~d to pull and is ~adirty.\n"
+                        (basename repo) numup numdown
+                        (if clean? "not " ""))))
+            repositories))
+
+(define option-spec
+  `((version  (single-char #\v) (value #f))
+    (help     (single-char #\h) (value #f))
+    (register (single-char #\r) (value #t)
+              (predicate ,git-dir?))
+    (remove   (single-char #\R) (value #t)
+              (predicate ,git-dir?))))
+
+(define (main args)
+  (let* ((options (getopt-long args option-spec))
+         (help-wanted (option-ref options 'help #f))
+         (version-wanted (option-ref options 'version #f))
+         (registration-needed (option-ref options 'register #f))
+         (removal (option-ref options 'remove #f)))
+    (cond (version-wanted (version))
+          (help-wanted (help))
+          (registration-needed => register-repository)
+          (removal => remove-repository)
+          (#t (list-repositories)))))