Add checkable-menu-item

examples/menu.rkt

@@ -3,6 +3,7 @@
 (define/obs @menu-bar-enabled? #t)
 (define/obs @file-menu-enabled? #t)
 (define/obs @can-save? #t)
+(define/obs @checked? #f)
 
 (render
  (window
@@ -22,7 +23,12 @@
                     '(cmd #\s)
                     '(ctl #\s)))
     (menu-item-separator)
-    (menu-item "&Print...")))
+    (checkable-menu-item
+     (@checked? . ~> . (λ (checked?) (if checked?
+                                         "This is checked"
+                                         "This is not checked")))
+     (λ:= @checked?)
+     #:checked? @checked?)))
   (vpanel
    (button
     "Toggle Menu Bar"

gui-easy-lib/gui/easy/private/view/menu.rkt

@@ -17,6 +17,7 @@
  menu-view<%>
  menu
  menu-item
+ checkable-menu-item
  menu-item-separator)
 
 (define popup-menu-view<%>
@@ -157,6 +158,47 @@
       (send v set-shortcut k)
       (send v set-shortcut-prefix p))))
 
+(define checkable-menu-item%
+  (class* object% (view<%>)
+    (init-field @label @checked? @enabled? @help @shortcut action)
+    (super-new)
+
+    (define/public (dependencies)
+      (filter obs? (list @label @checked? @enabled? @help @shortcut)))
+
+    (define/public (create parent)
+      (define the-item
+        (new gui:checkable-menu-item%
+             [parent parent]
+             [help-string (peek @help)]
+             [label (peek @label)]
+             [callback (λ (_self _event)
+                         (action (send _self is-checked?)))]
+             [checked (peek @checked?)]))
+      (begin0 the-item
+        (send the-item enable (peek @enabled?))
+        (set-shortcut the-item (peek @shortcut))))
+
+    (define/public (update v what val)
+      (case/dep what
+        [@checked? (send v check val)]
+        [@enabled? (send v enable val)]
+        [@help (send v set-help-string val)]
+        [@label (send v set-label val)]
+        [@shortcut (set-shortcut v val)]))
+
+    (define/public (destroy _v)
+      (void))
+
+    (define/private (set-shortcut v s)
+      ;; Contract guarantees at least one prefix and one key.
+      (define-values (p k)
+        (for/fold ([p null] [k #f] #:result (values (reverse p) k))
+                  ([v (in-list (or s null))])
+          (values (if k (cons k p) p) v)))
+      (send v set-shortcut k)
+      (send v set-shortcut-prefix p))))
+
 (define menu-item-separator%
   (class* object% (view<%>)
     (super-new)
@@ -205,5 +247,18 @@
        [@shortcut (->obs @shortcut)]
        [action action]))
 
+(define (checkable-menu-item @label [action void]
+                             #:checked? [@checked? (obs #f)]
+                             #:enabled? [@enabled? (obs #t)]
+                             #:help [@help (obs #f)]
+                             #:shortcut [@shortcut (obs #f)])
+  (new checkable-menu-item%
+       [@label (->obs @label)]
+       [@checked? (->obs @checked?)]
+       [@enabled? (->obs @enabled?)]
+       [@help (->obs @help)]
+       [@shortcut (->obs @shortcut)]
+       [action action]))
+
 (define (menu-item-separator)
   (new menu-item-separator%))

gui-easy-lib/gui/easy/view.rkt

@@ -51,6 +51,16 @@
                                                      (or/c 'alt 'cmd 'meta 'ctl 'shift 'option)
                                                      (or/c char? symbol?)))))
                   view/c)]
+  [checkable-menu-item (->* ((maybe-obs/c maybe-label/c))
+                            ((-> boolean? any)
+                             #:checked? (maybe-obs/c any/c)
+                             #:enabled? (maybe-obs/c any/c)
+                             #:help (maybe-obs/c (or/c #f string?))
+                             #:shortcut (maybe-obs/c (or/c #f (*list/c
+                                                               (or/c 'alt 'cmd 'meta 'ctl 'shift 'option)
+                                                               (or/c 'alt 'cmd 'meta 'ctl 'shift 'option)
+                                                               (or/c char? symbol?)))))
+                            view/c)]
   [menu-item-separator (-> view/c)]
 
   ;; Containers

gui-easy/gui/easy/scribblings/reference.scrbl

@@ -172,6 +172,18 @@
   ]
 }
 
+@defproc[(checkable-menu-item [label (maybe-obs/c maybe-label/c)]
+                              [action (-> boolean? any) void]
+                              [#:checked? checked? (maybe-obs/c any/c) #f]
+                              [#:enabled? enabled? (maybe-obs/c any/c) #t]
+                              [#:help help-text (maybe-obs/c (or/c #f string?)) #f]
+                              [#:shortcut shortcut (maybe-obs/c (or/c #f (*list/c
+                                                                          (or/c 'alt 'cmd 'meta 'ctl 'shift 'option)
+                                                                          (or/c 'alt 'cmd 'meta 'ctl 'shift 'option)
+                                                                          (or/c char? symbol?)))) #f]) (is-a?/c view<%>)]{
+
+  Returns a representation of a menu item with a checkbox. The @racket[action] callback is called with the current checked state when the menu item is clicked. Use @racket[#:checked?] to set or update the checkbox programmatically.}
+
 @defproc[(menu-item-separator) (is-a?/c view<%>)]{
   Returns a representation of a menu item separator.
 }