From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
Date: Thu, 7 May 2020 04:02:11 +0000 (+1000)
Subject: added
X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=a904a9831583a57edf8cb233e4f7d653816f2fde;p=rrq%2Fnewlisp-ftw.git

added
---

diff --git a/hobby-http.lsp b/hobby-http.lsp
new file mode 100755
index 0000000..3b6be62
--- /dev/null
+++ b/hobby-http.lsp
@@ -0,0 +1,38 @@
+#!/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)
diff --git a/humancss.lsp b/humancss.lsp
new file mode 100755
index 0000000..e17bff5
--- /dev/null
+++ b/humancss.lsp
@@ -0,0 +1,86 @@
+#!/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)