Move my git functions to projects.scm
I have not (yet) set them up in the best way and they're only used there, so keep them there for now.
This commit is contained in:
parent
a24f7703e6
commit
d313e75c28
2 changed files with 41 additions and 40 deletions
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue