+ (define (serve-tree)
+ (let ((entries (git "ls-tree" branch path))
+ (references (git "show-ref" "--heads")))
+ (append
+ (list (conc "Git repository " git-base-url repo)
+ "")
+ (let ((descr-file (make-pathname git-base-dir
+ (make-pathname repo "project-description"))))
+ (if (file-exists? descr-file)
+ (list "----= Description =----"
+ (with-input-from-file descr-file read-string)
+ "")
+ '()))
+ (list "-----= Branches =-----")
+ (map (lambda (ref)
+ (let ((refname (caddr (string-split ref "/"))))
+ (list
+ 1
+ (conc (if (equal? branch refname) "*" "")
+ refname)
+ (conc "browse-git.scm|" repo "|" refname "|" path "|tree"))))
+ references)
+ (list ""
+ (conc "-----= Files [" path "] =-----"))
+ (map (lambda (entry)
+ (let* ((l (string-split entry "\t"))
+ (type (string->symbol (cadr (string-split (car l) " "))))
+ (file-path (cadr l))
+ (file (conc (pathname-file file-path)
+ (if (pathname-extension file-path)
+ (conc "." (pathname-extension file-path))
+ ""))))
+ (list (if (eq? type 'tree) 1 0)
+ file
+ (conc "browse-git.scm|" repo "|" branch "|"
+ file-path
+ (if (eq? type 'tree) "/" "")
+ "|" type))))
+ entries))))