diff options
author | 2012-07-01 01:42:15 +0200 | |
---|---|---|
committer | 2012-07-01 01:42:15 +0200 | |
commit | d7a622d4ba8b187a6f35a7dc5b054148aba2469f (patch) | |
tree | 2e12e4eb8d386fd2f2e0c1b1051c594670db3c4b /gitto | |
parent | 5e17738e22b6d4907590614efe3d4cd122c5e2c4 (diff) | |
download | gitto-d7a622d4ba8b187a6f35a7dc5b054148aba2469f.tar.gz gitto-d7a622d4ba8b187a6f35a7dc5b054148aba2469f.zip |
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.
Diffstat (limited to 'gitto')
-rw-r--r-- | gitto/.gitignore | 1 | ||||
-rw-r--r-- | gitto/Makefile | 25 | ||||
-rw-r--r-- | gitto/main.scm | 122 |
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))))) |