*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Thu, 13 Aug 2009 15:29:54 +0200
changeset 11851 adda395bb92e
parent 11850 ee84c01dc50d
child 11852 6732161ece56
*** empty log message ***
ExternalFunctionCallback.st
--- a/ExternalFunctionCallback.st	Thu Aug 13 14:56:48 2009 +0200
+++ b/ExternalFunctionCallback.st	Thu Aug 13 15:29:54 2009 +0200
@@ -293,7 +293,7 @@
 
 !ExternalFunctionCallback class methodsFor:'common callbacks'!
 
-errorCallbackProcFor:aThreeArgBlock
+callbackFor:aBlock returnType:returnType argumentTypes:argumentTypes
     "generate a callback for the ErrorCallbackProc signature:
         ErrorCallbackProc(HWND hWnd, int nErrID, LPTSTR lpErrorText)
      which, can be given to an external API call and which invokes the
@@ -302,11 +302,13 @@
 
     |cb|
 
+    self assert:(aBlock numArgs == argumentTypes size).
+
     cb := ExternalFunctionCallback new.
-    cb returnType:#long "LRESULT" argumentTypes:#(handle int charPointer).
+    cb returnType:returnType argumentTypes:argumentTypes.
     cb beCallTypeWINAPI.
     cb generateClosure.
-    cb action:aThreeArgBlock.
+    cb action:aBlock.
     "/ ^ cb code.  'can be passed to C'.
     ^ cb
 
@@ -317,6 +319,27 @@
      ExternalFunctionCallback testCall:cb withArguments:#(#[1 2 3] 456 'hello').
      cb release
     "
+!
+
+errorCallbackProcFor:aThreeArgBlock
+    "generate a callback for the ErrorCallbackProc signature:
+        ErrorCallbackProc(HWND hWnd, int nErrID, LPTSTR lpErrorText)
+     which, can be given to an external API call and which invokes the
+     three arg block when clled.
+     Do not forget to eventually release the callback to avoid a memory leak."
+
+    ^ self 
+        callbackFor:aThreeArgBlock 
+        returnType:#long 
+        argumentTypes:#(handle int charPointer)
+
+    "
+     |cb|
+
+     cb := self errorCallbackProcFor:[:a1 :a2 :a3 | Transcript showCR:('%1 %2 %3' bindWith:a1 with:a2 with:a3)].
+     ExternalFunctionCallback testCall:cb withArguments:#(#[1 2 3] 456 'hello').
+     cb release
+    "
 ! !
 
 !ExternalFunctionCallback class methodsFor:'constants'!
@@ -806,5 +829,5 @@
 !ExternalFunctionCallback class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunctionCallback.st,v 1.12 2009-08-13 11:48:43 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunctionCallback.st,v 1.13 2009-08-13 13:29:54 cg Exp $'
 ! !