diff --git a/decode.rkt b/decode.rkt index 852dcf8..6dd43f0 100644 --- a/decode.rkt +++ b/decode.rkt @@ -69,16 +69,16 @@ (define+provide/contract (decode-elements elements - #:txexpr-tag-proc [txexpr-tag-proc (λ(x)x)] - #:txexpr-attrs-proc [txexpr-attrs-proc (λ(x)x)] - #:txexpr-elements-proc [txexpr-elements-proc (λ(x)x)] - #:block-txexpr-proc [block-txexpr-proc (λ(x)x)] - #:inline-txexpr-proc [inline-txexpr-proc (λ(x)x)] - #:string-proc [string-proc (λ(x)x)] - #:symbol-proc [symbol-proc (λ(x)x)] - #:valid-char-proc [valid-char-proc (λ(x)x)] - #:cdata-proc [cdata-proc (λ(x)x)] - #:exclude-tags [excluded-tags '()]) + #:txexpr-tag-proc [txexpr-tag-proc (λ(x)x)] + #:txexpr-attrs-proc [txexpr-attrs-proc (λ(x)x)] + #:txexpr-elements-proc [txexpr-elements-proc (λ(x)x)] + #:block-txexpr-proc [block-txexpr-proc (λ(x)x)] + #:inline-txexpr-proc [inline-txexpr-proc (λ(x)x)] + #:string-proc [string-proc (λ(x)x)] + #:symbol-proc [symbol-proc (λ(x)x)] + #:valid-char-proc [valid-char-proc (λ(x)x)] + #:cdata-proc [cdata-proc (λ(x)x)] + #:exclude-tags [excluded-tags '()]) ((txexpr-elements?) (#:txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?) #:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?) @@ -94,17 +94,17 @@ (define temp-tag (gensym "temp-tag")) (define decode-result (decode `(temp-tag ,@elements) #:txexpr-tag-proc txexpr-tag-proc - #:txexpr-attrs-proc txexpr-attrs-proc - #:txexpr-elements-proc txexpr-elements-proc - #:block-txexpr-proc block-txexpr-proc - #:inline-txexpr-proc inline-txexpr-proc - #:string-proc string-proc - #:symbol-proc symbol-proc - #:valid-char-proc valid-char-proc - #:cdata-proc cdata-proc - #:exclude-tags excluded-tags)) + #:txexpr-attrs-proc txexpr-attrs-proc + #:txexpr-elements-proc txexpr-elements-proc + #:block-txexpr-proc block-txexpr-proc + #:inline-txexpr-proc inline-txexpr-proc + #:string-proc string-proc + #:symbol-proc symbol-proc + #:valid-char-proc valid-char-proc + #:cdata-proc cdata-proc + #:exclude-tags excluded-tags)) (get-elements decode-result)) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -334,23 +334,26 @@ ;; todo: unit tests (define+provide/contract (detect-paragraphs elements #:tag [tag 'p] #:separator [sep world:paragraph-separator] - #:linebreak-proc [linebreak-proc detect-linebreaks]) - ((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?)) + #:linebreak-proc [linebreak-proc detect-linebreaks] + #:force? [force-paragraph #f]) + ((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?) #:force? boolean?) . ->* . txexpr-elements?) ;; prepare elements for paragraph testing - (define (prep-paragraph-flow xc) - (linebreak-proc (merge-newlines (trimf xc whitespace?)))) + (define (prep-paragraph-flow elems) + (linebreak-proc (merge-newlines (trimf elems whitespace?)))) (define my-paragraph-break? (λ(x) (and (paragraph-break? x #:separator sep) #t))) - (define (wrap-paragraph xc) - (match xc + (define (wrap-paragraph elems) + (match elems [(list (? block-txexpr? bxs) ...) bxs] ; leave a series of block xexprs alone - [else (list (make-txexpr tag empty xc))])) ; otherwise wrap in p tag + [else (list (make-txexpr tag empty elems))])) ; otherwise wrap in p tag (let ([elements (prep-paragraph-flow elements)]) (if (ormap my-paragraph-break? elements) ; need this condition to prevent infinite recursion ;; use append-map rather than map to permit return of multiple elements (append-map wrap-paragraph (filter-split elements my-paragraph-break?)) ; split into ¶¶ - elements))) + (if force-paragraph + (append-map wrap-paragraph (slicef elements block-txexpr?)) ; upconverts non-block elements to paragraphs + elements)))) diff --git a/scribblings/decode.scrbl b/scribblings/decode.scrbl index 5a438ec..bbc703b 100644 --- a/scribblings/decode.scrbl +++ b/scribblings/decode.scrbl @@ -327,7 +327,8 @@ Within @racket[_tagged-xexpr-elements], convert occurrences of @racket[_linebrea [elements txexpr-elements?] [#:separator paragraph-sep string? world:paragraph-separator] [#:tag paragraph-tag symbol? 'p] -[#:linebreak-proc linebreak-proc (txexpr-elements? . -> . txexpr-elements?) detect-linebreaks]) +[#:linebreak-proc linebreak-proc (txexpr-elements? . -> . txexpr-elements?) detect-linebreaks] +[#:force? force-paragraph? boolean? #f]) txexpr-elements?] Find paragraphs within @racket[_elements] (as denoted by @racket[_paragraph-sep]) and wrap them with @racket[_paragraph-tag]. Also handle linebreaks using @racket[detect-linebreaks]. @@ -337,6 +338,8 @@ The @racket[_paragraph-tag] argument sets the tag used to wrap paragraphs. The @racket[_linebreak-proc] argument allows you to use a different linebreaking procedure other than the usual @racket[detect-linebreaks]. +The @racket[#:force?] option will wrap a paragraph tag around @racket[_elements], even if no paragraph break is found. If any @racket[_element] is already a @racket[block-txexpr?], it is skipped, but the remaining sequences of non-block @racket[_elements] are wrapped. The @racket[#:force?] option is useful for when you want to guarantee that you get a list of blocks. + @examples[#:eval my-eval (detect-paragraphs '("First para" "\n\n" "Second para")) (detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line")) @@ -345,6 +348,8 @@ The @racket[_linebreak-proc] argument allows you to use a different linebreaking (detect-paragraphs '("First para" "\n\n" "Second para") #:tag 'ns:p) (detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line") #:linebreak-proc (λ(x) (detect-linebreaks x #:insert '(newline)))) +(detect-paragraphs '("First" (span "para") (div "Block") "Second para") +#:force? #t) ] @defproc[ diff --git a/tests/tests-decode.rkt b/tests/tests-decode.rkt index f3f6aa8..6ab66de 100644 --- a/tests/tests-decode.rkt +++ b/tests/tests-decode.rkt @@ -54,6 +54,18 @@ (check-equal? (detect-paragraphs '("foo" "\n\n" (div "bar") "\n\n" (div "zam"))) '((p "foo") (div "bar") (div "zam"))) +(check-equal? (detect-paragraphs '("foo")) '("foo")) +(check-equal? (detect-paragraphs '("foo") #:force? #t) '((p "foo"))) +(check-equal? (detect-paragraphs '((div "foo"))) '((div "foo"))) +(check-equal? (detect-paragraphs '((div "foo")) #:force? #t) '((div "foo"))) +(check-equal? (detect-paragraphs '("foo" (div "bar"))) '("foo" (div "bar"))) +(check-equal? (detect-paragraphs '("foo" (div "bar")) #:force? #t) '((p "foo") (div "bar"))) +(check-equal? (detect-paragraphs '("foo" (div "bar") "zam")) '("foo" (div "bar") "zam")) +(check-equal? (detect-paragraphs '("foo" (span "zing") (div "bar") "zam")) '("foo" (span "zing") (div "bar") "zam")) +(check-equal? (detect-paragraphs '("foo" (span "zing") (div "bar") "zam") #:force? #t) '((p "foo" (span "zing")) (div "bar") (p "zam"))) + + + (check-equal? (merge-newlines '(p "\n" "foo" "\n" "\n" "bar" (em "\n" "\n" "\n"))) '(p "\n" "foo" "\n\n" "bar" (em "\n\n\n")))