The Lambda Lab
/
projects
/
scratchy.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
045c10a
)
Improvements to git browser example.
author
Tim Vaughan
<plugd@thelambdalab.xyz>
Sat, 30 May 2020 15:08:10 +0000
(17:08 +0200)
committer
Tim Vaughan
<plugd@thelambdalab.xyz>
Sat, 30 May 2020 15:08:10 +0000
(17:08 +0200)
examples/browse-git.scm
patch
|
blob
|
history
diff --git
a/examples/browse-git.scm
b/examples/browse-git.scm
index
9edd585
..
d62a002
100644
(file)
--- a/
examples/browse-git.scm
+++ b/
examples/browse-git.scm
@@
-8,7
+8,7
@@
;; A zip archive of the repository can be retrieved using
;; the selector browse-git.scm|REPO||zip.
;;
;; A zip archive of the repository can be retrieved using
;; the selector browse-git.scm|REPO||zip.
;;
-;; You may optionally include a file named
project-
description
+;; You may optionally include a file named description
;; in each repository, which will be displayed at the top
;; of the page when the repository tree is served.
;; in each repository, which will be displayed at the top
;; of the page when the repository tree is served.
@@
-23,7
+23,12
@@
(chicken pathname)
(chicken file)
(chicken port)
(chicken pathname)
(chicken file)
(chicken port)
- srfi-13)
+ srfi-1 srfi-13)
+
+ (define (take-last l n)
+ (if (< (length l) n)
+ l
+ (take-right l n)))
(define git-base-url "git://MY.GIT.SERVER/")
(define git-base-dir "/path/to/git/repositories/")
(define git-base-url "git://MY.GIT.SERVER/")
(define git-base-dir "/path/to/git/repositories/")
@@
-58,18
+63,19
@@
(define (serve-tree)
(let ((entries (git "ls-tree" branch path))
(references (git "show-ref" "--heads"))
(define (serve-tree)
(let ((entries (git "ls-tree" branch path))
(references (git "show-ref" "--heads"))
+ (tags (reverse (take-last (git "show-ref" "--tags") 5)))
(commits (git "rev-list" "--abbrev-commit" "-n5" branch)))
(append
(list (conc "Git repository " git-base-url repo)
"")
(let ((descr-file (make-pathname git-base-dir
(commits (git "rev-list" "--abbrev-commit" "-n5" branch)))
(append
(list (conc "Git repository " git-base-url repo)
"")
(let ((descr-file (make-pathname git-base-dir
- (make-pathname repo "
project-
description"))))
+ (make-pathname repo "description"))))
(if (file-exists? descr-file)
(list "----= Description =----"
(with-input-from-file descr-file read-string)
"")
'()))
(if (file-exists? descr-file)
(list "----= Description =----"
(with-input-from-file descr-file read-string)
"")
'()))
- (list "----
-= Branches =-
----")
+ (list "----
= Branches and Recent Tags=
----")
(map (lambda (ref)
(let ((refname (caddr (string-split ref "/"))))
(list
(map (lambda (ref)
(let ((refname (caddr (string-split ref "/"))))
(list
@@
-77,10
+83,10
@@
(conc (if (equal? branch refname) "*" "")
refname)
(conc "browse-git.scm|" repo "|" refname "|" path "|tree"))))
(conc (if (equal? branch refname) "*" "")
refname)
(conc "browse-git.scm|" repo "|" refname "|" path "|tree"))))
-
references
)
+
(append references tags)
)
(list
""
(list
""
- (conc "----
-= Recent Commits [" branch "] =-
----"))
+ (conc "----
= Recent Commits [" branch "] =
----"))
(map (lambda (commit)
(list
1
(map (lambda (commit)
(list
1
@@
-89,7
+95,7
@@
(conc "browse-git.scm|" repo "|" commit "|" path "|tree")))
commits)
(list ""
(conc "browse-git.scm|" repo "|" commit "|" path "|tree")))
commits)
(list ""
- (conc "----
-= Files [" path "] =-
----"))
+ (conc "----
= Files [" path "] =
----"))
(map (lambda (entry)
(let* ((l (string-split entry "\t"))
(type (string->symbol (cadr (string-split (car l) " "))))
(map (lambda (entry)
(let* ((l (string-split entry "\t"))
(type (string->symbol (cadr (string-split (car l) " "))))