diff options
| -rw-r--r-- | tekuti/projects.scm | 19 |
1 files changed, 12 insertions, 7 deletions
diff --git a/tekuti/projects.scm b/tekuti/projects.scm index 7f68eb6..1f5fcf2 100644 --- a/tekuti/projects.scm +++ b/tekuti/projects.scm @@ -40,15 +40,19 @@ (substring name 0 pos) name))) -(define (project->row dir project) - (let ((project-dir (string-append dir "/" project))) +(define (project->row dir project prefix) + (let ((project-dir (string-append dir "/" project)) + (project-name (gitless project))) `(tr - (td (@ (class "span3")) ,(gitless project)) + (td (@ (class "span3")) + (a (@ (href "http://code.ryuslash.org/cgit.cgi/" + ,prefix "/" ,project-name)) + ,project-name)) (td (@ (class "span6")) ,(project-description project-dir)) (td (@ (class "span2")) ,(git-last-update project-dir)) (td (@ (class "span1")) "")))) -(define (project-list->table top-dir list lvl) +(define (project-list->table top-dir list lvl prefix) (let ((head (car list)) (body (cadr list))) `((,(string->symbol (string-append "h" (number->string lvl))) ,head) @@ -62,13 +66,14 @@ (th ""))) (tbody ,@(map (lambda (elt) - (project->row top-dir elt)) + (project->row top-dir elt prefix)) (filter (lambda (elt) (and (string? elt) (access? (string-append top-dir "/" elt) R_OK))) body)))) ,@(map (lambda (elt) (project-list->table - (string-append top-dir (car elt)) elt (1+ lvl))) + (string-append top-dir (car elt)) elt (1+ lvl) + (string-append prefix (car elt)))) (filter (lambda (elt) (and (list? elt) @@ -76,5 +81,5 @@ body))))) (define (page-projects request body index) - (respond (project-list->table *projects-dir* (list-projects) 1) + (respond (project-list->table *projects-dir* (list-projects) 1 "") #:extra-headers '((pragma . (no-cache (broccoli . "tastyy")))))) |