1 ;; Script to browse locally-hosted URLs
3 (lambda (type-str repo branch path)
4 (import (chicken string)
10 (define git-base-url "git://GIT-SERVER-URL/")
11 (define git-base-dir "/PATH/TO/GIT/REPOS/")
14 (with-current-working-directory
15 (conc git-base-dir repo)
17 (let-values (((in-port out-port id) (process "git" args)))
18 (let ((result (read-lines in-port)))
19 (close-input-port in-port)
20 (close-output-port out-port)
24 (let ((entries (git "ls-tree" branch path))
25 (references (git "show-ref" "--heads")))
28 (conc "Git repository for " repo)
30 (conc "(Clone from " git-base-url repo ".)")
34 (let ((refname (caddr (string-split ref "/"))))
37 (conc (if (equal? branch refname) "*" "")
39 (conc "git.scm:tree:" repo ":" refname ":" path))))
44 (let* ((l (string-split entry "\t"))
45 (type (string->symbol (cadr (string-split (car l) " "))))
47 (list (if (eq? type 'tree) 1 0)
49 (conc "git.scm:" type ":" repo ":" branch ":"
51 (if (eq? type 'tree) "/" "")))))
60 (git "cat-file" "blob" (conc branch ":" path)))
63 (let ((type (string->symbol type-str)))
68 (error "Unsupported git object.")))))