aboutsummaryrefslogtreecommitdiffstats
path: root/gitto.scm
diff options
context:
space:
mode:
authorGravatar Tom Willemsen2012-07-01 01:42:15 +0200
committerGravatar Tom Willemsen2012-07-01 01:42:15 +0200
commitd7a622d4ba8b187a6f35a7dc5b054148aba2469f (patch)
tree2e12e4eb8d386fd2f2e0c1b1051c594670db3c4b /gitto.scm
parent5e17738e22b6d4907590614efe3d4cd122c5e2c4 (diff)
downloadgitto-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.scm')
-rwxr-xr-xgitto.scm123
1 files changed, 0 insertions, 123 deletions
diff --git a/gitto.scm b/gitto.scm
deleted file mode 100755
index 75b0aff..0000000
--- a/gitto.scm
+++ /dev/null
@@ -1,123 +0,0 @@
-#! /usr/bin/guile \
--e main -s
-!#
-(use-modules (ice-9 format)
- (ice-9 getopt-long)
- (ice-9 popen)
- (ice-9 rdelim))
-
-(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)))))