mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

add #:force? option to `detect-paragraphs`

Browse Source
pull/58/head
Matthew Butterick 10 years ago
parent d4c6f6b0ec
commit 2b4294e223
3 changed files with 49 additions and 29 deletions
Show Stats Download Patch File Download Diff File

57
decode.rkt
Unescape Escape View File

@ -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,15 +94,15 @@
(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))))

7
scribblings/decode.scrbl
Unescape Escape View File

@ -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[

12
tests/tests-decode.rkt
Unescape Escape View File

@ -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")))

Write Preview
Loading…
Cancel
Save