commit c1b8f76a1a6c12fb3b03eeb196f254c51dcabfec Author: gnat Date: Mon Aug 26 21:40:45 2024 -0700 initial diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..4fe4bf7 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +out/* +src/* +templates/* +files +scripts diff --git a/exec.lisp b/exec.lisp new file mode 100644 index 0000000..2da3611 --- /dev/null +++ b/exec.lisp @@ -0,0 +1,14 @@ +(defun exec-command (command &key (env-vars nil)) + (let* ((default-env '(("PATH" . "\"$PATH:./scripts\""))) + (combined-env (append default-env env-vars)) + (full-command (format nil "~{~a=~a~} ; ~a" + (mapcan (lambda (kv) (list (car kv) (cdr kv))) + combined-env) + command))) + (with-open-stream (output-stream + (ext:run-program "/bin/sh" :arguments (list "-c" full-command) + :output :stream)) + (with-output-to-string (result) + (loop for line = (read-line output-stream nil nil) + while line do (format result "~a~%" line)))))) + diff --git a/gen.lisp b/gen.lisp new file mode 100644 index 0000000..4e67d1d --- /dev/null +++ b/gen.lisp @@ -0,0 +1,47 @@ +(load "~/quicklisp/setup.lisp") + +(load "html.lisp") +(load "exec.lisp") +(load "templates/page.lsp") + +(ql:quickload "uiop") + +(defparameter *src-files* nil) + +(uiop:collect-sub*directories "src/" t t (lambda (x) (push x *src-files*))) + +(print *src-files*) + +(defun create-directories-iteratively (path) + (let* ((directories (pathname-directory (pathname path))) + (accumulated-path (make-pathname :directory nil))) + (dolist (dir directories) + (setq accumulated-path (make-pathname :directory (append (pathname-directory accumulated-path) (list dir)))) + (ignore-errors + (make-directory accumulated-path))))) + +(defun write-to-file (content path) + (create-directories-iteratively path) + (with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create) + (write-string content stream))) + +(defun replace-substring (original-string old-substring new-substring) + (let ((start (search old-substring original-string))) + (if start + (let* ((end (+ start (length old-substring))) + (before (subseq original-string 0 start)) + (after (subseq original-string end))) + (concatenate 'string before new-substring after)) + original-string))) + +(defun build (file) + (load file) + (write-to-file (html->string (html)) (replace-substring (replace-substring (format nil "~a" file) (format nil "~asrc" (ext:cd)) "./out") ".lisp" ".html"))) + +(defun build-dir (directory) + (let ((lisp-files (uiop:directory-files directory))) + (dolist (file lisp-files) + (build file)))) + +(dolist (dir *src-files*) + (build-dir dir)) diff --git a/html.lisp b/html.lisp new file mode 100644 index 0000000..a1e00c4 --- /dev/null +++ b/html.lisp @@ -0,0 +1,86 @@ +;; Copyright (c) 2020 Mark Polyakov +;; Released under the WTFPL (Do What The Fuck You Want To Public License) + +;; https://gist.github.com/markasoftware/ab357f1b967b3f656d026e33fec3bc0e + +(defvar *html-void-tags* '(:area :base :br :col :embed :hr :img :input :link + :meta :param :source :track :wbr) + "String designators for self-closing/void tags. +https://html.spec.whatwg.org/multipage/syntax.html#void-elements") + +(defvar *html-escapes* + '()) + +(defun escape (str) + (declare (string str)) + (with-output-to-string (stream) + (loop for ch across str + for escaped = (getf *html-escapes* ch) + do (if escaped + (write-string escaped stream) + (write-char ch stream))))) + +(defun html->string (html) + "The argument should be of the form (tag-name (attr-name attr-val) child1 +child2 ...). Attributes and children are optional. + + (html->string + '(html () + (head () + (title () \"My awesome website!\")) + (body () + \"Hello! I'm Mark.\" + ;; No attributes or children: + (br) + (a (href \"https://github.com/markasoftware\") \"My stuff\") + (br) + ;; No children: + (img (src \"/cats.jpg\" alt \"My cute cats!\"))))) + +Since the argument must be quoted, you can use backquote notation to interleave +html and lisp: + + `(div () + \"My name is \" + ,*my-name* + \", But you can call me:\" + (br) + (ul () + ,@(mapcar (lambda (name) `(li () ,name)) *my-nicknames*))) + +All text and attribute values are escaped properly. You can use keyword symbols for tag and +attribute names if you'd like. There's a hardcoded list of self-closing tags, such as br and img. + +Unescaped HTML can be inserted as a string using (:noescape \"
\"), for example. This is the +only time the second argument may be a string, so :noescape can still be used to designate +." + (etypecase html + (null "") + (string (escape html)) + (number (write-to-string html)) + (cons + (cond + ;; if html is not a valid html element, assume it's a list of html elements and recurse + ((or (null (car html)) + (not (symbolp (car html)))) + (apply #'concatenate 'string (mapcar #'html->string html))) + ((and (eq :noescape (car html)) + (stringp (cadr html))) + (cadr html)) + (t (destructuring-bind + ;; the &key business forces an even number of arguments. + (tag &optional ((&rest attrs &key &allow-other-keys)) &rest body) + html + (check-type tag symbol) + ;; printf is a child's toy. Honestly, regex might be too! + (format nil "<~A~:{ ~A=\"~A\"~}~:[/>~;>~A~]" + (string-downcase tag) + (loop for (attr-name attr-val) on attrs by #'cddr + collect + (list (string-downcase attr-name) + (escape (etypecase attr-val + ((or string symbol) (string attr-val)) + (number (write-to-string attr-val)))))) + (not (member tag *html-void-tags* :test #'string=)) + (apply #'concatenate 'string (mapcar #'html->string body)) + (string-downcase tag)))))))) diff --git a/readme.md b/readme.md new file mode 100644 index 0000000..e6c9a26 --- /dev/null +++ b/readme.md @@ -0,0 +1,38 @@ +# htmlgen +tool for generating html from lisp code. +used for natalieee.net. +built around https://gist.github.com/markasoftware/ab357f1b967b3f656d026e33fec3bc0e + +## useage +templates/: used for templates +src/: documents in lisp +out/: where html will be written + +to compile, run `{clisp,sbcl} gen.lisp` + +## example +templates/page.lisp for natalieee.net +```lisp +(load "./templates/header.lsp") +(load "./templates/footer.lsp") + +(defun page (title html) + `(html (:lang "en") + (head () + (meta (:http-equiv "content-type" :content "text/html; charset=utf-8")) + (meta (:name "viewport" :content "width=device-width, initial-scale=1")) + (link (:rel "stylesheet" :href "/style.css")) + (title () ,title)) + (body () + ,(header) + (main () + ,html) + ,(footer)))) +``` + +example page: +```lisp +; this would have a path of src/example.lisp or similar +(defun html () + (page "example" '(h1 () "example"))) +```