Improved git browser example.

[scratchy.git] / examples / browse-git.scm

diff --git a/examples/browse-git.scm b/examples/browse-git.scm
index 02e7554..75b940c 100755 (executable)
--- a/examples/browse-git.scm
+++ b/examples/browse-git.scm
@@ -8,21 +8,26 @@
           srfi-13)
 
   (define git-base-url "git://MY.GIT.SERVER/")
-  (define git-base-dir "/PATH/TO/REPOS/")
+  (define git-base-dir "/PATH/TO/GIT/REPOS/")
+
 
   (define (git . args)
-    (with-current-working-directory
-     (list git-base-dir repo)
-     (lambda ()
-       (let-values (((in-port out-port id) (process "git" args)))
-         (let ((result (read-lines in-port)))
-           (close-input-port in-port)
-           (close-output-port out-port)
-           result)))))
+    (let ((repo-pathname (make-pathname git-base-dir repo)))
+      (if (not (string-prefix? git-base-dir (normalize-pathname repo-pathname)))
+          (error "Invalid git repository."))
+      (with-current-working-directory
+       repo-pathname
+       (lambda ()
+         (let-values (((in-port out-port id) (process "git" args)))
+           (let ((result (read-lines in-port)))
+             (close-input-port in-port)
+             (close-output-port out-port)
+             result))))))
 
   (define (serve-tree)
     (let ((entries (git "ls-tree" branch path))
-          (references (git "show-ref" "--heads")))
+          (references (git "show-ref" "--heads"))
+          (commits (git "rev-list" "--abbrev-commit" "-n5" branch)))
       (append
        (list
         (conc "Git repository " repo)
@@ -38,8 +43,19 @@
                        refname)
                  (conc "browse-git.scm|tree|" repo "|" refname "|" path))))
             references)
-       (list ""
-             (conc "-----= Files [" path "] =-----"))
+       (list
+        ""
+        (conc "-----= Recent Commits [" branch "] =-----"))
+       (map (lambda (commit)
+              (list
+               1
+               (conc (if (equal? branch commit) "*" "")
+                     (car (git "show" "-s" "--format=%s (%ar)" commit)))
+               (conc "browse-git.scm|tree|" repo "|" commit "|" path)))
+            commits)
+       (list
+        ""
+        (conc "-----= Files [" path "] =-----"))
        (map (lambda (entry)
               (let* ((l (string-split entry "\t"))
                      (type (string->symbol (cadr (string-split (car l) " "))))
@@ -59,7 +75,7 @@
     (for-each
      (lambda (line)
        (print line "\r"))
-     (git "cat-file" "blob" (conc branch "|" path)))
+     (git "cat-file" "blob" (conc branch ":" path)))
     (print ".\r"))
 
   (let ((type (string->symbol type-str)))