Przeglądaj źródła

feat: custom models in the shim, drag-and-drop/clipboard, and media

Shim (item 1):
- M2ListModel: a generic GListModel in lib/m2gtkshim.c driven by
  Modula-2 get_n_items/get_item callbacks; m2_list_model_items_changed
- test_shim2

Drag-and-drop / clipboard (item 2):
- GtkDropTarget, GtkDragSource, GdkContentProvider, GdkClipboard
- Gdk: gdk_display_get_clipboard + GdkDragAction constants
- GObject: g_type_from_name
- test_dnd, examples/clipboard.mod

Media (item 3):
- GdkTexture, GdkPixbuf, GtkVideo, GtkMediaFile, GtkMediaStream
- GtkImage: new_from_paintable/set_from_paintable
- test_media, examples/media.mod

31 tests pass; 132 src modules, 22 examples.
Eric Streit 3 dni temu
rodzic
commit
ef9e8b9c11

+ 2 - 2
Makefile

@@ -19,8 +19,8 @@ OBJS    := $(OBJDIR)/GtkUtils.o $(OBJDIR)/GtkClosures.o $(OBJDIR)/m2gtkshim.o
 
 INCLUDES := -I$(SRC_DIR) -I$(LIB_DIR)
 
-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_application
-EXAMPLES := hello counter inputs containers actions headerbar editor layouts files views builder feedback styling popover dialogs drawing demo gestures customwidget
+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_dnd test_media test_application
+EXAMPLES := hello counter inputs containers actions headerbar editor layouts files views builder feedback styling popover dialogs drawing demo gestures customwidget media clipboard
 
 # Include the libadwaita test/example only when libadwaita is installed.
 ifneq ($(ADWLIBS),)

+ 8 - 4
README.md

@@ -14,14 +14,14 @@ Verified with `gm2` 16.0.1 (experimental), GTK 4.18.6 and libadwaita 1.7.6.
 
 ## Features
 
-- **123 hand-written binding modules** across GLib, GObject, Gio, GTK4
+- **132 hand-written binding modules** across GLib, GObject, Gio, GTK4
   and libadwaita — windows, widgets, inputs, containers, model-backed
   views, actions/menus/accelerators, dialogs, CSS, drawing (Cairo/Pango),
-  gestures, settings, and more.
+  gestures, drag-and-drop, media, settings, and more.
 - **Pure-Modula-2 helpers**: `GtkUtils` (string/number conversion,
   `Connect`, `SetAccel`, ownership and `GError` helpers) and
   `GtkClosures` (per-connection signal contexts with cleanup).
-- **28 tests** and **20 runnable examples**.
+- **31 tests** and **22 runnable examples**.
 - **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.
@@ -122,6 +122,8 @@ gm2 -fiso -Isrc -Ilib myprog.mod \
 | `demo` | searchable demo browser (filter model + stack of pages) |
 | `gestures` | click/drag gestures on a drawing area |
 | `customwidget` | custom `GtkWidget` and `GdkPaintable` via the C shim |
+| `media` | `GdkTexture` in a `GtkPicture`, plus `GtkVideo` |
+| `clipboard` | copy/paste text through `GdkClipboard` |
 | `adw` | libadwaita preferences app (toolbar view, rows, toast, about) |
 
 ## Module reference
@@ -151,6 +153,8 @@ gm2 -fiso -Isrc -Ilib myprog.mod \
 | `GtkMultiSelection`, `GtkBitset` | multiple selection and bitsets |
 | `GtkTreeListModel`, `GtkTreeListRow`, `GtkTreeExpander` | tree models and expanders |
 | `GtkDirectoryList`, `GtkBookmarkList` | directory / bookmark models |
+| `GtkDropTarget`, `GtkDragSource`, `GdkContentProvider`, `GdkClipboard` | drag-and-drop and clipboard |
+| `GdkTexture`, `GdkPixbuf`, `GtkVideo`, `GtkMediaFile`, `GtkMediaStream` | images and media |
 | `GFile`, `GtkFileDialog` | file handles and the native dialog |
 | `GSettings`, `GSettingsSchema` | typed settings and schema lookup |
 
@@ -192,7 +196,7 @@ gm2 -fiso -Isrc -Ilib myprog.mod \
 |---|---|
 | `GtkUtils` | `CStrToM2`, `StrAppend`, `IntToStr`, `Connect`, `SetAccel`, `Unref`, `Free`, `ErrorMessage`, `ClearError` |
 | `GtkClosures` | `Connect2`/`Connect3` (and owned variants) for per-connection signal state |
-| `M2GtkShim` (`lib/m2gtkshim.c`) | C shim for GObject subclassing: a custom `GtkWidget` and `GdkPaintable` whose snapshot vfuncs hand a Cairo context to Modula-2 |
+| `M2GtkShim` (`lib/m2gtkshim.c`) | C shim for GObject subclassing: a custom `GtkWidget`, a `GdkPaintable`, and a generic `GListModel`, all driven by Modula-2 callbacks |
 
 ## Signals, ownership and errors
 

+ 118 - 0
examples/clipboard.mod

