Improvements to git repo browser.

diff --git a/examples/git.scm b/examples/browse-git.scm
old mode 100644 (file)
new mode 100755 (executable)
similarity index 66%
rename from examples/git.scm
rename to examples/browse-git.scm
index 3b64ff9..02e7554
--- a/examples/git.scm
+++ b/examples/browse-git.scm
@@ -7,12 +7,12 @@
           (chicken pathname)
           srfi-13)
 
-  (define git-base-url "git://GIT-SERVER-URL/")
-  (define git-base-dir "/PATH/TO/GIT/REPOS/")
+  (define git-base-url "git://MY.GIT.SERVER/")
+  (define git-base-dir "/PATH/TO/REPOS/")
 
   (define (git . args)
     (with-current-working-directory
-     (conc git-base-dir repo)
+     (list git-base-dir repo)
      (lambda ()
        (let-values (((in-port out-port id) (process "git" args)))
          (let ((result (read-lines in-port)))
@@ -25,39 +25,41 @@
           (references (git "show-ref" "--heads")))
       (append
        (list
-        (conc "Git repository for " repo)
+        (conc "Git repository " repo)
         ""
         (conc "(Clone from " git-base-url repo ".)")
         ""
-        "Branches:")
+        "-----= Branches =-----")
        (map (lambda (ref)
               (let ((refname (caddr (string-split ref "/"))))
                 (list
                  1
                  (conc (if (equal? branch refname) "*" "")
                        refname)
-                 (conc "git.scm:tree:" repo ":" refname ":" path))))
+                 (conc "browse-git.scm|tree|" repo "|" refname "|" path))))
             references)
        (list ""
-             "Files:")
+             (conc "-----= Files [" path "] =-----"))
        (map (lambda (entry)
               (let* ((l (string-split entry "\t"))
                      (type (string->symbol (cadr (string-split (car l) " "))))
-                     (file (cadr l)))
+                     (file-path (cadr l))
+                     (file (conc (pathname-file file-path)
+                                 (if (pathname-extension file-path)
+                                     (conc "." (pathname-extension file-path))
+                                     ""))))
                 (list (if (eq? type 'tree) 1 0)
                       file
-                      (conc "git.scm:" type ":" repo ":" branch ":"
-                            file
+                      (conc "browse-git.scm|" type "|" repo "|" branch "|"
+                            file-path
                             (if (eq? type 'tree) "/" "")))))
-            entries)
-       (list
-        "------"))))
+            entries))))
 
   (define (serve-blob)
     (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)))