Tree views, a styles example, and the Readme for all of it
A tree node is a TreeViewItem: a header and items, patched by key as a list's items are. The chosen node is chosen by its key, once the nodes are there, and a click sends the key. SelectedItem is a direct property, which a clear does not reset, so no choice is set as null. The Readme now covers menus and keys, dialogs, styles and themes, and the new controls. docs/styles.png is examples/styles.bjo. 🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-8) Co-Authored-By: eca-agent <git@eca.dev>
This commit is contained in:
parent
e3c54c4348
commit
8941425f05
6 changed files with 321 additions and 10 deletions
106
Readme.org
106
Readme.org
|
|
@ -68,6 +68,16 @@ being changed, and they are dropped, so only the user's events are messages.
|
||||||
| ~(grid #:columns #:rows child ...)~ | ~Grid~ | nothing |
|
| ~(grid #:columns #:rows child ...)~ | ~Grid~ | nothing |
|
||||||
| ~(scroll child)~ | ~ScrollViewer~ | nothing |
|
| ~(scroll child)~ | ~ScrollViewer~ | nothing |
|
||||||
| ~(border child)~ | ~Border~ | nothing |
|
| ~(border child)~ | ~Border~ | nothing |
|
||||||
|
| ~(toggle-switch label on? on-toggle)~ | ~ToggleSwitch~ | ~(on-toggle on)~ |
|
||||||
|
| ~(radio label chosen? msg)~ | ~RadioButton~ | ~msg~ when it is chosen |
|
||||||
|
| ~(number-input value on-change)~ | ~NumericUpDown~ | ~(on-change value)~ |
|
||||||
|
| ~(date-picker "2026-10-25" on-change)~ | ~DatePicker~ | ~(on-change date)~ |
|
||||||
|
| ~(auto-complete value options on-input)~ | ~AutoCompleteBox~ | ~(on-input text)~ |
|
||||||
|
| ~(expander header expanded? on-toggle child)~ | ~Expander~ | ~(on-toggle expanded)~ |
|
||||||
|
| ~(tree-view chosen on-pick (tree-node key header ...) ...)~ | ~TreeView~ | ~(on-pick key)~ |
|
||||||
|
| ~(flow child ...)~ | ~WrapPanel~ | nothing |
|
||||||
|
| ~(dock child ...)~, with ~at-top~, ~at-left~ … | ~DockPanel~ | nothing |
|
||||||
|
| ~(menu-bar (submenu label (menu-item label msg) ...))~ | ~Menu~ | ~msg~ when an item is chosen |
|
||||||
|
|
||||||
They take keywords where they apply: ~#:size~ (the font size of a text),
|
They take keywords where they apply: ~#:size~ (the font size of a text),
|
||||||
~#:wrap~ (a text breaks its lines at its width), ~#:width~, ~#:height~,
|
~#:wrap~ (a text breaks its lines at its width), ~#:width~, ~#:height~,
|
||||||
|
|
@ -122,6 +132,53 @@ a line around a view, with round corners if ~#:radius~ is more than zero.
|
||||||
The Fluent theme gives a button its own colours when the pointer is over it
|
The Fluent theme gives a button its own colours when the pointer is over it
|
||||||
or it is pressed, so a painted button shows the theme's colour then.
|
or it is pressed, so a painted button shows the theme's colour then.
|
||||||
|
|
||||||
|
More wrappers: ~(tooltip view "text")~, ~(with-context-menu view item ...)~
|
||||||
|
for a menu on the right button, and ~(classed view "name" ...)~ for styles.
|
||||||
|
|
||||||
|
A tree node is known by its key, which must be its own in the tree. A node
|
||||||
|
is open at first when it says ~#:expanded~; after that the user opens and
|
||||||
|
closes it.
|
||||||
|
|
||||||
|
* Styles and themes
|
||||||
|
|
||||||
|
[[file:docs/styles.png]]
|
||||||
|
|
||||||
|
~run-app~'s ~#:theme~ gives ~"light"~, ~"dark"~, or anything else for the
|
||||||
|
system's, for a model, so a setting can switch it. ~#:styles~ is a list of
|
||||||
|
rules made by ~style~: a kind, by the name of its constructor, a class
|
||||||
|
given with ~classed~, and the look.
|
||||||
|
|
||||||
|
#+BEGIN_SRC scheme
|
||||||
|
(run-app init gui-update view
|
||||||
|
#:theme (fun (m) (if (.dark m) "dark" "light"))
|
||||||
|
#:styles (list (style "text" #:class "title" #:font-size 22.0 #:colour "#f1c40f")
|
||||||
|
(style "button" #:class "primary" #:background "#27ae60" #:colour "white"
|
||||||
|
#:hover-background "#2ecc71" #:pressed-background "#1e8449")))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
A rule takes ~#:colour~, ~#:background~, ~#:font-size~, ~#:padding~ and
|
||||||
|
~#:radius~. A button's rule also takes ~#:hover-colour~, ~#:hover-background~,
|
||||||
|
~#:pressed-colour~ and ~#:pressed-background~, which are set inside its
|
||||||
|
template, as the Fluent theme sets its own; no other kind has them.
|
||||||
|
[[file:examples/styles.bjo][examples/styles.bjo]] is the picture above.
|
||||||
|
|
||||||
|
* Menus and keys
|
||||||
|
|
||||||
|
#+BEGIN_SRC scheme
|
||||||
|
(menu-bar
|
||||||
|
(submenu "File"
|
||||||
|
(menu-item "New" New #:shortcut "Ctrl+N")
|
||||||
|
(menu-separator)
|
||||||
|
(menu-item "Quit" Quit #:shortcut "Ctrl+Q")))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
A menu bar is a view, so it goes where the program puts it, usually at the
|
||||||
|
top of a ~dock~. A menu item's ~#:shortcut~ is shown beside it, and the keys
|
||||||
|
send its message while it is in the view and enabled. ~run-app~'s ~#:keys~
|
||||||
|
gives more, for a model: ~(fun (m) (list (key "F5" Refresh)))~. Keys are
|
||||||
|
the window's after the control that has the keyboard had its chance, so a
|
||||||
|
text input keeps ~Ctrl+C~.
|
||||||
|
|
||||||
* Work: commands and subscriptions
|
* Work: commands and subscriptions
|
||||||
|
|
||||||
~gui-update~ is a plain function, so it cannot wait, and the compiler says so
|
~gui-update~ is a plain function, so it cannot wait, and the compiler says so
|
||||||
|
|
@ -159,10 +216,42 @@ The fibers belong to the app. They post their messages to the UI thread, so
|
||||||
~gui-update~ and ~view~ always run there. When the window is closed they are
|
~gui-update~ and ~view~ always run there. When the window is closed they are
|
||||||
cancelled, and the program ends.
|
cancelled, and the program ends.
|
||||||
|
|
||||||
|
* Dialogs: (bjogui dialogs)
|
||||||
|
|
||||||
|
A dialog is a command, and its answer comes back as a message.
|
||||||
|
|
||||||
|
| Command | Sends |
|
||||||
|
|-------------------------------------------+-----------------------------------------------|
|
||||||
|
| ~(alert text msg)~ | ~msg~ when it is closed |
|
||||||
|
| ~(confirm text on-answer)~ | ~(on-answer #t)~ for OK, ~#f~ otherwise |
|
||||||
|
| ~(prompt text on-answer #:value)~ | ~(on-answer (Some text))~, or ~None~ |
|
||||||
|
| ~(open-file on-answer #:filters)~ | ~(on-answer (Some path))~, or ~None~ |
|
||||||
|
| ~(open-files on-answer)~ | ~(on-answer paths)~ |
|
||||||
|
| ~(save-file on-answer #:name)~ | ~(on-answer (Some path))~, or ~None~ |
|
||||||
|
| ~(open-folder on-answer)~ | ~(on-answer (Some path))~, or ~None~ |
|
||||||
|
| ~(quit)~ | nothing: it closes the windows |
|
||||||
|
|
||||||
|
#+BEGIN_SRC scheme
|
||||||
|
(Delete (next m (confirm "Delete it?" Deleted?)))
|
||||||
|
((Deleted? #t) (next (remove m)))
|
||||||
|
((Deleted? #f) (next m))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
~#:filters~ are kinds of file, each a name and patterns: ~(list (Tuple "Text"
|
||||||
|
'("*.txt" "*.md")))~. ~run-app~'s ~#:on-close msg~ makes the close button
|
||||||
|
send ~msg~ instead of closing, and the program closes with ~(quit)~ when it
|
||||||
|
is ready, say after asking about unsaved work.
|
||||||
|
|
||||||
|
A dialog belongs to the main window. With none, as under ~start-app~, each
|
||||||
|
answers as if it was cancelled. Avalonia's dialogs cannot be cancelled, so a
|
||||||
|
command that is cancelled stops waiting, and the dialog stays until it is
|
||||||
|
answered.
|
||||||
|
|
||||||
* Running: (bjogui app)
|
* Running: (bjogui app)
|
||||||
|
|
||||||
- ~(run-app init gui-update view #:subscriptions #:title #:width #:height)~
|
- ~(run-app init gui-update view #:subscriptions #:keys #:theme #:styles
|
||||||
opens a window and runs until it is closed.
|
#:on-close #:title #:width #:height)~ opens a window and runs until it is
|
||||||
|
closed.
|
||||||
- ~#:screenshot path~ makes ~run-app~ save a PNG of the window once it is
|
- ~#:screenshot path~ makes ~run-app~ save a PNG of the window once it is
|
||||||
shown, at twice its size, and close it. It is the environment variable
|
shown, at twice its size, and close it. It is the environment variable
|
||||||
~BJOGUI_SCREENSHOT~ unless the program says otherwise, so any program can
|
~BJOGUI_SCREENSHOT~ unless the program says otherwise, so any program can
|
||||||
|
|
@ -176,6 +265,7 @@ cancelled, and the program ends.
|
||||||
- ~app-run-pending!~ runs what fibers have posted, where no loop of
|
- ~app-run-pending!~ runs what fibers have posted, where no loop of
|
||||||
Avalonia's does.
|
Avalonia's does.
|
||||||
- ~app-stop!~ cancels the subscriptions and drops later messages.
|
- ~app-stop!~ cancels the subscriptions and drops later messages.
|
||||||
|
- ~app-press!~ presses keys, such as ~"Ctrl+S"~, as the window does.
|
||||||
- ~app-model~ reads the model, and ~app-control-at~ finds a control by its
|
- ~app-model~ reads the model, and ~app-control-at~ finds a control by its
|
||||||
path of child indices.
|
path of child indices.
|
||||||
|
|
||||||
|
|
@ -196,15 +286,21 @@ bjo run tests/app.bjo # prints "bjogui ok"
|
||||||
bjo run tests/effects.bjo # prints "bjogui effects ok"
|
bjo run tests/effects.bjo # prints "bjogui effects ok"
|
||||||
bjo run tests/controls.bjo # prints "bjogui controls ok"
|
bjo run tests/controls.bjo # prints "bjogui controls ok"
|
||||||
bjo run tests/lists.bjo # prints "bjogui lists ok"
|
bjo run tests/lists.bjo # prints "bjogui lists ok"
|
||||||
|
bjo run tests/inputs.bjo # prints "bjogui inputs ok"
|
||||||
|
bjo run tests/menus.bjo # prints "bjogui menus ok"
|
||||||
|
bjo run tests/dialogs.bjo # prints "bjogui dialogs ok"
|
||||||
|
bjo run tests/tree.bjo # prints "bjogui tree ok"
|
||||||
bjo run examples/counter.bjo
|
bjo run examples/counter.bjo
|
||||||
bjo run examples/stopwatch.bjo
|
bjo run examples/stopwatch.bjo
|
||||||
bjo run examples/todo.bjo
|
bjo run examples/todo.bjo
|
||||||
|
bjo run examples/styles.bjo
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
* Not yet
|
* Not yet
|
||||||
|
|
||||||
- Menus and dialogs.
|
- A data grid, and lists that make controls only for the items on screen.
|
||||||
- Styles of one's own, with classes, and colours for the pointer-over and
|
- Dialogs of one's own, with a view and a state.
|
||||||
pressed states.
|
- The macOS menu bar.
|
||||||
|
- Pointer-over and pressed colours for kinds other than buttons.
|
||||||
- A moved control is taken out of the panel and put back, so it may lose the
|
- A moved control is taken out of the panel and put back, so it may lose the
|
||||||
keyboard focus.
|
keyboard focus.
|
||||||
|
|
|
||||||
BIN
docs/styles.png
Normal file
BIN
docs/styles.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 33 KiB |
38
examples/styles.bjo
Normal file
38
examples/styles.bjo
Normal file
|
|
@ -0,0 +1,38 @@
|
||||||
|
;; 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/examples/styles.bjo — styles, classes and the dark theme.
|
||||||
|
;;
|
||||||
|
;; bjo run examples/styles.bjo
|
||||||
|
;;
|
||||||
|
;; The picture in the Readme is this program, taken with
|
||||||
|
;;
|
||||||
|
;; BJOGUI_SCREENSHOT=docs/styles.png bjo run examples/styles.bjo
|
||||||
|
(import (std prelude))
|
||||||
|
(import (bjogui view))
|
||||||
|
(import (bjogui app))
|
||||||
|
|
||||||
|
(type (: Msg (Union Nothing)))
|
||||||
|
|
||||||
|
(defun (main)
|
||||||
|
(run-app 0 (fun (msg n) (next n))
|
||||||
|
(fun (n)
|
||||||
|
(column #:spacing 12.0 #:margin 20.0
|
||||||
|
(classed (text "Styled with classes") "title")
|
||||||
|
(row #:spacing 8.0
|
||||||
|
(classed (button "Save" Nothing) "primary")
|
||||||
|
(classed (button "Delete" Nothing) "danger")
|
||||||
|
(button "Plain" Nothing))
|
||||||
|
(classed (border (text "a card") #:padding 10.0) "card")
|
||||||
|
(toggle-switch "Dark mode" #t (fun (b) Nothing))
|
||||||
|
(number-input 3.0 (fun (d) Nothing) #:width 160.0)
|
||||||
|
(date-picker "2026-10-25" (fun (d) Nothing))))
|
||||||
|
#:theme (fun (n) "dark")
|
||||||
|
#:styles (list (style "text" #:class "title" #:font-size 22.0 #:colour "#f1c40f")
|
||||||
|
(style "button" #:class "primary" #:background "#27ae60" #:colour "white"
|
||||||
|
#:hover-background "#2ecc71" #:pressed-background "#1e8449")
|
||||||
|
(style "button" #:class "danger" #:background "#c0392b" #:colour "white"
|
||||||
|
#:hover-background "#e74c3c" #:radius 12.0)
|
||||||
|
(style "border" #:class "card" #:background "#34495e" #:radius 8.0))
|
||||||
|
#:title "styles" #:width 360.0 #:height 330.0))
|
||||||
72
src/app.bjo
72
src/app.bjo
|
|
@ -99,6 +99,8 @@
|
||||||
(WrapPanel (: Avalonia.Controls.WrapPanel (-> WrapPanel)))
|
(WrapPanel (: Avalonia.Controls.WrapPanel (-> WrapPanel)))
|
||||||
(DockPanel (: Avalonia.Controls.DockPanel (-> DockPanel)))
|
(DockPanel (: Avalonia.Controls.DockPanel (-> DockPanel)))
|
||||||
(DockEdge (: Avalonia.Controls.Dock))
|
(DockEdge (: Avalonia.Controls.Dock))
|
||||||
|
(TreeView (: Avalonia.Controls.TreeView (-> TreeView)))
|
||||||
|
(TreeViewItem (: Avalonia.Controls.TreeViewItem (-> TreeViewItem)))
|
||||||
(PropertyChange (: Avalonia.AvaloniaPropertyChangedEventArgs))
|
(PropertyChange (: Avalonia.AvaloniaPropertyChangedEventArgs))
|
||||||
(Classes (: Avalonia.Controls.Classes))
|
(Classes (: Avalonia.Controls.Classes))
|
||||||
(StyledElement (: Avalonia.StyledElement))
|
(StyledElement (: Avalonia.StyledElement))
|
||||||
|
|
@ -220,6 +222,10 @@
|
||||||
(auto-watermark-property (: Avalonia.Controls.AutoCompleteBox.WatermarkProperty #:get))
|
(auto-watermark-property (: Avalonia.Controls.AutoCompleteBox.WatermarkProperty #:get))
|
||||||
(auto-text (: Avalonia.Controls.AutoCompleteBox.Text (-> AutoCompleteBox string) #:get))
|
(auto-text (: Avalonia.Controls.AutoCompleteBox.Text (-> AutoCompleteBox string) #:get))
|
||||||
(expanded? (: Avalonia.Controls.Expander.IsExpanded (-> Expander bool) #:get))
|
(expanded? (: Avalonia.Controls.Expander.IsExpanded (-> Expander bool) #:get))
|
||||||
|
(tree-header-property (: Avalonia.Controls.Primitives.HeaderedItemsControl.HeaderProperty #:get))
|
||||||
|
(tree-expanded-property (: Avalonia.Controls.TreeViewItem.IsExpandedProperty #:get))
|
||||||
|
(tree-selected-property (: Avalonia.Controls.TreeView.SelectedItemProperty #:get))
|
||||||
|
(tree-selected (: Avalonia.Controls.TreeView.SelectedItem (-> TreeView Object) #:get))
|
||||||
(classes-of (: Avalonia.StyledElement.Classes (-> StyledElement Classes) #:get))
|
(classes-of (: Avalonia.StyledElement.Classes (-> StyledElement Classes) #:get))
|
||||||
(classes-clear! (: Avalonia.Controls.Classes.Clear (-> Classes void)))
|
(classes-clear! (: Avalonia.Controls.Classes.Clear (-> Classes void)))
|
||||||
(classes-add! (: Avalonia.Controls.Classes.Add (-> Classes string void)))
|
(classes-add! (: Avalonia.Controls.Classes.Add (-> Classes string void)))
|
||||||
|
|
@ -378,6 +384,8 @@
|
||||||
(MenuBarKind #t)
|
(MenuBarKind #t)
|
||||||
(MenuItemKind #t)
|
(MenuItemKind #t)
|
||||||
(ContextMenuKind #t)
|
(ContextMenuKind #t)
|
||||||
|
(TreeKind #t)
|
||||||
|
(TreeNodeKind #t)
|
||||||
(_ #f)))
|
(_ #f)))
|
||||||
|
|
||||||
;; A kind whose children each have a place of their own: the content of a
|
;; A kind whose children each have a place of their own: the content of a
|
||||||
|
|
@ -430,6 +438,7 @@
|
||||||
(ToggleSwitchKind (Some (cast AvaloniaProperty content-property)))
|
(ToggleSwitchKind (Some (cast AvaloniaProperty content-property)))
|
||||||
(RadioKind (Some (cast AvaloniaProperty content-property)))
|
(RadioKind (Some (cast AvaloniaProperty content-property)))
|
||||||
(ExpanderKind (Some (cast AvaloniaProperty header-property)))
|
(ExpanderKind (Some (cast AvaloniaProperty header-property)))
|
||||||
|
(TreeNodeKind (Some (cast AvaloniaProperty tree-header-property)))
|
||||||
(TabKind (Some (cast AvaloniaProperty header-property)))
|
(TabKind (Some (cast AvaloniaProperty header-property)))
|
||||||
(MenuItemKind (Some (cast AvaloniaProperty menu-header-property)))
|
(MenuItemKind (Some (cast AvaloniaProperty menu-header-property)))
|
||||||
(_ None)))
|
(_ None)))
|
||||||
|
|
@ -484,7 +493,12 @@
|
||||||
((PropRadius _) (when-kind (= kind BorderKind) (cast AvaloniaProperty corner-radius-property)))
|
((PropRadius _) (when-kind (= kind BorderKind) (cast AvaloniaProperty corner-radius-property)))
|
||||||
((PropShortcut _) (when-kind (= kind MenuItemKind) (cast AvaloniaProperty input-gesture-property)))
|
((PropShortcut _) (when-kind (= kind MenuItemKind) (cast AvaloniaProperty input-gesture-property)))
|
||||||
((PropTip _) (Some (cast AvaloniaProperty tip-property)))
|
((PropTip _) (Some (cast AvaloniaProperty tip-property)))
|
||||||
((PropExpanded _) (when-kind (= kind ExpanderKind) (cast AvaloniaProperty expanded-property)))
|
((PropExpanded _)
|
||||||
|
(cond ((= kind ExpanderKind) (Some (cast AvaloniaProperty expanded-property)))
|
||||||
|
((= kind TreeNodeKind) (Some (cast AvaloniaProperty tree-expanded-property)))
|
||||||
|
(else None)))
|
||||||
|
;; Set after the children, by `sync-tree-choice!`.
|
||||||
|
((PropChosenKey _) None)
|
||||||
((PropDockSide _) (Some (cast AvaloniaProperty dock-property)))
|
((PropDockSide _) (Some (cast AvaloniaProperty dock-property)))
|
||||||
((PropClasses _) None)
|
((PropClasses _) None)
|
||||||
((PropDate _) (when-kind (= kind DateKind) (cast AvaloniaProperty date-property)))
|
((PropDate _) (when-kind (= kind DateKind) (cast AvaloniaProperty date-property)))
|
||||||
|
|
@ -573,6 +587,7 @@
|
||||||
((PropExpanded b) (cast Object b))
|
((PropExpanded b) (cast Object b))
|
||||||
((PropDate s) (text s))
|
((PropDate s) (text s))
|
||||||
((PropClasses _) (cast Object 0))
|
((PropClasses _) (cast Object 0))
|
||||||
|
((PropChosenKey s) (text s))
|
||||||
((PropDockSide i)
|
((PropDockSide i)
|
||||||
(cast Object (match i (0 DockEdge.Left) (1 DockEdge.Top) (2 DockEdge.Right) (_ DockEdge.Bottom))))))
|
(cast Object (match i (0 DockEdge.Left) (1 DockEdge.Top) (2 DockEdge.Right) (_ DockEdge.Bottom))))))
|
||||||
|
|
||||||
|
|
@ -589,7 +604,7 @@
|
||||||
((PropRows _) 20) ((PropRow _) 21) ((PropColumn _) 22) ((PropRowSpan _) 23) ((PropColumnSpan _) 24)
|
((PropRows _) 20) ((PropRow _) 21) ((PropColumn _) 22) ((PropRowSpan _) 23) ((PropColumnSpan _) 24)
|
||||||
((PropBackground _) 25) ((PropForeground _) 26) ((PropBorderColour _) 27) ((PropBorderWidth _) 28)
|
((PropBackground _) 25) ((PropForeground _) 26) ((PropBorderColour _) 27) ((PropBorderWidth _) 28)
|
||||||
((PropRadius _) 29) ((PropShortcut _) 30) ((PropTip _) 31) ((PropExpanded _) 32) ((PropDate _) 33)
|
((PropRadius _) 29) ((PropShortcut _) 30) ((PropTip _) 31) ((PropExpanded _) 32) ((PropDate _) 33)
|
||||||
((PropDockSide _) 34) ((PropClasses _) 35)))
|
((PropDockSide _) 34) ((PropClasses _) 35) ((PropChosenKey _) 36)))
|
||||||
|
|
||||||
(: (-> Control AvaloniaProperty Object void))
|
(: (-> Control AvaloniaProperty Object void))
|
||||||
(defun (put! control property value)
|
(defun (put! control property value)
|
||||||
|
|
@ -1009,6 +1024,13 @@
|
||||||
(fun ()
|
(fun ()
|
||||||
(def d (range-value (cast RangeBase control)))
|
(def d (range-value (cast RangeBase control)))
|
||||||
(fun (on) (match on ((OnSlide f) (Some (f d))) (_ None))))))
|
(fun (on) (match on ((OnSlide f) (Some (f d))) (_ None))))))
|
||||||
|
(TreeKind
|
||||||
|
(on-event (cast RoutedEvent selection-changed-event)
|
||||||
|
(fun ()
|
||||||
|
(def key (match (tree-node-key live (tree-selected (cast TreeView control)))
|
||||||
|
((Some k) k)
|
||||||
|
(None "")))
|
||||||
|
(fun (on) (match on ((OnPick f) (Some (f key))) (_ None))))))
|
||||||
((or DropdownKind ListBoxKind TabsKind)
|
((or DropdownKind ListBoxKind TabsKind)
|
||||||
(on-event (cast RoutedEvent selection-changed-event)
|
(on-event (cast RoutedEvent selection-changed-event)
|
||||||
(fun ()
|
(fun ()
|
||||||
|
|
@ -1060,6 +1082,8 @@
|
||||||
(SeparatorKind (cast Control (Separator.)))
|
(SeparatorKind (cast Control (Separator.)))
|
||||||
(ContextKind (cast Control (Border.)))
|
(ContextKind (cast Control (Border.)))
|
||||||
(ContextMenuKind (cast Control (ContextMenu.)))
|
(ContextMenuKind (cast Control (ContextMenu.)))
|
||||||
|
(TreeKind (cast Control (TreeView.)))
|
||||||
|
(TreeNodeKind (cast Control (TreeViewItem.)))
|
||||||
(ToggleSwitchKind (cast Control (ToggleSwitch.)))
|
(ToggleSwitchKind (cast Control (ToggleSwitch.)))
|
||||||
(RadioKind (cast Control (RadioButton.)))
|
(RadioKind (cast Control (RadioButton.)))
|
||||||
(NumberKind (cast Control (NumericUpDown.)))
|
(NumberKind (cast Control (NumericUpDown.)))
|
||||||
|
|
@ -1119,6 +1143,7 @@
|
||||||
(mutablevec-add! (.children live) c)
|
(mutablevec-add! (.children live) c)
|
||||||
(adopt! kind control (- (mutablevec-length (.children live)) 1) (.control c))))
|
(adopt! kind control (- (mutablevec-length (.children live)) 1) (.control c))))
|
||||||
(sync-selection! control kind (view-props v))
|
(sync-selection! control kind (view-props v))
|
||||||
|
(sync-tree-choice! live)
|
||||||
live)
|
live)
|
||||||
|
|
||||||
;; Changes the controls of `live` to show `next`. Gives `live` itself, or new
|
;; Changes the controls of `live` to show `next`. Gives `live` itself, or new
|
||||||
|
|
@ -1136,8 +1161,51 @@
|
||||||
((or (panel? kind) (items? kind)) (patch-children! app live kind (view-children next)))
|
((or (panel? kind) (items? kind)) (patch-children! app live kind (view-children next)))
|
||||||
(else unit))
|
(else unit))
|
||||||
(sync-selection! (.control live) kind (view-props next))
|
(sync-selection! (.control live) kind (view-props next))
|
||||||
|
(sync-tree-choice! live)
|
||||||
live)))
|
live)))
|
||||||
|
|
||||||
|
;; The node of a tree whose control is `control`, among the live nodes below
|
||||||
|
;; `live`, and its key.
|
||||||
|
(: (-> (Live %m) Object (Option string)))
|
||||||
|
(defun (tree-node-key live control)
|
||||||
|
(: (-> (Live %m) (Option string)))
|
||||||
|
(defun (walk l)
|
||||||
|
(if (and (= (view-kind (.view l)) TreeNodeKind) (eq? (cast Object (.control l)) control))
|
||||||
|
(view-key (.view l))
|
||||||
|
(loop (:for c (mutablevec->vec (.children l)))
|
||||||
|
(:when-let (Some k) (walk c))
|
||||||
|
(:finish #t (Some k))
|
||||||
|
=> None)))
|
||||||
|
(walk live))
|
||||||
|
|
||||||
|
;; The control of the node with `key` below `live`.
|
||||||
|
(: (-> (Live %m) string (Option Control)))
|
||||||
|
(defun (tree-node-control live key)
|
||||||
|
(if (and (= (view-kind (.view live)) TreeNodeKind) (= (view-key (.view live)) (Some key)))
|
||||||
|
(Some (.control live))
|
||||||
|
(loop (:for c (mutablevec->vec (.children live)))
|
||||||
|
(:when-let (Some found) (tree-node-control c key))
|
||||||
|
(:finish #t (Some found))
|
||||||
|
=> None)))
|
||||||
|
|
||||||
|
;; Chooses the node of a tree whose key the view gives, once the nodes are
|
||||||
|
;; there, if it is not chosen already.
|
||||||
|
(: (-> (Live %m) void))
|
||||||
|
(defun (sync-tree-choice! live)
|
||||||
|
(when (= (view-kind (.view live)) TreeKind)
|
||||||
|
(def control (.control live))
|
||||||
|
(loop (:for p (view-props (.view live)))
|
||||||
|
(:do (match p
|
||||||
|
((PropChosenKey key)
|
||||||
|
(match (if (string-empty? key) None (tree-node-control live key))
|
||||||
|
((Some node)
|
||||||
|
(unless (eq? (tree-selected (cast TreeView control)) (cast Object node))
|
||||||
|
(put! control (cast AvaloniaProperty tree-selected-property) (cast Object node))))
|
||||||
|
;; Null and not a clear: SelectedItem is a direct property,
|
||||||
|
;; which a clear does not reset.
|
||||||
|
(None (put! control (cast AvaloniaProperty tree-selected-property) (clr-default)))))
|
||||||
|
(_ unit))))))
|
||||||
|
|
||||||
;; The children of a kind whose children each have a place of their own.
|
;; The children of a kind whose children each have a place of their own.
|
||||||
(: (-> (App %model %m) (Live %m) Kind (Vec (View %m)) void))
|
(: (-> (App %model %m) (Live %m) Kind (Vec (View %m)) void))
|
||||||
(defun (patch-single! app live kind views)
|
(defun (patch-single! app live kind views)
|
||||||
|
|
|
||||||
31
src/view.bjo
31
src/view.bjo
|
|
@ -22,6 +22,7 @@
|
||||||
list-box tabs tab
|
list-box tabs tab
|
||||||
menu-bar submenu menu-item menu-separator
|
menu-bar submenu menu-item menu-separator
|
||||||
toggle-switch radio number-input date-picker auto-complete expander
|
toggle-switch radio number-input date-picker auto-complete expander
|
||||||
|
tree-view tree-node
|
||||||
column row grid scroll border flow dock
|
column row grid scroll border flow dock
|
||||||
;; Wrappers.
|
;; Wrappers.
|
||||||
keyed at paint with-context-menu tooltip at-top at-bottom at-left at-right classed
|
keyed at paint with-context-menu tooltip at-top at-bottom at-left at-right classed
|
||||||
|
|
@ -44,7 +45,7 @@
|
||||||
ListBoxKind TabsKind TabKind
|
ListBoxKind TabsKind TabKind
|
||||||
MenuBarKind MenuItemKind SeparatorKind ContextKind ContextMenuKind
|
MenuBarKind MenuItemKind SeparatorKind ContextKind ContextMenuKind
|
||||||
ToggleSwitchKind RadioKind NumberKind DateKind AutoCompleteKind
|
ToggleSwitchKind RadioKind NumberKind DateKind AutoCompleteKind
|
||||||
ExpanderKind WrapKind DockKind
|
ExpanderKind WrapKind DockKind TreeKind TreeNodeKind
|
||||||
ColumnKind RowKind GridKind ScrollKind BorderKind)))
|
ColumnKind RowKind GridKind ScrollKind BorderKind)))
|
||||||
|
|
||||||
;; A property of a control. A kind takes only some of them; the app ignores
|
;; A property of a control. A kind takes only some of them; the app ignores
|
||||||
|
|
@ -84,14 +85,16 @@
|
||||||
(: PropExpanded bool) ; whether an expander shows its content
|
(: PropExpanded bool) ; whether an expander shows its content
|
||||||
(: PropDate string) ; a date picker's date, as "2026-10-25"
|
(: PropDate string) ; a date picker's date, as "2026-10-25"
|
||||||
(: PropDockSide int) ; where a view is in its dock: 0 to 3
|
(: PropDockSide int) ; where a view is in its dock: 0 to 3
|
||||||
(: PropClasses (Vec string))))) ; the classes that styles match
|
(: PropClasses (Vec string)) ; the classes that styles match
|
||||||
|
(: PropChosenKey string)))) ; the key of a tree's chosen node
|
||||||
|
|
||||||
;; An event, and the message it sends.
|
;; An event, and the message it sends.
|
||||||
(type (: (On %m) (Union (: OnClick %m)
|
(type (: (On %m) (Union (: OnClick %m)
|
||||||
(: OnInput (-> string %m))
|
(: OnInput (-> string %m))
|
||||||
(: OnToggle (-> bool %m))
|
(: OnToggle (-> bool %m))
|
||||||
(: OnSlide (-> double %m))
|
(: OnSlide (-> double %m))
|
||||||
(: OnSelect (-> int %m)))))
|
(: OnSelect (-> int %m))
|
||||||
|
(: OnPick (-> string %m)))))
|
||||||
|
|
||||||
;; One control and what is in it.
|
;; One control and what is in it.
|
||||||
;;
|
;;
|
||||||
|
|
@ -393,6 +396,28 @@
|
||||||
(children [child])
|
(children [child])
|
||||||
(key None)))
|
(key None)))
|
||||||
|
|
||||||
|
;; A tree of nodes made by `tree-node`, with the node whose key is `chosen`
|
||||||
|
;; chosen, or none for "". A click on a node sends `(on-pick key)`.
|
||||||
|
(: (-> string (-> string %m) (#:width double) (#:height double) (#:margin double)
|
||||||
|
#:rest (View %m) (View %m)))
|
||||||
|
(defun (tree-view chosen on-pick #:width 0.0 #:height 0.0 #:margin 0.0 #:rest nodes)
|
||||||
|
(View (kind TreeKind)
|
||||||
|
(props (with-layout [(PropChosenKey chosen)] width height margin 0.0))
|
||||||
|
(events [(OnPick on-pick)])
|
||||||
|
(children (array->vec nodes))
|
||||||
|
(key None)))
|
||||||
|
|
||||||
|
;; A node of a tree, known by `key`, which must be one of its own in the
|
||||||
|
;; tree. It opens to show `children`, more nodes, and is open at first when
|
||||||
|
;; `#:expanded`; after that it is opened and closed by the user.
|
||||||
|
(: (-> string string (#:expanded bool) #:rest (View %m) (View %m)))
|
||||||
|
(defun (tree-node key header #:expanded #f #:rest children)
|
||||||
|
(View (kind TreeNodeKind)
|
||||||
|
(props [(PropLabel header) (PropExpanded expanded)])
|
||||||
|
(events [])
|
||||||
|
(children (array->vec children))
|
||||||
|
(key (Some key))))
|
||||||
|
|
||||||
;; A checkbox that is `checked?`. A click sends `(on-toggle checked)`, with
|
;; A checkbox that is `checked?`. A click sends `(on-toggle checked)`, with
|
||||||
;; the new state.
|
;; the new state.
|
||||||
(: (-> string bool (-> bool %m) (#:enabled bool) (#:margin double) (View %m)))
|
(: (-> string bool (-> bool %m) (#:enabled bool) (#:margin double) (View %m)))
|
||||||
|
|
|
||||||
84
tests/tree.bjo
Normal file
84
tests/tree.bjo
Normal file
|
|
@ -0,0 +1,84 @@
|
||||||
|
;; 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/tree.bjo — tree views.
|
||||||
|
;;
|
||||||
|
;; bjo run tests/tree.bjo
|
||||||
|
;;
|
||||||
|
;; No window is opened.
|
||||||
|
|
||||||
|
(import (std prelude))
|
||||||
|
(import (std simpletest))
|
||||||
|
(import (std interop))
|
||||||
|
(import (bjogui view))
|
||||||
|
(import (bjogui app))
|
||||||
|
|
||||||
|
(import/class
|
||||||
|
(Object (: System.Object))
|
||||||
|
(Disposable (: System.IDisposable))
|
||||||
|
(AvaloniaObject (: Avalonia.AvaloniaObject))
|
||||||
|
(AvaloniaProperty (: Avalonia.AvaloniaProperty))
|
||||||
|
(Priority (: Avalonia.Data.BindingPriority))
|
||||||
|
(ItemsControl (: Avalonia.Controls.ItemsControl))
|
||||||
|
(TreeView (: Avalonia.Controls.TreeView))
|
||||||
|
(TreeViewItem (: Avalonia.Controls.TreeViewItem))
|
||||||
|
(Headered (: Avalonia.Controls.Primitives.HeaderedItemsControl)))
|
||||||
|
|
||||||
|
(import/extern
|
||||||
|
(set-value (: Avalonia.AvaloniaObject.SetValue
|
||||||
|
(-> AvaloniaObject AvaloniaProperty Object Priority Disposable)))
|
||||||
|
(selected-property (: Avalonia.Controls.TreeView.SelectedItemProperty #:get))
|
||||||
|
(selected (: Avalonia.Controls.TreeView.SelectedItem (-> TreeView Object) #:get))
|
||||||
|
(item-count (: Avalonia.Controls.ItemsControl.ItemCount (-> ItemsControl int) #:get))
|
||||||
|
(header (: Avalonia.Controls.Primitives.HeaderedItemsControl.Header (-> Headered Object) #:get))
|
||||||
|
(expanded? (: Avalonia.Controls.TreeViewItem.IsExpanded (-> TreeViewItem bool) #:get))
|
||||||
|
(same? (: System.Object.ReferenceEquals (-> Object Object bool))))
|
||||||
|
|
||||||
|
(type (: Msg (Union (: Chose string) Reverse)))
|
||||||
|
(type (: Model (Record (: chosen string) (: fruit (List string)))))
|
||||||
|
|
||||||
|
(: (-> Msg Model (Tuple Model (List (Event Msg)))))
|
||||||
|
(defun (gui-update msg m)
|
||||||
|
(next (match msg
|
||||||
|
((Chose k) (record-set m (chosen k)))
|
||||||
|
(Reverse (record-set m (fruit (list-reverse (.fruit m))))))))
|
||||||
|
|
||||||
|
(: (-> Model (View Msg)))
|
||||||
|
(defun (view m)
|
||||||
|
(tree-view (.chosen m) Chose
|
||||||
|
(apply tree-node "fruit" "Fruit" #:expanded #t
|
||||||
|
(vec->array (vec-map (fun (f) (tree-node f (string-upcase f))) (list->vec (.fruit m)))))
|
||||||
|
(tree-node "veg" "Vegetables"
|
||||||
|
(tree-node "kale" "KALE"))))
|
||||||
|
|
||||||
|
(defun (main)
|
||||||
|
(def app (start-app (Model (chosen "pear") (fruit '("apple" "pear")))
|
||||||
|
gui-update view (fun (c) unit)))
|
||||||
|
(defun (ctl path) (app-control-at app path))
|
||||||
|
(def tree (cast TreeView (ctl '())))
|
||||||
|
(defun (chosen-is? path) (same? (selected tree) (cast Object (ctl path))))
|
||||||
|
|
||||||
|
(expect "the top nodes" (item-count (cast ItemsControl tree)) 2)
|
||||||
|
(expect "a node's nodes" (item-count (cast ItemsControl (ctl '(0)))) 2)
|
||||||
|
(expect "a header" (.ToString (header (cast Headered (ctl '(0 1))))) "PEAR")
|
||||||
|
(expect "open at first" (expanded? (cast TreeViewItem (ctl '(0)))) #t)
|
||||||
|
(expect "closed at first" (expanded? (cast TreeViewItem (ctl '(1)))) #f)
|
||||||
|
(expect "the chosen node is chosen once the nodes are there" (chosen-is? '(0 1)) #t)
|
||||||
|
|
||||||
|
(ignore (set-value (cast AvaloniaObject tree) (cast AvaloniaProperty selected-property)
|
||||||
|
(cast Object (ctl '(1 0))) Priority.LocalValue))
|
||||||
|
(expect "a node chosen sends its key" (.chosen (app-model app)) "kale")
|
||||||
|
|
||||||
|
(app-dispatch! app (Chose "apple"))
|
||||||
|
(expect "the model chooses the node" (chosen-is? '(0 0)) #t)
|
||||||
|
|
||||||
|
(def apple (ctl '(0 0)))
|
||||||
|
(app-dispatch! app Reverse)
|
||||||
|
(expect "nodes moved by key keep their controls" (same? (cast Object (ctl '(0 1))) (cast Object apple)) #t)
|
||||||
|
(expect "and the choice" (chosen-is? '(0 1)) #t)
|
||||||
|
|
||||||
|
(app-dispatch! app (Chose ""))
|
||||||
|
(expect "no choice" (same? (selected tree) (clr-default)) #t)
|
||||||
|
|
||||||
|
(println "bjogui tree ok"))
|
||||||
Loading…
Add table
Add a link
Reference in a new issue