1  #lang racket/base
 2  ;; owner: ryanc
 3  (require racket/class
 4           racket/gui/base
 5           "private/notify.rkt")
 6  (provide (prefix-out notify:
 7                       (combine-out (all-from-out "private/notify.rkt")
 8                                    menu-option/notify-box
 9                                    menu-group/notify-box
10                                    check-box/notify-box
11                                    choice/notify-box)))
12  
13  ;; GUI elements tied to notify-boxes
14  ;; See private/notify.rkt for the non-gui parts of notify-boxes.
15  
16  (define (menu-option/notify-box parent label nb)
17    (define menu-item
18      (new checkable-menu-item%
19           (label label)
20           (parent parent)
21           (demand-callback
22            (lambda (i)
23              (send i check (send nb get))))
24           (callback
25            (lambda _ 
26              #;(send nb set (send menu-item is-checked?))
27              (send nb set (not (send nb get)))))))
28    menu-item)
29  
30  (define (check-box/notify-box parent label nb)
31    (define checkbox
32      (new check-box%
33           (label label)
34           (parent parent)
35           (value (send nb get))
36           (callback
37            (lambda (c e) (send nb set (send c get-value))))))
38    (send nb listen (lambda (value) (send checkbox set-value value)))
39    checkbox)
40  
41  (define (choice/notify-box parent label choices nb)
42    (define choice
43      (new choice%
44           (label label)
45           (parent parent)
46           (style '(horizontal-label))
47           (choices choices)
48           (callback (lambda (c e) (send nb set (send c get-string-selection))))))
49    (send choice set-string-selection (send nb get))
50    (send nb listen (lambda (value) (send choice set-string-selection value)))
51    choice)
52  
53  (define (menu-group/notify-box parent labels nb)
54    (map (lambda (option)
55           (define label (if (pair? option) (car option) option))
56           (define menu-item
57             (new checkable-menu-item%
58                  (label label)
59                  (parent parent)
60                  (checked (eq? (send nb get) option))
61                  (callback
62                   (lambda _ (send nb set option)))))
63           (send nb listen
64                 (lambda (value) (send menu-item check (eq? value option))))
65           menu-item)
66         labels))