Parcourir la source

feat: m2 gtk-demo browser (demos/) with five ported demos

Add a small Modula-2 port of GTK's gtk4-demo, following its structure:
a browser window with a searchable sidebar of demos; activating a row
opens the demo in its own window.

- demos/GtkDemo.def/.mod: the demo registry (title, keywords, build fn)
- demos/DemoImpl.def/.mod: demos ported/simplified from gtk/demos/gtk-demo
    Links (links.c), List Box (listbox.c), Flow Box (flowbox.c),
    Expander (expander.c), CSS Basics (css_basics.c)
- demos/m2gtkdemo.mod: GtkApplication browser (sidebar + search + Run)
- Makefile: `make demos` target, `demos` added to all
- tests/test_demos.mod + runner wiring: registry/build/teardown test
- extra bindings: GtkLabel.set_wrap/wrap_mode/max_width_chars,
    GtkButton.set_child, GtkScrolledWindow.set_has_frame/
    propagate_natural_height, Gdk.gdk_rgba_parse/gdk_cairo_set_source_rgba
- .gitignore: ignore the vendored gtk/ source tree
- README: document the demo browser

Test suite: 41 passed. gir-verify: 0 unexpected.
Eric Streit il y a 2 jours
Parent
commit
61d3d29ae9
14 fichiers modifiés avec 898 ajouts et 12 suppressions
  1. 1 0
      .gitignore
  2. 20 2
      Makefile
  3. 31 2
      README.md
  4. 19 0
      demos/DemoImpl.def
  5. 356 0
      demos/DemoImpl.mod
  6. 26 0
      demos/GtkDemo.def
  7. 87 0
      demos/GtkDemo.mod
  8. 214 0
      demos/m2gtkdemo.mod
  9. 8 1
      src/Gdk.def
  10. 4 1
      src/GtkButton.def
  11. 11 1
      src/GtkLabel.def
  12. 7 1
      src/GtkScrolledWindow.def
  13. 14 4
      tests/run_tests.sh
  14. 100 0
      tests/test_demos.mod

+ 1 - 0
.gitignore

@@ -1,5 +1,6 @@
 build/
 gen/
+gtk/
 *.o
 *.s
 *.a

+ 20 - 2
Makefile

@@ -29,9 +29,9 @@ TESTS    += test_adw
 EXAMPLES += adw
 endif
 
-.PHONY: all tests examples check clean gir gir-check gir-verify
+.PHONY: all tests examples demos check clean gir gir-check gir-verify
 
-all: tests examples
+all: tests examples demos
 
 $(OBJDIR):
 	mkdir -p $(OBJDIR)
@@ -64,6 +64,24 @@ examples: $(BLD)/examples $(OBJS) $(addprefix $(BLD)/examples/,$(EXAMPLES))
 $(BLD)/examples/%: examples/%.mod $(OBJS) | $(BLD)/examples
 	$(GM2) $(INCLUDES) $(GM2FLAGS) $(GTKCFG) $< $(OBJS) -o $@ $(GTKLIBS)
 
+# --- m2 gtk-demo (demos/) -------------------------------------------------
+DEMO_DIR := demos
+
+$(BLD)/demos:
+	mkdir -p $(BLD)/demos
+
+$(OBJDIR)/DemoImpl.o: $(DEMO_DIR)/DemoImpl.mod $(DEMO_DIR)/DemoImpl.def | $(OBJDIR)
+	$(GM2) $(INCLUDES) -I$(DEMO_DIR) $(GM2FLAGS) -c $< -o $@
+
+$(OBJDIR)/GtkDemo.o: $(DEMO_DIR)/GtkDemo.mod $(DEMO_DIR)/GtkDemo.def | $(OBJDIR)
+	$(GM2) $(INCLUDES) -I$(DEMO_DIR) $(GM2FLAGS) -c $< -o $@
+
+demos: $(BLD)/demos $(OBJS) $(OBJDIR)/DemoImpl.o $(OBJDIR)/GtkDemo.o $(BLD)/demos/m2gtkdemo
+
+$(BLD)/demos/m2gtkdemo: $(DEMO_DIR)/m2gtkdemo.mod $(OBJS) $(OBJDIR)/DemoImpl.o $(OBJDIR)/GtkDemo.o | $(BLD)/demos
+	$(GM2) $(INCLUDES) -I$(DEMO_DIR) $(GM2FLAGS) $(GTKCFG) $< \
+	     $(OBJS) $(OBJDIR)/DemoImpl.o $(OBJDIR)/GtkDemo.o -o $@ $(GTKLIBS)
+
 check: tests
 	./tests/run_tests.sh
 

+ 31 - 2
README.md

@@ -22,7 +22,8 @@ Verified with `gm2` 16.0.1 (experimental), GTK 4.18.6 and libadwaita 1.7.6.
 - **Pure-Modula-2 helpers**: `GtkUtils` (string/number conversion,
   `Connect`, `SetAccel`, ownership and `GError` helpers) and
   `GtkClosures` (per-connection signal contexts with cleanup).
-- **40 tests** and **26 runnable examples**.
+- **41 tests**, **26 runnable examples**, and an **m2 gtk-demo**
+  browser (`demos/`) modelled on GTK's own `gtk4-demo`.
 - **Generator + verifier**: `tools/gir2def.py` turns a `.gir` file into
   `.def` files; `tools/gir_verify.py` checks every generated identifier
   against the installed library. Verified clean across 8602 identifiers.
@@ -42,7 +43,7 @@ export PATH=$HOME/bin/Modula2/Gm2/bin:$PATH
 ## Build and test
 
 ```sh
-make                 # build all tests and examples into build/
+make                 # build all tests, examples and the demo browser into build/
 ./tests/run_tests.sh # run the test suite
 ```
 
@@ -131,6 +132,33 @@ gm2 -fiso -Isrc -Ilib myprog.mod \
 | `clipboard` | copy/paste text through `GdkClipboard` |
 | `adw` | libadwaita preferences app (toolbar view, rows, toast, about) |
 
