Revert "updates"

This reverts commit 185aa15ac2.
dev-validator
Matthew Butterick 10 years ago
parent 185aa15ac2
commit 2607c1603e

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(require racket/contract racket/match xml racket/list sugar/debug) (require racket/contract racket/match xml racket/list)
(define-syntax (define+provide/contract stx) (define-syntax (define+provide/contract stx)
(syntax-case stx () (syntax-case stx ()
@ -137,17 +137,14 @@
[else x])) [else x]))
(define+provide/contract (map-elements proc x [filter-proc (λ(x) #t)]) (define+provide/contract (map-elements proc x)
((procedure? tagged-xexpr?) (procedure?) . ->* . tagged-xexpr?) (procedure? tagged-xexpr? . -> . tagged-xexpr?)
(cond (define-values (tag attr elements) (tagged-xexpr->values x))
[(tagged-xexpr? x) (define recursive-proc
(if (filter-proc x) (λ(x)
(let-values ([(tag attr elements) (tagged-xexpr->values x)]) (cond
(make-tagged-xexpr tag attr [(tagged-xexpr? x) (map-elements proc x)]
(map (λ(x)(map-elements proc x filter-proc)) elements))) [else (proc x)])))
x)] (make-tagged-xexpr tag attr (map recursive-proc elements)))
;; externally the function only accepts tagged-xexpr,
;; but internally we don't care
[else (proc x)]))

@ -77,8 +77,3 @@
'(p "foo" "bar" (em "square"))) '(p "foo" "bar" (em "square")))
'(p "boing" "boing" (em "boing"))) '(p "boing" "boing" (em "boing")))
(require hyphenate sugar/debug)
(check-equal? (map-elements hyphenate '(p "foobar" (em "snowman")) (λ(tx) (not (equal? (car tx) 'em)))) '(p "foo\u00ADbar" (em "snowman")))

Loading…
Cancel
Save