From 5f40dae3f5566a9d4068b32d0615367c66b49b07 Mon Sep 17 00:00:00 2001
From: Tim Vaughan <tgvaughan@gmail.com>
Date: Thu, 30 May 2019 11:07:21 +0200
Subject: [PATCH] Added example scripts.

---
 examples/git.scm            | 69 +++++++++++++++++++++++++++++++++++++
 examples/name.scm           |  7 ++++
 examples/sign-guestbook.scm |  8 +++++
 3 files changed, 84 insertions(+)
 create mode 100644 examples/git.scm
 create mode 100644 examples/name.scm
 create mode 100644 examples/sign-guestbook.scm

diff --git a/examples/git.scm b/examples/git.scm
new file mode 100644
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
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
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!"))
-- 
2.20.1