From 6cd86e8975528a9ca5cbf12285724b99b63db4c6 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Tue, 22 Aug 2023 17:40:08 -0700 Subject: 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. --- README.md | 38 ++++++++++++++++++++++++++++++++++++-- specials.tl | 6 ++++++ test/simple.tl | 9 +++++++++ who.tl | 17 ++++++++++------- 4 files changed, 61 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index 2b05f76..762c0e5 100644 --- a/README.md +++ b/README.md @@ -239,13 +239,15 @@ macro `show-html-expansion`, which was removed from CL-WHO in 2009. ### Syntax: ::text - (deftag + (deftag ...) ::= (* [ . ]) := | ( [ []]) + := + ### 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 ``, +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")) + link text + +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")) + link text + ### 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")) " \ ") + +;;; 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")) + "insidelink") diff --git a/who.tl b/who.tl index 6c2d0ac..12ce78d 100644 --- a/who.tl +++ b/who.tl @@ -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)))))) -- cgit v1.2.3