...

original commit: 1e6ba4af8540b2ec9c175bb63311752cd292ad51

collects/embedded-gui/private/aligned-pasteboard.ss

@@ -14,16 +14,24 @@
    "really-resized-pasteboard.ss"
    "interface.ss"
    "snip-lib.ss"
-   "verthoriz-alignment.ss")
+   "locked-pasteboard.ss"
+   "verthoriz-alignment.ss"
+   "suppress-modify-editor.ss")
   
   (define aligned-pasteboard%
     (class (click-forwarding-editor-mixin
             (on-show-pasteboard-mixin
-             (really-resized-pasteboard-mixin pasteboard%)))
+              (suppress-modify-editor-mixin
+               (locked-pasteboard-mixin
+                (really-resized-pasteboard-mixin pasteboard%)))))
       
-      (inherit begin-edit-sequence end-edit-sequence get-max-view-size refresh-delayed?)
+      (inherit begin-edit-sequence end-edit-sequence
+               get-max-view-size refresh-delayed?)
+      (init align)
       (field
-       [alignment (new vertical-alignment%)]
+       [alignment (new (case align
+                         [(horizontal) horizontal-alignment%]
+                         [else vertical-alignment%]))]
        [lock-alignment? false]
        [needs-alignment? false])
       
@@ -56,8 +64,8 @@
         (super-really-resized snip)
         (realign))
       
-      (rename [super-on-show on-show])
-      (define/override (on-show)
+      #;(rename [super-on-show on-show])
+      #;(define/override (on-show)
         (realign)
         (super-on-show))
       

collects/embedded-gui/private/button-snip.ss

@@ -88,20 +88,20 @@
   (define toggle-button-snip%
     (class button-snip%
       (inherit set-images)
-      (init-field images1 images2 callback1 callback2 (state 1))
+      (init-field images-off images-on callback-off callback-on (state 'on))
       (super-new
-       (images images1)
+       (images (if (symbol=? state 'on) images-on images-off))
        (callback
         (lambda (b e)
-          (if (= state 1)
+          (if (symbol=? state 'on)
               (begin
-                (set-images images2)
-                (set! state 2)
-                (callback1 b e))
+                (set-images images-off)
+                (set! state 'off)
+                (callback-on b e))
               (begin
-                (set-images images1)
-                (set! state 1)
-                (callback2 b e))))))))
+                (set-images images-on)
+                (set! state 'on)
+                (callback-off b e))))))))
   
   ;;;;;;;;;;
   ;; tests

collects/embedded-gui/private/locked-pasteboard.ss

@@ -0,0 +1,31 @@
+;; This module provides a mixin that locks a pasteboard to all mouse interaction. This
+;; means that there is no interactive dragging, no keyboard deletion, no handles drawn
+;; at the corners of the snips for dragging, and anything else that must be added.
+
+(module locked-pasteboard mzscheme
+  
+  (require
+   (lib "class.ss")
+   (lib "mred.ss" "mred")
+   (lib "etc.ss")
+   (lib "contract.ss")
+   (lib "framework.ss" "framework"))
+  
+  (provide/contract
+   (locked-pasteboard-mixin mixin-contract))
+  
+  ;; mixin to remove interactive movement of snips from pasteboards
+  ;; STATUS: Look into and make sure I don't need to deal with the following.
+  ;;           interactive-adjust-mouse, interactive-adjust-move, on-default-event
+  ;;           interactive-adjust-resize
+  (define locked-pasteboard-mixin
+    (mixin ((class->interface pasteboard%)) ()
+      (define/override (on-default-event event) (void))
+      ;; The rest of the methods I believe to be redundant but
+      ;; are overriden anyway for consistancy.
+      (define/override (can-interactive-move? event) false)
+      (define/override (can-interactive-resize? snip) false)
+      (define/override (get-dragable) false)
+      (define/override (get-selection-visible) false)
+      (super-new)))
+  )

collects/embedded-gui/private/on-show-pasteboard.ss

@@ -14,14 +14,12 @@
       (field [shown? false])
       (rename [super-refresh refresh])
       (define/override (refresh x y w h d-c)
-        (super-refresh x y w h d-c)
+        (super-refresh x y (max w 0) (max h 0) d-c)
         (unless shown?
           (set! shown? true)
           (on-show)))
-      (define/public (showing?)
-        shown?)
-      (define/public (on-show)
-        (void))
+      (define/public (showing?) shown?)
+      (define/public (on-show) (void))
       (super-new)))
   
   (define on-show-pasteboard%

collects/embedded-gui/private/suppress-modify-editor.ss

@@ -0,0 +1,32 @@
+(module suppress-modify-editor mzscheme
+  
+  (require
+   (lib "etc.ss")
+   (lib "class.ss")
+   (lib "mred.ss" "mred"))
+  
+  (provide suppress-modify-editor-mixin)
+      
+  ;; Ignore the modification of the pasteboard that is used for layout
+  ;; Allow nested editors to percollate modify messages up through 
+  (define (suppress-modify-editor-mixin %)
+    (class %
+      (inherit set-modified)
+      (rename [super-after-delete after-delete]
+              [super-after-insert after-insert]
+              [super-after-move-to after-move-to]
+              [super-after-resize after-resize])
+      (define/override (after-delete snip)
+        (super-after-delete snip)
+        (set-modified false))
+      (define/override (after-insert snip before x y)
+        (super-after-insert snip before x y)
+        (set-modified false))
+      (define/override (after-move-to snip x y dragging?)
+        (super-after-move-to snip x y dragging?)
+        (set-modified false))
+      (define/override (after-resize snip w h resized?)
+        (super-after-resize snip w h resized?)
+        (set-modified false))
+      (super-new)))
+  )