add callbacks definitions; clean up

diff --git a/basis/gir/ffi/ffi.factor b/basis/gir/ffi/ffi.factor
index 88c2ceb40eaec2c4468a2365c2be946f2fa4817a..b9e8ecb9fa7989301491aaddce92bd806590ab68 100644 (file)
--- a/basis/gir/ffi/ffi.factor
+++ b/basis/gir/ffi/ffi.factor
@@ -13,16 +13,16 @@ IN: gir.ffi
 : define-each ( nodes quot -- )
     '[ dup @ >>ffi drop ] each ; inline
 
-: ffi-invoker ( func -- quot )
+: function-ffi-invoker ( func -- quot )
     {
         [ return>> c-type>> string>c-type ]
         [ drop current-lib get-global ]
         [ identifier>> ]
         [ parameters>> [ c-type>> string>c-type ] map ]
         [ varargs?>> [ void* suffix ] when ]
-    } cleave \ alien-invoke 5 narray >quotation ;
+    } cleave function-quot ;
 
-: ffi-effect ( func -- effect )
+: function-ffi-effect ( func -- effect )
     [ parameters>> [ name>> ] map ]
     [ varargs?>> [ "varargs" suffix ] when ]
     [ return>> type>> none-type? { } { "result" } ? ] tri
@@ -30,42 +30,45 @@ IN: gir.ffi
 
 : define-ffi-function ( func -- word )
     [ identifier>> create-in dup ]
-    [ ffi-invoker ] [ ffi-effect ] tri define-declared ;
+    [ function-ffi-invoker ] [ function-ffi-effect ] tri
+    define-declared ;
 
 : define-ffi-functions ( functions -- )
     [ define-ffi-function ] define-each ;
 
-: signal-param-c-type ( param -- c-type )
-    [ c-type>> ] [ type>> ] bi
-    {
-        [ none-type? ]
-        [ simple-type? ]
-        [ enum-type? ]
-        [ bitfield-type? ]
-    } 1|| [ dup "*" tail? [ CHAR: * suffix ] unless ] unless ;
+: callback-ffi-invoker ( callback -- quot )
+    [ return>> c-type>> string>c-type ]
+    [ parameters>> [ c-type>> string>c-type ] map ] bi
+    cdecl callback-quot ;
 
-: signal-ffi-invoker ( signal -- quot )
-    [ return>> signal-param-c-type string>c-type ]
-    [ parameters>> [ signal-param-c-type string>c-type ] map ] bi
-    cdecl [ [ ] 3curry dip alien-callback ] 3curry ;
-
-: signal-ffi-effect ( signal -- effect )
+: callback-ffi-effect ( callback -- effect )
     [ parameters>> [ name>> ] map ]
     [ return>> type>> none-type? { } { "result" } ? ] bi
     <effect> ;
 
-:: define-ffi-signal ( signal class -- word ) ! сделать попонятнее
-    signal
-    [
-        name>> class c-type>> swap ":" glue create-in
-        [ void* swap typedef ] keep dup
-    ] keep
-    [ signal-ffi-effect "callback-effect" set-word-prop ]
+: define-ffi-callback ( callback -- word )
+    [ c-type>> create-in [ void* swap typedef ] keep dup ] keep
+    [ callback-ffi-effect "callback-effect" set-word-prop ]
     [ drop current-lib get-global "callback-library" set-word-prop ] 
-    [ signal-ffi-invoker (( quot -- alien )) define-inline ] 2tri ;
+    [ callback-ffi-invoker (( quot -- alien )) define-inline ] 2tri ;
+
+: fix-signal-param-c-type ( param -- )
+    dup [ c-type>> ] [ type>> ] bi
+    {
+        [ none-type? ]
+        [ simple-type? ]
+        [ enum-type? ]
+        [ bitfield-type? ]
+    } 1|| [ dup "*" tail? [ CHAR: * suffix ] unless ] unless
+    >>c-type drop ;
 
-: define-ffi-signals ( signals class -- )
-    '[ _ define-ffi-signal ] define-each ;
+: define-ffi-signal ( signal -- word )
+    [ return>> fix-signal-param-c-type ]
+    [ parameters>> [ fix-signal-param-c-type ] each ]
+    [ define-ffi-callback ] tri ;
+    
+: define-ffi-signals ( signals -- )
+    [ define-ffi-signal ] define-each ;
 
 : const-value ( const -- value )
     [ value>> ] [ type>> name>> ] bi {
@@ -139,9 +142,6 @@ IN: gir.ffi
 : define-ffi-unions ( unions -- )
     [ define-ffi-union ] define-each ;
 
-: define-ffi-callback ( callback -- word )
-    c-type>> create-in [ void* swap typedef ] keep ;
-
 : define-ffi-callbacks ( callbacks -- )
     [ define-ffi-callback ] define-each ;
 

diff --git a/basis/gir/loader/loader.factor b/basis/gir/loader/loader.factor
index 3d444bd500fafb386414b3c44cad91c19fbbfbdb..fc3de0103bc1c20ad9f314ecbe86fb1e2d05532e 100644 (file)
--- a/basis/gir/loader/loader.factor
+++ b/basis/gir/loader/loader.factor
@@ -174,6 +174,8 @@ SYMBOL: namespace-PREFIX
             "signal" tags-named [ xml>signal ] map
             over type>sender-param
             '[ [ _ prefix ] change-parameters ] map
+            over c-type>> CHAR: : suffix
+            '[ dup name>> _ prepend >>c-type ] map
             >>signals
         ]
     } cleave ;