diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2023-08-22 17:40:08 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2023-08-22 17:40:08 -0700 |
| commit | 6cd86e8975528a9ca5cbf12285724b99b63db4c6 (patch) | |
| tree | eaa9eb3ac924e86e896fa16c8740c0b43b006cd0 | |
| parent | 16a1a11fc9f8a2530940150029e3d7cc0b58430d (diff) | |
| download | tl-who-6cd86e8975528a9ca5cbf12285724b99b63db4c6.tar.gz tl-who-6cd86e8975528a9ca5cbf12285724b99b63db4c6.tar.bz2 tl-who-6cd86e8975528a9ca5cbf12285724b99b63db4c6.zip | |
deftag: support destructuring of body.
The variable which captures the body part of the tag (material
after attributes) is now a pattern. Thus the body can be
destructured, allowing the custom to effectively have
non-attribute parameters.
* README.md: Documented.
* specials (*cur-form*, *cur-env*): New special variables.
* test/simple.tl: Test case for new deftag feature.
* who.tl (with-html-output): Capture macro invocation's form
and environment, binding them to *cur-form* and *cur-env*.
This is a way of getting this information down to the custom
tag expander, where destructuring errors can occur now.
We would like them diagnosed against the right form.
The body destructuring pattern can use :env too.
(deftag): tag-body parameter renamed to body-pattern. This
is not inserted into the lambda parameter list any more;
a gensym is inserted into that position, and then that value
is destructured using body-pattern.
| -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)))))) |