@@ -0,0 +1,118 @@
+MODULE clipboard ;
+
+(*
+   m2-GTK4 example - clipboard copy/paste between two entries.
+
+   "Copy" puts the first entry's text on the clipboard; "Paste" reads the
+   clipboard asynchronously and puts it in the second entry.
+
+   Build:  make examples
+   Run:    ./build/examples/clipboard
+*)
+
+FROM Gio IMPORT g_application_run;
+FROM GtkApplication IMPORT gtk_application_new;
+FROM GtkWindow IMPORT gtk_application_window_new, 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 GtkEntry IMPORT gtk_entry_new, gtk_entry_set_placeholder_text;
+FROM GtkEditable IMPORT gtk_editable_get_text, gtk_editable_set_text;
+FROM GtkButton IMPORT gtk_button_new_with_label;
+FROM GtkWidget IMPORT gtk_widget_set_margin_top,
+   gtk_widget_set_margin_bottom, gtk_widget_set_margin_start,
+   gtk_widget_set_margin_end;
+FROM Gdk IMPORT gdk_display_get_default, gdk_display_get_clipboard;
+FROM GdkClipboard IMPORT gdk_clipboard_set_text,
+   gdk_clipboard_read_text_async, gdk_clipboard_read_text_finish;
+FROM GError IMPORT GError;
+FROM GtkClosures IMPORT Connect2;
+FROM GtkUtils IMPORT CStrToM2, Free, ClearError;
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM libc IMPORT printf;
+
+CONST
+   AppId = "org.example.m2gtk4.Clipboard";
+
+VAR
+   clipboard, sourceEntry, destEntry: ADDRESS;
+
+PROCEDURE OnCopy (button: ADDRESS; user: ADDRESS);
+VAR
+   text: ARRAY [0..255] OF CHAR;
+BEGIN
+   CStrToM2(gtk_editable_get_text(sourceEntry), text);
+   gdk_clipboard_set_text(clipboard, text)
+END OnCopy;
+
+(* void on_read(GObject *source, GAsyncResult *result, gpointer user) *)
+PROCEDURE OnRead (source: ADDRESS; result: ADDRESS; user: ADDRESS);
+VAR
+   s: ADDRESS;
+   err: GError;
+   text: ARRAY [0..255] OF CHAR;
+BEGIN
+   err := NIL;
+   s := gdk_clipboard_read_text_finish(clipboard, result, err);
+   IF s = NIL THEN
+      ClearError(err)
+   ELSE
+      CStrToM2(s, text);
+      gtk_editable_set_text(destEntry, text);
+      Free(s)
+   END
+END OnRead;
+
+PROCEDURE OnPaste (button: ADDRESS; user: ADDRESS);
+BEGIN
+   gdk_clipboard_read_text_async(clipboard, NIL, ADR(OnRead), NIL)
+END OnPaste;
+
+PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
+VAR
+   window, box, buttons, copyButton, pasteButton: ADDRESS;
+BEGIN
+   clipboard := gdk_display_get_clipboard(gdk_display_get_default());
+
+   sourceEntry := gtk_entry_new();
+   gtk_entry_set_placeholder_text(sourceEntry, "type some text");
+   destEntry := gtk_entry_new();
+   gtk_entry_set_placeholder_text(destEntry, "pasted text appears here");
+
+   copyButton := gtk_button_new_with_label("Copy");
+   Connect2(copyButton, "clicked", OnCopy, NIL);
+   pasteButton := gtk_button_new_with_label("Paste");
+   Connect2(pasteButton, "clicked", OnPaste, NIL);
+
+   buttons := gtk_box_new(GtkHorizontal, 8);
+   gtk_box_append(buttons, copyButton);
+   gtk_box_append(buttons, pasteButton);
+
+   box := gtk_box_new(GtkVertical, 8);
+   gtk_box_set_spacing(box, 8);
+   gtk_widget_set_margin_top(box, 12);
+   gtk_widget_set_margin_bottom(box, 12);
+   gtk_widget_set_margin_start(box, 12);
+   gtk_widget_set_margin_end(box, 12);
+   gtk_box_append(box, sourceEntry);
+   gtk_box_append(box, buttons);
+   gtk_box_append(box, destEntry);
+
+   window := gtk_application_window_new(application);
+   gtk_window_set_title(window, "m2-GTK4 Clipboard");
+   gtk_window_set_default_size(window, 360, 180);
+   gtk_window_set_child(window, box);
+   gtk_window_present(window)
+END OnActivate;
+
+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", OnActivate, NIL);
+   g_application_run(app, 0, NIL)
+END clipboard.

+ 90 - 0
examples/media.mod

@@ -0,0 +1,90 @@
+MODULE media ;
+
+(*
+   m2-GTK4 example - media: a GdkTexture shown in a GtkPicture.
+
+   Generates a PNG with Cairo at run time, loads it as a texture and
+   displays it; a GtkVideo widget is added as a placeholder.
+
+   Build:  make examples
+   Run:    ./build/examples/media
+*)
+
+FROM Gio IMPORT g_application_run;
+FROM GtkApplication IMPORT gtk_application_new;
+FROM GtkWindow IMPORT gtk_application_window_new, 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;
+FROM GtkPicture IMPORT gtk_picture_new, gtk_picture_set_paintable;
+FROM GtkVideo IMPORT gtk_video_new;
+FROM GdkTexture IMPORT gdk_texture_new_from_filename;
+FROM GError IMPORT GError;
+FROM Cairo IMPORT cairo_image_surface_create, cairo_create, cairo_destroy,
+   cairo_surface_destroy, cairo_set_source_rgb, cairo_rectangle, cairo_fill,
+   cairo_surface_write_to_png, CairoFormatARGB32;
+FROM GtkClosures IMPORT Connect2;
+FROM GtkUtils IMPORT ClearError;
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM libc IMPORT printf;
+
+CONST
+   AppId = "org.example.m2gtk4.Media";
+   PngPath = "/tmp/opencode/m2media_demo.png";
+
+PROCEDURE MakePng;
+VAR
+   surface, cr: ADDRESS;
+BEGIN
+   surface := cairo_image_surface_create(CairoFormatARGB32, 200, 120);
+   cr := cairo_create(surface);
+   cairo_set_source_rgb(cr, 0.16, 0.50, 0.72);
+   cairo_rectangle(cr, 0.0, 0.0, 200.0, 120.0);
+   cairo_fill(cr);
+   cairo_destroy(cr);
+   cairo_surface_write_to_png(surface, PngPath);
+   cairo_surface_destroy(surface)
+END MakePng;
+
+PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
+VAR
+   window, box, picture, video, texture: ADDRESS;
+   err: GError;
+BEGIN
+   MakePng();
+
+   err := NIL;
+   texture := gdk_texture_new_from_filename(PngPath, err);
+   picture := gtk_picture_new();
+   IF texture # NIL THEN
+      gtk_picture_set_paintable(picture, texture)
+   ELSE
+      printf("could not load %s\n", PngPath);
+      ClearError(err)
+   END;
+
+   video := gtk_video_new();
+
+   box := gtk_box_new(GtkVertical, 8);
+   gtk_box_set_spacing(box, 8);
+   gtk_box_append(box, picture);
+   gtk_box_append(box, video);
+
+   window := gtk_application_window_new(application);
+   gtk_window_set_title(window, "m2-GTK4 Media");
+   gtk_window_set_default_size(window, 320, 320);
+   gtk_window_set_child(window, box);
+   gtk_window_present(window)
+END OnActivate;
+
+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", OnActivate, NIL);
+   g_application_run(app, 0, NIL)
+END media.

+ 23 - 1
lib/M2GtkShim.def

@@ -29,7 +29,9 @@ FROM SYSTEM IMPORT ADDRESS;
 EXPORT UNQUALIFIED
    M2Widget, M2WidgetDrawFunc,
    M2Paintable, M2PaintableDrawFunc,
-   m2_gtk_widget_new, m2_paintable_new;
+   M2ListModel, M2ListModelGetNItemsFunc, M2ListModelGetItemFunc,
+   m2_gtk_widget_new, m2_paintable_new,
+   m2_list_model_new, m2_list_model_items_changed;
 
 
 TYPE
@@ -37,6 +39,12 @@ TYPE
    M2WidgetDrawFunc = ADDRESS;
    M2Paintable = ADDRESS;
    M2PaintableDrawFunc = ADDRESS;
+   M2ListModel = ADDRESS;
+   (* PROCEDURE (user: ADDRESS) : CARDINAL *)
+   M2ListModelGetNItemsFunc = ADDRESS;
+   (* PROCEDURE (position: CARDINAL; user: ADDRESS) : ADDRESS
+      Must return a new reference (transfer full). *)
+   M2ListModelGetItemFunc = ADDRESS;
 
 (* GtkWidget *m2_gtk_widget_new(M2WidgetDrawFunc draw, gpointer user_data,
                                 GDestroyNotify destroy) *)
