7d50e61c7f
* Another big chunk of v4-require-isms * Allow `#lang framework/keybinding-lang' for keybinding files * Move hierlist sources into "mrlib/hierlist", leave stub behind svn: r10689
55 lines
1.5 KiB
Scheme
55 lines
1.5 KiB
Scheme
(require
|
|
mred
|
|
mzlib/class
|
|
mzlib/etc
|
|
mzlib/list
|
|
mzlib/match
|
|
(prefix a: "../alignment.ss")
|
|
"../alignment-helpers.ss"
|
|
"../dllist.ss"
|
|
mrlib/click-forwarding-editor
|
|
"../on-show-pasteboard.ss"
|
|
"../really-resized-pasteboard.ss"
|
|
"../interface.ss"
|
|
"../locked-pasteboard.ss"
|
|
"../suppress-modify-editor.ss")
|
|
|
|
;;;;;;;;;;
|
|
;; alignment
|
|
|
|
(define (vert/horiz-alignment type)
|
|
(class* dllist% ()
|
|
|
|
(init-field [parent #f])
|
|
|
|
(field
|
|
[head (new head%)]
|
|
[tail (new tail%)])
|
|
|
|
(send head next tail)
|
|
(send tail prev head)
|
|
|
|
#;(((is-a?/c alignment<%>)) ((union (is-a?/c alignment<%>) false?)) . opt-> . void?)
|
|
;; Add the given alignment as a child before the existing child
|
|
(define/public add-child
|
|
(opt-lambda (child (after #f))
|
|
(define (link p item n)
|
|
(send p next child)
|
|
(send child prev p)
|
|
(send n prev child)
|
|
(send child next n))
|
|
(if after
|
|
(link after child (send after next))
|
|
(link (send tail prev) child tail))))
|
|
|
|
(super-new)
|
|
(when parent (send parent add-child this))))
|
|
|
|
(define vertical-alignment% (vert/horiz-alignment 'vertical))
|
|
(define horizontal-alignment% (vert/horiz-alignment 'horizontal))
|
|
|
|
(let* ([interactions (new vertical-alignment% (parent (new vertical-alignment%)))])
|
|
(new horizontal-alignment% (parent interactions))
|
|
(new horizontal-alignment% (parent interactions))
|
|
`(equal? ,(length (send interactions map-to-list (lambda (x) x))) 2))
|