1 ;; Script to browse locally-hosted URLs
3 (lambda (type-str repo branch path)
4 (import (chicken string)
10 (define git-base-url "git://MY.GIT.SERVER/")
11 (define git-base-dir "/PATH/TO/GIT/REPOS/")
15 (let ((repo-pathname (make-pathname git-base-dir repo)))
16 (if (not (string-prefix? git-base-dir (normalize-pathname repo-pathname)))
17 (error "Invalid git repository."))
18 (with-current-working-directory
21 (let-values (((in-port out-port id) (process "git" args)))
22 (let ((result (read-lines in-port)))
23 (close-input-port in-port)
24 (close-output-port out-port)
28 (let ((entries (git "ls-tree" branch path))
29 (references (git "show-ref" "--heads"))
30 (commits (git "rev-list" "--abbrev-commit" "-n5" branch)))
33 (conc "Git repository " repo)
35 (conc "(Clone from " git-base-url repo ".)")
37 "-----= Branches =-----")
39 (let ((refname (caddr (string-split ref "/"))))
42 (conc (if (equal? branch refname) "*" "")
44 (conc "browse-git.scm|tree|" repo "|" refname "|" path))))
48 (conc "-----= Recent Commits [" branch "] =-----"))
52 (conc (if (equal? branch commit) "*" "")
53 (car (git "show" "-s" "--format=%s (%ar)" commit)))
54 (conc "browse-git.scm|tree|" repo "|" commit "|" path)))
58 (conc "-----= Files [" path "] =-----"))
60 (let* ((l (string-split entry "\t"))
61 (type (string->symbol (cadr (string-split (car l) " "))))
63 (file (conc (pathname-file file-path)
64 (if (pathname-extension file-path)
65 (conc "." (pathname-extension file-path))
67 (list (if (eq? type 'tree) 1 0)
69 (conc "browse-git.scm|" type "|" repo "|" branch "|"
71 (if (eq? type 'tree) "/" "")))))
78 (git "cat-file" "blob" (conc branch ":" path)))
81 (let ((type (string->symbol type-str)))
86 (error "Unsupported git object.")))))