diff options
| -rw-r--r-- | shtml.lisp | 269 |
1 files changed, 149 insertions, 120 deletions
@@ -4,11 +4,6 @@ (loop :for (i . j) :in lst :when j :append (list i j))) -(eval-when - (:compile-toplevel) - (defun downcase-name (s) - (string-downcase (symbol-name s)))) - (defun separate-keys (lst) (let (keys body) (loop :while lst @@ -20,125 +15,159 @@ :do (push (pop lst) body)) (cons (cons 'list (reverse body)) (reverse keys)))) -(defmacro define-html (tag &key single attrs) +(eval-when + (:compile-toplevel) + (defun downcase-name (s) + (string-downcase (symbol-name s))) + + (defvar *global-attributes* + (list 'style 'lang 'id 'class 'title 'hidden))) + +(defmacro define-singleton-tag (tag &rest attrs) + (let* ((attrs (append *global-attributes* attrs)) + (tag-name (downcase-name tag)) + (attrs-and-values (cons 'list + (mapcar (lambda (attr) + (list 'cons (downcase-name attr) attr)) + attrs)))) + `(defun ,tag (&key ,@attrs) + (format nil "<~a ~{~a=~s~^ ~}>" + ,tag-name + (trim-flatten-assoc ,attrs-and-values))))) + +(defmacro define-tag (tag &rest attrs) (let* ((args (gensym)) - (attrs (append (list 'style 'lang 'id 'class 'title 'hidden) attrs)) + (attrs (append *global-attributes* 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~^ ~}</~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)))))) + `(defmacro ,tag (&rest ,args) + (let ((body (gensym)) + (parsed-args (separate-keys ,args))) + `((lambda (,body &key ,@',attrs) + (format nil "<~a~{ ~a=~s~}>~{~a~^ ~}</~a>" + ,,tag-name + (trim-flatten-assoc ,',attrs-and-values) + ,body + ,,tag-name)) ,@parsed-args))))) + +(defmacro define-html-tag () + (let* ((args (gensym)) + (attrs (cons 'xmlns *global-attributes*)) + (tag-name "html") + (attrs-and-values (cons 'list + (mapcar (lambda (attr) + (list 'cons (downcase-name attr) attr)) + attrs)))) + `(defmacro html (&rest ,args) + (let ((body (gensym)) + (parsed-args (separate-keys ,args))) + `((lambda (,body &key ,@',attrs) + (format nil "<!DOCTYPE html><~a~{ ~a=~s~}>~{~a~^ ~}</~a>" + ,,tag-name + (trim-flatten-assoc ,',attrs-and-values) + ,body + ,,tag-name)) ,@parsed-args))))) + +(define-html-tag) -(define-html a :attrs (download href hreflang media ping referrerpolicy rel target type)) -(define-html abbr) -(define-html address) -(define-html area :attrs (alt coords download href hreflang media referrerpolicy rel shape target type) :single t) -(define-html article) -(define-html aside) -(define-html audio :attrs (autoplay controls loop muted preload src)) -(define-html b) -(define-html base :attrs (href target) :single t) -(define-html blockquote :attrs (cite)) -(define-html body) -(define-html br :single t) -(define-html button :attrs (autofocus disabled form formaction formenctype formmethod formnovalidate formtarget name type value)) -(define-html canvas :attrs (height width)) -(define-html caption) -(define-html cite) -(define-html code) -(define-html col :attrs (span) :single t) -(define-html colgroup :attrs (span)) -(define-html data :attrs (value)) -(define-html datalist) -(define-html dd) -(define-html del :attrs (cite datetime)) -(define-html details :attrs (open)) -(define-html div) -(define-html dl) -(define-html dt) -(define-html em) -(define-html embed :attrs (height src type width) :single t) -(define-html fieldset :attrs (disabled form name)) -(define-html figcaption) -(define-html figure) -(define-html footer) -(define-html form :attrs (accept-charset action autocomplete enctype method name novalidate rel target)) -(define-html h1) -(define-html h2) -(define-html h3) -(define-html h4) -(define-html h5) -(define-html h6) -(define-html head) -(define-html head) -(define-html header) -(define-html hr :single t) -(define-html html :attrs (xmlns)) -(define-html i) -(define-html img :attrs (alt crossorigin height ismap loading longdesc referrerpolicy sizes src srcset usemap width) :single t) -(define-html input :attrs (accept alt autocomplete autofocus checked dirname disabled form formaction formenctype formmethod formnovalidate formtarget height list max maxlength min minlength multiple name pattern placeholder readonly required size src step type value width) :single t) -(define-html ins :attrs (cite datetime)) -(define-html label :attrs (for form)) -(define-html legend) -(define-html li :attrs (value)) -(define-html link :attrs (crossorigin href hreflang media referrerpolicy rel sizes type) :single t) -(define-html main) -(define-html mark) -(define-html meta :attrs (charset content http_equiv name) :single t) -(define-html nav) -(define-html noscript) -(define-html object :attrs (data form height name type usemap width)) -(define-html ol :attrs (refersed start type)) -(define-html optgroup :attrs (disabled label)) -(define-html option :attrs (disabled label selected value)) -(define-html output :attrs (for form name)) -(define-html p) -(define-html param :attrs (name value) :single t) -(define-html picture) -(define-html pre) -(define-html progress :attrs (max value)) -(define-html q :attrs (cite)) -(define-html s) -(define-html samp) -(define-html script :attrs (async crossorigin defer integrity nomodule referrerpolicy src type)) -(define-html section) -(define-html select :attrs (autofocus disabled form multiple name requred size)) -(define-html small) -(define-html source :attrs (media sizes src srcset type) :single t) -(define-html span) -(define-html strong) -(define-html style :attrs (media type)) -(define-html sub) -(define-html summary) -(define-html sup) -(define-html svg) -(define-html table) -(define-html tbody) -(define-html td :attrs (colspan headers rowspan)) -(define-html template) -(define-html textarea :attrs (autocomplete autofocus cols dirname disabled form maxlength minlength name placeholder readonly required rows spellcheck wrap)) -(define-html tfoot) -(define-html th :attrs (abbr colspan headers rowspan scope)) -(define-html thead) -(define-html title) -(define-html tr) -(define-html track :attrs (default kind label src srclang) :single t) -(define-html u) -(define-html ul) -(define-html var) -(define-html video :attrs (autoplay controls height loop muted poster preload src width)) -(define-html wbr :single t) +(define-tag a download href hreflang media ping referrerpolicy rel target type) +(define-tag abbr) +(define-tag address) +(define-singleton-tag area alt coords download href hreflang media referrerpolicy rel shape target type) +(define-tag article) +(define-tag aside) +(define-tag audio autoplay controls loop muted preload src) +(define-tag b) +(define-singleton-tag base href target) +(define-tag blockquote cite) +(define-tag body) +(define-singleton-tag br) +(define-tag button autofocus disabled form formaction formenctype formmethod formnovalidate formtarget name type value) +(define-tag canvas height width) +(define-tag caption) +(define-tag cite) +(define-tag code) +(define-singleton-tag col span) +(define-tag colgroup span) +(define-tag data value) +(define-tag datalist) +(define-tag dd) +(define-tag del cite datetime) +(define-tag details open) +(define-tag div) +(define-tag dl) +(define-tag dt) +(define-tag em) +(define-singleton-tag embed height src type width) +(define-tag fieldset disabled form name) +(define-tag figcaption) +(define-tag figure) +(define-tag footer) +(define-tag form accept-charset action autocomplete enctype method name novalidate rel target) +(define-tag h1) +(define-tag h2) +(define-tag h3) +(define-tag h4) +(define-tag h5) +(define-tag h6) +(define-tag head) +(define-tag head) +(define-tag header) +(define-singleton-tag hr) +(define-tag i) +(define-singleton-tag img alt crossorigin height ismap loading longdesc referrerpolicy sizes src srcset usemap width) +(define-singleton-tag input accept alt autocomplete autofocus checked dirname disabled form formaction formenctype formmethod formnovalidate formtarget height list max maxlength min minlength multiple name pattern placeholder readonly required size src step type value width) +(define-tag ins cite datetime) +(define-tag label for form) +(define-tag legend) +(define-tag li value) +(define-singleton-tag link crossorigin href hreflang media referrerpolicy rel sizes type) +(define-tag main) +(define-tag mark) +(define-singleton-tag meta charset content http_equiv name) +(define-tag nav) +(define-tag noscript) +(define-tag object data form height name type usemap width) +(define-tag ol refersed start type) +(define-tag optgroup disabled label) +(define-tag option disabled label selected value) +(define-tag output for form name) +(define-tag p) +(define-singleton-tag param name value) +(define-tag picture) +(define-tag pre) +(define-tag progress max value) +(define-tag q cite) +(define-tag s) +(define-tag samp) +(define-tag script async crossorigin defer integrity nomodule referrerpolicy src type) +(define-tag section) +(define-tag select autofocus disabled form multiple name requred size) +(define-tag small) +(define-singleton-tag source media sizes src srcset type) +(define-tag span) +(define-tag strong) +(define-tag style media type) +(define-tag sub) +(define-tag summary) +(define-tag sup) +(define-tag svg) +(define-tag table) +(define-tag tbody) +(define-tag td colspan headers rowspan) +(define-tag template) +(define-tag textarea autocomplete autofocus cols dirname disabled form maxlength minlength name placeholder readonly required rows spellcheck wrap) +(define-tag tfoot) +(define-tag th abbr colspan headers rowspan scope) +(define-tag thead) +(define-tag title) +(define-tag tr) +(define-singleton-tag track default kind label src srclang) +(define-tag u) +(define-tag ul) +(define-tag var) +(define-tag video autoplay controls height loop muted poster preload src width) +(define-singleton-tag wbr) |