diff --git a/system-test.asd b/flute-test.asd similarity index 87% rename from system-test.asd rename to flute-test.asd index 04a93bc..957c3d4 100644 --- a/system-test.asd +++ b/flute-test.asd @@ -1,7 +1,7 @@ (defsystem flute-test :author "Your Name " :license "Specify license here" - :depends-on (:flute) + :depends-on (:flute :fiveam) :components ((:module "t" :serial t :components diff --git a/src/flute.lisp b/src/flute.lisp index b539778..780b898 100644 --- a/src/flute.lisp +++ b/src/flute.lisp @@ -44,7 +44,7 @@ If NIL, nothing is escaped and programmer is responsible to escape elements prop When given :ASCII and :ATTR, it's possible to insert html text as a children, e.g. (div :id \"container\" \"Some text\")") -(defun make-attrs (&keys alist) +(defun make-attrs (&key alist) (if *escape-html* (%make-attrs :alist (escape-attrs-alist alist)) (%make-attrs :alist alist))) @@ -67,30 +67,6 @@ When given :ASCII and :ATTR, it's possible to insert html text as a children, e. (defmethod attr ((element element) key) (attr (element-attrs element))) -(defun split-attrs-and-children (attrs-and-children) - (cond - ((attrs-p (first attrs-and-children)) - (values (first attrs-and-children) (flatten (rest attrs-and-children)))) - ((alistp (first attrs-and-children)) - (values (make-attrs :alist (first attrs-and-children)) - (flatten (rest attrs-and-children)))) - ((listp (first attrs-and-children)) - (values (make-attrs :alist (plist-alist (first attrs-and-children))) - (flatten (rest attrs-and-children)))) - ((hash-table-p (first attrs-and-children)) - (values (make-attrs :alist (hash-alist (first attrs-and-children))) - (flatten (rest attrs-and-children)))) - ((keywordp (first attrs-and-children)) - (loop for thing on attrs-and-children by #'cddr - for (k v) = thing - when (and (keywordp k) v) - collect (cons k v) into attrs - when (not (keywordp k)) - return (values (make-attrs :alist attrs) (flatten thing)) - finally (return (values (make-attrs :alist attrs) nil)))) - (t - (values (make-attrs :alist nil) (flatten attrs-and-children))))) - (defvar *builtin-elements* (make-hash-table)) (defun html (&rest attrs-and-children) diff --git a/src/package.lisp b/src/package.lisp index 78d3206..b098f40 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -28,4 +28,9 @@ :element-children :user-element-expand-to :*expand-user-element* - :h)) + :h + :*escape-html* + :escape-string + :utf8-html-escape-char-p + :ascii-html-escape-char-p + :attr-value-escape-char-p)) diff --git a/src/util.lisp b/src/util.lisp index 27035e3..5a5022c 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -70,3 +70,27 @@ (otherwise child)) child)) children)) + +(defun split-attrs-and-children (attrs-and-children) + (cond + ((attrs-p (first attrs-and-children)) + (values (first attrs-and-children) (flatten (rest attrs-and-children)))) + ((alistp (first attrs-and-children)) + (values (make-attrs :alist (first attrs-and-children)) + (flatten (rest attrs-and-children)))) + ((listp (first attrs-and-children)) + (values (make-attrs :alist (plist-alist (first attrs-and-children))) + (flatten (rest attrs-and-children)))) + ((hash-table-p (first attrs-and-children)) + (values (make-attrs :alist (hash-alist (first attrs-and-children))) + (flatten (rest attrs-and-children)))) + ((keywordp (first attrs-and-children)) + (loop for thing on attrs-and-children by #'cddr + for (k v) = thing + when (and (keywordp k) v) + collect (cons k v) into attrs + when (not (keywordp k)) + return (values (make-attrs :alist attrs) (flatten thing)) + finally (return (values (make-attrs :alist attrs) nil)))) + (t + (values (make-attrs :alist nil) (flatten attrs-and-children))))) diff --git a/t/flute.lisp b/t/flute.lisp index f886bb9..8c4cea9 100644 --- a/t/flute.lisp +++ b/t/flute.lisp @@ -1,10 +1,118 @@ (in-package :cl-user) (defpackage flute.test - (:use :cl :flute)) + (:use :cl :flute :fiveam)) (in-package :flute.test) -(define-element clock (id size) - (div :id id - (h1 "clock") - (img "blabal" :size size) - children)) +(def-suite simple-builtin-element) +(in-suite simple-builtin-element) + +(test empty-attr + (let* ((div1 (div)) + (div2 (div "the children text")) + (div3 (div "text 1" "text 2")) + (div4 (div (h1 "text 0") "text 01" + (list (list "text 3" div2) div3) "text 4"))) + (is (eql nil (attrs-alist (element-attrs div1)))) + (is (eql nil (element-children div1))) + (is (eql nil (attrs-alist (element-attrs div2)))) + (is (equal (list "the children text") (element-children div2))) + (is (eql nil (attrs-alist (element-attrs div3)))) + (is (equal (list "text 1" "text 2") (element-children div3))) + (is (eql nil (attrs-alist (element-attrs div4)))) + (is (= 6 (length (element-children div4)))) + (let ((child1 (first (element-children div4))) + (child2 (second (element-children div4))) + (child3 (third (element-children div4))) + (child4 (fourth (element-children div4))) + (child5 (fifth (element-children div4))) + (child6 (sixth (element-children div4)))) + (is (equal "h1" (element-tag child1))) + (is (equal "text 01" child2)) + (is (equal "text 3" child3)) + (is (eql div2 child4)) + (is (eql div3 child5)) + (is (equal "text 4" child6))))) + +(test attr-given-by-inline-args + (let* ((div1 (div :id "container")) + (div2 (div :id "cat" :class "happy")) + (div3 (div :id "container" "some children text" div1)) + (div4 (div :id "dog" :class "happy" (list (list div1) div2) (list div3)))) + (is (equal '((:id . "container")) (attrs-alist (element-attrs div1)))) + (is (eql nil (element-children div1))) + (is (equal '((:id . "cat") (:class . "happy")) (attrs-alist (element-attrs div2)))) + (is (eql nil (element-children div2))) + (is (equal '((:id . "container")) (attrs-alist (element-attrs div3)))) + (is (equal (list "some children text" div1) (element-children div3))) + (is (equal '((:id . "dog") (:class . "happy")) (attrs-alist (element-attrs div4)))) + (is (equal (list div1 div2 div3) (element-children div4))))) + +(test attr-given-by-attrs + (let* ((div00 (div (make-attrs))) + (div01 (div (make-attrs :alist nil) "some text")) + (div1 (div (make-attrs :alist '((:id . "container"))))) + (div2 (div (make-attrs :alist '((:id . "cat") (:class . "happy"))))) + (div3 (div (make-attrs :alist '((:id . "container"))) "some children text" div1)) + (div4 (div (make-attrs :alist '((:id . "dog") (:class . "happy"))) (list (list div1) div2) (list div3)))) + (is (eql nil (attrs-alist (element-attrs div00)))) + (is (eql nil (element-children div00))) + (is (eql nil (attrs-alist (element-attrs div01)))) + (is (equal (list "some text") (element-children div01))) + (is (equal '((:id . "container")) (attrs-alist (element-attrs div1)))) + (is (eql nil (element-children div1))) + (is (equal '((:id . "cat") (:class . "happy")) (attrs-alist (element-attrs div2)))) + (is (eql nil (element-children div2))) + (is (equal '((:id . "container")) (attrs-alist (element-attrs div3)))) + (is (equal (list "some children text" div1) (element-children div3))) + (is (equal '((:id . "dog") (:class . "happy")) (attrs-alist (element-attrs div4)))) + (is (equal (list div1 div2 div3) (element-children div4))))) + +(test attr-given-by-alist + (let* ((div00 (div nil)) + (div01 (div nil "some text")) + (div1 (div '((:id . "container")))) + (div2 (div '((:id . "cat") (:class . "happy")))) + (div3 (div '((:id . "container")) "some children text" div1)) + (div4 (div '((:id . "dog") (:class . "happy")) (list (list div1) div2) (list div3)))) + (is (eql nil (attrs-alist (element-attrs div00)))) + (is (eql nil (element-children div00))) + (is (eql nil (attrs-alist (element-attrs div01)))) + (is (equal (list "some text") (element-children div01))) + (is (equal '((:id . "container")) (attrs-alist (element-attrs div1)))) + (is (eql nil (element-children div1))) + (is (equal '((:id . "cat") (:class . "happy")) (attrs-alist (element-attrs div2)))) + (is (eql nil (element-children div2))) + (is (equal '((:id . "container")) (attrs-alist (element-attrs div3)))) + (is (equal (list "some children text" div1) (element-children div3))) + (is (equal '((:id . "dog") (:class . "happy")) (attrs-alist (element-attrs div4)))) + (is (equal (list div1 div2 div3) (element-children div4))))) + +(test attr-given-by-plist + (let* ((div00 (div nil)) + (div01 (div nil "some text")) + (div1 (div '(:id "container"))) + (div2 (div '(:id "cat" :class "happy"))) + (div3 (div '(:id "container") "some children text" div1)) + (div4 (div '(:id "dog" :class "happy") (list (list div1) div2) (list div3)))) + (is (eql nil (attrs-alist (element-attrs div00)))) + (is (eql nil (element-children div00))) + (is (eql nil (attrs-alist (element-attrs div01)))) + (is (equal (list "some text") (element-children div01))) + (is (equal '((:id . "container")) (attrs-alist (element-attrs div1)))) + (is (eql nil (element-children div1))) + (is (equal '((:id . "cat") (:class . "happy")) (attrs-alist (element-attrs div2)))) + (is (eql nil (element-children div2))) + (is (equal '((:id . "container")) (attrs-alist (element-attrs div3)))) + (is (equal (list "some children text" div1) (element-children div3))) + (is (equal '((:id . "dog") (:class . "happy")) (attrs-alist (element-attrs div4)))) + (is (equal (list div1 div2 div3) (element-children div4))))) + + + +(run-all-tests) + +;; (define-element clock (id size) +;; (div :id id +;; (h1 "clock") +;; (img "blabal" :size size) +;; children))