Browse Source

added

master
Ralph Rönnquist 2 years ago
parent
commit
a904a98315
  1. 38
      hobby-http.lsp
  2. 86
      humancss.lsp

38
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)

86
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)
Loading…
Cancel
Save