(in-package #:shtml) (defun trim-flatten-assoc (lst) (loop :for (i . j) :in lst :when j :append (list i j))) (defun downcase-name (s) (string-downcase (symbol-name s))) (defun separate-keys (lst) (let (keys body) (loop :while lst :if (keywordp (car lst)) :do (progn (push (pop lst) keys) (push (pop lst) keys)) :else :do (push (pop lst) body)) (cons (cons 'list (reverse body)) (reverse keys)))) (defmacro define-html (tag &key single attrs) (let* ((args (gensym)) (attrs (append (list 'id 'class) attrs)) (tag-name (downcase-name tag)) (attrs-and-values (cons 'list (mapcar (lambda (attr) (list 'cons (downcase-name attr) attr)) attrs)))) (if (eq single nil) `(defmacro ,tag (&rest ,args) (let ((body (gensym)) (parsed-args (separate-keys ,args))) `((lambda (,body &key ,@',attrs) (format nil "<~a~{ ~a=~s~}>~{~a~^ ~}" ,,tag-name (trim-flatten-assoc ,',attrs-and-values) ,body ,,tag-name)) ,@parsed-args))) `(defun ,tag (&key ,@attrs) (format nil "<~a ~{~a=~s~^ ~}>" ,tag-name (trim-flatten-assoc ,attrs-and-values))))))