Syncing here also.

svn: r13137

collects/macro-debugger/syntax-browser/controller.ss

@@ -38,7 +38,7 @@
 ;; mark-manager-mixin
 (define mark-manager-mixin
   (mixin () (mark-manager<%>)
-    (init-field [primary-partition (new-bound-partition)])
+    (init-field: [primary-partition partition<%> (new-bound-partition)])
     (super-new)
 
     ;; get-primary-partition : -> partition
@@ -63,8 +63,8 @@
              (new partition% (relation (cdr name+proc)))))))
     (listen-secondary-partition
      (lambda (p)
-       (for-each (lambda (d) (send: d display<%> refresh))
+       (for ([d displays])
-                 displays)))
+         (send: d display<%> refresh))))
     (super-new)))
 
 (define controller%

collects/macro-debugger/syntax-browser/display.ss

@@ -1,4 +1,3 @@
-
 #lang scheme/base
 (require scheme/class
          scheme/gui
@@ -19,8 +18,8 @@
   (define range
     (pretty-print-syntax stx output-port 
                          (send: controller controller<%> get-primary-partition)
-                         (send config get-colors)
+                         (send: config config<%> get-colors)
-                         (send config get-suffix-option)
+                         (send: config config<%> get-suffix-option)
                          columns))
   (define output-string (get-output-string output-port))
   (define output-length (sub1 (string-length output-string))) ;; skip final newline
@@ -55,18 +54,18 @@
 ;; set-standard-font : text% config number number -> void
 (define (set-standard-font text config start end)
   (send text change-style
-        (code-style text (send config get-syntax-font-size))
+        (code-style text (send: config config<%> get-syntax-font-size))
         start end))
 
 ;; display%
 (define display%
   (class* object% (display<%>)
-    (init-field text)
+    (init-field: [controller controller<%>]
-    (init-field controller)
+                 [config config<%>]
-    (init-field config)
+                 [range range<%>])
-    (init-field range)
+    (init-field text
-    (init-field start-position)
+                start-position
-    (init-field end-position)
+                end-position)
 
     (define extra-styles (make-hasheq))
 
@@ -131,7 +130,7 @@
           (send delta set-delta-foreground color)
           delta))
       (define color-styles
-        (list->vector (map color-style (send config get-colors))))
+        (list->vector (map color-style (send: config config<%> get-colors))))
       (define overflow-style (color-style "darkgray"))
       (define color-partition
         (send: controller mark-manager<%> get-primary-partition))
@@ -189,7 +188,7 @@
 
     ;; draw-secondary-connection : syntax -> void
     (define/private (draw-secondary-connection stx2)
-      (for ([r (send range get-ranges stx2)])
+      (for ([r (send: range range<%> get-ranges stx2)])
         (restyle-range r select-sub-highlight-d)))
 
     ;; restyle-range : (cons num num) style-delta% -> void
@@ -204,11 +203,11 @@
 
     ;; Initialize
     (super-new)
-    (send controller add-syntax-display this)))
+    (send: controller controller<%> add-syntax-display this)))
 
 ;; fixup-parentheses : string range -> void
 (define (fixup-parentheses string range)
-  (define (fixup r)
+  (for ([r (send: range range<%> all-ranges)])
     (let ([stx (range-obj r)]
           [start (range-start r)]
           [end (range-end r)])
@@ -219,8 +218,7 @@
            (string-set! string (sub1 end) #\]))
           ((#\{) 
            (string-set! string start #\{)
-           (string-set! string (sub1 end) #\}))))))
+           (string-set! string (sub1 end) #\})))))))
-  (for-each fixup (send range all-ranges)))
 
 (define (open-output-string/count-lines)
   (let ([os (open-output-string)])

collects/macro-debugger/syntax-browser/frame.ss

@@ -1,8 +1,10 @@
 #lang scheme/base
 (require scheme/class
+         macro-debugger/util/class-iop
          scheme/gui
          framework/framework
          scheme/list
+         "interfaces.ss"
          "partition.ss"
          "prefs.ss"
          "widget.ss")
@@ -20,8 +22,9 @@
 (define (browse-syntaxes stxs)
   (let ((w (make-syntax-browser)))
     (for ([stx stxs])
-      (send w add-syntax stx)
+      (send*: w syntax-browser<%>
-      (send w add-separator))))
+        (add-syntax stx)
+        (add-separator)))))
 
 ;; make-syntax-browser : -> syntax-browser<%>
 (define (make-syntax-browser)
@@ -32,21 +35,23 @@
 ;; syntax-browser-frame%
 (define syntax-browser-frame%
   (class* frame% ()
-    (init-field [config (new syntax-prefs%)])
+    (inherit get-width
+             get-height)
+    (init-field: [config config<%> (new syntax-prefs%)])
     (super-new (label "Syntax Browser")
-               (width (send config pref:width))
+               (width (send: config config<%> get-width))
-               (height (send config pref:height)))
+               (height (send: config config<%> get-height)))
-    (define widget
+    (define: widget syntax-browser<%>
       (new syntax-widget/controls%
            (parent this)
            (config config)))
     (define/public (get-widget) widget)
     (define/augment (on-close)
-      (send config pref:width (send this get-width))
+      (send*: config config<%>
-      (send config pref:height (send this get-height))
+        (set-width (get-width))
+        (set-height (get-height)))
       (send widget shutdown)
-      (inner (void) on-close))
+      (inner (void) on-close))))
-    ))
 
 ;; syntax-widget/controls%
 (define syntax-widget/controls%
@@ -72,22 +77,22 @@
            (choices (map car -identifier=-choices))
            (callback 
             (lambda (c e)
-              (send (get-controller) set-identifier=?
+              (send: (get-controller) controller<%> set-identifier=?
                      (assoc (send c get-string-selection)
                             -identifier=-choices))))))
     (new button% 
          (label "Clear")
          (parent -control-panel)
-         (callback (lambda _ (send (get-controller) select-syntax #f))))
+         (callback (lambda _ (send: (get-controller) controller<%> set-selected-syntax #f))))
     (new button%
          (label "Properties")
          (parent -control-panel)
          (callback
           (lambda _ 
-            (send config set-props-shown? 
+            (send: config config<%> set-props-shown? 
-                  (not (send config get-props-shown?))))))
+                   (not (send: config config<%> get-props-shown?))))))
 
-    (send (get-controller) listen-identifier=?
+    (send: (get-controller) controller<%> listen-identifier=?
            (lambda (name+func)
              (send -choice set-selection
                    (or (send -choice find-string (car name+func)) 0))))

collects/macro-debugger/syntax-browser/interfaces.ss

@@ -1,8 +1,19 @@
 #lang scheme/base
 (require scheme/class
-         macro-debugger/util/class-iop)
+         macro-debugger/util/class-iop
+         "../util/notify.ss")
 (provide (all-defined-out))
 
+;; config<%>
+(define-interface config<%> ()
+  ((methods:notify suffix-option
+                   syntax-font-size
+                   colors
+                   width
+                   height
+                   props-percentage
+                   props-shown?)))
+
 ;; displays-manager<%>
 (define-interface displays-manager<%> ()
   (;; add-syntax-display : display<%> -> void
@@ -13,10 +24,8 @@
 
 ;; selection-manager<%>
 (define-interface selection-manager<%> ()
-  (;; selected-syntax : syntax/#f
+  (;; selected-syntax : notify-box of syntax/#f
-   set-selected-syntax
+   (methods:notify selected-syntax)))
-   get-selected-syntax
-   listen-selected-syntax))
 
 ;; mark-manager<%>
 ;; Manages marks, mappings from marks to colors
@@ -29,23 +38,10 @@
 
 ;; secondary-partition<%>
 (define-interface secondary-partition<%> ()
-  (;; get-secondary-partition : -> partition<%>
+  (;; secondary-partition : notify-box of partition<%>
-   get-secondary-partition
+   ;; identifier=? : notify-box of (cons string procedure)
-
+   (methods:notify secondary-partition
-   ;; set-secondary-partition : partition<%> -> void
+                   identifier=?)))
-   set-secondary-partition
-
-   ;; listen-secondary-partition : (partition<%> -> void) -> void
-   listen-secondary-partition
-
-   ;; get-identifier=? : -> (cons string procedure)
-   get-identifier=?
-
-   ;; set-identifier=? : (cons string procedure) -> void
-   set-identifier=?
-
-   ;; listen-identifier=? : ((cons string procedure) -> void) -> void
-   listen-identifier=?))
 
 ;; controller<%>
 (define-interface controller<%> (displays-manager<%>
@@ -143,6 +139,7 @@
    add-clickback
    add-separator
    erase-all
+   get-controller
    get-text))
 
 (define-interface partition<%> ()

collects/macro-debugger/syntax-browser/prefs.ss

@@ -42,7 +42,7 @@
     (super-new)))
 
 (define syntax-prefs-base%
-  (class prefs-base%
+  (class* prefs-base% (config<%>)
     ;; width, height : number
     (notify-methods width)
     (notify-methods height)

collects/macro-debugger/syntax-browser/pretty-helper.ss

@@ -1,7 +1,9 @@
 
 #lang scheme/base
 (require scheme/class
-         syntax/stx)
+         macro-debugger/util/class-iop
+         syntax/stx
+         "interfaces.ss")
 (provide (all-defined-out))
 
 ;; Problem: If stx1 and stx2 are two distinguishable syntax objects, it
@@ -45,10 +47,10 @@
     (case suffixopt
       ((never) (unintern (syntax-e id)))
       ((always)
-       (let ([n (send partition get-partition id)])
+       (let ([n (send: partition partition<%> get-partition id)])
          (if (zero? n) (unintern (syntax-e id)) (suffix (syntax-e id) n))))
       ((over-limit)
-       (let ([n (send partition get-partition id)])
+       (let ([n (send: partition partition<%> get-partition id)])
          (if (<= n limit)
              (unintern (syntax-e id))
              (suffix (syntax-e id) n))))))
@@ -61,7 +63,7 @@
                => (lambda (datum) datum)]
               [(and partition (identifier? obj))
                (when (and (eq? suffixopt 'all-if-over-limit)
-                          (> (send partition count) limit))
+                          (> (send: partition partition<%> count) limit))
                  (call-with-values (lambda () (table stx partition #f 'always))
                                    escape))
                (let ([lp-datum (make-identifier-proxy obj)])
@@ -70,7 +72,7 @@
                  lp-datum)]
               [(and (syntax? obj) (check+convert-special-expression obj))
                => (lambda (newobj)
-                    (when partition (send partition get-partition obj))
+                    (when partition (send: partition partition<%> get-partition obj))
                     (let* ([inner (cadr newobj)]
                            [lp-inner-datum (loop inner)]
                            [lp-datum (list (car newobj) lp-inner-datum)])
@@ -80,7 +82,7 @@
                       (hash-set! stx=>flat obj lp-datum)
                       lp-datum))]
               [(syntax? obj)
-               (when partition (send partition get-partition obj))
+               (when partition (send: partition partition<%> get-partition obj))
                (let ([lp-datum (loop (syntax-e obj))])
                  (hash-set! flat=>stx lp-datum obj)
                  (hash-set! stx=>flat obj lp-datum)

collects/macro-debugger/syntax-browser/syntax-snip.ss

@@ -1,6 +1,7 @@
 
 #lang scheme/base
 (require scheme/class
+         macro-debugger/util/class-iop
          scheme/match
          scheme/list
          mzlib/string
@@ -205,7 +206,7 @@
     (define/public (read-special src line col pos)
       (send the-syntax-snip read-special src line col pos))
 
-    (send config listen-props-shown?
+    (send: config config<%> listen-props-shown?
            (lambda (?) (refresh-contents)))
 
     (super-new)

collects/macro-debugger/syntax-browser/widget.ss

@@ -43,6 +43,7 @@
     (define/public (setup-keymap)
       (new syntax-keymap% 
            (editor -text)
+           (controller controller)
            (config config)))
 
     (send -text set-styles-sticky #f)
@@ -54,7 +55,7 @@
     (define/private (internal-show-props show?)
       (if show?
           (unless (send -props-panel is-shown?)
-            (let ([p (send config get-props-percentage)])
+            (let ([p (send: config config<%> get-props-percentage)])
               (send -split-panel add-child -props-panel)
               (update-props-percentage p))
             (send -props-panel show #t))
@@ -81,7 +82,7 @@
 
     (define/public (shutdown)
       (when (props-panel-shown?)
-        (send config set-props-percentage
+        (send: config config<%> set-props-percentage
                (cadr (send -split-panel get-percentages)))))
 
     ;; syntax-browser<%> Methods
@@ -202,7 +203,7 @@
           display)))
 
     (define/private (calculate-columns)
-      (define style (code-style -text (send config get-syntax-font-size)))
+      (define style (code-style -text (send: config config<%> get-syntax-font-size)))
       (define char-width (send style get-text-width (send -ecanvas get-dc)))
       (define-values (canvas-w canvas-h) (send -ecanvas get-client-size))
       (sub1 (inexact->exact (floor (/ canvas-w char-width)))))
@@ -211,13 +212,13 @@
     (super-new)
     (setup-keymap)
 
-    (send config listen-props-shown?
+    (send: config config<%> listen-props-shown?
            (lambda (show?)
              (show-props show?)))
-    (send config listen-props-percentage
+    (send: config config<%> listen-props-percentage
            (lambda (p)
              (update-props-percentage p)))
-    (internal-show-props (send config get-props-shown?))))
+    (internal-show-props (send: config config<%> get-props-shown?))))
 
 
 (define clickback-style

collects/macro-debugger/util/class-ct.ss

@@ -14,7 +14,15 @@
          checked-binding-iface
 
          checked-binding
-         static-interface)
+         static-interface
+
+         interface-expander?
+         make-interface-expander
+         interface-expander-proc
+
+         interface-expander
+         method-entry)
+
 
 (define-struct static-interface (dynamic members)
   #:omit-define-syntaxes
@@ -60,6 +68,11 @@
 (define (checked-binding-iface x)
   (raw-checked-binding-iface (set!-transformer-procedure x)))
 
+
+(define-struct interface-expander (proc)
+  #:omit-define-syntaxes)
+
+
 ;; Syntax
 
 (define-syntax-class static-interface
@@ -71,3 +84,20 @@
   (pattern x
            #:declare x (static-of 'checked-binding checked-binding?)
            #:with value #'x.value))
+
+
+(define-syntax-class interface-expander
+  (pattern x
+           #:declare x (static-of 'interface-expander interface-expander?)
+           #:with value #'x.value))
+
+(define-syntax-class method-entry
+  (pattern method:id
+           #:with methods (list #'method))
+  (pattern (macro:interface-expander . args)
+           #:with methods
+                  (apply append
+                         (for/list ([m ((interface-expander-proc #'macro.value)
+                                        #'(macro . args))])
+                           (syntax-parse m
+                             [m:method-entry #'m.methods])))))

collects/macro-debugger/util/class-iop.ss

@@ -5,6 +5,7 @@
                      "class-ct.ss"))
 (provide define-interface
          define-interface/dynamic
+         define-interface-expander
 
          send:
          send*:
@@ -26,13 +27,14 @@
 ;; Defines NAME as an interface.
 (define-syntax (define-interface stx)
   (syntax-parse stx
-    [(_ name:id (super:static-interface ...) (mname:id ...))
+    [(_ name:id (super:static-interface ...) (m:method-entry ...))
      (with-syntax ([((super-method ...) ...)
                     (map static-interface-members
-                         (syntax->datum #'(super.value ...)))])
+                         (syntax->datum #'(super.value ...)))]
+                   [((mname ...) ...) #'(m.methods ...)])
        #'(define-interface/dynamic name
-           (let ([name (interface (super ...) mname ...)]) name)
+           (let ([name (interface (super ...) mname ... ...)]) name)
-           (super-method ... ... mname ...)))]))
+           (super-method ... ... mname ... ...)))]))
 
 ;; define-interface/dynamic SYNTAX
 ;; (define-interface/dynamic NAME EXPR (IDENTIFIER ...))
@@ -54,6 +56,11 @@
                 (define-syntax name
                   (make-static-interface #'dynamic-name '(mname ...)))))]))
 
+(define-syntax (define-interface-expander stx)
+  (syntax-parse stx
+    [(_ name:id rhs:expr)
+     #'(define-syntax name (make-interface-expander rhs))]))
+
 ;; Helper
 
 (begin-for-syntax
@@ -173,19 +180,19 @@
 ;; FIXME: unsafe due to mutation
 (define-syntax (init-field: stx)
   (syntax-parse stx
-    [(_ (name:id iface:static-interface) ...)
+    [(_ (name:id iface:static-interface . default) ...)
-     #'(begin (init1: init-field name iface) ...)]))
+     #'(begin (init1: init-field name iface . default) ...)]))
 
 (define-syntax (init: stx)
   (syntax-parse stx
-    [(_ (name:id iface:static-interface) ...)
+    [(_ (name:id iface:static-interface . default) ...)
-     #'(begin (init1: init name iface) ...)]))
+     #'(begin (init1: init name iface . default) ...)]))
 
 (define-syntax (init1: stx)
   (syntax-parse stx
-    [(_ init name:id iface:static-interface)
+    [(_ init name:id iface:static-interface . default)
      (with-syntax ([(name-internal) (generate-temporaries #'(name))])
-       #'(begin (init ((name-internal name)))
+       #'(begin (init ((name-internal name) . default))
                 (void (check-object<:interface init: name-internal iface))
                 (define-syntax name 
                   (make-checked-binding

collects/macro-debugger/util/notify.ss

@@ -3,6 +3,7 @@
 (require (for-syntax scheme/base)
          scheme/list
          scheme/class
+         macro-debugger/util/class-iop
          scheme/gui)
 (provide define/listen
          field/notify
@@ -15,7 +16,9 @@
          menu-option/notify-box
          menu-group/notify-box
          check-box/notify-box
-         choice/notify-box)
+         choice/notify-box
+
+         methods:notify)
 
 (define-for-syntax (join . args)
   (define (->string x)
@@ -71,6 +74,19 @@
                 (define/public-final (listen-name listener)
                   (send name listen listener))))]))
 
+
+(define-interface-expander methods:notify
+  (lambda (stx)
+    (syntax-case stx ()
+      [(_ name ...)
+       (apply append
+              (for/list ([name (syntax->list #'(name ...))])
+                (list ;; (join "init-" #'name)
+                      (join "get-" name)
+                      (join "set-" name)
+                      (join "listen-" name))))])))
+
+
 (define-syntax (connect-to-pref stx)
   (syntax-case stx ()
     [(connect-to-pref name pref)

collects/macro-debugger/view/debug.ss

@@ -2,6 +2,8 @@
 #lang scheme/base
 (require scheme/pretty
          scheme/class
+         macro-debugger/util/class-iop
+         "interfaces.ss"
          "debug-format.ss"
          "prefs.ss"
          "view.ss")
@@ -30,5 +32,5 @@
     (pretty-print msg)
     (pretty-print ctx)
     (let* ([w (make-stepper)])
-      (send w add-trace events)
+      (send: w widget<%> add-trace events)
       w)))

collects/macro-debugger/view/frame.ss

@@ -42,8 +42,8 @@
              get-help-menu)
 
     (super-new (label (make-label))
-               (width (send config get-width))
+               (width (send: config config<%> get-width))
-               (height (send config get-height)))
+               (height (send: config config<%> get-height)))
 
     (define/private (make-label)
       (if filename
@@ -54,8 +54,8 @@
           "Macro stepper"))
 
     (define/override (on-size w h)
-      (send config set-width w)
+      (send: config config<%> set-width w)
-      (send config set-height h)
+      (send: config config<%> set-height h)
       (send: widget widget<%> update/preserve-view))
 
     (define warning-panel
@@ -143,7 +143,7 @@
                                    (eq? (car name+func) (car p)))))))
                 (sb:identifier=-choices)))
 
-    (let ([identifier=? (send config get-identifier=?)])
+    (let ([identifier=? (send: config config<%> get-identifier=?)])
       (when identifier=?
         (let ([p (assoc identifier=? (sb:identifier=-choices))])
           (send: controller sb:controller<%> set-identifier=? p))))
@@ -178,7 +178,7 @@
            (parent extras-menu)
            (callback
             (lambda (i e)
-              (send config set-suffix-option
+              (send: config config<%> set-suffix-option
                      (if (send i is-checked?)
                          'always
                          'over-limit))

collects/macro-debugger/view/hiding-panel.ss

@@ -79,7 +79,7 @@
            (style '(deleted))))
 
     (define/private (get-mode)
-      (send config get-macro-hiding-mode))
+      (send: config config<%> get-macro-hiding-mode))
 
     (define/private (macro-hiding-enabled?)
       (let ([mode (get-mode)])
@@ -89,7 +89,7 @@
 
     (define/private (ensure-custom-mode)
       (unless (equal? (get-mode) mode:custom)
-        (send config set-macro-hiding-mode mode:custom)))
+        (send: config config<%> set-macro-hiding-mode mode:custom)))
 
     (define/private (update-visibility)
       (let ([customizing (equal? (get-mode) mode:custom)])
@@ -104,7 +104,7 @@
                             (list customize-panel)
                             null))))))
 
-    (send config listen-macro-hiding-mode
+    (send: config config<%> listen-macro-hiding-mode
            (lambda (value)
              (update-visibility)
              (force-refresh)))

collects/macro-debugger/view/interfaces.ss

@@ -1,8 +1,23 @@
 
 #lang scheme/base
-(require macro-debugger/util/class-iop)
+(require macro-debugger/util/class-iop
+         "../util/notify.ss"
+         (prefix-in sb: "../syntax-browser/interfaces.ss"))
 (provide (all-defined-out))
 
+(define-interface config<%> (sb:config<%>)
+  ((methods:notify macro-hiding-mode
+                   show-hiding-panel?
+                   identifier=?
+                   highlight-foci?
+                   highlight-frontier?
+                   show-rename-steps?
+                   suppress-warnings?
+                   one-by-one?
+                   extra-navigation?
+                   debug-catch-errors?
+                   force-letrec-transformation?)))
+
 (define-interface widget<%> ()
   (get-config
    get-controller

collects/macro-debugger/view/prefs.ss

@@ -2,6 +2,7 @@
 #lang scheme/base
 (require scheme/class
          framework/framework
+         "interfaces.ss"
          "../syntax-browser/prefs.ss"
          "../util/notify.ss"
          "../util/misc.ss")
@@ -43,7 +44,7 @@
 (pref:get/set pref:force-letrec-transformation? MacroStepper:ForceLetrecTransformation?)
 
 (define macro-stepper-config-base%
-  (class syntax-prefs-base%
+  (class* syntax-prefs-base% (config<%>)
     (notify-methods macro-hiding-mode)
     (notify-methods show-hiding-panel?)
     (notify-methods identifier=?)

collects/macro-debugger/view/step-display.ss

@@ -41,7 +41,7 @@
 (define step-display%
   (class* object% (step-display<%>)
 
-    (init-field config)
+    (init-field: (config config<%>))
     (init-field ((sbview syntax-widget)))
     (super-new)
 
@@ -194,8 +194,8 @@
     ;; insert-syntax/color
     (define/private (insert-syntax/color stx foci binders shift-table
                                          definites frontier hi-color)
-      (define highlight-foci? (send config get-highlight-foci?))
+      (define highlight-foci? (send: config config<%> get-highlight-foci?))
-      (define highlight-frontier? (send config get-highlight-frontier?))
+      (define highlight-frontier? (send: config config<%> get-highlight-frontier?))
       (send: sbview sb:syntax-browser<%> add-syntax stx
              #:definites (or definites null)
              #:binder-table binders

collects/macro-debugger/view/stepper.ss

@@ -86,7 +86,7 @@
       (let ([term (focused-term)])
         (when term
           (let ([new-stepper (send: director director<%> new-stepper '(no-new-traces))])
-            (send: new-stepper widget<%> add-deriv (send term get-raw-deriv))
+            (send: new-stepper widget<%> add-deriv (send: term term-record<%> get-raw-deriv))
             (void)))))
 
     ;; duplicate-stepper : -> void
@@ -138,7 +138,7 @@
            (config config)
            (syntax-widget sbview)))
     (define: sbc sb:controller<%>
-      (send sbview get-controller))
+      (send: sbview sb:syntax-browser<%> get-controller))
     (define control-pane
       (new vertical-panel% (parent area) (stretchable-height #f)))
     (define: macro-hiding-prefs hiding-prefs<%>
@@ -147,22 +147,24 @@
            (stepper this)
            (config config)))
 
-    (send config listen-show-hiding-panel?
+    (send: sbc sb:controller<%>
-          (lambda (show?) (show-macro-hiding-panel show?)))
+           listen-selected-syntax
-    (send sbc listen-selected-syntax
            (lambda (stx) (send: macro-hiding-prefs hiding-prefs<%> set-syntax stx)))
-    (send config listen-highlight-foci?
+    (send*: config config<%>
+      (listen-show-hiding-panel?
+       (lambda (show?) (show-macro-hiding-panel show?)))
+      (listen-highlight-foci?
        (lambda (_) (update/preserve-view)))
-    (send config listen-highlight-frontier?
+      (listen-highlight-frontier?
        (lambda (_) (update/preserve-view)))
-    (send config listen-show-rename-steps?
+      (listen-show-rename-steps?
        (lambda (_) (refresh/re-reduce)))
-    (send config listen-one-by-one?
+      (listen-one-by-one?
        (lambda (_) (refresh/re-reduce)))
-    (send config listen-force-letrec-transformation?
+      (listen-force-letrec-transformation?
        (lambda (_) (refresh/resynth)))
-    (send config listen-extra-navigation?
+      (listen-extra-navigation?
-          (lambda (show?) (show-extra-navigation show?)))
+       (lambda (show?) (show-extra-navigation show?))))
 
     (define nav:up
       (new button% (label "Previous term") (parent navigator)
@@ -400,8 +402,8 @@
     ;; Initialization
 
     (super-new)
-    (show-macro-hiding-panel (send config get-show-hiding-panel?))
+    (show-macro-hiding-panel (send: config config<%> get-show-hiding-panel?))
-    (show-extra-navigation (send config get-extra-navigation?))
+    (show-extra-navigation (send: config config<%> get-extra-navigation?))
     (refresh/move)
     ))
 

collects/macro-debugger/view/term-record.ss

@@ -33,7 +33,8 @@
   (class* object% (term-record<%>)
     (init-field: (stepper widget<%>))
 
-    (define config (send stepper get-config))
+    (define: config config<%>
+      (send: stepper widget<%> get-config))
     (define: displayer step-display<%>
       (send: stepper widget<%> get-step-displayer))
 
@@ -173,12 +174,12 @@
           (set! steps
                 (and raw-steps
                      (let* ([filtered-steps 
-                             (if (send config get-show-rename-steps?)
+                             (if (send: config config<%> get-show-rename-steps?)
                                  raw-steps
                                  (filter (lambda (x) (not (rename-step? x)))
                                          raw-steps))]
                             [processed-steps
-                             (if (send config get-one-by-one?)
+                             (if (send: config config<%> get-one-by-one?)
                                  (reduce:one-by-one filtered-steps)
                                  filtered-steps)])
                        (cursor:new processed-steps))))

collects/mred/private/kernel.ss

@@ -240,6 +240,7 @@
     can-save-file?
     on-new-box
     on-new-image-snip
+    size-cache-invalid
     invalidate-bitmap-cache
     on-paint
     write-footers-to-file
@@ -921,6 +922,7 @@
     can-save-file?
     on-new-box
     on-new-image-snip
+    size-cache-invalid
     invalidate-bitmap-cache
     on-paint
     write-footers-to-file
@@ -1133,6 +1135,7 @@
     can-save-file?
     on-new-box
     on-new-image-snip
+    size-cache-invalid
     invalidate-bitmap-cache
     on-paint
     write-footers-to-file

collects/redex/examples/arithmetic.ss

@@ -38,4 +38,5 @@
    [(--> (in-hole e-ctxt_1 a) (in-hole e-ctxt_1 b))
     (c--> a b)]))
 
-(traces reductions (term (- (* (sqrt 36) (/ 1 2)) (+ 1 2))))
+(traces/ps reductions (term (- (* (sqrt 36) (/ 1 2)) (+ 1 2)))
+           "/home/mflatt/Desktop/p.ps")

collects/redex/private/traces.ss

@@ -86,7 +86,7 @@
    (λ (ed)
      (let ([yb (box 0)]
            [snip (term-node-snip term-node)])
-       (if (send ed get-snip-location snip yb #f #f)
+       (if (send ed get-snip-location snip #f yb #f)
            (unbox yb)
            0)))))
 
@@ -132,7 +132,7 @@
                    #:scheme-colors? [scheme-colors? #t]
                    #:colors [colors '()]
                    #:layout [layout void])
-  (let-values ([(graph-pb frame)
+  (let-values ([(graph-pb canvas)
                 (traces reductions pre-exprs
                         #:no-show-frame? #t
                         #:multiple? multiple? 
@@ -141,21 +141,18 @@
                         #:scheme-colors? scheme-colors?
                         #:colors colors
                         #:layout layout)])
-    (print-to-ps graph-pb filename)))
+    (print-to-ps graph-pb canvas filename)))
 
-(define (print-to-ps graph-pb filename)
+(define (print-to-ps graph-pb canvas filename)
   (let ([admin (send graph-pb get-admin)]
-        [printing-admin (new printing-editor-admin%)])
+        [printing-admin (new printing-editor-admin% [ed graph-pb])])
+    (send canvas set-editor #f)
     (send graph-pb set-admin printing-admin)
     
     (dynamic-wind
      void
      (λ ()
-       (let loop ([snip (send graph-pb find-first-snip)])
+       (send graph-pb size-cache-invalid)
-         (when snip
-           (send snip size-cache-invalid)
-           (loop (send snip next))))
-       (send graph-pb invalidate-bitmap-cache)
        
        (send graph-pb re-run-layout)
        
@@ -168,17 +165,20 @@
      
      (λ ()
        (send graph-pb set-admin admin)
+       (send canvas set-editor graph-pb)
        (send printing-admin shutdown) ;; do this early
        (let loop ([snip (send graph-pb find-first-snip)])
          (when snip
            (send snip size-cache-invalid)
            (loop (send snip next))))
-       (send graph-pb invalidate-bitmap-cache)
+       (send graph-pb size-cache-invalid)
        (send graph-pb re-run-layout)))))
 
 (define printing-editor-admin%
   (class editor-admin%
     
+    (init-field ed)
+    
     (define temp-file (make-temporary-file "redex-size-snip-~a"))
     
     (define ps-dc
@@ -204,7 +204,8 @@
     (define/override (get-max-view x y w h [full? #f])
       (get-view x y w h full?))
     (define/override (get-view x y w h [full? #f])
-      (super get-view x y w h full?)
+      (when x (set-box! x 0.0))
+      (when y (set-box! x 0.0))
       (when (box? w) (set-box! w 500))
       (when (box? h) (set-box! h 500)))
     
@@ -270,7 +271,7 @@
                           "Reducing..." 
                           lower-panel
                           (lambda (x y)
-                            (reduce-button-callback))))
+                            (reduce-button-callback #f))))
   (define status-message (instantiate message% ()
                            (label "")
                            (parent lower-panel)
@@ -411,7 +412,6 @@
                         (set! col (+ x-spacing (find-rightmost-x graph-pb))))
                       (begin0
                         (insert-into col y graph-pb new-snips)
-                        (send graph-pb re-run-layout)
                         (send graph-pb end-edit-sequence)
                         (send status-message set-label
                               (string-append (term-count (count-snips)) "...")))))])
@@ -455,9 +455,10 @@
     (send reduce-button enable #t)
     (send font-size enable #t))
   
-  ;; reduce-button-callback : -> void
+  ;; reduce-button-callback : boolean -> void
   ;; =eventspace main thread=
-  (define (reduce-button-callback)
+  (define (reduce-button-callback show-all-at-once?)
+    (when show-all-at-once? (send graph-pb begin-edit-sequence))
     (send reduce-button enable #f)
     (send reduce-button set-label "Reducing...")
     (thread
@@ -465,6 +466,10 @@
        (do-some-reductions)
        (queue-callback
         (lambda () ;; =eventspace main thread=
+          (send graph-pb begin-edit-sequence)
+          (send graph-pb re-run-layout)
+          (send graph-pb end-edit-sequence)
+          (when show-all-at-once? (send graph-pb end-edit-sequence))
           (scroll-to-rightmost-snip)
           (send reduce-button set-label "Reduce")
           (cond
@@ -541,9 +546,8 @@
               (list bottom-panel)
               null)))
   (out-of-dot-state) ;; make sure the state is initialized right
+  (set-font-size (initial-font-size)) ;; have to call this before 'insert-into' or else it triggers resizing
   (insert-into init-rightmost-x 0 graph-pb frontier)
-  (send graph-pb re-run-layout)
-  (set-font-size (initial-font-size))
   (cond
     [no-show-frame?
      (let ([s (make-semaphore)]) 
@@ -551,9 +555,9 @@
                  (do-some-reductions)
                  (semaphore-post s)))
        (yield s))
-     (values graph-pb f)]
+     (values graph-pb ec)]
     [else
-     (reduce-button-callback)
+     (reduce-button-callback #t)
      (send f show #t)]))
 
 (define red-sem-frame%

collects/redex/redex.scrbl

@@ -1218,9 +1218,11 @@ The @scheme[scheme-colors?] argument, if @scheme[#t] causes
 to DrScheme's Scheme mode color Scheme. If it is @scheme[#f],
 @scheme[traces] just uses black for the color scheme.
 
-The @scheme[layout] argument is called (with all of the terms) each
+The @scheme[layout] argument is called (with all of the terms) when
-time a new term is inserted into the window. See also
+new terms is inserted into the window. In general, it is called when
-@scheme[term-node-set-position!].
+after new terms are inserted in response to the user clicking on the
+reduce button, and after the initial set of terms is inserted.
+See also @scheme[term-node-set-position!].
 
 You can save the contents of the window as a postscript file
 from the menus.

collects/scheme/help.ss

@@ -14,13 +14,17 @@
        (identifier? #'id)
        #'(find-help (quote-syntax id))]
       [(help id #:from lib)
-       (if (identifier? #'id)
+       (cond [(not (identifier? #'id))
-         (if (module-path? (syntax->datum #'lib))
-           #'(find-help/lib (quote id) (quote lib))
               (raise-syntax-error
-            #f "expected a module path after #:from" stx #'lib))
+               #f "expected an identifier before #:from" stx #'id)]
+             [(not (module-path? (syntax->datum #'lib)))
               (raise-syntax-error
-          #f "expected an identifier before #:from" stx #'id))]
+               #f "expected a module path after #:from" stx #'lib)]
+             [else #'(find-help/lib (quote id) (quote lib))])]
+      [(help str0 str ...)
+       (andmap (lambda (s) (string? (syntax-e s)))
+               (syntax->list #'(str0 str ...)))
+       #'(search-for (list str0 str ...))]
       [(help #:search str ...)
        (with-syntax ([(str ...)
                       (map (lambda (e)
@@ -32,8 +36,9 @@
       [_
        (raise-syntax-error
         #f
-        (string-append "expects a single identifer, a #:from clause, or a"
+        (string-append "expects a single identifer, any number of literal"
-                       " #:search clause; try `(help help)' for more information")
+                       " strings, or #:search clauses;"
+                       " try `(help help)' for more information")
         stx)])))
 
 (define (open-help-start)

collects/scribblings/gui/editor-intf.scrbl

@@ -1015,7 +1015,7 @@ The default implementation triggers a redraw of the editor, either
  immediately or at the end of the current edit sequence (if any)
  started by @method[editor<%> begin-edit-sequence].
 
-}
+See also @method[editor<%> size-cache-invalid].}
 
 
 @defmethod[(is-locked?)
@@ -2322,6 +2322,20 @@ Setting the style list is disallowed when the editor is internally
 }
 
 
+@defmethod[(size-cache-invalid)
+           void?]{
+
+This method is called when the drawing context given to the editor by
+its administrator changes in a way that makes cached size information
+(such as the width of a string) invalid.
+
+The default implementation eventually propagates the message to snips,
+and, more generally, causes @tech{location} information to be
+recalculated on demand.
+
+See also @method[editor<%> invalidate-bitmap-cache].}
+
+
 @defmethod[(style-has-changed [style (or/c (is-a?/c style<%>) false/c)])
            void?]{
 

collects/scribblings/reference/help.scrbl

@@ -19,6 +19,7 @@
 
 @deftogether[(
 @defidform[help]
+@defform/none[#:literals (help) (help string ...)]
 @defform/none[#:literals (help) (help id)]
 @defform/none[#:literals (help) (help id #:from module-path)]
 @defform/none[#:literals (help) (help #:search datum ...)]
@@ -35,6 +36,17 @@ the user's browser is launched to display help information.}
 A simple @scheme[help] or @scheme[(help)] form opens the main
 documentation page.
 
+The @scheme[(help string ...)] form---using literal strings, as
+opposed to expressions that produce strings---performs a
+string-matching search. For example,
+
+@schemeblock[
+(help "web browser" "firefox")
+]
+
+searches the documentation index for references that include the
+phrase ``web browser'' or ``firefox.''
+
 A @scheme[(help id)] form looks for documentation specific to the
 current binding of @scheme[id]. For example, 
 
@@ -70,11 +82,10 @@ The @scheme[(help id #:from module-path)] variant is similar to
 (help frame% #:from scheme/gui) (code:comment #, @t{equivalent to the above})
 ]
 
-The @scheme[(help #:search datum ...)] form performs a general
+The @scheme[(help #:search datum ...)] form is similar to
-search. Searching uses strings; each string @scheme[datum] is used
+@scheme[(help string ...)], where any non-string form of
-as-is, and any other form of @scheme[datum] is converted to a string
+@scheme[datum] is converted to a string using @scheme[display]. No
-using @scheme[display]. No @scheme[datum] is evaluated as an
+@scheme[datum] is evaluated as an expression.
-expression.
 
 For example,
 
@@ -82,7 +93,7 @@ For example,
 (help #:search "web browser" firefox)
 ]
 
-searches the documentation index for references that include the
+also searches the documentation index for references that include the
 phrase ``web browser'' or ``firefox.''
 
 }

collects/scribblings/reference/mz.ss

@@ -57,7 +57,7 @@
               (schememodname lib)
               " and "
               (schememodname scheme/init)
-              " libraries, which means that they ara available when "
+              " libraries, which means that they are available when "
               (exec "mzscheme") " is started with no command-line arguments."
               " They are not provided by " (schememodname scheme/base)
               " or " (schememodname scheme) "."

collects/teachpack/2htdp/scribblings/universe.scrbl

@@ -125,7 +125,7 @@ Your program may deal with such events via the @emph{designation} of
  @emph{handler} functions.  Specifically, the teachpack provides for the
  installation of three event handlers: @scheme[on-tick], @scheme[on-key],
  and @scheme[on-mouse]. In addition, a @tech{world} program may specify a
- @scheme[_dra]} function, which is called every time your program should
+ @scheme[draw] function, which is called every time your program should
  visualize the current world, and a @scheme[_stop?] predicate, which is used
  to determine when the @tech{world} program should shut down. 
 

collects/tests/macro-debugger/gui-tests.ss

@@ -207,7 +207,8 @@
   (sleep 1)
   (parameterize ((current-eventspace (make-eventspace)))
     (let ([frame (new macro-stepper-frame%
-                      (config (new macro-stepper-config/prefs/readonly%)))])
+                      (config (new macro-stepper-config/prefs/readonly%))
+                      (director (new macro-stepper-director%)))])
       (send frame show #t)
       frame)))
 
@@ -270,4 +271,4 @@
               (send frame get-eventspace))))))))))
 
 (define (test-stepper expr)
-  (test-stepper* (list expr) '(none basic normal))))
+  (test-stepper* (list expr) '(none basic normal)))

src/mred/wxs/wxs_mbuf.xci

@@ -73,6 +73,7 @@
 
 @ Z "on-paint" : void OnPaint(bool,wxDC!,double,double,double,double,double,double,SYM[caret]);  : : /CHECKDCOK[1.METHODNAME("editor<%>","on-paint")]
 @ Y "invalidate-bitmap-cache" : void InvalidateBitmapCache(double=0.0,double=0.0,nnfs[end]=-1.0,nnfs[end]=-1.0);
+@ Y "size-cache-invalid" : void SizeCacheInvalid();
 
 @ Z "on-new-image-snip" : wxImageSnip! OnNewImageSnip(nxpathname,SYM[bitmapType],bool,bool);
 @ Z "on-new-box" : wxSnip! OnNewBox(SYM[bufferType]);

src/mred/wxs/wxs_mede.cxx

@@ -1015,6 +1015,7 @@ class os_wxMediaEdit : public wxMediaEdit {
   Bool CanSaveFile(epathname x0, int x1);
   class wxSnip* OnNewBox(int x0);
   class wxImageSnip* OnNewImageSnip(nxpathname x0, int x1, Bool x2, Bool x3);
+  void SizeCacheInvalid();
   void InvalidateBitmapCache(double x0 = 0.0, double x1 = 0.0, double x2 = -1.0, double x3 = -1.0);
   void OnPaint(Bool x0, class wxDC* x1, double x2, double x3, double x4, double x5, double x6, double x7, int x8);
   Bool WriteFootersToFile(class wxMediaStreamOut* x0);
@@ -2469,6 +2470,40 @@ class wxImageSnip* os_wxMediaEdit::OnNewImageSnip(nxpathname x0, int x1, Bool x2
   }
 }
 
+static Scheme_Object *os_wxMediaEditSizeCacheInvalid(int n, Scheme_Object *p[]);
+
+void os_wxMediaEdit::SizeCacheInvalid()
+{
+  Scheme_Object *p[POFFSET+0] INIT_NULLED_ARRAY({ NULLED_OUT });
+  Scheme_Object *v;
+  Scheme_Object *method INIT_NULLED_OUT;
+#ifdef MZ_PRECISE_GC
+  os_wxMediaEdit *sElF = this;
+#endif
+  static void *mcache = 0;
+
+  SETUP_VAR_STACK(5);
+  VAR_STACK_PUSH(0, method);
+  VAR_STACK_PUSH(1, sElF);
+  VAR_STACK_PUSH_ARRAY(2, p, POFFSET+0);
+  SET_VAR_STACK();
+
+  method = objscheme_find_method((Scheme_Object *) ASSELF __gc_external, os_wxMediaEdit_class, "size-cache-invalid", &mcache);
+  if (!method || OBJSCHEME_PRIM_METHOD(method, os_wxMediaEditSizeCacheInvalid)) {
+    SET_VAR_STACK();
+    READY_TO_RETURN; ASSELF wxMediaEdit::SizeCacheInvalid();
+  } else {
+  
+  
+  p[0] = (Scheme_Object *) ASSELF __gc_external;
+
+  v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p));
+  
+  
+     READY_TO_RETURN;
+  }
+}
+
 static Scheme_Object *os_wxMediaEditInvalidateBitmapCache(int n, Scheme_Object *p[]);
 
 void os_wxMediaEdit::InvalidateBitmapCache(double x0, double x1, double x2, double x3)
@@ -7673,6 +7708,29 @@ static Scheme_Object *os_wxMediaEditOnNewImageSnip(int n,  Scheme_Object *p[])
   return WITH_REMEMBERED_STACK(objscheme_bundle_wxImageSnip(r));
 }
 
+static Scheme_Object *os_wxMediaEditSizeCacheInvalid(int n,  Scheme_Object *p[])
+{
+  WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
+  REMEMBER_VAR_STACK();
+  objscheme_check_valid(os_wxMediaEdit_class, "size-cache-invalid in text%", n, p);
+
+  SETUP_VAR_STACK_REMEMBERED(1);
+  VAR_STACK_PUSH(0, p);
+
+  
+
+  
+  if (((Scheme_Class_Object *)p[0])->primflag)
+    WITH_VAR_STACK(((os_wxMediaEdit *)((Scheme_Class_Object *)p[0])->primdata)->wxMediaEdit::SizeCacheInvalid());
+  else
+    WITH_VAR_STACK(((wxMediaEdit *)((Scheme_Class_Object *)p[0])->primdata)->SizeCacheInvalid());
+
+  
+  
+  READY_TO_RETURN;
+  return scheme_void;
+}
+
 static Scheme_Object *os_wxMediaEditInvalidateBitmapCache(int n,  Scheme_Object *p[])
 {
   WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
@@ -8778,7 +8836,7 @@ void objscheme_setup_wxMediaEdit(Scheme_Env *env)
 
   wxREGGLOB(os_wxMediaEdit_class);
 
-  os_wxMediaEdit_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "text%", "editor%", (Scheme_Method_Prim *)os_wxMediaEdit_ConstructScheme, 153));
+  os_wxMediaEdit_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "text%", "editor%", (Scheme_Method_Prim *)os_wxMediaEdit_ConstructScheme, 154));
 
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "call-clickback" " method", (Scheme_Method_Prim *)os_wxMediaEditCallClickback, 2, 2));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "remove-clickback" " method", (Scheme_Method_Prim *)os_wxMediaEditRemoveClickback, 2, 2));
@@ -8896,6 +8954,7 @@ void objscheme_setup_wxMediaEdit(Scheme_Env *env)
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "can-save-file?" " method", (Scheme_Method_Prim *)os_wxMediaEditCanSaveFile, 2, 2));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "on-new-box" " method", (Scheme_Method_Prim *)os_wxMediaEditOnNewBox, 1, 1));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "on-new-image-snip" " method", (Scheme_Method_Prim *)os_wxMediaEditOnNewImageSnip, 4, 4));
+  WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "size-cache-invalid" " method", (Scheme_Method_Prim *)os_wxMediaEditSizeCacheInvalid, 0, 0));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "invalidate-bitmap-cache" " method", (Scheme_Method_Prim *)os_wxMediaEditInvalidateBitmapCache, 0, 4));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "on-paint" " method", (Scheme_Method_Prim *)os_wxMediaEditOnPaint, 9, 9));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaEdit_class, "write-footers-to-file" " method", (Scheme_Method_Prim *)os_wxMediaEditWriteFootersToFile, 1, 1));

src/mred/wxs/wxs_mpb.cxx

@@ -436,6 +436,7 @@ class os_wxMediaPasteboard : public wxMediaPasteboard {
   Bool CanSaveFile(epathname x0, int x1);
   class wxSnip* OnNewBox(int x0);
   class wxImageSnip* OnNewImageSnip(nxpathname x0, int x1, Bool x2, Bool x3);
+  void SizeCacheInvalid();
   void InvalidateBitmapCache(double x0 = 0.0, double x1 = 0.0, double x2 = -1.0, double x3 = -1.0);
   void OnPaint(Bool x0, class wxDC* x1, double x2, double x3, double x4, double x5, double x6, double x7, int x8);
   Bool WriteFootersToFile(class wxMediaStreamOut* x0);
@@ -2217,6 +2218,40 @@ class wxImageSnip* os_wxMediaPasteboard::OnNewImageSnip(nxpathname x0, int x1, B
   }
 }
 
+static Scheme_Object *os_wxMediaPasteboardSizeCacheInvalid(int n, Scheme_Object *p[]);
+
+void os_wxMediaPasteboard::SizeCacheInvalid()
+{
+  Scheme_Object *p[POFFSET+0] INIT_NULLED_ARRAY({ NULLED_OUT });
+  Scheme_Object *v;
+  Scheme_Object *method INIT_NULLED_OUT;
+#ifdef MZ_PRECISE_GC
+  os_wxMediaPasteboard *sElF = this;
+#endif
+  static void *mcache = 0;
+
+  SETUP_VAR_STACK(5);
+  VAR_STACK_PUSH(0, method);
+  VAR_STACK_PUSH(1, sElF);
+  VAR_STACK_PUSH_ARRAY(2, p, POFFSET+0);
+  SET_VAR_STACK();
+
+  method = objscheme_find_method((Scheme_Object *) ASSELF __gc_external, os_wxMediaPasteboard_class, "size-cache-invalid", &mcache);
+  if (!method || OBJSCHEME_PRIM_METHOD(method, os_wxMediaPasteboardSizeCacheInvalid)) {
+    SET_VAR_STACK();
+    READY_TO_RETURN; ASSELF wxMediaPasteboard::SizeCacheInvalid();
+  } else {
+  
+  
+  p[0] = (Scheme_Object *) ASSELF __gc_external;
+
+  v = WITH_VAR_STACK(scheme_apply(method, POFFSET+0, p));
+  
+  
+     READY_TO_RETURN;
+  }
+}
+
 static Scheme_Object *os_wxMediaPasteboardInvalidateBitmapCache(int n, Scheme_Object *p[]);
 
 void os_wxMediaPasteboard::InvalidateBitmapCache(double x0, double x1, double x2, double x3)
@@ -5718,6 +5753,29 @@ static Scheme_Object *os_wxMediaPasteboardOnNewImageSnip(int n,  Scheme_Object *
   return WITH_REMEMBERED_STACK(objscheme_bundle_wxImageSnip(r));
 }
 
+static Scheme_Object *os_wxMediaPasteboardSizeCacheInvalid(int n,  Scheme_Object *p[])
+{
+  WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
+  REMEMBER_VAR_STACK();
+  objscheme_check_valid(os_wxMediaPasteboard_class, "size-cache-invalid in pasteboard%", n, p);
+
+  SETUP_VAR_STACK_REMEMBERED(1);
+  VAR_STACK_PUSH(0, p);
+
+  
+
+  
+  if (((Scheme_Class_Object *)p[0])->primflag)
+    WITH_VAR_STACK(((os_wxMediaPasteboard *)((Scheme_Class_Object *)p[0])->primdata)->wxMediaPasteboard::SizeCacheInvalid());
+  else
+    WITH_VAR_STACK(((wxMediaPasteboard *)((Scheme_Class_Object *)p[0])->primdata)->SizeCacheInvalid());
+
+  
+  
+  READY_TO_RETURN;
+  return scheme_void;
+}
+
 static Scheme_Object *os_wxMediaPasteboardInvalidateBitmapCache(int n,  Scheme_Object *p[])
 {
   WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
@@ -6999,7 +7057,7 @@ void objscheme_setup_wxMediaPasteboard(Scheme_Env *env)
 
   wxREGGLOB(os_wxMediaPasteboard_class);
 
-  os_wxMediaPasteboard_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "pasteboard%", "editor%", (Scheme_Method_Prim *)os_wxMediaPasteboard_ConstructScheme, 115));
+  os_wxMediaPasteboard_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "pasteboard%", "editor%", (Scheme_Method_Prim *)os_wxMediaPasteboard_ConstructScheme, 116));
 
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaPasteboard_class, "set-scroll-step" " method", (Scheme_Method_Prim *)os_wxMediaPasteboardSetScrollStep, 1, 1));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaPasteboard_class, "get-scroll-step" " method", (Scheme_Method_Prim *)os_wxMediaPasteboardGetScrollStep, 0, 0));
@@ -7072,6 +7130,7 @@ void objscheme_setup_wxMediaPasteboard(Scheme_Env *env)
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaPasteboard_class, "can-save-file?" " method", (Scheme_Method_Prim *)os_wxMediaPasteboardCanSaveFile, 2, 2));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaPasteboard_class, "on-new-box" " method", (Scheme_Method_Prim *)os_wxMediaPasteboardOnNewBox, 1, 1));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaPasteboard_class, "on-new-image-snip" " method", (Scheme_Method_Prim *)os_wxMediaPasteboardOnNewImageSnip, 4, 4));
+  WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaPasteboard_class, "size-cache-invalid" " method", (Scheme_Method_Prim *)os_wxMediaPasteboardSizeCacheInvalid, 0, 0));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaPasteboard_class, "invalidate-bitmap-cache" " method", (Scheme_Method_Prim *)os_wxMediaPasteboardInvalidateBitmapCache, 0, 4));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaPasteboard_class, "on-paint" " method", (Scheme_Method_Prim *)os_wxMediaPasteboardOnPaint, 9, 9));
   WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaPasteboard_class, "write-footers-to-file" " method", (Scheme_Method_Prim *)os_wxMediaPasteboardWriteFootersToFile, 1, 1));