diff options
| -rw-r--r-- | README.md | 84 | ||||
| -rw-r--r-- | packages.tl | 1 | ||||
| -rw-r--r-- | specials.tl | 3 | ||||
| -rw-r--r-- | test/simple.tl | 54 | ||||
| -rw-r--r-- | who.tl | 56 |
5 files changed, 197 insertions, 1 deletions
@@ -168,6 +168,13 @@ Here are the differences to be aware of: a mess of the output if used; unlike CL-WHO, TL-WHO warns when they are used in attributes. +* TL-WHO provides a `deftag` macro for defining macro-expanding tags. + This is inspired by a `deftag` described in the + [Spinneret](https://github.com/ruricolist/spinneret) documentation. + Though ordinary macros can easily be used inside `with-html-output`, + `deftag` is an expansion mechanism which transforms the tag + markup, rather than embedded Lisp code. It is documented below. + * The CL-WHO `conc` function is missing. TXR Lisp has a function like this, which is called `join`, and that is what is used in TL-WHO. @@ -223,6 +230,83 @@ following issue: the CL-WHO documentation is not accurately maintained and makes some references to material that no longer exists in CL-WHO, such as the macro `show-html-expansion`, which was removed from CL-WHO in 2009. +## The `deftag` macro + +### Syntax: + + ::text + (deftag <keyword> <attr-param-list> <tag-body> + <body> ...) + + <attr-param-list> ::= (<key-param>* [ . <rest-param>]) + + <key-param> := <symbol> | (<name> [<default> [<pres-var>]]) + +### Description: + +A `deftag` macro rewrites HTML markup written in TL-WHO syntax +into other markup. + +Simple example: + + ::text + (deftag :boldface (. attrs) body + ^(:span :font "bold" ,*attrs ,*body)) + + (with-html-output-to-string (out) + (:boldface :id "hello-id" "Hello!")) + + --> <span font='bold' id='hello-id'>Hello!</span> + +Complex example, adapted from Spinneret documentation: + + ::text + (deftag :easy-input (label (name (gensym)) + (id name) (type "text") . other-attrs) default + ^(progn + (:label :for ,name ,label) + (:input :name ,name :id ,id :type ,type + ,*other-attrs :value (progn ,*default)))) + +Note that `progn` here isn't the Lisp `progn` operator; it is recognized +by the `deftag` expansion mechanism as a way of producing multiple elements. +To invoke `:easy-input`, we might do this: + + ::text + 5> (with-html-output (*stdout* nil :indent t) + (:div :class "cls" + (:easy-input :name "foo" :id "foo-23" + :style "style" :label "lab" "123"))) + <div class='cls'> + <label for='foo'>lab + </label> + <input name='foo' id='foo-23' type='text' style='style' value='123' /> + </div> + +Note a small flexibility: the `body` argument `"123"` of `:easy-input` wasn't +inserted as an element in the middle of the tag as in the simple example, but +as an attribute value. + +Note that the `other-attrs` rest parameter of `:easy-input` received +a list which only contained the `:style` attribute; all the others +were captured by their respective keyword parameters. + +### Parameters: + +The `attr-param-list` is an implicit keyword parameter list +which destructures attributes. It can specify default values for +attributes that are not passed. Its rest parameter is bound +to the remaining attributes that were not captured by the parameters. + +Each `key-param` is an ordinary TXR Lisp key parameter, implemented +by the TXR Lisp `:key` parameter list macro. It may be just a +name, or a name with `default` expression giving a value for +the parameter if the corresponds keyword argument is missing, +possibly followed by another variable name which, if present, +will be a Boolean value indicating, if true, that the keyword +argument was present, or if false that it was missing (and +thus defaulted). + ## Dependencies TL-WHO has no external dependencies other than TXR itself. diff --git a/packages.tl b/packages.tl index bad0c40..0eaca09 100644 --- a/packages.tl +++ b/packages.tl @@ -38,6 +38,7 @@ "conc" "convert-attributes" "convert-tag-to-string-list" + "deftag" "esc" "escq" "escj" diff --git a/specials.tl b/specials.tl index 941bdf4..e01de8d 100644 --- a/specials.tl +++ b/specials.tl @@ -121,5 +121,8 @@ ;; behaviors revert to the CL-WHO behaviors of not escaping. (defvar *cl-who-compat* nil) +;; Hash table with tag macro bindings for deftag. +(defvar *tag-macro* (hash)) + ;; Used for indentation. (defconstant +newline+ "\n") diff --git a/test/simple.tl b/test/simple.tl index 6f9464d..0efad02 100644 --- a/test/simple.tl +++ b/test/simple.tl @@ -524,3 +524,57 @@ (contains "requires" x)) :good))) :good) + + +;;; 50 +;;; Test deftag +(deftag :abc (foo (bar 2) . other-attrs) body + ^(:p :foo ,foo :bar ,bar ,*body " world!")) + +(test (with-html-output-to-string (out) + (:abc :foo 42 :bar "x" "Hello,")) + "<p foo='42' bar='x'>Hello, world!</p>") + +;;; 51 +;;; Test chained expansion, and attr keyword arg defaulting +(deftag :xyz (. other-attrs) body + ^(:abc :foo 1 "xyz" ,*body)) + +(test (with-html-output-to-string (out) + (:xyz "abc")) + "<p foo='1' bar='2'>xyzabc world!</p>") + +;;; 52 +;;; Test invalid return: not tag material. +(deftag :bad (. rest) body + ^(notkeyword)) + +(test (catch + (eval ^(with-html-output-to-string (out) (:bad))) + (error (x) (if (contains "non-tag" x) + :good))) + :good) + +;;; 53 +;;; Test deftag producing multiple consecutive tags +(deftag :multi (. rest) body + ^(progn (:p) (:q) (:r))) + +(test (with-html-output-to-string (out) + (:multi)) + "<p></p><q></q><r></r>") + + +;;; 54 +;;; Complex deftag +(deftag :easy-input (label (name (gensym)) + (id name) (type "text") . other-attrs) default + ^(progn + (:label :for ,name ,label) + (:input :name ,name :id ,id :type ,type + ,*other-attrs :value (progn ,*default)))) + +(test (with-html-output-to-string (out) + (:easy-input :name "foo" :id "foo-23" :style "style" :label "lab" "123")) + "<label for='foo'>lab</label> \ + <input name='foo' id='foo-23' type='text' style='style' value='123' />") @@ -83,7 +83,31 @@ (if (keywordp (first rest)) (push (cons (first rest) (second rest)) attr))) (set body (rest sexp))))) - (convert-tag-to-string-list tag attr-list body body-fn))) + ;; tag macro expansion + (flet ((finish () + (convert-tag-to-string-list tag attr-list body body-fn)) + (alist-to-plist (al) + (mappend (tb ((a . b)) (list a b)) al)) + (process-elem (elem) + (match-case elem + (@(or @(keywordp) + (@(keywordp) . @nil) + ((@(keywordp) . @nil) . @nil)) + [process-tag elem body-fn]) + (@else (compile-error sexp "produced non-tag form ~s" + else))))) + (iflet ((fn [*tag-macro* tag])) + ;; macro found + (let* ((attr-plist (alist-to-plist attr-list)) + (new-tag-elem [fn body . attr-plist])) + (match-case new-tag-elem + ;; returned keyword form + ((progn . @stuff) + (append-each ((elem stuff)) + (process-elem elem))) + (@else (process-elem else)))) + ;; no macro: convert to string list + (finish))))) (defun attr-warning-macrolet (form) (with-gensyms (warn) @@ -291,3 +315,33 @@ ^(with-output-to-string (,var ,string-form) (with-html-output (,var nil :prologue ,prologue :indent ,indent) ,*body))) + +(defun scrub-kw-args (key-params args) + (let* ((kwp (find-package "keyword")) + (keys [mapcar (op intern + (symbol-name + (tree-case @1 + ((prop t) prop) + (prop prop))) + kwp) + key-params])) + (build + (for ((iter args)) (iter) ((set iter (cddr iter))) + (tree-bind (prop val . t) iter + (unless (memq prop keys) + (add prop val))))))) + +(defmacro deftag (:form f keyword attr-param-list tag-body . body) + (unless (keywordp keyword) + (compile-error f "~s argument must be a keyword" keyword)) + (let ((rest-param (if (consp attr-param-list) + (last attr-param-list 0) + attr-param-list)) + (key-params (if (consp attr-param-list) + (butlast attr-param-list 0)))) + ^(set [*tag-macro* ,keyword] + (lambda (:key ,tag-body -- ,*attr-param-list) + ,*(if (and rest-param key-params) + ^((set ,rest-param + (scrub-kw-args ',key-params ,rest-param)))) + ,*body)))) |