Add per-project pages

Pages include summary, refs, log, tree, commit, diff, stats and about;
Just like cgit.

2 files changed, 35 insertions, 6 deletions

diff --git a/tekuti/projects.scm b/tekuti/projects.scm
index db5e7a2..773ff56 100644
--- a/tekuti/projects.scm
+++ b/tekuti/projects.scm
@@ -1,15 +1,15 @@
 (define-module (tekuti projects)
   #:use-module ((tekuti config) #:select (*projects-dir*))
+  #:use-module ((tekuti page) #:select (page-not-found))
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
   #:use-module (tekuti git)
   #:use-module (tekuti page-helpers)
-  #:export (page-projects))
-
-(use-modules (ice-9 ftw)
-             (ice-9 match))
+  #:use-module (web uri)
+  #:use-module (web request)
+  #:export (page-projects page-project))
 
 (define remove-stat
   (match-lambda
@@ -40,13 +40,16 @@
         (substring str 0 pos)
         str)))
 
+(define (project-url prefix name)
+  (uri-encode
+   (string-append prefix (if (string-null? prefix) "" "/") name)))
+
 (define (project->row dir project prefix)
   (let ((project-dir (string-append dir "/" project))
         (project-name (remove-suffix project ".git")))
     `(tr
       (td (@ (class "span3"))
-          (a (@ (href "http://code.ryuslash.org/cgit.cgi/"
-                      ,prefix "/" ,project-name))
+          (a (@ (href ,(project-url prefix project-name)))
              ,project-name))
       (td (@ (class "span6")) ,(project-description project-dir))
       (td (@ (class "span2")) ,(git-last-update project-dir))
@@ -83,3 +86,28 @@
 (define (page-projects request body index)
   (respond (project-list->table *projects-dir* (list-projects) 1 "")
            #:extra-headers '((pragma . (no-cache (broccoli . "tastyy"))))))
+
+(define (project-pages-menu request project page)
+  (let ((page-list '("summary" "refs" "log" "tree" "commit" "diff"
+                     "stats" "about")))
+    `((div (@ (class "navbar"))
+           (div (@ (class "navbar-inner"))
+                (a (@ (class "brand") (href ".")) ,project)
+                (ul (@ (class "nav"))
+                    ,@(map
+                       (lambda (elm)
+                         `(li (@ (class ,(if (string= page elm)
+                                             "active"
+                                             "")))
+                              ,(rellink `("projects" ,project ,elm)
+                                        (string-capitalize elm))))
+                       page-list)))))))
+
+(define* (page-project request body index project page)
+  (if (file-exists? (string-append *projects-dir* project ".git"))
+      (respond `(,(project-pages-menu request project (or page "summary"))
+                 (p "Goto: "
+                    (a (@ (href "http://code.ryuslash.org/cgit.cgi/"
+                                ,project "/" ,(or page "")))
+                       "cgit " ,(or page "summary")))))
+      (page-not-found request body index)))
diff --git a/tekuti/web.scm b/tekuti/web.scm
index 3ba12d7..4f826f5 100644
--- a/tekuti/web.scm
+++ b/tekuti/web.scm
@@ -61,6 +61,7 @@
    ((GET tags tag!) page-show-tag)
    ((GET debug) page-debug)
    ((GET projects) page-projects)
+   ((GET projects project! page?) page-project)
    (else page-not-found)))
 
 (define (cache-ref index request)