view release on metacpan or  search on metacpan

tkGlue.c  view on Meta::CPAN

  cm = FindHv(aTHX_ (HV *) SvRV(w),"LangClientMessage",0,CM_KEY);
 if (cm)
  {
   SV **x = hv_fetch(cm,key,strlen(key),0);
   SV *sv;
   if (!x)
    x = hv_fetch(cm,"any",3,0);
   if (x && (sv = *x))
    {
     dSP;
     SV *data = struct_sv(NULL, sizeof(EventAndKeySym));
     EventAndKeySym *info = (EventAndKeySym *) SvPVX(data);
     SV *e  = Blessed("XEvent", MakeReference(data));
     int result;
     info->event  = *event;
     info->keySym = 0;
     info->interp = interp;
     info->window = w;
     info->tkwin  = tkwin;
     ENTER;
     SAVETMPS;
     Tcl_ResetResult(interp);
     Lang_ClearErrorInfo(interp);
     Set_widget(w);
     Set_event(e);
     if (SvROK(w))
      {
       HV *hash = (HV *) SvRV(w);
       hv_store(hash, XEVENT_KEY, strlen(XEVENT_KEY), e, 0);
      }
     else
      Decrement(e,"Unused Event");
     result = PushObjCallbackArgs(interp,&sv,info);
     if (result == TCL_OK)
      LangCallCallback(sv, G_DISCARD | G_EVAL);
     Lang_MaybeError(interp,Check_Eval(interp),"ClientMessage handler");
     if (0 && SvROK(w))
      {
       HV *hash = (HV *) SvRV(w);
       hv_delete(hash, XEVENT_KEY, strlen(XEVENT_KEY), G_DISCARD);
      }
     FREETMPS;
     LEAVE;
    }
#if 0
   else
    {
     warn("%s has no handler for '%s'\n",Tk_PathName(tkwin),key);
    }
#endif
  }
#if 0
 else
  {
   warn("ClientMessage '%s' for %s\n", key, Tk_PathName(tkwin));
  }
#endif
}

int
LangEventCallback(cdata, interp, event, tkwin, keySym)
ClientData cdata;
Tcl_Interp *interp;
Tk_Window tkwin;
XEvent *event;
KeySym keySym;
{
 dTHX;
 SV *sv = (SV *) cdata;
 int result = TCL_ERROR;
 Tk_Window ewin = Tk_EventWindow(event);
#ifdef LEAK_CHECKING
 hash_ptr *save = NULL;
 long hwm = note_used(&save);
 fprintf(stderr, "Event Entry count=%ld hwm=%ld\n", ec = sv_count, hwm);
#endif
 Tcl_ResetResult(interp);
 Lang_ClearErrorInfo(interp);
 if (!SvOK(sv))
  {
   Tcl_SetResult(interp,"Call of undefined callback",TCL_STATIC);
   return TCL_ERROR;
  }
 if (ewin && tkwin)
  {
   dSP;
   int code;
   SV *data = struct_sv(NULL, sizeof(EventAndKeySym));
   EventAndKeySym *info = (EventAndKeySym *) SvPVX(data);
   SV *e = Blessed("XEvent", MakeReference(data));
   SV *w = TkToWidget(tkwin,NULL);
#ifdef DEBUG_GLUE
   fprintf(stderr, "%s:%s(%s) = %p\n", "LangEventCallback", SvPV_nolen(sv), Tk_PathName(tkwin), info);
#endif
   info->event = *event;
   info->keySym = keySym;
   info->interp = interp;
   info->window = w;
   info->tkwin  = tkwin;
   ENTER;
   PUSHSTACKi(PERLSI_MAGIC);
   SAVETMPS;
   PUTBACK;
   Tcl_ResetResult(interp);
   Lang_ClearErrorInfo(interp);
   Set_widget(w);
   Set_event(e);
   result = PushObjCallbackArgs(interp,&sv,info);
   if (SvROK(w))
    {
     HV *hash = (HV *) SvRV(w);
     hv_store(hash, XEVENT_KEY, strlen(XEVENT_KEY), e, 0);
    }
   else
    Decrement(e,"Unused Event");
   if (result == TCL_OK)
    {
     LangCallCallback(sv, G_DISCARD | G_EVAL);
     FREETMPS;
     result = Check_Eval(interp);
    }
   if (0 && SvROK(w))
    {
     HV *hash = (HV *) SvRV(w);
     hv_delete(hash, XEVENT_KEY, strlen(XEVENT_KEY), G_DISCARD);
    }
   POPSTACK;
   LEAVE;
  }