+## m2 gtk-demo (`demos/`)
+
+A small Modula-2 port of GTK's `gtk4-demo`, mirroring its structure: a
+browser window with a searchable sidebar of demos, where activating a
+row opens the demo in its own window.
+
+| File | Role |
+|---|---|
+| `demos/GtkDemo.def` / `.mod` | the demo registry (title, keywords, build function) |
+| `demos/DemoImpl.def` / `.mod` | the demo implementations |
+| `demos/m2gtkdemo.mod` | the browser application (`GtkApplication` + sidebar + search) |
+
+The demos are simplified ports of the C originals in
+`gtk/demos/gtk-demo`: **Links** (`links.c`, markup hyperlinks +
+`activate-link`), **List Box** (`listbox.c`), **Flow Box** (`flowbox.c`,
+colour swatches drawn with `gdk_rgba_parse` + `gdk_cairo_set_source_rgba`),
+**Expander** (`expander.c`) and **CSS Basics** (`css_basics.c`, live CSS
+editing through a `GtkCssProvider`). Each demo follows the `gtk-demo`
+convention — a build procedure that creates its window once, then toggles
+its visibility — so the registry in `GtkDemo` is just a table of
+`PROCEDURE (ADDRESS) : ADDRESS`.
+
+```sh
+make demos
+./build/demos/m2gtkdemo
+```
+
 ## Module reference
 
 ### Core runtime
@@ -281,6 +309,7 @@ m2-GTK4/
   lib/        helpers (GtkUtils, GtkClosures) + C shim (m2gtkshim.c)
   tests/      gm2 tests + run_tests.sh (+ a private GSettings schema)
   examples/   runnable GTK4 / libadwaita programs
+  demos/      the m2 gtk-demo browser (registry + demos + application)
   tools/      gir2def.py, gir_verify.py, run_gir_check.sh
   gen/        generator output (git-ignored)
   build/      generated binaries (git-ignored)

+ 19 - 0
demos/DemoImpl.def

@@ -0,0 +1,19 @@
+DEFINITION MODULE DemoImpl ;
+
+(*
+   m2-GTK4 - the demo implementations, in the gtk-demo style: each
+   Do* procedure creates (once) a window, toggles its visibility, and
+   returns it.  Ported/simplified from gtk/demos/gtk-demo.
+*)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+EXPORT UNQUALIFIED DoLinks, DoListBox, DoFlowBox, DoExpander, DoCss;
+
+PROCEDURE DoLinks (doWidget: ADDRESS) : ADDRESS;
+PROCEDURE DoListBox (doWidget: ADDRESS) : ADDRESS;
+PROCEDURE DoFlowBox (doWidget: ADDRESS) : ADDRESS;
+PROCEDURE DoExpander (doWidget: ADDRESS) : ADDRESS;
+PROCEDURE DoCss (doWidget: ADDRESS) : ADDRESS;
+
+END DemoImpl.

+ 356 - 0
demos/DemoImpl.mod

