From 387e3f1c677305cff2d104bcc6f23d6905b19335 Mon Sep 17 00:00:00 2001
From: Tom Willemse
Date: Sun, 5 May 2013 18:18:18 +0200
Subject: Turn format function into a generic method

This changes the way formatting functions can be customized in the init
file to:

,----
| (define-method (print (repo <repository>))
|   (format #t "~a: ~d up; ~d down; ~a. Updated ~a~%"
|           (repo-name repo) (repo-pushable repo) (repo-pullable repo)
|           (if (repo-clean? repo) "clean" "dirty") (repo-updated repo)))
`----

Note that it is possible that REPO doesn't exist, so you should always
check for that first.
---
 gitto/main.scm | 37 +++++++++++++++----------------------
 1 file changed, 15 insertions(+), 22 deletions(-)

diff --git a/gitto/main.scm b/gitto/main.scm
index f38b309..0fe28af 100644
--- a/gitto/main.scm
+++ b/gitto/main.scm
@@ -28,11 +28,12 @@
   #:export (main))
 
 (define-generic same-repository?)
+(define-generic print)
 
 (define-class <repository> ()
   (name #:getter repo-name)
   (location #:getter repo-location)
-  (state #:getter repo-state)
+  (clean? #:getter repo-clean?)
   (pushable #:getter repo-pushable)
   (pullable #:getter repo-pullable)
   (updated #:getter repo-updated))
@@ -41,13 +42,13 @@
   (let ((dir (car args)))
     (slot-set! repo 'name (basename dir))
     (slot-set! repo 'location dir)
-    (slot-set! repo 'state (delay (git-clean? dir)))
+    (slot-set! repo 'clean? (delay (git-clean? dir)))
     (slot-set! repo 'pushable (delay (git-revs-to-push dir)))
     (slot-set! repo 'pullable (delay (git-revs-to-pull dir)))
     (slot-set! repo 'updated (delay (git-last-update dir)))))
 
-(define-method (repo-state (repo <repository>))
-  (force (slot-ref repo 'state)))
+(define-method (repo-clean? (repo <repository>))
+  (force (slot-ref repo 'clean?)))
 (define-method (repo-pushable (repo <repository>))
   (force (slot-ref repo 'pushable)))
 (define-method (repo-pullable (repo <repository>))
@@ -55,6 +56,15 @@
 (define-method (repo-updated (repo <repository>))
   (force (slot-ref repo 'updated)))
 
+(define-method (print (repo <repository>))
+  (if (file-exists? (repo-location repo))
+      (format
+       #t "~a:~15t~d to push, ~d to pull and is ~a. Last update: ~a\n"
+       (repo-name repo) (repo-pushable repo) (repo-pullable repo)
+       (if (repo-clean? repo) "clean" "dirty") (repo-updated repo))
+      (format #t "~a:~15tnot found at ~s\n"
+              (repo-name repo) (repo-location repo))))
+
 (define (storage-dir xdg-env fallback)
   (let ((xdg (getenv xdg-env)))
     (string-append
@@ -155,11 +165,6 @@ gitto [options]
       (display "Not a registered repository."))
   (newline))
 
-(define (format-repository name pushable pullable clean? updated)
-  (format
-   #t "~a:~15t~d to push, ~d to pull and is ~a. Last update: ~a\n"
-   name pushable pullable (if clean? "clean" "dirty") updated))
-
 (define (git-revs-to-push dir)
   "Check how many commits should be pushed upstream."
   (let* ((pipe (start-git dir "log --pretty=oneline @{u}.." "| wc -l"))
@@ -198,19 +203,7 @@ to the tracked files. Utracked files will not register."
 
 (define (list-repositories)
   "List information about every repository."
-  (for-each
-   (lambda (repo)
-     (if (file-exists? (repo-location repo))
-         (begin
-           (let ((numup (repo-pushable repo))
-                 (numdown (repo-pullable repo))
-                 (clean? (repo-state repo))
-                 (lastupdate (repo-updated repo)))
-             (format-repository (repo-name repo) numup numdown clean?
-                                lastupdate)))
-         (format #t "~a:~15tnot found at ~s\n"
-                 (repo-name repo) (repo-location repo))))
-   repositories))
+  (for-each print repositories))
 
 (define (list-repository-locations)
   "List the registered locations of repositories."
-- 
cgit v1.2.3-54-g00ecf