diff --git a/collects/framework/private/editor.ss b/collects/framework/private/editor.ss
index a5ae252a..d76cd944 100644
--- a/collects/framework/private/editor.ss
+++ b/collects/framework/private/editor.ss
@@ -321,6 +321,7 @@
       
       (define/override (on-new-image-snip filename kind relative-path? inline?)
         (super on-new-image-snip 
+               filename
                (if (eq? kind 'unknown) 'unknown/mask kind) 
                relative-path? 
                inline?))
diff --git a/collects/mred/edit.ss b/collects/mred/edit.ss
index c81e38eb..cc887bd7 100644
--- a/collects/mred/edit.ss
+++ b/collects/mred/edit.ss
@@ -158,7 +158,7 @@
       (send c set-editor e)
 
       (when file
-	(if (regexp-match "[.](gif|bmp|jpe?g|xbm|xpm|png)$" file)
+	(if (regexp-match "[.](gif|bmp|jpe?g|xbm|xpm|png)$" (string-downcase file))
 	    (send e insert (make-object image-snip% file))
 	    (send e load-file file)))
 
diff --git a/collects/mred/mred.ss b/collects/mred/mred.ss
index d4397a54..0ba30ed8 100644
--- a/collects/mred/mred.ss
+++ b/collects/mred/mred.ss
@@ -6,6 +6,17 @@
            scheme/class
            mzlib/etc
 	   (prefix wx: "private/kernel.ss")
+	   (prefix wx: "private/wxme/style.ss")
+	   (prefix wx: "private/wxme/editor.ss")
+	   (prefix wx: "private/wxme/text.ss")
+	   (prefix wx: "private/wxme/pasteboard.ss")
+	   (prefix wx: "private/wxme/snip.ss")
+	   (prefix wx: "private/wxme/keymap.ss")
+	   (prefix wx: "private/wxme/editor-admin.ss")
+	   (prefix wx: "private/wxme/editor-snip.ss")
+	   (prefix wx: "private/wxme/stream.ss")
+	   (prefix wx: "private/wxme/wordbreak.ss")
+	   (prefix wx: "private/wxme/snip-admin.ss")
 	   "private/wxtop.ss"
 	   "private/app.ss"
 	   "private/misc.ss"
@@ -182,8 +193,8 @@
   (define the-font-list (wx:get-the-font-list))
   (define the-pen-list (wx:get-the-pen-list))
   (define the-brush-list (wx:get-the-brush-list))
-  (define the-style-list (wx:get-the-style-list))
-  (define the-editor-wordbreak-map (wx:get-the-editor-wordbreak-map))
+  (define the-style-list wx:the-style-list)
+  (define the-editor-wordbreak-map wx:the-editor-wordbreak-map)
 
   (provide button%
 	   canvas%
diff --git a/collects/mred/private/editor.ss b/collects/mred/private/editor.ss
index 1ecb655e..7740a207 100644
--- a/collects/mred/private/editor.ss
+++ b/collects/mred/private/editor.ss
@@ -5,6 +5,15 @@
 	   mzlib/list
 	   mzlib/file
 	   (prefix wx: "kernel.ss")
+           (prefix wx: "wxme/style.ss")
+           (prefix wx: "wxme/keymap.ss")
+           (prefix wx: "wxme/editor.ss")
+           (prefix wx: "wxme/text.ss")
+           (prefix wx: "wxme/pasteboard.ss")
+           (prefix wx: "wxme/editor-snip.ss")
+           (rename "wxme/cycle.ss" wx:set-extended-editor-snip%! set-extended-editor-snip%!)
+           (rename "wxme/cycle.ss" wx:set-extended-text%! set-extended-text%!)
+           (rename "wxme/cycle.ss" wx:set-extended-pasteboard%! set-extended-pasteboard%!)
 	   "seqcontract.ss"
 	   "lock.ss"
 	   "check.ss"
@@ -324,7 +333,7 @@
 		   (when (and can-wrap? auto-set-wrap?)
 		     (let-values ([(current-width) (as-exit (lambda () (get-max-width)))]
 				  [(new-width new-height) (max-view-size)])
-		       (when (and (not (= current-width new-width))
+		       (when (and (not (equal? current-width new-width))
 				  (< 0 new-width))
 			 (as-exit (lambda () (set-max-width new-width)))))))
 		 (as-exit (lambda () (inner (void) on-display-size)))))])
@@ -481,9 +490,9 @@
 				       min-height
 				       max-height))))
 
-  (wx:set-editor-snip-maker (lambda args (apply make-object editor-snip% args)))
-  (wx:set-text-editor-maker (lambda () (make-object text%)))
-  (wx:set-pasteboard-editor-maker (lambda () (make-object pasteboard%)))
+  (wx:set-extended-editor-snip%! editor-snip%)
+  (wx:set-extended-text%! text%)
+  (wx:set-extended-pasteboard%! pasteboard%)
 
   ;; ----------------------- Keymap ----------------------------------------
 
diff --git a/collects/mred/private/filedialog.ss b/collects/mred/private/filedialog.ss
index 8b2e4229..a3d06564 100644
--- a/collects/mred/private/filedialog.ss
+++ b/collects/mred/private/filedialog.ss
@@ -3,6 +3,8 @@
 	   mzlib/etc
 	   mzlib/list
 	   (prefix wx: "kernel.ss")
+	   (prefix wx: "wxme/style.ss")
+	   (prefix wx: "wxme/cycle.ss")
 	   "lock.ss"
 	   "wx.ss"
 	   "cycle.ss"
@@ -105,4 +107,6 @@
       ((mk-file-selector 'get-directory #f #f #t)
        message parent directory #f #f style null)))
 
-  (set-get-file! get-file))
+  (set-get-file! get-file)
+  (wx:set-editor-get-file! get-file)
+  (wx:set-editor-put-file! put-file))
diff --git a/collects/mred/private/helper.ss b/collects/mred/private/helper.ss
index 2be01a71..b11e0718 100644
--- a/collects/mred/private/helper.ss
+++ b/collects/mred/private/helper.ss
@@ -1,6 +1,7 @@
 (module helper mzscheme
   (require mzlib/class
 	   (prefix wx: "kernel.ss")
+           (prefix wx: "wxme/style.ss")
 	   "lock.ss")
 
   (provide (protect (struct child-info (x-min y-min x-margin y-margin x-stretch y-stretch))
diff --git a/collects/mred/private/kernel.ss b/collects/mred/private/kernel.ss
index f448c678..794007f5 100644
--- a/collects/mred/private/kernel.ss
+++ b/collects/mred/private/kernel.ss
@@ -160,147 +160,6 @@
     on-size
     on-set-focus
     on-kill-focus)
-  (define-private-class editor% editor<%> object% () #f
-    dc-location-to-editor-location
-    editor-location-to-dc-location
-    set-inactive-caret-threshold
-    get-inactive-caret-threshold
-    get-focus-snip
-    end-write-header-footer-to-file
-    begin-write-header-footer-to-file
-    print
-    insert-image
-    insert-box
-    get-filename
-    is-modified?
-    is-locked?
-    lock
-    set-cursor
-    get-paste-text-only
-    set-paste-text-only
-    get-load-overwrites-styles
-    set-load-overwrites-styles
-    set-style-list
-    get-style-list
-    get-keymap
-    set-keymap
-    can-do-edit-operation?
-    do-edit-operation
-    get-max-undo-history
-    set-max-undo-history
-    add-undo
-    clear-undos
-    redo
-    undo
-    select-all
-    clear
-    get-view-size
-    get-dc
-    local-to-global
-    global-to-local
-    locked-for-flow?
-    locked-for-write?
-    locked-for-read?
-    set-admin
-    get-admin
-    print-to-dc
-    find-scroll-line
-    num-scroll-lines
-    scroll-line-location
-    get-snip-location
-    locations-computed?
-    in-edit-sequence?
-    refresh-delayed?
-    end-edit-sequence
-    begin-edit-sequence
-    style-has-changed
-    set-min-height
-    set-max-height
-    get-min-height
-    get-max-height
-    set-min-width
-    set-max-width
-    get-min-width
-    get-max-width
-    insert-file
-    load-file
-    insert-port
-    save-port
-    default-style-name
-    get-flattened-text
-    put-file
-    get-file
-    after-edit-sequence
-    on-edit-sequence
-    after-load-file
-    on-load-file
-    can-load-file?
-    after-save-file
-    on-save-file
-    can-save-file?
-    on-new-box
-    on-new-image-snip
-    size-cache-invalid
-    invalidate-bitmap-cache
-    on-paint
-    write-footers-to-file
-    write-headers-to-file
-    read-footer-from-file
-    read-header-from-file
-    write-to-file
-    read-from-file
-    set-filename
-    release-snip
-    on-snip-modified
-    set-modified
-    scroll-editor-to
-    set-snip-data
-    get-snip-data
-    needs-update
-    resized
-    set-caret-owner
-    scroll-to
-    on-display-size-when-ready
-    on-display-size
-    on-change
-    on-focus
-    on-default-char
-    on-default-event
-    on-local-char
-    on-local-event
-    find-first-snip
-    get-space
-    get-descent
-    get-extent
-    blink-caret
-    own-caret
-    refresh
-    adjust-cursor
-    on-char
-    on-event
-    copy-self-to
-    copy-self
-    kill
-    paste-x-selection
-    paste
-    copy
-    cut
-    insert
-    change-style)
-  (define-function get-the-editor-data-class-list)
-  (define-function get-the-snip-class-list)
-  (define-function editor-set-x-selection-mode)
-  (define-function add-pasteboard-keymap-functions)
-  (define-function add-text-keymap-functions)
-  (define-function add-editor-keymap-functions)
-  (define-function write-editor-global-footer)
-  (define-function write-editor-global-header)
-  (define-function read-editor-global-footer)
-  (define-function read-editor-global-header)
-  (define-function read-editor-version)
-  (define-function write-editor-version)
-  (define-function set-editor-print-margin)
-  (define-function get-editor-print-margin)
   (define-class bitmap% object% () #f
     get-argb-pixels
     get-gl-config
@@ -375,6 +234,7 @@
     on-event
     on-paint)
   (define-private-class dc% dc<%> object% () #f
+    cache-font-metrics-key
     get-alpha
     set-alpha
     glyph-exists?
@@ -711,255 +571,6 @@
     on-size
     on-set-focus
     on-kill-focus)
-  (define-class editor-canvas% canvas% () #f
-    on-char
-    on-event
-    on-paint
-    on-drop-file
-    pre-on-event
-    pre-on-char
-    on-size
-    on-set-focus
-    on-kill-focus
-    popup-for-editor
-    call-as-primary-owner
-    get-canvas-background
-    set-canvas-background
-    set-y-margin
-    set-x-margin
-    get-y-margin
-    get-x-margin
-    clear-margins
-    scroll-to
-    set-lazy-refresh
-    get-lazy-refresh
-    scroll-with-bottom-base
-    allow-scroll-to-last
-    force-display-focus
-    is-focus-on?
-    on-scroll-on-change
-    get-editor
-    set-editor
-    get-wheel-step
-    set-wheel-step)
-  (define-class editor-admin% object% () #f
-    modified
-    refresh-delayed?
-    popup-menu
-    update-cursor
-    needs-update
-    resized
-    grab-caret
-    scroll-to
-    get-max-view
-    get-view
-    get-dc)
-  (define-private-class editor-snip-editor-admin% editor-snip-editor-admin<%> editor-admin% () #f
-    get-snip)
-  (define-class snip-admin% object% () #f
-    modified
-    popup-menu
-    update-cursor
-    release-snip
-    needs-update
-    recounted
-    resized
-    set-caret-owner
-    scroll-to
-    get-view
-    get-view-size
-    get-dc
-    get-editor)
-  (define-class snip-class% object% () #f
-    reading-version
-    write-header
-    read-header
-    read
-    get-classname
-    set-classname
-    get-version
-    set-version)
-  (define-private-class snip-class-list% snip-class-list<%> object% () #f
-    nth
-    number
-    add
-    find-position
-    find)
-  (define-class keymap% object% () #f
-    remove-chained-keymap
-    chain-to-keymap
-    set-break-sequence-callback
-    call-function
-    remove-grab-mouse-function
-    set-grab-mouse-function
-    remove-grab-key-function
-    set-grab-key-function
-    add-function
-    map-function
-    break-sequence
-    handle-mouse-event
-    handle-key-event
-    set-double-click-interval
-    get-double-click-interval)
-  (define-class editor-wordbreak-map% object% () #f
-    get-map
-    set-map)
-  (define-function get-the-editor-wordbreak-map)
-  (define-class text% editor% () #f
-    call-clickback
-    remove-clickback
-    set-clickback
-    set-wordbreak-func
-    set-autowrap-bitmap
-    on-reflow
-    on-new-tab-snip
-    on-new-string-snip
-    caret-hidden?
-    hide-caret
-    get-wordbreak-map
-    set-wordbreak-map
-    find-wordbreak
-    set-region-data
-    get-region-data
-    get-revision-number
-    after-merge-snips
-    after-split-snip
-    after-set-size-constraint
-    on-set-size-constraint
-    can-set-size-constraint?
-    after-set-position
-    after-change-style
-    on-change-style
-    can-change-style?
-    after-delete
-    on-delete
-    can-delete?
-    after-insert
-    on-insert
-    can-insert?
-    set-tabs
-    get-tabs
-    set-overwrite-mode
-    get-overwrite-mode
-    set-file-format
-    get-file-format
-    write-to-file
-    read-from-file
-    get-character
-    get-text
-    find-next-non-string-snip
-    get-snip-position
-    get-snip-position-and-location
-    find-snip
-    find-string-all
-    find-string
-    set-styles-sticky
-    get-styles-sticky
-    set-line-spacing
-    get-line-spacing
-    set-paragraph-alignment
-    set-paragraph-margins
-    last-paragraph
-    paragraph-end-line
-    paragraph-start-line
-    line-paragraph
-    paragraph-end-position
-    paragraph-start-position
-    position-paragraph
-    last-line
-    last-position
-    line-length
-    line-end-position
-    line-start-position
-    line-location
-    position-locations
-    position-location
-    position-line
-    set-between-threshold
-    get-between-threshold
-    find-position-in-line
-    find-line
-    find-position
-    split-snip
-    change-style
-    do-paste-x-selection
-    do-paste
-    do-copy
-    kill
-    paste-next
-    paste-x-selection
-    paste
-    copy
-    cut
-    erase
-    delete
-    insert
-    get-top-line-base
-    flash-off
-    flash-on
-    get-anchor
-    set-anchor
-    get-visible-line-range
-    get-visible-position-range
-    scroll-to-position
-    move-position
-    set-position-bias-scroll
-    set-position
-    get-end-position
-    get-start-position
-    get-position
-    default-style-name
-    get-flattened-text
-    put-file
-    get-file
-    after-edit-sequence
-    on-edit-sequence
-    after-load-file
-    on-load-file
-    can-load-file?
-    after-save-file
-    on-save-file
-    can-save-file?
-    on-new-box
-    on-new-image-snip
-    size-cache-invalid
-    invalidate-bitmap-cache
-    on-paint
-    write-footers-to-file
-    write-headers-to-file
-    read-footer-from-file
-    read-header-from-file
-    set-filename
-    release-snip
-    on-snip-modified
-    set-modified
-    scroll-editor-to
-    set-snip-data
-    get-snip-data
-    needs-update
-    resized
-    set-caret-owner
-    scroll-to
-    on-display-size-when-ready
-    on-display-size
-    on-change
-    on-focus
-    on-default-char
-    on-default-event
-    on-local-char
-    on-local-event
-    find-first-snip
-    get-space
-    get-descent
-    get-extent
-    blink-caret
-    own-caret
-    refresh
-    adjust-cursor
-    on-char
-    on-event
-    copy-self-to
-    copy-self)
   (define-class menu% object% () #f
     select
     get-font
@@ -984,46 +595,13 @@
   (define-class menu-item% object% () #f
     id)
   (define-function id-to-menu-item)
-  (define-class editor-stream-in-base% object% () #f
-    read
-    bad?
-    skip
-    seek
-    tell)
-  (define-class editor-stream-out-base% object% () #f
-    write
-    bad?
-    seek
-    tell)
-  (define-class editor-stream-in-bytes-base% editor-stream-in-base% () #f)
-  (define-class editor-stream-out-bytes-base% editor-stream-out-base% () #f
-    get-bytes)
-  (define-class editor-stream-in% object% () #f
-    ok?
-    jump-to
-    tell
-    skip
-    remove-boundary
-    set-boundary
-    get-inexact
-    get-exact
-    get-fixed
-    get-unterminated-bytes
-    get-bytes
-    get)
-  (define-class editor-stream-out% object% () #f
-    ok?
-    pretty-finish
-    jump-to
-    tell
-    put-fixed
-    put)
   (define-class timer% object% () ()
     stop
     start
     notify
     interval)
   (define-private-class clipboard% clipboard<%> object% () #f
+    same-clipboard-client?
     get-clipboard-bitmap
     set-clipboard-bitmap
     get-clipboard-data
@@ -1033,6 +611,7 @@
   (define-function get-the-x-selection)
   (define-function get-the-clipboard)
   (define-class clipboard-client% object% () ()
+    same-eventspace?
     get-types
     add-type
     get-data
@@ -1063,123 +642,6 @@
     get-command)
   (define-function show-print-setup)
   (define-function can-show-print-setup?)
-  (define-class pasteboard% editor% () #f
-    set-scroll-step
-    get-scroll-step
-    set-selection-visible
-    get-selection-visible
-    set-dragable
-    get-dragable
-    after-interactive-resize
-    on-interactive-resize
-    can-interactive-resize?
-    after-interactive-move
-    on-interactive-move
-    can-interactive-move?
-    interactive-adjust-resize
-    interactive-adjust-move
-    interactive-adjust-mouse
-    on-double-click
-    after-select
-    on-select
-    can-select?
-    after-reorder
-    on-reorder
-    can-reorder?
-    after-resize
-    on-resize
-    can-resize?
-    after-move-to
-    on-move-to
-    can-move-to?
-    after-delete
-    on-delete
-    can-delete?
-    after-insert
-    on-insert
-    can-insert?
-    find-next-selected-snip
-    is-selected?
-    find-snip
-    get-center
-    remove-selected
-    no-selected
-    add-selected
-    set-selected
-    change-style
-    set-after
-    set-before
-    lower
-    raise
-    resize
-    move
-    move-to
-    remove
-    erase
-    do-paste-x-selection
-    do-paste
-    do-copy
-    delete
-    insert
-    default-style-name
-    get-flattened-text
-    put-file
-    get-file
-    after-edit-sequence
-    on-edit-sequence
-    after-load-file
-    on-load-file
-    can-load-file?
-    after-save-file
-    on-save-file
-    can-save-file?
-    on-new-box
-    on-new-image-snip
-    size-cache-invalid
-    invalidate-bitmap-cache
-    on-paint
-    write-footers-to-file
-    write-headers-to-file
-    read-footer-from-file
-    read-header-from-file
-    write-to-file
-    read-from-file
-    set-filename
-    release-snip
-    on-snip-modified
-    set-modified
-    scroll-editor-to
-    set-snip-data
-    get-snip-data
-    needs-update
-    resized
-    set-caret-owner
-    scroll-to
-    on-display-size-when-ready
-    on-display-size
-    on-change
-    on-focus
-    on-default-char
-    on-default-event
-    on-local-char
-    on-local-event
-    find-first-snip
-    get-space
-    get-descent
-    get-extent
-    blink-caret
-    own-caret
-    refresh
-    adjust-cursor
-    on-char
-    on-event
-    copy-self-to
-    copy-self
-    kill
-    paste-x-selection
-    paste
-    copy
-    cut)
   (define-class panel% window% () #f
     get-label-position
     set-label-position
@@ -1227,302 +689,6 @@
     on-size
     on-set-focus
     on-kill-focus)
-  (define-class snip% object% () #f
-    previous
-    next
-    set-unmodified
-    get-scroll-step-offset
-    find-scroll-step
-    get-num-scroll-steps
-    set-admin
-    resize
-    write
-    match?
-    can-do-edit-operation?
-    do-edit-operation
-    blink-caret
-    own-caret
-    adjust-cursor
-    on-char
-    on-event
-    size-cache-invalid
-    copy
-    get-text!
-    get-text
-    merge-with
-    split
-    draw
-    partial-offset
-    get-extent
-    release-from-owner
-    is-owned?
-    set-style
-    set-flags
-    set-count
-    get-admin
-    get-count
-    get-flags
-    get-style
-    get-snipclass
-    set-snipclass)
-  (define-class string-snip% snip% () #f
-    read
-    insert
-    set-unmodified
-    get-scroll-step-offset
-    find-scroll-step
-    get-num-scroll-steps
-    set-admin
-    resize
-    write
-    match?
-    can-do-edit-operation?
-    do-edit-operation
-    blink-caret
-    own-caret
-    adjust-cursor
-    on-char
-    on-event
-    size-cache-invalid
-    copy
-    get-text!
-    get-text
-    merge-with
-    split
-    draw
-    partial-offset
-    get-extent)
-  (define-class tab-snip% string-snip% () #f
-    set-unmodified
-    get-scroll-step-offset
-    find-scroll-step
-    get-num-scroll-steps
-    set-admin
-    resize
-    write
-    match?
-    can-do-edit-operation?
-    do-edit-operation
-    blink-caret
-    own-caret
-    adjust-cursor
-    on-char
-    on-event
-    size-cache-invalid
-    copy
-    get-text!
-    get-text
-    merge-with
-    split
-    draw
-    partial-offset
-    get-extent)
-  (define-class image-snip% snip% (equal<%>) #f
-    equal-secondary-hash-code-of
-    equal-hash-code-of
-    other-equal-to?
-    equal-to?
-    set-offset
-    get-bitmap-mask
-    get-bitmap
-    set-bitmap
-    get-filetype
-    get-filename
-    load-file
-    set-unmodified
-    get-scroll-step-offset
-    find-scroll-step
-    get-num-scroll-steps
-    set-admin
-    resize
-    write
-    match?
-    can-do-edit-operation?
-    do-edit-operation
-    blink-caret
-    own-caret
-    adjust-cursor
-    on-char
-    on-event
-    size-cache-invalid
-    copy
-    get-text!
-    get-text
-    merge-with
-    split
-    draw
-    partial-offset
-    get-extent)
-  (define-class editor-snip% snip% () #f
-    get-inset
-    set-inset
-    get-margin
-    set-margin
-    style-background-used?
-    use-style-background
-    border-visible?
-    show-border
-    set-align-top-line
-    get-align-top-line
-    set-tight-text-fit
-    get-tight-text-fit
-    get-min-height
-    get-min-width
-    set-min-height
-    set-min-width
-    get-max-height
-    get-max-width
-    set-max-height
-    set-max-width
-    set-unmodified
-    get-scroll-step-offset
-    find-scroll-step
-    get-num-scroll-steps
-    set-admin
-    resize
-    write
-    match?
-    can-do-edit-operation?
-    do-edit-operation
-    blink-caret
-    own-caret
-    adjust-cursor
-    on-char
-    on-event
-    size-cache-invalid
-    copy
-    get-text!
-    get-text
-    merge-with
-    split
-    draw
-    partial-offset
-    get-extent
-    set-editor
-    get-editor)
-  (define-class editor-data-class% object% () #f
-    read
-    get-classname
-    set-classname)
-  (define-private-class editor-data-class-list% editor-data-class-list<%> object% () #f
-    nth
-    number
-    add
-    find-position
-    find)
-  (define-class editor-data% object% () #f
-    set-next
-    write
-    get-dataclass
-    set-dataclass
-    get-next)
-  (define-private-class mult-color% mult-color<%> object% () #f
-    set
-    get
-    get-r
-    set-r
-    get-g
-    set-g
-    get-b
-    set-b)
-  (define-private-class add-color% add-color<%> object% () #f
-    set
-    get
-    get-r
-    set-r
-    get-g
-    set-g
-    get-b
-    set-b)
-  (define-class style-delta% object% () #f
-    copy
-    collapse
-    equal?
-    set-delta-foreground
-    set-delta-background
-    set-delta-face
-    set-delta
-    get-family
-    set-family
-    get-face
-    set-face
-    get-size-mult
-    set-size-mult
-    get-size-add
-    set-size-add
-    get-weight-on
-    set-weight-on
-    get-weight-off
-    set-weight-off
-    get-smoothing-on
-    set-smoothing-on
-    get-smoothing-off
-    set-smoothing-off
-    get-style-on
-    set-style-on
-    get-style-off
-    set-style-off
-    get-underlined-on
-    set-underlined-on
-    get-underlined-off
-    set-underlined-off
-    get-size-in-pixels-on
-    set-size-in-pixels-on
-    get-size-in-pixels-off
-    set-size-in-pixels-off
-    get-transparent-text-backing-on
-    set-transparent-text-backing-on
-    get-transparent-text-backing-off
-    set-transparent-text-backing-off
-    get-foreground-mult
-    get-background-mult
-    get-foreground-add
-    get-background-add
-    get-alignment-on
-    set-alignment-on
-    get-alignment-off
-    set-alignment-off)
-  (define-private-class style% style<%> object% () #f
-    switch-to
-    set-shift-style
-    get-shift-style
-    is-join?
-    set-delta
-    get-delta
-    set-base-style
-    get-base-style
-    get-text-width
-    get-text-space
-    get-text-descent
-    get-text-height
-    get-transparent-text-backing
-    get-alignment
-    get-background
-    get-foreground
-    get-font
-    get-size-in-pixels
-    get-underlined
-    get-smoothing
-    get-style
-    get-weight
-    get-size
-    get-face
-    get-family
-    get-name)
-  (define-class style-list% object% () #f
-    forget-notification
-    notify-on-change
-    style-to-index
-    index-to-style
-    convert
-    replace-named-style
-    new-named-style
-    find-named-style
-    find-or-create-join-style
-    find-or-create-style
-    number
-    basic-style)
-  (define-function get-the-style-list)
   (define-class tab-group% item% () #f
     button-focus
     set
@@ -1551,7 +717,6 @@
   (define-functions
     special-control-key
     special-option-key
-    map-command-as-meta-key
     application-file-handler
     application-quit-handler
     application-about-handler
@@ -1576,20 +741,19 @@
     shortcut-visible-in-label?
     eventspace-shutdown?
     in-atomic-region
-    set-editor-snip-maker
-    set-text-editor-maker
-    set-pasteboard-editor-maker
     set-menu-tester
     location->window
     set-dialogs
     set-executer
     send-event
     file-creator-and-type
-    set-snip-class-getter
-    set-editor-data-class-getter
     set-ps-procs
     main-eventspace?
-    eventspace-handler-thread)
+    eventspace-handler-thread
+    begin-refresh-sequence
+    end-refresh-sequence
+    run-printout
+    get-double-click-time)
 
 )
 ;; end
diff --git a/collects/mred/private/moredialogs.ss b/collects/mred/private/moredialogs.ss
index 6dbc0e9c..3f9b1fc5 100644
--- a/collects/mred/private/moredialogs.ss
+++ b/collects/mred/private/moredialogs.ss
@@ -3,6 +3,7 @@
 	   mzlib/etc
 	   mzlib/list
 	   (prefix wx: "kernel.ss")
+	   (prefix wx: "wxme/style.ss")
 	   "lock.ss"
 	   "const.ss"
 	   "check.ss"
diff --git a/collects/mred/private/mrmenu.ss b/collects/mred/private/mrmenu.ss
index e04f6250..907e4250 100644
--- a/collects/mred/private/mrmenu.ss
+++ b/collects/mred/private/mrmenu.ss
@@ -3,6 +3,7 @@
 	   mzlib/class100
 	   mzlib/list
 	   (prefix wx: "kernel.ss")
+           (prefix wx: "wxme/keymap.ss")
 	   "lock.ss"
 	   "const.ss"
 	   "helper.ss"
@@ -285,11 +286,12 @@
 								 ":"
 								 "")])
 						  (case (system-type)
-						    [(unix windows) (format "~a~a~a~a~a?:~a" 
+						    [(unix windows) (format "~a~a~a~a?:~a" 
 									    exact
 									    (if (memq 'shift prefix) "s:" "")
-									    (if (memq 'meta prefix) "m:" "~m:")
-									    (if (memq 'alt prefix) "m:" "~m:")
+                                                                            (if (or (memq 'meta prefix)
+                                                                                    (memq 'alt prefix))
+                                                                                "m:" "~m:")
 									    (if (memq 'ctl prefix) "c:" "")
 									    base)]
 						    [(macosx) (format "~a~a~a~a~a?:~a" 
diff --git a/collects/mred/private/mrpopup.ss b/collects/mred/private/mrpopup.ss
index b9b7f77e..81a75c62 100644
--- a/collects/mred/private/mrpopup.ss
+++ b/collects/mred/private/mrpopup.ss
@@ -3,6 +3,7 @@
 	   mzlib/class100
 	   mzlib/list
 	   (prefix wx: "kernel.ss")
+           (prefix wx: "wxme/cycle.ss")
 	   "lock.ss"
 	   "const.ss"
 	   "helper.ss"
@@ -63,4 +64,6 @@
 					 (wx:queue-callback go wx:middle-queue-key)
 					 (go))))
 				 (no-val->#f font)))
-	   (super-init wx)))))))
+	   (super-init wx))))))
+
+  (wx:set-popup-menu%! popup-menu%))
diff --git a/collects/mred/private/path-dialog.ss b/collects/mred/private/path-dialog.ss
index 464eedc8..9b81def8 100644
--- a/collects/mred/private/path-dialog.ss
+++ b/collects/mred/private/path-dialog.ss
@@ -1,6 +1,7 @@
 (module path-dialog mzscheme
   (require mzlib/class mzlib/list mzlib/string mzlib/file
 	   (prefix wx: "kernel.ss")
+	   (prefix wx: "wxme/style.ss")
 	   "helper.ss" "mrtop.ss" "mritem.ss" "mrpanel.ss" "mrtextfield.ss"
            "messagebox.ss" "mrmenu.ss" (only scheme/base compose))
   (provide path-dialog%)
diff --git a/collects/mred/private/repl.ss b/collects/mred/private/repl.ss
index f5c9b7f2..8f406c19 100644
--- a/collects/mred/private/repl.ss
+++ b/collects/mred/private/repl.ss
@@ -2,6 +2,7 @@
   (require mzlib/class
 	   mzlib/class100
 	   (prefix wx: "kernel.ss")
+	   (prefix wx: "wxme/style.ss")
 	   "editor.ss"
 	   "app.ss"
 	   "mrtop.ss"
diff --git a/collects/mred/private/seqcontract.ss b/collects/mred/private/seqcontract.ss
index c16fd39c..0bfe0b5b 100644
--- a/collects/mred/private/seqcontract.ss
+++ b/collects/mred/private/seqcontract.ss
@@ -245,7 +245,7 @@ Matthew
             (not (locked-for-read?)))
        (set-position [(x) (x y) (x y z) (x y z p) (x y z p q)] unlocked)
        (set-autowrap-bitmap [(bitmap)] unlocked)
-       (print-to-dc [(dc)] unlocked)
+       (print-to-dc [(dc) (dc page)] unlocked)
        (move-position [(code?) (code? extend) (code? extend kind)] unlocked)
        (split-snip [(pos)] unlocked)
        (set-line-spacing [(space)] unlocked)
diff --git a/collects/mred/private/snipfile.ss b/collects/mred/private/snipfile.ss
index 11379e41..bd8ba41f 100644
--- a/collects/mred/private/snipfile.ss
+++ b/collects/mred/private/snipfile.ss
@@ -4,6 +4,8 @@
 	   mzlib/port
 	   syntax/moddep
 	   (prefix wx: "kernel.ss")
+	   (prefix wx: "wxme/snip.ss")
+	   (prefix wx: "wxme/cycle.ss")
 	   "check.ss"
 	   "editor.ss")
 		
@@ -50,10 +52,10 @@
                          (error 'load-class "not a ~a% instance" id))))
 		 #f)))])
     ;; install the getters:
-    (wx:set-snip-class-getter 
+    (wx:set-get-snip-class!
      (lambda (name)
        (load-one name 'snip-class wx:snip-class%)))
-    (wx:set-editor-data-class-getter 
+    (wx:set-get-editor-data-class!
      (lambda (name)
        (load-one name 'editor-data-class wx:editor-data-class%))))
 
diff --git a/collects/mred/private/syntax.ss b/collects/mred/private/syntax.ss
new file mode 100644
index 00000000..c195293b
--- /dev/null
+++ b/collects/mred/private/syntax.ss
@@ -0,0 +1,266 @@
+#lang scheme/base
+(require scheme/class
+         scheme/stxparam
+         (for-syntax scheme/base))
+
+(provide defclass defclass*
+         def/public def/override define/top case-args
+         maybe-box? any? bool? nonnegative-real? make-or-false make-box make-list make-alts 
+         make-literal symbol-in make-procedure
+         method-name init-name
+         let-boxes
+         properties field-properties init-properties
+         ->long)
+
+(define-syntax-parameter class-name #f)
+
+(define-syntax-rule (defclass name super . body)
+  (defclass* name super () . body))
+(define-syntax-rule (defclass* name super intfs . body)
+  (define name
+    (syntax-parameterize ([class-name 'name])
+      (class* super intfs . body))))
+
+(define-syntax (def/public stx)
+  #`(def/thing define/public #,stx))
+(define-syntax (def/override stx)
+  #`(def/thing define/override #,stx))
+(define-syntax (define/top stx)
+  #`(def/thing define #,stx))
+
+(define (method-name class method)
+  (string->symbol (format "~a in ~a" method class)))
+(define (init-name class)
+  (string->symbol (format "initialization for ~a" class)))
+
+(define-syntax just-id
+  (syntax-rules ()
+    [(_ [id default]) id]
+    [(_ id) id]))
+
+(define-struct named-pred (pred make-name)
+  #:property prop:procedure (struct-field-index pred))
+
+(define (apply-pred pred val)
+  (cond
+   [(procedure? pred) (pred val)]
+   [(class? pred) (val . is-a? . pred)]
+   [(interface? pred) (val . is-a? . pred)]
+   [else (error 'check-arg "unknown predicate type: ~e" pred)]))
+
+(define (make-or-false pred)
+  (make-named-pred (lambda (v)
+                     (or (not v) (apply-pred pred v)))
+                   (lambda ()
+                     (string-append (predicate-name pred)
+                                    " or #f"))))
+
+(define (make-box pred)
+  (make-named-pred (lambda (v)
+                     (and (box? v) (apply-pred pred (unbox v))))
+                   (lambda ()
+                     (string-append "boxed " (predicate-name pred)))))
+
+(define (make-list pred)
+  (make-named-pred (lambda (v)
+                     (and (list? v) (andmap (lambda (v) (apply-pred pred v)) v)))
+                   (lambda ()
+                     (string-append "list of " (predicate-name pred)))))
+
+(define (make-alts a b)
+  (make-named-pred (lambda (v)
+                     (or (apply-pred a v) (apply-pred b v)))
+                   (lambda ()
+                     (string-append (predicate-name a)
+                                    " or "
+                                    (predicate-name b)))))
+
+(define (make-literal lit)
+  (make-named-pred (lambda (v) (equal? v lit))
+                   (lambda () (if (symbol? lit)
+                                  (format "'~s" lit)
+                                  (format "~s" lit)))))
+
+(define (make-symbol syms)
+  (make-named-pred (lambda (v) (memq v syms))
+                   (lambda ()
+                     (let loop ([syms syms])
+                       (cond
+                        [(null? (cdr syms))
+                         (format "'~s" (car syms))]
+                        [(null? (cddr syms))
+                         (format "'~s, or '~s" (car syms) (cadr syms))]
+                        [else
+                         (format "'~s, ~a" (car syms) (loop (cdr syms)))])))))
+(define-syntax-rule (symbol-in sym ...)
+  (make-symbol '(sym ...)))
+
+(define (make-procedure arity)
+  (make-named-pred (lambda (p)
+                     (and (procedure? p)
+                          (procedure-arity-includes? p arity)))
+                   (lambda ()
+                     (format "procedure (arity ~a)" arity))))
+
+(define (check-arg val pred pos)
+  (if (apply-pred pred val)
+      #f
+      (cons (predicate-name pred)
+            pos)))
+
+(define (predicate-name pred)
+  (cond
+   [(named-pred? pred) ((named-pred-make-name pred))]
+   [(procedure? pred) (let ([s (symbol->string (object-name pred))])
+                        (substring s 0 (sub1 (string-length s))))]
+   [(or (class? pred) (interface? pred))
+    (format "~a instance" (object-name pred))]
+   [else "???"]))
+
+(define maybe-box? (make-named-pred (lambda (v) (or (not v) (box? v)))
+                                    (lambda () "box or #f")))
+(define (any? v) #t)
+(define (bool? v) #t)
+(define (nonnegative-real? v) (and (real? v) (v . >= . 0)))
+
+(define (method-of cls nam)
+  (if cls
+      (string->symbol (format "~a method of ~a" nam cls))
+      nam))
+
+(define-syntax (def/thing stx)
+  (syntax-case stx ()
+    [(_ define/orig (_ (id [arg-type arg] ...)))
+     (raise-syntax-error #f "missing body" stx)]
+    [(_ define/orig (_ (id [arg-type arg] ...) . body))
+     (with-syntax ([(_ _ orig-stx) stx]
+                   [(pos ...) (for/list ([i (in-range (length (syntax->list #'(arg ...))))])
+                                i)]
+                   [cname (syntax-parameter-value #'class-name)])
+       (syntax/loc #'orig-stx
+         (define/orig (id arg ...)
+           (let ([bad (or (check-arg (just-id arg) arg-type pos)
+                          ...)])
+             (when bad
+               (raise-type-error (method-of 'cname 'id) (car bad) (cdr bad) (just-id arg) ...)))
+           (let ()
+             . body))))]))
+
+(define-for-syntax lifted (make-hash))
+(define-syntax (lift-predicate stx)
+  (syntax-case stx ()
+    [(_ id) (identifier? #'id) #'id]
+    [(_ expr)
+     (let ([d (syntax->datum #'expr)])
+       (or (hash-ref lifted d #f)
+           (let ([id (syntax-local-lift-expression #'expr)])
+             (hash-set! lifted d id)
+             id)))]))
+
+(define-syntax (case-args stx)
+  (syntax-case stx ()
+    [(_ expr [([arg-type arg] ...) rhs ...] ... who)
+     (with-syntax ([((min-args-len . max-args-len) ...)
+                    (map (lambda (args)
+                           (let ([args (syntax->list args)])
+                             (cons (let loop ([args args])
+                                     (if (or (null? args)
+                                             (not (identifier? (car args))))
+                                         0
+                                         (add1 (loop (cdr args)))))
+                                   (length args))))
+                         (syntax->list #'((arg ...) ...)))])
+       #'(let* ([args expr]
+                [len (length args)])
+           (find-match
+            (lambda (next)
+              (if (and (len . >= . min-args-len)
+                       (len . <= . max-args-len))
+                  (apply
+                   (lambda (arg ...)
+                     (if (and (not (check-arg (just-id arg) (lift-predicate arg-type) 0)) ...)
+                         (lambda () rhs ...)
+                         next))
+                   args)
+                  next))
+            ...
+            (lambda (next)
+              (bad-args who args)))))]))
+
+(define (bad-args who args)
+  (error who "bad argument combination:~a"
+         (apply string-append (map (lambda (x) (format " ~e" x))
+                                   args))))
+
+(define-syntax find-match
+  (syntax-rules ()
+    [(_ proc)
+     ((proc #f))]
+    [(_ proc1 proc ...)
+     ((proc1 (lambda () (find-match proc ...))))]))
+
+(define-syntax-rule (let-boxes ([id init] ...)
+                               call
+                               body ...)
+  (let ([id (box init)] ...)
+    call
+    (let ([id (unbox id)] ...)
+      body ...)))
+
+(define-syntax (do-properties stx)
+  (syntax-case stx ()
+    [(_ define-base check-immutable [[type id] expr] ...)
+     (let ([ids (syntax->list #'(id ...))])
+       (with-syntax ([(getter ...)
+                      (map (lambda (id)
+                             (datum->syntax id
+                                            (string->symbol
+                                             (format "get-~a" (syntax-e id)))
+                                            id))
+                           ids)]
+                     [(setter ...)
+                      (map (lambda (id)
+                             (datum->syntax id
+                                            (string->symbol
+                                             (format "set-~a" (syntax-e id)))
+                                            id))
+                           ids)])
+         #'(begin
+             (define-base id expr) ...
+             (define/public (getter) id) ...
+             (def/public (setter [type v]) (check-immutable 'setter) (set! id (coerce type v))) ...)))]))
+
+(define-syntax coerce
+  (syntax-rules (bool?)
+    [(_ bool? v) (and v #t)]
+    [(_ _ v) v]))
+
+(define-syntax properties
+  (syntax-rules ()
+    [(_ #:check-immutable check-immutable . props)
+     (do-properties define check-immutable . props)]
+    [(_ . props)
+     (do-properties define void . props)]))
+(define-syntax field-properties
+  (syntax-rules ()
+    [(_ #:check-immutable check-immutable . props)
+     (do-properties define-field check-immutable . props)]
+    [(_ . props)
+     (do-properties define-field void . props)]))
+(define-syntax-rule (define-field id val) (field [id val]))
+(define-syntax init-properties
+  (syntax-rules ()
+    [(_ #:check-immutable check-immutable . props)
+     (do-properties define-init check-immutable . props)]
+    [(_ . props)
+     (do-properties define-init void . props)]))
+(define-syntax-rule (define-init id val) (begin
+                                           (init [(internal id) val])
+                                           (define id internal)))
+
+(define (->long i) 
+  (cond
+   [(eqv? -inf.0 i) (- (expt 2 64))]
+   [(eqv? +inf.0 i) (expt 2 64)]
+   [(eqv? +nan.0 i) 0]
+   [else (inexact->exact (floor i))]))
diff --git a/collects/mred/private/wxcanvas.ss b/collects/mred/private/wxcanvas.ss
index 8f926a6b..2bef5bab 100644
--- a/collects/mred/private/wxcanvas.ss
+++ b/collects/mred/private/wxcanvas.ss
@@ -2,6 +2,8 @@
   (require mzlib/class
 	   mzlib/class100
 	   (prefix wx: "kernel.ss")
+	   (prefix wx: "wxme/text.ss")
+	   (prefix wx: "wxme/editor-canvas.ss")
 	   "lock.ss"
 	   "helper.ss"
 	   "wx.ss"
@@ -216,6 +218,11 @@
 	    (when mred
 	      (as-exit (lambda () (send init-buffer add-canvas mred)))))))))
 
-  (define wx-editor-canvas% (make-canvas-glue%
-			     (make-editor-canvas% (make-control% wx:editor-canvas%
-								 0 0 #t #t)))))
+  (define wx-editor-canvas% 
+    (class (make-canvas-glue%
+            (make-editor-canvas% (make-control% wx:editor-canvas%
+                                                0 0 #t #t)))
+      (inherit editor-canvas-on-scroll)
+      (define/override (on-scroll e)
+        (editor-canvas-on-scroll))
+      (super-new))))
diff --git a/collects/mred/private/wxme/const.ss b/collects/mred/private/wxme/const.ss
new file mode 100644
index 00000000..37c0eb4a
--- /dev/null
+++ b/collects/mred/private/wxme/const.ss
@@ -0,0 +1,5 @@
+#lang scheme/base
+
+(provide (all-defined-out))
+
+(define CURSOR-WIDTH 2)
diff --git a/collects/mred/private/wxme/cycle.ss b/collects/mred/private/wxme/cycle.ss
new file mode 100644
index 00000000..7bc95563
--- /dev/null
+++ b/collects/mred/private/wxme/cycle.ss
@@ -0,0 +1,27 @@
+#lang scheme/base
+
+(define-syntax-rule (decl id set-id)
+  (begin
+    (provide id set-id)
+    (define id #f)
+    (define (set-id v) (set! id v))))
+
+(decl text% set-text%!)
+(decl pasteboard% set-pasteboard%!)
+(decl snip-admin% set-snip-admin%!)
+(decl editor-stream-in% set-editor-stream-in%!)
+(decl editor-stream-out% set-editor-stream-out%!)
+(decl editor-snip% set-editor-snip%!)
+(decl editor-snip-editor-admin% set-editor-snip-editor-admin%!)
+
+(decl extended-editor-snip% set-extended-editor-snip%!)
+(decl extended-text% set-extended-text%!)
+(decl extended-pasteboard% set-extended-pasteboard%!)
+
+(decl get-snip-class set-get-snip-class!)
+(decl get-editor-data-class set-get-editor-data-class!)
+
+(decl editor-get-file set-editor-get-file!)
+(decl editor-put-file set-editor-put-file!)
+
+(decl popup-menu% set-popup-menu%!)
diff --git a/collects/mred/private/wxme/editor-admin.ss b/collects/mred/private/wxme/editor-admin.ss
new file mode 100644
index 00000000..8ece0cf2
--- /dev/null
+++ b/collects/mred/private/wxme/editor-admin.ss
@@ -0,0 +1,57 @@
+#lang scheme/base
+(require scheme/class
+         "../syntax.ss"
+         "snip.ss"
+         "private.ss"
+         (only-in "cycle.ss" popup-menu%))
+
+(provide editor-admin%)
+
+(defclass editor-admin% object%
+  (super-new)
+
+  (define standard 0) ; used to recognize standard display
+  (define/public (get-s-standard) standard)
+  (define/public (set-s-standard v) (set! standard v))
+  
+  (def/public (get-dc [maybe-box? [x #f]] [maybe-box? [y #f]])
+    (when x (set-box! x 0.0))
+    (when y (set-box! y 0.0))
+    #f)
+
+  (define/private (do-get-view x y w h)
+    (when x (set-box! x 0.0))
+    (when y (set-box! y 0.0))
+    (when w (set-box! w 0.0))
+    (when h (set-box! h 0.0)))
+
+  (def/public (get-view [maybe-box? x] [maybe-box? y]
+                        [maybe-box? w] [maybe-box? h]
+                        [any? [full? #f]])
+    (do-get-view x y w h))
+
+  (def/public (get-max-view [maybe-box? x] [maybe-box? y]
+                            [maybe-box? w] [maybe-box? h]
+                            [any? [full? #f]])
+    (get-view x y w h))
+
+  (def/public (scroll-to [real? localx] [real? localy] [real? w] [real? h] [any? [refresh? #t]] 
+                         [(symbol-in start none end) [bias 'none]])
+    (void))
+
+  (def/public (grab-caret [(symbol-in immediate display global) dist])
+    (void))
+
+  (def/public (resized [any? redraw-now]) (void))
+  
+  (def/public (needs-update [real? x] [real? y]
+                            [nonnegative-real? w] [nonnegative-real? h])
+    (void))
+
+  (def/public (update-cursor) (void))
+
+  (def/public (delay-refresh?) #f)
+
+  (def/public (popup-menu [popup-menu% m] [real? x] [real? y]) #f)
+
+  (def/public (modified [any? mod?]) (void)))
diff --git a/collects/mred/private/wxme/editor-canvas.ss b/collects/mred/private/wxme/editor-canvas.ss
new file mode 100644
index 00000000..cec33592
--- /dev/null
+++ b/collects/mred/private/wxme/editor-canvas.ss
@@ -0,0 +1,1133 @@
+#lang scheme/base
+(require scheme/class
+         "../syntax.ss"
+         "editor.ss"
+         "editor-admin.ss"
+         "private.ss"
+         (only-in "cycle.ss" popup-menu%)
+         "wx.ss")
+
+(provide editor-canvas%)
+
+;; FIXME: need contracts on public classes
+
+;; ----------------------------------------
+
+(define simple-scroll%
+  (class object%
+    (define horizontal #f)
+    (define count 0)
+    (define page-step 0)
+    (define value 0)
+
+    (init canvas
+          style
+          length
+          steps-per-page
+          position)
+
+    (super-new)
+
+    (set! count length)
+    (set! page-step steps-per-page)
+    (set! value position)
+
+    (set! horizontal (and (memq 'horizontal style) #t))
+    (set-scroll length steps-per-page position)
+    
+    (define/public (set-value position)
+      (set! value (max 0 (min count position))))
+
+    (define/public (set-scroll length steps-per-page position)
+      (when (length . > . -1)
+        (set! count length))
+      (when (steps-per-page . > . 0)
+        (set! page-step steps-per-page))
+      (when (position . > . -1)
+        (set! value position))
+      
+      (when (value . < . 0)
+        (set! value 0))
+      (when (value . > . count)
+        (set! value count)))
+
+    (define/public (get-value)
+      value)))
+
+;; ----------------------------------------
+
+(define update-cursor-timer%
+  (class timer%
+    (inherit start stop)
+    (init-field admin)
+
+    (super-new)
+
+    (define/override (notify)
+      (stop)
+      (when admin
+        (send admin clear-update-cursor-timer)
+        (send (send admin get-canvas) update-cursor-now)))
+
+    (define/public (cancel)
+      (set! admin #f))))
+
+;; ----------------------------------------
+
+(define BLINK-DELAY 500)
+
+(define blink-timer%
+  (class timer%
+    (inherit stop)
+    (init-field canvas)
+
+    (super-new)
+    
+    (define/override (notify)
+      (when canvas
+        (send canvas blink-caret)))
+
+    (define/public (kill)
+      (set! canvas #f)
+      (stop))))
+
+;; ----------------------------------------
+
+(define AUTO-DRAG-DELAY 100)
+
+(define auto-drag-timer%
+  (class timer% 
+    (inherit start stop)
+    (init-field canvas event)
+
+    (super-new)
+
+    (start AUTO-DRAG-DELAY #t)
+
+    (define/override (notify)
+      (when canvas
+        (let ([e (make-object mouse-event% (send event get-event-type))])
+          (send e set-alt-down (send event get-alt-down))
+          (send e set-caps-down (send event get-caps-down))
+          (send e set-control-down (send event get-control-down))
+          (send e set-left-down (send event get-left-down))
+          (send e set-meta-down (send event get-meta-down))
+          (send e set-middle-down (send event get-middle-down))
+          (send e set-right-down (send event get-right-down))
+          (send e set-shift-down (send event get-shift-down))
+          (send e set-x (send event get-x))
+          (send e set-y (send event get-y))
+          (send e set-time-stamp
+                (+ (send e get-time-stamp) AUTO-DRAG-DELAY))
+          (send canvas on-event event))))
+
+    (define/public (kill)
+      (set! canvas #f)
+      (stop))))
+
+;; ----------------------------------------
+
+(define default-wheel-amt 3)
+
+(define (INIT-SB style)
+  (append
+   (if (or (memq 'no-hscroll style)
+           (memq 'hide-hscroll style))
+       null
+       '(hscroll))
+   (if (or (memq 'no-vscroll style)
+           (memq 'hide-vscroll style))
+       null
+       '(vscroll))))
+
+(define (memq? s l) (and (memq s l) #t))
+
+(define (keep-style l s) (if (memq s l) (list s) null))
+
+(defclass editor-canvas% canvas%
+
+  (inherit refresh get-canvas-background get-dc
+           get-client-size get-size set-cursor
+           get-scroll-pos set-scroll-pos 
+           get-scroll-page set-scroll-page
+           get-scroll-range set-scroll-range
+           is-shown-to-root?
+           show-scrollbars)
+
+  (define blink-timer #f)
+  (define noloop? #f)
+
+  (define focuson? #f)
+  (define focusforcedon? #f)
+  (define/public (get-focusforcedon?) focusforcedon?)
+  (define lazy-refresh? #f)
+  (define need-refresh? #f)
+
+  (define auto-dragger #f)
+
+  (define custom-cursor #f)
+  (define custom-cursor-on? #f)
+
+  (define scroll-to-last? #f)
+  (define scroll-bottom-based? #f)
+  (define scroll-offset 0)
+
+  (define lastwidth -1)
+  (define lastheight -1)
+
+  (define last-x 0)
+  (define last-y 0)
+
+  (define bg-color #f)
+
+  (define wheel-amt default-wheel-amt)
+  (define xmargin 5)
+  (define ymargin 5)
+
+  (set! noloop? #t)
+  (init parent x y width height
+        name style 
+        [scrolls-per-page 100]
+        [editor #f]
+        [gl-config #f])
+
+  (super-make-object parent
+                     x y width height
+                     (append (keep-style style 'border)
+                             (INIT-SB style)
+                             (keep-style style 'invisible)
+                             (if (memq 'transparent style)
+                                 '(transparent)
+                                 '(no-autoclear))
+                             (keep-style style 'control-border)
+                             (keep-style style 'combo-side)
+                             (keep-style style 'resize-corner))
+                     name
+                     gl-config)
+
+  (define given-h-scrolls-per-page scrolls-per-page)
+
+  (define allow-x-scroll? (not (memq 'no-hscroll style)))
+  (define allow-y-scroll? (not (memq 'no-vscroll style)))
+
+  (define fake-x-scroll? (or (not allow-x-scroll?)
+                             (memq? 'hide-hscroll style)))
+  (define fake-y-scroll? (or (not allow-y-scroll?)
+                             (memq? 'hide-vscroll style)))
+
+  (define auto-x? (and (not fake-x-scroll?)
+                       (memq? 'auto-hscroll style)))
+  (define auto-y? (and (not fake-y-scroll?)
+                       (memq? 'auto-vscroll style)))
+
+  (define xscroll-on? (and (not fake-x-scroll?) (not auto-x?)))
+  (define yscroll-on? (and (not fake-y-scroll?) (not auto-y?)))
+
+  (show-scrollbars xscroll-on? yscroll-on?)
+  (super set-scrollbars 
+         1 1 ;; Windows fake-{x,y}-scroll => -1 instead of 1 !? 
+         1 1 ;;
+         1 1 0 0 #f)
+  
+  (define hscroll
+    (if fake-x-scroll?
+        (new simple-scroll%
+             [canvas this]
+             [style '(horizontal)]
+             [length 0]
+             [steps-per-page 1]
+             [position 0])
+        #f))
+  (define vscroll
+    (if fake-y-scroll?
+        (new simple-scroll%
+             [canvas this]
+             [style '(vertical)]
+             [length 0]
+             [steps-per-page 1]
+             [position 0])
+        #f))
+
+  (define scroll-width (if fake-x-scroll? 1 1)) ;; else used to be 0
+  (define scroll-height (if fake-y-scroll? 1 1))
+
+  (define hscrolls-per-page 1)
+  (define vscrolls-per-page 1)
+  (define hpixels-per-scroll 0)
+
+  (set! noloop? #f)
+
+  (define admin (new canvas-editor-admin%
+                     [canvas this]))
+  (send admin adjust-std-flag)
+
+  (define media editor)
+  (when media (set-editor media))
+  
+  ;; FIXME: needed?
+  (define/public (~)
+    (when auto-dragger
+      (send auto-dragger kill)
+      (set! auto-dragger #f))
+    (when blink-timer
+      (send blink-timer kill)
+      (set! blink-timer #f))
+    (send admin set-canvas #f)
+    #;(super ~))
+  
+  (define/override (on-size w h)
+    (unless noloop?
+      (unless (and (= w lastwidth)
+                   (= h lastheight))
+        (unless (and media
+                     (send media get-printing))
+          (reset-size)))))
+
+  (define/private (reset-size)
+    (reset-visual #f)
+    (refresh))
+
+  (define/public (set-x-margin x)
+    (unless (= x xmargin)
+      (set! xmargin x)
+      (reset-size)))
+  (define/public (set-y-margin y)
+    (unless (= y ymargin)
+      (set! ymargin y)
+      (reset-size)))
+  (define/public (get-x-margin) xmargin)
+  (define/public (get-y-margin) ymargin)
+
+  (define/override (set-canvas-background c)
+    (super set-canvas-background c)
+    (refresh))
+
+  (define-syntax-rule (using-admin body ...)
+    (let ([oldadmin (send media get-admin)])
+      (unless (eq? admin oldadmin)
+        (send media set-admin admin))
+      (begin0
+       (begin body ...)
+       (when media
+         (unless (eq? admin oldadmin)
+           ;; FIXME: how do we know that this adminstrator
+           ;; still wants the editor?
+           (send media set-admin oldadmin))))))
+
+  (define/private (get-eventspace)
+    (send (send this get-top-level) get-eventspace))
+
+  (define/private (on-focus focus?)
+    (unless (eq? focus? focuson?)
+      (set! focuson? focus?)
+      (when (and media
+                 (not (send media get-printing)))
+        (using-admin
+         (when media
+           (send media own-caret focus?))))
+      (when focuson?
+        (unless blink-timer
+          (set! blink-timer (parameterize ([current-eventspace (get-eventspace)])
+                              (new blink-timer% [canvas this]))))
+        (send blink-timer start BLINK-DELAY #t))))
+
+  (define/public (blink-caret)
+    (when focuson?
+      (when media
+        (using-admin
+         (when media
+           (send media blink-caret))))
+      (send blink-timer start BLINK-DELAY #t)))
+
+  (define/public (call-as-primary-owner thunk)
+    (if media
+        (using-admin
+         (thunk))
+        (thunk)))
+
+  (define/override (on-set-focus)
+    (on-focus #t))
+  (define/override (on-kill-focus)
+    (on-focus #f))
+
+  (define/public (is-focus-on?) focuson?)
+
+  (define (force-display-focus on?)
+    (let ([old-on? focusforcedon?])
+      (set! focusforcedon? on?)
+      (send admin adjust-std-flag)
+      (when (not (equal? (or focuson? focusforcedon?)
+                         (or focuson? old-on?)))
+        (refresh))))
+
+
+  (define/override (on-event event)
+    ;; Turn off auto-dragger, if there is one
+    (when auto-dragger
+      (send auto-dragger kill)
+      (set! auto-dragger #f))
+
+    (let ([x (send event get-x)]
+          [y (send event get-y)])
+      (set! last-x x)
+      (set! last-y y)
+      
+      (when (and media
+                 (not (send media get-printing)))
+        (using-admin
+         (when media
+           (set-custom-cursor
+            (send media adjust-cursor event)))
+         (when media
+           (send media on-event event))))
+      
+      (when (send event dragging?)
+        (let-boxes ([cw 0]
+                    [ch 0])
+            (get-client-size cw ch)
+          (when (or (x . < . 0)
+                    (y . < . 0)
+                    (x . > . cw)
+                    (y . > . ch))
+            ;; Dragging outside the canvas: auto-generate more events because the buffer
+            ;; is probably scrolling. But make sure we're shown.
+            (when (is-shown-to-root?)
+              (set! auto-dragger (parameterize ([current-eventspace (get-eventspace)])
+                                   (new auto-drag-timer% 
+                                        [canvas this]
+                                        [event event])))))))))
+
+  (define/private (update-cursor-now)
+    (when media
+      (let ([e (new mouse-event% [type 'motion])])
+        (send e set-x last-x)
+        (send e set-y last-y)
+        (send e set-timestamp 0)
+
+        (using-admin
+         (when media
+           (set-custom-cursor (send media adjust-cursor e)))))))
+
+  (define/public (popup-for-editor b m) #f)
+
+  (define/override (on-char event)
+    (let ([code (send event get-key-code)])
+      (case (and (positive? wheel-amt)
+                 code)
+        [(wheel-up wheel-down)
+         (when (and allow-y-scroll?
+                    (not fake-y-scroll?))
+           (let-boxes ([x 0]
+                       [y 0])
+               (get-scroll x y)
+             (let ([y (max (+ y
+                              (if (eq? code 'wheel-up)
+                                  -1
+                                  1))
+                           0)])
+               (scroll x y #t))))]
+        [else
+         (when (and media (not (send media get-printing)))
+           (using-admin
+            (when media
+              (send media on-char event))))])))
+
+  (define/public (clear-margins)
+    ;; This method is called by `on-paint' in `editor-canvas%'
+    ;; before it calls the `on-paint' in `canvas%'. It's
+    ;; essentially a compromise between autoclear mode and
+    ;; no-autoclear mode.
+
+    (when (or (positive? xmargin)
+              (positive? ymargin))
+      (let ([bg (get-canvas-background)])
+        (when bg
+          (let ([cw (box 0)]
+                [ch (box 0)]
+                [b (send the-brush-list find-or-create-brush bg 'solid)]
+                [p (send the-pen-list find-or-create-pen "BLACK" 0 'transparent)]
+                [dc (get-dc)])
+            (get-client-size cw ch)
+            (let ([ob (send dc get-brush)]
+                  [op (send dc get-pen)]
+                  [cw (unbox cw)]
+                  [ch (unbox ch)])
+              (send dc set-brush b)
+              (send dc set-pen p)
+              
+              (send dc draw-rectangle 0 0 xmargin ch)
+              (send dc draw-rectangle (- cw xmargin) 0 cw ch)
+              (send dc draw-rectangle 0 0 cw ymargin)
+              (send dc draw-rectangle 0 (- ch ymargin) cw ch)
+
+              (send dc set-brush ob)
+              (send dc set-pen op)))))))
+
+  (define/override (on-paint)
+    (set! need-refresh? #f)
+    (if media
+        (when (not (send media get-printing))
+          (let-boxes ([x 0][y 0][w 0][h 0])
+              (get-view x y w h)
+            (redraw x y w h)))
+        (let ([bg (get-canvas-background)])
+          (when bg
+            (let ([adc (get-dc)])
+              (send adc set-background bg)
+              (send adc clear)))))
+    (super on-paint))
+
+  (define/public (repaint)
+    (unless need-refresh?
+      (if (or lazy-refresh? (not (get-canvas-background)))
+          (begin
+            (set! need-refresh? #t)
+            (refresh))
+          (on-paint))))
+  
+  (define/private (paint-scrolls) (void))
+
+  (define/public (set-lazy-refresh on?)
+    (set! lazy-refresh? on?)
+    (when (and (not on?)
+               need-refresh?)
+      (on-paint)))
+
+  (define (get-lazy-refresh) lazy-refresh?)
+
+  (define/public (set-custom-cursor cursor)
+    (if (not cursor)
+        (no-custom-cursor)
+        (begin
+          (set! custom-cursor-on? #t)
+          (set! custom-cursor cursor)
+          (set-cursor custom-cursor))))
+
+  (define arrow #f)
+  (define/public (no-custom-cursor)
+    (when (not arrow)
+      (set! arrow (make-object cursor% 'arrow)))
+    (when custom-cursor-on?
+      (set! custom-cursor-on? #f)
+      (set-cursor arrow)))
+
+
+  (define/public (get-dc-and-offset fx fy)
+    (when (or fx fy)
+      (let-boxes ([x 0]
+                  [y 0])
+          (get-scroll x y)
+        (when fx
+          (set-box! fx (- (* x hpixels-per-scroll) xmargin)))
+        (when fy
+          (if (and media
+                   (or (positive? y)
+                       scroll-bottom-based?))
+              (let ([v (- (send media scroll-line-location (+ y scroll-offset))
+                          ymargin)])
+                (set-box! fy v)
+                (when (and scroll-bottom-based?
+                           (or (positive? scroll-height)
+                               scroll-to-last?))
+                  (let-boxes ([w 0] [h 0])
+                      (get-client-size w h)
+                    (let ([h (max (- h (* 2 ymargin))
+                                  0)])
+                      (set-box! fy (- (unbox fy) h))))))
+              (set-box! fy (- ymargin))))))
+    (get-dc))
+
+  (define/public (get-view fx fy fw fh [unused-full? #f])
+    (let ([w (box 0)]
+          [h (box 0)])
+      (get-client-size w h)
+      (get-dc-and-offset fx fy)
+      (when fx
+        (set-box! fx (+ (unbox fx) xmargin)))
+      (when fy
+        (set-box! fy (+ (unbox fy) ymargin)))
+      (when fh
+        (set-box! fh (max 0 (- (unbox h) (* 2 ymargin)))))
+      (when fw
+        (set-box! fw (max 0 (- (unbox w) (* 2 xmargin)))))))
+
+  (define/public (redraw localx localy fw fh)
+    (when (and media
+               (not (send media get-printing)))
+      (begin-refresh-sequence)
+      (let ([x (box 0)]
+            [y (box 0)]
+            [w (box 0)]
+            [h (box 0)])
+        (get-view x y w h)        
+        (let ([x (unbox x)]
+              [y (unbox y)]
+              [w (unbox w)]
+              [h (unbox h)])
+          (let ([right (+ x w)]
+                [bottom (+ y h)])
+            (let ([x (max x localx)]
+                  [y (max y localy)]
+                  [right (min right (+ localx fw))]
+                  [bottom (min bottom (+ localy fh))])
+              (let ([w (max 0 (- right x))]
+                    [h (max 0 (- bottom y))])
+                (when (or (positive? w)
+                          (positive? h))
+                  (using-admin
+                   (when media
+                     (send media refresh
+                           x y w h
+                           (if (or focuson? focusforcedon?)
+                               'show-caret
+                               'show-inactive-caret)
+                           (get-canvas-background))))))))))
+      (end-refresh-sequence)))
+
+
+  (def/public (scroll-to [real? localx] [real? localy] [real? fw] [real? fh] [any? refresh?] 
+                         [(symbol-in start none end) [bias 'none]])
+    (let ([med media])
+      (if (or (not med)
+              (send med get-printing)
+              (and (not allow-x-scroll?)
+                   (not allow-y-scroll?)))
+          #f
+          (let-boxes ([x 0]
+                      [y 0]
+                      [iw 0]
+                      [ih 0])
+              (get-view x y iw ih)
+            (if (or (zero? iw)
+                    (zero? ih))
+                #f
+                (let ([find-dy (if scroll-bottom-based?
+                                   ih
+                                   0)])
+                  (let-boxes ([cx 0]
+                              [cy 0])
+                      (get-scroll cx cy)
+                    (let ([sy
+                           (if allow-y-scroll?
+                               (cond
+                                [(or
+                                  ;; doesn't fit and bias is set:
+                                  (and (eq? bias 'start) (fh . > . ih))
+                                  ;; fits, need to shift down into view:
+                                  (and (fh . <= . ih) (localy . < . y) )
+                                  ;; doesn't fit, no conflicting bias, can shift up to see more:
+                                  (and (fh . > . ih) (not (eq? bias 'end)) (localy . < . y)))
+                                 (- (send med find-scroll-line (+ find-dy localy))
+                                    scroll-offset)]
+                                [(or
+                                  ;; doesn't fit, bias is set:
+                                  (and (eq? bias 'end) (fh . > . ih))
+                                  ;; fits, need to shift up into view:
+                                  (and (fh . <= . ih) ((+ y ih) . < . (+ localy fh))))
+                                 (let ([l (+ find-dy localy (- fh ih))])
+                                   ;; find scroll pos for top of region to show:
+                                   (let ([sy (send med find-scroll-line l)])
+                                     ;; unless l is exactly the top of a line, move down to the next whole line:
+                                     (let ([sy (if (= (send med scroll-line-location sy) l)
+                                                   sy
+                                                   (+ sy 1))])
+                                       (- sy scroll-offset))))]
+                                [(or
+                                  ;; doesn't fit, no conflicting bias, maybe shift down to see more:
+                                  (and (fh . > . ih)
+                                       (not (eq? bias 'start))
+                                       ((+ localy fh) .  > . (+ y ih))))
+                                 ;; shift to one more than the first scroll position that shows last line
+                                 (let ([my (+ (send med find-scroll-line (+ find-dy localy (- fh ih)))
+                                              (- 1 scroll-offset))])
+                                   ;; but only shift down the extra line if doing so doesn't skip the whole area
+                                   (cond
+                                    [((send med scroll-line-location my) . < . (+ find-dy localy fh))
+                                     my]
+                                    [(my . > . 0)
+                                     (- my 1)]
+                                    [else 0]))]
+                                [else cy])
+                               cy)]
+                          [sx
+                           (if allow-x-scroll?
+                               (if (positive? hpixels-per-scroll)
+                                   (cond
+                                    [(or (and (eq? bias 'start) (fw . > . iw))
+                                         (and (fw . < . iw) (localx . < . x))
+                                         (and (fw . > . iw) (not (eq? bias 'end)) (localx . < . x)))
+                                     (quotient localx hpixels-per-scroll)]
+                                    [(or (and (eq? bias 'end) (fw . > . iw))
+                                         (and (fw . < . iw) ((+ x iw) . < . (+ localx fw)))
+                                         (and (fw . > . iw) (not (eq? bias 'start)) ((+ localx fw) . > . (+ x iw))))
+                                     (+ (quotient (+ localx (- fw iw)) hpixels-per-scroll) 1)]
+                                    [else cx])
+                                   0)
+                               cx)])
+                      (if (or (not (= sy cy))
+                              (not (= sx cx)))
+                          (begin
+                            (when hscroll
+                              (send hscroll set-value sx))
+                            (when vscroll
+                              (send vscroll set-value sy))
+                            (scroll sx sy refresh?)
+                            #t)
+                          #f)))))))))
+
+  (define/public (reset-visual reset-scroll?)
+    (if (given-h-scrolls-per-page . < . 0)
+        (begin
+          (set! given-h-scrolls-per-page -2)
+          #f)
+        (let loop ([retval #f])
+          (let-boxes ([sx 0]
+                      [sy 0])
+              (get-scroll sx sy)
+            (let-boxes ([lw 0]
+                        [lh 0])
+                (get-size lw lh)
+              (set! lastwidth lw)
+              (set! lastheight lh)
+              
+              (let-values ([(x y vnum-scrolls hnum-scrolls vspp hspp)
+                            (if (and media (or allow-x-scroll? allow-y-scroll?))
+
+                                (let ([med media])
+                                  (let-values ([(x y)
+                                                (if reset-scroll?
+                                                    (values 0 0)
+                                                    (values sx sy))])
+                                    
+                                    (let-boxes ([w 0.0]
+                                                [h 0.0])
+                                        (get-view #f #f w h)
+                                      (let-boxes ([total-width 0.0]
+                                                  [total-height 0.0])
+                                          (send med get-extent total-width total-height)
+
+                                        (let-values ([(vnum-scrolls scroll-offset)
+                                                      (if (or (zero? h)
+                                                              (and (not scroll-to-last?)
+                                                                   (h . >= . total-height)))
+                                                          (values 0 0)
+
+                                                          (if scroll-bottom-based?
+                                                              (let ([vnum-scrolls (- (send med num-scroll-lines) 1)])
+                                                                (if scroll-to-last?
+                                                                    (values vnum-scrolls 1)
+                                                                    (let ([start (- (send med find-scroll-line (+ h 1)) 1)])
+                                                                      (values (- vnum-scrolls start)
+                                                                              (+ scroll-offset start)))))
+                                                              (let ([top (max 0
+                                                                              (- (->long (- total-height
+                                                                                            (if scroll-to-last?
+                                                                                                0
+                                                                                                h)))
+                                                                                 1))])
+                                                                (let ([vnum-scrolls (+ (send med find-scroll-line top) 1)]
+                                                                      [nsl (send med num-scroll-lines)])
+                                                                  (values (if (vnum-scrolls . >= . nsl)
+                                                                              (- nsl 1)
+                                                                              vnum-scrolls)
+                                                                          0)))))])
+
+                                          (let-values ([(num-scrolls vspp)
+                                                        (if (positive? vnum-scrolls)
+                                                            (let ([num-lines (- (send med num-scroll-lines) 1)])
+                                                              (values vnum-scrolls
+                                                                      (max 1
+                                                                           (- (->long
+                                                                               (/ (* h num-lines)
+                                                                                  total-height))
+                                                                              1))))
+                                                            (values 0 1))])
+
+                                            (let-values ([(hnum-scrolls hspp)
+                                                          (if (total-width . >= . w)
+                                                              (let ([tw (->long (- total-width w))])
+                                                                (set! hpixels-per-scroll 
+                                                                      (let ([v (->long (/ w given-h-scrolls-per-page))])
+                                                                        (if (zero? v) 2 v)))
+                                                                (let ([tw
+                                                                       (if (modulo tw hpixels-per-scroll)
+                                                                           (+ tw (- hpixels-per-scroll (modulo tw hpixels-per-scroll)))
+                                                                           tw)])
+                                                                  (values (quotient tw hpixels-per-scroll)
+                                                                          given-h-scrolls-per-page)))
+                                                              (values 0 1))])
+
+                                              (values x y vnum-scrolls hnum-scrolls vspp hspp))))))))
+
+                                (begin0
+                                 (values 0 0 0 0 1 1)
+                                 (when (not media)
+                                   (let ([dc (get-dc)])
+                                     (send dc set-background (get-canvas-background))
+                                     (send dc clear)))))])
+
+                (if (not (and (= scroll-width hnum-scrolls)
+                              (= scroll-height vnum-scrolls)
+                              (= vspp vscrolls-per-page)
+                              (= hspp hscrolls-per-page)
+                              (= x sx)
+                              (= y sy)))
+                    (begin
+                      (when hscroll
+                        (send hscroll set-scroll hnum-scrolls hspp x))
+                      (when vscroll
+                        (send vscroll set-scroll vnum-scrolls vspp y))
+                      (let ([savenoloop? noloop?]
+                            [save-h-s-p-p given-h-scrolls-per-page])
+                        (set! noloop? #t)
+                        (set! given-h-scrolls-per-page -1)
+                        
+                        (let ([xon? (and (not fake-x-scroll?) (not (zero? hnum-scrolls)))]
+                              [yon? (and (not fake-y-scroll?) (not (zero? vnum-scrolls)))])
+                          (let ([go-again?
+                                 (if (or (and auto-x? (not (eq? xon? xscroll-on?)))
+                                         (and auto-y? (not (eq? yon? yscroll-on?))))
+                                     (begin
+                                       (when auto-x?
+                                         (set! xscroll-on? xon?))
+                                       (when auto-y?
+                                         (set! yscroll-on? yon?))
+                                       (show-scrollbars xscroll-on? yscroll-on?)
+                                       (on-scroll-on-change)
+                                       #t)
+                                     #f)])
+
+                            (unless fake-x-scroll?
+                              (let ([x (min x hnum-scrolls)])
+                                (when (hspp . < . hscrolls-per-page)
+                                  (set-scroll-page 'horizontal hspp))
+                                (when (x . < . sx)
+                                  (set-scroll-pos 'horizontal x))
+                                (when (not (= scroll-width hnum-scrolls))
+                                  (set-scroll-range 'horizontal hnum-scrolls))
+                                (when (x . > . sx)
+                                  (set-scroll-pos 'horizontal x))
+                                (when (hspp . > . hscrolls-per-page)
+                                  (set-scroll-page 'horizontal hspp))))
+                            
+                            (unless fake-y-scroll?
+                              (let ([y (min y vnum-scrolls)])
+                                (when (vspp . < . vscrolls-per-page)
+                                  (set-scroll-page 'vertical vspp))
+                                (when (y . < . sy)
+                                  (set-scroll-pos 'vertical y))
+                                (when (not (= scroll-height vnum-scrolls))
+                                  (set-scroll-range 'vertical vnum-scrolls))
+                                (when (y . > . sy)
+                                  (set-scroll-pos 'vertical y))
+                                (when (vspp . > . vscrolls-per-page)
+                                  (set-scroll-page 'vertical vspp))))
+
+                            (let ([go-again? (or go-again?
+                                                 (given-h-scrolls-per-page . < . -1))])
+                              (set! given-h-scrolls-per-page save-h-s-p-p)
+                              (set! noloop? savenoloop?)
+                              (set! hscrolls-per-page hspp)
+                              (set! vscrolls-per-page vspp)
+                              (set! scroll-width hnum-scrolls)
+                              (set! scroll-height vnum-scrolls)
+
+                              (if go-again?
+                                  (loop #t)
+                                  #t))))))
+
+                    retval)))))))
+
+  (define/override scroll
+    (case-lambda 
+     [(x y refresh?)
+      (let ([savenoloop? noloop?])
+        (set! noloop? #t)
+        
+        (when (and (x . > . -1)
+                   (not fake-x-scroll?))
+          (when (positive? scroll-width)
+            (set-scroll-pos 'horizontal (->long (min x scroll-width)))))
+        
+        (when (and (y . > . -1)
+                   (not fake-y-scroll?))
+          (when (positive? scroll-height)
+            (set-scroll-pos 'vertical (->long (min y scroll-height)))))
+        
+        (set! noloop? savenoloop?)
+        
+        (when refresh? (repaint)))]
+     [(scroll x y) (void)]))
+
+  (define/override (set-scrollbars x y x2 y2 x3 y3 x4 y4 ?) (void))
+
+  (define/public (get-scroll x y)
+    ;; get fake scroll values if available
+    (set-box! x (if hscroll
+                    (send hscroll get-value)
+                    (get-scroll-pos 'horizontal)))
+    (set-box! y (if vscroll
+                    (send vscroll get-value)
+                    (get-scroll-pos 'vertical))))
+
+  (define/public (editor-canvas-on-scroll)
+    (unless noloop?
+      (repaint)))
+
+  (define/public (on-scroll-on-change) 
+    (void))
+
+  (define/public (get-editor) media)
+
+  (define/public (set-editor m update?)
+    (unless (eq? media m)
+      (when media
+        (when (eq? admin (send media get-admin))
+          (send media set-admin 
+                (or (send admin get-nextadmin)
+                    (send admin get-prevadmin))))
+
+        (let ([a (send admin get-nextadmin)])
+          (when a
+            (send a set-prevadmin (send admin get-prevadmin))
+            (send a adjust-std-flag)))
+        (let ([a (send admin get-prevadmin)])
+          (when a
+            (send a set-nextadmin (send admin get-nextadmin))
+            (send a adjust-std-flag)))
+        (send admin set-nextadmin #f)
+        (send admin set-prevadmin #f)
+        (when custom-cursor
+          (no-custom-cursor)
+          (set! custom-cursor #f)))
+      (set! media m)
+      (when media
+        (let ([oldadmin (send media get-admin)])
+          (if (and oldadmin
+                   (not (send oldadmin get-s-standard)))
+              (set! media #f)
+              (if oldadmin
+                  (begin
+                    (send admin set-nextadmin oldadmin)
+                    (send admin set-prevadmin (send oldadmin get-prevadmin))
+                    (send oldadmin set-prevadmin admin)
+                    (send oldadmin adjust-std-flag)
+                    (let ([a (send admin get-prevadmin)])
+                      (when a
+                        (send a set-nextadmin admin)
+                        (send a adjust-std-flag)))
+                    ;; get the right cursor:
+                    (send admin update-cursor))
+                  (begin
+                    (send admin set-nextadmin #f)
+                    (send admin set-prevadmin #f)
+                    (send media set-admin admin)
+                    (send media own-caret focuson?))))))
+      (send admin adjust-std-flag)
+      (reset-visual #t)
+      (when update?
+        (repaint))))
+
+  (define/public (allow-scroll-to-last to-last?)
+    (set! scroll-to-last? to-last?)
+    (reset-visual #f)
+    (repaint))
+  
+  (define (scroll-with-bottom-base bottom?)
+    (set! scroll-bottom-based? bottom?)
+    (reset-visual #f)
+    (repaint)))
+
+;; ----------------------------------------
+
+(defclass canvas-editor-admin% editor-admin%
+  (init-field canvas)
+
+  (super-new)
+
+  (inherit set-s-standard)
+  
+  (define reset? #f)
+  (properties [[any? nextadmin] #f]
+              [[any? prevadmin] #f])
+
+  (define update-cursor-timer #f)
+
+  (define update-block? #f)
+  (define resized-block? #f)
+
+  ;; FIXME: needed?
+  (define/private (~)
+    (when update-cursor-timer
+      (send update-cursor-timer cancel)
+      (set! update-cursor-timer #f))
+    (set! canvas #f))
+
+  (define/public (do-get-canvas) canvas)
+
+  (define canvasless-offscreen #f)
+
+  (define/override (get-dc [fx #f] [fy #f])
+    (cond
+     [(not canvas)
+      (unless canvasless-offscreen
+        (set! canvasless-offscreen (new bitmap-dc%)))
+      (when fx (set-box! fx 0))
+      (when fy (set-box! fy 0))
+      canvasless-offscreen]
+     [(let ([m (send canvas get-editor)])
+        (and m (send m get-printing)))
+      => (lambda (p)
+           (when fx (set-box! fx 0))
+           (when fy (set-box! fy 0))
+           p)]
+     [else
+      (send canvas get-dc-and-offset fx fy)]))
+
+  (define/override (get-view fx fy fh fw [full? #f])
+    (cond
+     [(not canvas)
+      (when fx (set-box! fx 0))
+      (when fy (set-box! fy 0))
+      (when fh (set-box! fh 1))
+      (when fw (set-box! fw 1))]
+     [(let ([m (send canvas get-editor)])
+        (and m (send m get-printing)))
+      (when fx (set-box! fx 0))
+      (when fy (set-box! fy 0))
+      (when fh (set-box! fh 10000))
+      (when fw (set-box! fw 10000))]
+     [else
+      (send canvas get-view fx fy fh fw full?)]))
+
+  (define/override (get-max-view fx fy fw fh [full? #f])
+    (if (or (and (not nextadmin)
+                 (not prevadmin))
+            (not canvas)
+            (and (let ([m (send canvas get-editor)])
+                   (and m (send m get-printing)))))
+        (get-view fx fy fw fh full?)
+        (let ([a (let loop ([a this])
+                   (let ([a2 (send a get-prevadmin)])
+                     (if a2
+                         (loop a2)
+                         a)))])
+          (let-boxes ([cx 0] [cy 0] [cw 0] [ch 0])
+              (send a get-view cx cy cw ch)
+            (let loop ([a (send a get-nextadmin)]
+                       [cx cx][cy cy][cr (+ cx cw)][cb (+ cy ch)])
+              (if (not a)
+                  (let ([cw (- cr cx)]
+                        [ch (- cb cy)])
+                    (when fx (set-box! fx cx))
+                    (when fy (set-box! fy cy))
+                    (when fw (set-box! fw cw))
+                    (when fh (set-box! fh ch)))
+                  (let-boxes ([x 0] [y 0] [w 0] [h 0])
+                      (send a get-view x y w h)
+                    (loop (send a get-nextadmin)
+                          (min x cx)
+                          (min y cy)
+                          (max (+ x w) cr)
+                          (max (+ y h) cb)))))))))
+
+  (def/override (scroll-to [real? localx] [real? localy] [real? w] [real? h] [any? [refresh? #t]] 
+                           [(symbol-in start none end) [bias 'none]])
+    (let ([v (do-scroll-to localx localy w h refresh? bias #t #t #f)])
+      (and v (car v))))
+
+  (define/private (do-scroll-to localx localy w h refresh? bias prev? next? only-focus?)
+    (and canvas
+         (or (and (not (send canvas is-focus-on?))
+                  (or
+                   (and prev? 
+                        prevadmin
+                        (send prevadmin do-scroll-to localx localy w h refresh? bias #t #f #t))
+                   (and next? 
+                        nextadmin
+                        (send nextadmin do-scroll-to localx localy w h refresh? bias #f #t #t))))
+             (and (or (not only-focus?)
+                      (send canvas is-focus-on?))
+                  (list (send canvas scroll-to localx localy w h refresh? bias))))))
+
+  (def/override (grab-caret [(symbol-in immediate display global) dist])
+    (when canvas
+      (when (eq? dist 'global)
+        (send canvas set-focus))))
+
+  (define/public all-in-chain
+    (case-lambda
+     [(proc) (all-in-chain proc #t #t)]
+     [(proc backward? forward?)
+      (proc this)
+      (when (and forward? nextadmin)
+        (send nextadmin all-in-chain proc #f #t))
+      (when (and backward? prevadmin)
+        (send prevadmin all-in-chain proc #t #f))]))
+
+  (def/override (needs-update [real? localx] [real? localy]
+                              [nonnegative-real? w] [nonnegative-real? h])
+    (all-in-chain (lambda (a) (send a do-needs-update localx localy w h))))
+
+  (define/public (do-needs-update localx localy w h)
+    (when canvas
+      (let ([is-shown? (send canvas is-shown-to-root?)])
+        
+        (cond
+         [reset?
+          (when is-shown? (send canvas repaint))
+          (set! reset? #f)]
+         [is-shown?
+          (if (not (send canvas get-canvas-background))
+              (send canvas repaint)
+              (send canvas redraw localx localy w h))]))))
+
+  (define/override (resized update?)
+    (all-in-chain (lambda (a) (send a do-resized update?))))
+
+  (define/public (do-resized update?)
+    (when canvas 
+      (when (send canvas reset-visual #f)
+        (set! reset? #t))
+      
+      (when update?
+        (send canvas repaint)
+        (set! reset? #f))))
+
+  (define/override (update-cursor)
+    (all-in-chain (lambda (a) (send a do-update-cursor))))
+
+  (define/public (do-update-cursor)
+    (when (not update-cursor-timer)
+      (set! update-cursor-timer (new update-cursor-timer% [admin this]))))
+
+  (def/override (popup-menu [popup-menu% m] [real? x] [real? y])
+    (and canvas
+         (let ([e (send canvas get-editor)])
+           (and e
+                (let ([m (send canvas popup-for-editor e m)])
+                  (let-boxes ([dx 0.0]
+                              [dy 0.0])
+                      (send canvas get-dc-and-offset dx dy)
+                    (send canvas popup-menu m (->long (- x dx)) (->long (- y dy)))))))))
+  
+  (define/public (adjust-std-flag)
+    ;; 1 indicates that this is the sole, main admin. 
+    ;; this info is used for quick (xor) caret refreshing
+    ;; by an editor buffer
+    (set-s-standard (if (or nextadmin 
+                            prevadmin 
+                            (and canvas (send canvas get-focusforcedon?)))
+                        -1
+                        1)))
+
+  (def/override (modified [bool? modified?]) (void)))
+
+
+;; For editor-admin%:
+#;(
+    (define/override (get-max-view fx fy fw fh full?)
+      (get-view fx fy fh fw full?))
+
+    (define/override (delay-refresh?) #f)
+)
diff --git a/collects/mred/private/wxme/editor-snip.ss b/collects/mred/private/wxme/editor-snip.ss
new file mode 100644
index 00000000..791925d1
--- /dev/null
+++ b/collects/mred/private/wxme/editor-snip.ss
@@ -0,0 +1,716 @@
+#lang scheme/base
+(require scheme/class
+         "../syntax.ss"
+         "private.ss"
+         "const.ss"
+         "snip.ss"
+         "snip-flags.ss"
+         "editor.ss"
+         "editor-admin.ss"
+         "snip-admin.ss"
+         "text.ss"
+         "pasteboard.ss"
+         "wx.ss"
+         (except-in "cycle.ss" 
+                    text%
+                    pasteboard%
+                    editor-snip%
+                    editor-snip-editor-admin%
+                    snip-admin%))
+
+(provide editor-snip%
+         editor-snip-editor-admin<%>)
+
+;; FIXME: use "type"s
+(define-syntax-rule (private-inits [[type id] val] ...)
+  (begin
+    (define-init id val)
+    ...))
+(define-syntax-rule (define-init id v)
+  (begin
+    (init [(init-tmp id) v])
+    (define id init-tmp)))
+
+;; see also "private.ss"
+(define-local-member-name
+  with-dc
+  do-get-left-margin do-get-right-margin do-get-bottom-margin do-get-top-margin
+  do-get-extent)
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass editor-snip% snip%
+  (private-inits
+   [[(make-or-false editor<%>) editor] #f]
+   [[bool? with-border?] #t]
+   [[exact-nonnegative-integer? left-margin] 5]
+   [[exact-nonnegative-integer? top-margin] 5]
+   [[exact-nonnegative-integer? right-margin] 5]
+   [[exact-nonnegative-integer? bottom-margin] 5]
+   [[exact-nonnegative-integer? left-inset] 1]
+   [[exact-nonnegative-integer? top-inset] 1]
+   [[exact-nonnegative-integer? right-inset] 1]
+   [[exact-nonnegative-integer? bottom-inset] 1]
+   [[(make-alts (symbol-in none) nonnegative-real?) min-width] 'none]
+   [[(make-alts (symbol-in none) nonnegative-real?) max-width] 'none]
+   [[(make-alts (symbol-in none) nonnegative-real?) min-height] 'none]
+   [[(make-alts (symbol-in none) nonnegative-real?) max-height] 'none])
+
+  (unless (symbol? min-width) (set! min-width (exact->inexact min-width)))
+  (unless (symbol? max-width) (set! max-width (exact->inexact max-width)))
+  (unless (symbol? min-height) (set! min-height (exact->inexact min-height)))
+  (unless (symbol? max-height) (set! max-height (exact->inexact max-height)))
+
+  (define align-top-line? #f)
+  (define tight-fit? #f)
+  (define use-style-bg? #f)
+
+  (super-new)
+
+  (inherit set-snipclass
+           do-copy-to)
+  (inherit-field s-admin
+                 s-flags
+                 s-style)
+
+  (set-snipclass the-editor-snip-class)
+
+  (when (and editor (send editor get-admin))
+    (set! editor #f))
+  (unless editor
+    (set! editor (new extended-text%)))
+
+  (define my-admin (new editor-snip-editor-admin% [owner this]))
+
+  (set! s-flags (add-flag s-flags HANDLES-EVENTS))
+  (when (no-permanent-filename? editor)
+    (set! s-flags (add-flag s-flags USES-BUFFER-PATH)))
+
+  (send editor own-caret #f)
+
+  ;; ----------------------------------------
+
+  (define/private (no-permanent-filename? editor)
+    (let ([temp (box #f)])
+      (let ([fn (send editor get-filename temp)])
+        (or (not fn) (unbox temp)))))
+
+  (def/override (set-admin [(make-or-false snip-admin%) a])
+
+    (when (not (eq? a s-admin))
+      (super set-admin a)
+      (when editor
+        (if a
+            (begin
+              (when (send editor get-admin)
+                ;; traitor! - get rid of it
+                (set! editor #f))
+              (send editor set-admin my-admin))
+            (send editor set-admin #f))))
+
+    (when (and s-admin
+               (has-flag? s-flags USES-BUFFER-PATH))
+      ;; propogate a filename change:
+      (if (and editor
+               (no-permanent-filename? editor))
+          (let ([b (send s-admin get-editor)])
+            (when b
+              (let ([fn (send b get-filename)])
+                (when fn
+                  (send editor set-filename fn #t)))))
+          (set! s-flags (remove-flag s-flags USES-BUFFER-PATH)))) ;; turn off the flag; not needed
+  
+    (void))
+  
+  (def/public (set-editor [editor<%> b])
+    (unless (eq? editor b)
+      (when (and editor s-admin)
+        (send editor set-admin #f))
+      (set! editor b)
+      (when b
+        (cond
+         [(send b get-admin)
+          (set! editor #f)]
+         [s-admin
+          (send editor set-admin my-admin)]))
+      (when s-admin
+        (send s-admin resized this #t))))
+
+  (def/public (get-editor)
+    editor)
+
+  (def/override (adjust-cursor [dc<%> dc] [real? x] [real? y] [real? ex] [real? ey] [mouse-event% event])
+    (if (not editor)
+        #f
+        (send my-admin
+              with-dc
+              dc x y
+              (lambda ()
+                (send editor adjust-cursor event)))))
+
+  (def/override (on-event [dc<%> dc] [real? x] [real? y] [real? ex] [real? ey] [mouse-event% event])
+    (when editor
+      (send my-admin
+            with-dc
+            dc x y
+            (lambda ()
+              (send editor on-event event)))))
+  
+  (def/override (on-char [dc<%> dc] [real? x] [real? y] [real? ex] [real? ey] [key-event% event])
+    (when editor
+      (send my-admin
+            with-dc
+            dc x y
+            (lambda ()
+              (send editor on-char event)))))
+
+  (def/override (own-caret [bool? own?])
+    (when editor
+      (send editor own-caret own?)))
+
+  (def/override (blink-caret [dc<%> dc] [real? x] [real? y])
+    (when editor
+      (send my-admin
+            with-dc
+            dc x y
+            (lambda ()
+              (send editor blink-caret)))))
+
+  (def/override (do-edit-operation [symbol? op] [any? [recur? #t]] [exact-integer? [timestamp 0]])
+    (when editor
+      (send editor do-edit-operation op recur? timestamp)))
+
+  (def/override (can-do-edit-operation? [symbol? op] [any? [recur? #t]])
+    (and editor
+         (send editor can-do-edit-operation? op recur?)))
+
+  (def/override (match [snip% s])
+    #f)
+
+  (def/override (size-cache-invalid)
+    (when editor
+      (send editor size-cache-invalid)))
+
+  (def/override (get-text [exact-nonnegative-integer? offset] [exact-integer? num] 
+                          [any? [flattened? #f]])
+    (cond
+     [(or (offset . >= . 1)
+          (zero? num))
+      ""]
+     [(not flattened?)
+      "."]
+     [editor
+      (send editor get-flattened-text)]
+     [else ""]))
+
+  (define/public (do-get-extent dc x y w h -descent -space lspace rspace)
+    (send my-admin
+          with-dc
+          dc x y
+          (lambda ()
+            (let ([h2 (or h (box 0.0))])
+              (if editor
+                  (send editor get-extent w h2)
+                  (begin
+                    (when w (set-box! w 0.0))
+                    (set-box! h2 0.0)))
+              (let ([orig-h (if align-top-line?
+                                (unbox h2)
+                                0.0)])
+                
+                (when w
+                  (when (editor . is-a? . text%)
+                    (set-box!
+                     w
+                     (- (unbox w)
+                        (if tight-fit?
+                            CURSOR-WIDTH
+                            1)))) ;; it still looks better to subtract 1
+                  (when ((unbox w) . < . (if (symbol? min-width) -inf.0 min-width))
+                    (set-box! w min-width))
+                  (when ((unbox w) . > . (if (symbol? max-width) +inf.0 max-width))
+                    (set-box! w max-width))
+                  (set-box! w (+ (unbox w) (+ right-margin left-margin))))
+
+                (when h
+                  (when (editor . is-a? . text%)
+                    (when tight-fit?
+                      (set-box! h
+                                (max 0.0
+                                     (- (unbox h)
+                                        (send editor get-line-spacing))))))
+                  (when ((unbox h) . < . (if (symbol? min-height) -inf.0 min-height))
+                    (set-box! h min-height))
+                  (when ((unbox h) . > . (if (symbol? max-height) +inf.0 max-height))
+                    (set-box! h max-height))
+                  (set-box! h (+ (unbox h) (+ top-margin bottom-margin))))
+
+                (let* ([descent (+ (if editor
+                                       (send editor get-descent)
+                                       0.0)
+                                   bottom-margin)]
+                       [descent
+                        (if (editor . is-a? . text%)
+                            (let ([descent (if align-top-line?
+                                               (- orig-h
+                                                  (+ (send editor get-top-line-base)
+                                                     bottom-margin))
+                                               descent)])
+                              (if tight-fit?
+                                  (max (- descent (send editor get-line-spacing)) 0.0)
+                                  descent))
+                            descent)]
+                       [space (+ (if editor 
+                                     (send editor get-space)
+                                     0.0)
+                                 top-margin)])
+                  (let-values ([(space descent)
+                                (if (and (not (symbol? max-height))
+                                         ((+ descent space) . >= . (+ max-height top-margin bottom-margin)))
+                                    ;; just give up on spaces in this case:
+                                    (values top-margin bottom-margin)
+                                    (values space descent))])
+                    (when -descent (set-box! -descent descent))
+                    (when -space (set-box! -space space))))
+
+                (when lspace (set-box! lspace left-margin))
+                (when rspace (set-box! rspace right-margin)))))))
+
+  (def/override (get-extent [dc<%> dc] [real? x] [real? y] 
+                            [maybe-box? [w #f]] [maybe-box? [h #f]]
+                            [maybe-box? [-descent #f]] [maybe-box? [-space #f]]
+                            [maybe-box? [lspace #f]] [maybe-box? [rspace #f]])
+    (do-get-extent dc x y w h -descent -space lspace rspace))
+
+  (def/override (draw [dc<%> dc] [real? x] [real? y] 
+                      [real? left] [real? top] [real? right] [real? bottom] 
+                      [real? dx] [real? dy] [symbol? caret])
+    (send my-admin
+          with-dc
+          dc x y
+          (lambda ()
+            (let-boxes ([w 0.0]
+                        [h 0.0])
+                (when editor
+                  (send editor get-extent w h)
+                  (when (editor . is-a? . text%)
+                    (set-box! w (max 0.0
+                                     (- (unbox w) 
+                                        (if tight-fit?
+                                            CURSOR-WIDTH
+                                            1)))) ;; it still looks better to subtract 1
+                    (when tight-fit?
+                      (set-box! h (max 0.0
+                                       (- (unbox h)
+                                          (send editor get-line-spacing)))))))
+              (let* ([w (min (max w (if (symbol? min-width) -inf.0 min-width))
+                             (if (symbol? max-width) +inf.0 max-width))]
+                     [h (min (max h (if (symbol? min-height) -inf.0 min-height))
+                             (if (symbol? max-height) +inf.0 max-height))]
+                     [orig-x x]
+                     [orig-y y]
+                     [x (+ x left-margin)]
+                     [y (+ y top-margin)]
+                     [r (+ x w)]
+                     [b (+ y h)]
+                     [l (max x left)]
+                     [t (max y top)]
+                     [r (min r right)]
+                     [b (min b bottom)])
+
+                (let ([bg-color
+                       (cond
+                        [(not use-style-bg?)
+                         (make-object color% 255 255 255)]
+                        [(send s-style get-transparent-text-backing)
+                         #f]
+                        [else
+                         (let ([bg-color (send s-style get-background)])
+                           (let ([l (+ orig-x left-inset)]
+                                 [t (+ orig-y top-inset)]
+                                 [r (+ l w left-margin right-margin 
+                                       (- (+ left-inset right-inset))
+                                       -1)]
+                                 [b (+ t h top-margin bottom-margin 
+                                       (- (+ top-inset bottom-inset))
+                                       -1)])
+                             (let ([trans-pen (send the-pen-list
+                                                    find-or-create-pen
+                                                    bg-color 0 'transparent)]
+                                   [fill (send the-brush-list
+                                               find-or-create-brush
+                                               bg-color 'solid)]
+                                   [savep (send dc get-pen)]
+                                   [saveb (send dc get-brush)])
+                               (send dc set-pen trans-pen)
+                               (send dc set-brush fill)
+
+                               (send dc draw-rectangle l t (- r l) (- b t))
+
+                               (send dc set-brush saveb)
+                               (send dc set-pen savep)))
+                           bg-color)])])
+
+                  (when editor
+                    (send editor refresh
+                          (- l x) (- t y) (max 0.0 (- r l)) (max 0.0 (- b t))
+                          caret bg-color))
+
+                  (when with-border?
+                    (let* ([l (+ orig-x left-inset)]
+                           [t (+ orig-y top-inset)]
+                           [r (+ l w left-margin right-margin 
+                                 (- (+ left-inset right-inset))
+                                 -1)]
+                           [b (+ t h top-margin bottom-margin 
+                                 (- (+ top-inset bottom-inset))
+                                 -1)])
+                      (let ([ml (max (min l right) left)]
+                            [mr (max (min r right) left)]
+                            [mt (max (min t bottom) top)]
+                            [mb (max (min b bottom) top)])
+                        (when (and (l . >= . left)
+                                   (l . < . right)
+                                   (mt . < . mb))
+                          (send dc draw-line l mt l mb))
+                        (when (and (r . >= . left)
+                                   (r . < . right)
+                                   (mt . < . mb))
+                          (send dc draw-line r mt r mb))
+                        (when (and (t . >= . top)
+                                   (t . < . bottom)
+                                   (ml . < . mr))
+                          (send dc draw-line ml t mr t))
+                        (when (and (b . >= . top)
+                                   (b . < . bottom)
+                                   (ml . < . mr))
+                          (send dc draw-line ml b mr b)))))))))))
+
+  (def/override (copy)
+    (let* ([mb (and editor
+                    (send editor copy-self))]
+           [ms (make-object extended-editor-snip%
+                            mb
+                            with-border?
+                            left-margin top-margin
+                            right-margin bottom-margin
+                            left-inset top-inset
+                            right-inset bottom-inset
+                            min-width max-width
+                            min-height max-height)])
+      (do-copy-to ms)
+
+      (send ms do-set-graphics tight-fit? align-top-line? use-style-bg?)
+      (when (not editor)
+        (send ms set-editor #f))
+      ms))
+
+  (define/public (do-set-graphics tf? atl? usb?)
+    (set! tight-fit? tf?)
+    (set! align-top-line? atl?)
+    (set! use-style-bg? usb?))
+
+  (def/override (write [editor-stream-out% f])
+    (send f put (if editor
+                    (if (editor . is-a? . pasteboard%) 2 1)
+                    0))
+    (send f put (if with-border? 1 0))
+    (send f put left-margin)
+    (send f put top-margin)
+    (send f put right-margin)
+    (send f put bottom-margin)
+    (send f put left-inset)
+    (send f put top-inset)
+    (send f put right-inset)
+    (send f put bottom-inset)
+    (send f put (if (symbol? min-width) -1.0 min-width))
+    (send f put (if (symbol? max-width) -1.0 max-width))
+    (send f put (if (symbol? min-height) -1.0 min-height))
+    (send f put (if (symbol? max-height) -1.0 max-height))
+    (send f put (if tight-fit? 1 0))
+    (send f put (if align-top-line? 1 0))
+    (send f put (if use-style-bg? 1 0))
+    (when editor
+      (send editor write-to-file f)))
+
+  (define/private (resize-me)
+    (when s-admin (send s-admin resized this #t)))
+
+  (def/public (set-max-width [(make-alts (symbol-in none) nonnegative-real?) w])
+    (set! max-width w)
+    (resize-me))
+
+  (def/public (set-min-width [(make-alts (symbol-in none) nonnegative-real?) w])
+    (set! min-width w)
+    (resize-me))
+
+  (def/public (set-max-height [(make-alts (symbol-in none) nonnegative-real?) h])
+    (set! max-height h)
+    (resize-me))
+
+  (def/public (set-min-height [(make-alts (symbol-in none) nonnegative-real?) h])
+    (set! min-height h)
+    (resize-me))
+
+  (def/public (get-max-width) max-width)
+  (def/public (get-min-width) min-width)
+  (def/public (get-max-height) max-height)
+  (def/public (get-min-height) min-height)
+
+  (def/public (get-tight-text-fit)
+    tight-fit?)
+  (def/public (set-tight-text-fit [bool? t])
+    (set! tight-fit? t)
+    (resize-me))
+
+  (def/public (get-align-top-line)
+    align-top-line?)
+  (def/public (set-align-top-line [bool? t])
+    (set! align-top-line? t)
+    (resize-me))
+
+  (def/public (style-background-used?)
+    use-style-bg?)
+  (def/public (use-style-background [bool? u])
+    (unless (eq? use-style-bg? u)
+      (set! use-style-bg? u)
+      (request-refresh)))
+
+  (def/override (resize [real? w] [real? h])
+    (let ([w (max 0.0 (- w (+ left-margin right-margin)))]
+          [h (max 0.0 (- h (+ top-margin bottom-margin)))])
+      (set! min-width w)
+      (set! max-width w)
+      (set! min-height h)
+      (set! max-height h)
+
+      (when editor
+        (send editor set-max-width w)
+        (send editor set-min-width w))
+
+      (resize-me)
+      #t))
+
+  (define/private (request-refresh)
+    (when s-admin
+      (let ([dc (send s-admin get-dc)])
+        (when dc
+          (let-boxes ([w 0.0]
+                      [h 0.0])
+              (get-extent dc 0 0 w h)
+            (send s-admin needs-update
+                  this left-inset top-inset
+                  (+ w (- right-margin right-inset))
+                  (+ h (- bottom-margin bottom-inset))))))))
+
+  (def/public (show-border [bool? show])
+    (unless (eq? with-border? show)
+      (set! with-border? show)
+      (request-refresh)))
+  (def/public (border-visible?)
+    with-border?)
+
+  (def/public (set-margin [exact-nonnegative-integer? lm]
+                          [exact-nonnegative-integer? tm]
+                          [exact-nonnegative-integer? rm]
+                          [exact-nonnegative-integer? bm])
+    (set! left-margin lm)
+    (set! top-margin tm)
+    (set! right-margin rm)
+    (set! bottom-margin bm)
+    (resize-me))
+
+  (def/public (get-margin [box? lm] [box? tm] [box? rm] [box? bm])
+    (set-box! lm left-margin)
+    (set-box! tm top-margin)
+    (set-box! rm right-margin)
+    (set-box! bm bottom-margin))
+
+  (def/public (set-inset [exact-nonnegative-integer? lm]
+                         [exact-nonnegative-integer? tm]
+                         [exact-nonnegative-integer? rm]
+                         [exact-nonnegative-integer? bm])
+    (set! left-margin lm)
+    (set! top-margin tm)
+    (set! right-margin rm)
+    (set! bottom-margin bm)
+    (request-refresh))
+
+  (def/public (get-inset [box? lm] [box? tm] [box? rm] [box? bm])
+    (set-box! lm left-inset)
+    (set-box! tm top-inset)
+    (set-box! rm right-inset)
+    (set-box! bm bottom-inset))
+
+  (def/override (get-num-scroll-steps)
+    (if editor
+        (send editor num-scroll-lines)
+        1))
+
+  (def/override (find-scroll-step [real? y])
+    (if editor
+        (send editor find-scroll-line (- y top-margin))
+        0))
+
+  (def/override (get-scroll-step-offset [exact-integer? n])
+    (if editor
+        (+ (send editor scroll-line-location n) top-margin)
+        0))
+
+  (def/override (set-unmodified)
+    (when editor
+      (send editor set-modified #f)))
+
+  (def/public (do-get-left-margin) left-margin)
+  (def/public (do-get-right-margin) right-margin)
+  (def/public (do-get-bottom-margin) bottom-margin)
+  (def/public (do-get-top-margin) top-margin))
+
+(set-editor-snip%! editor-snip%)
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-struct state (dc x y))
+
+(defclass editor-snip-editor-admin% editor-admin%
+  (init owner)
+  (define snip owner)
+  (define state #f)
+
+  (super-new)
+
+  (define/public (get-snip) snip)
+
+  (define/public (with-dc dc x y thunk)
+    (let* ([other (make-state dc 
+                              (+ x (send snip do-get-left-margin))
+                              (+ y (send snip do-get-top-margin)))]
+           [swap (lambda ()
+                   (let ([s state])
+                     (set! state other)
+                     (set! other s)))])
+      (dynamic-wind swap thunk swap)))
+  
+  (def/override (get-dc [maybe-box? [x #f]] [maybe-box? [y #f]])
+    (let-values ([(xv yv)
+                  (if state
+                      (values (- (state-x state))
+                              (- (state-y state)))
+                      (values 0 0))])
+      (when x (set-box! x xv))
+      (when y (set-box! y yv))
+      (if state
+          (state-dc state)
+          (let ([sadmin (send snip get-admin)])
+            (if sadmin
+                (send sadmin get-dc)
+                #f)))))
+
+  (def/override (get-view [maybe-box? x] [maybe-box? y]
+                          [maybe-box? w] [maybe-box? h]
+                          [any? [full? #f]])
+    (let ([sadmin (send snip get-admin)])
+      (cond
+       [(not sadmin)
+        (when x (set-box! x 0.0))
+        (when y (set-box! y 0.0))
+        (when w (set-box! w 0.0))
+        (when h (set-box! h 0.0))]
+       [full?
+        (send sadmin get-view x y w h #f)]
+       [else
+        (let-boxes ([sx 0.0]
+                    [sy 0.0]
+                    [sw 0.0]
+                    [sh 0.0])
+            (send sadmin get-view sx sy sw sh snip)
+          (when x
+            (set-box! x (max 0.0 (- sx (send snip do-get-left-margin)))))
+          (when y
+            (set-box! y (max 0.0 (- sy (send snip do-get-top-margin)))))
+          (when (or w h)
+            (if (or (positive? sw) (positive? sh))
+                ;; w and h might be too big due to margins - but
+                ;; they might be small enough already because 
+                ;; part of the snip itself is not viewed
+                (let-boxes ([rw 0.0]
+                            [rh 0.0])
+                    ;; we want the internal, non-overridden method:
+                    (send snip do-get-extent (and state (state-dc state)) 0 0 rw rh #f #f #f #f)
+                  
+                  ;; remember: sx and sy are in snip coordinates
+
+                  (when w
+                    (let* ([left-margin (max 0.0 (- (send snip do-get-left-margin) sx))]
+                           [sw (- sw left-margin)]
+                           [rw (- rw (send snip do-get-left-margin))]
+                           [right-margin (max 0.0 (- (send snip do-get-right-margin) (- rw sw)))]
+                           [sw (max 0.0 (- sw right-margin))])
+                      (set-box! w sw)))
+
+                  (when h
+                    (let* ([top-margin (max 0.0 (- (send snip do-get-top-margin) sy))]
+                           [sh (- sh top-margin)]
+                           [rh (- rh (send snip do-get-top-margin))]
+                           [bottom-margin (max 0.0 (- (send snip do-get-bottom-margin) (- rh sh)))]
+                           [sh (max 0.0 (- sh bottom-margin))])
+                      (set-box! h sh))))
+                
+                (begin
+                  (when w (set-box! w 0.0))
+                  (when h (set-box! h 0.0))))))])))
+  
+  (def/override (scroll-to [real? localx] [real? localy] [real? w] [real? h] [any? [refresh? #t]] 
+                           [(symbol-in start none end) [bias 'none]])
+    (let ([sadmin (send snip get-admin)])
+      (and sadmin
+           (send sadmin scroll-to snip (+ localx (send snip do-get-left-margin))
+                 (+ localy (send snip do-get-top-margin))
+                 w h refresh? bias))))
+  
+  (def/override (grab-caret [(symbol-in immediate display global) dist])
+    (let ([sadmin (send snip get-admin)])
+      (when sadmin
+        (send sadmin set-caret-owner snip dist))))
+
+  (def/override (resized [any? redraw-now])
+    (let ([sadmin (send snip get-admin)])
+      (when sadmin
+        (send sadmin resized snip redraw-now))))
+
+  (def/override (needs-update [real? localx] [real? localy]
+                              [nonnegative-real? w] [nonnegative-real? h])
+    (let ([sadmin (send snip get-admin)])
+      (when sadmin
+        (send sadmin needs-update snip
+              (+ localx (send snip do-get-left-margin))
+              (+ localy (send snip do-get-top-margin))
+              w h))))
+
+  (def/override (update-cursor)
+    (let ([sadmin (send snip get-admin)])
+      (when sadmin
+        (send sadmin update-cursor))))
+
+  (def/override (popup-menu [popup-menu% m] [real? x] [real? y])
+    (let ([sadmin (send snip get-admin)])
+      (and sadmin
+           (send sadmin popup-menu m snip
+                 (+ x (send snip do-get-left-margin))
+                 (+ y (send snip do-get-top-margin))))))
+  
+  (def/override (delay-refresh?)
+    (let ([sadmin (send snip get-admin)])
+      (or (not sadmin)
+          (and (sadmin . is-a? . standard-snip-admin%)
+               (send (send sadmin get-editor) refresh-delayed?)))))
+
+  (def/override (modified [any? mod?])
+    (let ([sadmin (send snip get-admin)])
+      (when sadmin
+        (send sadmin modified snip mod?)))))
+
+(set-editor-snip-editor-admin%! editor-snip-editor-admin%)
+
+(define editor-snip-editor-admin<%> (class->interface editor-snip-editor-admin%))
+
diff --git a/collects/mred/private/wxme/editor.ss b/collects/mred/private/wxme/editor.ss
new file mode 100644
index 00000000..6e191f86
--- /dev/null
+++ b/collects/mred/private/wxme/editor.ss
@@ -0,0 +1,1819 @@
+#lang scheme/base
+(require scheme/class
+         (for-syntax scheme/base)
+         scheme/file
+         "../syntax.ss"
+         "private.ss"
+         "style.ss"
+         "snip.ss"
+         "snip-flags.ss"
+         "editor-admin.ss"
+         "stream.ss"
+         "undo.ss"
+         "keymap.ss"
+         (only-in "cycle.ss" 
+                  text%
+                  pasteboard%
+                  editor-snip%
+                  editor-snip-editor-admin%
+                  editor-get-file
+                  editor-put-file)
+         "wx.ss")
+
+(provide editor%
+         editor<%>
+         add-editor-keymap-functions
+         ALLOW-X-STYLE-SELECTION?
+         copy-style-list
+         set-common-copy-region-data!
+         cons-common-copy-buffer!
+         cons-common-copy-buffer2!
+         editor-set-x-selection-mode
+         editor-x-selection-allowed
+         editor-x-selection-mode?
+         editor-x-selection-owner
+         detect-wxme-file
+         read-editor-version
+         read-editor-global-header
+         read-editor-global-footer
+         write-editor-version
+         write-editor-global-header
+         write-editor-global-footer
+         write-snips-to-file
+         get-default-print-size)
+
+;; ----------------------------------------
+
+(define RIDICULOUS-SIZE 2000)
+(define ALLOW-X-STYLE-SELECTION? (eq? 'unix (system-type)))
+
+(defclass offscreen% object%
+  (define bitmap #f)
+  (define dc (make-object bitmap-dc%))
+  (define bm-width 0)
+  (define bm-height 0)
+  (define in-use? #f)
+  (define last-used #f)
+
+  (define/public (is-in-use?) in-use?)
+  (define/public (set-in-use v) (set! in-use? (and v #t)))
+  (define/public (get-bitmap) bitmap)
+  (define/public (get-dc) dc)
+  (define/public (get-last-used) last-used)
+  (define/public (set-last-used v) (set! last-used v))
+
+  (define/public (ready-offscreen width height)
+    (if (or (width . > . RIDICULOUS-SIZE)
+            (height . > . RIDICULOUS-SIZE)
+            (eq? (system-type) 'macosx))
+        #f
+        (if (and (not in-use?)
+                 (or (height . > . bm-height)
+                     (width . > . bm-width)))
+            (let ([oldbm bitmap])
+              (set! bm-height (max (add1 (->long height)) bm-height))
+              (set! bm-width (max (add1 (->long width)) bm-width))
+              (set! bitmap (make-object bitmap% bm-width bm-height))
+              (send dc set-bitmap #f)
+              (when (send bitmap ok?)
+                (send dc set-bitmap bitmap))
+              #t)
+            #f)))
+
+  (super-new))
+
+(define the-offscreen (new offscreen%))
+
+;; ----------------------------------------
+
+;; 8.5" x 11" paper, 0.5" margin; usually not used
+(define PAGE-WIDTH 612)
+(define PAGE-HEIGHT 792)
+
+(define (get-printer-orientation)
+  (send (current-ps-setup)  get-orientation))
+
+(define (get-default-print-size w h)
+  (set-box! w PAGE-WIDTH)
+  (set-box! h PAGE-HEIGHT)
+  (when (eq? (get-printer-orientation) 'landscape)
+    (let ([tmp h])
+      (set! h w)
+      (set! w tmp))))
+
+;; ----------------------------------------
+
+(define emacs-style-undo? (and (get-preference 'MrEd:emacs-undo) #t))
+(define (max-undo-value? v) (or (exact-nonnegative-integer? v)
+                                (eq? v 'forever)))
+
+(define global-lock (make-semaphore 1))
+
+(defclass editor% object%
+
+  (field [s-offscreen the-offscreen]
+         [s-admin #f]
+         [s-keymap (new keymap%)]
+         [s-own-caret? #f]
+         [s-temp-filename? #f]
+         [s-user-locked? #f]
+         [s-modified? #f]
+         [s-noundomode 0])
+  (def/public (is-modified?) s-modified?)
+  
+  (define undomode? #f)
+  (define redomode? #f)
+  (define interceptmode? #f)
+  (define loadoverwritesstyles? #f)
+
+  (field [s-custom-cursor-overrides? #f]
+         [s-need-on-display-size? #f])
+  (define paste-text-only? #f)
+
+  (define num-parts-modified 0)
+
+  (field [s-caret-snip #f]
+         [s-style-list (new style-list%)])
+  (define/public (get-focus-snip) s-caret-snip)
+  (define/public (get-s-style-list) s-style-list)
+
+  (send s-style-list new-named-style "Standard" (send s-style-list basic-style))
+  (define notify-id
+    (send s-style-list notify-on-change (lambda (which) (style-has-changed which))))
+  
+  (field [s-filename #f]) ; last loaded file
+
+  (define max-undos 0)
+
+  (define changes #())
+  (define changes-start 0)
+  (define changes-end 0)
+  (define changes-size 0)
+
+  (define redochanges #())
+  (define redochanges-start 0)
+  (define redochanges-end 0)
+  (define redochanges-size 0)
+  
+  (define savedchanges #f) ;; for emacs-style undo
+  (define intercepted null)
+
+  (field [s-custom-cursor #f]
+         [s-inactive-caret-threshold 'show-inactive-caret])
+
+  (define printing #f)
+  (define/public (get-printing) printing)
+
+  (define num-extra-headers 0)
+  (define seq-lock #f)
+
+  (super-new)
+
+  (define/public (~)
+    (send s-style-list forget-notification notify-id)
+    (clear-undos))
+
+  (define/public (is-printing?) (and printing #t))
+
+  ;; ----------------------------------------
+
+  (def/public (blink-caret) (void))
+
+  (def/public (size-cache-invalid) (void))
+  (def/public (locked-for-read?) #f)
+  (def/public (locked-for-write?) #f)
+
+  (def/public (resized) (void))
+  (def/public (recounted) (void))
+  (define/public (invalidate-bitmap-cache) (void))
+  (def/public (needs-update) (void))
+  (def/public (release-snip) (void))
+
+  (def/public (scroll-line-location) (void))
+  (def/public (num-scroll-lines) (void))
+  (def/public (find-scroll-line) (void))
+
+  ;; ----------------------------------------
+
+  (define/public (on-event event) (void))
+  (define/public (on-char event) (void))
+
+  (def/public (on-local-event [mouse-event% event])
+    (unless (and s-keymap
+                 (or (send s-keymap handle-mouse-event this event)
+                     (begin
+                       (when (not (send event moving?))
+                         (send s-keymap break-sequence))
+                       #f)))
+      (on-default-event event)))
+  
+  (def/public (on-local-char [key-event% event])
+    (unless (and s-keymap
+                 (or (send s-keymap handle-key-event this event)
+                     (begin
+                       (send s-keymap break-sequence)
+                       #f)))
+      (on-default-char event)))
+
+  (define/public (on-default-event event) (void))
+  (define/public (on-default-char event) (void))
+  
+  (def/public (on-focus [any? on?]) (void))
+
+  ;; ----------------------------------------
+
+  (def/public (set-admin [(make-or-false editor-admin%) administrator])
+    (setting-admin administrator)
+
+    (set! s-admin administrator)
+    (when (not s-admin)
+      (set! s-own-caret? #f))
+    (when s-admin
+      (init-new-admin)))
+
+  (def/public (setting-admin [(make-or-false editor-admin%) a]) (void))
+
+  (def/public (init-new-admin) (void))
+
+  (def/public (get-admin) s-admin)
+
+  ;; ----------------------------------------
+
+  (def/public (own-caret [any? ownit?]) (void))
+
+  (def/public (do-own-caret [any? ownit?])
+    (let ([ownint? (and ownit? #t)])
+      (let ([refresh? (and (not s-caret-snip)
+                           (not (eq? s-own-caret? ownit?)))])
+        (set! s-own-caret? ownit?)
+        (when s-caret-snip
+          (send s-caret-snip own-caret ownit?))
+        (when (and s-keymap (not ownint?) refresh?)
+          (send s-keymap break-sequence))
+
+        (when ALLOW-X-STYLE-SELECTION?
+          (cond
+           [(and ownit? (not s-caret-snip))
+            (set! editor-x-selection-allowed this)]
+           [(eq? editor-x-selection-allowed this)
+            (set! editor-x-selection-allowed #f)]))
+
+        (when s-admin
+          (send s-admin update-cursor))
+
+        refresh?)))
+
+  (def/public (get-dc)
+    ;; this can be called by snips to get a DC appropriate for
+    ;; sizing text, etc., outside of draws. it isn't the destination 
+    ;; for draws, though
+    (if s-admin
+        (send s-admin get-dc #f #f)
+        #f))
+
+  (def/public (get-view-size [(make-or-false box?) w][(make-or-false box?) h])
+    (if s-admin
+        (send s-admin get-view #f #f w h)
+        (begin
+          (when w (set-box! w 0.0))
+          (when h (set-box! h 0.0)))))
+
+  (define/public (get-snip-location snip x y)
+    (when x (set-box! x 0.0))
+    (when y (set-box! y 0.0))
+    #t)
+
+  (def/public (do-set-caret-owner [(make-or-false snip%) snip] [symbol? dist])
+    (let ([same? (eq? snip s-caret-snip)])
+      (if (and same?
+               (or (not s-admin) (eq? dist 'immediate)))
+          #f
+          (begin
+            (when same?
+              (send s-admin grab-caret dist))
+
+            (let ([vis-caret? s-own-caret?])
+              (cond
+               [(or (not snip)
+                    (not (has-flag? (snip->flags snip) HANDLES-EVENTS)))
+                
+                (let ([old-caret s-caret-snip]
+                      [refresh? #f])
+                  (set! s-caret-snip #f)
+                  (when old-caret
+                    (send old-caret own-caret #f)
+                    (when vis-caret?
+                      (set! refresh? #t)))
+                  (when ALLOW-X-STYLE-SELECTION?
+                    (set! editor-x-selection-allowed this))
+                  (when s-admin
+                    (send s-admin update-cursor))
+                  refresh?)]
+               [(not (get-snip-location snip #f #f)) #f]
+               [else
+                (let ([had-caret? (and s-own-caret?
+                                       (not s-caret-snip))]
+                      [old-caret s-caret-snip]
+                      [refresh? #f])
+
+                  (set! s-caret-snip snip)
+
+                  (begin-edit-sequence)
+                  (cond
+                   [old-caret (send old-caret own-caret #f)]
+                   [vis-caret? (set! refresh? #t)])
+                  (send snip own-caret s-own-caret?)
+                  (end-edit-sequence)
+
+                  (when (and s-admin
+                             (not (eq? dist 'immediate)))
+                    (send s-admin grab-caret dist))
+
+                  (when s-admin
+                    (send s-admin update-cursor))
+
+                  refresh?)]))))))
+
+  (define/private (convert-coords admin x y to-local?)
+    (let-values ([(lx ly)
+                  (if admin
+                      (if (admin . is-a? . editor-snip-editor-admin%)
+                          (let* ([snip (send admin get-snip)]
+                                 [sa (send snip get-admin)])
+                            (if sa
+                                (let ([mbuf (send sa get-editor)])
+                                  (if mbuf 
+                                      (let-boxes ([bx 0.0][by 0.0]
+                                                  [lx 0.0][ly 0.0]
+                                                  [l 0.0][t 0.0][r 0.0][b 0.0])
+                                          (begin
+                                            (send mbuf local-to-global bx by)
+                                            (send mbuf get-snip-location snip lx ly #f)
+                                            (send snip get-margin l t r b))
+                                        (values (+ lx bx l)
+                                                (+ ly by t)))
+                                      (values 0.0 0.0)))
+                                (values 0.0 0.0)))
+                          (let-boxes ([lx 0.0][ly 0.0])
+                              (send admin get-dc lx ly)
+                            (values (- lx) (- ly))))
+                      (values 0.0 0.0))])
+      (when x (set-box! x (+ (unbox x) (if to-local? (- lx) lx))))
+      (when y (set-box! y (+ (unbox y) (if to-local? (- ly) ly))))))
+
+  (def/public (editor-location-to-dc-location [real? x] [real? y])
+    (let-boxes ([x x] [y y])
+        (local-to-global x y)
+      (values x y)))
+
+  (def/public (dc-location-to-editor-location [real? x] [real? y])
+    (let-boxes ([x x] [y y])
+        (global-to-local x y)
+      (values x y)))
+
+  (def/public (global-to-local [maybe-box? x] [maybe-box? y])
+    (convert-coords s-admin x y #t))
+
+  (def/public (local-to-global [maybe-box? x] [maybe-box? y])
+    (convert-coords s-admin x y #f))
+
+  (def/public (set-cursor [(make-or-false cursor%) c] [any? [override? #t]])
+    (set! s-custom-cursor c)
+    (set! s-custom-cursor-overrides? override?)
+    (when s-admin
+      (send s-admin update-cursor)))
+
+  (def/public (adjust-cursor [mouse-event% event]) (void))
+
+  ;; ----------------------------------------
+
+  (def/public (set-keymap [keymap% k])
+    (set! s-keymap k))
+  (def/public (get-keymap) s-keymap)
+  (def/public (get-style-list) s-style-list)
+
+  (def/public (set-style-list [style-list% new-list])
+    (send s-style-list forget-notification notify-id)
+    (set! notify-id
+          (send new-list notify-on-change (lambda (which) (style-has-changed which))))
+    (set! s-style-list new-list)
+    ;; create "Standard" if it's not there:
+    (send s-style-list new-named-style "Standard" (send s-style-list basic-style)))
+
+  (define/public (style-has-changed which) (void))
+  
+  (def/public (default-style-name) "Standard")
+
+  (def/public (get-default-style)
+    (send s-style-list find-named-style (default-style-name)))
+
+  ;; ----------------------------------------
+
+  (define/public (set-max-width w) (void))
+  (define/public (set-min-width v) (void))
+  (define/public (get-max-width) 0.0)
+  (define/public (get-min-width) 0.0)
+  (define/public (set-min-height w) (void))
+  (define/public (set-max-height w) (void))
+  (define/public (get-min-height) 0.0)
+  (define/public (get-max-height) 0.0)
+
+  (define/public (find-first-snip) #f)
+
+  (define/public (get-extent) (void))
+  (define/public (get-descent) (void))
+  (define/public (get-space) (void))
+
+  (define/public (get-flattened-text) (void))
+
+  ;; ----------------------------------------
+
+  (define/public (clear) (void))
+  (define/public (cut ? time) (void))
+  (define/public (copy ? time) (void))
+  (define/public (paste time) (void))
+  (define/public (paste-x-selection time) (void))
+  (define/public (kill time) (void))
+  (define/public (select-all) (void))
+  (define/public (insert snip) (void))
+  (define/public (insert-paste-snip snip) (void))
+  (define/public (insert-paste-string str) (void))
+  (define/public (do-read-insert snip) (void))
+  (define/public (set-caret-owner snip focus) (void))
+  (define/public (read-from-file mf) #f)
+
+  (define/public (do-copy time) (void))
+  (define/public (do-paste time) (void))
+  (define/public (do-paste-x-selection time) (void))
+
+  (def/public (do-edit-operation [symbol? op] [any? [recursive? #t]] [exact-integer? [time 0]])
+    (if (and recursive?
+             s-caret-snip)
+        (send s-caret-snip do-edit-operation op #t time)
+        (case op
+          [(undo) (undo)]
+          [(redo) (redo)]
+          [(clear) (clear)]
+          [(cut) (cut #f time)]
+          [(copy) (copy #f time)]
+          [(paste) (paste time)]
+          [(kill) (kill time)]
+          [(insert-text-box) (insert-box 'text)]
+          [(insert-pasteboard-box) (insert-box 'pasteboard)]
+          [(insert-image) (insert-image)]
+          [(select-all) (select-all)])))
+
+  (def/public (can-do-edit-operation? [symbol? op] [any? [recursive? #t]])
+    (if (and recursive?
+             s-caret-snip)
+        (send s-caret-snip can-do-edit-operation? op #t)
+        (cond
+         [(and (is-locked?)
+               (not (or (eq? op 'copy) (eq? op 'select-all))))
+          #f]
+         [(and (eq? op 'undo)
+               (= changes-start changes-end))
+          #f]
+         [(and (eq? op 'redo)
+               (= redochanges-start redochanges-end))
+          #f]
+         [else (really-can-edit? op)])))
+
+  (define/public (really-can-edit?) #f)
+
+  (def/public (insert-box [symbol? type])
+    (let ([snip (on-new-box type)])
+      (when snip
+        (let ([sname (default-style-name)])
+
+          (begin-edit-sequence)
+          (send snip set-s-style (or (send s-style-list find-named-style sname)
+                                     (send s-style-list basic-style)))
+          (insert snip)
+          (set-caret-owner snip)
+          (end-edit-sequence)))))
+
+  (def/public (on-new-box [symbol? type])
+    (let* ([media (if (eq? type 'text)
+                      (new text%)
+                      (new pasteboard%))]
+           [snip (make-object editor-snip% media)])
+      (send media set-keymap s-keymap)  
+      (send media set-style-list s-style-list)
+      snip))
+
+  (def/public (insert-image [(make-or-false path-string?) [filename #f]]
+                            [symbol? [type 'unknown]]
+                            [any? [relative? #f]]
+                            [any? [inline-img? #t]])
+    (let ([filename (or filename
+                        (get-file #f))])
+      (when filename
+        (let ([snip (on-new-image-snip filename type 
+                                       (and relative? #t) 
+                                       (and inline-img? #t))])
+          (insert snip)))))
+
+  (def/public (on-new-image-snip [path-string? filename]
+                                 [symbol? type]
+                                 [any? relative?]
+                                 [any? inline-img?])
+    (make-object image-snip% filename type relative? inline-img?))
+
+  ;; ----------------------------------------
+
+  (def/public (get-snip-data [snip% s]) #f)
+  (def/public (set-snip-data [snip% s] [editor-data% v]) (void))
+  
+  ;; ----------------------------------------
+
+  (def/public (read-header-from-file [editor-stream-in% f] [string? header-name])
+    (error 'read-header-from-file "unknown header data: ~s" header-name))
+  (def/public (read-footer-from-file [editor-stream-in% f] [string? header-name])
+    (error 'read-header-from-file "unknown footer data: ~s" header-name))
+  (def/public (write-headers-to-file [editor-stream-out% f]) #t)
+  (def/public (write-footers-to-file [editor-stream-out% f]) #t)
+
+  (def/public (begin-write-header-footer-to-file [editor-stream-out% f]
+                                                 [string? header-name]
+                                                 [box? data-buffer])
+    (set-box! data-buffer (send f tell))
+    (send f put-fixed 0)
+    (send f put-bytes (string->bytes/utf-8 header-name))
+    #t)
+
+  (def/public (end-write-header-footer-to-file [editor-stream-out% f]
+                                               [exact-integer? data])
+    (let ([end (send f tell)])
+      (send f jump-to data)
+      (send f put-fixed 0)
+      (let ([pos (send f tell)])
+        (send f jump-to data)
+        (send f put-fixed (- end pos))
+        (send f jump-to end)
+        (set! num-extra-headers (add1 num-extra-headers))
+        #t)))
+
+  (def/public (read-headers-footers [editor-stream-in% f] [any? headers?])
+    (let-boxes ([num-headers 0])
+        (send f get-fixed num-headers)
+      (for/fold ([ok? #t]) ([i (in-range num-headers)] #:when ok?)
+        (let-boxes ([len 0])
+            (send f get-fixed len)
+          (and (send f ok?)
+               (if (positive? len)
+                   (let ([pos (send f tell)])
+                     (send f set-boundary len)
+                     (let ([header-name (bytes->string/utf-8 (send f get-unterminated-bytes) #\?)])
+                       (and (if headers?
+                                (read-header-from-file f header-name)
+                                (read-footer-from-file f header-name))
+                            (send f ok?)
+                            (begin
+                              (send f remove-boundary)
+                              (let ([len (- len (- (send f tell) pos))])
+                                (when (positive? len)
+                                  (send f skip len))
+                                (send f ok?))))))
+                   #t))))))
+
+  (define/public (do-write-headers-footers f headers?)
+    (let ([all-start (send f tell)])
+      (send f put-fixed 0)
+      (set! num-extra-headers 0)
+
+      (and
+       (if headers?
+           (write-headers-to-file f)
+           (write-footers-to-file f))
+       (begin
+         (when (positive? num-extra-headers)
+           (let ([all-end (send f tell)])
+             (send f jump-to all-start)
+             (send f put-fixed num-extra-headers)
+             (send f jump-to all-end))
+           #t)))))
+
+  ;; ----------------------------------------
+
+  (def/public (read-snips-from-file [editor-stream-in% f]
+                                    [any? overwritestylename?])
+    (and (read-headers-footers f #t)
+         (let* ([list-id (box 0)]
+                [new-list (read-styles-from-file s-style-list f overwritestylename? list-id)])
+           (and new-list 
+                (begin
+                  (unless (eq? new-list s-style-list)
+                    (set-style-list new-list))
+                  (let-boxes ([num-headers 0])
+                      (send f get-fixed num-headers)
+                    (and
+                     ;; Read headers
+                     (for/and ([i (in-range num-headers)])
+                       (let-boxes ([n 0]
+                                   [len 0])
+                           (begin
+                             (send f get n)
+                             (send f get-fixed len))
+                         (and (send f ok?)
+                              (or (zero? len)
+                                  (let ([sclass (send (send f get-s-scl) find-by-map-position f n)])
+                                    (and
+                                     (if sclass
+                                         (let ([start (send f tell)])
+                                           (send f set-boundary len)
+                                           (and (send sclass read-header f)
+                                                (send f ok?)
+                                                (begin
+                                                  (send f do-set-header-flag sclass)
+                                                  (let ([rcount (- (send f tell) start)])
+                                                    (when (rcount . < . len)
+                                                      (error 'read-snips-from-file "underread (caused by file corruption?)"))
+                                                    (send f skip (- len rcount)))
+                                                  (send f remove-boundary)
+                                                  #t)))
+                                         (begin (send f skip len) #t))
+                                     (send f ok?)))))))
+                     ;; Read snips
+                     (let-boxes ([num-snips 0])
+                         (send f get num-snips)
+                       (let ([accum? (this . is-a? . text%)])
+                         (let ([accum
+                                (for/fold ([accum null]) ([i (in-range num-snips)] #:when accum)
+                                  (let-boxes ([n 0])
+                                      (send f get n)
+                                    (let ([sclass (if (n . >= . 0)
+                                                      (send (send f get-s-scl) find-by-map-position f n)
+                                                      #f)]) ; -1 => unknown
+                                      (let-boxes ([len 0])
+                                          (if (or (not sclass)
+                                                  (not (send sclass get-s-required?)))
+                                              (send f get-fixed len)
+                                              (set-box! len -1))
+                                        (and (send f ok?)
+                                             (or (and (zero? len) accum)
+                                                 (and
+                                                  (if sclass
+                                                      (let ([start (send f tell)])
+                                                        (when (len . >= . 0)
+                                                          (send f set-boundary len))
+                                                        (let-boxes ([style-index 0])
+                                                            (send f get style-index)
+                                                          (let ([snip (send sclass read f)])
+                                                            (and 
+                                                             snip
+                                                             (begin
+                                                               (when (has-flag? (snip->flags snip) OWNED)
+                                                                 (send snip set-s-flags (remove-flag (snip->flags snip) OWNED)))
+                                                               (send snip set-s-style
+                                                                     (or
+                                                                      (send s-style-list map-index-to-style f style-index (unbox list-id))
+                                                                      (send s-style-list basic-style)))
+                                                               (let ([accum
+                                                                      (if accum?
+                                                                          (cons snip accum)
+                                                                          (do-read-insert snip))])
+                                                                 (and
+                                                                  accum
+                                                                  (let ([data (read-buffer-data f)])
+                                                                    (and
+                                                                     (send f ok?)
+                                                                     (let ([accum
+                                                                            (if accum?
+                                                                                (cons (cons (car accum) data) (cdr accum))
+                                                                                (when data
+                                                                                  (set-snip-data snip data)))])
+                                                                       (and
+                                                                        accum
+                                                                        (begin
+                                                                          (when (len . >= . 0)
+                                                                            (let ([rcount (- (send f tell) start)])
+                                                                              (when (rcount . < . len)
+                                                                                (error 'read-snips-from-file
+                                                                                       "underread (caused by file corruption?)"))
+                                                                              (send f skip (- len rcount))
+                                                                              (send f remove-boundary)))
+                                                                          accum))))))))))))
+                                                      (begin
+                                                        (send f skip len)
+                                                        (and (send f ok?)
+                                                             accum))))))))))])
+                           (and accum
+                                (begin
+                                  (when accum?
+                                    (let ([accum (reverse accum)])
+                                      (send this do-read-insert (map car accum))
+                                      (for ([p (in-list accum)])
+                                        (when (cdr p)
+                                          (set-snip-data (car p) (cdr p))))))
+                                  
+                                  (read-headers-footers f #f)))))))))))))
+
+  ;; ----------------------------------------
+
+  (define/public (insert-port) (void))
+  (define/public (insert-file) (void))
+  (define/public (save-port) (void))
+  (define/public (load-file) (void))
+  (define/public (set-filename) (void))
+  (define/public (write-to-file) (void))
+
+  (def/public (get-filename [(make-or-false box?) [temp #f]])
+    (when temp (set-box! temp s-temp-filename?))
+    s-filename)
+
+  (define/private (extract-parent)
+    (and s-admin
+         ((send s-admin get-s-standard) . > . 0)
+         (let ([w (send s-admin do-get-canvas)])
+           (send w get-top-level))))
+
+  (define/public (do-begin-print) (void))
+  (define/public (print-to-dc) (void))
+  (define/public (do-end-print) (void))
+  (define/public (do-has-print-page?) (void))
+
+  (def/public (print [bool? [interactive? #t]]
+                     [bool? [fit-to-page? #t]]
+                     [(symbol-in standard postscript) [output-mode 'standard]]
+                     [any? [parent #f]] ; checked in ../editor.ss
+                     [bool? [force-page-bbox? #t]]
+                     [bool? [as-eps? #f]])
+    (let ([ps? (case (system-type)
+                 [(macosx windows) (eq? output-mode 'postscript)]
+                 [else #t])]
+          [parent (or parent
+                      (extract-parent))])
+      (cond
+       [ps?
+        (let ([dc (make-object post-script-dc% interactive? parent force-page-bbox? as-eps?)])
+          (when (send dc ok?)
+            (send dc start-doc "printing buffer")
+            (set! printing dc)
+            (let ([data (do-begin-print dc fit-to-page?)])
+              (print-to-dc dc)
+              (set! printing #f)
+              (do-end-print dc data)
+              (send dc end-doc)
+              (invalidate-bitmap-cache 0.0 0.0 'end 'end))))]
+       [else
+        (let ([data #f])
+          (run-printout ;; from wx
+           parent
+           interactive?
+           fit-to-page?
+           ;; begin-doc:
+           (lambda (dc)
+             (set! printing dc)
+             (set! data (do-begin-print printing fit-to-page?)))
+           ;; has page?:
+           (lambda (dc n) (do-has-print-page? dc n))
+           ;; print-page:
+           (lambda (dc n) (print-to-dc dc n))
+           ;; end-doc
+           (lambda ()
+             (let ([pr printing])
+               (set! printing #f)
+               (do-end-print printing data))
+             (invalidate-bitmap-cache 0.0 0.0 'end 'end))))])))
+
+  (def/public (undo)
+    (when (and (not undomode?)
+               (not redomode?))
+      (set! undomode? #t)
+      (perform-undos #f)
+      (set! undomode? #f)))
+
+  (def/public (redo)
+    (when (and (not undomode?)
+               (not redomode?))
+      (set! redomode? #t)
+      (perform-undos #t)
+      (set! redomode? #f)))
+
+  (define/private (do-clear-undos changes start end size)
+    (let loop ([i start])
+      (unless (= i end)
+        (send (vector-ref changes i) cancel)
+        (vector-set! changes i #f)
+        (loop (modulo (+ i 1) size)))))
+
+  (define/public (add-undo-rec rec)
+    (cond
+     [interceptmode?
+      (send intercepted append rec)]
+     [undomode?
+      (append-undo rec #t)]
+     [(zero? s-noundomode)
+      (when (not redomode?)
+        (cond
+         [emacs-style-undo?
+          (when (not (= redochanges-start redochanges-end))
+            (let loop ([e redochanges-end])
+              (unless (= redochanges-start e)
+                (let ([e (modulo (+ e -1 redochanges-size) redochanges-size)])
+                  (append-undo (vector-ref redochanges (send (vector-ref redochanges e) inverse)) #f)
+                  (loop e))))
+            (let loop ()
+              (unless (= redochanges-start redochanges-end)
+                (append-undo (vector-ref redochanges redochanges-start) #f)
+                (vector-set! redochanges redochanges-start #f)
+                (set! redochanges-start (modulo (add1 redochanges-start) redochanges-size))))
+            (set! redochanges-start 0)
+            (set! redochanges-end 0))]
+         [else
+          (do-clear-undos redochanges redochanges-start redochanges-end redochanges-size)
+          (set! redochanges-start 0)
+          (set! redochanges-end 0)]))
+      (append-undo rec #f)]
+     [else (send rec cancel)]))
+
+  (def/public (add-undo [(make-procedure 0) proc])
+    (add-undo-rec (new proc-record% [proc proc])))
+
+  (define/private (append-undo rec redos?)
+    (if (or (eq? max-undos 'forever) (positive? max-undos))
+        (let-values ([(start end size c) (get-undos redos?)])
+          (let-values ([(size c) (if (zero? size)
+                                     (let ([size (min 128 (if (eq? max-undos 'forever) 128 max-undos))])
+                                       (values size
+                                               (make-vector size #f)))
+                                     (values size c))])
+            (vector-set! c end rec)
+            (let ([end (modulo (add1 end) size)])
+              (let-values ([(start end size c)
+                            (if (= end start)
+                                (if (or (eq? max-undos 'forever)
+                                        (size . < . max-undos)
+                                        emacs-style-undo?)
+                                    ;; make more room
+                                    (let* ([s (min (* size 2) (if (eq? max-undos 'forever) (* size 2) max-undos))]
+                                           [naya (make-vector s #f)])
+                                      (for ([j (in-range size)])
+                                        (vector-set! naya j (vector-ref c (modulo (+ start j) size))))
+                                      (values 0 size s naya))
+                                    ;; no room to grow, so drop an undo record
+                                    (begin
+                                      (send c cancel)
+                                      (vector-set! c start #f)
+                                      (values (modulo (add1 start) size)
+                                              end
+                                              size
+                                              c)))
+                                (values start end size c))])
+                (put-undos-back redos? start end size c)))))
+        (send rec cancel)))
+
+  (define/private (get-undos redos?)
+    (if redos?
+        (values redochanges-start redochanges-end redochanges-size redochanges)
+        (values changes-start changes-end changes-size changes)))
+
+  (define/private (put-undos-back redos? start end size c)
+    (if redos?
+        (begin
+          (set! redochanges-start start)
+          (set! redochanges-end end)
+          (set! redochanges-size size)
+          (set! redochanges c))
+        (begin
+          (set! changes-start start)
+          (set! changes-end end)
+          (set! changes-size size)
+          (set! changes c))))
+
+  (def/public (begin-edit-sequence) (void))
+  (def/public (end-edit-sequence) (void))
+  (def/public (in-edit-sequence?) #f)
+  (def/public (refresh-delayed?) #f)
+  (def/public (locations-computed?) #f)
+
+  (define/private (perform-undos redos?)
+    (let ([id #f] [parity #f])
+      (let-values ([(start end size c) (get-undos redos?)])
+        (begin-edit-sequence)
+        (let loop ([end end])
+          (unless (= start end)
+            (let ([end (modulo (+ end -1 size) size)])
+              (let ([rec (vector-ref c end)])
+                (vector-set! c end #f)
+                (put-undos-back redos? start end size c)
+                (when emacs-style-undo?
+                  (set! id (send rec get-id))
+                  (set! parity (send rec get-parity)))
+                (when (send rec undo this)
+                  (loop end))))))
+        (end-edit-sequence)
+        (when (and emacs-style-undo?
+                   (not redos?))
+          ;; combine all new steps into one undo record, and
+          ;; set/generate id
+          (let-values ([(start end size c) (get-undos #t)])
+            (unless (= start end)
+              (let ([cnt (let loop ([e end][cnt 0])
+                           (if (= start e)
+                               cnt
+                               (let ([e (modulo (+ e -1 size) size)])
+                                 (if (send (vector-ref c e) is-composite?)
+                                     cnt
+                                     (loop e (add1 cnt))))))])
+                (when (positive? cnt)
+                  (let ([cu (new composite-record% [cnt cnt] [id id] [parity (not parity)])])
+                    (for ([i (in-range cnt)])
+                      (let ([e (modulo (+ (- end cnt) i size) size)])
+                        (send cu add-undo i (vector-ref c e))
+                        (vector-set! c e #f)))
+                    (let ([e (modulo (+ (- end cnt) cnt size) size)])
+                      (vector-set! c e cu)
+                      (set! redochanges-end (modulo (add1 e) size))))))))))))
+
+  (define/public (perform-undo-list changes)
+    (begin-edit-sequence)
+    (let loop ([changes changes])
+      (unless (null? changes)
+        (when (send (car changes) undo this)
+          (loop (cdr changes)))))
+    (end-edit-sequence))
+
+  (define/public (clear-undos)
+    (do-clear-undos changes changes-start changes-end changes-size)
+    (set! changes-start 0)
+    (set! changes-end 0)
+    (do-clear-undos redochanges redochanges-start redochanges-end redochanges-size)
+    (set! redochanges-start 0)
+    (set! redochanges-end 0))
+
+  (def/public (set-max-undo-history [max-undo-value? v])
+    (unless (or undomode?
+                redomode?
+                (eq? v max-undos))
+      (when (equal? 0 v)
+        (clear-undos)
+        (set! changes #f)
+        (set! redochanges #f)
+        (set! changes-size 0)
+        (set! redochanges-size 0))
+      ;;  should we bother downsizing if max-undos gets smaller but stays
+      ;; non-0?
+      (set! max-undos v)))
+
+  (def/public (get-max-undo-history) max-undos)
+
+  (def/public (s-start-intercept)
+    (set! interceptmode? #t)
+    (set! intercepted null))
+  
+  (def/public (s-end-intercept)
+    (begin0
+     intercepted
+     (set! interceptmode? #f)
+     (set! intercepted null)))
+  
+  ;; ----------------------------------------
+
+  ;; see top-level functions below, at "copy ring"
+
+  (define/public (copy-ring-next)
+    (vector-set! copy-ring-buffer1 copy-ring-pos common-copy-buffer)
+    (vector-set! copy-ring-buffer2 copy-ring-pos common-copy-buffer2)
+    (vector-set! copy-ring-data copy-ring-pos common-copy-region-data)
+    (vector-set! copy-ring-style copy-ring-pos copy-style-list)
+
+    (set! copy-ring-pos (sub1 copy-ring-pos))
+    (when (copy-ring-pos . < . 0)
+      (set! copy-ring-pos (sub1 copy-ring-max)))
+
+    (set! common-copy-buffer (vector-ref copy-ring-buffer1 copy-ring-pos))
+    (set! common-copy-buffer2 (vector-ref copy-ring-buffer2 copy-ring-pos))
+    (set! common-copy-region-data (vector-ref copy-ring-data copy-ring-pos))
+    (set! copy-style-list (vector-ref copy-ring-style copy-ring-pos)))
+
+  (define/public (begin-copy-buffer)
+    (set! copy-depth (add1 copy-depth)))
+  (define/public (end-copy-buffer)
+    (set! copy-depth (sub1 copy-depth)))
+
+  (define/public (free-old-copies)
+    (when copy-style-list
+      (if (copy-depth . > . 1)
+          ;; delete current "ring" occupant:
+          (begin
+            (set! common-copy-buffer null)
+            (set! common-copy-buffer2 null)
+            (set! common-copy-region-data #f)
+            (set! copy-style-list #f))
+
+          (begin
+            (vector-set! copy-ring-buffer1 copy-ring-pos common-copy-buffer)
+            (vector-set! copy-ring-buffer2 copy-ring-pos common-copy-buffer2)
+            (vector-set! copy-ring-data copy-ring-pos common-copy-region-data)
+            (vector-set! copy-ring-style copy-ring-pos copy-style-list)
+            
+            (when (copy-ring-max . > . copy-ring-dest)
+              ;; no more space: delete current ring occupant:
+              (vector-set! copy-ring-buffer1 copy-ring-dest #f)
+              (vector-set! copy-ring-buffer2 copy-ring-dest #f)
+              (vector-set! copy-ring-data copy-ring-dest #f))
+
+            (set! common-copy-buffer null)
+            (set! common-copy-buffer2 null)
+            (set! common-copy-region-data #f)
+            (set! copy-style-list #f)
+            (set! copy-ring-pos copy-ring-dest)
+
+            (set! copy-ring-dest (add1 copy-ring-dest))
+            (when (copy-ring-max . < . copy-ring-dest)
+              (set! copy-ring-max copy-ring-dest))
+            (when (copy-ring-dest . >= . copy-ring-size)
+              (set! copy-ring-dest 0))))))
+  
+  (define/public (install-copy-buffer time sl)
+    (set! copy-style-list sl)
+
+    (when (not (= copying-self copy-depth))
+      (when (or (not ALLOW-X-STYLE-SELECTION?)
+                (not x-clipboard-hack?))
+        (send the-clipboard set-clipboard-client the-editor-clipboard-client time))))
+
+  (define/public (do-buffer-paste cb time local?)
+    ;; cut and paste to ourself? (same eventspace?)
+    (if (or local?
+            (and (not paste-text-only?)
+                 (send cb same-clipboard-client? the-editor-clipboard-client)
+                 (send the-editor-clipboard-client same-eventspace? (current-eventspace))))
+        ;; local direct copy:
+        (begin
+          (set! copy-depth (add1 copy-depth))
+          (map (lambda (snip bd)
+                 (insert-paste-snip (send snip copy) bd))
+               (reverse common-copy-buffer)
+               (reverse common-copy-buffer2))
+          (set! copy-depth (sub1 copy-depth))
+          (when (and common-copy-region-data
+                     (this . is-a? . text%))
+            (send this paste-region-data common-copy-region-data)))
+        ;; general paste:
+        (or
+         (and (not paste-text-only?)
+              (let ([str (send cb get-clipboard-data "WXME" time)])
+                (and str
+                     (let* ([b (make-object editor-stream-in-bytes-base% str)]
+                            [mf (make-object editor-stream-in% b)])
+                       (and (read-editor-version mf b #t #f)
+                            (begin
+                              (when (read-editor-global-header mf)
+                                (when (send mf ok?)
+                                  (when (read-from-file mf)
+                                    (let ([data (read-buffer-data mf)])
+                                      (and data
+                                           (this . is-a? . text%)
+                                           (send this paste-region-data data))))))
+                              (read-editor-global-footer mf)
+                              #t))))))
+         (and (not paste-text-only?)
+              (let ([bm (send cb get-clipboard-bitmap time)])
+                (and bm
+                     (begin
+                       (insert-paste-snip (make-object image-snip% bm) #f)
+                       #t))))
+         (let ([str (send cb get-clipboard-string time)])
+           ;; no data => empty string
+           (insert-paste-string str)))))
+
+  (def/public (copy-self) (void))
+
+  (def/public (copy-self-to [editor<%> m])
+    ;; copy style list
+    (send (send m get-s-style-list) copy s-style-list)
+    ;; copy all the snips:
+    (let ([save-buffer common-copy-buffer]
+          [save-buffer2 common-copy-buffer2]
+          [save-styles copy-style-list]
+          [save-data common-copy-region-data]
+          [save-cs copying-self])
+      
+      (send m begin-edit-sequence)
+
+      (set! common-copy-buffer null)
+      (set! common-copy-buffer2 null)
+      (set! copy-style-list #f)
+      (set! common-copy-region-data #f)
+      (set! copying-self (add1 copy-depth))
+      
+      (cond
+       [(this . is-a? . text%)
+        (send this copy #t 0 0 (send this last-position))]
+       [(this . is-a? . pasteboard%)
+        (begin-edit-sequence)
+        (let ([unselect
+               (let loop ([s (send this find-first-snip)])
+                 (if s
+                     (if (send this is-selected? s)
+                         (begin
+                           (send this add-selected s)
+                           (cons s (loop (snip->next s))))
+                         (loop (snip->next s)))
+                     null))])
+          (send this copy #t 0)
+          (for-each (lambda (s)
+                      (send this remove-selected s))
+                    unselect))
+        (end-edit-sequence)])
+
+      (let ([copy-snips (reverse common-copy-buffer)]
+            [copy-snips2 (reverse common-copy-buffer2)])
+      
+        (set! common-copy-buffer save-buffer)
+        (set! common-copy-buffer2 save-buffer2)
+        (set! copy-style-list save-styles)
+        (set! common-copy-region-data save-data)
+        (set! copying-self save-cs)
+
+        (when (this . is-a? . text%)
+          (send m do-insert-snips copy-snips 0))
+
+        (for-each (lambda (s bfd)
+                    (unless (this . is-a? . text%)
+                      (send m insert s s)) ;; before itself -> at end
+                    (when bfd
+                      (send m set-snip-data s bfd)))
+                  copy-snips
+                  copy-snips2)
+
+        (send m size-cache-invalid)
+
+        (send m set-min-width (get-min-width))
+        (send m set-max-width (get-max-width))
+        (send m set-min-height (get-min-height))
+        (send m set-max-height (get-max-height))
+
+        (let-boxes ([temp? (box #f)]
+                    [f (box #f)])
+            (set-box! f (get-filename temp?))
+          (send m set-filename f temp?))
+
+        (send m set-max-undo-history (get-max-undo-history))
+        
+        (send m set-keymap (get-keymap))
+
+        (send m set-inactive-caret-threshold (get-inactive-caret-threshold))
+        (send m set-load-overwrites-styles (get-load-overwrites-styles))
+
+        (send m end-edit-sequence))))
+  
+  ;; ----------------------------------------
+
+  (define/public (own-x-selection) (void))
+
+  (define/public (do-own-x-selection on? force?)
+    (if on?
+        (if (and (not force?)
+                 (not (eq? editor-x-selection-allowed this)))
+            #f
+            (begin
+              (when editor-x-selection-owner
+                (send editor-x-selection-owner own-x-selection #f #t #f)
+                (set! editor-x-selection-owner #f))
+              (set! x-selection-copied? #f)
+              (send the-x-selection-clipboard set-clipboard-client the-editor-x-clipboard-client 0)
+              (set! editor-x-selection-owner this)
+              #t))
+        (begin
+          (when (eq? this editor-x-selection-owner)
+            (set! editor-x-selection-owner #f)
+            (when (and (not x-selection-copied?)
+                       (send the-x-selection-clipboard same-clipboard-client?
+                             the-editor-x-clipboard-client))
+              (send the-x-selection-clipboard set-clipboard-string "" 0)))
+          #t)))
+
+  (define/public (copy-out-x-selection)
+    (when (eq? this editor-x-selection-owner)
+      (copy-into-selection)
+      (set! x-selection-copied? #t)))
+
+  (def/public (get-paste-text-only)
+    paste-text-only?)
+
+  (def/public (set-paste-text-only [any? pto?])
+    (set! paste-text-only? (and pto? #t)))
+
+  ;; ----------------------------------------
+
+  (def/public (lock [any? lock?])
+    (set! s-user-locked? (and lock? #t)))
+
+  (def/public (is-locked?) s-user-locked?)
+
+  (def/public (modified?) s-modified?)
+
+  (def/public (set-modified [any? mod?])
+    (let ([mod? (and mod? #t)])
+      (unless (eq? mod? s-modified?)
+        (set! s-modified? mod?)
+        (when mod?
+          (set! num-parts-modified 1))
+
+        (when (and (not mod?)
+                   (not undomode?))
+          ;; get rid of undos that reset the modification state
+          (set! num-parts-modified 0)
+          (let loop ([i changes-end])
+            (unless (= i changes-start)
+              (let ([i (modulo (+ i -1 changes-size) changes-size)])
+                (send (vector-ref changes i) drop-set-unmodified)
+                (loop i))))
+          (let loop ([i redochanges-end])
+            (unless (= i redochanges-start)
+              (let ([i (modulo (+ i -1 redochanges-size) redochanges-size)])
+                (send (vector-ref redochanges i) drop-set-unmodified)
+                (loop i)))))
+
+        (when s-admin
+          (send s-admin modified s-modified?))
+        
+        (when (and (not mod?) (not undomode?))
+          ;; tell all snips that they should now consider themselves unmodified:
+          (let loop ([snip (find-first-snip)])
+            (when snip
+              (send snip set-unmodified)
+              (loop (snip->next snip))))))))
+
+  (def/public (on-snip-modified [snip% s] [any? mod?])
+    (if (not mod?)
+        (when (= num-parts-modified 1)
+          (set! num-parts-modified 0)
+          (when s-modified?
+            (set-modified #f)))
+        (if s-modified?
+            (set! num-parts-modified (add1 num-parts-modified))
+            (set-modified #t))))
+
+  (def/public (get-inactive-caret-threshold)
+    s-inactive-caret-threshold)
+
+  (def/public (set-inactive-caret-threshold [(symbol-in no-caret show-inactive-caret show-caret) v])
+    (set! s-inactive-caret-threshold v))
+
+  (define/public (scroll-editor-to localx localy w h refresh? bias)
+    (if s-admin
+        (send s-admin scroll-to localx localy w h refresh? bias)
+        #f))
+
+  (def/public (refresh [real? left] [real? top] [nonnegative-real? width] [nonnegative-real? height]
+                       [(symbol-in no-caret show-inactive-caret show-caret) show-caret]
+                       [(make-or-false color%) bg-color])
+    (void))
+
+  (def/public (on-paint [any? pre?] [dc<%> dc]
+                        [real? l] [real? t] [real? r] [real? b]
+                        [real? dx] [real? dy]
+                        [(symbol-in no-caret show-inactive-caret show-caret) show-caret])
+    (void))
+
+  (def/public (can-save-file? [path-string? filename]
+                              [symbol? format])
+    #t)
+
+  (def/public (on-save-file [path-string? filename]
+                            [symbol? format])
+    (void))
+
+  (def/public (after-save-file [any? ok?])
+    (void))
+
+  (def/public (can-load-file? [path-string? filename]
+                              [symbol? format])
+    #t)
+
+  (def/public (on-load-file [path-string? filename]
+                            [symbol? format])
+    (void))
+
+  (def/public (after-load-file [any? ok?])
+    (void))
+
+  (def/public (on-edit-sequence) (void))
+
+  (def/public (after-edit-sequence) (void))
+
+  (def/public (on-display-size) (void))
+
+  (def/public (on-change) (void))
+
+  (def/public (on-display-size-when-ready)
+    (cond
+     [(in-edit-sequence?)
+      (set! s-need-on-display-size? #t)]
+     [(or (not seq-lock)
+          (semaphore-try-wait? seq-lock))
+      (when seq-lock
+        (semaphore-post seq-lock))
+      (on-display-size)]
+     [else (set! s-need-on-display-size? #t)]))
+
+  (def/public (begin-sequence-lock)
+    (call-with-semaphore
+     global-lock
+     (lambda ()
+       (unless seq-lock
+         (set! seq-lock (make-semaphore 1)))))
+    
+    ;; "Try" really should succeed, because multiple refreshes are
+    ;; prevented through other flags. Still, we don't want to block if
+    ;; someone previously escaped from a repaint.
+    (void (semaphore-try-wait? seq-lock)))
+
+  (def/public (end-sequence-lock)
+    (semaphore-post seq-lock))
+
+  (def/public (wait-sequence-lock)
+    (when seq-lock
+      (sync seq-lock)
+      (semaphore-post seq-lock)))
+
+  (def/public (get-file [(make-or-false path-string?) path])
+    (editor-get-file "choose a file" (extract-parent) #f path))
+
+  (def/public (put-file [(make-or-false path-string?) dir]
+                        [(make-or-false string?) suggested-name])
+    (editor-put-file "save file as" (extract-parent) dir suggested-name))
+  
+  (def/public (set-load-overwrites-styles [any? b?])
+    (set! loadoverwritesstyles? (and b? #t)))
+
+  (def/public (get-load-overwrites-styles) loadoverwritesstyles?))
+
+(define editor<%> (class->interface editor%))
+
+;; ------------------------------------------------------------
+
+(define/top (add-editor-keymap-functions [keymap% tab])
+  (let ([add (lambda (n f)
+               (send tab add-function n f))])
+    (add "copy-clipboard" (lambda (e event) (send e copy #f (send event get-time-stamp))))
+    (add "copy-append-clipboard" (lambda (e event) (send e copy #t (send event get-time-stamp))))
+    (add "paste-clipboard" (lambda (e event) (send e paste (send event get-time-stamp))))
+    (add "paste-x-selection" (lambda (e event) (send e paste-x-selection (send event get-time-stamp))))
+    (add "cut-clipboard"  (lambda (e event) (send e cut #f (send event get-time-stamp))))
+    (add "cut-append-clipboard" (lambda (e event) (send e cut #t (send event get-time-stamp))))
+    (add "delete-to-end-of-line" (lambda (e event) (send e kill (send event get-time-stamp))))
+    (add "undo" (lambda (e event) (send e undo)))
+    (add "redo" (lambda (e event) (send e redo)))
+    (add "delete-selection" (lambda (e event) (send e clear)))
+    (add "clear-selection" (lambda (e event) (send e clear)))
+    (add "select-all" (lambda (e event) (send e select-all)))))
+
+;; ------------------------------------------------------------
+
+(define (write-buffer-data f data)
+  (let loop ([data data])
+    (if data
+        (let ([mp (send f do-map-position (send data get-s-dataclass))])
+          (send f put mp)
+          (let ([req? (send (send data get-s-dataclass) get-s-required?)])
+            (let-values ([(data-start data-pos)
+                          (if req?
+                              (values #f #f)
+                              (values (send f tell)
+                                      (begin
+                                        (send f put-fixed 0)
+                                        (send f tell))))])
+              (if (not (send data write f))
+                  #f
+                  (begin
+                    (unless req?
+                      (let ([data-end (send f tell)])
+                        (send f jump-to data-start)
+                        (send f put-fixed (- data-end data-pos))
+                        (send f jump-to data-end)))
+                    (loop (send data get-s-next)))))))
+        (begin
+          (send f put 0)
+          #t))))
+
+(define (write-snips-to-file f style-list snip-list
+                             start-snip end-snip
+                             extra-data buffer)
+  (and 
+   (write-styles-to-file style-list f)
+   (let ([all-start (send f tell)])
+     (send f put-fixed 0)
+
+     (let ([snip-list
+            (if snip-list
+                (reverse snip-list)
+                (let loop ([snip start-snip])
+                  (if (and snip
+                           (not (eq? snip end-snip)))
+                      (cons snip (loop (snip->next snip)))
+                      null)))])
+
+       (let ([num-headers
+              (let loop ([num-headers 0]
+                         [snips snip-list])
+                (if (null? snips)
+                    num-headers
+                    (let ([snip (car snips)])
+                      (let ([sclass (snip->snipclass snip)])
+                        (unless sclass
+                          (error 'write-snips-to-file "snip has no snipclass"))
+                        (if (send f do-get-header-flag sclass)
+                            (begin
+                              (send f put (send f do-map-position sclass))
+                              (let ([header-start (send f tell)])
+                                (send f put-fixed 0)
+                                (let ([header-pos (send f tell)])
+                                  (if (not (send sclass write-header f))
+                                      #f
+                                      (begin
+                                        (send f do-set-header-flag sclass)
+                                        (let ([header-end (send f tell)])
+                                          (send f jump-to header-start)
+                                          (send f put-fixed (- header-end header-pos))
+                                          (send f jump-to header-end)
+                                          (if (send f ok?)
+                                              (loop (add1 num-headers)
+                                                    (cdr snips))
+                                              #f)))))))
+                            (loop num-headers (cdr snips)))))))])
+
+         (and
+          num-headers
+          (let ([all-end (send f tell)])
+            (send f jump-to all-start)
+            (send f put-fixed num-headers)
+            (send f jump-to all-end)
+
+            (send f put (length snip-list))
+            
+            (andmap
+             (lambda (snip data)
+               (let ([sclass (snip->snipclass snip)])
+                 (if sclass
+                     (send f put (send f do-map-position sclass))
+                     (send f put -1))
+                 (let-values ([(snip-start snip-pos)
+                               (if (or (not sclass)
+                                       (not (send sclass get-s-required?)))
+                                   (values (send f tell)
+                                           (begin
+                                             (send f put-fixed 0)
+                                             (send f tell)))
+                                   (values #f #f))])
+                   (let ([style-index (send style-list style-to-index (snip->style snip))])
+                     (when (not style-index)
+                       (error 'write-snips-to-file "bad style discovered"))
+                     (send f put style-index))
+                   (send snip write f)
+                   (and (write-buffer-data f data)
+                        (begin
+                          (when snip-start
+                            (let ([snip-end (send f tell)])
+                              (send f jump-to snip-start)
+                              (send f put-fixed (- snip-end snip-pos))
+                              (send f jump-to snip-end)))
+                          (send f ok?))))))
+             snip-list
+             (if extra-data
+                 (reverse extra-data)
+                 (map (lambda (snip)
+                        (send buffer get-snip-data snip))
+                      snip-list))))))))))
+
+;; ------------------------------------------------------------
+
+;; Copy and the copy ring: the current clipboard content is stored in
+;; common-copy-buffer, etc. to implement the copy ring, then when a
+;; copy is started, we moved the wxmb_common-copy-buffer, etc. values
+;; into a copy ring. yanking from the ring swaps the values in
+;;  wxmb_common-copy-buffer, etc.  and the ring values and adjust the
+;; pointer into the ring.
+
+(define copy-depth 0)
+
+(define copy-ring-size 30)
+(define copy-ring-pos 0)
+(define copy-ring-max 1)
+(define copy-ring-dest 1)
+
+(define copy-ring-buffer1 (make-vector copy-ring-size #f))
+(define copy-ring-buffer2 (make-vector copy-ring-size #f))
+
+(define copy-ring-style (make-vector copy-ring-size #f))
+(define copy-ring-data (make-vector copy-ring-size #f))
+
+(define common-copy-buffer null)
+(define common-copy-buffer2 null)
+(define copy-style-list #f)
+(define common-copy-region-data #f)
+
+(define selection-copy-buffer #f)
+(define selection-copy-buffer2 #f)
+(define selection-copy-style-list #f)
+(define selection-copy-region-data #f)
+
+(define (set-common-copy-region-data! v) (set! common-copy-region-data v))
+(define (cons-common-copy-buffer! v) (set! common-copy-buffer (cons v common-copy-buffer)))
+(define (cons-common-copy-buffer2! v) (set! common-copy-buffer2 (cons v common-copy-buffer2)))
+
+(define copying-self 0)
+
+(define editor-x-selection-mode? ALLOW-X-STYLE-SELECTION?)
+(define editor-x-selection-owner #f)
+(define editor-x-selection-allowed #f)
+(define x-selection-copied? #f)
+(define x-clipboard-hack? #f)
+
+(define (generic-get-data fformat copy-buffer copy-buffer2 copy-styles copy-region-data)
+  (cond
+   [(equal? fformat "TEXT")
+    (string->bytes/utf-8
+     (let ([out (open-output-string)])
+       (for-each (lambda (snip)
+                   (let ([s (send snip get-text 0 (snip->count snip) #t)])
+                     (display s out)))
+                 (reverse copy-buffer))
+       (let ([s (get-output-string out)])
+         (cond
+          [(eq? 'macosx (system-type))
+           ;; change newline to return
+           (regexp-replace* #rx"\r" s "\n")]
+          [(eq? 'windows (system-type))
+           ;; change newline to return-newline:
+           (regexp-replace* #rx"\n" s "\r\n")]
+          [else s]))))]
+   [(equal? fformat "WXME")
+    (let* ([b (make-object editor-stream-out-bytes-base%)]
+           [mf (make-object editor-stream-out% b)])
+      (write-editor-version mf b)
+      (write-editor-global-header mf)
+      (and (send mf ok?)
+           (begin
+            (send mf put-fixed 0)
+            (and (write-snips-to-file mf copy-styles copy-buffer #f #f copy-buffer2 #f)
+                 (begin
+                   (send mf put-fixed 0)
+                   (write-buffer-data mf copy-region-data))))
+           (write-editor-global-footer mf)
+           (send b get-bytes)))]
+   [else #""]))
+
+(defclass editor-clipboard-client% clipboard-client%
+  (inherit add-type)
+  (super-new)
+  (add-type "TEXT")
+  (add-type "WXME")
+  (define/override (get-data format)
+    (generic-get-data format
+                      common-copy-buffer
+                      common-copy-buffer2
+                      copy-style-list
+                      common-copy-region-data))
+  (define/override (on-replaced)
+    (void)))
+
+(defclass editor-x-clipboard-client% clipboard-client%
+  (inherit add-type)
+  (super-new)
+  (add-type "TEXT")
+  (add-type "WXME")
+  (define/override (get-data format)
+    (cond
+     [(and (not x-selection-copied?)
+           (not editor-x-selection-owner))
+      ""]
+     [else
+      (when (or (not x-selection-copied?)
+                editor-x-selection-owner)
+        (copy-into-selection))
+      
+      ;; if nothing is copied (e.g., do-copy is overriden to not copy anything
+      ;; or copies directly to clipboard):
+      (if (not selection-copy-style-list)
+          (if (send the-x-selection-clipboard same-clipboard-client? this)
+              #f
+              (send the-x-selection-clipboard get-clipboard-data format 0))
+          (generic-get-data format
+                            selection-copy-buffer
+                            selection-copy-buffer2
+                            selection-copy-style-list
+                            selection-copy-region-data))]))
+  (define/override (on-replaced)
+    (if editor-x-selection-owner
+        ;; in case this client replaced itself somewhere along the way:
+        (when (not (send the-x-selection-clipboard same-clipboard-client? this))
+          (let ([b editor-x-selection-owner])
+            (set! editor-x-selection-owner #f)
+            (set! x-selection-copied? #f)
+            (send b own-x-selection #f #t #f)))
+        (set! x-selection-copied? #f))))
+
+(define the-editor-clipboard-client
+  (new editor-clipboard-client%))
+(define the-editor-x-clipboard-client
+  (new editor-x-clipboard-client%))
+
+(define/top (editor-set-x-selection-mode [any? on?])
+  (when ALLOW-X-STYLE-SELECTION?
+    (set! editor-x-selection-mode? (and on? #t))
+    (when (and (not on?)
+               (send the-x-selection-clipboard same-clipboard-client?
+                     the-editor-x-clipboard-client))
+      (send the-x-selection-clipboard set-clipboard-string "" 0))))
+
+(define (copy-into-selection)
+  ;; copy all the snips:
+  (set! x-clipboard-hack? #t)
+  
+  ;; save normal buffers:
+  (let ([save-buffer common-copy-buffer]
+        [save-buffer2 common-copy-buffer2]
+        [save-styles copy-style-list]
+        [save-data common-copy-region-data])
+    
+    ;; set up new selection buffers, and redirect:
+    (set! common-copy-buffer null)
+    (set! common-copy-buffer2 null)
+    (set! copy-style-list #f)
+    (set! common-copy-region-data #f)
+    
+    (send editor-x-selection-owner copy #f 0)
+    
+    ;; move "normal" buffers to selection:
+    (set! selection-copy-buffer common-copy-buffer)
+    (set! selection-copy-buffer2 common-copy-buffer2)
+    (set! selection-copy-style-list copy-style-list)
+    (set! selection-copy-region-data common-copy-region-data)
+
+    ;; restore normal buffers:
+    (set! common-copy-buffer save-buffer)
+    (set! common-copy-buffer2 save-buffer2)
+    (set! copy-style-list save-styles)
+    (set! common-copy-region-data save-data))
+  
+  (set! x-clipboard-hack? #f))
+
+;; ------------------------------------------------------------
+
+(define (read-buffer-data f)
+  (let loop ([data #f])
+    (let-boxes ([extra-data-index 0])
+        (send f get extra-data-index)
+      (if (zero? extra-data-index)
+          data
+          (let ([dclass (send (send f get-s-bdl) find-by-map-position f extra-data-index)])
+            (let ([datalen (if (or (not dclass)
+                                   (not (send dclass get-s-required?)))
+                               (let-boxes ([datalen 0])
+                                   (send f get datalen)
+                                 datalen)
+                               -1)])
+              (if dclass
+                  (let ([start (send f tell)])
+                    (when (datalen . >= . 0)
+                      (send f set-boundary datalen))
+                    (let ([newdata (send dclass read f)])
+                      (and 
+                       newdata
+                       (begin
+                         (send newdata set-s-next data)
+                         (let ([data newdata])
+                           (when (datalen . >= . 0)
+                             (let ([rcount (- (send f tell) start)])
+                               (when (rcount . < . datalen)
+                                 (error 'read-buffer-data "underread (caused by file corruption?)"))
+                               (send f skip (- datalen rcount)))
+                             (send f remove-boundary))
+                           (and (send f ok?)
+                                (loop data)))))))
+                  ;; unknown extra data
+                  (begin
+                    (send f skip datalen)
+                    (and (send f ok?)
+                         (loop data))))))))))
+
+;; ------------------------------------------------------------
+
+(define MRED-READER-STR #"#reader(lib\"read.ss\"\"wxme\")")
+(define MRED-START-STR #"WXME")
+(define MRED-FORMAT-STR #"01")
+(define MRED-VERSION-STR #"08")
+(define MRED-VERSION-RX #rx"^0[1-8]$")
+
+(define (write-editor-version f b)
+  (send b write-bytes MRED-READER-STR)
+  (send b write-bytes MRED-START-STR)
+  (send b write-bytes MRED-FORMAT-STR)
+  (send b write-bytes MRED-VERSION-STR)
+  (send b write-bytes #" ## ")
+  (not (send b bad?)))
+
+(define MRED-READER+START-STR (bytes-append MRED-READER-STR MRED-START-STR))
+
+(define (detect-wxme-file who f peek?)
+  (let* ([l1 (bytes-length MRED-START-STR)]
+         [s (if peek?
+                (peek-bytes l1 0 f)
+                (read-bytes l1 f))])
+    (or (equal? s MRED-START-STR)
+        (and (equal? s (subbytes MRED-READER-STR 0 l1))
+             (let ([s (bytes-append
+                       s
+                       (let ([v (if peek?                           
+                                    (peek-bytes (- (bytes-length MRED-READER+START-STR) l1) l1 f)
+                                    (read-bytes (- (bytes-length MRED-READER+START-STR) l1) f))])
+                         (if (eof-object? v)
+                             ""
+                             v)))])
+               (equal? s MRED-READER+START-STR))))))
+
+(define (read-editor-version mf b parse-format? show-errors?)
+  (and
+   (or
+    (not parse-format?)
+    (let* ([n1 (bytes-length MRED-START-STR)]
+           [vbuf (make-vector n1)])
+      (let ([n (send b read vbuf)])
+        (or (and (= n (vector-length vbuf))
+                 (bytes=? MRED-START-STR (string->bytes/latin-1 (list->string (vector->list vbuf)))))
+            ;; maybe we have a #reader... prefix?
+            (let* ([n2 (bytes-length MRED-READER-STR)]
+                   [vbuf2 (make-vector (- n2 n1))])
+              (let ([n (send b read vbuf2)])
+                (and (= n (- n2 n1))
+                     (bytes=? MRED-READER-STR
+                              (string->bytes/latin-1 
+                               (string-append (list->string (vector->list vbuf))
+                                              (list->string (vector->list vbuf2)))))
+                     ;; yes, so try reading start again.
+                     (let ([n (send b read vbuf)])
+                       (and (= n (vector-length vbuf))
+                            (bytes=? MRED-START-STR (string->bytes/latin-1 (list->string (vector->list vbuf)))))))))
+            (if show-errors?
+                (error (method-name 'pasteboard%: 'insert-file) "not a WXME file")
+                #f)))))
+   (begin
+     (let* ([n1 (bytes-length MRED-FORMAT-STR)]
+            [vbuf (make-vector n1)])
+       (let ([n (send b read vbuf)])
+         (send mf set-s-read-format (string->bytes/latin-1 (list->string (vector->list vbuf))))))
+     (let* ([n1 (bytes-length MRED-VERSION-STR)]
+            [vbuf (make-vector n1)])
+       (let ([n (send b read vbuf)])
+         (and (= n n1)
+              (send mf set-s-read-version (string->bytes/latin-1 (list->string (vector->list vbuf)))))))
+     (check-format-and-version mf b show-errors?))))
+
+(define (read-editor-global-header f)
+  (send (send f get-s-scl) reset-header-flags f)
+  (if (not (send (send f get-s-scl) read f))
+      #f
+      (begin
+        (setup-style-reads-writes f)
+        (send (send f get-s-bdl) read f))))
+
+(define (read-editor-global-footer f)
+  (done-style-reads-writes f)
+  (send (send f get-s-scl) reset-header-flags f)
+  #t)
+
+(define (write-editor-global-header f)
+  (send f pretty-start)
+  (send (send f get-s-scl) reset-header-flags f)
+  (if (not (send (send f get-s-scl) write f))
+      #f
+      (begin
+        (setup-style-reads-writes f)
+        (send (send f get-s-bdl) write f))))
+
+(define (write-editor-global-footer f)
+  (done-style-reads-writes f)
+  (send (send f get-s-scl) reset-header-flags f)
+  (send f pretty-finish)
+  #t)
+
+(define (check-format-and-version s b show-errors?)
+  (and
+   (or (bytes=? (send s get-s-read-format) MRED-FORMAT-STR)
+       (if show-errors?
+           (error 'load-file "unknown format number in WXME file format: ~s"
+                  (send s get-s-read-format))
+           #f))
+   (or (regexp-match MRED-VERSION-RX (send s get-s-read-format))
+       (if show-errors?
+           (error 'load-file "unknown version number in WXME file format")
+           #f))
+   (if ((send s get-wxme-version) . > . 3)
+       ;; need to skip " ## "
+       (let* ([v (make-vector 4)]
+              [n (send b read v)])
+         (or (and (= n 4)
+                  (char=? (vector-ref v 0) #\space)
+                  (char=? (vector-ref v 1) #\#)
+                  (char=? (vector-ref v 2) #\#)
+                  (member (vector-ref v 3) '(#\space #\return #\newline)))
+             (if show-errors?
+                 (error 'load-file "WXME file missing ' ## ' mark")
+                 #f)))
+       #t)))
diff --git a/collects/mred/private/wxme/keymap.ss b/collects/mred/private/wxme/keymap.ss
new file mode 100644
index 00000000..4f2f66a9
--- /dev/null
+++ b/collects/mred/private/wxme/keymap.ss
@@ -0,0 +1,737 @@
+#lang scheme/base
+(require scheme/class
+         "../syntax.ss"
+         "wx.ss")
+
+(provide keymap%
+         map-command-as-meta-key)
+
+(define map-command-as-meta? #f)
+
+(define/top (map-command-as-meta-key [bool? v])
+  (set! map-command-as-meta? v))
+
+(define (as-meta-key k)
+  (case (system-type)
+    [(macosx) (if map-command-as-meta?
+                  k
+                  #f)]
+    [else k]))
+
+(define (as-cmd-key k)
+  (case (system-type)
+    [(macosx) k]
+    [else #f]))
+
+(define keylist
+  #hash(("leftbutton" . mouse-left)
+        ("rightbutton" . mouse-right)
+        ("middlebutton" . mouse-middle)
+        ("leftbuttondouble" . mouse-left-double)
+        ("rightbuttondouble" . mouse-right-double)
+        ("middlebuttondouble" . mouse-middle-double)
+        ("leftbuttontriple" . mouse-left-triple)
+        ("rightbuttontriple" . mouse-right-triple)
+        ("middlebuttontriple" . mouse-middle-triple)
+        ("leftbuttonseq" . mouse-left)
+        ("rightbuttonseq" . mouse-right)
+        ("middlebuttonseq" . mouse-middle)
+        ("wheelup" . wheel-up)
+        ("wheeldown" . wheel-down)
+        ("esc" . escape) 
+        ("delete" . delete)
+        ("del" . #\rubout)
+        ("insert" . insert)
+        ("ins" . insert)
+        ("add" . add)
+        ("subtract" . subtract)
+        ("multiply" . multiply)
+        ("divide" . divide)
+        ("backspace" . back)
+        ("back" . back)
+        ("return" . #\return)
+        ("enter" . #\return)
+        ("tab" . #\tab)
+        ("space" . #\space)
+        ("right" . right)
+        ("left" . left)
+        ("up" . up)
+        ("down" . down)
+        ("home" . home)
+        ("end" . end)
+        ("pageup" . prior)
+        ("pagedown" . next)
+        ("semicolon" . #\;)
+        ("colon" . #\:)
+        ("numpad0" . numpad0)
+        ("numpad1" . numpad1)
+        ("numpad2" . numpad2)
+        ("numpad3" . numpad3)
+        ("numpad4" . numpad4)
+        ("numpad5" . numpad5)
+        ("numpad6" . numpad6)
+        ("numpad7" . numpad7)
+        ("numpad8" . numpad8)
+        ("numpad9" . numpad9)
+        ("numpadenter" . #\u3)
+        ("f1" . f1)
+        ("f2" . f2)
+        ("f3" . f3)
+        ("f4" . f4)
+        ("f5" . f5)
+        ("f6" . f6)
+        ("f7" . f7)
+        ("f8" . f8)
+        ("f9" . f9)
+        ("f10" . f10)
+        ("f11" . f11)
+        ("f12" . f12)
+        ("f13" . f13)
+        ("f14" . f14)
+        ("f15" . f15)
+        ("f16" . f16)
+        ("f17" . f17)
+        ("f18" . f18)
+        ("f19" . f19)
+        ("f20" . f20)
+        ("f21" . f21)
+        ("f22" . f22)
+        ("f23" . f23)
+        ("f24" . f24)))
+(define rev-keylist
+  (make-immutable-hash
+   (hash-map keylist (lambda (k v) (cons v k)))))
+
+(define-struct kmfunc (name f))
+
+(define-struct key (code
+
+                    shift-on?
+                    shift-off?
+                    ctrl-on?
+                    ctrl-off?
+                    alt-on?
+                    alt-off?
+                    meta-on?
+                    meta-off?
+                    cmd-on?
+                    cmd-off?
+                    caps-on?
+                    caps-off?
+
+                    score
+
+                    check-other?
+                    fullset?
+
+                    [fname #:mutable]
+
+                    isprefix?
+                    seqprefix))
+
+(define-local-member-name 
+  chain-handle-key-event
+  get-best-score
+  chain-handle-mouse-event
+  get-best-mouse-score
+  cycle-check)
+
+(defclass keymap% object%
+  
+  (super-new)
+
+  (define functions (make-hash))
+  (define keys (make-hash))
+
+  (define prefix #f)
+  (define prefixed? #f)
+
+  (define active-mouse-function #f)
+
+  (define grab-key-function #f)
+  (define grab-mouse-function #f)
+  (define on-break #f)
+
+  (define chain-to null)
+
+  (define last-time 0)
+  (define last-x 0)
+  (define last-y 0)
+  (define click-count 0)
+  (define last-code #f)
+  (define last-button #f)
+
+  (define double-interval (get-double-click-threshold))
+
+  (def/public (reset)
+    (set! prefix #f)
+    (set! prefixed? #f)
+
+    (for-each (lambda (c)
+                (send c reset))
+              chain-to))
+
+  (def/public (break-sequence)
+    (set! prefix #f)
+
+    (when on-break
+      (let ([f on-break])
+        (set! on-break #f)
+        (f)))
+    
+    (for-each (lambda (c)
+                (send c break-sequence))
+              chain-to))
+
+  (def/public (set-break-sequence-callback [(make-procedure 0) f])
+    (let ([old on-break])
+      (set! on-break f)
+      (when old (old))))
+
+  (define/private (find-key code other-code alt-code other-alt-code caps-code
+                            shift? ctrl? alt? meta? cmd? caps?
+                            prefix)
+    (for*/fold ([best-key #f]
+                [best-score -1])
+        ([findk (in-list (list code other-code alt-code other-alt-code caps-code))]
+         [key (in-list (hash-ref keys findk null))])
+      (if (and (or (eqv? (key-code key) code)
+                   (and (key-check-other? key)
+                        (or (eqv? (key-code key) other-code)
+                            (eqv? (key-code key) alt-code)
+                            (eqv? (key-code key) other-alt-code)
+                            (eqv? (key-code key) caps-code))))
+               (or (and (key-shift-on? key) shift?)
+                   (and (key-shift-off? key) (not shift?))
+                   (and (not (key-shift-on? key)) (not (key-shift-off? key))))
+               (or (and (key-ctrl-on? key) ctrl?)
+                   (and (key-ctrl-off? key) (not ctrl?))
+                   (and (not (key-ctrl-on? key)) (not (key-ctrl-off? key))))
+               (or (and (key-alt-on? key) alt?)
+                   (and (key-alt-off? key) (not alt?))
+                   (and (not (key-alt-on? key)) (not (key-alt-off? key))))
+               (or (and (key-meta-on? key) meta?)
+                   (and (key-meta-off? key) (not meta?))
+                   (and (not (key-meta-on? key)) (not (key-meta-off? key))))
+               (or (and (key-cmd-on? key) cmd?)
+                   (and (key-cmd-off? key) (not cmd?))
+                   (and (not (key-cmd-on? key)) (not (key-cmd-off? key))))
+               (or (and (key-caps-on? key) caps?)
+                   (and (key-caps-off? key) (not caps?))
+                   (and (not (key-caps-on? key)) (not (key-caps-off? key))))
+               (eq? (key-seqprefix key) prefix))
+          (let ([score (+ (key-score key)
+                          (if (eqv? (key-code key) code)
+                              0
+                              (if (eqv? (key-code key) other-alt-code)
+                                  -4
+                                  -2)))])
+            (if (score . > . best-score)
+                (values key score)
+                (values best-key best-score)))
+          (values best-key best-score))))
+
+  (define/private (do-map-function code shift ctrl alt meta cmd caps check-other?
+                                   fname prev isprefix? fullset?)
+    ;; look for existing key mapping:
+    (let ([key
+           (ormap (lambda (key)
+                    (and (eqv? (key-code key) code)
+                         (eq? (key-shift-on? key) (shift . > . 0))
+                         (eq? (key-shift-off? key) (shift . < . 0))
+                         (eq? (key-ctrl-on? key) (ctrl . > . 0))
+                         (eq? (key-ctrl-off? key) (ctrl . < . 0))
+                         (eq? (key-alt-on? key) (alt . > . 0))
+                         (eq? (key-alt-off? key) (alt . < . 0))
+                         (eq? (key-meta-on? key) (meta . > . 0))
+                         (eq? (key-meta-off? key) (meta . < . 0))
+                         (eq? (key-cmd-on? key) (cmd . > . 0))
+                         (eq? (key-cmd-off? key) (cmd . < . 0))
+                         (eq? (key-caps-on? key) (caps . > . 0))
+                         (eq? (key-caps-off? key) (caps . < . 0))
+                         (eq? (key-check-other? key) check-other?)
+                         (eq? (key-seqprefix key) prev)
+                         key))
+                  (hash-ref keys code null))])
+
+      (if key
+          ;; Found existing
+          (if (not (eq? isprefix? (key-isprefix? key)))
+              ;; prefix vs no-prefix mismatch:
+              (let ([s
+                     (string-append
+                      (if (meta . > . 0) "m:" "")
+                      (if (meta . < . 0) "~m:" "")
+                      (if (cmd . > . 0) "d:" "")
+                      (if (cmd . < . 0) "~d:" "")
+                      (if (alt . > . 0) "a:" "")
+                      (if (alt . < . 0) "~a:" "")
+                      (if (ctrl . > . 0) "c:" "")
+                      (if (ctrl . < . 0) "~c:" "")
+                      (if (shift . > . 0) "s:" "")
+                      (if (shift . < . 0) "~s:" "")
+                      (or (hash-ref rev-keylist code)
+                          (format "~c" code)))])
+                (error (method-name 'keymap% 'map-function)
+                       "~s is already mapped as a ~aprefix key"
+                       s (if isprefix? "non-" "")))
+              (begin
+                (set-key-fname! key (string->immutable-string fname))
+                key))
+          ;; Create new
+          (let ([newkey (make-key
+                         code
+                         (shift . > . 0) (shift . < . 0)
+                         (ctrl . > . 0) (ctrl . < . 0)
+                         (alt . > . 0) (alt . < . 0)
+                         (meta . > . 0) (meta . < . 0)
+                         (cmd . > . 0) (cmd . < . 0)
+                         (caps . > . 0) (caps . < . 0)
+                         (+ (if (shift . > . 0) 1 0)
+                            (if (shift . < . 0) 5 0)
+                            (if (ctrl . > . 0) 1 0)
+                            (if (ctrl . < . 0) 5 0)
+                            (if (alt . > . 0) 1 0)
+                            (if (alt . < . 0) 5 0)
+                            (if (meta . > . 0) 1 0)
+                            (if (meta . < . 0) 5 0)
+                            (if (cmd . > . 0) 1 0)
+                            (if (cmd . < . 0) 5 0)
+                            (if (caps . > . 0) 1 0)
+                            (if (caps . < . 0) 5 0)
+                            (if check-other? 6 30))
+                         check-other?
+                         fullset?
+                         (string->immutable-string fname)
+                         isprefix?
+                         prev)])
+            (hash-set! keys code (cons newkey (hash-ref keys code null)))
+            newkey))))
+
+  (define/private (get-code str)
+    (let ([code (hash-ref keylist (string-downcase str) #f)])
+      (if code
+          (values code (member str '("leftbuttonseq"
+                                     "middlebuttonseq"
+                                     "rightbuttonseq")))
+          (if (= 1 (string-length str))
+              (values (string-ref str 0)
+                      #f)
+              (values #f #f)))))
+
+  (def/public (map-function [string? keys]
+                            [string? fname])
+    (if (string=? keys "")
+        (error (method-name 'keymap% 'map-function)
+               "bad key string: ~e"
+               keys)
+        (let loop ([seq (regexp-split #rx";" keys)]
+                   [prev-key #f])
+          (let ([str (car seq)])
+            (define (bad-string msg)
+              (error (method-name 'keymap% 'map-function)
+                     "bad keymap string: ~e~a: ~a"
+                     str
+                     (if (equal? str keys)
+                         ""
+                         (format " within ~e" keys))
+                     msg))
+            (let-values ([(str default-off?)
+                          (if (regexp-match? #rx"^:" str)
+                              (values (substring str 1) #t)
+                              (values str #f))])
+              (let sloop ([str str]
+                          [downs null]
+                          [ups null]
+                          [others? #f])
+                (cond
+                 [(regexp-match? #rx"^[?]:" str)
+                  (sloop (substring str 2) downs ups #t)]
+                 [(regexp-match? #rx"^~[SsCcAaMmDdLl]:" str)
+                  (let ([c (char-downcase (string-ref str 1))])
+                    (if (memv c downs)
+                        (bad-string (format "inconsistent ~a: modifier state" c))
+                        (sloop (substring str 3) downs (cons c ups) others?)))]
+                 [(regexp-match? #rx"^[SsCcAaMmDdLl]:" str)
+                  (let ([c (char-downcase (string-ref str 0))])
+                    (if (memv c ups)
+                        (bad-string (format "inconsistent ~a: modifier state" c))
+                        (sloop (substring str 2) (cons c downs) ups others?)))]
+                 [else
+                  (let-values ([(code fullset?) (get-code str)])
+                    (if (not code)
+                        (bad-string "unrecognized key name")
+                        (let-values ([(downs code)
+                                      (if (and (char? code)
+                                               ((char->integer code) . > . 0)
+                                               ((char->integer code) . < . 127)
+                                               (char-alphabetic? code))
+                                          (cond
+                                           [(memq #\s downs)
+                                            (if (or (and (eq? (system-type) 'macosx)
+                                                         (not (memq #\m downs))
+                                                         (not (memq #\d downs)))
+                                                    (and (eq? (system-type) 'windows)
+                                                         (or (not (memq #\c downs))
+                                                             (memq #\m downs))))
+                                                (values downs (char-upcase code))
+                                                (values downs code))]
+                                           [(char-upper-case? code)
+                                            (values (cons #\s downs) code)]
+                                           [else
+                                            (values downs code)])
+                                          (values downs code))])
+                          (let ([newkey
+                                 (let ([modval (lambda (c)
+                                                 (cond
+                                                  [(memq c downs) 1]
+                                                  [(memq c ups) -1]
+                                                  [else (if default-off? -1 0)]))])
+                                   (do-map-function code
+                                                    (modval #\s)
+                                                    (modval #\c)
+                                                    (modval #\a)
+                                                    (modval #\m)
+                                                    (modval #\d)
+                                                    (modval #\l)
+                                                    others?
+                                                    fname
+                                                    prev-key
+                                                    (not (null? (cdr seq)))
+                                                    fullset?))])
+                            (if (null? (cdr seq))
+                                (void)
+                                (loop (cdr seq) newkey))))))])))))))
+
+  (define/private (handle-event code other-code alt-code other-alt-code caps-code
+                                shift? ctrl? alt? meta? cmd? caps?
+                                score)
+    (let-values ([(key found-score)
+                  (find-key code other-code alt-code other-alt-code caps-code
+                            shift? ctrl? alt? meta? cmd? caps? prefix)])
+      (set! prefix #f)
+
+      (if (and key (found-score . >= . score))
+          (if (key-isprefix? key)
+              (begin
+                (set! prefix key)
+                (values #t #f #f))
+              (values #t
+                      (key-fname key)
+                      (key-fullset? key)))
+          (values #f #f #f))))
+
+  (define/public (get-best-score code other-code alt-code other-alt-code caps-code
+                                 shift? ctrl? alt? meta? cmd? caps?)
+    (let-values ([(key score)
+                  (find-key code other-code alt-code other-alt-code caps-code
+                            shift? ctrl? alt? meta? cmd? caps? prefix)])
+      (for/fold ([s (if key score -1)])
+          ([c (in-list chain-to)])
+        (max s
+             (send c get-best-score code other-code alt-code other-alt-code caps-code
+                   shift? ctrl? alt? meta? cmd? caps?)))))
+
+  (def/public (set-grab-key-function [(make-procedure 4) grab])
+    (set! grab-key-function grab))
+  
+  (def/public (remove-grab-key-function)
+    (set! grab-key-function #f))
+
+  (def/public (handle-key-event [any? obj] [key-event% event])
+    (let ([code (send event get-key-code)])
+      (or (eq? code 'shift)
+          (eq? code 'control)
+          (eq? code 'release)
+          (let ([score (get-best-score 
+                        code
+                        (send event get-other-shift-key-code)
+                        (send event get-other-altgr-key-code)
+                        (send event get-other-shift-altgr-key-code)
+                        (send event get-other-caps-key-code)
+                        (send event get-shift-down)
+                        (send event get-control-down)
+                        (send event get-alt-down)
+                        (as-meta-key (send event get-meta-down))
+                        (as-cmd-key (send event get-meta-down))
+                        (send event get-caps-down))])
+            (let ([was-prefixed? prefixed?])
+              
+              (let* ([r (chain-handle-key-event obj event #f prefixed? score)]
+                     [r (if (and (zero? r)
+                                 was-prefixed?)
+                            (begin
+                              (reset)
+                              ;; try again without prefix:
+                              (chain-handle-key-event obj event #f #f score))
+                            r)])
+                (when (r . >= . 0)
+                  (reset))
+                (not (zero? r))))))))
+
+  (define/private (other-handle-key-event obj event grab try-prefixed? score)
+    (for/fold ([r 0])
+        ([c (in-list chain-to)]
+         #:when (r . <= . 0))
+      (let ([r (send c chain-handle-key-event obj event grab try-prefixed? score)])
+        (if (r . > . 0)
+            (begin
+              (reset)
+              r)
+            r))))
+
+  (define/public (chain-handle-key-event obj event grab only-prefixed? score)
+    ;; results: 0 = no match, 1 = match, -1 = matched prefix
+    (set! last-time (send event get-time-stamp))
+    (set! last-button #f)
+    (let ([grab (or grab-key-function
+                    grab)])
+      (if (and only-prefixed? (not prefixed?))
+          0
+          (let ([sub-result (other-handle-key-event obj event grab only-prefixed? score)])
+            (if (sub-result . > . 0)
+                sub-result
+                (let-values ([(h? fname fullset?)
+                              (handle-event (send event get-key-code)
+                                            (send event get-other-shift-key-code)
+                                            (send event get-other-altgr-key-code)
+                                            (send event get-other-shift-altgr-key-code)
+                                            (send event get-other-caps-key-code)
+                                            (send event get-shift-down)
+                                            (send event get-control-down)
+                                            (send event get-alt-down)
+                                            (as-meta-key (send event get-meta-down))
+                                            (as-cmd-key (send event get-meta-down))
+                                            (send event get-caps-down)
+                                            score)])
+                  (if h?
+                      (if fname
+                          (begin
+                            (reset)
+                            (if (and grab
+                                     (grab fname this obj event))
+                                1
+                                (if (call-function fname obj event)
+                                    1
+                                    0)))
+                          (if prefix
+                              (begin
+                                (set! prefixed? #t)
+                                -1)
+                              ;; shouldn't get here
+                              0))
+                      (let ([result
+                             (if (sub-result . < . 0)
+                                 (begin
+                                   (set! prefixed? #t)
+                                   -1)
+                                 0)])
+                        (if (and (zero? result)
+                                 grab-key-function
+                                 (grab-key-function #f this obj event))
+                            1
+                            result)))))))))
+
+  (def/public (set-grab-mouse-function [(make-procedure 4) grab])
+    (set! grab-mouse-function grab))
+
+  (def/public (remove-grab-mouse-function)
+    (set! grab-mouse-function #f))
+
+  (define/private (adjust-button-code code click-count)
+    (case click-count
+      [(0) code]
+      [(1) (case code
+             [(mouse-right) 'mouse-right-double]
+             [(mouse-left) 'mouse-left-double]
+             [(mouse-middle) 'mouse-middle-double])]
+      [else (case code
+              [(mouse-right) 'mouse-right-triple]
+              [(mouse-left) 'mouse-left-triple]
+              [(mouse-middle) 'mouse-middle-triple])]))
+
+  (def/public (handle-mouse-event [any? obj][mouse-event% event])
+    (let ([score (get-best-mouse-score event)])
+      (not (zero? (chain-handle-mouse-event obj event #f 0 score)))))
+
+  (define/public (get-best-mouse-score event)
+    (cond
+     [(not (send event button-down?))
+      (if active-mouse-function
+          100
+          (or (ormap (lambda (c)
+                       (and (not (zero? (send c get-best-mouse-score event)))
+                            100))
+                     chain-to)
+              -1))]
+     [else
+      (let ([code (cond
+                   [(send event get-right-down) 'mouse-right]
+                   [(send event get-left-down) 'mouse-left]
+                   [(send event get-middle-down) 'mouse-middle]
+                   [else #f])])
+        (if (not code)
+            -1
+            (let ([code
+                   (if (and (eq? code last-button)
+                            (= (send event get-x) last-x)
+                            (= (send event get-y) last-y)
+                            ((abs (- (send event get-time-stamp) last-time)) . < . double-interval))
+                       (adjust-button-code code click-count)
+                       code)])
+              (get-best-score code #f #f #f #f
+                              (send event get-shift-down)
+                              (send event get-control-down)
+                              (send event get-alt-down)
+                              (as-meta-key (send event get-meta-down))
+                              (as-cmd-key (send event get-meta-down))
+                              (send event get-caps-down)))))]))
+
+  (define/private (other-handle-mouse-event obj event grab try-state score)
+    (for/fold ([result 0])
+        ([c (in-list chain-to)]
+         #:when (result . <= . 0))
+      (let ([r (send c chain-handle-mouse-event obj event grab try-state score)])
+        (cond
+         [(r . > . 0)
+          (reset)
+          r]
+         [(zero? r) result]
+         [else r]))))
+
+  (define/public (chain-handle-mouse-event obj event grab try-state score)
+    (let ([grab (or grab-mouse-function grab)])
+      (define (step1)
+        (cond
+         [(and (not prefix)
+               (try-state . >= . 0))
+          (let ([r (other-handle-mouse-event obj event grab 1 score)])
+            (cond
+             [(r . > . 0) r]
+             [(try-state . > . 0) r]
+             [else (step2 -1)]))]
+         [(and prefix (try-state . < . 0))
+          (other-handle-mouse-event obj event grab -1 score)]
+         [else (step2 try-state)]))
+      (define (step2 try-state)
+        (cond
+         [(not (send event button-down?))
+          (when (and (not (send event dragging?))
+                     (not (send event button-up?)))
+            ;; we must have missed the button-up
+            (set! active-mouse-function #f))
+          (if (not active-mouse-function)
+              (other-handle-mouse-event obj event grab -1 score)
+              (let ([v (if (and grab 
+                                (grab active-mouse-function this obj event))
+                           1
+                           (if (call-function active-mouse-function obj event)
+                               1
+                               0))])
+                (when (send event button-up?)
+                  (set! active-mouse-function #f))
+                v))]
+         [else
+          (let ([code (cond
+                       [(send event get-right-down) 'mouse-right]
+                       [(send event get-left-down) 'mouse-left]
+                       [(send event get-middle-down) 'mouse-middle]
+                       [else #f])])
+            (if (not code)
+                0 ;; FIXME: should we call grab here?
+                (let ([orig-code code]
+                      [code
+                       (if (and (eq? code last-button)
+                                (= (send event get-x) last-x)
+                                (= (send event get-y) last-y))
+                           (if ((abs (- (send event get-time-stamp) last-time)) . < . double-interval)
+                               (begin0
+                                (adjust-button-code code click-count)
+                                (set! click-count (add1 click-count)))
+                               (begin
+                                 (set! click-count 1)
+                                 code))
+                           (begin
+                             (set! last-button code)
+                             (set! click-count 1)
+                             code))])
+                  (set! last-time (send event get-time-stamp))
+                  (set! last-x (send event get-x))
+                  (set! last-y (send event get-y))
+
+                  (let loop ([code code])
+                    (let-values ([(h? fname fullset?) (handle-event code
+                                                                    #f #f #f #f
+                                                                    (send event get-shift-down)
+                                                                    (send event get-control-down)
+                                                                    (send event get-alt-down)
+                                                                    (as-meta-key (send event get-meta-down))
+                                                                    (as-cmd-key (send event get-meta-down))
+                                                                    (send event get-caps-down)
+                                                                    score)])
+                      (cond
+                       [(and h? fname)
+                        (reset)
+                        (when fullset?
+                          (set! active-mouse-function fname))
+                        (cond
+                         [(and grab (grab fname this obj event)) 1]
+                         [(call-function fname obj event) 1]
+                         [else 0])]
+                       [h?
+                        (let ([r (other-handle-mouse-event obj event grab try-state score)])
+                          (if (r . > . 0)
+                              r
+                              -1))]
+                       [else
+                        (set! last-code code)
+                        (if (not (eqv? last-code orig-code))
+                            (loop orig-code)
+                            (let ([result (other-handle-mouse-event obj event grab try-state score)])
+                              (if (and (zero? result)
+                                       grab-mouse-function
+                                       (grab-mouse-function #f this obj event))
+                                  1
+                                  result)))]))))))]))
+      (step1)))
+
+  (def/public (add-function [string? name] [(make-procedure 2) f])
+    (hash-set! functions
+               (string->immutable-string name)
+               f))
+
+  (def/public (call-function [string? name] [any? obj] [event% event] [any? [try-chained? #f]])
+    (let ([f (hash-ref functions name #f)])
+      (cond
+       [f 
+        (f obj event)
+        #t]
+       [try-chained?
+        (ormap (lambda (c)
+                 (send c call-function name obj event #t))
+               chain-to)]
+       [else
+        (error 'keymap "no function ~e" name)])))
+
+  (def/public (get-double-click-interval)
+    double-interval)
+
+  (def/public (set-double-click-interval [exact-positive-integer? d])
+    (set! double-interval d))
+
+  (define/public (cycle-check km)
+    (ormap (lambda (c)
+             (or (eq? km c)
+                 (send c cycle-check km)))
+           chain-to))
+
+  (def/public (chain-to-keymap [keymap% km] [any? prefix?])
+    (unless (or (eq? km this)
+                (cycle-check km)
+                (send km cycle-check this))
+      (set! chain-to (if prefix?
+                         (cons km chain-to)
+                         (append chain-to (list km))))))
+
+  (def/public (remove-chained-keymap [keymap% km])
+    (set! chain-to (remq km chain-to))))
diff --git a/collects/mred/private/wxme/mline.ss b/collects/mred/private/wxme/mline.ss
new file mode 100644
index 00000000..1af464b9
--- /dev/null
+++ b/collects/mred/private/wxme/mline.ss
@@ -0,0 +1,1192 @@
+#lang scheme/base
+(require scheme/class
+         "../syntax.ss"
+         "const.ss"
+         "snip.ss"
+         "snip-flags.ss"
+         "private.ss")
+
+(provide create-mline
+         (struct-out mline)
+         (struct-out paragraph)
+         mline-next
+         mline-prev
+         (prefix-out
+          mline-
+          (for-meta
+           0
+           NIL
+           clone-paragraph
+           get-line-max-width
+           adjust-offsets
+           deadjust-offsets
+           move-parent!
+           rotate-left
+           rotate-right
+           insert
+           delete
+           find-line
+           find-position
+           find-scroll
+           find-location
+           find-paragraph
+           get-line
+           get-position
+           get-scroll
+           get-location
+           get-paragraph
+           get-paragraph-style
+           set-length
+           set-scroll-length
+           set-height
+           calc-line-length
+           set-starts-paragraph
+           starts-paragraph
+           adjust-max-width
+           set-width
+           scroll-offset
+           find-extra-scroll
+           mark-recalculate
+           adjust-need-calc
+           mark-check-flow
+           adjust-need-flow
+           update-flow
+           update-graphics
+           get-root
+           check-consistent
+           first
+           last
+           get-left-location
+           get-right-location
+           number)))
+
+(define RED #x1)
+(define BLACK #x2)
+(define MAX-W-HERE #x4)
+(define MAX-W-LEFT #x8)
+(define MAX-W-RIGHT #x10)
+(define CALC-HERE #x20)
+(define CALC-LEFT #x40)
+(define CALC-RIGHT #x80)
+(define FLOW-HERE #x100)
+(define FLOW-LEFT #x200)
+(define FLOW-RIGHT #x400)
+(define STARTS-PARA #x800)
+
+(define MAX-W-MASK (bitwise-ior MAX-W-HERE MAX-W-LEFT MAX-W-RIGHT))
+(define COLOR-MASK (bitwise-ior RED BLACK))
+(define CALC-MASK (bitwise-ior CALC-HERE CALC-LEFT CALC-RIGHT))
+(define FLOW-MASK (bitwise-ior FLOW-HERE FLOW-LEFT FLOW-RIGHT))
+
+(define-struct mline (prev next parent left right
+
+                           flags paragraph
+                           
+                           ;; relative values:
+                           line pos scroll parno y
+                           
+                           max-width
+
+                           snip last-snip scroll-snip
+                           
+                           len numscrolls
+                           last-h last-w ;; height/width of last snip in line
+                           h w ;; height/width of line
+                           bottombase topbase ;; bottom baseline, top baseline (relative)
+                           )
+  #:mutable #:transparent)
+
+(define NIL #f)
+
+(define (create-mline)
+  (make-mline #f #f NIL NIL NIL
+              (bitwise-ior BLACK MAX-W-HERE CALC-HERE) #f
+              0 0 0 0 0.0
+              0.0
+              #f #f #f
+              0 1
+              0.0 0.0
+              0.0 0.0
+              0.0 0.0))
+
+(set! NIL (create-mline))
+(set-mline-parent! NIL NIL)
+(set-mline-left! NIL NIL)
+(set-mline-right! NIL NIL)
+
+(define (mline-destroy! m)
+  ;; Doesn't need to to anything, but this may be helpful for debugging
+  (begin
+    (set-mline-prev! m 'BAD)
+    (set-mline-parent! m 'BAD)
+    (set-mline-left! m 'BAD)
+    (set-mline-right! m 'BAD)
+    (set-mline-flags! m 'BAD)
+    (set-mline-paragraph! m 'BAD)
+    (set-mline-line! m 'BAD)
+    (set-mline-pos! m 'BAD)
+    (set-mline-scroll! m 'BAD)
+    (set-mline-parno! m 'BAD)
+    (set-mline-y! m 'BAD)
+    (set-mline-max-width! m 'BAD)
+    (set-mline-snip! m 'BAD)
+    (set-mline-last-snip! m 'BAD)
+    (set-mline-scroll-snip! m 'BAD)
+    (set-mline-len! m 'BAD)
+    (set-mline-numscrolls! m 'BAD)
+    (set-mline-last-h! m 'BAD)
+    (set-mline-last-w! m 'BAD)
+    (set-mline-h! m 'BAD)
+    (set-mline-w! m 'BAD)
+    (set-mline-bottombase! m 'BAD)
+    (set-mline-topbase! m 'BAD))
+  (void))
+
+(define (set-red! mline)
+  (set-mline-flags! mline (bitwise-ior RED (bitwise-and (mline-flags mline) 
+                                                        (bitwise-not COLOR-MASK)))))
+(define (set-black! mline)
+  (set-mline-flags! mline (bitwise-ior BLACK (bitwise-and (mline-flags mline) 
+                                                          (bitwise-not COLOR-MASK)))))
+
+(define (bit-overlap? a b)
+  (not (zero? (bitwise-and a b))))
+
+(define (red? mline)
+  (bit-overlap? (mline-flags mline) RED))
+(define (black? mline)
+  (bit-overlap? (mline-flags mline) BLACK))
+
+(define (starts-paragraph mline)
+  (if (bit-overlap? STARTS-PARA (mline-flags mline))
+      1
+      0))
+
+;; ----------------------------------------
+
+(define-struct paragraph (left-margin-first
+                          left-margin
+                          right-margin
+                          alignment)
+  #:mutable)
+
+(define plain-paragraph (make-paragraph 0.0 0.0 0.0 'left))
+
+(define (clone-paragraph p)
+  (make-paragraph (paragraph-left-margin-first p)
+                  (paragraph-left-margin p)
+                  (paragraph-right-margin p)
+                  (paragraph-alignment p)))
+
+(define (get-line-max-width p max-width first?)
+  (if (max-width . <= . 0)
+      max-width
+      (max 1
+           (- max-width
+              (if first?
+                  (paragraph-left-margin-first p)
+                  (paragraph-left-margin p))
+              (paragraph-right-margin p)))))
+
+;; ----------------------------------------
+
+(define (adjust-offsets mline newchild)
+  (unless (eq? newchild NIL)
+    ;; Adjust relative values:
+    (set-mline-line! newchild (- (mline-line newchild) (+ (mline-line mline) 1)))
+    (set-mline-pos! newchild (- (mline-pos newchild) (+ (mline-pos mline) (mline-len mline))))
+    (set-mline-scroll! newchild (- (mline-scroll newchild) (+ (mline-scroll mline) (mline-numscrolls mline))))
+    (set-mline-y! newchild (- (mline-y newchild) (+ (mline-y mline) (mline-h mline))))
+    (set-mline-parno! newchild (- (mline-parno newchild) (+ (mline-parno mline) (starts-paragraph mline))))))
+
+(define (deadjust-offsets mline oldchild)
+  (unless (eq? oldchild NIL)
+    ;; Adjust relative values:
+    (set-mline-line! oldchild (+ (mline-line oldchild) (+ (mline-line mline) 1)))
+    (set-mline-pos! oldchild (+ (mline-pos oldchild) (+ (mline-pos mline) (mline-len mline))))
+    (set-mline-scroll! oldchild (+ (mline-scroll oldchild) (+ (mline-scroll mline) (mline-numscrolls mline))))
+    (set-mline-y! oldchild (+ (mline-y oldchild) (+ (mline-y mline) (mline-h mline))))
+    (set-mline-parno! oldchild (+ (mline-parno oldchild) (+ (mline-parno mline) (starts-paragraph mline))))))
+
+(define (move-parent! v x root-box)
+  ;; replace v with x
+  (let ([parent (mline-parent v)])
+    (set-mline-parent! x parent) ; x can be NIL!
+    (cond
+     [(eq? parent NIL)
+      (set-box! root-box x)]
+     [(eq? v (mline-left parent))
+      (set-mline-left! parent x)]
+     [else
+      (set-mline-right! parent x)])))
+
+(define (rotate-left mline root-box)
+  (let ([oldright (mline-right mline)])
+    (deadjust-offsets mline oldright)
+  
+    (let ([right (mline-left oldright)])
+      (set-mline-right! mline right)
+      (unless (eq? right NIL)
+        (set-mline-parent! right mline)))
+    
+    (move-parent! mline oldright root-box)
+
+    (set-mline-left! oldright mline)
+    (set-mline-parent! mline oldright)
+
+    (adjust-max-width mline)
+    (adjust-need-calc mline)
+    (adjust-need-flow mline)
+    (adjust-max-width oldright)
+    (adjust-need-calc oldright)
+    (adjust-need-flow oldright)))
+
+(define (rotate-right mline root-box)
+  (let ([oldleft (mline-left mline)])
+    (adjust-offsets oldleft mline)
+  
+    (let ([left (mline-right oldleft)])
+      (set-mline-left! mline left)
+      (unless (eq? left NIL)
+        (set-mline-parent! left mline)))
+    
+    (move-parent! mline oldleft root-box)
+
+    (set-mline-right! oldleft mline)
+    (set-mline-parent! mline oldleft)
+
+    (adjust-max-width mline)
+    (adjust-need-calc mline)
+    (adjust-need-flow mline)
+    (adjust-max-width oldleft)
+    (adjust-need-calc oldleft)
+    (adjust-need-flow oldleft)))
+
+(define (insert mline root-box before?)
+  (let ([newline (create-mline)])
+    (if (eq? (unbox root-box) NIL)
+        (begin
+          (set-box! root-box newline)
+          newline)
+        (begin
+          (set-red! newline)
+
+          (if before?
+              (let ([prev (mline-prev mline)])
+                (set-mline-prev! newline prev)
+                (when prev
+                  (set-mline-next! prev newline))
+                (set-mline-next! newline mline)
+                (set-mline-prev! mline newline))
+              (let ([next (mline-next mline)])
+                (set-mline-prev! newline mline)
+                (set-mline-next! newline next)
+                (when next
+                  (set-mline-prev! next newline))
+                (set-mline-next! mline newline)))
+
+          (let ([node
+                 (if before?
+                     (let ([left (mline-left mline)])
+                       (if (eq? left NIL)
+                           (begin
+                             (set-mline-left! mline newline)
+                             mline)
+                           (let loop ([node left])
+                             (let ([right (mline-right node)])
+                               (if (not (eq? right NIL))
+                                   (loop right)
+                                   (begin
+                                     (set-mline-right! node newline)
+                                     node))))))
+                     (let ([right (mline-right mline)])
+                       (if (eq? right NIL)
+                           (begin
+                             (set-mline-right! mline newline)
+                             mline)
+                           (let loop ([node right])
+                             (let ([left (mline-left node)])
+                               (if (not (eq? left NIL))
+                                   (loop left)
+                                   (begin
+                                     (set-mline-left! node newline)
+                                     node)))))))])
+            (set-mline-parent! newline node)
+            (adjust-need-calc node #t))
+
+          (let loop ([node newline])
+            (let ([parent (mline-parent node)])
+              (unless (eq? parent NIL)
+                (when (eq? node (mline-left parent))
+                  (deadjust-offsets newline parent))
+                (loop parent))))
+
+          (let loop ([node newline])
+            (when (and (not (eq? node (unbox root-box)))
+                       (red? (mline-parent node)))
+              (let ([parent (mline-parent node)])
+                (if (eq? parent (mline-left (mline-parent parent)))
+                    (let ([v (mline-right (mline-parent parent))])
+                      (if (red? v)
+                          (begin
+                            (set-black! parent)
+                            (set-black! v)
+                            (let ([node (mline-parent parent)])
+                              (set-red! node)
+                              (loop node)))
+                          (let* ([node (if (eq? node (mline-right parent))
+                                           (begin
+                                             (rotate-left parent root-box)
+                                             parent)
+                                           node)]
+                                 [parent (mline-parent node)])
+                            (set-black! parent)
+                            (let ([node (mline-parent parent)])
+                              (set-red! node)
+                              (rotate-right node root-box)
+                              (loop node)))))
+                    (let ([v (mline-left (mline-parent parent))])
+                      (if (red? v)
+                          (begin
+                            (set-black! parent)
+                            (set-black! v)
+                            (let ([node (mline-parent parent)])
+                              (set-red! node)
+                              (loop node)))
+                          (let* ([node (if (eq? node (mline-left parent))
+                                           (begin
+                                             (rotate-right parent root-box)
+                                             parent)
+                                           node)]
+                                 [parent (mline-parent node)])
+                            (set-black! parent)
+                            (let ([node (mline-parent parent)])
+                              (set-red! node)
+                              (rotate-left node root-box)
+                              (loop node)))))))))
+
+          (set-black! (unbox root-box))
+
+          newline))))
+
+(define (delete mline root-box)
+
+  ;; adjust ancestor offsets
+  (let ([len (mline-len mline)]
+        [numscrolls (mline-numscrolls mline)]
+        [h (mline-h mline)])
+    (let loop ([v mline])
+      (let ([parent (mline-parent v)])
+        (unless (eq? parent NIL)
+          (if (eq? v (mline-right parent))
+              (loop parent)
+              (let ([v parent])
+                (set-mline-line! v (- (mline-line v) 1))
+                (set-mline-pos! v (- (mline-pos v) len))
+                (set-mline-scroll! v (- (mline-scroll v) numscrolls))
+                (set-mline-y! v (- (mline-y v) h))
+                (set-mline-parno! v (- (mline-parno v) (starts-paragraph mline)))
+                (loop v)))))))
+
+  (let ([v (if (or (eq? (mline-left mline) NIL)
+                   (eq? (mline-right mline) NIL))
+               mline
+               (let ([v (mline-next mline)])
+                 (let loop ([x v])
+                   (unless (eq? mline (mline-parent x))
+                     (let ([parent (mline-parent x)])
+                       (if (eq? x (mline-right parent))
+                           (loop parent)
+                           (let ([x parent])
+                             (set-mline-line! x (- (mline-line x) 1))
+                             (set-mline-pos! x (- (mline-pos x) (mline-len v)))
+                             (set-mline-scroll! x (- (mline-scroll x) (mline-numscrolls v)))
+                             (set-mline-y! x (- (mline-y x) (mline-h v)))
+                             (set-mline-parno! x (- (mline-parno x) (starts-paragraph v)))
+                             (loop x))))))
+                 v))])
+
+    (let ([x (if (eq? (mline-left v) NIL)
+                 (mline-right v)
+                 (mline-left v))])
+      (move-parent! v x root-box)
+
+      (let ([was-black? (black? v)])
+        
+        (if (not (eq? v mline))
+            (let ([oldparent (mline-parent v)])
+              (if (black? mline)
+                  (set-black! v)
+                  (set-red! v))
+              
+              (let ([left (mline-left mline)])
+                (set-mline-left! v left)
+                (unless (eq? left NIL)
+                  (set-mline-parent! left v)))
+              (let ([right (mline-right mline)])
+                (set-mline-right! v right)
+                (unless (eq? right NIL)
+                  (set-mline-parent! right v)))
+              (move-parent! mline v root-box)
+              (let ([prev (mline-prev mline)])
+                (set-mline-prev! v prev)
+                (when prev
+                  (set-mline-next! prev v)))
+
+              (set-mline-line! v (mline-line mline))
+              (set-mline-pos! v (mline-pos mline))
+              (set-mline-scroll! v (mline-scroll mline))
+              (set-mline-y! v (mline-y mline))
+              (set-mline-parno! v (mline-parno mline))
+
+              (adjust-max-width oldparent #t)
+              (adjust-need-calc oldparent #t)
+              (adjust-need-flow oldparent #t)
+              
+              (adjust-max-width v #t)
+              (adjust-need-calc v #t)
+              (adjust-need-flow v #t)
+
+              (when (eq? (mline-parent x) mline)
+                (set-mline-parent! x v)))
+            (begin
+              (let ([prev (mline-prev mline)]
+                    [next (mline-next mline)])
+                (when prev
+                  (set-mline-next! prev next))
+                (when next
+                  (set-mline-prev! next prev)))))
+
+        (when was-black?
+          ;; fixup 
+          (let loop ([x x])
+            (if (and (not (eq? x (unbox root-box)))
+                     (black? x))
+                (let ([parent (mline-parent x)])
+                  (if (eq? x (mline-left parent))
+                      (let* ([z (mline-right parent)]
+                             [z (if (red? z)
+                                    (begin
+                                      (set-black! z)
+                                      (set-red! parent)
+                                      (rotate-left parent root-box)
+                                      (mline-right (mline-parent x)))
+                                    z)]
+                             [x (if (and (black? (mline-left z))
+                                         (black? (mline-right z)))
+                                    (begin
+                                      (set-red! z)
+                                      (mline-parent x))
+                                    (let ([z (if (black? (mline-right z))
+                                                 (begin
+                                                   (set-black! (mline-left z))
+                                                   (set-red! z)
+                                                   (rotate-right z root-box)
+                                                   (mline-right (mline-parent x)))
+                                                 z)])
+                                      (if (red? (mline-parent x))
+                                          (set-red! z)
+                                          (set-black! z))
+                                      (set-black! (mline-parent x))
+                                      (set-black! (mline-right z))
+                                      (rotate-left (mline-parent x) root-box)
+                                      (unbox root-box)))])
+                        (loop x))
+                      (let* ([z (mline-left parent)]
+                             [z (if (red? z)
+                                    (begin
+                                      (set-black! z)
+                                      (set-red! parent)
+                                      (rotate-right parent root-box)
+                                      (mline-left (mline-parent x)))
+                                    z)]
+                             [x (if (and (black? (mline-right z))
+                                         (black? (mline-left z)))
+                                    (begin
+                                      (set-red! z)
+                                      (mline-parent x))
+                                    (let ([z (if (black? (mline-left z))
+                                                 (begin
+                                                   (set-black! (mline-right z))
+                                                   (set-red! z)
+                                                   (rotate-left z root-box)
+                                                   (mline-left (mline-parent x)))
+                                                 z)])
+                                      (if (red? (mline-parent x))
+                                          (set-red! z)
+                                          (set-black! z))
+                                      (set-black! (mline-parent x))
+                                      (set-black! (mline-left z))
+                                      (rotate-right (mline-parent x) root-box)
+                                      (unbox root-box)))])
+                        (loop x))))
+                (set-black! x)))))))
+
+  ;; In case we set the parent of NIL:
+  (set-mline-parent! NIL NIL)
+
+  (mline-destroy! mline))
+
+;; ----------------------------------------
+
+(define (search mline v v-sel size-sel)
+  (let loop ([v v][node mline][prev #f])
+    (if (not (eq? node NIL))
+        (let ([v2 (v-sel node)]
+              [size (size-sel node)])
+          (cond
+           [(v . < . v2)
+            (loop v (mline-left node) node)]
+           [(v . >= . (+ v2 size))
+            (loop (- v (+ v2 size))
+                  (mline-right node) node)]
+           [else node]))
+        prev)))
+
+ (define (find-line mline line)
+  (search mline line mline-line (lambda (mline) 1)))
+
+(define (find-position mline pos)
+  (search mline pos mline-pos mline-len))
+
+(define (find-scroll mline scroll)
+  (search mline scroll mline-scroll mline-numscrolls))
+
+(define (find-location mline y)
+  (search mline y mline-y mline-h))
+
+(define (find-paragraph mline parno)
+  (search mline parno mline-parno starts-paragraph))
+
+;; ----------------------------------------
+
+(define (sum mline v-sel size-sel)
+  (let loop ([node mline][v (v-sel mline)])
+    (let ([parent (mline-parent node)])
+      (if (not (eq? parent NIL))
+          (if (eq? node (mline-left parent))
+              (loop parent v)
+              (loop parent (+ v (v-sel parent) (size-sel parent))))
+          v))))
+
+(define (get-line mline)
+  (sum mline mline-line (lambda (mline) 1)))
+
+(define (get-position mline)
+  (sum mline mline-pos mline-len))
+
+(define (get-scroll mline)
+  (sum mline mline-scroll mline-numscrolls))
+
+(define (get-location mline)
+  (sum mline mline-y mline-h))
+
+(define (get-paragraph mline)
+  (+ (sum mline mline-parno starts-paragraph)
+     (sub1 (starts-paragraph mline))))
+
+(define (get-paragraph-style mline [first-box #f])
+  (if (bit-overlap? (mline-flags mline) STARTS-PARA)
+      (begin
+        (when first-box (set-box! first-box #t))
+        (mline-paragraph mline))
+      (begin
+        (when first-box (set-box! first-box #f))
+        (let ([root (get-root mline)]
+              [p (get-paragraph mline)])
+          (let ([pstart (find-paragraph root p)])
+            (mline-paragraph pstart))))))
+
+;; ----------------------------------------
+
+(define (adjust mline new-val val-sel val-mut! sel mut!)
+  (let ([delta (- new-val (val-sel mline))])
+    (val-mut! mline new-val)
+    (let loop ([node mline])
+      (let ([parent (mline-parent node)])
+        (unless (eq? parent NIL)
+          (if (eq? node (mline-left parent))
+              (begin
+                (mut! parent (+ delta (sel parent)))
+                (loop parent))
+              (loop parent)))))))
+
+(define (set-length mline len)
+  (adjust mline
+          len mline-len set-mline-len! 
+          mline-pos set-mline-pos!))
+
+(define (set-scroll-length mline numscrolls)
+  (adjust mline
+          numscrolls mline-numscrolls set-mline-numscrolls!
+          mline-scroll set-mline-scroll!))
+
+(define (set-height mline h)
+  (adjust mline
+          h mline-h set-mline-h!
+          mline-y set-mline-y!))
+
+(define (calc-line-length mline)
+  (let ([l
+         (let ([nexts (snip->next (mline-last-snip mline))])
+           (let loop ([asnip (mline-snip mline)][l 0])
+             (if (eq? asnip nexts)
+                 l
+                 (let ([l (+ l (snip->count asnip))])
+                   (when (has-flag? (snip->count asnip) WIDTH-DEPENDS-ON-X)
+                     (send asnip size-cache-invalid))
+                   (loop (snip->next asnip) l)))))])
+
+    (when (not (= l (mline-len mline)))
+      (set-length mline l)))
+
+  (let ([next (mline-next mline)])
+    (cond
+     [(and next
+           (has-flag? (snip->flags (mline-last-snip mline))
+                      HARD-NEWLINE))
+      (when (zero? (starts-paragraph next))
+        (set-starts-paragraph next #t))]
+     [next
+      (when (starts-paragraph next)
+        (set-starts-paragraph next #f))]))
+  
+  (let ([prev (mline-prev mline)])
+    (cond
+     [(or (not prev)
+          (has-flag? (snip->flags (mline-last-snip prev))
+                     HARD-NEWLINE))
+      (when (zero? (starts-paragraph mline))
+        (set-starts-paragraph mline #t))]
+     [(positive? (starts-paragraph mline))
+      (set-starts-paragraph mline #f)])))
+
+(define (set-starts-paragraph mline starts?)
+  (unless (= (if starts? 1 0) (starts-paragraph mline))
+    (if starts?
+        (begin
+          (set-mline-flags! mline
+                            (bitwise-ior (mline-flags mline) STARTS-PARA))
+          (unless (mline-paragraph mline)
+            (set-mline-paragraph! mline plain-paragraph)))
+        (begin
+          (set-mline-flags! mline (- (mline-flags mline) STARTS-PARA))
+          (set-mline-paragraph! mline #f)))
+
+    (let loop ([node mline])
+      (let ([parent (mline-parent node)])
+        (unless (eq? parent NIL)
+          (when (eq? node (mline-left parent))
+            (set-mline-parno! parent (+ (mline-parno parent)
+                                        (if starts? 1 -1))))
+          (loop parent))))))
+
+;; ------------------------------------------------------------
+
+(define (adjust-max-width mline [recur? #f])
+  (when (not (eq? mline NIL))
+    (let loop ([node mline])
+      (let ([old (bitwise-and (mline-flags node) MAX-W-MASK)])
+        (let ([which
+               (cond
+                [(and (not (eq? (mline-right node) NIL))
+                      ((mline-max-width (mline-right node)) . > . (mline-w node))
+                      (or (eq? (mline-left node) NIL)
+                          ((mline-max-width (mline-right node)) . > . (mline-max-width (mline-left node)))))
+                 (set-mline-max-width! node (mline-max-width (mline-right node)))
+                 MAX-W-RIGHT]
+                [(and (not (eq? (mline-left node) NIL))
+                      ((mline-max-width (mline-left node)) . > . (mline-w node)))
+                 (set-mline-max-width! node (mline-max-width (mline-left node)))
+                 MAX-W-LEFT]
+                [else
+                 (set-mline-max-width! node (mline-w node))
+                 MAX-W-HERE])])
+          (unless (= old which)
+            (set-mline-flags! node
+                              (bitwise-ior
+                               (bitwise-and (mline-flags node)
+                                            (bitwise-not MAX-W-MASK))
+                               which)))
+          (when recur?
+            (let ([parent (mline-parent node)])
+              (unless (eq? parent NIL)
+                (loop parent)))))))))
+
+(define (set-width mline w)
+  (set-mline-w! mline w)
+  (adjust-max-width mline #t))
+
+;; ----------------------------------------
+
+(define (scroll-offset mline p)
+  (let ([scroll-snip (mline-scroll-snip mline)])
+    (cond
+     [(not scroll-snip)
+      0.0]
+     [(p . >= . (mline-numscrolls mline))
+      (mline-h mline)]
+     [else
+      (send scroll-snip get-scroll-step-offset p)])))
+
+(define (find-extra-scroll mline y)
+  (cond
+   [(y . >= . (mline-h mline))
+    (mline-numscrolls mline)]
+   [(y . <= . 0)
+    0]
+   [else
+    (let ([scroll-snip (mline-scroll-snip mline)])
+      (if (not scroll-snip)
+          0
+          (send scroll-snip find-scroll-step y)))]))
+
+;; ----------------------------------------
+
+(define (mark-need mline HERE recur)
+  (unless (bit-overlap? (mline-flags mline) HERE)
+    (set-mline-flags! mline (bitwise-ior (mline-flags mline) HERE))
+    (let ([parent (mline-parent mline)])
+      (unless (eq? parent NIL)
+        (recur parent #t)))))
+
+(define (adjust-need-flag mline MASK HERE RIGHT LEFT recur?)
+  (let loop ([node mline])
+    (let ([old (bitwise-and (mline-flags node) MASK)])
+      (let* ([which (bitwise-and old HERE)]
+             [which (if (and (not (eq? (mline-right node) NIL))
+                             (bit-overlap? (mline-flags (mline-right node)) MASK))
+                        (bitwise-ior which RIGHT)
+                        which)]
+             [which (if (and (not (eq? (mline-left node) NIL))
+                             (bit-overlap? (mline-flags (mline-left node)) MASK))
+                        (bitwise-ior which LEFT)
+                        which)])
+        (when (not (= old which))
+          (set-mline-flags! node
+                            (bitwise-ior
+                             (bitwise-and (mline-flags node)
+                                          (bitwise-not MASK))
+                             which))
+          (when recur?
+            (let ([parent (mline-parent node)])
+              (unless (eq? parent NIL)
+                (loop parent)))))))))
+
+(define (mark-recalculate mline)
+  (mark-need mline CALC-HERE adjust-need-calc))
+
+(define (adjust-need-calc mline [recur? #f])
+  (adjust-need-flag mline CALC-MASK CALC-HERE CALC-RIGHT CALC-LEFT recur?))
+
+(define (mark-check-flow mline)
+  (mark-need mline FLOW-HERE adjust-need-flow))
+
+(define (adjust-need-flow mline [recur? #f])
+  (adjust-need-flag mline FLOW-MASK FLOW-HERE FLOW-RIGHT FLOW-LEFT recur?))
+
+;; ----------------------------------------
+
+(define (get-root mline)
+  (let ([parent (mline-parent mline)])
+    (if (not (eq? parent NIL))
+        (get-root parent)
+        mline)))
+
+;; ----------------------------------------
+
+(define (check-consistent root)
+  (unless (black? root)
+    (error "root is not black"))
+  (let ([l1 (let loop ([mline root])
+              (if (eq? mline NIL)
+                  null
+                  (begin
+                    (when (red? mline)
+                      (unless (black? (mline-left mline))
+                        (error "red left child is not black"))
+                      (unless (black? (mline-right mline))
+                        (error "red right child is not black")))
+                    (unless (or (eq? (mline-left mline) NIL)
+                                (eq? (mline-parent (mline-left mline)) mline))
+                      (error "left and up doesn't work"))
+                    (unless (or (eq? (mline-right mline) NIL)
+                                (eq? (mline-parent (mline-right mline)) mline))
+                      (error "right and up doesn't work"))
+                    (append
+                     (loop (mline-left mline))
+                     (list mline)
+                     (loop (mline-right mline))))))]
+        [l2 (let loop ([mline root])
+              (let ([prev (mline-prev mline)])
+                (if prev
+                    (begin
+                      (unless (eq? (mline-next prev) mline)
+                        (error "back doesn't go forward"))
+                      (loop prev))
+                    (let loop ([mline mline])
+                      (if mline
+                          (cons mline (loop (mline-next mline)))
+                          null)))))])
+    (unless (= (length l1) (length l2))
+      (error 'check-consistent "different lengths: ~s ~s" (length l1) (length l2)))
+    (unless (andmap eq? l1 l2)
+      (error "different elems")))
+  (let loop ([mline root])
+    (if (eq? mline NIL)
+        0
+        (let ([left (loop (mline-left mline))]
+              [right (loop (mline-right mline))])
+          (unless (= left right)
+            (error "different black counts:" left right))
+          (if (black? mline)
+              (+ 1 left)
+              left))))
+  (unless (eq? (mline-parent root) NIL)
+    (error "root has non-NIL parent"))
+  (unless (black? NIL)
+    (error "NIL is non-black"))
+  (unless (eq? NIL (mline-parent NIL))
+    (error "NIL parent changed"))
+  (unless (eq? NIL (mline-left NIL))
+    (error "NIL left changed"))
+  (unless (eq? NIL (mline-left NIL))
+    (error "NIL right changed")))
+
+#|
+
+Debugging tools:
+
+(define (draw p)
+  (for-each (lambda (l)
+              (display l)
+              (newline))
+            (paint p)))
+
+(define (paint p)
+  (if (eq? p NIL)
+      '("*")
+      (let ([l (paint (mline-left p))]
+            [r (paint (mline-right p))])
+        (let ([ll (string-length (car l))]
+              [rl (string-length (car r))]
+              [s ((if (red? p) string-upcase values) (format "~s" (mline-sym p)))])
+          (cons
+           (string-append (make-string ll #\space)
+                          s
+                          (make-string rl #\space))
+           (let loop ([l l][r r])
+             (cond
+              [(null? l) (if (null? r)
+                             null
+                             (map (lambda (r)
+                                    (string-append 
+                                     (make-string (+ ll (string-length s)) #\space)
+                                     r))
+                                  r))]
+              [(null? r) (map (lambda (l)
+                                    (string-append 
+                                     l
+                                     (make-string (+ rl (string-length s)) #\space)))
+                                  l)]
+              [else (cons (string-append (car l)
+                                         (make-string (string-length s) #\space)
+                                         (car r))
+                          (loop (cdr l) (cdr r)))])))))))
+
+(define (find? root m)
+  (or (eq? root m)
+      (if (eq? root NIL)
+          #f
+          (or (find? (mline-left root) m)
+              (find? (mline-right root) m)))))
+
+|#
+
+;; ------------------------------------------------------------
+
+(define (update-flow mline root-box media max-width dc)
+  (define (flow-left)
+    (if (bit-overlap? (mline-flags mline) FLOW-LEFT)
+        (if (and (not (eq? (mline-left mline) NIL))
+                 (update-flow (mline-left mline) root-box media max-width dc))
+            #t
+            (begin
+              (set-mline-flags! mline (- (mline-flags mline) FLOW-LEFT))
+              (flow-here)))
+        (flow-here)))
+  (define (flow-here)
+    (if (bit-overlap? (mline-flags mline) FLOW-HERE)
+        (begin
+          (set-mline-flags! mline (- (mline-flags mline) FLOW-HERE))
+          (let* ([first-line (box #f)]
+                 [para (get-paragraph-style mline first-line)]
+                 [line-max-width (get-line-max-width para max-width (unbox first-line))])
+            (if (send media check-flow line-max-width dc (get-location mline) (get-position mline) (mline-snip mline))
+                (do-flow)
+                (flow-right))))
+        (flow-right)))
+  (define (flow-right)
+    (if (bit-overlap? (mline-flags mline) FLOW-RIGHT)
+        (if (and (not (eq? (mline-right mline) NIL))
+                 (update-flow (mline-right mline) root-box media max-width dc))
+            #t
+            (begin
+              (set-mline-flags! mline (- (mline-flags mline) FLOW-RIGHT))
+              #f))
+        #f))
+  (define (do-flow)
+    (let loop ([asnip (mline-snip mline)])
+      (if (eq? asnip (mline-last-snip mline))
+          (begin
+            (do-extend-line asnip)
+            #t)
+          (if (has-flag? (snip->flags asnip) NEWLINE)
+              (begin
+                (do-new-line asnip)
+                #t)
+              (begin
+                (set-snip-line! asnip mline)
+                (loop (snip->next asnip)))))))
+  (define (do-new-line asnip)
+    ;; items pushed to next line or new line was inserted
+    (let ([next (mline-next mline)])
+      (let ([nextsnip (if next
+                          (let loop ([nextsnip (snip->next asnip)])
+                            (if (and nextsnip
+                                     (not (eq? nextsnip (mline-last-snip next)))
+                                     (not (has-flag? (snip->flags nextsnip) NEWLINE)))
+                                (loop (snip->next nextsnip))
+                                nextsnip))
+                          #f)])
+        (if (or (not next)
+                (not (eq? nextsnip (mline-last-snip next))))
+            ;; it was a new line
+            (let ([newline (insert mline root-box #f)])
+              (set-mline-snip! newline (snip->next asnip))
+              (set-mline-last-snip! newline (mline-last-snip mline))
+              (set-mline-last-snip! mline asnip)
+
+              (snips-to-line! newline))
+            ;; just pushed to next line
+            (begin
+              (set-mline-last-snip! mline asnip)
+              (set-snip-line! asnip mline)
+              
+              (set-mline-snip! next (snip->next asnip))
+
+              (snips-to-line! next)))
+
+        (calc-line-length mline)
+        (mark-recalculate mline))))
+  (define (snips-to-line! next)
+    (let ([nextsnip (snip->next (mline-last-snip next))])
+      (let loop ([asnip (mline-snip next)])
+        (unless (eq? asnip nextsnip)
+          (set-snip-line! asnip next)
+          (loop (snip->next asnip)))))
+    (mark-check-flow next)
+    (mark-recalculate next)
+    (calc-line-length next))
+  (define (maybe-delete-line! asnip mline)
+    (if (and (mline-next mline)
+             (eq? asnip (mline-last-snip (mline-next mline))))
+        ;; a line was deleted
+        (begin (delete (mline-next mline) root-box) #t)
+        #f))
+  (define (do-extend-line asnip)
+    ;; this line was extended
+    (let ([asnip
+           (if asnip
+               (let loop ([asnip asnip])
+                 (if (and (snip->next asnip)
+                          (not (has-flag? (snip->flags asnip) NEWLINE)))
+                     (begin
+                       (set-snip-line! asnip mline)
+                       (maybe-delete-line! asnip mline)
+                       (loop (snip->next asnip)))
+                     (begin
+                       (maybe-delete-line! asnip mline)
+                       (set-mline-last-snip! mline asnip)
+                       asnip)))
+               (begin
+                 (set-mline-last-snip! mline (send media get-s-last-snip))
+                 (let loop ()
+                   (let ([next (mline-next mline)])
+                     (when next
+                       (delete next root-box)
+                       (loop))))
+                 #f))])
+
+      (set-snip-line! (mline-last-snip mline) mline)
+
+      (when (mline-next mline)
+        (let ([asnip (snip->next asnip)]
+              [next (mline-next mline)])
+          (when (or (not (eq? (mline-snip next) asnip))
+                    (not (has-flag? (snip->flags (mline-last-snip next)) NEWLINE)))
+            ;; Effect can propogate to more lines, merging the
+            ;; next several. (Handle prefixing the remains of the source of
+            ;; the extension to this line onto the next line. Implemented
+            ;; as the next line eating the next->next line.) 
+            (set-mline-snip! next asnip)
+            (let ([asnip
+                   (let loop ([asnip asnip])
+                     (if (and (snip->next asnip)
+                              (not (has-flag? (snip->flags asnip) NEWLINE)))
+                         (begin
+                           (maybe-delete-line! asnip next)
+                           (set-snip-line! asnip next)
+                           (loop (snip->next asnip)))
+                         asnip))])
+              (set-snip-line! asnip next)
+              (set-mline-last-snip! next asnip)
+              (when (mline-next next)
+                (unless (maybe-delete-line! asnip next)
+                  (set-mline-snip! (mline-next next) (snip->next asnip))))
+              (calc-line-length next)
+              (mark-recalculate next)
+              (mark-check-flow next)))))
+
+      (calc-line-length mline)
+      (mark-recalculate mline)))
+  ;; Try left first....
+  (flow-left))
+
+;; ----------------------------------------
+
+(define (update-graphics mline media dc)
+  (define (update-left)
+    (and (bit-overlap? (mline-flags mline) CALC-LEFT)
+         (not (eq? (mline-left mline) NIL))
+         (update-graphics (mline-left mline) media dc)))
+  (define (update-here)
+    (and 
+     (bit-overlap? (mline-flags mline) CALC-HERE)
+     (let ([y (get-location mline)]
+           [nextsnip (snip->next (mline-last-snip mline))])
+       (let loop ([asnip (mline-snip mline)]
+                  [maxbase 0.0]
+                  [maxdescent 0.0]
+                  [maxspace 0.0]
+                  [maxantidescent 0.0]
+                  [maxantispace 0.0]
+                  [totalwidth 0.0]
+                  [maxscroll 1]
+                  [scroll-snip #f]
+                  [last-w 0.0]
+                  [last-h 0.0])
+         (if (not (eq? asnip nextsnip))
+             (let-boxes ([w 0.0]
+                         [h 0.0]
+                         [descent 0.0]
+                         [space 0.0])
+                 (send asnip get-extent dc totalwidth y w h descent space #f #f)
+               (let* ([align (send (snip->style asnip) get-alignment)]
+                      [scroll (send asnip get-num-scroll-steps)]
+                      [maxbase (max maxbase (- h descent space))]
+                      [maxdescent (if (eq? align 'bottom)
+                                      (max maxdescent descent)
+                                      maxdescent)]
+                      [maxantispace (if (eq? align 'bottom)
+                                        maxantispace
+                                        (max maxantispace (- h space)))]
+                      [maxspace (if (eq? align 'top)
+                                    (max maxspace space)
+                                    maxspace)]
+                      [maxantidescent (if (eq? align 'top)
+                                          maxantidescent
+                                          (max maxantidescent (- h descent)))]
+                      [scroll-snip (if (scroll . > . maxscroll)
+                                       asnip
+                                       scroll-snip)]
+                      [maxscroll (max maxscroll scroll)]
+                      [totalwidth (+ w totalwidth)])
+                 (loop (snip->next asnip)
+                       maxbase maxdescent maxspace maxantidescent maxantispace
+                       totalwidth maxscroll scroll-snip
+                       w h)))
+             (let ([maxspace (max maxspace (- maxantidescent maxbase))]
+                   [maxdescent (max maxdescent (- maxantispace maxbase))])
+               (set-mline-scroll-snip! mline scroll-snip)
+               (set-mline-last-h! mline last-h)
+               (set-mline-last-w! mline last-w)
+               (set-mline-topbase! mline maxspace)
+               (set-mline-bottombase! mline (+ maxspace maxbase))
+               (let ([maxh (+ maxbase 
+                              maxdescent
+                              maxspace
+                              (send media get-s-line-spacing))]
+                     [bigwidth (+ (if ((mline-w mline) . > . totalwidth)
+                                      (mline-w mline)
+                                      totalwidth)
+                                  CURSOR-WIDTH
+                                  (let-boxes ([is-first? #f]
+                                              [para #f])
+                                      (set-box! para (get-paragraph-style mline is-first?))
+                                    (if is-first?
+                                        (paragraph-left-margin-first para)
+                                        (paragraph-left-margin para))))])
+                 (set-width mline totalwidth)
+                 (unless (= maxscroll (mline-numscrolls mline))
+                   (set-scroll-length mline maxscroll))
+                 (if (= maxh (mline-h mline))
+                     (send media refresh-box 0 y bigwidth maxh)
+                     (begin
+                       (set-height mline maxh)
+                       (let ([bigwidth (max 1e5 ;; really want viewable width, but > ok
+                                            (send media get-s-total-width))]
+                             [bigheight (+ maxh (send media get-s-total-height))])
+                         (send media refresh-box 0 y bigwidth bigheight))))))))
+       #t)))
+  (define (update-right)
+    (and (bit-overlap? (mline-flags mline) CALC-RIGHT)
+         (not (eq? (mline-right mline) NIL))
+         (update-graphics (mline-right mline) media dc)))
+
+  (let ([left? (update-left)]
+        [here? (update-here)]
+        [right? (update-right)])
+    (set-mline-flags! mline (bitwise-and
+                             (mline-flags mline)
+                             (bitwise-not CALC-MASK)))
+    (or left? here? right?)))
+
+;; ------------------------------------------------------------
+
+(define (number mline)
+  (add1 (get-line (last mline))))
+
+(define (first mline)
+  (let ([left (mline-left mline)])
+    (if (eq? left NIL)
+        mline
+        (first left))))
+    
+(define (last mline)
+  (let ([right (mline-right mline)])
+    (if (eq? right NIL)
+        mline
+        (last right))))
+
+;; ------------------------------------------------------------
+
+(define (get-left-location mline max-width)
+  (let-values ([(para left)
+                (if (bit-overlap? (mline-flags mline) STARTS-PARA)
+                    (let ([para (mline-paragraph mline)])
+                      (values para
+                              (paragraph-left-margin-first para)))
+                    (let ([para (get-paragraph-style mline)])
+                      (values para
+                              (paragraph-left-margin para))))])
+    (if (and (max-width . > . 0)
+             (not (eq? (paragraph-alignment para) 'left)))
+        (let ([delta (max 0 (- max-width (mline-w mline)))])
+          (if (eq? (paragraph-alignment para) 'right)
+              (+ left delta)
+              (+ left (/ delta 2))))
+        left)))
+
+(define (get-right-location mline max-width)
+  (+ (get-left-location mline max-width) (mline-w mline)))
diff --git a/collects/mred/private/wxme/pasteboard.ss b/collects/mred/private/wxme/pasteboard.ss
new file mode 100644
index 00000000..98366e7d
--- /dev/null
+++ b/collects/mred/private/wxme/pasteboard.ss
@@ -0,0 +1,2122 @@
+#lang scheme/base
+(require scheme/class
+         scheme/port
+         scheme/file
+         "../syntax.ss"
+         "const.ss"
+         "private.ss"
+         "editor.ss"
+         "undo.ss"
+         "style.ss"
+         "snip.ss"
+         "snip-flags.ss"
+         "snip-admin.ss"
+         "keymap.ss"
+         (only-in "cycle.ss" set-pasteboard%!)
+         "wordbreak.ss"
+         "stream.ss"
+         "wx.ss")
+
+(provide pasteboard%
+         add-pasteboard-keymap-functions)
+
+;; ----------------------------------------
+
+(define LINE-HEIGHT 16.0)
+
+(define DOT-WIDTH 5.0)
+(define HALF-DOT-WIDTH 2.0)
+
+(define (inbox? lx x)
+  (and ((- lx HALF-DOT-WIDTH) . <= . x)
+       ((+ (- lx HALF-DOT-WIDTH) DOT-WIDTH) . >= . x)))
+
+(define black-brush (send the-brush-list find-or-create-brush "black" 'xor))
+(define white-brush (send the-brush-list find-or-create-brush "white" 'solid))
+(define invisi-pen (send the-pen-list find-or-create-pen "black" 1 'transparent))
+(define rb-brush (send the-brush-list find-or-create-brush "black" 'transparent))
+(define rb-pen (send the-pen-list find-or-create-pen "black" 1 'xor-dot))
+
+(define arrow (make-object cursor% 'arrow))
+
+;; ----------------------------------------
+
+(define-struct loc (x y w h r b hm vm
+                      startx starty
+                      selected? need-resize?
+                      snip)
+  #:mutable)
+
+;; ----------------------------------------
+
+(defclass pasteboard% editor%
+  (inherit-field s-admin
+                 s-custom-cursor
+                 s-custom-cursor-overrides?
+                 s-own-caret?
+                 s-caret-snip
+                 s-keymap
+                 s-style-list
+                 s-noundomode
+                 s-modified?
+                 s-offscreen
+                 s-filename
+                 s-temp-filename?
+                 s-user-locked?
+                 s-need-on-display-size?)
+  (inherit on-change
+           get-default-style
+           set-modified
+           on-paint
+           wait-sequence-lock
+           begin-sequence-lock
+           end-sequence-lock
+           do-own-caret
+           on-focus
+           scroll-editor-to
+           do-set-caret-owner
+           install-copy-buffer
+           begin-copy-buffer
+           end-copy-buffer
+           free-old-copies
+           do-write-headers-footers
+           read-snips-from-file
+           do-own-x-selection
+           do-buffer-paste
+           add-undo-rec
+           get-dc
+           on-local-event
+           on-local-char
+           on-edit-sequence
+           after-edit-sequence
+           on-display-size)
+
+  (define dragable? #t)
+  (define selection-visible? #t)
+
+  (define snips #f)
+  (define last-snip #f)
+
+  (define snip-location-list (make-hasheq))
+  (define/private (snip-loc snip) (hash-ref snip-location-list snip #f))
+
+  (define snip-admin (new standard-snip-admin% [editor this]))
+  
+  (define last-time 0)
+  (define start-x 0.0)
+  (define start-y 0.0)
+  (define last-x 0.0)
+  (define last-y 0.0)
+
+  (define orig-x 0.0)
+  (define orig-y 0.0)
+  (define orig-w 0.0)
+  (define orig-h 0.0)
+  
+  (define max-width 'none)
+  (define min-width 'none)
+  (define max-height 'none)
+  (define min-height 'none)
+
+  (define keep-size? #f)
+  (define dragging? #f)
+  (define rubberband? #f)
+
+  (define need-resize? #f)
+
+  (define resizing #f) ; a snip
+  (define sizedxm 0.0)
+  (define sizedym 0.0)
+
+  (define scroll-step LINE-HEIGHT)
+
+  (define total-width 0.0)
+  (define total-height 0.0)
+  (define real-width 0.0)
+  (define real-height 0.0)
+
+  (define update-left 0.0)
+  (define update-right 0.0)
+  (define update-top 0.0)
+  (define update-bottom 0.0)
+  (define update-nonempty? #f)
+  (define no-implicit-update? #f)
+
+  (define size-cache-invalid? #f)
+  (define write-locked 0)
+  (define flow-locked? #f)
+
+  (define sequence 0)
+
+  (define delayedscrollbias 'none)
+  (define delayedscrollsnip #f)
+  (define delayedscroll-x 0.0)
+  (define delayedscroll-y 0.0)
+  (define delayedscroll-w 0.0)
+  (define delayedscroll-h 0.0)
+
+  (define sequence-streak? #f)
+
+  (define changed? #f)
+  
+
+  (super-new)
+
+  ;; ----------------------------------------
+
+  (define/private (rubber-band x y w h)
+    (when (and s-admin
+               (positive? w)
+               (positive? h))
+      (let-values ([(x w)
+                    (if (w . < . 0)
+                        (values (+ x w) (- w))
+                        (values x w))]
+                   [(y h)
+                    (if (h . < . 0)
+                        (values (+ y h) (- h))
+                        (values y h))])
+        (let ([r (+ x w)]
+              [b (+ y h)])
+          (let-boxes ([vx 0.0]
+                      [vy 0.0]
+                      [vw 0.0]
+                      [vh 0.0])
+              (send s-admin get-view vx vy vw vh)
+            (let ([x (max x vx)]
+                  [y (max y vy)]
+                  [r (min r (+ vx vw))]
+                  [b (min b (+ vy vh))])
+              (unless (or (x . >= . r)
+                          (y . >= . b))
+                (let-boxes ([dc #f]
+                            [dx 0.0]
+                            [dy 0.0])
+                    (set-box! dc (send s-admin get-dc dx dy))
+                  (let ([old-pen (send dc get-pen)]
+                        [old-brush (send dc get-brush)])
+                    (send dc set-pen rb-pen)
+                    (send dc set-brush rb-brush)
+  
+                    (send dc draw-rectangle
+                          (- x dx) (- y dy)
+                          (- r x)
+                          (- b y))
+
+                    (send dc set-pen old-pen)
+                    (send dc set-brush old-brush))))))))))
+
+  (def/override (adjust-cursor [mouse-event% event])
+    (if (not s-admin)
+        #f
+        (let-boxes ([scrollx 0.0]
+                    [scrolly 0.0]
+                    [dc #f])
+            (set-box! dc (send s-admin get-dc scrollx scrolly))
+          (if (not dc)
+              #f
+              (let ([x (+ (send event get-x) scrollx)]
+                    [y (+ (send event get-y) scrolly)])
+                (or (and (not s-custom-cursor-overrides?)
+                         (or (and s-caret-snip (send event dragging?)
+                                  (let-boxes ([x 0.0]
+                                              [y 0.0])
+                                      (get-snip-location s-caret-snip x y)
+                                    (let ([c (send s-caret-snip adjust-cursor dc
+                                                   (- x scrollx) (- y scrolly)
+                                                   x y event)])
+                                      c)))
+                             ;; find snip:
+                             (let ([snip (find-snip x y)])
+                               (and snip
+                                    (eq? snip s-caret-snip)
+                                    (let-boxes ([x 0.0] [y 0.0])
+                                        (get-snip-location snip x y)
+                                      (let ([c (send snip adjust-cursor dc (- x scrollx) (- y scrolly) 
+                                                     x y event)])
+                                        c))))))
+                    s-custom-cursor
+                    arrow))))))
+
+  (def/override (on-event [mouse-event% event])
+    (when s-admin
+      (let-values ([(dc x y scrollx scrolly)
+                    (if (or (send event button-down?) s-caret-snip)
+                        ;; first, find clicked-on snip:
+                        (let ([x (send event get-x)]
+                              [y (send event get-y)])
+                          (let-boxes ([scrollx 0.0]
+                                      [scrolly 0.0]
+                                      [dc #f])
+                              (set-box! dc (send s-admin get-dc scrollx scrolly))
+                            ;; FIXME: old code returned if !dc
+                            (values dc (+ x scrollx) (+ y scrolly) scrollx scrolly)))
+                        (values #f 0.0 0.0 0.0 0.0))])
+        (let ([snip (if (send event button-down?)
+                        (find-snip x y)
+                        s-caret-snip)])
+        (if (and snip
+                 (eq? snip s-caret-snip))
+            (let ([loc (snip-loc snip)])
+              (send s-caret-snip on-event
+                    dc (- (loc-x loc) scrollx) (- (loc-y loc) scrolly) 
+                    (loc-x loc) (loc-y loc)
+                    event))
+            (on-local-event event))))))
+
+  (def/override (on-default-event [mouse-event% event])
+    (when s-admin
+      (let-boxes ([scrollx 0.0]
+                  [scrolly 0.0]
+                  [dc #f])
+          (set-box! dc (send s-admin get-dc scrollx scrolly))
+        (when dc
+          (let-boxes ([x (+ (send event get-x) scrollx)]
+                      [y (+ (send event get-y) scrolly)])
+              
+              (interactive-adjust-mouse x y)
+            
+            (when (or (send event button-down?)
+                      (and (send event moving?) (not (send event dragging?)))
+                      (send event button-up?))
+              (set! keep-size? #f)
+              
+              (when dragging?
+                (if resizing
+                    (begin
+                      (begin-edit-sequence)
+                      ;; move & resize back without undo
+                      (when (or (sizedxm . < . 0.0)
+                                (sizedym . < . 0.0))
+                        (move-to resizing orig-x orig-y))
+                      (resize resizing orig-w orig-h)
+                      (set! dragging? #f)
+                      ;; re-move and re-size with undo:
+                      (do-event-resize last-x last-y)
+                      (after-interactive-resize resizing)
+                      (end-edit-sequence)
+                      (set! resizing #f))
+                    (finish-dragging event)))
+
+              (when rubberband?
+                (set! rubberband? #f)
+                (rubber-band start-x start-y (- last-x start-x) (- last-y start-y))
+                (add-selected start-x start-y (- last-x start-x) (- last-y start-y))
+                (update-all)))
+
+            (if (or (send event button-down?)
+                    (and (send event dragging?)
+                         (not dragging?)
+                         (not rubberband?)))
+
+                (let ([snip (find-snip x y)])
+                  (if dragable?
+                      (begin
+                        (if snip
+                            (let ([loc (snip-loc snip)])
+                              (set! orig-x (loc-x loc))
+                              (set! orig-y (loc-y loc))
+                              (set! orig-w (loc-w loc))
+                              (set! orig-h (loc-h loc))
+                              (if (not (loc-selected? loc))
+                                  (begin
+                                    (unless (send event get-shift-down)
+                                      (no-selected))
+                                    (set-caret-owner #f)
+                                    (add-selected snip)
+                                    (init-dragging event))
+                                  (let ([interval (abs (- (send event get-time-stamp)
+                                                          last-time))])
+                                    (if (and (send event button-down?)
+                                             (interval . < . (if s-keymap
+                                                                 (send s-keymap get-double-click-interval)
+                                                                 (get-double-click-threshold))))
+                                        (on-double-click snip event)
+                                        (let-boxes ([dx sizedxm]
+                                                    [dy sizedym]
+                                                    [f? #f])
+                                            (set-box! f? (find-dot loc x y dx dy))
+                                          (set! sizedxm dx)
+                                          (set! sizedxm dy)
+                                          (when f?
+                                            (set! resizing snip))
+                                          (init-dragging event)))))
+                              (when (send event button-down?)
+                                (set! last-time (send event get-time-stamp))))
+                            (begin
+                              (unless (send event get-shift-down)
+                                (no-selected))
+                              (set-caret-owner #f)
+                              (set! rubberband? #t)))
+                        (set! start-x x)
+                        (set! last-x x)
+                        (set! start-y y)
+                        (set! last-y y))
+                      ;; not dragable:
+                      (set-caret-owner snip)))
+
+                ;; not a new click:
+                (when dragable?
+                  (when (send event dragging?)
+                    (cond
+                     [rubberband?
+                      ;; erase old
+                      (rubber-band start-x start-y (- last-x start-x) (- last-y start-y))
+                      ;; draw new:
+                      (rubber-band start-x start-y (- x start-x) (- y start-y))]
+                     [resizing
+                      (do-event-resize x y)]
+                     [else
+                      (do-event-move x y)]))
+                  (set! last-x x)
+                  (set! last-y y))))))))
+
+  (def/public (on-double-click [snip% snip] [mouse-event% evt])
+    (when (has-flag? (snip->flags snip) HANDLES-EVENTS)
+      (no-selected)
+      (set-caret-owner snip)))
+
+  (def/override (on-char [key-event% event])
+    (when s-admin
+      (let-boxes ([scrollx 0.0]
+                  [scrolly 0.0]
+                  [dc #f])
+          (set-box! dc (send s-admin get-dc scrollx scrolly))
+        (when dc
+          (let ([x (+ (send event get-x) scrollx)]
+                [y (+ (send event get-y) scrolly)])
+            (if s-caret-snip
+                (let ([loc (snip-loc s-caret-snip)])
+                  (send s-caret-snip on-char
+                        dc (loc-x loc) (loc-y loc) (- x scrollx) (- y scrolly)
+                        event))
+                (on-local-char event)))))))
+
+  (def/override (on-default-char [key-event% event])
+    (when s-admin
+      (let ([code (send event get-key-code)])
+        (case code
+          [(#\rubout #\backspace)
+           (delete)]
+          [(right)
+           (move 1 0)]
+          [(left)
+           (move -1 0)]
+          [(up)
+           (move 0 -1)]
+          [(down)
+           (move 0 1)]))))
+
+  (define/private (init-dragging e)
+    (define (phase1)
+      (if resizing
+          (if (not (can-interactive-resize? resizing))
+              (set! resizing #f)
+              (begin
+                (on-interactive-resize resizing)
+                (phase2)))
+          (when (can-interactive-move? e)
+            (on-interactive-move e)
+            (phase2))))
+    (define (phase2)
+      (set! dragging? #t)
+      (set! keep-size? #t)
+      (let loop ([s #f])
+        (let ([s (find-next-selected-snip s)])
+          (when s
+            (let ([loc (snip-loc s)])
+              (set-loc-startx! loc (loc-x loc))
+              (set-loc-starty! loc (loc-y loc)))
+            (loop s)))))
+    (phase1))
+
+  (define/private (finish-dragging e)
+    (begin-edit-sequence)
+
+    ;; move back without undo and remember final
+    (let loop ([s #f])
+      (let ([s (find-next-selected-snip s)])
+        (when s
+          (let* ([loc (snip-loc s)]
+                 [x (loc-startx loc)]
+                 [y (loc-starty loc)])
+            (set-loc-startx! loc (loc-x loc))
+            (set-loc-starty! loc (loc-y loc))
+            (move-to s x y))
+          (loop s))))
+
+    (set! dragging? #f)
+
+    ;; move to final position with undo:
+    (let loop ([s #f])
+      (let ([s (find-next-selected-snip s)])
+        (when s
+          (let* ([loc (snip-loc s)])
+            (move-to s (loc-startx loc) (loc-starty loc)))
+          (loop s))))
+
+    (after-interactive-move e)
+    (end-edit-sequence))
+
+  (define/private (do-event-move event-x event-y)
+    (let ([dx (- event-x start-x)]
+          [dy (- event-y start-y)])
+      (begin-edit-sequence)
+      
+      (let loop ([s #f])
+        (let ([s (find-next-selected-snip s)])
+          (when s
+            (let ([loc (snip-loc s)])
+              (let-boxes ([x (+ (loc-startx loc) dx)]
+                          [y (+ (loc-starty loc) dy)])
+                  (interactive-adjust-move s x y)
+                (move-to s x y)))
+            (loop s))))
+
+      (end-edit-sequence)))
+
+  (define/private (do-event-resize event-x event-y)
+    (let ([dx (- event-x start-x)]
+          [dy (- event-y start-y)])
+      (let-boxes ([w (max 0.0 (+ orig-w (* dx sizedxm)))]
+                  [h (max 0.0 (+ orig-h (* dy sizedym)))])
+          (interactive-adjust-resize resizing w h)
+        (let ([w (max 0.0 w)]
+              [h (max 0.0 h)])
+          (let ([x (+ orig-x
+                      (if (sizedxm . < . 0)
+                          (- orig-w w)
+                          0.0))]
+                [y (+ orig-y
+                      (if (sizedym . < . 0)
+                          (- orig-h h)
+                          0.0))])
+  
+            (begin-edit-sequence)
+  
+            (when (resize resizing w h)
+              (when (or (sizedxm . < . 0)
+                        (sizedym . < . 0))
+                (move-to resizing x y)))
+
+            (end-edit-sequence))))))
+
+  (def/public (interactive-adjust-mouse [(make-box real?) x] [(make-box real?) y])
+    (set-box! x (max 0.0 (unbox x)))
+    (set-box! y (max 0.0 (unbox y))))
+
+  (def/public (interactive-adjust-resize [snip% s] [(make-box real?) w] [(make-box real?) h])
+    (void))
+
+  (def/public (interactive-adjust-move [snip% s][(make-box real?) x] [(make-box real?) y])
+    (set-box! x (max 0.0 (unbox x)))
+    (set-box! y (max 0.0 (unbox y))))
+  
+  ;; ----------------------------------------
+  
+  (def/public (set-selected [snip% snip])
+    (begin-edit-sequence)
+    (no-selected)
+    (add-selected snip)
+    (end-edit-sequence))
+
+  (define/private (do-select snip on?)
+    (let ([loc (snip-loc snip)])
+      (when (and loc
+                 (not (eq? (loc-selected? loc) on?)))
+        (set! write-locked (add1 write-locked))
+        (if (can-select? snip on?)
+            (begin
+              (on-select snip on?)
+              (set! write-locked (sub1 write-locked))
+              (set-loc-selected?! loc on?)
+              (after-select snip on?)
+              (update-location loc))
+            (set! write-locked (sub1 write-locked))))))
+
+  (def/public (remove-selected [snip% snip])
+    (do-select snip #f))
+  
+  (define/private (add-selected-region x y w h)
+    (let-values ([(x w)
+                  (if (w . < . 0)
+                      (values (+ x w) (- w))
+                      (values x w))]
+                 [(y h)
+                  (if (h . < . 0)
+                      (values (+ y h) (- h))
+                      (values y h))])
+      (let ([r (+ x w)]
+            [b (+ y h)])
+        
+        (begin-edit-sequence)
+
+        (let loop ([s snips])
+          (when s
+            (let ([loc (snip-loc s)])
+              (when (and
+                     loc
+                     (not (loc-selected? loc))
+                     ((loc-x loc) . <= . r)
+                     ((loc-y loc) . <= . b)
+                     ((loc-r loc) . >= . x)
+                     ((loc-b loc) . >= . y))
+                (add-selected s)))
+            (loop (snip->next s))))
+
+        (end-edit-sequence))))
+
+  (define/public (add-selected . args)
+    (case-args
+     args
+     [([real? x] [real? y] [real? w] [real? h])
+      (add-selected-region x y w h)]
+     [([snip% snip])
+      (do-select snip #t)]
+     (method-name 'pasteboard% 'add-selected)))
+  
+  (def/override (select-all)
+    (begin-edit-sequence)
+    (let loop ([s snips])
+      (when s
+        (add-selected s)
+        (loop (snip->next s))))
+    (end-edit-sequence))
+				  
+  (def/public (no-selected)
+    (begin-edit-sequence)
+    (let loop ([s snips])
+      (when s
+        (remove-selected s)
+        (loop (snip->next s))))
+    (end-edit-sequence))
+
+  ;; ----------------------------------------
+
+  (define/private (do-insert snip before x y)
+    (unless (or s-user-locked?
+                (not (zero? write-locked))
+                (send snip is-owned?))
+      (when (not (snip->snipclass snip))
+        (error (method-name 'pasteboard% 'insert)
+               "cannot insert a snip without a snipclass: ~e" 
+               snip))
+
+      (set! write-locked (add1 write-locked))
+      (begin-edit-sequence)
+      (let ([ok?
+             (or (can-insert? snip before x y)
+                 (begin
+                   (end-edit-sequence)
+                   (set! write-locked (sub1 write-locked))
+                   #f))])
+        (when ok?
+          (on-insert snip before x y)
+          (set! write-locked (sub1 write-locked))
+
+          (let ([snip (if (send snip is-owned?)
+                          ;; disaster: can/on-insert made the snip owned
+                          (new image-snip%)
+                          snip)])
+            
+            (let ([search (and (snip-loc before)
+                               before)])
+  
+              (set-snip-next! snip search)
+              (if search
+                  (begin
+                    (set-snip-prev! snip (snip->prev search))
+                    (set-snip-prev! search snip))
+                  (begin
+                    (set-snip-prev! snip last-snip)
+                    (set! last-snip snip)))
+              (if (snip->prev snip)
+                  (set-snip-next! (snip->prev snip) snip)
+                  (set! snips snip)))
+            
+            (let ([loc (make-loc
+                        x y 0.0 0.0 0.0 0.0 0.0 0.0
+                        0.0 0.0
+                        #f #t
+                        snip)])
+              (hash-set! snip-location-list snip loc)
+            
+              (set-snip-style! snip (send s-style-list convert (snip->style snip)))
+              (when (eq? (snip->style snip)
+                         (send s-style-list basic-style))
+                (let ([s (get-default-style)])
+                  (when s
+                    (set-snip-style! snip s))))
+              
+              (send snip size-cache-invalid)
+              
+              (snip-set-admin snip snip-admin)
+              
+              (when (zero? s-noundomode)
+                (let ([is (make-object insert-snip-record% snip sequence-streak?)])
+                  (add-undo-rec is)))
+              (when (positive? sequence)
+                (set! sequence-streak? #t))
+              
+              (set! changed? #t)
+              
+              (unless s-modified?
+                (set-modified #t))
+            
+              (set! need-resize? #t)
+              (update-location loc)
+              
+              (set! write-locked (add1 write-locked))
+              (end-edit-sequence)
+              (set! write-locked (sub1 write-locked))
+              
+              (when (zero? sequence)
+                (update-needed))
+              
+              (after-insert snip before x y)))))))
+
+  (define/override (insert . args)
+    (case-args
+     args
+     [([snip% snip] [(make-or-false snip%) [before #f]])
+      (let-values ([(x y) (get-center)])
+        (do-insert snip before x y))]
+     [([snip% snip] [(make-or-false snip%) before] [real? x] [real? y])
+      (do-insert snip before x y)]
+     [([snip% snip] [real? x] [real? y])
+      (do-insert snip #f x y)]
+     (method-name 'pasteboard% 'insert)))
+
+  (define/private (delete-some del?)
+    (unless (or s-user-locked?
+                (not (zero? write-locked)))
+      (let ([del (make-object delete-snip-record% sequence-streak?)])
+        (when (positive? sequence)
+          (set! sequence-streak? #t))
+
+        (begin-edit-sequence)
+
+        (let loop ([s snips])
+          (when s
+            (let ([next (snip->next s)])
+              (when (del? s)
+                (-delete s del))
+              (loop next))))
+        
+        (when (zero? s-noundomode)
+          (add-undo-rec del))
+
+        (end-edit-sequence))))
+
+  (define/public (delete . args)
+    (case-args
+     args
+     [()
+      (delete-some (lambda (s) (loc-selected? (snip-loc s))))]
+     [([snip% s])
+      (unless (or s-user-locked?
+                  (not (zero? write-locked)))
+        (let ([del (make-object delete-snip-record% sequence-streak?)])
+          (when (positive? sequence)
+            (set! sequence-streak? #t))
+          (-delete s del)
+          (when (zero? s-noundomode)
+            (add-undo-rec del))))]
+     (method-name 'pasteboard% 'insert)))
+
+  (def/public (erase)
+    (delete-some (lambda (s) #t)))
+  
+  (define/private (-delete del-snip del)
+    (when (snip-loc del-snip)
+      (set! write-locked (add1 write-locked))
+      (begin-edit-sequence)
+      (let ([ok? (or (can-delete? del-snip)
+                     (begin
+                       (end-edit-sequence)
+                       (set! write-locked (sub1 write-locked))
+                       #f))])
+        (and 
+         ok?
+         (begin
+           (on-delete del-snip)
+           (set! write-locked (sub1 write-locked))
+           
+           (let ([update-cursor?
+                  (and (eq? del-snip s-caret-snip)
+                       (begin
+                         (send s-caret-snip own-caret #f)
+                         (set! s-caret-snip #f)
+                         #t))])
+
+             (update-snip del-snip)
+             
+             (if (snip->prev del-snip)
+                 (set-snip-next! (snip->prev del-snip) (snip->next del-snip))
+                 (set! snips (snip->next del-snip)))
+             (if (snip->next del-snip)
+                 (set-snip-prev! (snip->next del-snip) (snip->prev del-snip))
+                 (set! last-snip (snip->prev del-snip)))
+
+             (let ([loc (snip-loc del-snip)])
+               (hash-remove! snip-location-list del-snip)
+               (when del
+                 (send del insert-snip del-snip (snip->next del-snip) (loc-x loc) (loc-y loc))))
+             
+             (set-snip-next! del-snip #f)
+             (set-snip-prev! del-snip #f)
+             
+             (set-snip-flags! del-snip (add-flag CAN-DISOWN (snip->flags del-snip)))
+             (snip-set-admin del-snip #f)
+             (set-snip-flags! del-snip (remove-flag CAN-DISOWN (snip->flags del-snip)))
+             (unless del
+               (when (send del-snip get-admin)
+                 (set-snip-flags! del-snip (remove-flag OWNED (snip->flags del-snip)))))
+             
+             (unless s-modified?
+               (set-modified #t))
+
+             (after-delete del-snip)
+             (set! changed? #t)
+
+             (set! need-resize? #t)
+
+             (set! write-locked (add1 write-locked))
+             (end-edit-sequence)
+             (set! write-locked (sub1 write-locked))
+
+             (when (zero? sequence)
+               (update-needed))
+             
+             (when update-cursor?
+               (when s-admin
+                 (send s-admin update-cursor)))
+
+             #t))))))
+
+  (def/public (remove [snip% del-snip])
+    (unless (or s-user-locked?
+                (not (zero? write-locked)))
+      (-delete del-snip #f)))
+
+  ;; ----------------------------------------
+
+
+  (def/public (move-to [snip% snip] [real? x] [real? y])
+    (unless (or s-user-locked?
+                (not (zero? write-locked)))
+      (let ([loc (snip-loc snip)])
+        (when (and loc
+                   (not (and
+                         (= (loc-x loc) x)
+                         (= (loc-y loc) y))))
+          (set! write-locked (add1 write-locked))
+          (begin-edit-sequence)
+          (if (not (can-move-to? snip x y dragging?))
+              (begin
+                (end-edit-sequence)
+                (set! write-locked (sub1 write-locked)))
+              (begin
+                (on-move-to snip x y dragging?)
+                (set! write-locked (sub1 write-locked))
+
+                (update-location loc)
+
+                (unless dragging?
+                  (let ([rec (make-object move-snip-record%
+                                          snip
+                                          (loc-x loc)
+                                          (loc-y loc) 
+                                          #f
+                                          sequence-streak?)])
+                    (when (positive? sequence)
+                      (set! sequence-streak? #t))
+                    (when (zero? s-noundomode)
+                      (add-undo-rec rec))))
+                
+                (set-loc-x! loc x)
+                (set-loc-y! loc y)
+                (set-loc-r! loc (+ x (loc-w loc)))
+                (set-loc-b! loc (+ y (loc-h loc)))
+                (set-loc-hm! loc (+ x (/ (loc-w loc) 2)))
+                (set-loc-vm! loc (+ y (/ (loc-h loc) 2)))
+                (update-location loc)
+
+                (when (and (not dragging?)
+                           (not s-modified?))
+                  (set-modified #t))
+
+                (after-move-to snip x y dragging?)
+
+                (set! need-resize? #t)
+
+                (set! write-locked (add1 write-locked))
+                (end-edit-sequence)
+                (set! write-locked (sub1 write-locked))
+
+                (set! changed? #t)
+
+                (when (zero? sequence)
+                  (update-needed))))))))
+  
+  (define/public (move . args)
+    (case-args
+     args
+     [([snip% snip] [real? dx] [real? dy])
+      (unless (or s-user-locked?
+                  (not (zero? write-locked)))
+        (let ([loc (snip-loc snip)])
+          (when loc
+            (move-to snip (+ (loc-x loc) dx) (+ (loc-y loc) dy)))))]
+     [([real? dx] [real? dy])
+      (unless (or s-user-locked?
+                  (not (zero? write-locked)))
+        (begin-edit-sequence)
+        (for ([loc (in-hash-values snip-location-list)])
+          (when (loc-selected? loc)
+            (move (loc-snip loc) dx dy)))
+        (end-edit-sequence))]
+     (method-name 'pasteboard% 'move)))
+
+  (def/public (resize [snip% snip] [real? w] [real? h])
+    (if (not s-admin)
+        #f
+        (let ([loc (snip-loc snip)])
+          (if (not loc)
+              #f
+              (let ([oldw (loc-w loc)]
+                    [oldh (loc-h loc)])
+                (set! write-locked (add1 write-locked))
+                (begin-edit-sequence)
+                (if (not (can-resize? snip w h))
+                    (begin
+                      (end-edit-sequence)
+                      (set! write-locked (sub1 write-locked))
+                      #f)
+                    (begin
+                      (on-resize snip w h)
+                      (set! write-locked (sub1 write-locked))
+
+                      (let ([rv? 
+                             (and (send snip resize w h)
+                                  (begin
+                                    (when (not dragging?)
+                                      (when (zero? s-noundomode)
+                                        (let ([rs (make-object resize-snip-record%
+                                                               snip oldw oldh
+                                                               sequence-streak?)])
+                                          (add-undo-rec rs))
+                                        (when (positive? sequence)
+                                          (set! sequence-streak? #t))))
+                                    #t))])
+                        (when (and rv?
+                                   (not dragging?)
+                                   (not s-modified?))
+                          (set-modified #t))
+
+                        (after-resize snip w h rv?)
+
+                        (set! write-locked (add1 write-locked))
+                        (end-edit-sequence)
+                        (set! write-locked (sub1 write-locked))
+
+                        (set! changed? #t)
+
+                        (when (zero? sequence)
+                          (update-needed))
+
+                        rv?))))))))
+
+  ;; ----------------------------------------
+
+  (define/private (do-change-style style delta snip)
+    (unless (or s-user-locked?
+                  (not (zero? write-locked)))
+      (let ([rec (make-object style-change-snip-record% sequence-streak?)])
+        (when (positive? sequence)
+          (set! sequence-streak? #t))
+
+        (let ([style (or style
+                         (and (not delta)
+                              (or (get-default-style)
+                                  (send s-style-list basic-style))))])
+
+          (begin-edit-sequence)
+
+          (let ([didit?
+                 (if snip
+                     (begin
+                       (send rec add-style-change snip (snip->style snip))
+                       (set-snip-style!
+                        snip
+                        (or style
+                            (send s-style-list find-or-create-style (snip->style snip) delta)))
+                       (send snip size-cache-invalid)
+                       (update-snip snip)
+                       #t)
+                     (for/fold ([didit? #f])
+                         ([loc (in-hash-keys snip-location-list)])
+                       (if (loc-selected? loc)
+                           (let ([snip (loc-snip loc)])
+                             (send rec add-style-change (loc-snip loc) (snip->style snip))
+                             (set-snip-style!
+                              snip
+                              (or style
+                                  (send s-style-list find-or-create-style (snip->style snip) delta)))
+                             (send snip size-cache-invalid)
+                             (set-loc-need-resize?! loc #t)
+                             (set! need-resize? #t)
+                             (update-location loc)
+                             #t)
+                           didit?)))])
+
+            (when didit?
+              (when (zero? s-noundomode)
+                (add-undo-rec rec))
+
+              (set! changed? #t)
+              (when (not s-modified?)
+                (set-modified #t))))
+          
+          (end-edit-sequence)))))
+
+  (define/public (change-style . args)
+    (case-args
+     args
+     [([style-delta% delta])
+      (do-change-style #f delta #f)]
+     [([style-delta% delta] [snip% snip])
+      (do-change-style #f delta snip)]
+     [([style<%> style] [snip% snip])
+      (do-change-style style #f snip)]
+     (method-name 'pasteboard% 'change-style)))
+
+  ;; ----------------------------------------
+
+  (define/private (set-between snip before after)
+    (unless (or s-user-locked?
+                (not (zero? write-locked))
+                (not (snip-loc snip))
+                (eq? snip before)
+                (eq? snip after)
+                (and before (not (snip-loc before)))
+                (and after (not (snip-loc after))))
+      (set! write-locked (add1 write-locked))
+      (if (not (can-reorder? snip (or before after) (and before #t)))
+          (set! write-locked (sub1 write-locked))
+          (begin
+            (on-reorder snip (or before after) (and before #t))
+            (set! write-locked (sub1 write-locked))
+
+            ;; remove snip from current pos:
+            (if (snip->prev snip)
+                (set-snip-next! (snip->prev snip) (snip->next snip))
+                (set! snips (snip->next snip)))
+            (if (snip->next snip)
+                (set-snip-prev! (snip->next snip) (snip->prev snip))
+                (set! last-snip (snip->prev snip)))
+
+            ;; insert before `before' or after `after':
+            (if before
+                (begin
+                  (set-snip-prev! snip (snip->prev before))
+                  (set-snip-next! snip before)
+                  (set-snip-prev! before snip)
+                  (if (snip->prev snip)
+                      (set-snip-next! (snip->prev snip) snip)
+                      (set! snips snip)))
+                (begin
+                  (set-snip-next! snip (snip->next after))
+                  (set-snip-prev! snip after)
+                  (set-snip-next! after snip)
+                  (if (snip->next snip)
+                      (set-snip-prev! (snip->next snip) snip)
+                      (set! last-snip snip))))
+
+            (set! changed? #t)
+            (unless s-modified?
+              (set-modified #t))
+
+            (update-snip snip)
+
+            (after-reorder snip (or before after) (and before #t))))))
+
+  (def/public (set-before [snip% snip] [(make-or-false snip%) before])
+    (set-between snip (or before snips) #f))
+
+  (def/public (set-after [snip% snip] [(make-or-false snip%) after])
+    (set-between snip #f (or after last-snip)))
+
+  (def/public (raise [snip% snip])
+    (set-between snip (snip->prev snip) #f))
+
+  (def/public (lower [snip% snip])
+    (set-between snip #f (snip->next snip)))
+
+  ;; ----------------------------------------
+
+  (define/private (snip-set-admin snip a)
+    (let ([orig-admin (snip->admin snip)])
+      ;; lock during set-admin! [???]
+      (send snip set-admin a)
+
+      (if (not (eq? (send snip get-admin) a))
+          ;; something went wrong
+          (cond
+           [(and (not a)
+                 (eq? (snip->admin snip) orig-admin))
+            ;; force admin to null
+            (set-snip-admin! snip #f)
+            snip]
+           [a
+            ;; snip didn't accept membership into this editor; give up on it
+            (let ([naya (new snip%)])
+              (set-snip-prev! naya (snip->prev snip))
+              (set-snip-next! naya (snip->next snip))
+              (if (snip->prev snip)
+                  (set-snip-next! (snip->prev naya) naya)
+                  (set! snips naya))
+              (if (snip->next snip)
+                  (set-snip-prev! (snip->next naya) naya)
+                  (set! last-snip naya))
+              (set-snip-admin! snip #f)
+              (send naya set-admin a)
+              naya)]
+           [else snip])
+          snip)))
+  
+  ;; ----------------------------------------
+  
+  (define/override (really-can-edit? op)
+    (if (and (not (eq? op 'copy))
+             (positive? write-locked))
+        #f
+        (case op
+          [(clear cut copy kill)
+           (and (find-next-selected-snip #f)
+                #t)]
+          [(select-all)
+           (and snips #t)]
+          [else #t])))
+  
+  ;; ----------------------------------------
+  
+  (define/private (find-dot loc x y dxm dym)
+    (define (check-y)
+      (cond
+       [(inbox? (loc-y loc) y)
+        (set-box! dym -1) #t]
+       [(inbox? (loc-vm loc) y)
+        (set-box! dym 0) #t]
+       [(inbox? (loc-b loc) y)
+        (set-box! dym 1) #t]
+       [else #f]))
+    (cond
+     [(inbox? (loc-x loc) x)
+      (set-box! dxm -1)
+      (check-y)]
+     [(inbox? (loc-hm loc) x)
+      (set-box! dxm 0)
+      (check-y)]
+     [(inbox? (loc-r loc) x)
+      (set-box! dxm 1)
+      (check-y)]
+     [else #f]))
+
+  (def/public (find-snip [real? x] [real? y] [(make-or-false snip%) [after #f]])
+    (let ([dummy (box 0)])
+      (let loop ([s (if after 
+                        (if (snip-loc after)
+                            (snip->next after)
+                            #f)
+                        snips)])
+        (and s
+             (let ([loc (snip-loc s)])
+               (cond
+                [(and ((loc-x loc) . <= . x)
+                      ((loc-y loc) . <= . y)
+                      ((loc-r loc) . >= . x)
+                      ((loc-b loc) . >= . y))
+                 s]
+                [(and (loc-selected? loc)
+                      (find-dot loc x y dummy dummy))
+                 s]
+                [else (loop (snip->next s))]))))))
+  
+  (def/override (find-first-snip) snips)
+  
+  (def/public (is-selected? [snip% asnip])
+    (let ([loc (snip-loc asnip)])
+      (and loc
+           (loc-selected? loc))))
+  
+  (def/public (find-next-selected-snip [(make-or-false snip%) start])
+    (let loop ([s (if start 
+                      (if (snip-loc start)
+                          (snip->next start)
+                          #f)
+                      snips)])
+      (and s
+           (if (loc-selected? (snip-loc s))
+               s
+               (loop (snip->next s))))))
+
+  ;; ----------------------------------------
+  
+  (define/private (draw dc dx dy cx cy cw ch show-caret bg-color)
+    (when s-admin
+      (set! write-locked (add1 write-locked))
+      (set! flow-locked? #t)
+
+      (let ([dcx (+ cx dx)]
+            [dcy (+ cy dy)]
+            [cr (+ cx cw)]
+            [cb (+ cy ch)])
+        (let ([dcr (+ dcx cw)]
+              [dcb (+ dcy ch)])
+
+          (when bg-color
+            (let ([save-pen (send dc get-pen)]
+                  [save-brush (send dc get-brush)])
+              
+              (let ([wb (if (and (= 255 (send bg-color red))
+                                 (= 255 (send bg-color green))
+                                 (= 255 (send bg-color blue)))
+                            white-brush
+                            (send the-brush-list find-or-create-brush bg-color 'solid))])
+                (send dc set-brush wb)
+                (send dc set-pen invisi-pen)
+                (send dc draw-rectangle dcx dcy cw ch)
+                (send dc set-brush save-brush)
+                (send dc set-pen save-pen))))
+
+          (on-paint #t dc cx cy cr cb dx dy 
+                    (if (not s-caret-snip)
+                        show-caret
+                        'no-caret))
+
+          (let loop ([snip last-snip]
+                     [old-style #f])
+            (if snip
+                (let ([loc (snip-loc snip)])
+                  (when (and ((loc-x loc) . <= . cr)
+                             ((loc-y loc) . <= . cb)
+                             ((loc-r loc) . >= . cx)
+                             ((loc-b loc) . >= . cy))
+                    (send (snip->style snip) switch-to dc old-style)
+                    (let ([old-style (snip->style snip)])
+                      (let ([x (+ (loc-x loc) dx)]
+                            [y (+ (loc-y loc) dy)])
+                        
+                        (send snip draw
+                              dc x y dcx dcy dcr dcb dx dy 
+                              (if (eq? snip s-caret-snip)
+                                  show-caret
+                                  'no-caret))
+
+                        (when (and (eq? show-caret 'show-caret)
+                                   s-own-caret?
+                                   selection-visible?
+                                   (loc-selected? loc))
+                          (let ([oldbrush (send dc get-brush)]
+                                [oldpen (send dc get-pen)])
+                            (send dc set-brush black-brush)
+                            (send dc set-pen invisi-pen)
+
+                            (let ([r (+ (loc-r loc) dx)]
+                                  [b (+ (loc-b loc) dy)]
+                                  [hm (+ (loc-hm loc) dx)]
+                                  [vm (+ (loc-vm loc) dy)]
+                                  [rect
+                                   (lambda (x y)
+                                     (send dc draw-rectangle 
+                                           (- x HALF-DOT-WIDTH) (- y HALF-DOT-WIDTH)
+                                           DOT-WIDTH DOT-WIDTH))])
+                              (rect x y)
+                              (rect hm y)
+                              (rect r y)
+                              (rect r vm)
+                              (rect r b)
+                              (rect hm b)
+                              (rect x b)
+                              (rect x vm))
+
+                            (send dc set-pen oldpen)
+                            (send dc set-brush oldbrush))))))
+
+                  (loop (snip->prev snip) old-style))
+                (let ([bs (send s-style-list basic-style)])
+                  (send bs switch-to dc old-style))))
+
+          (on-paint #f dc cx cy cr cb dx dy 
+                    (if (not s-caret-snip)
+                        show-caret
+                        'no-caret))
+
+          (set! flow-locked? #f)
+          (set! write-locked (sub1 write-locked))))))
+
+  ;; called by the administrator to trigger a redraw
+  (def/override (refresh [real? left] [real? top] [nonnegative-real? width] [nonnegative-real? height]
+                         [(symbol-in no-caret show-inactive-caret show-caret) show-caret]
+                         [(make-or-false color%) bg-color])
+
+    (cond
+     [(not s-admin) (void)]
+     [(or (width . <= . 0) (height . <= . 0)) (void)]
+     [(or flow-locked? (positive? sequence))
+      ;; we're busy. invalidate so that everything is refreshed later.
+      (update left top width height)]
+     [else
+      (let-boxes ([x 0.0]
+                  [y 0.0]
+                  [dc #f])
+          (set-box! dc (send s-admin get-dc x y))
+        (when dc
+          (begin-sequence-lock)
+          
+          (send s-offscreen ready-offscreen width height)
+
+          ;; make sure all location information is integral,
+          ;; so we can shift the coordinate system and generally
+          ;; update on pixel boundaries
+          (let ([x (->long (floor x))]
+                [y (->long (floor y))]
+                [bottom (->long (ceiling (+ top height)))]
+                [right (->long (ceiling (+ left width)))]
+                [top (->long (floor top))]
+                [left (->long (floor left))])
+            (let ([width (- right left)]
+                  [height (- bottom top)]
+                  [ps? (or (dc . is-a? . post-script-dc%)
+                           (dc . is-a? . printer-dc%))])
+
+              (if (and bg-color
+                       (not (send s-offscreen is-in-use?))
+                       (send s-offscreen get-bitmap)
+                       (send (send s-offscreen get-bitmap) ok?)
+                       (send (send s-offscreen get-dc) ok?)
+                       (not ps?))
+                  ;; draw to offscreen
+                  (begin
+                    (draw (send s-offscreen get-dc) (- left) (- top) left top width height show-caret bg-color)
+                    
+                    (send dc draw-bitmap-section 
+                          (send (send s-offscreen get-dc) get-bitmap) 
+                          (- left x) (- top y) 
+                          0 0 width height 'solid)
+                    
+                    (send s-offscreen set-last-used #f)
+                    (send s-offscreen set-in-use #f))
+                  ;; draw directly
+                  (let ([pen (send dc get-pen)]
+                        [brush (send dc get-brush)]
+                        [font (send dc get-font)]
+                        [fg (send dc get-text-foreground)]
+                        [bg (send dc get-text-background)]
+                        [bgmode (send dc get-text-mode)]
+                        [rgn (send dc get-clipping-region)])
+
+                    (send dc set-clipping-rect (- left x) (- top y) width height)
+
+                    (draw dc (- x) (- y) left top width height show-caret bg-color)
+
+                    (send dc set-clipping-region rgn)
+
+                    (send dc set-brush brush)
+                    (send dc set-pen pen)
+                    (send dc set-font font)
+                    (send dc set-text-foreground fg)
+                    (send dc set-text-background bg)
+                    (send dc set-text-mode bgmode)))))
+
+          (end-sequence-lock)))]))
+  ;; ----------------------------------------
+
+  (define/private (loc-resize loc dc)
+    (let-boxes ([ww 0.0]
+                [hh 0.0])
+        (send (loc-snip loc) get-extent dc (loc-x loc) (loc-y loc) ww hh #f #f #f #f)
+      (set-loc-w! loc ww)
+      (set-loc-h! loc hh)
+      (set-loc-r! loc (+ (loc-x loc) ww))
+      (set-loc-b! loc (+ (loc-y loc) hh))
+      (set-loc-hm! loc (+ (loc-x loc) (/ ww 2)))
+      (set-loc-vm! loc (+ (loc-y loc) (/ hh 2)))
+      (set-loc-need-resize?! loc #f)))
+  
+  (define/private (check-recalc)
+    (when s-admin
+      (let ([dc (send s-admin get-dc)])
+        (when dc
+          (when need-resize?
+            (let-values ([(r b)
+                          (for/fold ([r 0.0]
+                                     [b 0.0])
+                              ([loc (in-hash-values snip-location-list)])
+                            (when size-cache-invalid?
+                              (send (loc-snip loc) size-cache-invalid)
+                              (set-loc-need-resize?! loc #t))
+                            (when (loc-need-resize? loc)
+                              (loc-resize loc dc))
+                            (values (max r (+ (loc-r loc) HALF-DOT-WIDTH))
+                                    (max b (+ (loc-b loc) HALF-DOT-WIDTH))))])
+
+              (set! real-width (max (min r (if (symbol? max-width) +inf.0 max-width))
+                                    (if (symbol? min-width) -inf.0 min-width)))
+              (set! real-height (max (min b (if (symbol? max-height) +inf.0 max-height))
+                                     (if (symbol? min-height) -inf.0 min-height)))
+
+              (set! need-resize? #f)))
+
+          (set! size-cache-invalid? #f)
+
+          (when (not keep-size?)
+            (when (or (not (= real-width total-width))
+                      (not (= real-height total-height)))
+              (set! total-width real-width)
+              (set! total-height real-height)
+              (send s-admin resized #f)))))))
+
+  (define/private (update x y w h)
+    (unless (and delayedscrollsnip
+                 (zero? sequence)
+                 (not flow-locked?)
+                 (let ([s delayedscrollsnip])
+                   (set! delayedscrollsnip #f)
+                   (scroll-to s
+                              delayedscroll-x delayedscroll-y
+                              delayedscroll-w delayedscroll-h
+                              #t delayedscrollbias)))
+      (let ([r (+ x w)]
+            [b (+ y h)])
+        (let ([x (max x 0.0)]
+              [y (max y 0.0)]
+              [r (max r 0.0)]
+              [b (max b 0.0)])
+          
+          (set! no-implicit-update? #f)
+
+          (if (not update-nonempty?)
+              (begin
+                (set! update-top y)
+                (set! update-left x)
+                (set! update-bottom (if (h . < . 0) h b))
+                (set! update-right (if (w . < . 0) w r))
+                (set! update-nonempty? #t))
+              (begin
+                (set! update-top (min y update-top))
+                (set! update-left (min x update-left))
+                (let ([ub (if (and (h . < . 0) (update-bottom . > . 0))
+                              (- update-bottom)
+                              update-bottom)])
+                  (set! update-bottom
+                        (if (ub . < . 0)
+                            (if (and (h . < . 0) (h . < . ub))
+                                h
+                                (if (and (h . > . 0)
+                                         ((- b) . < . ub))
+                                    (- b)
+                                    ub))
+                            (max b ub))))
+                (let ([ur (if (and (w . < . 0) (update-right . > . 0))
+                              (- update-right)
+                              update-right)])
+                  (set! update-right
+                        (if (ur . < . 0)
+                            (if (and (w . < . 0) (w . < . ur))
+                                w
+                                (if (and (w . > . 0)
+                                         ((- r) . < . ur))
+                                    (- r)
+                                    ur))
+                            (max r ur))))))
+
+          (unless (or (positive? sequence)
+                      (not s-admin)
+                      flow-locked?)
+            (check-recalc)
+
+            (when (update-bottom . < . 0)
+              (set! update-bottom (- update-bottom))
+              (when (update-bottom . < . real-height)
+                (set! update-bottom real-height)))
+
+            (when (update-right . < . 0)
+              (set! update-right (- update-right))
+              (when (update-right . < . real-width)
+                (set! update-right real-width)))
+
+            (set! update-nonempty? #f)
+
+            (when changed?
+              (set! changed? #f)
+              (set! write-locked (add1 write-locked))
+              (on-change)
+              (set! write-locked (sub1 write-locked)))
+
+            (when (or (not (= update-top update-bottom))
+                      (not (= update-left update-right)))
+              (let ([w (+ (- update-right update-left) 1)]
+                    [h (+ (- update-bottom update-top) 1)])
+                (when (and (w . > . 0) (h . > . 0))
+                  (send s-admin needs-update update-left update-top w h)))))))))
+
+  
+  (define/private (update-location loc)
+    (when s-admin
+      (when (loc-need-resize? loc)
+        (let ([dc (send s-admin get-dc)])
+          (when dc
+            (loc-resize loc dc))
+          ;; otherwise, still need resize...
+          ))
+      (update (- (loc-x loc) HALF-DOT-WIDTH)
+              (- (loc-y loc) HALF-DOT-WIDTH)
+              (+ (loc-w loc) DOT-WIDTH)
+              (+ (loc-h loc) DOT-WIDTH))))
+  
+  (define/private (update-snip snip)
+    (let ([loc (snip-loc snip)])
+      (when loc
+        (update-location loc))))
+
+  (define/private (update-selected)
+    (begin-edit-sequence)
+    (for ([loc (in-hash-values snip-location-list)])
+      (when (loc-selected? loc)
+	(update-location loc)))
+    (end-edit-sequence))
+
+  (define/private (update-all)
+    (update 0.0 0.0 -1.0 -1.0))
+
+  (define/private (update-needed)
+    (when (or (and update-nonempty?
+                   (not no-implicit-update?))
+              delayedscrollsnip)
+      (update update-left update-top 0 0)))
+
+  (def/override (invalidate-bitmap-cache [real? [x 0.0]] 
+                                         [real? [y 0.0]]
+                                         [(make-alts nonnegative-real? (symbol-in end)) [w 'end]]
+                                         [(make-alts nonnegative-real? (symbol-in end)) [h 'end]])
+    (update x y (if (symbol? w) -1.0 w) (if (symbol? h) -1.0 h)))
+
+  ;; ----------------------------------------
+
+  (def/override (own-caret [any? ownit?])
+    (when (do-own-caret ownit?)
+      (update-selected)
+      (on-focus ownit?)))
+
+  (def/override (blink-caret)
+    (when s-caret-snip
+      (let-boxes ([dc #f]
+                  [dx 0.0]
+                  [dy 0.0])
+          (set-box! dc (send s-admin get-dc dx dy))
+        (when dc
+          (let-boxes ([x 0.0]
+                      [y 0.0]
+                      [ok? #f])
+              (set-box! ok? (get-snip-location s-caret-snip y))
+            (when ok?
+              (send s-caret-snip blink-caret dc (- x dx) (- y dy))))))))
+
+  (def/override (size-cache-invalid)
+    (set! size-cache-invalid? #t)
+    (set! need-resize? #t))
+
+  (def/override (get-extent [maybe-box? w] [maybe-box? h])
+    (check-recalc)
+    (when w (set-box! w total-width))
+    (when h (set-box! h total-height)))
+
+  ;; ----------------------------------------
+
+  (def/public (scroll-to [snip% snip] [real? localx] [real? localy]
+                         [nonnegative-real? w] [nonnegative-real? h]
+                         [any? refresh?]
+                         [(symbol-in start end none) [bias 'none]])
+    (cond
+     [(positive? sequence)
+      (set! delayedscrollsnip snip)
+      (set! delayedscroll-x localx)
+      (set! delayedscroll-y localy)
+      (set! delayedscroll-w w)
+      (set! delayedscroll-h h)
+      #f]
+     [s-admin
+      (let-boxes ([x 0.0]
+                  [y 0.0])
+          (get-snip-location snip x y)
+        (if (scroll-editor-to (+ x localx) (+ y localy) w h refresh? bias)
+            (begin
+              (set! update-top 0.0)
+              (set! update-left 0.0)
+              (set! update-bottom -1.0)
+              (set! update-right -1.0)
+              (set! update-nonempty? #t)
+              #t)
+            #f))]
+     [else #f]))
+  
+  (def/override (set-caret-owner [(make-or-false snip%) snip] 
+                                 [(symbol-in immediate display global) [dist 'immediate]])
+    (when (do-set-caret-owner snip dist)
+      (update-all)
+      (on-focus (not snip))))
+
+  (def/override (resized [snip% snip] [any? redraw-now?])
+    (let ([loc (snip-loc snip)])
+      (when (and loc
+                 (not (loc-need-resize? loc)))
+        (set! changed? #t)
+
+        (let ([niu? (or (not update-nonempty?)
+                        no-implicit-update?)])
+          
+          (when (not redraw-now?)
+            (set! sequence (add1 sequence)))
+          (begin-edit-sequence)
+          
+          (update-location loc)
+
+          (set-loc-need-resize?! loc #t)
+          (set! need-resize? #t)
+
+          (update-location loc)
+
+          (end-edit-sequence)
+          (when (not redraw-now?)
+            (set! sequence (sub1 sequence)))
+          (when niu?
+            (set! no-implicit-update? #t))))))
+  
+  (def/override (recounted [snip% snip] [any? redraw-now?])
+    (resized snip redraw-now?)
+    #t)
+
+  (def/override (needs-update [snip% snip]
+                              [real? localx] [real? localy]
+                              [nonnegative-real? w] [nonnegative-real? h])
+    (let-boxes ([x 0.0]
+                [y 0.0])
+        (get-snip-location snip x y)
+      (update (+ x localx) (+ y localy) w h)))
+  
+  (def/override (release-snip [snip% snip])
+    (if (-delete snip #f) 
+        (begin
+          (when (and (not (snip->admin snip))
+                     (has-flag? (snip->flags snip) OWNED))
+            (set-snip-flags! snip (remove-flag (snip->flags snip) OWNED)))
+          #t)
+        #f))
+
+  ;; ----------------------------------------
+
+  (def/override (scroll-line-location [exact-integer? line])
+    (* line scroll-step))
+
+  (def/override (num-scroll-lines)
+    (->long (/ (- (+ total-height scroll-step) 1) scroll-step)))
+  
+  (def/override (find-scroll-line [real? y])
+    (->long (/ y scroll-step)))
+
+  (def/public (set-scroll-step [real? s])
+    (unless (= scroll-step s)
+      (set! scroll-step s)
+      (when s-admin
+        (send s-admin resized #t))))
+
+  (def/public (get-scroll-step)
+    scroll-step)
+
+  ;; ----------------------------------------
+  
+  (def/override (set-min-width [real? w])
+    (set! min-width (if (w . <= . 0) 'none w))
+    (set! need-resize? #t)
+    (update-all))
+  
+  (def/override (set-max-width [real? w])
+    (set! max-width (if (w . <= . 0) 'none w))
+    (set! need-resize? #t)
+    (update-all))
+  
+  (def/override (set-min-height [real? h])
+    (set! min-height (if (h . <= . 0) 'none h))
+    (set! need-resize? #t)
+    (update-all))
+  
+  (def/override (set-max-height [real? h])
+    (set! max-height (if (h . <= . 0) 'none h))
+    (set! need-resize? #t)
+    (update-all))
+  
+  (def/override (get-min-width) min-width)
+  (def/override (get-max-width) max-width)
+  (def/override (get-min-height) min-height)
+  (def/override (get-max-height) max-height)
+
+  ;; ----------------------------------------
+
+  (def/override (copy-self)
+    (let ([pb (new pasteboard%)])
+      (copy-self-to pb)
+      pb))
+  
+  (def/override (copy-self-to [editor<%> pb])
+    (when (pb . is-a? . pasteboard%)
+      (super copy-self-to pb)
+      (send pb set-dragable (get-dragable))
+      (send pb set-selection-visible (get-selection-visible))
+      (send pb set-scroll-step (get-scroll-step))))
+  
+  ;; ----------------------------------------
+
+  (def/override (get-descent) 0.0)
+  (def/override (get-space) 0.0)
+
+  (define/private (get-center)
+    (let-boxes ([x 0.0]
+                [y 0.0]
+                [w 0.0]
+                [h 0.0])
+        (if (not s-admin)
+            (begin
+              (set-box! w total-width)
+              (set-box! h total-height))
+            (send s-admin get-view x y w h #t))
+      (let ([w (if (w . > . 1000.0)
+                   500.0 ; don't belive it
+                   w)]
+            [h (if (h . > . 1000.0)
+                   500.0 ; don't belive it
+                   h)])
+        (values (/ w 2)
+                (/ h 2)))))
+
+  ;; ----------------------------------------
+
+  (def/override (get-flattened-text)
+    (let ([p (open-output-string)])
+      (let loop ([s snips])
+        (when s
+          (display (send s get-text 0 (snip->count s) #t) p)
+          (loop (snip->next s))))
+      (get-output-string p)))
+
+  (def/override (clear) (delete))
+
+  (def/override (cut [any? [extend? #f]] [exact-integer? [time 0]])
+    (copy extend? time)
+    (clear))
+
+  (def/override (do-copy [exact-integer? time] [bool? extend?])
+    (set-common-copy-region-data! #f)
+    (let ([sl (if (and extend?
+                       copy-style-list)
+                  copy-style-list
+                  s-style-list)])
+      (let loop ([snip snips])
+        (when snip
+          (let ([loc (snip-loc snip)])
+            (when (loc-selected? loc)
+              (let ([asnip (send snip copy)])
+                (send asnip set-admin #f)
+                (set-snip-style! asnip (send sl convert (snip->style asnip)))
+                (cons-common-copy-buffer! asnip)
+                (cons-common-copy-buffer2! (get-snip-data snip)))))
+          (loop (snip->next snip))))
+      (install-copy-buffer time sl)))
+  
+  (def/override (copy [bool? extend?] [exact-integer? time])
+    (begin-copy-buffer)
+    (when (not extend?)
+      (free-old-copies))
+    (do-copy time extend?)
+    (end-copy-buffer))
+
+  (define/private (do-generic-paste cb time)
+    (unless (or s-user-locked?
+                (positive? write-locked))
+      (let-values ([(start) snips]
+                   [(cx cy) (get-center)])
+
+        (do-buffer-paste cb time)
+        
+        (if (and s-admin
+                 (not (eq? snips start)))
+            (let ([dc (get-dc)])
+              (when dc
+                ;; get top/left/bottom/right of pasted group:
+                (let loop ([snip snips]
+                           [left +inf.0]
+                           [top +inf.0]
+                           [right -inf.0]
+                           [bottom -inf.0])
+                  (if (eq? snip start)
+                      (let ([dx (- cx (/ (left + right) 2))]
+                            [dy (- cy (/ (top + bottom) 2))])
+                        ;; shift the pasted group to center:
+                        (move dx dy))
+                      (let ([loc (snip-loc snip)])
+                        (add-selected snip)
+                        (when (loc-need-resize? loc)
+                          (loc-resize loc dc))
+                        (loop (snip->next snip)
+                              (min (loc-x loc) left)
+                              (min (loc-y loc) top)
+                              (max (loc-r loc) right)
+                              (max (loc-b loc) bottom)))))))
+            ;; just select them:
+            (let loop ([snip snips])
+              (unless (eq? snip start)
+                (add-selected snip)
+                (loop (snip->next snip))))))))
+
+  (def/override (do-paste [exact-integer? time])
+    (do-generic-paste the-clipboard time))
+
+  (def/override (do-paste-x-selection [exact-integer? time])
+    (do-generic-paste the-x-selection-clipboard time))
+  
+  (define/private (generic-paste x-sel? time)
+    (unless (or s-user-locked?
+                (positive? write-locked))
+      (begin-edit-sequence)
+      (no-selected)
+      (if x-sel?
+          (do-paste-x-selection time)
+          (do-paste time))
+      (end-edit-sequence)))
+  
+  (def/override (paste [exact-integer? time])
+    (generic-paste #f time))
+
+  (def/override (paste-x-selection [exact-integer? time])
+    (generic-paste #t time))
+
+  (define/override (insert-paste-snip snip data)
+    (insert snip snip)
+    (set-snip-data snip data))
+
+  (define/override (insert-paste-string str)
+    (let ([snip (new string-snip%)])
+      (set-snip-style! snip (or (get-default-style)
+                                (send s-style-list basic-style)))
+      (send snip insert str)
+      (insert-paste-snip snip #f)))
+  
+  (def/override (kill [exact-integer? time])
+    (cut time))
+
+  (define/override (own-x-selection on? update? force?)
+    (do-own-x-selection on? force?))
+  
+  ;; ----------------------------------------
+
+  (def/override (get-snip-location [snip% thesnip]
+                                   [maybe-box? [x #f]]
+                                   [maybe-box? [y #f]]
+                                   [bool? [bottom-right? #f]])
+    (if (and bottom-right?
+             (not s-admin))
+        #f
+        (begin
+          (when bottom-right?
+            (check-recalc))
+
+          (let ([loc (snip-loc thesnip)])
+            (and loc
+                 (begin
+                   (when x (set-box! x (+ (loc-x loc)
+                                          (if bottom-right?
+                                              (loc-w loc)
+                                              0.0))))
+                   (when y (set-box! y (+ (loc-y loc)
+                                          (if bottom-right?
+                                              (loc-h loc)
+                                              0.0))))
+                   #t))))))
+
+  ;; ----------------------------------------
+
+  (def/override (get-snip-data [snip% snip])
+    (let ([loc (snip-loc snip)]
+          [sup (super get-snip-data snip)])
+      (if (not loc)
+          sup
+          (let ([data (new location-editor-data%
+                           [x (loc-x loc)]
+                           [y (loc-y loc)])])
+            (send data set-next sup)
+            data))))
+
+  (def/override (set-snip-data [snip% snip] [editor-data% data])
+    (let loop ([data data])
+      (when data
+        (let ([c (send data get-dataclass)])
+          (when c
+            (let ([name (send c get-classname)])
+              (when (equal? name "wxloc")
+                (move-to snip (send data get-x) (send data get-y))))))
+        (loop (send data get-next)))))
+
+  (def/override (insert-port [input-port? f] 
+                             [(symbol-in guess same copy standard text text-force-cr) [format 'guess]]
+                             [any? [replace-styles? #f]])
+    (if (or s-user-locked? 
+            (not (zero? write-locked)))
+        'guess ;; FIXME: docs say that this is more specific
+        (do-insert-file (method-name 'pasteboard% 'insert-file) f replace-styles?)))
+  
+  (define/private (do-insert-file who f clear-styles?)
+    (when (not (detect-wxme-file who f #f))
+      (error who "not a WXME file"))
+    (let* ([b (make-object editor-stream-in-file-base% f)]
+           [mf (make-object editor-stream-in% b)])
+      (when (not (and (read-editor-version mf b #f #t)
+                      (read-editor-global-header mf)
+                      (send mf ok?)
+                      (read-from-file mf clear-styles?)
+                      (read-editor-global-footer mf)
+                      (begin
+                        ;; if STD-STYLE wasn't loaded, re-create it:
+                        (send s-style-list new-named-style "Standard" (send s-style-list basic-style))
+                        (send mf ok?))))
+        (error who "error loading the file")))
+    'standard)
+
+  (def/override (save-port [output-port? f]
+                           [(symbol-in guess same copy standard text text-force-cr) [format 'same]]
+                           [any? [show-errors? #t]])
+
+    (let* ([b (make-object editor-stream-out-file-base% f)]
+           [mf (make-object editor-stream-out% b)])
+      (when (not (and (write-editor-version mf b)
+                      (write-editor-global-header mf)
+                      (send mf ok?)
+                      (write-to-file mf)
+                      (write-editor-global-footer mf)
+                      (send mf ok?)))
+        (error (method-name 'pasteboard% 'save-port) "error writing the file"))
+      #t))
+
+  (def/override (write-to-file [editor-stream-out% f])
+    (and (do-write-headers-footers f #t)
+         (write-snips-to-file f s-style-list #f snips #f #f this)
+         (do-write-headers-footers f #f)))
+
+  (def/override (read-from-file [editor-stream-in% f] [bool? overwritestyle?])
+    (if (or s-user-locked? 
+            (not (zero? write-locked)))
+        #f
+        (read-snips-from-file f overwritestyle?)))
+
+  (define/override (do-read-insert snip)
+    (insert snip #f)
+    #t)
+
+  (def/override (set-filename [(make-or-false path-string?) name][any? [temp? #f]])
+    (set! s-filename (if (string? name)
+                         (string->path name)
+                         name))
+    (set! s-temp-filename? temp?)
+    (let loop ([snip snips])
+      (when snip
+        (when (has-flag? (snip->flags snip) USES-BUFFER-PATH)
+          ;; just a notification
+          (send snip set-admin snip-admin))
+        (loop (snip->next snip)))))
+
+  ;; ----------------------------------------
+  
+  (def/override (style-has-changed [(make-or-false style<%>) style])
+    (when (not style)
+      (set! changed? #t)
+      (update-all)))
+  
+  ;; ----------------------------------------
+
+  (def/override (begin-edit-sequence [any? [undoable? #t]] [any? [interrupt-seqs? #t]])
+    (wait-sequence-lock)
+    (when (or (positive? s-noundomode)
+              (not undoable?))
+      (set! s-noundomode (add1 s-noundomode)))
+    (when (and (zero? sequence)
+               (zero? write-locked))
+      (on-edit-sequence))
+    (set! sequence (add1 sequence)))
+
+  (def/override (end-edit-sequence)
+    (set! sequence (sub1 sequence))
+    (when (and (zero? sequence)
+               (zero? write-locked))
+      (set! sequence-streak? #f)
+      (update-needed)
+      (after-edit-sequence))
+    (when (positive? s-noundomode)
+      (set! s-noundomode (sub1 s-noundomode)))
+    (when (and (zero? sequence)
+               s-need-on-display-size?)
+      (set! s-need-on-display-size? #f)
+      (on-display-size)))
+
+  (def/override (refresh-delayed?)
+    (or (positive? sequence)
+        (not s-admin)
+        (send s-admin delay-refresh?)))
+
+  (def/override (in-edit-sequence?)
+    (positive? sequence))
+
+  (def/override (locations-computed?)
+    (not need-resize?))
+
+  ;; ----------------------------------------
+
+  (def/public (get-dragable) dragable?)
+
+  (def/public (set-dragable [bool? d?])
+    (set! dragable? d?))
+
+  (def/public (get-selection-visible) selection-visible?)
+
+  (def/public (set-selection-visible [bool? v])
+    (set! selection-visible? v))
+
+  ;; ----------------------------------------
+
+  (def/public (can-insert? [snip% a] [(make-or-false snip%) b] [real? x] [real? y])
+    #t)
+  (def/public (on-insert [snip% a] [(make-or-false snip%) b] [real? x] [real? y])
+    (void))
+  (def/public (after-insert [snip% a] [(make-or-false snip%) b] [real? x] [real? y])
+    (void))
+
+  (def/public (can-delete? [snip% s])
+    #t)
+  (def/public (on-delete [snip% s])
+    (void))
+  (def/public (after-delete [snip% s])
+    (void))
+
+  (def/public (can-move-to? [snip% s] [real? x] [real? y] [bool? dragging?])
+    #t)
+  (def/public (on-move-to [snip% s] [real? x] [real? y] [bool? dragging?])
+    (void))
+  (def/public (after-move-to [snip% s] [real? x] [real? y] [bool? dragging?])
+    (void))
+
+  (def/public (can-resize? [snip% s] [real? w] [real? h])
+    #t)
+  (def/public (on-resize [snip% s] [real? w] [real? h])
+    (void))
+  (def/public (after-resize [snip% s] [real? w] [real? h] [any? resized?])
+    (void))
+
+  (def/public (can-select? [snip% s] [bool? on?])
+    #t)
+  (def/public (on-select [snip% s] [bool? on?])
+    (void))
+  (def/public (after-select [snip% s] [bool? on?])
+    (void))
+
+  (def/public (can-reorder? [snip% s] [(make-or-false snip%) other] [bool? before?])
+    #t)
+  (def/public (on-reorder [snip% s] [(make-or-false snip%) other] [bool? before?])
+    (void))
+  (def/public (after-reorder [snip% s] [(make-or-false snip%) other] [bool? before?])
+    (void))
+
+  (def/public (can-interactive-move? [mouse-event% e])
+    #t)
+  (def/public (on-interactive-move [mouse-event% e])
+    (void))
+  (def/public (after-interactive-move [mouse-event% e])
+    (void))
+
+  (def/public (can-interactive-resize? [snip% s])
+    #t)
+  (def/public (on-interactive-resize [snip% s])
+    (void))
+  (def/public (after-interactive-resize [snip% s])
+    (void))
+
+  (define/override (do-begin-print dc fit?)
+    (size-cache-invalid)
+    (set! write-locked (add1 write-locked))
+    (on-change)
+    (set! write-locked (sub1 write-locked))
+    #f)
+
+  (define/override (do-end-print dc data)
+    (size-cache-invalid)
+    (set! write-locked (add1 write-locked))
+    (on-change)
+    (set! write-locked (sub1 write-locked)))
+
+  (define/override (do-has-print-page? dc page)
+    (do-has/print-page dc page #f))
+
+  (def/override (print-to-dc [dc<%> dc] [exact-integer? [page -1]])
+    (do-has/print-page dc page #t)
+    (void))
+
+  (define/private (do-has/print-page dc page print?)
+    (check-recalc)
+    
+    (let-values ([(w h) (send dc get-size)])
+      (let-boxes ([w w]
+                  [h h]
+                  [hm 0]
+                  [vm 0])
+          (begin
+            (when (or (zero? (unbox w))
+                      (zero? (unbox h)))
+              (get-default-print-size w h))
+            (send (current-ps-setup) get-editor-marginhm vm))
+        (let ([W (- w (* 2 hm))]
+              [H (- h (* 2 vm))])
+          (let-boxes ([w 0.0]
+                      [h 0.0])
+              (get-extent w h)
+
+            (let ([hcount (->long (ceiling (/ W w)))]
+                  [vcount (->long (ceiling (/ H h)))])
+
+              (if (not print?)
+                  (page . <= . (* hcount vcount))
+                  (let-values ([(start end)
+                                (if (negative? page)
+                                    (values 1 (* hcount vcount))
+                                    (values page page))])
+                    (for ([p (in-range start end)])
+                      (let ([vpos (quotient (- p 1) hcount)]
+                            [hpos (modulo (- p 1) hcount)])
+                        (let ([x (* hpos w)]
+                              [y (* vpos h)])
+                          (when (negative? page)
+                            (send dc start-page)
+                            
+                            (draw dc (+ (- x) hm) (+ (- y) vm)
+                                  x y (+ x w) (+ y h)
+                                  #f
+                                  #f)
+                            (when (negative? page)
+                              (send dc end-page))))))))))))))
+
+  ;; ----------------------------------------
+  )
+
+(set-pasteboard%! pasteboard%)
+
+;; ------------------------------------------------------------
+
+(define/top (add-pasteboard-keymap-functions [keymap% tab])
+  (void))
diff --git a/collects/mred/private/wxme/private.ss b/collects/mred/private/wxme/private.ss
new file mode 100644
index 00000000..816cf7c2
--- /dev/null
+++ b/collects/mred/private/wxme/private.ss
@@ -0,0 +1,140 @@
+#lang scheme/base
+(require scheme/class)
+
+(provide (all-defined-out))
+
+;; snip% and editor%
+(define-local-member-name
+  s-admin)
+
+;; snip%
+(define-local-member-name
+  s-prev set-s-prev
+  s-next set-s-next
+  s-count
+  s-style set-s-style
+  s-line set-s-line
+  s-snipclass set-s-snipclass
+  s-flags set-s-flags
+  s-dtext get-s-dtext
+  s-buffer get-s-buffer
+  str-w set-str-w
+  s-set-flags
+  do-copy-to)
+
+;; string-snip%
+(define-local-member-name
+  insert-with-offset)
+
+;; snip-class%
+(define-local-member-name
+  get-s-required?)
+
+;; editor-data%
+(define-local-member-name
+  get-s-dataclass
+  get-s-next)
+
+;; standard-snip-class-list%, editor-data-class-list%
+(define-local-member-name
+  reset-header-flags
+  find-by-map-position)
+
+;; editor%
+(define-local-member-name
+  s-offscreen
+  s-custom-cursor
+  s-custom-cursor-overrides?
+  s-keymap
+  s-style-list
+  get-s-style-list
+  s-user-locked?
+  s-modified?
+  s-noundomode
+  s-caret-snip
+  s-inactive-caret-threshold
+  s-filename
+  s-need-on-display-size?
+  really-can-edit?
+  copy-out-x-selection
+  own-x-selection
+  do-own-x-selection
+  perform-undo-list
+  copy-ring-next
+  begin-copy-buffer
+  end-copy-buffer
+  free-old-copies
+  install-copy-buffer
+  add-undo-rec
+  read-snips-from-file
+  admin-scroll-to
+  do-buffer-paste
+  insert-paste-snip
+  insert-paste-string
+  paste-region-data
+  setting-admin
+  init-new-admin
+  do-read-insert
+  do-set-caret-owner
+  do-own-caret
+  s-start-intercept
+  s-end-intercept
+  wait-sequence-lock
+  begin-sequence-lock
+  end-sequence-lock
+  check-flow
+  get-printing
+  is-printing?
+  do-begin-print
+  do-end-print
+  do-has-print-page?)
+
+;; text%
+(define-local-member-name
+  get-s-line-spacing
+  get-s-last-snip
+  get-s-total-width
+  get-s-total-height
+  refresh-box
+  add-back-clickback
+  do-insert-snips)
+
+;; editor-admin%
+(define-local-member-name
+  get-s-standard
+  set-s-standard)
+
+;; editor-canvas-editor-admin%
+(define-local-member-name
+  do-get-canvas)
+
+;; editor-stream%
+(define-local-member-name
+  get-sl
+  get-dl
+  set-sl
+  set-dl
+  add-sl
+  add-dl
+  set-s-sll
+  get-s-sll
+  get-s-scl
+  get-s-bdl
+  get-s-style-count
+  set-s-style-count
+  do-reading-version
+  do-map-position
+  do-get-header-flag
+  do-set-header-flag)
+
+;; editor-stream-in%
+(define-local-member-name
+  set-s-read-format
+  get-s-read-format
+  set-s-read-version
+  get-wxme-version)
+
+;; editor-snip%
+(define-local-member-name
+  do-set-graphics)
+
diff --git a/collects/mred/private/wxme/snip-admin.ss b/collects/mred/private/wxme/snip-admin.ss
new file mode 100644
index 00000000..73a23f3a
--- /dev/null
+++ b/collects/mred/private/wxme/snip-admin.ss
@@ -0,0 +1,147 @@
+#lang scheme/base
+(require scheme/class
+         "../syntax.ss"
+         "snip.ss"
+         (only-in "cycle.ss" 
+                  set-snip-admin%!
+                  popup-menu%)
+         "wx.ss")
+
+(provide snip-admin%
+         standard-snip-admin%)
+
+(defclass snip-admin% object%
+  (super-new)
+
+  (def/public (get-editor) #f)
+  (def/public (get-dc) #f)
+  (def/public (get-view-size [maybe-box? w] [maybe-box? h])
+    #f)
+
+  (def/public (get-view [maybe-box? x] [maybe-box? y] [maybe-box? w] [maybe-box? h] 
+                        [(make-or-false snip%) snip])
+    #f)
+
+  (def/public (scroll-to [snip% s]
+                         [real? x] [real? y]
+                         [nonnegative-real? w] [nonnegative-real? h]
+                         [any? refresh?]
+                         [(symbol-in start end none) [bias 'none]])
+    #f)
+
+  (def/public (set-caret-owner [snip% s] [(symbol-in imeditorte display global) dist])
+    (void))
+
+  (def/public (resized [snip% s] [any? redraw?]) (void))
+
+  (def/public (recounted [snip% s] [any? redraw?]) (void))
+
+  (def/public (needs-update [snip% s] [real? x] [real? y]
+                            [nonnegative-real? w] [nonnegative-real? h])
+    (void))
+
+  (def/public (release-snip [snip% s]) #f)
+
+  (def/public (update-cursor) (void))
+
+  (def/public (popup-menu [popup-menu% p][snip% snip][real? x][real? y])
+    #f)
+
+  (def/public (modified [snip% s] [any? modified?])
+    (void)))
+
+(set-snip-admin%! snip-admin%)
+
+(defclass standard-snip-admin% snip-admin%
+  (init-field editor)
+
+  (super-new)
+
+  (def/override (get-editor) editor)
+  (def/override (get-dc) (send editor get-dc))
+  (def/override (get-view-size [maybe-box? w] [maybe-box? h])
+    (get-view #f #f w h #f))
+
+  (def/override (get-view [maybe-box? x] [maybe-box? y] [maybe-box? w] [maybe-box? h] 
+                          [(make-or-false snip%) snip])
+    (let ([admin (send editor get-admin)]
+          [zeros (lambda ()
+                   (when x (set-box! x 0.0))
+                   (when y (set-box! y 0.0))
+                   (when w (set-box! w 0.0))
+                   (when h (set-box! h 0.0)))])
+      (if snip
+          (if admin
+              (let-boxes ([mx 0.0] [my 0.0]
+                          [mw 0.0] [mh 0.0])
+                  (send admin get-view mx my mw mh #f)
+                (let ([mb (+ my mh)]
+                      [mr (+ mx mw)])
+                  (let-boxes ([ok? #f]
+                              [sl 0.0]
+                              [st 0.0])
+                      (set-box! ok? (send editor get-snip-location snip sl st #f))
+                    (if ok?
+                        (let-boxes ([sr 0.0][sb 0.0])
+                            (send editor get-snip-location snip sr sb #t)
+                          (let ([l (max mx sl)]
+                                [t (max my st)]
+                                [r (min mr sr)]
+                                [b (min mb sb)])
+                            (when x (set-box! x (- l sl)))
+                            (when y (set-box! y (- t st)))
+                            (when w (set-box! w (max 0 (- r l))))
+                            (when h (set-box! h (max 0 (- b t))))))
+                        (zeros)))))
+              (zeros))
+          (if admin
+              (send admin get-view x y w h #t)
+              (zeros)))))
+
+  (def/override (scroll-to [snip% s]
+                           [real? localx] [real? localy]
+                           [nonnegative-real? w] [nonnegative-real? h]
+                           [any? [refresh? #t]]
+                           [(symbol-in start end none) [bias 'none]])
+    (and (eq? (send s get-admin) this)
+         (send editor scroll-to s localx localy w h refresh? bias)))
+
+  (def/override (set-caret-owner [snip% s] [(symbol-in imeditorte display global) dist])
+    (when (eq? (send s get-admin) this)
+      (send editor set-caret-owner s dist)))
+
+  (def/override (resized [snip% s] [any? redraw?])
+    (when (eq? (send s get-admin) this)
+      (send editor resized s redraw?)))
+
+  (def/override (recounted [snip% s] [any? redraw?])
+    (when (eq? (send s get-admin) this)
+      (send editor recounted s redraw?)))
+
+  (def/override (needs-update [snip% s] [real? localx] [real? localy]
+                              [nonnegative-real? w] [nonnegative-real? h])
+    (when (eq? (send s get-admin) this)
+      (send editor needs-update s localx localy w h)))
+
+  (def/override (release-snip [snip% s])
+    (and (eq? (send s get-admin) this)
+         (send editor release-snip s)))
+
+  (def/override (update-cursor)
+    (let ([admin (send editor get-admin)])
+      (when admin
+        (send admin update-cursor))))
+
+  (def/override (popup-menu [popup-menu% m][snip% snip][real? x][real? y])
+    (let ([admin (send editor get-admin)])
+      (and admin
+           (let-boxes ([sl 0.0]
+                       [st 0.0]
+                       [ok? #f])
+               (set-box! ok? (send editor get-snip-location snip sl st #f))
+             (and ok?
+                  (send admin popup-menu m (+ x sl) (+ y st)))))))
+
+  (def/override (modified [snip% s] [any? modified?])
+    (when (eq? (send s get-admin) this)
+      (send editor on-snip-modified s modified?))))
\ No newline at end of file
diff --git a/collects/mred/private/wxme/stream.ss b/collects/mred/private/wxme/stream.ss
new file mode 100644
index 00000000..10aa45c1
--- /dev/null
+++ b/collects/mred/private/wxme/stream.ss
@@ -0,0 +1,761 @@
+#lang scheme/base
+(require scheme/class
+         "../syntax.ss"
+         "private.ss"
+         "snip.ss"
+         (only-in "cycle.ss"
+                  set-editor-stream-in%!
+                  set-editor-stream-out%!))
+
+(provide editor-stream-in%
+         editor-stream-out%
+         editor-stream-in-base%
+         editor-stream-in-bytes-base%
+         editor-stream-in-file-base%
+         editor-stream-out-base%
+         editor-stream-out-bytes-base%
+         editor-stream-out-file-base%)
+
+;; ----------------------------------------
+
+(defclass editor-stream% object%
+
+  (super-new)
+
+  (define scl (get-the-snip-class-list))
+  (define bdl (get-the-editor-data-class-list))
+  (define/public (get-s-scl) scl)
+  (define/public (get-s-bdl) bdl)
+
+  (define sl null)
+  (define dl null)
+
+  (define/public (get-sl) sl)
+  (define/public (get-dl) dl)
+  (define/public (set-sl n) (set! sl n))
+  (define/public (set-dl n) (set! dl n))
+  (define/public (add-sl v) (set! sl (cons v sl)))
+  (define/public (add-dl v) (set! dl (cons v dl)))
+
+  (define sll null)
+  (define style-count 0)
+  (define/public (get-s-sll) sll)
+  (define/public (set-s-sll v) (set! sll v))
+  (define/public (get-s-style-count) style-count)
+  (define/public (set-s-style-count v) (set! style-count v))
+
+  (define/public (do-reading-version sclass)
+    (or (ormap (lambda (scl)
+                 (and (eq? (snip-class-link-c scl) sclass)
+                      (snip-class-link-reading-version scl)))
+               sl)
+        ;; Class didn't show up in the header?
+        ;; Assume we're reading the current version.
+        (send sclass get-version)))
+
+  (define/public (do-map-position sclass-or-dclass)
+    (if (sclass-or-dclass . is-a? . snip-class%)
+        (or (ormap (lambda (scl)
+                     (and (eq? (snip-class-link-c scl) sclass-or-dclass)
+                          (snip-class-link-map-position scl)))
+                   sl)
+            -1)
+        (or (ormap (lambda (dcl)
+                     (and (eq? (editor-data-class-link-c dcl) sclass-or-dclass)
+                          (editor-data-class-link-map-position dcl)))
+                   dl)
+            -1)))
+
+  (define/public (do-get-header-flag sclass)
+    (or (ormap (lambda (scl)
+                 (and (eq? (snip-class-link-c scl) sclass)
+                      (snip-class-link-header-flag scl)))
+               sl)
+        0))
+
+  (define/public (do-set-header-flag sclass)
+    (ormap (lambda (scl)
+             (and (eq? (snip-class-link-c scl) sclass)
+                  (begin
+                    (set-snip-class-link-header-flag! scl #t)
+                    #t)))
+           sl)
+    (void)))
+
+;; ----------------------------------------
+
+(defclass editor-stream-in-base% object%
+  (super-new)
+  (def/public (tell) 0)
+  (def/public (seek [exact-nonnegative-integer? i]) (void))
+  (def/public (skip [exact-nonnegative-integer? i]) (void))
+  (def/public (bad?) #t)
+  (def/public (read [vector? v])
+    (let ([s (make-bytes (vector-length v))])
+      (let ([n (read-bytes s)])
+        (for ([i (in-range n)])
+          (vector-set! v i (integer->char (bytes-ref s i))))
+        n)))
+  (def/public (read-bytes [bytes? v]
+                          [exact-nonnegative-integer? [start 0]]
+                          [exact-nonnegative-integer? [end (bytes-length v)]]) 
+    0))
+
+(defclass editor-stream-out-base% object%
+  (super-new)
+  (def/public (tell) 0)
+  (def/public (seek [exact-nonnegative-integer? i]) (void))
+  (def/public (skip [exact-nonnegative-integer? i]) (void))
+  (def/public (bad?) #t)
+  (def/public (write [(make-list char?) v])
+    (write-bytes (string->bytes/latin-1 (list->string v) (char->integer #\?))))
+  (def/public (write-bytes [bytes? v]
+                           [exact-nonnegative-integer? [start 0]]
+                           [exact-nonnegative-integer? [end (bytes-length v)]])
+    (void)))
+
+;; ----------------------------------------
+
+(defclass editor-stream-in-port-base% editor-stream-in-base%
+  (init-field port)
+  (super-new)
+
+  (def/override (tell)
+    (file-position port))
+
+  (def/override (seek [exact-nonnegative-integer? i])
+    (file-position port i))
+
+  (def/override (skip [exact-nonnegative-integer? i])
+    (file-position port (+ i (file-position port))))
+
+  (def/override (bad?) #f)
+
+  (def/override (read-bytes [bytes? v]
+                            [exact-nonnegative-integer? [start 0]]
+                            [exact-nonnegative-integer? [end (bytes-length v)]]) 
+    (let ([r (read-bytes! v port start end)])
+      (if (eof-object? r)
+          0
+          r))))
+
+(defclass editor-stream-in-file-base% editor-stream-in-port-base%
+  (super-new))
+
+(defclass editor-stream-in-bytes-base% editor-stream-in-port-base%
+  (init s)
+  (super-new [port (open-input-bytes s)]))
+
+;; ----------------------------------------
+
+(define write-bytes-proc write-bytes)
+
+(defclass editor-stream-out-port-base% editor-stream-out-base%
+  (init-field port)
+  (super-new)
+
+  (def/override (tell)
+    (file-position port))
+
+  (def/override (seek [exact-nonnegative-integer? i])
+    (file-position port i))
+
+  (def/override (skip [exact-nonnegative-integer? i])
+    (file-position port (+ i (file-position port))))
+
+  (def/override (bad?) #f)
+
+  (def/override (write-bytes [bytes? v]
+                             [exact-nonnegative-integer? [start 0]]
+                             [exact-nonnegative-integer? [end (bytes-length v)]]) 
+    (write-bytes-proc v port start end)))
+
+(defclass editor-stream-out-file-base% editor-stream-out-port-base%
+  (super-new))
+
+(defclass editor-stream-out-bytes-base% editor-stream-out-port-base%
+  (define s (open-output-bytes))
+  (super-new [port s])
+
+  (def/public (get-bytes)
+    (get-output-bytes s)))
+
+;; ----------------------------------------
+
+(defclass editor-stream-in% editor-stream%
+  (init-rest args)
+
+  (define f
+    (case-args
+     args
+     [([editor-stream-in-base% base]) base]
+     (init-name 'editor-stream-in%)))
+
+  (define boundaries null)
+  (define is-bad? #f)
+  (define items 0)
+  (define pos-map (make-hash))
+
+  (define read-version 8)
+  (define s-read-version #"08")
+
+  (super-new)
+
+  (define/public (set-s-read-version bstr)
+    (set! s-read-version bstr)
+    (set! read-version (or (string->number (bytes->string/utf-8 bstr)) 0)))
+  (define/public (get-wxme-version) read-version)
+
+  (define s-read-format #"WXME")
+  (define/public (set-s-read-format bstr)
+    (set! s-read-format bstr))
+  (define/public (get-s-read-format)
+    s-read-format)
+
+  (define/private (do-skip-whitespace)
+    (define (bad!) (set! is-bad? #t) 0)
+    (if is-bad?
+        0
+        (let ([s (make-bytes 1)])
+          (let loop ([prev-byte 0])
+            (if (not (= 1 (send f read-bytes s)))
+                (bad!)
+                (let ([b (bytes-ref s 0)])
+                  (case (integer->char b)
+                    [(#\#)
+                     (let ([pos (send f tell)])
+                       (if (and (= 1 (send f read-bytes s))
+                                (= (bytes-ref s 0) (char->integer #\|)))
+                           ;; skip to end of comment
+                           (let cloop ([saw-bar? #f]
+                                       [saw-hash? #f]
+                                       [nesting 0])
+                             (if (not (= 1 (send f read-bytes s)))
+                                 (bad!)
+                                 (cond
+                                  [(and saw-bar? (= (bytes-ref s 0) (char->integer #\#)))
+                                   (if (zero? nesting)
+                                       (loop (char->integer #\space))
+                                       (cloop #f #f (sub1 nesting)))]
+                                  [(and saw-hash? (= (bytes-ref s 0) (char->integer #\|)))
+                                   (cloop #t #f (add1 nesting))]
+                                  [else (cloop (= (bytes-ref s 0) (char->integer #\|))
+                                               (= (bytes-ref s 0) (char->integer #\#))
+                                               nesting)])))
+                           (begin
+                             (send f seek pos)
+                             (char->integer #\#))))]
+                    [(#\;)
+                     ;; skip to end of comment
+                     (let cloop ()
+                       (if (not (= 1 (send f read-bytes s)))
+                           (bad!)
+                           (if (or (= (bytes-ref s 0) (char->integer #\newline))
+                                   (= (bytes-ref s 0) (char->integer #\return)))
+                               (loop (char->integer #\space))
+                               (cloop))))]
+                    [else
+                     (if (char-whitespace? (integer->char b))
+                         (loop b)
+                         b)])))))))
+
+  (define/private (skip-whitespace [buf #f])
+    (let ([c (do-skip-whitespace)])
+      (when buf
+        (bytes-set! buf 0 c))
+      c))
+
+  (define/private (is-delim? b)
+    (cond
+     [(char-whitespace? (integer->char b)) #t]
+     [(= b (char->integer #\#))
+      (let ([pos (send f tell)]
+            [s (make-bytes 1)])
+        (send f read-bytes s)
+        (let ([d? (= (bytes-ref s 0) (char->integer #\|))])
+          (send f seek (if d? (sub1 pos) pos))
+          d?))]
+     [(= b (char->integer #\;))
+      (send f seek (sub1 (send f tell)))
+      #t]
+     [else #f]))
+
+  (define/private (get-number get-exact?)
+    (let ([c0 (skip-whitespace)])
+      (if (check-boundary)
+          (if get-exact? 0 0.0)
+          (let* ([s (make-bytes 1)]
+                 [l (cons (integer->char c0)
+                          (let loop ([counter 50])
+                            (if (zero? counter)
+                                null
+                                (if (= 1 (send f read-bytes s))
+                                    (let ([s (bytes-ref s 0)])
+                                      (if (is-delim? s)
+                                          null
+                                          (cons (integer->char s)
+                                                (loop (sub1 counter)))))
+                                    null))))])
+            (inc-item-count)
+            (let ([n (string->number (list->string l))])
+              (cond
+               [(or (not n) 
+                    (not (real? n))
+                    (and get-exact? (not (exact-integer? n))))
+                (set! is-bad? #t)
+                (if get-exact? 0 0.0)]
+               [get-exact? n]
+               [else
+                (exact->inexact n)]))))))
+
+  (define/private (get-a-string limit recur?)
+    (let* ([orig-len (if recur?
+                         (if (limit . < . 16)
+                             limit
+                             16)
+                         (get-exact))]
+           [buf (make-bytes 32)]
+           [fail (lambda ()
+                   (set! is-bad? #t)
+                   #"")])
+      (if recur?
+          (bytes-set! buf 0 (char->integer #\#))
+          (begin
+            (skip-whitespace buf)
+            (when is-bad?
+              (bytes-set! buf 0 0))))
+      (cond
+       [(= (bytes-ref buf 0) (char->integer #\#))
+        (if (and (= (send f read-bytes buf 1 2) 1)
+                 (= (bytes-ref buf 1) (char->integer #\")))
+            (let-values ([(si s) (make-pipe)]
+                         [(tmp) (make-bytes (+ orig-len 2))])
+              (display "#\"" s)
+              (let loop ([get-amt (add1 orig-len)]) ;; add 1 for closing quote
+                (let ([got-amt (send f read-bytes tmp 0 get-amt)])
+                  (if (not (= got-amt get-amt))
+                      (fail)
+                      (begin
+                        (write-bytes tmp s 0 got-amt)
+                        (let ([done?
+                               (let loop ([i 0])
+                                 (cond
+                                  [(= i got-amt) #f]
+                                  [(= (bytes-ref tmp i) (char->integer #\")) #t]
+                                  [(= (bytes-ref tmp i) (char->integer #\\))
+                                   (if (= (add1 i) got-amt)
+                                       ;; need to read escaped character
+                                       (if (not (= (send f read-bytes tmp got-amt (add1 got-amt)) 1))
+                                           (fail)
+                                           (begin
+                                             (write-bytes tmp s got-amt (add1 got-amt))
+                                             #f))
+                                       (loop (+ i 2)))]
+                                  [else (loop (+ i 1))]))])
+                          (if done?
+                              (begin
+                                (close-output-port s)
+                                (unless recur? (inc-item-count))
+                                (let ([s (with-handlers ([exn:fail:read? (lambda (x) #f)]) 
+                                           (read si))])
+                                  (if (or (not s)
+                                          (not (eof-object? (read-byte si))))
+                                      (fail)
+                                      (if (if recur?
+                                              ((bytes-length s) . <= . limit)
+                                              (= (bytes-length s) orig-len))
+                                          s
+                                          (fail)))))
+                              (loop 1))))))))
+            (fail))]
+       [(and (not recur?) (= (bytes-ref buf 0) (char->integer #\()))
+        ;; read a sequence of strings
+        (let loop ([accum null]
+                   [left-to-get orig-len])
+          (skip-whitespace buf)
+          (if (or is-bad? 
+                  (negative? left-to-get))
+              (fail)
+              (cond
+               [(= (bytes-ref buf 0) (char->integer #\)))
+                ;; got all byte strings
+                (if (zero? left-to-get)
+                    (begin
+                      (inc-item-count)
+                      (apply bytes-append (reverse accum)))
+                    (fail))]
+               [(= (bytes-ref buf 0) (char->integer #\#))
+                (let ([v (get-a-string left-to-get #t)])
+                  (if is-bad?
+                      (fail)
+                      (loop (cons v accum)
+                            (- left-to-get (bytes-length v)))))]
+               [else (fail)])))]
+       [else (fail)])))
+
+  (define/private (inc-item-count)
+    (set! items (add1 items))
+    (tell))
+
+  (define/private (skip-one recur?)
+    (let ([buf (make-bytes 1)]
+          [fail (lambda () (set! is-bad? #t) (void))]
+          [success (lambda () (unless recur? (inc-item-count)))])
+      (if recur?
+          (bytes-set! buf 0 (char->integer #\#))
+          (skip-whitespace buf))
+      (unless is-bad?
+        (cond
+         [(= (bytes-ref buf 0) (char->integer #\#))
+          ;; byte string
+          (if (and (= 1 (send f read-bytes buf))
+                   (= (bytes-ref buf 0) (char->integer #\")))
+              (let loop ()
+                (if (= 1 (send f read-bytes buf))
+                    (cond
+                     [(= (bytes-ref buf 0) (char->integer #\\))
+                      (if (= 1 (send f read-bytes buf))
+                          (loop)
+                          (fail))]
+                     [(= (bytes-ref buf 0) (char->integer #\"))
+                      (success)]
+                     [else (loop)])
+                    (fail)))
+              (fail))]
+         [(= (bytes-ref buf 0) (char->integer #\)))
+          ;; list of byte strings
+          (let loop ()
+            (if is-bad?
+                (fail)
+                (if (not (= (send f read-bytes buf) 1))
+                    (fail)
+                    (if (is-delim? (bytes-ref buf 0))
+                        (cond
+                         [(= (bytes-ref buf 0) (char->integer #\)))
+                          (success)]
+                         [(= (bytes-ref buf 0) (char->integer #\#))
+                          (skip-one #t)
+                          (loop)]
+                         [else (fail)])
+                        (loop)))))]
+         [else
+          ;; number -- skip anything delimited
+          (let loop ()
+            (if (not (= (send f read-bytes buf) 1))
+                (fail)
+                (if (is-delim? (bytes-ref buf 0))
+                    (success)
+                    (loop))))]))))
+
+  (def/public (get-fixed [box? vb])
+    (let ([v (if (check-boundary)
+                 0
+                 (if (read-version . < . 8)
+                     (let ([buf (make-bytes 4)])
+                       (send f read-bytes buf)
+                       (integer-bytes->integer
+                        buf
+                        #t
+                        (if (= read-version 1)
+                            (system-big-endian?)
+                            #t)))
+                     (get-exact)))])
+      (set-box! vb v)))
+
+  #|
+   integer format specified by first byte:
+     bit 8: 0 - read 7-bit (positive) number
+     bit 8: 1 - ...
+        bit 7: 0 - read abother byte for 15-bit (positive) number
+	bit 7: 1 - negative and long numbers...
+	 bit 1: 1 - read another 8-bit (signed) number
+	 bit 1: 0 - ...
+	   bit 2: 1 - read another 16-bit (signed) number
+	   bit 2: 0 - read another 32-bit (signed) number
+  |#
+
+  (def/public (get-exact)
+    (if (check-boundary)
+        0
+        (if (read-version . < . 8)
+            (let ([buf (make-bytes 4)]
+                  [fail (lambda () (set! is-bad? #t) 0)])
+              (if (not (= 1 (send f read-bytes buf 0 1)))
+                  (fail)
+                  (let ([b (bytes-ref buf 0)])
+                    (if (positive? (bitwise-and b #x80))
+                        (if (positive? (bitwise-and b #x40))
+                            (cond
+                             [(positive? (bitwise-and b #x01))
+                              (if (= 1 (send f read-bytes buf 0 1))
+                                  (let ([b (bytes-ref buf 0)])
+                                    (if (b . > . 127)
+                                        (- b 256)
+                                        b))
+                                  (fail))]
+                             [(positive? (bitwise-and b #x02))
+                              (if (= 2 (send f read-bytes buf 0 2))
+                                  (integer-bytes->integer b #t #t)
+                                  (fail))]
+                             [else
+                              (if (= 4 (send f read-bytes buf 0 2))
+                                  (integer-bytes->integer buf #t #t)
+                                  (fail))])
+                            (if (= 1 (send f read-bytes buf 0 1))
+                                (+ (arithmetic-shift (bitwise-and b #x3F) 8)
+                                   (bytes-ref buf 0))
+                                (fail)))
+                        b))))
+            (get-number #t))))
+
+  (def/public (get-inexact)
+    (if (check-boundary)
+        0
+        (if (read-version . < . 8)
+            (let ([buf (make-bytes 8)])
+              (send f read-bytes buf)
+              (floating-point-bytes->real
+               buf
+               (if (= read-version 1)
+                   (system-big-endian?)
+                   #t)))
+            (get-number #f))))
+
+  (define/private (do-get-bytes)
+    (if (check-boundary)
+        #""
+        (if (read-version . < . 8)
+            (let* ([len (get-exact)]
+                   [s (make-bytes len)])
+              (send f read-bytes s)
+              s)
+            (get-a-string #f #f))))
+  
+  (def/public (get-bytes [maybe-box? [len #f]])
+    (let ([s (do-get-bytes)])
+      (when len
+        (set-box! len (max 1 (bytes-length s))))
+      (subbytes s 0 (max 0 (sub1 (bytes-length s))))))
+  
+  (def/public (get-unterminated-bytes [maybe-box? [len #f]])
+    (let ([s (do-get-bytes)])
+      (when len
+        (set-box! len (bytes-length s)))
+      s))
+
+  (def/public (get-unterminated-bytes! [(make-box exact-nonnegative-integer?) len] 
+                                       [(lambda (s) (and (bytes? s) (not (immutable? s)))) s])
+    (let ([s2 (do-get-bytes)])
+      (if ((bytes-length s2) . <= . (unbox len))
+          (begin
+            (bytes-copy! s 0 s2)
+            (set-box! len (bytes-length s2)))
+          (set! is-bad? #t))))
+
+  (def/public (get [(make-box real?) b])
+    (unless (check-boundary)
+      (if (exact-integer? (unbox b))
+          (set-box! b (get-exact))
+          (set-box! b (get-inexact)))))
+
+  (def/public (set-boundary [exact-nonnegative-integer? n])
+    (set! boundaries (cons (+ (tell) n) boundaries)))
+
+  (def/public (remove-boundary)
+    (set! boundaries (cdr boundaries)))
+
+  (define/private (check-boundary)
+    (if is-bad?
+        #t
+        (cond
+         [(and (pair? boundaries)
+               ((tell) . > . (car boundaries)))
+          (set! is-bad? #t)
+          (error 'editor-stream-in%
+                 "overread (caused by file corruption?; ~a vs ~a)" (tell) (car boundaries))]
+         [(send f bad?)
+          (set! is-bad? #t)
+          (error 'editor-stream-in% "stream error")]
+         [else #f])))
+
+  (def/public (skip [exact-nonnegative-integer? n])
+    (if (read-version . < . 8)
+        (send f skip n)
+        (jump-to (+ n items))))
+
+  (def/public (tell)
+    (if (read-version . < . 8)
+        (send f tell)
+        (let ([pos (send f tell)])
+          (hash-set! pos-map items pos)
+          items)))
+
+  (def/public (jump-to [exact-nonnegative-integer? pos])
+    (if (read-version . < . 8)
+        (send f seek pos)
+        (let ([p (hash-ref pos-map pos #f)])
+          (if (not p)
+              (begin
+                (let loop ()
+                  (when (and (items . < . pos) (not is-bad?))
+                    (skip-one #f)
+                    (loop)))
+                (unless (= items pos)
+                  (set! is-bad? #t)))
+              (begin
+                (send f seek p)
+                (set! items pos))))))
+
+  (def/public (ok?) (not is-bad?)))
+
+(set-editor-stream-in%! editor-stream-in%)
+
+;; ----------------------------------------
+
+(defclass editor-stream-out% editor-stream%
+  (init-rest args)
+
+  (define f
+    (case-args
+     args
+     [([editor-stream-out-base% base]) base]
+     (init-name 'editor-stream-out%)))
+
+  (define is-bad? #f)
+  (define col 72)
+  (define items 0)
+  (define pos-map (make-hash))
+
+  (super-new)
+
+  (define/private (check-ok)
+    (unless is-bad?
+      (when (send f bad?)
+        (error 'editor-stream-out% "stream error"))))
+
+  (def/public (put-fixed [exact-integer? v])
+    (check-ok)
+    (let-values ([(new-col spc)
+                  (if ((+ col 12) . > . 72)
+                      (values 11 #"\n")
+                      (values (+ col 12) #" "))])
+      (let ([s (number->string v)])
+        (send f
+              write-bytes
+              (bytes-append spc
+                            (make-bytes (- 11 (string-length s)) (char->integer #\space))
+                            (string->bytes/latin-1 s))))
+      (set! items (add1 items)))
+    this)
+
+  (define/public (put . args)
+    (case-args
+     args
+     [([exact-nonnegative-integer? n][bytes? s])
+      (do-put-bytes (subbytes s 0 n))]
+     [([bytes? s])
+      (do-put-bytes (bytes-append s #"\0"))]
+     [([exact-integer? n])
+      (do-put-number n)]
+     [([real? n])
+      (do-put-number (exact->inexact n))]
+     (method-name 'editor-stream-out% 'put)))
+
+  (def/public (put-unterminated [bytes? s])
+    (do-put-bytes s))
+
+  (define/private (do-put-bytes orig-s)
+    (define (single-string)
+      (if ((bytes-length orig-s) . < . 72)
+          (let ([s (open-output-bytes)])
+            (write orig-s s)
+            (let* ([v (get-output-bytes s)]
+                   [len (bytes-length v)])
+              (if (len . >= . 72)
+                  (multiple-strings)
+                  (begin
+                    (if ((+ col len 1) . > . 72)
+                        (send f write-bytes #"\n")
+                        (send f write-bytes #" "))
+                    (send f write-bytes v)
+                    (set! col 72))))) ;; forcing a newline after every string makes the file more readable
+          (multiple-strings)))
+    (define (multiple-strings)
+      (send f write-bytes #"\n(")
+      (let loop ([offset 0][remain (bytes-length orig-s)])
+        (unless (zero? remain)
+          (let lloop ([amt (min 50 remain)][retry? #t])
+            (let ([s (open-output-bytes)])
+              (write (subbytes orig-s offset (+ offset amt)) s)
+              (let* ([v (get-output-bytes s)]
+                     [len (bytes-length v)])
+                (if (len . <= . 71)
+                    (if (and (len . < . 71) 
+                             retry?
+                             (amt . < . remain))
+                        (lloop (add1 amt) #t)
+                        (begin
+                          (send f write-bytes #"\n ")
+                          (send f write-bytes v)
+                          (loop (+ offset amt) (- remain amt))))
+                    (lloop (sub1 amt) #f)))))))
+      (send f write-bytes #"\n)")
+      (set! col 1))
+
+    (check-ok)
+    (do-put-number (bytes-length orig-s))
+    (single-string)
+    (set! items (add1 items))
+    this)
+
+  (define/private (do-put-number v)
+    (check-ok)
+    (let* ([s (string->bytes/latin-1 (format " ~a" v))]
+           [len (bytes-length s)])
+      (if ((+ col len) . > . 72)
+          (begin
+            (set! col (sub1 len))
+            (bytes-set! s 0 (char->integer #\newline)))
+          (set! col (+ col len)))
+      (send f write-bytes s)
+      (set! items (add1 items))
+      this))
+
+  (def/public (tell)
+    (let ([pos (send f tell)])
+      (hash-set! pos-map items (cons pos col))
+      items))
+
+  (def/public (jump-to [exact-nonnegative-integer? icount])
+    (unless is-bad?
+      (let ([p (hash-ref pos-map icount #f)])
+        (when p
+          (send f seek (car p))
+          (set! col (cdr p))
+          (set! items icount)))))
+  
+  (def/public (ok?) (not is-bad?))
+
+  (def/public (pretty-finish)
+    (unless is-bad?
+      (when (positive? col)
+        (send f write-bytes #"\n")
+        (set! col 0))))
+
+  (def/public (pretty-start)
+    (define (show s)
+      (send f write-bytes (if (string? s) (string->bytes/latin-1 s) s)))
+    (when (positive? col)
+      (show #"\n"))
+    (show #"#|\n   This file is in plt scheme editor format.\n")
+    (show (format "   Open this file in dr-scheme version ~a or later to read it.\n" (version)))
+    (show #"\n")
+    (show #"   Most likely, it was created by saving a program in DrScheme,\n")
+    (show #"   and it probably contains a program with non-text elements\n")
+    (show #"   (such as images or comment boxes).\n")
+    (show #"\n")
+    (show #"            http://www.plt-scheme.org\n|#\n")
+    (set! col 0)))
+
+(set-editor-stream-out%! editor-stream-out%)
+
diff --git a/collects/mred/private/wxme/text.ss b/collects/mred/private/wxme/text.ss
new file mode 100644
index 00000000..037fdfc5
--- /dev/null
+++ b/collects/mred/private/wxme/text.ss
@@ -0,0 +1,5482 @@
+#lang scheme/base
+(require scheme/class
+         scheme/port
+         scheme/file
+         (for-syntax scheme/base)
+         "../syntax.ss"
+         "const.ss"
+         "mline.ss"
+         "private.ss"
+         "editor.ss"
+         "undo.ss"
+         "style.ss"
+         "snip.ss"
+         "snip-flags.ss"
+         "snip-admin.ss"
+         "keymap.ss"
+         (only-in "cycle.ss" set-text%!)
+         "wordbreak.ss"
+         "stream.ss"
+         "wx.ss")
+
+(provide text%
+         add-text-keymap-functions)
+
+;; ----------------------------------------
+
+(define flash-timer% 
+  (class timer%
+    (init editor)
+    (define for-editor editor)
+    (super-new)
+    (define/override (notify)
+      (send for-editor flash-off))))
+
+;; ----------------------------------------
+
+(define arrow (make-object cursor% 'arrow))
+(define i-beam (make-object cursor% 'ibeam))
+
+(define MAX-COUNT-FOR-SNIP 500)
+(define A-VERY-BIG-NUMBER 1e50)
+
+(define TAB-WIDTH 20.0)
+
+(define show-outline-for-inactive?
+  (and (get-preference 'MrEd:outline-inactive-selection) #t))
+
+(define caret-pen (send the-pen-list find-or-create-pen "BLACK" 1 'xor))
+(define outline-pen (send the-pen-list find-or-create-pen "BLACK" 0 'transparent))
+(define outline-inactive-pen (send the-pen-list find-or-create-pen "BLACK" 1 'hilite))
+(define outline-brush (send the-brush-list find-or-create-brush "BLACK" 'hilite))
+(define xpattern #"\x88\x88\0\0\x22\x22\0\0\x88\x88\0\0\x22\x22\0\0\x88\x88\0\0\x22\x22\0\0\x88\x88\0\0\x22\x22\0\0")
+(define outline-nonowner-brush (let ([b (new brush%)])
+                                 (send b set-color "BLACK")
+                                 (send b set-stipple (make-object bitmap% xpattern 16 16))
+                                 (send b set-style 'xor)
+                                 b))
+(define clear-brush (send the-brush-list find-or-create-brush "WHITE" 'solid))
+
+(define (showcaret>= a b)
+  (memq a (memq b '(no-caret show-inactive-caret show-caret))))
+
+(define-struct clickback (start end f call-on-down? delta hilited? unhilite) #:mutable)
+
+(defclass text% editor%
+  (inherit-field s-admin
+                 s-offscreen
+                 s-custom-cursor
+                 s-custom-cursor-overrides?
+                 s-keymap
+                 s-own-caret?
+                 s-style-list
+                 s-user-locked?
+                 s-modified?
+                 s-noundomode
+                 s-caret-snip
+                 s-inactive-caret-threshold
+                 s-filename
+                 s-temp-filename?
+                 s-need-on-display-size?)
+  (inherit on-change
+           on-local-event
+           on-local-char
+           scroll-editor-to
+           free-old-copies
+           install-copy-buffer
+           begin-copy-buffer
+           end-copy-buffer
+           do-buffer-paste
+           copy-ring-next
+           do-write-headers-footers
+           do-set-caret-owner
+           perform-undo-list
+           s-start-intercept
+           s-end-intercept
+           do-own-x-selection
+           copy-out-x-selection
+           add-undo-rec
+           set-modified
+           get-default-style
+           get-snip-data
+           set-snip-data
+           read-snips-from-file
+           on-paint
+           on-focus
+           default-style-name
+           wait-sequence-lock
+           begin-sequence-lock
+           end-sequence-lock
+           do-own-caret
+           on-edit-sequence
+           after-edit-sequence
+           on-display-size)
+
+  (define is-locked-for-read? #f)
+  (define is-locked-for-flow? #f)
+  (define is-locked-for-write? #f)
+  
+  (define read-locked? #f)
+  (define flow-locked? #f)
+  (define write-locked? #f)
+
+  (define hilite-on? #t)
+
+  (define changed? #f) ;; set if on-change() needs to be called 
+
+  (define flash? #f)
+  (define flashautoreset? #f)
+  (define flashdirectoff? #f)
+
+  (define posateol? #f) ;; display the caret at the end of a line?
+  (define flashposateol? #f)
+  (define flashscroll? #f) ;; scroll back after unflashing?
+
+  (define graphics-invalid? #f)
+  (define flow-invalid? #f)
+  (define snip-cache-invalid? #f)
+  (define graphic-maybe-invalid? #f)
+  (define graphic-maybe-invalid-force? #f)
+
+  (define typing-streak? #f)
+  (define deletion-streak? #f)
+  (define delayed-streak? #f)
+  (define vcursor-streak? #f)
+  (define kill-streak? #f)
+  (define anchor-streak? #f)
+  (define extend-streak? #f)
+  (define insert-force-streak? #f)
+  (define delete-force-streak? #f)
+
+  (define keep-anchor-streak? #f)
+
+  (define streaks-pushed? #f)
+  (define save-typing-streak? #f)
+  (define save-deletion-streak? #f)
+  (define save-delayed-streak? #f)
+  (define save-vcursor-streak? #f)
+  (define save-kill-streak? #f)
+  (define save-anchor-streak? #f)
+  (define save-extend-streak? #f)
+
+  (define dragging? #f)
+  (define tracking? #f)
+  (define extra-line? #f) ;; empty line at end of file with no representative
+
+  (define delayedscrollateol? #f)
+  (define delayedscrollbox? #f)
+  (define draw-cached-in-bitmap? #f)
+  (define refresh-unset? #f)
+  (define refresh-box-unset? #f)
+  (define refresh-all? #f)
+
+  (define tab-space-in-units? #f)
+  (define sticky-styles? #t)
+  (define overwrite-mode? #f)
+
+  (def/public (set-styles-sticky [bool? s?]) (set! sticky-styles? s?))
+  (def/public (get-styles-sticky) sticky-styles?)
+
+  (def/public (get-overwrite-mode) overwrite-mode?)
+  (def/public (set-overwrite-mode [bool? v]) (set! overwrite-mode? v))
+
+  (def/public (get-sticky-styles) sticky-styles?)
+  (def/public (set-sticky-styles [bool? v]) (set! sticky-styles? v))
+
+  (define need-x-copy? #f)
+
+  (define caret-blinked? #f) ;; whether we want to hide an active caret or not
+
+  (define initial-style-needed? #t)
+
+  (define last-draw-caret 0)
+  (define last-draw-x-sel? #f)
+
+  (define max-width 0.0)
+  (define min-width 0.0)
+  (define max-height 0.0)
+  (define min-height 0.0)
+  (define wrap-bitmap-width 0.0)
+
+  (define auto-wrap-bitmap #f)
+
+  (define delay-refresh 0)
+
+  (define len 0) ; total length in "characters" == number of positions - 1
+
+  (define startpos 0)
+  (define endpos 0)
+  (define extendstartpos 0)
+  (define extendendpos 0) ; for extendstreak
+  (define vcursorloc 0.0) ; for vcursor-streak
+
+  (define flash-timer #f)
+  (define flashstartpos 0)
+  (define flashendpos 0)
+
+  (define snips #f)
+  (define last-snip #f) ; the contents of this edit session
+  (define snip-count 0)
+
+  (define snip-admin (new standard-snip-admin% [editor this]))
+  
+  (define line-root-box (box #f))
+  (define first-line #f)
+  (define last-line #f)
+  (define num-valid-lines 0)
+
+  (define extra-line-h 0.0)
+
+  (define total-height 0.0) ; total height/width in canvas units
+  (define total-width 0.0)
+  (define final-descent 0.0) ; descent of last line
+  (define initial-space 0.0) ; space from first line
+  (define initial-line-base 0.0) ; inverse descent from first line
+
+  (define/public (get-s-last-snip) last-snip)
+  (define/public (get-s-total-width) total-width)
+  (define/public (get-s-total-height) total-height)
+
+  (define caret-style #f)
+
+  (define dragstart 0)
+
+  (define track-clickback #f)
+
+  (define refresh-start 0)
+  (define refresh-end 0)
+  (define refresh-l 0.0)
+  (define refresh-t 0.0)
+  (define refresh-r 0.0)
+  (define refresh-b 0.0)
+
+  (define last-draw-l 0.0)
+  (define last-draw-t 0.0)
+  (define last-draw-r 0.0)
+  (define last-draw-b 0.0)
+  (define last-draw-red 0)
+  (define last-draw-green 0)
+  (define last-draw-blue 0)
+
+  (define delayedscroll -1)
+  (define delayedscrollend 0)
+  (define delayedscrollbias 'none)
+  (define delayedscrollsnip #f)
+  (define delayedscroll-x 0.0)
+  (define delayedscroll-y 0.0)
+  (define delayedscroll-w 0.0)
+  (define delayedscroll-h 0.0)
+
+  (define clickbacks null)
+
+  (define file-format 'standard)
+
+  (define between-threshold 2.0)
+
+  (define tab-space TAB-WIDTH) ; inexact
+  
+  (define read-insert 0)
+  (define read-insert-start 0)
+
+  (define prev-paste-start 0)
+  (define prev-paste-end 0)
+  (define save-prev-paste-start 0)
+  (define save-prev-paste-end 0)
+
+  (define revision-count 0.0)
+
+  (define word-break standard-wordbreak)
+  (define word-break-map the-editor-wordbreak-map)
+
+  (define offscreen-key (gensym))
+
+  (init [(ls line-spacing) 1.0]
+        [tab-stops null]
+        [auto-wrap #f])
+
+  (super-new)
+
+  (define line-spacing ls)
+  (define/public (get-s-line-spacing) line-spacing)
+  (define tabs (list->vector tab-stops))
+  
+  (make-only-snip)
+
+  (def/override (~)
+    (set! word-break-map standard-wordbreak)
+    (let loop ([snip snips])
+      (when snip
+        (let ([next (snip->next snip)])
+          (send snip ~)
+          (loop next))))
+    (set! snips #f)
+    (set! clickbacks null))
+
+  (def/override (copy-self)
+    (let ([m (new text% [line-spacing line-spacing])])
+      (copy-self-to m)
+      m))
+
+  (def/override (copy-self-to [editor<%> m])
+    (when (m . is-a? . text%)
+      ;; copy parameters, such as tab settings: */
+      (send m set-tabs (vector->list tabs) tab-space tab-space-in-units?)
+      (super copy-self-to m)
+      (when (zero? (send m last-position))
+        ;; make sure only snip in m has a good style (since we called
+        ;; (send m->style-list copy) in copy-self-to).
+        (let* ([sname (default-style-name)]
+               [bs (send (send m get-s-style-list) find-named-style sname)])
+          (set-snip-style! (send m get-s-snips) 
+                           (or bs
+                               (send (send m get-s-style-list) basic-style)))))
+
+      (send m set-file-format (get-file-format))
+      
+      (send m set-wordbreak-func word-break)
+      (send m set-wordbreak-map (get-wordbreak-map))
+      (send m set-between-threshold (get-between-threshold))
+      (send m hide-caret (caret-hidden))
+      (send m set-overwrite-mode (get-overwrite-mode))
+
+      (send m set-autowrap-bitmap auto-wrap-bitmap)
+
+      (send m set-sticky-styles sticky-styles?)))
+
+  ;; ----------------------------------------
+
+  (def/override (adjust-cursor [mouse-event% event])
+    (if (not s-admin)
+        #f
+        (let-boxes ([scrollx 0.0]
+                    [scrolly 0.0]
+                    [dc #f])
+            (set-box! dc (send s-admin get-dc scrollx scrolly))
+          (if (not dc)
+              #f
+              (let ([x (+ (send event get-x) scrollx)]
+                    [y (+ (send event get-y) scrolly)])
+                (if tracking?
+                    (or s-custom-cursor arrow)
+                    (if (too-busy-to-refresh?)
+                        ;; we're too busy; ask again later
+                        (or (and s-custom-cursor-overrides? s-custom-cursor)
+                            i-beam)
+                        (begin
+                          (begin-sequence-lock)
+                          (begin0
+                           (or (and (not s-custom-cursor-overrides?)
+                                    (or (and s-caret-snip (send event dragging?)
+                                             (let-boxes ([x 0.0]
+                                                         [y 0.0])
+                                                 (get-snip-position-and-location s-caret-snip #f x y)
+                                               (let ([c (send s-caret-snip adjust-cursor dc
+                                                              (- x scrollx) (- y scrolly)
+                                                              x y event)])
+                                                 c)))
+                                        ;; find snip:
+                                        (let-boxes ([onit? #f]
+                                                    [how-close 0.0]
+                                                    [pos 0])
+                                            (set-box! pos (find-position x y #f onit? how-close))
+                                          ;; FIXME: the following refinement of `onit?' seems pointless
+                                          (let ([onit? (and onit?
+                                                            (not (zero? how-close))
+                                                            ((abs how-close) . > . between-threshold))])
+                                            (let ([snip (and onit?
+                                                             (find-snip pos 'after))])
+                                              (and snip
+                                                   (let-boxes ([x 0.0] [y 0.0])
+                                                       (get-snip-position-and-location snip #f x y)
+                                                     (let ([c (send snip adjust-cursor dc (- x scrollx) (- y scrolly) 
+                                                                    x y event)])
+                                                       c))))))))
+                               s-custom-cursor
+                               (if (x . >= . 0)
+                                   (let ([cb? (find-clickback (find-position x y #f) y)])
+                                     (if cb? arrow i-beam))
+                                   i-beam))
+                           (end-sequence-lock))))))))))
+
+  (def/override (on-event [mouse-event% event])
+    (when s-admin
+      (when (and (not (send event moving?))
+                 (not (send event entering?))
+                 (not (send event leaving?)))
+        (end-streaks '(except-key-sequence cursor delayed)))
+      (let-values ([(dc x y scrollx scrolly)
+                    (if (or (send event button-down?) s-caret-snip)
+                        ;; first, find clicked-on snip:
+                        (let ([x (send event get-x)]
+                              [y (send event get-y)])
+                          (let-boxes ([scrollx 0.0]
+                                      [scrolly 0.0]
+                                      [dc #f])
+                              (set-box! dc (send s-admin get-dc scrollx scrolly))
+                            ;; FIXME: old code returned if !dc
+                            (values dc (+ x scrollx) (+ y scrolly) scrollx scrolly)))
+                        (values #f 0.0 0.0 0.0 0.0))])
+        (when (send event button-down?)
+          (let ([snip
+                 (let-boxes ([onit? #f]
+                             [how-close 0.0]
+                             [now 0])
+                     (set-box! now (find-position x y #f onit? how-close))
+                   ;; FIXME: the following refinement of `onit?' seems pointless
+                   (let ([onit? (and onit?
+                                     (not (zero? how-close))
+                                     ((abs how-close) . > . between-threshold))])
+                     (if onit?
+                         ;; we're in the snip's horizontal region...
+                         (let ([snip (find-snip now 'after)])
+                           ;; ... but maybe the mouse is above or below it.
+                           (let-boxes ([top 0.0]
+                                       [bottom 0.0]
+                                       [dummy 0.0])
+                               (begin
+                                 (get-snip-location snip dummy top #f)
+                                 (get-snip-location snip dummy bottom #t))
+                             (if (or (top . > . y) (y . > . bottom))
+                                 #f
+                                 snip)))
+                         #f)))])
+            (set-caret-owner snip)))
+        (if (and s-caret-snip (has-flag? (snip->flags s-caret-snip) HANDLES-EVENTS))
+            (let-boxes ([x 0.0] [y 0.0])
+                (get-snip-position-and-location s-caret-snip #f x y)
+              (send s-caret-snip on-event dc (- x scrollx) (- y scrolly) x y event))
+            (on-local-event event)))))
+
+  (def/override (on-default-event [mouse-event% event])
+    (when s-admin
+      (let-boxes ([scrollx 0.0]
+                  [scrolly 0.0]
+                  [dc #f])
+          (set-box! dc (send s-admin get-dc scrollx scrolly))
+        (let ([x (+ (send event get-x) scrollx)]
+              [y (+ (send event get-y) scrolly)])
+          (when dc
+
+            (let-boxes ([now 0]
+                        [ateol? #f]
+                        [how-close 0.0])
+                (set-box! now (find-position x y ateol? #f how-close))
+              (let ([now (if (and (how-close . > . 0)
+                                  (how-close . <= . between-threshold))
+                             (add1 now)
+                             now)])
+                (cond
+                 [(send event button-down?)
+                  (set! tracking? #f)
+                  (let ([click (and (x . >= . 0) (find-clickback now y))])
+                    (if click
+                        (if (clickback-call-on-down? click)
+                            ((clickback-f click) this (clickback-start click) (clickback-end click))
+                            (begin
+                              (set! tracking? #t)
+                              (set! track-clickback click)
+                              (when s-admin
+                                (send s-admin update-cursor))
+                              (set-clickback-hilited?! track-clickback #t)))
+                        (begin
+                          (set! dragstart now)
+                          (set! dragging? #t)
+                          (when (send event get-shift-down)
+                            (if (dragstart . > . startpos)
+                                (set! dragstart startpos)
+                                (set! dragstart endpos)))
+                          (if (now . < . dragstart)
+                              (set-position-bias-scroll 'start-only now dragstart ateol?)
+                              (set-position-bias-scroll 'end-only dragstart now ateol?)))))]
+                 [(send event dragging?)
+                  (cond
+                   [dragging?
+                    (if (now . < . dragstart)
+                        (when (or (not (= startpos now)) (not (= endpos dragstart)))
+                          (set-position-bias-scroll 'start-only now dragstart ateol?))
+                        (when (or (not (= endpos now)) (not (= startpos dragstart)))
+                          (set-position-bias-scroll 'end-only dragstart now ateol?)))]
+                   [tracking?
+                    (let ([cb (if (x . >= . 0)
+                                  (find-clickback now y)
+                                  #f)])
+                      (set-clickback-hilited?! track-clickback (eq? cb track-clickback)))])]
+                 [(send event button-up?)
+                  (cond
+                   [dragging?
+                    (set! dragging? #f)]
+                   [tracking?
+                    (set! tracking? #f)
+                    (when (clickback-hilited? track-clickback)
+                      (set-clickback-hilited?! track-clickback #f)
+                      (let ([click track-clickback])
+                        ((clickback-f click) this (clickback-start click) (clickback-end click))))
+                    (when s-admin
+                      (send s-admin update-cursor))])]
+                 [(send event moving?)
+                  (set! dragging? #f)
+                  (when tracking?
+                    (set! tracking? #f)
+                    (when (clickback-hilited? track-clickback)
+                      (set-clickback-hilited?! track-clickback #f)
+                      (let ([click track-clickback])
+                        ((clickback-f click) this (clickback-start click) (clickback-end click)))))
+                  (when s-admin
+                    (send s-admin update-cursor))]))))))))
+
+  (def/override (on-char [key-event% event])
+    (when s-admin
+      (if (and s-caret-snip
+               (has-flag? (snip->flags s-caret-snip) HANDLES-EVENTS))
+          (let-boxes ([scrollx 0.0]
+                      [scrolly 0.0]
+                      [dc #f])
+              (set-box! dc (send s-admin get-dc scrollx scrolly))
+            (let-boxes ([x 0.0] [y 0.0])
+                (get-snip-position-and-location s-caret-snip #f x y)
+              (send s-caret-snip on-char dc (- x scrollx) (- y scrolly) x y event)))
+          (let ([code (send event get-key-code)])
+            (when (and (not (eq? 'release code))
+                       (not (eq? 'shift code))
+                       (not (eq? 'control code))
+                       (not (eq? 'menu code))
+                       (not (equal? code #\nul)))
+              (hide-cursor))
+            (on-local-char event)))))
+
+  (def/override (on-default-char [key-event% event])
+    (when s-admin
+      (let ([code (send event get-key-code)]
+            [ins (lambda (ch)
+                   (if (and overwrite-mode? (= endpos startpos))
+                       (insert ch startpos (add1 startpos))
+                       (insert ch)))])
+        (case code
+          [(#\backspace) (delete)]
+          [(#\rubout)
+           (if (= endpos startpos)
+               (when (endpos . < . len)
+                 (delete endpos (add1 endpos)))
+               (delete))]
+          [(right left up down home end prior next)
+           (move-position code (send event get-shift-down))]
+          [(numpad0) (ins #\0)]
+          [(numpad1) (ins #\1)]
+          [(numpad2) (ins #\2)]
+          [(numpad3) (ins #\3)]
+          [(numpad4) (ins #\4)]
+          [(numpad5) (ins #\5)]
+          [(numpad6) (ins #\6)]
+          [(numpad7) (ins #\7)]
+          [(numpad8) (ins #\8)]
+          [(numpad9) (ins #\9)]
+          [(multiply) (ins #\*)]
+          [(divide) (ins #\/)]
+          [(add) (ins #\+)]
+          [(subtract) (ins #\-)]
+          [(decimal) (ins #\.)]
+          [(#\u3) (ins #\return)] ; NUMPAD-ENTER
+          [(#\return #\tab) (ins code)]
+          [else
+           (let ([vcode (if (char? code)
+                            (char->integer code)
+                            0)])
+             (when (and (vcode . >= . 32)
+                        (or (vcode . <= . #xd800)
+                            (vcode . > . #xdf00)))
+               (ins code)))]))))
+  
+  (def/override (own-caret [any? ownit?])
+    (when (do-own-caret (and ownit? #t))
+      (need-caret-refresh)
+      (on-focus (and ownit? #t))))
+
+  (def/override (blink-caret)
+    (if s-caret-snip
+        (let-boxes ([dx 0.0]
+                    [dy 0.0]
+                    [dc #f])
+            (set-box! dc (send s-admin get-dc dx dy))
+          (when dc
+            (let-boxes ([x 0.0] [y 0.0])
+                (get-snip-location s-caret-snip x y)
+              (send s-caret-snip blink-caret dc (- x dx) (- y dy)))))
+        (if (too-busy-to-refresh?)
+            ;; we're busy; go away
+            (void)
+            (when (and (= endpos startpos) 
+                       (not flash?)
+                       hilite-on?)
+              (set! caret-blinked? (not caret-blinked?))
+              (need-caret-refresh)))))
+
+  (def/override (size-cache-invalid)
+    (set! graphic-maybe-invalid? #t)
+    (set! graphics-invalid? #t)
+    (when (max-width . > . 0.0)
+      (set! flow-invalid? #t))
+    (set! snip-cache-invalid? #t))
+
+  (def/override (locked-for-read?)
+    read-locked?)
+  (def/public (locked-for-flow?)
+    flow-locked?)
+  (def/override (locked-for-write?)
+    write-locked?)
+
+  ;; ----------------------------------------
+
+  (def/public (can-insert? [exact-nonnegative-integer? start]
+                           [exact-nonnegative-integer? len])
+    #t)
+  (def/public (on-insert [exact-nonnegative-integer? start]
+                         [exact-nonnegative-integer? len])
+    (void))
+  (def/public (after-insert [exact-nonnegative-integer? start]
+                            [exact-nonnegative-integer? len])
+    (void))
+
+  (def/public (can-delete? [exact-nonnegative-integer? start]
+                           [exact-nonnegative-integer? len])
+    #t)
+  (def/public (on-delete [exact-nonnegative-integer? start]
+                         [exact-nonnegative-integer? len])
+    (void))
+  (def/public (after-delete [exact-nonnegative-integer? start]
+                            [exact-nonnegative-integer? len])
+    (void))
+
+  (def/public (can-change-style? [exact-nonnegative-integer? start]
+                                 [exact-nonnegative-integer? len])
+    #t)
+  (def/public (on-change-style [exact-nonnegative-integer? start]
+                               [exact-nonnegative-integer? len])
+    (void))
+  (def/public (after-change-style [exact-nonnegative-integer? start]
+                                  [exact-nonnegative-integer? len])
+    (void))
+
+  (def/public (after-set-position) (void))
+
+  (def/public (can-set-size-constraint?) #t)
+  (def/public (on-set-size-constraint) (void))
+  (def/public (after-set-size-constraint) (void))
+
+  (def/public (after-split-snip [exact-nonnegative-integer? pos]) (void))
+  (def/public (after-merge-snips [exact-nonnegative-integer? pos]) (void))
+
+  ;; ----------------------------------------
+
+  (def/override (begin-edit-sequence [any? [undoable? #t]] [any? [interrupt-seqs? #t]])
+    (wait-sequence-lock)
+
+    (when (and (zero? delay-refresh)
+               (not interrupt-seqs?))
+      (push-streaks))
+
+    (end-streaks '(delayed))
+
+    (when (or (positive? s-noundomode)
+              (not undoable?))
+      (set! s-noundomode (add1 s-noundomode)))
+    
+    (if (zero? delay-refresh)
+        (begin
+          (when ALLOW-X-STYLE-SELECTION?
+            (set! need-x-copy? #t))
+          (set! delay-refresh 1)
+          (on-edit-sequence))
+        (set! delay-refresh (add1 delay-refresh))))
+
+  (def/override (end-edit-sequence)
+    (if (zero? delay-refresh)
+        (log-error "end-edit-sequence without begin-edit-sequence")
+        (begin
+          (set! delay-refresh (sub1 delay-refresh))
+          (when (zero? delay-refresh)
+            (end-streaks null)
+            (pop-streaks)
+            (redraw)
+            (when ALLOW-X-STYLE-SELECTION?
+              (set! need-x-copy? #f))
+            (after-edit-sequence))
+          (when (positive? s-noundomode)
+            (set! s-noundomode (sub1 s-noundomode)))
+          (when (and (zero? delay-refresh)
+                     s-need-on-display-size?)
+            (set! s-need-on-display-size? #f)
+            (on-display-size)))))
+
+  (def/override (refresh-delayed?)
+    (or (delay-refresh . > . 0)
+        (not s-admin)
+        (send s-admin delay-refresh?)))
+
+  (def/override (in-edit-sequence?)
+    (delay-refresh . > . 0))
+
+  (def/override (locations-computed?)
+    (not graphic-maybe-invalid?))
+
+  (def/public (recalculate) (void))
+  
+  (def/public (get-position [maybe-box? start] [maybe-box? [end #f]])
+    (when start (set-box! start startpos))
+    (when end (set-box! end endpos)))
+  
+  (def/public (get-start-position) startpos)
+  (def/public (get-end-position) endpos)
+
+  (def/public (set-position [exact-nonnegative-integer? start]
+                            [(make-alts exact-nonnegative-integer? (make-literal 'same)) [end 'same]]
+                            [any? [ateol? #f]]
+                            [any? [scroll? #t]]
+                            [(symbol-in default x local) [seltype 'default]])
+    (do-set-position #f 'none start end ateol? scroll? seltype))
+
+  (def/public (set-position-bias-scroll [symbol? bias]
+                                        [exact-nonnegative-integer? start]
+                                        [(make-alts exact-nonnegative-integer? (make-literal 'same)) [end 'same]]
+                                        [any? [ateol? #f]]
+                                        [any? [scroll? #t]]
+                                        [(symbol-in default x local) [seltype 'default]])
+    (do-set-position #f bias start end ateol? scroll? seltype))
+
+  (define/private (do-set-position setflash? bias start end ateol? scroll? seltype)
+    (unless flow-locked?
+      (when (and (not setflash?)
+                 (or (not flash?) (not flashautoreset?) (not flashdirectoff?)))
+        (end-streaks '(delayed)))
+      
+      (unless (or (start . < . 0) 
+                  (and (number? end)
+                       (start . > . end)))
+        (let* ([start (min start len)]
+               [end (if (symbol? end)
+                        start
+                        (min end len))]
+               [ateol?
+                (and ateol?
+                     (= end start)
+                     (let-values ([(snip s-pos)
+                                   (find-snip/pos start 'before)])
+                       (and (has-flag? (snip->flags snip) NEWLINE) 
+                            (not (has-flag? (snip->flags snip) INVISIBLE))
+                            (= start (+ s-pos (snip->count snip))))))])
+          (let-values ([(oldstart oldend oldateol?)
+                        (if flash?
+                            (values flashstartpos flashendpos flashposateol?)
+                            (values startpos endpos posateol?))])
+            (when (and (not setflash?)
+                       flash?
+                       flashautoreset?)
+              (set! flash? #f)
+              (when flash-timer
+                (send flash-timer stop)
+                (set! flash-timer #f)))
+            (let* ([need-refresh? (not (and (= oldstart start)
+                                            (= oldend end)
+                                            (eq? oldateol? ateol?)))]
+                   [changed-pos? need-refresh?])
+
+              (if setflash?
+                  (begin
+                    (set! flashstartpos start)
+                    (set! flashendpos end)
+                    (set! flashposateol? ateol?))
+                  (begin
+                    (when ALLOW-X-STYLE-SELECTION?
+                      (when (or (= end start)
+                                (not (eq? editor-x-selection-allowed this))
+                                (eq? 'local seltype))
+                        (when (or (zero? delay-refresh) need-x-copy?)
+                          (set! need-x-copy? #f)
+                          (copy-out-x-selection))))
+                    
+                    (check-merge-snips startpos)
+                    (check-merge-snips endpos)
+    
+                    (set! caret-style #f)
+                    (set! startpos start)
+                    (set! endpos end)
+                    (set! posateol? ateol?)))
+
+              (let-values ([(need-refresh? need-full-refresh?)
+                            (let ([refresh? (and ALLOW-X-STYLE-SELECTION?
+                                                 (not setflash?)
+                                                 editor-x-selection-mode?
+                                                 (or (and (not (eq? 'local seltype))
+                                                          (not (= start end ))
+                                                          (not (eq? editor-x-selection-owner this))
+                                                          (eq? (own-x-selection #t #f seltype) 'x))
+                                                     (and (or (= start end)
+                                                              (not (eq? editor-x-selection-allowed this))
+                                                              (eq? 'local seltype))
+                                                          (eq? editor-x-selection-owner this)
+                                                          (own-x-selection #f #f #f))))])
+                              (values (or refresh? need-refresh?)
+                                      refresh?))])
+                (when setflash?
+                  (set! flash? #t))
+
+                (let ([need-refresh?
+                       (or
+                        (and scroll?
+                             (let-values ([(scroll-start scroll-end bias)
+                                           (cond
+                                            [(eq? bias 'start-only)
+                                             (values start start 'none)]
+                                            [(eq? bias 'end-only)
+                                             (values end end 'none)]
+                                            [else
+                                             (values start end bias)])])
+                               (let ([was-blinked? caret-blinked?])
+                                 (set! caret-blinked? #f)
+                                 (if (scroll-to-position/refresh scroll-start posateol? #t scroll-end bias)
+                                     #t
+                                     (begin
+                                       (set! caret-blinked? was-blinked?)
+                                       #f)))))
+                        need-refresh?)])
+
+                  (when need-refresh?
+                    (set! caret-blinked? #f)
+                    (if (or (start . >= . oldend)
+                            (end . <= . oldstart)
+                            need-full-refresh?)
+                        (begin
+                          ;; no overlap:
+                          (need-refresh oldstart oldend)
+                          (need-refresh start end))
+                        (begin
+                          (when (start . < . oldstart)
+                            (need-refresh start oldstart))
+                          (when (oldstart . < . start)
+                            (need-refresh oldstart start))
+                          (when (end . < . oldend)
+                            (need-refresh end oldend))
+                          (when (oldend . < . end)
+                            (need-refresh oldend end)))))))
+
+              (when (and changed-pos? (not setflash?))
+                (after-set-position))))))))
+
+  (define/private (scroll-to-position/refresh start
+                                              [ateol? #f]
+                                              [refresh? #t]
+                                              [end 'same]
+                                              [bias 'none])
+    (and 
+     (not flow-locked?)
+     (let ([end (if (eq? end 'same) start (max start end))])
+       (cond
+        [(positive? delay-refresh)
+         (when s-admin
+           (set! delayedscrollbox? #f)
+           (set! delayedscroll start)
+           (set! delayedscrollend end)
+           (set! delayedscrollateol? ateol?)
+           (set! delayedscrollbias bias))
+         #f]
+        [(not (check-recalc #t #f))
+         #f]
+        [else
+         (set! delayedscroll -1)
+  
+         (let-boxes ([topx 0.0] [topy 0.0]
+                     [botx 0.0] [boty 0.0])
+             (begin
+               (position-location start topx topy #t ateol? #t)
+               (position-location end botx boty #f ateol? #t))
+           (let-values ([(topx botx)
+                         (if (botx . < . topx)
+                             ;; when the end position is to the left of the start position 
+                             (values 0 total-width)
+                             (values topx botx))])
+             (scroll-editor-to topx topy (- botx topx) (- boty topy) refresh? bias)))]))))
+
+  (def/public (scroll-to-position [exact-nonnegative-integer? start]
+                                  [any? [ateol? #f]]
+                                  [(make-alts exact-nonnegative-integer? (make-literal 'same)) [end 'same]]
+                                  [(symbol-in start end none) [bias 'none]])
+    (scroll-to-position/refresh start ateol? #t end bias))
+
+  (define/private (get-visible-X-range start end all? find)
+    (when (check-recalc #t #f)
+      (let-boxes ([x 0.0] [y 0.0] [w 0.0] [h 0.0])
+          (if all?
+              (send s-admin get-max-view x y w h)
+              (send s-admin get-view x y w h))
+        (begin
+          (when start
+            (set-box! start (find x y)))
+          (when end
+            (set-box! end (find (+ x w) (+ y h))))))))
+
+  (def/public (get-visible-position-range [maybe-box? start] [maybe-box? end] [any? [all? #t]])
+    (get-visible-X-range start end all? (lambda (x y) (find-position x y))))
+
+  (def/public (get-visible-line-range [maybe-box? start] [maybe-box? end] [any? [all? #t]])
+    (get-visible-X-range start end all? (lambda (x y) (find-line y))))
+
+  ;; ----------------------------------------
+
+  (def/public (move-position [(make-alts symbol? char?) code]
+                             [any? [extend-selection? #f]]
+                             [(symbol-in simple word page line) [kind 'simple]])
+    (unless (or flow-locked?
+                (not (check-recalc (max-width . > . 0.0) #f #t)))
+
+      (let-values ([(anchor?) anchor-streak?]
+                   [(vcursor?) vcursor-streak?]
+                   [(extendstart extendend)
+                    (if (or extend-streak? anchor-streak?)
+                        (values extendstartpos extendendpos)
+                        (values startpos endpos))]
+                   [(kas?) keep-anchor-streak?])
+
+        (set! keep-anchor-streak? anchor-streak?)
+        
+        (end-streaks '(delayed))
+
+        (let* ([extend? (or anchor? extend-selection?)]
+               ;; rightshrink: motion to right shrinks the selected region
+               [rightshrink? (and extend? (startpos . < . extendstart))]
+               [leftshrink? (and extend? (endpos . > . extendend))])
+          (let-values ([(code kind)
+                        (cond
+                         [(eq? 'prior code) (values 'up 'page)]
+                         [(eq? 'next code) (values 'down 'page)]
+                         [else (values code kind)])])
+            (cond
+             [(eq? 'home code)
+              (if leftshrink?
+                  (set-position-bias-scroll 'start-only extendstart extendend)
+                  (set-position-bias-scroll 'start-only 0 (if extend? extendend 0)))]
+             [(eq? 'end code)
+              (if rightshrink?
+                  (set-position-bias-scroll 'end-only extendstart extendend)
+                  (set-position-bias-scroll 'end-only (if extend? extendstart len) len))]
+             [(eq? 'left code)
+              (if (and (not (eq? 'line kind))
+                       (not (eq? 'word kind))
+                       (not extend?)
+                       (not (= endpos startpos)))
+                  (set-position startpos)
+                  (begin
+                    ;; pick a starting place
+                    (let ([start 
+                           (let ([start (if leftshrink?
+                                            endpos
+                                            startpos)])
+                             (cond
+                              [(eq? 'word kind)
+                               (let-boxes ([start start])
+                                   (find-wordbreak start #f 'caret)
+                                 start)]
+                              [(eq? 'line kind)
+                               (line-start-position (position-line start posateol?))]
+                              [else (max 0 (sub1 start))]))])
+                      (let-values ([(start end)
+                                    (if extend?
+                                        (if leftshrink?
+                                            (let ([start (max start extendend)]) ;; collapse to original
+                                              (values startpos start))
+                                            (values start endpos))
+                                        (values start start))])
+                        (set-position-bias-scroll 'start-only start end)))))]
+             [(eq? 'right code)
+              (if (and (not (eq? 'line kind))
+                       (not (eq? 'word kind))
+                       (not extend?)
+                       (not (= endpos startpos)))
+                  (set-position endpos endpos #t)
+                  (begin
+                    ;; pick a starting place
+                    (let ([end
+                           (let ([end (if rightshrink?
+                                          startpos
+                                          endpos)])
+                             (cond
+                              [(eq? 'word kind)
+                               (let-boxes ([end end])
+                                   (find-wordbreak #f end 'caret)
+                                 end)]
+                              [(eq? 'line kind)
+                               (line-end-position (position-line end posateol?))]
+                              [else (add1 end)]))])
+                      (let-values ([(start end)
+                                    (if extend?
+                                        (if rightshrink?
+                                            (let ([end (min end extendstart)]) ;; collapse to original
+                                              (values end endpos))
+                                            (values startpos end))
+                                        (values end end))])
+                        (set-position-bias-scroll 'end-only start end #t)))))]
+             [(or (eq? 'up code) (eq? 'down code))
+              (let ([special-scroll? (eq? 'page kind)]) ;; used when paging
+                (let-values ([(start end ateol? special-scroll?
+                                     scroll-left scroll-top scroll-width scroll-height
+                                     bias)
+                              (if (eq? 'up code)
+                                  (let ([start (if leftshrink?
+                                                   endpos
+                                                   startpos)])
+                                    (let-boxes ([vcl vcursorloc])
+                                        (when (not vcursor?)
+                                          (position-location start vcl #f #t posateol? #t))
+                                      (set! vcursorloc vcl)
+                                      (let ([cline (position-line start posateol?)])
+                                        (let-values ([(i scroll-left scroll-top scroll-width scroll-height)
+                                                      (if (eq? 'page kind)
+                                                          ;; the current top line should become the next-to bottom line.
+                                                          ;; the caret should go to line above current top line, but
+                                                          ;; watch out for:
+                                                          ;;   - especially tall lines
+                                                          ;;   - already at top
+                                                          (let-boxes ([scroll-left 0.0] [vy 0.0]
+                                                                      [scroll-width 0.0] [scroll-height 0.0])
+                                                              (send s-admin get-view scroll-left vy scroll-width scroll-height)
+                                                            ;; top line should be completely visible as bottom line after
+                                                            ;;   scrolling
+                                                            (let* ([top (find-scroll-line vy)]
+                                                                   [ty (scroll-line-location (+ top 1))]
+                                                                   [newtop (find-scroll-line (- ty scroll-height))]
+                                                                   [y (scroll-line-location newtop)]
+                                                                   [newtop (if (y . < . (- ty scroll-height))
+                                                                               (add1 newtop)
+                                                                               newtop)]
+                                                                   [y (scroll-line-location newtop)]
+                                                                   ;; y is the new top location
+                                                                   [y (if (y . >= . vy)
+                                                                          ;; no or backward progess
+                                                                          (scroll-line-location (max 0 (sub1 top)))
+                                                                          y)])
+                                                              (let ([i (if (= vy y)
+                                                                           ;; must be at the top:
+                                                                           (find-line y)
+                                                                           (let ([i (find-line (+ y scroll-height))])
+                                                                             (if ((line-location (max 0 (- i 1))) . > . y)
+                                                                                 (sub1 i)
+                                                                                 i)))])
+                                                                (values i scroll-left y scroll-width scroll-height))))
+                                                          (values (- cline 1) 0.0 0.0 0.0 0.0))])
+                                          (let-boxes ([start 0] [ateol? #f])
+                                              (if (i . >= . 0)
+                                                  (set-box! start (find-position-in-line i vcursorloc ateol?))
+                                                  (begin (set-box! start 0) (set-box! ateol? #f)))
+                                            (let-values ([(start end special-scroll?)
+                                                          (if extend?
+                                                              (if leftshrink?
+                                                                  (if (start . < . extendend)
+                                                                      (if (and (not (eq? 'page kind))
+                                                                               (start . < . extendstart))
+                                                                          ;; inversion!
+                                                                          (values start extendend special-scroll?)
+                                                                          ;; Collapse to original
+                                                                          (values startpos extendend #f))
+                                                                      (values startpos start special-scroll?))
+                                                                  (values start endpos special-scroll?))
+                                                              (values start start special-scroll?))])
+                                              (values start end ateol? special-scroll?
+                                                      scroll-left scroll-top scroll-width scroll-height
+                                                      (if leftshrink? 'end-only 'start-only))))))))
+                                  ;; (eq? code 'down)
+                                  (let ([end (if rightshrink?
+                                                 startpos
+                                                 endpos)])
+                                    (let-boxes ([vcl vcursorloc])
+                                        (when (not vcursor?)
+                                          (position-location end vcl #f #t posateol? #t))
+                                      (set! vcursorloc vcl)
+                                      (let ([cline (position-line end posateol?)])
+                                        (let-values ([(i scroll-left scroll-top scroll-width scroll-height)
+                                                      (if (eq? 'page kind)
+                                                          (let-boxes ([scroll-left 0.0] [vy 0.0]
+                                                                      [scroll-width 0.0] [scroll-height 0.0])
+                                                              (send s-admin get-view scroll-left vy scroll-width scroll-height)
+                                                            ;; last fully-visible line is the new top line 
+                                                            (let* ([newtop (find-scroll-line (+ vy scroll-height))]
+                                                                   [y (scroll-line-location (+ newtop 1))]
+                                                                   [newtop (if (y . > . (+ vy scroll-height))
+                                                                               (sub1 newtop)
+                                                                               newtop)]
+                                                                   [y (scroll-line-location newtop)])
+                                                              ;; y is the new top location
+                                                              (let-values ([(newtop y)
+                                                                            (if (y . <= . vy)
+                                                                                ;; no or backwards movement; scroll back one
+                                                                                (let ([newtop (+ (find-scroll-line vy) 1)])
+                                                                                  (values newtop (scroll-line-location newtop)))
+                                                                                (values newtop y))])
+                                                                ;; compute top line, for caret
+                                                                (let* ([i (find-line y)]
+                                                                       [i (if ((line-location i #t) . < . y)
+                                                                              (add1 i)
+                                                                              i)])
+                                                                  ;; Now, suppose we're scrolling down while extending the
+                                                                  ;; selection. We want to be able to see that we're
+                                                                  ;; selecting. So try moving the line `i' down one more, if
+                                                                  ;; there's room:
+                                                                  (let ([i (if ((line-location (+ i 1) #f) . < . (+ y scroll-height))
+                                                                               (add1 i)
+                                                                               i)])
+                                                                    (values i scroll-left (- y 1) scroll-width scroll-height))))))
+                                                          (values (+ cline 1) 0.0 0.0 0.0 0.0))])
+                                          (let-values ([(end ateol?)
+                                                        (if (i . <= . (sub1 num-valid-lines))
+                                                            (let-boxes ([ateol? #f] [end 0])
+                                                                (set-box! end (find-position-in-line i vcursorloc ateol?))
+                                                              (values end ateol?))
+                                                            (values len #f))])
+                                            (let-values ([(start end special-scroll?)
+                                                          (if extend?
+                                                              (if rightshrink?
+                                                                  (if (end . > . extendstart)
+                                                                      (if (and (not (eq? 'page kind))
+                                                                               (end . > . extendend))
+                                                                          ;; inversion!
+                                                                          (values extendstart end special-scroll?)
+                                                                          ;; collapse to original
+                                                                          (values extendstart endpos #f))
+                                                                      (values end endpos special-scroll?))
+                                                                  (values startpos end special-scroll?))
+                                                              (values end end special-scroll?))])
+                                              (values start end ateol? special-scroll?
+                                                      scroll-left scroll-top scroll-width scroll-height
+                                                      (if rightshrink? 'start-only 'end-only)))))))))])
+                  (when special-scroll?
+                    (begin-edit-sequence))
+                  
+                  ;; scroll only if !special-scroll
+                  (set-position-bias-scroll bias start end ateol? (not special-scroll?))
+
+                  (when special-scroll?
+                    ;; special scrolling intructions:
+                    (do-scroll-to #f scroll-left scroll-top scroll-width scroll-height #f 'none)
+
+                    (end-edit-sequence))
+
+                  (set! vcursor-streak? #t)))])
+
+            (set! keep-anchor-streak? kas?)
+            (when extend?
+              (set! extend-streak? #t))
+
+            (when (or extend-streak? anchor-streak?)
+              (set! extendendpos extendend)
+              (set! extendstartpos extendstart)))))))
+
+  (def/public (set-anchor [any? on?])
+    (let ([wason? anchor-streak?])
+      (set! anchor-streak? (and on? #t))
+      (when (and on? (not wason?))
+        (set! extendendpos endpos)
+        (set! extendstartpos startpos))))
+
+  (def/public (get-anchor)
+    anchor-streak?)
+
+  ;; ----------------------------------------
+
+  (define/private (do-insert isnip str snipsl start end scroll-ok?)
+    (unless (or write-locked?
+                s-user-locked?
+                (start . < . 0))
+      (let ([start (min start len)])
+        ;; turn off pending style, if it doesn't apply
+        (when caret-style
+          (when (or (not (equal? end start)) (not (= startpos start)))
+            (set! caret-style #f)))
+        (let ([deleted? (and (not (eq? end 'same))
+                             (start . < . end)
+                             (begin
+                               (when ALLOW-X-STYLE-SELECTION?
+                                 (when (zero? delay-refresh)
+                                   (set! need-x-copy? #t)))
+                               (when (or isnip str snipsl)
+                                 (begin-edit-sequence))
+                               (delete start end scroll-ok?)
+                               (when ALLOW-X-STYLE-SELECTION?
+                                 (when (zero? delay-refresh)
+                                   (set! need-x-copy? #f)))
+                               #t))])
+          (when (or isnip str snipsl)
+            (set! write-locked? #t)
+            (let ([success-finish
+                   (lambda (addlen inserted-line?)
+                     (set! initial-style-needed? #f)
+                     (set! revision-count (add1 revision-count))
+
+                     (adjust-clickbacks start start addlen #f)
+
+                     (unless s-modified?
+                       (add-undo-rec (make-object unmodify-record% delayed-streak?)))
+                     (unless (positive? s-noundomode)
+                       (add-undo-rec
+                        (make-object insert-record%
+                                     start addlen
+                                     (or deleted? typing-streak? delayed-streak?
+                                         insert-force-streak?
+                                         (not s-modified?))
+                                     startpos endpos)))
+                     (when (positive? delay-refresh)
+                       (set! delayed-streak? #t))
+
+                     (let ([scroll? (= start startpos)])
+
+                       (when (startpos . >= . start)
+                         (set! startpos (+ startpos addlen)))
+                       (when (endpos . >= . start)
+                         (set! endpos (+ endpos addlen)))
+                       (unless refresh-unset?
+                         (when (refresh-start . >= . start)
+                           (set! refresh-start (+ refresh-start addlen)))
+                         (when (refresh-end . >= . start)
+                           (set! refresh-end (+ refresh-end addlen))))
+
+                       (set! extra-line? (has-flag? (snip->flags last-snip) NEWLINE))
+
+                       (set! write-locked? #f)
+                       (set! flow-locked? #f)
+
+                       (when scroll?
+                         (set! caret-blinked? #f))
+
+                       (when (and scroll? scroll-ok?)
+                         (set! delay-refresh (add1 delay-refresh))
+                         (scroll-to-position/refresh startpos)
+                         (set! delay-refresh (sub1 delay-refresh)))
+
+                       (set! changed? #t)
+
+                       (set! caret-style #f)
+
+                       (if inserted-line?
+                           (begin
+                             (set! graphic-maybe-invalid? #t)
+                             (need-refresh start))
+                           (refresh-by-line-demand))
+
+                       (when deleted?
+                         (end-edit-sequence))
+
+                       (unless s-modified?
+                         (set-modified #t))
+                       
+                       (after-insert start addlen)))]
+                  [fail-finish
+                   (lambda ()
+                     (set! write-locked? #f)
+                     (set! flow-locked? #f)
+                     (when deleted?
+                       (end-edit-sequence)))])
+            (cond
+             [(or isnip snipsl) 
+              (insert-snips (if isnip (list isnip) snipsl) start success-finish fail-finish)]
+             [else (insert-string str start success-finish fail-finish)])))))))
+  
+  (define/private (insert-snips snipsl start success-finish fail-finish)
+    (let ([addlen (for/fold ([addlen 0])
+                      ([isnip (in-list snipsl)]
+                       #:when addlen)
+                    (let ([c (snip->count isnip)])
+                      (and (positive? c)
+                           (not (send isnip is-owned?))
+                           (+ addlen c))))])
+
+      (if (or (not addlen)
+              (zero? addlen)
+              (not (can-insert? start addlen)))
+          (fail-finish)
+          (begin
+            (on-insert start addlen)
+
+            (set! flow-locked? #t)
+
+            ;; make sure on-insert didn't do something bad to the snips:
+            (if (not (for/and ([isnip (in-list snipsl)])
+                       (and (positive? (snip->count isnip))
+                            (not (send isnip is-owned?)))))
+
+                (fail-finish)
+
+                (let loop ([did-one? #f]
+                           [before-snip #f]
+                           [inserted-line? #f]
+                           [snipsl snipsl])
+
+                  (if (null? snipsl)
+                      (success-finish addlen inserted-line?)
+                      (let ([isnip (car snipsl)])
+                        (when (and (has-flag? (snip->flags isnip) NEWLINE)
+                                   (not (has-flag? (snip->flags isnip) HARD-NEWLINE)))
+                          (set-snip-flags! isnip (remove-flag (snip->flags isnip) NEWLINE)))
+
+                        (let-values ([(before-snip inserted-new-line?)
+                                      (if (and (zero? len) (not did-one?))
+                                          
+                                          ;; special case: ignore the empty snip
+                                          (begin
+                                            (set! snips isnip)
+                                            (set! last-snip isnip)
+                                            (let ([line-root (create-mline)])
+                                              (set-box! line-root-box line-root)
+                                              (set-snip-line! isnip line-root)
+                                              (set-mline-snip! line-root isnip)
+                                              (set-mline-last-snip! line-root isnip)
+                                              (when (max-width . > . 0)
+                                                (mline-mark-check-flow line-root)))
+                                            (values before-snip #f))
+
+                                          (let* ([gsnip (if (not did-one?)
+                                                            (begin
+                                                              (make-snipset start start)
+                                                              (find-snip start 'after-or-none))
+                                                            before-snip)]
+                                                 [before-snip (or before-snip gsnip)]
+                                                 [inserted-new-line?
+                                                  (if (not gsnip)
+                                                      (begin
+                                                        (append-snip isnip)
+                                                        (let ([gsnip (mline-last-snip last-line)])
+                                                          (if (and gsnip (has-flag? (snip->flags gsnip) HARD-NEWLINE))
+                                                              (let ([line (mline-insert last-line line-root-box #f)])
+                                                                (set-snip-line! isnip line)
+                                                                (set-mline-snip! line isnip)
+                                                                (set-mline-last-snip! line isnip)
+                                                                (set! num-valid-lines (add1 num-valid-lines))
+                                                                #t)
+                                                              (begin
+                                                                (set-snip-line! isnip last-line)
+                                                                (when (not (mline-snip last-line))
+                                                                  (set-mline-snip! last-line isnip))
+                                                                (set-mline-last-snip! last-line isnip)
+                                                                ;; maybe added extra ghost line:
+                                                                (has-flag? (snip->flags isnip) HARD-NEWLINE)))))
+                                                      (begin
+                                                        (insert-snip gsnip isnip)
+                                                        (if (has-flag? (snip->flags isnip) HARD-NEWLINE)
+                                                            (let* ([gline (snip->line gsnip)]
+                                                                   [line (mline-insert gline line-root-box #t)])
+                                                              (set-snip-line! isnip line)
+                                                              (set! num-valid-lines (add1 num-valid-lines))
+                                                              (if (eq? gsnip (mline-snip gline))
+                                                                  (set-mline-snip! line isnip)
+                                                                  (set-mline-snip! line (mline-snip gline)))
+                                                              (set-mline-last-snip! line isnip)
+                                                              (set-mline-snip! gline gsnip)
+                                                              
+                                                              (let loop ([c-snip (mline-snip line)])
+                                                                (unless (eq? c-snip isnip)
+                                                                  (set-snip-line! c-snip line)
+                                                                  (loop (snip->next c-snip))))
+                                                              
+                                                              (mline-calc-line-length gline)
+                                                              (mline-mark-recalculate gline)
+                                                              #t)
+                                                            (let ([gline (snip->line gsnip)])
+                                                              (set-snip-line! isnip gline)
+                                                              (when (eq? (mline-snip gline) gsnip)
+                                                                (set-mline-snip! gline isnip))
+                                                              #f))))])
+                                            
+                                            (when (max-width . > . 0)
+                                              (mline-mark-check-flow (snip->line isnip))
+                                              (let ([prev (snip->prev isnip)])
+                                                (when (and prev
+                                                           (not (has-flag? (snip->flags isnip) NEWLINE)))
+                                                  (mline-mark-check-flow (snip->line prev))))
+                                              (let ([next (mline-next (snip->line isnip))])
+                                                (when (and next
+                                                           (has-flag? (snip->flags isnip) HARD-NEWLINE))
+                                                  (mline-mark-check-flow next))))
+
+                                            (values before-snip inserted-new-line?)))])
+                          
+                          (set-snip-style! isnip (send s-style-list convert (or (snip->style isnip)
+                                                                                (send s-style-list basic-style))))
+                          
+                          (send isnip size-cache-invalid)
+
+                          (mline-calc-line-length (snip->line isnip))
+                          (mline-mark-recalculate (snip->line isnip))
+
+                          (set! len (+ len (snip->count isnip)))
+                          
+                          (snip-set-admin isnip snip-admin)
+
+                          (set! first-line (mline-first (unbox line-root-box)))
+                          (set! last-line (mline-last (unbox line-root-box)))
+
+                          (loop #t
+                                before-snip
+                                (or inserted-line? inserted-new-line?)
+                                (cdr snipsl)))))))))))
+
+  (define/private (insert-string str start success-finish fail-finish)
+    (let ([addlen (string-length str)])
+      (if (not (can-insert? start addlen))
+          (fail-finish)
+          (begin
+            (on-insert start addlen)      
+    
+            (set! flow-locked? #t)
+
+            (let-values ([(snip s-pos inserted-line?)
+                          (if (zero? len)
+                              
+                              (let* ([style (if (and sticky-styles?
+                                                     (not initial-style-needed?))
+                                                (snip->style snips)
+                                                (get-default-style))]
+                                     [snip (insert-text-snip start style)])
+                                (set! caret-style #f)
+                                (set-mline-snip! (unbox line-root-box) snip)
+                                (set-mline-last-snip! (unbox line-root-box) snip)
+                                (values snip 0 #f))
+
+                              (let-values ([(gsnip s-pos)
+                                            (if (positive? start)
+                                                (find-snip/pos start 'before)
+                                                (values #f 0))])
+                                (let-values ([(snip s-pos)
+                                              (if (or (not gsnip)
+                                                      (and caret-style (not (eq? caret-style (snip->style gsnip))))
+                                                      (not (has-flag? (snip->flags gsnip) IS-TEXT))
+                                                      ((+ (snip->count gsnip) addlen) . > . MAX-COUNT-FOR-SNIP)
+                                                      (and (not sticky-styles?)
+                                                           (not (eq? (snip->style gsnip) (get-default-style)))))
+                                                  
+                                                  (let ([style (or caret-style
+                                                                   (if sticky-styles?
+                                                                       (if gsnip
+                                                                           (snip->style gsnip)
+                                                                           (snip->style snips))
+                                                                       (get-default-style)))])
+                                                    (let ([snip (insert-text-snip start style)])
+                                                      (set! caret-style #f)
+                                                      (values snip start)))
+                                                  
+                                                  (let ([snip gsnip])
+                                                    (if (has-flag? (snip->flags snip) CAN-APPEND)
+                                                        (values snip s-pos)
+                                                        (let ([style (if sticky-styles?
+                                                                         (snip->style snip)
+                                                                         (get-default-style))])
+                                                          (values (insert-text-snip start style)
+                                                                  start)))))])
+
+                                  (if (and gsnip
+                                           (has-flag? (snip->flags gsnip) HARD-NEWLINE)
+                                           (eq? (snip->next gsnip) snip))
+                                      ;; preceeding snip was a newline, so the new slip belongs on the next line:
+                                      (let* ([oldline (snip->line gsnip)]
+                                             [inserted-new-line?
+                                              (if (mline-next oldline)
+                                                  #f
+                                                  (begin
+                                                    (mline-insert oldline line-root-box #f)
+                                                    (set! num-valid-lines (add1 num-valid-lines))
+                                                    (set-mline-last-snip! (mline-next oldline) snip)
+                                                    #t))])
+                                        (let ([newline (mline-next oldline)])
+                                          (set-snip-line! snip newline)
+                                          
+                                          (set-mline-last-snip! oldline gsnip)
+                                          (set-mline-snip! newline snip)
+                                          
+                                          (mline-calc-line-length oldline)
+                                          (mline-mark-recalculate oldline)
+                                          (values snip s-pos inserted-new-line?)))
+                                      
+                                      (values snip s-pos #f)))))])
+
+              (let ([s (- start s-pos)])
+                (set-snip-flags! snip (add-flag (snip->flags snip) CAN-SPLIT))
+                (send snip insert str addlen s)
+                (when (has-flag? (snip->flags snip) CAN-SPLIT)
+                  (set-snip-flags! snip (remove-flag (snip->flags snip) CAN-SPLIT)))
+
+                (mline-calc-line-length (snip->line snip))
+                (mline-mark-recalculate (snip->line snip))
+
+                (when (max-width . > . 0)
+                  (mline-mark-check-flow (snip->line snip))
+                  (let ([prev (mline-prev (snip->line snip))])
+                    (when (and prev
+                               (not (has-flag? (snip->flags (mline-last-snip prev)) HARD-NEWLINE)))
+                      (mline-mark-check-flow prev))))
+
+                ;; The text is inserted, but all into one big snip. If the
+                ;;  inserted text contains any newlines or tabs, we need to split
+                ;;  it up to use tab snips or the HARD-NEWLINE flag:
+                (let loop ([snip-start-pos start]
+                           [str (string-snip-buffer snip)]
+                           [sp (+ s (string-snip-dtext snip))]
+                           [i 0]
+                           [cnt 0]
+                           [inserted-line? inserted-line?])
+                  (if (= i addlen)
+                      (begin
+                        (set! first-line (mline-first (unbox line-root-box)))
+                        (set! last-line (mline-last (unbox line-root-box)))
+                        (set! len (+ len addlen))
+                        (unless (= (last-position) (+ (mline-get-position last-line)
+                                                      (mline-len last-line)))
+                          (error "yuck out"))
+                        (success-finish addlen inserted-line?))
+                      (begin
+                        (when (equal? (string-ref str sp) #\return)
+                          (string-set! str sp #\newline))
+                        (let ([c (string-ref str sp)])
+                          (cond
+                           [(or (equal? c #\newline) (equal? c #\tab))
+                            (let ([newline? (equal? c #\newline)])
+                              (make-snipset (+ i start) (+ i start 1))
+                              (let ([snip (find-snip (+ i start) 'after)])
+                                (if newline?
+
+                                    ;; forced return - split the snip
+                                    (begin
+                                      (set-snip-flags! snip
+                                                       (remove-flag
+                                                        (add-flag (add-flag (add-flag (snip->flags snip)
+                                                                                      NEWLINE)
+                                                                            HARD-NEWLINE)
+                                                                  INVISIBLE)
+                                                        CAN-APPEND))
+                                      (if (not (eq? snip (mline-last-snip (snip->line snip))))
+                                          (let* ([old-line (snip->line snip)]
+                                                 [line (mline-insert old-line line-root-box #t)])
+                                            (set-snip-line! snip line)
+                                            (set! num-valid-lines (add1 num-valid-lines))
+                                            (set-mline-last-snip! line snip)
+                                            (set-mline-snip! line (mline-snip old-line))
+
+                                            ;; retarget snips moved to new line:
+                                            (let loop ([c-snip (mline-snip old-line)])
+                                              (unless (eq? c-snip snip)
+                                                (set-snip-line! c-snip line)
+                                                (loop (snip->next c-snip))))
+                                            
+                                            (set-mline-snip! old-line (snip->next snip))
+
+                                            (mline-calc-line-length old-line)
+                                            (mline-mark-recalculate old-line)
+                                            (when (max-width . > . 0)
+                                              (mline-mark-check-flow old-line))
+
+                                            (mline-calc-line-length line)
+                                            (mline-mark-recalculate line)
+                                            (when (max-width . > . 0)
+                                              (mline-mark-check-flow line)))
+
+                                          ;; carriage-return inserted at the end of a auto-wrapped line;
+                                          ;; line lengths stay the same, but next line now starts
+                                          ;; a paragraph
+                                          (let ([next (mline-next (snip->line snip))])
+                                            (when next
+                                              (when (zero? (mline-starts-paragraph next))
+                                                (mline-set-starts-paragraph next #t))))))
+
+                                    ;; convert a tab to a tab-snip%
+                                    (let ([tabsnip (let ([ts (on-new-tab-snip)])
+                                                     (if (or (send ts is-owned?)
+                                                             (positive? (snip->count ts)))
+                                                         ;; uh-oh
+                                                         (new tab-snip%)
+                                                         ts))])
+                                      (set-snip-style! tabsnip (snip->style snip))
+                                      (let* ([rsnip (snip-set-admin tabsnip snip-admin)]
+                                             [tabsnip (if (not (eq? rsnip tabsnip))
+                                                          ;; uh-oh
+                                                          (let ([tabsnip (new tab-snip%)])
+                                                            (set-snip-style! tabsnip (snip->style snip))
+                                                            (send tabsnip set-admin snip-admin)
+                                                            tabsnip)
+                                                          tabsnip)])
+                                        
+                                        (set-snip-flags! tabsnip 
+                                                         (add-flag (snip->flags tabsnip) CAN-SPLIT))
+                                        (send tabsnip insert "\t" 1 0)
+                                        (when (has-flag? (snip->flags tabsnip) CAN-SPLIT)
+                                          (set-snip-flags! tabsnip 
+                                                           (remove-flag (snip->flags tabsnip) CAN-SPLIT)))
+
+                                        (splice-snip tabsnip (snip->prev snip) (snip->next snip))
+                                        (set-snip-line! tabsnip (snip->line snip))
+                                        (when (eq? (mline-snip (snip->line snip)) snip)
+                                          (set-mline-snip! (snip->line tabsnip) tabsnip))
+                                        (when (eq? (mline-last-snip (snip->line snip)) snip)
+                                          (set-mline-last-snip! (snip->line tabsnip) tabsnip))))))
+
+                              (let ([snip (find-snip (+ i start 1) 'after)])
+                                (let ([i (add1 i)])
+                                  (loop (+ i start)
+                                        (if (= i addlen) #f (string-snip-buffer snip))
+                                        (if (= i addlen) #f (string-snip-dtext snip))
+                                        i
+                                        0
+                                        (or inserted-line? newline?)))))]
+
+                           [(cnt . > . MAX-COUNT-FOR-SNIP)
+                            ;; divide up snip, because it's too large:
+                            (make-snipset (+ i start) (+ i start))
+                            (let ([snip (find-snip (+ i start) 'after)])
+                              (loop (+ i start)
+                                    (string-snip-buffer snip)
+                                    (add1 (string-snip-dtext snip))
+                                    (add1 i)
+                                    1
+                                    inserted-line?))]
+                           
+                           [else
+                            (loop start str (+ sp 1) (+ i 1) (+ cnt 1) inserted-line?)])))))))))))
+
+  (define/override (insert . args)
+    (case-args
+     args
+     [([string? str])
+      (do-insert #f str #f startpos endpos #t)]
+     [([string? str] 
+       [exact-nonnegative-integer? start] 
+       [(make-alts exact-nonnegative-integer? (symbol-in same)) [end 'same]]
+       [any? [scroll-ok? #t]])
+      (do-insert #f str #f start end scroll-ok?)]
+     [([exact-nonnegative-integer? len] 
+       [string? str])
+      (do-insert #f str #f startpos endpos #t)]
+     [([exact-nonnegative-integer? len] 
+       [string? str] 
+       [exact-nonnegative-integer? start] 
+       [(make-alts exact-nonnegative-integer? (symbol-in same)) [end 'same]]
+       [any? [scroll-ok? #t]])
+      (do-insert #f (substring str 0 len) #f start end scroll-ok?)]
+     [([snip% snip]
+       [exact-nonnegative-integer? [start startpos]]
+       [(make-alts exact-nonnegative-integer? (symbol-in same)) [end 'same]]
+       [any? [scroll-ok? #t]])
+      (do-insert snip #f #f start end scroll-ok?)]
+     [([char? ch])
+      (do-insert-char ch startpos endpos)]
+     [([char? ch] 
+       [exact-nonnegative-integer? start] 
+       [(make-alts exact-nonnegative-integer? (symbol-in same)) [end 'same]])
+      (do-insert-char ch start end)]
+     (method-name 'text% 'insert)))
+
+  (define/public (do-insert-snips snips pos)
+    (do-insert #f #f snips pos pos #t))
+
+  (define/private (do-insert-char ch start end)
+    (let ([streak? typing-streak?]
+          [ifs? insert-force-streak?])
+      (end-streaks '(delayed))
+      (set! insert-force-streak? streak?)
+      (do-insert #f (string ch) #f start end #t)
+      (set! insert-force-streak? ifs?)
+      (set! typing-streak? #t)))
+
+  (define/private (do-delete start end with-undo? [scroll-ok? #t])
+    (unless (or write-locked? s-user-locked?)
+      (let-values ([(start end set-caret-style?)
+                    (if (eq? end 'back)
+                        (if (zero? start)
+                            (values 0 0 #f)
+                            (values (sub1 start) start #t))
+                        (values start end (and (= start startpos)
+                                               (= end endpos))))])
+        (unless (or (start . >= . end)
+                    (start . < . 0)
+                    (start . >= . len))
+          (let ([end (min end len)])
+            (when ALLOW-X-STYLE-SELECTION?
+              (when (and (start . <= . startpos) (end . >= . endpos))
+                (when (or (zero? delay-refresh) need-x-copy?)
+                  (set! need-x-copy? #f)
+                  (copy-out-x-selection))))
+
+            (set! write-locked? #t)
+
+            (if (not (can-delete? start (- end start)))
+                (begin
+                  (set! write-locked? #f)
+                  (set! flow-locked? #f))
+                (begin
+                  (on-delete start (- end start))
+
+                  (set! flow-locked? #t)
+
+                  (make-snipset start end)
+                  (set! revision-count (add1 revision-count))
+
+                  (let* ([start-snip (find-snip start 'before-or-none)]
+                         [end-snip (find-snip end 'before)]
+                         [with-undo? (and with-undo?
+                                          (zero? s-noundomode))]
+                         [rec (if with-undo?
+                                  (begin
+                                    (when (not s-modified?)
+                                      (add-undo-rec (make-object unmodify-record% delayed-streak?)))
+                                    (make-object delete-record%
+                                                 start  end
+                                                 (or deletion-streak? delayed-streak?
+                                                     delete-force-streak? (not s-modified?))
+                                                 startpos endpos))
+                                  #f)])
+
+                    (when (and set-caret-style? sticky-styles?)
+                      (set! caret-style (if start-snip
+                                            (snip->style (snip->next start-snip))
+                                            (snip->style snips))))
+
+                    (let-values ([(deleted-line? update-cursor?)
+                                  (let loop ([snip end-snip]
+                                             [deleted-line? #f]
+                                             [update-cursor? #f])
+                                    (if (eq? snip start-snip)
+                                        (values deleted-line? update-cursor?)
+                                        (let ([update-cursor?
+                                               (or (and (eq? snip s-caret-snip)
+                                                        (begin
+                                                          (send s-caret-snip own-caret #f)
+                                                          (set! s-caret-snip #f)
+                                                          #t))
+                                                   update-cursor?)])
+                                          
+                                          (when with-undo?
+                                            (send rec insert-snip snip))
+                                          
+                                          (let* ([prev (snip->prev snip)]
+                                                 [deleted-another-line?
+                                                  (let ([line (snip->line snip)])
+                                                    (cond
+                                                     [(eq? (mline-snip line) snip)
+                                                      (if (eq? (mline-last-snip line) snip)
+                                                          (begin
+                                                            (mline-delete line line-root-box)
+                                                            (set! num-valid-lines (sub1 num-valid-lines))
+                                                            #t)
+                                                          (begin
+                                                            (set-mline-snip! line (snip->next snip))
+                                                            #f))]
+                                                     [(eq? (mline-last-snip line) snip)
+                                                      (if (mline-next line)
+                                                          (begin
+                                                            (set-mline-last-snip! line (mline-last-snip (mline-next line)))
+                                                            (mline-delete (mline-next line) line-root-box)
+                                                            (set! num-valid-lines (sub1 num-valid-lines))
+                                                            #t)
+                                                          (begin
+                                                            (set-mline-last-snip! line prev)
+                                                            ;; maybe deleted extra ghost line:
+                                                            extra-line?))]
+                                                     [else #f]))])
+                                            (delete-snip snip)
+                                            (loop prev 
+                                                  (or deleted-line?
+                                                      deleted-another-line?)
+                                                  update-cursor?)))))])
+
+                      (when (zero? snip-count)
+                        (make-only-snip)
+                        (when caret-style
+                          (set-snip-style! snips caret-style)
+                          (set! caret-style #f)))
+
+                      (set! first-line (mline-first (unbox line-root-box)))
+                      (set! last-line (mline-last (unbox line-root-box)))
+                      
+                      (let-values ([(line moved-to-next?)
+                                    (if start-snip
+                                        (if (has-flag? (snip->flags start-snip) NEWLINE)
+                                            (if (mline-next (snip->line start-snip))
+                                                (values (mline-next (snip->line start-snip))
+                                                        #t)
+                                                (begin
+                                                  (mline-mark-check-flow (snip->line start-snip))
+                                                  (values #f #f)))
+                                            (values (snip->line start-snip) #f))
+                                        (values first-line #f))])
+                        
+                        (when line
+                          ;; fix line references from possibly moved snips:
+                          (let ([next (snip->next (mline-last-snip line))])
+                            (let loop ([snip (mline-snip line)])
+                              (unless (eq? snip next)
+                                (set-snip-line! snip line)
+                                (loop (snip->next snip)))))
+
+                          (mline-calc-line-length line)
+                          (mline-mark-recalculate line)
+
+                          (when (max-width . >= . 0)
+                            (mline-mark-check-flow line)
+                            (let ([prev (mline-prev line)])
+                              (when (and prev
+                                         (has-flag? (snip->flags (mline-last-snip prev)) HARD-NEWLINE))
+                                (mline-mark-check-flow prev)
+                                (when (and moved-to-next?
+                                           deleted-line?
+                                           (mline-prev prev)
+                                           (not (has-flag? (snip->flags (mline-last-snip (mline-prev prev))) 
+                                                           HARD-NEWLINE)))
+                                  ;; maybe the deleted object was in the middle of a long word,
+                                  ;; and maybe now the long word can be folded into the previous
+                                  ;; line
+                                  (mline-mark-check-flow (mline-prev prev)))))))
+
+                        (adjust-clickbacks start end (- start end) rec)
+
+                        (when with-undo?
+                          (add-undo-rec rec)
+                          (when (positive? delay-refresh)
+                            (set! delayed-streak? #t)))
+
+                        (let ([dellen (- end start)])
+                          (set! len (- len dellen))
+
+                          (check-merge-snips start)
+
+                          (set! flow-locked? #f)
+                          (set! write-locked? #f)
+
+                          (cond
+                           [(and (startpos . >= . start) (startpos . <= . end))
+                            (set! caret-blinked? #f)
+                            (set! startpos start)]
+                           [(startpos . > . end)
+                            (set! caret-blinked? #f)
+                            (set! startpos (- startpos dellen))])
+
+                          (cond
+                           [(and (endpos . >= . start) (endpos . <= . end))
+                            (set! endpos start)]
+                           [(endpos . > . end)
+                            (set! endpos (- endpos dellen))])
+
+                          (unless refresh-unset?
+                            (cond
+                             [(and (refresh-start . >= . start) (refresh-start . <= . end))
+                              (set! refresh-start start)]
+                             [(refresh-start . >= . end)
+                              (set! refresh-start (- refresh-start dellen))])
+                            (cond
+                             [(and (refresh-end . >= . start) (refresh-end . <= . end))
+                              (set! refresh-end start)]
+                             [(refresh-end . >= . end)
+                              (set! refresh-end (- refresh-end dellen))]))
+
+                          (set! extra-line? (has-flag? (snip->flags last-snip) NEWLINE))
+
+                          (when (and scroll-ok? (= start startpos))
+                            (set! delay-refresh (add1 delay-refresh))
+                            (scroll-to-position/refresh startpos)
+                            (set! delay-refresh (sub1 delay-refresh)))
+
+                          (set! changed? #t)
+
+                          (unless set-caret-style?
+                            (set! caret-style #f))
+
+                          (when (= len start)
+                            ;; force recheck extra line state:
+                            (set! graphic-maybe-invalid? #t)
+                            (set! graphic-maybe-invalid-force? #t))
+
+                          (if deleted-line?
+                              (begin
+                                (set! graphic-maybe-invalid? #t)
+                                (need-refresh start))
+                              (refresh-by-line-demand))
+
+                          (unless s-modified?
+                            (set-modified #t))
+
+                          (after-delete start dellen)
+
+                          (when update-cursor?
+                            (when s-admin
+                              (send s-admin update-cursor))))))))))))))
+
+  (define/public (delete . args)
+    (case-args
+     args
+     [()
+      (let ([streak? (= endpos startpos)]
+            [dstreak? deletion-streak?]
+            [dfs? delete-force-streak?])
+        (end-streaks '(delayed))
+        (set! delete-force-streak? dstreak?)
+        
+        (delete startpos (if (= startpos endpos) 'back endpos))
+
+        (set! delete-force-streak? dfs?)
+        (set! deletion-streak? streak?))]
+     [([(make-alts exact-nonnegative-integer? (symbol-in start)) start]
+       [(make-alts exact-nonnegative-integer? (symbol-in back)) [end 'back]]
+       [any? [scroll-ok? #t]])
+      (do-delete (if (symbol? start) startpos start) end scroll-ok?)]
+     (method-name 'text% 'delete)))
+
+  (def/public (erase)
+    (do-delete 0 len #t))
+  
+  (def/override (clear)
+    (delete startpos endpos #t))
+  
+  ;; ----------------------------------------
+
+  (def/override (cut [any? [extend? #f]] [exact-integer? [time 0]]
+                     [(make-alts exact-nonnegative-integer? (symbol-in start)) [start 'start]]
+                     [(make-alts exact-nonnegative-integer? (symbol-in end)) [end 'end]])
+    (let* ([start (if (symbol? start)
+                      startpos
+                      start)]
+           [end (if (symbol? end)
+                    endpos
+                    end)]
+           [end (min end len)])
+      (unless (start . >= . end)
+        (copy extend? time start end)
+        (delete start end))))
+
+  (def/override (do-copy [exact-nonnegative-integer? startp] 
+                         [exact-nonnegative-integer? endp] 
+                         [exact-integer? time] 
+                         [bool? extend?])
+    (let ([startp (max startp 0)]
+          [endp (min endp len)])
+      (unless (endp . <= . startp)
+
+        (make-snipset startp endp)
+  
+        (let ([sl (or (and extend? copy-style-list)
+                      s-style-list)])
+          (set-common-copy-region-data! (get-region-data startp endp))
+
+          (let ([start (find-snip startp 'after)]
+                [end (find-snip endp 'after-or-none)]
+                [wl? write-locked?]
+                [fl? flow-locked?])
+
+            (set! write-locked? #t)
+            (set! flow-locked? #t)
+
+            (let loop ([snip start])
+              (unless (eq? snip end)
+                (let ([asnip (send snip copy)])
+                  (snip-set-admin asnip #f)
+                  (set-snip-style! asnip (send sl convert (snip->style asnip)))
+                  (cons-common-copy-buffer! asnip)
+                  (cons-common-copy-buffer2! (get-snip-data snip)))
+                (loop (snip->next snip))))
+
+            (set! write-locked? wl?)
+            (set! flow-locked? fl?)
+
+            (install-copy-buffer time sl))))))
+
+  (def/override (copy [any? [extend? #f]] [exact-integer? [time 0]]
+                      [(make-alts exact-nonnegative-integer? (symbol-in start)) [start 'start]]
+                      [(make-alts exact-nonnegative-integer? (symbol-in end)) [end 'end]])
+    (let* ([start (if (symbol? start)
+                      startpos
+                      start)]
+           [end (if (symbol? end)
+                    endpos
+                    end)]
+           [end (min end len)])
+      (unless (start . >= . end)
+        (begin-copy-buffer)
+        (unless extend?
+          (free-old-copies))
+        (do-copy start end time extend?)
+        (end-copy-buffer))))
+
+  (define/private (do-generic-paste cb start time)
+    (set! read-insert start)
+    (set! read-insert-start start)
+    (let ([orig-len len])
+      (do-buffer-paste cb time #f)
+      (let ([delta (- len orig-len)])
+        (set! prev-paste-start start)
+        (set! prev-paste-end (+ start delta)))))
+
+  (define/override (do-paste start time)
+    (do-generic-paste the-clipboard start time))
+
+  (define/override (do-paste-x-selection start time)
+    (do-generic-paste the-x-selection-clipboard start time))
+
+  (define/private (generic-paste x-sel? time start end)
+    (let* ([end (if (symbol? end)
+                    (if (symbol? start)
+                        endpos
+                        start)
+                    end)]
+           [start (if (eq? start 'start)
+                      startpos
+                      (if (symbol? start)
+                          endpos
+                          start))]
+           [end (min end len)])
+      (unless (start . > . end)
+
+        (begin-edit-sequence)
+        (when (start . < . end)
+          (delete start end))
+
+        (if x-sel?
+            (do-paste-x-selection start time)
+            (do-paste start time))
+
+        (let ([save-prev-paste prev-paste-start])
+          (end-edit-sequence)
+          (set! prev-paste-start save-prev-paste)))))
+
+  (def/override (paste [exact-integer? [time 0]]
+                       [(make-alts exact-nonnegative-integer? (symbol-in start end)) [start 'start]]
+                       [(make-alts exact-nonnegative-integer? (symbol-in same)) [end 'same]])
+    (generic-paste #f time start end))
+
+  (def/override (paste-x-selection [exact-integer? [time 0]]
+                                   [(make-alts exact-nonnegative-integer? (symbol-in start end)) [start 'start]]
+                                   [(make-alts exact-nonnegative-integer? (symbol-in same)) [end 'same]])
+    (generic-paste #t time start end))
+  
+  (define/override (insert-paste-snip snip data)
+    (let ([addpos (snip->count snip)])
+      (insert snip read-insert)
+      (when data
+        (let ([snip (find-snip read-insert 'after)])
+          (set-snip-data snip data)))
+      (set! read-insert (+ read-insert addpos))))
+
+  (define/public (paste-region-data data)
+    (set-region-data read-insert-start read-insert data))
+
+  (define/override (insert-paste-string str)
+    (let* ([str (if (eq? 'windows (system-type))
+                    (regexp-replace* #rx"\r\n" str "\n")
+                    str)]
+           ;; change non-breaking space to space:
+           [str (regexp-replace* #rx"\xA0" str " ")])
+
+      (insert str read-insert)
+      (set! read-insert (+ read-insert (string-length str)))))
+
+  (def/public (paste-next)
+    (unless (prev-paste-start . < . 0)
+      (let ([start prev-paste-start]
+            [end prev-paste-end])
+
+        (copy-ring-next)
+        (begin-edit-sequence)
+        (delete start end)
+        (set! read-insert start)
+        (set! read-insert-start start)
+
+        (let ([orig-len len])
+          (do-buffer-paste the-clipboard 0 #t)
+
+          (end-edit-sequence)
+          
+          (let ([delta (- len orig-len)])
+            
+            (set! prev-paste-start start)
+            (set! prev-paste-end (+ start delta)))))))
+
+  (define/private (do-kill time start end)
+    (let ([streak? kill-streak?])
+
+      (begin-edit-sequence)
+      (let-values ([(start end)
+                    (if (symbol? start)
+                        (let ([newend (paragraph-end-position (position-paragraph endpos posateol?))])
+                          (if (= newend startpos)
+                              (set-position startpos (+ startpos 1) #f #t 'local)
+                              (begin
+                                (set-position startpos newend #f #t 'local)
+                                
+                                (let ([text (get-text startpos endpos)])
+                                  (let loop ([i (- endpos startpos)])
+                                    (if (zero? i)
+                                        ;; line has all spaces: move one more
+                                        (set-position startpos (+ endpos 1) #f #t 'local)
+                                        (let ([i (sub1 i)])
+                                          (when (char-whitespace? (string-ref text i))
+                                            (loop i))))))))
+                          (values startpos endpos))
+                        (values start end))])
+
+        (cut streak? time start end)
+        (end-edit-sequence)
+
+        (set! kill-streak? #t))))
+
+  (define/override (kill . args)
+    (case-args
+     args
+     [([exact-integer? [time 0]])
+      (do-kill 0 'start 'end)]
+     [([exact-integer? time]
+       [exact-nonnegative-integer? start]
+       [exact-nonnegative-integer? end])
+      (do-kill time start end)]
+     (method-name 'text% 'kill)))
+
+  (def/override (select-all)
+    (set-position 0 len))
+
+  (define/override (really-can-edit? op)
+    (cond
+     [read-locked? #f]
+     [(and (not (eq? 'copy op))
+           (or flow-locked? write-locked?))
+      #f]
+     [else
+      (case op
+        [(clear cut copy)
+         (not (= endpos startpos))]
+        [(kill)
+         (not (= len endpos))]
+        [(select-all)
+         (positive? len)]
+        [else #t])]))
+
+  ;; ----------------------------------------
+
+  (def/public (split-snip [exact-nonnegative-integer? pos])
+    (unless (or flow-locked?
+                (pos . <= . 0)
+                (pos . >= . len))
+      (let ([wl? write-locked?])
+
+        (set! write-locked? #t)
+        (set! flow-locked? #t)
+        (make-snipset pos pos)
+        (set! write-locked? wl?)
+        (set! flow-locked? #f))))
+
+  (def/public (get-revision-number)
+    revision-count)
+
+  (def/override (get-flattened-text)
+    (get-text 0 'eof #t #f))
+
+  (def/public (get-text [exact-nonnegative-integer? [start 0]]
+                        [(make-alts exact-nonnegative-integer? (symbol-in eof)) [end 'eof]]
+                        [any? [flat? #f]]
+                        [any? [force-cr? #f]])
+    (if read-locked? 
+        ""
+        (let* ([end (if (eq? end 'eof)
+                        len
+                        end)]
+               [start (min start len)]
+               [end (max end start)]
+               [end (min end len)]
+               [count (- end start)])
+          (if (zero? count)
+              ""
+              (let ([wl? write-locked?]
+                    [fl? flow-locked?]
+                    [p (open-output-string)])
+                (set! write-locked? #t)
+                (set! flow-locked? #t)
+
+                (let-values ([(snip s-pos) (find-snip/pos start 'after)])
+                  (let loop ([snip snip]
+                             [offset (- start s-pos)]
+                             [count count])
+                    (let ([num (min (- (snip->count snip) offset)
+                                    count)])
+                      (if (not flat?)
+                          (display (send-generic snip snip%-get-text offset num #f) p)
+                          (begin
+                            (display (send-generic snip snip%-get-text offset num #t) p)
+                            (when (and force-cr?
+                                       (has-flag? (snip->flags snip) NEWLINE)
+                                       (not (has-flag? (snip->flags snip) HARD-NEWLINE)))
+                              (display "\n" p))))
+                      (let ([count (- count num)])
+                        (if (zero? count)
+                            (begin
+                              (set! write-locked? wl?)
+                              (set! flow-locked? fl?)
+                              (get-output-string p))
+                            (loop (snip->next snip)
+                                  0
+                                  count)))))))))))
+  
+  (def/public (get-character [exact-nonnegative-integer? start])
+    (if read-locked?
+        #\nul
+        (let-values ([(snip s-pos) (find-snip/pos (max 0 (min start len)) 'after)])
+          (let ([buffer (make-string 1)])
+            (send snip get-text! buffer (- start s-pos) 1 0)
+            (string-ref buffer 0)))))
+
+  ;; ----------------------------------------
+
+  (def/public (set-clickback [exact-nonnegative-integer? start]
+                             [exact-nonnegative-integer? end]
+                             [procedure? f]
+                             [(make-or-false style-delta%) [c-delta #f]]
+                             [any? [call-on-down? #f]])
+    (let ([delta (make-object style-delta%)])
+      (when c-delta
+        (send delta copy c-delta))
+      
+      (let ([cb (make-clickback start
+                                end
+                                f
+                                call-on-down?
+                                delta
+                                #f
+                                null)])
+        (set! clickbacks (cons cb clickbacks)))))
+
+  (define/public (add-back-clickback cb)
+    (set! clickbacks (cons cb clickbacks)))
+
+  (def/public (remove-clickback [exact-nonnegative-integer? start]
+                                [exact-nonnegative-integer? end])
+    (set! clickbacks
+          (filter (lambda (cb)
+                    (not (and (= start (clickback-start cb))
+                              (= end (clickback-start cb)))))
+                  clickbacks)))
+
+  (def/public (call-clickback [exact-nonnegative-integer? start]
+                              [exact-nonnegative-integer? end])
+    (for-each (lambda (cb)
+                (when (and ((clickback-start cb) . <= . start)
+                           ((clickback-end cb) . >= . end))
+                  ((clickback-f cb)  this (clickback-start cb)  (clickback-end cb))))
+              clickbacks))
+
+  
+  (define/private (adjust-clickbacks start end d rec)
+    (when (pair? clickbacks)
+      (set! clickbacks
+            (filter (lambda (c)
+                      (if (and ((clickback-start c) . >= . start) 
+                               ((clickback-end c) . <= . end))
+                          (begin
+                            (when rec
+                              (send rec add-clickback c))
+                            #f)
+                          #t))
+                    clickbacks))
+      (for-each (lambda (c)
+                  (cond
+                   [((clickback-start c) . >= . end)
+                    (set-clickback-start! c (+ (clickback-start c) d))
+                    (set-clickback-end! c (+ (clickback-end c) d))]
+                   [(and ((clickback-start c) . <= . start)
+                         ((clickback-end c) . >= . end))
+                    (when (or (d . < . 0) ((clickback-end c) . > . end))
+                      (set-clickback-end! c (+ (clickback-end c) d)))]
+                   [(and ((clickback-start c) . > . start) 
+                         ((clickback-end c) . > . end))
+                    (set-clickback-start! c start)
+                    (set-clickback-end! c (+ (clickback-end c) d))]))
+                clickbacks)
+      (set! clickbacks
+            (filter (lambda (c)
+                      (if (= (clickback-start c) (clickback-end c))
+                          (when rec
+                            (send rec add-clickback c)
+                            #f)
+                          #t))
+                    clickbacks))))
+
+  (define/private (find-clickback start y)
+    (ormap (lambda (c)
+             (and ((clickback-start c) . <= . start)
+                  ((clickback-end c) . > . start)
+                  ;; we're in the right horizontal region, but maybe the mouse
+                  ;; is above or below the clickback
+                  (let ([start (find-snip (clickback-start c) 'after)]
+                        [end (find-snip (clickback-end c) 'before)])
+                    (and start
+                         end
+                         (let-boxes ([top 0.0]
+                                     [bottom 0.0])
+                             (begin
+                               (get-snip-location start #f top #f)
+                               (get-snip-location start #f bottom #t))
+                           (let loop ([start start]
+                                      [top top]
+                                      [bottom bottom])
+                             (if (eq? end start)
+                                 (and (y . >= . top)
+                                      (y . <= . bottom)
+                                      c)
+                                 (let ([start (snip->next start)])
+                                   (let-boxes ([ntop 0.0]
+                                               [nbottom 0.0])
+                                       (begin
+                                         (get-snip-location start #f ntop #f)
+                                         (get-snip-location start #f nbottom #t))
+                                     (loop start
+                                           (min ntop top)
+                                           (max nbottom bottom)))))))))))
+           clickbacks))
+
+  (define/private (set-clickback-hilited c on?)
+    (when (not (eq? (and on? #t)
+                    (clickback-hilited? c)))
+      (cond
+       [on? 
+        (s-start-intercept)
+        
+        (begin-edit-sequence)
+        (flash-on (clickback-start c) (clickback-end c) #f #f 0)
+        (do-change-style (clickback-start c) (clickback-end c) #f (clickback-delta c) #f)
+        (end-edit-sequence)
+
+        (set-clickback-unhilite! c (s-end-intercept))]
+       [else
+        (perform-undo-list (clickback-unhilite c))
+        (set-clickback-unhilite! c null)
+        (flash-off)])
+      (set-clickback-hilited?! (and on? #t))))
+
+  ;; ----------------------------------------
+
+  (def/public (flash-on [exact-nonnegative-integer? start]
+                        [exact-nonnegative-integer? end]
+                        [any? [ateol? #f]]
+                        [any? [scroll? #t]]
+                        [exact-nonnegative-integer? [timeout 500]])
+    (do-set-position #t 'none start end ateol? scroll? 'default)
+    (when (timeout . > . 0)
+      (set! flashautoreset? #t)
+      (when flash-timer
+        (send flash-timer stop))
+      (set! flash-timer (new flash-timer% [editor this]))
+      (send flash-timer start timeout))
+    (set! flashscroll? scroll?))
+
+  (def/public (flash-off)
+    (when flash?
+      (set! flashautoreset? #t)
+      (set! flashdirectoff? #t)
+      (do-set-position #f 'none startpos endpos posateol? flashscroll? 'default)))
+
+  ;; ----------------------------------------
+
+  (def/public (set-wordbreak-func [procedure? f])
+    (set! word-break f))
+
+  (def/public (find-wordbreak [(make-or-false (make-box exact-nonnegative-integer?)) start] 
+                              [(make-or-false (make-box exact-nonnegative-integer?)) end] 
+                              [(symbol-in caret line selection user1 user2) reason])
+    (unless read-locked?
+      (let ([oldstart (if start (unbox start) 0)]
+            [oldend (if end (unbox end) 0)])
+        (word-break this start end reason)
+
+        (when (and start ((unbox start) . > . oldstart))
+          (set-box! start oldstart))
+        (when (and end ((unbox end) . < . oldend))
+          (set-box! end oldend)))))
+
+  (def/public (get-wordbreak-map)
+    word-break-map)
+
+  (def/public (set-wordbreak-map [(make-or-false editor-wordbreak-map%) map])
+    (set! word-break-map map))
+
+  ;; ----------------------------------------
+
+  (def/public (set-line-spacing [nonnegative-real? s])
+    (unless (or flow-locked?
+                (= line-spacing s))
+      (set! line-spacing s)
+      (size-cache-invalid)
+      (set! changed? #t)
+      (need-refresh -1 -1)))
+
+  (def/public (get-line-spacing) line-spacing)
+
+  (def/override (get-max-width)
+    (if (max-width . <= . 0)
+        'none
+        (+ max-width wrap-bitmap-width)))
+
+  (def/override (get-min-width)
+    (if (min-width . <= . 0)
+        'none
+        min-width))
+
+  (def/override (set-max-width [(make-alts nonnegative-real? (symbol-in none)) w])
+    (unless flow-locked?
+      (let* ([w (if (eq? w 'none) 0.0 w)]
+             [w (if (and (positive? wrap-bitmap-width) (w . > . 0))
+                    (let ([w (- w wrap-bitmap-width)])
+                      (if (w . <= . 0.0)
+                          (+ CURSOR-WIDTH 1)
+                          w))
+                    w)])
+        (unless (or (= max-width w) 
+                    (and (w . <= . 0) (max-width . <= . 0))
+                    (not (can-set-size-constraint?)))
+          (on-set-size-constraint)
+          
+          (let ([w (if (and (w . > . 0)
+                            (w . < . (+ CURSOR-WIDTH 1)))
+                       (+ CURSOR-WIDTH 1)
+                       w)])
+            (set! max-width w)
+            (set! flow-invalid? #t)
+            (set! graphic-maybe-invalid? #t)
+            (set! changed? #t)
+            (need-refresh -1 -1)
+
+            (after-set-size-constraint))))))
+
+  (define/private (set-m-x v current setter)
+    (let ([v (if (eq? v 'none) 0.0 v)])
+      (unless (or flow-locked?
+                  (= current v)
+                  (and (v . <= . 0) (current . <= . 0))
+                  (not (can-set-size-constraint?)))
+      (on-set-size-constraint)
+
+      (set! graphic-maybe-invalid? #t)
+      (set! graphic-maybe-invalid-force? #t)
+      (setter v)
+      (set! changed? #t)
+      (need-refresh -1 -1)
+
+      (after-set-size-constraint))))
+
+  (def/override (set-min-width [(make-alts nonnegative-real? (symbol-in none)) w])
+    (set-m-x w min-width (lambda (w) (set! min-width w))))
+
+  (def/override (set-min-height [(make-alts nonnegative-real? (symbol-in none)) h])
+    (set-m-x h min-height (lambda (h) (set! min-height h))))
+
+  (def/override (set-max-height [(make-alts nonnegative-real? (symbol-in none)) h])
+    (set-m-x h max-height (lambda (h) (set! max-height h))))
+
+  (def/override (get-min-height)
+    (if (min-height . <= . 0)
+        'none
+        min-height))
+
+  (def/override (get-max-height)
+    (if (max-height . <= . 0)
+        'none
+        max-height))
+
+  ;; ----------------------------------------
+
+  (def/override (insert-port [input-port? f] 
+                             [(symbol-in guess same copy standard text text-force-cr) [format 'guess]]
+                             [any? [replace-styles? #f]])
+    (if (or write-locked? s-user-locked?)
+        'guess ;; FIXME: docs say that this is more specific
+        (do-insert-file (method-name 'text% 'insert-file) f format replace-styles?)))
+
+  (define/private (do-insert-file who f format clear-styles?)
+    (let ([format
+           (cond
+            [(or (eq? 'guess format) (eq? 'same format) (eq? 'copy format))
+             (if (not (detect-wxme-file who f #t))
+                 'text
+                 'standard)]
+            [else format])])
+
+      (let ([fileerr?
+             (cond
+              [(eq? 'standard format)
+               (if (not (detect-wxme-file who f #f))
+                   (error who "not a WXME file")
+                   (let* ([b (make-object editor-stream-in-file-base% f)]
+                          [mf (make-object editor-stream-in% b)])
+                     (not (and (read-editor-version mf b #f #t)
+                               (read-editor-global-header mf)
+                               (send mf ok?)
+                               (read-from-file mf clear-styles?)
+                               (read-editor-global-footer mf)
+                               (begin
+                                 ;; if STD-STYLE wasn't loaded, re-create it:
+                                 (send s-style-list new-named-style "Standard" (send s-style-list basic-style))
+                                 (send mf ok?))))))]
+              [(or (eq? format 'text) (eq? format 'text-force-cr))
+               (let loop ()
+                 (let ([l (read-string 256 f)])
+                   (unless (eof-object? l)
+                     (insert l)
+                     (loop))))
+               #f])])
+
+        (when fileerr?
+          (error who "error loading the file"))
+
+        format)))
+
+  (def/override (save-port [output-port? f]
+                           [(symbol-in guess same copy standard text text-force-cr) [format 'same]]
+                           [any? [show-errors? #t]])
+    (when read-locked?
+      (error (method-name 'text% 'save-file) "editor locked for reading"))
+
+    (let ([format 
+           (cond
+            [(or (eq? 'same format) (eq? 'guess format) (eq? 'copy format))
+             file-format]
+            [else format])])
+
+      (let ([fileerr?
+             (cond
+              [(or (eq? 'text format) (eq? 'text-force-cr format))
+               (display (get-text 0 'eof #t (eq? format 'text-force-cr)) f)
+               #f]
+              [else
+               (let* ([b (make-object editor-stream-out-file-base% f)]
+                      [mf (make-object editor-stream-out% b)])
+                 (not (and (write-editor-version mf b)
+                           (write-editor-global-header mf)
+                           (send mf ok?)
+                           (write-to-file mf)
+                           (write-editor-global-footer mf)
+                           (send mf ok?))))])])
+        (when fileerr?
+          (error (method-name 'text% 'save-port) "error writing editor content"))
+        #t)))
+
+  
+  (define/private (do-read-from-file f start overwritestyle?)
+    (if write-locked?
+        #f
+        (let ([start (if (symbol? start)
+                         startpos
+                         start)])
+          (set! read-insert start)
+          (let ([result (read-snips-from-file f overwritestyle?)])
+
+            (when (zero? len)
+              ;; we probably destructively changed the style list; reset the dummy snip
+              (set-snip-style! snips (or (get-default-style)
+                                         (send s-style-list basic-style))))
+
+            result))))
+
+  (define/override (read-from-file . args)
+    (case-args
+     args
+     [([editor-stream-in% f] [exact-nonnegative-integer? start] [any? [overwritestyle? #t]])
+      (do-read-from-file f start overwritestyle?)]
+     [([editor-stream-in% f] [any? [overwritestyle? #t]])
+      (do-read-from-file f 'start overwritestyle?)]
+     (method-name 'text% 'read-from-file)))
+
+  (define/override (do-read-insert snip)
+    (if (list? snip)
+        (let ([oldlen len])
+          (do-insert #f #f snip startpos startpos #t)
+          (set! read-insert (+ read-insert (- len oldlen)))
+          #t)
+        (let ([addpos (snip->count snip)])
+          (do-insert snip #f #f startpos startpos #t)
+          (set! read-insert (+ addpos read-insert))
+          #t)))
+
+  (def/override (write-to-file [editor-stream-out% f]
+                               [exact-nonnegative-integer? [start 0]]
+                               [(make-alts exact-nonnegative-integer? (symbol-in eof)) [end 'eof]])
+    (if read-locked?
+        #f
+        (let ([end (max (if (eq? end 'eof)
+                            len
+                            end)
+                        start)])
+          (let ([start-snip (if (zero? len) #f (find-snip start 'after))]
+                [end-snip (if (zero? len) #f (find-snip end 'after-or-none))])
+            (and (do-write-headers-footers f #t)
+                 (write-snips-to-file f s-style-list #f start-snip end-snip #f this)
+                 (do-write-headers-footers f #f))))))
+
+  (def/public (get-file-format) file-format)
+  (def/public (set-file-format [(symbol-in standard text text-force-cr) format])
+    (set! file-format format))
+
+  (def/override (set-filename [(make-or-false path-string?) name][any? [temp? #f]])
+    (set! s-filename (if (string? name)
+                         (string->path name)
+                         name))
+    (set! s-temp-filename? temp?)
+    (let ([wl? write-locked?]
+          [fl? flow-locked?])
+      (set! write-locked? #t)
+      (set! flow-locked? #t)
+
+      (let loop ([snip snips])
+        (when snip
+          (when (has-flag? (snip->flags snip) USES-BUFFER-PATH)
+            (send snip set-admin snip-admin))
+          (loop (snip->next snip))))
+      
+      (set! write-locked? wl?)
+      (set! flow-locked? fl?)))
+
+  ;; ----------------------------------------
+
+  (def/public (get-region-data [exact-nonnegative-integer? start]
+                               [exact-nonnegative-integer? end])
+    #f)
+
+  (def/public (set-region-data [exact-nonnegative-integer? start]
+                               [exact-nonnegative-integer? end]
+                               [editor-data% d])
+    (void))
+
+  ;; ----------------------------------------
+
+  (def/public (get-tabs [maybe-box? [count #f]] 
+                        [maybe-box? [space #f]] 
+                        [maybe-box? [in-units #f]])
+    (when count
+      (set-box! count (vector-length tabs)))
+    (when space
+      (set-box! space (if (symbol? tab-space)
+                          #f
+                          tab-space)))
+    (when in-units
+      (set-box! in-units tab-space-in-units?))
+
+    (vector->list tabs))
+
+  (def/public (set-tabs [(make-list real?) newtabs]
+                        [(make-alts real? (symbol-in tab-width)) [tab-width 20]]
+                        [any? [in-units? #t]])
+    (unless flow-locked?
+      (set! tabs (list->vector newtabs))
+
+      (if (and (number? tab-width) (tab-width . >= . 1))
+          (set! tab-space (exact->inexact tab-width))
+          (set! tab-space TAB-WIDTH))
+
+      (set! tab-space-in-units? in-units?)
+      
+      (size-cache-invalid)
+      (set! changed? #t)
+      (need-refresh -1 -1)))
+
+  ;; ----------------------------------------
+
+  (define/private (do-find-position-in-line internal? i x ateol?-box onit?-box how-close-box)
+    (when onit?-box
+      (set-box! onit?-box #f))
+    (when ateol?-box
+      (set-box! ateol?-box #f))
+    (when how-close-box
+      (set-box! how-close-box 100.0))
+
+    (cond
+     [(and (not internal?) (not (check-recalc #t #f)))
+      0]
+     [(i . < . 0) 0]
+     [(i . >= . num-valid-lines) len]
+     [else
+      (let* ([line (mline-find-line (unbox line-root-box) i)]
+             [x (- x (mline-get-left-location line max-width))])
+        (if (x . <= . 0)
+            (find-first-visible-position line)
+            (let ([p (mline-get-position line)])
+              (let-values ([(snip s-pos p)
+                            (if (x . >= . (mline-w line))
+                                ;; snip == the last one
+                                (let ([snip (mline-last-snip line)])
+                                  (values snip
+                                          (+ p (- (mline-len line) (snip->count snip)))
+                                          (+ p (mline-len line))))
+                                (begin
+                                  (when onit?-box
+                                    (set-box! onit?-box #t))
+
+                                  (let ([dc (send s-admin get-dc)]
+                                        [X 0]
+                                        [wl? write-locked?]
+                                        [fl? flow-locked?])
+                                    (set! write-locked? #t)
+                                    (set! flow-locked? #t)
+
+                                    ;; linear seach for snip
+                                    (let ([topy (mline-get-location line)])
+                                      (let loop ([snip (mline-snip line)]
+                                                 [X X]
+                                                 [x x]
+                                                 [p p])
+                                        (let-boxes ([w 0.0])
+                                            (when dc (send snip get-extent dc X topy w #f #f #f #f #f))
+                                          (if (and (x . > . w) (snip->next snip) dc)
+                                              (loop (snip->next snip)
+                                                    (+ X w)
+                                                    (- x w)
+                                                    (+ p (snip->count snip)))
+                                              ;; found the right snip
+                                              (let ([s-pos p]
+                                                    [p (+ p (do-find-position-in-snip dc X topy snip x how-close-box))])
+                                                (set! write-locked? wl?)
+                                                (set! flow-locked? fl?)
+                                                (values snip s-pos p)))))))))])
+
+                ;; back up over invisibles
+                (let ([atsnipend? (- (- p s-pos) (snip->count snip))])
+                  (let-boxes ([p p]
+                              [snip snip])
+                      (when atsnipend?
+                        (find-last-visible-position line p snip))
+                    (when (and ateol?-box 
+                               atsnipend?
+                               snip 
+                               (eq? snip (mline-last-snip line)))
+                      (set-box! ateol?-box #t))
+                    p))))))]))
+
+  (define/private (find-first-visible-position line [snip #f])
+    (if read-locked?
+        0
+        (let* ([snip (or snip (mline-snip line))]
+               [startp (mline-get-position line)]
+               [p startp]
+               [next-snip (snip->next (mline-last-snip line))])
+          (let loop ([snip snip]
+                     [p p])
+            (cond
+             [(eq? snip next-snip)
+              ;; if everything is invisible, then presumably the CR is forced,
+              ;; so go to the beginning of the line anyway
+              startp]
+             [(has-flag? (snip->flags snip) INVISIBLE)
+              (loop (snip->next snip) (+ p (snip->count snip)))]
+             [else p])))))
+
+  (define/private (find-last-visible-position line p-box [snip-box #f])
+    (unless read-locked?
+      (let ([snip (or (if snip-box
+                          (unbox snip-box)
+                          #f)
+                      (mline-last-snip line))]
+            [p (unbox p-box)])
+        (let loop ([p p]
+                   [snip snip])
+          (let ([p (if (has-flag? (snip->flags snip) INVISIBLE)
+                       (- p (snip->count snip))
+                       p)])
+            (if (eq? snip (mline-snip line))
+                (begin
+                  (set-box! p-box p)
+                  (when snip-box
+                    (set-box! snip-box snip)))
+                (loop p (snip->prev snip))))))))
+
+  (def/public (find-position-in-line [exact-nonnegative-integer? i]
+                                     [real? x]
+                                     [maybe-box? [ateol? #f]]
+                                     [maybe-box? [onit? #f]]
+                                     [maybe-box? [how-close #f]])
+    (do-find-position-in-line #f i x ateol? onit? how-close))
+
+  (define/private (do-find-position-in-snip dc X Y snip x how-close)
+    (cond
+     [read-locked? 0]
+     [(x . < . 0)
+      (when how-close
+        (set-box! how-close -100.0))
+      0]
+     [else
+      (let ([wl? write-locked?]
+            [fl? flow-locked?])
+        (set! write-locked? #t)
+        (set! flow-locked? #t)
+
+        (let ([c (snip->count snip)])
+          (if ((send snip partial-offset dc X Y c) . <= . x)
+              (begin
+                (when how-close
+                  (set-box! how-close 100.0))
+                (set! write-locked? wl?)
+                (set! flow-locked? fl?)
+                c)
+            
+              ;; binary search for position within snip:
+              (let loop ([range c]
+                         [i (quotient c 2)]
+                         [offset 0])
+                (let ([dl (send snip partial-offset dc X Y (+ offset i))])
+                  (if (dl . > . x)
+                      (loop i (quotient i 2) offset)
+                      (let ([dr (send snip partial-offset dc X Y (+ offset i 1))])
+                        (if (dr . <= . x)
+                            (let ([range (- range i)])
+                              (loop range (quotient range 2) (+ offset i)))
+                            (begin
+                              (when how-close
+                                (set-box! how-close
+                                          (if ((- dr x) . < . (- x dl))
+                                              (- dr x)
+                                              (- dl x))))
+                              (set! write-locked? wl?)
+                              (set! flow-locked? fl?)
+                              (+ i offset))))))))))]))
+
+  (def/public (find-line [real? y] [maybe-box? [onit? #f]])
+    (when onit?
+      (set-box! onit? #f))
+    
+    (cond
+     [(not (check-recalc #t #f)) 0]
+     [(y . <= . 0) 0]
+     [(or (y . >= . total-height) (and extra-line? (y . >= . (- total-height extra-line-h))))
+      (- num-valid-lines (if extra-line? 0 1))]
+     [else
+      (when onit?
+        (set-box! onit? #t))
+      (mline-get-line (mline-find-location (unbox line-root-box) y))]))
+
+  (def/public (find-position [real? x] [real? y]
+                             [maybe-box? [ateol? #f]]
+                             [maybe-box? [onit? #f]]
+                             [maybe-box? [how-close #f]])
+    (if read-locked?
+        0
+        (begin
+          (when ateol?
+            (set-box! ateol? #f))
+
+          (let* ([online (box #f)]
+                 [i (find-line y online)])
+            (if (and (i . >= . (- num-valid-lines 1))
+                     (not (unbox online))
+                     (y . > . 0))
+                (begin
+                  (when onit?
+                    (set-box! onit? #f))
+                  (when how-close
+                    (set-box! how-close 100.0))
+                  len)
+                (let ([p (find-position-in-line i x ateol? onit? how-close)])
+                  (when onit?
+                    (set-box! onit? (and (unbox online) (unbox onit?))))
+                  p))))))
+
+  (def/public (position-line [exact-nonnegative-integer? start]
+                             [any? [eol? #f]])
+    (cond
+     [(not (check-recalc (max-width . > . 0) #f #t)) 0]
+     [(start . <= . 0) 0]
+     [(start . >= . len)
+      (if (and extra-line? (not eol?))
+          num-valid-lines
+          (- num-valid-lines 1))]
+     [else
+      (let* ([line (mline-find-position (unbox line-root-box) start)]
+             [line (if (and eol? (= (mline-get-position line) start))
+                       (mline-prev line)
+                       line)])
+        (mline-get-line line))]))
+
+  
+  (def/public (get-snip-position-and-location [snip% thesnip] [maybe-box? pos] 
+                                              [maybe-box? [x #f]] [maybe-box? [y #f]])
+    (cond
+     [(not (check-recalc (or x y) #f))
+      #f]
+     [(or (not (snip->line thesnip))
+          (not (eq? (mline-get-root (snip->line thesnip)) (unbox line-root-box))))
+      #f]
+     [(or pos x y)
+      (let* ([line (snip->line thesnip)]
+             [p (mline-get-position line)])
+        (let loop ([snip (mline-snip line)]
+                   [p p])
+          (if (eq? snip thesnip)
+              (begin
+                (when pos
+                  (set-box! pos p))
+                (when (or x y)
+                  (position-location p x y))
+                #t)
+              (loop (snip->next snip)
+                    (+ p (snip->count snip))))))]
+     [else #t]))
+
+  (def/override (get-snip-location [snip% thesnip] [maybe-box? [x #f]] [maybe-box? [y #f]] [any? [bottom-right? #f]])
+    (let ([x (or x (and bottom-right? (box 0.0)))]
+          [y (or y (and bottom-right? (box 0.0)))])
+      (if (get-snip-position-and-location thesnip #f x y)
+          (if bottom-right?
+              (let ([wl? write-locked?]
+                    [fl? flow-locked?])
+                (set! write-locked? #t)
+                (set! flow-locked? #t)
+      
+                (let ([dc (send s-admin get-dc)])
+                  (let-boxes ([w 0.0]
+                              [h 0.0])
+                      (send thesnip get-extent dc (unbox x) (unbox y) w h #f #f #f #f)
+
+                    (set! write-locked? wl?)
+                    (set! flow-locked? fl?)
+
+                    (set-box! x (+ (unbox x) w))
+                    (set-box! y (+ (unbox y) h))
+                    #t)))
+              #t)
+          #f)))
+
+  (def/public (get-snip-position [snip% thesnip])
+    (let-boxes ([pos 0])
+        (unless (get-snip-position-and-location thesnip pos)
+          (set-box! pos #f))
+      pos))
+  
+  (def/public (position-locations [exact-nonnegative-integer? start]
+                                  [maybe-box? [tx #f]]
+                                  [maybe-box? [ty #f]]
+                                  [maybe-box? [bx #f]]
+                                  [maybe-box? [by #f]]
+                                  [any? [eol? #f]]
+                                  [any? [whole-line? #f]])
+    (when (check-recalc #t #f)
+
+      ;; handle boundary cases first:
+      (let ([line
+             (cond
+              [(start . <= . 0)
+               (if whole-line?
+                   (begin
+                     (when (or tx bx)
+                       (let ([xl (mline-get-left-location first-line max-width)])
+                         (when tx (set-box! tx xl))
+                         (when bx (set-box! bx xl))))
+                     (when (or ty by)
+                       (let ([yl (mline-get-location first-line)])
+                         (when ty (set-box! ty yl))
+                         (when by (set-box! by (+ yl (mline-h first-line))))))
+                     #f)
+                   first-line)]
+              [(start . >= . len)
+               (if (and extra-line? (not eol?))
+                   (begin
+                     (when ty (set-box! ty (- total-height extra-line-h)))
+                     (when by (set-box! by total-height))
+                     (when tx (set-box! tx 0))
+                     (when bx (set-box! bx 0))
+                     #f)
+                   (if (or whole-line? (zero? len))
+                       (begin
+                         (when (or tx bx)
+                           (let ([xl (mline-get-right-location last-line max-width)])
+                             (when tx (set-box! tx xl))
+                             (when bx (set-box! bx xl))))
+                         (when (or ty by)
+                           (let ([yl (mline-get-location last-line)])
+                             (when ty (set-box! ty yl))
+                             (when by (set-box! by (+ yl (mline-h last-line))))))
+                         #f)
+                       last-line))]
+              [else
+               (let ([line (mline-find-line (unbox line-root-box) (position-line start eol?))])
+                 (if whole-line?
+                     (begin
+                       (when (or by ty)
+                         (let ([yl (mline-get-location line)])
+                           (when ty (set-box! ty yl))
+                           (when by (set-box! by (+ yl (mline-h line))))))
+                       (if (not (or tx bx))
+                           #f
+                           line))
+                     line))])])
+        (when line
+          (let ([wl? write-locked?]
+                [fl? flow-locked?])
+            (set! write-locked? #t)
+            (set! flow-locked? #t)
+
+            (let ([horiz (mline-get-left-location line max-width)]
+                  [topy (mline-get-location line)]
+                  [start (- start (mline-get-position line))])
+              (let-values ([(snip horiz start dc)
+                            (cond
+                             [(zero? start) (values (mline-snip line) horiz start #f)]
+                             [(start . >= . (mline-len line))
+                              (values (mline-last-snip line) (+ horiz (- (mline-w line) (mline-last-w line)))
+                                      start #f)]
+                             [else
+                              ;; linear seach for snip
+                              (let loop ([snip (mline-snip line)]
+                                         [start start]
+                                         [horiz horiz]
+                                         [dc #f])
+                                (if (or (start . > . (snip->count snip))
+                                        (and (or whole-line? (positive? start))
+                                             (= start (snip->count snip))))
+                                    (let* ([start (- start (snip->count snip))]
+                                           [dc (or dc (send s-admin get-dc))])
+                                      (let-boxes ([v 1.0])
+                                          (when dc
+                                            (send snip get-extent dc horiz topy v #f #f #f #f #f))
+                                        (loop (snip->next snip) start (+ horiz v) dc)))
+                                    ;; found snip
+                                    (values snip horiz start dc)))])])
+                (let ([dc
+                       (if (or tx bx)
+                           (let ([dc (or dc
+                                         (and (positive? start)
+                                              (send s-admin get-dc)))])
+                             (let ([xv (+ horiz
+                                          (if (and dc (positive? start))
+                                              (send snip partial-offset dc horiz topy start)
+                                              0))])
+                               (when tx (set-box! tx xv))
+                               (when bx (set-box! bx xv)))
+                             dc)
+                           dc)])
+                  (when (and (not whole-line?)
+                             (or ty by))
+                    (let ([dc (or dc (send s-admin get-dc))])
+                      (let-boxes ([h 0.0]
+                                  [descent 0.0]
+                                  [space 0.0])
+                          (send snip get-extent dc horiz topy #f h descent space #f #F)
+                        (let ([align (send (snip->style snip) get-alignment)])
+                          (cond
+                           [(eq? 'bottom align)
+                            (let ([yl (+ topy (mline-bottombase line) descent)])
+                              (when ty (set-box! ty (- yl h)))
+                              (when by (set-box! by yl)))]
+                           [(eq? 'top align)
+                            (let ([yl (- (+ topy (mline-topbase line)) space)])
+                              (when ty (set-box! ty yl))
+                              (when by (set-box! by (+ yl h))))]
+                           [else
+                            (let* ([h (/ (- h descent space) 2)]
+                                   [yl (+ topy (/ (+ (mline-topbase line) (mline-bottombase line)) 2))])
+                              (when ty (set-box! ty (- yl h space)))
+                              (when by (set-box! by (+ yl h descent))))])))))
+
+                  (set! write-locked? wl?)
+                  (set! flow-locked? fl?)))))))))
+
+  (def/public (position-location [exact-nonnegative-integer? start]
+                                 [maybe-box? [x #f]]
+                                 [maybe-box? [y #f]]
+                                 [any? [top? #t]]
+                                 [any? [eol? #f]]
+                                 [any? [whole-line? #f]])
+    (position-locations start
+                        (if top? x #f) (if top? y #f)
+                        (if top? #f x) (if top? #f y)
+                        eol? whole-line?))
+
+  (def/public (line-location [exact-nonnegative-integer? i]
+                             [any? [top? #t]])
+    (cond
+     [(not (check-recalc #t #f)) 0.0]
+     [(i . < . 0) 0.0]
+     [(i . > . num-valid-lines) total-height]
+     [(= num-valid-lines i)
+      (if extra-line?
+          (- total-height extra-line-h)
+          total-height)]
+     [else
+      (let* ([line (mline-find-line (unbox line-root-box) i)]
+             [y (mline-get-location line)])
+        (if top?
+            y
+            (+ y (mline-h line))))]))
+
+  (define/private (do-line-position start? i visible-only?)
+    (cond
+     [(not (check-recalc (max-width . > . 0) #f #t))
+      0]
+     [(and (i . >= . num-valid-lines) extra-line?)
+      len]
+     [else (let* ([i (max 0 (min i (sub1 num-valid-lines)))]
+                  [line (mline-find-line (unbox line-root-box) i)])
+             (if start?
+                 (if visible-only?
+                     (find-first-visible-position line)
+                     (mline-get-position line))
+                 (let ([p (+ (mline-get-position line) (mline-len line))])
+                   (if visible-only?
+                       (let-boxes ([p p])
+                           (find-last-visible-position line p)
+                         p)
+                       p))))]))
+
+  (def/public (line-start-position [exact-nonnegative-integer? i]
+                                   [any? [visible-only? #t]])
+    (do-line-position #t i visible-only?))
+
+  (def/public (line-end-position [exact-nonnegative-integer? i]
+                                 [any? [visible-only? #t]])
+    (do-line-position #f i visible-only?))
+
+
+  (def/public (line-length [exact-nonnegative-integer? i])
+    (cond
+     [(not (check-recalc (max-width . > . 0) #f #t))
+      0]
+     [(i . < . 0) 0]
+     [(i . >= . num-valid-lines) 0]
+     [else (let ([line (mline-find-line (unbox line-root-box) i)])
+             (mline-len line))]))
+
+  (def/public (position-paragraph [exact-nonnegative-integer? i]
+                                  [any? [at-eol? #f]])
+    (cond
+     [(not (check-recalc #f #f #t)) 0]
+     [else (let ([delta (if (and (i . >= . len) extra-line?)
+                            1
+                            0)]
+                 [i (max 0 (min i len))])
+             (let ([line (mline-find-position (unbox line-root-box) i)])
+               (+ (mline-get-paragraph line) delta)))]))
+
+  (def/public (paragraph-start-position [exact-nonnegative-integer? i]
+                                        [any? [visible-only? #t]])
+    (if (not (check-recalc #f #f #t))
+        0
+        (if (i . > . (+ (last-paragraph) (if extra-line? -1 0)))
+            len
+            (let* ([i (max 0 i)]
+                   [l (mline-find-paragraph (unbox line-root-box) i)]
+                   [l (if (not l)
+                          (if extra-line?
+                              len
+                              (let loop ([l last-line])
+                                (if (and (mline-prev l)
+                                         (not (mline-starts-paragraph l)))
+                                    (loop (mline-prev l))
+                                    l)))
+                          l)])
+              (if visible-only?
+                  (find-first-visible-position l)
+                  (mline-get-position l))))))
+
+  (def/public (paragraph-end-position [exact-nonnegative-integer? i]
+                                      [any? [visible-only? #t]])
+    (if (not (check-recalc #f #f #t))
+        0
+        (let* ([i (max 0 i)]
+               [l (mline-find-paragraph (unbox line-root-box) i)]
+               [l (if l
+                      (let loop ([l l])
+                        (if (and (mline-next l)
+                                 (zero? (mline-starts-paragraph (mline-next l))))
+                            (loop (mline-next l))
+                            l))
+                      (if extra-line?
+                          len
+                          last-line))])
+          (if (mline? l)
+              (let ([p (+ (mline-get-position l) (mline-len l))])
+                (if visible-only?
+                    (let-boxes ([p p])
+                        (find-last-visible-position l p)
+                      p)
+                    p))
+              l))))
+
+  (def/public (line-paragraph [exact-nonnegative-integer? i])
+    (cond
+     [(not (check-recalc (max-width . > . 0) #f #t))
+      0]
+     [(i . < . 0) 0]
+     [(i . >= . num-valid-lines)
+      (+ (mline-get-paragraph last-line) (if extra-line? 1 0))]
+     [else
+      (let ([l (mline-find-line (unbox line-root-box) i)])
+        (mline-get-paragraph l))]))
+
+  (def/public (paragraph-start-line [exact-nonnegative-integer? i])
+    (if (not (check-recalc (max-width . > . 0) #f #t))
+        0
+        (let* ([i (max i 0)]
+               [l (mline-find-paragraph (unbox line-root-box) i)])
+          (if (not l)
+              (last-line)
+              (mline-get-line l)))))
+
+  (def/public (paragraph-end-line [exact-nonnegative-integer? i])
+    (if (not (check-recalc (max-width . > . 0) #f #t))
+        0
+        (let* ([i (max i 0)]
+               [l (mline-find-paragraph (unbox line-root-box) i)])
+          (mline-get-line
+           (if l
+               (let loop ([l l])
+                 (if (and (mline-next l)
+                          (not (mline-starts-paragraph (mline-next l))))
+                     (loop (mline-next l))
+                     l))
+               last-line)))))
+
+  (def/public (last-position) len)
+  
+  (public [/last-line last-line])
+  (define (/last-line)
+    (if (not (check-recalc (max-width . > . 0) #f #t))
+        0
+        (- num-valid-lines (if extra-line? 0 1))))
+
+  (def/public (last-paragraph)
+    (if (not (check-recalc #f #f #t))
+        0
+        (+ (mline-get-paragraph last-line) (if extra-line? 1 0))))
+
+  ;; ----------------------------------------
+
+  (def/override (get-extent [maybe-box? w] [maybe-box? h])
+    (check-recalc #t #f)
+    (when w (set-box! w total-width))
+    (when h (set-box! h total-height)))
+
+  (def/override (get-descent)
+    (check-recalc #t #f)
+    final-descent)
+  
+  (def/override (get-space)
+    (check-recalc #t #f)
+    initial-space)
+  
+  (def/public (get-top-line-base)
+    (check-recalc #t #f)
+    initial-line-base)
+  
+  (def/override (scroll-line-location [exact-nonnegative-integer? scroll])
+    (if read-locked?
+        0.0
+        (begin
+          (check-recalc #t #f)
+          (let ([total (+ (mline-get-scroll last-line) (mline-numscrolls last-line))])
+            (cond
+             [(= total scroll)
+              (if extra-line?
+                  (- total-height extra-line-h)
+                  total-height)]
+             [(scroll . > . total)
+              total-height]
+             [else
+              (let* ([line (mline-find-scroll (unbox line-root-box) scroll)]
+                     [p (mline-get-scroll line)]
+                     [y (mline-get-location line)])
+                (if (p . < . scroll)
+                    (+ y (mline-scroll-offset line (- scroll p)))
+                    y))])))))
+
+  (def/override (num-scroll-lines)
+    (if read-locked?
+        0
+        (begin
+          (check-recalc (max-width . > . 0) #f #t)
+          (+ (mline-get-scroll last-line)
+             (mline-numscrolls last-line)
+             (if extra-line? 1 0)))))
+
+  (def/override (find-scroll-line [real? p])
+    (if read-locked?
+        0
+        (begin
+          (check-recalc #t #f)
+          (if (and extra-line?
+                   (p . >= . (- total-height extra-line-h)))
+              (- (num-scroll-lines) 1)
+              (let* ([line (mline-find-location (unbox line-root-box) p)]
+                     [s (mline-get-scroll line)])
+                (if ((mline-numscrolls line) . > . 1)
+                    (let ([y (mline-get-location line)])
+                      (+ s (mline-find-extra-scroll line (- p y))))
+                    s))))))
+
+  ;; ----------------------------------------
+
+  (def/public (find-string [string? str]
+                           [(symbol-in forward backward) [direction 'forward]]
+                           [(make-alts exact-nonnegative-integer? (symbol-in start)) [start 'start]]
+                           [(make-alts exact-nonnegative-integer? (symbol-in eof)) [end 'eof]]
+                           [any? [bos? #t]]
+                           [any? [case-sens? #t]])
+    (if (not (check-recalc #f #f))
+        #f
+        (do-find-string-all str direction start end #t bos? case-sens?)))
+
+  (def/public (find-string-all [string? str]
+                               [(symbol-in forward backward) [direction 'forward]]
+                               [(make-alts exact-nonnegative-integer? (symbol-in start)) [start 'start]]
+                               [(make-alts exact-nonnegative-integer? (symbol-in eof)) [end 'eof]]
+                               [any? [bos? #t]]
+                               [any? [case-sens? #t]])
+    (if (not (check-recalc #f #f))
+        null
+        (reverse (do-find-string-all str direction start end #f bos? case-sens?))))
+
+  (def/public (find-newline [(symbol-in forward backward) [direction 'forward]]
+                            [(make-alts exact-nonnegative-integer? (symbol-in start)) [start 'start]]
+                            [(make-alts exact-nonnegative-integer? (symbol-in eof)) [end 'eof]])
+    (let* ([para (position-paragraph (if (symbol? start)
+                                         startpos
+                                         start)
+                                     (eq? direction 'backward))]
+           [pos (if (eq? direction 'backward)
+                    (paragraph-start-position para)
+                    (if (para . >= . (last-paragraph))
+                        len
+                        (paragraph-start-position (add1 para))))]
+           [end (if (symbol? end) len end)])
+      (if (eq? direction 'forward)
+          (if (pos . > . end)
+              #f
+              pos)
+          (if (pos . < . end)
+              #f
+              pos))))
+
+  (define/private (do-find-string-all str direction
+                                      start end
+                                      just-one?
+                                      bos?
+                                      case-sens?)
+
+    (let ([start (min (if (symbol? start)
+                          startpos
+                          start)
+                      len)]
+          [end (min (if (symbol? end)
+                        (if (eq? direction 'forward)
+                            len
+                            0)
+                        end)
+                    len)])
+      (let ([total-count
+             (if (eq? direction 'backward)
+                 (- start end)
+                 (- end start))])
+        (if (or (negative? total-count)
+                (string=? str ""))
+            (if just-one? #f null)
+            
+            (let ([slen (string-length str)]
+                  [str (if case-sens?
+                           str
+                           (string-foldcase str))])
+              (let-values ([(snip s-pos) (find-snip/pos start (if (eq? direction 'forward) 'after 'before))])
+                
+                (if (not snip)
+                    (if just-one? #f null)
+
+                    ;; Knuth-Bendix
+
+                    (let-values ([(offset shorten sbase beyond sgoal direction)
+                                  (if (eq? direction 'forward)
+                                      (values (- start s-pos) 0 0 -1 slen 1)
+                                      (values 0 (- (+ s-pos (snip->count snip)) start) (- slen 1) slen -1 -1))]
+                                 [(smap) (make-vector slen 0)])
+
+                      ;; initialize smap:
+                      (vector-set! smap sbase beyond)
+                      (let loop ([s beyond]
+                                 [i (+ sbase direction)])
+                        (unless (= i sgoal)
+                          (let iloop ([s s])
+                            (if (and (not (= beyond s))
+                                     (not (char=? (string-ref str (+ s direction)) (string-ref str i))))
+                                (iloop (vector-ref smap s))
+                                (let ([s (if (char=? (string-ref str (+ s direction))
+                                                     (string-ref str i))
+                                             (+ s direction)
+                                             s)])
+                                  (vector-set! smap i s)
+                                  (loop s (+ i direction)))))))
+
+                      (let a-loop ([s beyond]
+                                   [s-pos s-pos]
+                                   [snip snip]
+                                   [total-count total-count]
+                                   [offset offset]
+                                   [shorten shorten]
+                                   [results null])
+                        (if (and snip (positive? total-count))
+                            (let*-values ([(need) (- (snip->count snip) shorten offset)]
+                                          [(need offset)
+                                           (if (need . > . total-count)
+                                               (if (direction . < . 0)
+                                                   (values total-count (+ offset (- need total-count)))
+                                                   (values total-count offset))
+                                               (values need offset))]
+                                          [(total-count) (- total-count need)])
+                              
+                              (let b-loop ([checked 0]
+                                           [need need]
+                                           [results results])
+                                (let* ([thistime (min need 255)]
+                                       [need (- need thistime)]
+                                       [thisoffset (+ offset (if (direction . < . 0) need checked))]
+                                       [wl? write-locked?]
+                                       [fl? flow-locked?])
+                                  (set! write-locked? #t)
+                                  (set! flow-locked? #t)
+                                  (let ([text (send snip get-text thisoffset thistime #f)])
+                                    (set! write-locked? wl?)
+                                    (set! flow-locked? fl?)
+                                    
+                                    (let c-loop ([i (if (direction . > . 0) 0 (- thistime 1))]
+                                                 [n thistime]
+                                                 [s s]
+                                                 [results results])
+                                      (if (zero? n)
+                                          (if (positive? need)
+                                              
+                                              (b-loop (add1 checked)
+                                                      need
+                                                      results)
+
+                                              (let* ([s-pos (if (direction . > . 0)
+                                                                (+ s-pos (snip->count snip))
+                                                                s-pos)]
+                                                     [snip (if (direction . > . 0)
+                                                               (snip->next snip)
+                                                               (snip->prev snip))]
+                                                     [s-pos (if (and snip (direction . < . 0))
+                                                                (- s-pos (snip->count snip))
+                                                                s-pos)])
+                                                (a-loop s
+                                                        s-pos
+                                                        snip
+                                                        total-count
+                                                        0
+                                                        0
+                                                        results)))
+
+                                          (let* ([n (sub1 n)]
+                                                 [c (string-ref text i)]
+                                                 [c (if case-sens? (char-foldcase c) c)]
+                                                 [s (let loop ([s s])
+                                                      (if (and (not (= beyond s))
+                                                               (not (char=? (string-ref str (+ s direction)) c)))
+                                                          (loop (vector-ref smap s))
+                                                          s))])
+                                            (if (char=? (string-ref str (+ s direction)) c)
+                                                (let ([s (+ s direction)])
+                                                  (if (= (+ s direction) sgoal)
+                                                      (let* ([p (+ s-pos i thisoffset)]
+                                                             [p (if bos?
+                                                                    (if (direction . < . 0)
+                                                                        (+ p slen)
+                                                                        (- p (- slen 1)))
+                                                                    (if (direction . > . 0)
+                                                                        (add1 p)
+                                                                        p))])
+                                                        (if just-one?
+                                                            p ;; <------ single result returned here
+                                                            (c-loop (+ i direction)
+                                                                    n
+                                                                    beyond
+                                                                    (cons p results))))
+                                                      (c-loop (+ i direction)
+                                                              n
+                                                              s
+                                                              results)))
+                                                (c-loop (+ i direction)
+                                                        n
+                                                        s
+                                                        results)))))))))
+                            (if just-one?
+                                #f
+                                results)))))))))))
+
+  ;; ----------------------------------------
+  
+  (define/private (do-change-style start end new-style delta restore-sel? counts-as-mod?)
+    (unless (or write-locked?
+                s-user-locked?
+                (and new-style
+                     (not (send s-style-list style-to-index new-style))))
+      (let* ([start (max 0 (min len start))]
+             [end (min end len)])
+        (unless (start . > . end)
+          (let ([new-style (if (and (not new-style) (not delta))
+                               (or (get-default-style)
+                                   (send s-style-list basic-style))
+                               new-style)])
+            (cond
+             [(and (= start startpos) (= end endpos) (= end start) (positive? len))
+              (when sticky-styles?
+                (set! caret-style 
+                      (cond
+                       [new-style new-style]
+                       [caret-style (send s-style-list find-or-create-style caret-style delta)]
+                       [else (let ([gsnip (find-snip start 'before)])
+                               (send s-style-list find-or-create-style (snip->style gsnip) delta))])))]
+             [else
+              (set! write-locked? #t)
+
+              (if (not (can-change-style? start (- end start)))
+                  (set! write-locked? #f)
+                  
+                  (begin
+                    (on-change-style start (- end start))
+                    
+                    (set! flow-locked? #t)
+
+                    (make-snipset start end)
+                    
+                    (let-values ([(start-snip end-snip)
+                                  (if (zero? len)
+                                      (begin
+                                        (set! initial-style-needed? #f)
+                                        (values snips #f))
+                                      (values (find-snip start 'after) (find-snip end 'after-or-none)))]
+                                 [(rec)
+                                  (and (zero? s-noundomode)
+                                       (make-object style-change-record% start end 
+                                                    (or delayed-streak? (not s-modified?))
+                                                    startpos endpos restore-sel?))])
+                      (let loop ([something? #f]
+                                 [extra-check-pos #f]
+                                 [prev-style #f]
+                                 [prev-style-pos start]
+                                 [p start]
+                                 [gsnip start-snip])
+                        (if (not (eq? gsnip end-snip))
+                            ;; Change a snip style:
+                            (let* ([style (snip->style gsnip)]
+                                   [style2 (or new-style
+                                               (send s-style-list find-or-create-style style delta))])
+                              (if (not (eq? style style2))
+                                  (begin
+                                    (set-snip-style! gsnip style2)
+                                    (let-values ([(prev-style prev-style-pos)
+                                                  (if (and rec (not (eq? prev-style style)))
+                                                      (begin
+                                                        (when prev-style
+                                                          (send rec add-style-change prev-style-pos p prev-style))
+                                                        (values style p))
+                                                      (values prev-style prev-style-pos))])
+                                      (send gsnip size-cache-invalid)
+                                      (mline-mark-recalculate (snip->line gsnip))
+                                      (when (max-width . > . 0)
+                                        (mline-mark-check-flow (snip->line gsnip)))
+                                      (loop #t
+                                            p
+                                            prev-style
+                                            prev-style-pos
+                                            (+ p (snip->count gsnip))
+                                            (snip->next gsnip))))
+                                  (let ([prev-style
+                                         (if (and rec prev-style)
+                                             (begin
+                                               (send rec add-style-change prev-style-pos p prev-style)
+                                               #f)
+                                             prev-style)])
+                                    (loop something?
+                                          extra-check-pos
+                                          prev-style
+                                          prev-style-pos
+                                          (+ p (snip->count gsnip))
+                                          (snip->next gsnip)))))
+                            ;; All snips changed
+                            (begin
+                              (when (and rec prev-style)
+                                (send rec add-style-change prev-style-pos p prev-style))
+
+                              (if something?
+                                  ;; Something changed, so recalc and refresh:
+                                  (let ([line (snip->line start-snip)])
+                                    (when (and (mline-prev line)
+                                               (not (has-flag? (snip->flags (mline-snip (mline-prev line))) HARD-NEWLINE)))
+                                      (mline-mark-check-flow (mline-prev line)))
+                                    (when (not s-modified?)
+                                      (add-undo-rec (make-object unmodify-record% delayed-streak?)))
+                                    (when rec
+                                      (add-undo-rec rec))
+                                    (when (positive? delay-refresh)
+                                      (set! delayed-streak? #t))
+                                    
+                                    (check-merge-snips start)
+                                    (when extra-check-pos
+                                      (check-merge-snips extra-check-pos))
+                                    (when (not (= end extra-check-pos))
+                                      (check-merge-snips end))
+                                    
+                                    (when (and (not s-modified?) counts-as-mod?)
+                                      (set-modified #t))
+
+                                    (set! write-locked? #f)
+                                    (set! flow-locked? #f)
+                                  
+                                    (refresh-by-line-demand))
+                                  ;; Nothing changed after all:
+                                  (begin
+                                    (set! write-locked? #f)
+                                    (set! flow-locked? #f)
+
+                                    (check-merge-snips start)
+                                    (check-merge-snips end)))
+
+                              (after-change-style start (- end start))))))))]))))))
+
+  (def/public (change-style [(make-or-false (make-alts style<%> style-delta%)) st]
+                            [(make-alts exact-nonnegative-integer? (symbol-in start)) [start 'start]]
+                            [(make-alts exact-nonnegative-integer? (symbol-in end)) [end 'end]]
+                            [any? [counts-as-mod? #t]])
+    (do-change-style (if (symbol? start) startpos start)
+                     (if (symbol? end) (if (symbol? start) endpos len) end)
+                     (and (st . is-a? . style<%>) st)
+                     (and (st . is-a? . style-delta%) st)
+                     1
+                     counts-as-mod?))
+
+  (def/override (set-style-list [style-list% new-list])
+    (unless write-locked?
+      (let ([delta (new style-delta%)]
+            [count (send s-style-list number)])
+        (when (positive? count)
+          (let ([smap (make-vector count #f)])
+            (vector-set! smap 0 (send new-list index-to-style 0))
+            (for ([index (in-range 1 count)])
+              (let* ([style (send s-style-list index-to-style index)]
+                     [name (send style get-name)])
+                (vector-set!
+                 smap
+                 index
+                 (cond
+                  [(and name (send new-list find-named-style name))
+                   => (lambda (new-style) new-style)]
+                  [else
+                   (let ([new-style
+                          (let* ([base-style (send style get-base-style)]
+                                 [base-index (send s-style-list style-to-index base-style)])
+                            (if (send style is-join?)
+                                (let* ([ss (send style get-shift-style)]
+                                       [shift-index (send s-style-list style-to-index ss)])
+                                  (send new-list find-or-create-join-style 
+                                        (vector-ref smap base-index)
+                                        (vector-ref smap shift-index)))
+                                (begin
+                                  (send style get-delta delta)
+                                  (send new-list find-or-create-style 
+                                        (vector-ref smap base-index)
+                                        delta))))])
+                     (if name
+                         (send new-list new-named-style name new-style)
+                         new-style))]))))
+            (let loop ([snip snips])
+              (when snip
+                (let* ([index (send s-style-list style-to-index (snip->style snip))]
+                       [index (if (not index)
+                                  ;; bad! snip had style not from this buffer's style list
+                                  0
+                                  index)])
+                  (set-snip-style! snip (vector-ref smap index)))
+                (loop (snip->next snip))))))
+          
+        (super set-style-list new-list)
+        
+        (size-cache-invalid)
+        (set! changed? #t)
+        (need-refresh -1 -1))))
+
+  (def/override (style-has-changed [(make-or-false style<%>) style])
+    (unless read-locked?
+      (if (not style)
+          ;; our cue to repaint
+          (begin
+            (set! changed? #t)
+            (need-refresh -1 -1))
+          ;; notify snips:
+          (let ([wl? write-locked?]
+                [fl? flow-locked?])
+            (set! write-locked? #t)
+            (set! flow-locked? #t)
+
+            (let loop ([snip snips])
+              (when snip
+                (when (eq? style (snip->style snip))
+                  (send snip size-cache-invalid)
+                  (let ([line (snip->line snip)])
+                    (mline-mark-recalculate line)
+                    (when (max-width . >= . 0)
+                      (mline-mark-check-flow line)
+                      (when (and (mline-prev line)
+                                 (not (has-flag? (snip->flags (mline-last-snip (mline-prev line)))
+                                                 HARD-NEWLINE)))
+                        (mline-mark-check-flow (mline-prev line))))))
+                (loop (snip->next snip))))
+            (set! write-locked? wl?)
+            (set! flow-locked? fl?)))))
+
+  ;; ----------------------------------------
+
+  (define/private (do-scroll-to snip localx localy w h refresh? [bias 'none])
+    (cond
+     [flow-locked? #f]
+     [(positive? delay-refresh)
+      (when s-admin
+        (set! delayedscroll -1)
+        (set! delayedscrollbox? #t)
+        (set! delayedscrollsnip snip)
+        (set! delayedscroll-x localx)
+        (set! delayedscroll-y localy)
+        (set! delayedscroll-w w)
+        (set! delayedscroll-h h)
+        (set! delayedscrollbias bias))
+      #f]
+     [else
+      (let-boxes ([x 0.0]
+                  [y 0.0]
+                  [ok? #t])
+          (when snip
+            (set-box! ok? (get-snip-position-and-location snip #f x y)))
+        (cond
+         [(not ok?) #f]
+         [(scroll-editor-to (+ x localx) (+ y localy) w h refresh? bias)
+          (unless refresh?
+            (set! refresh-all? #t))
+          #t]
+         [else #f]))]))
+
+  (def/public (scroll-to [snip% snip] [real? localx] [real? localy]
+                         [nonnegative-real? w] [nonnegative-real? h]
+                         [any? refresh?]
+                         [(symbol-in start end none) [bias 'none]])
+    (do-scroll-to snip localx localy w h refresh? bias))
+
+  (def/override (resized [snip% snip] [any? redraw-now?])
+    (when (get-snip-position-and-location snip #f #f #f)
+
+      (let ([line (snip->line snip)])
+        (mline-mark-recalculate line)
+        (when (max-width . >= . 0)
+          (mline-mark-check-flow line)
+          ;; maybe something can now move to the previous line
+          (when (and (mline-prev line)
+                     (not (has-flag? (snip->flags (mline-last-snip (mline-prev line)))
+                                     HARD-NEWLINE)))
+            (mline-mark-check-flow (mline-prev line)))))
+
+      (set! graphic-maybe-invalid? #t)
+
+      (let ([redraw-now? (and redraw-now?
+                              (not flow-locked?))])
+
+        (set! changed? #t)
+
+        (unless redraw-now? (set! delay-refresh (add1 delay-refresh)))
+        (refresh-by-line-demand)
+        (unless redraw-now? (set! delay-refresh (sub1 delay-refresh))))))
+
+  (def/override (recounted [snip% snip] [any? redraw-now?])
+    (if write-locked?
+        #f
+        (begin
+          (set! revision-count (add1 revision-count))
+          (resized snip redraw-now?)
+          #t)))
+
+  (def/override (set-caret-owner [(make-or-false snip%) snip] 
+                                 [(symbol-in immediate display global) [dist 'immediate]])
+    (when (do-set-caret-owner snip dist)
+      (need-refresh startpos endpos) ;; (need-caret-refresh); <- doesn't work; local caret ownership weirdness
+      (on-focus (not snip))))
+
+  (def/override (release-snip [snip% snip])
+    (let ([pos (get-snip-position snip)])
+      (and pos
+           (begin
+             (do-delete pos (+ pos (snip->count snip)) #f #f)
+             (when (and (not (snip->admin snip))
+                        (has-flag? (snip->flags snip) OWNED))
+               (set-snip-flags! snip (remove-flag (snip->flags snip) OWNED)))
+             #t))))
+  
+  (define/public (refresh-box L T w h)
+    (let ([B (+ T h)]
+          [R (+ L w)])
+      (if refresh-box-unset?
+          (begin
+            (set! refresh-l L)
+            (set! refresh-r R)
+            (set! refresh-t T)
+            (set! refresh-b B)
+            (set! refresh-box-unset? #f))
+          (begin
+            (when (L . < . refresh-l)
+              (set! refresh-l L))
+            (when (R . > . refresh-r)
+              (set! refresh-r R))
+            (when (T . < . refresh-t)
+              (set! refresh-t T))
+            (when (B . > . refresh-b)
+              (set! refresh-b B))))
+
+      (set! draw-cached-in-bitmap? #f)))
+
+  (def/override (needs-update [snip% snip]
+                              [real? localx] [real? localy]
+                              [nonnegative-real? w] [nonnegative-real? h])
+    (let-boxes ([x 0.0]
+                [y 0.0]
+                [ok? #t])
+        (set-box! ok? (get-snip-location snip x y))
+      (when ok?
+        (refresh-box (+ x localx) (+ y localy) w h)
+        (when (zero? delay-refresh)
+          (redraw)))))
+
+  (def/override (invalidate-bitmap-cache [real? [x 0.0]] 
+                                         [real? [y 0.0]]
+                                         [(make-alts nonnegative-real? (symbol-in end)) [w 'end]]
+                                         [(make-alts nonnegative-real? (symbol-in end)) [h 'end]])
+    (let ([w (if (symbol? w) (- total-width x) w)]
+          [h (if (symbol? h) (- total-height y) h)])
+
+      (refresh-box x y w h)
+      (when (zero? delay-refresh)
+        (redraw))))
+
+  (def/public (hide-caret [any? hide?])
+    (unless (eq? hilite-on? (not hide?))
+      (set! hilite-on? (not hide?))
+      (when (or s-own-caret? (not (= endpos startpos)))
+        (need-caret-refresh))))
+
+  (def/public (caret-hidden) (not hilite-on?))
+
+  (def/public (get-between-threshold) between-threshold)
+
+  (def/public (set-between-threshold [nonnegative-real? t])
+    (set! between-threshold (min t 99.0)))
+
+  ;; ----------------------------------------
+
+  (define/private (make-only-snip)
+    (set! snips (new string-snip%))
+    (set-snip-style! snips (or (get-default-style)
+                               (send s-style-list basic-style)))
+    (set-snip-count! snips 0)
+    (send snips set-s-admin snip-admin)
+
+    (let ([line (create-mline)])
+      (set-snip-line! snips line)
+      (set-box! line-root-box line)
+      (set! first-line line)
+      (set! last-line line)
+      (mline-set-starts-paragraph line #t)
+
+      (set-mline-snip! line snips)
+      (set-mline-last-snip! line snips)
+
+      (set! last-snip snips)
+      (set! snip-count 1)
+
+      (set! num-valid-lines 1)))
+
+  (define/private (splice-snip snip prev next)
+    (if prev
+        (set-snip-next! prev snip)
+        (set! snips snip))
+    (set-snip-prev! snip prev)
+    (set-snip-next! snip next)
+    (if next
+        (set-snip-prev! next snip)
+        (set! last-snip snip)))
+
+  (define/private (insert-snip before snip)
+    (if (and (eq? snips last-snip) (zero? (snip->count snips)))
+        (append-snip snip)
+        (begin
+          (splice-snip snip (snip->prev before) before)
+          (set! snip-count (add1 snip-count)))))
+  
+  (define/private (append-snip snip)
+    (if (and (eq? snips last-snip) (zero? (snip->count snips))) 
+        ;; get rid of empty snip
+        (begin
+          (set! snips snip)
+          (set! last-snip snip))
+        (begin
+          (splice-snip snip last-snip #f)
+          (set! snip-count (add1 snip-count)))))
+  
+  (define/private (delete-snip snip)
+    (cond
+     [(snip->next snip)
+      (splice-snip (snip->next snip) (snip->prev snip) (snip->next (snip->next snip)))]
+     [(snip->prev snip)
+      (splice-snip (snip->prev snip) (snip->prev (snip->prev snip)) (snip->next snip))]
+     [else
+      (set! last-snip #f)
+      (set! snips #f)])
+    (set! snip-count (sub1 snip-count))
+    (set-snip-flags! snip (add-flag (snip->flags snip) CAN-DISOWN))
+    (snip-set-admin snip #f)
+    (set-snip-line! snip #f)
+    (set-snip-prev! snip #f)
+    (set-snip-next! snip #f)
+    (set-snip-flags! snip (remove-flag (snip->flags snip) CAN-DISOWN)))
+  
+  (define/private (snip-set-admin snip a)
+    (let ([orig-count (snip->count snip)]
+          [line (snip->line snip)]
+          [orig-admin (snip->admin snip)]
+          [wl? write-locked?]
+          [fl? flow-locked?])
+
+      (set! read-locked? #t)
+      (set! write-locked? #t)
+      (set! flow-locked? #t)
+
+      (send snip set-admin a)
+      
+      (set! read-locked? #f) 
+      (set! write-locked? wl?) 
+      (set! flow-locked? fl?)
+
+      (let ([snip
+             (if (not (eq? (snip->admin snip) a))
+                 ;; something went wrong
+                 (cond
+                  [(and (not a) (eq? (snip->admin snip) orig-admin))
+                   ;; force admin to NULL
+                   (send snip set-s-admin #f)
+                   snip]
+                  [a
+                   ;; snip didn't accept membership into this editor; give up on it
+                   (let ([naya (new snip%)])
+                     (set-snip-count! naya orig-count)
+                     (splice-snip naya (snip->prev snip) (snip->next snip))
+                     (set-snip-line! naya line)
+                     
+                     (when line
+                       (when (eq? (mline-snip line) snip)
+                         (set-mline-snip! line naya))
+                       (when (eq? (mline-last-snip line) snip)
+                         (set-mline-last-snip! line naya)))
+                     
+                     (send snip set-s-admin #f)
+                     
+                     (send naya set-admin a)
+                     (set! snip naya)
+                     naya)]
+                  [else snip])
+                 snip)])
+
+        ;; force count to be consistent:
+        (when (and a (not (= (snip->count snip) orig-count)))
+          (set-snip-count! snip orig-count))
+
+        snip)))
+
+  (define/private (snip-split snip pos a-ptr b-ptr)
+    (let ([c (snip->count snip)]
+          [nl? (has-flag? (snip->flags snip) NEWLINE)]
+          [hnl? (has-flag? (snip->flags snip) HARD-NEWLINE)]
+          [orig snip])
+
+      (set-snip-flags! snip (add-flag (snip->flags snip) CAN-SPLIT))
+
+      (delete-snip snip)
+
+      (set-snip-flags! orig (remove-flag (snip->flags orig) OWNED))
+
+      (set! revision-count (add1 revision-count))
+
+      (let ([wl? write-locked?]
+            [fl? flow-locked?])
+
+        (set! read-locked? #t)
+        (set! write-locked? #t)
+        (set! flow-locked? #t)      
+
+        (set-box! a-ptr #f)
+        (set-box! b-ptr #f)
+        (send snip split pos a-ptr b-ptr)
+
+        (set! read-locked? #f)
+        (set! write-locked? wl?)
+        (set! flow-locked? fl?))
+
+      (let* ([a (or (unbox a-ptr)
+                    (new snip%))]
+             [a (if (send a is-owned?)
+                    (new snip%)
+                    a)]
+             [b (or (unbox b-ptr)
+                    (new snip%))]
+             [b (if (send b is-owned?)
+                    (new snip%)
+                    b)])
+
+        (set-box! a-ptr a)
+        (set-box! b-ptr b)
+
+        (set-snip-flags! a (remove-flag (snip->flags a) CAN-SPLIT))
+        (set-snip-flags! b (remove-flag (snip->flags b) CAN-SPLIT))
+        (set-snip-flags! orig (remove-flag (snip->flags orig) CAN-SPLIT))
+
+        ;; make sure that count is right
+        (set-snip-count! a pos)
+        (set-snip-count! b (- c pos))
+
+        ;; make sure that NEWLINE & HARD-NEWLINE is consistent:
+        (when nl?
+          (set-snip-flags! b (add-flag (snip->flags b) NEWLINE)))
+        (when hnl?
+          (set-snip-flags! b (add-flag (snip->flags b) HARD-NEWLINE)))
+        (set-snip-flags! a (remove-flag (remove-flag (snip->flags b) NEWLINE)
+                                        HARD-NEWLINE)))))
+
+    (define/private (split-one pos s-pos snip extra)
+      (let ([line (snip->line snip)]
+            [prev (snip->prev snip)]
+            [next (snip->next snip)]
+            [style (snip->style snip)])
+        (let ([at-start? (eq? (mline-snip line) snip)]
+              [at-end? (eq? (mline-last-snip line) snip)]
+              [orig snip])
+          (let-boxes ([ins-snip #f]
+                      [snip #f])
+              (snip-split orig (- pos s-pos) ins-snip snip)
+
+            (set-snip-style! snip style)
+            (set-snip-style! ins-snip style)
+      
+            (set-snip-line! snip line)
+            (set-snip-line! ins-snip line)
+
+            (when at-start?
+              (set-mline-snip! line ins-snip))
+            (when at-end?
+              (set-mline-last-snip! line snip))
+      
+            (splice-snip snip prev next)
+            (set! snip-count (add1 snip-count))
+            (insert-snip snip ins-snip)
+            (extra snip)
+                  
+            (snip-set-admin snip snip-admin)
+            (snip-set-admin ins-snip snip-admin)
+            
+            (after-split-snip (- pos s-pos))))))
+
+  (define/private (make-snipset start end) 
+    ;; BEWARE: `len' may not be up-to-date
+    (when (positive? start)
+      (let-values ([(snip s-pos) (find-snip/pos start 'after-or-none)])
+        (when snip
+          (unless (= s-pos start)
+            (split-one start s-pos snip void)))))
+    (when (positive? end)
+      (let-values ([(snip s-pos) (find-snip/pos end 'before)])
+        (unless (= (+ s-pos (snip->count snip)) end)
+          (split-one end s-pos snip void)))))
+
+  (define/private (insert-text-snip start style)
+    (let* ([snip (on-new-string-snip)]
+           [snip (if (or (send snip is-owned?)
+                         (positive? (snip->count snip)))
+                     ;; uh-oh; resort to string-snip%
+                     (new string-snip%)
+                     snip)]
+           [style (or style
+                      (get-default-style)
+                      (send s-style-list basic-style))])
+      (set-snip-style! snip style)
+      (let ([snip (let ([rsnip (snip-set-admin snip snip-admin)])
+                    (if (not (eq? snip rsnip))
+                        ;; uh-oh; resort to string-snip%:
+                        (let ([snip (new string-snip%)])
+                          (set-snip-style! snip style)
+                          (send snip set-s-admin snip-admin))
+                        snip))])
+        (set-snip-count! snip 0)
+        
+        (let-values ([(gsnip s-pos) (find-snip/pos start 'before-or-none)])
+          (if (and gsnip
+                   (= (+ (snip->count gsnip) s-pos) start)
+                   (has-flag? (snip->flags gsnip) NEWLINE)
+                   (not (has-flag? (snip->flags gsnip) HARD-NEWLINE)))
+              (begin
+                ;; we want the snip on the same line as the preceeding snip:
+                (if (snip->next gsnip)
+                    (insert-snip (snip->next gsnip) snip)
+                    (append-snip snip))
+                (set-snip-flags! gsnip (remove-flag (snip->flags gsnip) NEWLINE))
+                (set-snip-flags! snip (add-flag (snip->flags snip) NEWLINE))
+                (set-snip-line! snip (snip->line gsnip))
+                (set-mline-last-snip! (snip->line snip) snip)
+                snip)
+              (let-values ([(gsnip s-pos) (find-snip/pos start 'after-or-none)])
+                (cond
+                 [(not gsnip)
+                  (append-snip snip)
+                  (set-snip-line! snip last-line)
+                  (when (eq? (mline-last-snip last-line) last-snip)
+                    (set! last-snip snip))
+                  (set-mline-last-snip! last-line snip)
+                  snip]
+                 [(= s-pos start)
+                  (insert-snip gsnip snip)
+                  (set-snip-line! snip (snip->line gsnip))
+                  (when (eq? (mline-snip (snip->line snip)) gsnip)
+                    (set-mline-snip! (snip->line snip) snip))
+                  snip]
+                 [else
+                  (split-one start s-pos gsnip
+                             (lambda (gsnip)
+                               (set-snip-line! snip (snip->line gsnip))
+                               (insert-snip gsnip snip)))
+                  snip])))))))
+
+  (define/private (check-merge-snips start)
+    (when (let loop ([did-something? #f])
+            (let-values ([(snip1 s-pos1) (find-snip/pos start 'before)]
+                         [(snip2 s-pos2) (find-snip/pos start 'after)])
+              (if (eq? snip1 snip2)
+                  did-something?
+                  (if (not (and (snip->snipclass snip1)
+                                (eq? (snip->snipclass snip1) (snip->snipclass snip2))
+                                (eq? (snip->style snip1) (snip->style snip2))))
+                      did-something?
+                      (if (not (and
+                                (not (has-flag? (snip->flags snip1) NEWLINE))
+                                (has-flag? (snip->flags snip1) CAN-APPEND)
+                                (has-flag? (snip->flags snip2) CAN-APPEND)
+                                ((+ (snip->count snip1) (snip->count snip2)) . < . MAX-COUNT-FOR-SNIP)
+                                (eq? (snip->line snip1) (snip->line snip2))))
+                          did-something?
+                          (cond
+                           [(zero? (snip->count snip1))
+                            (when (eq? (mline-snip (snip->line snip1)) snip1)
+                              (set-mline-snip! (snip->line snip1) snip2))
+                            (delete-snip snip1)
+                            (set-snip-flags! snip1 (remove-flag (snip->flags snip1) OWNED))
+                            (loop #t)]
+                           [(zero? (snip->count snip2))
+                            (when (eq? (mline-last-snip (snip->line snip2)) snip2)
+                              (set-mline-last-snip! (snip->line snip2) snip1)
+                              (mline-mark-recalculate (snip->line snip1)) ; need last-w updated
+                              (set! graphic-maybe-invalid? #t))
+                            (delete-snip snip2)
+                            (set-snip-flags! snip2 (remove-flag (snip->flags snip2) OWNED))
+                            (loop #t)]
+                           [else
+                            (let ([c (+ (snip->count snip1) (snip->count snip2))]
+                                  [prev (snip->prev snip1)]
+                                  [next (snip->next snip2)]
+                                  [line (snip->line snip1)])
+                              (let ([at-start? (eq? (mline-snip line) snip1)]
+                                    [at-end? (eq? (mline-last-snip line) snip2)]
+                                    [wl? write-locked?]
+                                    [fl flow-locked?])
+                                (set! read-locked? #t)
+                                (set! write-locked? #t)
+                                (set! flow-locked? #t)
+
+                                (set-snip-flags! snip2 (add-flag (snip->flags snip2) CAN-SPLIT))
+                                (let ([naya (send snip2 merge-with snip1)])
+                                  (set! read-locked? #t)
+                                  (set! write-locked? wl?)
+                                  (set! flow-locked? wl?)
+                                  
+                                  (if naya
+                                      (begin
+                                        ;; claim snip1 & snip2 unowned for naya test:
+                                        (set-snip-flags! snip1 (remove-flag (remove-flag (snip->flags snip1) CAN-SPLIT)
+                                                                            OWNED))
+                                        (set-snip-flags! snip2 (remove-flag (remove-flag (snip->flags snip2) CAN-SPLIT)
+                                                                            OWNED))
+                                        
+                                        (let ([naya (if (send naya is-owned?)
+                                                        ;; uh-oh; make dummy
+                                                        (new snip%)
+                                                        naya)])
+                                          (set-snip-flags! naya (remove-flag (snip->flags naya) CAN-SPLIT))
+                                          (set-snip-flags! snip1 (add-flag (snip->flags snip1) OWNED))
+                                          (set-snip-flags! snip2 (add-flag (snip->flags snip2) OWNED))
+
+                                          (delete-snip snip1)
+                                          (set-snip-flags! snip1 (remove-flag (snip->flags snip1) OWNED))
+                                          (delete-snip snip2)
+                                          (set-snip-flags! snip2 (remove-flag (snip->flags snip2) OWNED))
+                                          
+                                          (splice-snip naya prev next)
+                                          (set! snip-count (add1 snip-count))
+                                          
+                                          ;; make sure that count is right:
+                                          (set-snip-count! naya c)
+
+                                          (set! revision-count (add1 revision-count))
+
+                                          (let ([naya (snip-set-admin naya snip-admin)])
+                                            
+                                            (set-snip-line! naya line)
+                                            (when at-start?
+                                              (set-mline-snip! line naya))
+                                            (when at-end?
+                                              (set-mline-last-snip! line naya)
+                                              (mline-mark-recalculate line) ;; need last-w updated
+                                              (set! graphic-maybe-invalid? #t))
+                                            #t)))
+                                      (begin
+                                        (set-snip-flags! snip2 (remove-flag (snip->flags snip2) CAN-SPLIT))
+                                        #t)))))]))))))
+      (after-merge-snips start)))
+
+  ;; ----------------------------------------
+
+  (def/public (on-new-string-snip)
+    (new string-snip%))
+
+  (def/public (on-new-tab-snip)
+    (new tab-snip%))
+  
+  ;; ----------------------------------------
+
+  (def/override (find-first-snip)
+    (if (zero? len)
+        #f
+        snips))
+  
+  (def/public (find-snip [exact-nonnegative-integer? p]
+                         [(symbol-in before-or-none before after after-or-none) direction]
+                         [maybe-box? [s-pos #f]])
+    ;; BEWARE: `len' may not be up-to-date
+    (let-values ([(snip pos) (find-snip/pos p direction)])
+      (when s-pos (set-box! s-pos pos))
+      snip))
+
+  (define/private (find-snip/pos p direction)
+    ;; BEWARE: `len' may not be up-to-date
+    (cond
+     [(and (eq? direction 'before-or-none) (zero? p))
+      (values #f 0)]
+     [(and (eq? direction 'after-or-none) (p . >= . (let ([l (mline-last (unbox line-root-box))])
+                                                      (+ (mline-get-position l)
+                                                         (mline-len l)))))
+      (values #f 0)]
+     [else
+      (let* ([line (mline-find-position (unbox line-root-box) p)]
+             [pos (mline-get-position line)]
+             [p (- p pos)])
+
+        (let-values ([(snip pos p)
+                      (let ([snip (mline-snip line)])
+                        (if (and (zero? p) (snip->prev snip))
+                            ;; back up one:
+                            (let ([snip (snip->prev snip)])
+                              (values snip
+                                      (- pos (snip->count snip))
+                                      (+ p (snip->count snip))))
+                            (values snip pos p)))])
+
+          (let loop ([snip snip]
+                     [pos pos]
+                     [p p])
+            (if snip
+                (let ([p (- p (snip->count snip))])
+                  (cond
+                   [(or (and (eq? direction 'on)
+                             (zero? p))
+                        (and (or (eq? direction 'before)
+                                 (eq? direction 'before-or-none))
+                             (p . <= . 0))
+                        (and (or (eq? direction 'after)
+                                 (eq? direction 'after-or-none))
+                             (p . < . 0)))
+                    (values snip pos)]
+                   [(and (eq? direction 'on)
+                         (p . < . 0))
+                    (values #f 0)]
+                   [else
+                    (loop (snip->next snip) (+ pos (snip->count snip)) p)]))
+                (if (not (eq? direction 'after-or-none))
+                    (values last-snip (- pos (snip->count last-snip)))
+                    (values #f 0))))))]))
+
+  (def/public (find-next-non-string-snip [(make-or-false snip%) snip])
+    (if (or (and snip
+                 (not (eq? (snip->admin snip) snip-admin)))
+            (zero? len))
+        #f
+        (let loop ([snip (if snip
+                             (snip->next snip)
+                             snips)])
+          (if (and snip (snip . is-a? . string-snip%))
+              (loop (snip->next snip))
+              snip))))
+
+  ;; ----------------------------------------
+
+  (define/override (setting-admin admin) (void))
+
+  (define/override (init-new-admin)
+    (when (and (zero? delay-refresh)
+               (or (not s-admin) (not (send s-admin delay-refresh?))))
+      (redraw)))
+
+  (define/private (end-streaks exceptions)
+    (when (and s-keymap 
+               (not (memq 'key-sequence exceptions))
+               (not streaks-pushed?))
+      (send s-keymap break-sequence))
+    (when (and flash? flashautoreset? (not flashdirectoff?))
+      (flash-off))
+
+    (set! typing-streak? #f)
+    (set! deletion-streak? #f)
+    (when (not (memq 'cursor exceptions))
+      (set! vcursor-streak? #f)
+      (set! extend-streak? #f))
+    
+    (when (and anchor-streak? (not keep-anchor-streak?))
+      (set-anchor #f))
+
+    (when (not (memq 'delayed exceptions))
+      (set! delayed-streak? #f))
+
+    (set! kill-streak? #f)
+    
+    (set! prev-paste-start -1))
+
+  (define/private (push-streaks)
+    (set! streaks-pushed? #t)
+    (set! save-typing-streak? typing-streak?)
+    (set! save-deletion-streak? deletion-streak?)
+    (set! save-delayed-streak? delayed-streak?)
+    (set! save-vcursor-streak? vcursor-streak?)
+    (set! save-kill-streak? kill-streak?)
+    (set! save-anchor-streak? anchor-streak?)
+    (set! save-extend-streak? extend-streak?)
+    (set! save-prev-paste-start prev-paste-start)
+    (set! save-prev-paste-end prev-paste-end))
+
+  (define/private (pop-streaks)
+    (when streaks-pushed?
+      (set! streaks-pushed? #f)
+      (set! typing-streak? save-typing-streak?)
+      (set! deletion-streak? save-deletion-streak?)
+      (set! delayed-streak? save-delayed-streak?)
+      (set! vcursor-streak? save-vcursor-streak?)
+      (set! kill-streak? save-kill-streak?)
+      (set! anchor-streak? save-anchor-streak?)
+      (set! extend-streak? save-extend-streak?)
+      (set! prev-paste-start save-prev-paste-start)
+      (set! prev-paste-end save-prev-paste-end)))
+
+  ;; ----------------------------------------
+
+  (define/private (check-recalc [need-graphic? #t] [need-write? #t] [no-display-ok? #f])
+    (and (not read-locked?)
+         (not (and write-locked? need-write?))
+         (if (not need-graphic?)
+             #t
+             (if (not s-admin)
+                 no-display-ok?
+                 (if (not graphic-maybe-invalid?)
+                     #t
+                     (if flow-locked?
+                         #f
+                         (let ([dc (send s-admin get-dc)])
+                           (if (not dc)
+                               no-display-ok?
+                               (recalc-lines dc need-graphic?)))))))))
+
+  (define/public (check-flow maxw dc Y startp start)
+    ;; this method is called with write-locked and flow-locked already #t
+    (let ([p startp]
+          [checking-underflow? #f] ;; start by ensuring no overflow
+          [checking-underflow-at-next? #f]
+          [no-change-if-end-of-snip? #t] ;; because an immediate overflow can't be helped
+          [no-change-if-start-of-snip? #f]
+          [the-first-snip? #t]
+          [first-underflow? #f]
+          [deleted-a-newline? #f]
+          [had-newline? #f])
+
+      (define (done snip)
+        (cond
+         [(and (not snip)
+               (has-flag? (snip->flags last-snip) NEWLINE)
+               (not (has-flag? (snip->flags last-snip) HARD-NEWLINE)))
+          (begin
+            (set-snip-flags! last-snip (remove-flag (snip->flags last-snip) NEWLINE))
+            (set! refresh-all? #t)
+            #t)]
+         [(or (not checking-underflow?) no-change-if-end-of-snip?)
+          deleted-a-newline?]
+         [else
+          (set! refresh-all? #t)
+          #t]))
+
+      (let loop ([snip start]
+                 [p p]
+                 [_total-width 0])
+        (if (and snip (not (has-flag? (snip->flags snip) HARD-NEWLINE)))
+            (begin
+              (when (not checking-underflow?)
+                (set! checking-underflow? checking-underflow-at-next?)
+                (when checking-underflow?
+                  (set! first-underflow? #t)))
+              (set! no-change-if-start-of-snip? no-change-if-end-of-snip?)
+              
+              (if (has-flag? (snip->flags snip) NEWLINE)
+                  (begin
+                    (set! no-change-if-end-of-snip? (not checking-underflow?))
+                    (set-snip-flags! snip (remove-flag (snip->flags snip) NEWLINE))
+                    (set! checking-underflow-at-next? #t)
+                    (set! had-newline? #t)
+                    (set! deleted-a-newline? #t)
+                    ;; note: if the newline is restored, then
+                    ;; we leave the loop
+                    )
+                  (begin
+                    (set! no-change-if-end-of-snip? #f)
+                    (set! checking-underflow-at-next? #f)
+                    (set! had-newline? #f)))
+              
+              (let-boxes ([w 0.0])
+                  (send snip get-extent dc _total-width Y w #f #f #f #f #f)
+                (let ([_total-width (+ _total-width w)])
+                  (if (_total-width . > . maxw)
+                      (let ([_total-width (- _total-width w)])
+                        ;; get best breaking position:
+                        ;; (0.1 is hopefully a positive value smaller than any character)
+                        (let ([origc (do-find-position-in-snip dc _total-width Y snip (- maxw _total-width 0.1) #f)])
+                          ;; get legal breaking position before optimal:
+                          (let-boxes ([b (+ p origc 1)])
+                              (find-wordbreak b #f 'line)
+                            (let ([c (min (- b p) origc)])
+                              (let ([p
+                                     (if (c . <= . 0)
+                                         (cond
+                                          [(and (b . <= . startp) checking-underflow? (positive? origc))
+                                           ;; the word was currently force-broken; shift some part to here
+                                           (+ p origc)]
+                                          [(or (and checking-underflow?
+                                                    first-underflow?
+                                                    (or (b . <= . startp) (c . >= . 0)))
+                                               (and (not the-first-snip?)
+                                                    (or (zero? c)
+                                                        (and (zero? origc)
+                                                             (c . < . 0)
+                                                             (b . <= . startp)))))
+                                           ;; can't fit this snip in the line
+                                           (when (snip->prev snip)
+                                             (set-snip-flags! (snip->prev snip) (add-flag (snip->flags (snip->prev snip)) NEWLINE)))
+                                           (when (and had-newline? (snip->next snip))
+                                             (set-snip-flags! snip (add-flag (snip->flags snip) NEWLINE)))
+                                           (if (and no-change-if-start-of-snip?
+                                                    (or (not had-newline?)
+                                                        (snip->next snip)))
+                                               #f
+                                               (begin
+                                                (set! refresh-all? #t)
+                                                #t))]
+                                          [(and (c . < . 0) (b . > . startp))
+                                           ;; overflow, but previous wordbreak was before this snip
+                                           b]
+                                          [else
+                                           ;; overflow: we have to break the word anyway
+                                           (if (zero? origc)
+                                               (if (and (= (snip->count snip) 1)
+                                                        (snip->next snip)
+                                                        (has-flag? (snip->flags (snip->next snip)) NEWLINE))
+                                                   ;; don't insert a break before a real newline
+                                                   (done snip)
+                                                   (+ p 1))
+                                               (+ p origc))])
+                                         (+ p c))])
+                                (if (not (number? p))
+                                    p ;; the result
+                                    (begin
+                                      (make-snipset p p)
+                                      (let ([snip (find-snip p 'before)])
+                                        (when (snip->next snip)
+                                          (set-snip-flags! snip (add-flag (snip->flags snip) NEWLINE)))
+                                        (set! refresh-all? #t)
+                                        #t))))))))
+                      (begin
+                        (set! the-first-snip? #f)
+                        (set! first-underflow? #f)
+                        (loop (snip->next snip)
+                              (+ p (snip->count snip))
+                              _total-width))))))
+            (done snip)))))
+
+  (define/private (recalc-lines dc [calc-graphics? #t])
+    (when calc-graphics?
+      (when snip-cache-invalid?
+        (let loop ([snip snips])
+          (when snip
+            (send snip size-cache-invalid)
+            (loop (snip->next snip)))))
+
+      (let ([old-max-width max-width])
+        (when (and flow-invalid?
+                   (max-width . <= . 0))
+          (set! max-width A-VERY-BIG-NUMBER))
+
+        (when (or graphics-invalid?
+                  flow-invalid?
+                  snip-cache-invalid?)
+          ;; set all lines invalid
+          (let loop ([line first-line])
+            (when line
+              (mline-mark-recalculate line)
+              (when flow-invalid?
+                (mline-mark-check-flow line))
+              (loop (mline-next line)))))
+        
+        (let ([-changed?
+               (if (max-width . > . 0)
+                   (let ([wl? write-locked?]
+                         [fl? flow-locked?])
+                     ;; if any flow is updated, snip sizing methods will be called
+                     (set! write-locked? #t)
+                     (set! flow-locked? #t)
+                     
+                     (let ([w (- max-width CURSOR-WIDTH)])
+                       (let loop ([-changed? #f])
+                         (if (mline-update-flow (unbox line-root-box) line-root-box this w dc)
+                             (loop #t)
+                             
+                             (begin
+                               (set! flow-locked? fl?)
+                               (set! write-locked? wl?)
+                               -changed?)))))
+                   #f)])
+
+          (when (not (= max-width old-max-width))
+            (set! max-width old-max-width))
+
+          (when -changed?
+            (set! refresh-all? #t)
+            (set! first-line (mline-first (unbox line-root-box)))
+            (set! last-line (mline-last (unbox line-root-box)))
+            (set! num-valid-lines (mline-number (unbox line-root-box))))
+
+          (let ([-changed?
+                 (or (mline-update-graphics (unbox line-root-box) this dc)
+                     -changed?)])
+
+            (if (and (not -changed?)
+                     (not graphic-maybe-invalid-force?))
+                (begin
+                  (set! graphic-maybe-invalid? #f)
+                  (void))
+                (begin
+                  (set! graphic-maybe-invalid? #f)
+                  (set! graphic-maybe-invalid-force? #f)
+
+                  (let* ([Y (+ (mline-get-location last-line) (mline-h last-line))]
+                         [Y (if (has-flag? (snip->flags last-snip) NEWLINE)
+                                (begin
+                                  (set! extra-line? #t)
+                                  (set! extra-line-h (+ (mline-last-h last-line) line-spacing))
+                                  (+ Y extra-line-h))
+                                (begin
+                                  (set! extra-line? #f)
+                                  (set! extra-line-h 0)
+                                  Y))]
+                         [X (+ (mline-max-width (unbox line-root-box)) CURSOR-WIDTH)]
+                         [X (if (min-width . > . 0.0)
+                                (max X min-width)
+                                X)]
+                         [Y (if (min-height . > . 0.0)
+                                (max Y min-height)
+                                Y)]
+                         [Y (if (max-height . > . 0.0)
+                                (min Y max-height)
+                                Y)])
+                    (let ([descent (- (mline-h last-line) (mline-bottombase last-line))]
+                          [space (mline-topbase first-line)]
+                          [line-base (mline-bottombase first-line)])
+                      (let ([resized?
+                             (if (or (not (= total-height Y))
+                                     (not (= total-width X))
+                                     (not (= final-descent descent))
+                                     (not (= initial-space space))
+                                     (not (= line-base initial-line-base)))
+                                 (begin
+                                   (set! total-height Y)
+                                   (set! total-width X)
+                                   (set! final-descent descent)
+                                   (set! initial-space space)
+                                   (set! initial-line-base line-base)
+                                   #t)
+                                 #f)])
+
+                        (set! graphics-invalid? #f)
+                        (set! flow-invalid? #f)
+                        (set! snip-cache-invalid? #f)
+
+                        (set! draw-cached-in-bitmap? #f)
+
+                        (when (and resized? s-admin)
+                          (send s-admin resized #f))
+                        
+                        (on-reflow)))))))))))
+
+  (def/public (on-reflow) (void))
+
+  (def/public (set-autowrap-bitmap [(make-or-false bitmap%) bm])
+    (if flow-locked?
+        #f
+        (let ([old auto-wrap-bitmap]
+              [old-width wrap-bitmap-width])
+
+          (set! auto-wrap-bitmap bm)
+          (if auto-wrap-bitmap
+              (set! wrap-bitmap-width (send auto-wrap-bitmap get-width))
+              (set! wrap-bitmap-width 0))
+
+          (when (max-width . > . 0)
+            (set-max-width (+ max-width old-width)))
+
+          old)))
+
+  ;; ----------------------------------------
+
+  ;; notifies the administrator that we need to be redrawn
+  (define/private (redraw)
+
+    (unless (or flow-locked? (not s-admin))
+      (let-values ([(continue? notify?)
+                    (if (send s-admin delay-refresh?)
+                        ;; does the admin know the refresh box already?
+                        (if (and (not (= delayedscroll -1))
+                                 (not delayedscrollbox?)
+                                 (or refresh-all? refresh-unset?))
+                            ;; yes...
+                            (if (and (not refresh-all?) refresh-box-unset?)
+                                ;; nothing to do
+                                (values #f #f)
+                                (values #t #t))
+                            (values #t #t))
+                        (values #t #f))])
+        (when continue?
+          
+          (when notify?
+            (let-boxes ([x 0.0] [y 0.0] [w 0.0] [h 0.0])
+                (send s-admin get-max-view x y w h)
+              (let ([top y]
+                    [bottom (+ y h)]
+                    [left x]
+                    [right (+ x w)])
+                (let-values ([(left right top bottom)
+                              (if refresh-all?
+                                  (values left right top bottom)
+                                  (values
+                                   (max refresh-l left)
+                                   (min refresh-r right)
+                                   (max refresh-t top)
+                                   (min refresh-b bottom)))])
+                  (set! refresh-unset? #t)
+                  (set! refresh-box-unset? #t)
+                  (set! refresh-all? #f)
+                  (let ([height (- bottom top)]
+                        [width (- right left)])
+                    (when (and (width . > . 0) (height . > . 0))
+                      (send s-admin needs-update left top width height)))))))
+
+          (let-boxes ([dc #f]
+                      [x 0.0]
+                      [y 0.0])
+              (set-box! dc (send s-admin get-dc x y))
+            (if (not dc)
+                (begin
+                  (set! delayedscroll -1)
+                  (set! delayedscrollbox? #f))
+
+                (let ([origx x]
+                      [origy y])
+
+                  (recalc-lines dc) 
+
+                  (cond
+                   [(not (= delayedscroll -1))
+                    (scroll-to-position/refresh delayedscroll delayedscrollateol? #f
+                                                delayedscrollend delayedscrollbias)
+                    (set! refresh-all? #t)]
+                   [delayedscrollbox?
+                    (set! delayedscrollbox? #f)
+                    (when (do-scroll-to delayedscrollsnip delayedscroll-x delayedscroll-y
+                                        delayedscroll-w delayedscroll-h #f delayedscrollbias)
+                      (set! refresh-all? #t))])
+                  (let-boxes ([x 0.0]
+                              [y 0.0])
+                      (send s-admin get-dc x y)
+                    (when (or (not (= origx x)) (not (= origy y)))
+                      (set! refresh-all? #t)))
+                  
+                  (let-boxes ([x 0.0] [y 0.0] [w 0.0] [h 0.0])
+                      (send s-admin get-max-view x y w h)
+                    (let ([top y]
+                          [bottom (+ y h)]
+                          [left x]
+                          [right (+ x w)])
+
+                      ;; figure out the minimal refresh area; the refresh area may be
+                      ;; determined by character position ranges, box coordinates, or
+                      ;; both; if neither is specified, we have to assume that everything
+                      ;; needs to be refreshed
+                      (let-values ([(left top right bottom needs-update?)
+                                    (if (and (not refresh-all?)
+                                             (or (not refresh-unset?) (not refresh-box-unset?)))
+                                        (if (not refresh-unset?)
+                                            (let ([top (if (refresh-start . > . -1)
+                                                           (let-boxes ([fy 0.0])
+                                                               (position-location refresh-start #f fy #t #t #t)
+                                                             (max top fy))
+                                                           top)]
+                                                  [bottom (if (refresh-end . > . -1)
+                                                              (let-boxes ([fy 0.0])
+                                                                  (position-location refresh-end #f fy #f #f #t)
+                                                                (min bottom fy))
+                                                              bottom)])
+                                              (values left (if (not refresh-box-unset?)
+                                                               (min refresh-t top)
+                                                               top)
+                                                      right (if (not refresh-box-unset?)
+                                                                (max bottom refresh-b)
+                                                                bottom)
+                                                      #t))
+                                            (values (max refresh-l left)
+                                                    (max top refresh-t)
+                                                    (min right refresh-r)
+                                                    (min bottom refresh-b)
+                                                    #t))
+                                        (values left top right bottom refresh-all?))])
+                        
+                        (set! refresh-unset? #t)
+                        (set! refresh-box-unset? #t)
+                        (set! refresh-all? #f)
+
+                        (let ([height (- bottom top)]
+                              [width (- right left)])
+
+                          (when changed? 
+                            (set! changed? #f)
+                            (let ([wl? write-locked?]
+                                  [fl? flow-locked?])
+                              
+                              (set! write-locked? #t)
+                              (set! flow-locked? #t)
+                              (on-change)
+                              (set! write-locked? wl?)
+                              (set! flow-locked? fl?)))
+
+                          (when (and needs-update?
+                                     (width . > . 0)
+                                     (height . > . 0))
+                            (send s-admin needs-update left top width height)))))))))))))
+
+  (define/private (too-busy-to-refresh?)
+    (or graphic-maybe-invalid?
+        flow-locked?
+        (positive? delay-refresh)))
+
+  ;; called by the administrator to trigger a redraw
+  (def/override (refresh [real? left] [real? top] [nonnegative-real? width] [nonnegative-real? height]
+                         [(symbol-in no-caret show-inactive-caret show-caret) show-caret]
+                         [(make-or-false color%) bg-color])
+    (cond
+     [(or (width . <= . 0) (height . <= . 0)) (void)]
+     [(too-busy-to-refresh?)
+      ;; this refresh command was not requested by us and we're busy
+      ;; (probably in the middle of a begin-/end-edit-sequnce);
+      ;; add the given region to our own invalid-region tracking, and
+      ;; we'll get back to it when we're done with whatever
+      (refresh-box left top width height)]
+     [(not s-admin)
+      (void)]
+     [else
+      (let-boxes ([x 0.0]
+                  [y 0.0]
+                  [dc #f])
+          (set-box! dc (send s-admin get-dc x y))
+        (when dc
+          (begin-sequence-lock)
+
+          (let ([show-caret
+                 (if (and caret-blinked?
+                          (not (eq? show-caret 'no-caret))
+                          (not s-caret-snip))
+                     ;; maintain caret-blinked invariant
+                     'no-caret
+                     show-caret)])
+
+            (when (send s-offscreen ready-offscreen width height)
+              (set! draw-cached-in-bitmap? #f))
+
+            ;; make sure all location information is integral,
+            ;; so we can shift the coordinate system and generally
+            ;; update on pixel boundaries
+            (let ([x (->long (floor x))]
+                  [y (->long (floor y))]
+                  [bottom (->long (ceiling (+ top height)))]
+                  [right (->long (ceiling (+ left width)))]
+                  [top (->long (floor top))]
+                  [left (->long (floor left))])
+              (let ([width (- right left)]
+                    [height (- bottom top)]
+                    [ps? (or (dc . is-a? . post-script-dc%)
+                             (dc . is-a? . printer-dc%))]
+                    [show-xsel?
+                     (and ALLOW-X-STYLE-SELECTION?
+                          (or (not (eq? 'show-caret show-caret)) s-caret-snip)
+                          (eq? this editor-x-selection-owner)
+                          (not flash?)
+                          (not (= endpos startpos)))])
+
+                (if (and bg-color
+                         (not (send s-offscreen is-in-use?))
+                         (send s-offscreen get-bitmap)
+                         (send (send s-offscreen get-bitmap) ok?)
+                         (send (send s-offscreen get-dc) ok?)
+                         (not ps?))
+                    ;; draw to offscreen
+                    (let ([red (send bg-color red)]
+                          [green (send bg-color green)]
+                          [blue (send bg-color blue)])
+                      (send s-offscreen set-in-use #t)
+                      
+                      (when (or
+                             (not draw-cached-in-bitmap?)
+                             (not (eq? offscreen-key (send s-offscreen get-last-used)))
+                             (not (= last-draw-t top))
+                             (not (= last-draw-b bottom))
+                             (not (= last-draw-l left))
+                             (not (= last-draw-r right))
+                             (not (eq? show-caret last-draw-caret))
+                             (not (eq? show-xsel? last-draw-x-sel?))
+                             (not (= last-draw-red red))
+                             (not (= last-draw-green green))
+                             (not (= last-draw-blue blue)))
+                        
+                        (do-redraw (send s-offscreen get-dc) top bottom left right 
+                                   (- top) (- left) show-caret show-xsel? bg-color)
+                        
+                        (set! last-draw-l left)
+                        (set! last-draw-t top)
+                        (set! last-draw-r right)
+                        (set! last-draw-b bottom)
+                        (set! last-draw-caret show-caret)
+                        (set! last-draw-x-sel? show-xsel?)
+                        (set! last-draw-red red)
+                        (set! last-draw-green green)
+                        (set! last-draw-blue blue)
+                        (set! draw-cached-in-bitmap? #t))
+
+                      (send dc draw-bitmap-section 
+                            (send (send s-offscreen get-dc) get-bitmap) 
+                            (- left x) (- top y) 
+                            0 0 width height 'solid)
+                      
+                      (send s-offscreen set-last-used offscreen-key)
+                      (send s-offscreen set-in-use #f))
+                    
+                    ;; draw to given DC:
+                    (let ([pen (send dc get-pen)]
+                          [brush (send dc get-brush)]
+                          [font (send dc get-font)]
+                          [fg (make-object color% (send dc get-text-foreground))]
+                          [bg (make-object color% (send dc get-text-background))]
+                          [bgmode (send dc get-text-mode)]
+                          [rgn (send dc get-clipping-region)])
+
+                      (send dc set-clipping-rect (- left x) (- top y) width height)
+
+                      (do-redraw dc top bottom left right (- y) (- x) show-caret show-xsel? bg-color)
+
+                      (send dc set-clipping-region rgn)
+
+                      (send dc set-brush brush)
+                      (send dc set-pen pen)
+                      (send dc set-font font)
+                      (send dc set-text-foreground fg)
+                      (send dc set-text-background bg)
+                      (send dc set-text-mode bgmode))))))
+
+          (end-sequence-lock)))]))
+  
+  ;; performs the actual drawing operations
+  (define/private (do-redraw dc starty endy leftx rightx dy dx show-caret show-xsel? bg-color)
+    (let ([wl? write-locked?])
+
+      (set! flow-locked? #t)
+      (set! write-locked? #t)
+
+      (let-values ([(-startpos -endpos pos-at-eol?)
+                    (if flash?
+                        (values flashstartpos flashendpos flashposateol?)
+                        (values startpos endpos posateol?))])
+
+        (send dc set-text-mode 'solid)
+
+        (let ([line (mline-find-location (unbox line-root-box) starty)])
+
+          (when bg-color
+            (let ([lsave-pen (send dc get-pen)]
+                  [lsave-brush (send dc get-brush)])
+              (let ([wb (if (and (= 255 (send bg-color red))
+                                 (= 255 (send bg-color green))
+                                 (= 255 (send bg-color blue)))
+                            clear-brush
+                            (send the-brush-list find-or-create-brush bg-color 'solid))])
+                (send dc set-brush wb)
+                (send dc set-pen outline-pen)
+
+                (send dc draw-rectangle
+                      (+ leftx dx) (+ starty dy)
+                      (- rightx leftx) (- endy starty))
+
+                (send dc set-brush lsave-brush)
+                (send dc set-pen lsave-pen))))
+
+          (let* ([call-on-paint
+                  (lambda (pre?)
+                    (on-paint pre? dc leftx starty rightx endy dx dy
+                              (if (not s-caret-snip)
+                                  show-caret
+                                  'no-caret)))]
+                 [paint-done
+                  (lambda ()
+                    (call-on-paint #f)
+                    (set! write-locked? wl?)
+                    (set! flow-locked? #f))])
+
+            (call-on-paint #t)
+            
+            (when line
+              (let ([tleftx (+ leftx dx)]
+                    [tstarty (+ starty dy)]
+                    [trightx (+ rightx dx)]
+                    [tendy (+ endy dy)])
+                (let lloop ([line line]
+                            [old-style #f]
+                            [ycounter (mline-get-location line)]
+                            [pcounter (mline-get-position line)]
+                            [prevwasfirst 0.0])
+                  (cond
+                   [(not line)
+                    (send (send s-style-list basic-style) switch-to dc old-style)
+                    (when (and (eq? 'show-caret show-caret) (not s-caret-snip)
+                               extra-line?
+                               (not pos-at-eol?)
+                               (= len -startpos)
+                               (= -endpos -startpos)
+                               hilite-on?)
+                      (let ([y ycounter]
+                            [save-pen (send dc get-pen)])
+                        (send dc set-pen caret-pen)
+                        (send dc draw-line dx (+ y dy) dx (sub1 (+ y extra-line-h dy)))
+                        (send dc set-pen save-pen)))
+                    (paint-done)]
+                   [(ycounter . >= . endy)
+                    (paint-done)]
+                   [line
+                    (let ([first (mline-snip line)]
+                          [last (snip->next (mline-last-snip line))]
+                          [bottombase (+ ycounter (mline-bottombase line))]
+                          [topbase (+ ycounter (mline-topbase line))])
+                      (let-values ([(hilite-some? hsxs hsxe hsys hsye old-style)
+                                    (let sloop ([snip first]
+                                                [p pcounter]
+                                                [x (mline-get-left-location line max-width)]
+                                                [hilite-some? #f]
+                                                [hsxs 0.0]
+                                                [hsxe 0.0]
+                                                [hsys 0.0]
+                                                [hsye 0.0]
+                                                [old-style old-style])
+                                      (if (eq? snip last)
+                                          (values hilite-some? hsxs hsxe hsys hsye old-style)
+                                          (begin
+                                            (send (snip->style snip) switch-to dc old-style)
+                                            (let ([old-style (snip->style snip)])
+                                              (let-boxes ([w 0.0] [h 0.0] [descent 0.0] [space 0.0])
+                                                  (send snip get-extent dc x ycounter w h descent space #f #f)
+                                                (let* ([align (send (snip->style snip) get-alignment)]
+                                                       [down
+                                                        (cond
+                                                         [(eq? 'bottom align)
+                                                          (+ (- bottombase h) descent)]
+                                                         [(eq? 'top align)
+                                                          (- topbase space)]
+                                                         [else
+                                                          (- (/ (+ topbase bottombase) 2) 
+                                                             (/ (- h descent space) 2)
+                                                             space)])])
+
+                                                  (when (and (x . <= . rightx)
+                                                             ((+ x w) . >= . leftx))
+                                                    (send snip draw dc (+ x dx) (+ down dy)
+                                                          tleftx tstarty trightx tendy
+                                                          dx dy
+                                                          (if (eq? snip s-caret-snip)
+                                                              show-caret
+                                                              'no-caret)))
+
+                                                  ;; the rules for hiliting are surprisingly complicated:
+                                                  (let ([hilite? 
+                                                         (and
+                                                          hilite-on?
+                                                          (or show-xsel?
+                                                              (and (not s-caret-snip)
+                                                                   (or (eq? 'show-caret show-caret)
+                                                                       (and (show-caret . showcaret>= . s-inactive-caret-threshold)
+                                                                            (not (= -endpos -startpos))))))
+                                                          (if pos-at-eol?
+                                                              (= -startpos (+ p (snip->count snip)))
+                                                              (or (and (-startpos . < . (+ p (snip->count snip)))
+                                                                       (-endpos . >= . p)
+                                                                       (or (= -endpos -startpos) (-endpos . > . p)))
+                                                                  (and (= (+ p (snip->count snip)) len)
+                                                                       (= len -startpos))))
+                                                          (or (not (has-flag? (snip->flags snip) NEWLINE))
+                                                              ;; end of line:
+                                                              (or (not (= -startpos (+ p (snip->count snip))))
+                                                                  (and (= -endpos -startpos) pos-at-eol?)
+                                                                  (and (not (= -endpos -startpos)) 
+                                                                       (-startpos . < . (+ p (snip->count snip))))))
+                                                          (or (not (eq? snip first))
+                                                              ;; beginning of line:
+                                                              (or (not (= p -endpos))
+                                                                  (and (= -endpos -startpos) (not pos-at-eol?))
+                                                                  (and (not (= -endpos -startpos))
+                                                                       (-endpos . > . p)))))])
+                                                    
+                                                    (if hilite?
+                                                        (let*-values ([(bottom) (+ down h)]
+                                                                      [(hxs) (if (-startpos . <= . p)
+                                                                                 (if (-startpos . < . p)
+                                                                                     0
+                                                                                     x)
+                                                                                 (+ x (send snip partial-offset dc x ycounter
+                                                                                            (- -startpos p))))]
+                                                                      [(hxe bottom) (if (-endpos . >= . (+ p (snip->count snip)))
+                                                                                        (if (has-flag? (snip->flags snip) NEWLINE)
+                                                                                            (if (= -startpos -endpos)
+                                                                                                (values hxs bottom)
+                                                                                                (values rightx
+                                                                                                        (+ ycounter (mline-h line))))
+                                                                                            (values (+ x w) bottom))
+                                                                                        (values (+ x (send snip partial-offset dc x ycounter
+                                                                                                           (- -endpos p)))
+                                                                                                bottom))])
+                                                          
+                                                          (let-values ([(hsxs hsxe hsys hsye)
+                                                                        (if (not hilite-some?)
+                                                                            (values hxs hxe down bottom)
+                                                                            (values hsxs hxe (min down hsys) (max hsye bottom)))])
+                                                            (sloop (snip->next snip)
+                                                                   (+ p (snip->count snip))
+                                                                   (+ x w)
+                                                                   #t hsxs hsxe hsys hsye
+                                                                   old-style)))
+                                                        (sloop (snip->next snip)
+                                                               (+ p (snip->count snip))
+                                                               (+ x w)
+                                                               hilite-some? hsxs hsxe hsys hsye
+                                                               old-style)))))))))])
+                        (when (and (positive? wrap-bitmap-width)
+                                   (not (has-flag? (snip->flags (mline-last-snip line)) HARD-NEWLINE))
+                                   last
+                                   (rightx . >= . max-width)
+                                   (send auto-wrap-bitmap ok?))
+                          (let ([h (min (->long (send auto-wrap-bitmap get-height))
+                                        (mline-bottombase line))]
+                                [osfg (send old-style get-foreground)])
+                            (send dc draw-bitmap-section
+                                  auto-wrap-bitmap 
+                                  (sub1 (+ max-width dx)) (+ (- bottombase h) dy)
+                                  0 0 wrap-bitmap-width h
+                                  'solid osfg)))
+
+                        (let ([prevwasfirst
+                               (if hilite-some?
+                                   (if (not (= hsxs hsxe))
+                                       (if (and (hsxs . <= . rightx) (hsxe . >= . leftx))
+                                           (let ([save-pen (send dc get-pen)]
+                                                 [hxsx (max hsxs leftx)]
+                                                 [hsxe (min hsxe rightx)])
+                                             (begin0
+                                              (if (and (not show-xsel?)
+                                                       (not (showcaret>= show-caret 'show-caret)))
+                                                  (if show-outline-for-inactive?
+                                                      (let ([first-hilite? (-startpos . >= . pcounter)]
+                                                            [last-hilite? (-endpos . <= . (+ pcounter (mline-len line)))])
+                                                        (send dc set-pen outline-inactive-pen)
+                                                        (let ([prevwasfirst
+                                                               (cond
+                                                                [first-hilite?
+                                                                 (send dc draw-line (+ hsxs dx) (+ hsys dy) (+ hsxe (sub1 dx)) (+ hsys dy))
+                                                                 hsxs]
+                                                                [(positive? prevwasfirst)
+                                                                 (send dc draw-line dx (+ hsys dy) (+ prevwasfirst dx) (+ hsys dy))
+                                                                 0.0]
+                                                                [else 0.0])])
+                                                          (send dc draw-line (+ hsxs dx) (+ hsys dy) (+ hsxs dx) (+ hsye (sub1 dy)))
+                                                          (send dc draw-line (+ hsxe (sub1 dx)) (+ hsys dy) 
+                                                                (+ hsxe (sub1 dx)) (+ hsye (sub1 dy)))
+                                                          (when last-hilite?
+                                                            (send dc draw-line (+ hsxs dx) (+ hsye dy) (+ hsxe (sub1 dx)) (+ hsye dy)))
+                                                          (when (not first-hilite?)
+                                                            (send dc draw-line (+ hsxe dx) (+ hsys dy) (+ rightx dx) (+ hsys dy)))
+                                                          prevwasfirst))
+                                                      prevwasfirst)
+                                                  (let ([save-brush (send dc get-brush)])
+                                                    (send dc set-pen outline-pen)
+                                                    (send dc set-brush outline-brush)
+                                                    
+                                                    (send dc draw-rectangle (+ hsxs dx) (+ hsys dy) 
+                                                          (max 0.0 (- hsxe hsxs)) (max 0.0 (- hsye hsys)))
+                                                    (when ALLOW-X-STYLE-SELECTION?
+                                                      (when show-xsel?
+                                                        (send dc set-brush outline-nonowner-brush)
+                                                        (send dc draw-rectangle (+ hsxs dx) (+ hsys dy) 
+                                                              (max 0.0 (- hsxe hsxs)) (max 0.0 (- hsye hsys)))))
+                                                    (send dc set-brush save-brush)
+                                                    prevwasfirst))
+                                              (send dc set-pen save-pen)))
+                                           prevwasfirst)
+                                       (begin
+                                         (when (eq? 'show-caret show-caret)
+                                           (when (and (hsxs . <= . rightx) (hsxs . >= . leftx))
+                                             (let ([save-pen (send dc get-pen)])
+                                               (send dc set-pen caret-pen)
+                                               (send dc draw-line (+ hsxs dx) (+ hsys dy) 
+                                                     (+ hsxs dx) 
+                                                     (+ hsye (sub1 dy)))
+                                               (send dc set-pen save-pen))))
+                                         prevwasfirst))
+                                   prevwasfirst)])
+                          (lloop (mline-next line)
+                                 old-style
+                                 (+ ycounter (mline-h line))
+                                 (+ pcounter (mline-len line))
+                                 prevwasfirst))))])))))))))
+
+  ;; ----------------------------------------
+
+  ;; used internally to delay refreshes:
+  (define/private (need-refresh start [end -1])
+    (if refresh-unset?
+        (begin
+          (set! refresh-start start)
+          (set! refresh-end end)
+          (set! refresh-unset? #f))
+        (begin
+          (set! refresh-start (min start refresh-start))
+          (cond
+           [(= end -1)
+            (set! refresh-end -1)]
+           [(= refresh-end -1)
+            (void)]
+           [else (set! refresh-end (max end refresh-end))])))
+
+    (set! draw-cached-in-bitmap? #f)
+    
+    (continue-refresh))
+
+  (define/private (refresh-by-line-demand)
+    (set! graphic-maybe-invalid? #t)
+    (continue-refresh))
+
+  (define/private (continue-refresh)
+    (if (and (zero? delay-refresh)
+             (not (super is-printing?))
+             (or (not s-admin) (not (send s-admin delay-refresh?))))
+        (redraw)
+        (begin
+          (when (and (zero? delay-refresh)
+                     (or (= delayedscroll -1) 
+                         delayedscrollbox?))
+            (if (and (not (super is-printing?)) s-admin)
+                ;; although the administrator says to delay,
+                ;; we can't just drop scroll requests
+                (redraw)
+                (begin
+                  (set! delayedscroll -1)
+                  (set! delayedscrollbox? #f))))
+          (when (and s-admin (zero? (send s-admin get-s-standard)))
+            (send s-admin resized #f)))))
+
+  (define/private (need-caret-refresh)
+    (need-refresh startpos endpos))
+
+  ;; ----------------------------------------
+
+  (define/override (own-x-selection on? update? force?)
+    (and (do-own-x-selection on? force?)
+         (begin
+           (when update?
+             (need-caret-refresh))
+           #t)))
+
+  ;; ----------------------------------------
+
+  (def/public (set-paragraph-margins [exact-nonnegative-integer? i]
+                                     [nonnegative-real? first-left]
+                                     [nonnegative-real? left]
+                                     [nonnegative-real? right])
+    (let ([l (mline-find-paragraph (unbox line-root-box) i)])
+      (when l
+        (let ([p (mline-clone-paragraph (mline-paragraph l))])
+          (set-mline-paragraph! l p)
+
+          (set-paragraph-left-margin-first! p first-left)
+          (set-paragraph-left-margin! p left)
+          (set-paragraph-right-margin! p right)
+
+          (if (max-width . > . 0)
+              (begin
+                (mline-mark-check-flow l)
+                (let loop ([l (mline-next l)])
+                  (when (and l
+                             (zero? (mline-starts-paragraph l)))
+                    (mline-mark-check-flow l)
+                    (loop (mline-next l)))))
+              (need-refresh (paragraph-start-position i) (paragraph-end-position i)))
+
+          (refresh-by-line-demand)))))
+  
+  (def/public (set-paragraph-alignment [exact-nonnegative-integer? i] [(symbol-in left center right) align])
+    (let ([l (mline-find-paragraph (unbox line-root-box) i)])
+      (when l
+        (let ([p (mline-clone-paragraph (mline-paragraph l))])
+          (set-mline-paragraph! l p)
+          
+          (set-paragraph-alignment! p align)
+
+          (need-refresh (paragraph-start-position i) (paragraph-end-position i))
+
+          (refresh-by-line-demand)))))
+
+  ;; ----------------------------------------
+
+  (def/override (is-printing?) (super is-printing?))
+
+  (define/override (do-begin-print dc fit?)
+    (if flow-locked?
+        #f
+        (begin
+          (check-recalc)
+          (size-cache-invalid)
+
+          (let ([save-info (if fit?
+                               (cons (get-max-width)
+                                     (set-autowrap-bitmap #f))
+                               #f)])
+            (when fit?
+              (let-values ([(w h) (send dc get-size)])
+                (let-boxes ([hm 0]
+                            [vm 0])
+                    (send (current-ps-setup) get-editor-margin hm vm)
+                  (set-max-width (- w (* 2 hm))))))
+
+            (recalc-lines dc #t)
+
+            (let ([wl? write-locked?]
+                  [fl? flow-locked?])
+              (set! write-locked? #t)
+              (set! flow-locked? #t)
+              (on-change)
+              (set! write-locked? wl?)
+              (set! flow-locked? fl?))
+
+            save-info))))
+
+  (define/override (do-end-print dc data)
+    (unless flow-locked?
+      (size-cache-invalid)
+
+      (when data
+        (set-max-width (car data))
+        (set-autowrap-bitmap (cdr data)))
+
+      (let ([wl? write-locked?]
+            [fl? flow-locked?])
+        (set! write-locked? #t)
+        (set! flow-locked? #t)
+        (on-change)
+        (set! write-locked? wl?)
+        (set! flow-locked? fl?))))
+
+  (define/private (has/print-page dc page print?)
+    (if flow-locked?
+        #f
+        (begin
+          (recalc-lines dc #t)
+          (let-values ([(W H) (send dc get-size)])
+            (let-boxes ([W W]
+                        [H H]
+                        [hm 0]
+                        [vm 0])
+              (begin
+                (when (or (zero? (unbox W)) (zero? (unbox H)))
+                  (get-default-print-size W H))
+                (send (current-ps-setup) get-editor-margin hm vm))
+            (let ([H (- H (* 2 vm))]
+                  [W (- W (* 2 hm))])
+
+              ;; H is the total page height;
+              ;; line is the line that we haven't finished printing;
+              ;; y is the starting location to print for this page;
+              ;; h is the height that we're hoping to fit into the page
+              ;; i is the line number
+              (let ploop ([this-page 1]
+                          [line first-line]
+                          [y 0.0]
+                          [next-h 0.0]
+                          [i 0])
+                (and 
+                 line
+                 (let ([h next-h]
+                       [next-h 0.0])
+                   (let loop ([h h]
+                              [i i]
+                              [line line])
+                     (if (or (zero? h)
+                             (and (i . < . num-valid-lines)
+                                  ((mline-h line) . < . (- H h))))
+                         (loop (+ h (mline-h line))
+                               (add1 i)
+                               (mline-next line))
+                         (let-values ([(h i line)
+                                       (if (and (h . < . H)
+                                                (i . < . num-valid-lines)
+                                                ((mline-h line) . > . H))
+                                           ;; we'll have to break it up anyway; start now?
+                                           (let* ([pos (find-scroll-line (+ y H))]
+                                                  [py (scroll-line-location pos)])
+                                             (if (py . > . (+ y h))
+                                                 ;; yes, at least one line will fit
+                                                 (values (+ h (mline-h line))
+                                                         (add1 i)
+                                                         (mline-next line))
+                                                 (values h i line)))
+                                           (values h i line))])
+                           (let-values ([(next-h h)
+                                         (if (h . > . H)
+                                             ;; only happens if we have something that's too big to fit on a page;
+                                             ;; look for internal scroll positions
+                                             (let* ([pos (find-scroll-line (+ y H))]
+                                                    [py (scroll-line-location pos)])
+                                               (if (py . > . y)
+                                                   (let ([new-h (- py y)])
+                                                     (values (- h new-h)
+                                                             new-h))
+                                                   (values next-h h)))
+                                             (values next-h h))])
+                             (or (if print?
+                                     (begin
+                                       (when (or (negative? page) (= this-page page))
+                                         (begin
+                                           (when (negative? page)
+                                             (send dc start-page))
+                                           (do-redraw dc 
+                                                      (+ y (if (zero? i) 0 1))
+                                                      (+ y (- h 1))
+                                                      0 W (+ (- y) vm) hm
+                                                      'no-caret #f #f)
+                                           (when (negative? page)
+                                             (send dc end-page))))
+                                       #f)
+                                     (= this-page page))
+                                 (ploop (add1 this-page)
+                                        line
+                                        (+ y h)
+                                        next-h 
+                                        i)))))))))))))))
+
+  (define/override (do-has-print-page? dc page)
+    (has/print-page dc page #f))
+
+  (def/override (print-to-dc [dc<%> dc] [exact-integer? [page -1]])
+    (has/print-page dc page #t)
+    (void)))
+
+(set-text%! text%)
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define/top (add-text-keymap-functions [keymap% tab])
+  (let ([add (lambda (n f)
+               (send tab add-function n
+                     (lambda (e evt)
+                       (if (e . is-a? . text%)
+                           (begin (f e evt) #t)
+                           #f))))])
+    (add "forward-character" (lambda (t evt) (send t move-position 'right)))
+    (add "backward-character" (lambda (t evt) (send t move-position 'left)))
+    (add "previous-line" (lambda (t evt) (send t move-position 'up)))
+    (add "next-line" (lambda (t evt) (send t move-position 'down)))
+    (add "previous-page" (lambda (t evt) (send t move-position 'up #f 'page)))
+    (add "next-page" (lambda (t evt) (send t move-position 'down #f 'page)))
+    (add "forward-word" (lambda (t evt) (send t move-position 'right #f 'word)))
+    (add "backward-word" (lambda (t evt) (send t move-position 'left #f 'word)))
+
+    (add "forward-select" (lambda (t evt) (send t move-position 'right #t)))
+    (add "backward-select" (lambda (t evt) (send t move-position 'left #t)))
+    (add "select-down" (lambda (t evt) (send t move-position 'down #t)))
+    (add "select-up" (lambda (t evt) (send t move-position 'up #t)))
+    (add "select-page-up" (lambda (t evt) (send t move-position 'up #t 'page)))
+    (add "select-page-down" (lambda (t evt) (send t move-position 'down #t 'page)))
+    (add "forward-select-word" (lambda (t evt) (send t move-position 'right #t 'word)))
+    (add "backward-select-word" (lambda (t evt) (send t move-position 'left #t 'word)))
+
+    (add "beginning-of-file" (lambda (t evt) (send t move-position 'home)))
+    (add "end-of-file" (lambda (t evt) (send t move-position 'end)))
+    (add "beginning-of-line" (lambda (t evt) (send t move-position 'left #f 'line)))
+    (add "end-of-line" (lambda (t evt) (send t move-position 'right #f 'line)))
+
+    (add "select-to-beginning-of-file" (lambda (t evt) (send t move-position 'home #t)))
+    (add "select-to-end-of-file" (lambda (t evt) (send t move-position 'end #t)))
+    (add "select-to-beginning-of-line" (lambda (t evt) (send t move-position 'left #t 'line)))
+    (add "select-to-end-of-line" (lambda (t evt) (send t move-position 'right #t 'line)))
+
+    (add "delete-previous-character" (lambda (t evt) (send t delete)))
+    (add "delete-next-character" (lambda (t evt)
+                                   (let-boxes ([s 0]
+                                               [e 0])
+                                       (send t get-position s e)
+                                     (if (not (= s e))
+                                         (send t delete)
+                                         (send t delete s (+ s 1))))))
+    
+    (add "clear-buffer" (lambda (t evt) (send t erase)))
+    (add "delete-next-word" (lambda (t evt)
+                              (send t begin-edit-sequence)
+                              (send t move-position 'right #t 'word)
+                              (send t delete)
+                              (send t end-edit-sequence)))
+    (add "delete-previous-word" (lambda (t evt)
+                                  (send t begin-edit-sequence)
+                                  (send t move-position 'left #t 'word)
+                                  (send t delete)
+                                  (send t end-edit-sequence)))
+    (add "delete-line" (lambda (t evt)
+                         (send t begin-edit-sequence)
+                         (send t move-position 'left #f 'line)
+                         (send t move-position 'right #t 'line)
+                         (send t delete)
+                         (send t end-edit-sequence)))
+
+    (add "paste-next" (lambda (t evt) (send t paste-next)))
+
+    (add-editor-keymap-functions tab)))
diff --git a/collects/mred/private/wxme/undo.ss b/collects/mred/private/wxme/undo.ss
new file mode 100644
index 00000000..15f44fbd
--- /dev/null
+++ b/collects/mred/private/wxme/undo.ss
@@ -0,0 +1,307 @@
+#lang scheme/base
+(require scheme/class
+         "private.ss"
+         "snip.ss"
+         "snip-flags.ss")
+
+(provide proc-record%
+         unmodify-record%
+         insert-record%
+         insert-snip-record%
+         delete-record%
+         delete-snip-record%
+         style-change-record%
+         style-change-snip-record%
+         move-snip-record%
+         resize-snip-record%
+         composite-record%)
+
+(define (disown snip)
+  (when (has-flag? (snip->flags snip) OWNED)
+    (send snip set-s-flags (remove-flag (snip->flags snip) OWNED))))
+
+(define change-record%
+  (class object%
+    (super-new)
+    (define/public (cancel) (void))
+    (define/public (undo editor) #f)
+    (define/public (drop-set-unmodified) (void))
+    (define/public (is-composite?) #f)
+    (define/public (get-id) #f)
+    (define/public (get-parity) 0)
+    (define/public (inverse) #f)))
+
+(define proc-record%
+  (class change-record%
+    (init-field proc)
+    (super-new)
+    
+    (define/override (undo editor)
+      (proc))))
+
+(define unmodify-record%
+  (class change-record%
+    (init-field cont?)
+    (define ok? #t)
+    (super-new)
+
+    (define/override (undo editor)
+      (when ok?
+        (send editor set-modified #f))
+      cont?)
+
+    (define/override (drop-set-unmodified)
+      (set! ok? #f))))
+
+(define insert-record%
+  (class change-record%
+    (init-field start)
+    (init       length)
+    (init-field cont?
+                startsel
+                endsel)
+    (define end (+ start length))
+    (super-new)
+
+    (define/override (undo editor)
+      (send editor delete start end)
+      (send editor set-position startsel endsel)
+      cont?)))
+
+(define insert-snip-record%
+  (class change-record%
+    (init-field snip 
+                cont?)
+    (super-new)
+    
+    (define/override (undo editor)
+      (send editor delete snip)
+      (unless cont?
+        (send editor set-selected snip))
+      cont?)))
+
+(define-struct delete-snip-item (snip before x y))
+
+(define delete-snip-record%
+  (class change-record%
+    (init-field cont?)
+    (define deletions null)
+    (define undid? #f)
+    (super-new)
+
+    (define/public (insert-snip snip before x y)
+      (set! deletions (cons (make-delete-snip-item snip before x y)
+                            deletions)))
+
+    (define/override (cancel)
+      (unless undid?
+        (for-each (lambda (i)
+                    (let ([snip (delete-snip-item-snip i)])
+                      (disown snip)
+                      (send snip set-admin #f)))
+                  deletions)))
+
+    (define/override (undo editor)
+      (unless cont?
+        (send editor no-selected))
+
+      (for-each 
+       (lambda (del)
+         (let ([snip (delete-snip-item-snip del)])
+           ;; have to turn off the owned flag; we know that it's really ours
+           (disown snip)
+           
+           (send editor insert snip 
+                 (delete-snip-item-before del)
+                 (delete-snip-item-x del)
+                 (delete-snip-item-y del))
+
+           (unless cont?
+             (send editor add-selected snip))))
+       deletions)
+      
+      (set! undid? #t)
+
+      cont?)))
+
+(define delete-record% 
+  (class change-record% 
+    (init-field start
+                end
+                cont?
+                startsel
+                endsel)
+    (define deletions null)
+    (define clickbacks null)
+    (define undid? #f)
+    (super-new)
+
+    (define/public (insert-snip snip)
+      (set! deletions (cons snip deletions)))
+
+    (define/public (add-clickback click)
+      (set! clickbacks (cons click clickbacks)))
+
+    (define/override (cancel)
+      (unless undid?
+        (for-each (lambda (snip)
+                    (disown snip)
+                    (send snip set-admin #f))
+                  deletions)))
+
+    (define/override (undo editor)
+      ;; have to turn off the owned flag; we know that it's really ours
+      (for-each disown deletions)
+      (send editor do-insert-snips deletions start)
+      (for-each (lambda (cb)
+                  (send editor set-clickback cb))
+                clickbacks)
+
+      (send editor set-position startsel endsel)
+
+      (set! undid? #t)
+
+      cont?)))
+
+(define style-change-record%
+  (class change-record% 
+    (init-field start
+                end
+                cont?
+                startsel
+                endsel
+                restore-selection?)
+    (define changes null)
+    (super-new)
+
+    (define/public (add-style-change start end style)
+      (set! changes (cons (vector start end style)
+                          changes)))
+
+    (define/override (undo editor)
+      (for-each (lambda (c)
+                  (send editor change-style
+                        (vector-ref c 2)
+                        (vector-ref c 0)
+                        (vector-ref c 1)))
+                (reverse changes))
+      
+      (when restore-selection?
+        (send editor set-position startsel endsel))
+      
+      cont?)))
+
+(define style-change-snip-record%
+  (class change-record%
+    (init-field cont?)
+    (define changes null)
+    (super-new)
+
+    (define/public (add-style-change snip style)
+      (set! changes (cons (cons snip style) changes)))
+
+    (define/override (undo editor)
+      (unless cont?
+        (send editor no-selected))
+      
+      (for-each (lambda (s)
+                  (send editor change-style (cdr s) (cdr s))
+                  (unless cont?
+                    (send editor add-selected (car s))))
+                (reverse changes))
+
+      cont?)))
+
+(define move-snip-record%
+  (class change-record%
+    (init-field snip
+                x
+                y
+                delta?
+                cont?)
+    (super-new)
+
+    (define/override (undo editor)
+      (if delta?
+          (send editor move snip x y)
+          (send editor move-to snip x y))
+      cont?)))
+
+(define resize-snip-record%
+  (class change-record%
+    (init-field snip
+                x
+                y
+                cont?)
+    (super-new)
+
+    (define/override (undo editor)
+      (send editor resize snip x y)
+      cont?)))
+
+(define composite-record%
+  (class change-record%
+    (init       count)
+    (init-field id
+                parity?)
+    (unless id
+      (set! id (if parity?
+                   (cons this #f)
+                   (cons #f this))))
+    (define seq (make-vector count))
+    (super-new)
+
+    (define/override (cancel)
+      (for ([c (in-vector seq)])
+        (send c cancel)))
+
+    (define/override (undo editor)
+      (for ([c (in-vector seq)])
+        (send c undo))
+      #f)
+
+    (define/override (drop-set-unmodified)
+      (for ([c (in-vector seq)])
+        (send c drop-set-unmodified)))
+
+    (define/public (add-undo pos c)
+      (vector-set! seq (- (vector-length seq) pos 1) c))
+
+    (define/override (is-composite?) #t)
+
+    (define/override (get-id) id)
+
+    (define/override (get-parity) parity?)
+
+    (define/override (inverse)
+      (make-object inverse-record% id (not parity?)))))
+
+
+(define inverse-record%
+  (class change-record%
+    (init-field id
+                parity?)
+
+    (define/private (get)
+      (if parity?
+          (car id)
+          (cdr id)))
+
+    (define/override (cancel)
+      ;; Avoid double-frees by not doing anything
+      (void))
+
+    (define/override (undo editor)
+      (send (get) undo editor))
+
+    (define/override (drop-set-unmodified)
+      (let ([c (get)])
+        (when c
+          (send c drop-set-unmodified))))
+
+    (define/override (get-id) id)
+
+    (define/override (get-parity) parity?)
+
+    (define/override (inverse)
+      (send (get) inverse))))
diff --git a/collects/mred/private/wxme/wordbreak.ss b/collects/mred/private/wxme/wordbreak.ss
new file mode 100644
index 00000000..03b428c9
--- /dev/null
+++ b/collects/mred/private/wxme/wordbreak.ss
@@ -0,0 +1,151 @@
+#lang scheme/base
+(require scheme/class
+         "../syntax.ss"
+         "cycle.ss")
+
+(provide editor-wordbreak-map%
+         the-editor-wordbreak-map
+         standard-wordbreak)
+
+(defclass editor-wordbreak-map% object%
+  (define char-map (make-hash))
+
+  (super-new)
+
+  (hash-set! char-map #\- '(line))
+
+  (def/public (set-map [char? ch] [(make-list (symbol-in caret line selection user1 user2)) mask])
+    (hash-set! char-map ch mask))
+
+  (def/public (get-map [char? ch])
+    (or (hash-ref char-map ch #f)
+        (cond
+         [(or (char-alphabetic? ch)
+              (char-numeric? ch))
+          '(caret line selection)]
+         [(not (char-whitespace? ch))
+          '(line)]
+         [else null]))))
+
+(define the-editor-wordbreak-map (new editor-wordbreak-map%))
+
+(define MAX-DIST-TRY 30)
+
+(define wb-get-map (generic editor-wordbreak-map% get-map))
+
+(define (string-ref* str n)
+  (if (n . >= . (string-length str))
+      #\nul
+      (string-ref str n)))
+
+(define/top (standard-wordbreak [text% win] 
+                                [(make-or-false (make-box exact-nonnegative-integer?)) startp]
+                                [(make-or-false (make-box exact-nonnegative-integer?)) endp]
+                                [(symbol-in caret line selection user1 user2)reason])
+  (with-method ([get-map ((send win get-wordbreak-map) get-map)])
+    (define (nonbreak? ch) (memq reason (get-map ch)))
+
+    (when startp
+      (let* ([start (unbox startp)]
+             [pstart start]
+             [lstart (send win find-newline 'backward start 0)]
+             [lstart (if lstart
+                         (if (eq? 'caret reason)
+                             (or (and (positive? lstart)
+                                      (send win find-newline 'backward (sub1 lstart) 0))
+                                 0)
+                             lstart)
+                         0)]
+             [lend (min (+ start 1) (send win last-position))]
+             [tstart (if ((- start lstart) . > . MAX-DIST-TRY)
+                         (- start MAX-DIST-TRY)
+                         lstart)]
+             [text (send win get-text tstart lend)]
+             [start (- start tstart)]
+             [pstart (- pstart tstart)])
+
+        (let ploop ([phase1-complete? #f]
+                    [phase2-complete? #f]
+                    [start start]
+                    [pstart pstart]
+                    [text text]
+                    [tstart tstart])
+          (let*-values ([(start phase1-complete?)
+                         (if phase1-complete?
+                             (values start #t)
+                             (let ([start (if (and (positive? start)
+                                                   (nonbreak? (string-ref* text start)))
+                                              (sub1 start)
+                                              start)])
+                               (values start
+                                       (not (nonbreak? (string-ref* text start))))))]
+                        [(start phase2-complete?)
+                         (if (not (eq? 'selection reason))
+                             (if (not phase2-complete?)
+                                 (let loop ([start start])
+                                   (if (and (positive? start)
+                                            (not (nonbreak? (string-ref* text start))))
+                                       (loop (sub1 start))
+                                       (if (nonbreak? (string-ref* text start))
+                                           (values start #t)
+                                           (values start #f))))
+                                 (values start #t))
+                             (values start phase2-complete?))])
+            (let loop ([start start])
+              (if (and (positive? start)
+                       (nonbreak? (string-ref* text start)))
+                  (loop (sub1 start))
+                  (let ([start (if (and (start . < . pstart)
+                                        (not (nonbreak? (string-ref* text start))))
+                                   (add1 start)
+                                   start)])
+                    (if (and (zero? start)
+                             (not (= lstart tstart)))
+                        (ploop phase1-complete?
+                               phase2-complete?
+                               (+ start (- tstart lstart))
+                               (+ pstart (- tstart lstart))
+                               (send win get-text lstart lend)
+                               lstart)
+                        (set-box! startp (+ start tstart))))))))))
+    
+    (when endp
+      (let* ([end (unbox endp)]
+             [lstart end]
+             [lend (send win find-newline 'forward end)]
+             [lend (if lend
+                       (if (eq? 'caret reason)
+                           (or (send win find-newline 'forward (+ lend 1))
+                               (send win last-position))
+                           lend)
+                       (send win last-position))]
+             [tend (if ((- lend end) . > . MAX-DIST-TRY)
+                       (+ end MAX-DIST-TRY)
+                       lend)]
+             [text (send win get-text lstart tend)]
+             [end (- end lstart)]
+             [lend (- lend lstart)]
+             [tend (- tend lstart)])
+        
+        (let ploop ([phase1-complete? #f]
+                    [text text]
+                    [tend tend])
+          (let-values ([(end phase1-complete?)
+                        (if phase1-complete?
+                            (values end #t)
+                            (let loop ([end end])
+                              (if (and (end . < . tend) 
+                                       (not (nonbreak? (string-ref* text end))))
+                                  (loop (add1 end))
+                                  (if (end . < . tend)
+                                      (values end #t)
+                                      (values end #f)))))])
+            (let loop ([end end])
+              (if (and (end . < . tend)
+                       (nonbreak? (string-ref* text end)))
+                  (loop (add1 end))
+                  (if (and (= tend end) (not (= lend tend)))
+                      (ploop phase1-complete?
+                             (send win get-text lstart (+ lstart lend))
+                             lend)
+                      (set-box! endp (+ end lstart)))))))))))
diff --git a/collects/mred/private/wxme/wx.ss b/collects/mred/private/wxme/wx.ss
new file mode 100644
index 00000000..a50d9a08
--- /dev/null
+++ b/collects/mred/private/wxme/wx.ss
@@ -0,0 +1,63 @@
+#lang scheme/base
+(require "../kernel.ss")
+
+(define the-clipboard (get-the-clipboard))
+(define the-x-selection-clipboard (get-the-x-selection))
+(define the-brush-list (get-the-brush-list))
+(define the-pen-list (get-the-pen-list))
+(define the-font-list (get-the-font-list))
+(define the-color-database (get-the-color-database))
+(define the-font-name-directory (get-the-font-name-directory))
+
+(define (family-symbol? s)
+  (memq s '(default decorative roman script
+             swiss modern symbol system)))
+(define (style-symbol? s)
+  (memq s '(normal italic slant)))
+(define (weight-symbol? s)
+  (memq s '(normal bold light)))
+(define (smoothing-symbol? s)
+  (memq s '(default smoothed unsmoothed partly-smoothed)))
+(define (size? v) (and (exact-positive-integer? v)
+                       (byte? v)))
+
+(provide event%
+         mouse-event%
+         key-event%
+         timer%
+         canvas%
+         bitmap-dc%
+         color%
+         the-color-database
+         pen%
+         the-pen-list
+         brush%
+         the-brush-list
+         font%
+         the-font-list
+         the-font-name-directory
+         cursor%
+         bitmap%
+         dc<%>
+         post-script-dc%
+         printer-dc%
+         current-eventspace
+         clipboard-client%
+         clipboard<%>
+         the-clipboard
+         the-x-selection-clipboard
+         get-double-click-threshold
+         begin-refresh-sequence
+         end-refresh-sequence
+         begin-busy-cursor
+         end-busy-cursor
+         hide-cursor
+         run-printout
+         current-ps-setup
+         family-symbol?
+         style-symbol?
+         weight-symbol?
+         smoothing-symbol?)
+
+(define (get-double-click-threshold)
+  (get-double-click-time))
diff --git a/collects/mred/private/wxmenu.ss b/collects/mred/private/wxmenu.ss
index 91c34e9a..d0a00ff5 100644
--- a/collects/mred/private/wxmenu.ss
+++ b/collects/mred/private/wxmenu.ss
@@ -3,6 +3,7 @@
 	   mzlib/class100
 	   mzlib/list
 	   (prefix wx: "kernel.ss")
+           (prefix wx: "wxme/keymap.ss")
 	   "lock.ss"
 	   "const.ss"
 	   "helper.ss"
diff --git a/collects/mred/private/wxtextfield.ss b/collects/mred/private/wxtextfield.ss
index 4ecd8030..f17688bb 100644
--- a/collects/mred/private/wxtextfield.ss
+++ b/collects/mred/private/wxtextfield.ss
@@ -2,6 +2,8 @@
   (require mzlib/class
 	   mzlib/class100
 	   (prefix wx: "kernel.ss")
+           (prefix wx: "wxme/text.ss")
+           (prefix wx: "wxme/editor-canvas.ss")
 	   "lock.ss"
 	   "const.ss"
 	   "check.ss"
diff --git a/collects/mred/private/wxtop.ss b/collects/mred/private/wxtop.ss
index ada1f634..da720d36 100644
--- a/collects/mred/private/wxtop.ss
+++ b/collects/mred/private/wxtop.ss
@@ -4,6 +4,8 @@
 	   mzlib/etc
 	   mzlib/list
 	   (prefix wx: "kernel.ss")
+           (prefix wx: "wxme/editor-canvas.ss")
+           (prefix wx: "wxme/editor-snip.ss")
 	   "lock.ss"
 	   "helper.ss"
 	   "const.ss"
diff --git a/collects/scribblings/gui/clipboard-intf.scrbl b/collects/scribblings/gui/clipboard-intf.scrbl
index bb1807c6..23094928 100644
--- a/collects/scribblings/gui/clipboard-intf.scrbl
+++ b/collects/scribblings/gui/clipboard-intf.scrbl
@@ -80,6 +80,14 @@ See @|timediscuss| for a discussion of the @scheme[time] argument.  If
 
 }
 
+
+@defmethod[(same-clipboard-client? [owner (is-a?/c clipboard-client%)])
+           boolean?]{
+
+Returns @scheme[#t] if @scheme[owner] currently owns the clipboard,
+@scheme[#f] otherwise.}
+
+
 @defmethod[(set-clipboard-bitmap [new-bitmap (is-a?/c bitmap%)]
                                  [time (and/c exact? integer?)])
            void?]{
diff --git a/collects/scribblings/gui/editor-intf.scrbl b/collects/scribblings/gui/editor-intf.scrbl
index 1e975675..2184550f 100644
--- a/collects/scribblings/gui/editor-intf.scrbl
+++ b/collects/scribblings/gui/editor-intf.scrbl
@@ -59,7 +59,7 @@ The system adds undoers to an editor (in response to other method
 }
 
 @defmethod[(adjust-cursor [event (is-a?/c mouse-event%)])
-           (or/c (is-a?/c cursor%) false/c)]{
+           (or/c (is-a?/c cursor%) #f)]{
 
 @methspec{
 
@@ -332,9 +332,9 @@ Returns @scheme[#t].
 
 }}
 
-@defmethod*[([(change-style [delta (or/c (is-a?/c style-delta%) false/c)])
+@defmethod*[([(change-style [delta (or/c (is-a?/c style-delta%) #f)])
               void?]
-             [(change-style [style (or/c (is-a?/c style<%>) false/c)])
+             [(change-style [style (or/c (is-a?/c style<%>) #f)])
               void?])]{
 
 Changes the style for @techlink{items} in the editor, either by
@@ -456,6 +456,12 @@ Returns the name of a style to be used for newly inserted text,
 
 }
 
+
+@defmethod[(do-copy) void?]{
+
+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)]
@@ -492,6 +498,17 @@ See @|timediscuss| for a discussion of the @scheme[time] argument. If
 
 }
 
+
+@defmethod[(do-paste) void?]{
+
+See @xmethod[text% do-paste] or @xmethod[pasteboard% do-paste].}
+
+
+@defmethod[(do-paste-x-selection) void?]{
+
+See @xmethod[text% do-paste-x-selection] or @xmethod[pasteboard% do-paste-x-selection].}
+
+
 @defmethod[(editor-location-to-dc-location [x real?]
                                            [y real?])
            (values real? real?)]{
@@ -530,7 +547,7 @@ more information.
 
 
 @defmethod[(find-first-snip)
-           (or/c (is-a?/c snip%) false/c)]{
+           (or/c (is-a?/c snip%) #f)]{
 
 Returns the first snip in the editor, or @scheme[#f] if the editor is
  empty. To get all of the snips in the editor, use the @xmethod[snip%
@@ -553,7 +570,7 @@ For @scheme[text%] objects: @|FCA| @|OVD|
 }
 
 @defmethod[(get-active-canvas)
-           (or/c (is-a?/c editor-canvas%) false/c)]{
+           (or/c (is-a?/c editor-canvas%) #f)]{
 
 If the editor is displayed in a canvas, this method returns the canvas
  that most recently had the keyboard focus (while the editor was
@@ -562,7 +579,7 @@ If the editor is displayed in a canvas, this method returns the canvas
 }
 
 @defmethod[(get-admin)
-           (or/c (is-a?/c editor-admin%) false/c)]{
+           (or/c (is-a?/c editor-admin%) #f)]{
 
 Returns the @scheme[editor-admin%] object currently managing this
  editor or @scheme[#f] if the editor is not displayed.
@@ -570,7 +587,7 @@ Returns the @scheme[editor-admin%] object currently managing this
 }
 
 @defmethod[(get-canvas)
-           (or/c (is-a?/c editor-canvas%) false/c)]{
+           (or/c (is-a?/c editor-canvas%) #f)]{
 
 If @method[editor<%> get-active-canvas] returns a canvas, that canvas
  is also returned by this method. Otherwise, if @method[editor<%>
@@ -591,7 +608,7 @@ Returns a list of canvases displaying the editor. An editor may be
 }
 
 @defmethod[(get-dc)
-           (or/c (is-a?/c dc<%>) false/c)]{
+           (or/c (is-a?/c dc<%>) #f)]{
 
 Typically used (indirectly) by snip objects belonging to the
  editor. Returns a destination drawing context which is suitable for
@@ -610,8 +627,8 @@ Returns the font descent for the editor. This method is primarily used
 
 }
 
-@defmethod[(get-extent [w (or/c (box/c (and/c real? (not/c negative?))) false/c)]
-                       [h (or/c (box/c (and/c real? (not/c negative?))) false/c)])
+@defmethod[(get-extent [w (or/c (box/c (and/c real? (not/c negative?))) #f)]
+                       [h (or/c (box/c (and/c real? (not/c negative?))) #f)])
            void?]{
 
 Gets the current extent of the editor's graphical representation.
@@ -622,8 +639,8 @@ Gets the current extent of the editor's graphical representation.
 
 }
 
-@defmethod[(get-file [directory (or/c path? false/c)])
-           (or/c path-string? false/c)]{
+@defmethod[(get-file [directory (or/c path? #f)])
+           (or/c path-string? #f)]{
 @methspec{
 
 Called when the user must be queried for a filename to load an
@@ -644,8 +661,8 @@ If the editor is displayed in a single canvas, then the canvas's
 
 }}
 
-@defmethod[(get-filename [temp (box/c (or/c any/c false/c)) #f])
-           (or/c path-string? false/c)]{
+@defmethod[(get-filename [temp (box/c (or/c any/c #f)) #f])
+           (or/c path-string? #f)]{
 
 Returns the path name of the last file saved from or loaded into this
  editor, @scheme[#f] if the editor has no filename.
@@ -665,7 +682,7 @@ a discussion of flattened vs. non-flattened text.
 
 
 @defmethod[(get-focus-snip)
-           (or/c (is-a?/c snip%) false/c)]{
+           (or/c (is-a?/c snip%) #f)]{
 
 @index['("keyboard focus" "snips")]{Returns} the snip within the
  editor that gets the keyboard focus when the editor has the focus, or
@@ -698,7 +715,7 @@ See also @method[editor<%> set-inactive-caret-threshold] and
 
 
 @defmethod[(get-keymap)
-           (or/c (is-a?/c keymap%) false/c)]{
+           (or/c (is-a?/c keymap%) #f)]{
 
 Returns the main keymap currently used by the editor.
 
@@ -788,7 +805,7 @@ If the result is @scheme[#t], then the editor accepts only plain-text
 }
 
 @defmethod[(get-snip-data [thesnip (is-a?/c snip%)])
-           (or/c (is-a?/c editor-data%) false/c)]{
+           (or/c (is-a?/c editor-data%) #f)]{
 
 @methspec{
 
@@ -805,8 +822,8 @@ Returns @scheme[#f].
 
 
 @defmethod[(get-snip-location [thesnip (is-a?/c snip%)]
-                              [x (or/c (box/c real?) false/c) #f]
-                              [y (or/c (box/c real?) false/c) #f]
+                              [x (or/c (box/c real?) #f) #f]
+                              [y (or/c (box/c real?) #f) #f]
                               [bottom-right? any/c #f])
            boolean?]{
 
@@ -850,8 +867,8 @@ Returns the style list currently in use by the editor.
 }
 
 
-@defmethod[(get-view-size [w (or/c (box/c (and/c real? (not/c negative?))) false/c)]
-                          [h (or/c (box/c (and/c real? (not/c negative?))) false/c)])
+@defmethod[(get-view-size [w (or/c (box/c (and/c real? (not/c negative?))) #f)]
+                          [h (or/c (box/c (and/c real? (not/c negative?))) #f)])
            void?]{
 
 Returns the visible area into which the editor is currently being
@@ -868,8 +885,8 @@ If the @techlink{display} is an editor canvas, see also
 
 }
 
-@defmethod[(global-to-local [x (or/c (box/c real?) false/c)]
-                            [y (or/c (box/c real?) false/c)])
+@defmethod[(global-to-local [x (or/c (box/c real?) #f)]
+                            [y (or/c (box/c real?) #f)])
            void?]{
 
 Converts the given coordinates from top-level @techlink{display} coordinates
@@ -949,7 +966,7 @@ The @scheme[show-errors?] argument is no longer used.
 }
 
 
-@defmethod[(insert-image [filename (or/c path-string? false/c) #f]
+@defmethod[(insert-image [filename (or/c path-string? #f) #f]
                          [type (one-of/c 'unknown 'gif 'jpeg 'xbm 'xpm 'bmp 'pict) 'unknown]
                          [relative-path? any/c #f]
                          [inline? any/c #t])
@@ -974,7 +991,7 @@ calling
 @defmethod[(insert-port [port input-port]
                         [format (one-of/c 'guess 'same 'copy 'standard
                                           'text 'text-force-cr) 'guess]
-                        [show-errors? any/c #t])
+                        [replace-styles? any/c #t])
            (one-of/c 'standard 'text 'text-force-cr)]{
 
 Use @method[editor<%> insert-file], instead.
@@ -991,8 +1008,8 @@ The @scheme[port] must support position setting with @scheme[file-position].
 For information on @scheme[format], see
 @method[editor<%> load-file]. 
 
-The @scheme[show-errors?] argument is no longer used.
-
+if @scheme[replace-styles?] is true, then styles in the current style
+ list are replaced by style specifications in @scheme[port]'s stream.
 }
 
 @defmethod[(invalidate-bitmap-cache [x real? 0.0]
@@ -1030,13 +1047,20 @@ Returns @scheme[#t] if the editor is currently locked, @scheme[#f]
 @defmethod[(is-modified?)
            boolean?]{
 
-Returns @scheme[#t] is the editor has been modified since the last
+Returns @scheme[#t] if the editor has been modified since the last
  save or load (or the last call to @method[editor<%> set-modified]
  with @scheme[#f]), @scheme[#f] otherwise.
 
 }
 
 
+@defmethod[(is-printing?)
+           boolean?]{
+
+Returns @scheme[#t] if the editor is currently being printed through
+the @method[editor<%> print] method, @scheme[#f] otherwise.}
+
+
 @defmethod[(kill [time (and/c exact? integer?) 0])
            void?]{
 
@@ -1056,7 +1080,7 @@ See also @method[editor<%> cut].
 }
 
 
-@defmethod[(load-file [filename (or/c path-string? false/c) #f]
+@defmethod[(load-file [filename (or/c path-string? #f) #f]
                       [format (one-of/c 'guess 'same 'copy 'standard
                                         'text 'text-force-cr) 'guess]
                       [show-errors? any/c #t])
@@ -1117,8 +1141,8 @@ See also @method[editor<%> on-load-file], @method[editor<%>
 
 }
 
-@defmethod[(local-to-global [x (box/c real?)]
-                            [y (box/c real?)])
+@defmethod[(local-to-global [x (or/c (box/c real?) #f)]
+                            [y (or/c (box/c real?) #f)])
            void?]{
 
 Converts the given coordinates from editor @techlink{location}
@@ -1499,7 +1523,7 @@ Creates a @scheme[editor-snip%] with either a sub-editor from
 }}
 
 
-@defmethod[(on-new-image-snip [filename (or/c path? false/c)]
+@defmethod[(on-new-image-snip [filename (or/c path? #f)]
                               [kind (one-of/c 'unknown 'gif 'jpeg 'xbm 'xpm 'bmp 'pict)]
                               [relative-path? any/c]
                               [inline? any/c])
@@ -1689,7 +1713,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]
-                  [parent (or/c (or/c @scheme[frame%] (is-a?/c dialog%)) false/c) #f]
+                  [parent (or/c (or/c @scheme[frame%] (is-a?/c dialog%)) #f) #f]
                   [force-ps-page-bbox? any/c #t]
                   [as-eps? any/c #f])
            void?]{
@@ -1750,18 +1774,26 @@ The printing margins are determined by @method[ps-setup%
 }
 
 
-@defmethod[(print-to-dc [dc (is-a?/c dc<%>)])
+@defmethod[(print-to-dc [dc (is-a?/c dc<%>)]
+                        [page-number exact-integer? -1])
            void?]{
 
 Prints the editor into the given drawing context. See also
  @method[editor<%> print].
 
+If @scheme[page-number] is a non-negative integer, then just the
+indicated page is printed, where pages are numbered from
+@scheme[1]. (So, supplying @scheme[0] as @scheme[page-number] produces
+no output.) When @scheme[page-number] is negative, the
+@method[dc<%> start-page] and @scheme[dc<%> end-page] methods of @scheme[dc] are
+called for each page.
+
 }
 
 
-@defmethod[(put-file [directory (or/c path? false/c)]
-                     [default-name (or/c path? false/c)])
-           (or/c path-string? false/c)]{
+@defmethod[(put-file [directory (or/c path? #f)]
+                     [default-name (or/c path? #f)])
+           (or/c path-string? #f)]{
 @methspec{
 
 Called when the user must be queried for a filename to save an
@@ -1860,7 +1892,7 @@ See also @method[editor<%> add-undo].
                     [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)]
-                    [background (or/c (is-a?/c color%) false/c)])
+                    [background (or/c (is-a?/c color%) #f)])
            void?]{
 
 Repaints a region of the editor, generally called by an editor
@@ -1940,7 +1972,7 @@ If @scheme[redraw-now?] is @scheme[#f], the editor will require
 }
 
 
-@defmethod[(save-file [filename (or/c path-string? false/c) #f]
+@defmethod[(save-file [filename (or/c path-string? #f) #f]
                       [format (one-of/c 'guess 'same 'copy 'standard
                                         'text 'text-force-cr) 'same]
                       [show-errors? any/c #t])
@@ -2074,7 +2106,7 @@ Normally, this method is called only by @xmethod[editor-canvas%
 
 }
 
-@defmethod[(set-admin [admin (or/c (is-a?/c editor-admin%) false/c)])
+@defmethod[(set-admin [admin (or/c (is-a?/c editor-admin%) #f)])
            void?]{
 
 Sets the editor's administrator. This method is only called by an
@@ -2087,7 +2119,7 @@ get-admin]}]
 }
 
 
-@defmethod[(set-caret-owner [snip (or/c (is-a?/c snip%) false/c)]
+@defmethod[(set-caret-owner [snip (or/c (is-a?/c snip%) #f)]
                             [domain (one-of/c 'immediate 'display 'global) 'immediate])
            void?]{
 
@@ -2127,8 +2159,8 @@ See also @method[editor<%> get-focus-snip].
 }
 
 
-@defmethod[(set-cursor [cursor (or/c (is-a?/c cursor%) false/c)]
-                       [override? any/c @scheme[#t]])
+@defmethod[(set-cursor [cursor (or/c (is-a?/c cursor%) #f)]
+                       [override? any/c #t])
            void?]{
 
 Sets the custom cursor for the editor to @scheme[cursor]. If
@@ -2148,7 +2180,7 @@ An embedding editor's custom cursor can override the cursor of an
 }
 
 
-@defmethod[(set-filename [filename (or/c path-string? false/c)]
+@defmethod[(set-filename [filename (or/c path-string? #f)]
                          [temporary? any/c #f])
            void?]{
 
@@ -2172,7 +2204,7 @@ Sets the threshold for painting an inactive selection.  See
 }
 
 
-@defmethod[(set-keymap [keymap (or/c (is-a?/c keymap%) false/c) #f])
+@defmethod[(set-keymap [keymap (or/c (is-a?/c keymap%) #f) #f])
            void?]{
 
 Sets the current keymap for the editor. A @scheme[#f] argument removes
@@ -2336,7 +2368,7 @@ recalculated on demand.
 See also @method[editor<%> invalidate-bitmap-cache].}
 
 
-@defmethod[(style-has-changed [style (or/c (is-a?/c style<%>) false/c)])
+@defmethod[(style-has-changed [style (or/c (is-a?/c style<%>) #f)])
            void?]{
 
 Notifies the editor that a style in its style list has changed. This
diff --git a/collects/scribblings/gui/editor-stream-in-base-class.scrbl b/collects/scribblings/gui/editor-stream-in-base-class.scrbl
index adc5952e..ce4cfc89 100644
--- a/collects/scribblings/gui/editor-stream-in-base-class.scrbl
+++ b/collects/scribblings/gui/editor-stream-in-base-class.scrbl
@@ -24,14 +24,18 @@ Returns @scheme[#t] if there has been an error reading from the
 @defmethod[(read [data (and/c vector? (not immutable?))])
            exact-nonnegative-integer?]{
 
-Reads Latin-1 characters to fill the supplied vector. The return value is the
- number of characters read, which may be less than the number
+Like @method[editor-stream-in-base% read-bytes], but fills a supplied
+vector with Latin-1 characters instead of filling a byte string.  This method
+is implemented by default via @method[editor-stream-in-base% read-bytes].}
+
+@defmethod[(read-bytes [bstr (and/c bytes? (not immutable?))])
+           exact-nonnegative-integer?]{
+
+Reads bytes to fill the supplied byte string. The return value is the
+ number of bytes read, which may be less than the number
  requested if the stream is emptied. If the stream is emptied, the
  next call to @method[editor-stream-in-base% bad?] must return
- @scheme[#t].
-
-}
-
+ @scheme[#t].}
 
 @defmethod[(seek [pos exact-nonnegative-integer?])
            void?]{
diff --git a/collects/scribblings/gui/editor-stream-out-base-class.scrbl b/collects/scribblings/gui/editor-stream-out-base-class.scrbl
index d45aabb5..9b02aab2 100644
--- a/collects/scribblings/gui/editor-stream-out-base-class.scrbl
+++ b/collects/scribblings/gui/editor-stream-out-base-class.scrbl
@@ -39,6 +39,12 @@ Returns the current stream position.
 @defmethod[(write [data (listof char?)])
            void?]{
 
-Writes data (encoded as Latin-1 characters) to the stream.
+Writes data (encoded as Latin-1 characters) to the stream. This method
+is implemented by default via @method[editor-stream-out-base%
+write-bytes].}
+
+@defmethod[(write-bytes [bstr bytes?]) void?]{
+
+Writes data to the stream.}}
+
 
-}}
diff --git a/collects/scribblings/gui/editor-stream-out-class.scrbl b/collects/scribblings/gui/editor-stream-out-class.scrbl
index 2499f448..d869eaf2 100644
--- a/collects/scribblings/gui/editor-stream-out-class.scrbl
+++ b/collects/scribblings/gui/editor-stream-out-class.scrbl
@@ -62,8 +62,9 @@ This method is called by @scheme[write-editor-global-header].
 
 Writes @scheme[v], or @scheme[n] bytes of @scheme[v]. 
 
-When @scheme[n] is supplied, use @method[editor-stream-in%
- get-unterminated-bytes] to read the bytes later.
+When @scheme[n] is supplied with a byte-string @scheme[v], use
+ @method[editor-stream-in% get-unterminated-bytes] to read the bytes
+ later.
 
 If @scheme[n] is not supplied and @scheme[v] is a byte string, then
  for historical reasons, the actual number of bytes written includes a
@@ -85,9 +86,14 @@ Puts a fixed-sized integer into the stream. This method is needed
  fixed-size number.
 
 Numbers written to a stream with @method[editor-stream-out% put-fixed]
- must be read with @method[editor-stream-in% get-fixed].
+ must be read with @method[editor-stream-in% get-fixed].}
+
+
+@defmethod[(put-unterminated [v bytes?]) (is-a?/c editor-stream-out%)]{
+
+The same as calling @method[editor-stream-out% put] with
+@scheme[(bytes-length v)] and @scheme[v].}
 
-}
 
 @defmethod[(tell)
            exact-nonnegative-integer?]{
diff --git a/collects/scribblings/gui/pasteboard-class.scrbl b/collects/scribblings/gui/pasteboard-class.scrbl
index d4e58bc6..5c109bb6 100644
--- a/collects/scribblings/gui/pasteboard-class.scrbl
+++ b/collects/scribblings/gui/pasteboard-class.scrbl
@@ -499,7 +499,8 @@ Deletes @scheme[snip] when provided, or deletes the currently selected
 }
 
 
-@defmethod[(do-copy [time (and/c exact? integer?)]
+@defmethod[#:mode override 
+           (do-copy [time (and/c exact? integer?)]
                     [extend? any/c])
            void?]{
 
@@ -523,7 +524,8 @@ Copies the current selection, extending the current clipboard contexts
 }}
 
 
-@defmethod[(do-paste [time (and/c exact? integer?)])
+@defmethod[#:mode override
+           (do-paste [time (and/c exact? integer?)])
            void?]{
 @methspec{
 
@@ -544,7 +546,8 @@ Pastes.
 }}
 
 
-@defmethod[(do-paste-x-selection [time (and/c exact? integer?)])
+@defmethod[#:mode override
+           (do-paste-x-selection [time (and/c exact? integer?)])
            void?]{
 @methspec{
 
@@ -806,7 +809,7 @@ Deselects all selected snips in the editor.
 }
 
 
-@defmethod[#:mode override 
+@defmethod[#:mode override
            (on-default-event [event (is-a?/c mouse-event%)])
            void?]{
 
diff --git a/collects/scribblings/gui/text-class.scrbl b/collects/scribblings/gui/text-class.scrbl
index 1b0f04dd..3635683e 100644
--- a/collects/scribblings/gui/text-class.scrbl
+++ b/collects/scribblings/gui/text-class.scrbl
@@ -324,12 +324,12 @@ See also @method[text% hide-caret].
 
 
 @defmethod*[#:mode extend
-            ([(change-style [delta (or/c (is-a?/c style-delta%) false/c)]
+            ([(change-style [delta (or/c (is-a?/c style-delta%) #f)]
                             [start (or/c exact-nonnegative-integer? (one/of 'start)) 'start]
                             [end (or/c exact-nonnegative-integer? (one/of 'end)) 'end]
                             [counts-as-mod? any/c #t])
               void?]
-             [(change-style [style (or/c (is-a?/c style<%>) false/c)]
+             [(change-style [style (or/c (is-a?/c style<%>) #f)]
                             [start (or/c exact-nonnegative-integer? (one/of 'start)) 'start]
                             [end (or/c exact-nonnegative-integer? (one/of 'end)) 'end]
                             [counts-as-mod? any/c #t])
@@ -422,7 +422,8 @@ Deletes the specified range or the currently selected text (when no
 
 }
 
-@defmethod[(do-copy [start exact-nonnegative-integer?]
+@defmethod[#:mode override
+           (do-copy [start exact-nonnegative-integer?]
                     [end exact-nonnegative-integer?]
                     [time (and/c exact? integer?)]
                     [extend? any/c])
@@ -446,7 +447,8 @@ Copy the data from @scheme[start] to @scheme[end], extending the current
 }}
 
 
-@defmethod[(do-paste [start exact-nonnegative-integer?]
+@defmethod[#:mode override
+           (do-paste [start exact-nonnegative-integer?]
                      [time (and/c exact? integer?)])
            void?]{
 @methspec{
@@ -467,7 +469,8 @@ Pastes into the @techlink{position} @scheme[start].
 }}
 
 
-@defmethod[(do-paste-x-selection [start exact-nonnegative-integer?]
+@defmethod[#:mode override
+           (do-paste-x-selection [start exact-nonnegative-integer?]
                                  [time (and/c exact? integer?)])
            void?]{
 @methspec{
@@ -500,7 +503,7 @@ See also @method[text% delete].
 
 
 @defmethod[(find-line [y real?]
-                      [on-it? (or/c (box/c any/c) false/c) #f])
+                      [on-it? (or/c (box/c any/c) #f) #f])
            exact-nonnegative-integer?]{
 
 Given a @techlink{location} in the editor, returns the line at the
@@ -516,8 +519,17 @@ Given a @techlink{location} in the editor, returns the line at the
 }
 
 
-@defmethod[(find-next-non-string-snip [after (or/c (is-a?/c snip%) false/c)])
-           (or/c (is-a?/c snip%) false/c)]{
+@defmethod[(find-newline [direction (one-of/c 'forward 'backward) 'forward]
+                         [start (or/c exact-nonnegative-integer? (one/of 'start)) 'start]
+                         [end (or/c exact-nonnegative-integer? (one/of 'eof)) 'eof])
+           (or/c exact-nonnegative-integer? #f)]{
+
+Like @method[text% find-string], but specifically finds a paragraph
+break (possibly more efficiently than searching text).}
+
+
+@defmethod[(find-next-non-string-snip [after (or/c (is-a?/c snip%) #f)])
+           (or/c (is-a?/c snip%) #f)]{
 
 Given a snip, returns the next snip in the editor (after the given
  one) that is not an instance of @scheme[string-snip%]. If
@@ -530,9 +542,9 @@ Given a snip, returns the next snip in the editor (after the given
 
 @defmethod[(find-position [x real?]
                           [y real?]
-                          [at-eol? (or/c (box/c any/c) false/c) #f]
-                          [on-it? (or/c (box/c any/c) false/c) #f]
-                          [edge-close? (or/c (box/c real?) false/c) #f])
+                          [at-eol? (or/c (box/c any/c) #f) #f]
+                          [on-it? (or/c (box/c any/c) #f) #f]
+                          [edge-close? (or/c (box/c real?) #f) #f])
            exact-nonnegative-integer?]{
 
 Given a @techlink{location} in the editor, returns the @techlink{position} at the
@@ -557,9 +569,9 @@ See @|ateoldiscuss| for a discussion of the @scheme[at-eol?] argument.
 
 @defmethod[(find-position-in-line [line exact-nonnegative-integer?]
                                   [x real?]
-                                  [at-eol? (or/c (box/c any/c) false/c) #f]
-                                  [on-it? (or/c (box/c any/c) false/c) #f]
-                                  [edge-close? (or/c (box/c real?) false/c) #f])
+                                  [at-eol? (or/c (box/c any/c) #f) #f]
+                                  [on-it? (or/c (box/c any/c) #f) #f]
+                                  [edge-close? (or/c (box/c real?) #f) #f])
            exact-nonnegative-integer?]{
 
 Given a @techlink{location} within a line of the editor, returns the
@@ -579,8 +591,8 @@ 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)]
-                      [s-pos (or/c (box/c exact-nonnegative-integer?) false/c) #f])
-           (or/c (is-a?/c snip%) false/c)]{
+                      [s-pos (or/c (box/c exact-nonnegative-integer?) #f) #f])
+           (or/c (is-a?/c snip%) #f)]{
 
 Returns the snip at a given @techlink{position}, or @scheme[#f] if an appropriate
  snip cannot be found.
@@ -615,7 +627,7 @@ can be any of the following:
                         [end (or/c exact-nonnegative-integer? (one/of 'eof)) 'eof]
                         [get-start? any/c #t]
                         [case-sensitive? any/c #t])
-           (or/c exact-nonnegative-integer? false/c)]{
+           (or/c exact-nonnegative-integer? #f)]{
 
 Finds an exact-match string in the editor and returns its @techlink{position}. 
  If the string is not found, @scheme[#f] is returned.
@@ -656,8 +668,8 @@ Finds all occurrences of a string using @method[text% find-string]. If
 }
 
 
-@defmethod[(find-wordbreak [start (or/c (box/c exact-nonnegative-integer?) false/c)]
-                           [end (or/c (box/c exact-nonnegative-integer?) false/c)]
+@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)])
            void?]{
 
@@ -804,8 +816,8 @@ Returns @scheme[#t] if the editor is in overwrite mode, @scheme[#f]
 }
 
 
-@defmethod[(get-position [start (or/c (box/c exact-nonnegative-integer?) false/c)]
-                         [end (or/c (box/c exact-nonnegative-integer?) false/c) #f])
+@defmethod[(get-position [start (or/c (box/c exact-nonnegative-integer?) #f)]
+                         [end (or/c (box/c exact-nonnegative-integer?) #f) #f])
            void?]{
 
 Returns the current selection range in @techlink{position}s.  If
@@ -823,7 +835,7 @@ and @method[text% get-end-position].
 
 @defmethod[(get-region-data [start exact-nonnegative-integer?]
                             [end exact-nonnegative-integer?])
-           (or/c (is-a?/c editor-data%) false/c)]{
+           (or/c (is-a?/c editor-data%) #f)]{
 
 Gets extra data associated with a given region. See
  @|editordatadiscuss| for more information.
@@ -854,7 +866,7 @@ Returns an inexact number that increments every time the editor is
 
 
 @defmethod[(get-snip-position [snip (is-a?/c snip%)])
-           (or/c exact-nonnegative-integer? false/c)]{
+           (or/c exact-nonnegative-integer? #f)]{
 
 Returns the starting @techlink{position} of a given snip or
  @scheme[#f] if the snip is not in this editor.
@@ -862,9 +874,9 @@ Returns the starting @techlink{position} of a given snip or
 }
 
 @defmethod[(get-snip-position-and-location [snip (is-a?/c snip%)]
-                                           [pos (or/c (box/c exact-nonnegative-integer?) false/c)]
-                                           [x (or/c (box/c real?) false/c) #f]
-                                           [y (or/c (box/c real?) false/c) #f])
+                                           [pos (or/c (box/c exact-nonnegative-integer?) #f)]
+                                           [x (or/c (box/c real?) #f) #f]
+                                           [y (or/c (box/c real?) #f) #f])
            boolean?]{
 
 Gets a snip's @techlink{position} and top left @techlink{location} in editor
@@ -911,9 +923,9 @@ See also @method[text% set-styles-sticky].
 }
 
 
-@defmethod[(get-tabs [length (or/c (box/c exact-nonnegative-integer?) false/c) #f]
-                     [tab-width (or/c (box/c real?) false/c) #f]
-                     [in-units (or/c (box/c any/c) false/c) #f])
+@defmethod[(get-tabs [length (or/c (box/c exact-nonnegative-integer?) #f) #f]
+                     [tab-width (or/c (box/c real?) #f) #f]
+                     [in-units (or/c (box/c any/c) #f) #f])
            (listof real?)]{
 
 Returns the current tab-position array as a list.
@@ -964,8 +976,8 @@ Returns the distance from the top of the editor to the alignment
 }
 
 
-@defmethod[(get-visible-line-range [start (or/c (box/c exact-nonnegative-integer?) false/c)]
-                                   [end (or/c (box/c exact-nonnegative-integer?) false/c)]
+@defmethod[(get-visible-line-range [start (or/c (box/c exact-nonnegative-integer?) #f)]
+                                   [end (or/c (box/c exact-nonnegative-integer?) #f)]
                                    [all? any/c #t])
            void?]{
 
@@ -985,8 +997,8 @@ If the editor is displayed by multiple canvases and @scheme[all?] is
 }
 
 
-@defmethod[(get-visible-position-range [start (or/c (box/c exact-nonnegative-integer?) false/c)]
-                                       [end (or/c (box/c exact-nonnegative-integer?) false/c)]
+@defmethod[(get-visible-position-range [start (or/c (box/c exact-nonnegative-integer?) #f)]
+                                       [end (or/c (box/c exact-nonnegative-integer?) #f)]
                                        [all? any/c #t])
            void?]{
 
@@ -1523,7 +1535,9 @@ If the paragraph ends with invisible @techlink{item}s (such as a carriage
 @defmethod[(paragraph-start-line [paragraph exact-nonnegative-integer?])
            exact-nonnegative-integer?]{
 
-Returns the starting line of a given paragraph. @|ParagraphNumbering| @|LineNumbering|
+Returns the starting line of a given paragraph. If @scheme[paragraph]
+is greater than the highest-numbered paragraph, then the editor's end
+@tech{position} is returned. @|ParagraphNumbering| @|LineNumbering|
 
 @|FCAMW| @|EVD|
 
@@ -1548,13 +1562,17 @@ If the paragraph starts with invisible @techlink{item}s and @scheme[visible?] is
 
 @defmethod[#:mode override
            (paste [time (and/c exact? integer?) 0]
-                  [start (or/c exact-nonnegative-integer? (one/of 'end)) 'end]
+                  [start (or/c exact-nonnegative-integer? (one/of 'start 'end)) 'start]
                   [end (or/c exact-nonnegative-integer? (one/of 'same)) 'same])
            void?]{
 
-Pastes into the specified range. If @scheme[start] is @scheme['end], then
- the current selection end @techlink{position} is used. If @scheme[end] is
- @scheme['same], then @scheme[start] is used for @scheme[end].
+Pastes into the specified range. If @scheme[start] is @scheme['start],
+ then the current selection start @techlink{position} is used. If
+ @scheme[start] is @scheme['end], then the current selection end
+ @techlink{position} is used. If @scheme[end] is @scheme['same], then
+ @scheme[start] is used for @scheme[end], unless @scheme[start] is
+ @scheme['start], in which case the current selection end
+ @techlink{position} is used.
 
 See @|timediscuss| for a discussion of the @scheme[time] argument. If
  @scheme[time] is outside the platform-specific range of times,
@@ -1586,13 +1604,17 @@ If the previous operation on the editor was not a paste, calling
 
 @defmethod[#:mode override
            (paste-x-selection [time (and/c exact? integer?)]
-                              [start (or/c exact-nonnegative-integer? (one/of 'end)) 'end]
+                              [start (or/c exact-nonnegative-integer? (one/of 'start 'end)) 'start]
                               [end (or/c exact-nonnegative-integer? (one/of 'same)) 'same])
            void?]{
 
-Pastes into the specified range. If @scheme[start] is @scheme['end], then
- the current selection end @techlink{position} is used. If @scheme[end] is
- @scheme['same], then @scheme[start] is used for @scheme[end].
+Pastes into the specified range. If @scheme[start] is @scheme['start],
+ then the current selection start @techlink{position} is used. If
+ @scheme[start] is @scheme['end], then the current selection end
+ @techlink{position} is used. If @scheme[end] is @scheme['same], then
+ @scheme[start] is used for @scheme[end], unless @scheme[start] is
+ @scheme['start], in which case the current selection end
+ @techlink{position} is used.
 
 See @|timediscuss| for a discussion of the @scheme[time] argument. If
  @scheme[time] is outside the platform-specific range of times,
@@ -1616,8 +1638,8 @@ See @|ateoldiscuss| for a discussion of @scheme[at-eol?].
 
 
 @defmethod[(position-location [start exact-nonnegative-integer?]
-                              [x (or/c (box/c real?) false/c) #f]
-                              [y (or/c (box/c real?) false/c) #f]
+                              [x (or/c (box/c real?) #f) #f]
+                              [y (or/c (box/c real?) #f) #f]
                               [top? any/c #t]
                               [at-eol? any/c #f]
                               [whole-line? any/c #f])
@@ -1647,10 +1669,10 @@ maximum bottom @techlink{location} for the whole line is returned in @scheme[y].
 
 
 @defmethod[(position-locations [start exact-nonnegative-integer?]
-                               [top-x (or/c (box/c real?) false/c) #f]
-                               [top-y (or/c (box/c real?) false/c) #f]
-                               [bottom-x (or/c (box/c real?) false/c) #f]
-                               [bottom-y (or/c (box/c real?) false/c) #f]
+                               [top-x (or/c (box/c real?) #f) #f]
+                               [top-y (or/c (box/c real?) #f) #f]
+                               [bottom-x (or/c (box/c real?) #f) #f]
+                               [bottom-y (or/c (box/c real?) #f) #f]
                                [at-eol? any/c #f]
                                [whole-line? any/c #f])
            void?]{
@@ -1750,8 +1772,8 @@ If @scheme[on?] is not @scheme[#f], then the selection will be
 }
 
 
-@defmethod[(set-autowrap-bitmap [bitmap (or/c (is-a?/c bitmap%) false/c)])
-           (or/c (is-a?/c bitmap%) false/c)]{
+@defmethod[(set-autowrap-bitmap [bitmap (or/c (is-a?/c bitmap%) #f)])
+           (or/c (is-a?/c bitmap%) #f)]{
 
 Sets the bitmap that is drawn at the end of a line when it is
  automatically line-wrapped.
@@ -1790,7 +1812,7 @@ See also
                                        exact-nonnegative-integer?
                                        exact-nonnegative-integer?)
                               . -> . any)]
-                          [hilite-delta (or/c (is-a?/c style-delta%) false/c) #f]
+                          [hilite-delta (or/c (is-a?/c style-delta%) #f) #f]
                           [call-on-down? any/c #f])
            void?]{
 
@@ -2010,8 +2032,8 @@ Setting tabs is disallowed when the editor is internally locked for
 }
 
 
-@defmethod[(set-wordbreak-func [f ((is-a?/c text%) (or/c (box/c exact-nonnegative-integer?) false/c)
-                                                   (or/c (box/c exact-nonnegative-integer?) false/c)
+@defmethod[(set-wordbreak-func [f ((is-a?/c text%) (or/c (box/c exact-nonnegative-integer?) #f)
+                                                   (or/c (box/c exact-nonnegative-integer?) #f)
                                                    symbol?
                                    . -> . any)])
            void?]{
@@ -2036,7 +2058,7 @@ Since the wordbreak function will be called when line breaks are being
 }
 
 
-@defmethod[(set-wordbreak-map [map (or/c (is-a?/c editor-wordbreak-map%) false/c)])
+@defmethod[(set-wordbreak-map [map (or/c (is-a?/c editor-wordbreak-map%) #f)])
            void?]{
 
 Sets the wordbreaking map that is used by the standard wordbreaking
diff --git a/collects/tests/mred/media8.mre b/collects/tests/mred/media8.mre
index 3b2f394b..3f19360e 100644
--- a/collects/tests/mred/media8.mre
+++ b/collects/tests/mred/media8.mre
@@ -1,17 +1,20 @@
 #reader(lib"read.ss""wxme")WXME0108 ## 
+#|
+   This file is in PLT Scheme editor format.
    Open this file in DrScheme version 370 or later to read it.
-   Open this file in DrScheme version 370 or later to read it.
-   Most likely, it was created by saving a program in DrScheme version
-   370 or later, and it probably contains a program with non-text
-   elements (such as images or comment boxes).
-                 www.plt-scheme.org
+
+   Most likely, it was created by saving a program in DrScheme,
+   and it probably contains a program with non-text elements
+   (such as images or comment boxes).
+
+            http://www.plt-scheme.org
 |#
  4 7 #"wxtext\0"
 3 1 6 #"wxtab\0"
 1 1 8 #"wxmedia\0"
-3 1 8 #"wximage\0"
+4 1 8 #"wximage\0"
 2 0 1 6 #"wxloc\0"
-00000000000 1 26 0 9 #"Standard\0"
+00000000000 1 19 0 9 #"Standard\0"
 0 70 1 #"\0"
 1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
 0 70 1 #"\0"
@@ -50,25 +53,11 @@
 0 75 1 #"\0"
 1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 0 1 1 1 #"\0"
 0 70 1 #"\0"
-1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 2 1 1 1 #"\0"
-0 71 1 #"\0"
-1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
-0 70 1 #"\0"
-1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
-0 72 1 #"\0"
-1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
-0 73 1 #"\0"
-1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
-0 74 1 #"\0"
-1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
-0 75 1 #"\0"
-1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1 1 1 #"\0"
-0 -1 1 #"\0"
-1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 -1
-00000000002 0 00000000000 2 00000000000 41 0 1 3 44
+1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 2 1 00000000002
+0 00000000000 2 00000000000 40 0 1 3 44
 #"This is a line of plain text (default font)."
 0 0 1 29 1 #"\n"
-0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 00000000000 2 3 0 9
+0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 0 00000000000 2 3 0 9
 #"Standard\0"
 0 70 1 #"\0"
 1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
@@ -76,13 +65,13 @@
 1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 00000000000
 1 0 1 3 38 #"This is a line of plain text in a box."
 0 00000000000 0 0 1 29 1 #"\n"
-0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 00000000000 3 3 0 9
+0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 0 00000000000 3 3 0 9
 #"Standard\0"
 0 70 1 #"\0"
 1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
 0 70 1 #"\0"
 1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 00000000000
-1 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 00000000000 4 3 0 9
+1 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 0 00000000000 4 3 0 9
 #"Standard\0"
 0 70 1 #"\0"
 1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
@@ -97,7 +86,7 @@
 0 0 5 3 29 #"This has a yellow background."
 0 0 1 29 1 #"\n"
 0 0 7 3 34 #"Top aligned (compared to the box)."
-0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 00000000000 5 5 0 9
+0 2 1 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 0 00000000000 5 5 0 9
 #"Standard\0"
 0 70 1 #"\0"
 1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
@@ -112,7 +101,7 @@
 0 0 1 29 1 #"\n"
 0 0 4 3 3 #"Red"
 0 0 4 29 1 #"\n"
-0 2 4 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 00000000000 6 4 0 9
+0 2 4 1 1 5 5 5 5 1 1 1 1 -1 -1 -1 -1 0 0 0 00000000000 6 4 0 9
 #"Standard\0"
 0 70 1 #"\0"
 1 0 90 90 90 90 3 3 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 1 1 0 1 #"\0"
@@ -138,15 +127,14 @@
 0 0 7 29 1 #"\n"
 0 0 12 3 19 #"(2 points smaller.)"
 0 0 7 29 1 #"\n"
-0 0 19 3 11 #"Decorative."
-0 0 20 3 1 #" "
-0 0 21 3 6 #"Roman."
-0 0 20 3 1 #" "
-0 0 22 3 7 #"Script."
-0 0 20 3 1 #" "
-0 0 23 3 6 #"Swiss."
-0 0 20 3 1 #" "
-0 0 24 3 6 #"Fixed."
-0 0 25 3 53 #" (Last line changed to bottom-aligned for version 8.)"
-0 0 20 29 1 #"\n"
+0 0 13 3 11 #"Decorative."
+0 0 7 3 1 #" "
+0 0 14 3 6 #"Roman."
+0 0 7 3 1 #" "
+0 0 15 3 7 #"Script."
+0 0 7 3 1 #" "
+0 0 16 3 6 #"Swiss."
+0 0 7 3 1 #" "
+0 0 17 3 6 #"Fixed."
+0 0 7 29 1 #"\n"
 0 00000000000
diff --git a/collects/tests/mred/test-editor-admin.ss b/collects/tests/mred/test-editor-admin.ss
new file mode 100644
index 00000000..d0732366
--- /dev/null
+++ b/collects/tests/mred/test-editor-admin.ss
@@ -0,0 +1,44 @@
+#lang scheme/base
+(require scheme/class
+         scheme/gui/base)
+
+(provide test-editor-admin%)
+
+(define the-dc
+  (new (class* bitmap-dc% ()
+         (super-new)
+         (define/override (get-text-extent s [font #f] [combine? #f] [offset 0])
+           (values (* 10.0 (string-length s)) 10.0 1.0 1.0))
+         (define/override (set-pen . p) (void))
+         (define/override (get-pen . p) #f)
+         (define/override (set-brush . b) (void))
+         (define/override (get-brush . b) #f)
+         (define/override (set-clipping-rect . b) (void))
+         (define/override (get-clipping-region . b) #f)
+         (define/override (draw-text s x y combine? offset count) (void))
+         (define/override (cache-font-metrics-key) 100))))
+         
+
+(define test-editor-admin%
+  (class editor-admin% 
+    (super-new)
+
+    (define/override (get-dc [x #f] [y #f])
+      (when x (set-box! x 1.0))
+      (when y (set-box! y 1.0))
+      the-dc)
+
+    (define/private (do-get-view x y w h)
+      (when x (set-box! x 0.0))
+      (when y (set-box! y 0.0))
+      (when w (set-box! w 100.0))
+      (when h (set-box! h 100.0)))
+
+    (define/override (get-view x y w h [full? #f])
+      (do-get-view x y w h))
+
+    (define/override (get-max-view x y w h [full? #f])
+      (do-get-view x y w h))
+
+    (define/override (scroll-to x y w h refresh? bias)
+      (void))))
diff --git a/collects/tests/mred/wxme.ss b/collects/tests/mred/wxme.ss
new file mode 100644
index 00000000..695bce17
--- /dev/null
+++ b/collects/tests/mred/wxme.ss
@@ -0,0 +1,1337 @@
+#lang scheme/base
+(require scheme/class
+         (only-in scheme/gui/base
+                  color% 
+                  font%
+                  the-clipboard
+                  clipboard-client%
+                  key-event%
+                  mouse-event%)
+         mred/private/wxme/snip
+         mred/private/wxme/mline
+         mred/private/wxme/style
+         mred/private/wxme/editor
+         mred/private/wxme/text
+         mred/private/wxme/pasteboard
+         "test-editor-admin.ss"
+         mred/private/wxme/stream
+         mred/private/wxme/keymap
+         mred/private/wxme/editor-snip)
+
+(define wrong-cnt 0)
+(define test-cnt 0)
+
+(define (expect v v2)
+  (set! test-cnt (add1 test-cnt))
+  (unless (equal? v v2)
+    (set! wrong-cnt (add1 wrong-cnt))
+    (printf "EXPECTED ~s:\n" v2))
+  v)
+
+(define (show v)
+  (print v)
+  (newline))
+
+(define (expect* v v2)
+  (if (equal? v v2)
+      (set! test-cnt (add1 test-cnt))
+      (show (expect v v2))))
+
+(define (done)
+  (printf "\n~a tests\n" test-cnt)
+  (if (zero? wrong-cnt)
+      (printf "all passed\n")
+      (printf "~s FAILED\n" wrong-cnt)))
+
+;; ----------------------------------------
+;; String snips and lines
+
+(define s (make-object string-snip% "helko"))
+(send s insert "cat " 4 2)
+(send s get-text 0 (send s get-count))
+(send s set-flags (cons 'invisible (send s get-flags)))
+(send s get-flags)
+(send (send (get-the-snip-class-list) find "wxtext") get-classname)
+
+(define root-box (box mline-NIL))
+(define m20 (mline-insert #f root-box #t))
+(expect (mline-get-line m20) 0)
+(define m00 (mline-insert m20 root-box #t))
+(expect (mline-get-line m00) 0)
+(expect (mline-get-line m20) 1)
+(expect (mline-get-position m00) 0)
+(expect (mline-get-position m20) 0)
+(mline-set-length m00 5)
+(mline-set-length m20 20)
+(expect (mline-get-position m00) 0)
+(expect (mline-get-position m20) 5)
+
+(mline-check-consistent (unbox root-box))
+
+;; ----------------------------------------
+;; Line inserts and deletes
+
+(define m5 (mline-insert m20 root-box #t))
+(mline-check-consistent (unbox root-box))
+
+(mline-set-length m5 10)
+
+(expect (mline-get-position m00) 0)
+(expect (mline-get-position m5) 5)
+(expect (mline-get-position m20) 15)
+
+(mline-delete m5 root-box)
+(expect (mline-get-position m20) 5)
+
+(set! m5 (mline-insert m20 root-box #t))
+(mline-set-length m5 8)
+
+(expect (mline-get-position m00) 0)
+(expect (mline-get-position m5) 5)
+(expect (mline-get-position m20) 13)
+
+(mline-delete m5 root-box)
+
+(mline-check-consistent (unbox root-box))
+
+;; ----------------------------------------
+;; Line counts and positions
+
+(define m30 (mline-insert m20 root-box #f))
+
+(expect (mline-get-line m00) 0)
+(expect (mline-get-line m20) 1)
+(expect (mline-get-line m30) 2)
+
+(expect (mline-get-position m00) 0)
+(expect (mline-get-position m20) 5)
+(expect (mline-get-position m30) 25)
+
+(mline-check-consistent (unbox root-box))
+
+;; ----------------------------------------
+;; More line lines and positions
+
+(define m05 (mline-insert m00 root-box #f))
+
+(mline-set-length m05 2)
+
+(expect (mline-get-line m00) 0)
+(expect (mline-get-line m05) 1)
+(expect (mline-get-line m20) 2)
+(expect (mline-get-line m30) 3)
+
+(expect (mline-get-position m00) 0)
+(expect (mline-get-position m05) 5)
+(expect (mline-get-position m20) 7)
+(expect (mline-get-position m30) 27)
+
+(mline-check-consistent (unbox root-box))
+
+;; ----------------------------------------
+;; Line inserts and deletes, radomized
+
+(let ([added
+       (let loop ([l (list m00 m05 m20 m30)]
+                  [n 100])
+         (let ([m (mline-insert (list-ref l (random (length l))) 
+                                root-box
+                                (zero? (random 2)))])
+           (mline-check-consistent (unbox root-box))
+           (if (zero? n)
+               (cons m l)
+               (loop (cons m l) (sub1 n)))))])
+  (for-each (lambda (i)
+              (mline-delete i root-box)
+              (mline-check-consistent (unbox root-box)))
+            (cdr added))
+  (show (expect (mline-next (car added)) #f))
+  (show (expect (mline-prev (car added)) #f))
+  (expect (unbox root-box)
+          (car added)))
+
+;; ----------------------------------------
+;; Styles, deltas, lists
+
+(define d1 (new style-delta%))
+(define d2 (new style-delta%))
+(expect (send d1 get-underlined-on) #f)
+(expect (send d1 equal d2) #t)
+(send d1 set-underlined-on #t)
+(expect (send d1 equal d2) #f)
+(send d2 collapse d1)
+(expect (send d2 get-underlined-on) #t)
+(send d2 set-underlined-on #f)
+(send d1 copy d2)
+(expect (send d1 get-underlined-on) #f)
+
+(define sl (new style-list%))
+(expect #t (eq? (send sl basic-style) (send sl basic-style)))
+(define s-plain (send sl find-or-create-style (send sl basic-style)
+                      (new style-delta%)))
+(expect (send sl find-or-create-style (send sl basic-style)
+              (new style-delta%))
+        s-plain)
+
+(send d1 set-underlined-on #t)
+(define s-underlined (send sl find-or-create-style s-plain d1))
+(expect (send s-plain get-underlined) #f)
+(expect (send s-underlined get-underlined) #t)
+
+(send d2 set-underlined-off #t)
+(send d2 set-smoothing-on 'partly-smoothed)
+(define s-nonunderlined1 (send sl find-or-create-style s-underlined d2))
+(expect (send s-nonunderlined1 get-underlined) #f)
+(expect (send s-nonunderlined1 get-base-style) (send sl basic-style)) ; due to collpasing
+
+(define s-named-underlined (send sl new-named-style "underlined" s-underlined))
+(define s-nonunderlined (send sl find-or-create-style s-named-underlined d2))
+(expect (send s-nonunderlined get-underlined) #f)
+(expect (send s-nonunderlined get-base-style) s-named-underlined)
+
+(send d1 set-family 'modern)
+(define s-modern (send sl find-or-create-style s-plain d1))
+(expect (send s-modern get-underlined) #t)
+(expect (send s-modern get-family) 'modern)
+(expect (send s-plain get-family) 'default)
+
+(expect (send s-plain is-join?) #f)
+
+(define s-modern+nonunderlined (send sl find-or-create-join-style
+                                     s-modern
+                                     s-nonunderlined))
+(expect (send s-modern+nonunderlined get-underlined) #f)
+(expect (send s-modern+nonunderlined get-smoothing) 'partly-smoothed)
+(expect (send s-modern+nonunderlined get-family) 'modern)
+(expect (send s-modern+nonunderlined is-join?) #t)
+
+(send d2 set-smoothing-on 'base)
+(send s-nonunderlined set-delta d2)
+(expect (send s-nonunderlined get-smoothing) 'default)
+(expect (send s-modern+nonunderlined get-smoothing) 'default)
+
+(send d1 set-style-on 'italic)
+(send s-modern set-delta d1)
+(expect (send s-modern get-style) 'italic)
+(expect (send s-modern+nonunderlined get-style) 'italic)
+
+(expect (send s-plain get-alignment) 'bottom)
+(expect (send (send s-plain get-background) red) 255)
+(expect (send s-plain get-base-style) (send sl basic-style))
+(expect (send s-modern+nonunderlined get-base-style) s-modern)
+(expect (send s-plain get-face) #f)
+(expect (send s-plain get-name) #f)
+(expect (send s-plain get-shift-style) (send sl basic-style))
+(expect (send s-modern+nonunderlined get-shift-style) s-nonunderlined)
+(expect (send s-plain get-size-in-pixels) #f)
+(expect (send s-plain get-transparent-text-backing) #t)
+(expect (send s-plain get-weight) 'normal)
+
+(expect (send s-nonunderlined get-base-style) s-named-underlined)
+(send s-nonunderlined set-base-style s-modern+nonunderlined) ; would create cycle
+(expect (send s-nonunderlined get-base-style) s-named-underlined)
+
+(send s-modern+nonunderlined set-base-style s-plain)
+(expect (send s-modern+nonunderlined get-family) 'default)
+(expect (send s-modern+nonunderlined get-style) 'normal)
+
+(send s-modern+nonunderlined set-shift-style s-modern+nonunderlined) ; would create cycle
+
+(define sl2 (new style-list%))
+(define s2-modern (send sl2 convert s-modern))
+(expect (send s2-modern get-family) 'modern)
+
+;; ----------------------------------------
+;; Lines, positions, paragraphs
+
+(define t (new text%))
+(expect (send t get-text) "")
+(expect (send t last-position) 0)
+(expect (send t get-start-position) 0)
+(expect (send t get-end-position) 0)
+(expect (send t position-line 0) 0)
+(expect (send t position-paragraph 0) 0)
+
+(send t insert "hello")
+(expect (send t get-text) "hello")
+(expect (send t get-text 3) "lo")
+(expect (send t get-text 2 4) "ll")
+(expect (send t last-position) 5)
+(expect (send t last-line) 0)
+(expect (send t get-start-position) 5)
+(expect (send t get-end-position) 5)
+(expect (send t get-character 1) #\e)
+(expect (send t position-line 1) 0)
+(expect (send t position-paragraph 1) 0)
+
+(send t insert "!\nbye")
+(expect (send t get-text) "hello!\nbye")
+(expect (send t last-position) 10)
+(expect (send t line-length 0) 7)
+(expect (send t line-length 1) 3)
+(expect (send t last-line) 1)
+(expect (send t line-start-position 0) 0)
+(expect (send t line-start-position 1) 7)
+(expect (send t line-end-position 0) 6)
+(expect (send t position-line 0) 0)
+(expect (send t position-line 1) 0)
+(expect (send t position-line 6) 0)
+(expect (send t position-line 7 #t) 0)
+(expect (send t position-line 7) 1)
+(expect (send t position-line 10) 1)
+(expect (send t position-paragraph 1) 0)
+(expect (send t position-paragraph 6) 0)
+(expect (send t position-paragraph 7 #t) 1) ; no eol ambiguity for paragraphs
+(expect (send t position-paragraph 7) 1)
+(expect (send t position-paragraph 8) 1)
+(expect (send t get-start-position) 10)
+(expect (send t get-end-position) 10)
+
+(send t set-position 7 8)
+(expect (send t get-start-position) 7)
+(expect (send t get-end-position) 8)
+(expect
+ (let ([b (box 0)][e (box 0)])
+   (list
+    (begin (send t get-position b) (unbox b))
+    (begin (send t get-position #f e) (list (unbox b) (unbox e)))))
+ '(7 (7 8)))
+
+(send t insert ".\t," 2 4)
+(expect (send t get-text) "he.\t,o!\nbye")
+(expect (send t get-start-position) 8)
+(expect (send t get-end-position) 9)
+
+(send t insert "\n3\n" 10)
+(expect (send t get-text) "he.\t,o!\nby\n3\ne")
+(expect (send t last-line) 3)
+(expect (send t get-start-position) 8)
+(expect (send t get-end-position) 9)
+(send t set-position 100)
+(expect (send t get-start-position) 14)
+(expect (send t get-end-position) 14)
+(send t set-position 14)
+(expect (send t get-start-position) 14)
+(expect (send t get-end-position) 14)
+
+(send t delete (send t last-position))
+(expect (send t get-text) "he.\t,o!\nby\n3\n")
+(expect (send t last-line) 3)
+(expect (send t get-start-position) 13)
+(expect (send t get-end-position) 13)
+
+(send t insert "4" (send t last-position))
+(expect (send t get-text) "he.\t,o!\nby\n3\n4")
+(expect (send t last-line) 3)
+(send t delete 9 11)
+(expect (send t last-line) 2)
+(expect (send t get-text) "he.\t,o!\nb3\n4")
+
+(send t set-position 2 4)
+(send t delete)
+(expect (send t get-text) "he,o!\nb3\n4")
+(expect (send t last-line) 2)
+(expect (send t get-start-position) 2)
+(expect (send t get-end-position) 2)
+(expect (send t position-line 6) 1)
+(expect (send t position-line 7) 1)
+(expect (send t position-line 12) 2)
+
+(send t insert (make-object string-snip% "?") 2)
+(expect (send t get-text) "he?,o!\nb3\n4")
+
+(expect (send t find-string "o") 4)
+(expect (send t find-string "q") #f)
+(expect (send t find-string "\n") 6)
+(expect (send t find-string "\n" 'forward) 6)
+(expect (send t find-string "\n" 'forward 7) 9)
+(expect (send t find-string "\n" 'backward 7) 7)
+(expect (send t find-string "\n" 'backward 9) 7)
+(expect (send t find-string-all "\n") '(6 9))
+(expect (send t find-string-all "\n" 'forward 3 7) '(6))
+(expect (send t find-string-all "\n" 'backward 8 4) '(7))
+(expect (send t find-string-all "\n" 'backward 8 4 #f) '(6))
+(expect (send t find-string "\n4") 9)
+(expect (send t find-string "O") #f)
+(expect (send t find-string "O" 'forward 0 20 #t #f) 4)
+
+(expect (send t find-next-non-string-snip #f) #f)
+
+;; ----------------------------------------
+
+;; Insert very long strings to test max-string-length handling
+(send t delete 0 (send t last-position))
+(send t insert (make-string 256 #\a))
+(send t insert (make-string 256 #\a))
+(send t insert (make-string 256 #\a))
+(send t insert (make-string 256 #\a))
+(send t insert (make-string 1024 #\a))
+(expect (send t last-position) 2048)
+
+;; ----------------------------------------
+;; Moving and word boundaries
+
+(send t delete 0 (send t last-position))
+(send t insert "do you like\ngreen eggs and ham?")
+(expect (send t position-paragraph 0) 0)
+(expect (send t position-paragraph 12) 1)
+(expect (send t paragraph-start-position 1) 12)
+(expect (send t paragraph-start-position 2) 31)
+(expect (send t find-newline 'forward 0) 12)
+(expect (send t find-newline 'forward 12) 31)
+(expect (send t get-text) "do you like\ngreen eggs and ham?")
+(send t set-position 0)
+(send t move-position 'right #f 'word)
+(expect (send t get-start-position) 2)
+(send t move-position 'right #f 'word)
+(expect (send t get-start-position) 6)
+(send t move-position 'left #f 'word)
+(expect (send t get-start-position) 3)
+(send t move-position 'right #f 'word)
+(expect (send t get-start-position) 6)
+(send t move-position 'right #f 'word)
+(expect (send t get-start-position) 11)
+(send t move-position 'right #f 'simple)
+(send t move-position 'right #f 'word)
+(expect (send t get-start-position) 17)
+(send t set-position 11)
+(send t move-position 'right #f 'word)
+(expect (send t get-start-position) 17)
+
+(define (check-positions graphics?)
+  (define snips+counts
+    (let loop ([snip (send t find-first-snip)])
+      (if snip
+          (cons (cons snip (send snip get-count))
+                (loop (send snip next)))
+          null)))
+
+  (let ([x (box 0.0)]
+        [y (box 0.0)])
+    (let loop ([s+c snips+counts]
+               [pos 0])
+      (unless (null? s+c)
+        (let ([p (send t get-snip-position (caar s+c))])
+          (expect* p pos)
+          (let ([p2 (box 0)])
+            (when graphics?
+              (if (send t get-snip-position-and-location (caar s+c) p2 x y)
+                  (expect* (unbox p2) pos)
+                  (show (expect #f #t))))
+            (loop (cdr s+c) (+ pos (cdar s+c))))))))
+
+  (for-each 
+   (lambda (before)
+     (let loop ([pos 0][s+c snips+counts][snip-pos 0])
+       (if (null? s+c)
+           (show (expect pos (add1 (send t last-position))))
+           (let* ([s-pos (box 0)]
+                  [s (send t find-snip pos before s-pos)])
+             (let ([es (if (and (= pos 0) (eq? before 'before-or-none))
+                           #f
+                           (caar s+c))])
+               (expect* s es)
+               (expect* (unbox s-pos) snip-pos)
+               (let ([next? (= pos (+ snip-pos (cdar s+c)))])
+                 (loop (add1 pos)
+                       (if next?
+                           (cdr s+c)
+                           s+c)
+                       (if next?
+                           (+ snip-pos (cdar s+c))
+                           snip-pos))))))))
+   '(before before-or-none))
+
+  (for-each 
+   (lambda (after)
+     (let loop ([pos 0][s+c snips+counts][snip-pos 0][prev #f][prev-snip-pos 0])
+       (let* ([s-pos (box 0)]
+              [s (send t find-snip pos after s-pos)]
+              [end? (null? s+c)]
+              [es (if end?
+                      (if (eq? after 'after-or-none)
+                          #f
+                          (car prev))
+                      (caar s+c))]
+              [ep (if end? (if es prev-snip-pos 0) snip-pos)])
+         (expect* s es)
+         (expect* (unbox s-pos) ep)
+         (if end?
+             (show (expect pos (send t last-position)))
+             (let ([next? (= (add1 pos) (+ snip-pos (cdar s+c)))])
+               (loop (add1 pos)
+                     (if next?
+                         (cdr s+c)
+                         s+c)
+                     (if next?
+                         (+ snip-pos (cdar s+c))
+                         snip-pos)
+                     (car s+c)
+                     snip-pos))))))
+   '(after after-or-none)))
+
+(check-positions #f)
+
+;; ----------------------------------------
+;; Line flow
+
+;; Every character is 10.0 high, 10.0 wide, 1.0 descent, 1.0 top space
+(send t set-admin (new test-editor-admin%))
+
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (list (begin
+                  (send t position-location 1 x y)
+                  (list (unbox x) (unbox y)))
+                (begin
+                  (send t position-location 1 x y #f)
+                  (list (unbox x) (unbox y)))))
+        '((10.0 0.0) (10.0 10.0)))
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (list (begin
+                  (send t position-location 14 x y)
+                  (list (unbox x) (unbox y)))
+                (begin
+                  (send t position-location 14 x y #f)
+                  (list (unbox x) (unbox y)))))
+        '((20.0 11.0) (20.0 21.0)))
+(expect (let ([w (box 0.0)] [h (box 0.0)])
+          (send t get-extent w h)
+          (list (unbox w) (unbox h)))
+        '(192.0 22.0))
+
+(expect (send t find-position 0.0 0.0) 0)
+(expect (send t find-position 0.0 3.0) 0)
+(expect (send t find-position 10.0 0.0) 1)
+(expect (send t find-position 13.0 0.0) 1)
+(expect (send t find-position 0.0 12.0) 12)
+(expect (send t find-position 13.0 12.0) 13)
+(expect (send t find-position 13.0 23.0) 31)
+(expect (send t find-position 0.0 230.0) 31)
+(expect (send t find-position 300.0 2.0) 11)
+(expect (send t find-position -1.0 12.0) 12)
+(expect (send t find-position 109.0 2.0) 10)
+(expect (send t find-position 110.0 2.0) 11)
+(expect (let ([b (box #f)])
+          (send t find-position 1.0 12.0 #f b)
+          (unbox b))
+        #t)
+(expect (let ([b (box #f)]
+              [e (box 0.0)])
+          (send t find-position -1.0 12.0 #f b e)
+          (list (unbox b) (unbox e)))
+        '(#f 100.0))
+(expect (let ([b (box #f)]
+              [e (box 0.0)])
+          (list (send t find-position 109.0 2.0 #f b e)
+                (unbox b) 
+                (unbox e)))
+        '(10 #t 1.0))
+(expect (let ([b (box #f)]
+              [e (box 0.0)])
+          (list (send t find-position 102.0 2.0 #f b e)
+                (unbox b) 
+                (unbox e)))
+        '(10 #t -2.0))
+(expect (let ([b (box #f)]
+              [e (box 0.0)])
+          (list (send t find-position 110.0 2.0 #f b e)
+                (unbox b)
+                (unbox e)))
+        '(11 #f 100.0))
+(expect (send t find-position-in-line 0 14.0) 1)
+(expect (send t find-position-in-line 1 14.0) 13)
+
+(send t set-position 1 1)
+(send t move-position 'down #f 'line)
+(expect (send t get-start-position) 13)
+(send t move-position 'right #f 'simple)
+(send t move-position 'up #f 'line)
+(expect (send t get-start-position) 2)
+
+(check-positions #t)
+
+(send t set-max-width 71.0)
+
+(define (check-ge&h-flow)
+  (expect* (send t last-line) 6)
+  (expect* (send t line-start-position 0) 0)
+  (expect* (send t line-start-position 1) 3)
+  (expect* (send t line-start-position 2) 7)
+  (expect* (send t line-start-position 3) 12)
+  (expect* (send t line-start-position 4) 18)
+  (expect* (send t line-start-position 5) 23)
+  (expect* (send t line-start-position 6) 27)
+  (expect* (send t last-paragraph) 1)
+  (expect* (send t paragraph-start-position 0) 0)
+  (expect* (send t paragraph-end-position 0) 11)
+  (expect* (send t paragraph-start-position 1) 12)
+  (expect* (send t paragraph-end-position 1) 31)
+  (expect* (send t paragraph-start-position 2) 31)
+  (void))
+(check-ge&h-flow)
+
+(check-positions #t)
+
+(send t set-max-width 200.0)
+(expect (send t last-line) 1)
+
+(send t set-max-width 71.0)
+(check-ge&h-flow)
+
+(send t insert "Sir: " 0)
+(expect (send t last-line) 7)
+(expect (send t line-start-position 7) 32)
+(send t delete 0 5)
+(check-ge&h-flow)
+
+(define (check-line-starts)
+  (let ([lens (let loop ([snip (send t find-first-snip)][len 0])
+                (if snip
+                    (let ([len (+ len (send snip get-count))])
+                      (let ([s (send snip get-text 0 (send snip get-count))])
+                        (when (regexp-match? #rx"\n" s)
+                          (unless (and (memq 'hard-newline (send snip get-flags))
+                                       (string=? s "\n"))
+                            (error "embedded newline!")))
+                        (if (or (memq 'newline (send snip get-flags))
+                                (memq 'hard-newline (send snip get-flags)))
+                            (cons len (loop (send snip next) 0))
+                            (loop (send snip next) len))))
+                    (list len)))])
+    (for/fold ([pos 0]) ([i (in-range (add1 (send t last-line)))]
+                         [len (in-list lens)])
+      (expect* (send t line-start-position i #f) pos)
+      (expect* (send t line-end-position i #f) (+ pos len))
+      (+ pos len))))
+
+(for-each
+ (lambda (str)
+   ;; (printf ">> ~a <<\n" str)
+   (for ([i (in-range (add1 (send t last-position)))])
+     ;; (printf "~a\n" i)
+     (check-line-starts)
+     (send t insert str i)
+     (check-line-starts)
+     (send t last-line)
+     (send t delete i (+ i (string-length str)))
+     (check-line-starts)
+     (check-ge&h-flow)))
+ '(" a" "a " "qvzxw " " qvxzw" "qqq qqqq" "a\nb"))
+
+;; ----------------------------------------
+;; Undo
+
+(send t set-modified #f)
+(send t set-max-undo-history 100)
+(send t delete 0 3)
+(expect (send t get-text) "you like\ngreen eggs and ham?")
+(expect (send t modified?) #t)
+(send t undo)
+(expect (send t get-text) "do you like\ngreen eggs and ham?")
+(expect (send t modified?) #f)
+(send t redo)
+(expect (send t modified?) #t)
+(expect (send t get-text) "you like\ngreen eggs and ham?")
+(send t set-position 0)
+(send t insert #\d)
+(send t insert #\o)
+(send t insert #\space)
+(expect (send t get-text) "do you like\ngreen eggs and ham?")
+(send t undo)
+(expect (send t get-text) "you like\ngreen eggs and ham?")
+(send t redo)
+(expect (send t get-text) "do you like\ngreen eggs and ham?")
+
+(send t begin-edit-sequence)
+(send t delete 0 3)
+(send t delete (- (send t last-position) 4) (send t last-position))
+(send t end-edit-sequence)
+(expect (send t get-text) "you like\ngreen eggs and ")
+(send t delete 0 4)
+(expect (send t get-text) "like\ngreen eggs and ")
+(send t undo)
+(send t undo)
+(expect (send t get-text) "do you like\ngreen eggs and ham?")
+
+;; ----------------------------------------
+;; Stream out base
+
+(define fbo (make-object editor-stream-out-bytes-base%))
+(expect (send fbo tell) 0)
+(send fbo write-bytes #"abc")
+(expect (send fbo tell) 3)
+(expect (send fbo get-bytes) #"abc")
+(send fbo seek 2)
+(send fbo write-bytes #"012345" 1 4)
+(expect (send fbo tell) 5)
+(expect (send fbo get-bytes) #"ab123")
+(expect (send fbo bad?) #f)
+(send fbo write '(#\o #\l #\d))
+(expect (send fbo get-bytes) #"ab123old")
+
+;; ----------------------------------------
+;; Stream in base
+
+(define fbi (make-object editor-stream-in-bytes-base% #"ab123old"))
+(define ibuf (make-bytes 3))
+(expect (send fbi tell) 0)
+(send fbi read-bytes ibuf)
+(expect ibuf #"ab1")
+(expect (send fbi tell) 3)
+(send fbi seek 2)
+(send fbi read-bytes ibuf 1 2)
+(expect ibuf #"a11")
+(send fbi skip 2)
+(send fbi read-bytes ibuf 0 2)
+(expect ibuf #"ol1")
+(expect (send fbi bad?) #f)
+
+;; ----------------------------------------
+;; Stream writing
+
+(define fbo2 (make-object editor-stream-out-bytes-base%))
+(define fo (make-object editor-stream-out% fbo2))
+
+(expect (send fo tell) 0)
+(void (send fo put 2))
+(expect (send fbo2 get-bytes) #"\n2")
+(void (send fo put 2.0))
+(expect (send fbo2 get-bytes) #"\n2 2.0")
+(expect (send fo tell) 2)
+(send fo jump-to 0)
+(send fo put 3)
+(send fo jump-to 2)
+(expect (send fbo2 get-bytes) #"\n3 2.0")
+(void (send fo put #"hi"))
+(expect (send fbo2 get-bytes) #"\n3 2.0 3 #\"hi\\0\"")
+(void (send fo put 3 #"bye?"))
+(expect (send fbo2 get-bytes) #"\n3 2.0 3 #\"hi\\0\"\n3 #\"bye\"")
+(void (send fo put 80 #"0123456789abcdefghij0123456789ABCDEFGHIJ0123456789abcdefghij0123456\"89ABCDEFGHIJ"))
+(expect (send fbo2 get-bytes) 
+        (bytes-append
+         #"\n3 2.0 3 #\"hi\\0\"\n3 #\"bye\"\n80\n"
+         #"(\n"
+         #" #\"0123456789abcdefghij0123456789ABCDEFGHIJ0123456789abcdefghij0123456\"\n"
+         #" #\"\\\"89ABCDEFGHIJ\"\n"
+         #")"))
+
+(define fbo3 (make-object editor-stream-out-bytes-base%))
+(define fo3 (make-object editor-stream-out% fbo3))
+(void (send fo3 put 2))
+(expect (send fo3 tell) 1)
+(void (send fo3 put-fixed 5))
+(expect (send fo3 tell) 2)
+(void (send fo3 put-fixed -8))
+(void (send fo3 put 2 #"hi"))
+(expect (send fbo3 get-bytes) #"\n2           5          -8 2 #\"hi\"")
+(send fo3 jump-to 1)
+(void (send fo3 put-fixed -4))
+(send fo3 jump-to 2)
+(void (send fo3 put-fixed 7))
+(expect (send fbo3 get-bytes) #"\n2          -4           7 2 #\"hi\"")
+
+;; ----------------------------------------
+;; Stream reading
+
+(define fbi2 (make-object editor-stream-in-bytes-base% (bytes-append #"1 ; comment \n 2 "
+                                                                     #"#| | x # #|  |# q |# 4.0"
+                                                                     #" 2 #\"hi\""
+                                                                     #" 3 #\"hi\\\"\""
+                                                                     #" 23 ( #\"0123456789ABCDEFappl\" #\"e!\\0\" ) 88")))
+(define fi2 (make-object editor-stream-in% fbi2))
+
+(expect (send fi2 ok?) #t)
+(expect (send fi2 tell) 0)
+(expect (let ([b (box 0)]) (send fi2 get b) (unbox b)) 1)
+(expect (send fi2 ok?) #t)
+(expect (send fi2 tell) 1)
+(expect (let ([b (box 0)]) (send fi2 get b) (unbox b)) 2)
+(expect (send fi2 ok?) #t)
+(expect (let ([b (box 0.0)]) (send fi2 get b) (unbox b)) 4.0)
+(expect (send fi2 ok?) #t)
+(expect (send fi2 tell) 3)
+(expect (send fi2 get-unterminated-bytes) #"hi")
+(expect (send fi2 ok?) #t)
+(expect (send fi2 tell) 5)
+(expect (send fi2 get-unterminated-bytes) #"hi\"")
+(expect (send fi2 ok?) #t)
+(expect (send fi2 get-bytes) #"0123456789ABCDEFapple!")
+(expect (send fi2 ok?) #t)
+(expect (send fi2 tell) 9)
+
+(send fi2 jump-to 3)
+(expect (send fi2 tell) 3)
+(expect (send fi2 get-unterminated-bytes) #"hi")
+(send fi2 skip 4)
+(expect (let ([b (box 0)]) (send fi2 get b) (unbox b)) 88)
+(expect (send fi2 ok?) #t)
+(expect (send fi2 tell) 10)
+
+(send fi2 jump-to 3)
+(send fi2 set-boundary 5)
+(expect (send fi2 get-unterminated-bytes) #"hi")
+(send fi2 jump-to 3)
+(expect (send fi2 ok?) #t)
+(send fi2 set-boundary 4)
+(expect (send fi2 get-unterminated-bytes) #"")
+(expect (send fi2 ok?) #f)
+
+;; ----------------------------------------
+;; Save & load
+
+(send t delete 0 (send t last-position))
+(send t clear-undos)
+(send t insert "one\ntwo\n")
+(send t set-position 0 3)
+(send t copy #f 0)
+(send t set-position 8)
+(send t paste 0) ;; probably uses the snip% `copy' method
+(expect (send t get-text) "one\ntwo\none")
+(define (move-to-serialized-clipboard)
+  (let ([data (send the-clipboard get-clipboard-data "WXME" 0)])
+    (send the-clipboard set-clipboard-client
+          (new (class clipboard-client%
+                 (inherit add-type)
+                 (super-new)
+                 (add-type "WXME")
+                 (define/override (get-data format) data)))
+          0)))
+(move-to-serialized-clipboard)
+(send t paste 0) ;; uses above clipboard
+(expect (send t get-text) "one\ntwo\noneone")
+(send the-clipboard set-clipboard-string "\u3BB" 0)
+(send t paste 0)
+(expect (send t get-text) "one\ntwo\noneone\u3BB")
+
+(send t set-position 3 4)
+(send t copy #f 0)
+(send t set-position 4 7)
+(send t copy #t 0)
+(send t set-position (send t last-position))
+(send t paste 0)
+(expect (send t get-text) "one\ntwo\noneone\u3BB\ntwo")
+(send t paste-next)
+(expect (send t get-text) "one\ntwo\noneone\u3BBone")
+
+(send t cut #f 0 0 4)
+(expect (send t get-text) "two\noneone\u3BBone")
+
+(define-values (in7 out7) (make-pipe))
+(expect (send t save-port out7 'text) #t)
+(close-output-port out7)
+(expect (read-string 100 in7)  "two\noneone\u3BBone")
+
+(define out8 (open-output-bytes))
+(expect (send t save-port out8 'standard) #t)
+(define in8 (open-input-bytes (get-output-bytes out8)))
+(expect (peek-bytes 31 0 in8) #"#reader(lib\"read.ss\"\"wxme\")WXME")
+(send t erase)
+(expect (send t get-text) "")
+(expect (send t insert-port in8) 'standard)
+(expect (send t get-text) "two\noneone\u3BBone")
+
+;; ----------------------------------------
+;; Styles on text
+
+(define (check-color pos r g b w)
+  (let* ([s (send (send t find-snip pos 'after) get-style)]
+         [c (send s get-foreground)]
+         [f (send s get-font)])
+    (expect* (send c red) r)
+    (expect* (send c green) g)
+    (expect* (send c blue) b)
+    (expect* (send f get-weight) w)))
+
+(send t erase)
+(send t insert "red\nblue")
+(check-color 0 0 0 0 'normal)
+(let ([d (send (new style-delta%) set-delta-foreground (make-object color% 255 0 0))])
+  (send d set-weight-on 'bold)
+  (send t change-style d 0 3))
+(send t change-style
+      (send (new style-delta%) set-delta-foreground (make-object color% 0 0 255))
+      4 8)
+(check-color 0 255 0 0 'bold)
+(check-color 4 0 0 255 'normal)
+
+(define out9 (open-output-bytes))
+(expect (send t save-port out9 'standard) #t)
+(define in9 (open-input-bytes (get-output-bytes out9)))
+(send t erase)
+(expect (send t insert-port in9) 'standard)
+(expect (send t get-text) "red\nblue")
+(check-color 0 255 0 0 'bold)
+(check-color 4 0 0 255 'normal)
+
+(define (check-random-delta d)
+  (expect* (send d get-alignment-on) 'top)
+  (expect* (send d get-alignment-off) 'base)
+  (expect* (send (send d get-background-add) get-r) 25)
+  (expect* (send (send d get-background-add) get-g) 25)
+  (expect* (send (send d get-background-add) get-b) 25)
+  (expect* (send (send d get-background-mult) get-r) 0.5)
+  (expect* (send (send d get-background-mult) get-g) 0.5)
+  (expect* (send (send d get-background-mult) get-b) 0.5)
+  (expect* (send (send d get-foreground-add) get-r) 50)
+  (expect* (send (send d get-foreground-add) get-g) 50)
+  (expect* (send (send d get-foreground-add) get-b) 50)
+  (expect* (send (send d get-foreground-mult) get-r) 0.6)
+  (expect* (send (send d get-foreground-mult) get-g) 0.6)
+  (expect* (send (send d get-foreground-mult) get-b) 0.6)
+  (expect* (send d get-face) "Purty") 
+  (expect* (send d get-family) 'decorative)
+  (expect* (send d get-size-in-pixels-on) #t)
+  (expect* (send d get-size-in-pixels-off) #f)
+  (expect* (send d get-smoothing-off) 'smoothed)
+  (expect* (send d get-smoothing-on) 'base)
+  (expect* (send d get-style-on) 'italic)
+  (expect* (send d get-style-off) 'base)
+  (expect* (send d get-transparent-text-backing-on) #t)
+  (expect* (send d get-transparent-text-backing-off) #f)
+  (expect* (send d get-underlined-off) #t)
+  (expect* (send d get-underlined-on) #f)
+  (expect* (send d get-weight-on) 'light)
+  (expect* (send d get-weight-off) 'base))
+
+(let ([d (new style-delta%)])
+  (send d set-alignment-on 'top)
+  (send (send d get-background-add) set 25 25 25)
+  (send (send d get-background-mult) set 0.5 0.5 0.5)
+  (send (send d get-foreground-add) set 50 50 50)
+  (send (send d get-foreground-mult) set 0.6 0.6 0.6)
+  (send d set-delta-face "Purty" 'decorative)
+  (send d set-size-in-pixels-on #t)
+  (send d set-smoothing-off 'smoothed)
+  (send d set-style-on 'italic)
+  (send d set-transparent-text-backing-on #t)
+  (send d set-underlined-off #t)
+  (send d set-weight-on 'light)
+
+  (check-random-delta d)
+
+  (let* ([sl (send t get-style-list)]
+         [s (send sl find-or-create-style (send sl basic-style) d)])
+    (send t change-style s 0 1)))
+
+(define out10 (open-output-bytes))
+(expect (send t save-port out10 'standard) #t)
+(define in10 (open-input-bytes (get-output-bytes out10)))
+(send t erase)
+(expect (send t insert-port in10 'guess #t) 'standard)
+(expect (send t get-text) "red\nblue")
+(check-color 0 50 50 50 'light)
+(check-color 1 255 0 0 'bold)
+(check-color 4 0 0 255 'normal)
+
+(let ([d (new style-delta%)])
+  (send (send (send t find-first-snip) get-style) get-delta d)
+  (check-random-delta d))
+
+;; ----------------------------------------
+;; Keymaps
+
+(define km (new keymap%))
+(define hit #f)
+(define kevt (new key-event%))
+
+(send km add-function "letter-a" (lambda (obj evt) (set! hit #\a)))
+(send km add-function "letter-m" (lambda (obj evt) (set! hit #\m)))
+(send km add-function "letter-n" (lambda (obj evt) (set! hit #\n)))
+(send km add-function "letter-up" (lambda (obj evt) (set! hit 'up)))
+(send km add-function "letter-UP" (lambda (obj evt) (set! hit 'UP)))
+(send km add-function "letter-down" (lambda (obj evt) (set! hit 'down)))
+(send km add-function "letter-DOWN" (lambda (obj evt) (set! hit 'DOWN)))
+
+(send km map-function "a" "letter-a")
+(send kevt set-key-code #\x)
+(expect (send km handle-key-event 'obj kevt) #f)
+(send kevt set-key-code #\a)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit #\a)
+
+(send km map-function "up" "letter-up")
+(send kevt set-key-code 'up)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit 'up)
+(set! hit #f)
+(send kevt set-shift-down #t)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit 'up)
+
+(send km map-function "s:up" "letter-UP")
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit 'UP)
+
+(send km map-function ":down" "letter-down")
+(send kevt set-key-code 'down)
+(send kevt set-shift-down #f)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit 'down)
+(set! hit #f)
+(send kevt set-shift-down #t)
+(expect (send km handle-key-event 'obj kevt) #f)
+
+(send km map-function "s:down" "letter-DOWN")
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit 'DOWN)
+
+(expect (with-handlers ([values
+                         (lambda (exn)
+                           (and (regexp-match? #rx"mapped as a non-prefix key" (exn-message exn))
+                                'bad-remap))])
+          (send km map-function "s:down;z" "oops"))
+        'bad-remap)
+
+;; Check sequence
+(set! hit #f)
+(send km map-function "d;O" "letter-down")
+(send kevt set-shift-down #f)
+(send kevt set-key-code #\d)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit #f)
+(send kevt set-key-code #\o)
+(expect (send km handle-key-event 'obj kevt) #f)
+(send kevt set-shift-down #f)
+(send kevt set-key-code #\d)
+(expect (send km handle-key-event 'obj kevt) #t)
+(send kevt set-key-code #\O)
+(send kevt set-shift-down #t)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit 'down)
+
+;; Interrupt sequence
+(set! hit #f)
+(send kevt set-shift-down #f)
+(send kevt set-key-code #\d)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit #f)
+(send km break-sequence)
+(send kevt set-key-code #\O)
+(send kevt set-shift-down #t)
+(expect (send km handle-key-event 'obj kevt) #f)
+(expect hit #f)
+
+;; Check success with alternate, then override with more specific non-alternate
+(send kevt set-key-code #\m)
+(send kevt set-other-shift-key-code #\n)
+(send kevt set-shift-down #f)
+(send km map-function "?:n" "letter-n")
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit #\n)
+(send km map-function "?:m" "letter-m")
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit #\m)
+
+(define km2 (new keymap%))
+(send km chain-to-keymap km2 #t)
+
+;; Chained keymap more specific overrides less specific
+(send km2 add-function "letter-n2" (lambda (obj evt) (set! hit 'n2)))
+(send km2 map-function "n" "letter-n2")
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit #\m)
+(send kevt set-key-code #\n)
+(send kevt set-other-shift-key-code #\p)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit 'n2)
+
+;; Check sequence in chained keymap
+(send km2 add-function "letter-t" (lambda (obj evt) (set! hit #\t)))
+(send km2 map-function "c:x;t" "letter-t")
+(send kevt set-key-code #\x)
+(send kevt set-control-down #t)
+(send kevt set-other-shift-key-code #f)
+(set! hit #f)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit #f)
+(send kevt set-control-down #f)
+(send kevt set-key-code #\t)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit #\t)
+
+;; Chained keymap non-prefixed overrides prefixed
+(send km2 add-function "letter-d" (lambda (obj evt) (set! hit #\d)))
+(send km2 map-function "d" "letter-d")
+(send kevt set-key-code #\d)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit #\d)
+(send kevt set-key-code #\O)
+(send kevt set-shift-down #t)
+(expect (send km handle-key-event 'obj kevt) #f)
+(expect hit #\d)
+
+;; Remove chained keymap
+(send km remove-chained-keymap km2)
+(send kevt set-key-code #\d)
+(send kevt set-shift-down #f)
+(set! hit #f)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit #f)
+(send kevt set-key-code #\O)
+(send kevt set-shift-down #t)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit 'down)
+
+;; Key grab
+(send kevt set-key-code #\m)
+(send kevt set-shift-down #f)
+(send km set-grab-key-function (lambda (str km-in ed evt)
+                                 (expect* km-in km)
+                                 (expect* evt kevt)
+                                 (set! hit (list str ed))
+                                 #t))
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit '("letter-m" obj))
+(send kevt set-key-code #\p)
+(expect (send km handle-key-event 'obj kevt) #t)
+(expect hit '(#f obj))
+(send km set-grab-key-function (lambda (str km-in ed evt)
+                                 (expect* str "letter-m")
+                                 (expect* ed 'obj2)
+                                 (set! hit 'nope)
+                                 #f))
+(send kevt set-key-code #\m)
+(expect (send km handle-key-event 'obj2 kevt) #t)
+(expect hit #\m)
+(send km set-grab-key-function (lambda (str km-in ed evt)
+                                 (expect* str #f)
+                                 (expect* ed 'obj3)
+                                 (set! hit 'nope)
+                                 #f))
+(send kevt set-key-code #\p)
+(expect (send km handle-key-event 'obj3 kevt) #f)
+(expect hit 'nope)
+
+;; Mouse events
+(define mevt/l (new mouse-event% [event-type 'left-down]))
+(send mevt/l set-left-down #t)
+(send km add-function "mouse-right" (lambda (obj evt) (set! hit 'right)))
+(send km add-function "mouse-left" (lambda (obj evt) (set! hit 'left)))
+(send km add-function "mouse-left2" (lambda (obj evt) (set! hit 'left2)))
+
+(expect (send km handle-mouse-event 'obj mevt/l) #f)
+(send mevt/l set-time-stamp 501) ;; FIXME: depends on double-click time
+(send km map-function "leftbutton" "mouse-left")
+(send km map-function "leftbuttondouble" "mouse-left2")
+(expect (send km handle-mouse-event 'obj mevt/l) #t)
+(expect hit 'left)
+(expect (send km handle-mouse-event 'obj mevt/l) #t)
+(expect hit 'left2)
+(expect (send km handle-mouse-event 'obj mevt/l) #t)
+(expect hit 'left)
+(send mevt/l set-time-stamp 10100)
+(expect (send km handle-mouse-event 'obj mevt/l) #t)
+(expect hit 'left)
+
+(set! hit #f)
+(send km map-function "rightbuttonseq" "mouse-right")
+(define mevt/r (new mouse-event% [event-type 'right-down]))
+(send mevt/r set-right-down #t)
+(define mevt/r/up (new mouse-event% [event-type 'right-up]))
+(expect (send km handle-mouse-event 'obj mevt/r) #t)
+(expect hit 'right)
+(set! hit #f)
+(expect (send km handle-mouse-event 'obj mevt/r/up) #t)
+(expect hit 'right)
+
+(send km set-grab-mouse-function (lambda (str km-in ed evt)
+                                   (set! hit 'm)
+                                   #t))
+(define mevt/m (new mouse-event% [event-type 'middle-down]))
+(send mevt/m set-middle-down #t)
+(expect (send km handle-mouse-event 'obj mevt/m) #t)
+(expect hit 'm)
+(send km remove-grab-mouse-function)
+(expect (send km handle-mouse-event 'obj mevt/m) #f)
+
+;; ----------------------------------------
+;; editor snips, content
+
+(define oe (new text%))
+(define ie (new text%))
+(define es (new editor-snip% [editor ie]))
+(send ie insert "Hello")
+(send oe insert es)
+
+(expect (send oe get-text 0 'eof #f) ".")
+(expect (send oe get-flattened-text) "Hello")
+
+(send es show-border #t)
+(expect (send es border-visible?) #t)
+(send es set-margin 1 2 3 4)
+(define (check-border es)
+  (let ([l (box 0)][t (box 0)][r (box 0)][b (box 0)])
+    (send es get-margin l t r b)
+    (expect (list (unbox l) (unbox t) (unbox r) (unbox b))
+            (list 1 2 3 4))))
+(check-border es)
+
+(send oe set-position 0 1)
+(send oe copy #f 0)
+(send oe set-position 1)
+(send oe paste 0) ;; probably uses the snip% `copy' method
+(expect (send oe last-position) 2)
+(define es2 (send oe find-snip 1 'after-or-none))
+(check-border es2)
+(move-to-serialized-clipboard)
+(send oe paste 0) ;; uses above clipboard
+(define es3 (send oe find-snip 2 'after-or-none))
+(check-border es3)
+(expect (send es3 border-visible?) #t)
+(expect (send es3 get-align-top-line) #f)
+
+(send (send es2 get-editor) insert "zzz" 2 2)
+(expect (send oe get-text 0 'eof #f) "...")
+(expect (send oe get-flattened-text) "HelloHezzzlloHello")
+
+(send oe insert "a\n" 0)
+(send oe insert "\nb" (send oe last-position))
+(expect (send oe get-flattened-text) "a\nHelloHezzzlloHello\nb")
+
+;; ----------------------------------------
+;; editor snips, locations
+
+(send oe set-admin (new test-editor-admin%))
+(expect (let ([w (box 0.0)] [h (box 0.0)])
+          (send oe get-extent w h)
+          (list (unbox w) (unbox h)))
+        '(197.0 40.0))
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (list (begin
+                  (send oe position-location 0 x y)
+                  (list (unbox x) (unbox y)))
+                (begin
+                  (send oe position-location 1 x y #f)
+                  (list (unbox x) (unbox y)))))
+        '((0.0 0.0) (10.0 10.0)))
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (list (begin
+                  (send oe position-location 2 x y)
+                  (list (unbox x) (unbox y)))
+                (begin
+                  (send oe position-location 3 x y #f)
+                  (list (unbox x) (unbox y)))))
+        '((0.0 11.0) (55.0 28.0)))
+
+(send (send es2 get-editor) insert "\nmore" 100)
+(expect (let ([w (box 0.0)] [h (box 0.0)])
+          (send oe get-extent w h)
+          (list (unbox w) (unbox h)))
+        '(197.0 51.0))
+
+;; ----------------------------------------
+;; Pasteboard
+
+(define pb (new pasteboard%))
+(expect (send pb find-first-snip) #f)
+(expect (send pb find-snip 10.0 10.0) #f)
+(expect (let ([w (box 0.0)] [h (box 0.0)])
+          (send pb get-extent w h)
+          (list (unbox w) (unbox h)))
+        '(0.0 0.0))
+
+(define ss1 (new string-snip%))
+(send ss1 insert "one" 3)
+(send pb insert ss1 12.0 17.5)
+(expect (send pb find-first-snip) ss1)
+(expect (send pb get-flattened-text) "one")
+
+(define ss2 (new string-snip%))
+(send ss2 insert "two!" 4)
+(send pb insert ss2 ss1 32.0 7.5)
+(expect (send pb find-first-snip) ss2)
+(expect (send pb get-flattened-text) "two!one")
+(send pb lower ss2)
+(expect (send pb get-flattened-text) "onetwo!")
+(send pb raise ss2)
+(expect (send pb get-flattened-text) "two!one")
+
+(send pb set-admin (new test-editor-admin%))
+(expect (let ([w (box 0.0)] [h (box 0.0)])
+          (send pb get-extent w h)
+          (list (unbox w) (unbox h)))
+        '(74.0 29.5))
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (send pb get-snip-location ss2 x y #t)
+          (list (unbox x) (unbox y)))
+        '(72.0 17.5))
+(send ss2 insert "more" 4 3)
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (send pb get-snip-location ss2 x y #t)
+          (list (unbox x) (unbox y)))
+        '(112.0 17.5))
+(expect (send pb get-flattened-text) "twomore!one")
+
+(send pb no-selected)
+(expect (send pb find-next-selected-snip #f) #f)
+(send pb add-selected ss1)
+(expect (send pb find-next-selected-snip #f) ss1)
+(expect (send pb find-next-selected-snip ss1) #f)
+(send pb no-selected)
+(send pb add-selected 0.0 0.0 10.0 10.0)
+(expect (send pb find-next-selected-snip #f) #f)
+(send pb add-selected 10.0 10.0 20.0 20.0)
+(expect (send pb find-next-selected-snip #f) ss1)
+(expect (send pb find-next-selected-snip ss1) #f)
+(send pb add-selected 10.0 10.0 40.0 40.0)
+(expect (send pb find-next-selected-snip #f) ss2)
+(expect (send pb find-next-selected-snip ss2) ss1)
+
+(send pb set-max-undo-history 10)
+
+(send pb move 3 4)
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (send pb get-snip-location ss1 x y #f)
+          (list (unbox x) (unbox y)))
+        '(15.0 21.5))
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (send pb get-snip-location ss2 x y #f)
+          (list (unbox x) (unbox y)))
+        '(35.0 11.5))
+(send pb undo)
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (send pb get-snip-location ss1 x y #f)
+          (list (unbox x) (unbox y)))
+        '(12.0 17.5))
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (send pb get-snip-location ss2 x y #f)
+          (list (unbox x) (unbox y)))
+        '(32.0 7.5))
+
+(send pb remove-selected ss1)
+(expect (send pb find-snip 15.0 20.0) ss1)
+(expect (send pb find-snip 35.0 10.0) ss2)
+(expect (send pb find-first-snip) ss2)
+(send pb delete) "delete"
+(expect (send pb find-first-snip) ss1)
+(expect (send pb find-snip 15.0 20.0) ss1)
+(expect (send pb find-snip 35.0 10.0) #f)
+(send pb undo) "undo"
+(expect (send pb find-first-snip) ss2)
+(expect (send pb find-snip 35.0 10.0) ss2)
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (send pb get-snip-location ss2 x y #f)
+          (list (unbox x) (unbox y)))
+        '(32.0 7.5))
+
+(define out20 (open-output-bytes))
+(expect (send pb save-port out20 'standard) #t)
+(define in20 (open-input-bytes (get-output-bytes out20)))
+(expect (peek-bytes 31 0 in20) #"#reader(lib\"read.ss\"\"wxme\")WXME")
+
+(define t10 (make-object text%))
+(expect (send t10 insert-port in20) 'standard)
+(expect (send t10 get-flattened-text) "twomore!one")
+
+(define in21 (open-input-bytes (get-output-bytes out20)))
+(define pb2 (make-object pasteboard%))
+(expect (send pb2 insert-port in21) 'standard)
+(expect (send pb2 get-flattened-text) "twomore!one")
+(expect (let ([x (box 0.0)] [y (box 0.0)])
+          (send pb2 get-snip-location (send pb2 find-first-snip) x y #f)
+          (list (unbox x) (unbox y)))
+        '(32.0 7.5))
+
+;; ----------------------------------------
+
+(done)