first commit main

6 files changed, 69 insertions, 0 deletions

@@ -0,0 +1,4 @@
+;;; Directory Local Variables            -*- no-byte-compile: t -*-
+;;; For more information see (info "(emacs) Directory Variables")
+
+((scheme-mode . ((geiser-scheme-implementation . chicken))))
@@ -0,0 +1,10 @@
+boudin
+*.inline
+*.link
+*.so
+*.o
+*.import.scm
+*.types
+*.build.sh
+*.install.sh
+test/out/
\ No newline at end of file
@@ -0,0 +1,10 @@
+((synopsis "cock server")
+ (author "Case Duckworth")
+ (license "God Willing")
+ (version 0.0.0)
+ (components
+  (program cock
+           (source cock.scm))
+  (extension cock-mod
+             (source cock.mod.scm)
+             (install-name cock))))
@@ -0,0 +1,24 @@
+(module cock (serve)
+
+  (import (scheme)
+          (chicken base)
+          (chicken process signal)
+          (spiffy)
+          (utf8))
+
+  (define (eprint . xs)
+    (for-each (lambda (x) (display x (current-error-port)))
+              xs)
+    (newline (current-error-port)))
+
+  (define (serve root port)
+    (set-signal-handler! signal/int
+                         (lambda _
+                           (eprint "stopping server")
+                           (exit)))
+    (eprint "Starting web server in " root "...")
+    (eprint "Served at http://localhost:" port)
+    (eprint "[Ctrl-c to stop]")
+    (parameterize ((server-port port)
+                   (root-path root))
+      (start-server))))
@@ -0,0 +1,21 @@
+(import (cock)
+        (chicken process-context))
+
+(define (main args)
+  (define root (current-directory))
+  (define port 8000)
+  (let loop ((args args))
+    (cond
+     ((null? args) (serve root port))
+     ((equal? (car args) "-p")
+      (set! port (cadr args))
+      (loop (cddr args)))
+     (else
+      (set! root (car args))
+      ;; Stop processing arguments
+      (loop '())))))
+
+(cond-expand
+  ((or chicken-script compiling)
+   (main (command-line-arguments)))
+  (else))