allow keyword arguments to specify attributes in default tag functions

scribblings/command.scrbl

@@ -705,20 +705,20 @@ Here's the hard way. You can type out your list of attributes in Racket format a
 @repl-output{'(title ((class "red") (id "first")) "The Beginning of the End")}
 
 
-But that's a lot of parentheses to think about. So here's the easy way. Anytime you use a tag function, there's a shortcut for inserting attributes. You can enter them as a series of symbol–string pairs between the Racket-argument brackets. The only caveat is that the symbols have to begin with a quote mark @litchar{'} and end with a colon @litchar{:}. So taken together, they look like this:
+But that's a lot of parentheses to think about. So here's the easy way. Anytime you use a tag function, there's a shortcut for inserting attributes. You can enter them as a series of @italic{keyword arguments} between the Racket-argument brackets. The only caveat is that the values for these keyword arguments have to be strings. So taken together, they look like this:
 
 @codeblock|{
 #lang pollen
-◊title['class: "red" 'id: "first"]{The Beginning of the End}
+◊title[#:class "red" #:id "first"]{The Beginning of the End}
 }|
 
 @repl-output{'(title ((class "red") (id "first")) "The Beginning of the End")}
 
-Racket arguments can be any valid Racket expressions. For instance, this will also work:
+The string arguments can be any valid Racket expressions that produce strings. For instance, this will also work:
 
 @codeblock|{
 #lang pollen
-◊title['class: (format "~a" (* 6 7)) 'id: "first"]{The Beginning of the End}
+◊title[#:class (format "~a" (* 6 7)) #:id "first"]{The Beginning of the End}
 }|
 
 @repl-output{'(title ((class "42") (id "first")) "The Beginning of the End")}
@@ -728,12 +728,12 @@ Since Pollen commands are really just Racket arguments underneath, you can use t
 @codeblock|{
 #lang pollen
 ◊(define name "Brennan")
-◊title['class: "red" 'id: ◊name]{The Beginning of the End}
+◊title[#:class "red" #:id ◊name]{The Beginning of the End}
 }|
 
 @repl-output{'(title ((class "read") (id "Brennan")) "The Beginning of the End")}
 
-You can also use this area for @italic{keyword arguments}. Keyword arguments can be used to provide options for a particular Pollen command, to avoid redundancy. Suppose that instead of using the @code{h1 ... h6} tags, you want to consolidate them into one command called @code{heading} and select the level separately. You can do this with a keyword, in this case @racket[#:level], which is passed as a Racket argument:
+When used in custom tag functions, keyword arguments don't have to represent attributes. Instead, they can be used to provide options for a particular Pollen command, to avoid redundancy. Suppose that instead of using the @code{h1 ... h6} tags, you want to consolidate them into one command called @code{heading} and select the level separately. You can do this with a keyword, in this case @racket[#:level], which is passed as a Racket argument:
 
 @codeblock|{
 #lang pollen

scribblings/tag.scrbl

@@ -14,9 +14,11 @@ Convenience functions for working with tags.
 
 @defproc[
 (make-default-tag-function
-[id txexpr-tag?])
+[id txexpr-tag?]
+[kw-attr-name keyword?]
+[kw-attr-value string?] ... ...)
 (-> txexpr?)]
-Make a default tag function for @racket[_id]. As arguments, a tag function takes an optional set of X-expression attributes (@racket[txexpr-attrs?]) followed by X-expression elements (@racket[txexpr-elements?]). From these, the tag function creates a tagged X-expression using @racket[_id] as the tag.
+Make a default tag function for @racket[_id]. The new tag function takes an optional set of X-expression attributes (@racket[txexpr-attrs?]) followed by X-expression elements (@racket[txexpr-elements?]). From these, the tag function creates a tagged X-expression using @racket[_id] as the tag.
 
 @examples[
 (require pollen/tag)
@@ -25,20 +27,37 @@ Make a default tag function for @racket[_id]. As arguments, a tag function takes
 (beaucoup '((id "greeting")) "Bonjour")
 ]
 
-Entering attributes this way can be cumbersome. So for convenience, a tag function provides an alternative: any symbol + string pairs at the front of your expression will be interpreted as attributes, if the symbols are followed by a colon. If you leave out the colon, the symbols will be interpreted as part of the content of the tag.
+Entering attributes this way can be cumbersome. So for convenience, the new tag function provides an alternative: any keyword arguments and their values will be interpreted as attributes.
 
 @examples[
 (require pollen/tag)
 (define beaucoup (make-default-tag-function 'em))
-(beaucoup 'id: "greeting" 'class: "large" "Bonjour")
+(beaucoup #:id "greeting" #:class "large" "Bonjour")
-(code:comment @#,t{Don't forget the colons})
+]
-(beaucoup 'id "greeting" 'class "large" "Bonjour")
+
-(code:comment @#,t{Don't forget to provide a value for each attribute})
+You can also provide keyword arguments to @racket[make-default-tag-function] itself, and they will become default attributes for every use of the tag function.
-(beaucoup 'id: 'class: "large" "Bonjour")
+
+@examples[
+(require pollen/tag)
+(define beaucoup-small (make-default-tag-function 'em #:class "small"))
+(beaucoup-small #:id "greeting" "Bonjour")
 ]
 
 Pollen also uses this function to provide the default behavior for undefined tags. See @racket[#%top].
 
+Note that while default tag functions are typically used to generate tagged X-expressions, they don't enforce any restrictions on input, so they also do not guarantee that you will in fact get a valid tagged X-expression as output. This is intentional — default tag functions are a coding convenience, and their output is likely to be processed by other tag functions, so raising the error here would be premature.
+
+@examples[
+(require pollen/tag)
+(define strange (make-default-tag-function 'div #:class "bizarre"))
+(code:comment @#,t{Invalid data types for elements})
+(strange + *)
+(code:comment @#,t{Double "class" attribute})
+(strange #:class "spooky")
+]
+
+
+
 @defproc[
 (split-attributes
 [parts list?])

scribblings/tutorial-second.scrbl

@@ -311,7 +311,7 @@ To understand the necessary ingredients of a template, let's look at a simple on
 @fileblock["fallback.html"
 @codeblock[#:keep-lang-line? #f]{
 #lang pollen
-◊(->html (html (head (meta 'charset: "UTF-8")) (body doc)))
+◊(->html (html (head (meta #:charset "UTF-8")) (body doc)))
 }]
 
 It has three key ingredients. 
@@ -320,7 +320,7 @@ First, there's an X-expression that represents a basic HTML page:
 
 @codeblock[#:keep-lang-line? #f]{
 #lang pollen
-(html (head (meta 'charset: "UTF-8")) (body))
+(html (head (meta #:charset "UTF-8")) (body))
 }
 
 That X-expression is equivalent to this HTML string:
@@ -331,7 +331,7 @@ But within a template, we need to tell Pollen how we want to convert the X-expre
 
 @codeblock[#:keep-lang-line? #f]{
 #lang pollen
-◊(->html (html (head (meta 'charset: "UTF-8")) (body)))
+◊(->html (html (head (meta #:charset "UTF-8")) (body)))
 }
 
 Third, we need to include the content from our source file. By convention, every Pollen source file makes its output available through an exported variable named @code{doc}. A source file in preprocessor mode puts its text result in @code{doc}. And a source file in authoring mode puts its X-expression result in @code{doc}. So we put the variable @code{doc} inside the @code{body} tag.
@@ -340,7 +340,7 @@ Third, we need to include the content from our source file. By convention, every
 
 @codeblock[#:keep-lang-line? #f]{
 #lang pollen
-◊(->html (html (head (meta 'charset: "UTF-8")) (body doc)))
+◊(->html (html (head (meta #:charset "UTF-8")) (body doc)))
 }
 
 Under the hood, a template is just a partial program that relies on a set of variables defined by another source file. (In Racket, this set of variables is called a @defterm{lexical context}). So if you ran this template on its own, nothing would happen, because @code{doc} isn't defined. But when you run it in the context of another source file, it picks up the @code{doc} that's defined by that file.

scribblings/tutorial-third.scrbl

@@ -192,15 +192,15 @@ Then you have two options for adding attributes. The verbose way corresponds to
 
 Each key–value pair is in parentheses, and then the list of pairs is within parentheses, with a @racket[quote] (@litchar{'}) at the front that signals that the text should be used literally.
 
-This involves some superfluous typing, however, so Pollen also supports an abbreviated syntax for attributes:
+This involves some superfluous typing, however, so Pollen also allows you to specify attributes with keyword arguments:
 
 @fileblock["article.html.pm" @codeblock{
 #lang pollen
  
-◊span['class:"author" 'id:"primary" 'living:"true"]{Prof. Leonard}
+◊span[#:class "author" #:id "primary" #:living "true"]{Prof. Leonard}
 }]
 
-In this form, each attribute key starts with a quote mark @litchar{'} and ends with a colon @litchar{:}. As before, the attribute value is in quotation marks.
+In this form, each attribute name is prefixed with @litchar{#:}, indicating a keyword argument. As before, the attribute value is in quotation marks following the keyword name.
 
 Both of these forms will produce the same X-expression:
 
@@ -213,7 +213,7 @@ Now that you know how to make tags and attributes, you might wonder whether Poll
 
 You could write it in Pollen markup like so:
 
-@repl-output{◊div['class:"red" style:"font-size:150%"]{Important ◊em{News}}}
+@repl-output{◊div[#:class "red" #:style "font-size:150%"]{Important ◊em{News}}}
 
 And then just convert it (using the @racket[->html] function) into the HTML above. Thus, the tags you already know (and love?) can be used in Pollen markup, but with fewer keystrokes and cruft.
 

server-extras/fallback.html

@@ -1 +1 @@
-◊(->html (html (head (meta 'charset: "UTF-8")) (body doc)))
+◊(->html (html (head (meta #:charset "UTF-8")) (body doc)))

tag.rkt

@@ -1,38 +1,72 @@
 #lang racket/base
-(require txexpr sugar/define racket/string) 
+(require txexpr sugar/define racket/string racket/match)
 
-(define/contract+provide (make-default-tag-function . ids)
-  (() #:rest txexpr-tags? . ->* . procedure?)
-  (define (make-one-tag id)
-    (λ x 
-      (define reversed-pieces ; list of attribute pairs, and last element holds a list of everything else, then reversed
-        (reverse (let chomp ([x x])
-                   (define result+regexp (and ((length x) . >= . 2) 
-                                              (symbol? (car x)) 
-                                              ;; accept strings only
-                                              ;; numbers are difficult because they don't parse as cleanly.
-                                              ;; string will read as a string even if there's no space to the left.
-                                              (or (string? (cadr x))) 
-                                              ;; Looking for symbol ending with a colon
-                                              (regexp-match #rx"^(.*?):$" (symbol->string (car x)))))
-                   (if result+regexp
-                       ; reuse result value. cadr is first group in match. 
-                       (cons (list (string->symbol (cadr result+regexp))(cadr x)) (chomp (cddr x)))
-                       (list x)))))
-      
-      (define-values (body attrs) (if (equal? null reversed-pieces)
-                                      (values null null)
-                                      (values (car reversed-pieces) (cdr reversed-pieces))))
-      
-      `(,id ,@(if (equal? attrs null) null (list (reverse attrs))) ,@body)))
-  
-  (procedure-rename (apply compose1 (map make-one-tag ids)) (string->symbol (format "pollen-tag:~a" (string-join (map symbol->string ids) "+")))))
 
+(define first car)
+(define second cadr)
+(define+provide make-default-tag-function
+  (make-keyword-procedure
+   (λ (outer-kws outer-kw-args . ids)
+     (define (make-one-tag id)
+       (make-keyword-procedure
+        (λ (inner-kws inner-kw-args . attrs+xs)
+
+          ;; Three possible sources of attrs:
+          ;; 1) normal attrs, in a list at the front of the args
+          ;; 2) colon args, using special 'key: "value" syntax, also at the front of the args
+          ;; 3) keyword args.
+          
+          (define-values (leading-attrs xs) (if (and (pair? attrs+xs) (txexpr-attrs? (car attrs+xs)))
+                                                (values (car attrs+xs) (cdr attrs+xs))
+                                                (values null attrs+xs)))                                               
+          
+          (define-values (kws kw-args) (values (append outer-kws inner-kws) (append outer-kw-args inner-kw-args)))
+          
+          (match-define (list colon-attrs ... body) (let parse-one-colon-attr ([xs xs])
+                                                      (define (colon-attr-name? x) (let ([result (regexp-match #rx".*?(?=:$)" (symbol->string x))])
+                                                                                     (and result (string->symbol (car result))))) ; return name or #f
+                                                      (define maybe-attr-name (and (>= (length xs) 2) 
+                                                                                   (symbol? (first xs)) 
+                                                                                   (string? (second xs)) ; accept strings only as attr value
+                                                                                   (colon-attr-name? (first xs))))
+                                                      (if maybe-attr-name
+                                                          (let ([attr-name maybe-attr-name][attr-value (second xs)])
+                                                            (cons (list attr-name attr-value) (parse-one-colon-attr (cddr xs))))
+                                                          (list xs))))
+          (define kw-symbols (map (λ(kw) (string->symbol (string-trim (keyword->string kw) "#:"))) kws))
+          (define attrs (append (map list kw-symbols kw-args) colon-attrs leading-attrs))
+          
+          ;; construct the xexpr result "manually" (i.e., not with `make-txexpr` because it may not be a legit txexpr for now
+          ;; (but it may become one through further processing, so no need to be finicky)
+          ;; however, don't show empty attrs.
+          (list* id (if (null? attrs)
+                        body
+                        (list* attrs body))))))
+     
+     (let ([tag-proc (apply compose1 (map make-one-tag ids))]
+           [tag-proc-name (string->symbol (format "pollen-tag:~a" (string-join (map symbol->string ids) "+")))])
+       (procedure-rename tag-proc tag-proc-name)))))
 
 
 (define/contract+provide (split-attributes parts)
   (list? . -> . (values txexpr-attrs? txexpr-elements?))
-   (define dummy-tag (gensym))
+  (define dummy-tag (gensym))
-   (define dummy-txexpr (apply (make-default-tag-function dummy-tag) parts))
+  (define dummy-txexpr (apply (make-default-tag-function dummy-tag) parts))
-   (define-values (tag attrs elements) (txexpr->values dummy-txexpr))
+  (define-values (tag attrs elements) (txexpr->values dummy-txexpr))
-   (values attrs elements))
+  (values attrs elements))
+
+
+(module+ test
+  (require rackunit)
+  (define outerdiv (make-default-tag-function 'div #:class "outer" #:style "outer"))
+  (check-equal? (outerdiv "foo") '(div ((class "outer") (style "outer")) "foo"))
+  (check-equal? (outerdiv) '(div ((class "outer") (style "outer"))))
+  (check-equal? (outerdiv #:class "inner") '(div ((class "outer") (style "outer") (class "inner"))))
+  (check-equal? (outerdiv #:class "inner" "foo") '(div ((class "outer") (style "outer") (class "inner")) "foo"))
+  ;; `make-keyword-procedure` sorts keyword arguments alphabetically, so 'field' ends up before 'id'
+  (check-equal? (outerdiv #:id "shazbot" #:field "greens" "foo") '(div ((class "outer") (style "outer") (field "greens") (id "shazbot")) "foo"))
+  (check-equal? (outerdiv 'id: "shazbot" "foo") '(div ((class "outer") (style "outer") (id "shazbot")) "foo"))
+  (check-equal? (outerdiv '((id "shazbot")) "foo") '(div ((class "outer") (style "outer") (id "shazbot")) "foo"))
+  (check-equal? (outerdiv 'id: "shazbot" 'class: "inner" "foo") '(div ((class "outer") (style "outer") (id "shazbot") (class "inner")) "foo"))
+  ;; (outerdiv 'id: "shazbot" '((class "inner")) "foo") won't work because colon attrs supplant conventional attrs (docs concur)
+  (check-equal? (outerdiv 'id: "shazbot" #:class "inner" "foo") '(div ((class "outer") (style "outer") (class "inner") (id "shazbot")) "foo")))