suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

v299 updates

Browse Source 
original commit: 186ee95616789aeafa764281004190f101f71e52
This commit is contained in:
Matthew Flatt 2004-09-10 15:14:40 +00:00
parent b1ec1e51cc
commit f9f2f82b26
4 changed files with 17 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/mrlib/click-forwarding-editor.ss
View File

@ -17,15 +17,14 @@
;; on-event ((is-a?/c mouse-event%) . -> . void?)
;; overridden to give focus to child snips when clicked
(rename [super-on-event on-event])
(define/override (on-event event)
(if (memq (send event get-event-type)
'(left-down left-up middle-down middle-up right-down right-up))
(let ([snip (find-snip/global (send event get-x) (send event get-y))])
(if (is-a? snip snip%)
(forward-event snip event)
(super-on-event event)))
(super-on-event event)))
(super on-event event)))
(super on-event event)))
;; forward-event ((is-a?/c snip%) (is-a?/c mouse-event%) . -> . void?)
;; send the event to the snip

6
collects/mrlib/private/aligned-pasteboard/aligned-editor-container.ss
View File

@ -49,9 +49,8 @@
;; on-size (number? number? . -> . (void))
;; called when the canvas's parent size changes
(rename (super-on-size on-size))
(define/override (on-size width height)
(super-on-size width height)
(super on-size width height)
(let ([w (- width width-diff machenrys-constant)]
[h (- height height-diff machenrys-constant)])
(when (and (positive? w) (positive? h))
@ -170,9 +169,8 @@
;; This code is needed to probe the tree of editors for their real sizes when they
;; finally know them. This happens when the top level snip gets an admin.
(rename [super-set-admin set-admin])
(define/override (set-admin admin)
(super-set-admin admin)
(super set-admin admin)
(let ([parent (snip-parent this)])
(when (and parent (not (is-a? parent aligned-pasteboard<%>)))
(set-aligned-min-sizes)

25
collects/mrlib/private/aligned-pasteboard/geometry-managed-pasteboard.ss
View File

@ -109,39 +109,34 @@
;; after-insert ((is-a?/c snip%) (is-a?/c snip%) number? number? . -> . void?)
;; called after a snip is inserted to the pasteboard
(rename [super-after-insert after-insert])
(define/override (after-insert snip before x y)
(define/augment (after-insert snip before x y)
(aligned-min-sizes-invalid)
(super-after-insert snip before x y))
(inner (void) after-insert snip before x y))
;; after-delete ((is-a?/c snip%) . -> . void?)
;; called after a snip is deleted from the pasteboard%
(rename [super-after-delete after-delete])
(define/override (after-delete snip)
(define/augment (after-delete snip)
(aligned-min-sizes-invalid)
(super-after-delete snip))
(inner (void) after-delete snip))
; after-reorder ((is-a?/c snip%) (is-a?/c snip%) boolean? . -> . void?)
;; called after a snip is moved in the front to back snip order
(rename [super-after-reorder after-reorder])
(define/override (after-reorder snip to-snip before?)
(define/augment (after-reorder snip to-snip before?)
(realign-to-alloted)
(super-after-reorder snip to-snip before?))
(inner (void) after-reorder snip to-snip before?))
;; resized ((is-a?/c snip%) . -> . void?)
;; called when a snip inside the editor is resized
(rename [super-resized resized])
(define/override (resized snip redraw-now?)
(super-resized snip redraw-now?)
(super resized snip redraw-now?)
(unless ignore-resizing?
(aligned-min-sizes-invalid)))
;; after-edit-sequence (-> void?)
;; called after an edit-sequence ends
(rename [super-after-edit-sequence after-edit-sequence])
(define/override (after-edit-sequence)
(super-after-edit-sequence)
(when needs-realign? (aligned-min-sizes-invalid)))
(define/augment (after-edit-sequence)
(when needs-realign? (aligned-min-sizes-invalid))
(inner (void) after-edit-sequence))
(super-new)))

9
collects/mrlib/private/aligned-pasteboard/stretchable-editor-snip.ss
View File

@ -53,9 +53,8 @@
(define/public (stretch w h)
(super-resize w h))
(rename [super-get-extent get-extent])
(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)
(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))
@ -68,8 +67,6 @@
;; account for margin !!!!!!
(send (get-editor) set-min-height h))
(rename [super-set-min-width set-min-width]
[super-set-min-height set-min-height])
(define/public (super-resize w h)
(let ((top (box 0))
(bot (box 0))
@ -84,8 +81,8 @@
;; 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)
(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