From 257672152b93c08f573db2912eef2b9a4145d5f5 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Thu, 1 Jun 2023 20:20:40 -0700 Subject: 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. --- README.md | 84 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ packages.tl | 1 + specials.tl | 3 +++ test/simple.tl | 54 +++++++++++++++++++++++++++++++++++++ who.tl | 56 ++++++++++++++++++++++++++++++++++++++- 5 files changed, 197 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 8ef3b5c..2f8d5f1 100644 --- a/README.md +++ b/README.md @@ -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

+ ...) + + ::= (* [ . ]) + + := | ( [ []]) + +### 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!")) + + --> Hello! + +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"))) +

+ lab + + +

+ +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,")) + "

Hello, world!

") + +;;; 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")) + "

xyzabc world!

") + +;;; 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)) + "

") + + +;;; 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")) + "lab \ + ") diff --git a/who.tl b/who.tl index b605ba2..1ce80d7 100644 --- a/who.tl +++ b/who.tl @@ -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)))) -- cgit v1.2.3