note description: "Callback Marshal to deal with gtk signal emissions" legal: "See notice at end of class." status: "See notice at end of class." date: "$Date$" revision: "$Revision$" class EV_GTK_CALLBACK_MARSHAL inherit IDENTIFIED undefine default_create, copy, is_equal, dispose end EV_INTERMEDIARY_ROUTINES undefine default_create, dispose end EXCEPTIONS export {NONE} all undefine default_create end create default_create feature {NONE} -- Initialization default_create -- Create the dispatcher, one object per system. do initialize end initialize -- Initialize callbacks once debug("gtk_net") print (generator + " initialize%N" ) end create marshal_delegate.make (Current, $marshal) create free_delegate.make(Current, $free) c_ev_gtk_callback_marshal_init (marshal_delegate, free_delegate) c_ev_gtk_callback_marshal_set_is_enabled (True) dispatcher_object := {GC_HANDLE}.alloc (Current) cgtk_set_dispatcher_object ({GC_HANDLE}.to_pointer (dispatcher_object)) end feature {NONE} -- Implementation dispatcher_object: GC_HANDLE -- Handle to Current. marshal_delegate: detachable GTK_MARSHAL_DISPATCHER_DELEGATE note option: stable attribute end -- Delegate for callbacks. free_delegate: detachable WEL_ENUM_WINDOW_DELEGATE note option: stable attribute end -- Delegate for callbacks. procedure_delegate: detachable EIFFEL_PROCEDURE_DELEGATE dispatcher_procedure: detachable GC_HANDLE dispose -- Wean `Current' do if attached dispatcher_object as l_handle then if l_handle.is_allocated then l_handle.free end cgtk_set_dispatcher_object (default_pointer) end end free (a_pointer: POINTER) do debug("gtk_net") print (generator + ".free%N" ) end if attached {GC_HANDLE}.from_int_ptr (a_pointer) as h then h.free end end feature {EV_ANY_IMP} -- Access dimension_tuple (a_x, a_y, a_width, a_height: INTEGER): like internal_dimension_tuple -- Return a dimension tuple from given arguments. do Result := internal_dimension_tuple Result.x := a_x Result.y := a_y Result.width := a_width Result.height := a_height end feature -- Implementation signal_connect ( a_c_object: POINTER; a_signal_name: EV_GTK_C_STRING; an_agent: ROUTINE; invoke_after_handler: BOOLEAN ) -- Signal connect, depending on `invoke_after_handler` invoked before or after default handler. -- Notes: -- - on connect the agent `an_agent` is eif_adopt-ed by the run-time -- - on disconnect the eif_adopt-ed agent `an_agent` is eif_wean-ed by the run-time -- and thus can be collected by the GC local l_agent_hdl: POINTER do -- How do we convert a ROUTINE to a Pointer. dispatcher_procedure := {GC_HANDLE}.alloc (an_agent) l_agent_hdl := {GC_HANDLE}.to_int_ptr (dispatcher_procedure) debug("gtk_net") print (generator + ".signal_connect ("+a_c_object.out +"," + a_signal_name.string.out + "," + an_agent.out + " -> "+ l_agent_hdl.out +"," + invoke_after_handler.out + ")%N" ) end last_signal_connection_id := c_signal_connect (a_c_object, a_signal_name.item, l_agent_hdl, invoke_after_handler) debug("gtk_net") print (generator + ".signal_connect (..): AFTER%N" ) end debug("gtk_signal") print (generator + ".signal_connect (" + a_c_object.out +", " + a_signal_name.string.to_string_8 + ", " + if attached an_agent.target as tgt then tgt.generator else "NoTarget" end + " ...,"+ invoke_after_handler.out +") -> "+ last_signal_connection_id.out +"%N") end end signal_connect_after ( a_c_object: POINTER; a_signal_name: EV_GTK_C_STRING; an_agent: ROUTINE ) -- Signal connect, invoke after default handler. do debug("gtk_net") print (generator + ".signal_connect_after ("+a_c_object.out +"," + a_signal_name.string.out + "," + an_agent.out + ")%N" ) end signal_connect (a_c_object, a_signal_name, an_agent, True) end signal_disconnect (a_c_object: POINTER; a_conn_id: INTEGER) -- Close connection `a_conn_id` for object `a_c_object`. -- Note: the associated Eiffel agent will be "wean" by the run-time do debug("gtk_net") print (generator + ".signal_disconnect ("+a_c_object.out +"," + a_conn_id.out + ")%N" ) end {GTK2}.signal_disconnect (a_c_object, a_conn_id) end last_signal_connection_id: INTEGER -- Last signal connection id. feature {EV_ANY_IMP} -- Agent implementation routines is_destroyed: BOOLEAN -- Has `destroy' been called? feature {EV_APPLICATION_IMP} -- Destruction destroy -- Destroy `Current'. do --c_ev_gtk_callback_marshal_destroy is_destroyed := True end feature {NONE} -- Implementation marshal (action_ptr: POINTER; n_args: INTEGER; args: POINTER; a_return_value: POINTER) --marshal (action: ROUTINE; n_args: INTEGER; args: POINTER; a_return_value: POINTER) -- Call `action' with GTK+ event data from `args'. -- There are `n_args' GtkArg*s in `args'. -- Called by C function `c_ev_gtk_callback_marshal'. require action_not_void: action_ptr /= default_pointer n_args_not_negative: n_args >= 0 args_not_null: n_args > 0 implies args /= default_pointer local retry_count: INTEGER l_integer_pointer_tuple: detachable like integer_pointer_tuple l_pointer_tuple: detachable like pointer_tuple l_any: detachable ANY b: BOOLEAN action: SYSTEM_OBJECT do debug("gtk_net") print ("%N" + generator + ".marshal (" + action_ptr.out+"," + n_args.out + "," + args.out + "," + a_return_value.out + ") <>%N") if retry_count > 0 then print (generator + ".marshal (..) retry_count=" + retry_count.out + "%N") end end action := if attached {GC_HANDLE}.from_int_ptr (action_ptr) as h then h.target else Void end if action = Void then debug("gtk_net") print (generator + ".marshal(..) action is not set!%N") end elseif retry_count = 0 then if attached {PROCEDURE [detachable TUPLE [POINTER]]} action as l_action then debug("gtk_net") print (generator + ".marshal(..) -> {PROCEDURE [detachable TUPLE [POINTER]]} %N") print (generator + ".marshal(..) -> " + l_action.out + "%N") end if n_args > 0 then l_pointer_tuple := pointer_tuple l_pointer_tuple.pointer := args end b := False if l_action.valid_operands (l_pointer_tuple) then debug("gtk_net") print (generator + ".marshal(..) before action.call (arg_1)%N") end l_action.call (l_pointer_tuple) else debug("gtk_net") print (generator + ".marshal(..) cancel action.call due to invalid operands!%N") end end elseif attached {FUNCTION [TUPLE, POINTER]} action as fct then debug("gtk_net") print (generator + "{FUNCTION [TUPLE, POINTER]} " ) print ("%N") end if n_args > 0 then l_pointer_tuple := pointer_tuple l_pointer_tuple.pointer := args end b := False if fct.valid_operands (l_pointer_tuple) then l_any := fct.item (l_pointer_tuple) else debug("gtk_net") print (generator + ".marshal(..) cancel fct.item due to invalid operands!%N") end end if attached {BOOLEAN} l_any as l_bool then b := l_bool end elseif attached {PREDICATE [TUPLE [POINTER]]} action as fct then debug("gtk_net") print (generator + ".marshal -> " + fct.generating_type.out) print ("%N") end if n_args > 0 then l_pointer_tuple := pointer_tuple l_pointer_tuple.pointer := args end b := False if fct.valid_operands (l_pointer_tuple) then debug("gtk_net") print (generator + ".marshal(..) call fct.item with pointer tuple operands%N") end l_any := fct.item (l_pointer_tuple) else debug("gtk_net") print (generator + ".marshal(..) cancel fct.item due to invalid operands!%N") end end if attached {BOOLEAN} l_any as l_bool then b := l_bool end elseif attached {FUNCTION [TUPLE, detachable ANY]} action as fct then debug("gtk_net") print (generator + "{FUNCTION [TUPLE, detachable ANY]} " ) print ("%N") end if n_args > 0 then l_integer_pointer_tuple := Integer_pointer_tuple l_integer_pointer_tuple.integer := n_args l_integer_pointer_tuple.pointer := args end b := False if fct.valid_operands (l_integer_pointer_tuple) then l_any := fct.item (l_integer_pointer_tuple) else debug("gtk_net") print (generator + ".marshal(..) cancel fct.item due to invalid operands!%N") end end if attached {BOOLEAN} l_any as l_bool then b := l_bool end else debug("gtk_net") print (generator + " else condition%N") end if n_args > 0 then l_integer_pointer_tuple := integer_pointer_tuple l_integer_pointer_tuple.integer := n_args l_integer_pointer_tuple.pointer := args end b := False check not attached {FUNCTION [TUPLE, detachable ANY]} action end if attached {PROCEDURE [TUPLE]} action as l_proc_action then debug("gtk_net") print (generator + "{PROCEDURE [TUPLE]} " ) print ("%N") end if l_proc_action.open_count = 0 then l_proc_action.call (Void) elseif l_proc_action.valid_operands (l_integer_pointer_tuple) then l_proc_action.call (l_integer_pointer_tuple) else debug("gtk_net") print (generator + ".marshal(..) cancel proc_action.call due to invalid operands!%N") end end end end debug("gtk_net") print (generator + ".marshal (..) completed%N") end if a_return_value /= default_pointer then {GTK2}.g_value_set_boolean (a_return_value, b) -- TODO: #gtk check if this is ok to return FALSE? end elseif retry_count = 1 then debug("gtk_net") print (generator + ".marshal (...) RETRY<1>%N") end check attached {EV_APPLICATION_IMP} (create {EV_ENVIRONMENT}).implementation.application_i as app_imp then app_imp.on_exception_action (app_imp.new_exception) end end rescue retry_count := retry_count + 1 if retry_count = 1 then -- Only retry once retry else -- There is an exception from calling `on_exception_action' so we exit gracefully. print ("Error: An exception was raised when during handling of a previous exception%N") end end feature {NONE} -- Tuple optimizations. internal_dimension_tuple: TUPLE [x: INTEGER; y: INTEGER; width: INTEGER; height: INTEGER] -- Once function used for global access of dimension tuple. once create Result end internal_key_tuple: TUPLE [key: EV_KEY; string: STRING_32; key_press: BOOLEAN] -- Once function used for global access of key tuple. once create Result end pointer_tuple: TUPLE [pointer: POINTER] once create Result end integer_tuple: TUPLE [integer: INTEGER] once create Result end integer_pointer_tuple: TUPLE [integer: INTEGER; pointer: POINTER] once create Result end feature {EV_GTK_CALLBACK_MARSHAL} -- Externals frozen c_ev_gtk_callback_marshal_init (a_marshal: like marshal_delegate; a_free: like free_delegate) -- See ev_gtk_callback_marshal.c external "C inline use " alias "c_ev_gtk_callback_marshal_init ((void (*) (EIF_POINTER, EIF_INTEGER, EIF_POINTER, EIF_POINTER)) $a_marshal, (void (*) (EIF_POINTER))$a_free);" ensure is_class: class end frozen c_ev_gtk_callback_marshal_destroy -- See ev_gtk_callback_marshal.c external "C inline use " alias "c_ev_gtk_callback_marshal_destroy()" ensure is_class: class end feature {NONE} -- Externals cgtk_set_dispatcher_object (dispatcher: POINTER) external "C inline use " alias "cgtk_set_dispatcher_object($dispatcher)" end cgtk_release_dispatcher_object external "C inline use " alias "cgtk_release_dispatcher_object" end feature -- Implementation frozen c_ev_gtk_callback_marshal_is_enabled: BOOLEAN -- See ev_gtk_callback_marshal.c external "C inline use " alias "(EIF_BOOLEAN) c_ev_gtk_callback_marshal_is_enabled" ensure is_class: class end frozen c_ev_gtk_callback_marshal_set_is_enabled (a_enabled_state: BOOLEAN) -- See ev_gtk_callback_marshal.c external "C inline use " alias "c_ev_gtk_callback_marshal_set_is_enabled((int)$a_enabled_state)" ensure is_class: class end feature {EV_ANY_IMP} -- Disposal implementation frozen on_destroy_event (oid: INTEGER) -- Dispose object associated with eif object id `oid`, if any and not yet destroyed. do debug("gtk_net") -- print ("dispose oid="+ oid.out+"..%N") end if oid >= 0 and then attached {EV_ANY_IMP} eif_id_object (oid) as obj and then not obj.is_destroyed then obj.c_object_dispose end end feature {EV_ANY_IMP, EV_GTK_CALLBACK_MARSHAL} -- Externals frozen set_eif_oid_in_c_object (a_c_object: POINTER; eif_oid: INTEGER) -- Store Eiffel object_id in `gtk_object'. -- Set up signal handlers. do c_g_object_set_eif_oid_data (a_c_object, eif_oid) if {GTK}.gtk_is_tree_view_column (a_c_object) then -- Signal destroy is not applicable to object type GtkTreeViewColumn else signal_connect (a_c_object, {EV_GTK_EVENT_STRINGS}.destroy_event_string, agent on_destroy_event (eif_oid), False) end end frozen c_g_object_set_eif_oid_data (a_gtk_object: POINTER; a_object_id: INTEGER) -- Associate GtkObject `a_gtk_object' with object id `a_object_id' external "C inline use %"ev_gtk.h%"" alias "[ g_object_set_data ( G_OBJECT ($a_gtk_object), "eif_oid", (gpointer) (rt_int_ptr) $a_object_id ); ]" end frozen c_signal_connect (a_c_object: POINTER; a_signal_name: POINTER; an_agent: POINTER; invoke_after_handler: BOOLEAN): INTEGER -- Connect `an_agent' to 'a_signal_name' on `a_c_object'. external "C inline use " alias "c_ev_gtk_callback_marshal_signal_connect((gpointer) $a_c_object, (gchar*) $a_signal_name, (EIF_POINTER) $an_agent, (gboolean) $invoke_after_handler)" ensure is_class: class end feature {EV_APPLICATION_IMP, EV_TIMEOUT_IMP} -- Externals frozen c_ev_gtk_callback_marshal_timeout_connect (a_delay: INTEGER; an_agent: POINTER): NATURAL_32 -- Call `an_agent' after `a_delay'. external "C inline use " alias "c_ev_gtk_callback_marshal_timeout_connect((gint) $a_delay, (EIF_OBJECT) $an_agent)" ensure is_class: class end note copyright: "Copyright (c) 1984-2024, Eiffel Software and others" license: "Eiffel Forum License v2 (see http://www.eiffel.com/licensing/forum.txt)" source: "[ Eiffel Software 5949 Hollister Ave., Goleta, CA 93117 USA Telephone 805-685-1006, Fax 805-685-6869 Website http://www.eiffel.com Customer support http://support.eiffel.com ]" end -- class EV_GTK_CALLBACK_MARSHAL