Merge pull request #3 from ailisp/0.2

css style id and class for builtin elements in hmacro

README.md

@@ -146,10 +146,22 @@ Then just wrap `h` for all html generation part. In the same examples above, it
 
 (defparameter *dog2* (dog :id "dog2" :size 20 "some children"))
 ```
-
+From version 0.2 (available in Aug 2018 Quicklisp), flute supports css style id and class attribute for builtin elements. For example `div#id-name.class1.class2`, So you can also write:
+```lisp
+(h (div#a.b "..."))
+;; Provide additional class and attributes
+(h (div#a.b :class "c" :onclick "fun()"))
+```
 
 That's all you need to know to define elements and generate html. Please reference the [API Reference](#api-reference) Section for detailed API.
 
+# Change Logs
+## 2018/07/28 Version 0.2-dev
+- Support `element#id.class1.class2` in `H` macro for builtin elements;
+- Jon Atack fix an error example in README.
+## 2018/07/11 Version 0.1
+- Current features, APIs and Tests.
+
 # Motivation
 Currently there're a few HTML generation library in Common Lisp, like [CL-WHO](https://edicl.github.io/cl-who/), [CL-MARKUP](https://github.com/arielnetworks/cl-markup) and [Spinneret](https://github.com/ruricolist/spinneret). They both have good features for generating standard HTML, but not very good at user element (components) that currently widely used in frontend: you need to define all of them as macros and to define components on top of these components, you'll have to make these components more complex macros to composite them. [Spinneret](https://github.com/ruricolist/spinneret) has a `deftag` feature, but `deftag` is still expand to a `defmacro`.
 

flute.asd

@@ -1,7 +1,7 @@
 (defsystem flute
   :author "Bo Yao <icerove@gmail.com>"
   :license "MIT"
-  :version "0.1"
+  :version "0.2-dev"
   :components ((:module "src"
                 :serial t
                 :components

src/element-belongs-to.lisp

@@ -0,0 +1,167 @@
+(in-package :flute)
+
+(defparameter *attribute-belongs-to*
+  '((accept	input)
+    (accept-charset	form)
+    (accesskey	*)
+    (action	form)
+    (alt	area img input)
+    (async	script)
+    (autocomplete	form input)
+    (autofocus	button input select textarea)
+    (autoplay	audio video)
+    (charset	meta script)
+    (checked	input)
+    (cite	blockquote del ins q)
+    (class	*)
+    (cols	textarea)
+    (colspan	td th)
+    (content	meta)
+    (contenteditable	*)
+    (controls	audio video)
+    (coords	area)
+    (data	object)
+    (data-*	*)
+    (datetime	del ins time)
+    (default	track)
+    (defer	script)
+    (dir	*)
+    (dirname	input textarea)
+    (disabled	button fieldset input optgroup option select textarea)
+    (download	a area)
+    (draggable	*)
+    (dropzone	*)
+    (enctype	form)
+    (for	label output)
+    (form	button fieldset input label meter object output select textarea)
+    (formaction	button input)
+    (headers	td th)
+    (height	canvas embed iframe img input object video)
+    (hidden	*)
+    (high	meter)
+    (href	a area base link)
+    (hreflang	a area link)
+    (http-equiv	meta)
+    (id	*)
+    (ismap	img)
+    (kind	track)
+    (label	track option optgroup)
+    (lang	*)
+    (list	input)
+    (loop	audio video)
+    (low	meter)
+    (max	input meter progress)
+    (maxlength	input textarea)
+    (media	a area link source style)
+    (method	form)
+    (min	input meter)
+    (multiple	input select)
+    (muted	video audio)
+    (name	button fieldset form iframe input map meta object output param select textarea)
+    (novalidate	form)
+    (onabort	audio embed img object video)
+    (onafterprint	body)
+    (onbeforeprint	body)
+    (onbeforeunload	body)
+    (onblur	All visible elements.)
+    (oncanplay	audio embed object video)
+    (oncanplaythrough	audio video)
+    (onchange	All visible elements.)
+    (onclick	All visible elements.)
+    (oncontextmenu	All visible elements.)
+    (oncopy	All visible elements.)
+    (oncuechange	track)
+    (oncut	+)
+    (ondblclick	+)
+    (ondrag	+)
+    (ondragend	+)
+    (ondragenter	+)
+    (ondragleave	+)
+    (ondragover	+)
+    (ondragstart	+)
+    (ondrop	+)
+    (ondurationchange	audio video)
+    (onemptied	audio video)
+    (onended	audio video)
+    (onerror	audio body embed img object script style video)
+    (onfocus	+)
+    (onhashchange	body)
+    (oninput	+)
+    (oninvalid	+)
+    (onkeydown	+)
+    (onkeypress	+)
+    (onkeyup	+)
+    (onload	body iframe img input link script style)
+    (onloadeddata	audio video)
+    (onloadedmetadata	audio video)
+    (onloadstart	audio video)
+    (onmousedown	+)
+    (onmousemove	+)
+    (onmouseout	+)
+    (onmouseover	+)
+    (onmouseup	+)
+    (onmousewheel	+)
+    (onoffline	body)
+    (ononline	body)
+    (onpagehide	body)
+    (onpageshow	body)
+    (onpaste	+)
+    (onpause	audio video)
+    (onplay	audio video)
+    (onplaying	audio video)
+    (onpopstate	body)
+    (onprogress	audio video)
+    (onratechange	audio video)
+    (onreset	form)
+    (onresize	body)
+    (onscroll	+)
+    (onsearch	input)
+    (onseeked	audio video)
+    (onseeking	audio video)
+    (onselect	+)
+    (onstalled	audio video)
+    (onstorage	body)
+    h(onsubmit	form)
+    (onsuspend	audio video)
+    (ontimeupdate	audio video)
+    (ontoggle	details)
+    (onunload	body)
+    (onvolumechange	audio video)
+    (onwaiting	audio video)
+    (onwheel	+)
+    (open	details)
+    (optimum	meter)
+    (pattern	input)
+    (placeholder	input textarea)
+    (poster	video)
+    (preload	audio video)
+    (readonly	input textarea)
+    (rel	a area link)
+    (required	input select textarea)
+    (reversed	ol)
+    (rows	textarea)
+    (rowspan	td th)
+    (sandbox	iframe)
+    (scope	th)
+    (selected	option)
+    (shape	area)
+    (size	input select)
+    (sizes	img link source)
+    (span	col colgroup)
+    (spellcheck	*)
+    (src	audio embed iframe img input script source track video)
+    (srcdoc	iframe)
+    (srclang	track)
+    (srcset	img source)
+    (start	ol)
+    (step	input)
+    (style	*)
+    (tabindex	*)
+    (target	a area base form)
+    (title	*)
+    (translate	*)
+    (type	button embed input link menu object script source style)
+    (usemap	img object)
+    (value	button input li option meter progress param)
+    (width	canvas embed iframe img input object video)
+    (wrap	textarea)))

src/flute.lisp

@@ -152,12 +152,37 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e.
       (print-object (user-element-expand-to element) stream)
       (call-next-method)))
 
+(defun html-element-p (x)
+  (and (symbolp x) (not (keywordp x)) (gethash (collect-name-as-keyword x) *builtin-elements*)))
+
 (defmacro h (&body body)
   `(progn
      ,@(tree-leaves
         body
-        (and (symbolp x) (not (keywordp x)) (gethash (collect-name-as-keyword x) *builtin-elements*))
+        (html-element-p x)
-        (find-symbol (string (collect-name-as-keyword x)) :flute))))
+        (multiple-value-bind (name id class) (collect-id-and-class x)
+          (if (or id class)
+              (make-!expanded :list (list (find-symbol (string-upcase name) :flute)
+                                          (coerce (append (when id (list :id id))
+                                                          (when class (list :class class)))
+                                                  'vector)))
+              (find-symbol (string-upcase name) :flute))))))
+
+;;; Experimental
+;; (when (find :illusion *features*)
+;;   (illusion:set-paren-reader
+;;    :flute
+;;    #'html-element-p
+;;    (lambda (stream indicator)
+;;      (multiple-value-bind (name id class) (collect-id-and-class indicator)
+;;        (if (or id class)
+;;            (list* (find-symbol (string-upcase name) :flute)
+;;                   (coerce (append (when id (list :id))
+;;                                  (when class (list :class class)))
+;;                           'vector)
+;;                   (illusion:cl-read-list stream))
+;;            (cons (find-symbol (string-upcase name) :flute)
+;;                  (illusion:cl-read-list stream)))))))
 
 (defmethod element-string ((element element))
   (with-output-to-string (s)

src/package.lisp

@@ -12,7 +12,8 @@
                 :mkstr
                 :flatten)
   (:import-from :alexandria
-                :make-keyword)
+                :make-keyword
+                :if-let)
   (:export
    ;;; builtin HTML elements
    ;;; all html5 elements, e.g. div, nav, media, export in code except

src/util.lisp

@@ -10,15 +10,19 @@
                   (cdr kv)))
           alist))
 
+(defstruct !expanded list)
+
 (defun tree-leaves%% (tree test result)
   (if tree
-    (if (listp tree)
+      (if (listp tree)
-      (cons
+          (let ((car-result (tree-leaves%% (car tree) test result))
-        (tree-leaves%% (car tree) test result)
+                (cdr-result (tree-leaves%% (cdr tree) test result)))
-        (tree-leaves%% (cdr tree) test result))
+            (if (!expanded-p car-result)
-      (if (funcall test tree)
+             (append (!expanded-list car-result) cdr-result)
-        (funcall result tree)
+             (cons car-result cdr-result)))
-        tree))))
+          (if (funcall test tree)
+              (funcall result tree)
+              tree))))
 
 (defmacro tree-leaves (tree test result)
   `(tree-leaves%%
@@ -86,6 +90,9 @@
     ((hash-table-p (first attrs-and-children))
      (values (make-attrs :alist (hash-alist (first attrs-and-children)))
              (flatten (rest attrs-and-children))))
+    ((and (vectorp (first attrs-and-children))
+          (keywordp (aref (first attrs-and-children) 0)))
+     (append-inline-attrs attrs-and-children))
     ((keywordp (first attrs-and-children))
      (loop for thing on attrs-and-children by #'cddr
         for (k v) = thing
@@ -97,6 +104,20 @@
     (t
      (values (make-attrs :alist nil) (flatten attrs-and-children)))))
 
+(defun append-inline-attrs (attrs-and-children)
+  (let* ((inline-attrs (coerce (first attrs-and-children) 'list))
+         (id (getf inline-attrs :id))
+         (class (getf inline-attrs :class)))
+    (multiple-value-bind (attrs children)
+        (split-attrs-and-children (rest attrs-and-children))
+      (when (and id (not (attr attrs :id)))
+        (setf (attr attrs :id) id))
+      (when class
+        (if-let (other-class (attr attrs :class))
+          (setf (attr attrs :class) (format nil "~a ~a" class other-class))
+          (setf (attr attrs :class) class)))
+      (values attrs children))))
+
 (defun collect-until-dot-or-sharp (string)
   (let ((pos (position-if (lambda (c) (or (char= c #\.) (char= c #\#))) string)))
     (if pos
@@ -111,13 +132,13 @@
     (do ((current-and-remains (collect-until-dot-or-sharp (string-downcase (string symbol)))
                               (collect-until-dot-or-sharp (cdr current-and-remains))))
         ((string= "" (car current-and-remains))
-         (values name id (format nil "~{~a~^ ~}" (nreverse class))))
+         (values name id (when class (format nil "~{~a~^ ~}" (nreverse class)))))
       (case next-is
         (:id (setf id (car current-and-remains)))
         (:class (push (car current-and-remains) class))
         (otherwise (setf name (car current-and-remains))))
       (unless (string= "" (cdr current-and-remains))
         (setf next-is (ecase (aref (cdr current-and-remains) 0)
-                        (#\. :id)
+                        (#\# :id)
-                        (#\# :class))
+                        (#\. :class))
               (cdr current-and-remains) (subseq (cdr current-and-remains) 1))))))

t/flute.lisp

@@ -371,6 +371,22 @@
 </div>"
          (element-string
           (h (duck :id 5 :color "blue"
-                   (img :href "duck.png"))))))))
+                   (img :href "duck.png"))))))
+    (is (string=
+         "<div class=\"class1 class2\" id=\"has-id\">child</div>"
+         (element-string
+          (h (div#has-id.class1.class2 "child")))))
+    (is (string=
+         "<div class=\"class1 class2\" id=\"has-id\" onclick=\"func()\">child</div>"
+         (element-string
+          (h (div#has-id.class1.class2 :onclick "func()" "child")))))
+    (is (string=
+         "<div class=\"class1 class2\" id=\"has-id\" onclick=\"func()\">child</div>"
+         (element-string
+          (h (div#has-id.class1.class2 '(:onclick "func()") "child")))))
+    (is (string=
+         "<div id=\"has-id\" class=\"class1 class2 additional-class\">child</div>"
+         (element-string
+          (h (div.class1#has-id.class2 ':class "additional-class" "child")))))))
 
 (run-all-tests)