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

added vertical-separator-snip for pickle-ability

Browse Source 
svn: r4621
This commit is contained in:
John Clements 2006-10-17 22:50:13 +00:00
parent 5aa1aacd97
commit 57b2dd2903
2 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/stepper/private/mred-extensions.ss
View File

@ -13,7 +13,8 @@
stepper-text% stepper-text%
snip? snip?
stepper-warning% stepper-warning%
finished-text) finished-text
vertical-separator-snip-class%)
(define test-dc (make-object bitmap-dc% (make-object bitmap% 1 1))) (define test-dc (make-object bitmap-dc% (make-object bitmap% 1 1)))
(define reduct-highlight-color (make-object color% 255 255 255)) (define reduct-highlight-color (make-object color% 255 255 255))
@ -36,9 +37,8 @@
(unless (send red-arrow-bitmap ok?) (unless (send red-arrow-bitmap ok?)
(error 'red-arrow-bitmap "unable to load red-arrow bitmap")) (error 'red-arrow-bitmap "unable to load red-arrow bitmap"))
(define vertical-separator-snipclass (define vertical-separator-snip-class%
(make-object (class snip-class% ()
(class snip-class% ()
(override read) (override read)
(define (read s) (define (read s)
@ -46,11 +46,15 @@
(send s get size-box) (send s get size-box)
(make-object vertical-separator-snip% 100))) (make-object vertical-separator-snip% 100)))
(super-instantiate ())))) (super-instantiate ())))
(define vertical-separator-snipclass
(make-object vertical-separator-snip-class%))
(send* vertical-separator-snipclass (send* vertical-separator-snipclass
(set-version 1) (set-version 1)
(set-classname "drscheme:vertical-separator-snip%")) (set-classname (format "~s" `(lib "vertical-separator-snip.ss" "stepper" "private"))))
(send (get-the-snip-class-list) add vertical-separator-snipclass) (send (get-the-snip-class-list) add vertical-separator-snipclass)

9
collects/stepper/private/vertical-separator-snip.ss Normal file
View File

@ -0,0 +1,9 @@
(module vertical-separator-snip mzscheme
(require (lib "mred.ss" "mred")
(lib "class.ss")
"mred-extensions.ss")
(provide snip-class)
(define snip-class (make-object vertical-separator-snip-class%))
(send snip-class set-classname (format "~s" `(lib "vertical-separator-snip.ss" "stepper" "private")))
(send (get-the-snip-class-list) add snip-class))