--- /dev/null
+#!/usr/local/bin/newlisp
+#
+# Simple HTTP service for a directory tree. Start with:
+#
+# newlisp hobby-http.lsp -c -d $PORT -w $TREE
+#
+
+; Exit on ^C -- not cleanly
+(signal 2 (fn (x) (write-line 2 "Exiting") (close 3) (exit 0)))
+
+; Resolve the root path
+(constant 'HERE (real-path ((match '(* "-w" ? *) (main-args)) 1)))
+
+; Map absolute path
+(define (actual PATH)
+ (if (starts-with PATH "/") (string HERE PATH) PATH))
+
+; Rewriting rules: add ".html" or "/index.html" to request path where
+; that results in an actual file.
+(define (maybe-html PATH)
+ (let ((P0 (actual PATH)) (HTML nil))
+ (if (find ".." PATH) PATH
+ true
+ (if (file? (string P0 ".html")) (string PATH ".html")
+ (file? (string P0 "/index.html"))
+ (string PATH (if (ends-with PATH "/") "" "/") "index.html")
+ PATH )
+ PATH )))
+
+; Apply rewriting rules for some requests
+(define (tag-on-html X)
+ (write-line 2 (string "> " X ))
+ (let ((C (if (and (string? X) (regex "^GET ([^ ]+) (.+)" X 0))
+ (format "GET %s %s\r\n" (maybe-html $1) $2) X)))
+ (write-line 2 (string "< " C))
+ C))
+
+(command-event tag-on-html)
--- /dev/null
+#!/usr/local/bin/newlisp
+#
+# Stream filter that reads css and writes it out, stylished. run with
+#
+# newlisp humancss.lsp < bad.css > good.css
+#
+# Not actually pretty-printing, but merely adding indentation and newlines.
+
+;(signal 2 (fn (x) (exit 0)))
+
+(setf IN '())
+
+;; Load the CSS file as an array of single-character strings
+(while (setf LINE (read-line)) (extend IN (explode LINE) '("\n")))
+(setf IN (array (length IN) IN)) ; This should speed of indexed access
+(setf LAST (- (length IN) 1))
+
+;; Coalsce comments and strings into units
+(define (coalesce START END) ; exclusive
+ (when (< END (length IN))
+ (setf (IN START) (join (array-list (START (- END START) IN))))
+ (while (< (inc START) END) (setf (IN START) ""))))
+
+(define (coalesce-block-comment i)
+ (let ((STAR nil) (END nil))
+ (for (j (+ 2 i) LAST 1 END)
+ (if STAR (if (= "/" (IN j)) (setf END j) (setf STAR nil))
+ (= "*" (IN j)) (setf STAR true)))
+ (when END (coalesce i (+ 1 END)))))
+
+(define (coalesce-line-comment i)
+ (let ((END (find "\n" IN nil i)))
+ (when END (coalesce i (+ 1 END)))))
+
+(define (index-of-any OPTS START)
+ (if (> START LAST) nil
+ (if (find OPTS (START IN) (fn (X Y) (member Y X))) (+ START $it))))
+
+(define (coalesce-string i) ; (IN i) is the string character
+ (let ((END nil))
+ (for (j (+ 1 i) LAST 1 END)
+ (if (= "\\" (IN j)) (coalesce j (+ 2 j))
+ (= (IN i) (IN j)) (setf END (+ 1 j))))
+ (when END (coalesce i END))))
+
+; Coalesce comments, meta-quotes and strings
+(let ((SLASH nil))
+ (for (i 0 LAST)
+ (if (= "\\" (IN i)) (begin (coalesce i (+ 2 i)) (setf SLASH nil))
+ SLASH (begin (case (IN i)
+ ("*" (coalesce-block-comment (- i 1)))
+ ("/" (coalesce-line-comment (- i 1)))
+ (true nil))
+ (setf SLASH nil))
+ (= "/" (IN i)) (setf SLASH true)
+ (= "\"" (IN i)) (coalesce-string i)
+ (= "'" (IN i)) (coalesce-string i)
+ )))
+
+(define (indent TXT n)
+ (join (clean empty? (parse TXT "\n")) (string "\n" (dup " " n))))
+
+; Coalesce blocks recursively, adding a newline to it
+(define (coalesce-block i (DEPTH 0))
+ ;(write-line 2 (string "block level " DEPTH " from " i))
+ (let ((j 0) (END nil))
+ (for (j (+ 1 i) LAST 1 END)
+ (case (IN j)
+ ("{" (coalesce-block j (+ 1 DEPTH)))
+ ("}" (setf END j))
+ (true nil)))
+ (when END
+ (setf (IN i) " {\n")
+ (coalesce i END)
+ (setf (IN i) (indent (IN i) DEPTH))
+ (extend (IN i) (if (ends-with (IN i) "\n") "}\n" "\n}\n"))
+ (setf (IN END) "")
+ )))
+
+(for (i 0 LAST) (when (= ";" (IN i)) (setf (IN i) ";\n")))
+
+(for (i 0 LAST) (when (= "{" (IN i)) (coalesce-block i 1)))
+
+(write 1 (join (array-list IN)))
+
+(exit 0)