updates

main.rkt

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

tests.rkt

@@ -77,3 +77,8 @@
                                   '(p "foo" "bar" (em "square"))) 
               '(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")))
+
+
+