From 3e11d5f0ab2beac318f529b6e452a816569aeea0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 20 Dec 1997 15:57:42 +0000 Subject: [PATCH 2/3] startup original commit: 3a0f0320d6b793ce1e5bf05aff04f77f67a0141c --- collects/tests/mred/README | 101 +++ collects/tests/mred/draw.ss | 346 +++++++++ collects/tests/mred/item.ss | 1167 +++++++++++++++++++++++++++++++ collects/tests/mred/mem.ss | 241 +++++++ collects/tests/mred/nruter.xbm | 4 + src/mred/HISTORY | 409 +++++++++++ src/mzscheme/gc/makefile.depend | 0 tests/mred/steps.txt | 130 ++++ 8 files changed, 2398 insertions(+) create mode 100644 collects/tests/mred/README create mode 100644 collects/tests/mred/draw.ss create mode 100644 collects/tests/mred/item.ss create mode 100644 collects/tests/mred/mem.ss create mode 100644 collects/tests/mred/nruter.xbm create mode 100644 src/mred/HISTORY create mode 100644 src/mzscheme/gc/makefile.depend create mode 100644 tests/mred/steps.txt diff --git a/collects/tests/mred/README b/collects/tests/mred/README new file mode 100644 index 00000000..97a628a0 --- /dev/null +++ b/collects/tests/mred/README @@ -0,0 +1,101 @@ + +The "item.ss" test (use load/cd) creates a frame to select +among several types of control-testing frames: + + * Big - Tests basic controls; try everything + + * Medium - Tests sliders & gauges; keep a new Big or + Medium frame open while getting a new Medium + frame to use the "Enable Previous Frame" test + + * Menu - contains its own test instructions + + * Button, Checkbox, etc. - Test everything, watching for + messages in the console + +For Big & Medium, verify that hide & disbale work (via the checkboxes +on the right). Hiding or disabling a panel should hde or disable all +its contained controls. Disbaling a frame (a "Previous" frame) should +also disbale all of the contained controls. When "Null label" is +used, there should *not* be extra space left where a label might have +gone. + +--------------------------------------------------------------------------- + +The "draw.ss" test (use load/cd) tests drawing commands. There +is a checkbox for testing drawing into an intermediate offscreen +bitmap as well. The drawing area should have the following +features: + + At the top, "Pen 0 x 0" in a consistent font (i.e., re-painting + should not change the font) + "Pen 1 x 1" in a possibly different font + "Pen 2 x 2" in a bold font (bold version of 1x1 font) + + the drawings under 0x0 and 1x1 should look the same: + TopLeft: h-line should be left-aligned with box below it, + but extend 1 extra pixel. v-line similarly should be + top-aligned and 1 pixel longer. The lines should not + touch the box - there should be 2 pixels of space. + Top: Lines for the rotated L's should join in a sharp corner + Second from Top: like top-left, but lines should touch the box + Four shape lines: First and second should be exactly the same + shape, with the first hollow and the second filled. + Third shape and 2x2 shapes are ill-defined. + Octagons: two hollow octagons exactly the same shape. + Line: actually two lines, but they should form a single + unbroken line + Images: MrEd logo (b & w) + BB logo (color) + Down-left arrow (b & w) + Down-left arrow - B & W, *not* red + Down-left arrow - red with white background + BB logo, possibly reddened + Down-left arrow - red with *white* background + +--------------------------------------------------------------------------- + +The "imred.ss" test is used to check for memory leaks in a loop +invoking the mred system. Call the `go' procedure with a list +of symbol flags: + 'force not included: + Use the current eventspaces; expects mred:run-exit-callbacks + to terminate everything properly + 'force included: + Use a new eventspace; don't run mred:run-exit-callbacks and + call wx:kill-eventspace instead. + 'console included: + Open a MrEd console + 'thread included: + Spawn a sleeping-and-looping thread during each invocation. + Also tests semaphore-callback (because it has to) + 'eventspace included: + Create a new sub-eventspace during each invocation with + a wx:frame% shown + +--------------------------------------------------------------------------- + +The "mem.ss" test should be loaded at startup: + mred -nu -f tests/mem.ss +It will create a lot of frames and instance of other objects, +reporting memory information along the way. At the end, +before the last memory dump, objects that are still allocated +are displayed like this: + (frame (1 . 5)) +This means that the frame allocated by thread #1 at cycle 5 +(counting down from some number) hasn't been garbage-collected. +If there's a few of these lines (less than 10), that's ok. +A large number of lines indicates a GC problem. + +--------------------------------------------------------------------------- + +The "setup.ss" test is a randomized test of the MrEd classes that tests +MrEd's stability. Load/cd setup.ss, and then run + (init) +This attempts to create instances of classes using random +intialization arguments. (init) can be run any number of times. Then +run + (call-all-random) +This calls every method of every class (skipping some "dangerous" ones +that modify the file system) with a random instance and with random +arguments. diff --git a/collects/tests/mred/draw.ss b/collects/tests/mred/draw.ss new file mode 100644 index 00000000..8be648b3 --- /dev/null +++ b/collects/tests/mred/draw.ss @@ -0,0 +1,346 @@ + +(define sys-path + (lambda (f) + (build-path (collection-path "icons") f))) + +(let* ([f (make-object mred:frame% () + "Graphics Test" + -1 -1 300 350)] + [vp (make-object mred:vertical-panel% f)] + [hp0 (make-object mred:horizontal-panel% vp)] + [hp (make-object mred:horizontal-panel% vp)] + [hp2 (make-object mred:horizontal-panel% vp)] + [bb (make-object wx:bitmap% (sys-path "bb.gif") + wx:const-bitmap-type-gif)] + [return (make-object wx:bitmap% (sys-path "return.xbm") + wx:const-bitmap-type-xbm)] + [tmp-mdc (make-object wx:memory-dc%)] + [use-bitmap? #f] + [depth-one? #f]) + (send hp0 stretchable-in-y #f) + (send hp stretchable-in-y #f) + (send hp2 stretchable-in-y #f) + (let ([canvas + (make-object + (make-class mred:canvas% + (inherit get-dc) + (public + [no-bitmaps? #f] + [set-bitmaps (lambda (on?) (set! no-bitmaps? (not on?)) (on-paint))] + [no-stipples? #f] + [set-stipples (lambda (on?) (set! no-stipples? (not on?)) (on-paint))] + [scale 1] + [set-scale (lambda (s) (set! scale s) (on-paint))] + [offset 0] + [set-offset (lambda (o) (set! offset o) (on-paint))] + [on-paint + (case-lambda + [() (on-paint #f)] + [(ps?) + (let* ([can-dc (get-dc)] + [pen0s (make-object wx:pen% "BLACK" 0 wx:const-solid)] + [pen1s (make-object wx:pen% "BLACK" 1 wx:const-solid)] + [pen2s (make-object wx:pen% "BLACK" 2 wx:const-solid)] + [pen0t (make-object wx:pen% "BLACK" 0 wx:const-transparent)] + [pen1t (make-object wx:pen% "BLACK" 1 wx:const-transparent)] + [pen2t (make-object wx:pen% "BLACK" 2 wx:const-transparent)] + [brushs (make-object wx:brush% "BLACK" wx:const-solid)] + [brusht (make-object wx:brush% "BLACK" wx:const-transparent)] + [penr (make-object wx:pen% "RED" 1 wx:const-solid)] + [brushb (make-object wx:brush% "BLUE" wx:const-solid)] + [mem-dc (if use-bitmap? + (make-object wx:memory-dc%) + #f)] + [bm (if use-bitmap? + (make-object wx:bitmap% (* scale 300) (* scale 300) + (if depth-one? 1 -1)) + #f)] + [draw-series + (lambda (dc pens pent size x y flevel last?) + (let* ([ofont (send dc get-font)]) + (if (positive? flevel) + (send dc set-font + (make-object wx:font% + 10 wx:const-decorative + wx:const-normal + (if (> flevel 1) + wx:const-bold + wx:const-normal) + #t))) + + (send dc set-pen pens) + (send dc set-brush brusht) + + ; Test should overlay this line: + (send dc draw-line + (+ x 3) (+ y 12) + (+ x 40) (+ y 12)) + + (send dc draw-text (string-append size " Pen") + (+ x 5) (+ y 8)) + (send dc set-font ofont) + + (send dc draw-line + (+ x 5) (+ y 27) (+ x 10) (+ 27 y)) + (send dc draw-rectangle + (+ x 5) (+ y 30) 5 5) + (send dc draw-line + (+ x 12) (+ y 30) (+ x 12) (+ y 35)) + + (send dc draw-line + (+ x 5) (+ y 40) (+ x 10) (+ 40 y)) + (send dc draw-rectangle + (+ x 5) (+ y 41) 5 5) + (send dc draw-line + (+ x 10) (+ y 41) (+ x 10) (+ 46 y)) + + (send dc draw-line + (+ x 15) (+ y 25) (+ x 20) (+ 25 y)) + (send dc draw-line + (+ x 20) (+ y 30) (+ x 20) (+ 25 y)) + + (send dc draw-line + (+ x 30) (+ y 25) (+ x 25) (+ 25 y)) + (send dc draw-line + (+ x 25) (+ y 30) (+ x 25) (+ 25 y)) + + (send dc draw-line + (+ x 35) (+ y 30) (+ x 40) (+ 30 y)) + (send dc draw-line + (+ x 40) (+ y 25) (+ x 40) (+ 30 y)) + + (send dc draw-line + (+ x 50) (+ y 30) (+ x 45) (+ 30 y)) + (send dc draw-line + (+ x 45) (+ y 25) (+ x 45) (+ 30 y)) + + ; Check line thickness with "X" + (send dc draw-line + (+ x 20) (+ y 45) (+ x 40) (+ 39 y)) + (send dc draw-line + (+ x 20) (+ y 39) (+ x 40) (+ 45 y)) + + (send dc draw-rectangle + (+ x 5) (+ y 50) 10 10) + (send dc draw-rounded-rectangle + (+ x 5) (+ y 65) 10 10 3) + (send dc draw-ellipse + (+ x 5) (+ y 80) 10 10) + + (send dc set-brush brushs) + (send dc draw-rectangle + (+ x 17) (+ y 50) 10 10) + (send dc draw-rounded-rectangle + (+ x 17) (+ y 65) 10 10 3) + (send dc draw-ellipse + (+ x 17) (+ y 80) 10 10) + + (send dc set-pen pent) + (send dc draw-rectangle + (+ x 29) (+ y 50) 10 10) + (send dc draw-rounded-rectangle + (+ x 29) (+ y 65) 10 10 3) + (send dc draw-ellipse + (+ x 29) (+ y 80) 10 10) + + + (send dc set-pen pens) + (send dc draw-rectangle + (+ x 17) (+ y 95) 10 10) + (send dc set-logical-function wx:const-clear) + (send dc draw-rectangle + (+ x 18) (+ y 96) 8 8) + (send dc set-logical-function wx:const-copy) + + (send dc draw-rectangle + (+ x 29) (+ y 95) 10 10) + (send dc set-logical-function wx:const-clear) + (send dc set-pen pent) + (send dc draw-rectangle + (+ x 30) (+ y 96) 8 8) + + (send dc set-pen pens) + (send dc draw-rectangle + (+ x 5) (+ y 95) 10 10) + (send dc set-logical-function wx:const-xor) + (send dc draw-rectangle + (+ x 5) (+ y 95) 10 10) + (send dc set-logical-function wx:const-copy) + + (send dc draw-line + (+ x 5) (+ y 110) (+ x 8) (+ y 110)) + (send dc draw-line + (+ x 8) (+ y 110) (+ x 11) (+ y 113)) + (send dc draw-line + (+ x 11) (+ y 113) (+ x 11) (+ y 116)) + (send dc draw-line + (+ x 11) (+ y 116) (+ x 8) (+ y 119)) + (send dc draw-line + (+ x 8) (+ y 119) (+ x 5) (+ y 119)) + (send dc draw-line + (+ x 5) (+ y 119) (+ x 2) (+ y 116)) + (send dc draw-line + (+ x 2) (+ y 116) (+ x 2) (+ y 113)) + (send dc draw-line + (+ x 2) (+ y 113) (+ x 5) (+ y 110)) + + (send dc draw-lines + (list + (make-object wx:point% 5 95) + (make-object wx:point% 8 95) + (make-object wx:point% 11 98) + (make-object wx:point% 11 101) + (make-object wx:point% 8 104) + (make-object wx:point% 5 104) + (make-object wx:point% 2 101) + (make-object wx:point% 2 98) + (make-object wx:point% 5 95)) + (+ x 12) (+ y 15)) + + (send dc draw-line + (+ x 5) (+ y 125) (+ x 10) (+ y 125)) + (send dc draw-line + (+ x 11) (+ y 125) (+ x 16) (+ y 125)) + + (send dc set-brush brusht) + (send dc draw-arc + (+ x 20) (+ y 135) + (+ x 5) (+ y 150) + (+ x 20) (+ y 150)) + (send dc draw-arc + (+ x 35) (+ y 150) + (+ x 20) (+ y 135) + (+ x 20) (+ y 150)) + (send dc set-brush brushs) + (send dc draw-arc + (+ x 60) (+ y 135) + (+ x 36) (+ y 150) + (+ x 60) (+ y 150)) + (send dc set-brush brusht) + + (unless (or no-bitmaps? (not last?)) + (let ([x 5] [y 165]) + (send dc draw-icon + (mred:get-icon) x y) + (set! x (+ x (send (mred:get-icon) get-width))) + (let ([do-one + (lambda (bm mode) + (if (send bm ok?) + (begin + (send tmp-mdc select-object bm) + (let ([h (send bm get-height)] + [w (send bm get-width)]) + (send dc blit x y + w h + tmp-mdc 0 0 + mode) + (set! x (+ x w 10))) + (send tmp-mdc select-object null)) + (printf "bad bitmap~n")))]) + (do-one bb wx:const-copy) + (do-one return wx:const-copy) + (send dc set-pen penr) + (do-one return wx:const-copy) + (do-one return wx:const-colour) + (do-one bb wx:const-colour) + (let ([bg (send dc get-background)]) + (send dc set-background brushs) + (do-one return wx:const-colour) + (send dc set-background bg)) + (send dc set-pen pens)))) + + (unless (or no-stipples? (not last?)) + (send dc set-brush brushb) + (send dc draw-rectangle 80 200 100 40) + (when (send return ok?) + (let ([b (make-object wx:brush% "GREEN" wx:const-stipple)]) + (send b set-stipple return) + (send dc set-brush b) + (send dc draw-rectangle 85 205 30 30) + (send dc set-brush brushs) + (send b set-style wx:const-opaque-stipple) + (send dc set-brush b) + (send dc draw-rectangle 120 205 30 30) + (send dc set-brush brushs) + (send b set-stipple bb) + (send dc set-brush b) + (send dc draw-rectangle 155 205 20 30) + (send dc set-brush brushs) + (send b set-stipple null)))) + + (if (not (or ps? (eq? dc can-dc))) + (send can-dc blit 0 0 + (* scale 300) (* scale 300) + mem-dc 0 0 wx:const-copy))) + + 'done)]) + + (send (get-dc) set-user-scale 1 1) + (send (get-dc) set-device-origin 0 0) + + (let ([dc (if ps? + (let ([dc (make-object wx:post-script-dc% null #t)]) + (and (send dc ok?) dc)) + (if (and use-bitmap? (send bm ok?)) + (begin + (send mem-dc select-object bm) + mem-dc) + (get-dc)))]) + (when dc + (when ps? + (send dc start-doc "Draw Test") + (send dc start-page)) + + (send dc set-user-scale scale scale) + (send dc set-device-origin offset offset) + + (send dc clear) + ; check default pen/brush: + (send dc draw-rectangle 0 0 5 5) + (send dc draw-line 0 0 20 6) + + (draw-series dc pen0s pen0t "0 x 0" 5 0 0 #f) + + (draw-series dc pen1s pen1t "1 x 1" 70 0 1 #f) + + (draw-series dc pen2s pen2t "2 x 2" 135 0 2 #t) + + (when ps? + (send dc end-page) + (send dc end-doc)))) + + 'done)])])) + vp 0 50 300 300)]) + (make-object mred:radio-box% hp0 + (lambda (self event) + (set! use-bitmap? (< 0 (send event get-command-int))) + (set! depth-one? (< 1 (send event get-command-int))) + (send canvas on-paint)) + null + -1 -1 -1 -1 + '("Canvas" "Pixmap" "Bitmap") + 0 wx:const-horizontal) + (make-object mred:button% hp + (lambda (self event) + (send canvas on-paint #t)) + "PostScript") + (make-object mred:check-box% hp + (lambda (self event) + (send canvas set-scale (if (send event checked?) 2 1))) + "*2") + (make-object mred:check-box% hp + (lambda (self event) + (send canvas set-offset (if (send event checked?) 10 0))) + "+10") + (send (make-object mred:check-box% hp2 + (lambda (self event) + (send canvas set-bitmaps (send event checked?))) + "Icons") + set-value #t) + (send (make-object mred:check-box% hp2 + (lambda (self event) + (send canvas set-stipples (send event checked?))) + "Stipples") + set-value #t)) + + (send f show #t)) diff --git a/collects/tests/mred/item.ss b/collects/tests/mred/item.ss new file mode 100644 index 00000000..b44212df --- /dev/null +++ b/collects/tests/mred/item.ss @@ -0,0 +1,1167 @@ + +(define my-txt #f) + +(define special-font (send wx:the-font-list find-or-create-font + 20 wx:const-decorative + wx:const-bold wx:const-normal + #f)) + +(define (make-h&s cp f) + (make-object mred:button% cp + (lambda (b e) (send f show #f) (send f show #t)) + "Hide and Show")) + +(define (add-hide name w cp) + (let ([c + (make-object mred:check-box% cp + (lambda (c e) (send w show (send c get-value))) + (format "Show ~a" name))]) + (send c set-value #t))) + +(define (add-disable name w ep) + (let ([c + (make-object mred:check-box% ep + (lambda (c e) (send w enable (send c get-value))) + (format "Enable ~a" name))]) + (send c set-value #t))) + +(define (add-disable-radio name w i ep) + (let ([c + (make-object mred:check-box% ep + (lambda (c e) (send w enable i (send c get-value))) + (format "Enable ~a" name))]) + (send c set-value #t))) + +(define (add-change-label name w lp orig other) + (make-object mred:button% lp + (let ([orig-name (if orig orig (send w get-label))] + [changed? #f]) + (lambda (b e) + (if changed? + (unless (null? orig-name) + (send w set-label orig-name)) + (send w set-label other)) + (set! changed? (not changed?)))) + (format "Relabel ~a" name))) + +(define (add-focus-note frame panel) + (define m (make-object mred:message% panel "focus: ??????????????????????????????")) + (send + (make-object + (class-asi wx:timer% + (inherit start) + (public + [notify + (lambda () + (when (send frame is-shown?) + (send m set-label + (format "focus: ~s" (mred:test:get-focused-window))) + (start 1000 #t)))]))) + start 1000 #t)) + +(define OTHER-LABEL "XXXXXXXXXXXXXXXXXXXXXX") + +(define-values (icons-path local-path) + (let ([d (current-load-relative-directory)]) + (values + (lambda (n) + (build-path (collection-path "icons") n)) + (lambda (n) + (build-path d n))))) + +(define popup-test-canvas% + (class mred:canvas% (objects names . args) + (inherit popup-menu draw-text clear) + (public + [last-m null] + [last-choice #f] + [on-paint + (lambda () + (clear) + (draw-text "Left: popup hide state" 0 0) + (draw-text "Right: popup previous" 0 20) + (draw-text (format "Last pick: ~s" last-choice) 0 40))] + [on-event + (lambda (e) + (if (send e button-down?) + (let ([x (send e get-x)] + [y (send e get-y)] + [m (if (or (null? last-m) + (send e button-down? 1)) + (let ([m (make-object mred:menu% + "Title" + (lambda (m e) + (set! last-choice + (send e get-command-int)) + (on-paint)))] + [id 1]) + (for-each + (lambda (obj name) + (send m append + (begin0 id (set! id (add1 id))) + (string-append + name ": " + (if (send obj is-shown?) + "SHOWN" + "")))) + objects names) + m) + last-m)]) + (set! last-m m) + (popup-menu m x y))))]) + (sequence + (apply super-init args)))) + +(define prev-frame #f) + +(define bitmap% + (class wx:bitmap% args + (inherit ok?) + (sequence + (apply super-init args) + (unless (ok?) + (printf "bitmap failure: ~s~n" args))))) + +(define (make-ctls ip cp lp add-testers ep radio-h? label-h? null-label? stretchy?) + + (define return-bmp + (make-object bitmap% (icons-path "return.xbm") + wx:const-bitmap-type-xbm)) + (define bb-bmp + (make-object bitmap% (icons-path "bb.gif") + wx:const-bitmap-type-gif)) + (define mred-bmp + (make-object bitmap% (icons-path "mred.xbm") + wx:const-bitmap-type-xbm)) + (define nruter-bmp + (make-object bitmap% (local-path "nruter.xbm") + wx:const-bitmap-type-xbm)) + + (define :::dummy::: + (when (not label-h?) + (send ip set-label-position wx:const-vertical))) + + (define-values (l il) + (let ([p (make-object mred:horizontal-panel% ip)]) + (send p stretchable-in-x stretchy?) + (send p stretchable-in-y stretchy?) + + (begin + (define l (make-object mred:message% p "Me&ssage")) + (define il (make-object mred:message% p return-bmp)) + + (add-testers "Message" l) + (add-change-label "Message" l lp #f OTHER-LABEL) + + (add-testers "Image Message" il) + (add-change-label "Image Message" il lp return-bmp nruter-bmp) + + (values l il)))) + + (define b (make-object mred:button% ip void "He&llo")) + + (define ib (make-object mred:button% ip void bb-bmp)) + + ; (define ib2 (make-object mred:button% ip void return-bmp)) + + (define lb (make-object mred:list-box% ip void + (if null-label? null "L&ist") + 0 -1 -1 -1 -1 + '("Apple" "Banana" "Coconut & Donuts"))) + + (define cb (make-object mred:check-box% ip void "C&heck")) + + (define icb (make-object mred:check-box% ip void mred-bmp)) + + (define rb (make-object mred:radio-box% ip void + (if null-label? null "R&adio") + -1 -1 -1 -1 + '("First" "Dos" "T&rio") + 0 (if radio-h? + wx:const-horizontal + wx:const-vertical))) + + (define irb (make-object mred:radio-box% ip void + (if null-label? null "Image Ra&dio") + -1 -1 -1 -1 + (list return-bmp nruter-bmp) + 0 (if radio-h? + wx:const-horizontal + wx:const-vertical))) + + (define ch (make-object mred:choice% ip void + (if null-label? null "Ch&oice") + -1 -1 -1 -1 + '("Alpha" "Beta" "Gamma" "Delta & Rest"))) + + (define txt (make-object mred:text% ip void + (if null-label? null "T&ext") + "initial & starting" + -1 -1 -1 -1)) + + (set! my-txt txt) + + (add-testers "Button" b) + (add-change-label "Button" b lp #f OTHER-LABEL) + + (add-testers "Image Button" ib) + (add-change-label "Image Button" ib lp bb-bmp return-bmp) + + (add-testers "List" lb) + (add-change-label "List" lb lp #f OTHER-LABEL) + + (add-testers "Checkbox" cb) + (add-change-label "Checkbox" cb lp #f OTHER-LABEL) + + (add-testers "Image Checkbox" icb) + (add-change-label "Image Checkbox" icb lp mred-bmp bb-bmp) + + (add-testers "Radiobox" rb) + (add-disable-radio "Radio Item `First'" rb 0 ep) + (add-disable-radio "Radio Item `Dos'" rb 1 ep) + (add-disable-radio "Radio Item `Trio'" rb 2 ep) + (add-change-label "Radiobox" rb lp #f OTHER-LABEL) + + (add-testers "Image Radiobox" irb) + (add-disable-radio "Radio Image Item 1" irb 0 ep) + (add-disable-radio "Radio Image Item 2" irb 1 ep) + (add-change-label "Image Radiobox" irb lp #f OTHER-LABEL) + + (add-testers "Choice" ch) + (add-change-label "Choice" ch lp #f OTHER-LABEL) + + (add-testers "Text" txt) + (add-change-label "Text" txt lp #f OTHER-LABEL) + + (make-object popup-test-canvas% + (list l il + b ib + lb + cb icb + rb irb + ch + txt) + (list "label" "image label" + "button" "image button" + "list box" + "checkbox" "image checkbox" + "radio box" "image radiobox" + "choice" + "text") + cp)) + +(define (big-frame h-radio? v-label? null-label? stretchy? special-font?) + (define f (make-object mred:frame% null "Tester")) + + (define hp (make-object mred:horizontal-panel% f)) + + (define ip (make-object mred:vertical-panel% hp)) + (define cp (make-object mred:vertical-panel% hp)) + (define ep (make-object mred:vertical-panel% hp)) + (define lp (make-object mred:vertical-panel% hp)) + + (define (basic-add-testers name w) + (add-hide name w cp) + (add-disable name w ep)) + + (define add-testers + (if stretchy? + (lambda (name control) + (send control stretchable-in-x #t) + (send control stretchable-in-y #t) + (basic-add-testers name control)) + basic-add-testers)) + + (define fp (make-object mred:vertical-panel% ip)) + + (define tp (make-object mred:vertical-panel% fp)) + + (make-h&s cp f) + + (add-testers "Sub-panel" fp) + + (add-testers "Sub-sub-panel" tp) + + (when special-font? + (send tp set-label-font special-font)) + + (make-ctls tp cp lp add-testers ep h-radio? v-label? null-label? stretchy?) + + (add-focus-note f ep) + + (send f show #t) + (set! prev-frame f) + f) + +(define (med-frame radio-h? label-h? null-label? stretchy? special-font?) + (define f2 (make-object mred:frame% null "Tester2")) + + (define hp2 (make-object mred:horizontal-panel% f2)) + + (define ip2 (make-object mred:vertical-panel% hp2)) + (define cp2 (make-object mred:vertical-panel% hp2)) + (define ep2 (make-object mred:vertical-panel% hp2)) + (define lp2 (make-object mred:vertical-panel% hp2)) + + (define (basic-add-testers2 name w) + (add-hide name w cp2) + (add-disable name w ep2)) + + (define add-testers2 + (if stretchy? + (lambda (name control) + (send control stretchable-in-x #t) + (send control stretchable-in-y #t) + (basic-add-testers2 name control)) + basic-add-testers2)) + + (make-h&s cp2 f2) + + (add-disable "Previous Tester Frame" prev-frame ep2) + + (when (not label-h?) + (send ip2 set-label-position wx:const-vertical)) + + (when special-font? + (send ip2 set-label-font special-font)) + + (begin + (define sh (make-object mred:slider% ip2 + (lambda (s e) + (send gh set-value (send sh get-value))) + (if null-label? null "H S&lider") + 5 0 10 -1 -1 -1 + wx:const-horizontal)) + + (define sv (make-object mred:slider% ip2 + (lambda (s e) + (send gv set-value (send sv get-value))) + (if null-label? null "V Sl&ider") + 5 0 10 -1 -1 -1 + wx:const-vertical)) + + (define gh (make-object mred:gauge% ip2 + (if null-label? null "H G&auge") + 10 -1 -1 -1 -1 + wx:const-horizontal)) + + (define gv (make-object mred:gauge% ip2 + (if null-label? null "V Ga&uge") + 10 -1 -1 -1 -1 + wx:const-vertical)) + + (define cmt (make-object mred:canvas-message% ip2 + "Howdy")) + + (define cmi (make-object mred:canvas-message% ip2 + (make-object bitmap% (icons-path "bb.gif") + wx:const-bitmap-type-gif))) + + + (define txt (make-object mred:media-text% ip2 void + (if null-label? null "T&ext") + "initial & starting" + -1 -1 -1 -1)) + + (add-testers2 "Horiz Slider" sh) + (add-testers2 "Vert Slider" sv) + (add-testers2 "Horiz Gauge" gh) + (add-testers2 "Vert Gauge" gv) + (add-testers2 "Text Message" cmt) + (add-testers2 "Image Message" cmi) + (add-testers2 "Text" txt) + + (add-change-label "Horiz Slider" sh lp2 #f OTHER-LABEL) + (add-change-label "Vert Slider" sv lp2 #f OTHER-LABEL) + (add-change-label "Horiz Gauge" gh lp2 #f OTHER-LABEL) + (add-change-label "Vert Gauge" gv lp2 #f OTHER-LABEL) + (add-change-label "Text" txt lp2 #f OTHER-LABEL) + + (add-focus-note f2 ep2) + + (send f2 show #t) + (set! prev-frame f2) + f2)) + +; Need: check, check-test, and enable via menubar +; All operations on Submenus +(define f% + (let-enumerate + ([ADD-APPLE + ADD-BANANA + ADD-COCONUT + DELETE-APPLE + DELETE-BANANA + DELETE-COCONUT-0 + DELETE-COCONUT + DELETE-COCONUT-2 + COCONUT-ID + DELETE-ONCE + APPLE-CHECK-ID]) + (class mred:menu-frame% args + (inherit next-menu-id make-menu) + (rename + [super-make-menu-bar make-menu-bar] + [super-on-menu-command on-menu-command]) + (private + offset + menu-bar + main-menu + apple-menu + banana-menu + coconut-menu + baseball-ids + hockey-ids + enable-item) + (public + [make-menu-bar + (lambda () + (let ([mb (super-make-menu-bar)] + [menu (make-menu)]) + (set! offset (next-menu-id)) + (set! menu-bar mb) + (set! main-menu menu) + + (send menu append (+ offset ADD-APPLE) "Add Apple" "Adds the Apple menu") + (send menu append (+ offset ADD-BANANA) "Add Banana") + (send menu append (+ offset ADD-COCONUT) "Add Coconut") + (send menu append-item "Append Donut" + (lambda () (send apple-menu append-item "Donut" void))) + (send menu append-separator) + (send menu append (+ offset DELETE-COCONUT-0) + "Delete Coconut") + (send menu append-item "Delete Apple" + (lambda () + (send menu-bar delete apple-menu) + (set! apple-installed? #f))) + + (send menu append-separator) + (set! enable-item + (send menu append-item "Apple Once Disabled" + (lambda () + (send apple-menu enable DELETE-ONCE + (not (send menu checked? enable-item)))) + null #t)) + (send menu append-item "Disable Second" + (lambda () (send menu-bar enable-top 1 #f))) + (send menu append-item "Enable Second" + (lambda () (send menu-bar enable-top 1 #t))) + + (send menu append-separator) + (set! baseball-ids + (send menu append-check-set + (list "Astros" "Braves" "Cardinals") + (lambda (which) + (wx:message-box (format "~s Checked" which))))) + (send menu append-separator) + (set! hockey-ids + (send menu append-check-set + `(("Aeros" . Houston) + ("Bruins" . Boston) + ("Capitols" . Washington)) + (lambda (which) + (wx:message-box (format "~s Checked" which))))) + + (set! apple-menu (make-menu)) + (set! banana-menu (make-menu)) + (set! coconut-menu (make-menu)) + + (send apple-menu append (+ offset DELETE-ONCE) + "Delete Once") + (send apple-menu append (+ offset DELETE-APPLE) + "Delete Apple" "Deletes the Apple menu") + (send apple-menu append (+ offset APPLE-CHECK-ID) + "Checkable" null #t) + + (send banana-menu append (+ offset DELETE-BANANA) + "Delete Banana") + (send coconut-menu append (+ offset DELETE-COCONUT) + "Delete Coconut") + (send coconut-menu append (+ offset DELETE-COCONUT-2) + "Delete Coconut By Position") + + (send mb append menu "Tester") + (send mb append apple-menu "Appul") + (send mb enable-top 1 #f) + (send mb set-label-top 1 "Apple") + mb))] + [on-menu-command + (lambda (orig-op) + (let ([op (- orig-op offset)]) + (cond + [(= op ADD-APPLE) + (send menu-bar append apple-menu "Apple") + (set! apple-installed? #t)] + [(= op ADD-BANANA) + (send menu-bar append banana-menu "Banana")] + [(= op ADD-COCONUT) + (send apple-menu append (+ offset COCONUT-ID) + "Coconut" coconut-menu "Submenu")] + [(= op DELETE-ONCE) + (send apple-menu delete (+ offset DELETE-ONCE))] + [(= op DELETE-APPLE) + (send menu-bar delete apple-menu) + (set! apple-installed? #f)] + [(= op DELETE-BANANA) + (send menu-bar delete banana-menu)] + [(or (= op DELETE-COCONUT) (= op DELETE-COCONUT-0)) + (send apple-menu delete (+ offset COCONUT-ID))] + [(= op DELETE-COCONUT-2) + (send apple-menu delete-by-position 3)] + [else + (super-on-menu-command orig-op)])))]) + (sequence (apply super-init args)) + (public + [mfp (make-object mred:vertical-panel% (ivar this panel))] + [mc (make-object mred:wrapping-canvas% mfp -1 -1 200 200)] + [restp (make-object mred:vertical-panel% mfp)] + [mfbp (make-object mred:horizontal-panel% restp)] + [lblp (make-object mred:horizontal-panel% restp)] + [badp (make-object mred:horizontal-panel% restp)] + [e (make-object mred:media-edit%)]) + (sequence + (send restp stretchable-in-y #f) + (send mc set-media e) + (send e load-file (local-path "steps.txt"))) + (public + [make-test-button + (lambda (name pnl menu id) + (make-object mred:button% pnl + (lambda (b e) + (wx:message-box + (if (send (via menu) checked? id) + "yes" + "no") + "Checked?")) + (format "Test ~a" name)))] + [make-bad-test + (lambda (method) + (lambda args + (method 777 #t) + (method 777 #f) + (method -1 #t) + (method -1 #f)))] + [compare + (lambda (expect v kind) + (unless (or (and (string? expect) (string? v) + (string=? expect v)) + (eq? expect v)) + (error 'test-compare "~a mistmatch: ~s != ~s" kind expect v)))] + [label-test + (lambda (menu id expect) + (let ([v (send menu get-label id)]) + (compare expect v "label")))] + [top-label-test + (lambda (pos expect) + (let ([v (send menu-bar get-label-top pos)]) + (compare expect v "top label")))] + [help-string-test + (lambda (menu id expect) + (let ([v (send menu get-help-string id)]) + (compare expect v "help string")))] + [find-test + (lambda (menu title expect string) + (let ([v (if use-menubar? + (send menu-bar find-menu-item title string) + (send menu find-item string))]) + (compare expect v (format "label search: ~a" string))))] + [tell-ok + (lambda () + (printf "ok~n"))] + [temp-labels? #f] + [use-menubar? #f] + [apple-installed? #f] + [via (lambda (menu) (if use-menubar? menu-bar menu))] + [tmp-pick (lambda (a b) (if temp-labels? a b))] + [apple-pick (lambda (x a b) (if (and use-menubar? (not apple-installed?)) + x + (tmp-pick a b)))]) + (sequence +(make-test-button "Aeros" mfbp main-menu (list-ref hockey-ids 0)) + (make-test-button "Bruins" mfbp main-menu (list-ref hockey-ids 1)) + (make-test-button "Capitols" mfbp main-menu (list-ref hockey-ids 2)) + (make-test-button "Apple Item" mfbp apple-menu APPLE-CHECK-ID) + (make-object mred:button% mfbp + (lambda args + (send (via apple-menu) check APPLE-CHECK-ID #t)) + "Check in Apple") + + (make-object mred:button% lblp + (lambda args + (label-test (via main-menu) ADD-APPLE (tmp-pick "Apple Adder" "Add Apple")) + (help-string-test (via main-menu) ADD-APPLE (tmp-pick "ADDER" "Adds the Apple menu")) + (label-test (via main-menu) (car baseball-ids) (tmp-pick "'Stros" "Astros")) + (help-string-test (via main-menu) (car baseball-ids) (tmp-pick "Houston" null)) + (label-test (via main-menu) (cadr hockey-ids) "Bruins") + (label-test (via apple-menu) DELETE-APPLE (apple-pick null "Apple Deleter" "Delete Apple")) + (help-string-test (via apple-menu) DELETE-APPLE (apple-pick null "DELETER" + "Deletes the Apple menu")) + (label-test (via apple-menu) COCONUT-ID (apple-pick null "Coconut!" "Coconut")) + (help-string-test (via apple-menu) COCONUT-ID (apple-pick null "SUBMENU" "Submenu")) + (label-test (via apple-menu) DELETE-COCONUT (apple-pick null "Coconut Deleter" "Delete Coconut")) ; submenu test + (help-string-test (via apple-menu) DELETE-COCONUT (apple-pick null "CDELETER" null)) + (top-label-test 0 (if temp-labels? "Hi" "Tester")) + (top-label-test 1 (if apple-installed? "Apple" null)) + (tell-ok)) + "Test Labels") + (make-object mred:button% lblp + (lambda args + (find-test main-menu (tmp-pick "Hi" "Tester") + ADD-APPLE (tmp-pick "Apple Adder" "Add Apple")) + (find-test apple-menu "Apple" (apple-pick -1 DELETE-APPLE DELETE-APPLE) + (tmp-pick "Apple Deleter" "Delete Apple")) + (find-test apple-menu "Apple" (apple-pick -1 COCONUT-ID COCONUT-ID) + (tmp-pick "Coconut!" "Coconut")) + (find-test apple-menu "Apple" (apple-pick -1 DELETE-COCONUT DELETE-COCONUT) + (tmp-pick "Coconut Deleter" "Delete Coconut")) + (tell-ok)) + "Find Labels") + (make-object mred:button% lblp + (lambda args + (set! temp-labels? (not temp-labels?)) + (let ([menu (via main-menu)]) + (send menu set-label ADD-APPLE (tmp-pick "Apple Adder" "Add Apple")) + (send menu set-label (car baseball-ids) (tmp-pick "'Stros" "Astros")) + (send apple-menu set-label DELETE-APPLE (tmp-pick "Apple Deleter" "Delete Apple")) + (send apple-menu set-label COCONUT-ID (tmp-pick "Coconut!" "Coconut")) + (send apple-menu set-label DELETE-COCONUT (tmp-pick "Coconut Deleter" "Delete Coconut")) + (send menu set-help-string ADD-APPLE (tmp-pick "ADDER" "Adds the Apple menu")) + (send menu set-help-string (car baseball-ids) (tmp-pick "Houston" null)) + (send apple-menu set-help-string DELETE-APPLE (tmp-pick "DELETER" "Deletes the Apple menu")) + (send apple-menu set-help-string COCONUT-ID (tmp-pick "SUBMENU" "Submenu")) + (send apple-menu set-help-string DELETE-COCONUT (tmp-pick "CDELETER" null)) + (send menu-bar set-label-top 0 (if temp-labels? "Hi" "Tester")))) + "Toggle Labels") + (letrec ([by-bar (make-object mred:check-box% lblp + (lambda args + (set! use-menubar? (send by-bar get-value))) + "Via Menubar")]) + by-bar) + + (make-test-button "Bad Item" badp apple-menu 777) + (make-test-button "Other Bad Item" badp apple-menu -1) + (make-object mred:button% badp + (lambda args + (label-test main-menu 777 null) + (label-test main-menu -1 null) + (help-string-test main-menu 777 null) + (help-string-test main-menu -1 null) + (top-label-test -1 null) + (top-label-test 777 null) + (find-test main-menu "No way" -1 "Not in the menus") + (tell-ok)) + "Bad Item Labels") + (make-object mred:button% badp + (make-bad-test (ivar main-menu check)) + "Check Bad") + (make-object mred:button% badp + (make-bad-test (ivar main-menu enable)) + "Enable Bad") + (make-object mred:button% badp + (make-bad-test (lambda (a b) (send main-menu delete a))) + "Delete Bad") + + #f)))) + +(define (menu-frame) + (define mf (make-object f% null "Menu Test")) + (set! prev-frame mf) + (send mf show #t) + mf) + +(define (check-callback-event orig got e types silent?) + (unless (eq? orig got) + (error "object not the same")) + (unless (is-a? e wx:command-event%) + (error "bad event object")) + (unless (eq? got (send e get-event-object)) + (error "event object mismatch")) + (let ([type (send e get-event-type)]) + (unless (member type types) + (error (format "bad event type: ~a" type)))) + (unless silent? + (printf "Callback Ok~n"))) + +(define (button-frame) + (define f (make-object mred:frame% null "Button Test")) + (define p (make-object mred:vertical-panel% f)) + (define old-list null) + (define commands (list wx:const-event-type-button-command)) + (define sema (make-semaphore)) + (define b (make-object mred:button% p + (lambda (bx e) + (semaphore-post sema) + (set! old-list (cons e old-list)) + (check-callback-event b bx e commands #f)) + "Hit Me")) + (define c (make-object mred:button% p + (lambda (c e) + (for-each + (lambda (e) + (check-callback-event b b e commands #t)) + old-list) + (printf "All Ok~n")) + "Check")) + (define e (make-object mred:button% p + (lambda (c e) + (sleep 1) + (wx:yield) ; try to catch a click, but not a callback + (set! sema (make-semaphore)) + (send b enable #f) + (thread (lambda () (wx:yield sema))) + (when (semaphore-wait-multiple (list sema) 0.5) + (printf "un-oh~n")) + (send b enable #t) + (semaphore-post sema)) + "Disable Test")) + (send f show #t)) + +(define (checkbox-frame) + (define f (make-object mred:frame% null "Checkbox Test")) + (define p (make-object mred:vertical-panel% f)) + (define old-list null) + (define commands (list wx:const-event-type-checkbox-command)) + (define cb (make-object mred:check-box% p + (lambda (cx e) + (set! old-list (cons e old-list)) + (unless (eq? (send cb get-value) + (send e checked?)) + (error "event checkstate mismatch")) + (check-callback-event cb cx e commands #f)) + "On")) + (define t (make-object mred:button% p + (lambda (t e) + (let ([on? (send cb get-value)]) + (send cb set-value (not on?)))) + "Toggle")) + (define c (make-object mred:button% p + (lambda (c e) + (for-each + (lambda (e) + (check-callback-event cb cb e commands #t)) + old-list) + (printf "All Ok~n")) + "Check")) + (send f show #t)) + +(define (choice-or-list-frame list? list-style empty?) + (define f (make-object mred:frame% null "Choice Test")) + (define p (make-object mred:vertical-panel% f)) + (define-values (actual-content actual-user-data) + (if empty? + (values null null) + (values '("Alpha" "Beta" "Gamma") + (list null null null)))) + (define commands + (if list? + (list wx:const-event-type-listbox-command) + (list wx:const-event-type-choice-command))) + (define old-list null) + (define callback + (lambda (cx e) + (when (zero? (send c number)) + (error "Callback for empty choice/list")) + (set! old-list (cons (list e + (send e get-command-int) + (send e get-command-string)) + old-list)) + (unless (= (send e get-command-int) + (send c get-selection)) + (error "event selection value mismatch")) + (unless (string=? (send e get-command-string) + (send c get-string-selection) + (send c get-string (send c get-selection))) + (error "selection string mistmatch")) + (check-callback-event c cx e commands #f))) + (define c (if list? + (make-object mred:list-box% p + callback + "Tester" + list-style + -1 -1 -1 -1 + actual-content) + (make-object mred:choice% p + callback + "Tester" + -1 -1 -1 -1 + actual-content))) + (define counter 0) + (define append-with-user-data? #f) + (define ab (make-object mred:button% p + (lambda (b e) + (set! counter (add1 counter)) + (let ([naya (format "Extra ~a" counter)] + [naya-data (box 0)]) + (set! actual-content (append actual-content (list naya))) + (set! actual-user-data (append actual-user-data (list naya-data))) + (if (and list? append-with-user-data?) + (send c append naya naya-data) + (begin + (send c append naya) + (when list? + (send c set-client-data + (sub1 (send c number)) + naya-data)))) + (set! append-with-user-data? + (not append-with-user-data?)))) + "Append")) + (define cdp (make-object mred:horizontal-panel% p)) + (define rb (make-object mred:button% cdp + (lambda (b e) + (set! actual-content null) + (set! actual-user-data null) + (send c clear)) + "Clear")) + (define db (if list? + (make-object mred:button% cdp + (lambda (b e) + (let ([p (send c get-selection)]) + (when (<= 0 p (sub1 (length actual-content))) + (send c delete p) + (if (zero? p) + (begin + (set! actual-content (cdr actual-content)) + (set! actual-user-data (cdr actual-user-data))) + (begin + (set-cdr! (list-tail actual-content (sub1 p)) + (list-tail actual-content (add1 p))) + (set-cdr! (list-tail actual-user-data (sub1 p)) + (list-tail actual-user-data (add1 p)))))))) + "Delete") + null)) + (define (make-selectors method numerical?) + (define p2 (make-object mred:horizontal-panel% p)) + (when numerical? + (make-object mred:button% p2 + (lambda (b e) + (method -1)) + "Select Bad -1")) + (make-object mred:button% p2 + (lambda (b e) + (method 0)) + "Select First") + (make-object mred:button% p2 + (lambda (b e) + (method (floor (/ (send c number) 2)))) + "Select Middle") + (make-object mred:button% p2 + (lambda (b e) + (method (sub1 (send c number)))) + "Select Last") + (make-object mred:button% p2 + (lambda (b e) + (method (if numerical? + (send c number) + #f))) + "Select Bad X") + #f) + (define dummy-1 (make-selectors (ivar c set-selection) #t)) + (define dummy-2 (make-selectors (lambda (p) + (if p + (when (positive? (length actual-content)) + (send c set-string-selection + (list-ref actual-content p))) + (send c set-string-selection "nada"))) + #f)) + (define tb (make-object mred:button% p + (lambda (b e) + (let ([c (send c number)]) + (unless (= c (length actual-content)) + (error "bad number response"))) + (let loop ([n 0][l actual-content][lud actual-user-data]) + (unless (null? l) + (let ([s (car l)] + [sud (car lud)] + [sv (send c get-string n)] + [sudv (if list? + (send c get-client-data n) + #f)]) + (unless (string=? s sv) + (error "get-string mismatch")) + (unless (or (not list?) (eq? sud sudv)) + (error "get-user-data mismatch")) + (unless (= n (send c find-string s)) + (error "bad find-string result"))) + (loop (add1 n) (cdr l) (cdr lud)))) + (unless (and (null? (send c get-string -1)) + (null? (send c get-string (send c number)))) + (error "out-of-bounds did not return null")) + (unless (= -1 (send c find-string "nada")) + (error "bad find-string result for nada")) + (for-each + (lambda (eis) + (let ([e (car eis)] + [i (cadr eis)] + [s (caddr eis)]) + (unless (= (send e get-command-int) i) + (error "event selection value mismatch")) + (unless (string=? (send e get-command-string) s) + (error "selection string mistmatch")) + (check-callback-event c c e commands #t))) + old-list) + (printf "content: ~s~n" actual-content)) + "Check")) + (send f show #t)) + +(define (gauge-frame) + (define f (make-object mred:frame% null "Gauge Test")) + (define p (make-object mred:vertical-panel% f)) + (define g (make-object mred:gauge% p "Tester" 10)) + (define (move d name) + (make-object mred:button% p + (lambda (c e) + (send g set-value (+ d (send g get-value)))) + name)) + (define (size d name) + (make-object mred:button% p + (lambda (c e) + (send g set-range (+ d (send g get-range)))) + name)) + (move 1 "+") + (move -1 "-") + (size 1 "Bigger") + (size -1 "Smaller") + (send f show #t)) + +(define (text-frame mred:text% style) + (define (handler get-this) + (lambda (c e) + (unless (eq? c (get-this)) + (printf "callback: bad item: ~a~n" c)) + (unless (eq? c (send e get-event-object)) + (printf "callback: bad item in event: ~a~n" (send e get-event-object))) + (let ([t (send e get-event-type)]) + (cond + [(= t wx:const-event-type-text-command) + (printf "Changed: ~a~n" (send e get-command-string))] + [(= t wx:const-event-type-text-enter-command) + (printf "Return: ~a~n" (send e get-command-string))] + [(= t wx:const-event-type-set-focus) + (printf "Focus in~n")] + [(= t wx:const-event-type-kill-focus) + (printf "Focus out~n")])))) + + (define f (make-object mred:frame% null "Text Test")) + (define p (make-object (class-asi mred:vertical-panel% + (public + [on-default-action + (lambda (v) + (printf "Panel default action~n"))])) + f)) + (define t1 (make-object mred:text% p (handler (lambda () t1)) null "This should just fit!" + -1 -1 -1 -1 style)) + (define t2 (make-object mred:text% p (handler (lambda () t2)) "Another" "This too!" + -1 -1 -1 -1 style)) + (define junk (send p set-label-position wx:const-vertical)) + (define t3 (make-object mred:text% p (handler (lambda () t3)) "Catch Returns" "And, yes, this!" + -1 -1 -1 -1 (+ style wx:const-process-enter))) + (send t1 stretchable-in-x #f) + (send t2 stretchable-in-x #f) + (send t3 stretchable-in-x #f) + (send f show #t)) + +(define (canvas-frame flags) + (define f (make-object mred:frame% null "Canvas Test")) + (define p (make-object mred:vertical-panel% f)) + (define c% (class mred:canvas% (name p) + (inherit clear draw-text draw-line set-clipping-region + get-scroll-pos get-scroll-range get-scroll-page + get-client-size get-virtual-size) + (public + [on-paint + (lambda () + (let ([s (format "V: p: ~s r: ~s g: ~s H: ~s ~s ~s" + (get-scroll-pos wx:const-vertical) + (get-scroll-range wx:const-vertical) + (get-scroll-page wx:const-vertical) + (get-scroll-pos wx:const-horizontal) + (get-scroll-range wx:const-horizontal) + (get-scroll-page wx:const-horizontal))] + [w (box 0)][w2 (box 0)] + [h (box 0)][h2 (box 0)]) + (get-client-size w h) + (get-virtual-size w2 h2) + ; (set-clipping-region 0 0 (unbox w2) (unbox h2)) + (clear) + (draw-text name 3 3) + ; (draw-line 3 12 40 12) + (draw-text s 3 15) + (draw-text (format "client: ~s x ~s virtual: ~s x ~s" + (unbox w) (unbox h) + (unbox w2) (unbox h2)) + 3 27)))] + [on-scroll + (lambda (e) (on-paint))]) + (sequence + (super-init p -1 -1 -1 -1 flags)))) + (define c1 (make-object c% "Unmanaged scroll" p)) + (define c2 (make-object c% "Automanaged scroll" p)) + (define (reset-scrolls) + (let* ([h? (send ck-h get-value)] + [v? (send ck-v get-value)] + [small? (send ck-s get-value)] + [swap? (send ck-w get-value)]) + (send c1 set-scrollbars (if h? 1 -1) (if v? 1 -1) 10 10 3 3 0 0 swap?) + (send c2 set-scrollbars (if h? 25 -1) (if v? 10 -1) (if small? 2 20) (if small? 2 20) + 3 3 0 0 (not swap?)))) + (define p2 (make-object mred:horizontal-panel% p)) + (define jumk (send p2 stretchable-in-y #f)) + (define ck-v (make-object mred:check-box% p2 (lambda (b e) (reset-scrolls)) "Vertical Scroll")) + (define ck-h (make-object mred:check-box% p2 (lambda (b e) (reset-scrolls)) "Horizontal Scroll")) + (define ck-s (make-object mred:check-box% p2 (lambda (b e) (reset-scrolls)) "Small")) + (define ck-w (make-object mred:check-box% p2 (lambda (b e) (reset-scrolls)) "Swap")) + (send f show #t)) + +;---------------------------------------------------------------------- + +(define selector (make-object mred:frame% null "Test Selector")) +(define ap (make-object mred:vertical-panel% selector)) + +; Test timers while we're at it: +(let ([clockp (make-object mred:horizontal-panel% ap)] + [selector selector]) + (make-object mred:vertical-panel% clockp) ; filler + (let ([time (make-object mred:message% clockp "XX:XX:XX")]) + (make-object + (class wx:timer% () + (inherit start) + (public + [notify + (lambda () + (let* ([now (seconds->date (current-seconds))] + [pad (lambda (pc d) + (let ([s (number->string d)]) + (if (= 1 (string-length s)) + (string-append pc s) + s)))] + [s (format "~a:~a:~a" + (pad " " (let ([h (modulo (date-hour now) 12)]) + (if (zero? h) + 12 + h))) + (pad "0" (date-minute now)) + (pad "0" (date-second now)))]) + (send time set-label s) + (when (send selector is-shown?) + (start 1000 #t))))]) + (sequence + (super-init) + (start 1000 #t)))))) + +(define bp (make-object mred:vertical-panel% ap -1 -1 -1 -1 wx:const-border)) +(define bp1 (make-object mred:horizontal-panel% bp)) +(define bp2 (make-object mred:horizontal-panel% bp)) +(define mp (make-object mred:vertical-panel% ap -1 -1 -1 -1 wx:const-border)) +(define mp1 (make-object mred:horizontal-panel% mp)) +(define mp2 (make-object mred:horizontal-panel% mp)) + +(send bp1 set-label-position wx:const-vertical) +(send mp1 set-label-position wx:const-vertical) + +(make-object mred:button% ap (lambda (b e) (menu-frame)) "Make Menus Frame") +(make-object mred:button% ap (lambda (b e) (button-frame)) "Make Button Frame") +(make-object mred:button% ap (lambda (b e) (checkbox-frame)) "Make Checkbox Frame") +(define cp (make-object mred:horizontal-panel% ap)) +(send cp stretchable-in-x #f) +(make-object mred:button% cp (lambda (b e) (choice-or-list-frame #f 0 #f)) "Make Choice Frame") +(make-object mred:button% cp (lambda (b e) (choice-or-list-frame #f 0 #t)) "Make Empty Choice Frame") +(define lp (make-object mred:horizontal-panel% ap)) +(send lp stretchable-in-x #f) +(make-object mred:button% lp (lambda (b e) (choice-or-list-frame #t wx:const-single #f)) "Make List Frame") +(make-object mred:button% lp (lambda (b e) (choice-or-list-frame #t wx:const-single #t)) "Make Empty List Frame") +(make-object mred:button% lp (lambda (b e) (choice-or-list-frame #t wx:const-multiple #f)) "Make Multilist Frame") +(make-object mred:button% ap (lambda (b e) (gauge-frame)) "Make Gauge Frame") +(define tp (make-object mred:horizontal-panel% ap)) +(send tp stretchable-in-x #f) +(make-object mred:button% tp (lambda (b e) (text-frame mred:text% 0)) "Make Text Frame") +(make-object mred:button% tp (lambda (b e) (text-frame mred:media-text% 0)) "Make Media Text Frame") +(make-object mred:button% tp (lambda (b e) (text-frame mred:multi-text% 0)) "Make Multitext Frame") +(make-object mred:button% tp (lambda (b e) (text-frame mred:media-multi-text% 0)) "Make Media Multitext Frame") +(define tp2 (make-object mred:horizontal-panel% ap)) +(send tp2 stretchable-in-x #f) +(make-object mred:button% tp2 (lambda (b e) (text-frame mred:multi-text% wx:const-hscroll)) "Make Multitext Frame/HScroll") +(make-object mred:button% tp2 (lambda (b e) (text-frame mred:media-multi-text% wx:const-hscroll)) "Make Media Multitext Frame/HScroll") + +(define cnp (make-object mred:horizontal-panel% ap)) +(send cnp stretchable-in-x #f) +(let ([mkf (lambda (flags name) + (make-object mred:button% cnp + (lambda (b e) (canvas-frame flags)) + (format "Make ~aCanvas Frame" name)))]) + (mkf (+ wx:const-hscroll wx:const-vscroll) "HV") + (mkf wx:const-hscroll "H") + (mkf wx:const-vscroll "V") + (mkf 0 "")) + +(define (choose-next radios) + (let loop ([l radios]) + (let* ([c (car l)] + [rest (cdr l)] + [n (send c number)] + [v (send c get-selection)]) + (if (< v (sub1 n)) + (send c set-selection (add1 v)) + (if (null? rest) + (map (lambda (c) (send c set-selection 0)) radios) + (begin + (send c set-selection 0) + (loop rest))))))) + +(define make-next-button + (lambda (p l) + (make-object mred:button% p + (lambda (b e) (choose-next l)) + "Next Configuration"))) + +(define make-selector-and-runner + (lambda (p1 p2 radios? size maker) + (define radio-h-radio + (if radios? + (make-object mred:radio-box% p1 void "Radio Box Orientation" + -1 -1 -1 -1 + '("Vertical" "Horizontal")) + #f)) + (define label-h-radio + (make-object mred:radio-box% p1 void "Label Orientation" + -1 -1 -1 -1 + '("Vertical" "Horizontal"))) + (define label-null-radio + (make-object mred:radio-box% p1 void "Optional Labels" + -1 -1 -1 -1 + '("Use Label" "No Label"))) + (define stretchy-radio + (make-object mred:radio-box% p1 void "Stretchiness" + -1 -1 -1 -1 + '("Normal" "All Stretchy"))) + (define font-radio + (make-object mred:radio-box% p1 void "Font" + -1 -1 -1 -1 + '("Normal" "Big"))) + (define next-button + (let ([basic-set (list label-h-radio label-null-radio stretchy-radio font-radio)]) + (make-next-button p2 + (if radios? + (cons radio-h-radio basic-set) + basic-set)))) + (define go-button + (make-object mred:button% p2 + (lambda (b e) + (maker + (if radios? + (positive? (send radio-h-radio get-selection)) + #f) + (positive? (send label-h-radio get-selection)) + (positive? (send label-null-radio get-selection)) + (positive? (send stretchy-radio get-selection)) + (positive? (send font-radio get-selection)))) + (format "Make ~a Frame" size))) + #t)) + +(make-selector-and-runner bp1 bp2 #t "Big" big-frame) +(make-selector-and-runner mp1 mp2 #f "Medium" med-frame) + +(send selector show #t) + +; (define e (make-object wx:key-event% wx:const-event-type-char)) +; (send e set-key-code 65) +; (send e set-shift-down #t) diff --git a/collects/tests/mred/mem.ss b/collects/tests/mred/mem.ss new file mode 100644 index 00000000..7ebc1a11 --- /dev/null +++ b/collects/tests/mred/mem.ss @@ -0,0 +1,241 @@ + +(define source-dir (current-load-relative-directory)) + +(define num-times 12) +(define num-threads 1) + +(define dump-stats? #t) + +(define edit? #t) +(define insert? #t) +(define load-file? #f) ; adds a lot of messy objects + +(define menus? #t) +(define atomic? #t) +(define offscreen? #t) +(define frame? #t) + +(define subwindows? #t) + +(define allocated '()) +(define (remember tag v) + (set! allocated + (cons (cons tag (make-weak-box v)) + allocated)) + v) + +(define frame% + ; Leave this as the (obsolete) make-class form for macro testing + (make-class mred:editor-frame% + (rename [super-show show]) + (public + [prim-show (lambda (arg) (super-show arg))] + [show + (lambda (x) (void))]))) + +(when subwindows? + (define sub-collect-frame + (make-object wx:frame% null "sub-collect" -1 -1 200 200)) + (define sub-collect-panel + (make-object wx:panel% sub-collect-frame 0 0 100 100))) + +(send sub-collect-frame show #t) + +(define (maker id n) + (sleep) + (collect-garbage) + (collect-garbage) + (printf "Thread: ~s Cycle: ~s~n" id n) + (dump-object-stats) + (if (and dump-stats? (= id 1)) + (dump-memory-stats)) + (unless (zero? n) + (let ([tag (cons id n)]) + (let* ([f (if edit? (remember tag (make-object frame%)))] + [c (make-custodian)] + [es (parameterize ([current-custodian c]) + (wx:make-eventspace))]) + + (parameterize ([wx:current-eventspace es]) + (send (remember + tag + (make-object + (class-asi wx:timer% + (public + [notify void])))) + start 100)) + + (when edit? + (remember tag (send f get-edit))) + + (when (and edit? (zero? (modulo n 2))) + (send f prim-show #t) + (sleep 0.5)) + + (if frame? + (let* ([f (make-object wx:frame% '() "Tester" -1 -1 200 200)] + [p (remember tag (make-object wx:panel% f))]) + (remember tag (make-object wx:canvas% f)) + (if (zero? (modulo n 3)) + (send f show #t)) + (remember tag (make-object wx:button% p (lambda args #t) "one")) + (let ([class wx:check-box%]) + (let loop ([m 10]) + (unless (zero? m) + (remember (cons tag m) + (make-object class p (lambda args #t) "another")) + (loop (sub1 m))))) + (send p new-line) + (remember tag (make-object wx:check-box% p (lambda args #t) "check")) + (remember tag (make-object wx:choice% p (lambda args #t) "choice")) + (remember tag (make-object wx:list-box% p (lambda args #t) "list" + wx:const-single -1 -1 -1 -1 + '("apple" "banana" "coconut"))) + (remember tag (make-object wx:button% p (lambda args #t) "two")) + (send f show #f))) + + (if subwindows? + (let ([p (make-object wx:panel% sub-collect-frame 100 100 50 50)] + [cv (make-object wx:canvas% sub-collect-frame 150 150 50 50)] + [add-objects + (lambda (p tag hide?) + (let ([b (make-object wx:button% p (lambda args #t) "one" 0 0)] + [c (make-object wx:check-box% p (lambda args #t) "check" 0 0)] + [co (make-object wx:choice% p (lambda args #t) "choice" 0 0)] + [cv (make-object wx:canvas% p 0 0 50 50)] + [lb (make-object wx:list-box% p (lambda args #t) "list" + wx:const-single 0 0 -1 -1 + '("apple" "banana" "coconut"))]) + (when hide? + (send b show #f) + (send c show #f) + (send cv show #f) + (send co show #f) + (send lb show #f)) + (remember tag b) + (remember tag c) + (remember tag cv) + (remember tag co) + (remember tag lb)))]) + (add-objects sub-collect-panel (cons 'sc1 tag) #t) + (add-objects p (cons 'sc2 tag) #f) + (remember (cons 'sc0 tag) p) + (remember (cons 'sc0 tag) cv) + (send p show #f) + (send cv show #f))) + + + (if (and edit? insert?) + (let ([e (send f get-edit)]) + (when load-file? + (send e load-file (build-path source-dir "mem.ss"))) + (let loop ([i 20]) + (send e insert (number->string i)) + (unless (zero? i) + (loop (sub1 i)))) + (let ([s (make-object wx:media-snip%)]) + (send (send s get-this-media) insert "Hello!") + (send e insert s)) + (send e insert #\newline) + (send e insert "done") + (send e set-modified #f))) + + (when menus? + (remember tag (make-object wx:menu-bar%)) + (remember tag (make-object wx:menu%)) + (let ([mb (remember tag (make-object wx:menu-bar%))] + [m (remember tag (make-object wx:menu%))]) + (send m append 5 "Hi" (remember tag (make-object wx:menu%))) + (send mb append m "x")) + + (if edit? + (let ([m (remember tag (make-object mred:menu%))] + [m2 (remember tag (make-object mred:menu%))] + [mb (send f get-menu-bar)]) + (send m append 4 "ok") + (send m2 append 4 "hao") + (send m append 5 "Hi" (remember tag (make-object mred:menu%))) + (send mb append m "Extra") + (send mb append m2 "Other") + (send m delete 5) + (send mb delete m)))) + + (when atomic? + (let loop ([m 8]) + (unless (zero? m) + (remember (cons tag m) (make-object wx:point% n m)) + (remember (cons tag m) (make-object wx:int-point% n m)) + (remember (cons tag m) (make-object wx:brush%)) + (remember (cons tag m) (make-object wx:pen%)) + (loop (sub1 m))))) + + (when offscreen? + (let ([m (remember tag (make-object wx:memory-dc%))] + [b (remember (cons tag 'u) (make-object wx:bitmap% 100 100))] + [b2 (remember (cons tag 'x) (make-object wx:bitmap% 100 100))]) + (send m select-object b))) + + + (when edit? + (let ([name (wx:get-temp-file-name "hi")]) + (send (send f get-edit) save-file name) + (send f on-close) + (send f prim-show #f) + (delete-file name))) + + (custodian-shutdown-all c) + + (collect-garbage) + + (maker id (sub1 n)))))) + +(define (still) + (map (lambda (x) + (let ([v (weak-box-value (cdr x))]) + (if v + (printf "~s ~s~n" (send v get-class-name) (car x))))) + allocated) + (void)) + +(define (xthread f) + (f)) + +(define (stw t n) + (thread-weight t (floor (/ (thread-weight t) n)))) + +(define (do-test) + (let ([sema (make-semaphore)]) + (let loop ([n num-threads]) + (unless (zero? n) + (thread (lambda () + (stw (current-thread) n) + (dynamic-wind + void + (lambda () (maker n num-times)) + (lambda () (semaphore-post sema))))) + (loop (sub1 n)))) + (let loop ([n num-threads]) + (unless (zero? n) + (wx:yield sema) + (loop (sub1 n))))) + + (collect-garbage) + (collect-garbage) + (let loop ([n 100]) + (if (zero? n) 0 (sub1 (loop (sub1 n))))) + (collect-garbage) + (collect-garbage) + (still) + (when subwindows? + (set! sub-collect-frame #f) + (set! sub-collect-panel #f)) + (when dump-stats? + (dump-memory-stats) + (still))) + +(define mred:startup + (let ([old-mred:startup mred:startup]) + (lambda args + (send mred:the-frame-group set-empty-callback (lambda () #t)) + (do-test) + (apply old-mred:startup args)))) diff --git a/collects/tests/mred/nruter.xbm b/collects/tests/mred/nruter.xbm new file mode 100644 index 00000000..9e74923d --- /dev/null +++ b/collects/tests/mred/nruter.xbm @@ -0,0 +1,4 @@ +#define nruter_width 6 +#define nruter_height 9 +static char nruter_bits[] = { + 0x1e,0x1f,0x03,0x03,0x27,0x3e,0x3c,0x3c,0x3e}; diff --git a/src/mred/HISTORY b/src/mred/HISTORY new file mode 100644 index 00000000..06ed9480 --- /dev/null +++ b/src/mred/HISTORY @@ -0,0 +1,409 @@ +Version 51: ??, 1997 +X Windows: window manager close-frame request is ignored + when a modal dialog is in control +Added security so that wx:snip% methods cannot be overridden + to crash MrEd +Fixed wx:canvas% scrolling on all platforms; the style flags + wx:const-hscroll and wx:const-vscroll must be used at + canvas-creation to set up for scrolling. Removed the + enable-scrolling method from wx:canvas%. Renamed the method + get-scroll-page-units to get-scroll-units. Added methods + get-scroll-pos, get-scroll-range, and get-scroll-page. +The wx:canvas% wx:const-backingstore and wx:const-retained + style flags have been removed. +Removed wx:key-event%'s position method and added get-x, + get-y, set-x, and set-y +Changed default pen in DC to width 0 instead of 1 +Added get-max-view method to wx:media-admin% +Revised wx:media-buffer%'s cursor system for better + cooperation with embedded buffers; instead of handling + the cursor in on-default-event, added a method adjust-cursor + to buffers and snips, and replaced admin's set-cursor with + update-cursor +Added refresh-delayed? predicate to wx:media-buffer%, useful + for deciding whether a buffer (or one of its enclosing + buffers) is in an edit-sequence +Added a --pre flag for evaluating an expression in a + MzScheme-only namespace at startup. This flag is intended + for use with image dumps (see the MzScheme manual) +Removed wx:copy-file; MzScheme now has copy-file +Fixed wx:media-stream-in%'s get-string (it was adding an + extra nul character) +Removed error dialogs when wx:media-buffer%'s load-file or + save-file fails +Windows: fixed canvas mouse events; button-down event grabs + the mouse until the next button-up event +Windows: fixed initial setting of DC text mode: transparent + instead of opaque +X Windows: fixed wx:frame's iconize and iconized? methods, + ignoring the X idea of not de-iconifying windows that were + iconified by the user +Removed wx:exit + +Version 50: August 26, 1997 +Changed wx:dc%'s get-size method to return size of + destination area; old [documented] functionality + is available via max-x and max-y +Made button-click state visible for Xt on b&w displays +Fixed and normalized PostScript drawing +Removed wx:dc% methods: device-to-logical-x, etc. +Windows wx:display-size changed to return the size of the + screen not including the task bar +Windows: finally fixed scale for [non-PostScript] printing +Added wx:[un]register-collecting-blit +X Windows: Fixed use of colormap by loaded bitmap images +Added an optional argument to wx:media-buffer's print method + to supporting fitting to the destination page +X Windows: Saving as xbm works for bitmaps of any depth +MzScheme pathname expansion performed by all wx: toolbox + procedures that take a pathname +X Windows Xt: removed excessive borders on wx:canvas% objects +X Windows Xt: removed 2 pixel offset for a single auto-sized + child in a wx:frame% or wx:dialog-box% +Windows: Fixed scrollbars on editor buffers; they're always + shown now, but the editor never gets confused about the size +Fixed on-size, pre-on-char, and pre-on-event for wx:item% + subclasses +Fixed confusing argument type and number error messages + for overloaded methods of primitive classes + +Version 49: May 31, 1997 +Object system changes: see mzscheme/HISTORY for details +Fixed Mac event-handling and many other Mac things +Fixed garbage collection of hidden frames under Windows (!) +Panels, canvases, and controls that are both hidden and + inaccessible are now garbage-collected +Disabled controls are reliably grayed-out, including items + within a disabled panel +Instances of wx:pen%, wx:brush%, or wx:pen% that are + selected into a drawing context cannot be mutated +Immutability of objects obtained via wx:the-XXX-list is + enforced +Controls for Windows, Xt are created with the "System" family + rather than the "Default" family (using resources) +Single wx:bitmap% object can be used by multiple controls + and/or pens and/or brushes +Fixed Motif image-label radio button +wx:find-directory replaced with wx:find-path +All wx:dc% instances have a default font for drawing +wx:const-copy blit never uses the pen/background color; + new blit mode wx:const-colour uses current pen +X Windows: removed mapping of Mod3 to Alt (too confusing on + keyboards where NumLock is Mod3) +Fixed wx:timer% bug that caused autosaving to not work +Fixed eventspace bugs +Fixed .bmp reading when smaller-than-max colormap is provided +Fixed interlaced .gif reading for Windows and MacOS +Xt: fixed default height of wx:text% items +Xt: In a wx:mouse-event% instance, type wx:const-type-XXX-down + implies get-XXX-down => #t (formerly #f) +Removed wx:group-box% class; use a panel with a border, instead +Removed wx:tool-bar% class +wx:choice% get-columns and set-columns no longer supported +Added wx:gauge% methods: get-value and get-range +wx:media-pasteboard% bug fixes and improvements: raise, lower, + set-before, and set-after methods now work +wx:list-box% set-client-data and get-client-data work with + any Scheme data type +Windows and X Windows: Break key changed back to shift-ctl-c + instead of ctl-c (to avoid conflicts with Emacs-std keyboard + mappings) + +Version 48: Skipped to avoid confusion with Scheme48 + +Version 47: January 11, 1997 +WARNING: multiple inhertance is going away in 48 +Added overwrite-styles? arg to wx:media-buffer%'s read-from-file, + and added get-/set-load-overwrites-styles methods +Modified wx:media-buffer%'s set-caret-owner to provide more + levels of focus control +Controls with bitmap labels work correctly, fixed crashing bugs, + some Mac controls do not display yet +wx:bitmap%'s load-file only allowed when the bitmap is not selected + into a wx:memory-dc% object or used by a control + +Version 46: December 5, 1996 +Fixed misc. Motif control-sizing problems +Mac & Xt: "&" stripped from control labels correctly +wx:yield takes an optional semaphore argument + +Version 45: November 12, 1996 +IMPORTANT: let-values is now analogous to let; the old + let-values is now let*-values +Added thread-savy parameterization system; namespace system changed +Added eventspaces +wx:server%, wx:client%, and wx:connection% are no longer supported + (Better TCP support is now built into MzScheme) +wx:the-snip-class-list was replaced by (wx:get-the-snip-class-list) +wx:the-buffer-data-class-list was replaced by (wx:get-the-buffer-data-class-list) +Added transparent text backing for editor text +Added wx:dc% try-colour method +wx:window% capture-mode, release-mouse, and make-modal no longer supported + Modal dialogs can be used instead of make-modal (modal is + specified through the constructor). There is currently no + replacement for capture-mouse and release-mouse, but a replacement is + likely to be in 46. +Xt and Mac: "&" stripped from control labels (matches Windows/Motif), sortof + +Version 44: September 9, 1996 +wx:play-sound added +Saving bitmaps fixed on all platforms; editor can now save + "inlined" images instead of only references to images +Hyper-text browser handles HTML files (w/o networking) +Fixed Mac control drawing and hiding +Fixed Xt menus (finally!) +Fixed menu item auto-check for popup menus +Fixed Motif canvas click event reporting (spurious drags) +See also mzscheme/HISTORY, wxme/README, and system/HISTORY +Upgraded to gc 11alpha3 + +Version 43: Re-released August 12, 1996 +Under GNU LGPL license + +Version 43: August 9, 1996 +Major system overhaul (Robby Findler); see system/HISTORY +Windows stability greatly advanced +Windows and MacOS versions much more "Windows-like" and "Mac-like" + with standard menu shortcuts and better icons +MacOS and Windows use native print facilities +GIF images supported under Windows +wx:window set-client-size removed +wx:panel%'s get-cursor renamed to get-item-cursor; added set-item-cursor +Fixed cut-n-paste newlines under MacOS and Windows +Xt: panel with one item no longer auto-sizes the child +See also mzscheme/HISTORY + +Version 42: June 8, 1996 +Documentation translated to Scheme notation, corrected +Windows update bug fixed for embedded buffers +MacOS memory use greatly improved +Fixed annoying non-standard Windows beep +Non-matching cond or case expression raises and error +mred:platform and mred:window-system changed to wx:... +standard system uses functors (see MzScheme) +wx:canvas%::int-draw-line and wx:int-point% removed +wx:list%, wx:hash-table%, wx:string-list%, wx:path-list removed +wx:media-stream-in%::get removed for strings; use get-string +Redundant wx: functions removed: + wx:dir-exists? (use directory-exists?) + wx:file-exists? (use file-exists?) + wx:file-name-from-path (use file-name-from-path or split-path) + wx:path-only (use path-only or split-path) + wx:is-absolute-path? (use reletaive-path?) + wx:expand-path (use expand-path) + wx:get-working-directory (use current-directory) + wx:set-working-directory (use current-directory) + wx:mkdir (use make-directory) + wx:remove-file (use delete-file) + wx:rename-file (use rename-file) + wx:get-user-home and wx:get-home-dir (use expand-path with "~") + wx:execute and wx:shell (use system or process) + wx:find-first-file and wx:find-next-file (use get-directory-list) + wx:sleep (use sleep) + wx:sub-type? (use subclass?) + wx:to-lower (use char-upcase) + wx:to-upper (use char-downcase) + wx:is-wild? (use reg exps) + wx:match-wild? (use reg exps) + +Version 0.41: April 15, 1996 +Important language changes; see mzscheme/HISTORY +Fixed bug in wxCanvas drawing methods +Fixed wxCanvasDC and wxMemoryDC bugs in Xt version +Pasteboards fixed +AIX: two consecutive SIGDANGERs => exit(-1) +wxGetMultipleChoice supported + +Version 0.40: March 24, 1996 +Possible improvements to memory system +Some redundant event methods removed +Finally fixed Windows NT/95 Scheme threads +Stdout/stderr messages to a window instead of file for Windows/Mac+ +Fixed misc. Xt problems, including show-n-hide on frame + +Version 0.39: March 6, 1996 +Fixed safety from Scheme on invalidated C++ objects (stack objs, too) +Fixed many bugs in Xt version +Upgraded to gc version 4.10 +Reduced memory usage of buffer objects + +Version 0.38: February 22, 1996 +Xt port released +Part of standard system moved to DrScheme +See also mzscheme HISTORY and wxmedia README + +Version 0.37: Not released + +Version 0.36: January 18, 1996 +Fixed bug in MzScheme's bignum multiplication + +Version 0.35: January 17, 1996 +X selection protocol supported. To get the old clipboard-style + mechanism, add this to your .mredrc: + (wx:media-set-x-selection-mode #f) + See also wxMediaEdit::SetPosition() in the wxMedia manual. + +Version 0.34: December 30, 1995 +Minor improvements to MzScheme and the standard system + +Version 0.33: December 21, 1995 +MzScheme language changes; see mzscheme/HISTORY +Old standard system no longer compatible +Project system improved +Many bugs fixed in the new standard system + +Version 0.32: December 4, 1995 +New standard system: + * The console I/O is completely different. It works more + like an Emacs shell. Use M-p and M-n to access previously + entered expressions. (read) will now read from the console. + * All mred:std- variables have been eliminated. For each + mred:%, there is now a procedure mred:make-% that takes a + superclass and returns a new class. + * The frame and buffer hierarchies have changed a little. + * From a mred:edit% object, you can get to its canvas or frame. + * The menubar/menu system is completely revised. You don't have to + deal with menu ids much anymore. Menus and menu items can now be + dynamically added and removed. + * Keymap chaining works differently. + * The new Scheme project system is roughly in place. This will let you + develop Scheme programs by organizing Scheme files within a project. + Projects help manage loading program files into the + evaluator and uses Shriram's Zodiac/Aries packages to + provide debugging facilities. This will be improved in the near + future. + The old standard system is available in the "oldsys" directory. +Pretty printer handles loops and graphs +Very limited support for wxYield under XView - will be extended +Fixed some wxMedia bugs (see wxme/README) +Fixed some MzScheme bugs (see mzscheme/HISTORY) + +Version 0.31: November 14, 1995 +Fixed some wxMedia bugs (see wxme/README) +Fixed some MzScheme bugs (see mzscheme/HISTORY) +Parameterization for Macintosh + +Verion 0.30: October 25, 1995 +Added call-with-values and regexp to MzScheme +Unix stack-checking setup code fixed in MzScheme +wxMediaPasteboard implemented more +Scheme-C++ object link changed; use ptr in all C++ objects +Added tutorial section to "User Manual" + +Version 0.29: October 18, 1995 +Editor can save text preserving automatic CR +Bug fix in automatic line-wrapping +New font system can access arbitrary fonts +Multiple displays in Motif: wx:set-display and wx:get-display-name +MzScheme fix for forms such as (let ([x (let ...)]) ...) + +Version 0.28: October 3, 1995 +MzScheme bug fix: stack-checking on Unix +wxMedia fix: Insert(unsigned char, ...) instead of Insert(char, ...) + and proper use of `unsigned' in word-breaking array access + +Version 0.27: September 29, 1995 +Major MzScheme upgrade, including multiple inheritance + (See MzScheme HISTORY for details) +Win32: Allow deeper recursion by copying the stack +Win32: Allow breaking with Shift-Ctl-C +New font configuration system + +Version 0.26: September 8, 1995 +Very minor changes +Bug fix to MzScheme for Win32s + +Version 0.25: September 7, 1995 +Upgraded to wxWindows 1.63 +Minor bug fixes + +Version 0.24: September 1, 1995 +Minor bug fixes + +Version 0.23: August 23, 1995 +Minor bug fixes +Editor can display images (types depend on wxWindow compile flags) +MzScheme correction: expand & expand-once + +Version 0.22: August 17, 1995 +Mostly MzScheme improvements +File-format bug fixed related to portability; To make files created + earlier portable, open and re-save them. + +Version 0.21: August 8, 1995 +Bug fixes +triggers, hash tables, and case-lambda added to MzScheme +MzScheme "sleeps" properly +Connected MrEd to wxWindow's layout constraint system + +Version 0.20: July 26, 1995 +MzScheme Bug fixes + +Version 0.19: July 25, 1995 +All "!"s removed from method names!!!!! +Full continuations and bignums added to MzScheme +Bug Fixes + +Version 0.18: July 20, 1995 +Win32s kinda supported +Bug fixes +Added (compile ...) to MzScheme +Added internal processes & threads to MzScheme +wxSnipData -> wxBufferData +Old process and system changed to process* and system* + +Version 0.17: July 11, 1995 +Bug fixes, especially Motif and memory bugs +Rewrote editor line-maintenance +Faster caret updating +Upgraded garbage collector +File format changed to accomodate nested buffers with + separate style lists +Standard system standardized +Code changes for compiling on MSWindows (almost works...) +Scheme mode + +Version 0.16: June 16, 1995 +Fixed define-struct bug + +Version 0.15: June 15, 1995 +Bug fixes, especially XView +make-input-port takes only 3 args; "unget" param dropped +on-local-char & on-local-event renamed to on-default-char + and on-default-event +name changes: to have "!" or not to have "!". See doc/names.diff + for a list of changed names +fonts configuarble through .Xdefaults; see MrEd.ad + +Version 0.14: June 9, 1995 +Bug fixes, including wxWindows widget table clash +Scheme mode works +error-handler changed to parameterizing function + +Version 0.13: June 5, 1995 +MzScheme replaced libscheme +ctl-c breaks Scheme evaluation in MrEd +libscheme/ changed to mzscheme/ - change your make.env! + +Version 0.12: June 1, 1995 +Bug fixes +Revised object system: requires (inherit ...) declarations +(pretty-print ...) installed + +Version 0.11: May 19, 1995 +Bug Fixes + +Version 0.10: May 19, 1995 +Bug fixes +(match ...) installed + +Version 0.9: May 18, 1995 +wxMediaPasteboard + +Version 0.8: May 11, 1995 +Bug fixes + +Version 0.7: May 10, 1995 +mred:default- changed to mred: in system +README in demo directory +Lots of bug fixes diff --git a/src/mzscheme/gc/makefile.depend b/src/mzscheme/gc/makefile.depend new file mode 100644 index 00000000..e69de29b diff --git a/tests/mred/steps.txt b/tests/mred/steps.txt new file mode 100644 index 00000000..b33c7e5b --- /dev/null +++ b/tests/mred/steps.txt @@ -0,0 +1,130 @@ +Instructions: + Initial Setup: + - Second menu is enabled "Apple" + Delete Apple + + Menu Inserting & Deleting: + Add Apple - apple menu appears + Add Banana - banana menu appears + Delete Apple (from apple menu) - apple menu goes, banana menu still there + Delete Banana - back to starting point + Add Apple + Add Banana + Delete Banana - apple still there + Delete Apple + Add Apple + Add Coconut - coconut submenu appears + Delete Coconut (from sub-menu) - coconut submenu gone + Delete Apple + Add Coconut + Add Apple - apple menu appears with coconut already + Delete Apple + Delete Coconut + Add Apple - apple menu appears without coconut + + Menu Enabling: + Disable Second - apple menu gray & unselectable + Enable Second - back to normal + Disable Second + Delete Apple (from tester menu) + Add Apple - NOT gray anymore + + Item Enabling: + Disable Apple Once Item -> once item grayed & unselectable + Un-Disable Apple Once Item -> once item normal + Disable Apple Once Item + Delete Apple + Add Apple -> once item still gray + Un-Disable Apple Once Item + Delete Apple + Disable Apple Once Item + Add Apple -> once item gray again + Un-Disable Apple Once Item + + Item Inserting & Deleting: + Append Donut - donut item added + Delete Once - once item disappears + Delete Apple + Add Apple - once item still gone + Append Donut - another donut + Delete Apple + Append Donut + Add Apple - three donuts total + + Checkable Items & Insertions: + Test Apple Item -> "no" + Apple Checkable + Test Apple Item -> "yes" + Delete Apple + Test Apple Item -> "yes" + Apple Checkable + Test Apple Item -> "no" + Delete Apple + Test Apple Item -> "no" + + More Checkable (Apple & Banana currently deleted): + Test Aeros -> "yes" + Test Bruin -> "no" + Test Capitols -> "no" + + Check Astros -> nothing + Check Braves -> "Braves checked", braves checked, astros unchecked + Check Cardianls -> "Cardinals checked", cardinals checked, braves unchecked + + Check Bruins -> "Boston checked", aeros unchecked, bruins checked + + Test Aeros -> "no" + Test Bruin -> "yes" + Test Capitols -> "no" + + Checkable via Menubar (Apple & Banana currently deleted): + Via Menubar + Test Aeros -> "no" + Test Bruin -> "yes" + Test Apple Item -> "no" + Check in Apple (Button) + Add Apple - checkable item *not* checked + Check in Apple (Button) - item checked + Test Apple Item -> "yes" + Delete Apple + Test Apple Item -> "no" + Add Apple + Apple | Checkable + Delete Apple + Via Menubar + + Labels (Apple & Banana currently deleted): + Add Coconut - (coconut item needed for the rest) + Test Labels - "ok" in console + Find Labels - "ok" in console + Toggle Labels - "Tester" -> "Hi", "Add Apple" -> "Apple Adder", "Astros" -> "'Stros" + Add Apple - check that "Delete Apple" -> "Apple Deleter" + Delete Apple + Test Labels - "ok" in console + Find Labels - "ok" in console + Toggle Labels - original labels + Add Apple - check for original labels + Toggle Labels - "Delete Apple" -> "Apple Deleter" + Toggle Labels + Delete Apple + Via Menubar + Test Labels - "ok" in console + Find Labels - "ok" in console + Toggle Labels - "Add Apple" -> "Apple Adder", "Astros" -> "'Stros" + Test Labels - "ok" in console + Find Labels - "ok" in console + Toggle Labels - original labels + Add Apple + Test Labels - "ok" in console + Find Labels - "ok" in console + Via Menubar - off + + Handling Bad Requests: + Test Bad Item -> #f + Test Other Bad Item -> #f + Bad Item Labels - "ok" in console + Via Menubar + Bad Item Labels - "ok" in console + Via Menubar + Bad Check - nothing + Bad Enable - nothing From 4fbea1da38beffafea56368052b903075e615fd8 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 21 Dec 1997 01:48:32 +0000 Subject: [PATCH 3/3] import original commit: 3c656b8f01859131285df2a54e904d9a49459763 --- notes/mred/HISTORY | 373 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 373 insertions(+) create mode 100644 notes/mred/HISTORY diff --git a/notes/mred/HISTORY b/notes/mred/HISTORY new file mode 100644 index 00000000..22c4a703 --- /dev/null +++ b/notes/mred/HISTORY @@ -0,0 +1,373 @@ +Version 51: ??, 1997 +X Windows: window manager close-frame request is ignored + when a modal dialog is in control +Added security so that wx:snip% methods cannot be overridden + to crash MrEd + +Version 50: August 26, 1997 +Changed wx:dc%'s get-size method to return size of + destination area; old [documented] functionality + is available via max-x and max-y +Made button-click state visible for Xt on b&w displays +Fixed and normalized PostScript drawing +Removed wx:dc% methods: device-to-logical-x, etc. +Windows wx:display-size changed to return the size of the + screen not including the task bar +Windows: finally fixed scale for [non-PostScript] printing +Added wx:[un]register-collecting-blit +X Windows: Fixed use of colormap by loaded bitmap images +Added an optional argument to wx:media-buffer's print method + to supporting fitting to the destination page +X Windows: Saving as xbm works for bitmaps of any depth +MzScheme pathname expansion performed by all wx: toolbox + procedures that take a pathname +X Windows Xt: removed excessive borders on wx:canvas% objects +X Windows Xt: removed 2 pixel offset for a single auto-sized + child in a wx:frame% or wx:dialog-box% +Windows: Fixed scrollbars on editor buffers; they're always + shown now, but the editor never gets confused about the size +Fixed on-size, pre-on-char, and pre-on-event for wx:item% + subclasses +Fixed confusing argument type and number error messages + for overloaded methods of primitive classes + +Version 49: May 31, 1997 +Object system changes: see mzscheme/HISTORY for details +Fixed Mac event-handling and many other Mac things +Fixed garbage collection of hidden frames under Windows (!) +Panels, canvases, and controls that are both hidden and + inaccessible are now garbage-collected +Disabled controls are reliably grayed-out, including items + within a disabled panel +Instances of wx:pen%, wx:brush%, or wx:pen% that are + selected into a drawing context cannot be mutated +Immutability of objects obtained via wx:the-XXX-list is + enforced +Controls for Windows, Xt are created with the "System" family + rather than the "Default" family (using resources) +Single wx:bitmap% object can be used by multiple controls + and/or pens and/or brushes +Fixed Motif image-label radio button +wx:find-directory replaced with wx:find-path +All wx:dc% instances have a default font for drawing +wx:const-copy blit never uses the pen/background color; + new blit mode wx:const-colour uses current pen +X Windows: removed mapping of Mod3 to Alt (too confusing on + keyboards where NumLock is Mod3) +Fixed wx:timer% bug that caused autosaving to not work +Fixed eventspace bugs +Fixed .bmp reading when smaller-than-max colormap is provided +Fixed interlaced .gif reading for Windows and MacOS +Xt: fixed default height of wx:text% items +Xt: In a wx:mouse-event% instance, type wx:const-type-XXX-down + implies get-XXX-down => #t (formerly #f) +Removed wx:group-box% class; use a panel with a border, instead +Removed wx:tool-bar% class +wx:choice% get-columns and set-columns no longer supported +Added wx:gauge% methods: get-value and get-range +wx:media-pasteboard% bug fixes and improvements: raise, lower, + set-before, and set-after methods now work +wx:list-box% set-client-data and get-client-data work with + any Scheme data type +Windows and X Windows: Break key changed back to shift-ctl-c + instead of ctl-c (to avoid conflicts with Emacs-std keyboard + mappings) + +Version 48: Skipped to avoid confusion with Scheme48 + +Version 47: January 11, 1997 +WARNING: multiple inhertance is going away in 48 +Added overwrite-styles? arg to wx:media-buffer%'s read-from-file, + and added get-/set-load-overwrites-styles methods +Modified wx:media-buffer%'s set-caret-owner to provide more + levels of focus control +Controls with bitmap labels work correctly, fixed crashing bugs, + some Mac controls do not display yet +wx:bitmap%'s load-file only allowed when the bitmap is not selected + into a wx:memory-dc% object or used by a control + +Version 46: December 5, 1996 +Fixed misc. Motif control-sizing problems +Mac & Xt: "&" stripped from control labels correctly +wx:yield takes an optional semaphore argument + +Version 45: November 12, 1996 +IMPORTANT: let-values is now analogous to let; the old + let-values is now let*-values +Added thread-savy parameterization system; namespace system changed +Added eventspaces +wx:server%, wx:client%, and wx:connection% are no longer supported + (Better TCP support is now built into MzScheme) +wx:the-snip-class-list was replaced by (wx:get-the-snip-class-list) +wx:the-buffer-data-class-list was replaced by (wx:get-the-buffer-data-class-list) +Added transparent text backing for editor text +Added wx:dc% try-colour method +wx:window% capture-mode, release-mouse, and make-modal no longer supported + Modal dialogs can be used instead of make-modal (modal is + specified through the constructor). There is currently no + replacement for capture-mouse and release-mouse, but a replacement is + likely to be in 46. +Xt and Mac: "&" stripped from control labels (matches Windows/Motif), sortof + +Version 44: September 9, 1996 +wx:play-sound added +Saving bitmaps fixed on all platforms; editor can now save + "inlined" images instead of only references to images +Hyper-text browser handles HTML files (w/o networking) +Fixed Mac control drawing and hiding +Fixed Xt menus (finally!) +Fixed menu item auto-check for popup menus +Fixed Motif canvas click event reporting (spurious drags) +See also mzscheme/HISTORY, wxme/README, and system/HISTORY +Upgraded to gc 11alpha3 + +Version 43: Re-released August 12, 1996 +Under GNU LGPL license + +Version 43: August 9, 1996 +Major system overhaul (Robby Findler); see system/HISTORY +Windows stability greatly advanced +Windows and MacOS versions much more "Windows-like" and "Mac-like" + with standard menu shortcuts and better icons +MacOS and Windows use native print facilities +GIF images supported under Windows +wx:window set-client-size removed +wx:panel%'s get-cursor renamed to get-item-cursor; added set-item-cursor +Fixed cut-n-paste newlines under MacOS and Windows +Xt: panel with one item no longer auto-sizes the child +See also mzscheme/HISTORY + +Version 42: June 8, 1996 +Documentation translated to Scheme notation, corrected +Windows update bug fixed for embedded buffers +MacOS memory use greatly improved +Fixed annoying non-standard Windows beep +Non-matching cond or case expression raises and error +mred:platform and mred:window-system changed to wx:... +standard system uses functors (see MzScheme) +wx:canvas%::int-draw-line and wx:int-point% removed +wx:list%, wx:hash-table%, wx:string-list%, wx:path-list removed +wx:media-stream-in%::get removed for strings; use get-string +Redundant wx: functions removed: + wx:dir-exists? (use directory-exists?) + wx:file-exists? (use file-exists?) + wx:file-name-from-path (use file-name-from-path or split-path) + wx:path-only (use path-only or split-path) + wx:is-absolute-path? (use reletaive-path?) + wx:expand-path (use expand-path) + wx:get-working-directory (use current-directory) + wx:set-working-directory (use current-directory) + wx:mkdir (use make-directory) + wx:remove-file (use delete-file) + wx:rename-file (use rename-file) + wx:get-user-home and wx:get-home-dir (use expand-path with "~") + wx:execute and wx:shell (use system or process) + wx:find-first-file and wx:find-next-file (use get-directory-list) + wx:sleep (use sleep) + wx:sub-type? (use subclass?) + wx:to-lower (use char-upcase) + wx:to-upper (use char-downcase) + wx:is-wild? (use reg exps) + wx:match-wild? (use reg exps) + +Version 0.41: April 15, 1996 +Important language changes; see mzscheme/HISTORY +Fixed bug in wxCanvas drawing methods +Fixed wxCanvasDC and wxMemoryDC bugs in Xt version +Pasteboards fixed +AIX: two consecutive SIGDANGERs => exit(-1) +wxGetMultipleChoice supported + +Version 0.40: March 24, 1996 +Possible improvements to memory system +Some redundant event methods removed +Finally fixed Windows NT/95 Scheme threads +Stdout/stderr messages to a window instead of file for Windows/Mac+ +Fixed misc. Xt problems, including show-n-hide on frame + +Version 0.39: March 6, 1996 +Fixed safety from Scheme on invalidated C++ objects (stack objs, too) +Fixed many bugs in Xt version +Upgraded to gc version 4.10 +Reduced memory usage of buffer objects + +Version 0.38: February 22, 1996 +Xt port released +Part of standard system moved to DrScheme +See also mzscheme HISTORY and wxmedia README + +Version 0.37: Not released + +Version 0.36: January 18, 1996 +Fixed bug in MzScheme's bignum multiplication + +Version 0.35: January 17, 1996 +X selection protocol supported. To get the old clipboard-style + mechanism, add this to your .mredrc: + (wx:media-set-x-selection-mode #f) + See also wxMediaEdit::SetPosition() in the wxMedia manual. + +Version 0.34: December 30, 1995 +Minor improvements to MzScheme and the standard system + +Version 0.33: December 21, 1995 +MzScheme language changes; see mzscheme/HISTORY +Old standard system no longer compatible +Project system improved +Many bugs fixed in the new standard system + +Version 0.32: December 4, 1995 +New standard system: + * The console I/O is completely different. It works more + like an Emacs shell. Use M-p and M-n to access previously + entered expressions. (read) will now read from the console. + * All mred:std- variables have been eliminated. For each + mred:%, there is now a procedure mred:make-% that takes a + superclass and returns a new class. + * The frame and buffer hierarchies have changed a little. + * From a mred:edit% object, you can get to its canvas or frame. + * The menubar/menu system is completely revised. You don't have to + deal with menu ids much anymore. Menus and menu items can now be + dynamically added and removed. + * Keymap chaining works differently. + * The new Scheme project system is roughly in place. This will let you + develop Scheme programs by organizing Scheme files within a project. + Projects help manage loading program files into the + evaluator and uses Shriram's Zodiac/Aries packages to + provide debugging facilities. This will be improved in the near + future. + The old standard system is available in the "oldsys" directory. +Pretty printer handles loops and graphs +Very limited support for wxYield under XView - will be extended +Fixed some wxMedia bugs (see wxme/README) +Fixed some MzScheme bugs (see mzscheme/HISTORY) + +Version 0.31: November 14, 1995 +Fixed some wxMedia bugs (see wxme/README) +Fixed some MzScheme bugs (see mzscheme/HISTORY) +Parameterization for Macintosh + +Verion 0.30: October 25, 1995 +Added call-with-values and regexp to MzScheme +Unix stack-checking setup code fixed in MzScheme +wxMediaPasteboard implemented more +Scheme-C++ object link changed; use ptr in all C++ objects +Added tutorial section to "User Manual" + +Version 0.29: October 18, 1995 +Editor can save text preserving automatic CR +Bug fix in automatic line-wrapping +New font system can access arbitrary fonts +Multiple displays in Motif: wx:set-display and wx:get-display-name +MzScheme fix for forms such as (let ([x (let ...)]) ...) + +Version 0.28: October 3, 1995 +MzScheme bug fix: stack-checking on Unix +wxMedia fix: Insert(unsigned char, ...) instead of Insert(char, ...) + and proper use of `unsigned' in word-breaking array access + +Version 0.27: September 29, 1995 +Major MzScheme upgrade, including multiple inheritance + (See MzScheme HISTORY for details) +Win32: Allow deeper recursion by copying the stack +Win32: Allow breaking with Shift-Ctl-C +New font configuration system + +Version 0.26: September 8, 1995 +Very minor changes +Bug fix to MzScheme for Win32s + +Version 0.25: September 7, 1995 +Upgraded to wxWindows 1.63 +Minor bug fixes + +Version 0.24: September 1, 1995 +Minor bug fixes + +Version 0.23: August 23, 1995 +Minor bug fixes +Editor can display images (types depend on wxWindow compile flags) +MzScheme correction: expand & expand-once + +Version 0.22: August 17, 1995 +Mostly MzScheme improvements +File-format bug fixed related to portability; To make files created + earlier portable, open and re-save them. + +Version 0.21: August 8, 1995 +Bug fixes +triggers, hash tables, and case-lambda added to MzScheme +MzScheme "sleeps" properly +Connected MrEd to wxWindow's layout constraint system + +Version 0.20: July 26, 1995 +MzScheme Bug fixes + +Version 0.19: July 25, 1995 +All "!"s removed from method names!!!!! +Full continuations and bignums added to MzScheme +Bug Fixes + +Version 0.18: July 20, 1995 +Win32s kinda supported +Bug fixes +Added (compile ...) to MzScheme +Added internal processes & threads to MzScheme +wxSnipData -> wxBufferData +Old process and system changed to process* and system* + +Version 0.17: July 11, 1995 +Bug fixes, especially Motif and memory bugs +Rewrote editor line-maintenance +Faster caret updating +Upgraded garbage collector +File format changed to accomodate nested buffers with + separate style lists +Standard system standardized +Code changes for compiling on MSWindows (almost works...) +Scheme mode + +Version 0.16: June 16, 1995 +Fixed define-struct bug + +Version 0.15: June 15, 1995 +Bug fixes, especially XView +make-input-port takes only 3 args; "unget" param dropped +on-local-char & on-local-event renamed to on-default-char + and on-default-event +name changes: to have "!" or not to have "!". See doc/names.diff + for a list of changed names +fonts configuarble through .Xdefaults; see MrEd.ad + +Version 0.14: June 9, 1995 +Bug fixes, including wxWindows widget table clash +Scheme mode works +error-handler changed to parameterizing function + +Version 0.13: June 5, 1995 +MzScheme replaced libscheme +ctl-c breaks Scheme evaluation in MrEd +libscheme/ changed to mzscheme/ - change your make.env! + +Version 0.12: June 1, 1995 +Bug fixes +Revised object system: requires (inherit ...) declarations +(pretty-print ...) installed + +Version 0.11: May 19, 1995 +Bug Fixes + +Version 0.10: May 19, 1995 +Bug fixes +(match ...) installed + +Version 0.9: May 18, 1995 +wxMediaPasteboard + +Version 0.8: May 11, 1995 +Bug fixes + +Version 0.7: May 10, 1995 +mred:default- changed to mred: in system +README in demo directory +Lots of bug fixes