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.
46 lines
1.8 KiB
Racket
46 lines
1.8 KiB
Racket
#lang racket/gui
|
|
|
|
(provide dump-children (struct-out snip-dump) dump=?)
|
|
|
|
;;dump=?: ((union snip-dump? (listof snip-dump?)) . -> . boolean?)
|
|
(define (dump=? dump1 dump2)
|
|
(cond [(and (list? dump1) (list? dump2) (eq? (length dump1) (length dump2)))
|
|
(andmap dump=? dump1 dump2)]
|
|
[(and (snip-dump? dump1) (snip-dump? dump2))
|
|
(and (dump=? (snip-dump-left dump1) (snip-dump-left dump2))
|
|
(dump=? (snip-dump-top dump1) (snip-dump-top dump2))
|
|
(dump=? (snip-dump-right dump1) (snip-dump-right dump2))
|
|
(dump=? (snip-dump-bottom dump1) (snip-dump-bottom dump2))
|
|
(dump=? (snip-dump-children dump1) (snip-dump-children dump2)))]
|
|
[else (equal? dump1 dump2)]))
|
|
|
|
;; type snip-dump =
|
|
;; (make-single number number number number (union #f (listof snip-dump)))
|
|
;; if children is #f, this indicates that the snip was not an
|
|
;; editor-snip. In contrast, if it is null, this indicates that
|
|
;; the snip is an editor-snip, but has no children.
|
|
(define-struct snip-dump (left top right bottom children))
|
|
|
|
;; dump-pb : snip -> snip-dump
|
|
(define (dump-snip snip)
|
|
(define outer-pb (send (send snip get-admin) get-editor))
|
|
(define bl (box 0))
|
|
(define bt (box 0))
|
|
(define br (box 0))
|
|
(define bb (box 0))
|
|
(send outer-pb get-snip-location snip bl bt #t)
|
|
(send outer-pb get-snip-location snip br bb #f)
|
|
(make-snip-dump (unbox bl) (unbox bt) (unbox br) (unbox bb)
|
|
(dump-snips snip)))
|
|
|
|
;; dump-snips : snip -> (union #f (listof snip-dump))
|
|
(define (dump-snips snip)
|
|
(and (is-a? snip editor-snip%) (dump-children (send snip get-editor))))
|
|
|
|
;; dump-children : editor<%> -> (listof snip-dump)
|
|
(define (dump-children editor)
|
|
(let loop ([snip (send editor find-first-snip)])
|
|
(if snip
|
|
(cons (dump-snip snip) (loop (send snip next)))
|
|
'())))
|