Add snip canvases to mrlib, from unstable/gui/snip.

gui-doc/mrlib/scribblings/mrlib.scrbl

@@ -20,6 +20,7 @@
 @include-section["switchable-button.scrbl"]
 @include-section["image-core.scrbl"]
 @include-section["matrix-snip.scrbl"]
+@include-section["snip-canvas.scrbl"]
 @include-section["tex-table.scrbl"]
 @include-section["terminal.scrbl"]
 

gui-doc/mrlib/scribblings/snip-canvas.scrbl

@@ -0,0 +1,93 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/class
+                     racket/gui/base
+                     unstable/gui/snip
+                     racket/contract))
+
+@title[#:tag "snip"]{Snip Canvases}
+
+@defmodule[mrlib/snip-canvas]
+
+@defclass[snip-canvas% editor-canvas% ()]{
+A canvas that contains a single snip.
+
+Snips cannot be placed directly on dialogs, frames and panels.
+To use an interactive snip in a GUI,
+it must be inserted into an editor, which itself must be placed on a special canvas, which can be placed in a GUI container.
+To provide a seamless user experience, the editor should be enabled but not writable,
+not be able to receive focus, not have scrollbars, and other small details.
+
+The @racket[snip-canvas%] class handles these details, making it easy to use interactive snips as normal GUI elements.
+
+@defconstructor[([parent (or/c (is-a?/c frame%) (is-a?/c dialog%)
+                               (is-a?/c panel%) (is-a?/c pane%))]
+                 [make-snip ((integer-in 0 10000) (integer-in 0 10000) . -> . snip%)]
+                 [style (listof (one-of/c 'no-border 'control-border 'combo
+                                          'resize-corner 'no-focus 'deleted
+                                          'transparent)) null]
+                 [label (or/c label-string? false/c) #f]
+                 [horizontal-inset (integer-in 0 1000) 5]
+                 [vertical-inset (integer-in 0 1000) 5]
+                 [enabled any/c #t]
+                 [vert-margin (integer-in 0 1000) 0]
+                 [horiz-margin (integer-in 0 1000) 0]
+                 [min-width (integer-in 0 10000) 0]
+                 [min-height (integer-in 0 10000) 0]
+                 [stretchable-width any/c #t]
+                 [stretchable-height any/c #t])]{
+Unlike instances of @racket[editor-canvas%], each instance of this class creates and manages its own editor.
+The editor contains one object: a @racket[snip%] instance created by @racket[make-snip].
+
+The @racket[make-snip] function receives the requested width and height of the snip, which are calculated from the size of the snip canvas.
+It is called the first time the snip canvas is resized, which most likely coincides with the first time the snip canvas is shown.
+The snip is thus created @italic{lazily}: only when needed, at the size needed.
+See @method[snip-canvas% on-size] for more details and an example.
+
+The @racket[style] list is prepended with @racket['no-hscroll] and @racket['no-vscroll] before being passed to the @racket[editor-canvas%] constructor.
+The other constructor arguments are passed untouched.
+}
+
+@defmethod[(get-snip) (or/c (is-a?/c snip%) #f)]{
+Returns the wrapped snip, or @racket[#f] if @racket[make-snip] has not been called yet.
+}
+
+@defmethod[#:mode override 
+           (on-size [width (integer-in 0 10000)]
+                    [height (integer-in 0 10000)])
+           void?]{
+This is called when the snip canvas is resized.
+
+On the first call, @method[snip-canvas% on-size] calls @racket[make-snip] with width and height arguments
+respectively @racket[(max 0 (- width (* 2 horizontal-inset)))] and @racket[(max 0 (- height (* 2 vertical-inset)))].
+It then inserts the resulting snip into its editor.
+
+On subsequent calls, @method[snip-canvas% on-size] calls the snip's @method[snip% resize] method, calculating the width and height arguments the same way.
+
+When a @racket[snip-canvas%] instance is intended to wrap an existing @racket[snip%] instance, @racket[make-snip] should simply resize it and return it.
+
+Example: functions from @racketmodname[plot #:indirect]
+create snips and call a function similar to the following to place plots in a frame:
+@racketblock[
+(define (make-snip-frame snip w h label)
+  (define (make-snip width height)
+    (send snip resize width height)
+    snip)
+  
+  (define frame
+    (new frame%
+         [label label]
+         [width (+ 5 5 5 5 w)]
+         [height (+ 5 5 5 5 h)]))
+  
+  (new snip-canvas%
+       [parent frame]
+       [make-snip make-snip]
+       [horiz-margin 5] [vert-margin 5]
+       [horizontal-inset 5] [vertical-inset 5])
+  
+  frame)]
+}
+
+} @; defclass snip-canvas%

gui-lib/info.rkt

@@ -30,4 +30,4 @@
 
 (define pkg-authors '(mflatt robby))
 
-(define version "1.17")
+(define version "1.18")

gui-lib/mrlib/snip-canvas.rkt

@@ -0,0 +1,80 @@
+#lang racket/base
+
+(require racket/gui/base racket/class)
+
+(provide snip-canvas%)
+
+(define snip-canvas%
+  (class editor-canvas%
+    (init parent
+          make-snip
+          [style null]
+          [label #f]
+          [horizontal-inset 5]
+          [vertical-inset 5]
+          [enabled #t]
+          [vert-margin 0]
+          [horiz-margin 0]
+          [min-width 0]
+          [min-height 0]
+          [stretchable-width #t]
+          [stretchable-height #t])
+    
+    (define snip #f)
+    (define text (new read-only-text%))
+    (send text set-writable #f)
+    
+    (define/public (get-snip) snip)
+    
+    (define/override (on-size w h)
+      (update-snip w h)
+      (super on-size w h))
+    
+    (define (update-snip w h)
+      (define snip-w (max 0 (- w (* 2 horizontal-inset))))
+      (define snip-h (max 0 (- h (* 2 vertical-inset))))
+      (cond [snip  (send snip resize snip-w snip-h)]
+            [else  (set-snip (make-snip snip-w snip-h))]))
+    
+    (define (set-snip s)
+      (unless (is-a? s snip%)
+        (raise-type-error 'set-snip "snip%" s))
+      (set! snip s)
+      (send text set-writable #t)
+      (send text begin-edit-sequence #f)
+      (send text erase)
+      (send text insert snip)
+      (send text end-edit-sequence)
+      (send text set-writable #f))
+    
+    (super-new [parent parent]
+               [editor text]
+               [horizontal-inset horizontal-inset]
+               [vertical-inset vertical-inset]
+               [label label]
+               [enabled enabled]
+               [style (list* 'no-hscroll 'no-vscroll style)]
+               [vert-margin vert-margin]
+               [horiz-margin horiz-margin]
+               [min-width min-width]
+               [min-height min-height]
+               [stretchable-width stretchable-width]
+               [stretchable-height stretchable-height])))
+
+(define read-only-text%
+  (class text%
+    (define writable? #t)
+    (define/public (set-writable w?) (set! writable? w?))
+    
+    (define/augment (can-change-style? start len) writable?)
+    (define/augment (can-delete? start len) writable?)
+    (define/augment (can-insert? start len) writable?)
+    (define/augment (can-load-file? filename format) writable?)
+    (define/augment (can-save-file? filename format) writable?)
+    (define/override (can-do-edit-operation? op [recursive? #t])
+      (case op
+        [(copy select-all)  #t]
+        [else    writable?]))
+    
+    (super-new)
+    (send this hide-caret #t)))