diff options
-rw-r--r-- | tekuti/git.scm | 32 | ||||
-rw-r--r-- | tekuti/projects.scm | 49 |
2 files changed, 41 insertions, 40 deletions
diff --git a/tekuti/git.scm b/tekuti/git.scm index b17c963..3c9df31 100644 --- a/tekuti/git.scm +++ b/tekuti/git.scm @@ -41,8 +41,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 + git-commit-tree git-rev-list git-revert munge-tree munge-tree1 parse-commit commit-utc-timestamp @@ -192,35 +191,6 @@ (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) - "rev-list" "--pretty=format:%ar" "-n" "1" "HEAD") - #\newline)) - (ret '())) - (if (or (null? lines) - (and (null? (cdr lines)) (string-null? (car lines)))) - ret - (lp (cddr lines) - (cadr lines))))) - (define (git-hash-object contents) (string-trim-both (git* '("hash-object" "-w" "--stdin") #:input contents))) diff --git a/tekuti/projects.scm b/tekuti/projects.scm index bc0d7a6..bca78e2 100644 --- a/tekuti/projects.scm +++ b/tekuti/projects.scm @@ -1,14 +1,16 @@ (define-module (tekuti projects) - #:use-module ((tekuti config) #:select (*projects-dir*)) + #:use-module ((tekuti config) #:select (*projects-dir* *git-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 match-bind) #:use-module (tekuti page-helpers) - #:use-module (web uri) + #:use-module (tekuti util) #:use-module (web request) + #:use-module (web uri) #:export (page-projects page-project)) (define remove-stat @@ -44,6 +46,18 @@ (uri-encode (string-append prefix (if (string-null? prefix) "" "/") name))) +(define* (last-update #:optional (git-dir *git-dir*)) + (let lp ((lines (string-split + (git "--git-dir" (expanduser git-dir) + "rev-list" "--pretty=format:%ar" "-n" "1" "HEAD") + #\newline)) + (ret '())) + (if (or (null? lines) + (and (null? (cdr lines)) (string-null? (car lines)))) + ret + (lp (cddr lines) + (cadr lines))))) + (define (project->row dir project prefix) (let ((project-dir (string-append dir "/" project)) (project-name (remove-suffix project ".git"))) @@ -52,7 +66,7 @@ (a (@ (href ,(project-url prefix project-name))) ,project-name)) (td (@ (class "span6")) ,(project-description project-dir)) - (td (@ (class "span2")) ,(git-last-update project-dir)) + (td (@ (class "span2")) ,(last-update project-dir)) (td (@ (class "span1")) "")))) (define (project-list->table top-dir list lvl prefix) @@ -103,15 +117,32 @@ (string-capitalize elm)))) page-list))))))) -(define* (page-project request body index project page) - (let ((project-dir (string-append *projects-dir* project ".git"))) +(define* (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 (page-project request body index project page) + (let ((project-dir (string-append *projects-dir* project ".git")) + (page (or page "summary"))) (if (file-exists? project-dir) (respond - `(,(project-pages-menu request project (or page "summary")) + `(,(project-pages-menu request project page) (p "Goto: " (a (@ (href "http://code.ryuslash.org/cgit.cgi/" - ,project "/" ,(or page ""))) - "cgit " ,(or page "summary"))) + ,project "/" ,page)) + "cgit " ,page)) ,@(case (string->symbol page) ((summary) `((h2 "Last 10 commits") @@ -126,6 +157,6 @@ (td ,(car elm)) (td ,(cadr elm)) (td ,(caddr elm)))) - (git-latest-commits "HEAD" 10 project-dir))))) + (latest-commits "HEAD" 10 project-dir))))) (else '())))) (page-not-found request body index)))) |