Example callback code
/* Contents: VA Smalltalk Window Proc interface for call-in.
Comments:
This file contains an implementation of the window proc
for Windows. The window proc calls into Smalltalk to process
every event received. The default window proc is called
if an error occurred during processing of the call-in.
The most typical error is a walkback during call-in.
*/
#include <windows.h>
#ifndef MRESULT
#define MRESULT LRESULT
#endif
#ifndef MPARAM
#define MPARAM LPARAM
#endif
#ifndef EXPENTRY
#define EXPENTRY CALLBACK
#endif
#define WinDefWindowProc DefWindowProc
#include "esuser.h"
typedef struct {
EsObject class;
U_32 flags;
U_32 size;
EsObject selector;
EsObject arguments;
EsObject receiver;
} ESDirectedMessage;
static BOOL RecursiveError = FALSE;
static BOOL PrimitiveError = FALSE;
static ESGlobalInfo *GlobalInfo = 0;
static ESDirectedMessage * WindowProcMessage = 0;
MRESULT EXPENTRY WindowProc (HWND hwnd, ULONG msg, MPARAM mp1, MPARAM mp2)
{
MRESULT mresult;
EsDefineUserPrimitiveEnvironment(GlobalInfo);
EsObject result, objHwnd, objMsg, objMp1, objMp2;
extern int EsTerminated;
if (EsTerminated) {
return WinDefWindowProc (hwnd, msg, mp1, mp2);
}
if (RecursiveError) {
EsTTYOutputString ("\nRecursive WindProc Failure.");
EsTTYOutputString ("Using WinDefProc");
return WinDefWindowProc (hwnd, msg, mp1, mp2);
}
/*
Converts the arguments into Smalltalk objects
The parameters are converted into Smalltalk objects.
If the values are large enough, a LargeInteger may
be created. To prevent the garbage collection
from reclaiming any objects created, they are
saved on the Smalltalk stack for protection from the GC.
/*
PrimitiveError = FALSE;
if (EsU32ToInteger ((U_32) hwnd, &objHwnd) != EsPrimErrNoError) {
PrimitiveError = TRUE;
} else {
EsSaveObject(objHwnd);
if (EsU32ToInteger ((U_32) msg, &objMsg) != EsPrimErrNoError) {
EsRestoreObject();
PrimitiveError = TRUE;
} else {
EsSaveObject(objMsg);
if (EsU32ToInteger ((U_32) mp1, &objMp1) != EsPrimErrNoError) {
EsRestoreObject(); EsRestoreObject();
PrimitiveError = TRUE;
} else {
EsSaveObject(objMp1);
if (EsU32ToInteger ((U_32) mp2, &objMp2)
!= EsPrimErrNoError)
{
PrimitiveError = TRUE;
EsRestoreObject(); EsRestoreObject(); EsRestoreObject();
} else {
objMp1 = EsRestoreObject();
objMsg = EsRestoreObject();
objHwnd = EsRestoreObject();
}
}
}
}
/* Sends the message to Smalltalk via call-in if there was no error */
if (PrimitiveError) {
EsTTYOutputString ("\nWindProc:EsU32ToInteger failed");
EsTTYOutputString ("Using WinDefProc");
RecursiveError = TRUE;
mresult = WinDefWindowProc (hwnd, msg, mp1, mp2);
RecursiveError = FALSE;
return mresult;
} else {
if (EsSendMessage(EsPrimVMContext,
&result,
WindowProcMessage->receiver,
WindowProcMessage->selector,
4,
objHwnd, objMsg, objMp1, objMp2) != 0) {
EsTTYOutputString ("\nWindProc:EsSendMessage failed.");
EsTTYOutputString ("Using WinDefProc");
RecursiveError = TRUE;
mresult = WinDefWindowProc (hwnd, msg, mp1, mp2);
RecursiveError = FALSE;
return mresult;
}
}
/* -2^31 to +2^31 */
if (EsIntegerToI32(result, &mresult) == EsPrimErrNoError) {
return mresult;
}
/* 0 to 2^32 */
if (EsIntegerToU32(result, &mresult) == EsPrimErrNoError) {
return mresult;
}
EsTTYOutputString ("\nWindProc Failed.");
EsTTYOutputString ("Result was not an Integer");
return WinDefWindowProc (hwnd, msg, mp1,mp2);
}
EsUserPrimitive(installWindowProc)
{
EsObject result;
GlobalInfo = EsPrimVMContext->globalInfo;
WindowProcMessage = (ESDirectedMessage *) EsPrimArgument(1);
if (EsU32ToInteger ((U_32) WindowProc, &result) != EsPrimErrNoError) {
EsPrimFail (EsPrimErrInvalidClass, 1);
}
EsPrimSucceed (result);
}
EsDefinePrimitiveTable(WindowProcPrimitiveTable)
EsPrimitiveTableEntry("installWindowProc", installWindowProc)
EsEndPrimitiveTable