diff --git a/README.md b/README.md index 7653d05..ff4c606 100644 --- a/README.md +++ b/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`. diff --git a/flute.asd b/flute.asd index 1086832..a9bfb80 100644 --- a/flute.asd +++ b/flute.asd @@ -1,7 +1,7 @@ (defsystem flute :author "Bo Yao " :license "MIT" - :version "0.1" + :version "0.2-dev" :components ((:module "src" :serial t :components diff --git a/src/element-belongs-to.lisp b/src/element-belongs-to.lisp new file mode 100644 index 0000000..96779c4 --- /dev/null +++ b/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))) diff --git a/src/flute.lisp b/src/flute.lisp index 1f1d517..860519a 100644 --- a/src/flute.lisp +++ b/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*)) - (find-symbol (string (collect-name-as-keyword x)) :flute)))) + (html-element-p x) + (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) diff --git a/src/package.lisp b/src/package.lisp index dc6bed2..6a46763 100644 --- a/src/package.lisp +++ b/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 diff --git a/src/util.lisp b/src/util.lisp index 96ccb8e..b3bf036 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -10,15 +10,19 @@ (cdr kv))) alist)) +(defstruct !expanded list) + (defun tree-leaves%% (tree test result) (if tree - (if (listp tree) - (cons - (tree-leaves%% (car tree) test result) - (tree-leaves%% (cdr tree) test result)) - (if (funcall test tree) - (funcall result tree) - tree)))) + (if (listp tree) + (let ((car-result (tree-leaves%% (car tree) test result)) + (cdr-result (tree-leaves%% (cdr tree) test result))) + (if (!expanded-p car-result) + (append (!expanded-list car-result) cdr-result) + (cons car-result cdr-result))) + (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) - (#\# :class)) + (#\# :id) + (#\. :class)) (cdr current-and-remains) (subseq (cdr current-and-remains) 1)))))) diff --git a/t/flute.lisp b/t/flute.lisp index 17ce834..4257cb7 100644 --- a/t/flute.lisp +++ b/t/flute.lisp @@ -371,6 +371,22 @@ " (element-string (h (duck :id 5 :color "blue" - (img :href "duck.png")))))))) + (img :href "duck.png")))))) + (is (string= + "
child
" + (element-string + (h (div#has-id.class1.class2 "child"))))) + (is (string= + "
child
" + (element-string + (h (div#has-id.class1.class2 :onclick "func()" "child"))))) + (is (string= + "
child
" + (element-string + (h (div#has-id.class1.class2 '(:onclick "func()") "child"))))) + (is (string= + "
child
" + (element-string + (h (div.class1#has-id.class2 ':class "additional-class" "child"))))))) (run-all-tests)