Improvements to git repo browser.

[scratchy.git] / examples / git.scm

diff --git a/examples/git.scm b/examples/git.scm
deleted file mode 100644 (file)
index 3b64ff9..0000000
--- a/examples/git.scm
+++ /dev/null
@@ -1,69 +0,0 @@
-;; Script to browse locally-hosted URLs
-
-(lambda (type-str repo branch path)
-  (import (chicken string)
-          (chicken process)
-          (chicken io)
-          (chicken pathname)
-          srfi-13)
-
-  (define git-base-url "git://GIT-SERVER-URL/")
-  (define git-base-dir "/PATH/TO/GIT/REPOS/")
-
-  (define (git . args)
-    (with-current-working-directory
-     (conc git-base-dir repo)
-     (lambda ()
-       (let-values (((in-port out-port id) (process "git" args)))
-         (let ((result (read-lines in-port)))
-           (close-input-port in-port)
-           (close-output-port out-port)
-           result)))))
-
-  (define (serve-tree)
-    (let ((entries (git "ls-tree" branch path))
-          (references (git "show-ref" "--heads")))
-      (append
-       (list
-        (conc "Git repository for " repo)
-        ""
-        (conc "(Clone from " git-base-url repo ".)")
-        ""
-        "Branches:")
-       (map (lambda (ref)
-              (let ((refname (caddr (string-split ref "/"))))
-                (list
-                 1
-                 (conc (if (equal? branch refname) "*" "")
-                       refname)
-                 (conc "git.scm:tree:" repo ":" refname ":" path))))
-            references)
-       (list ""
-             "Files:")
-       (map (lambda (entry)
-              (let* ((l (string-split entry "\t"))
-                     (type (string->symbol (cadr (string-split (car l) " "))))
-                     (file (cadr l)))
-                (list (if (eq? type 'tree) 1 0)
-                      file
-                      (conc "git.scm:" type ":" repo ":" branch ":"
-                            file
-                            (if (eq? type 'tree) "/" "")))))
-            entries)
-       (list
-        "------"))))
-
-  (define (serve-blob)
-    (for-each
-     (lambda (line)
-       (print line "\r"))
-     (git "cat-file" "blob" (conc branch ":" path)))
-    (print ".\r"))
-
-  (let ((type (string->symbol type-str)))
-    (case type
-      ((tree) (serve-tree))
-      ((blob) (serve-blob))
-      (else
-       (error "Unsupported git object.")))))
-