@@ -49,4 +57,18 @@ PROCEDURE m2_gtk_widget_new (draw: M2WidgetDrawFunc; user_data: ADDRESS;
 PROCEDURE m2_paintable_new (draw: M2PaintableDrawFunc; width, height: INTEGER;
                             user_data: ADDRESS; destroy: ADDRESS) : M2Paintable;
 
+(* GListModel *m2_list_model_new(M2ListModelGetNItemsFunc get_n_items,
+                                 M2ListModelGetItemFunc get_item,
+                                 GType item_type, gpointer user_data,
+                                 GDestroyNotify destroy) *)
+PROCEDURE m2_list_model_new (get_n_items: M2ListModelGetNItemsFunc;
+                             get_item: M2ListModelGetItemFunc;
+                             item_type: LONGCARD; user_data: ADDRESS;
+                             destroy: ADDRESS) : M2ListModel;
+
+(* void m2_list_model_items_changed(GListModel *model, guint position,
+                                     guint removed, guint added) *)
+PROCEDURE m2_list_model_items_changed (model: M2ListModel;
+                                       position, removed, added: CARDINAL);
+
 END M2GtkShim.

+ 110 - 0
lib/m2gtkshim.c

@@ -215,3 +215,113 @@ m2_paintable_new (M2PaintableDrawFunc draw, int width, int height,
   self->destroy = destroy;
   return GDK_PAINTABLE (self);
 }
+
+/* ------------------------------------------------------------------ */
+/* M2ListModel (implements GListModel)                                 */
+/* ------------------------------------------------------------------ */
+
+typedef guint    (*M2ListModelGetNItemsFunc) (gpointer user_data);
+typedef gpointer (*M2ListModelGetItemFunc)   (guint position,
+                                              gpointer user_data);
+
+typedef struct _M2ListModel M2ListModel;
+typedef struct _M2ListModelClass M2ListModelClass;
+
+struct _M2ListModel
+{
+  GObject parent_instance;
+  M2ListModelGetNItemsFunc get_n_items;
+  M2ListModelGetItemFunc get_item;
+  gpointer user_data;
+  GDestroyNotify destroy;
+  GType item_type;
+};
+
+struct _M2ListModelClass
+{
+  GObjectClass parent_class;
+};
+
+static guint
+m2_list_model_get_n_items (GListModel *list)
+{
+  M2ListModel *self = (M2ListModel *) list;
+
+  return self->get_n_items != NULL ? self->get_n_items (self->user_data) : 0;
+}
+
+static GType
+m2_list_model_get_item_type (GListModel *list)
+{
+  return ((M2ListModel *) list)->item_type;
+}
+
+static gpointer
+m2_list_model_get_item (GListModel *list, guint position)
+{
+  M2ListModel *self = (M2ListModel *) list;
+
+  return self->get_item != NULL ? self->get_item (position, self->user_data)
+                                : NULL;
+}
+
+static void
+m2_list_model_list_init (GListModelInterface *iface)
+{
+  iface->get_n_items = m2_list_model_get_n_items;
+  iface->get_item_type = m2_list_model_get_item_type;
+  iface->get_item = m2_list_model_get_item;
+}
+
+G_DEFINE_TYPE_WITH_CODE (M2ListModel, m2_list_model, G_TYPE_OBJECT,
+                         G_IMPLEMENT_INTERFACE (G_TYPE_LIST_MODEL,
+                                                m2_list_model_list_init))
+
+static void
+m2_list_model_finalize (GObject *object)
+{
+  M2ListModel *self = (M2ListModel *) object;
+
+  if (self->destroy != NULL)
+    self->destroy (self->user_data);
+
+  G_OBJECT_CLASS (m2_list_model_parent_class)->finalize (object);
+}
+
+static void
+m2_list_model_class_init (M2ListModelClass *klass)
+{
+  G_OBJECT_CLASS (klass)->finalize = m2_list_model_finalize;
+}
+
+static void
+m2_list_model_init (M2ListModel *self)
+{
+  self->get_n_items = NULL;
+  self->get_item = NULL;
+  self->user_data = NULL;
+  self->destroy = NULL;
+  self->item_type = G_TYPE_OBJECT;
+}
+
+GListModel *
+m2_list_model_new (M2ListModelGetNItemsFunc get_n_items,
+                   M2ListModelGetItemFunc get_item, GType item_type,
+                   gpointer user_data, GDestroyNotify destroy)
+{
+  M2ListModel *self = g_object_new (m2_list_model_get_type (), NULL);
+
+  self->get_n_items = get_n_items;
+  self->get_item = get_item;
+  self->item_type = item_type;
+  self->user_data = user_data;
+  self->destroy = destroy;
+  return G_LIST_MODEL (self);
+}
+
+void
+m2_list_model_items_changed (GListModel *model, guint position,
+                             guint removed, guint added)
+{
+  g_list_model_items_changed (model, position, removed, added);
+}

+ 4 - 1
src/GObject.def

@@ -30,7 +30,7 @@ FROM SYSTEM IMPORT ADDRESS;
 EXPORT UNQUALIFIED
    GObject, GType, GCallback, GClosureNotify, GConnectFlags, GSignalHandlerID,
    GConnectDefault, GConnectAfter, GConnectSwapped,
-   g_object_get_type, g_object_new,
+   g_object_get_type, g_object_new, g_type_from_name,
    g_object_ref, g_object_unref,
    g_signal_connect_data, g_signal_handler_disconnect,
    g_signal_emit_by_name,
@@ -55,6 +55,9 @@ CONST
 (* GType g_object_get_type(void) *)
 PROCEDURE g_object_get_type () : GType;
 
+(* GType g_type_from_name(const gchar *name) *)
+PROCEDURE g_type_from_name (name: ARRAY OF CHAR) : GType;
+
 (* gpointer g_object_new(GType object_type, const gchar *first_property_name, ...) *)
 PROCEDURE g_object_new (object_type: GType;
                         first_property_name: ARRAY OF CHAR; ...) : ADDRESS;

+ 12 - 2
src/Gdk.def

@@ -11,8 +11,9 @@ DEFINITION MODULE FOR "C" Gdk ;
 FROM SYSTEM IMPORT ADDRESS;
 
 EXPORT UNQUALIFIED
-   GdkDisplay, GdkRGBA, GdkRGBAPtr,
-   gdk_display_get_default,
+   GdkDisplay, GdkRGBA, GdkRGBAPtr, GdkDragAction,
+   GdkActionCopy, GdkActionMove, GdkActionLink,
+   gdk_display_get_default, gdk_display_get_clipboard,
    gdk_rgba_free, gdk_rgba_to_string;
 
 
@@ -23,10 +24,19 @@ TYPE
       red, green, blue, alpha: SHORTREAL;
    END;
    GdkRGBAPtr = POINTER TO GdkRGBA;
+   GdkDragAction = CARDINAL;
+
+CONST
+   GdkActionCopy = 2;   (* GDK_ACTION_COPY *)
+   GdkActionMove = 4;   (* GDK_ACTION_MOVE *)
+   GdkActionLink = 8;   (* GDK_ACTION_LINK *)
 
 (* GdkDisplay *gdk_display_get_default(void) *)
 PROCEDURE gdk_display_get_default () : GdkDisplay;
 
+(* GdkClipboard *gdk_display_get_clipboard(GdkDisplay *display) *)
+PROCEDURE gdk_display_get_clipboard (display: GdkDisplay) : ADDRESS;
+
 (* void gdk_rgba_free(GdkRGBA *rgba) *)
 PROCEDURE gdk_rgba_free (rgba: ADDRESS);
 

+ 47 - 0
src/GdkClipboard.def

@@ -0,0 +1,47 @@
+DEFINITION MODULE FOR "C" GdkClipboard ;
+
+(*
+   m2-GTK4 - GdkClipboard.  Mapped onto <gdk/gdkclipboard.h>.
+
+   Get the default display's clipboard with
+   Gdk.gdk_display_get_clipboard(), then set or read text.  Reading is
+   asynchronous:
+
+      gdk_clipboard_read_text_async(clipboard, NIL, ADR(OnRead), NIL);
+      ...
+      (* void on_read(GObject *src, GAsyncResult *res, gpointer user) *)
+      text := gdk_clipboard_read_text_finish(clipboard, res, err);
+      (* text is newly allocated; free with GtkUtils.Free *)
+*)
+
+FROM SYSTEM IMPORT ADDRESS;
+FROM GError IMPORT GError;
+
+EXPORT UNQUALIFIED
+   GdkClipboard,
+   gdk_clipboard_set_text,
+   gdk_clipboard_read_text_async, gdk_clipboard_read_text_finish;
+
+
+TYPE
+   GdkClipboard = ADDRESS;
+
+(* void gdk_clipboard_set_text(GdkClipboard *clipboard, const char *text) *)
+PROCEDURE gdk_clipboard_set_text (clipboard: GdkClipboard; text: ARRAY OF CHAR);
+
+(* void gdk_clipboard_read_text_async(GdkClipboard *clipboard,
+                                      GCancellable *cancellable,
+                                      GAsyncReadyCallback callback,
+                                      gpointer user_data) *)
+PROCEDURE gdk_clipboard_read_text_async (clipboard: GdkClipboard;
+                                         cancellable: ADDRESS;
+                                         callback: ADDRESS;
+                                         user_data: ADDRESS);
+
+(* char *gdk_clipboard_read_text_finish(GdkClipboard *clipboard,
+                                         GAsyncResult *result, GError **error) *)
+PROCEDURE gdk_clipboard_read_text_finish (clipboard: GdkClipboard;
+                                          result: ADDRESS;
+                                          VAR error: GError) : ADDRESS;
+
+END GdkClipboard.

+ 38 - 0
src/GdkContentProvider.def

@@ -0,0 +1,38 @@
+DEFINITION MODULE FOR "C" GdkContentProvider ;
+
+(*
+   m2-GTK4 - GdkContentProvider: the data behind a drag or clipboard
+   operation.  Mapped onto <gdk/gdkcontentprovider.h>.
+
+   Convenience constructors:
+     for_bytes  - a provider for raw bytes of a given MIME type;
+     for_value  - a provider for a single GValue;
+     new_union  - combine several providers.
+*)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+EXPORT UNQUALIFIED
+   GdkContentProvider,
+   gdk_content_provider_new_for_bytes,
+   gdk_content_provider_new_for_value,
+   gdk_content_provider_new_union;
+
+
+TYPE
+   GdkContentProvider = ADDRESS;
+
+(* GdkContentProvider *gdk_content_provider_new_for_bytes(
+                          const char *mime_type, GBytes *bytes) *)
+PROCEDURE gdk_content_provider_new_for_bytes (mime_type: ARRAY OF CHAR;
+                                              bytes: ADDRESS) : GdkContentProvider;
+
+(* GdkContentProvider *gdk_content_provider_new_for_value(const GValue *value) *)
+PROCEDURE gdk_content_provider_new_for_value (value: ADDRESS) : GdkContentProvider;
+
+(* GdkContentProvider *gdk_content_provider_new_union(
+                          GdkContentProvider **providers, gsize n_providers) *)
+PROCEDURE gdk_content_provider_new_union (providers: ADDRESS;
+                                          n_providers: LONGCARD) : GdkContentProvider;
+
+END GdkContentProvider.

+ 33 - 0
src/GdkPixbuf.def

@@ -0,0 +1,33 @@
+DEFINITION MODULE FOR "C" GdkPixbuf ;
+
+(*
+   m2-GTK4 - GdkPixbuf: CPU-side images.  Mapped onto
+   <gdk-pixbuf/gdk-pixbuf.h>.
+
+   A small subset; convert to a texture with GdkTexture for display, or
+   use it for image processing.
+*)
+
+FROM SYSTEM IMPORT ADDRESS;
+FROM GError IMPORT GError;
+
+EXPORT UNQUALIFIED
+   GdkPixbuf,
+   gdk_pixbuf_new_from_file,
+   gdk_pixbuf_get_width, gdk_pixbuf_get_height;
+
+
+TYPE
+   GdkPixbuf = ADDRESS;
+
+(* GdkPixbuf *gdk_pixbuf_new_from_file(const char *filename, GError **error) *)
+PROCEDURE gdk_pixbuf_new_from_file (filename: ARRAY OF CHAR;
+                                    VAR error: GError) : GdkPixbuf;
+
+(* int gdk_pixbuf_get_width(const GdkPixbuf *pixbuf) *)
+PROCEDURE gdk_pixbuf_get_width (pixbuf: GdkPixbuf) : INTEGER;
+
+(* int gdk_pixbuf_get_height(const GdkPixbuf *pixbuf) *)
+PROCEDURE gdk_pixbuf_get_height (pixbuf: GdkPixbuf) : INTEGER;
+
+END GdkPixbuf.

+ 41 - 0
src/GdkTexture.def

@@ -0,0 +1,41 @@
+DEFINITION MODULE FOR "C" GdkTexture ;
+
+(*
+   m2-GTK4 - GdkTexture: an image on the GPU, and a GdkPaintable.
+   Mapped onto <gdk/gdktexture.h>.
+
+   Show it with GtkPicture.gtk_picture_set_paintable or
+   GtkImage.gtk_image_set_from_paintable.  The loaders take a GError.
+*)
+
+FROM SYSTEM IMPORT ADDRESS;
+FROM GError IMPORT GError;
+
+EXPORT UNQUALIFIED
+   GdkTexture,
+   gdk_texture_new_from_file, gdk_texture_new_from_filename,
+   gdk_texture_new_from_resource,
+   gdk_texture_get_width, gdk_texture_get_height;
+
+
+TYPE
+   GdkTexture = ADDRESS;
+
+(* GdkTexture *gdk_texture_new_from_file(GFile *file, GError **error) *)
+PROCEDURE gdk_texture_new_from_file (file: ADDRESS;
+                                     VAR error: GError) : GdkTexture;
+
+(* GdkTexture *gdk_texture_new_from_filename(const char *path, GError **error) *)
+PROCEDURE gdk_texture_new_from_filename (path: ARRAY OF CHAR;
+                                         VAR error: GError) : GdkTexture;
+
+(* GdkTexture *gdk_texture_new_from_resource(const char *resource_path) *)
+PROCEDURE gdk_texture_new_from_resource (resource_path: ARRAY OF CHAR) : GdkTexture;
+
+(* int gdk_texture_get_width(GdkTexture *texture) *)
+PROCEDURE gdk_texture_get_width (texture: GdkTexture) : INTEGER;
+
+(* int gdk_texture_get_height(GdkTexture *texture) *)
+PROCEDURE gdk_texture_get_height (texture: GdkTexture) : INTEGER;
+
+END GdkTexture.

+ 46 - 0
src/GtkDragSource.def

@@ -0,0 +1,46 @@
+DEFINITION MODULE FOR "C" GtkDragSource ;
+
+(*
+   m2-GTK4 - GtkDragSource: an event controller that starts drags.
+   Mapped onto <gtk/gtkdragsource.h>.
+
+   Add it to a widget with GtkWidget.gtk_widget_add_controller(), then
+   set the content (a GdkContentProvider) and the allowed actions.
+   Signals: "prepare"/"drag-begin"/"drag-end"/"cancel".
+*)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+EXPORT UNQUALIFIED
+   GtkDragSource,
+   gtk_drag_source_new,
+   gtk_drag_source_set_content, gtk_drag_source_get_content,
+   gtk_drag_source_set_actions, gtk_drag_source_get_actions,
+   gtk_drag_source_set_icon;
+
+
+TYPE
+   GtkDragSource = ADDRESS;
+
+(* GtkDragSource *gtk_drag_source_new(void) *)
+PROCEDURE gtk_drag_source_new () : GtkDragSource;
+
+(* void gtk_drag_source_set_content(GtkDragSource *source,
+                                     GdkContentProvider *content) *)
+PROCEDURE gtk_drag_source_set_content (source: GtkDragSource; content: ADDRESS);
+
+(* GdkContentProvider *gtk_drag_source_get_content(GtkDragSource *source) *)
+PROCEDURE gtk_drag_source_get_content (source: GtkDragSource) : ADDRESS;
+
+(* void gtk_drag_source_set_actions(GtkDragSource *source, GdkDragAction actions) *)
+PROCEDURE gtk_drag_source_set_actions (source: GtkDragSource; actions: CARDINAL);
+
+(* GdkDragAction gtk_drag_source_get_actions(GtkDragSource *source) *)
+PROCEDURE gtk_drag_source_get_actions (source: GtkDragSource) : CARDINAL;
+
+(* void gtk_drag_source_set_icon(GtkDragSource *source, GdkPaintable *paintable,
+                                  int hot_x, int hot_y) *)
+PROCEDURE gtk_drag_source_set_icon (source: GtkDragSource; paintable: ADDRESS;
+                                    hot_x, hot_y: INTEGER);
+
+END GtkDragSource.

+ 47 - 0
src/GtkDropTarget.def

@@ -0,0 +1,47 @@
+DEFINITION MODULE FOR "C" GtkDropTarget ;
+
+(*
+   m2-GTK4 - GtkDropTarget: an event controller that accepts drops.
+   Mapped onto <gtk/gtkdroptarget.h>.
+
+   Add it to a widget with GtkWidget.gtk_widget_add_controller().  The
+   item type is a GType (use GObject.g_type_from_name("gchararray") for
+   text, or gtk_string_object_get_type()).  Signals: "drop"/"accept"/
+   "enter"/"motion"/"leave".
+*)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+EXPORT UNQUALIFIED
+   GtkDropTarget,
+   gtk_drop_target_new,
+   gtk_drop_target_set_actions, gtk_drop_target_get_actions,
+   gtk_drop_target_set_gtypes,
+   gtk_drop_target_get_drop, gtk_drop_target_get_current_drop;
+
+
+TYPE
+   GtkDropTarget = ADDRESS;
+
+(* GtkDropTarget *gtk_drop_target_new(GType type, GdkDragAction actions) *)
+PROCEDURE gtk_drop_target_new (item_type: LONGCARD;
+                               actions: CARDINAL) : GtkDropTarget;
+
+(* void gtk_drop_target_set_actions(GtkDropTarget *self, GdkDragAction actions) *)
+PROCEDURE gtk_drop_target_set_actions (self: GtkDropTarget; actions: CARDINAL);
+
+(* GdkDragAction gtk_drop_target_get_actions(GtkDropTarget *self) *)
+PROCEDURE gtk_drop_target_get_actions (self: GtkDropTarget) : CARDINAL;
+
+(* void gtk_drop_target_set_gtypes(GtkDropTarget *self, GType *types,
+                                   gsize n_types) *)
+PROCEDURE gtk_drop_target_set_gtypes (self: GtkDropTarget; types: ADDRESS;
+                                      n_types: LONGCARD);
+
+(* GdkDrop *gtk_drop_target_get_drop(GtkDropTarget *self) *)
+PROCEDURE gtk_drop_target_get_drop (self: GtkDropTarget) : ADDRESS;
+
+(* GdkDrop *gtk_drop_target_get_current_drop(GtkDropTarget *self) *)
+PROCEDURE gtk_drop_target_get_current_drop (self: GtkDropTarget) : ADDRESS;
+
+END GtkDropTarget.

+ 9 - 1
src/GtkImage.def

@@ -14,7 +14,9 @@ EXPORT UNQUALIFIED
    GtkImage,
    gtk_image_new,
    gtk_image_new_from_icon_name, gtk_image_new_from_file,
-   gtk_image_set_from_icon_name, gtk_image_get_icon_name;
+   gtk_image_new_from_paintable,
+   gtk_image_set_from_icon_name, gtk_image_get_icon_name,
+   gtk_image_set_from_paintable;
 
 
 TYPE
@@ -29,6 +31,12 @@ PROCEDURE gtk_image_new_from_icon_name (icon_name: ARRAY OF CHAR) : GtkImage;
 (* GtkWidget *gtk_image_new_from_file(const char *filename) *)
 PROCEDURE gtk_image_new_from_file (filename: ARRAY OF CHAR) : GtkImage;
 
+(* GtkWidget *gtk_image_new_from_paintable(GdkPaintable *paintable) *)
+PROCEDURE gtk_image_new_from_paintable (paintable: ADDRESS) : GtkImage;
+
+(* void gtk_image_set_from_paintable(GtkImage *image, GdkPaintable *paintable) *)
+PROCEDURE gtk_image_set_from_paintable (image: GtkImage; paintable: ADDRESS);
+
 (* void gtk_image_set_from_icon_name(GtkImage *image, const char *icon_name) *)
 PROCEDURE gtk_image_set_from_icon_name (image: GtkImage;
                                         icon_name: ARRAY OF CHAR);

+ 36 - 0
src/GtkMediaFile.def

@@ -0,0 +1,36 @@
+DEFINITION MODULE FOR "C" GtkMediaFile ;
+
+(*
+   m2-GTK4 - GtkMediaFile: a GtkMediaStream backed by a file.  Mapped
+   onto <gtk/gtkmediafile.h>.
+*)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+EXPORT UNQUALIFIED
+   GtkMediaFile,
+   gtk_media_file_new, gtk_media_file_new_for_filename,
+   gtk_media_file_new_for_file,
+   gtk_media_file_set_filename, gtk_media_file_set_file;
+
+
+TYPE
+   GtkMediaFile = ADDRESS;
+
+(* GtkMediaStream *gtk_media_file_new(void) *)
+PROCEDURE gtk_media_file_new () : GtkMediaFile;
+
+(* GtkMediaStream *gtk_media_file_new_for_filename(const char *filename) *)
+PROCEDURE gtk_media_file_new_for_filename (filename: ARRAY OF CHAR) : GtkMediaFile;
+
+(* GtkMediaStream *gtk_media_file_new_for_file(GFile *file) *)
+PROCEDURE gtk_media_file_new_for_file (file: ADDRESS) : GtkMediaFile;
+
+(* void gtk_media_file_set_filename(GtkMediaFile *self, const char *filename) *)
+PROCEDURE gtk_media_file_set_filename (self: GtkMediaFile;
+                                       filename: ARRAY OF CHAR);
+
+(* void gtk_media_file_set_file(GtkMediaFile *self, GFile *file) *)
+PROCEDURE gtk_media_file_set_file (self: GtkMediaFile; file: ADDRESS);
+
+END GtkMediaFile.

+ 38 - 0
src/GtkMediaStream.def

@@ -0,0 +1,38 @@
+DEFINITION MODULE FOR "C" GtkMediaStream ;
+
+(*
+   m2-GTK4 - GtkMediaStream: playback control shared by GtkMediaFile and
+   GtkVideo's stream.  Mapped onto <gtk/gtkmediastream.h>.
+*)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+EXPORT UNQUALIFIED
+   GtkMediaStream,
+   gtk_media_stream_play, gtk_media_stream_pause,
+   gtk_media_stream_get_playing, gtk_media_stream_set_playing,
+   gtk_media_stream_set_loop, gtk_media_stream_get_loop;
+
+
+TYPE
+   GtkMediaStream = ADDRESS;
+
+(* void gtk_media_stream_play(GtkMediaStream *self) *)
+PROCEDURE gtk_media_stream_play (self: GtkMediaStream);
+
+(* void gtk_media_stream_pause(GtkMediaStream *self) *)
+PROCEDURE gtk_media_stream_pause (self: GtkMediaStream);
+
+(* gboolean gtk_media_stream_get_playing(GtkMediaStream *self) *)
+PROCEDURE gtk_media_stream_get_playing (self: GtkMediaStream) : [ INTEGER ];
+
+(* void gtk_media_stream_set_playing(GtkMediaStream *self, gboolean playing) *)
+PROCEDURE gtk_media_stream_set_playing (self: GtkMediaStream; playing: INTEGER);
+
+(* void gtk_media_stream_set_loop(GtkMediaStream *self, gboolean loop) *)
+PROCEDURE gtk_media_stream_set_loop (self: GtkMediaStream; loop: INTEGER);
+
+(* gboolean gtk_media_stream_get_loop(GtkMediaStream *self) *)
+PROCEDURE gtk_media_stream_get_loop (self: GtkMediaStream) : [ INTEGER ];
+
+END GtkMediaStream.

+ 55 - 0
src/GtkVideo.def

@@ -0,0 +1,55 @@
+DEFINITION MODULE FOR "C" GtkVideo ;
+
+(*
+   m2-GTK4 - GtkVideo: a video player widget.  Mapped onto
+   <gtk/gtkvideo.h>.
+
+   Set a file with set_filename(), optionally set autoplay/loop, and get
+   the underlying stream with get_media_stream() for play/pause.
+*)
+
+FROM SYSTEM IMPORT ADDRESS;
+
+EXPORT UNQUALIFIED
+   GtkVideo,
+   gtk_video_new, gtk_video_new_for_filename, gtk_video_new_for_file,
+   gtk_video_set_filename, gtk_video_set_file,
+   gtk_video_get_media_stream,
+   gtk_video_set_autoplay, gtk_video_get_autoplay,
+   gtk_video_set_loop, gtk_video_get_loop;
+
+
+TYPE
+   GtkVideo = ADDRESS;
+
+(* GtkWidget *gtk_video_new(void) *)
+PROCEDURE gtk_video_new () : GtkVideo;
+
+(* GtkWidget *gtk_video_new_for_filename(const char *filename) *)
+PROCEDURE gtk_video_new_for_filename (filename: ARRAY OF CHAR) : GtkVideo;
+
+(* GtkWidget *gtk_video_new_for_file(GFile *file) *)
+PROCEDURE gtk_video_new_for_file (file: ADDRESS) : GtkVideo;
+
+(* void gtk_video_set_filename(GtkVideo *self, const char *filename) *)
+PROCEDURE gtk_video_set_filename (self: GtkVideo; filename: ARRAY OF CHAR);
+
+(* void gtk_video_set_file(GtkVideo *self, GFile *file) *)
+PROCEDURE gtk_video_set_file (self: GtkVideo; file: ADDRESS);
+
+(* GtkMediaStream *gtk_video_get_media_stream(GtkVideo *self) *)
+PROCEDURE gtk_video_get_media_stream (self: GtkVideo) : ADDRESS;
+
+(* void gtk_video_set_autoplay(GtkVideo *self, gboolean autoplay) *)
+PROCEDURE gtk_video_set_autoplay (self: GtkVideo; autoplay: INTEGER);
+
+(* gboolean gtk_video_get_autoplay(GtkVideo *self) *)
+PROCEDURE gtk_video_get_autoplay (self: GtkVideo) : [ INTEGER ];
+
+(* void gtk_video_set_loop(GtkVideo *self, gboolean loop) *)
+PROCEDURE gtk_video_set_loop (self: GtkVideo; loop: INTEGER);
+
+(* gboolean gtk_video_get_loop(GtkVideo *self) *)
+PROCEDURE gtk_video_get_loop (self: GtkVideo) : [ INTEGER ];
+
+END GtkVideo.

+ 2 - 2
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_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_dnd test_media test_application"
 if pkg-config --exists libadwaita-1 2>/dev/null; then
   CFLAGS="$CFLAGS $(pkg-config --cflags libadwaita-1)"
   LIBS="$LIBS $(pkg-config --libs libadwaita-1)"
@@ -48,7 +48,7 @@ for t in $TESTS; do
        "$ROOT/tests/$t.mod" "$OBJ/GtkUtils.o" "$OBJ/GtkClosures.o" \
        "$OBJ/m2gtkshim.o" -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_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_dnd|test_media|test_adw|test_application) needs_display=1 ;;
     *) needs_display=0 ;;
   esac
   if [ "$needs_display" = 1 ] && [ -z "$DISPLAY" ] && [ -z "$WAYLAND_DISPLAY" ]; then

