diff --git a/collects/mrlib/private/aligned-pasteboard/aligned-editor-container.ss b/collects/mrlib/private/aligned-pasteboard/aligned-editor-container.ss index b406a199..d58092eb 100644 --- a/collects/mrlib/private/aligned-pasteboard/aligned-editor-container.ss +++ b/collects/mrlib/private/aligned-pasteboard/aligned-editor-container.ss @@ -12,6 +12,7 @@ (lib "mred.ss" "mred") (lib "etc.ss") (lib "list.ss") + "snip-lib.ss" "interface.ss" "constants.ss") @@ -80,8 +81,8 @@ ;; a snip that can contain an aligned-pasteboard<%> and also be stretched within an aligned-pasteboard<%> (define aligned-editor-snip% (class* editor-snip% (aligned-pasteboard-parent<%> aligned-snip<%>) - (inherit get-editor get-margin) - + (inherit get-editor get-margin set-min-width set-min-height) + (init (stretchable-width true) (stretchable-height true)) @@ -150,7 +151,9 @@ ;; set-aligned-min-size (-> (void)) ;; calculates and stores the minimum height and width of the snip (define/public (set-aligned-min-sizes) - (send (get-editor) set-aligned-min-sizes)) + (send (get-editor) set-aligned-min-sizes) + (set-min-width (get-aligned-min-width)) + (set-min-height (get-aligned-min-height))) (super-instantiate ()) )) @@ -192,7 +195,15 @@ [right (box 0)] [bottom (box 0)]) (get-margin left top right bottom) - (+ (unbox left) (unbox right)))) + (+ (unbox left) + (let* ([ed (get-editor)] + [last (send ed last-line)]) + (let loop ([line 0]) + (if (= line last) + 0 + (max (send ed line-length line) + (loop (add1 line)))))) + (unbox right)))) ;; get-aligned-min-height (-> number?) ;; the minimum height of the snip based on the children @@ -207,6 +218,70 @@ (* (send editor line-location 0 false) (add1 (send editor last-line)))))) +; ; get-aligned-min-width (-> number?) +; ; the minimum width of the snip based on the children +; (inherit get-max-width set-max-width get-min-width set-min-width) +; (define/public (get-aligned-min-width) +; (let* ([parent (snip-parent this)] +; [ed (get-editor)] +; [ed-max (send ed get-max-width)] +; [ed-min (send ed get-min-width)] +; [this-max (get-max-width)] +; [this-min (get-min-width)]) +; (when (is-a? parent aligned-pasteboard<%>) +; (send parent ignore-resizing true)) +; (send parent begin-edit-sequence) +; (send ed begin-edit-sequence) +; (send ed set-max-width 'none) +; (send ed set-min-width 'none) +; (set-max-width 'none) +; (set-min-width 'none) +; (begin0 +; (let ([left (box 0)] +; [top (box 0)] +; [right (box 0)] +; [bottom (box 0)]) +; (get-margin left top right bottom) +; (+ (unbox left) +; (snip-width this))) +; (send ed set-max-width ed-max) +; (send ed set-max-width ed-min) +; (set-min-width this-min) +; (set-max-width this-max) +; (send ed end-edit-sequence) +; (send parent end-edit-sequence) +; (when (is-a? parent aligned-pasteboard<%>) +; (send parent ignore-resizing false))))) +; +; ; get-aligned-min-height (-> number?) +; ; the minimum height of the snip based on the children +; (inherit get-max-height set-max-height get-min-height set-min-height) +; (define/public (get-aligned-min-height) +; (let* ([parent (snip-parent this)] +; [ed (get-editor)] +; [ed-max (send ed get-max-height)] +; [ed-min (send ed get-min-height)] +; [this-max (get-max-height)] +; [this-min (get-min-height)]) +; (when (is-a? parent aligned-pasteboard<%>) +; (send parent ignore-resizing true)) +; (send parent begin-edit-sequence) +; (send ed begin-edit-sequence) +; (send ed set-max-height 'none) +; (send ed set-min-height 'none) +; (set-max-height 'none) +; (set-min-height 'none) +; (begin0 +; (snip-height this) +; (send ed set-max-height ed-max) +; (send ed set-min-height ed-min) +; (set-min-height this-min) +; (set-max-height this-max) +; (send ed end-edit-sequence) +; (send parent end-edit-sequence) +; (when (is-a? parent aligned-pasteboard<%>) +; (send parent ignore-resizing false))))) + (super-instantiate ()) )) ) \ No newline at end of file diff --git a/collects/mrlib/private/aligned-pasteboard/aligned-pasteboard.ss b/collects/mrlib/private/aligned-pasteboard/aligned-pasteboard.ss index 68d2e47f..145e316f 100644 --- a/collects/mrlib/private/aligned-pasteboard/aligned-pasteboard.ss +++ b/collects/mrlib/private/aligned-pasteboard/aligned-pasteboard.ss @@ -1,11 +1,9 @@ (module aligned-pasteboard mzscheme (require - (lib "mred.ss" "mred") (lib "framework.ss" "framework") (lib "click-forwarding-editor.ss" "mrlib") "geometry-managed-pasteboard.ss" - "event-handling-pasteboard.ss" "locked-pasteboard.ss") (provide @@ -13,17 +11,15 @@ horizontal-pasteboard%) ;; contruct the basic mixin that both pasteboards will be created from - (define (make-aligned-pasteboard type) + (define (click/lock type) (editor:basic-mixin (click-forwarding-editor-mixin (locked-pasteboard-mixin - (event-handling-pasteboard-mixin - (geometry-managed-pasteboard-mixin - pasteboard% type)))))) + (make-aligned-pasteboard type))))) (define vertical-pasteboard% - (make-aligned-pasteboard 'vertical)) + (click/lock 'vertical)) (define horizontal-pasteboard% - (make-aligned-pasteboard 'horizontal)) + (click/lock 'horizontal)) ) diff --git a/collects/mrlib/private/aligned-pasteboard/alignment.ss b/collects/mrlib/private/aligned-pasteboard/alignment.ss index 99843422..5c94ba34 100644 --- a/collects/mrlib/private/aligned-pasteboard/alignment.ss +++ b/collects/mrlib/private/aligned-pasteboard/alignment.ss @@ -22,7 +22,7 @@ (require (lib "match.ss") - (lib "contracts.ss") + (lib "contract.ss") (lib "etc.ss") (lib "list.ss")) @@ -145,4 +145,4 @@ (begin (set! n (sub1 n)) 1)))) - ) \ No newline at end of file + ) diff --git a/collects/mrlib/private/aligned-pasteboard/geometry-managed-pasteboard.ss b/collects/mrlib/private/aligned-pasteboard/geometry-managed-pasteboard.ss index dda18738..f9af9255 100644 --- a/collects/mrlib/private/aligned-pasteboard/geometry-managed-pasteboard.ss +++ b/collects/mrlib/private/aligned-pasteboard/geometry-managed-pasteboard.ss @@ -2,21 +2,22 @@ (require (lib "class.ss") - (lib "contracts.ss") + (lib "contract.ss") (lib "list.ss") (lib "etc.ss") (lib "match.ss") - "interface.ss" + (lib "mred.ss" "mred") "interface.ss" "alignment.ss" - "snip-lib.ss") + "snip-lib.ss" + "pasteboard-lib.ss") (provide/contract - (geometry-managed-pasteboard-mixin (class? (symbols 'vertical 'horizontal) . -> . class?))) + (make-aligned-pasteboard ((symbols 'vertical 'horizontal) . -> . class?))) ;; mixin to add geometry management to pasteboard with the give type of alignement - (define (geometry-managed-pasteboard-mixin super% type) - (class* super% (aligned-pasteboard<%>) - (inherit resize move-to find-first-snip + (define (make-aligned-pasteboard type) + (class* pasteboard% (aligned-pasteboard<%>) + (inherit resize move-to find-first-snip refresh-delayed? begin-edit-sequence end-edit-sequence) (field @@ -28,6 +29,10 @@ [aligned-min-height 0] [aligned-rects empty]) + ;;temp fix + (define/public (ignore-resizing ignore?) + (set! ignore-resizing? ignore?)) + ;; get-aligned-min-width (-> number?) ;; the aligned-min-width of the pasteboard (define/public (get-aligned-min-width) @@ -81,8 +86,122 @@ ($ dim x width stretchable-width?) ($ dim y height stretchable-height?))) (move-to snip x y) - (when (or stretchable-height? stretchable-width?) - (resize snip width height))])) + (when (or stretchable-height? stretchable-width? (is-a? snip aligned-pasteboard-parent<%>)) + (resize snip width height)) + ;(resize snip width height) + ;(when (is-a? snip editor-snip%) + ; (send snip set-min-width 'none) + ; (send (send snip get-editor) set-min-width 'none)) + ])) + + (field [in-edit-sequence? false]) + + ;; after-insert ((is-a?/c snip%) (is-a?/c snip%) number? number? . -> . void?) + ;; called after a snip is inserted to the pasteboard + (rename [super-after-insert after-insert]) + (define/override (after-insert snip before x y) + (calc/realign) + (super-after-insert snip before x y)) + + ;; after-delete ((is-a?/c snip%) . -> . void?) + ;; called after a snip is deleted from the pasteboard% + (rename [super-after-delete after-delete]) + (define/override (after-delete snip) + (calc/realign) + (super-after-delete snip)) + + ;; after-reorder ((is-a?/c snip%) (is-a?/c snip%) boolean? . -> . void?) + ;; called after a snip is moved in the front to back snip order + (rename [super-after-reorder after-reorder]) + (define/override (after-reorder snip to-snip before?) + (realign) + (super-after-reorder snip to-snip before?)) + + ;; resized ((is-a?/c snip%) . -> . void?) + ;; called when a snip inside the editor is resized + (rename [super-resized resized]) + (define/override (resized snip redraw-now?) + (super-resized snip redraw-now?) + (unless ignore-resizing? + (when (or redraw-now? + (and (not (refresh-delayed?)) + (needs-resize? snip) + )) + (calc/realign)))) + + ;; after-edit-sequence (-> void?) + ;; called after an edit-sequence ends + (rename [super-after-edit-sequence after-edit-sequence]) + (define/override (after-edit-sequence) + (set! in-edit-sequence? false) + (when needs-realign? (calc/realign))) + + (rename [super-on-edit-sequence on-edit-sequence]) + (define/override (on-edit-sequence) + (set! in-edit-sequence? true) + (super-on-edit-sequence)) + + ;; calc/realign (-> void?) + ;; sends a message to the pasteboard to recalculate min sizes and realign + (define/private (calc/realign) + (if in-edit-sequence? + (set! needs-realign? true) + (let* ([root (pasteboard-root this)] + [parent (pasteboard-parent root)]) + (when parent + (send parent set-aligned-min-sizes) + (send root realign))))) + + ;; needs-resize? ((is-a?/c snip%) . -> . boolean?) + ;; determines if the snip's size is smaller than it's min size + (define/private (needs-resize? snip) + (with-handlers ([exn? (lambda a false)]) + (match-let ([($ rect + ($ dim _ alloted-width _) + ($ dim _ alloted-height _)) + (find-rect snip)]) + (if (is-a? snip aligned-snip<%>) + (or (< alloted-width (send snip get-aligned-min-width)) + (< alloted-height (send snip get-aligned-min-height))) + (if (empty? aligned-rects) + false + + (match-let ([($ rect + ($ dim _ actual-width _) + ($ dim _ actual-height _)) + (build-rect snip)]) + (not (and (= alloted-width actual-width) + (= alloted-height actual-height))))))))) + + ;(define/private (needs-resize? snip) + ; (cond + ; [(is-a? snip aligned-snip<%>) + ; (or (< (snip-width snip) + ; (send snip get-aligned-min-width)) + ; (< (snip-height snip) + ; (send snip get-aligned-min-height)) + ; (and (not (send snip stretchable-width)) + ; (> (snip-width snip) + ; (send snip get-aligned-min-width))) + ; (and (not (send snip stretchable-height)) + ; (> (snip-height snip) + ; (send snip get-aligned-min-height))))] + ; [else false])) + + ;; find-rect ((is-a?/c snip%) . -> . rect?) + ;; finds the rect that corresponds to the given snip + (define/private (find-rect target-snip) + (letrec ([find-rect-aux + (lambda (snip rects) + (cond + [(or (equal? snip false) (empty? rects)) + (error 'find-rect "Snip not found")] + [else + (if (equal? snip target-snip) + (car rects) + (find-rect-aux (send snip next) + (rest rects)))]))]) + (find-rect-aux (find-first-snip) aligned-rects))) (super-instantiate ()) )) diff --git a/collects/mrlib/private/aligned-pasteboard/interface.ss b/collects/mrlib/private/aligned-pasteboard/interface.ss index 85674c74..901d4b13 100644 --- a/collects/mrlib/private/aligned-pasteboard/interface.ss +++ b/collects/mrlib/private/aligned-pasteboard/interface.ss @@ -12,6 +12,9 @@ ;; the interface that must be implemented for a pasteboard to be contained in an aligned-pasteboard-parent<%> (define aligned-pasteboard<%> (interface (editor<%>) + ;; temp fix + ignore-resizing + ;; get-alignment (-> (values symbol? symbol?)) ;; get the pasteboards current alignment specification ;; status: possible future feature diff --git a/collects/mrlib/private/aligned-pasteboard/locked-pasteboard.ss b/collects/mrlib/private/aligned-pasteboard/locked-pasteboard.ss index 9b05030f..53fe4c84 100644 --- a/collects/mrlib/private/aligned-pasteboard/locked-pasteboard.ss +++ b/collects/mrlib/private/aligned-pasteboard/locked-pasteboard.ss @@ -3,7 +3,7 @@ (require (lib "class.ss") (lib "etc.ss") - (lib "contracts.ss")) + (lib "contract.ss")) (provide/contract (locked-pasteboard-mixin mixin-contract)) @@ -22,4 +22,4 @@ false) (super-instantiate ()) )) - ) \ No newline at end of file + ) diff --git a/collects/mrlib/private/aligned-pasteboard/pasteboard-lib.ss b/collects/mrlib/private/aligned-pasteboard/pasteboard-lib.ss index f8ed4eda..fbf75b39 100644 --- a/collects/mrlib/private/aligned-pasteboard/pasteboard-lib.ss +++ b/collects/mrlib/private/aligned-pasteboard/pasteboard-lib.ss @@ -3,7 +3,7 @@ (require (lib "class.ss") (lib "mred.ss" "mred") - (lib "contracts.ss") + (lib "contract.ss") (lib "etc.ss") "interface.ss" "snip-lib.ss") diff --git a/collects/mrlib/private/aligned-pasteboard/snip-lib.ss b/collects/mrlib/private/aligned-pasteboard/snip-lib.ss index ed700ef6..34871fbd 100644 --- a/collects/mrlib/private/aligned-pasteboard/snip-lib.ss +++ b/collects/mrlib/private/aligned-pasteboard/snip-lib.ss @@ -5,7 +5,7 @@ (lib "etc.ss") (lib "mred.ss" "mred") (lib "list.ss") - (lib "contracts.ss") + (lib "contract.ss") "interface.ss") ;; a snip