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

Dialogs, file pickers, and closing by the program's leave

Browse source 
(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 <git@eca.dev>
This commit is contained in:
Linus Björnstam 2026-10-25 18:01:27 +01:00
parent be288ac03e
commit cfcb1851b7
3 changed files with 483 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

22
src/app.bjo
View file

@ -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)

408
src/dialogs.bjo Normal file
View file

@ -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))))

54
tests/dialogs.bjo Normal file
View file

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