;; 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"))