@@ -0,0 +1,356 @@
+IMPLEMENTATION MODULE DemoImpl ;
+
+(*
+   Five demos ported from the GTK source tree (gtk/demos/gtk-demo),
+   simplified to the features bound by m2-GTK4:
+     Links      (links.c)      - markup with hyperlinks + activate-link
+     List Box   (listbox.c)    - rows in a GtkListBox
+     Flow Box   (flowbox.c)    - reflowing color swatches
+     Expander   (expander.c)   - collapsible scrolled text
+     CSS Basics (css_basics.c) - live CSS editing
+*)
+
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM GtkWindow IMPORT gtk_window_new, gtk_window_set_title,
+   gtk_window_set_default_size, gtk_window_set_resizable,
+   gtk_window_set_child, gtk_window_destroy;
+FROM GtkWidget IMPORT gtk_widget_set_visible, gtk_widget_get_visible,
+   gtk_widget_set_margin_start, gtk_widget_set_margin_end,
+   gtk_widget_set_margin_top, gtk_widget_set_margin_bottom,
+   gtk_widget_set_vexpand, gtk_widget_add_css_class;
+FROM GtkEnums IMPORT GtkVertical, GtkSelectionNone;
+FROM GtkLabel IMPORT gtk_label_new, gtk_label_set_use_markup,
+   gtk_label_set_wrap, gtk_label_set_wrap_mode, gtk_label_set_max_width_chars;
+FROM GtkBox IMPORT gtk_box_new, gtk_box_append, gtk_box_set_spacing;
+FROM GtkScrolledWindow IMPORT gtk_scrolled_window_new,
+   gtk_scrolled_window_set_child, gtk_scrolled_window_set_min_content_height,
+   gtk_scrolled_window_set_has_frame;
+FROM GtkListBox IMPORT gtk_list_box_new, gtk_list_box_append,
+   gtk_list_box_row_new, gtk_list_box_row_set_child;
+FROM GtkFlowBox IMPORT gtk_flow_box_new, gtk_flow_box_append,
+   gtk_flow_box_set_selection_mode, gtk_flow_box_set_max_children_per_line;
+FROM GtkDrawingArea IMPORT gtk_drawing_area_new,
+   gtk_drawing_area_set_content_width, gtk_drawing_area_set_content_height,
+   gtk_drawing_area_set_draw_func;
+FROM GtkButton IMPORT gtk_button_new, gtk_button_set_child;
+FROM GtkExpander IMPORT gtk_expander_new, gtk_expander_set_child;
+FROM GtkTextView IMPORT gtk_text_view_new, gtk_text_view_new_with_buffer;
+FROM GtkTextBuffer IMPORT gtk_text_buffer_new, gtk_text_buffer_set_text,
+   gtk_text_buffer_get_text, gtk_text_buffer_get_start_iter,
+   gtk_text_buffer_get_end_iter;
+FROM GtkTextIter IMPORT GtkTextIter;
+FROM GtkCssProvider IMPORT gtk_css_provider_new,
+   gtk_css_provider_load_from_string;
+FROM GtkStyleContext IMPORT gtk_style_context_add_provider_for_display,
+   GtkStyleProviderPriorityApplication;
+FROM GtkAlertDialog IMPORT gtk_alert_dialog_new, gtk_alert_dialog_set_detail,
+   gtk_alert_dialog_show;
+FROM Gdk IMPORT gdk_display_get_default, GdkRGBA, gdk_rgba_parse,
+   gdk_cairo_set_source_rgba;
+FROM Cairo IMPORT cairo_paint;
+FROM GObject IMPORT g_signal_connect_data, g_object_unref, GConnectDefault;
+FROM GtkClosures IMPORT Connect2;
+FROM GtkUtils IMPORT IntToStr, Free, CStrToM2;
+FROM GLib IMPORT g_strcmp0;
+FROM libc IMPORT printf;
+
+(* ------------------------------------------------------------------ *)
+(* Links                                                               *)
+(* ------------------------------------------------------------------ *)
+
+VAR
+   linksWindow: ADDRESS;
+
+CONST
+   LinksMarkup = "Some <a href='http://en.wikipedia.org/wiki/Text' title='plain text'>text</a> may be marked up as hyperlinks, which can be clicked or activated via <a href='keynav'>keynav</a>, working fine alongside other markup such as <a href='http://www.flathub.org/'><b>Flathub</b></a>.";
+
+(* gboolean activate_link(GtkWidget *label, const char *uri, gpointer data) *)
+PROCEDURE OnActivateLink (label: ADDRESS; uri: ADDRESS; data: ADDRESS) : INTEGER;
+VAR
+   dialog: ADDRESS;
+   key: ARRAY [0..7] OF CHAR;
+BEGIN
+   key := "keynav";
+   IF g_strcmp0(uri, ADR(key)) = 0 THEN
+      dialog := gtk_alert_dialog_new("Keyboard navigation");
+      gtk_alert_dialog_set_detail(dialog,
+         "keynav is a shorthand for keyboard navigation.");
+      gtk_alert_dialog_show(dialog, NIL);
+      g_object_unref(dialog);
+      RETURN 1
+   END;
+   RETURN 0
+END OnActivateLink;
+
+PROCEDURE DoLinks (doWidget: ADDRESS) : ADDRESS;
+VAR
+   label: ADDRESS;
+BEGIN
+   IF linksWindow = NIL THEN
+      linksWindow := gtk_window_new();
+      gtk_window_set_title(linksWindow, "Links");
+      gtk_window_set_resizable(linksWindow, 0);
+      label := gtk_label_new(LinksMarkup);
+      gtk_label_set_use_markup(label, 1);
+      gtk_label_set_max_width_chars(label, 40);
+      gtk_label_set_wrap(label, 1);
+      gtk_label_set_wrap_mode(label, 0);   (* PANGO_WRAP_WORD *)
+      g_signal_connect_data(label, "activate-link", ADR(OnActivateLink),
+                            NIL, NIL, GConnectDefault);
+      gtk_widget_set_margin_start(label, 20);
+      gtk_widget_set_margin_end(label, 20);
+      gtk_widget_set_margin_top(label, 20);
+      gtk_widget_set_margin_bottom(label, 20);
+      gtk_window_set_child(linksWindow, label)
+   END;
+
+   IF gtk_widget_get_visible(linksWindow) = 0 THEN
+      gtk_widget_set_visible(linksWindow, 1)
+   ELSE
+      gtk_window_destroy(linksWindow);
+      linksWindow := NIL
+   END;
+   RETURN linksWindow
+END DoLinks;
+
+(* ------------------------------------------------------------------ *)
+(* List Box                                                            *)
+(* ------------------------------------------------------------------ *)
+
+VAR
+   listBoxWindow: ADDRESS;
+
+PROCEDURE DoListBox (doWidget: ADDRESS) : ADDRESS;
+VAR
+   box, row, sw: ADDRESS;
+   i: INTEGER;
+   text: ARRAY [0..15] OF CHAR;
+BEGIN
+   IF listBoxWindow = NIL THEN
+      listBoxWindow := gtk_window_new();
+      gtk_window_set_title(listBoxWindow, "List Box");
+      gtk_window_set_default_size(listBoxWindow, 260, 220);
+
+      box := gtk_list_box_new();
+      FOR i := 1 TO 5 DO
+         row := gtk_list_box_row_new();
+         IntToStr(i, text);
+         gtk_list_box_row_set_child(row, gtk_label_new(text));
+         gtk_list_box_append(box, row)
+      END;
+
+      sw := gtk_scrolled_window_new();
+      gtk_scrolled_window_set_child(sw, box);
+      gtk_window_set_child(listBoxWindow, sw)
+   END;
+
+   IF gtk_widget_get_visible(listBoxWindow) = 0 THEN
+      gtk_widget_set_visible(listBoxWindow, 1)
+   ELSE
+      gtk_window_destroy(listBoxWindow);
+      listBoxWindow := NIL
+   END;
+   RETURN listBoxWindow
+END DoListBox;
+
+(* ------------------------------------------------------------------ *)
+(* Flow Box                                                            *)
+(* ------------------------------------------------------------------ *)
+
+VAR
+   flowBoxWindow: ADDRESS;
+   colors: ARRAY [0..11] OF ARRAY [0..31] OF CHAR;
+
+(* void draw_color(GtkDrawingArea *area, cairo_t *cr, int w, int h, gpointer d) *)
+PROCEDURE DrawColor (area: ADDRESS; cr: ADDRESS; width, height: INTEGER;
+                     data: ADDRESS);
+VAR
+   spec: ARRAY [0..31] OF CHAR;
+   rgba: GdkRGBA;
+BEGIN
+   CStrToM2(data, spec);
+   IF gdk_rgba_parse(rgba, spec) # 0 THEN
+      gdk_cairo_set_source_rgba(cr, rgba);
+      cairo_paint(cr)
+   END
+END DrawColor;
+
+PROCEDURE ColorSwatch (color: ADDRESS) : ADDRESS;
+VAR
+   button, area: ADDRESS;
+BEGIN
+   button := gtk_button_new();
+   area := gtk_drawing_area_new();
+   gtk_drawing_area_set_content_width(area, 24);
+   gtk_drawing_area_set_content_height(area, 24);
+   gtk_drawing_area_set_draw_func(area, ADR(DrawColor), color, NIL);
+   gtk_button_set_child(button, area);
+   RETURN button
+END ColorSwatch;
+
+PROCEDURE DoFlowBox (doWidget: ADDRESS) : ADDRESS;
+VAR
+   sw, flowbox: ADDRESS;
+   i: INTEGER;
+BEGIN
+   IF flowBoxWindow = NIL THEN
+      flowBoxWindow := gtk_window_new();
+      gtk_window_set_title(flowBoxWindow, "Flow Box");
+      gtk_window_set_default_size(flowBoxWindow, 320, 260);
+
+      colors[0] := "AliceBlue";    colors[1] := "AntiqueWhite";
+      colors[2] := "aqua";         colors[3] := "blue";
+      colors[4] := "chartreuse";   colors[5] := "coral";
+      colors[6] := "crimson";      colors[7] := "DarkOrange";
+      colors[8] := "gold";         colors[9] := "ForestGreen";
+      colors[10] := "Orchid";      colors[11] := "SteelBlue";
+
+      flowbox := gtk_flow_box_new();
+      gtk_flow_box_set_selection_mode(flowbox, GtkSelectionNone);
+      gtk_flow_box_set_max_children_per_line(flowbox, 8);
+      FOR i := 0 TO 11 DO
+         gtk_flow_box_append(flowbox, ColorSwatch(ADR(colors[i])))
+      END;
+
+      sw := gtk_scrolled_window_new();
+      gtk_scrolled_window_set_child(sw, flowbox);
+      gtk_window_set_child(flowBoxWindow, sw)
+   END;
+
+   IF gtk_widget_get_visible(flowBoxWindow) = 0 THEN
+      gtk_widget_set_visible(flowBoxWindow, 1)
+   ELSE
+      gtk_window_destroy(flowBoxWindow);
+      flowBoxWindow := NIL
+   END;
+   RETURN flowBoxWindow
+END DoFlowBox;
+
+(* ------------------------------------------------------------------ *)
+(* Expander                                                            *)
+(* ------------------------------------------------------------------ *)
+
+VAR
+   expanderWindow: ADDRESS;
+
+PROCEDURE DoExpander (doWidget: ADDRESS) : ADDRESS;
+VAR
+   box, expander, sw, tv: ADDRESS;
+BEGIN
+   IF expanderWindow = NIL THEN
+      expanderWindow := gtk_window_new();
+      gtk_window_set_title(expanderWindow, "Expander");
+      gtk_window_set_default_size(expanderWindow, 320, 260);
+
+      box := gtk_box_new(GtkVertical, 10);
+      gtk_box_set_spacing(box, 10);
+      gtk_widget_set_margin_start(box, 10);
+      gtk_widget_set_margin_end(box, 10);
+      gtk_widget_set_margin_top(box, 10);
+      gtk_widget_set_margin_bottom(box, 10);
+
+      gtk_box_append(box, gtk_label_new("Here are some more details:"));
+      expander := gtk_expander_new("Details:");
+      gtk_widget_set_vexpand(expander, 1);
+
+      tv := gtk_text_view_new();
+      sw := gtk_scrolled_window_new();
+      gtk_scrolled_window_set_min_content_height(sw, 100);
+      gtk_scrolled_window_set_has_frame(sw, 1);
+      gtk_scrolled_window_set_child(sw, tv);
+      gtk_widget_set_vexpand(sw, 1);
+      gtk_expander_set_child(expander, sw);
+      gtk_box_append(box, expander);
+
+      gtk_window_set_child(expanderWindow, box)
+   END;
+
+   IF gtk_widget_get_visible(expanderWindow) = 0 THEN
+      gtk_widget_set_visible(expanderWindow, 1)
+   ELSE
+      gtk_window_destroy(expanderWindow);
+      expanderWindow := NIL
+   END;
+   RETURN expanderWindow
+END DoExpander;
+
+(* ------------------------------------------------------------------ *)
+(* CSS Basics                                                          *)
+(* ------------------------------------------------------------------ *)
+
+VAR
+   cssWindow, cssBuffer, cssProvider: ADDRESS;
+
+CONST
+   InitialCss = ".sample { color: #1c71d8; font-weight: bold; font-size: 20px; }";
+
+PROCEDURE ApplyCss;
+VAR
+   start, stop: GtkTextIter;
+   text: ADDRESS;
+   buf: ARRAY [0..1023] OF CHAR;
+BEGIN
+   gtk_text_buffer_get_start_iter(cssBuffer, start);
+   gtk_text_buffer_get_end_iter(cssBuffer, stop);
+   text := gtk_text_buffer_get_text(cssBuffer, start, stop, 0);
+   IF text # NIL THEN
+      CStrToM2(text, buf);
+      gtk_css_provider_load_from_string(cssProvider, buf);
+      Free(text)
+   END
+END ApplyCss;
+
+PROCEDURE OnCssChanged (buffer: ADDRESS; user: ADDRESS);
+BEGIN
+   ApplyCss
+END OnCssChanged;
+
+PROCEDURE DoCss (doWidget: ADDRESS) : ADDRESS;
+VAR
+   box, view, sw, sample: ADDRESS;
+BEGIN
+   IF cssWindow = NIL THEN
+      cssWindow := gtk_window_new();
+      gtk_window_set_title(cssWindow, "CSS Basics");
+      gtk_window_set_default_size(cssWindow, 400, 300);
+
+      cssProvider := gtk_css_provider_new();
+      gtk_style_context_add_provider_for_display(gdk_display_get_default(),
+         cssProvider, GtkStyleProviderPriorityApplication);
+
+      sample := gtk_label_new("Sample label (styled by the CSS below)");
+      gtk_widget_add_css_class(sample, "sample");
+
+      cssBuffer := gtk_text_buffer_new(NIL);
+      gtk_text_buffer_set_text(cssBuffer, InitialCss, -1);
+      view := gtk_text_view_new_with_buffer(cssBuffer);
+
+      sw := gtk_scrolled_window_new();
+      gtk_scrolled_window_set_child(sw, view);
+      gtk_scrolled_window_set_min_content_height(sw, 120);
+      gtk_widget_set_vexpand(sw, 1);
+
+      box := gtk_box_new(GtkVertical, 10);
+      gtk_box_set_spacing(box, 10);
+      gtk_widget_set_margin_start(box, 10);
+      gtk_widget_set_margin_end(box, 10);
+      gtk_widget_set_margin_top(box, 10);
+      gtk_widget_set_margin_bottom(box, 10);
+      gtk_box_append(box, sample);
+      gtk_box_append(box, sw);
+
+      Connect2(cssBuffer, "changed", OnCssChanged, NIL);
+      gtk_window_set_child(cssWindow, box);
+      ApplyCss
+   END;
+
+   IF gtk_widget_get_visible(cssWindow) = 0 THEN
+      gtk_widget_set_visible(cssWindow, 1)
+   ELSE
+      gtk_window_destroy(cssWindow);
+      cssWindow := NIL
+   END;
+   RETURN cssWindow
+END DoCss;
+
+END DemoImpl.

