[plt-scheme] Difficulty with threads, channels, and canvasses

I'm trying to use channels and a "mailbox" implementation I wrote to
queue up events captured by a mred canvas, but I'm getting strange
behavior.  The events will only queue up while nothing is waiting on
them.  Any time something is waiting for an event, none register.

To see this behavior:  run the module at the bottom of this email in
DrScheme in the (module ...) language.  At the interactions window,
type

(define C (new my-canvas%))

Then, with the focus on the new canvas, press and release the "a" key
(for instance).  Then enter

(send C get-event)
(send C get-event)

It should produce #\a, then 'release.  Now enter

(send C get-event)

again and it should hang.  Press keys any number of times on the
canvas, nothing happens.  Hit the "Stop" button.  Now type "b" on the
canvas, and at the interactions window type:

(send C get-event)
(send C get-event)
(send C get-event)

It will get #\b and 'release, then hang.  All the keys pressed while
it was previously waiting for an event were completely lost, not just
delayed.

Am I doing something wrong, or misunderstanding something?  What's
preventing these events from getting through?

--
Carl Eastlund
"Cynical, but technically correct."
--

(module bug mzscheme

  (require (lib "class.ss")
           (lib "mred.ss" "mred"))

  (define-struct mbox (in out))

  (define (make-mailbox)
    (let* ([in (make-channel)]
           [out (make-channel)]
           [mb (make-mbox in out)])
      (thread (lambda () (listener mb '())))
      mb))

  (define (listener mb queue)
    (sync
     (choice-evt
      (handle-evt (mbox-in mb)
                  (lambda (data)
                    (listener mb (append queue (list data)))))
      (if (null? queue)
          never-evt
          (handle-evt (channel-put-evt (mbox-out mb) (car queue))
                      (lambda (dummy) (listener mb (cdr queue))))))))

  (define (mailbox-put mb data)
    (channel-put (mbox-in mb) data))

  (define (mailbox-get mb)
    (channel-get (mbox-out mb)))

  (define my-canvas%
    (class canvas%
      (define parent (new frame%
                          [label "My Canvas"]
                          [width 300]
                          [height 300]))
      (super-new [parent parent])
      (inherit get-dc)
      (define mailbox (make-mailbox))
      (define/override (on-char key-event)
        (mailbox-put mailbox (send key-event get-key-code)))
      (define/public (draw x y color)
        (let* ([dc (get-dc)])
          (send dc clear)
          (send dc set-brush color 'solid)
          (send dc draw-ellipse (- x 10) (- y 10) 20 20)))
      (define/public (get-event)
        (mailbox-get mailbox))
      (send parent show #t)
      (draw 100 100 "green")))

  )