From a24f7703e62c64dbcf4eda0964bde318b22f3860 Mon Sep 17 00:00:00 2001 From: Tom Willemsen Date: Thu, 20 Sep 2012 01:10:17 +0200 Subject: Show 10 last commits on summary page --- tekuti/git.scm | 18 ++++++++++++++++++ tekuti/projects.scm | 32 +++++++++++++++++++++++++------- 2 files changed, 43 insertions(+), 7 deletions(-) diff --git a/tekuti/git.scm b/tekuti/git.scm index 0fe3bd4..b17c963 100644 --- a/tekuti/git.scm +++ b/tekuti/git.scm @@ -42,6 +42,7 @@ git git* ensure-git-repo git-ls-tree git-ls-subdirs git-mktree git-rev-parse git-hash-object git-update-ref git-commit-tree git-rev-list git-revert git-last-update + git-latest-commits munge-tree munge-tree1 parse-commit commit-utc-timestamp @@ -191,6 +192,23 @@ (error "bad line2" line2)) (error "bad line1" line1))))))) +(define* (git-latest-commits rev n #:optional (git-dir *git-dir*)) + (let lp ((lines (string-split + (git "--git-dir" (expanduser git-dir) + "rev-list" "--pretty=format:%ar\t%s\t%an" + "-n" (number->string n) rev) #\newline)) + (ret '())) + (if (or (null? lines) + (and (null? (cdr lines)) (string-null? (car lines)))) + (reverse ret) + (lp (cddr lines) + (let ((line (cadr lines))) + (match-bind + "^([^\t]+)\t([^\t]+)\t(.*)$" line (_ sha1 subject author) + (cons `(,sha1 ,subject ,author) ret) + (error "bad line" line))))))) + + (define* (git-last-update #:optional (git-dir *git-dir*)) (let lp ((lines (string-split (git "--git-dir" (expanduser git-dir) diff --git a/tekuti/projects.scm b/tekuti/projects.scm index 773ff56..bc0d7a6 100644 --- a/tekuti/projects.scm +++ b/tekuti/projects.scm @@ -104,10 +104,28 @@ 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))) + (let ((project-dir (string-append *projects-dir* project ".git"))) + (if (file-exists? project-dir) + (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"))) + ,@(case (string->symbol page) + ((summary) + `((h2 "Last 10 commits") + (table + (@ (class "table table-condensed table-striped")) + (tr + (th "Time") + (th "Subject") + (th "Author")) + ,@(map (lambda (elm) + `(tr + (td ,(car elm)) + (td ,(cadr elm)) + (td ,(caddr elm)))) + (git-latest-commits "HEAD" 10 project-dir))))) + (else '())))) + (page-not-found request body index)))) -- cgit v1.2.3-54-g00ecf