Improvements to git browser example.

diff --git a/examples/browse-git.scm b/examples/browse-git.scm
index 9edd585..d62a002 100644 (file)
--- a/examples/browse-git.scm
+++ b/examples/browse-git.scm
@@ -8,7 +8,7 @@
 ;; A zip archive of the repository can be retrieved using
 ;; the selector browse-git.scm|REPO||zip.
 ;;
-;; You may optionally include a file named project-description
+;; You may optionally include a file named description
 ;; in each repository, which will be displayed at the top
 ;; of the page when the repository tree is served.
 
@@ -23,7 +23,12 @@
             (chicken pathname)
             (chicken file)
             (chicken port)
-            srfi-13)
+            srfi-1 srfi-13)
+
+    (define (take-last l n)
+      (if (< (length l) n)
+          l
+          (take-right l n)))
 
     (define git-base-url "git://MY.GIT.SERVER/")
     (define git-base-dir "/path/to/git/repositories/")
@@ -58,18 +63,19 @@
     (define (serve-tree)
       (let ((entries (git "ls-tree" branch path))
             (references (git "show-ref" "--heads"))
+            (tags (reverse (take-last (git "show-ref" "--tags") 5)))
             (commits (git "rev-list" "--abbrev-commit" "-n5" branch)))
         (append
          (list (conc "Git repository " git-base-url repo)
                "")
          (let ((descr-file (make-pathname git-base-dir
-                                          (make-pathname repo "project-description"))))
+                                          (make-pathname repo "description"))))
            (if (file-exists? descr-file)
                (list "----= Description =----"
                      (with-input-from-file descr-file read-string)
                      "")
                '()))
-         (list "-----= Branches =-----")
+         (list "----= Branches and Recent Tags=----")
          (map (lambda (ref)
                 (let ((refname (caddr (string-split ref "/"))))
                   (list
@@ -77,10 +83,10 @@
                    (conc (if (equal? branch refname) "*" "")
                          refname)
                    (conc "browse-git.scm|" repo "|" refname "|" path "|tree"))))
-              references)
+              (append references tags))
          (list
           ""
-          (conc "-----= Recent Commits [" branch "] =-----"))
+          (conc "----= Recent Commits [" branch "] =----"))
          (map (lambda (commit)
                 (list
                  1
@@ -89,7 +95,7 @@
                  (conc "browse-git.scm|" repo "|" commit "|" path "|tree")))
               commits)
          (list ""
-               (conc "-----= Files [" path "] =-----"))
+               (conc "----= Files [" path "] =----"))
          (map (lambda (entry)
                 (let* ((l (string-split entry "\t"))
                        (type (string->symbol (cadr (string-split (car l) " "))))