Themes, classes and styles

run-app's #:theme gives "light", "dark" or the system's for a model, and is
set again when it changes. classed puts a view in classes, and #:styles
are rules of style: a kind and a class, and colours, a font size, a
padding and a radius. A button's rule may also give the colours while the
pointer is over it and while it is pressed; those are set on the presenter
in its template, as the Fluent theme sets its own.

Avalonia's Selectors.Class adds a class to a type-and-class selector it is
given rather than making a new one, so each style's selector is made anew.

🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-8)

Co-Authored-By: eca-agent <git@eca.dev>

src/app.bjo

@@ -25,8 +25,8 @@
 ;; `AvaloniaObject.SetValue`, so no Avalonia class is subclassed.
 
 (export
-  App Live Control Sub
+  App Live Control Sub StyleRule
-  run-app next
+  run-app next style
   ;; Subscriptions.
   every subscription
   ;; For tests and for hosts of their own: an app with no window.
@@ -100,6 +100,16 @@
   (DockPanel         (: Avalonia.Controls.DockPanel (-> DockPanel)))
   (DockEdge          (: Avalonia.Controls.Dock))
   (PropertyChange    (: Avalonia.AvaloniaPropertyChangedEventArgs))
+  (Classes           (: Avalonia.Controls.Classes))
+  (StyledElement     (: Avalonia.StyledElement))
+  (Selector          (: Avalonia.Styling.Selector))
+  (AvaloniaStyle     (: Avalonia.Styling.Style (-> AvaloniaStyle)))
+  (Setter            (: Avalonia.Styling.Setter (-> AvaloniaProperty Object Setter)))
+  (SetterBase        (: Avalonia.Styling.SetterBase))
+  ((IListOf %a)      (: System.Collections.Generic.IList))
+  (StyleBase         (: Avalonia.Styling.StyleBase))
+  (ThemeVariant      (: Avalonia.Styling.ThemeVariant))
+  (ClrType           (: System.Type))
   (CancelArgs        (: System.ComponentModel.CancelEventArgs))
   (ICollection       (: System.Collections.ICollection))
   (Timer             (: Avalonia.Threading.DispatcherTimer (-> Timer)))
@@ -210,6 +220,23 @@
   (auto-watermark-property (: Avalonia.Controls.AutoCompleteBox.WatermarkProperty #:get))
   (auto-text            (: Avalonia.Controls.AutoCompleteBox.Text (-> AutoCompleteBox string) #:get))
   (expanded?            (: Avalonia.Controls.Expander.IsExpanded (-> Expander bool) #:get))
+  (classes-of           (: Avalonia.StyledElement.Classes (-> StyledElement Classes) #:get))
+  (classes-clear!       (: Avalonia.Controls.Classes.Clear (-> Classes void)))
+  (classes-add!         (: Avalonia.Controls.Classes.Add (-> Classes string void)))
+  (of-type              (: Avalonia.Styling.Selectors.OfType (-> Selector ClrType Selector)))
+  (with-class           (: Avalonia.Styling.Selectors.Class (-> Selector string Selector)))
+  (in-template          (: Avalonia.Styling.Selectors.Template (-> Selector Selector)))
+  (named                (: Avalonia.Styling.Selectors.Name (-> Selector string Selector)))
+  (selector!            (: Avalonia.Styling.Style.Selector (-> AvaloniaStyle Selector void) #:set))
+  (setters-of           (: Avalonia.Styling.StyleBase.Setters (-> StyleBase (IListOf SetterBase)) #:get))
+  (type-named           (: System.Type.GetType (-> string ClrType)))
+  (theme-light          (: Avalonia.Styling.ThemeVariant.Light #:get))
+  (theme-dark           (: Avalonia.Styling.ThemeVariant.Dark #:get))
+  (theme-default        (: Avalonia.Styling.ThemeVariant.Default #:get))
+  (requested-theme!     (: Avalonia.Application.RequestedThemeVariant (-> Application ThemeVariant void) #:set))
+  (presenter-background (: Avalonia.Controls.Presenters.ContentPresenter.BackgroundProperty #:get))
+  (presenter-foreground (: Avalonia.Controls.Presenters.ContentPresenter.ForegroundProperty #:get))
+  (corner-property      (: Avalonia.Controls.Primitives.TemplatedControl.CornerRadiusProperty #:get))
   (changed-property     (: Avalonia.AvaloniaPropertyChangedEventArgs.Property
                            (-> PropertyChange AvaloniaProperty) #:get))
   (wrap-item-spacing    (: Avalonia.Controls.WrapPanel.ItemSpacingProperty #:get))
@@ -459,6 +486,7 @@
     ((PropTip _) (Some (cast AvaloniaProperty tip-property)))
     ((PropExpanded _) (when-kind (= kind ExpanderKind) (cast AvaloniaProperty expanded-property)))
     ((PropDockSide _) (Some (cast AvaloniaProperty dock-property)))
+    ((PropClasses _) None)
     ((PropDate _) (when-kind (= kind DateKind) (cast AvaloniaProperty date-property)))
     ;; Set by `set-prop!` itself.
     ((PropSource _) None)
@@ -544,6 +572,7 @@
     ((PropTip s) (text s))
     ((PropExpanded b) (cast Object b))
     ((PropDate s) (text s))
+    ((PropClasses _) (cast Object 0))
     ((PropDockSide i)
      (cast Object (match i (0 DockEdge.Left) (1 DockEdge.Top) (2 DockEdge.Right) (_ DockEdge.Bottom))))))
 
@@ -560,7 +589,7 @@
     ((PropRows _) 20) ((PropRow _) 21) ((PropColumn _) 22) ((PropRowSpan _) 23) ((PropColumnSpan _) 24)
     ((PropBackground _) 25) ((PropForeground _) 26) ((PropBorderColour _) 27) ((PropBorderWidth _) 28)
     ((PropRadius _) 29) ((PropShortcut _) 30) ((PropTip _) 31) ((PropExpanded _) 32) ((PropDate _) 33)
-    ((PropDockSide _) 34)))
+    ((PropDockSide _) 34) ((PropClasses _) 35)))
 
 (: (-> Control AvaloniaProperty Object void))
 (defun (put! control property value)
@@ -588,6 +617,10 @@
     ((Tuple WrapKind (PropSpacing d))
      (put! control (cast AvaloniaProperty wrap-item-spacing) (cast Object d))
      (put! control (cast AvaloniaProperty wrap-line-spacing) (cast Object d)))
+    ((Tuple _ (PropClasses names))
+     (def classes (classes-of (cast StyledElement control)))
+     (classes-clear! classes)
+     (loop (:for n names) (:do (classes-add! classes n))))
     ;; A number input's numbers are decimals.
     ((Tuple NumberKind (PropMinimum d))
      (put! control (cast AvaloniaProperty number-minimum-property) (cast Object (cast System.Decimal d))))
@@ -618,6 +651,7 @@
     ((Tuple WrapKind (PropSpacing _))
      (clear (cast AvaloniaProperty wrap-item-spacing))
      (clear (cast AvaloniaProperty wrap-line-spacing)))
+    ((Tuple _ (PropClasses _)) (classes-clear! (classes-of (cast StyledElement control))))
     (_
      (match (slot kind p)
        ((Some property) (clear property))
@@ -698,6 +732,8 @@
                  (: view (-> %model (View %m)))
                  (: subscriptions (-> %model (List (Sub %m))))
                  (: keys (-> %model (List (Key %m))))
+                 (: theme (-> %model string))
+                 (: shown-theme string #:mutable)
                  (: root (Option (Live %m)) #:mutable)
                  (: patching bool #:mutable)
                  (: stopped bool #:mutable)
@@ -809,6 +845,7 @@
 (: (-> (App %model %m) (List (Event %m)) void))
 (defun (step! app commands)
   (render! app)
+  (apply-theme! app)
   (in-scope (.home app)
     (loop (:for command commands)
           (:do (spawn/daemon (run-command app command)))))
@@ -857,6 +894,18 @@
         (:do (set! kept (cons (Tuple (sub-key sub) (start-sub! app sub)) kept))))
   (record-set! app (subs kept)))
 
+;; Sets the theme the model asks for, when it is another than the one shown.
+;; "light" and "dark" are those; anything else is the system's.
+(: (-> (App %model %m) void))
+(defun (apply-theme! app)
+  (def wanted ((.theme app) (.model app)))
+  (unless (= wanted (.shown-theme app))
+    (record-set! app (shown-theme wanted))
+    (def application (cast Object current-app))
+    (unless (eq? application (clr-default))
+      (requested-theme! (cast Application application)
+                        (match wanted ("light" theme-light) ("dark" theme-dark) (_ theme-default))))))
+
 (: (-> (App %model %m) void))
 (defun (render! app)
   (def next-view ((.view app) (.model app)))
@@ -1166,16 +1215,132 @@
 ;; Its fibers belong to the scope it is started in.
 (: (-> %model (-> %m %model (Tuple %model (List (Event %m)))) (-> %model (View %m))
        (-> Control void) (#:subscriptions (-> %model (List (Sub %m))))
-       (#:keys (-> %model (List (Key %m))))
+       (#:keys (-> %model (List (Key %m)))) (#:theme (-> %model string))
        (App %model %m)))
 (defun (start-app init gui-update view on-root #:subscriptions (fun (m) '())
-                  #:keys (fun (m) '()))
+                  #:keys (fun (m) '()) #:theme (fun (m) ""))
   (def app (App (model init) (gui-update gui-update) (view view)
-                (subscriptions subscriptions) (keys keys) (root None) (patching #f) (stopped #f)
+                (subscriptions subscriptions) (keys keys) (theme theme) (shown-theme "")
+                (root None) (patching #f) (stopped #f)
                 (home (current-scope)) (subs '()) (on-root on-root)))
   (step! app '())
   app)
 
+;; ---------------------------------------------------------------------------
+;; Styles
+;; ---------------------------------------------------------------------------
+
+;; A style: the look of every view of a kind, or of a kind and a class.
+(type (: StyleRule (Record (: kind string) (: class string) (: props (Vec Prop))
+                           (: hover (Vec Prop)) (: pressed (Vec Prop)))))
+
+(: (-> (Vec Prop) string (-> string Prop) (Vec Prop)))
+(defun (with-colour props c make)
+  (if (string-empty? c) props (vec-add props (make c))))
+
+;; The look of every view of `kind` in the class `#:class`, or of every view
+;; of `kind` if there is no class. `kind` is the name of the constructor:
+;; "button", "text", "text-input", "checkbox", "border" and so on.
+;;
+;; `#:hover-…` and `#:pressed-…` are the colours while the pointer is over a
+;; button and while it is pressed. They are set inside the button's template,
+;; as the Fluent theme sets its own, and so only a button has them.
+(: style (-> string (#:class string) (#:colour string) (#:background string)
+             (#:hover-colour string) (#:hover-background string)
+             (#:pressed-colour string) (#:pressed-background string)
+             (#:font-size double) (#:padding double) (#:radius double)
+             StyleRule))
+(defun (style kind #:class "" #:colour "" #:background "" #:hover-colour "" #:hover-background ""
+              #:pressed-colour "" #:pressed-background "" #:font-size 0.0 #:padding 0.0
+              #:radius 0.0)
+  (defun (size props make d) (if (> d 0.0) (vec-add props (make d)) props))
+  (StyleRule (kind kind) (class class)
+             (props (size (size (size (with-colour (with-colour [] colour PropForeground)
+                                                   background PropBackground)
+                                      PropFontSize font-size)
+                                PropPadding padding)
+                          PropRadius radius))
+             (hover (with-colour (with-colour [] hover-colour PropForeground)
+                                 hover-background PropBackground))
+             (pressed (with-colour (with-colour [] pressed-colour PropForeground)
+                                   pressed-background PropBackground))))
+
+;; The kind a constructor's name makes, and the Avalonia class of it.
+(: (-> string (Option (Tuple Kind string))))
+(defun (styled-kind name)
+  (match name
+    ("text" (Some (Tuple TextKind "Avalonia.Controls.TextBlock")))
+    ("button" (Some (Tuple ButtonKind "Avalonia.Controls.Button")))
+    ("text-input" (Some (Tuple TextInputKind "Avalonia.Controls.TextBox")))
+    ("text-area" (Some (Tuple TextAreaKind "Avalonia.Controls.TextBox")))
+    ("checkbox" (Some (Tuple CheckBoxKind "Avalonia.Controls.CheckBox")))
+    ("toggle-switch" (Some (Tuple ToggleSwitchKind "Avalonia.Controls.ToggleSwitch")))
+    ("radio" (Some (Tuple RadioKind "Avalonia.Controls.RadioButton")))
+    ("list-box" (Some (Tuple ListBoxKind "Avalonia.Controls.ListBox")))
+    ("dropdown" (Some (Tuple DropdownKind "Avalonia.Controls.ComboBox")))
+    ("border" (Some (Tuple BorderKind "Avalonia.Controls.Border")))
+    ("column" (Some (Tuple ColumnKind "Avalonia.Controls.StackPanel")))
+    ("row" (Some (Tuple RowKind "Avalonia.Controls.StackPanel")))
+    ("grid" (Some (Tuple GridKind "Avalonia.Controls.Grid")))
+    (_ None)))
+
+;; The setters are a List of Avalonia's, so they are reached as an IList.
+(: (-> AvaloniaStyle Setter void))
+(defun (add-setter! s setter)
+  (ignore (list-add! (cast IList (cast Object (setters-of (cast StyleBase s)))) (cast Object setter))))
+
+;; A setter for each prop that the kind takes.
+(: (-> AvaloniaStyle Kind (Vec Prop) void))
+(defun (add-setters! s kind props)
+  (loop (:for p props)
+        (:do (def property
+               (match (Tuple kind p)
+                 ((Tuple BorderKind (PropRadius _)) (Some (cast AvaloniaProperty corner-radius-property)))
+                 ((Tuple _ (PropRadius _))
+                  (if (templated? kind) (Some (cast AvaloniaProperty corner-property)) None))
+                 (_ (slot kind p))))
+             (match (Tuple property (boxed p))
+               ((Tuple (Some prop) (Some value))
+                (add-setter! s (Setter. prop value)))
+               (_ unit)))))
+
+;; The setters of a state of a button, on the presenter in its template.
+(: (-> AvaloniaStyle (Vec Prop) void))
+(defun (add-presenter-setters! s props)
+  (loop (:for p props)
+        (:do (match (Tuple p (boxed p))
+               ((Tuple (PropBackground _) (Some v))
+                (add-setter! s (Setter. (cast AvaloniaProperty presenter-background) v)))
+               ((Tuple (PropForeground _) (Some v))
+                (add-setter! s (Setter. (cast AvaloniaProperty presenter-foreground) v)))
+               (_ unit)))))
+
+;; The Avalonia styles of a rule: the look at rest, and for a button the look
+;; while the pointer is over it and while it is pressed. A kind that has no
+;; name here makes none.
+(: (-> StyleRule (List AvaloniaStyle)))
+(defun (avalonia-styles rule)
+  (match (styled-kind (.kind rule))
+    (None '())
+    ((Some (Tuple kind type-name))
+     ;; Made anew for each style, because Selectors.Class adds a class to a
+     ;; type-and-class selector it is given, and does not make a new one.
+     (defun (base)
+       (def t (of-type (clr-default) (type-named #"${type-name}, Avalonia.Controls")))
+       (if (string-empty? (.class rule)) t (with-class t (.class rule))))
+     (defun (make sel) (def s (AvaloniaStyle.)) (selector! s sel) s)
+     (def at-rest (make (base)))
+     (add-setters! at-rest kind (.props rule))
+     (defun (state pseudo props)
+       (def s (make (named (of-type (in-template (with-class (base) pseudo))
+                                    (type-named "Avalonia.Controls.Presenters.ContentPresenter, Avalonia.Controls"))
+                           "PART_ContentPresenter")))
+       (add-presenter-setters! s props)
+       s)
+     (if (and (= kind ButtonKind) (or (> (vec-length (.hover rule)) 0) (> (vec-length (.pressed rule)) 0)))
+         (list at-rest (state ":pointerover" (.hover rule)) (state ":pressed" (.pressed rule)))
+         (list at-rest)))))
+
 ;; Saves a picture of the window to `path` once it has been shown and laid
 ;; out, and closes it. Twice the pixels of the window, so that it is sharp on
 ;; a screen with a scale of 2.
@@ -1210,10 +1375,11 @@
 (: (-> %model (-> %m %model (Tuple %model (List (Event %m)))) (-> %model (View %m))
        (#:subscriptions (-> %model (List (Sub %m))))
        (#:keys (-> %model (List (Key %m)))) (#:on-close (Option %m))
+       (#:theme (-> %model string)) (#:styles (List StyleRule))
        (#: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
+                #:on-close None #:theme (fun (m) "") #:styles '()
                 #: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
@@ -1222,6 +1388,9 @@
   (ignore (setup-with-lifetime (use-platform-detect (configure (fun () (Application.))))
                                lifetime))
   (.Add (app-styles current-app) (FluentTheme. (clr-default)))
+  (loop (:for rule styles)
+        (:do (loop (:for s (avalonia-styles rule))
+                   (:do (.Add (app-styles current-app) s)))))
   (def w (Window.))
   (window-title! w title)
   (ignore (set-value (cast AvaloniaObject w) (cast AvaloniaProperty width-property)
@@ -1231,7 +1400,7 @@
   (with-cancel (cancel)
     (def app (start-app init gui-update view
                         (fun (c) (window-content! (cast ContentControl w) (cast Object c)))
-                        #:subscriptions subscriptions #:keys keys))
+                        #:subscriptions subscriptions #:keys keys #:theme theme))
     ;; 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

src/view.bjo

@@ -24,7 +24,7 @@
   toggle-switch radio number-input date-picker auto-complete expander
   column row grid scroll border flow dock
   ;; Wrappers.
-  keyed at paint with-context-menu tooltip at-top at-bottom at-left at-right
+  keyed at paint with-context-menu tooltip at-top at-bottom at-left at-right classed
 
   ;; Keyboard shortcuts.
   Key key key-gesture key-message
@@ -83,7 +83,8 @@
                      (: PropTip string)             ; shown when the pointer rests on a view
                      (: PropExpanded bool)          ; whether an expander shows its content
                      (: 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
 
 ;; An event, and the message it sends.
 (type (: (On %m) (Union (: OnClick %m)
@@ -143,6 +144,12 @@
 (defun (with-context-menu v #:rest items)
   (container ContextKind [] [v (container ContextMenuKind [] (array->vec items))]))
 
+;; The view, in the classes `names`, which the styles given to `run-app`
+;; match with `#:class`.
+(: classed (-> (View %m) #:rest string (View %m)))
+(defun (classed v #:rest names)
+  (record-set v (props (vec-add (.props v) (PropClasses (array->vec names))))))
+
 ;; The view, with `text` shown when the pointer rests on it.
 (: tooltip (-> (View %m) string (View %m)))
 (defun (tooltip v text)

tests/inputs.bjo

@@ -32,6 +32,8 @@
   (AutoCompleteBox  (: Avalonia.Controls.AutoCompleteBox))
   (Expander         (: Avalonia.Controls.Expander))
   (DockEdge         (: Avalonia.Controls.Dock))
+  (StyledElement    (: Avalonia.StyledElement))
+  (Classes          (: Avalonia.Controls.Classes))
   ((Nullable %a)    (: System.Nullable)))
 
 (import/extern
@@ -52,6 +54,7 @@
   (dock-of        (: Avalonia.Controls.DockPanel.GetDock (-> Control DockEdge)))
   (children       (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get))
   (count          (: Avalonia.Controls.Controls.Count (-> Controls int) #:get))
+  (classes-of     (: Avalonia.StyledElement.Classes (-> StyledElement Classes) #:get))
   (clr-string     (: System.Convert.ToString (-> string ClrString))))
 
 (type (: Msg (Union (: Switched bool) (: Picked string) (: Amount double) (: Dated string)
@@ -81,7 +84,8 @@
     (expander "More" (.open m) Opened (text "inside"))                         ; 5
     (tooltip (text "hover me") "a tip")                                        ; 6
     (flow #:spacing 4.0 (text "a") (text "b") (text "c"))                      ; 7
-    (dock (at-top (text "top")) (text "fill"))))                               ; 8
+    (dock (at-top (text "top")) (text "fill"))                                 ; 8
+    (if (.open m) (classed (text "c") "wide") (classed (text "c") "big" "red"))))  ; 9
 
 (defun (main)
   (def app (start-app (Model (on #f) (pick "tea") (amount 2.0) (date "2026-10-25")
@@ -127,4 +131,14 @@
   (expect "a flow's children" (count (children (cast Panel (ctl '(7))))) 3)
   (expect "a docked child" (written (dock-of (ctl '(8 0)))) "Top")
 
+  ;; --- classes ---------------------------------------------------------------------
+  ;; The expander was opened above, so the view has "wide" and not the others.
+  (def cls (classes-of (cast StyledElement (ctl '(9)))))
+  (defun (has-class? (: c Classes) (: name string)) (.Contains c name))
+  (expect "a class" (has-class? cls "wide") #t)
+  (expect "the classes of the last view are gone" (has-class? cls "big") #f)
+  (put! '(5) (cast AvaloniaProperty expanded-property) (cast Object #f))
+  (expect "and change with the model" (list (has-class? cls "big") (has-class? cls "red") (has-class? cls "wide"))
+          '(#t #t #f))
+
   (println "bjogui inputs ok"))