Programmer's Reference
/* Contents: IBM Smalltalk Window Proc interface for call-in.
Comments:
This file contains an implementation of the window proc
for Windows and OS/2. 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.
*/
#ifdef WIN32
/*
Includes different header file and redefines some result values
for Windows.
*/
#include <windows.h>
#ifndef MRESULT
#define MRESULT LRESULT
#endif
#ifndef MPARAM
#define MPARAM LPARAM
#endif
#ifndef EXPENTRY
#define EXPENTRY CALLBACK
#endif
#define WinDefWindowProc DefWindowProc
#endif
#ifdef OS2
/*
Includes different header file and redefines some result values
for OS/2.
*/
#define INCL_WININPUT
#include <os2.h>
#endif
#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
[ Top of Page | Previous Page | Next Page | Table of Contents | Index ]