From 02cdc44a4f428a6835fcdc7af9dbe3e9b1984cb0 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 27 Jan 2016 14:02:38 -0800 Subject: [PATCH] implement lang-wide splicing with `current-splicing-tag`; reimplement `when/block` as `when/splice` --- pollen/private/main-base.rkt | 10 ++++++---- pollen/private/project-server-routes.rkt | 11 +++++----- pollen/private/splice.rkt | 20 +++++++++++++++++++ pollen/private/split-metas.rkt | 8 ++++---- pollen/scribblings/mb-tools.rkt | 3 +-- pollen/scribblings/template.scrbl | 9 +++++++++ .../third-tutorial-files/template.html | 4 ++-- pollen/scribblings/tutorial-second.scrbl | 18 ++++++++--------- pollen/scribblings/tutorial-third.scrbl | 6 +++--- pollen/scribblings/world.scrbl | 3 +++ pollen/template/base.rkt | 15 ++++++++++++++ pollen/test/test-lang-splice.rkt | 20 +++++++++++++++++++ pollen/unstable/mb.rkt | 15 ++------------ pollen/unstable/tmpl.rkt | 8 -------- pollen/world.rkt | 2 ++ 15 files changed, 102 insertions(+), 50 deletions(-) create mode 100644 pollen/private/splice.rkt create mode 100644 pollen/test/test-lang-splice.rkt delete mode 100644 pollen/unstable/tmpl.rkt diff --git a/pollen/private/main-base.rkt b/pollen/private/main-base.rkt index 51fa099..59a7d0a 100644 --- a/pollen/private/main-base.rkt +++ b/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 \ No newline at end of file diff --git a/pollen/private/project-server-routes.rkt b/pollen/private/project-server-routes.rkt index 64dfe3a..b8d0c17 100644 --- a/pollen/private/project-server-routes.rkt +++ b/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 diff --git a/pollen/private/splice.rkt b/pollen/private/splice.rkt new file mode 100644 index 0000000..357fbad --- /dev/null +++ b/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)) \ No newline at end of file diff --git a/pollen/private/split-metas.rkt b/pollen/private/split-metas.rkt index 533f6a2..e455fde 100644 --- a/pollen/private/split-metas.rkt +++ b/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))) \ No newline at end of file diff --git a/pollen/scribblings/mb-tools.rkt b/pollen/scribblings/mb-tools.rkt index 44a7b4f..43c9f43 100644 --- a/pollen/scribblings/mb-tools.rkt +++ b/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 ...))])) diff --git a/pollen/scribblings/template.scrbl b/pollen/scribblings/template.scrbl index 495d2dc..c9ad3f1 100644 --- a/pollen/scribblings/template.scrbl +++ b/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} diff --git a/pollen/scribblings/third-tutorial-files/template.html b/pollen/scribblings/third-tutorial-files/template.html index 092a5eb..b05fb02 100644 --- a/pollen/scribblings/third-tutorial-files/template.html +++ b/pollen/scribblings/third-tutorial-files/template.html @@ -6,10 +6,10 @@ ◊->html[doc] ◊(define prev-page (previous here)) -◊when/block[prev-page]{ +◊when/splice[prev-page]{ } ◊(define next-page (next here)) -◊when/block[next-page]{ +◊when/splice[next-page]{ } \ No newline at end of file diff --git a/pollen/scribblings/tutorial-second.scrbl b/pollen/scribblings/tutorial-second.scrbl index fc8d30e..bffc560 100644 --- a/pollen/scribblings/tutorial-second.scrbl +++ b/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 ◊->html[doc] The current page is called ◊|here|. -◊when/block[(previous here)]{The previous is +◊when/splice[(previous here)]{The previous is ◊|(previous here)|.} The next is ◊|(next here)|. }] -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 @ ◊->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 ◊|prev-page|.} The next is ◊|(next here)|. @@ -717,7 +717,7 @@ The next is ◊|(next here)|. 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 ◊->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 ◊|prev-page|.} -◊when/block[(regexp-match "article" (->string (next here)))]{ +◊when/splice[(regexp-match "article" (->string (next here)))]{ The next is ◊|(next here)|.} @@ -799,10 +799,10 @@ BAM! An error page that says @tt{Can’t convert #f to string}. What happened? W ◊->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 ◊|prev-page|.} ◊(define next-page (next here)) -◊when/block[next-page]{ +◊when/splice[next-page]{ The next is ◊|next-page|.} diff --git a/pollen/scribblings/tutorial-third.scrbl b/pollen/scribblings/tutorial-third.scrbl index d6f85d2..82fb293 100644 --- a/pollen/scribblings/tutorial-third.scrbl +++ b/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 ◊(->html doc #:splice #t) ◊(define prev-page (previous here)) -◊when/block[prev-page]{ +◊when/splice[prev-page]{ } ◊(define next-page (next here)) -◊when/block[next-page]{ +◊when/splice[next-page]{ } @@ -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].} ] diff --git a/pollen/scribblings/world.scrbl b/pollen/scribblings/world.scrbl index 471cd8e..334cab0 100644 --- a/pollen/scribblings/world.scrbl +++ b/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].} diff --git a/pollen/template/base.rkt b/pollen/template/base.rkt index 076cce7..c222220 100644 --- a/pollen/template/base.rkt +++ b/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 ...)) + diff --git a/pollen/test/test-lang-splice.rkt b/pollen/test/test-lang-splice.rkt new file mode 100644 index 0000000..7599a30 --- /dev/null +++ b/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"))) diff --git a/pollen/unstable/mb.rkt b/pollen/unstable/mb.rkt index 4dede9a..d0163c2 100644 --- a/pollen/unstable/mb.rkt +++ b/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 ...)))) - "")])) \ No newline at end of file diff --git a/pollen/unstable/tmpl.rkt b/pollen/unstable/tmpl.rkt deleted file mode 100644 index 33e362a..0000000 --- a/pollen/unstable/tmpl.rkt +++ /dev/null @@ -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)) \ No newline at end of file diff --git a/pollen/world.rkt b/pollen/world.rkt index 5808fca..da9ab5c 100644 --- a/pollen/world.rkt +++ b/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)))) \ No newline at end of file