From 964756b7308dbe0aecc30fe668ae6a2a24f449be Mon Sep 17 00:00:00 2001 From: Tom Willemse Date: Sun, 12 May 2013 16:02:23 +0200 Subject: Split git function into separate module --- gitto/Makefile | 2 +- gitto/git.scm | 165 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ gitto/main.scm | 124 +------------------------------------------ 3 files changed, 167 insertions(+), 124 deletions(-) create mode 100644 gitto/git.scm diff --git a/gitto/Makefile b/gitto/Makefile index dba5570..e9422aa 100644 --- a/gitto/Makefile +++ b/gitto/Makefile @@ -3,7 +3,7 @@ SITEDIR = $(shell pkg-config guile-2.0 --variable=sitedir \ --define-variable=prefix=$(DESTDIR)) COMPDIR = $(DESTDIR)/lib/guile/2.0/site-ccache -objects = main.scm main.go path.scm path.go +objects = git.scm git.go main.scm main.go path.scm path.go install-objects = $(addprefix install-,$(objects)) uninstall-objects = $(addprefix uninstall-,$(objects)) diff --git a/gitto/git.scm b/gitto/git.scm new file mode 100644 index 0000000..3f816a3 --- /dev/null +++ b/gitto/git.scm @@ -0,0 +1,165 @@ +;; -*- coding: utf-8; -*- +;; gitto -- Keep track of your git repositories +;; Copyright (C) 2012 Tom Willemsen + +;; This file is part of gitto. + +;; gitto is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; gitto is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with gitto. If not, see . + +(define-module (gitto git) + #:use-module (ice-9 format) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) + #:use-module (oop goops) + #:export ( + + + branch-name + branch-pullable + branch-pushable + branch-updated + git-dir? + print + repo-branches + repo-clean? + repo-location + repo-name + same-repository?)) + +(define-generic print) +(define-generic same-repository?) + +(define-class () + (name #:getter branch-name) + (pushable #:getter branch-pushable) + (pullable #:getter branch-pullable) + (updated #:getter branch-updated)) + +(define-class () + (name #:getter repo-name) + (location #:getter repo-location) + (clean? #:getter repo-clean?) + (branches #:getter repo-branches)) + +(define-method (branch-pullable (branch )) + (force (slot-ref branch 'pullable))) + +(define-method (branch-pushable (branch )) + (force (slot-ref branch 'pushable))) + +(define-method (branch-updated (branch )) + (force (slot-ref branch 'updated))) + +(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-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 (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 (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 (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-method (initialize (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 (initialize (repo ) 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 b dir)) + (git-branches dir)))))) + +(define-method (print (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-method (print (repo )) + (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 (repo-branches (repo )) + (force (slot-ref repo 'branches))) + +(define-method (repo-clean? (repo )) + (force (slot-ref repo 'clean?))) + +(define-method (same-repository? (x ) (y )) + (string= (repo-location x) (repo-location y))) + +(define-method (same-repository? (x ) (y )) + (string= (repo-location x) y)) + +(define-method (same-repository? (x ) (y )) + (string= x (repo-location y))) + +(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))) 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 . (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 () - (name #:getter repo-name) - (location #:getter repo-location) - (clean? #:getter repo-clean?) - (branches #:getter repo-branches)) - -(define-class () - (name #:getter branch-name) - (pushable #:getter branch-pushable) - (pullable #:getter branch-pullable) - (updated #:getter branch-updated)) - -(define-method (initialize (repo ) 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 b dir)) - (git-branches dir)))))) - -(define-method (initialize (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 )) - (force (slot-ref repo 'clean?))) -(define-method (repo-branches (repo )) - (force (slot-ref repo 'branches))) -(define-method (branch-pushable (branch )) - (force (slot-ref branch 'pushable))) -(define-method (branch-pullable (branch )) - (force (slot-ref branch 'pullable))) -(define-method (branch-updated (branch )) - (force (slot-ref branch 'updated))) - -(define-method (print (repo )) - (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 )) - (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 ) (y )) - (string= (repo-location x) (repo-location y))) -(define-method (same-repository? (x ) (y )) - (string= x (repo-location y))) -(define-method (same-repository? (x ) (y )) - (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)) -- cgit v1.2.3-54-g00ecf