blob: 600ddc5e5dc8d695a450d56e1ba28994e980733a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
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:~15t~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)))))
|
