From 8424dea37b9cf83dce52b07dd8eeb4c3a15c0495 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 18 Feb 2010 20:36:03 +0000
Subject: [PATCH 1/9] avoid doing mac os x-specific tests unless under mac os x

svn: r18154
---
 collects/tests/framework/group-test.ss | 173 +++++++++++++------------
 1 file changed, 88 insertions(+), 85 deletions(-)

diff --git a/collects/tests/framework/group-test.ss b/collects/tests/framework/group-test.ss
index f9396d0646..b5285bfba0 100644
--- a/collects/tests/framework/group-test.ss
+++ b/collects/tests/framework/group-test.ss
@@ -5,14 +5,14 @@
   (let ([basics (list "Bring Frame to Front..." "Most Recent Window" 
                       #f)])
     (if (eq? (system-type) 'macosx)
-      (list* "Minimize" "Zoom" basics)
-      basics)))
+        (list* "Minimize" "Zoom" basics)
+        basics)))
 (send-sexp-to-mred
  '(define-syntax car*
     (syntax-rules ()
       [(car* x) (if (pair? x)
-                  (car x)
-                  (error 'car* "got a non-pair for ~s" 'x))])))
+                    (car x)
+                    (error 'car* "got a non-pair for ~s" 'x))])))
 
 ;; this test uses a new eventspace so that the mred function
 ;; current-eventspace-has-standard-menus? returns #f and thus
