exercise-calm-evt.ss
(module exercise-calm-evt mzscheme
  (require (lib "mred.ss" "mred")
           (lib "class.ss")
           (lib "async-channel.ss")
           "calm-evt.ss")
  
  (provide test)
  
  (define text%/changed-notification
    (class text%
      (inherit get-text)
      (define notify-channel (make-async-channel))
      
      (define/public (get-notify-channel)
        notify-channel)
      
      (define/augment (after-insert pos len)
        (inner (void) after-insert pos len)
        (async-channel-put notify-channel (get-text)))
      
      (define/augment (after-delete pos len)
        (inner (void) after-delete pos len)
        (async-channel-put notify-channel (get-text)))
      
      (super-new)))
  
  (define (test)
    (parameterize ([current-eventspace (make-eventspace)])
      (define f (new frame% [label ""]))
      (define t (new text%/changed-notification))
      (define c (new editor-canvas%
                     [parent f]
                     [editor t]))
      (send f show #t)
      
      (thread
       (lambda ()
         (define delayed-change-evt 
           (make-calm-evt (send t get-notify-channel)))
         (let loop ()
           (sync (handle-evt delayed-change-evt
                             (lambda (val)
                               (printf "~s~n" val))))
           (loop))))
      (void))))