b8034828d0
1. Lots of #lang-ization, other racketizations, code improvements, etc. 2. Some files that were not working now do. 3. "collects/tests/aligned-pasteboard" had some files that were near duplicates of "collects/mrlib/private/aligned-pasteboard/tests". I've removed the former since in a few places it looked like an older version (eg, there were bogus references to a non-existent "utils.rkt"). The former has more files that are in runnable condition now. 4. There are plenty of tests that look like they're failing, but it wasn't shown since they just return #f, and when they were running with a "-f" these results weren't displayed. 5. I have no idea about the code, this is all just reshuffling and minor editing.
40 lines
1.3 KiB
Racket
40 lines
1.3 KiB
Racket
#lang racket/gui
|
|
|
|
(require "../aligned-editor-container.rkt" "../aligned-pasteboard.rkt")
|
|
|
|
(define editor (new vertical-pasteboard%))
|
|
(define pb (new horizontal-pasteboard%))
|
|
(send* pb
|
|
(insert (make-object string-snip% "Call") #f)
|
|
(insert (new editor-snip% [editor (new text%)]) #f))
|
|
(send editor insert (new aligned-editor-snip% [editor pb]))
|
|
(define f (new frame% [label "more-test-jacob"] [width 200] [height 200]))
|
|
(define e (new vertical-pasteboard%))
|
|
(define c (new aligned-editor-canvas% [editor e] [parent f]))
|
|
(define t (new aligned-editor-snip%
|
|
[editor editor] [stretchable-height #f] [stretchable-width #f]))
|
|
(send e insert t)
|
|
(send f show #t)
|
|
|
|
;;;;;;;;;;
|
|
;; exploration
|
|
(require "../snip-lib.rkt")
|
|
(define t-e (send t get-editor))
|
|
(send t-e get-aligned-min-width)
|
|
(send t get-aligned-min-width)
|
|
(define fs (send t-e find-first-snip))
|
|
(define fs-e (send fs get-editor))
|
|
(send fs-e find-first-snip)
|
|
(send fs-e get-aligned-min-width)
|
|
(send fs get-aligned-min-width)
|
|
(define (margin snip)
|
|
(define left (box 0))
|
|
(define top (box 0))
|
|
(define right (box 0))
|
|
(define bottom (box 0))
|
|
(send snip get-margin left top right bottom)
|
|
(list (cons 'left (unbox left))
|
|
(cons 'right (unbox right))
|
|
(cons 'top (unbox top))
|
|
(cons 'bottom (unbox bottom))))
|