From cfcb1851b7056df18da3756efb105a090930dd71514f9a0de761daaea6c54765 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Linus=20Bj=C3=B6rnstam?= Date: Sun, 25 Oct 2026 18:01:27 +0100 Subject: [PATCH] Dialogs, file pickers, and closing by the program's leave MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit (bjogui dialogs) has alert, confirm and prompt, the open, save and folder pickers, and quit, each a command whose answer comes back as a message. A dialog is a window, which only the UI thread may make, so the command posts it there and awaits its Task in a fiber. Avalonia's dialogs take no CancellationToken, so they cannot be task->event; the Task is awaited through the non-generic Task.WhenAll, and its result read by reflection, because Bjolang reads no Task's Result. With no window, as under start-app, each answers as if cancelled. run-app's #:on-close turns the close button into a message, and quit closes the windows by program, which is not asked again. 🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-8) Co-Authored-By: eca-agent --- src/app.bjo | 22 ++- src/dialogs.bjo | 408 ++++++++++++++++++++++++++++++++++++++++++++++ tests/dialogs.bjo | 54 ++++++ 3 files changed, 483 insertions(+), 1 deletion(-) create mode 100644 src/dialogs.bjo create mode 100644 tests/dialogs.bjo diff --git a/src/app.bjo b/src/app.bjo index 18f052a..ddbde1a 100644 --- a/src/app.bjo +++ b/src/app.bjo @@ -88,6 +88,8 @@ (KeyCode (: Avalonia.Input.Key)) (KeyModifiers (: Avalonia.Input.KeyModifiers)) (KeyEventArgs (: Avalonia.Input.KeyEventArgs)) + (ClosingArgs (: Avalonia.Controls.WindowClosingEventArgs)) + (CancelArgs (: System.ComponentModel.CancelEventArgs)) (ICollection (: System.Collections.ICollection)) (Timer (: Avalonia.Threading.DispatcherTimer (-> Timer))) (TimeSpan (: System.TimeSpan)) @@ -180,6 +182,8 @@ (key-of (: Avalonia.Input.KeyEventArgs.Key (-> KeyEventArgs KeyCode) #:get)) (modifiers-of (: Avalonia.Input.KeyEventArgs.KeyModifiers (-> KeyEventArgs KeyModifiers) #:get)) (handled! (: Avalonia.Interactivity.RoutedEventArgs.Handled (-> RoutedEventArgs bool void) #:set)) + (programmatic? (: Avalonia.Controls.WindowClosingEventArgs.IsProgrammatic (-> ClosingArgs bool) #:get)) + (cancel-close! (: System.ComponentModel.CancelEventArgs.Cancel (-> CancelArgs bool void) #:set)) ;; A grid's sizes are not Avalonia properties, so they are set as .NET ;; properties are. @@ -1060,6 +1064,10 @@ ;; Runs the program in a window, until the window is closed. Then the ;; subscriptions and the commands still running are cancelled. ;; +;; With `#:on-close msg`, a click on the window's close button does not close +;; it: it sends `msg`, and the program closes it with `quit` from +;; (bjogui dialogs) when it is ready, say after asking about unsaved work. +;; ;; With `#:screenshot`, a path, the window saves a PNG of itself there once it ;; is shown, and closes. It is the environment variable BJOGUI_SCREENSHOT ;; unless told otherwise, so any program can be pictured with no change: @@ -1067,10 +1075,11 @@ ;; BJOGUI_SCREENSHOT=shot.png bjo run examples/todo.bjo (: (-> %model (-> %m %model (Tuple %model (List (Event %m)))) (-> %model (View %m)) (#:subscriptions (-> %model (List (Sub %m)))) - (#:keys (-> %model (List (Key %m)))) + (#:keys (-> %model (List (Key %m)))) (#:on-close (Option %m)) (#:title string) (#:width double) (#:height double) (#:screenshot string) void)) (defun (run-app init gui-update view #:subscriptions (fun (m) '()) #:keys (fun (m) '()) + #:on-close None #:title "bjogui" #:width 400.0 #:height 300.0 #:screenshot (option-ref-or (get-environment-variable "BJOGUI_SCREENSHOT") "")) ;; The Application is made inside the setup, because making one uses the @@ -1089,6 +1098,17 @@ (def app (start-app init gui-update view (fun (c) (window-content! (cast ContentControl w) (cast Object c))) #:subscriptions subscriptions #:keys keys)) + ;; With `#:on-close`, closing the window is a message. The program closes + ;; it with `quit`, which closes it by program, and that is not asked. + (match on-close + ((Some msg) + (ignore (add-event-handler! w "Closing" + (: (fun (sender e) + (unless (programmatic? (cast ClosingArgs e)) + (cancel-close! (cast CancelArgs e) #t) + (app-dispatch! app msg))) + (-> Object Object void))))) + (None unit)) ;; Keys that no control took, such as a shortcut pressed in a text input. (on! (cast Control w) (cast RoutedEvent key-down-event) (fun (sender e) diff --git a/src/dialogs.bjo b/src/dialogs.bjo new file mode 100644 index 0000000..96c632e --- /dev/null +++ b/src/dialogs.bjo @@ -0,0 +1,408 @@ +;; 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/src/dialogs.bjo — the module (bjogui dialogs). +;; +;; Dialogs, file pickers and quitting, as commands: each is an `(Event %m)` +;; that `gui-update` returns, and the answer comes back as a message. +;; +;; (Delete (next m (confirm "Delete it?" Deleted?))) +;; ((Deleted? #t) (next (remove m))) +;; +;; A dialog is a window, which only the UI thread may make, and a command is +;; synced in a fiber. So each one is a `guard`: when the fiber syncs it, a +;; fiber of its own asks the UI thread to show the dialog, and waits for the +;; Task that the dialog gives back. +;; +;; A dialog needs a window to belong to. With none, as in a test that runs an +;; app with `start-app`, each answers as if it was cancelled: `confirm` #f, +;; `prompt` and the pickers None or nothing. + +(export + alert confirm prompt + open-file open-files save-file open-folder + quit) + +(import (std prelude)) +(import (std interop)) + +(import/class + (Object (: System.Object)) + (DispatcherOpBase (: Avalonia.Threading.DispatcherOperation)) + (ClrType (: System.Type)) + (PropertyInfo (: System.Reflection.PropertyInfo)) + (ClrString (: System.String)) + ((ReadOnlyList %a) (: System.Collections.Generic.IReadOnlyList)) + ((EventHandler %a) (: System.EventHandler)) + (Application (: Avalonia.Application)) + (ILifetime (: Avalonia.Controls.ApplicationLifetimes.IApplicationLifetime)) + (Lifetime (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime)) + (Dispatcher (: Avalonia.Threading.Dispatcher)) + ((DispatcherOp %a) (: Avalonia.Threading.DispatcherOperation)) + (AvaloniaObject (: Avalonia.AvaloniaObject)) + (AvaloniaProperty (: Avalonia.AvaloniaProperty)) + (Priority (: Avalonia.Data.BindingPriority)) + (Disposable (: System.IDisposable)) + (Thickness (: Avalonia.Thickness (-> double Thickness))) + (Orientation (: Avalonia.Layout.Orientation)) + (HAlignment (: Avalonia.Layout.HorizontalAlignment)) + (TextWrapping (: Avalonia.Media.TextWrapping)) + (SizeToContent (: Avalonia.Controls.SizeToContent)) + (StartupLocation (: Avalonia.Controls.WindowStartupLocation)) + (Control (: Avalonia.Controls.Control)) + (Controls (: Avalonia.Controls.Controls)) + (Panel (: Avalonia.Controls.Panel)) + (StackPanel (: Avalonia.Controls.StackPanel (-> StackPanel))) + (TextBlock (: Avalonia.Controls.TextBlock (-> TextBlock))) + (TextBox (: Avalonia.Controls.TextBox (-> TextBox))) + (Button (: Avalonia.Controls.Button (-> Button))) + (Window (: Avalonia.Controls.Window (-> Window))) + (TopLevel (: Avalonia.Controls.TopLevel)) + (Interactive (: Avalonia.Interactivity.Interactive)) + (RoutedEvent (: Avalonia.Interactivity.RoutedEvent)) + (RoutedEventArgs (: Avalonia.Interactivity.RoutedEventArgs)) + (Routes (: Avalonia.Interactivity.RoutingStrategies)) + (StorageProvider (: Avalonia.Platform.Storage.IStorageProvider)) + (StorageItem (: Avalonia.Platform.Storage.IStorageItem)) + (StorageFile (: Avalonia.Platform.Storage.IStorageFile)) + (StorageFolder (: Avalonia.Platform.Storage.IStorageFolder)) + (FileType (: Avalonia.Platform.Storage.FilePickerFileType (-> string FileType))) + (PickerOptions (: Avalonia.Platform.Storage.PickerOptions)) + (OpenOptions (: Avalonia.Platform.Storage.FilePickerOpenOptions (-> OpenOptions))) + (SaveOptions (: Avalonia.Platform.Storage.FilePickerSaveOptions (-> SaveOptions))) + (FolderOptions (: Avalonia.Platform.Storage.FolderPickerOpenOptions (-> FolderOptions)))) + +(import/extern + ;; The UI thread, and the window a dialog belongs to. + (ui-dispatcher (: Avalonia.Threading.Dispatcher.UIThread #:get)) + (ui-post (: Avalonia.Threading.Dispatcher.InvokeAsync (-> Dispatcher (-> Unit) (DispatcherOp Unit)))) + ;; Runs a function on the UI thread. + (on-ui (: Avalonia.Threading.Dispatcher.InvokeAsync + (-> Dispatcher (-> Unit) (DispatcherOp Unit)))) + (op-task (: Avalonia.Threading.DispatcherOperation.GetTask (-> DispatcherOpBase Task))) + ;; Waits for Tasks. Avalonia's dialogs take no CancellationToken, so this + ;; cannot be cancelled: a cancelled command stops at its next sync, and the + ;; dialog stays until it is answered. + (await-tasks (: System.Threading.Tasks.Task.WhenAll (-> (Array Task) void) + #:async #:uncancellable)) + ;; What a finished Task answers. By reflection, because Bjolang reads no + ;; Task's Result: on a Task that is not finished, that would block. + (type-of (: System.Object.GetType (-> Object ClrType))) + (property-of (: System.Type.GetProperty (-> ClrType string PropertyInfo))) + (value-of (: System.Reflection.PropertyInfo.GetValue (-> PropertyInfo Object Object))) + (answered (: System.Threading.Tasks.Task.FromResult (-> %a (Task %a)))) + (current-app (: Avalonia.Application.Current #:get)) + (app-lifetime (: Avalonia.Application.ApplicationLifetime (-> Application ILifetime) #:get)) + (main-window (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime.MainWindow + (-> Lifetime Window) #:get)) + (shutdown! (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime.Shutdown + (-> Lifetime int void))) + (reference=? (: System.Object.ReferenceEquals (-> Object Object bool))) + + ;; The dialog window. + (set-value (: Avalonia.AvaloniaObject.SetValue + (-> AvaloniaObject AvaloniaProperty Object Priority Disposable))) + (title-property (: Avalonia.Controls.Window.TitleProperty #:get)) + (size-to-content-property (: Avalonia.Controls.Window.SizeToContentProperty #:get)) + (startup-location-property (: Avalonia.Controls.Window.WindowStartupLocationProperty #:get)) + (can-resize-property (: Avalonia.Controls.Window.CanResizeProperty #:get)) + (show-in-taskbar-property (: Avalonia.Controls.Window.ShowInTaskbarProperty #:get)) + (content-property (: Avalonia.Controls.ContentControl.ContentProperty #:get)) + (margin-property (: Avalonia.Layout.Layoutable.MarginProperty #:get)) + (max-width-property (: Avalonia.Layout.Layoutable.MaxWidthProperty #:get)) + (min-width-property (: Avalonia.Layout.Layoutable.MinWidthProperty #:get)) + (halign-property (: Avalonia.Layout.Layoutable.HorizontalAlignmentProperty #:get)) + (spacing-property (: Avalonia.Controls.StackPanel.SpacingProperty #:get)) + (orientation-property (: Avalonia.Controls.StackPanel.OrientationProperty #:get)) + (text-property (: Avalonia.Controls.TextBlock.TextProperty #:get)) + (wrapping-property (: Avalonia.Controls.TextBlock.TextWrappingProperty #:get)) + (box-text-property (: Avalonia.Controls.TextBox.TextProperty #:get)) + (is-default-property (: Avalonia.Controls.Button.IsDefaultProperty #:get)) + (is-cancel-property (: Avalonia.Controls.Button.IsCancelProperty #:get)) + (click-event (: Avalonia.Controls.Button.ClickEvent #:get)) + (add-handler (: Avalonia.Interactivity.Interactive.AddHandler + (-> Interactive RoutedEvent Delegate Routes bool void))) + (children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get)) + (box-text (: Avalonia.Controls.TextBox.Text (-> TextBox ClrString) #:get)) + (close-with! (: Avalonia.Controls.Window.Close (-> Window Object void))) + (show-dialog (: Avalonia.Controls.Window.ShowDialog (-> Window Window (Task Object)))) + (clr-string (: System.Convert.ToString (-> string ClrString))) + + ;; The pickers. + (storage-provider (: Avalonia.Controls.TopLevel.StorageProvider (-> TopLevel StorageProvider) #:get)) + (pick-files (: Avalonia.Platform.Storage.IStorageProvider.OpenFilePickerAsync + (-> StorageProvider OpenOptions (Task (ReadOnlyList StorageFile))))) + (pick-save (: Avalonia.Platform.Storage.IStorageProvider.SaveFilePickerAsync + (-> StorageProvider SaveOptions (Task StorageFile)))) + (pick-folders (: Avalonia.Platform.Storage.IStorageProvider.OpenFolderPickerAsync + (-> StorageProvider FolderOptions (Task (ReadOnlyList StorageFolder))))) + (local-path (: Avalonia.Platform.Storage.StorageProviderExtensions.TryGetLocalPath (-> StorageItem string))) + (title! (: Avalonia.Platform.Storage.PickerOptions.Title (-> PickerOptions string void) #:set)) + (allow-multiple! (: Avalonia.Platform.Storage.FilePickerOpenOptions.AllowMultiple (-> OpenOptions bool void) #:set)) + (file-types! (: Avalonia.Platform.Storage.FilePickerOpenOptions.FileTypeFilter + (-> OpenOptions (ReadOnlyList FileType) void) #:set)) + (suggested-name! (: Avalonia.Platform.Storage.FilePickerSaveOptions.SuggestedFileName + (-> SaveOptions string void) #:set)) + (patterns! (: Avalonia.Platform.Storage.FilePickerFileType.Patterns + (-> FileType (ReadOnlyList ClrString) void) #:set))) + +;; --------------------------------------------------------------------------- +;; The UI thread +;; --------------------------------------------------------------------------- + +(: (-> Object bool)) +(defun (null? x) (reference=? x (clr-default))) + +;; The app's main window, if there is an app with one. +(: (-> (Option Window))) +(defun (owner) + (def app (cast Object current-app)) + (if (null? app) + None + (match (try (cast Lifetime (app-lifetime (cast Application app))) + #:catch (System.InvalidCastException System.NullReferenceException)) + ((Ok lifetime) + (def w (main-window lifetime)) + (if (null? (cast Object w)) None (Some w))) + ((Err _) None)))) + +;; Runs `start` on the UI thread with the main window, and waits for the +;; Task it makes. `none` is the answer when there is no window. +(: (-bjo-> (-> Window (Task %a)) %a %a)) +(defbjo (run-on-ui start none) + (def/mutable task (: (clr-default) Task)) + (def op (on-ui ui-dispatcher + (fun () + (set! task (cast Task (cast Object (match (owner) + ((Some w) (start w)) + (None (answered none)))))) + unit))) + (await-tasks #[(op-task (cast DispatcherOpBase (cast Object op)))]) + (await-tasks #[task]) + (cast %a (value-of (property-of (type-of (cast Object task)) "Result") (cast Object task)))) + +;; The event of what the Task that `start` makes answers, at each sync. +;; `none` is the answer when there is no window, or the Task fails. +(: (-> (-> Window (Task %a)) %a (Event %a))) +(defun (ask start none) + (guard (fun () + (wrap (promise-join (bjo (run-on-ui start none))) + (fun (r) (match r + ((Ok x) x) + ((Err _) none))))))) + +;; None for null. +(: (-> Object (Option Object))) +(defun (non-null o) (if (null? o) None (Some o))) + +;; --------------------------------------------------------------------------- +;; Message boxes +;; --------------------------------------------------------------------------- + +(: (-> AvaloniaObject AvaloniaProperty Object void)) +(defun (put! o property value) + (ignore (set-value o property value Priority.LocalValue))) + +(: (-> Control (-> void) void)) +(defun (on-click! button f) + (add-handler (cast Interactive button) (cast RoutedEvent click-event) + (cast Delegate (cast Object (: (as-delegate (: (fun (s e) (f)) (-> Object RoutedEventArgs void))) + (EventHandler RoutedEventArgs)))) + Routes.Bubble #f)) + +;; A button of a dialog: its label, what the dialog answers when it is +;; clicked, from its text input, and whether Enter or Escape clicks it. +(type (: Choice (Record (: label string) (: answer (-> TextBox Object)) (: enter bool) (: escape bool)))) + +;; Shows a dialog with `text`, a text input holding `value` if there is one, +;; and the buttons of `choices`, and answers the Task of what it closes with. +(: (-> string string (Option string) (List Choice) Window (Task Object))) +(defun (show-box! title text value choices owner) + (def w (Window.)) + (def o (cast AvaloniaObject w)) + (put! o (cast AvaloniaProperty title-property) (cast Object (clr-string title))) + (put! o (cast AvaloniaProperty size-to-content-property) (cast Object SizeToContent.WidthAndHeight)) + (put! o (cast AvaloniaProperty startup-location-property) (cast Object StartupLocation.CenterOwner)) + (put! o (cast AvaloniaProperty can-resize-property) (cast Object #f)) + (put! o (cast AvaloniaProperty show-in-taskbar-property) (cast Object #f)) + + (def panel (StackPanel.)) + (put! (cast AvaloniaObject panel) (cast AvaloniaProperty margin-property) (cast Object (Thickness. 20.0))) + (put! (cast AvaloniaObject panel) (cast AvaloniaProperty spacing-property) (cast Object 14.0)) + (put! (cast AvaloniaObject panel) (cast AvaloniaProperty min-width-property) (cast Object 280.0)) + + (def label (TextBlock.)) + (put! (cast AvaloniaObject label) (cast AvaloniaProperty text-property) (cast Object (clr-string text))) + (put! (cast AvaloniaObject label) (cast AvaloniaProperty wrapping-property) (cast Object TextWrapping.Wrap)) + (put! (cast AvaloniaObject label) (cast AvaloniaProperty max-width-property) (cast Object 400.0)) + (.Add (children (cast Panel panel)) (cast Control label)) + + (def input (TextBox.)) + (match value + ((Some v) + (put! (cast AvaloniaObject input) (cast AvaloniaProperty box-text-property) (cast Object (clr-string v))) + (.Add (children (cast Panel panel)) (cast Control input))) + (None unit)) + + (def buttons (StackPanel.)) + (put! (cast AvaloniaObject buttons) (cast AvaloniaProperty orientation-property) (cast Object Orientation.Horizontal)) + (put! (cast AvaloniaObject buttons) (cast AvaloniaProperty spacing-property) (cast Object 8.0)) + (put! (cast AvaloniaObject buttons) (cast AvaloniaProperty halign-property) (cast Object HAlignment.Right)) + (loop (:for c choices) + (:do (def b (Button.)) + (put! (cast AvaloniaObject b) (cast AvaloniaProperty content-property) (cast Object (clr-string (.label c)))) + (put! (cast AvaloniaObject b) (cast AvaloniaProperty is-default-property) (cast Object (.enter c))) + (put! (cast AvaloniaObject b) (cast AvaloniaProperty is-cancel-property) (cast Object (.escape c))) + (on-click! (cast Control b) (fun () (close-with! w ((.answer c) input)))) + (.Add (children (cast Panel buttons)) (cast Control b)))) + (.Add (children (cast Panel panel)) (cast Control buttons)) + (put! o (cast AvaloniaProperty content-property) (cast Object panel)) + (show-dialog w owner)) + +(: (-> string (-> TextBox Object) bool bool Choice)) +(defun (choice label answer enter escape) + (Choice (label label) (answer answer) (enter enter) (escape escape))) + +;; A message, and an OK button. Sends `msg` when it is closed. +(: alert (-> string %m (#:title string) (Event %m))) +(defun (alert text msg #:title "") + (wrap (ask (fun (w) (show-box! title text None + (list (choice "OK" (fun (i) (clr-default)) #t #t)) w)) + (clr-default)) + (fun (_) msg))) + +;; A question, with OK and Cancel. Sends `(on-answer #t)` for OK, and +;; `(on-answer #f)` for Cancel, Escape or a closed window. +(: confirm (-> string (-> bool %m) (#:title string) (#:ok string) (#:cancel string) (Event %m))) +(defun (confirm text on-answer #:title "" #:ok "OK" #:cancel "Cancel") + (wrap (ask (fun (w) (show-box! title text None + (list (choice cancel (fun (i) (cast Object #f)) #f #t) + (choice ok (fun (i) (cast Object #t)) #t #f)) + w)) + (clr-default)) + (fun (answer) + (on-answer (match (non-null answer) ((Some o) (.Equals o (cast Object #t))) (None #f)))))) + +;; A question with a text input holding `#:value`. Sends `(on-answer (Some +;; text))` for OK, and `(on-answer None)` for Cancel, Escape or a closed +;; window. +(: prompt (-> string (-> (Option string) %m) (#:value string) (#:title string) (Event %m))) +(defun (prompt text on-answer #:value "" #:title "") + (wrap (ask (fun (w) (show-box! title text (Some value) + (list (choice "Cancel" (fun (i) (clr-default)) #f #t) + (choice "OK" (fun (i) (cast Object (box-text i))) #t #f)) + w)) + (clr-default)) + (fun (answer) + (on-answer (match (non-null answer) ((Some o) (Some (.ToString o))) (None None)))))) + +;; --------------------------------------------------------------------------- +;; Files +;; --------------------------------------------------------------------------- + +;; The local paths of the items. A list of Avalonia's is walked as a Seq. +(: (-> (ReadOnlyList StorageItem) (List string))) +(defun (paths items) + (loop (:for item (cast (Seq StorageItem) (cast Object items))) + (:let p (local-path item)) + (:when (not (string-empty? p))) + (:acc out (listing p)) + => out)) + +(: (-> (List string) (Array ClrString))) +(defun (clr-strings xs) + (vec->array (list->vec (list-map (fun (s) (clr-string s)) xs)))) + +(: (-> (List (Tuple string (List string))) (ReadOnlyList FileType))) +(defun (file-types filters) + (def types + (list-map (fun (f) + (def t (FileType. (fst f))) + (patterns! t (cast (ReadOnlyList ClrString) (cast Object (clr-strings (snd f))))) + t) + filters)) + (cast (ReadOnlyList FileType) (cast Object (vec->array (list->vec types))))) + +(: (-> (ReadOnlyList StorageFile))) +(defun (no-files) + (cast (ReadOnlyList StorageFile) (cast Object (: (make-array 0) (Array StorageFile))))) + +(: (-> string (List (Tuple string (List string))) bool (Event (List string)))) +(defun (ask-files title filters many?) + (wrap (ask (fun (w) + (def options (OpenOptions.)) + (unless (string-empty? title) (title! (cast PickerOptions options) title)) + (allow-multiple! options many?) + (unless (list-empty? filters) (file-types! options (file-types filters))) + (pick-files (storage-provider (cast TopLevel w)) options)) + (no-files)) + (fun (files) (paths (cast (ReadOnlyList StorageItem) (cast Object files)))))) + +(: (-> (List string) (Option string))) +(defun (first-path ps) + (match ps ((List p rest ...) (Some p)) (_ None))) + +;; Asks for a file to open. Sends `(on-answer (Some path))`, or `(on-answer +;; None)` when the picker is cancelled. `#:filters` are the kinds of file it +;; shows, each a name and patterns: `(list (Tuple "Text" '("*.txt" "*.md")))`. +(: open-file (-> (-> (Option string) %m) (#:title string) + (#:filters (List (Tuple string (List string)))) (Event %m))) +(defun (open-file on-answer #:title "" #:filters '()) + (wrap (ask-files title filters #f) (fun (ps) (on-answer (first-path ps))))) + +;; Asks for files to open. Sends `(on-answer paths)`, empty when the picker +;; is cancelled. +(: open-files (-> (-> (List string) %m) (#:title string) + (#:filters (List (Tuple string (List string)))) (Event %m))) +(defun (open-files on-answer #:title "" #:filters '()) + (wrap (ask-files title filters #t) on-answer)) + +;; Asks where to save a file. Sends `(on-answer (Some path))`, or `(on-answer +;; None)` when the picker is cancelled. The file is not made. +(: save-file (-> (-> (Option string) %m) (#:title string) (#:name string) (Event %m))) +(defun (save-file on-answer #:title "" #:name "") + (wrap (ask (fun (w) + (def options (SaveOptions.)) + (unless (string-empty? title) (title! (cast PickerOptions options) title)) + (unless (string-empty? name) (suggested-name! options name)) + (pick-save (storage-provider (cast TopLevel w)) options)) + (: (clr-default) StorageFile)) + (fun (f) + (on-answer (if (null? (cast Object f)) + None + (match (local-path (cast StorageItem f)) + ("" None) + (p (Some p)))))))) + +;; Asks for a folder. Sends `(on-answer (Some path))`, or `(on-answer None)` +;; when the picker is cancelled. +(: open-folder (-> (-> (Option string) %m) (#:title string) (Event %m))) +(defun (open-folder on-answer #:title "") + (wrap (ask (fun (w) + (def options (FolderOptions.)) + (unless (string-empty? title) (title! (cast PickerOptions options) title)) + (pick-folders (storage-provider (cast TopLevel w)) options)) + (cast (ReadOnlyList StorageFolder) (cast Object (: (make-array 0) (Array StorageFolder))))) + (fun (folders) (on-answer (first-path (paths (cast (ReadOnlyList StorageItem) (cast Object folders)))))))) + +;; --------------------------------------------------------------------------- +;; Quitting +;; --------------------------------------------------------------------------- + +;; Closes the app's windows, and so ends `run-app`. Sends nothing. This is how +;; a program closes after it was asked with `#:on-close`. +(: quit (-> (Event %m))) +(defun (quit) + (guard (fun () + (ignore (ui-post ui-dispatcher + (fun () + (def app (cast Object current-app)) + (unless (null? app) + (match (try (cast Lifetime (app-lifetime (cast Application app))) + #:catch (System.InvalidCastException + System.NullReferenceException)) + ((Ok lifetime) (shutdown! lifetime 0)) + ((Err _) unit))) + unit))) + (never)))) diff --git a/tests/dialogs.bjo b/tests/dialogs.bjo new file mode 100644 index 0000000..951a452 --- /dev/null +++ b/tests/dialogs.bjo @@ -0,0 +1,54 @@ +;; 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/dialogs.bjo — dialogs and pickers with no window. +;; +;; bjo run tests/dialogs.bjo +;; +;; A dialog needs a window to belong to, and an app started with `start-app` +;; has none. So each answers as if it was cancelled, and that is what this +;; checks: that the command goes to the UI thread and back, and its message +;; comes. A dialog on a screen is looked at by a person. + +(import (std prelude)) +(import (std simpletest)) +(import (bjogui view)) +(import (bjogui app)) +(import (bjogui dialogs)) + +(import/extern + (sleep-ms (: System.Threading.Thread.Sleep (-> int void) #:blocking))) + +(type (: Msg (Union Ask (: Answer string)))) + +(: (-> Msg (List string) (Tuple (List string) (List (Event Msg))))) +(defun (gui-update msg answers) + (match msg + (Ask (next answers + (alert "Saved." (Answer "alert")) + (confirm "Delete?" (fun (b) (Answer #"confirm ${b}"))) + (prompt "Name?" (fun (s) (Answer #"prompt ${(option-ref-or s "none")}")) #:value "Ada") + (open-file (fun (p) (Answer #"open-file ${(option-ref-or p "none")}"))) + (open-files (fun (ps) (Answer #"open-files ${(length ps)}"))) + (save-file (fun (p) (Answer #"save-file ${(option-ref-or p "none")}")) #:name "a.txt") + (open-folder (fun (p) (Answer #"open-folder ${(option-ref-or p "none")}"))) + (quit))) + ((Answer s) (next (cons s answers))))) + +(defun (main) + (def app (start-app '() gui-update (fun (m) (text "")) (fun (c) unit))) + (app-dispatch! app Ask) + (let go ((tries 0)) + (app-run-pending! app) + (when (and (< (length (app-model app)) 7) (< tries 300)) + (sleep-ms 10) + (go (+ tries 1)))) + (def answers (list-sort (app-model app))) + (expect "every dialog answered" (length answers) 7) + (expect "the answers with no window" + answers + (list-sort '("alert" "confirm #f" "prompt none" "open-file none" "open-files 0" + "save-file none" "open-folder none"))) + (app-stop! app) + (println "bjogui dialogs ok"))