Show repository status.

src/hackerbase.scm

@@ -41,7 +41,9 @@
 	util-mail
 	logging
 	progress
-	period)
+	period
+	util-git
+	util-dict-list)
 
 ;; Command-line options and configurable parameters
 (define -needs-bank- (make-parameter #f))
@@ -162,6 +164,8 @@
 	   (-notify-months- 3)
 	   (-needs-bank- #t)
 	   (-action- 'notify))
+ (-status () "Show members directory status"
+	  (-action- 'status))
  )
 
 ;; Print banner
@@ -342,6 +346,17 @@
 		   (make+send-reminder-email (car lst))
 		   (make+print-reminder-email (car lst)))
 	       (loop (cdr lst))))))))
+  ((status)
+   (let ((status (git-status (*members-directory*))))
+     (newline)
+     (print "Repository " (*members-directory*) " status:")
+     (if (ldict-ref status 'clean)
+	 (print "  Repository up-to-date.")
+	 (let loop ((keys '(unknown untracked modified)))
+	   (when (not (null? keys))
+	     (when (ldict-contains? status (car keys))
+	       (print "  " (car keys) ": " (length (ldict-ref status (car keys)))))
+	     (loop (cdr keys)))))))
   (else
    (print "Nothing to do."))
   

src/util-git.scm

@@ -29,6 +29,7 @@
  util-git
  (
   git
+  git-status
   )
 
  (import scheme
@@ -79,8 +80,10 @@
 
  ;; Returns a dictionary of unknown, modified, deleted and added files
  (define (git-status repo)
-   (let loop ((lines ((git repo) 'status '--porcelain))
-	      (res (make-ldict)))
+   (let* ((lines ((git repo) 'status '--porcelain))
+	  (clean? (null? lines)))
+     (let loop ((lines lines)
+		(res (make-ldict `((clean . ,clean?)))))
        (if (null? lines)
 	   res
 	   (let* ((line (car lines))
@@ -92,6 +95,6 @@
 		   (ldict-set res
 			      status
 			      (cons fname
-				  (ldict-ref res status '()))))))))
+				    (ldict-ref res status '())))))))))
 
  )