implement lang-wide splicing with `current-splicing-tag`; reimplement `when/block` as `when/splice`

pollen/private/main-base.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 (require (for-syntax racket/base syntax/strip-context racket/syntax "../world.rkt" "split-metas.rkt")
-         "to-string.rkt" "../pagetree.rkt" "../world.rkt") ; need world here to resolve PARSER-MODE-ARG later
+         "to-string.rkt" "../pagetree.rkt" "splice.rkt" "../world.rkt") ; need world here to resolve PARSER-MODE-ARG
 (provide (all-defined-out))
 
 (define-syntax-rule (define+provide-module-begin-in-mode PARSER-MODE-ARG)
@@ -10,7 +10,7 @@
     (define-syntax (pollen-module-begin stx)
       (syntax-case stx ()
         [(_ EXPR (... ...))
-         (let-values ([(meta-keys meta-values expr-without-metas) (split-metas (syntax->datum #'(EXPR (... ...))) (world:current-define-meta-name))])
+         (let*-values ([(meta-keys meta-values expr-without-metas) (split-metas (syntax->datum #'(EXPR (... ...))) (world:current-define-meta-name))])
            (with-syntax ([(EXPR-WITHOUT-METAS (... ...)) (datum->syntax #'(EXPR (... ...)) expr-without-metas)]
                          [(KEY (... ...)) (datum->syntax #'(EXPR (... ...)) meta-keys)]
                          [(VALUE (... ...)) (datum->syntax #'(EXPR (... ...)) meta-values)]
@@ -21,6 +21,7 @@
                          [MODE-PAGETREE (datum->syntax #'(EXPR (... ...)) world:mode-pagetree)]
                          [MODE-MARKUP (datum->syntax #'(EXPR (... ...)) world:mode-markup)]
                          [MODE-MARKDOWN (datum->syntax #'(EXPR (... ...)) world:mode-markdown)]
+                         [SPLICING_TAG (datum->syntax #'(EXPR (... ...)) (world:current-splicing-tag))]
                          [DOC (format-id #'(EXPR (... ...)) "~a" (world:current-main-export))]
                          [DOC-RAW (generate-temporary)]); prevents conflicts with other imported Pollen sources
              (replace-context #'(EXPR (... ...))
@@ -48,7 +49,8 @@
                                                    (λ(xs) (apply ROOT ((dynamic-require 'markdown 'parse-markdown) (apply string-append (map to-string xs)))))]
                                                   [else (λ(xs) (apply string-append (map to-string xs)))])] ; string output for preprocessor
                                           ;; drop leading newlines, as they're often the result of `defines` and `requires`
-                                          [doc-elements (or (memf (λ(ln) (not (equal? ln NEWLINE))) DOC-RAW) null)])
-                                     (proc doc-elements)))
+                                          [doc-elements (or (memf (λ(ln) (not (equal? ln NEWLINE))) DOC-RAW) null)]
+                                          [doc-elements-spliced (splice doc-elements 'SPLICING_TAG)])
+                                     (proc doc-elements-spliced)))
                                  
                                  (provide DOC METAS (except-out (all-from-out 'inner) DOC-RAW #%top))))))])))) ; hide internal exports

pollen/private/project-server-routes.rkt

@@ -83,9 +83,10 @@
   `(div  
     (p "filename =" ,(->string relative-path))
     (p "size = " ,(bytecount->string (file-size path)))
-    ,@(when/splice (not (equal? (get-ext path) "svg"))
-                   `(p "width = " ,(->string (image-width img)) " " 
-                       "height = " ,(->string (image-height img))))
+    ,@(if (not (equal? (get-ext path) "svg"))
+          `(p "width = " ,(->string (image-width img)) " " 
+              "height = " ,(->string (image-height img)))
+          "")
     (a ((href ,img-url)) (img ((style "width:100%;border:1px solid #eee")(src ,img-url))))))
 
 (require file/unzip)
@@ -186,8 +187,8 @@
                                    (cond
                                      [(string? cell-content) (string-append indent-string cell-content)]
                                      [(txexpr? cell-content)
-                                               ;; indent link text by depth in pagetree
-                                               `(,(get-tag cell-content) ,(cons '(class "indented-link") (get-attrs cell-content)) ,indent-string (span ((class "indented-link-text")) ,@(get-elements cell-content)))]
+                                      ;; indent link text by depth in pagetree
+                                      `(,(get-tag cell-content) ,(cons '(class "indented-link") (get-attrs cell-content)) ,indent-string (span ((class "indented-link-text")) ,@(get-elements cell-content)))]
                                      [else (error 'make-path-row (format "mysterious cell data: ~v" cell-content))]))))
                          
                          (cond ; 'in' cell

pollen/private/splice.rkt

@@ -0,0 +1,20 @@
+#lang racket/base
+(provide (all-defined-out))
+
+(define (splice x [splicing-tag '@])
+  (let loop ([x x])
+    (if (list? x)
+        (apply append
+               (map (λ(xi) (let ([proc (if (and (pair? xi) (eq? (car xi) splicing-tag))
+                               cdr ; expose elements
+                               list)]) ; wrap in list 
+                            (proc (loop xi)))) x))
+        x)))
+
+(module+ test
+  (require rackunit)
+  (check-equal? (splice '(@ 1 (@ 2 (@ 3 (div 4 (@ 5))) 6) 7))
+                '(@ 1 2 3 (div 4 5) 6 7))
+  (check-equal? (splice '((@ "foo" "bar"))) '("foo" "bar"))
+  (check-equal? (splice '(@ "foo" "bar")) '(@ "foo" "bar")) ; this is correct, for composable behavior
+  (check-equal? (splice null) null))

pollen/private/split-metas.rkt

@@ -6,16 +6,16 @@
   
   (define (meta? x)  ; meta has form (define-meta key value)
     (and (list? x) (>= (length x) 3) (eq? (car x) meta-key)))
-
+  
   (define (non-meta?/gather x)
     (or (not (meta? x))
         (and (set! matches (cons x matches)) #f)))
-
+  
   (define rest
     (let loop ([x (if (list? tree) tree (list tree))])
       (if (list? x)
           (map loop (filter non-meta?/gather x))
           x)))
-
+  
   (let ([meta-key cadr][meta-value caddr])
-    (values (map meta-key matches) (map meta-value matches) rest)))
+    (values (map meta-key matches) (map meta-value matches) rest)))

pollen/scribblings/mb-tools.rkt

@@ -64,8 +64,7 @@
   (syntax-case stx ()
     [(_ name predicate? desc ...)
      (with-syntax ([world:name (format-id stx "world:~a" #'name)]
-                   [world:current-name (format-id stx "world:current-~a" #'name)]
-                   [local:name (format-id stx "local:~a" #'name)])
+                   [world:current-name (format-id stx "world:current-~a" #'name)])
        #'(deftogether ((defthing world:name predicate?)
                        (defproc (world:current-name) predicate?))
            desc ...))]))

pollen/scribblings/template.scrbl

@@ -112,6 +112,15 @@ Note that if @racket[_meta-source] is a relative path or pagenode, it is treated
 ]
 
 
+@defform[(when/splice condition pollen-args)]
+If @racket[_condition] is true, put the @racket[_pollen-args] into the document. Within a template file, usually invoked like so:
+
+@verbatim{◊when/splice[@racketvarfont{condition}]{The text to insert.}}
+
+The inserted text can contain its own nested Pollen commands.
+
+@racket[when/splice] can be more convenient than @racket[when], because @racket[when] will only use the last argument between the curly braces. @racket[when/splice], by contrast, treats everything between the curly braces as a block.
+
 
 
 @section{HTML}

pollen/scribblings/third-tutorial-files/template.html

@@ -6,10 +6,10 @@
 </head>
 <body>◊->html[doc]
 ◊(define prev-page (previous here))
-◊when/block[prev-page]{
+◊when/splice[prev-page]{
 <div id="prev">← <a href="◊|prev-page|">◊(select 'h1 prev-page)</a></div>}
 ◊(define next-page (next here))
-◊when/block[next-page]{
+◊when/splice[next-page]{
 <div id="next"><a href="◊|next-page|">◊(select 'h1 next-page)</a> →</div>}
 </body>
 </html>

pollen/scribblings/tutorial-second.scrbl

@@ -672,7 +672,7 @@ One way to fix the problem would be to have three separate template files — t
 
 But since we have a whole programming language available in Pollen, that's a dull-witted way to solve the problem. The better way is to add @italic{conditionals} to the template to selectively change the navigation. That keeps things simple, because we'll still have only one @filepath{template.html} to deal with.
 
-To handle @filepath{article.html}, we want to hide the previous-page navigation link when there's no previous page. As it turns out, if the @racket[previous] function can't find a previous page, it will return false. So we just need to wrap our previous-page navigation in the @racket[when/block] command like so:
+To handle @filepath{article.html}, we want to hide the previous-page navigation link when there's no previous page. As it turns out, if the @racket[previous] function can't find a previous page, it will return false. So we just need to wrap our previous-page navigation in the @racket[when/splice] command like so:
 
 @fileblock["template.html"
 @codeblock[#:keep-lang-line? #f]{
@@ -685,14 +685,14 @@ To handle @filepath{article.html}, we want to hide the previous-page navigation
 </head>
 <body>◊->html[doc]
 The current page is called ◊|here|.
-◊when/block[(previous here)]{The previous is 
+◊when/splice[(previous here)]{The previous is 
 <a href="◊|(previous here)|">◊|(previous here)|</a>.} 
 The next is <a href="◊|(next here)|">◊|(next here)|</a>.
 </body>
 </html>
 }]
 
-The basic structure of @racket[when/block] is @tt{◊when/block[@racketvarfont{condition}]{@racketvarfont{insert-this-text}}.} Note the square braces around the @racketvarfont{condition}, and the curly braces around the @racketvarfont{text}. Using @racket[(previous here)] as the condition is shorthand for ``when @racket[(previous here)] does not return false...''
+The basic structure of @racket[when/splice] is @tt{◊when/splice[@racketvarfont{condition}]{@racketvarfont{insert-this-text}}.} Note the square braces around the @racketvarfont{condition}, and the curly braces around the @racketvarfont{text}. Using @racket[(previous here)] as the condition is shorthand for ``when @racket[(previous here)] does not return false...''
 
 Programmers in the audience might be getting anxious about the repeated use of @racket[(previous here)] — you're welcome to store that value in a variable, and everything will work the same way:
 
@@ -708,7 +708,7 @@ Programmers in the audience might be getting anxious about the repeated use of @
 <body>◊->html[doc]
 The current page is called ◊|here|.
 ◊(define prev-page (previous here))
-◊when/block[prev-page]{The previous is 
+◊when/splice[prev-page]{The previous is 
 <a href="◊|prev-page|">◊|prev-page|</a>.} 
 The next is <a href="◊|(next here)|">◊|(next here)|</a>.
 </body>
@@ -717,7 +717,7 @@ The next is <a href="◊|(next here)|">◊|(next here)|</a>.
 
 We need a different technique for handling the end of the next-page navigation, because we're not reaching the actual end of the pagetree. We're just reaching the end of the pages we care about navigating through. 
 
-What condition will help us detect this? Here, we can notice that the names of our article pages all contain the string @code{article}. While you'd probably want a more robust condition for a real project, in this tutorial, what we'll do is hide the next-page navigation if the name of the next page doesn't contain ``@code{article}''. As we did before, we wrap our navigation line in the @racket[when/block] function:
+What condition will help us detect this? Here, we can notice that the names of our article pages all contain the string @code{article}. While you'd probably want a more robust condition for a real project, in this tutorial, what we'll do is hide the next-page navigation if the name of the next page doesn't contain ``@code{article}''. As we did before, we wrap our navigation line in the @racket[when/splice] function:
 
 @fileblock["template.html"
 @codeblock[#:keep-lang-line? #f]{
@@ -731,9 +731,9 @@ What condition will help us detect this? Here, we can notice that the names of o
 <body>◊->html[doc]
 The current page is called ◊|here|.
 ◊(define prev-page (previous here))
-◊when/block[prev-page]{The previous is 
+◊when/splice[prev-page]{The previous is 
 <a href="◊|prev-page|">◊|prev-page|</a>.} 
-◊when/block[(regexp-match "article" (->string (next here)))]{
+◊when/splice[(regexp-match "article" (->string (next here)))]{
 The next is <a href="◊|(next here)|">◊|(next here)|</a>.}
 </body>
 </html>
@@ -799,10 +799,10 @@ BAM! An error page that says @tt{Can’t convert #f to string}. What happened? W
 <body>◊->html[doc]
 The current page is called ◊|here|.
 ◊(define prev-page (previous here))
-◊when/block[prev-page]{The previous is 
+◊when/splice[prev-page]{The previous is 
 <a href="◊|prev-page|">◊|prev-page|</a>.} 
 ◊(define next-page (next here))
-◊when/block[next-page]{
+◊when/splice[next-page]{
 The next is <a href="◊|next-page|">◊|next-page|</a>.}
 </body>
 </html>

pollen/scribblings/tutorial-third.scrbl

@@ -804,10 +804,10 @@ In this project, we want to end up with HTML, so our source files will be called
 </head>
 <body>◊(->html doc #:splice #t)
 ◊(define prev-page (previous here))
-◊when/block[prev-page]{
+◊when/splice[prev-page]{
 <div id="prev">← <a href="◊|prev-page|">◊(select 'h1 prev-page)</a></div>}
 ◊(define next-page (next here))
-◊when/block[next-page]{
+◊when/splice[next-page]{
 <div id="next"><a href="◊|next-page|">◊(select 'h1 next-page)</a> →</div>}
 </body>
 </html>
@@ -954,7 +954,7 @@ This page isn't a miracle of web design, but it shows you in one example:
 
 @item{A dynamically-generated CSS file that computes positions for CSS elements using numerical values set up with @racket[define], and mathematical conversions thereof;}
 
-@item{Navigational links that appear and disappear as needed using conditional statements (@racket[when/block]) in @filepath{template.html}, with the page sequence defined by @filepath{index.ptree} and the names of the links being pulled from the @code{h1} tag of each source file using @racket[select].}
+@item{Navigational links that appear and disappear as needed using conditional statements (@racket[when/splice]) in @filepath{template.html}, with the page sequence defined by @filepath{index.ptree} and the names of the links being pulled from the @code{h1} tag of each source file using @racket[select].}
 
 ]
 

pollen/scribblings/world.scrbl

@@ -155,6 +155,9 @@ Default separators used in decoding. The first two are initialized to @racket["\
 
 @defoverridable[here-path-key symbol?]{Key used to store the absolute path of the current source file in its @racket[metas] hashtable. Default is @racket['here-path].}
 
+@defoverridable[splicing-tag symbol?]{Key used to signal that an X-expression should be spliced into its containing X-expression. Default is @val[world:splicing-tag].}
+
+
 @defoverridable[poly-source-ext symbol?]{Extension that indicates a source file can target multiple output types. Default is @racket['poly].}
 
 

pollen/template/base.rkt

@@ -1,4 +1,5 @@
 #lang racket/base
+(require (for-syntax racket/base "../world.rkt"))
 (require racket/string xml xml/path sugar/define sugar/container sugar/coerce sugar/test racket/list)
 (require "../file.rkt" txexpr "../world.rkt" "../cache.rkt" "../pagetree.rkt" "../private/debug.rkt")
 
@@ -93,3 +94,17 @@
   ((or/c pagenode? pathish?) . -> . (or/c is-doc-value? string?))
   (cached-doc (convert+validate-path pagenode-or-path 'get-doc)))
 
+(provide when/splice)
+(define-syntax (when/splice stx)
+  (syntax-case stx ()
+    [(_ COND BODY ...)
+     (with-syntax ([SPLICING-TAG (datum->syntax stx (world:current-splicing-tag))])
+       #'(if COND
+             (with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))])
+               (list 'SPLICING-TAG BODY ...)) 
+             ""))]))
+
+(provide when/block) ; bw compat
+(define-syntax-rule (when/block ARGS ...)
+  (when/splice ARGS ...))
+

pollen/test/test-lang-splice.rkt

@@ -0,0 +1,20 @@
+#lang racket/base
+(require rackunit)
+
+(module markup pollen/markup
+  (require pollen/template)
+  "Hello" (when #t (@ "Splice")) (when/splice #t "Splice") "World")
+(require (prefix-in markup: 'markup))
+(check-equal? markup:doc '(root "Hello" "Splice" "Splice" "World"))
+
+(module pre pollen/pre
+  (require pollen/template)
+  "Hello" (when #t (@ "Splice")) (when/splice #t "Splice") "World")
+(require (prefix-in pre: 'pre))
+(check-equal? pre:doc "HelloSpliceSpliceWorld")
+
+(module markdown pollen/markdown
+  (require pollen/template)
+  "Hello" (when #t (@ "Splice")) (when/splice #t "Splice") "World")
+(require (prefix-in markdown: 'markdown))
+(check-equal? markdown:doc '(root (p () "HelloSpliceSpliceWorld")))

pollen/unstable/mb.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
-(require (for-syntax racket/base))
-(require racket/list sugar/define sugar/test txexpr racket/match sugar/container sugar/coerce sugar/len)
+(require (for-syntax racket/base "../world.rkt"))
+(require racket/list sugar/define sugar/test txexpr racket/match sugar/container sugar/coerce sugar/len racket/string "../private/to-string.rkt" )
 
 (define (make-replacer query+replacement)
   (let ([queries (map car query+replacement)]
@@ -123,14 +123,3 @@
  (check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "_up_" #:minimum-word-length 3) 
                '(p "Hi " "there")) 
  (check-equal? (nonbreaking-last-space '(p "Hi here" (em "ho there")) #:nbsp "Ø") '(p "Hi here" (em "hoØ" "there"))))
-
-
-
-(provide when/block)
-(define-syntax (when/block stx)
-  (syntax-case stx ()
-    [(_ condition body ...)
-     #'(if condition (string-append* 
-                      (with-handlers ([exn:fail? (λ(exn) (error (format "within when/block, ~a" (exn-message exn))))])
-                        (map ->string (list body ...)))) 
-           "")]))

pollen/unstable/tmpl.rkt

@@ -1,8 +0,0 @@
-#lang racket/base
-(require pollen/private/main-base)
-
-(define+provide-module-begin-in-mode world:mode-template)
-
-(module reader racket/base
-  (require pollen/private/reader-base)
-  (define+provide-reader-in-mode world:mode-template))

pollen/world.rkt

@@ -109,6 +109,8 @@
 
 (define-settable here-path-key 'here-path)
 
+(define-settable splicing-tag '@)
+
 (define-settable poly-source-ext 'poly) ; extension that signals source can be used for multiple output targets
 (define-settable poly-targets '(html)) ; current target applied to multi-output source files
 (define current-poly-target (make-parameter (car (current-poly-targets))))