m2-GTK4/tests/test_dnd.mod

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.