diff options
Diffstat (limited to 'gitto/main.scm')
-rw-r--r-- | gitto/main.scm | 124 |
1 files changed, 1 insertions, 123 deletions
diff --git a/gitto/main.scm b/gitto/main.scm index e65275a..efd1cee 100644 --- a/gitto/main.scm +++ b/gitto/main.scm @@ -18,75 +18,15 @@ ;; along with gitto. If not, see <http://www.gnu.org/licenses/>. (define-module (gitto main) + #:use-module (gitto git) #:use-module (gitto path) #:use-module (ice-9 format) - #:use-module (ice-9 ftw) #:use-module (ice-9 getopt-long) #:use-module (ice-9 popen) - #:use-module (ice-9 rdelim) #:use-module (oop goops) #:use-module (srfi srfi-1) #:export (main)) -(define-generic same-repository?) -(define-generic print) - -(define-class <repository> () - (name #:getter repo-name) - (location #:getter repo-location) - (clean? #:getter repo-clean?) - (branches #:getter repo-branches)) - -(define-class <branch> () - (name #:getter branch-name) - (pushable #:getter branch-pushable) - (pullable #:getter branch-pullable) - (updated #:getter branch-updated)) - -(define-method (initialize (repo <repository>) args) - (let ((dir (car args))) - (slot-set! repo 'name (basename dir)) - (slot-set! repo 'location dir) - (slot-set! repo 'clean? (delay (git-clean? dir))) - - (slot-set! repo 'branches - (delay (map (lambda (b) (make <branch> b dir)) - (git-branches dir)))))) - -(define-method (initialize (branch <branch>) args) - (let ((name (car args)) - (dir (cadr args))) - (slot-set! branch 'name name) - (slot-set! branch 'pushable (delay (git-revs-to-push dir name))) - (slot-set! branch 'pullable (delay (git-revs-to-pull dir name))) - (slot-set! branch 'updated (delay (git-last-update dir name))))) - -(define-method (repo-clean? (repo <repository>)) - (force (slot-ref repo 'clean?))) -(define-method (repo-branches (repo <repository>)) - (force (slot-ref repo 'branches))) -(define-method (branch-pushable (branch <branch>)) - (force (slot-ref branch 'pushable))) -(define-method (branch-pullable (branch <branch>)) - (force (slot-ref branch 'pullable))) -(define-method (branch-updated (branch <branch>)) - (force (slot-ref branch 'updated))) - -(define-method (print (repo <repository>)) - (if (file-exists? (repo-location repo)) - (begin - (format #t "~a: Worktree is ~a~%" (repo-name repo) - (if (repo-clean? repo) "clean" "dirty")) - (for-each print (repo-branches repo)) - (newline)) - (format #t "~a:~15tnot found at ~s\n" - (repo-name repo) (repo-location repo)))) - -(define-method (print (branch <branch>)) - (format #t " ~a:~15t~d to push and ~d to pull. Last update: ~a~%" - (branch-name branch) (branch-pushable branch) - (branch-pullable branch) (branch-updated branch))) - (define (storage-dir xdg-env fallback) (let ((xdg (getenv xdg-env))) (string-append @@ -118,21 +58,6 @@ gitto [options] -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-method (same-repository? (x <repository>) (y <repository>)) - (string= (repo-location x) (repo-location y))) -(define-method (same-repository? (x <string>) (y <repository>)) - (string= x (repo-location y))) -(define-method (same-repository? (x <repository>) (y <string>)) - (string= (repo-location x) y)) - (define (known? repo) "Do we know REPO?" (or (member repo repositories same-repository?) @@ -187,53 +112,6 @@ gitto [options] (display "Not a registered repository.")) (newline)) -(define (git-revs-to-push dir branch) - "Check how many commits should be pushed upstream." - (let* ((pipe (start-git - dir (format #f "log --pretty=oneline ~a@{u}..~:*~a" branch) - "| wc -l")) - (num (string->number (read-line pipe)))) - (close-pipe pipe) - num)) - -(define (git-revs-to-pull dir branch) - "Check how many commits should be pulled/merged from upstream." - (let* ((pipe (start-git - dir (format #f "log --pretty=oneline ~a..~:*~a@{u}" branch) - "| wc -l")) - (num (string->number (read-line pipe)))) - (close-pipe pipe) - num)) - -(define* (start-git dir args #:optional (extra "")) - (open-input-pipe - (format #f "git --work-tree=~s --git-dir=\"~a/.git\" ~a 2>/dev/null ~a" - dir dir args extra))) - -(define (git-branches dir) - (let ((pipe (start-git dir "branch"))) - (map - (lambda (b) (string-trim-both b (char-set #\* #\space))) - (string-split (string-trim-right (read-string pipe)) #\newline)))) - -(define (git-clean? dir) - "Check whether a repository is clean, meaning there are no changes -to the tracked files. Utracked files will not register." - (let* ((pipe (start-git dir "status -suno")) - (clean? (eof-object? (read-delimited "" pipe)))) - (close-pipe pipe) - clean?)) - -(define (git-last-update dir branch) - "Check when the last update upstream was." - (let* ((pipe (start-git - dir (format #f "log -1 --format=%ar ~a@{u}" branch))) - (relative-last-update (read-line pipe))) - (close-pipe pipe) - (if (eof-object? relative-last-update) - "never" - relative-last-update))) - (define (list-repositories) "List information about every repository." (for-each print repositories)) |