add replace-proc to splitf-txexpr

pull/1/head
Matthew Butterick 10 years ago
parent 8fd0916426
commit bb53965dc2

@ -243,14 +243,14 @@
(map-elements/exclude proc x (λ(x) #f))) (map-elements/exclude proc x (λ(x) #f)))
;; function to split tag out of txexpr ;; function to split tag out of txexpr
(define+provide+safe (splitf-txexpr tx proc) (define+provide+safe (splitf-txexpr tx pred [proc (λ(x) null)])
(txexpr? procedure? . -> . (values txexpr? (listof txexpr-element?))) ((txexpr? procedure?) (procedure?) . ->* . (values txexpr? (listof txexpr-element?)))
(define matches null) (define matches null)
(define (do-extraction x) (define (do-extraction x)
(cond (cond
[(proc x) (begin ; store matched item but return null value [(pred x) (begin ; store matched item and return processed value
(set! matches (cons x matches)) (set! matches (cons x matches))
null)] (proc x))]
[(txexpr? x) (let-values([(tag attr body) (txexpr->values x)]) [(txexpr? x) (let-values([(tag attr body) (txexpr->values x)])
(make-txexpr tag attr (do-extraction body)))] (make-txexpr tag attr (do-extraction body)))]
[(txexpr-elements? x) (filter (compose1 not null?) (map do-extraction x))] [(txexpr-elements? x) (filter (compose1 not null?) (map do-extraction x))]
@ -258,7 +258,6 @@
(define tx-extracted (do-extraction tx)) ;; do this first to fill matches (define tx-extracted (do-extraction tx)) ;; do this first to fill matches
(values tx-extracted (reverse matches))) (values tx-extracted (reverse matches)))
(define+provide+safe (xexpr->html x) (define+provide+safe (xexpr->html x)
(xexpr? . -> . string?) (xexpr? . -> . string?)
(define (->cdata x) (define (->cdata x)

@ -431,16 +431,27 @@ Be careful with the wider consequences of exclusion tests. When @racket[_exclude
@defproc[ @defproc[
(splitf-txexpr (splitf-txexpr
[tx txexpr?] [tx txexpr?]
[pred procedure?]) [pred procedure?]
[replace-proc procedure? (λ(x) null)])
(values txexpr? (listof txexpr-element?))] (values txexpr? (listof txexpr-element?))]
Recursively descend through @racket[_txexpr] and extract all elements that match @racket[_pred]. Returns two values: a @racket[_txexpr] with the matching elements removed, and the list of matching elements. Sort of esoteric, but I've needed it more than once, so here it is. Recursively descend through @racket[_txexpr] and extract all elements that match @racket[_pred]. Returns two values: a @racket[_txexpr] with the matching elements removed, and the list of matching elements. Sort of esoteric, but I've needed it more than once, so here it is.
@examples[#:eval my-eval @examples[#:eval my-eval
(define tx '(div "Wonderful day" (meta "weather" "good") "for a walk")) (define tx '(div "Wonderful day" (meta "weather" "good") "for a walk"))
(define remove? (λ(x) (and (txexpr? x) (equal? 'meta (get-tag x))))) (define is-meta? (λ(x) (and (txexpr? x) (equal? 'meta (get-tag x)))))
(splitf-txexpr tx remove?) (splitf-txexpr tx is-meta?)
] ]
Ordinarily, the result of the split operation is to remove the elements that match @racket[_pred]. But you can change this behavior with the optional @racket[_replace-proc] argument.
@examples[#:eval my-eval
(define tx '(div "Wonderful day" (meta "weather" "good") "for a walk"))
(define is-meta? (λ(x) (and (txexpr? x) (equal? 'meta (get-tag x)))))
(define replace-meta (λ(x) '(em "meta was here")))
(splitf-txexpr tx is-meta? replace-meta)
]
@section{License & source code} @section{License & source code}

@ -115,8 +115,13 @@
(define split-this-tx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2") (define split-this-tx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2")
(em "goodnight" "moon" (meta "foo3" "bar3")))) (em "goodnight" "moon" (meta "foo3" "bar3"))))
(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))) list) (define split-predicate (λ(x) (and (txexpr? x) (equal? 'meta (car x)))))
(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate)) list)
(list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3")))) (list '(root "hello" "world" (em "goodnight" "moon")) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
(define split-proc (λ(x) '(div "foo")))
(check-equal? (call-with-values (λ() (splitf-txexpr split-this-tx split-predicate split-proc)) list)
(list '(root (div "foo") "hello" "world" (div "foo") (em "goodnight" "moon" (div "foo"))) '((meta "foo" "bar") (meta "foo2" "bar2") (meta "foo3" "bar3"))))
(check-equal? (xexpr->html '(root (script "3 > 2") "Why is 3 > 2?")) (check-equal? (xexpr->html '(root (script "3 > 2") "Why is 3 > 2?"))
"<root><script>3 > 2</script>Why is 3 &gt; 2?</root>") "<root><script>3 > 2</script>Why is 3 &gt; 2?</root>")
Loading…
Cancel
Save