menu: add #:enabled?, #:help and #:shortcut to menu-items

Bogdanp · Oct 8, 2023 · 69e477b · 69e477b
1 parent 677840d
commit 69e477b
Show file tree

Hide file tree

Showing 5 changed files with 79 additions and 19 deletions.
diff --git a/examples/menu.rkt b/examples/menu.rkt
@@ -1,14 +1,25 @@
-#lang racket/base
+#lang racket/gui/easy
 
-(require (prefix-in gui: racket/gui)
-         racket/gui/easy)
+
+(define/obs @can-save? #t)
 
 (render
  (window
   #:size '(800 600)
   (menu-bar
    (menu "&File"
          (menu-item "&New File")
-         (menu-item "&Open File..." (λ () (gui:get-file)))
+         (menu-item "&Open..." (λ () (gui:get-file)))
+         (menu-item
+          "&Save..."
+          #:enabled? @can-save?
+          #:help "Saves the file"
+          #:shortcut (if (eq? (system-type 'os) 'macosx)
+                         '(cmd #\s)
+                         '(ctl #\s)))
          (menu-item-separator)
-         (menu-item "&Print...")))))
+         (menu-item "&Print...")))
+  (button
+   "Toggle Save"
+   (lambda ()
+     (@can-save? . <~ . not)))))
diff --git a/gui-easy-lib/gui/easy/private/view/menu.rkt b/gui-easy-lib/gui/easy/private/view/menu.rkt
@@ -110,25 +110,47 @@
 
 (define menu-item%
   (class* object% (view<%>)
-    (init-field @label action)
+    (init-field @label @enabled? @help @shortcut action)
     (super-new)
 
     (define/public (dependencies)
-      (filter obs? (list @label)))
+      (filter obs? (list @label @enabled? @help @shortcut)))
 
     (define/public (create parent)
-      (new gui:menu-item%
-           [parent parent]
-           [label (peek @label)]
-           [callback (λ (_self _event)
-                       (action))]))
+      (define the-item
+        (new gui:menu-item%
+             [parent parent]
+             [help-string (obs-peek @help)]
+             [label (peek @label)]
+             [callback (λ (_self _event)
+                         (action))]))
+      (begin0 the-item
+        (send the-item enable (obs-peek @enabled?))
+        (set-shortcut the-item (obs-peek @shortcut))))
 
     (define/public (update v what val)
       (case/dep what
-        [@label (send v set-label 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))))
+      (void))
+
+    (define/private (set-shortcut v s)
+      (cond
+        [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 s)])
+             (values (if k (cons k p) p) v)))
+         (send v set-shortcut k)
+         (send v set-shortcut-prefix p)]
+        [else
+         (send v set-shortcut #f)
+         (send v set-shortcut-prefix null)]))))
 
 (define menu-item-separator%
   (class* object% (view<%>)
@@ -160,9 +182,15 @@
        [@label @label]
        [children children]))
 
-(define (menu-item @label [action void])
+(define (menu-item @label [action void]
+                   #:enabled? [@enabled? (obs #t)]
+                   #:help [@help (obs #f)]
+                   #:shortcut [@shortcut (obs #f)])
   (new menu-item%
-       [@label @label]
+       [@label (->obs @label)]
+       [@enabled? (->obs @enabled?)]
+       [@help (->obs @help)]
+       [@shortcut (->obs @shortcut)]
        [action action]))
 
 (define (menu-item-separator)

diff --git a/gui-easy-lib/gui/easy/view.rkt b/gui-easy-lib/gui/easy/view.rkt
@@ -35,7 +35,15 @@
   [popup-menu (-> view/c ... (is-a?/c popup-menu-view<%>))]
   [menu-bar (-> view/c ... (is-a?/c menu-bar-view<%>))]
   [menu (-> (maybe-obs/c maybe-label/c) view/c ... (is-a?/c menu-view<%>))]
-  [menu-item (->* ((maybe-obs/c maybe-label/c)) ((-> any)) view/c)]
+  [menu-item (->* ((maybe-obs/c maybe-label/c))
+                  ((-> any)
+                   #: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

diff --git a/gui-easy-lib/info.rkt b/gui-easy-lib/info.rkt
@@ -1,7 +1,7 @@
 #lang info
 
 (define license 'BSD-3-Clause)
-(define version "0.14")
+(define version "0.15")
 (define collection "racket")
 (define deps '("base"
                "box-extra-lib"

diff --git a/gui-easy/gui/easy/scribblings/reference.scrbl b/gui-easy/gui/easy/scribblings/reference.scrbl
@@ -140,10 +140,23 @@
 }
 
 @defproc[(menu-item [label (maybe-obs/c maybe-label/c)]
-                    [action (-> any) void]) (is-a?/c view<%>)]{
+                    [action (-> any) void]
+                    [#:enabled? enabled? (maybe-obs/c boolean?) #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 that calls @racket[action]
   when clicked.
+
+  @history[
+    #:changed "0.15" @elem{
+      The @racket[#:enabled?], @racket[#:help] and @racket[#:shortcut]
+      arguments.
+    }
+  ]
 }
 
 @defproc[(menu-item-separator) (is-a?/c view<%>)]{