bjoli/bjogui
SHA256
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Menus, context menus and keyboard shortcuts

Browse source 
A menu bar, submenus and menu items are views. A menu item's items are an
ItemsControl's, so they are patched as a list's. A context menu wraps a
view: the view and its menu are two places of the wrapper.

Keys are matched in the window's KeyDown, after the focused control had its
chance: an enabled menu item in the view whose shortcut it is, or else the
app's #:keys. Avalonia's own key bindings take an ICommand, which a Bjolang
program cannot make. app-press! presses keys for a test.

🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-8)

Co-Authored-By: eca-agent <git@eca.dev>
This commit is contained in:
Linus Björnstam 2026-10-25 17:55:19 +01:00
parent 1e46202eef
commit be288ac03e
3 changed files with 300 additions and 28 deletions
Download patch file Download diff file Expand all files Collapse all files

118
tests/menus.bjo Normal file
View file

@ -0,0 +1,118 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; bjogui/tests/menus.bjo — menus, context menus and keyboard shortcuts.
;;
;; bjo run tests/menus.bjo
;;
;; No window is opened. A click is raised on a menu item as Avalonia raises
;; it, and keys are pressed with `app-press!`, which is what the window's
;; handler calls.
(import (std prelude))
(import (std simpletest))
(import (bjogui view))
(import (bjogui app))
(import/class
(Object (: System.Object))
(Control (: Avalonia.Controls.Control))
(Interactive (: Avalonia.Interactivity.Interactive))
(RoutedEvent (: Avalonia.Interactivity.RoutedEvent))
(RoutedEventArgs (: Avalonia.Interactivity.RoutedEventArgs (-> RoutedEvent RoutedEventArgs)))
(ItemsControl (: Avalonia.Controls.ItemsControl))
(MenuItem (: Avalonia.Controls.MenuItem))
(Headered (: Avalonia.Controls.Primitives.HeaderedSelectingItemsControl))
(KeyGesture (: Avalonia.Input.KeyGesture))
(ContextMenu (: Avalonia.Controls.ContextMenu)))
(import/extern
(menu-click-event (: Avalonia.Controls.MenuItem.ClickEvent #:get))
(raise-event (: Avalonia.Interactivity.Interactive.RaiseEvent (-> Interactive RoutedEventArgs void)))
(item-count (: Avalonia.Controls.ItemsControl.ItemCount (-> ItemsControl int) #:get))
(header (: Avalonia.Controls.Primitives.HeaderedSelectingItemsControl.Header
(-> Headered Object) #:get))
(input-gesture (: Avalonia.Controls.MenuItem.InputGesture (-> MenuItem KeyGesture) #:get))
(context-menu (: Avalonia.Controls.Control.ContextMenu (-> Control ContextMenu) #:get)))
;; ---------------------------------------------------------------------------
;; The program under test
;; ---------------------------------------------------------------------------
(type (: Msg (Union New (: Open string) Quit Copy Refresh AllowQuit)))
(type (: Model (Record (: log (List string)) (: can-quit bool))))
(: (-> Msg Model (Tuple Model (List (Event Msg)))))
(defun (gui-update msg m)
(defun (log s) (record-set m (log (cons s (.log m)))))
(next (match msg
(New (log "new"))
((Open f) (log (string-append "open " f)))
(Quit (log "quit"))
(Copy (log "copy"))
(Refresh (log "refresh"))
(AllowQuit (record-set m (can-quit #t))))))
(: (-> Model (View Msg)))
(defun (view m)
(column
(menu-bar ; 0
(submenu "File" ; 0 0
(menu-item "New" New #:shortcut "Ctrl+N") ; 0 0 0
(menu-separator) ; 0 0 1
(submenu "Recent" ; 0 0 2
(menu-item "notes.txt" (Open "notes.txt"))) ; 0 0 2 0
(menu-item "Quit" Quit #:shortcut "Ctrl+Q" #:enabled (.can-quit m))))
(with-context-menu (text "right click me") ; 1
(menu-item "Copy" Copy #:shortcut "Ctrl+C"))))
(: (-> Model (List (Key Msg))))
(defun (keys m) (list (key "F5" Refresh)))
;; ---------------------------------------------------------------------------
;; The test
;; ---------------------------------------------------------------------------
(defun (main)
(def app (start-app (Model (log '()) (can-quit #f)) gui-update view (fun (c) unit)
#:keys keys))
(defun (ctl path) (app-control-at app path))
(defun (click path)
(raise-event (cast Interactive (ctl path))
(RoutedEventArgs. (cast RoutedEvent menu-click-event))))
(defun (history) (.log (app-model app)))
;; --- the menu bar -------------------------------------------------------------
(expect "one menu" (item-count (cast ItemsControl (ctl '(0)))) 1)
(expect "its items, with the separator" (item-count (cast ItemsControl (ctl '(0 0)))) 4)
(expect "a header" (.ToString (header (cast Headered (ctl '(0 0 0))))) "New")
(expect "a shortcut is shown" (.ToString (cast Object (input-gesture (cast MenuItem (ctl '(0 0 0))))))
"Ctrl+N")
(click '(0 0 0))
(expect "an item chosen is a message" (history) '("new"))
;; The click bubbles through "Recent" and "File"; only the item answers.
(click '(0 0 2 0))
(expect "an item in a submenu, once" (history) '("open notes.txt" "new"))
;; --- the context menu -------------------------------------------------------
(def cm (context-menu (ctl '(1))))
(expect "the context menu is the view's" (eq? (cast Object cm) (cast Object (ctl '(1 1)))) #t)
(expect "its items" (item-count (cast ItemsControl cm)) 1)
(click '(1 1 0))
(expect "a context menu item" (first (history)) (Some "copy"))
;; --- keys -----------------------------------------------------------------------
(expect "a menu item's shortcut" (app-press! app "Ctrl+N") #t)
(expect "sends its message" (first (history)) (Some "new"))
(expect "a context menu's shortcut too" (app-press! app "Ctrl+C") #t)
(expect "a disabled item's shortcut does nothing" (app-press! app "Ctrl+Q") #f)
(app-dispatch! app AllowQuit)
(expect "until it is enabled" (app-press! app "Ctrl+Q") #t)
(expect "the app's own keys" (app-press! app "F5") #t)
(expect "and their message" (first (history)) (Some "refresh"))
(expect "keys bound to nothing" (app-press! app "Ctrl+X") #f)
(expect "keys that cannot be read" (app-press! app "Ctrl+Nope") #f)
(println "bjogui menus ok"))