[plt-scheme] Dynamic menu-item% callback assignment?

On Thu, 22 Feb 2007, Greg Johnston wrote:

> I'm using very modular MVC to create a GUI for a program. As such,
> it's not really possible to create the callbacks for menu-item%s when
> the objects are created. According to the MrEd manual, this is when
> callbacks are created, unfortunately.
>
> Is there any way to assign a callback later, or do I need to work around 
> this?

Hi Greg,

Yes; I have a small example of this in:

    http://hkn.eecs.berkeley.edu/~dyoo/plt/mr-ed-notes.txt


Here's the example:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module sample-gui mzscheme
   (require (lib "mred.ss" "mred")
            (lib "class.ss")
            (lib "etc.ss"))

   (define view%
     (class frame%
       (init [label "test"])
       (super-new [label label])

       ;; The entry callback here does nothing until it's rewired
       ;; by the controller.
       (define (entry-callback text-field control-event)
         (void))

       (define/public (set-entry-callback! f)
         (set! entry-callback f))

       (define entry-field
         (new text-field%
              [label "entry: "]
              [parent this]
              [callback (lambda args
                          (apply entry-callback args))]))
       (define result-field
         (new text-field%
              [label "result: "]
              [parent this]
              [enabled #f]))

       (define/public (get-entry-field)
         entry-field)

       (define/public (get-result-field)
         result-field)))


   (define controller%
     (class object%
       [init model]
       [init view]
       (super-new)

       (define entry (send view get-entry-field))
       (define result (send view get-result-field))

       (define (entry-callback field event)
         (define (is-enter? event)
           (symbol=? 'text-field-enter
                     (send event get-event-type)))
         (when (is-enter? event)
           (update-result)))

       (define (update-result)
         (let* ([entry-str (send entry get-value)]
                [entry-num (string->number entry-str)])
           (cond [entry-num
                  (send result set-value
                        (number->string (model entry-num)))]
                 [else
                  (send result set-value
                        (format "~a: not number" entry-str))])))

       (send view set-entry-callback! entry-callback)))


   (define (simple-squaring-gui)
     (let ([model (lambda (n) (* n n))]
           [view (new view% [label "Squares"])])
       (let ([controller (new controller%
                              [model model]
                              [view view])])
         (send view show #t)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



Best of wishes!