/* evalhook - call the evalhook function */
LOCAL LVAL evalhook(LVAL expr)
{
LVAL *newfp,olddenv,val;
/* create the new call frame */
newfp = xlsp;
pusharg(cvfixnum((FIXTYPE)(newfp - xlfp)));
pusharg(getvalue(s_evalhook));
pusharg(cvfixnum((FIXTYPE)2));
pusharg(expr);
pusharg(cons(xlenv,xlfenv));
xlfp = newfp;
/* rebind the hook functions to nil */
olddenv = xldenv;
xldbind(s_evalhook,NIL);
xldbind(s_applyhook,NIL);
/* call the hook function */
val = xlapply(2);
/* unbind the symbols */
xlunbind(olddenv);
/* return the value */
return (val);
}
VOID StGWObDoMouse P5C(LVAL, object, int, x, int, y, MouseEventType, type, MouseClickModifier, mods)
{
LVAL Lx, Ly, argv[6], olddenv;
int extend, option;
xlstkcheck(2);
xlsave(Lx);
xlsave(Ly);
argv[0] = object;
argv[2] = Lx = cvfixnum((FIXTYPE) x);
argv[3] = Ly = cvfixnum((FIXTYPE) y);
olddenv = xldenv;
xldbind(s_in_callback, s_true);
if (type == MouseClick) {
extend = ((int) mods) % 2;
option = ((int) mods) / 2;
argv[1] = sk_do_click;
argv[4] = (extend) ? s_true : NIL;
argv[5] = (option) ? s_true : NIL;
xscallsubrvec(xmsend, 6, argv);
}
else {
argv[1] = sk_do_motion;
xscallsubrvec(xmsend, 4, argv);
}
xlpopn(2);
xlunbind(olddenv);
}
/* xljump - jump to a saved execution context */
void xljump(XLCONTEXT *target, int mask, LVAL val)
{
/* unwind the execution stack */
for (; xlcontext != target; xlcontext = xlcontext->c_xlcontext)
/* check for an UNWIND-PROTECT */
if ((xlcontext->c_flags & CF_UNWIND)) {
xltarget = target;
xlmask = mask;
break;
}
/* restore the state */
xlstack = xlcontext->c_xlstack;
xlenv = xlcontext->c_xlenv;
xlfenv = xlcontext->c_xlfenv;
xlunbind(xlcontext->c_xldenv);
xlargv = xlcontext->c_xlargv;
xlargc = xlcontext->c_xlargc;
xlfp = xlcontext->c_xlfp;
xlsp = xlcontext->c_xlsp;
xlvalue = val;
/* call the handler */
_longjmp(xlcontext->c_jmpbuf,mask);
}
/* xevalhook - eval hook function */
LVAL xevalhook(void)
{
LVAL expr,newehook,newahook,newenv,oldenv,oldfenv,olddenv,val;
/* protect some pointers */
xlstkcheck(3);
xlsave(oldenv);
xlsave(oldfenv);
xlsave(newenv);
/* get the expression, the new hook functions and the environment */
expr = xlgetarg();
newehook = xlgetarg();
newahook = xlgetarg();
newenv = (moreargs() ? xlgalist() : NIL);
xllastarg();
/* bind *evalhook* and *applyhook* to the hook functions */
olddenv = xldenv;
xldbind(s_evalhook,newehook);
xldbind(s_applyhook,newahook);
/* establish the environment for the hook function */
if (newenv) {
oldenv = xlenv;
oldfenv = xlfenv;
xlenv = car(newenv);
xlfenv = cdr(newenv);
}
/* evaluate the expression (bypassing *evalhook*) */
val = xlxeval(expr);
/* restore the old environment */
xlunbind(olddenv);
if (newenv) {
xlenv = oldenv;
xlfenv = oldfenv;
}
/* restore the stack */
xlpopn(3);
/* return the result */
return (val);
}
VOID StGWObDoKey P4C(LVAL, object, int, key, int, shift, int, opt)
{
LVAL argv[5], ch, olddenv;
olddenv = xldenv;
xldbind(s_in_callback, s_true);
xlsave1(ch);
ch = cvchar(key);
argv[0] = object;
argv[1] = sk_do_key;
argv[2] = ch;
argv[3] = shift ? s_true : NIL;
argv[4] = opt ? s_true : NIL;
xscallsubrvec(xmsend, 5, argv);
xlpop();
xlunbind(olddenv);
}