original commit: 42b6f993c01e462569690c5b3dc08b51c5ba6414
This commit is contained in:
Matthew Flatt 1999-12-09 01:19:43 +00:00
parent 6f9cf1b05b
commit af82a8ad61
2 changed files with 11 additions and 11 deletions

View File

@ -50,9 +50,7 @@ Medium Frame should contain:
V Slider (a vertical slider)
H Gauge (a horizontal slider)
V Gauge (a vertical slider)
Howdy (a canvas-message)
<BB logo> (a canvas-message)
Text (a media-text)
Text (a multi-line text field)
initial & starting
The names on labels must match the above exactly (except that <>
@ -64,7 +62,7 @@ Make sure all the controls with moving parts work.
Tabbing and arrow keys should work correctly. The canvas in the bottom
middle area does not receive the focus via tabs in Big Frame, but it
does in Medium Frame. When it receives the focus via a tab, "Tab in"
is drawn inthe canvas; when the focus leaves the canvas for any reason
is drawn in the canvas; when the focus leaves the canvas for any reason
(tab out, mouse click somewhere else, etc.), "Tab in" is erased.
Window Resizing

View File

@ -3,8 +3,8 @@
(define source-dir (current-load-relative-directory))
(define num-times 4)
(define num-threads 1)
(define num-times 8)
(define num-threads 3)
(define dump-stats? #f)
@ -34,6 +34,7 @@
'sub-collect-panel
(make-object panel% sub-collect-frame)))
(define permanent-ready? #f)
(define mb-lock (make-semaphore 1))
(define htw (make-hash-table-weak))
@ -179,17 +180,18 @@
(send i delete)))
(when subwindows?
(unless (send sub-collect-frame get-menu-bar)
(unless permanent-ready?
(semaphore-wait mb-lock)
(unless (send sub-collect-frame get-menu-bar)
(let ([mb (make-object menu-bar% sub-collect-frame)])
(make-object menu% "Permanent" mb)))
(set! permanent-ready? #t)
(semaphore-post mb-lock))
(let* ([mb (send sub-collect-frame get-menu-bar)]
[mm (car (send mb get-items))])
(send (remember tag (make-object menu-item% "Delete Me" mm void)) delete)
(let ([m (make-object menu% "Temporary" mb)])
(remember tag (make-object menu-item% "Temp Hi" m void))
(send (remember (cons 'm tag) (make-object menu-item% "Delete Me" mm void)) delete)
(let ([m (remember tag (make-object menu% "Temporary" mb))])
(remember (cons 't tag) (make-object menu-item% "Temp Hi" m void))
(send m delete)))))
(when atomic?
@ -260,7 +262,7 @@
(unless (zero? n)
(yield sema)
(loop (sub1 n)))))
(collect-garbage)
(collect-garbage)
(let loop ([n 100])