#include "GUI.h"
BOOL
ProcessEventError(NOTXSPROC
char
*Name,
int
* PerlResult) {
if
(SvTRUE(ERRSV)) {
if
(
strncmp
(Name,
"main::"
, 6) == 0) Name += 6;
MessageBeep(MB_ICONASTERISK);
*PerlResult = MessageBox(NULL, SvPV_nolen(ERRSV), Name, MB_ICONERROR | MB_OKCANCEL);
if
(*PerlResult == IDCANCEL) {
*PerlResult = -1;
}
return
TRUE;
}
else
{
return
FALSE;
}
}
int
DoEvent(
NOTXSPROC
LPPERLWIN32GUI_USERDATA perlud,
int
iEventId,
char
*Name,
...
) {
va_list
args;
int
count;
int
argtype;
int
PerlResult = 1;
HWND
hwnd = handle_From(NOTXSCALL perlud->svSelf);
perlud->dwPlStyle &= ~PERLWIN32GUI_EVENTHANDLING;
if
((perlud->dwPlStyle & PERLWIN32GUI_NEM) && (perlud->dwEventMask & iEventId)) {
SV** event;
event = hv_fetch( (perlud->hvEvents), Name,
strlen
(Name), 0);
if
(event != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(perlud->svSelf);
va_start
( args, Name );
argtype =
va_arg
( args,
int
);
while
(argtype != -1) {
switch
(argtype) {
case
PERLWIN32GUI_ARGTYPE_INT:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_LONG:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
long
))));
break
;
case
PERLWIN32GUI_ARGTYPE_WORD:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_STRING:
XPUSHs(sv_2mortal(newSVpv(
va_arg
( args,
char
* ), 0)));
break
;
case
PERLWIN32GUI_ARGTYPE_SV:
XPUSHs(
va_arg
( args, SV *));
break
;
default
:
warn(
"Win32::GUI: WARNING! unknown argument type (%d) to event '%s'"
, argtype, Name);
break
;
}
argtype =
va_arg
( args,
int
);
}
va_end
( args );
PUTBACK;
count = call_sv(*event, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL Name, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
if
(PerlResult == 1 && (perlud->dwPlStyle & PERLWIN32GUI_OEM) && perlud->szWindowName != NULL) {
char
EventName[MAX_EVENT_NAME];
strcpy
(EventName,
"main::"
);
strcat
(EventName, perlud->szWindowName);
strcat
(EventName,
"_"
);
strcat
(EventName, Name);
if
(perl_get_cv(EventName, FALSE) != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
va_start
( args, Name );
argtype =
va_arg
( args,
int
);
while
(argtype != -1) {
switch
(argtype) {
case
PERLWIN32GUI_ARGTYPE_INT:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_LONG:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
long
))));
break
;
case
PERLWIN32GUI_ARGTYPE_WORD:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_STRING:
XPUSHs(sv_2mortal(newSVpv(
va_arg
( args,
char
* ), 0)));
break
;
case
PERLWIN32GUI_ARGTYPE_SV:
XPUSHs(
va_arg
( args, SV *));
break
;
default
:
warn(
"Win32::GUI: WARNING! unknown argument type (%d) to event '%s'"
, argtype, Name);
break
;
}
argtype =
va_arg
( args,
int
);
}
va_end
( args );
PUTBACK;
count = perl_call_pv(EventName, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL EventName, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
return
PerlResult;
}
int
DoEvent_Menu(
NOTXSPROC
HWND
hwnd,
int
nID,
...
) {
int
PerlResult = 1;
int
count;
SV* event = &PL_sv_undef;
char
* name = NULL;
MENUITEMINFO mii;
HMENU
hmenu;
LPPERLWIN32GUI_MENUITEMDATA perlmid = NULL;
ZeroMemory(&mii,
sizeof
(MENUITEMINFO));
mii.cbSize =
sizeof
(MENUITEMINFO);
mii.fMask = MIIM_DATA;
hmenu = GetMenu(hwnd);
if
(hmenu == NULL) hmenu = GetMenuFromID( NOTXSCALL nID );
if
(GetMenuItemInfo( hmenu, nID, 0, &mii ) == 0) {
hmenu = GetMenuFromID( NOTXSCALL nID );
}
if
(GetMenuItemInfo( hmenu, nID, 0, &mii )) {
perlmid = (LPPERLWIN32GUI_MENUITEMDATA) mii.dwItemData;
if
(perlmid != NULL && perlmid->dwSize ==
sizeof
(PERLWIN32GUI_MENUITEMDATA)) {
event = perlmid->svCode;
name = perlmid->szName;
}
}
if
( SvOK(event) ) {
LPPERLWIN32GUI_USERDATA perlud = (LPPERLWIN32GUI_USERDATA) GetWindowLongPtr(hwnd, GWLP_USERDATA);
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
if
( ValidUserData(perlud) )
XPUSHs(perlud->svSelf);
PUTBACK;
count = call_sv(event, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL
""
, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
}
else
if
(name != NULL) {
char
EventName[MAX_EVENT_NAME];
strcpy
(EventName,
"main::"
);
strcat
(EventName, name);
strcat
(EventName,
"_Click"
);
if
(perl_get_cv(EventName, FALSE) != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
PUTBACK;
count = perl_call_pv(EventName, G_EVAL|G_NOARGS);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL EventName, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
}
}
return
PerlResult;
}
int
DoEvent_Accelerator(
NOTXSPROC
LPPERLWIN32GUI_USERDATA perlud,
int
nID
) {
int
count;
char
AcceleratorName[MAX_EVENT_NAME];
LPPERLWIN32GUI_USERDATA perlchild = NULL;
SV* acc_sub = NULL;
int
PerlResult = 1;
HWND
hwnd = handle_From(NOTXSCALL perlud->svSelf);
perlud->dwPlStyle &= ~PERLWIN32GUI_EVENTHANDLING;
{
itoa(nID, AcceleratorName, 10);
HV* hash = perl_get_hv(
"Win32::GUI::Accelerators"
, FALSE);
SV** acc = hv_fetch_mg(NOTXSCALL hash, AcceleratorName,
strlen
(AcceleratorName), FALSE);
if
(acc == NULL)
return
PerlResult;
if
(SvROK (*acc))
acc_sub = SvRV(*acc);
else
if
(SvPOK (*acc)) {
strcpy
(AcceleratorName, (
char
*) SvPV_nolen(*acc));
if
(
strcmp
(perlud->szWindowName, AcceleratorName) != 0) {
st_FindChildWindow st;
st.perlchild = NULL;
st.Name = AcceleratorName;
EnumChildWindows(hwnd, (WNDENUMPROC) FindChildWindowsProc, (
LPARAM
) &st);
perlchild = st.perlchild;
}
}
else
return
PerlResult;
}
if
(acc_sub != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(perlud->svSelf);
XPUSHs(sv_2mortal(newSVpv(AcceleratorName, 0)));
PUTBACK;
count = call_sv(acc_sub, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL
"Click"
, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
else
if
(perlchild != NULL &&
(perlchild->dwPlStyle & PERLWIN32GUI_NEM) && (perlchild->dwEventMask & PERLWIN32GUI_NEM_CLICK)) {
SV** event;
event = hv_fetch( (perlchild->hvEvents),
"Click"
, 5, 0);
if
(event != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(perlchild->svSelf);
PUTBACK;
count = call_sv(*event, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL
"Click"
, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
else
if
((perlud->dwPlStyle & PERLWIN32GUI_NEM) && (perlud->dwEventMask & PERLWIN32GUI_NEM_CLICK)) {
SV** event;
event = hv_fetch( (perlud->hvEvents),
"Click"
, 5, 0);
if
(event != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(perlud->svSelf);
XPUSHs(sv_2mortal(newSVpv(AcceleratorName, 0)));
PUTBACK;
count = call_sv(*event, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL
"Click"
, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
else
if
(perlchild == NULL || perlchild->dwPlStyle & PERLWIN32GUI_OEM) {
char
EventName[MAX_EVENT_NAME];
strcpy
(EventName,
"main::"
);
strcat
(EventName, AcceleratorName);
strcat
(EventName,
"_Click"
);
if
(perl_get_cv(EventName, FALSE) != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
PUTBACK;
count = perl_call_pv(EventName, G_EVAL|G_NOARGS);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL EventName, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
return
PerlResult;
}
char
* DoEvent_NeedText(
NOTXSPROC
LPPERLWIN32GUI_USERDATA perlud,
int
iEventId,
char
*Name,
...) {
va_list
args;
int
count;
int
argtype;
HWND
hwnd = handle_From(NOTXSCALL perlud->svSelf);
static
char
*textneeded = NULL;
if
(textneeded != NULL) {
safefree(textneeded);
textneeded = NULL;
}
int
PerlResult = 1;
perlud->dwPlStyle &= ~PERLWIN32GUI_EVENTHANDLING;
if
((perlud->dwPlStyle & PERLWIN32GUI_NEM) && (perlud->dwEventMask & iEventId)) {
SV** event;
event = hv_fetch( (perlud->hvEvents), Name,
strlen
(Name), 0);
if
(event != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(perlud->svSelf);
va_start
( args, Name );
argtype =
va_arg
( args,
int
);
while
(argtype != -1) {
switch
(argtype) {
case
PERLWIN32GUI_ARGTYPE_INT:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_LONG:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
long
))));
break
;
case
PERLWIN32GUI_ARGTYPE_WORD:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_STRING:
XPUSHs(sv_2mortal(newSVpv(
va_arg
( args,
char
* ), 0)));
break
;
default
:
warn(
"Win32::GUI: WARNING! unknown argument type (%d) to event '%s'"
, argtype, Name);
break
;
}
argtype =
va_arg
( args,
int
);
}
va_end
( args );
PUTBACK;
count = call_sv(*event, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL Name, &PerlResult)) {
if
(count > 0) {
if
(count > 1) {
PerlResult = POPi;
}
else
{
PerlResult = 0;
}
SV* svt = POPs;
textneeded = (
char
*) safemalloc(sv_len(svt) + 1);
strcpy
(textneeded, SvPV_nolen(svt));
}
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
textneeded;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
if
(PerlResult == 1 && (perlud->dwPlStyle & PERLWIN32GUI_OEM) && perlud->szWindowName != NULL) {
char
EventName[MAX_EVENT_NAME];
strcpy
(EventName,
"main::"
);
strcat
(EventName, perlud->szWindowName);
strcat
(EventName,
"_"
);
strcat
(EventName, Name);
if
(perl_get_cv(EventName, FALSE) != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
va_start
( args, Name );
argtype =
va_arg
( args,
int
);
while
(argtype != -1) {
switch
(argtype) {
case
PERLWIN32GUI_ARGTYPE_INT:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_LONG:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
long
))));
break
;
case
PERLWIN32GUI_ARGTYPE_WORD:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_STRING:
XPUSHs(sv_2mortal(newSVpv(
va_arg
( args,
char
* ), 0)));
break
;
default
:
warn(
"Win32::GUI: WARNING! unknown argument type (%d) to event '%s'"
, argtype, Name);
break
;
}
argtype =
va_arg
( args,
int
);
}
va_end
( args );
PUTBACK;
count = perl_call_pv(EventName, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL EventName, &PerlResult)) {
if
(count > 0) {
if
(count > 1) {
PerlResult = POPi;
}
else
{
PerlResult = 0;
}
SV* svt = POPs;
textneeded = (
char
*) safemalloc(sv_len(svt) + 1);
strcpy
(textneeded, SvPV_nolen(svt));
}
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
textneeded;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
return
textneeded;
}
int
DoEvent_Timer (
NOTXSPROC
LPPERLWIN32GUI_USERDATA perlud,
int
iTimerId,
int
iEventId,
char
*Name,
...) {
va_list
args;
int
count;
int
argtype;
char
TimerName[MAX_EVENT_NAME];
int
PerlResult = 1;
HWND
hwnd = handle_From(NOTXSCALL perlud->svSelf);
perlud->dwPlStyle &= ~PERLWIN32GUI_EVENTHANDLING;
{
itoa(iTimerId, TimerName, 10);
SV** timers = hv_fetch_mg(NOTXSCALL (HV*)SvRV(perlud->svSelf),
"-timers"
, 7, FALSE);
if
(timers == NULL || !SvROK(*timers))
return
PerlResult;
SV** name = hv_fetch_mg(NOTXSCALL (HV*) SvRV(*timers), TimerName,
strlen
(TimerName), FALSE);
if
(name == NULL && !SvPOK(*name))
return
PerlResult;
strcpy
(TimerName, (
char
*) SvPV_nolen(*name));
}
if
((perlud->dwPlStyle & PERLWIN32GUI_NEM) && (perlud->dwEventMask & iEventId)) {
SV** event;
event = hv_fetch( perlud->hvEvents,
"Timer"
, 5, 0);
if
(event != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(perlud->svSelf);
XPUSHs(sv_2mortal(newSVpv(TimerName, 0)));
va_start
( args, Name );
argtype =
va_arg
( args,
int
);
while
(argtype != -1) {
switch
(argtype) {
case
PERLWIN32GUI_ARGTYPE_INT:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_LONG:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
long
))));
break
;
case
PERLWIN32GUI_ARGTYPE_WORD:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_STRING:
XPUSHs(sv_2mortal(newSVpv(
va_arg
( args,
char
* ), 0)));
break
;
default
:
warn(
"Win32::GUI: WARNING! unknown argument type (%d) to event '%s'"
, argtype, Name);
break
;
}
argtype =
va_arg
( args,
int
);
}
va_end
( args );
PUTBACK;
count = call_sv(*event, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL Name, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
if
(PerlResult == 1 && (perlud->dwPlStyle & PERLWIN32GUI_OEM)) {
char
EventName[MAX_EVENT_NAME];
strcpy
(EventName,
"main::"
);
strcat
(EventName, TimerName);
strcat
(EventName,
"_"
);
strcat
(EventName, Name);
if
(perl_get_cv(EventName, FALSE) != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
va_start
( args, Name );
argtype =
va_arg
( args,
int
);
while
(argtype != -1) {
switch
(argtype) {
case
PERLWIN32GUI_ARGTYPE_INT:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_LONG:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
long
))));
break
;
case
PERLWIN32GUI_ARGTYPE_WORD:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_STRING:
XPUSHs(sv_2mortal(newSVpv(
va_arg
( args,
char
* ), 0)));
break
;
default
:
warn(
"Win32::GUI: WARNING! unknown argument type (%d) to event '%s'"
, argtype, Name);
break
;
}
argtype =
va_arg
( args,
int
);
}
va_end
( args );
PUTBACK;
count = perl_call_pv(EventName, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL EventName, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
return
PerlResult;
}
int
DoEvent_NotifyIcon (
NOTXSPROC
LPPERLWIN32GUI_USERDATA perlud,
int
iNotifyId,
char
* Name,
...) {
va_list
args;
int
count;
int
argtype;
char
NotifyIconName[MAX_EVENT_NAME];
SV** events = NULL;
int
PerlResult = 1;
HWND
hwnd = handle_From(NOTXSCALL perlud->svSelf);
perlud->dwPlStyle &= ~PERLWIN32GUI_EVENTHANDLING;
{
itoa(iNotifyId, NotifyIconName, 10);
SV** notifyicons = hv_fetch_mg(NOTXSCALL (HV*)SvRV(perlud->svSelf),
"-notifyicons"
, 12, FALSE);
if
(notifyicons == NULL || !SvROK(*notifyicons) )
return
PerlResult;
SV** name = hv_fetch_mg(NOTXSCALL (HV*) SvRV(*notifyicons), NotifyIconName,
strlen
(NotifyIconName), FALSE);
if
(name == NULL)
return
PerlResult;
strcpy
(NotifyIconName, (
char
*) SvPV_nolen(*name));
SV** notifyicon = hv_fetch_mg(NOTXSCALL (HV*) SvRV(perlud->svSelf), NotifyIconName,
strlen
(NotifyIconName), FALSE);
if
(notifyicon != NULL && SvROK(*notifyicon)) {
events = hv_fetch_mg(NOTXSCALL (HV*) SvRV(*notifyicon),
"-events"
, 7, FALSE);
}
}
if
(events != NULL) {
SV** event = hv_fetch( (HV*)SvRV(*events), Name,
strlen
(Name), 0);
if
(event != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(perlud->svSelf);
XPUSHs(sv_2mortal(newSVpv(NotifyIconName, 0)));
va_start
( args, Name );
argtype =
va_arg
( args,
int
);
while
(argtype != -1) {
switch
(argtype) {
case
PERLWIN32GUI_ARGTYPE_INT:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_LONG:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
long
))));
break
;
case
PERLWIN32GUI_ARGTYPE_WORD:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_STRING:
XPUSHs(sv_2mortal(newSVpv(
va_arg
( args,
char
* ), 0)));
break
;
default
:
warn(
"Win32::GUI: WARNING! unknown argument type (%d) to event '%s'"
, argtype, Name);
break
;
}
argtype =
va_arg
( args,
int
);
}
va_end
( args );
PUTBACK;
count = call_sv(*event, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL Name, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
if
(PerlResult == 1 && events == NULL) {
char
EventName[MAX_EVENT_NAME];
strcpy
(EventName,
"main::"
);
strcat
(EventName, NotifyIconName);
strcat
(EventName,
"_"
);
strcat
(EventName, Name);
if
(perl_get_cv(EventName, FALSE) != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
va_start
( args, Name );
argtype =
va_arg
( args,
int
);
while
(argtype != -1) {
switch
(argtype) {
case
PERLWIN32GUI_ARGTYPE_INT:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_LONG:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
long
))));
break
;
case
PERLWIN32GUI_ARGTYPE_WORD:
XPUSHs(sv_2mortal(newSViv(
va_arg
( args,
int
))));
break
;
case
PERLWIN32GUI_ARGTYPE_STRING:
XPUSHs(sv_2mortal(newSVpv(
va_arg
( args,
char
* ), 0)));
break
;
default
:
warn(
"Win32::GUI: WARNING! unknown argument type (%d) to event '%s'"
, argtype, Name);
break
;
}
argtype =
va_arg
( args,
int
);
}
va_end
( args );
PUTBACK;
count = perl_call_pv(EventName, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL EventName, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
return
PerlResult;
}
int
DoEvent_Paint(NOTXSPROC LPPERLWIN32GUI_USERDATA perlud) {
int
count;
SV* newdc;
int
PerlResult = 1;
HWND
hwnd = handle_From(NOTXSCALL perlud->svSelf);
perlud->dwPlStyle &= ~PERLWIN32GUI_EVENTHANDLING;
if
((perlud->dwPlStyle & PERLWIN32GUI_NEM) && (perlud->dwEventMask & PERLWIN32GUI_NEM_PAINT)) {
SV** event;
event = hv_fetch( (perlud->hvEvents),
"Paint"
, 5, 0);
if
(event != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv(
"Win32::GUI::DC"
, 0)));
XPUSHs(perlud->svSelf);
PUTBACK ;
count = perl_call_pv(
"Win32::GUI::DC::new"
, 0);
SPAGAIN ;
newdc = newSVsv(POPs);
PUTBACK;
FREETMPS;
LEAVE;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(perlud->svSelf);
XPUSHs(sv_2mortal(newdc));
PUTBACK;
count = call_sv(*event, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL
"Paint"
, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
if
(PerlResult == 1 && (perlud->dwPlStyle & PERLWIN32GUI_OEM) && perlud->szWindowName != NULL) {
char
EventName[MAX_EVENT_NAME];
strcpy
(EventName,
"main::"
);
strcat
(EventName, perlud->szWindowName);
strcat
(EventName,
"_Paint"
);
if
(perl_get_cv(EventName, FALSE) != NULL) {
PerlResult = 0;
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSVpv(
"Win32::GUI::DC"
, 0)));
XPUSHs(perlud->svSelf);
PUTBACK ;
count = perl_call_pv(
"Win32::GUI::DC::new"
, 0);
SPAGAIN ;
newdc = newSVsv(POPs);
PUTBACK;
FREETMPS;
LEAVE;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newdc));
PUTBACK;
count = perl_call_pv(EventName, G_EVAL|G_ARRAY);
SPAGAIN;
if
(!ProcessEventError(NOTXSCALL EventName, &PerlResult)) {
if
(count > 0) PerlResult = POPi;
}
PUTBACK;
FREETMPS;
LEAVE;
if
(!IsWindow(hwnd))
return
PerlResult;
perlud->dwPlStyle |= PERLWIN32GUI_EVENTHANDLING;
}
}
return
PerlResult;
}
void
DoHook(NOTXSPROC LPPERLWIN32GUI_USERDATA perlud,
UINT
uMsg,
WPARAM
wParam,
LPARAM
lParam,
int
* PerlResult,
int
notify) {
I32 count;
SV** arrayval;
SV* perlsub;
SV** arrayref;
AV* array;
int
i;
I32 originalMsg;
originalMsg = (I32) uMsg;
if
((I32) uMsg < 0) { uMsg = 0 - uMsg; }
arrayref = av_fetch(perlud->avHooks, (I32) uMsg, 0);
if
(arrayref != NULL) {
array = (AV*) SvRV(*arrayref);
SvREFCNT_inc((SV*) array);
for
(i = 0; i <= (
int
) av_len(array); i++) {
arrayval = av_fetch(array,(I32) i,0);
if
(arrayval != NULL) {
perlsub = *arrayval;
SvREFCNT_inc(perlsub);
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(perlud->svSelf);
XPUSHs(sv_2mortal(newSViv(wParam)));
XPUSHs(sv_2mortal(newSViv(lParam)));
XPUSHs(sv_2mortal(newSViv(notify)));
XPUSHs(sv_2mortal(newSViv(originalMsg)));
PUTBACK;
count = call_sv(perlsub, G_ARRAY|G_EVAL);
SPAGAIN;
if
(SvTRUE(ERRSV)) {
ProcessEventError(NOTXSCALL
"Hook"
, PerlResult);
}
else
{
if
(count > 0) { *PerlResult = POPi; }
}
PUTBACK;
FREETMPS;
LEAVE;
SvREFCNT_dec(perlsub);
}
}
SvREFCNT_dec((SV*) array);
}
}