119 lines
5.5 KiB
Text
119 lines
5.5 KiB
Text
|
;; 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"))
|