diff --git a/collects/tests/mred/wxme-doc-random.ss b/collects/tests/mred/wxme-doc-random.ss
new file mode 100644
index 0000000000..7f46ad6359
--- /dev/null
+++ b/collects/tests/mred/wxme-doc-random.ss
@@ -0,0 +1,169 @@
+#lang scheme/gui
+
+(define (find sym l)
+  (cond
+   [(null? l) null]
+   [(and (pair? (car l))
+         (eq? sym (caar l)))
+    (car l)]
+   [else (find sym (cdr l))]))
+
+(define (add-method s table)
+  (let* ([s (if (keyword? (cadr s))
+                (cddr s)
+                s)]
+         [name (caadr s)]
+         [args (map cadr (cdadr s))])
+    (cons (cons name args)
+          table)))
+
+(define (read-methods path kind table)
+  (let ([s (call-with-input-file* path (lambda (in)
+                                         (parameterize ([read-accept-reader #t])
+                                           (read in))))])
+    (for/fold ([table table])
+        ([s (in-list (find kind s))])
+      (if (pair? s)
+          (cond
+           [(eq? (car s) 'defmethod)
+            (add-method s table)]
+           [else table])
+          table))))
+
+(define editor-methods
+  (read-methods (build-path (collection-path "scribblings" "gui")
+                            "editor-intf.scrbl")
+                'definterface/title
+                null))
+
+(define (delete l l2)
+  (if (null? l)
+      l2
+      (delete (cdr l) (filter (lambda (p) (not (eq? (car l) (car p)))) l2))))
+
+(define text-methods
+  (list->vector
+   (delete
+    '(read-header-from-file read-footer-from-file read-from-file
+                            end-write-header-footer-to-file)
+    (read-methods (build-path (collection-path "scribblings" "gui")
+                              "text-class.scrbl")
+                  'defclass/title
+                  (delete '(do-paste-x-selection do-paste do-copy) editor-methods)))))
+
+;; ----------------------------------------
+
+(define bm-dc
+  (let ([bm (make-object bitmap% 10 10)])
+    (make-object bitmap-dc% bm)))
+(define frame
+  (new frame% [label "Test"]))
+(define canvas
+  (new editor-canvas% [parent frame]))
+
+(define (generate-args contract-expr)
+  (if (pair? contract-expr)
+      (case (car contract-expr)
+        [(or/c one-of/c) (generate-args
+                          (list-ref
+                           (cdr contract-expr)
+                           (random (length (cdr contract-expr)))))]
+        [(and/c)
+         (cond
+          [(equal? contract-expr '(and/c exact? integer?))
+           (generate-args 'exact-integer?)]
+          [(equal? contract-expr '(and/c real? (not/c negative?)))
+           (random-elem '#(0.0 1.0 100.0 1000.0))]
+          [else (error "unknown" contract-expr)])]
+        [(box/c) `(box ,(generate-args (cadr contract-expr)))]
+        [(listof) (case (random 3)
+                    [(0) 'null]
+                    [(1) (list 'list
+                               (generate-args (cadr contract-expr)))]
+                    [(2) (list 'list
+                               (generate-args (cadr contract-expr))
+                               (generate-args (cadr contract-expr)))])]
+        [(quote)
+         `(quote ,(cadr contract-expr))]
+        [(is-a?/c)
+         (case (cadr contract-expr)
+           [(editor-stream-out%)
+            (make-object editor-stream-out% (make-object editor-stream-out-bytes-base%))]
+           [(editor-stream-in%)
+            (make-object editor-stream-in% (make-object editor-stream-in-bytes-base% #""))]
+           [(snip%)
+            (let ([s (make-object string-snip%)])
+              (send s insert "hi" 2)
+              s)]
+           [(mouse-event%)
+            (make-object mouse-event% 'motion)]
+           [(key-event%)
+            (make-object key-event%)]
+           [(editor-data%) (new editor-data%)]
+           [(text%) (new text%)]
+           [(pasteboard%) (new pasteboard%)]
+           [(cursor%) (make-object cursor% 'arrow)]
+           [(style-delta%) (new style-delta%)]
+           [(style-list%) (new style-list%)]
+           [(style<%>) (send (new style-list%) basic-style)]
+           [(editor-canvas%) canvas]
+           [(frame% dialog%) frame]
+           [(dc<%>) bm-dc]
+           [(editor-admin%) (send t get-admin)]
+           [(bitmap%) (make-object bitmap% 10 10)]
+           [(color%) (new color%)]
+           [(keymap%) (new keymap%)]
+           [(editor-wordbreak-map%) (new editor-wordbreak-map%)]
+           [else (error "unknown" contract-expr)])]
+        [(->) void]
+        [else (error "unknown" contract-expr)])
+      (case contract-expr
+        [(any/c) #f]
+        [(path?) (string->path "/tmp/foo")]
+        [(path-string?) "/tmp/foo"]
+        [(input-port?) (open-input-bytes #"")]
+        [(output-port?) (open-output-bytes)]
+        [(real?)
+         (random-elem '#(0.0 1.0 -1.0 100.0 -100.0))]
+        [(exact-nonnegative-integer?)
+         (random-elem '#(0 1 2 10 100 1000))]
+        [(exact-integer?)
+         (random-elem '#(0 1 -1 2 10 -10 100 1000))]
+        [(string?)
+         (random-elem '#("a" "hello" ""))]
+        [(#f) #f]
+        [(#t) #t]
+        [else (error "unknown" contract-expr)])))
+
+(define (random-elem v)
+  (vector-ref v (random (vector-length v))))
+
+;; ----------------------------------------
+
+(define t (new text%))
+
+; (send t copy-self)
+; (send t begin-write-header-footer-to-file (generate-args '(is-a?/c editor-stream-out%)) "" (box 0))
+; is-printing?
+; #f for set-keymap
+; seqcontract print
+; undo error
+; get-character
+; blink-caret & no admin
+; move-position & no admin
+
+(define-namespace-anchor a)
+
+(let ([n (abs (current-milliseconds))])
+  (printf "~s\n" n)
+  (random-seed n))
+
+(parameterize ([current-namespace (namespace-anchor->namespace a)])
+  (let loop ()
+    (let ([m (random-elem text-methods)])
+      (let ([name (car m)]
+            [args (map generate-args (cdr m))])
+        (printf "Call ~s\n" (cons name args))
+        (eval `(send ,t ,(car m) ,@args))
+        (loop)))))
+
diff --git a/collects/tests/mred/wxme-random.ss b/collects/tests/mred/wxme-random.ss
new file mode 100644
index 0000000000..31ed15c1f5
--- /dev/null
+++ b/collects/tests/mred/wxme-random.ss
@@ -0,0 +1,61 @@
+#lang scheme/gui
+
+(define seed 704050726 #;(abs (current-milliseconds)))
+(random-seed seed)
+
+(define t (new text%))
+
+(define frame
+  (new frame% [label "Test"]
+       [width 300]
+       [height 400]))
+(define canvas
+  (new editor-canvas% [parent frame] [editor t]))
+
+(send frame show #t)
+
+(send t set-max-undo-history 100)
+
+(define (random-elem v)
+  (vector-ref v (random (vector-length v))))
+
+(define (random-string)
+  (random-elem '#("a" "x\ny\nz\n" "hello there")))
+
+(define seq 0)
+
+(define actions
+  (vector
+   (lambda () (send t undo))
+   (lambda () (send t redo))
+   (lambda () (send t insert (random-string) (random (add1 (send t last-position)))))
+   (lambda () 
+     (let ([pos (random (add1 (send t last-position)))])
+       (send t delete pos (random (max 1 (- (send t last-position) pos))))))
+   (lambda ()
+     (send t begin-edit-sequence)
+     (set! seq (add1 seq)))
+   (lambda () 
+     (let loop ()
+       (when (positive? seq)
+         (send t end-edit-sequence)
+         (set! seq (sub1 seq))
+         (when (zero? (random 2))
+           (loop)))))
+   (lambda () 
+     (let ([pos (random (add1 (send t last-position)))])
+       (send t set-position pos (random (max 1 (- (send t last-position) pos))))))
+   (lambda () (send t copy))
+   (lambda () (send t cut))
+   (lambda () (send t paste))
+   (lambda () (send t change-style (make-object style-delta% 'change-size (add1 (random 42)))))
+   (lambda () (send t insert (make-object editor-snip%)))
+   ))
+   
+(let loop ()
+  (let ([act (random-elem actions)])
+    (printf "~s: ~s\n" seed act)
+    (act)
+    (loop)))
+
+   
\ No newline at end of file