110 lines
3.7 KiB
Racket
110 lines
3.7 KiB
Racket
(module stretchable-editor-snip mzscheme
|
|
|
|
(provide
|
|
stretchable-editor-snip%
|
|
stretchable-editor-snip-mixin)
|
|
|
|
(require
|
|
mzlib/class
|
|
mred
|
|
mzlib/etc
|
|
"snip-lib.rkt"
|
|
"interface.rkt")
|
|
|
|
(define (stretchable-editor-snip-mixin super%)
|
|
(class* super% (stretchable-snip<%>)
|
|
|
|
(init
|
|
(stretchable-width true)
|
|
(stretchable-height true))
|
|
|
|
(field
|
|
(aligned-min-width 0)
|
|
(aligned-min-height 0)
|
|
(stretchable-width-field stretchable-width)
|
|
(stretchable-height-field stretchable-height))
|
|
|
|
(public (stretchable-width-method stretchable-width)
|
|
(stretchable-height-method stretchable-height))
|
|
|
|
;; stretchable-width (case-> (Boolean . -> . (void)) (-> Boolean))
|
|
;; get or set the stretchablity of the pasteboards width
|
|
(define stretchable-width-method
|
|
(case-lambda
|
|
[(value) (set! stretchable-width-field value)]
|
|
[() stretchable-width-field]))
|
|
|
|
;; stretchable-height (case-> (Boolean . -> .(void)) (-> Boolean))
|
|
;; get or set the stretchablity of the pasteboards height
|
|
(define stretchable-height-method
|
|
(case-lambda
|
|
[(value) (set! stretchable-height-field value)]
|
|
[() stretchable-height-field]))
|
|
|
|
(define/public (get-aligned-min-width) aligned-min-width)
|
|
(define/public (get-aligned-min-height) aligned-min-height)
|
|
|
|
(inherit get-margin get-editor get-admin)
|
|
(define/override (resize w h)
|
|
(set! aligned-min-width w)
|
|
(set! aligned-min-height h)
|
|
(super-resize w h))
|
|
|
|
(define/public (stretch w h)
|
|
(super-resize w h))
|
|
|
|
(define/override (get-extent dc x y w h descent space lspace rspace)
|
|
(super get-extent dc x y w h descent space lspace rspace)
|
|
(when (is-a? (get-editor) text%)
|
|
(set-box! w (sub1 (unbox w))))
|
|
(go))
|
|
|
|
(define/override (set-min-width w)
|
|
;; account for margin !!!!!!
|
|
(send (get-editor) set-min-width w))
|
|
|
|
(define/override (set-min-height h)
|
|
;; account for margin !!!!!!
|
|
(send (get-editor) set-min-height h))
|
|
|
|
(define/public (super-resize w h)
|
|
(let ((top (box 0))
|
|
(bot (box 0))
|
|
(lef (box 0))
|
|
(rit (box 0)))
|
|
(get-margin top bot lef rit)
|
|
(let ((w (max (- w (unbox lef) (unbox rit)) 0))
|
|
(h (max (- h (unbox top) (unbox bot)) 0))
|
|
(e (get-editor))
|
|
(a (get-admin)))
|
|
;; subtracting 1 from W seems to make it act more like the editor-snip
|
|
;; because the C code has a hack to sub1 to make it look better. I am not
|
|
;; sure if this change here is sound and works for every part of this
|
|
;; class.
|
|
(super set-min-width w)
|
|
(super set-min-height h)
|
|
(when a (send a resized this #t)))))
|
|
|
|
;; call this from within get extent and use the values it produces by subtracting the
|
|
;; margin instead of calling the editors get-extent and adding the margin.
|
|
(define (go)
|
|
(let ([w (box 0)]
|
|
[h (box 0)]
|
|
(top (box 0))
|
|
(bot (box 0))
|
|
(lef (box 0))
|
|
(rit (box 0)))
|
|
(get-margin top bot lef rit)
|
|
(send (get-editor) get-extent w h)
|
|
(set! aligned-min-width (+ (unbox w) (unbox lef) (unbox rit)))
|
|
(set! aligned-min-height (+ (unbox h) (unbox top) (unbox rit)))))
|
|
|
|
(super-new)
|
|
(inherit get-min-width get-min-height)
|
|
(set-min-width (get-min-width))
|
|
(set-min-height (get-min-height))))
|
|
|
|
(define stretchable-editor-snip%
|
|
(stretchable-editor-snip-mixin
|
|
editor-snip%)))
|