+ 138 - 0
tests/test_dnd.mod

@@ -0,0 +1,138 @@
+MODULE test_dnd ;
+
+(*
+   m2-GTK4 test - drag and drop controllers and the clipboard.
+
+   Constructs a GtkDropTarget and a GtkDragSource, adds them to a widget,
+   then round-trips text through the clipboard asynchronously.
+   Requires a display.
+*)
+
+FROM Gio IMPORT g_application_run, g_application_quit;
+FROM GtkApplication IMPORT gtk_application_new;
+FROM GtkWindow IMPORT gtk_application_window_new, gtk_window_set_child,
+   gtk_window_present;
+FROM GtkBox IMPORT gtk_box_new, gtk_box_append;
+FROM GtkEnums IMPORT GtkVertical;
+FROM GtkLabel IMPORT gtk_label_new;
+FROM GtkWidget IMPORT gtk_widget_add_controller;
+FROM GtkDropTarget IMPORT gtk_drop_target_new, gtk_drop_target_set_actions,
+   gtk_drop_target_get_actions;
+FROM GtkDragSource IMPORT gtk_drag_source_new, gtk_drag_source_set_actions,
+   gtk_drag_source_get_actions;
+FROM GObject IMPORT g_type_from_name;
+FROM Gdk IMPORT gdk_display_get_default, gdk_display_get_clipboard,
+   GdkActionCopy;
+FROM GdkClipboard IMPORT gdk_clipboard_set_text,
+   gdk_clipboard_read_text_async, gdk_clipboard_read_text_finish;
+FROM GError IMPORT GError;
+FROM GtkUtils IMPORT Connect, CStrToM2, Free, ClearError;
+FROM GLib IMPORT g_timeout_add, GSourceRemove;
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM libc IMPORT printf;
+
+CONST
+   AppId = "org.example.m2gtk4.TestDnd";
+   Expected = "m2-clipboard";
+
+VAR
+   app, clipboard: ADDRESS;
+   passed, gotText: BOOLEAN;
+   buf: ARRAY [0..63] OF CHAR;
+
+(* void on_read(GObject *source, GAsyncResult *result, gpointer user) *)
+PROCEDURE OnRead (source: ADDRESS; result: ADDRESS; user: ADDRESS);
+VAR
+   s: ADDRESS;
+   err: GError;
+BEGIN
+   err := NIL;
+   s := gdk_clipboard_read_text_finish(clipboard, result, err);
+   IF s = NIL THEN
+      printf("clipboard read failed\n");
+      ClearError(err);
+      passed := FALSE
+   ELSE
+      CStrToM2(s, buf);
+      gotText := TRUE;
+      IF (buf[0] # 'm') OR (buf[2] # '-') THEN
+         printf("clipboard text wrong: [%s]\n", buf);
+         passed := FALSE
+      END;
+      Free(s)
+   END;
+   g_application_quit(app)
+END OnRead;
+
+PROCEDURE Fallback (data: ADDRESS) : INTEGER;
+BEGIN
+   IF NOT gotText THEN
+      printf("clipboard callback did not fire\n");
+      passed := FALSE
+   END;
+   g_application_quit(app);
+   RETURN GSourceRemove
+END Fallback;
+
+PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
+VAR
+   window, box, drop, drag, label: ADDRESS;
+   gtype: LONGCARD;
+   ok: BOOLEAN;
+BEGIN
+   ok := TRUE;
+   gotText := FALSE;
+
+   gtype := g_type_from_name("gchararray");
+
+   drop := gtk_drop_target_new(gtype, GdkActionCopy);
+   IF drop = NIL THEN printf("drop target NIL\n"); ok := FALSE END;
+   gtk_drop_target_set_actions(drop, GdkActionCopy);
+   IF gtk_drop_target_get_actions(drop) # GdkActionCopy THEN
+      printf("drop actions wrong\n"); ok := FALSE
+   END;
+
+   drag := gtk_drag_source_new();
+   gtk_drag_source_set_actions(drag, GdkActionCopy);
+   IF gtk_drag_source_get_actions(drag) # GdkActionCopy THEN
+      printf("drag actions wrong\n"); ok := FALSE
+   END;
+
+   label := gtk_label_new("drag/drop target");
+   gtk_widget_add_controller(label, drop);
+   gtk_widget_add_controller(label, drag);
+
+   clipboard := gdk_display_get_clipboard(gdk_display_get_default());
+   gdk_clipboard_set_text(clipboard, Expected);
+   gdk_clipboard_read_text_async(clipboard, NIL, ADR(OnRead), NIL);
+
+   box := gtk_box_new(GtkVertical, 4);
+   gtk_box_append(box, label);
+   window := gtk_application_window_new(application);
+   gtk_window_set_child(window, box);
+   gtk_window_present(window);
+
+   passed := ok;
+   g_timeout_add(2000, Fallback, NIL)
+END OnActivate;
+
+VAR
+   rc: INTEGER;
+BEGIN
+   passed := FALSE;
+   app := gtk_application_new(AppId, 0);
+   IF app = NIL THEN
+      printf("test_dnd: FAIL (no app)\n");
+      HALT(1)
+   END;
+   Connect(app, "activate", ADR(OnActivate), NIL);
+   rc := g_application_run(app, 0, NIL);
+
+   IF passed THEN
+      printf("test_dnd: PASS\n");
+      HALT(0)
+   ELSE
+      printf("test_dnd: FAIL\n");
+      HALT(1)
+   END
+END test_dnd.

+ 119 - 0
tests/test_media.mod

@@ -0,0 +1,119 @@
+MODULE test_media ;
+
+(*
+   m2-GTK4 test - media: GdkTexture from a generated PNG, plus GtkVideo
+   and GtkMediaFile construction.  Requires a display.
+*)
+
+FROM Gio IMPORT g_application_run, g_application_quit;
+FROM GtkApplication IMPORT gtk_application_new;
+FROM GtkWindow IMPORT gtk_application_window_new, gtk_window_set_child,
+   gtk_window_present;
+FROM GtkBox IMPORT gtk_box_new, gtk_box_append;
+FROM GtkEnums IMPORT GtkVertical;
+FROM GtkPicture IMPORT gtk_picture_new, gtk_picture_set_paintable,
+   gtk_picture_get_paintable;
+FROM GtkVideo IMPORT gtk_video_new, gtk_video_set_autoplay,
+   gtk_video_get_autoplay, gtk_video_set_loop, gtk_video_get_loop;
+FROM GtkMediaFile IMPORT gtk_media_file_new;
+FROM GdkTexture IMPORT gdk_texture_new_from_filename,
+   gdk_texture_get_width, gdk_texture_get_height;
+FROM GError IMPORT GError;
+FROM Cairo IMPORT cairo_image_surface_create, cairo_create, cairo_destroy,
+   cairo_surface_destroy, cairo_set_source_rgb, cairo_rectangle, cairo_fill,
+   cairo_surface_write_to_png, CairoFormatARGB32;
+FROM GtkUtils IMPORT Connect, ClearError;
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM libc IMPORT printf;
+
+CONST
+   AppId = "org.example.m2gtk4.TestMedia";
+   PngPath = "/tmp/opencode/m2media.png";
+
+VAR
+   app: ADDRESS;
+   passed: BOOLEAN;
+
+PROCEDURE OnActivate (application: ADDRESS; data: ADDRESS);
+VAR
+   window, box, picture, texture, video, mediafile, surface, cr: ADDRESS;
+   err: GError;
+   ok: BOOLEAN;
+BEGIN
+   ok := TRUE;
+
+   surface := cairo_image_surface_create(CairoFormatARGB32, 40, 30);
+   cr := cairo_create(surface);
+   cairo_set_source_rgb(cr, 0.20, 0.60, 0.30);
+   cairo_rectangle(cr, 0.0, 0.0, 40.0, 30.0);
+   cairo_fill(cr);
+   cairo_destroy(cr);
+   IF cairo_surface_write_to_png(surface, PngPath) # 0 THEN
+      printf("png write failed\n"); ok := FALSE
+   END;
+   cairo_surface_destroy(surface);
+
+   err := NIL;
+   texture := gdk_texture_new_from_filename(PngPath, err);
+   IF texture = NIL THEN
+      printf("texture NIL\n");
+      ClearError(err);
+      ok := FALSE
+   ELSE
+      IF gdk_texture_get_width(texture) # 40 THEN
+         printf("texture width wrong\n"); ok := FALSE
+      END;
+      IF gdk_texture_get_height(texture) # 30 THEN
+         printf("texture height wrong\n"); ok := FALSE
+      END
+   END;
+
+   picture := gtk_picture_new();
+   IF texture # NIL THEN gtk_picture_set_paintable(picture, texture) END;
+   IF texture # NIL THEN
+      IF gtk_picture_get_paintable(picture) # texture THEN
+         printf("picture paintable wrong\n"); ok := FALSE
+      END
+   END;
+
+   video := gtk_video_new();
+   IF video = NIL THEN printf("video NIL\n"); ok := FALSE END;
+   gtk_video_set_autoplay(video, 1);
+   IF gtk_video_get_autoplay(video) # 1 THEN ok := FALSE END;
+   gtk_video_set_loop(video, 1);
+   IF gtk_video_get_loop(video) # 1 THEN ok := FALSE END;
+
+   mediafile := gtk_media_file_new();
+   IF mediafile = NIL THEN printf("media file NIL\n"); ok := FALSE END;
+
+   box := gtk_box_new(GtkVertical, 4);
+   gtk_box_append(box, picture);
+   gtk_box_append(box, video);
+   window := gtk_application_window_new(application);
+   gtk_window_set_child(window, box);
+   gtk_window_present(window);
+
+   passed := ok;
+   g_application_quit(application)
+END OnActivate;
+
+VAR
+   rc: INTEGER;
+BEGIN
+   passed := FALSE;
+   app := gtk_application_new(AppId, 0);
+   IF app = NIL THEN
+      printf("test_media: FAIL (no app)\n");
+      HALT(1)
+   END;
+   Connect(app, "activate", ADR(OnActivate), NIL);
+   rc := g_application_run(app, 0, NIL);
+
+   IF passed THEN
+      printf("test_media: PASS\n");
+      HALT(0)
+   ELSE
+      printf("test_media: FAIL\n");
+      HALT(1)
+   END
+END test_media.

+ 71 - 0
tests/test_shim2.mod

@@ -0,0 +1,71 @@
+MODULE test_shim2 ;
+
+(*
+   m2-GTK4 test - the shim's generic GListModel (m2_list_model_new).
+
+   A Modula-2 model with get_n_items/get_item callbacks is queried
+   through the GListModel API.  Requires GTK initialised (and so a
+   display).
+*)
+
+FROM Gtk IMPORT gtk_init;
+FROM M2GtkShim IMPORT m2_list_model_new;
+FROM GtkStringObject IMPORT gtk_string_object_new,
+   gtk_string_object_get_string, gtk_string_object_get_type;
+FROM GListModel IMPORT g_list_model_get_n_items, g_list_model_get_item;
+FROM GObject IMPORT g_object_unref;
+FROM GtkUtils IMPORT CStrToM2;
+FROM SYSTEM IMPORT ADDRESS, ADR;
+FROM libc IMPORT printf;
+
+VAR
+   failed: BOOLEAN;
+
+PROCEDURE Check (condition: BOOLEAN; what: ARRAY OF CHAR);
+BEGIN
+   IF NOT condition THEN
+      printf("FAIL: %s\n", what);
+      failed := TRUE
+   END
+END Check;
+
+PROCEDURE GetNItems (user: ADDRESS) : CARDINAL;
+BEGIN
+   RETURN 3
+END GetNItems;
+
+(* Return a new reference (transfer full). *)
+PROCEDURE GetItem (position: CARDINAL; user: ADDRESS) : ADDRESS;
+BEGIN
+   IF position = 0 THEN RETURN gtk_string_object_new("A") END;
+   IF position = 1 THEN RETURN gtk_string_object_new("B") END;
+   RETURN gtk_string_object_new("C")
+END GetItem;
+
+VAR
+   model, item: ADDRESS;
+   buf: ARRAY [0..31] OF CHAR;
+BEGIN
+   failed := FALSE;
+   gtk_init();
+
+   model := m2_list_model_new(ADR(GetNItems), ADR(GetItem),
+                              gtk_string_object_get_type(), NIL, NIL);
+   Check(model # NIL, "model created");
+   Check(g_list_model_get_n_items(model) = 3, "n items");
+
+   item := g_list_model_get_item(model, 1);
+   CStrToM2(gtk_string_object_get_string(item), buf);
+   Check((buf[0] = 'B') AND (buf[1] = 0C), "item 1 is B");
+   g_object_unref(item);
+
+   g_object_unref(model);
+
+   IF failed THEN
+      printf("test_shim2: FAIL\n");
+      HALT(1)
+   ELSE
+      printf("test_shim2: PASS\n");
+      HALT(0)
+   END
+END test_shim2.