summaryrefslogtreecommitdiff
path: root/shtml.lisp
blob: aeb44003032af72b9b2108072fa71c8e065d4dc0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
(in-package #:shtml)

(defun trim-flatten-assoc (lst)
  (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
          :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 'style 'lang 'id 'class 'title 'hidden) 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))))))

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