diff --git a/main.rkt b/main.rkt index 1086841..832c51d 100644 --- a/main.rkt +++ b/main.rkt @@ -243,14 +243,14 @@ (map-elements/exclude proc x (λ(x) #f))) ;; function to split tag out of txexpr -(define+provide+safe (splitf-txexpr tx proc) - (txexpr? procedure? . -> . (values txexpr? (listof txexpr-element?))) +(define+provide+safe (splitf-txexpr tx pred [proc (λ(x) null)]) + ((txexpr? procedure?) (procedure?) . ->* . (values txexpr? (listof txexpr-element?))) (define matches null) (define (do-extraction x) (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)) - null)] + (proc x))] [(txexpr? x) (let-values([(tag attr body) (txexpr->values x)]) (make-txexpr tag attr (do-extraction body)))] [(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 (values tx-extracted (reverse matches))) - (define+provide+safe (xexpr->html x) (xexpr? . -> . string?) (define (->cdata x) diff --git a/scribblings/txexpr.scrbl b/scribblings/txexpr.scrbl index 0f79d01..0009876 100644 --- a/scribblings/txexpr.scrbl +++ b/scribblings/txexpr.scrbl @@ -431,16 +431,27 @@ Be careful with the wider consequences of exclusion tests. When @racket[_exclude @defproc[ (splitf-txexpr [tx txexpr?] -[pred procedure?]) +[pred procedure?] +[replace-proc procedure? (λ(x) null)]) (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. @examples[#:eval my-eval (define tx '(div "Wonderful day" (meta "weather" "good") "for a walk")) -(define remove? (λ(x) (and (txexpr? x) (equal? 'meta (get-tag x))))) -(splitf-txexpr tx remove?) +(define is-meta? (λ(x) (and (txexpr? x) (equal? 'meta (get-tag x))))) +(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} diff --git a/tests.rkt b/tests.rkt index ffed143..601beca 100644 --- a/tests.rkt +++ b/tests.rkt @@ -115,8 +115,13 @@ (define split-this-tx '(root (meta "foo" "bar") "hello" "world" (meta "foo2" "bar2") (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")))) +(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?")) "Why is 3 > 2?") \ No newline at end of file