@@ -54,7 +54,7 @@
    (send-sexp-to-mred
     `(begin0 (map (lambda (x) (send x get-label))
                   (send (group:get-the-frame-group) get-frames))
-       (send (get-top-level-focus-window) close)))))
+             (send (get-top-level-focus-window) close)))))
 
 (test
  'two-frames-registered
@@ -94,89 +94,92 @@
                  frames)
        (map (lambda (x) (send x get-label)) frames)))))
 
-(test
- 'windows-menu
- (lambda (x)
-   (equal? x (append windows-menu-prefix (list "first" "test"))))
- (lambda ()
-   (send-sexp-to-mred
-    '(let ([frame (make-object frame:basic% "test")])
-       (send frame show #t)))
-   (wait-for-frame "test")
-   (send-sexp-to-mred
-    '(begin0 (map (lambda (x)
-                    (and (is-a? x labelled-menu-item<%>) (send x get-label)))
-                  (send (car* (send (send (get-top-level-focus-window)
-                                          get-menu-bar)
-                                    get-items))
-                        get-items))
-       (send (get-top-level-focus-window) close)))))
-
-(test
- 'windows-menu-unshown
- (lambda (x)
-   (equal? x (append windows-menu-prefix (list "first" "test"))))
- (lambda ()
-   (send-sexp-to-mred
-    '(let ([frame1 (make-object frame:basic% "test")]
-           [frame2 (make-object frame:basic% "test-not-shown")])
-       (send frame1 show #t)))
-   (wait-for-frame "test")
-   (send-sexp-to-mred
-    '(begin0 (map (lambda (x)
-                    (and (is-a? x labelled-menu-item<%>) (send x get-label)))
-                  (send (car* (send (send (get-top-level-focus-window)
-                                          get-menu-bar)
-                                    get-items))
-                        get-items))
-       (send (get-top-level-focus-window) close)))))
-
-(test
- 'windows-menu-sorted1
- (lambda (x)
-   (equal? x (append windows-menu-prefix (list "aaa" "bbb" "first"))))
- (lambda ()
-   (send-sexp-to-mred
-    '(let ([frame (make-object frame:basic% "aaa")])
-       (send frame show #t)))
-   (wait-for-frame "aaa")
-   (send-sexp-to-mred
-    '(let ([frame (make-object frame:basic% "bbb")])
-       (send frame show #t)))
-   (wait-for-frame "bbb")
-   (send-sexp-to-mred
-    `(let ([frames (send (group:get-the-frame-group) get-frames)])
-       (begin0 (map (lambda (x)
+(when (eq? (system-type) 'macosx)
+  
+  (test
+   'windows-menu
+   (lambda (x)
+     (equal? x (append windows-menu-prefix (list "first" "test"))))
+   (lambda ()
+     (send-sexp-to-mred
+      '(let ([frame (make-object frame:basic% "test")])
+         (send frame show #t)))
+     (wait-for-frame "test")
+     (send-sexp-to-mred
+      '(begin0 (map (lambda (x)
                       (and (is-a? x labelled-menu-item<%>) (send x get-label)))
-                    (send (car* (send (send (car* frames) get-menu-bar)
+                    (send (car* (send (send (get-top-level-focus-window)
+                                            get-menu-bar)
                                       get-items))
                           get-items))
-         (for-each (lambda (x)
-                     (unless (equal? (send x get-label) "first")
-                       (send x close)))
-                   frames))))))
-
-(test
- 'windows-menu-sorted2
- (lambda (x)
-   (equal? x (append windows-menu-prefix (list "aaa" "bbb" "first"))))
- (lambda ()
-   (send-sexp-to-mred
-    '(let ([frame (make-object frame:basic% "bbb")])
-       (send frame show #t)))
-   (wait-for-frame "bbb")
-   (send-sexp-to-mred
-    '(let ([frame (make-object frame:basic% "aaa")])
-       (send frame show #t)))
-   (wait-for-frame "aaa")
-   (send-sexp-to-mred
-    `(let ([frames (send (group:get-the-frame-group) get-frames)])
-       (begin0 (map (lambda (x)
+               (send (get-top-level-focus-window) close)))))
+  
+  (test
+   'windows-menu-unshown
+   (lambda (x)
+     (equal? x (append windows-menu-prefix (list "first" "test"))))
+   (lambda ()
+     (send-sexp-to-mred
+      '(let ([frame1 (make-object frame:basic% "test")]
+             [frame2 (make-object frame:basic% "test-not-shown")])
+         (send frame1 show #t)))
+     (wait-for-frame "test")
+     (send-sexp-to-mred
+      '(begin0 (map (lambda (x)
                       (and (is-a? x labelled-menu-item<%>) (send x get-label)))
-                    (send (car* (send (send (car* frames) get-menu-bar)
+                    (send (car* (send (send (get-top-level-focus-window)
+                                            get-menu-bar)
                                       get-items))
                           get-items))
-         (for-each (lambda (x)
-                     (unless (equal? (send x get-label) "first")
-                       (send x close)))
-                   frames))))))
+               (send (get-top-level-focus-window) close)))))
+  
+  (test
+   'windows-menu-sorted1
+   (lambda (x)
+     (equal? x (append windows-menu-prefix (list "aaa" "bbb" "first"))))
+   (lambda ()
+     (send-sexp-to-mred
+      '(let ([frame (make-object frame:basic% "aaa")])
+         (send frame show #t)))
+     (wait-for-frame "aaa")
+     (send-sexp-to-mred
+      '(let ([frame (make-object frame:basic% "bbb")])
+         (send frame show #t)))
+     (wait-for-frame "bbb")
+     (send-sexp-to-mred
+      `(let ([frames (send (group:get-the-frame-group) get-frames)])
+         (begin0 (map (lambda (x)
+                        (and (is-a? x labelled-menu-item<%>) (send x get-label)))
+                      (send (car* (send (send (car* frames) get-menu-bar)
+                                        get-items))
+                            get-items))
+                 (for-each (lambda (x)
+                             (unless (equal? (send x get-label) "first")
+                               (send x close)))
+                           frames))))))
+  
+  (test
+   'windows-menu-sorted2
+   (lambda (x)
+     (equal? x (append windows-menu-prefix (list "aaa" "bbb" "first"))))
+   (lambda ()
+     (send-sexp-to-mred
+      '(let ([frame (make-object frame:basic% "bbb")])
+         (send frame show #t)))
+     (wait-for-frame "bbb")
+     (send-sexp-to-mred
+      '(let ([frame (make-object frame:basic% "aaa")])
+         (send frame show #t)))
+     (wait-for-frame "aaa")
+     (send-sexp-to-mred
+      `(let ([frames (send (group:get-the-frame-group) get-frames)])
+         (begin0 (map (lambda (x)
+                        (and (is-a? x labelled-menu-item<%>) (send x get-label)))
+                      (send (car* (send (send (car* frames) get-menu-bar)
+                                        get-items))
+                            get-items))
+                 (for-each (lambda (x)
+                             (unless (equal? (send x get-label) "first")
+                               (send x close)))
+                           frames))))))
+  )
\ No newline at end of file

From fb73b168d1ebfc01de2b282fdc3917024ffe398c Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 18 Feb 2010 21:07:05 +0000
Subject: [PATCH 2/9] Adding testing for zo parser/marshaller/decompiler

svn: r18155
---
 collects/tests/compiler/zo-test.ss | 338 +++++++++++++++++++++++++++++
 1 file changed, 338 insertions(+)
 create mode 100644 collects/tests/compiler/zo-test.ss

diff --git a/collects/tests/compiler/zo-test.ss b/collects/tests/compiler/zo-test.ss
new file mode 100644
index 0000000000..137a7866a0
--- /dev/null
+++ b/collects/tests/compiler/zo-test.ss
@@ -0,0 +1,338 @@
+#lang scheme
+(require compiler/zo-parse
+         compiler/zo-marshal
+         compiler/decompile
+         setup/dirs)
+
+;; Helpers
+(define (bytes-gulp f)
+  (with-input-from-file f 
+    (λ () (port->bytes (current-input-port)))))
+(define (zo-parse/bytes bs)
+  (define ib (open-input-bytes bs))
+  (dynamic-wind void
+                (lambda ()
+                  (zo-parse ib))
+                (lambda ()
+                  (close-input-port ib))))
+
+(define (bytes-not-equal?-error b1 b2)
+  (unless (bytes=? b1 b2)
+    (error 'bytes-not-equal?-error "Not equal")))
+
+(define (replace-file file bytes)
+  (with-output-to-file file
+    (λ () (write-bytes bytes))
+    #:exists 'truncate))
+
+(define ((make-recorder! ht) file phase)
+  (hash-update! ht phase (curry list* file) empty))
+
+(define (equal?/why-not v1 v2)
+  (define (yield p m v1 v2)
+    (error 'equal?/why-not "~a in ~a: ~S ~S"
+           m (reverse p) v1 v2))
+  (define (inner p v1 v2)
+    (unless (eq? v1 v2)
+      (match v1
+        [(cons car1 cdr1)
+         (match v2
+           [(cons car2 cdr2)
+            (inner (list* 'car p) car1 car2)
+            (inner (list* 'cdr p) cdr1 cdr2)]
+           [_
+            (yield p "Not a cons on right" v1 v2)])]
+        [(? vector?)
+         (match v2
+           [(? vector?)
+            (define v1l (vector-length v1))
+            (define v2l (vector-length v2))
+            (if (= v1l v2l)
+                (for ([i (in-range v1l)])
+                  (inner (list* `(vector-ref ,i) p)
+                         (vector-ref v1 i)
+                         (vector-ref v2 i)))
+                (yield p "Vector lengths not equal" v1 v2))]
+           [_
+            (yield p "Not a vector on right" v1 v2)])]
+        [(? struct?)
+         (match v2
+           [(? struct?)
+            (define vv1 (struct->vector v1))
+            (define vv2 (struct->vector v2))
+            (inner (list* `(struct->vector ,(vector-ref vv1 0)) p)
+                   vv1 vv2)]
+           [_
+            (yield p "Not a struct on right" v1 v2)])]
+        [(? hash?)
+         (match v2
+           [(? hash?)
+            (let ([p (list* 'in-hash p)])
+              (for ([(k1 hv1) (in-hash v1)])
+                (define hv2 
+                  (hash-ref v2 k1
+                            (lambda ()
+                              (yield p (format "~S not in hash on right" k1) v1 v2))))
+                (inner (list* `(hash-ref ,k1) p)
+                       hv1 hv2)))]
+           [_
+            (yield p "Not a hash on right" v1 v2)])]
+        [(? module-path-index?)
+         (match v2
+           [(? module-path-index?)
+            (define-values (mp1 bmpi1) (module-path-index-split v1))
+            (define-values (mp2 bmpi2) (module-path-index-split v2))
+            (inner (list* 'module-path-index-split_0 p) mp1 mp2)
+            (inner (list* 'module-path-index-split_1 p) bmpi1 bmpi2)]
+           [_
+            (yield p "Not a module path index on right" v1 v2)])]
+        [(? string?)
+         (match v2
+           [(? string?)
+            (unless (string=? v1 v2)
+              (yield p "Unequal strings" v1 v2))]
+           [_
+            (yield p "Not a string on right" v1 v2)])]
+        [(? path?)
+         (match v2
+           [(? path?)
+            (unless (equal? v1 v2)
+              (yield p "Unequal paths" v1 v2))]
+           [_
+            (yield p "Not a path on right" v1 v2)])]
+        [(? number?)
+         (match v2
+           [(? number?)
+            (unless (equal? v1 v2)
+              (yield p "Unequal numbers" v1 v2))]
+           [_
+            (yield p "Not a number on right" v1 v2)])]
+        [(? symbol?)
+         (match v2
+           [(? symbol?)
+            (do-compare (symbol-interned?
+                         symbol-unreadable?)
+                        yield p v1 v2
+                        symbol=?)]
+           [_
+            (yield p "Not a symbol on right" v1 v2)])]        
+        [_
+         (yield p "Cannot inspect values deeper" v1 v2)])))
+  (inner empty v1 v2))  
+
+(define-syntax do-compare 
+  (syntax-rules ()
+    [(_ () yield p v1 v2 =) 
+     (unless (= v1 v2)
+       (yield p (format "Not ~a" '=) v1 v2))]
+    [(_ (?1 ? ...) yield p v1 v2 =)
+     (if (?1 v1)
+         (if (?1 v2)
+             (do-compare () yield (list* '?1 p) v1 v2 =)
+             (yield p (format "Not ~a or right" '?1) v1 v2))
+         (do-compare (? ...) yield p v1 v2 =))]))
+
+;; Parameters
+(define stop-on-first-error (make-parameter #f))
+(define verbose-mode (make-parameter #f))
+(define care-about-nonserious? (make-parameter #t))
+(define invariant-output (make-parameter #f))
+(define time-limit (make-parameter +inf.0))
+(define randomize (make-parameter #f))
+
+;; Work
+(define errors (make-hash))
+
+(define (common-message exn)
+  (define given-messages (regexp-match #rx".*given" (exn-message exn)))
+  (if (and given-messages (not (empty? given-messages)))
+      (first given-messages)
+      (exn-message exn)))
+
+(define (exn-printer file phase serious? exn)
+  (hash-update! errors (common-message exn) add1 0)
+  (unless (and (not (care-about-nonserious?)) (not serious?))
+    (when (or (verbose-mode) (stop-on-first-error))
+      (printf "~a -- ~a: ~a~n" file phase (exn-message exn)))
+    (when (stop-on-first-error)
+      exn)))
+
+(define (run-with-time-limit t thnk)
+  (define th (thread thnk))
+  (sync th
+        (handle-evt (alarm-evt (+ (current-inexact-milliseconds)
+                                  (* 1000 t)))
+                    (lambda _
+                      (kill-thread th)))))
+
+(define (run-with-limit file k thnk)
+  (define file-custodian (make-custodian))
+  (define ch (make-channel))
+  (custodian-limit-memory file-custodian k)
+  (local [(define worker-thread
+            (parameterize ([current-custodian file-custodian])
+              (thread
+               (lambda ()
+                 (define r (thnk))
+                 (channel-put ch r)
+                 (channel-get ch)))))]
+    (begin0
+      (sync
+       (handle-evt ch
+                   (lambda (v)
+                     (when (exn? v) (raise v))
+                     v))
+       (handle-evt worker-thread
+                   (lambda _
+                     (failure! file 'memory))))
+      (custodian-shutdown-all file-custodian))))
+
+(define success-ht (make-hasheq))
+(define success! (make-recorder! success-ht))
+(define failure-ht (make-hasheq))
+(define failure! (make-recorder! failure-ht))
+
+(define-syntax run/stages*
+  (syntax-rules ()
+    [(_ file) (success! file 'everything)]
+    [(_ file [step1 serious? e] . rst)
+     (let/ec esc
+       (let ([step1 (with-handlers ([exn:fail? 
+                                     (lambda (x)
+                                       (failure! file 'step1)
+                                       (esc (exn-printer file 'step1 serious? x)))])
+                      e)])
+         (success! file 'step1)
+         (run/stages* file . rst)))]))
+
+(define-syntax-rule (define-stages (stages run!)
+                      file
+                      [stage serious? e] ...)
+  (define-values (stages run!)
+    (values '(stage ...)
+            (lambda (file)
+              (run/stages* file [stage serious? e] ...)))))
+
+(define-stages (stages run!)
+  file
+  [read-orig 
+   #t
+   (bytes-gulp file)]
+  [parse-orig 
+   #t
+   (zo-parse/bytes read-orig)]
+  [marshal-parsed 
+   #t
+   (zo-marshal parse-orig)]
+  #;[ignored 
+     #f
+     (printf "orig: ~a, marshalled: ~a~n"
+             (bytes-length read-orig)
+             (bytes-length marshal-parsed))]
+  [parse-marshalled 
+   #t
+   (zo-parse/bytes marshal-parsed)]
+  [compare-parsed-to-parsed-marshalled 
+   #f
+   (equal?/why-not parse-orig parse-marshalled)]
+  [marshal-marshalled 
+   #t
+   (zo-marshal parse-marshalled)]
+  [compare-marshalled-to-marshalled-marshalled 
+   #f
+   (bytes-not-equal?-error marshal-parsed marshal-marshalled)]
+  #;[replace-with-marshalled 
+     #t
+     (replace-file file marshal-marshalled)]
+  [decompile-parsed 
+   #t
+   (decompile parse-orig)]
+  [compare-orig-to-marshalled 
+   #f
+   (bytes-not-equal?-error read-orig marshal-parsed)])
+
+(define (run-test file)
+  (run-with-limit 
+   file
+   (* 1024 1024 128)
+   (lambda ()
+     (run! file))))
+
+(define (randomize-list l)
+  (define ll (length l))
+  (define seen? (make-hasheq))
+  (let loop ([t 0])
+    (if (= t ll)
+        empty
+        (let ([i (random ll)])
+          (if (hash-has-key? seen? i)
+              (loop t)
+              (begin (hash-set! seen? i #t)
+                     (list* (list-ref l i)
+                            (loop (add1 t)))))))))
+
+(define (maybe-randomize-list l)
+  (if (randomize) (randomize-list l) l))
+
+(define (for-zos ! p)
+  (define p-str (if (path? p) (path->string p) p))
+  (cond
+    [(directory-exists? p)
+     (for ([sp (in-list (maybe-randomize-list (directory-list p)))])
+       (for-zos ! (build-path p sp)))]
+    [(regexp-match #rx"\\.zo$" p-str)
+     (! p-str)]))
+
+(define (zo-test paths)
+  (run-with-time-limit 
+   (time-limit)
+   (lambda ()
+     (for-each (curry for-zos run-test) paths)))
+  
+  (unless (invariant-output)
+    (for ([kind-name (list* 'memory stages)])
+      (define fails (length (hash-ref failure-ht kind-name empty)))
+      (define succs (length (hash-ref success-ht kind-name empty)))
+      (define all (+ fails succs))
+      (unless (zero? all)
+        (printf "~S~n"
+                `(,kind-name
+                  (#f ,fails)
+                  (#t ,succs)
+                  ,all))))
+    (printf "~a tests passed~n" (length (hash-ref success-ht 'everything empty)))
+    
+    (printf "Common Errors:~n")
+    
+    (for ([p (in-list (sort (filter (λ (p) ((car p) . > . 10))
+                                    (hash-map errors (λ (k v) (cons v k))))
+                            > #:key car))])
+      (printf "~a:~n~a~n~n" (car p) (cdr p)))))
+
+; Run
+#;(current-command-line-arguments #("-s" "/home/bjohn3x/development/plt/collects/browser/compiled/browser_scrbl.zo"))
+(command-line #:program "zo-test" 
+              #:once-each
+              [("-s" "--stop-on-first-error") 
+               "Stop testing when first error is encountered"
+               (stop-on-first-error #t)]
+              [("-S")
+               "Don't take some errors seriously"
+               (care-about-nonserious? #f)]
+              [("-v" "--verbose")
+               "Display verbose error messages"
+               (verbose-mode #t)]
+              [("-I")
+               "Invariant output"
+               (invariant-output #t)]
+              [("-R")
+               "Randomize"
+               (randomize #t)]
+              [("-t") 
+               number
+               "Limit the run to a given amount of time"
+               (time-limit (string->number number))]
+              #:args p
+              (zo-test (if (empty? p)
+                           (list (find-collects-dir))
+                           p)))
\ No newline at end of file

From d9f24d94e7887956ec497ea97721b7c4e9196634 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 18 Feb 2010 21:25:06 +0000
Subject: [PATCH 3/9] disable contracts

svn: r18156
---
 collects/typed-scheme/utils/utils.ss | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/utils/utils.ss b/collects/typed-scheme/utils/utils.ss
index 7706c32709..f56fb8b3bf 100644
--- a/collects/typed-scheme/utils/utils.ss
+++ b/collects/typed-scheme/utils/utils.ss
@@ -161,7 +161,7 @@ at least theoretically.
 
 
 ;; turn contracts on and off - off by default for performance.
-(define-for-syntax enable-contracts? #t)
+(define-for-syntax enable-contracts? #f)
 (provide (for-syntax enable-contracts?) p/c w/c cnt d-s/c d/c)
 
 ;; these are versions of the contract forms conditionalized by `enable-contracts?'

From b68494250fff8a402a8bd9e51ee01521cac57bbd Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Thu, 18 Feb 2010 22:53:11 +0000
Subject: [PATCH 4/9] scheme/pretty: added quasisyntax reader macro
 macro-debugger: added change layout menu items

svn: r18166
---
 .../macro-debugger/syntax-browser/display.ss  |  1 +
 .../macro-debugger/syntax-browser/keymap.ss   | 29 +++++++++++++++++
 .../macro-debugger/syntax-browser/prefs.ss    |  4 +++
 .../syntax-browser/pretty-helper.ss           |  4 +--
 .../syntax-browser/pretty-printer.ss          | 32 +++++++++++--------
 collects/macro-debugger/view/stepper.ss       |  2 ++
 collects/scheme/pretty.ss                     |  4 ++-
 7 files changed, 59 insertions(+), 17 deletions(-)

diff --git a/collects/macro-debugger/syntax-browser/display.ss b/collects/macro-debugger/syntax-browser/display.ss
index 173419929e..dc0cb2e08c 100644
--- a/collects/macro-debugger/syntax-browser/display.ss
+++ b/collects/macro-debugger/syntax-browser/display.ss
@@ -37,6 +37,7 @@
                           (send: controller controller<%> get-primary-partition)
                           (length (send: config config<%> get-colors))
                           (send: config config<%> get-suffix-option)
+                          (send config get-pretty-styles)
                           columns))
    (define output-string (get-output-string output-port))
    (define output-length (sub1 (string-length output-string))) ;; skip final newline
diff --git a/collects/macro-debugger/syntax-browser/keymap.ss b/collects/macro-debugger/syntax-browser/keymap.ss
index e462cf73a0..3affaa4c07 100644
--- a/collects/macro-debugger/syntax-browser/keymap.ss
+++ b/collects/macro-debugger/syntax-browser/keymap.ss
@@ -74,6 +74,14 @@
                   (lambda (i e)
                     (send config set-props-shown? #f)))
 
+    (define ((pretty-print-as sym) i e)
+      (let ([stx (selected-syntax)])
+        (when (identifier? stx)
+          (send config set-pretty-styles
+                (hash-set (send config get-pretty-styles)
+                          (syntax-e stx)
+                          sym)))))
+
     (define/override (add-context-menu-items menu)
       (new menu-item% (label "Copy") (parent menu)
            (demand-callback
@@ -83,6 +91,27 @@
             (lambda (i e)
               (call-function "copy-syntax-as-text" i e))))
       (new separator-menu-item% (parent menu))
+      (let ([pretty-menu
+             (new menu%
+                  (label "Change layout")
+                  (parent menu)
+                  (demand-callback
+                   (lambda (i)
+                     (send i enable (and (identifier? (selected-syntax)) #t)))))])
+        (for ([sym+desc '((and    "like and")
+                          (begin  "like begin (0 up)")
+                          (lambda "like lambda (1 up)")
+                          (do     "like do (2 up)"))])
+          (new menu-item%
+               (label (format "Format identifier ~a" (cadr sym+desc)))
+               (parent pretty-menu)
+               (demand-callback
+                (lambda (i)
+                  (let ([stx (selected-syntax)])
+                    (send i set-label
+                          (format "Format ~s ~a" (syntax-e stx) (cadr sym+desc))))))
+               (callback
+                (pretty-print-as (car sym+desc))))))
       (new menu-item%
            (label "Clear selection")
            (parent menu)
diff --git a/collects/macro-debugger/syntax-browser/prefs.ss b/collects/macro-debugger/syntax-browser/prefs.ss
index 81d1f338ad..8df1e63ba3 100644
--- a/collects/macro-debugger/syntax-browser/prefs.ss
+++ b/collects/macro-debugger/syntax-browser/prefs.ss
@@ -24,6 +24,10 @@
     ;; suffix-option : SuffixOption
     (define-notify suffix-option (new notify-box% (value 'over-limit)))
 
+    ;; pretty-styles : ImmutableHash[symbol -> symbol]
+    (define-notify pretty-styles
+      (new notify-box% (value (make-immutable-hasheq null))))
+
     ;; syntax-font-size : number/#f
     ;; When non-false, overrides the default font size
     (define-notify syntax-font-size (new notify-box% (value #f)))
diff --git a/collects/macro-debugger/syntax-browser/pretty-helper.ss b/collects/macro-debugger/syntax-browser/pretty-helper.ss
index 456eff080e..af67d155d1 100644
--- a/collects/macro-debugger/syntax-browser/pretty-helper.ss
+++ b/collects/macro-debugger/syntax-browser/pretty-helper.ss
@@ -171,8 +171,8 @@
                     (list expr))))))
 
 (define special-expression-keywords
-  '(quote quasiquote unquote unquote-splicing syntax))
-;; FIXME: quasisyntax unsyntax unsyntax-splicing
+  '(quote quasiquote unquote unquote-splicing syntax
+    quasisyntax unsyntax unsyntax-splicing))
 
 (define (suffix sym n)
   (string->symbol (format "~a:~a" sym n)))
diff --git a/collects/macro-debugger/syntax-browser/pretty-printer.ss b/collects/macro-debugger/syntax-browser/pretty-printer.ss
index f0aa609545..4787e834f7 100644
--- a/collects/macro-debugger/syntax-browser/pretty-printer.ss
+++ b/collects/macro-debugger/syntax-browser/pretty-printer.ss
@@ -9,9 +9,9 @@
 
 ;; FIXME: Need to disable printing of structs with custom-write property
 
-;; pretty-print-syntax : syntax port partition number SuffixOption number
+;; pretty-print-syntax : syntax port partition number SuffixOption hasheq number
 ;;                    -> range%
-(define (pretty-print-syntax stx port primary-partition colors suffix-option columns)
+(define (pretty-print-syntax stx port primary-partition colors suffix-option styles columns)
   (define range-builder (new range-builder%))
   (define-values (datum ht:flat=>stx ht:stx=>flat)
     (syntax->datum/tables stx primary-partition colors suffix-option))
@@ -45,7 +45,7 @@
     [pretty-print-size-hook pp-size-hook]
     [pretty-print-print-hook pp-print-hook]
     [pretty-print-remap-stylable pp-remap-stylable]
-    [pretty-print-current-style-table (pp-better-style-table)]
+    [pretty-print-current-style-table (pp-better-style-table styles)]
     [pretty-print-columns columns])
    (pretty-print/defaults datum port)
    (new range%
@@ -72,8 +72,21 @@
 (define (pp-remap-stylable obj)
   (and (id-syntax-dummy? obj) (id-syntax-dummy-remap obj)))
 
-(define (pp-better-style-table)
-  (basic-style-list)
+(define (pp-better-style-table styles)
+  (define style-list (for/list ([(k v) (in-hash styles)]) (cons k v)))
+  (pretty-print-extend-style-table
+   (basic-style-list)
+   (map car style-list)
+   (map cdr style-list)))
+
+(define (basic-style-list)
+  (pretty-print-extend-style-table
+   (pretty-print-current-style-table)
+   (map car basic-styles)
+   (map cdr basic-styles)))
+(define basic-styles
+  '((define-values          . define)
+    (define-syntaxes        . define-syntax))
   #|
   ;; Messes up formatting too much :(
   (let* ([pref (pref:tabify)]
@@ -88,15 +101,6 @@
        (map cdr style-list))))
   |#)
 
-(define (basic-style-list)
-  (pretty-print-extend-style-table
-   (pretty-print-current-style-table)
-   (map car basic-styles)
-   (map cdr basic-styles)))
-(define basic-styles
-  '((define-values          . define)
-    (define-syntaxes        . define-syntax)))
-
 (define-local-member-name range:get-ranges)
 
 ;; range-builder%
diff --git a/collects/macro-debugger/view/stepper.ss b/collects/macro-debugger/view/stepper.ss
index 6d8287678c..bce676324a 100644
--- a/collects/macro-debugger/view/stepper.ss
+++ b/collects/macro-debugger/view/stepper.ss
@@ -168,6 +168,8 @@
        (lambda (_) (refresh/re-reduce)))
       (listen-extra-navigation?
        (lambda (show?) (show-extra-navigation show?))))
+    (send config listen-pretty-styles
+          (lambda (_) (update/preserve-view)))
 
     (define nav:up
       (new button% (label "Previous term") (parent navigator)
diff --git a/collects/scheme/pretty.ss b/collects/scheme/pretty.ss
index ee8f8dbcd7..6ec3e16224 100644
--- a/collects/scheme/pretty.ss
+++ b/collects/scheme/pretty.ss
@@ -1188,7 +1188,8 @@
      (and (pretty-print-abbreviate-read-macros)
           (let ((head (do-remap (car l))) (tail (cdr l)))
             (case head
-              ((quote quasiquote unquote unquote-splicing syntax unsyntax unsyntax-splicing)
+              ((quote quasiquote unquote unquote-splicing syntax
+                quasisyntax unsyntax unsyntax-splicing)
                (length1? tail))
               (else #f)))))
    
@@ -1203,6 +1204,7 @@
 	 ((unquote)           ",")
 	 ((unquote-splicing)  ",@")
 	 ((syntax)            "#'")
+         ((quasisyntax)       "#`")
 	 ((unsyntax)          "#,")
 	 ((unsyntax-splicing) "#,@"))))
   

From 982820fba20d3821d7d2c7a7068099b1d34de456 Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@racket-lang.org>
Date: Fri, 19 Feb 2010 01:06:11 +0000
Subject: [PATCH 5/9] fixed double-def of empty-scene

svn: r18177
---
 collects/2htdp/tests/image-equality-performance.ss | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/2htdp/tests/image-equality-performance.ss b/collects/2htdp/tests/image-equality-performance.ss
index 79960d210e..ffcddd64c9 100644
--- a/collects/2htdp/tests/image-equality-performance.ss
+++ b/collects/2htdp/tests/image-equality-performance.ss
@@ -35,7 +35,7 @@ Also added the timing code at the end.
                 b-res
                 line))))
    tests))
-
+#;
 (define (empty-scene w h) 
   (overlay
    (rectangle w h 'solid 'white)

From cb16dde709387c4398a1ec787d0e09771c1011ed Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Fri, 19 Feb 2010 05:45:54 +0000
Subject: [PATCH 6/9] macro-debugger: some work on syntax snips

svn: r18182
---
 .../macro-debugger/syntax-browser/display.ss  |   3 +-
 .../{syntax-snip.ss => snip-decorated.ss}     | 184 ++----------------
 .../macro-debugger/syntax-browser/snip.ss     | 181 +++++++++++++++++
 3 files changed, 204 insertions(+), 164 deletions(-)
 rename collects/macro-debugger/syntax-browser/{syntax-snip.ss => snip-decorated.ss} (52%)
 create mode 100644 collects/macro-debugger/syntax-browser/snip.ss

diff --git a/collects/macro-debugger/syntax-browser/display.ss b/collects/macro-debugger/syntax-browser/display.ss
index dc0cb2e08c..563a932cfd 100644
--- a/collects/macro-debugger/syntax-browser/display.ss
+++ b/collects/macro-debugger/syntax-browser/display.ss
@@ -29,7 +29,8 @@
 
 ;; print-syntax-to-editor : syntax text controller<%> config number number
 ;;                       -> display<%>
-(define (print-syntax-to-editor stx text controller config columns insertion-point)
+(define (print-syntax-to-editor stx text controller config columns
+                                [insertion-point (send text last-position)])
   (begin-with-definitions
    (define output-port (open-output-string/count-lines))
    (define range
diff --git a/collects/macro-debugger/syntax-browser/syntax-snip.ss b/collects/macro-debugger/syntax-browser/snip-decorated.ss
similarity index 52%
rename from collects/macro-debugger/syntax-browser/syntax-snip.ss
rename to collects/macro-debugger/syntax-browser/snip-decorated.ss
index c5063b0c4b..55f0574048 100644
--- a/collects/macro-debugger/syntax-browser/syntax-snip.ss
+++ b/collects/macro-debugger/syntax-browser/snip-decorated.ss
@@ -2,76 +2,17 @@
 (require scheme/class
          (rename-in unstable/class-iop
                     [send/i send:])
-         scheme/match
-         scheme/list
          mzlib/string
          mred
-         framework
-         unstable/gui/notify
          "interfaces.ss"
-         "display.ss"
          "controller.ss"
-         "keymap.ss"
          "properties.ss"
-         "partition.ss"
-         "prefs.ss")
+         "prefs.ss"
+         (except-in "snip.ss"
+                    snip-class))
 
-(provide syntax-snip%
-         syntax-value-snip%)
-
-(define syntax-snip-config%
-  (class prefs-base%
-    (define-notify props-shown? (new notify-box% (value #f)))
-    (super-new)))
-
-;; syntax-value-snip%
-(define syntax-value-snip%
-  (class* editor-snip% (readable-snip<%>)
-    (init-field ((stx syntax)))
-    (init-field (controller (new controller%)))
-    (init-field (config (new syntax-snip-config%)))
-
-    (inherit set-margin
-             set-inset)
-
-    (define text (new text:standard-style-list%))
-    (super-new (editor text) (with-border? #f))
-
-    (set-margin 0 0 0 0)
-    ;;(set-inset 2 2 2 2)
-    ;;(set-margin 2 2 2 2)
-    (set-inset 0 0 0 0)
-
-    (send text begin-edit-sequence)
-    (send text change-style (make-object style-delta% 'change-alignment 'top))
-    (define display
-      (print-syntax-to-editor stx text controller config))
-    (send text lock #t)
-    (send text end-edit-sequence)
-    (send text hide-caret #t)
-
-    (setup-keymap text)
-
-    (define/public (setup-keymap text)
-      (new syntax-keymap%
-           (controller controller)
-           (config config)
-           (editor text)))
-
-    ;; snip% Methods
-    (define/override (copy)
-      (new syntax-value-snip%
-           (config config)
-           (controller controller)
-           (syntax stx)))
-
-    ;; read-special : any number/#f number/#f number/#f -> syntax
-    ;; Produces 3D syntax to preserve eq-ness of syntax
-    ;; #'#'stx would be lose identity when wrapped
-    (define/public (read-special src line col pos)
-      (with-syntax ([p (lambda () stx)])
-        #'(p)))
-    ))
+(provide decorated-syntax-snip%
+         snip-class)
 
 (define top-aligned
   (make-object style-delta% 'change-alignment 'top))
@@ -155,18 +96,18 @@
     (refresh-contents)
     ))
 
-;; syntax-snip%
-(define syntax-snip%
+;; decorated-syntax-snip%
+(define decorated-syntax-snip%
   (class* clicky-snip% (readable-snip<%>)
     (init-field ((stx syntax)))
     (init-field [controller (new controller%)])
-    (init-field [config (new syntax-snip-config%)])
+    (init-field [config (new syntax-prefs%)])
 
     (inherit set-snipclass
              refresh-contents)
 
     (define the-syntax-snip
-      (new syntax-value-snip%
+      (new syntax-snip%
            (syntax stx)
            (controller controller)
            (config config)))
@@ -193,7 +134,10 @@
 
     ;; Snip methods
     (define/override (copy)
-      (new syntax-snip% (syntax stx)))
+      (new decorated-syntax-snip%
+           (syntax stx)
+           (controller controller)
+           (config config)))
     (define/override (write stream)
       (send stream put
             (string->bytes/utf-8
@@ -251,105 +195,19 @@
   (make-object image-snip%
     (build-path (collection-path "icons") "syncheck.png")))
 
-;; marshall-syntax : syntax -> printable
-(define (marshall-syntax stx)
-  (unless (syntax? stx)
-    (error 'marshall-syntax "not syntax: ~s\n" stx))
-  `(syntax
-    (source ,(marshall-object (syntax-source stx)))
-    (source-module ,(marshall-object (syntax-source-module stx)))
-    (position ,(syntax-position stx))
-    (line ,(syntax-line stx))
-    (column ,(syntax-column stx))
-    (span ,(syntax-span stx))
-    (original? ,(syntax-original? stx))
-    (properties 
-     ,@(map (λ (x) `(,x ,(marshall-object (syntax-property stx x))))
-            (syntax-property-symbol-keys stx)))
-    (contents
-     ,(marshall-object (syntax-e stx)))))
 
-;; marshall-object : any -> printable
-;; really only intended for use with marshall-syntax
-(define (marshall-object obj)
-  (cond
-    [(syntax? obj) (marshall-syntax obj)]
-    [(pair? obj) 
-     `(pair ,(cons (marshall-object (car obj))
-                   (marshall-object (cdr obj))))]
-    [(or (symbol? obj)
-         (char? obj)
-         (number? obj)
-         (string? obj)
-         (boolean? obj)
-         (null? obj))
-     `(other ,obj)]
-    [else (string->symbol (format "unknown-object: ~s" obj))]))
+;; SNIPCLASS
 
 ;; COPIED AND MODIFIED from mrlib/syntax-browser.ss
-(define syntax-snipclass%
+(define decorated-syntax-snipclass%
   (class snip-class%
     (define/override (read stream)
-      (make-object syntax-snip%
-        (unmarshall-syntax (read-from-string (send stream get-bytes)))))
-    (super-instantiate ())))
+      (new decorated-syntax-snip%
+           (syntax (unmarshall-syntax
+                    (read-from-string (send stream get-bytes))))))
+    (super-new)))
 
-(define snip-class (make-object syntax-snipclass%))
+(define snip-class (make-object decorated-syntax-snipclass%))
 (send snip-class set-version 2)
 (send snip-class set-classname
-      (format "~s" '(lib "implementation.ss" "macro-debugger" "syntax-browser")))
-(send (get-the-snip-class-list) add snip-class)
-
-(define (unmarshall-syntax stx)
-  (match stx
-    [`(syntax
-       (source ,src)
-       (source-module ,source-module) ;; marshalling
-       (position ,pos)
-       (line ,line)
-       (column ,col)
-       (span ,span)
-       (original? ,original?)
-       (properties . ,properties)
-       (contents ,contents))
-      (foldl
-       add-properties
-       (datum->syntax
-        #'here ;; ack
-        (unmarshall-object contents)
-        (list (unmarshall-object src)
-              line
-              col
-              pos
-              span))
-       properties)]
-    [else #'unknown-syntax-object]))
-
-;; add-properties : syntax any -> syntax
-(define (add-properties prop-spec stx)
-  (match prop-spec
-    [`(,(and sym (? symbol?))
-        ,prop)
-      (syntax-property stx sym (unmarshall-object prop))]
-    [else stx]))
-
-(define (unmarshall-object obj)
-  (let ([unknown (lambda () (string->symbol (format "unknown: ~s" obj)))])
-    (if (and (pair? obj)
-             (symbol? (car obj)))
-        (case (car obj)
-          [(pair) 
-           (if (pair? (cdr obj))
-               (let ([raw-obj (cadr obj)])
-                 (if (pair? raw-obj)
-                     (cons (unmarshall-object (car raw-obj))
-                           (unmarshall-object (cdr raw-obj)))
-                     (unknown)))
-               (unknown))]
-          [(other) 
-           (if (pair? (cdr obj))
-               (cadr obj)
-               (unknown))]
-          [(syntax) (unmarshall-syntax obj)]
-          [else (unknown)])
-        (unknown))))
+      (format "~s" '(lib "macro-debugger/syntax-browser/snip-decorated.ss")))
diff --git a/collects/macro-debugger/syntax-browser/snip.ss b/collects/macro-debugger/syntax-browser/snip.ss
new file mode 100644
index 0000000000..7116afcbff
--- /dev/null
+++ b/collects/macro-debugger/syntax-browser/snip.ss
@@ -0,0 +1,181 @@
+#lang scheme/base
+(require scheme/class
+         (rename-in unstable/class-iop
+                    [send/i send:])
+         scheme/match
+         mzlib/string
+         mred
+         framework
+         "interfaces.ss"
+         "display.ss"
+         "controller.ss"
+         "keymap.ss"
+         "prefs.ss")
+
+(provide syntax-snip%
+         marshall-syntax
+         unmarshall-syntax
+         snip-class)
+
+;; syntax-snip%
+(define syntax-snip%
+  (class* editor-snip% (readable-snip<%>)
+    (init-field ((stx syntax)))
+    (init-field (controller (new controller%)))
+    (init-field (config (new syntax-prefs/readonly%)))
+    (init-field (columns 40))
+
+    (inherit set-margin
+             set-inset
+             set-snipclass)
+
+    (define text (new text:standard-style-list%))
+    (super-new (editor text) (with-border? #f))
+
+    (set-margin 0 0 0 0)
+    ;;(set-inset 2 2 2 2)
+    ;;(set-margin 2 2 2 2)
+    (set-inset 0 0 0 0)
+
+    (send text begin-edit-sequence)
+    (send text change-style (make-object style-delta% 'change-alignment 'top))
+    (define display
+      (print-syntax-to-editor stx text controller config columns))
+    (send text lock #t)
+    (send text end-edit-sequence)
+    (send text hide-caret #t)
+
+    (setup-keymap text)
+
+    (define/public (setup-keymap text)
+      (new syntax-keymap%
+           (controller controller)
+           (config config)
+           (editor text)))
+
+    ;; snip% Methods
+    (define/override (copy)
+      (new syntax-snip%
+           (config config)
+           (controller controller)
+           (syntax stx)))
+
+    ;; read-special : any number/#f number/#f number/#f -> syntax
+    ;; Produces 3D syntax to preserve eq-ness of syntax
+    ;; #'#'stx would be lose identity when wrapped
+    (define/public (read-special src line col pos)
+      (with-syntax ([p (lambda () stx)])
+        #'(p)))
+    
+    (define/override (write stream)
+      (send stream put
+            (string->bytes/utf-8
+             (format "~s" (marshall-syntax stx)))))
+
+    (set-snipclass snip-class)))
+
+;; Marshalling stuff
+
+;; marshall-syntax : syntax -> printable
+(define (marshall-syntax stx)
+  (unless (syntax? stx)
+    (error 'marshall-syntax "not syntax: ~s\n" stx))
+  `(syntax
+    (source ,(marshall-object (syntax-source stx)))
+    (source-module ,(marshall-object (syntax-source-module stx)))
+    (position ,(syntax-position stx))
+    (line ,(syntax-line stx))
+    (column ,(syntax-column stx))
+    (span ,(syntax-span stx))
+    (original? ,(syntax-original? stx))
+    (properties 
+     ,@(map (λ (x) `(,x ,(marshall-object (syntax-property stx x))))
+            (syntax-property-symbol-keys stx)))
+    (contents
+     ,(marshall-object (syntax-e stx)))))
+
+;; marshall-object : any -> printable
+;; really only intended for use with marshall-syntax
+(define (marshall-object obj)
+  (cond
+    [(syntax? obj) (marshall-syntax obj)]
+    [(pair? obj) 
+     `(pair ,(cons (marshall-object (car obj))
+                   (marshall-object (cdr obj))))]
+    [(or (symbol? obj)
+         (char? obj)
+         (number? obj)
+         (string? obj)
+         (boolean? obj)
+         (null? obj))
+     `(other ,obj)]
+    [else (string->symbol (format "unknown-object: ~s" obj))]))
+
+(define (unmarshall-syntax stx)
+  (match stx
+    [`(syntax
+       (source ,src)
+       (source-module ,source-module) ;; marshalling
+       (position ,pos)
+       (line ,line)
+       (column ,col)
+       (span ,span)
+       (original? ,original?)
+       (properties . ,properties)
+       (contents ,contents))
+      (foldl
+       add-properties
+       (datum->syntax
+        #'here ;; ack
+        (unmarshall-object contents)
+        (list (unmarshall-object src)
+              line
+              col
+              pos
+              span))
+       properties)]
+    [else #'unknown-syntax-object]))
+
+;; add-properties : syntax any -> syntax
+(define (add-properties prop-spec stx)
+  (match prop-spec
+    [`(,(and sym (? symbol?))
+        ,prop)
+      (syntax-property stx sym (unmarshall-object prop))]
+    [else stx]))
+
+(define (unmarshall-object obj)
+  (let ([unknown (lambda () (string->symbol (format "unknown: ~s" obj)))])
+    (if (and (pair? obj)
+             (symbol? (car obj)))
+        (case (car obj)
+          [(pair) 
+           (if (pair? (cdr obj))
+               (let ([raw-obj (cadr obj)])
+                 (if (pair? raw-obj)
+                     (cons (unmarshall-object (car raw-obj))
+                           (unmarshall-object (cdr raw-obj)))
+                     (unknown)))
+               (unknown))]
+          [(other) 
+           (if (pair? (cdr obj))
+               (cadr obj)
+               (unknown))]
+          [(syntax) (unmarshall-syntax obj)]
+          [else (unknown)])
+        (unknown))))
+
+;; SNIPCLASS
+
+;; COPIED AND MODIFIED from mrlib/syntax-browser.ss
+(define syntax-snipclass%
+  (class snip-class%
+    (define/override (read stream)
+      (make-object syntax-snip%
+        (unmarshall-syntax (read-from-string (send stream get-bytes)))))
+    (super-instantiate ())))
+
+(define snip-class (new syntax-snipclass%))
+(send snip-class set-version 2)
+(send snip-class set-classname
+      (format "~s" '(lib "macro-debugger/syntax-browser/snip.ss")))

From 94666a89cdb059b16d528beebbb3dd576d1fde6c Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Fri, 19 Feb 2010 08:50:39 +0000
Subject: [PATCH 7/9] Welcome to a new PLT day.

svn: r18183
---
 collects/repos-time-stamp/stamp.ss | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss
index b7761dac2d..04535d4c6b 100644
--- a/collects/repos-time-stamp/stamp.ss
+++ b/collects/repos-time-stamp/stamp.ss
@@ -1 +1 @@
-#lang scheme/base (provide stamp) (define stamp "18feb2010")
+#lang scheme/base (provide stamp) (define stamp "19feb2010")

From 94880b47332bfc0bdd3d1b15ff22746be5cb2843 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 19 Feb 2010 15:03:12 +0000
Subject: [PATCH 8/9] changed some one-of/c's to or/c's

svn: r18185
---
 collects/scribblings/gui/editor-intf.scrbl    |  78 ++++++------
 .../scribblings/gui/style-delta-class.scrbl   | 120 +++++++++---------
 collects/scribblings/gui/text-class.scrbl     |  28 ++--
 3 files changed, 113 insertions(+), 113 deletions(-)

diff --git a/collects/scribblings/gui/editor-intf.scrbl b/collects/scribblings/gui/editor-intf.scrbl
index b5ec74131d..ada8f3efa6 100644
--- a/collects/scribblings/gui/editor-intf.scrbl
+++ b/collects/scribblings/gui/editor-intf.scrbl
@@ -260,9 +260,9 @@ Propagates the request to any snip with the editor-local focus.
 
 }}
 
-@defmethod[(can-do-edit-operation? [op (one-of/c 'undo 'redo 'clear 'cut 'copy 'paste 
-                                                 'kill 'select-all 'insert-text-box 
-                                                 'insert-pasteboard-box 'insert-image)]
+@defmethod[(can-do-edit-operation? [op (or/c 'undo 'redo 'clear 'cut 'copy 'paste 
+                                             'kill 'select-all 'insert-text-box 
+                                             'insert-pasteboard-box 'insert-image)]
                                    [recursive? any/c #t])
            boolean?]{
 @methspec{
@@ -282,8 +282,8 @@ locked, etc.
 
 @defmethod[#:mode pubment 
            (can-load-file? [filename path?]
-                           [format (one-of/c 'guess 'same 'copy 'standard
-                                             'text 'text-force-cr)])
+                           [format (or/c 'guess 'same 'copy 'standard
+                                         'text 'text-force-cr)])
            boolean?]{
 @methspec{
 
@@ -308,8 +308,8 @@ Returns @scheme[#t].
 
 @defmethod[#:mode pubment 
            (can-save-file? [filename path?]
-                           [format (one-of/c 'guess 'same 'copy 'standard
-                                             'text 'text-force-cr)])
+                           [format (or/c 'guess 'same 'copy 'standard
+                                         'text 'text-force-cr)])
            boolean?]{
 @methspec{
 
@@ -462,9 +462,9 @@ Returns the name of a style to be used for newly inserted text,
 See @xmethod[text% do-copy] or @xmethod[pasteboard% do-copy].}
 
 
-@defmethod[(do-edit-operation [op (one-of/c 'undo 'redo 'clear 'cut 'copy 'paste 
-                                            'kill 'select-all 'insert-text-box 
-                                            'insert-pasteboard-box 'insert-image)]
+@defmethod[(do-edit-operation [op (or/c 'undo 'redo 'clear 'cut 'copy 'paste 
+                                        'kill 'select-all 'insert-text-box 
+                                        'insert-pasteboard-box 'insert-image)]
                               [recursive? any/c #t]
                               [time (and/c exact? integer?) 0])
            void?]{
@@ -700,7 +700,7 @@ See also @method[editor<%> set-caret-owner].
 
 
 @defmethod[(get-inactive-caret-threshold)
-           (one-of/c 'no-caret 'show-inactive-caret 'show-caret)]{
+           (or/c 'no-caret 'show-inactive-caret 'show-caret)]{
 
 Returns the threshold for painting an inactive selection. This
  threshold is compared with the @scheme[draw-caret] argument to
@@ -928,7 +928,7 @@ Inserts data into the editor. A snip cannot be inserted into multiple
 }
 
 
-@defmethod[(insert-box [type (one-of/c 'text 'pasteboard) 'text])
+@defmethod[(insert-box [type (or/c 'text 'pasteboard) 'text])
            void?]{
 
 Inserts a box (a sub-editor) into the editor by calling
@@ -941,13 +941,13 @@ inserts the resulting snip into the editor.
 
 
 @defmethod*[([(insert-file [filename path-string?]
-                           [format (one-of/c 'guess 'same 'copy 'standard
-                                             'text 'text-force-cr) 'guess]
+                           [format (or/c 'guess 'same 'copy 'standard
+                                         'text 'text-force-cr) 'guess]
                            [show-errors? any/c #t])
               boolean?]
              [(insert-file [port input-port?]
-                           [format (one-of/c 'guess 'same 'copy 'standard
-                                             'text 'text-force-cr) 'guess]
+                           [format (or/c 'guess 'same 'copy 'standard
+                                         'text 'text-force-cr) 'guess]
                            [show-errors? any/c #t])
               boolean?])]{
 
@@ -967,7 +967,7 @@ The @scheme[show-errors?] argument is no longer used.
 
 
 @defmethod[(insert-image [filename (or/c path-string? #f) #f]
-                         [type (one-of/c 'unknown 'gif 'jpeg 'xbm 'xpm 'bmp 'pict) 'unknown]
+                         [type (or/c 'unknown 'gif 'jpeg 'xbm 'xpm 'bmp 'pict) 'unknown]
                          [relative-path? any/c #f]
                          [inline? any/c #t])
            void?]{
@@ -989,10 +989,10 @@ calling
 }
 
 @defmethod[(insert-port [port input-port?]
-                        [format (one-of/c 'guess 'same 'copy 'standard
-                                          'text 'text-force-cr) 'guess]
+                        [format (or/c 'guess 'same 'copy 'standard
+                                      'text 'text-force-cr) 'guess]
                         [replace-styles? any/c #t])
-           (one-of/c 'standard 'text 'text-force-cr)]{
+           (or/c 'standard 'text 'text-force-cr)]{
 
 Use @method[editor<%> insert-file], instead.
 
@@ -1081,8 +1081,8 @@ See also @method[editor<%> cut].
 
 
 @defmethod[(load-file [filename (or/c path-string? #f) #f]
-                      [format (one-of/c 'guess 'same 'copy 'standard
-                                        'text 'text-force-cr) 'guess]
+                      [format (or/c 'guess 'same 'copy 'standard
+                                    'text 'text-force-cr) 'guess]
                       [show-errors? any/c #t])
            boolean?]{
 
@@ -1442,8 +1442,8 @@ Either passes this event on to a caret-owning snip, selects a new
 
 @defmethod[#:mode pubment 
            (on-load-file [filename path?]
-                         [format (one-of/c 'guess 'same 'copy 'standard
-                                           'text 'text-force-cr)])
+                         [format (or/c 'guess 'same 'copy 'standard
+                                       'text 'text-force-cr)])
            void?]{
 @methspec{
 
@@ -1503,7 +1503,7 @@ Either lets the keymap handle the event or calls
 }}
 
 
-@defmethod[(on-new-box [type (one-of/c 'text 'pasteboard)])
+@defmethod[(on-new-box [type (or/c 'text 'pasteboard)])
            (is-a?/c snip%)]{
 @methspec{
 
@@ -1524,7 +1524,7 @@ Creates a @scheme[editor-snip%] with either a sub-editor from
 
 
 @defmethod[(on-new-image-snip [filename path?]
-                              [kind (one-of/c 'unknown 'gif 'jpeg 'xbm 'xpm 'bmp 'pict)]
+                              [kind (or/c 'unknown 'gif 'jpeg 'xbm 'xpm 'bmp 'pict)]
                               [relative-path? any/c]
                               [inline? any/c])
            (is-a?/c image-snip%)]{
@@ -1552,7 +1552,7 @@ Returns @scheme[(make-object image-snip% filename kind relative-path? inline?)].
                      [bottom real?]
                      [dx real?]
                      [dy real?]
-                     [draw-caret (one-of/c 'no-caret 'show-inactive-caret 'show-caret)])
+                     [draw-caret (or/c 'no-caret 'show-inactive-caret 'show-caret)])
            void?]{
 @methspec{
 
@@ -1602,8 +1602,8 @@ Does nothing.
 
 @defmethod[#:mode pubment 
            (on-save-file [filename path?]
-                         [format (one-of/c 'guess 'same 'copy 'standard
-                                           'text 'text-force-cr)])
+                         [format (or/c 'guess 'same 'copy 'standard
+                                       'text 'text-force-cr)])
            void?]{
 @methspec{
 
@@ -1712,7 +1712,7 @@ To extend or re-implement copying, override the @xmethod[text%
 
 @defmethod[(print [interactive? any/c #t]
                   [fit-on-page? any/c #t]
-                  [output-mode (one-of/c 'standard 'postscript) 'standard]
+                  [output-mode (or/c 'standard 'postscript) 'standard]
                   [parent (or/c (or/c (is-a?/c frame%) (is-a?/c dialog%)) #f) #f]
                   [force-ps-page-bbox? any/c #t]
                   [as-eps? any/c #f])
@@ -1891,7 +1891,7 @@ See also @method[editor<%> add-undo].
                     [y real?]
                     [width (and/c real? (not/c negative?))]
                     [height (and/c real? (not/c negative?))]
-                    [draw-caret (one-of/c 'no-caret 'show-inactive-caret 'show-caret)]
+                    [draw-caret (or/c 'no-caret 'show-inactive-caret 'show-caret)]
                     [background (or/c (is-a?/c color%) #f)])
            void?]{
 
@@ -1973,8 +1973,8 @@ If @scheme[redraw-now?] is @scheme[#f], the editor will require
 
 
 @defmethod[(save-file [filename (or/c path-string? #f) #f]
-                      [format (one-of/c 'guess 'same 'copy 'standard
-                                        'text 'text-force-cr) 'same]
+                      [format (or/c 'guess 'same 'copy 'standard
+                                    'text 'text-force-cr) 'same]
                       [show-errors? any/c #t])
            boolean?]{
 
@@ -2004,8 +2004,8 @@ The @scheme[show-errors?] argument is no longer used.
 
 
 @defmethod[(save-port [port output-port?]
-                      [format (one-of/c 'guess 'same 'copy 'standard
-                                        'text 'text-force-cr) 'same]
+                      [format (or/c 'guess 'same 'copy 'standard
+                                    'text 'text-force-cr) 'same]
                       [show-errors? any/c #t])
            boolean?]{
 
@@ -2025,7 +2025,7 @@ The @scheme[show-errors?] argument is no longer used.
                              [width (and/c real? (not/c negative?))]
                              [height (and/c real? (not/c negative?))]
                              [refresh? any/c]
-                             [bias (one-of/c 'start 'end 'none)])
+                             [bias (or/c 'start 'end 'none)])
            boolean?]{
 
 Causes the editor to be scrolled so that a given @techlink{location}
@@ -2061,7 +2061,7 @@ For @scheme[text%] objects: @|FCA| @|EVD|
                       [width (and/c real? (not/c negative?))]
                       [height (and/c real? (not/c negative?))]
                       [refresh? any/c]
-                      [bias (one-of/c 'start 'end 'none) 'none])
+                      [bias (or/c 'start 'end 'none) 'none])
            boolean?]{
 
 Called (indirectly) by snips within the editor: it causes the editor
@@ -2120,7 +2120,7 @@ get-admin]}]
 
 
 @defmethod[(set-caret-owner [snip (or/c (is-a?/c snip%) #f)]
-                            [domain (one-of/c 'immediate 'display 'global) 'immediate])
+                            [domain (or/c 'immediate 'display 'global) 'immediate])
            void?]{
 
 Attempts to give the keyboard focus to @scheme[snip].  If @scheme[snip] is
@@ -2195,7 +2195,7 @@ This method is also called when the filename changes through any
 }
 
 
-@defmethod[(set-inactive-caret-threshold [threshold (one-of/c 'no-caret 'show-inactive-caret 'show-caret)])
+@defmethod[(set-inactive-caret-threshold [threshold (or/c 'no-caret 'show-inactive-caret 'show-caret)])
            void?]{
 
 Sets the threshold for painting an inactive selection.  See
diff --git a/collects/scribblings/gui/style-delta-class.scrbl b/collects/scribblings/gui/style-delta-class.scrbl
index 10744cf98c..e75d0b34f1 100644
--- a/collects/scribblings/gui/style-delta-class.scrbl
+++ b/collects/scribblings/gui/style-delta-class.scrbl
@@ -129,28 +129,28 @@ The family and face settings in a style delta are interdependent:
 
 
 
-@defconstructor*/make[(([change-command (one-of/c 'change-nothing 
-                                                  'change-normal 
-                                                  'change-toggle-underline 
-                                                  'change-toggle-size-in-pixels 
-                                                  'change-normal-color 
-                                                  'change-bold) 
+@defconstructor*/make[(([change-command (or/c 'change-nothing 
+                                              'change-normal 
+                                              'change-toggle-underline 
+                                              'change-toggle-size-in-pixels 
+                                              'change-normal-color 
+                                              'change-bold) 
                                         'change-nothing])
-                       ([change-command (one-of/c 'change-family 
-                                                  'change-style 
-                                                  'change-toggle-style 
-                                                  'change-weight 
-                                                  'change-toggle-weight 
-                                                  'change-smoothing 
-                                                  'change-toggle-smoothing
-                                                  'change-alignment)]
+                       ([change-command (or/c 'change-family 
+                                              'change-style 
+                                              'change-toggle-style 
+                                              'change-weight 
+                                              'change-toggle-weight 
+                                              'change-smoothing 
+                                              'change-toggle-smoothing
+                                              'change-alignment)]
                         [v symbol])
-                       ([change-command (one-of/c 'change-size 
-                                                  'change-bigger 
-                                                  'change-smaller)]
+                       ([change-command (or/c 'change-size 
+                                              'change-bigger 
+                                              'change-smaller)]
                         [v (integer-in 0 255)])
-                       ([change-command (one-of/c 'change-underline 
-                                                  'change-size-in-pixels)]
+                       ([change-command (or/c 'change-underline 
+                                              'change-size-in-pixels)]
                         [v any/c]))]{
 
 The initialization arguments are passed on to 
@@ -186,14 +186,14 @@ Returns @scheme[#t] if the given delta is equivalent to this one in
 }
 
 @defmethod[(get-alignment-off)
-           (one-of/c 'base 'top 'center 'bottom)]{
+           (or/c 'base 'top 'center 'bottom)]{
 
 See  @scheme[style-delta%].
 
 }
 
 @defmethod[(get-alignment-on)
-           (one-of/c 'base 'top 'center 'bottom)]{
+           (or/c 'base 'top 'center 'bottom)]{
 
 See  @scheme[style-delta%].
 
@@ -232,8 +232,8 @@ See also @method[style-delta% get-family].
 }
 
 @defmethod[(get-family)
-           (one-of/c 'base 'default 'decorative 'roman 'script 
-                     'swiss 'modern 'symbol 'system)]{
+           (or/c 'base 'default 'decorative 'roman 'script 
+                 'swiss 'modern 'symbol 'system)]{
 
 Returns the delta's font family. The possible values are
 @itemize[
@@ -301,24 +301,24 @@ Gets the multiplicative font size shift (applied before the additive factor).
 }
 
 @defmethod[(get-smoothing-off)
-           (one-of/c 'base 'default 'partly-smoothed 'smoothed 'unsmoothed)]{
+           (or/c 'base 'default 'partly-smoothed 'smoothed 'unsmoothed)]{
 
 See  @scheme[style-delta%].
 
 }
 
 @defmethod[(get-smoothing-on)
-           (one-of/c 'base 'default 'partly-smoothed 'smoothed 'unsmoothed)]{See 
+           (or/c 'base 'default 'partly-smoothed 'smoothed 'unsmoothed)]{See 
 @scheme[style-delta%].
 }
 
 @defmethod[(get-style-off)
-           (one-of/c 'base 'normal 'italic 'slant)]{See 
+           (or/c 'base 'normal 'italic 'slant)]{See 
 @scheme[style-delta%].
 }
 
 @defmethod[(get-style-on)
-           (one-of/c 'base 'normal 'italic 'slant)]{See 
+           (or/c 'base 'normal 'italic 'slant)]{See 
 @scheme[style-delta%].
 }
 
@@ -343,50 +343,50 @@ See  @scheme[style-delta%].
 }
 
 @defmethod[(get-weight-off)
-           (one-of/c 'base 'normal 'bold 'light)]{See 
+           (or/c 'base 'normal 'bold 'light)]{See 
 @scheme[style-delta%].
 }
 
 @defmethod[(get-weight-on)
-           (one-of/c 'base 'normal 'bold 'light)]{See 
+           (or/c 'base 'normal 'bold 'light)]{See 
 @scheme[style-delta%].
 }
 
-@defmethod[(set-alignment-off [v (one-of/c 'base 'top 'center 'bottom)])
+@defmethod[(set-alignment-off [v (or/c 'base 'top 'center 'bottom)])
            void?]{See 
 @scheme[style-delta%].
 }
 
-@defmethod[(set-alignment-on [v (one-of/c 'base 'top 'center 'bottom)])
+@defmethod[(set-alignment-on [v (or/c 'base 'top 'center 'bottom)])
            void?]{See 
 @scheme[style-delta%].
 }
 
-@defmethod*[([(set-delta [change-command (one-of/c 'change-nothing 
-                                                   'change-normal 
-                                                   'change-toggle-underline 
-                                                   'change-toggle-size-in-pixels 
-                                                   'change-normal-color 
-                                                   'change-bold) 
+@defmethod*[([(set-delta [change-command (or/c 'change-nothing 
+                                               'change-normal 
+                                               'change-toggle-underline 
+                                               'change-toggle-size-in-pixels 
+                                               'change-normal-color 
+                                               'change-bold) 
                                          'change-nothing])
               (is-a?/c style-delta%)]
-             [(set-delta [change-command (one-of/c 'change-family 
-                                                   'change-style 
-                                                   'change-toggle-style 
-                                                   'change-weight 
-                                                   'change-toggle-weight 
-                                                   'change-smoothing 
-                                                   'change-toggle-smoothing 
-                                                   'change-alignment)]
+             [(set-delta [change-command (or/c 'change-family 
+                                               'change-style 
+                                               'change-toggle-style 
+                                               'change-weight 
+                                               'change-toggle-weight 
+                                               'change-smoothing 
+                                               'change-toggle-smoothing 
+                                               'change-alignment)]
                          [param symbol])
               (is-a?/c style-delta%)]
-             [(set-delta [change-command (one-of/c 'change-size 
-                                                   'change-bigger 
-                                                   'change-smaller)]
+             [(set-delta [change-command (or/c 'change-size 
+                                               'change-bigger 
+                                               'change-smaller)]
                          [param (integer-in 0 255)])
               (is-a?/c style-delta%)]
-             [(set-delta [change-command (one-of/c 'change-underline 
-                                                   'change-size-in-pixels)]
+             [(set-delta [change-command (or/c 'change-underline 
+                                               'change-size-in-pixels)]
                          [on? any/c])
               (is-a?/c style-delta%)])]{
 
@@ -455,8 +455,8 @@ For the case that a string color name is supplied, see
 }
 
 @defmethod[(set-delta-face [name string?]
-                           [family (one-of/c 'base 'default 'decorative 'roman 
-                                             'script 'swiss 'modern 'symbol 'system)
+                           [family (or/c 'base 'default 'decorative 'roman 
+                                         'script 'swiss 'modern 'symbol 'system)
                                    'default])
            (is-a?/c style-delta%)]{
 
@@ -493,8 +493,8 @@ For the case that a string color name is supplied, see
 
 }
 
-@defmethod[(set-family [v (one-of/c 'base 'default 'decorative 'roman 'script 
-                                    'swiss 'modern 'symbol 'system)])
+@defmethod[(set-family [v (or/c 'base 'default 'decorative 'roman 'script 
+                                'swiss 'modern 'symbol 'system)])
            void?]{
 Sets the delta's font family. See
 @method[style-delta% get-family].
@@ -521,22 +521,22 @@ after the multiplicative factor).
 before the additive factor).
 }
 
-@defmethod[(set-smoothing-off [v (one-of/c 'base 'default 'partly-smoothed 'smoothed 'unsmoothed)])
+@defmethod[(set-smoothing-off [v (or/c 'base 'default 'partly-smoothed 'smoothed 'unsmoothed)])
            void?]{See 
 @scheme[style-delta%].
 }
 
-@defmethod[(set-smoothing-on [v (one-of/c 'base 'default 'partly-smoothed 'smoothed 'unsmoothed)])
+@defmethod[(set-smoothing-on [v (or/c 'base 'default 'partly-smoothed 'smoothed 'unsmoothed)])
            void?]{See 
 @scheme[style-delta%].
 }
 
-@defmethod[(set-style-off [v (one-of/c 'base 'normal 'italic 'slant)])
+@defmethod[(set-style-off [v (or/c 'base 'normal 'italic 'slant)])
            void?]{See 
 @scheme[style-delta%].
 }
 
-@defmethod[(set-style-on [v (one-of/c 'base 'normal 'italic 'slant)])
+@defmethod[(set-style-on [v (or/c 'base 'normal 'italic 'slant)])
            void?]{See 
 @scheme[style-delta%].
 }
@@ -561,12 +561,12 @@ before the additive factor).
 @scheme[style-delta%].
 }
 
-@defmethod[(set-weight-off [v (one-of/c 'base 'normal 'bold 'light)])
+@defmethod[(set-weight-off [v (or/c 'base 'normal 'bold 'light)])
            void?]{See 
 @scheme[style-delta%].
 }
 
-@defmethod[(set-weight-on [v (one-of/c 'base 'normal 'bold 'light)])
+@defmethod[(set-weight-on [v (or/c 'base 'normal 'bold 'light)])
            void?]{See 
 @scheme[style-delta%].
 }}
diff --git a/collects/scribblings/gui/text-class.scrbl b/collects/scribblings/gui/text-class.scrbl
index 941b59ced9..2a774fc970 100644
--- a/collects/scribblings/gui/text-class.scrbl
+++ b/collects/scribblings/gui/text-class.scrbl
@@ -519,7 +519,7 @@ Given a @techlink{location} in the editor, returns the line at the
 }
 
 
-@defmethod[(find-newline [direction (one-of/c 'forward 'backward) 'forward]
+@defmethod[(find-newline [direction (or/c 'forward 'backward) 'forward]
                          [start (or/c exact-nonnegative-integer? 'start) 'start]
                          [end (or/c exact-nonnegative-integer? 'eof) 'eof])
            (or/c exact-nonnegative-integer? #f)]{
@@ -590,7 +590,7 @@ See @method[text% find-position] for a discussion of
 
 
 @defmethod[(find-snip [pos exact-nonnegative-integer?]
-                      [direction (one-of/c 'before-or-none 'before 'after 'after-or-none)]
+                      [direction (or/c 'before-or-none 'before 'after 'after-or-none)]
                       [s-pos (or/c (box/c exact-nonnegative-integer?) #f) #f])
            (or/c (is-a?/c snip%) #f)]{
 
@@ -622,7 +622,7 @@ can be any of the following:
 
 
 @defmethod[(find-string [str string?]
-                        [direction (one-of/c 'forward 'backward) 'forward]
+                        [direction (or/c 'forward 'backward) 'forward]
                         [start (or/c exact-nonnegative-integer? 'start) 'start]
                         [end (or/c exact-nonnegative-integer? 'eof) 'eof]
                         [get-start? any/c #t]
@@ -654,7 +654,7 @@ If @scheme[case-sensitive?] is @scheme[#f], then an uppercase and lowercase
 
 
 @defmethod[(find-string-all [str string?]
-                            [direction (one-of/c 'forward 'backward) 'forward]
+                            [direction (or/c 'forward 'backward) 'forward]
                             [start (or/c exact-nonnegative-integer? 'start) 'start]
                             [end (or/c exact-nonnegative-integer? 'eof) 'eof]
                             [get-start? any/c #t]
@@ -670,7 +670,7 @@ Finds all occurrences of a string using @method[text% find-string]. If
 
 @defmethod[(find-wordbreak [start (or/c (box/c exact-nonnegative-integer?) #f)]
                            [end (or/c (box/c exact-nonnegative-integer?) #f)]
-                           [reason (one-of/c 'caret 'line 'selection 'user1 'user2)])
+                           [reason (or/c 'caret 'line 'selection 'user1 'user2)])
            void?]{
 
 Finds wordbreaks in the editor using the current wordbreak procedure.
@@ -789,7 +789,7 @@ Returns the ending @techlink{position} of the current selection. See
 
 
 @defmethod[(get-file-format)
-           (one-of/c 'standard 'text 'text-force-cr)]{
+           (or/c 'standard 'text 'text-force-cr)]{
 
 Returns the format of the last file saved from or loaded into this
  editor. See also @method[editor<%> load-file].
@@ -1259,9 +1259,9 @@ then this method ignores the editor's maximum width and any automatic
 }
 
 
-@defmethod[(move-position [code (one-of/c 'home 'end 'right 'left 'up 'down)]
+@defmethod[(move-position [code (or/c 'home 'end 'right 'left 'up 'down)]
                           [extend? any/c #f]
-                          [kind (one-of/c 'simple 'word 'page 'line) 'simple])
+                          [kind (or/c 'simple 'word 'page 'line) 'simple])
            void?]{
 
 Moves the current selection. 
@@ -1720,7 +1720,7 @@ Removes all clickbacks installed for exactly the range @scheme[start]
 @defmethod[(scroll-to-position [start exact-nonnegative-integer?]
                                [at-eol? any/c #f]
                                [end (or/c exact-nonnegative-integer? 'same) 'same]
-                               [bias (one-of/c 'start 'end 'none) 'none])
+                               [bias (or/c 'start 'end 'none) 'none])
            boolean?]{
 
 Scrolls the editor so that a given @techlink{position} is visible. 
@@ -1836,7 +1836,7 @@ If @scheme[call-on-down?] is not @scheme[#f], the clickback is called
 See also @|clickbackdiscuss|.
  }
 
-@defmethod[(set-file-format [format (one-of/c 'standard 'text 'text-force-cr)])
+@defmethod[(set-file-format [format (or/c 'standard 'text 'text-force-cr)])
            void?]{
 
 Set the format of the file saved from this editor. 
@@ -1875,7 +1875,7 @@ Enables or disables overwrite mode. See @method[text%
 
 
 @defmethod[(set-paragraph-alignment [paragraph exact-nonnegative-integer?]
-                                    [alignment (one-of/c 'left 'center 'right)])
+                                    [alignment (or/c 'left 'center 'right)])
            void?]{
 
 Sets a paragraph-specific horizontal alignment. The alignment is only
@@ -1917,7 +1917,7 @@ The first line of the paragraph is indented by @scheme[first-left] points
                          [end (or/c exact-nonnegative-integer? 'same) 'same]
                          [at-eol? any/c #f]
                          [scroll? any/c #t]
-                         [seltype (one-of/c 'default 'x 'local) 'default])
+                         [seltype (or/c 'default 'x 'local) 'default])
            void?]{
 
 Sets the current selection in the editor. 
@@ -1956,12 +1956,12 @@ See also @scheme[editor-set-x-selection-mode].
 }
 
 
-@defmethod[(set-position-bias-scroll [bias (one-of/c 'start-only 'start 'none 'end 'end-only)]
+@defmethod[(set-position-bias-scroll [bias (or/c 'start-only 'start 'none 'end 'end-only)]
                                      [start exact-nonnegative-integer?]
                                      [end (or/c exact-nonnegative-integer? 'same) 'same]
                                      [ateol? any/c #f]
                                      [scroll? any/c #t]
-                                     [seltype (one-of/c 'default 'x 'local) 'default])
+                                     [seltype (or/c 'default 'x 'local) 'default])
            void?]{
 
 Like  @method[text% set-position], but a scrolling bias can be specified.

From 47b5892c92d9334cb0fd2fa22423e91ef8782997 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 19 Feb 2010 15:29:54 +0000
Subject: [PATCH 9/9] probable fix to problems with this file (make sure
 find-relative-path's first argument is a directory)

svn: r18187
---
 collects/tests/plai/test-random-mutator.ss | 19 ++-----------------
 1 file changed, 2 insertions(+), 17 deletions(-)

diff --git a/collects/tests/plai/test-random-mutator.ss b/collects/tests/plai/test-random-mutator.ss
index a827604e75..9593415049 100644
--- a/collects/tests/plai/test-random-mutator.ss
+++ b/collects/tests/plai/test-random-mutator.ss
@@ -25,29 +25,14 @@
         (fprintf port "#lang plai/mutator\n")
         (fprintf port "~s\n" `(allocator-setup ,(path->string
                                                  (find-relative-path 
-                                                  (normalize-path (simple-form-path tmpfile))
+                                                  (let-values ([(base name dir?) (split-path tmpfile)])
+                                                    (normalize-path (simple-form-path base)))
                                                   (normalize-path
                                                    (simple-form-path collector-path))))
                                                100))
         (for-each (λ (exp) (pretty-print exp port)) exps))
       #:exists 'truncate)
 
-    (printf "tmpfile: ~s\n" tmpfile)
-    (printf "simple-form tmpfile ~s\n" (simple-form-path tmpfile))
-    (printf "normalized tmpfile ~s\n" (normalize-path (simple-form-path tmpfile)))
-    (newline)
-    (printf "collector ~s\n" collector-path)
-    (printf "simple-form collector: ~s\n" (simple-form-path collector-path))
-    (printf "normalized simple-form collector: ~s\n" (normalize-path (simple-form-path collector-path)))
-    (newline)
-    (printf "here ~s\n" here)
-    (printf "simple-form here: ~s\n" (simple-form-path here))
-    (printf "normalized simple-form here: ~s\n" (normalize-path (simple-form-path here)))
-    (newline)
-    
-    (printf "tmpfile contents:\n")
-    (call-with-input-file tmpfile (λ (p) (copy-port p (current-output-port))))
-    
     (let ([sp (open-output-string)])
       (parameterize ([current-output-port sp])
         (dynamic-require tmpfile #f))