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

.

Browse Source 
original commit: 36afec75cfdce66a42347a849299b4c49bc4f5f5
This commit is contained in:
Matthew Flatt 2001-06-12 17:41:11 +00:00
parent 400077edbd
commit c8a8366be1
1 changed files with 8 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/mred/mred.ss
View File

@ -3741,10 +3741,13 @@
(lambda ()
(super-init (lambda () (set! wx (mk-wx)) wx) (lambda () wx) #f parent #f))))))
(define default-paint-cb (lambda (canvas dc) (void)))
(define canvas%
(class100 basic-canvas% (parent [style null] [paint-callback (lambda (canvas dc) (void))])
(class100 basic-canvas% (parent [style null] [paint-callback default-paint-cb])
(private-field [paint-cb paint-callback])
(inherit get-client-size get-dc)
(rename [super-on-paint on-paint])
(sequence
(let ([cwho '(constructor canvas)])
(check-container-parent cwho parent)
@ -3823,7 +3826,10 @@
[get-scroll-page (entry-point (lambda (d) (send wx get-scroll-page d)))]
[set-scroll-page (entry-point (lambda (d v) (send wx set-scroll-page d v)))])
(override
[on-paint (lambda () (paint-cb this (get-dc)))])
[on-paint (lambda ()
(if (eq? paint-cb default-paint-cb)
(super-on-paint)
(paint-cb this (get-dc))))])
(private-field
[wx #f])
(sequence