+ 26 - 0
demos/GtkDemo.def

@@ -0,0 +1,26 @@
+DEFINITION MODULE GtkDemo ;
+
+(*
+   m2-GTK4 - the demo registry, mirroring the gtk-demo model: a list of
+   demos, each with a title, search keywords and a build function of the
+   form
+
+      BuildProc = PROCEDURE (ADDRESS) : ADDRESS;
+
+   which creates (once), toggles and returns the demo's window.
+*)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+EXPORT UNQUALIFIED BuildProc,
+   Count, TitleOf, KeywordsOf, BuildByTitle;
+
+TYPE
+   BuildProc = PROCEDURE (ADDRESS) : ADDRESS;
+
+PROCEDURE Count () : CARDINAL;
+PROCEDURE TitleOf (i: CARDINAL; VAR title: ARRAY OF CHAR);
+PROCEDURE KeywordsOf (i: CARDINAL; VAR keywords: ARRAY OF CHAR);
+PROCEDURE BuildByTitle (title: ARRAY OF CHAR; doWidget: ADDRESS) : ADDRESS;
+
+END GtkDemo.

+ 87 - 0
demos/GtkDemo.mod

@@ -0,0 +1,87 @@
+IMPLEMENTATION MODULE GtkDemo ;
+
+FROM DemoImpl IMPORT DoLinks, DoListBox, DoFlowBox, DoExpander, DoCss;
+FROM SYSTEM IMPORT ADDRESS;
+
+TYPE
+   Demo = RECORD
+      title: ARRAY [0..63] OF CHAR;
+      keywords: ARRAY [0..127] OF CHAR;
+      build: BuildProc;
+   END;
+
+VAR
+   demos: ARRAY [0..31] OF Demo;
+   n: CARDINAL;
+
+PROCEDURE Copy (VAR dst: ARRAY OF CHAR; src: ARRAY OF CHAR);
+VAR
+   i: CARDINAL;
+BEGIN
+   i := 0;
+   WHILE (i < HIGH(dst)) AND (i <= HIGH(src)) AND (src[i] # 0C) DO
+      dst[i] := src[i];
+      INC(i)
+   END;
+   dst[i] := 0C
+END Copy;
+
+PROCEDURE Equal (a, b: ARRAY OF CHAR) : BOOLEAN;
+VAR
+   i: CARDINAL;
+BEGIN
+   i := 0;
+   WHILE (a[i] # 0C) AND (b[i] # 0C) DO
+      IF a[i] # b[i] THEN RETURN FALSE END;
+      INC(i)
+   END;
+   RETURN a[i] = b[i]
+END Equal;
+
+PROCEDURE Register (title, keywords: ARRAY OF CHAR; build: BuildProc);
+BEGIN
+   IF n <= HIGH(demos) THEN
+      Copy(demos[n].title, title);
+      Copy(demos[n].keywords, keywords);
+      demos[n].build := build;
+      INC(n)
+   END
+END Register;
+
+PROCEDURE Count () : CARDINAL;
+BEGIN
+   RETURN n
+END Count;
+
+PROCEDURE TitleOf (i: CARDINAL; VAR title: ARRAY OF CHAR);
+BEGIN
+   IF i < n THEN Copy(title, demos[i].title) ELSE title[0] := 0C END
+END TitleOf;
+
+PROCEDURE KeywordsOf (i: CARDINAL; VAR keywords: ARRAY OF CHAR);
+BEGIN
+   IF i < n THEN Copy(keywords, demos[i].keywords) ELSE keywords[0] := 0C END
+END KeywordsOf;
+
+PROCEDURE BuildByTitle (title: ARRAY OF CHAR; doWidget: ADDRESS) : ADDRESS;
+VAR
+   i: CARDINAL;
+   buf: ARRAY [0..63] OF CHAR;
+BEGIN
+   i := 0;
+   WHILE i < n DO
+      TitleOf(i, buf);
+      IF Equal(buf, title) THEN RETURN demos[i].build(doWidget) END;
+      INC(i)
+   END;
+   RETURN NIL
+END BuildByTitle;
+
+BEGIN
+   n := 0;
+   Register("Links", "hyperlinks markup label uri anchor", DoLinks);
+   Register("List Box", "list rows selection box", DoListBox);
+   Register("Flow Box", "flow grid reflow colors swatches", DoFlowBox);
+   Register("Expander", "disclosure triangle expand collapse", DoExpander);
+   Register("CSS Basics", "css styling theme provider", DoCss)
+END GtkDemo.

+ 214 - 0
demos/m2gtkdemo.mod

@@ -0,0 +1,214 @@
+MODULE m2gtkdemo ;
+
+(*
+   m2-GTK4 - an m2 gtk-demo.
+
+   A browser window with a searchable sidebar of demos; activating a row
+   (double-click / Enter) or pressing "Run" opens the demo in its own
+   window, mirroring the GTK demo application.
+
+   Build:  make demos
+   Run:    ./build/demos/m2gtkdemo
+*)
+
+FROM Gio IMPORT g_application_run;
+FROM GtkApplication IMPORT gtk_application_new;
+FROM GtkApplicationWindow IMPORT gtk_application_window_new;
+FROM GtkWindow IMPORT gtk_window_set_title, gtk_window_set_default_size,
+   gtk_window_set_child, gtk_window_present;
+FROM GtkBox IMPORT gtk_box_new, gtk_box_append, gtk_box_set_spacing;
+FROM GtkEnums IMPORT GtkVertical, GtkHorizontal;
+FROM GtkWidget IMPORT gtk_widget_set_size_request, gtk_widget_set_vexpand,
+   gtk_widget_set_hexpand, gtk_widget_set_margin_start,
+   gtk_widget_set_margin_end, gtk_widget_set_margin_top,
+   gtk_widget_set_margin_bottom;
+FROM GtkLabel IMPORT gtk_label_new, gtk_label_set_text;
+FROM GtkButton IMPORT gtk_button_new_with_label;
+FROM GtkSearchEntry IMPORT gtk_search_entry_new,
+   gtk_search_entry_set_placeholder_text;
+FROM GtkEditable IMPORT gtk_editable_get_text;
+FROM GtkListView IMPORT gtk_list_view_new;
+FROM GtkListItem IMPORT gtk_list_item_get_item, gtk_list_item_get_child,
+   gtk_list_item_set_child;
+FROM GtkSignalListItemFactory IMPORT gtk_signal_list_item_factory_new;
+FROM GtkSingleSelection IMPORT gtk_single_selection_new,
+   gtk_single_selection_get_selected;
+FROM GtkFilterListModel IMPORT gtk_filter_list_model_new;
+FROM GtkCustomFilter IMPORT gtk_custom_filter_new,
+   gtk_custom_filter_set_filter_func;
+FROM GtkStringList IMPORT gtk_string_list_new, gtk_string_list_append;
+FROM GtkStringObject IMPORT gtk_string_object_get_string;
+FROM GListModel IMPORT g_list_model_get_item;
+FROM GObject IMPORT g_signal_connect_data, g_object_unref, GConnectDefault;
+FROM GtkClosures IMPORT Connect2, Connect3;
+FROM GtkUtils IMPORT Connect, CStrToM2;
+FROM GtkDemo IMPORT Count, TitleOf, BuildByTitle;
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM libc IMPORT printf;
+
+CONST
+   AppId = "org.example.m2gtk4.Demo4";
+   Invalid = 0FFFFFFFFH;
+
+VAR
+   window, filter, filterModel, selection: ADDRESS;
+   searchText: ARRAY [0..63] OF CHAR;
+
+PROCEDURE Contains (hay, needle: ARRAY OF CHAR) : BOOLEAN;
+VAR
+   i, j, hl, nl: CARDINAL;
+   found: BOOLEAN;
+BEGIN
+   hl := 0;
+   WHILE (hl <= HIGH(hay)) AND (hay[hl] # 0C) DO INC(hl) END;
+   nl := 0;
+   WHILE (nl <= HIGH(needle)) AND (needle[nl] # 0C) DO INC(nl) END;
+   IF nl = 0 THEN RETURN TRUE END;
+   IF nl > hl THEN RETURN FALSE END;
+   i := 0;
+   WHILE i + nl <= hl DO
+      found := TRUE;
+      j := 0;
+      WHILE j < nl DO
+         IF hay[i + j] # needle[j] THEN found := FALSE END;
+         INC(j)
+      END;
+      IF found THEN RETURN TRUE END;
+      INC(i)
+   END;
+   RETURN FALSE
+END Contains;
+
+(* gboolean match(gpointer item, gpointer user_data) - match the title *)
+PROCEDURE Match (item: ADDRESS; user: ADDRESS) : INTEGER;
+VAR
+   buf: ARRAY [0..63] OF CHAR;
+BEGIN
+   CStrToM2(gtk_string_object_get_string(item), buf);
+   IF Contains(buf, searchText) THEN RETURN 1 ELSE RETURN 0 END
+END Match;
+
+PROCEDURE OnSearchChanged (entry: ADDRESS; user: ADDRESS);
+BEGIN
+   CStrToM2(gtk_editable_get_text(entry), searchText);
+   gtk_custom_filter_set_filter_func(filter, ADR(Match), NIL, NIL)
+END OnSearchChanged;
+
+PROCEDURE RunPosition (position: CARDINAL);
+VAR
+   item, demoWindow: ADDRESS;
+   title: ARRAY [0..63] OF CHAR;
+BEGIN
+   item := g_list_model_get_item(filterModel, position);
+   CStrToM2(gtk_string_object_get_string(item), title);
+   g_object_unref(item);
+   demoWindow := BuildByTitle(title, window);
+   IF demoWindow = NIL THEN
+      printf("no demo named %s\n", title)
+   END
+END RunPosition;
+
+(* void activate(GtkListView *list, guint position, gpointer user) *)
+PROCEDURE OnActivate (list: ADDRESS; position: CARDINAL; user: ADDRESS);
+BEGIN
+   RunPosition(position)
+END OnActivate;
+
+PROCEDURE OnRun (button: ADDRESS; user: ADDRESS);
+VAR
+   index: CARDINAL;
+BEGIN
+   index := gtk_single_selection_get_selected(selection);
+   IF index # Invalid THEN RunPosition(index) END
+END OnRun;
+
+PROCEDURE RowSetup (factory: ADDRESS; item: ADDRESS; user: ADDRESS);
+BEGIN
+   gtk_list_item_set_child(item, gtk_label_new(""))
+END RowSetup;
+
+PROCEDURE RowBind (factory: ADDRESS; item: ADDRESS; user: ADDRESS);
+VAR
+   obj, child: ADDRESS;
+   buf: ARRAY [0..63] OF CHAR;
+BEGIN
+   obj := gtk_list_item_get_item(item);
+   CStrToM2(gtk_string_object_get_string(obj), buf);
+   child := gtk_list_item_get_child(item);
+   gtk_label_set_text(child, buf)
+END RowBind;
+
+PROCEDURE OnActivateApp (application: ADDRESS; data: ADDRESS);
+VAR
+   root, content, search, listView, factory, store, runButton, hint: ADDRESS;
+   title: ARRAY [0..63] OF CHAR;
+   i: CARDINAL;
+BEGIN
+   searchText[0] := 0C;
+
+   store := gtk_string_list_new(NIL);
+   i := 0;
+   WHILE i < Count() DO
+      TitleOf(i, title);
+      gtk_string_list_append(store, title);
+      INC(i)
+   END;
+
+   filter := gtk_custom_filter_new(ADR(Match), NIL, NIL);
+   filterModel := gtk_filter_list_model_new(store, filter);
+   selection := gtk_single_selection_new(filterModel);
+
+   factory := gtk_signal_list_item_factory_new();
+   Connect3(factory, "setup", RowSetup, NIL);
+   Connect3(factory, "bind", RowBind, NIL);
+   listView := gtk_list_view_new(selection, factory);
+   gtk_widget_set_size_request(listView, 200, -1);
+   gtk_widget_set_vexpand(listView, 1);
+   g_signal_connect_data(listView, "activate", ADR(OnActivate), NIL, NIL,
+                         GConnectDefault);
+
+   runButton := gtk_button_new_with_label("Run selected demo");
+   Connect2(runButton, "clicked", OnRun, NIL);
+
+   hint := gtk_label_new("Pick a demo, then Run (or double-click).");
+   gtk_widget_set_margin_start(hint, 8);
+
+   search := gtk_search_entry_new();
+   gtk_search_entry_set_placeholder_text(search, "Search demos");
+   Connect2(search, "search-changed", OnSearchChanged, NIL);
+
+   content := gtk_box_new(GtkHorizontal, 8);
+   gtk_box_set_spacing(content, 8);
+   gtk_widget_set_vexpand(content, 1);
+   gtk_box_append(content, listView);
+   gtk_box_append(content, runButton);
+   gtk_widget_set_hexpand(runButton, 0);
+
+   root := gtk_box_new(GtkVertical, 8);
+   gtk_box_set_spacing(root, 8);
+   gtk_widget_set_margin_start(root, 10);
+   gtk_widget_set_margin_end(root, 10);
+   gtk_widget_set_margin_top(root, 10);
+   gtk_widget_set_margin_bottom(root, 10);
+   gtk_box_append(root, search);
+   gtk_box_append(root, content);
+   gtk_box_append(root, hint);
+
+   window := gtk_application_window_new(application);
+   gtk_window_set_title(window, "m2-GTK4 Demo");
+   gtk_window_set_default_size(window, 480, 360);
+   gtk_window_set_child(window, root);
+   gtk_window_present(window)
+END OnActivateApp;
+
+VAR
+   app: ADDRESS;
+BEGIN
+   app := gtk_application_new(AppId, 0);
+   IF app = NIL THEN
+      printf("gtk_application_new failed\n");
+      HALT(1)
+   END;
+   Connect2(app, "activate", OnActivateApp, NIL);
+   g_application_run(app, 0, NIL)
+END m2gtkdemo.

+ 8 - 1
src/Gdk.def

@@ -14,7 +14,8 @@ EXPORT UNQUALIFIED
    GdkDisplay, GdkRGBA, GdkRGBAPtr, GdkDragAction,
    GdkActionCopy, GdkActionMove, GdkActionLink,
    gdk_display_get_default, gdk_display_get_clipboard,
-   gdk_rgba_free, gdk_rgba_to_string;
+   gdk_rgba_free, gdk_rgba_to_string, gdk_rgba_parse,
+   gdk_cairo_set_source_rgba;
 
 
 TYPE
@@ -43,4 +44,10 @@ PROCEDURE gdk_rgba_free (rgba: ADDRESS);
 (* char *gdk_rgba_to_string(const GdkRGBA *rgba) *)
 PROCEDURE gdk_rgba_to_string (VAR rgba: GdkRGBA) : ADDRESS;
 
+(* gboolean gdk_rgba_parse(GdkRGBA *rgba, const char *spec) *)
+PROCEDURE gdk_rgba_parse (VAR rgba: GdkRGBA; spec: ARRAY OF CHAR) : [ INTEGER ];
+
+(* void gdk_cairo_set_source_rgba(cairo_t *cr, const GdkRGBA *rgba) *)
+PROCEDURE gdk_cairo_set_source_rgba (cr: ADDRESS; VAR rgba: GdkRGBA);
+
 END Gdk.

+ 4 - 1
src/GtkButton.def

@@ -15,7 +15,7 @@ FROM SYSTEM IMPORT ADDRESS;
 EXPORT UNQUALIFIED
    GtkButton,
    gtk_button_new, gtk_button_new_with_label, gtk_button_new_with_mnemonic,
-   gtk_button_set_label, gtk_button_get_label;
+   gtk_button_set_label, gtk_button_get_label, gtk_button_set_child;
 
 
 TYPE
@@ -36,4 +36,7 @@ PROCEDURE gtk_button_set_label (button: GtkButton; label: ARRAY OF CHAR);
 (* const char *gtk_button_get_label(GtkButton *button) *)
 PROCEDURE gtk_button_get_label (button: GtkButton) : ADDRESS;
 
+(* void gtk_button_set_child(GtkButton *button, GtkWidget *child) *)
+PROCEDURE gtk_button_set_child (button: GtkButton; child: ADDRESS);
+
 END GtkButton.

+ 11 - 1
src/GtkLabel.def

@@ -15,7 +15,8 @@ FROM SYSTEM IMPORT ADDRESS;
 EXPORT UNQUALIFIED
    GtkLabel,
    gtk_label_new, gtk_label_set_text, gtk_label_get_text,
-   gtk_label_set_markup, gtk_label_set_use_markup;
+   gtk_label_set_markup, gtk_label_set_use_markup,
+   gtk_label_set_wrap, gtk_label_set_wrap_mode, gtk_label_set_max_width_chars;
 
 
 TYPE
@@ -36,4 +37,13 @@ PROCEDURE gtk_label_set_markup (label: GtkLabel; str: ARRAY OF CHAR);
 (* void gtk_label_set_use_markup(GtkLabel *self, gboolean setting) *)
 PROCEDURE gtk_label_set_use_markup (label: GtkLabel; setting: INTEGER);
 
+(* void gtk_label_set_wrap(GtkLabel *self, gboolean wrap) *)
+PROCEDURE gtk_label_set_wrap (label: GtkLabel; wrap: INTEGER);
+
+(* void gtk_label_set_wrap_mode(GtkLabel *self, PangoWrapMode wrap_mode) *)
+PROCEDURE gtk_label_set_wrap_mode (label: GtkLabel; wrap_mode: CARDINAL);
+
+(* void gtk_label_set_max_width_chars(GtkLabel *self, int n_chars) *)
+PROCEDURE gtk_label_set_max_width_chars (label: GtkLabel; n_chars: INTEGER);
+
 END GtkLabel.

+ 7 - 1
src/GtkScrolledWindow.def

@@ -21,7 +21,8 @@ EXPORT UNQUALIFIED
    gtk_scrolled_window_set_max_content_width,
    gtk_scrolled_window_set_max_content_height,
    gtk_scrolled_window_set_propagate_natural_width,
-   gtk_scrolled_window_set_propagate_natural_height;
+   gtk_scrolled_window_set_propagate_natural_height,
+   gtk_scrolled_window_set_has_frame;
 
 
 TYPE
@@ -84,4 +85,9 @@ PROCEDURE gtk_scrolled_window_set_propagate_natural_width (scrolled_window: GtkS
 PROCEDURE gtk_scrolled_window_set_propagate_natural_height (scrolled_window: GtkScrolledWindow;
                                                             propagate: INTEGER);
 
+(* void gtk_scrolled_window_set_has_frame(GtkScrolledWindow *scrolled_window,
+                                          gboolean has_frame) *)
+PROCEDURE gtk_scrolled_window_set_has_frame (scrolled_window: GtkScrolledWindow;
+                                             has_frame: INTEGER);
+
 END GtkScrolledWindow.

+ 14 - 4
tests/run_tests.sh

@@ -13,7 +13,7 @@ CFLAGS=$(pkg-config --cflags gtk4)
 LIBS=$(pkg-config --libs gtk4)
 
 # libadwaita is optional: add its flags and test when available.
-TESTS="test_glib test_version test_widgets test_inputs test_inputs2 test_containers test_containers2 test_actions test_closure test_headerbar test_gio test_gerror test_filedialog test_views test_builder test_utility test_css test_popover test_dialogs test_models test_cairo test_drawing test_gestures test_models2 test_widgets3 test_shim test_shim2 test_shim3 test_dnd test_media test_gl test_print test_text test_expr test_constraints test_shortcuts test_snapshot test_lastwidgets test_application"
+TESTS="test_glib test_version test_widgets test_inputs test_inputs2 test_containers test_containers2 test_actions test_closure test_headerbar test_gio test_gerror test_filedialog test_views test_builder test_utility test_css test_popover test_dialogs test_models test_cairo test_drawing test_gestures test_models2 test_widgets3 test_shim test_shim2 test_shim3 test_dnd test_media test_gl test_print test_text test_expr test_constraints test_shortcuts test_snapshot test_lastwidgets test_application test_demos"
 if pkg-config --exists libadwaita-1 2>/dev/null; then
   CFLAGS="$CFLAGS $(pkg-config --cflags libadwaita-1)"
   LIBS="$LIBS $(pkg-config --libs libadwaita-1)"
@@ -36,6 +36,14 @@ $GM2 -I"$ROOT/src" -I"$ROOT/lib" $GM2FLAGS -c "$ROOT/lib/GtkClosures.mod" -o "$O
 # C shim for GObject subclassing (compiled with the C compiler).
 ${CC:-cc} $CFLAGS -c "$ROOT/lib/m2gtkshim.c" -o "$OBJ/m2gtkshim.o"
 
+# the m2 gtk-demo registry (demos/) is compiled once and linked into test_demos.
+if [ -d "$ROOT/demos" ]; then
+  # shellcheck disable=SC2086
+  $GM2 -I"$ROOT/src" -I"$ROOT/lib" -I"$ROOT/demos" $GM2FLAGS -c "$ROOT/demos/DemoImpl.mod" -o "$OBJ/DemoImpl.o"
+  # shellcheck disable=SC2086
+  $GM2 -I"$ROOT/src" -I"$ROOT/lib" -I"$ROOT/demos" $GM2FLAGS -c "$ROOT/demos/GtkDemo.mod" -o "$OBJ/GtkDemo.o"
+fi
+
 # compile the test-only GSettings schema and make it discoverable
 SCHEMA_SRC="$ROOT/tests/schemas"
 SCHEMA_BLD="$ROOT/build/schemas"
@@ -48,12 +56,14 @@ export GSETTINGS_SCHEMA_DIR
 pass=0; fail=0; skip=0
 for t in $TESTS; do
   echo "== $t =="
+  DEMO_OBJS=""
+  case "$t" in test_demos) DEMO_OBJS="$OBJ/DemoImpl.o $OBJ/GtkDemo.o" ;; esac
   # shellcheck disable=SC2086
-  $GM2 -I"$ROOT/src" -I"$ROOT/lib" $GM2FLAGS $CFLAGS \
+  $GM2 -I"$ROOT/src" -I"$ROOT/lib" -I"$ROOT/demos" $GM2FLAGS $CFLAGS \
        "$ROOT/tests/$t.mod" "$OBJ/GtkUtils.o" "$OBJ/GtkClosures.o" \
-       "$OBJ/m2gtkshim.o" -o "$BIN/$t" $LIBS
+       "$OBJ/m2gtkshim.o" $DEMO_OBJS -o "$BIN/$t" $LIBS
   case "$t" in
-    test_widgets|test_inputs|test_inputs2|test_containers|test_containers2|test_actions|test_closure|test_headerbar|test_filedialog|test_views|test_builder|test_utility|test_css|test_popover|test_dialogs|test_models|test_drawing|test_gestures|test_models2|test_widgets3|test_shim|test_shim2|test_shim3|test_dnd|test_media|test_gl|test_print|test_text|test_expr|test_constraints|test_shortcuts|test_snapshot|test_lastwidgets|test_adw|test_application) needs_display=1 ;;
+    test_widgets|test_inputs|test_inputs2|test_containers|test_containers2|test_actions|test_closure|test_headerbar|test_filedialog|test_views|test_builder|test_utility|test_css|test_popover|test_dialogs|test_models|test_drawing|test_gestures|test_models2|test_widgets3|test_shim|test_shim2|test_shim3|test_dnd|test_media|test_gl|test_print|test_text|test_expr|test_constraints|test_shortcuts|test_snapshot|test_lastwidgets|test_adw|test_application|test_demos) needs_display=1 ;;
     *) needs_display=0 ;;
   esac
   if [ "$needs_display" = 1 ] && [ -z "$DISPLAY" ] && [ -z "$WAYLAND_DISPLAY" ]; then

+ 100 - 0
tests/test_demos.mod

@@ -0,0 +1,100 @@
+MODULE test_demos ;
+
+(*
+   m2-GTK4 test - the m2 gtk-demo registry (demos/).  Checks that the
+   registry is populated and that every demo can be built and torn down.
+   Requires a display.
+*)
+
+FROM GtkApplication IMPORT gtk_application_new;
+FROM Gio IMPORT g_application_run, g_application_quit;
+FROM GtkDemo IMPORT Count, TitleOf, KeywordsOf, BuildByTitle;
+FROM GtkUtils IMPORT Connect;
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM libc IMPORT printf;
+
+CONST
+   AppId = "org.example.m2gtk4.TestDemos";
+
+VAR
+   app: ADDRESS;
+   failures: INTEGER;
+
+PROCEDURE StrEqual (a, b: ARRAY OF CHAR) : BOOLEAN;
+VAR
+   i: CARDINAL;
+BEGIN
+   i := 0;
+   WHILE (a[i] # 0C) AND (b[i] # 0C) DO
+      IF a[i] # b[i] THEN RETURN FALSE END;
+      INC(i)
+   END;
+   RETURN a[i] = b[i]
+END StrEqual;
+
+PROCEDURE Check (cond: BOOLEAN; msg: ARRAY OF CHAR);
+BEGIN
+   IF cond THEN
+      printf("  ok - %s\n", msg)
+   ELSE
+      printf("  NOT OK - %s\n", msg);
+      INC(failures)
+   END
+END Check;
+
+(* build a demo once (creates + shows its window), then toggle it off. *)
+PROCEDURE BuildAndClose (title: ARRAY OF CHAR);
+VAR
+   w: ADDRESS;
+BEGIN
+   w := BuildByTitle(title, NIL);
+   Check(w # NIL, title);
+   IF w # NIL THEN
+      w := BuildByTitle(title, NIL)
+   END
+END BuildAndClose;
+
+PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
+VAR
+   t, kw: ARRAY [0..127] OF CHAR;
+BEGIN
+   failures := 0;
+
+   Check(Count() = 5, "registry reports 5 demos");
+   TitleOf(0, t);
+   Check(StrEqual(t, "Links"), "demo 0 is 'Links'");
+   KeywordsOf(0, kw);
+   Check(NOT StrEqual(kw, ""), "demo 0 has search keywords");
+   Check(BuildByTitle("NoSuchDemo", NIL) = NIL, "unknown demo yields NIL");
+
+   BuildAndClose("Links");
+   BuildAndClose("List Box");
+   BuildAndClose("Flow Box");
+   BuildAndClose("Expander");
+   BuildAndClose("CSS Basics");
+
+   IF failures = 0 THEN
+      printf("test_demos: PASS\n")
+   ELSE
+      printf("test_demos: FAIL (%d)\n", failures)
+   END;
+   g_application_quit(application)
+END OnActivate;
+
+VAR
+   rc: INTEGER;
+BEGIN
+   failures := 1;   (* set to 0 by OnActivate; stays 1 if it never runs *)
+   app := gtk_application_new(AppId, 0);
+   IF app = NIL THEN
+      printf("test_demos: FAIL (no app)\n");
+      HALT(1)
+   END;
+   Connect(app, "activate", ADR(OnActivate), NIL);
+   rc := g_application_run(app, 0, NIL);
+   IF failures = 0 THEN
+      HALT(0)
+   ELSE
+      HALT(1)
+   END
+END test_demos.