fixed up the framework docs so there are no more warnings

svn: r9810

collects/framework/decorated-editor-snip.ss

@@ -1,241 +1,9 @@
 #lang scheme/base
 
-(require scheme/gui/base
+(require "private/decorated-editor-snip.ss")
-         scheme/class)
 
-#;
+(provide 
-(provide editor-snip:decorated%
+ (rename-out [editor-snip:decorated% decorated-editor-snip%])
-         editor-snip:decorated-snipclass
+ (rename-out [editor-snip:decorated-snipclass decorated-editor-snipclass%])
-         editor-snip:decorated-editor-snip-mixin
+ (rename-out [editor-snip:decorated-mixin decorated-editor-snip-mixin])
-         decorated-editor-snip<%>)
+ (rename-out [editor-snip:decorated<%> decorated-editor-snip<%>]))
-
-(provide decorated-editor-snip%
-         decorated-editor-snipclass%
-         decorated-editor-snip-mixin
-         decorated-editor-snip<%>)
-
-(require "preferences.ss")
-
-(define decorated-editor-snip<%>
-  (interface ((class->interface editor-snip%))
-    get-corner-bitmap get-color get-menu get-position reset-min-sizes))
-
-(define decorated-editor-snip-mixin
-  (mixin ((class->interface editor-snip%)) (decorated-editor-snip<%>)
-    
-    ;; get-corner-bitmap : -> (union #f (is-a?/c bitmap%))
-    ;; returns the bitmap to be shown in the top right corner.
-    (define/public (get-corner-bitmap) #f)
-    
-    ;; get-color : -> (union string (is-a?/c color%))
-    (define/public (get-color) (if (preferences:get 'framework:white-on-black?) "white" "black"))
-    
-    ;; get-menu : -> (union #f (is-a?/c popup-menu%))
-    ;; returns the popup menu that should appear
-    ;; when clicking in the top part of the snip.
-    (define/public (get-menu) #f)
-    
-    ;; get-position : -> (union 'top-right 'left-top)
-    ;; returns the location of the image and the clickable
-    ;; region. 'top-right indicates top portion is clickable
-    ;; and icon on right. 'left-top means left portion is
-    ;; clickable and icon on top.
-    (define/public (get-position) 'top-right)
-    
-    [define/private (get-pen) (send the-pen-list find-or-create-pen (get-color) 1 'solid)]
-    [define/private (get-brush) (send the-brush-list find-or-create-brush "BLACK" 'transparent)]
-    
-    (inherit get-admin)
-    (define/override (on-event dc x y editorx editory evt)
-      (cond
-        [(eq? (send evt get-event-type) 'right-down)
-         (let ([sx (- (send evt get-x) x)]
-               [sy (- (send evt get-y) y)]
-               [bil (box 0)]
-               [bit (box 0)]
-               [bir (box 0)]
-               [bib (box 0)]
-               [bw (box 0)]
-               [bh (box 0)]
-               [bml (box 0)]
-               [bmt (box 0)]
-               [bmr (box 0)]
-               [bmb (box 0)]
-               [menu (get-menu)])
-           (get-extent dc x y bw bh #f #f #f #f)
-           (get-inset bil bit bir bib)
-           (get-margin bml bmt bmr bmb)
-           (let ([in-range
-                  (case (get-position)
-                    [(top-right)
-                     (and (<= 0 sx (unbox bw))
-                          (<= 0 sy (unbox bmt)))]
-                    [(left-top)
-                     (and (<= 0 sx (unbox bml))
-                          (<= 0 sy (unbox bh)))]
-                    [else #f])])
-             (cond
-               [(and menu in-range)
-                (let ([admin (get-admin)])
-                  (when admin
-                    (send admin popup-menu menu this (+ sx 1) (+ sy 1))))]
-               [else (super on-event dc x y editorx editory evt)])))]
-        [else
-         (super on-event dc x y editorx editory evt)]))
-    
-    (inherit get-extent get-inset)
-    (define/override (draw dc x y left top right bottom dx dy draw-caret)
-      (let ([bm (get-corner-bitmap)]
-            [bil (box 0)]
-            [bit (box 0)]
-            [bir (box 0)]
-            [bib (box 0)]
-            [bw (box 0)]
-            [bh (box 0)]
-            [bml (box 0)]
-            [bmt (box 0)]
-            [bmr (box 0)]
-            [bmb (box 0)])
-        (get-extent dc x y bw bh #f #f #f #f)
-        (get-inset bil bit bir bib)
-        (get-margin bml bmt bmr bmb)
-        (super draw dc x y left top right bottom dx dy draw-caret)
-        (let* ([old-pen (send dc get-pen)]
-               [old-brush (send dc get-brush)]
-               [white-on-black? (preferences:get 'framework:white-on-black?)])
-          
-          (send dc set-pen (send the-pen-list find-or-create-pen 
-                                 (if white-on-black? "black" "white")
-                                 1
-                                 'transparent))
-          (send dc set-brush (send the-brush-list find-or-create-brush 
-                                   (if white-on-black? "black" "white")
-                                   'solid))
-          (case (get-position)
-            [(top-right)
-             (send dc draw-rectangle 
-                   (+ x (unbox bml))
-                   (+ y (unbox bit))
-                   (max 0 (- (unbox bw) (unbox bml) (unbox bmr)))
-                   (- (unbox bmt) (unbox bit)))]
-            [(left-top)
-             (send dc draw-rectangle 
-                   (+ x (unbox bil))
-                   (+ y (unbox bmt))
-                   (- (unbox bml) (unbox bil))
-                   (max 0 (- (unbox bh) (unbox bmt) (unbox bmb))))])
-          
-          (send dc set-pen (send the-pen-list find-or-create-pen
-                                 (if white-on-black? "white" "black")
-                                 1
-                                 'solid))
-          (send dc set-brush (send the-brush-list find-or-create-brush 
-                                   (if white-on-black? "white" "black")
-                                   'solid))
-          
-          (when bm
-            (let ([bm-w (send bm get-width)]
-                  [bm-h (send bm get-height)])
-              (case (get-position)
-                [(top-right)
-                 (send dc draw-bitmap
-                       bm
-                       (+ x (max 0
-                                 (- (unbox bw)
-                                    (unbox bmr)
-                                    bm-w)))
-                       ;; leave two pixels above and two below (see super-instantiate below)
-                       (+ y (unbox bit) 2))]
-                [(left-top)
-                 (send dc draw-bitmap
-                       bm
-                       ;; leave two pixels left and two right (see super-instantiate below)
-                       (+ x (unbox bil) 2)
-                       (+ y (unbox bmt)))])))
-          
-          (send dc set-pen (get-pen))
-          (send dc set-brush (get-brush))
-          (send dc draw-rectangle
-                (+ x (unbox bil))
-                (+ y (unbox bit))
-                (max 0 (- (unbox bw) (unbox bil) (unbox bir)))
-                (max 0 (- (unbox bh) (unbox bit) (unbox bib))))
-          
-          (send dc set-pen old-pen)
-          (send dc set-brush old-brush))))
-    
-    (inherit set-min-width set-min-height get-margin)
-    (define/public (reset-min-sizes)
-      (let ([bm (get-corner-bitmap)])
-        (when bm
-          (case (get-position)
-            [(top-right)
-             (set-min-width (+ 4 (send bm get-width)))]
-            [(left-top)
-             (set-min-height (+ 4 (send bm get-height)))]))))
-    
-    (let ([top-margin 
-           (case (get-position)
-             [(top-right)
-              (+ 4 
-                 (let ([bm (get-corner-bitmap)])
-                   (if bm
-                       (send bm get-height)
-                       0)))]
-             [else 4])]
-          [left-margin
-           (case (get-position)
-             [(left-top)
-              (+ 4
-                 (let ([bm (get-corner-bitmap)])
-                   (if bm
-                       (send bm get-width)
-                       0)))]
-             [else 4])])
-      (super-new
-       (with-border? #f)
-       (top-margin top-margin)
-       (left-margin left-margin)))
-    
-    (inherit use-style-background)
-    (use-style-background #t)
-    
-    (reset-min-sizes)))
-
-(define decorated-editor-snip%
-  (class (decorated-editor-snip-mixin editor-snip%)
-    (inherit get-editor get-style)
-    
-    ;; make-snip : -> this%
-    ;; returns an instance of this class. used in the copy method
-    (define/public (make-snip) (make-object decorated-editor-snip%))
-    
-    ;; make-editor : -> editor<%>
-    ;; returns the editor to be used in this snip.
-    (define/public (make-editor) (make-object text%))
-    
-    (define/override write
-      (λ (stream-out)
-        (send (get-editor) write-to-file stream-out 0 'eof)))
-    
-    (define/override (copy)
-      (let ([snip (make-snip)])
-        (send snip set-editor (send (get-editor) copy-self))
-        (send snip set-style (get-style))
-        snip))
-    
-    (super-new
-     (editor (make-editor)))))
-
-(define decorated-editor-snipclass%
-  (class snip-class%
-    
-    ;; make-snip : stream-in -> (is-a?/c snip%)
-    ;; returns an unfilled version of the snip
-    (define/public (make-snip stream-in) (make-object decorated-editor-snip%))
-    
-    (define/override (read stream-in)
-      (let ([snip (make-snip stream-in)])
-        (send (send snip get-editor) read-from-file stream-in #f)
-        snip))
-    (super-new)))

collects/framework/main.ss

@@ -11,12 +11,14 @@
 (require framework/preferences
          framework/test
          framework/gui-utils
-         framework/decorated-editor-snip)
+         framework/decorated-editor-snip
+         framework/private/decorated-editor-snip)
 
 (provide (all-from-out framework/preferences
                        framework/test
                        framework/gui-utils
-                       framework/decorated-editor-snip))
+                       framework/decorated-editor-snip
+                       framework/private/decorated-editor-snip))
 
 (require/doc scheme/base scribble/manual framework/private/mapdesc)
 
@@ -424,9 +426,7 @@
     (parent (finder:dialog-parent-parameter))))
   @{This procedure queries the user for a single filename, using a
          platform-independent dialog box.  Consider using
-         @scheme[finder:put-file] instead of this function.
+         @scheme[finder:put-file] instead of this function.})
-         
-         See section @secref{selecting-a-filename} for more information.})
  
  (proc-doc/names
   finder:common-get-file
@@ -445,9 +445,7 @@
     (parent #f)))
   @{This procedure queries the user for a single filename, using a
          platform-independent dialog box.  Consider using
-         @scheme[finder:get-file] instead of this function.
+         @scheme[finder:get-file] instead of this function.})
-         
-         See section @secref{selecting-a-filename} for more information.})
  
  (proc-doc/names
   finder:std-put-file
@@ -470,9 +468,7 @@
     (parent (finder:dialog-parent-parameter))))
   @{This procedure queries the user for a single filename, using a
          platform-dependent dialog box.  Consider using
-         @scheme[finder:put-file] instead of this function.
+         @scheme[finder:put-file] instead of this function.})
-         
-         See section @secref{selecting-a-filename} for more information.})
  
  (proc-doc/names
   finder:std-get-file
@@ -491,9 +487,7 @@
     (parent #f)))
   @{This procedure queries the user for a single filename, using a
          platform-dependent dialog box.  Consider using
-         @scheme[finder:get-file] instead of this function.
+         @scheme[finder:get-file] instead of this function.})
-         
-         See section @secref{selecting-a-filename} for more information.})
  
  (proc-doc/names
   finder:put-file
@@ -557,9 +551,7 @@
     (filter-msg "That filename does not have the right form.")
     (parent #f)))
   @{This procedure queries the user for a list of filenames, using a
-         platform-independent dialog box.
+         platform-independent dialog box.})
-         
-         See @secref{selecting-a-filename} for more information.})
  
  (proc-doc/names
   frame:setup-size-pref

collects/framework/private/decorated-editor-snip.ss

@@ -0,0 +1,240 @@
+#lang scheme/base
+
+(require scheme/gui/base
+         scheme/class)
+
+
+(provide editor-snip:decorated%
+         editor-snip:decorated-snipclass
+         editor-snip:decorated-mixin
+         editor-snip:decorated<%>)
+
+(require "../preferences.ss")
+
+(define editor-snip:decorated<%>
+  (interface ((class->interface editor-snip%))
+    get-corner-bitmap
+    get-color
+    get-menu
+    get-position
+    reset-min-sizes))
+
+(define editor-snip:decorated-mixin
+  (mixin ((class->interface editor-snip%)) (editor-snip:decorated<%>)
+    
+    ;; get-corner-bitmap : -> (union #f (is-a?/c bitmap%))
+    ;; returns the bitmap to be shown in the top right corner.
+    (define/public (get-corner-bitmap) #f)
+    
+    ;; get-color : -> (union string (is-a?/c color%))
+    (define/public (get-color) (if (preferences:get 'framework:white-on-black?) "white" "black"))
+    
+    ;; get-menu : -> (union #f (is-a?/c popup-menu%))
+    ;; returns the popup menu that should appear
+    ;; when clicking in the top part of the snip.
+    (define/public (get-menu) #f)
+    
+    ;; get-position : -> (union 'top-right 'left-top)
+    ;; returns the location of the image and the clickable
+    ;; region. 'top-right indicates top portion is clickable
+    ;; and icon on right. 'left-top means left portion is
+    ;; clickable and icon on top.
+    (define/public (get-position) 'top-right)
+    
+    [define/private (get-pen) (send the-pen-list find-or-create-pen (get-color) 1 'solid)]
+    [define/private (get-brush) (send the-brush-list find-or-create-brush "BLACK" 'transparent)]
+    
+    (inherit get-admin)
+    (define/override (on-event dc x y editorx editory evt)
+      (cond
+        [(eq? (send evt get-event-type) 'right-down)
+         (let ([sx (- (send evt get-x) x)]
+               [sy (- (send evt get-y) y)]
+               [bil (box 0)]
+               [bit (box 0)]
+               [bir (box 0)]
+               [bib (box 0)]
+               [bw (box 0)]
+               [bh (box 0)]
+               [bml (box 0)]
+               [bmt (box 0)]
+               [bmr (box 0)]
+               [bmb (box 0)]
+               [menu (get-menu)])
+           (get-extent dc x y bw bh #f #f #f #f)
+           (get-inset bil bit bir bib)
+           (get-margin bml bmt bmr bmb)
+           (let ([in-range
+                  (case (get-position)
+                    [(top-right)
+                     (and (<= 0 sx (unbox bw))
+                          (<= 0 sy (unbox bmt)))]
+                    [(left-top)
+                     (and (<= 0 sx (unbox bml))
+                          (<= 0 sy (unbox bh)))]
+                    [else #f])])
+             (cond
+               [(and menu in-range)
+                (let ([admin (get-admin)])
+                  (when admin
+                    (send admin popup-menu menu this (+ sx 1) (+ sy 1))))]
+               [else (super on-event dc x y editorx editory evt)])))]
+        [else
+         (super on-event dc x y editorx editory evt)]))
+    
+    (inherit get-extent get-inset)
+    (define/override (draw dc x y left top right bottom dx dy draw-caret)
+      (let ([bm (get-corner-bitmap)]
+            [bil (box 0)]
+            [bit (box 0)]
+            [bir (box 0)]
+            [bib (box 0)]
+            [bw (box 0)]
+            [bh (box 0)]
+            [bml (box 0)]
+            [bmt (box 0)]
+            [bmr (box 0)]
+            [bmb (box 0)])
+        (get-extent dc x y bw bh #f #f #f #f)
+        (get-inset bil bit bir bib)
+        (get-margin bml bmt bmr bmb)
+        (super draw dc x y left top right bottom dx dy draw-caret)
+        (let* ([old-pen (send dc get-pen)]
+               [old-brush (send dc get-brush)]
+               [white-on-black? (preferences:get 'framework:white-on-black?)])
+          
+          (send dc set-pen (send the-pen-list find-or-create-pen 
+                                 (if white-on-black? "black" "white")
+                                 1
+                                 'transparent))
+          (send dc set-brush (send the-brush-list find-or-create-brush 
+                                   (if white-on-black? "black" "white")
+                                   'solid))
+          (case (get-position)
+            [(top-right)
+             (send dc draw-rectangle 
+                   (+ x (unbox bml))
+                   (+ y (unbox bit))
+                   (max 0 (- (unbox bw) (unbox bml) (unbox bmr)))
+                   (- (unbox bmt) (unbox bit)))]
+            [(left-top)
+             (send dc draw-rectangle 
+                   (+ x (unbox bil))
+                   (+ y (unbox bmt))
+                   (- (unbox bml) (unbox bil))
+                   (max 0 (- (unbox bh) (unbox bmt) (unbox bmb))))])
+          
+          (send dc set-pen (send the-pen-list find-or-create-pen
+                                 (if white-on-black? "white" "black")
+                                 1
+                                 'solid))
+          (send dc set-brush (send the-brush-list find-or-create-brush 
+                                   (if white-on-black? "white" "black")
+                                   'solid))
+          
+          (when bm
+            (let ([bm-w (send bm get-width)]
+                  [bm-h (send bm get-height)])
+              (case (get-position)
+                [(top-right)
+                 (send dc draw-bitmap
+                       bm
+                       (+ x (max 0
+                                 (- (unbox bw)
+                                    (unbox bmr)
+                                    bm-w)))
+                       ;; leave two pixels above and two below (see super-instantiate below)
+                       (+ y (unbox bit) 2))]
+                [(left-top)
+                 (send dc draw-bitmap
+                       bm
+                       ;; leave two pixels left and two right (see super-instantiate below)
+                       (+ x (unbox bil) 2)
+                       (+ y (unbox bmt)))])))
+          
+          (send dc set-pen (get-pen))
+          (send dc set-brush (get-brush))
+          (send dc draw-rectangle
+                (+ x (unbox bil))
+                (+ y (unbox bit))
+                (max 0 (- (unbox bw) (unbox bil) (unbox bir)))
+                (max 0 (- (unbox bh) (unbox bit) (unbox bib))))
+          
+          (send dc set-pen old-pen)
+          (send dc set-brush old-brush))))
+    
+    (inherit set-min-width set-min-height get-margin)
+    (define/public (reset-min-sizes)
+      (let ([bm (get-corner-bitmap)])
+        (when bm
+          (case (get-position)
+            [(top-right)
+             (set-min-width (+ 4 (send bm get-width)))]
+            [(left-top)
+             (set-min-height (+ 4 (send bm get-height)))]))))
+    
+    (let ([top-margin 
+           (case (get-position)
+             [(top-right)
+              (+ 4 
+                 (let ([bm (get-corner-bitmap)])
+                   (if bm
+                       (send bm get-height)
+                       0)))]
+             [else 4])]
+          [left-margin
+           (case (get-position)
+             [(left-top)
+              (+ 4
+                 (let ([bm (get-corner-bitmap)])
+                   (if bm
+                       (send bm get-width)
+                       0)))]
+             [else 4])])
+      (super-new
+       (with-border? #f)
+       (top-margin top-margin)
+       (left-margin left-margin)))
+    
+    (inherit use-style-background)
+    (use-style-background #t)
+    
+    (reset-min-sizes)))
+
+(define editor-snip:decorated%
+  (class (editor-snip:decorated-mixin editor-snip%)
+    (inherit get-editor get-style)
+    
+    ;; make-snip : -> this%
+    ;; returns an instance of this class. used in the copy method
+    (define/public (make-snip) (make-object editor-snip:decorated%))
+    
+    ;; make-editor : -> editor<%>
+    ;; returns the editor to be used in this snip.
+    (define/public (make-editor) (make-object text%))
+    
+    (define/override write
+      (λ (stream-out)
+        (send (get-editor) write-to-file stream-out 0 'eof)))
+    
+    (define/override (copy)
+      (let ([snip (make-snip)])
+        (send snip set-editor (send (get-editor) copy-self))
+        (send snip set-style (get-style))
+        snip))
+    
+    (super-new
+     (editor (make-editor)))))
+
+(define editor-snip:decorated-snipclass
+  (class snip-class%
+    
+    ;; make-snip : stream-in -> (is-a?/c snip%)
+    ;; returns an unfilled version of the snip
+    (define/public (make-snip stream-in) (make-object editor-snip:decorated%))
+    
+    (define/override (read stream-in)
+      (let ([snip (make-snip stream-in)])
+        (send (send snip get-editor) read-from-file stream-in #f)
+        snip))
+    (super-new)))

collects/framework/private/mode.ss

@@ -1,14 +1,17 @@
-#lang scheme/unit
+#lang scheme/base
-(require scheme/class
+
+(require (for-syntax scheme/base)
+         scheme/unit
+         scheme/class
          scheme/surrogate
          "sig.ss")
 
-(import)
+(provide mode@ surrogate-methods)
-(export framework:mode^)
 
-(define-values (host-text-mixin host-text<%> surrogate-text% surrogate-text<%>)
+(define-syntax (surrogate-methods stx)
-  (surrogate
+  (syntax-case stx ()
-   (augment (void) on-change ())
+    [(_ m)
+     #'(m (augment (void) on-change ())
           (override on-char (event))
           (override on-default-char (event))
           (override on-default-event (event))
@@ -47,4 +50,11 @@
           (augment #t can-set-size-constraint? ())
           (override can-do-edit-operation? (op) (op recursive?))
           (augment #t can-load-file? (filename format))
-   (augment #t can-save-file? (filename format))))
+          (augment #t can-save-file? (filename format)))]))
+
+(define-unit mode@
+  (import)
+  (export framework:mode^)
+  
+  (define-values (host-text-mixin host-text<%> surrogate-text% surrogate-text<%>)
+    (surrogate-methods surrogate)))

collects/scribblings/framework/comment-box.scrbl

@@ -4,7 +4,7 @@
 @(require (for-label scheme/gui))
 @title{Comment Box}
 
-@defclass[comment-box:snip% decorated-editor-snip% (readable-snip<%>)]{
+@defclass[comment-box:snip% editor-snip:decorated% (readable-snip<%>)]{
   This snip implements the comment boxes that you see in
   DrScheme.
 

collects/scribblings/framework/decorated-editor-snip.scrbl

@@ -1,10 +0,0 @@
-#lang scribble/doc
-@(require scribble/manual)
-@(require (for-label framework))
-@(require (for-label scheme/gui))
-@title{Decorated Editor Snip}
-@(defmodule framework/decorated-editor-snip)
-
-@definterface[decorated-editor-snip<%> (editor-snip%)]{
-
-}

collects/scribblings/framework/editor-snip.scrbl

@@ -0,0 +1,89 @@
+#lang scribble/doc
+@(require scribble/manual)
+@(require (for-label framework))
+@(require (for-label scheme/gui))
+@title[#:tag "editor-snip"]{Editor Snip}
+
+@definterface[editor-snip:decorated<%> (editor-snip%)]{
+  @defmethod[(get-corner-bitmap) (or/c false/c (is-a?/c bitmap%))]{
+    Returns a bitmap that is drawn in the upper-right corner of this snip.
+  }
+  @defmethod[(get-color) (or/c string? (is-a?/c color%))]{
+    Returns the color used to draw the background part of the snip.
+  }
+  @defmethod[(get-menu) (or/c false/c (is-a?/c popup-menu%))] {
+    Returns a popup menu that is used when clicking on the top part of the snip.
+  }
+  @defmethod[(get-position) (symbols 'top-right 'left-top)] {
+    Returns the location of the image and the clickable
+     region. The symbol @scheme['top-right] indicates top portion is clickable
+     and icon on right. The symbol @scheme['left-top] means left portion is
+     clickable and icon on top.
+  }
+  @defmethod[(reset-min-sizes) void?] {
+    Sets the minimum sizes based on the result of 
+    @method[editor-snip:decorated<%> get-corner-bitmap].
+  }
+}
+
+
+@defmixin[editor-snip:decorated-mixin (editor-snip%) (editor-snip:decorated<%>)]{
+  @defmethod[(get-corner-bitmap) (or/c false/c (is-a?/c bitmap%))]{
+    Returns @scheme[#f].
+  }
+  @defmethod[(get-color) (or/c string? (is-a?/c color%))]{
+     Returns @schemeblock[
+       (if (preferences:get 'framework:white-on-black?)
+           "white" 
+           "black")]
+  }
+  @defmethod[(get-menu) (or/c false/c (is-a?/c popup-menu%))] {
+    Returns @scheme[#f].
+ }
+  @defmethod[(get-position) (symbols 'top-right 'left-top)] {
+    Returns @scheme['top-right].
+  }
+}
+
+@defclass[editor-snip:decorated% (editor-snip:decorated-mixin editor-snip%) ()]{
+  @defconstructor/auto-super[()]{
+     Invokes the super constructor with the keyword @scheme[editor] as a call to
+     @method[editor-snip:decorated% make-editor].
+  }
+
+  @defmethod[(make-snip) (is-a?/c editor-snip:decorated%)]{
+    This method should return an instance of the class it is invoked in.
+    If you create a subclass of this class, be sure to override this method and
+    have it create instances of the subclass.
+  }
+  @defmethod[(make-editor) (is-a?/c editor<%>)]{
+   Creates an editor to be used in this snip.
+ }
+
+  @defmethod[(copy) (is-a?/c editor-snip:decorated%)]{
+    Uses the @method[editor-snip:decorated% make-editor] and
+    @method[editor-snip:decorated% make-snip] methods to create a
+    copy of this snip, as follows:
+    @schememod[
+      (let ([snip (make-snip)])
+        (send snip set-editor (send (get-editor) copy-self))
+        (send snip set-style (get-style))
+        snip)]
+  }
+}
+
+@defclass[editor-snip:decorated-snipclass% snip-class% ()]{
+  @defmethod[(make-snip [stream-in (is-a?/c editor-stream-in%)]) -editor-snip:decorated<%>]{
+   Returns an instance of @scheme[editor-snip:decorated%].
+  }
+  @defmethod[(read [stream-in (is-a?/c editor-stream-in%)]) editor-snip:decorated<%>]{
+   Calls @method[editor-snip:decorated-snipclass% make-snip] to get an object and
+   then invokes its @scheme[editor<%>]'s @method[editor<%> read-from-file] method
+   in order to read a snip from @scheme[stream-in], eg:
+   @schemeblock[
+      (let ([snip (make-snip stream-in)])
+        (send (send snip get-editor) read-from-file stream-in #f)
+        snip)
+   ]
+  }
+}

collects/scribblings/framework/framework.scrbl

@@ -6,12 +6,6 @@
 @title{@bold{Framework}: PLT GUI Application Framework}
 @(defmodule framework)
 
-@bold{TODO}
-
-@itemize{@item{decorated editor snip isn't exported by framework/framework}}
-
-----------------------------------------------------------------------------------------------------
-
 The framework provides a number of mixins, classes and
 functions designed to help you build a complete application
 program on top of the @scheme[scheme/gui] library.
@@ -58,13 +52,13 @@ This library provides all of the definitions beginning with
 @scheme[(require framework/gui-utils)]
     
     This libraries provides all of the definitions beginning
-    with \scheme{gui-utils:} described in this manual.
+    with @scheme[gui-utils:] described in this manual.
 }
 @item{ @bold{Preferences}
 @scheme[(require framework/preferences)]
     
   This library provides a subset of the names of the
-  \scheme|framework.ss| library, namely those for
+  @tt{framework.ss} library, namely those for
   manipulating preference settings and is designed to be
   used from mzscheme.
 
@@ -85,7 +79,9 @@ The precise set of exported names is:
 @item{@bold{Decorated Editor Snip}
 @scheme[(require framework/decorated-editor-snip)]
 
-This library exports an editor snipclass 
+This library is here for backwards compatibility. The
+functionality in it has moved into the framework proper, in
+the @secref["editor-snip"] section.
 }
 }
 
@@ -105,6 +101,7 @@ their feedback and help.
 @include-section["color-prefs.scrbl"]
 @include-section["color.scrbl"]
 @include-section["comment-box.scrbl"]
+@include-section["editor-snip.scrbl"]
 @include-section["editor.scrbl"]
 @include-section["exit.scrbl"]
 @include-section["finder.scrbl"]

collects/scribblings/framework/mode-helpers.ss

@@ -0,0 +1,28 @@
+#reader scribble/reader
+#lang scheme/base
+
+(provide spec->host-method spec->surrogate-method)
+(require (for-template scribble/manual scheme/base))
+(require scheme/class)
+(require (for-label framework))
+
+(define (spec->host-method spec)
+  (syntax-case* spec (override augment) (λ (x y) (eq? (syntax-e x) (syntax-e y)))
+    [(override mtd (x ...) ...)
+     #'@defmethod*[(((mtd (x any/c) ...) any) ...)]{
+        Delegates to the result of @method[mode:host-text<%> get-surrogate] if it is not @scheme[#f].}]
+    [(augment default mtd (x ...) ...)
+     #'@defmethod*[(((mtd (x any/c) ...) any) ...)]{
+        Delegates to the result of @method[mode:host-text<%> get-surrogate] if it is not @scheme[#f].}]))
+
+(define (spec->surrogate-method spec)
+  (syntax-case* spec (override augment) (λ (x y) (eq? (syntax-e x) (syntax-e y)))
+    [(override method (x ...) ...)
+     #'@defmethod*[(((method (orig (is-a?/c text%)) (call-super (-> any)) (x any/c) ...) any) ...)]{
+      Returns the result of invoking @scheme[call-super].
+    }]
+    [(augment default method (x ...) ...)
+     #'@defmethod*[(((method (orig (is-a?/c text%)) (call-inner (-> any)) (x any/c) ...) any) ...)]{
+       Returns the result of invoking @scheme[call-super].
+    }]))
+

collects/scribblings/framework/mode.scrbl

@@ -2,7 +2,45 @@
 @(require scribble/manual scribble/extract)
 @(require (for-label framework))
 @(require (for-label scheme/gui))
+@(require (for-syntax "mode-helpers.ss"))
 @title{Mode}
 
+@(begin
+(require framework/private/mode (for-syntax scheme/base))
+
+(define-syntax (docs stx)
+  (syntax-case stx ()
+   [(_ spec ...)
+   #`(begin
+    @definterface[mode:surrogate-text<%> ()]{
+     @defmethod[(on-enable-surrogate) any]{
+       Called by @method[mode:host-text<%> set-surrogate] to
+       notify the surrogate that it has just become active.
+     }
+     @defmethod[(on-disable-surrogate) any]{
+       Called by @method[mode:host-text<%> set-surrogate] to
+       notify the surrogate that it has just been disabled.
+     }
+   }
+    @defclass[mode:surrogate-text% object% (mode:surrogate-text<%>)]{
+    @#,@(map spec->surrogate-method (syntax->list #'(spec ...)))
+    }
+    @definterface[mode:host-text<%> ()]{
+     @defmethod[(get-surrogate) 
+                (or/c false/c (is-a?/c mode:surrogate-text<%>))]{
+      Returns the currently active surrogate.
+     }
+     @defmethod[(set-surrogate 
+                 [surrogate (or/c false/c (is-a?/c mode:surrogate-text<%>))])
+                void?]{
+      Sets the current surrogate to @scheme[surrogate].
+     }
+    }
+    @defmixin[mode:host-text-mixin () (mode:host-text<%>)]{
+    @#,@(map spec->host-method (syntax->list #'(spec ...)))
+})]))
+
+(surrogate-methods docs)
+)
 
 @(include-extracted (lib "main.ss" "framework") #rx"^mode:")