diff options
| -rw-r--r-- | README.md | 38 | ||||
| -rw-r--r-- | specials.tl | 6 | ||||
| -rw-r--r-- | test/simple.tl | 9 | ||||
| -rw-r--r-- | who.tl | 17 |
4 files changed, 61 insertions, 9 deletions
@@ -239,13 +239,15 @@ macro `show-html-expansion`, which was removed from CL-WHO in 2009. ### Syntax: ::text - (deftag <keyword> <attr-param-list> <tag-body> + (deftag <keyword> <attr-param-list> <body-pattern> <body> ...) <attr-param-list> ::= (<key-param>* [ . <rest-param>]) <key-param> := <symbol> | (<name> [<default> [<pres-var>]]) + <body-pattern> := <macro-style-parameter-list> + ### Description: A `deftag` macro rewrites HTML markup written in TL-WHO syntax @@ -277,7 +279,7 @@ 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) + 3> (with-html-output (*stdout* nil :indent t) (:div :class "cls" (:easy-input :name "foo" :id "foo-23" :style "style" :label "lab" "123"))) @@ -295,6 +297,31 @@ 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. +The following example shows the destructuring `<body-pattern>`, +which gives the `:atag` non-attribute parameters. + + ::text + (deftag :atag (. other-attrs) (url cls . rest) + ^(:a :href ,url :class ,cls ,*other-attrs ,*rest)) + +This `:atag` is then used like this: + + ::text + 3> (with-html-output (*stdout*) + (:atag "https://example.com" "ext" "link text")) + <a href='https://example.com' class='ext'>link text</a> + +Here, the `"https://example.c"` item from the body got matched +as the `url` parameter, then `cls` took `"ext"` and `rest` got +the rest of the body as a list of items, which includes `"link text"`. + +Other attributes tag can be passed through thanks to `other-attributes` parameter: + + ::text + 3> (with-html-output (*stdout*) + (:atag :target "_blank" "https://example.com" "ext" "link text")) + <a href='https://example.com' class='ext' target='_blank'>link text</a> + ### Parameters: The `attr-param-list` is an implicit keyword parameter list @@ -311,6 +338,13 @@ will be a Boolean value indicating, if true, that the keyword argument was present, or if false that it was missing (and thus defaulted). +The `body-pattern` is a destructuring pattern (macro-style parameter list). +It captures the body that is passed to the tag: material after the attributes. +Usually, this is specified as a single symbol, which captures the +entire body. However, if a pattern is specified, the body material +is destructurd, which effectively allows `deftag` tags to +have parameters, as in the `:atag` example above. + ## Dependencies TL-WHO has no external dependencies other than TXR itself. diff --git a/specials.tl b/specials.tl index e01de8d..0a9e192 100644 --- a/specials.tl +++ b/specials.tl @@ -124,5 +124,11 @@ ;; Hash table with tag macro bindings for deftag. (defvar *tag-macro* (hash)) +;; Current html form being expanded. +(defvar *cur-form* (hash)) + +;; Current macro-expansion environment. +(defvar *cur-env* (hash)) + ;; Used for indentation. (defconstant +newline+ "\n") diff --git a/test/simple.tl b/test/simple.tl index fb0e3e2..b1d58de 100644 --- a/test/simple.tl +++ b/test/simple.tl @@ -578,3 +578,12 @@ (: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' />") + +;;; 55 +;;; Test deftag with destrutured body params +(deftag :atag (. other-attrs) (url cls . rest) + ^(:a :href ,url :class ,cls ,*rest)) + +(test (with-html-output-to-string (out) + (:atag "https://example.com" "external" "inside" "link")) + "<a href='https://example.com' class='external'>insidelink</a>") @@ -280,6 +280,7 @@ ;; which should either hold a stream or which'll be bound to stream if ;; supplied. (defmacro with-html-output ((:key var : stream -- prologue indent . rest) + :form *cur-form* :env *cur-env* . body) ^(let ((,var ,(or stream var))) (macrolet ((htm (. body) @@ -331,7 +332,7 @@ (unless (memq prop keys) (add prop val))))))) -(defmacro deftag (:form f keyword attr-param-list tag-body . body) +(defmacro deftag (:form f keyword attr-param-list body-pattern . body) (unless (keywordp keyword) (compile-error f "~s argument must be a keyword" keyword)) (let ((rest-param (if (consp attr-param-list) @@ -339,9 +340,11 @@ 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)))) + (with-gensyms (body-arg) + ^(set [*tag-macro* ,keyword] + (lambda (:key ,body-arg -- ,*attr-param-list) + (mac-env-param-bind *cur-form* *cur-env* ,body-pattern ,body-arg + ,*(if (and rest-param key-params) + ^((set ,rest-param + (scrub-kw-args ',key-params ,rest-param)))) + ,*body)))))) |