m2-GTK4/lib/GtkClosures.mod

IMPLEMENTATION MODULE GtkClosures ;

(*
   Each connection gets a Context holding the handler, the user payload
   and an optional destroy procedure.  Two trampolines (2-argument and
   3-argument) recover the Context from their pointer parameter and
   forward the call.  DestroyCtx is registered as the GClosure destroy
   notify, so it runs on both explicit disconnect and object finalize.

   Trampoline parameters are typed pointers (ContextPtr), so the C
   gpointer is received without a CAST on the hot path.
*)

FROM SYSTEM IMPORT ADDRESS, CAST, ADR;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM GObject IMPORT g_signal_connect_data, GConnectDefault;

TYPE
   Context = RECORD
      user: ADDRESS;
      destroy: DestroyProc;
      h2: Handler2;
      h3: Handler3;
   END;
   ContextPtr = POINTER TO Context;

PROCEDURE Tramp2 (instance: ADDRESS; ctx: ContextPtr);
BEGIN
   ctx^.h2(instance, ctx^.user)
END Tramp2;

PROCEDURE Tramp3 (instance: ADDRESS; param: ADDRESS; ctx: ContextPtr);
BEGIN
   ctx^.h3(instance, param, ctx^.user)
END Tramp3;

PROCEDURE DestroyCtx (ctx: ContextPtr; closure: ADDRESS);
BEGIN
   IF ctx # NIL THEN
      IF ctx^.destroy # NIL THEN
         ctx^.destroy(ctx^.user)
      END;
      DISPOSE(ctx)
   END
END DestroyCtx;

PROCEDURE NewCtx () : ContextPtr;
VAR
   ctx: ContextPtr;
BEGIN
   NEW(ctx);
   ctx^.user := NIL;
   ctx^.destroy := NIL;
   ctx^.h2 := NIL;
   ctx^.h3 := NIL;
   RETURN ctx
END NewCtx;

PROCEDURE RawConnect (instance: ADDRESS; signal: ARRAY OF CHAR;
                      ctx: ContextPtr; tramp: ADDRESS) : [ LONGCARD ];
BEGIN
   RETURN g_signal_connect_data(instance, signal, tramp, CAST(ADDRESS, ctx),
                                ADR(DestroyCtx), GConnectDefault)
END RawConnect;

PROCEDURE Connect2 (instance: ADDRESS; signal: ARRAY OF CHAR;
                    handler: Handler2; user: ADDRESS) : [ LONGCARD ];
VAR
   ctx: ContextPtr;
BEGIN
   ctx := NewCtx();
   ctx^.h2 := handler;
   ctx^.user := user;
   RETURN RawConnect(instance, signal, ctx, ADR(Tramp2))
END Connect2;

PROCEDURE Connect3 (instance: ADDRESS; signal: ARRAY OF CHAR;
                    handler: Handler3; user: ADDRESS) : [ LONGCARD ];
VAR
   ctx: ContextPtr;
BEGIN
   ctx := NewCtx();
   ctx^.h3 := handler;
   ctx^.user := user;
   RETURN RawConnect(instance, signal, ctx, ADR(Tramp3))
END Connect3;

PROCEDURE Connect2Owned (instance: ADDRESS; signal: ARRAY OF CHAR;
                         handler: Handler2; user: ADDRESS;
                         destroy: DestroyProc) : [ LONGCARD ];
VAR
   ctx: ContextPtr;
BEGIN
   ctx := NewCtx();
   ctx^.h2 := handler;
   ctx^.user := user;
   ctx^.destroy := destroy;
   RETURN RawConnect(instance, signal, ctx, ADR(Tramp2))
END Connect2Owned;

PROCEDURE Connect3Owned (instance: ADDRESS; signal: ARRAY OF CHAR;
                         handler: Handler3; user: ADDRESS;
                         destroy: DestroyProc) : [ LONGCARD ];
VAR
   ctx: ContextPtr;
BEGIN
   ctx := NewCtx();
   ctx^.h3 := handler;
   ctx^.user := user;
   ctx^.destroy := destroy;
   RETURN RawConnect(instance, signal, ctx, ADR(Tramp3))
END Connect3Owned;

END GtkClosures.