aliens/tekuti
1
0
Fork 0
Code Activity

Add per-project pages

Browse source 
Pages include summary, refs, log, tree, commit, diff, stats and about;
Just like cgit.
This commit is contained in:
Tom Willemsen 2012-09-19 22:57:27 +02:00
parent 3b8eba0f0a
commit 4ad0c3969c
2 changed files with 35 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
tekuti/projects.scm
View file

@ -1,15 +1,15 @@
(define-module (tekuti projects) (define-module (tekuti projects)
#:use-module ((tekuti config) #:select (*projects-dir*)) #:use-module ((tekuti config) #:select (*projects-dir*))
#:use-module ((tekuti page) #:select (page-not-found))
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 popen) #:use-module (ice-9 popen)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (tekuti git) #:use-module (tekuti git)
#:use-module (tekuti page-helpers) #:use-module (tekuti page-helpers)
#:export (page-projects)) #:use-module (web uri)
#:use-module (web request)
(use-modules (ice-9 ftw) #:export (page-projects page-project))
(ice-9 match))
(define remove-stat (define remove-stat
(match-lambda (match-lambda
@ -40,13 +40,16 @@
(substring str 0 pos) (substring str 0 pos)
str))) str)))
(define (project-url prefix name)
(uri-encode
(string-append prefix (if (string-null? prefix) "" "/") name)))
(define (project->row dir project prefix) (define (project->row dir project prefix)
(let ((project-dir (string-append dir "/" project)) (let ((project-dir (string-append dir "/" project))
(project-name (remove-suffix project ".git"))) (project-name (remove-suffix project ".git")))
`(tr `(tr
(td (@ (class "span3")) (td (@ (class "span3"))
(a (@ (href "http://code.ryuslash.org/cgit.cgi/" (a (@ (href ,(project-url prefix project-name)))
,prefix "/" ,project-name))
,project-name)) ,project-name))
(td (@ (class "span6")) ,(project-description project-dir)) (td (@ (class "span6")) ,(project-description project-dir))
(td (@ (class "span2")) ,(git-last-update project-dir)) (td (@ (class "span2")) ,(git-last-update project-dir))
@ -83,3 +86,28 @@
(define (page-projects request body index) (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")))))) #: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)))

1
tekuti/web.scm
View file

@ -61,6 +61,7 @@
((GET tags tag!) page-show-tag) ((GET tags tag!) page-show-tag)
((GET debug) page-debug) ((GET debug) page-debug)
((GET projects) page-projects) ((GET projects) page-projects)
((GET projects project! page?) page-project)
(else page-not-found))) (else page-not-found)))
(define (cache-ref index request) (define (cache-ref index request)