gui/gui-lib/embedded-gui/private/really-resized-pasteboard.rkt
2014-12-02 02:33:07 -05:00

86 lines
2.8 KiB
Racket

#|
This module provides a really-resized pasteboard that calls the really-resized
method when a snip in the editor is really resized, not when pasteboard says
it's resized. This file was written because sometimes I need to override resized
to adjust my editors layout however the resized method of the pasteboard is
invoked whenever editor snips get focus, lose focus, get text typed into them,
get text deteleted from them, etc.
|#
(module really-resized-pasteboard mzscheme
(require
mzlib/etc
mzlib/class
mred)
(provide
really-resized-pasteboard-mixin
really-resized-pasteboard%)
(define (really-resized-pasteboard-mixin super%)
(class super%
(inherit refresh-delayed? get-snip-location)
(field [snip-cache (make-hash-table)]
[ignore-resizing? false])
;; Called whenever a snip within the editor is resized, just like the
;; resized method but excludes suchs events as when and editor-snip gets
;; focus.
(define/public (really-resized snip) (void))
#|
snip : snip% object
redraw-now? : boolean
|#
(define/override (resized snip redraw-now?)
(super resized snip redraw-now?)
(unless ignore-resizing?
(let ([size (snip-size snip)])
;; The snip is getting remove from hash table in a way I
;; am not antisipating. I need to find it and then I can
;; remove this error catcher.
(unless (equal? size (with-handlers ([exn? (lambda x 0)])
(hash-table-get snip-cache snip)))
(hash-table-put! snip-cache snip size)
(really-resized snip)))))
#|
snip : snip% object
before : snip% object or #f
x : real number
y : real number
|#
(define/augment (after-insert snip before x y)
(hash-table-put! snip-cache snip (snip-size snip))
(inner (void) after-insert snip before x y))
#|
snip : snip% object
|#
(define/augment (after-delete snip)
(hash-table-remove! snip-cache snip)
(inner (void) after-delete snip))
#;((is-a?/c snip%) . -> . (cons/p natural-number? natural-number?))
;; The width and height of the given snip in this pasteboard.
(define (snip-size snip)
(let ([top (box 0)]
[bottom (box 0)]
[left (box 0)]
[right (box 0)])
(fluid-let ([ignore-resizing? true])
(get-snip-location snip left top false)
(get-snip-location snip right bottom true))
(cons (- (unbox right) (unbox left))
(- (unbox bottom) (unbox top)))))
(super-new)))
(define really-resized-pasteboard%
(really-resized-pasteboard-mixin
pasteboard%))
)