diff --git a/collects/embedded-gui/private/aligned-pasteboard.ss b/collects/embedded-gui/private/aligned-pasteboard.ss index d24f6585..9078c992 100644 --- a/collects/embedded-gui/private/aligned-pasteboard.ss +++ b/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)) diff --git a/collects/embedded-gui/private/button-snip.ss b/collects/embedded-gui/private/button-snip.ss index 73628c71..667166bc 100644 --- a/collects/embedded-gui/private/button-snip.ss +++ b/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 diff --git a/collects/embedded-gui/private/locked-pasteboard.ss b/collects/embedded-gui/private/locked-pasteboard.ss new file mode 100644 index 00000000..1a4d060b --- /dev/null +++ b/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))) + ) \ No newline at end of file diff --git a/collects/embedded-gui/private/on-show-pasteboard.ss b/collects/embedded-gui/private/on-show-pasteboard.ss index 348e1778..29012266 100644 --- a/collects/embedded-gui/private/on-show-pasteboard.ss +++ b/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% diff --git a/collects/embedded-gui/private/suppress-modify-editor.ss b/collects/embedded-gui/private/suppress-modify-editor.ss new file mode 100644 index 00000000..1144e07a --- /dev/null +++ b/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))) + ) \ No newline at end of file