Added example scripts.

diff --git a/examples/git.scm b/examples/git.scm
new file mode 100644 (file)
index 0000000..3b64ff9
--- /dev/null
+++ b/examples/git.scm
@@ -0,0 +1,69 @@
+;; 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.")))))
+                                    

diff --git a/examples/name.scm b/examples/name.scm
new file mode 100644 (file)
index 0000000..f99640e
--- /dev/null
+++ b/examples/name.scm
@@ -0,0 +1,7 @@
+;; Query function that simply returns a greeting.
+
+(lambda (arg)
+  (import (chicken string))
+
+  (list
+   (conc "Hello, " arg ", nice to meet you!")))

diff --git a/examples/sign-guestbook.scm b/examples/sign-guestbook.scm
new file mode 100644 (file)
index 0000000..6a91bbf
--- /dev/null
+++ b/examples/sign-guestbook.scm
@@ -0,0 +1,8 @@
+;; Very simple guestbook
+
+(lambda (arg)
+  (with-output-to-file "guestbook_entries.txt"
+    (lambda ()
+      (print arg))
+    #:append)
+  (list "Thanks for signing my guestbook!"))