diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2023-06-01 20:20:40 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2023-06-01 20:20:40 -0700 |
| commit | 257672152b93c08f573db2912eef2b9a4145d5f5 (patch) | |
| tree | 8ea0a46605ce55b6a959c4ee3979531068e0e595 | |
| parent | 2e5ec1a87b614dfce7d9105e841b71d18691b98a (diff) | |
| download | tl-who-257672152b93c08f573db2912eef2b9a4145d5f5.tar.gz tl-who-257672152b93c08f573db2912eef2b9a4145d5f5.tar.bz2 tl-who-257672152b93c08f573db2912eef2b9a4145d5f5.zip | |
New feature: deftag macro.
The deftag macro targets the HTML markup syntax itself
rather than Lisp forms within it. deftag macros
masquerade as tag markup, but rewrite themselves into
other markup. They can produce multiple elements
using (progn ...) and can move element attribute
material into the avlue position and vice versa.
They can destructure attributes using keyword parameters,
and easily default the values of required attributes
and such.
* packages.tl (tl-who): New symbol, deftag.
* specials.tl (*tag-macro*): New special variable,
holding a hash table of deftag definitions.
* who.tl (process-tag): After a tag is parsed,
we check whether there is a macro defined for it.
If so we call its expander lambda. This is done
here because this function has the parsed pieces
of the tag. The higher level above this function
doesn't, and after this function, everything
is just a flat list of strings and other objects.
Here we recognize whether the macro put out a
progn shape, and iterate over the multiple items
it contains.
(scrub-kw-args): New function. This is a helper
function used by deftag expanders to remove, from
the attribute rest parameter, those keyword
arguments which were captured by the named parameters.
(deftag): New macro.
* test/simple.tl: New test cases 50-54 targeting deftag.
* README.md: Documented.
| -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)))) |