LcCall_tcl.c

Go to the documentation of this file.

 
/* LABEL-NO */
 
#include  "LibLcConfig_tcl.h"
 
#undef META_CONTEXT_S
#define META_CONTEXT_S cfg
 
/*****************************************************************************/
/*                                                                           */
/*                             Proc-Call                                     */
/*                                                                           */
/*****************************************************************************/
 
/*
[ConfigIncludeCall signature]
  callback-args := inclDir:String[in] path:String[in] ret:MkBufferListC[inout]
  [static]    proc callback { callback-args ?additional-args...? } ...
              $cfg SetIncludeFunc callback
  [instance]  ::oo::class create YYY {
                method callback { callback-args ?additional-args...? } ...
              }
              $cfg SetIncludeFunc [list [self] callback]
  [class]     ::oo::class create YYY {
                self method callback { callback-args ?additional-args...? } ...
              }
              $cfg SetIncludeFunc [list YYY callback]
[ConfigIncludeCall signature]
*/
 
enum MkErrorE NS(ConfigIncludeCall) ( LcConfigIncludeCallF_ARGS )
{
  LcConfigIncludeCallF_CHECK;
 
  // 1. setup environment
  SETUP_interp
  if (interp==NULL || Tcl_InterpDeleted(interp)) return MK_OK;
 
  // 2. setup arguments
  struct MkCallS *call = cfg->fConfigIncludeData ;
  Tcl_Obj *objv[6+MkProcResolve_maxArgsLen] = {0};
  int objc = 0;
 
  // 3. setup my
rescan:
  switch (call->type) {
    case MkCallS_own_method: {
      // this is a instance->method
      objv[objc++] = OT_SELF_NAME_O(MkOBJ(cfg));
      break;
    }
    case MkCallS_other_method:
    case MkCallS_static:
      objv[objc++] = call->my;
      break;
    case MkCallS_proc:
      break;
    case MkCallS_init: {
      check_META(MK(ProcResolve)(MK_RT_CALL interp, MkOBJ(cfg), call)) goto error_mq;
      goto rescan;
    }
    case MkCallS_error:
      goto error;
    case MkCallS_null:
      return MK_OK;
  }
 
  // 4. setup methode
  if (call->mth)  objv[objc++] = call->mth;
 
  // 5. setup CTX arg
  switch (call->type) {
    case MkCallS_own_method:
      break;
    case MkCallS_other_method:
    case MkCallS_static:
    case MkCallS_proc:
      objv[objc++] = META2VAL_X(cfg);
      break;
    case MkCallS_init:
      break;
    case MkCallS_error:
      goto error;
    case MkCallS_null:
      return MK_OK;
  }
  objv[objc++]  = Tcl_NewStringObj(incDir,-1);
  objv[objc++]  = Tcl_NewStringObj(path,-1);
  objv[objc++]  = OT_TMP_BFL_OBJ(ret_inout);
 
  if (call->args) MK(ProcResolveAppendArgs)(call,&objc,objv);
 
  // 3. call the callback
  int tclret = MK(EvalObjv) (interp, objc, objv, TCL_EVAL_GLOBAL);
 
  if (tclret == TCL_OK) {
    Tcl_ResetResult(interp);
    return MkErrorGetCode_0E();
  }
error:
  OT_ERROR_LNG_2_META(cfg);
error_mq:
  return MkErrorStack_0E();
}
 
void NS(ConfigIncludeFree) ( LcConfigIncludeFreeF_ARGS )
{
  SETUP_interp;
  if ( interp == NULL || Tcl_InterpDeleted(interp)) return;
 
  MkCallFree(cfg->fConfigIncludeData);
 
  //OT_REF_DECR_AND_NULL(cfg->fConfigIncludeHook);
 
  cfg->fConfigIncludeCall = NULL;
  cfg->fConfigIncludeFree = NULL;
}
 
// =====================================================================================================================
 
/*
[SettingDeleteCall signature]
  callback-args := hdl:EXPORT-HANDLE[in]
  [static]    proc callback { callback-args ?additional-args...? } ...
              $cfg SetSettingDeleteFunc callback
  [instance]  ::oo::class create XXX {
                method callback { callback-args ?additional-args...? } ...
              }
              $cfg SetSettingDeleteFunc [list [self] callback]
  [class]     ::oo::class create YYY {
                self method callback { callback-args ?additional-args...? } ...
              }
              $cfg SetSettingDeleteFunc [list YYY callback]
[SettingDeleteCall signature]
*/
 
enum MkErrorE NS(SettingDeleteCall) ( LcSettingDeleteCallF_ARGS )
{
  LcSettingDeleteCallF_CHECK;
 
  // 1. setup environment
  SETUP_interp
  if (interp==NULL || Tcl_InterpDeleted(interp)) return MK_OK;
 
  static MkThreadLocal bool onCall = false;
  if (onCall) {
printSTACK_1(cfg)
    return MkErrorSetC_2M(cfg,"REKURSIVE call on LcSettingC -> delete handler");
  }
  onCall=true;
 
  // 2. setup arguments
  struct MkCallS *call = cfg->fSettingDeleteData;
  Tcl_Obj *objv[5+MkProcResolve_maxArgsLen] = {0};
  int objc = 0;
 
  if (call->nsPtr == NULL) {
    call->nsPtr = Tcl_FindNamespace(interp,VAL2STR(call->nsO),NULL,TCL_GLOBAL_ONLY);
      if (call->nsPtr == NULL) return MK_OK ;   // instance namespace already deleted
  }
 
  // 3. setup my
rescan:
  switch (call->type) {
    case MkCallS_own_method: {
      // this is a instance->method
      objv[objc++] = OT_SELF_NAME_O(MkOBJ(cfg));
      break;
    }
    case MkCallS_other_method:
    case MkCallS_static:
      objv[objc++] = call->my;
      break;
    case MkCallS_proc:
      break;
    case MkCallS_init: {
      check_META(MK(ProcResolve)(MK_RT_CALL interp, MkOBJ(cfg), call)) goto error;
      goto rescan;
    }
    case MkCallS_error:
      goto error;
    case MkCallS_null:
      return MK_OK;
  }
 
  // 4. setup methode
  if (call->mth)  objv[objc++] = call->mth;
 
  objv[objc++] = LONG2VAL(MkObjectHandleGet_1X(cfs));
 
  if (call->args)  MK(ProcResolveAppendArgs)(call,&objc,objv);
 
  // 3. call the callback
  int tclret = MK(EvalObjv) (interp, objc, objv, TCL_EVAL_GLOBAL);
 
//printV("tclret=%i, code=%s\n", tclret, MkLogErrorE(MkErrorGetCode_0E()))
 
  if (tclret != TCL_OK) goto error;
 
  Tcl_ResetResult(interp);
  onCall = false;
  return MkErrorGetCode_0E();
  
error:
  OT_ERROR_LNG_2_META(cfg);
  onCall = false;
  return MkErrorStack_0E();
}
 
void NS(SettingDeleteFree) ( LcSettingDeleteFreeF_ARGS )
{
  SETUP_interp;
  if ( interp == NULL || Tcl_InterpDeleted(interp) ) return;
 
  MK(CallFree) (&cfg->fSettingDeleteData);
 
  //OT_REF_DECR_AND_NULL(cfg->fSettingDeleteHook);
 
  cfg->fSettingDeleteData = NULL;
  cfg->fSettingDeleteCall = NULL;
  cfg->fSettingDeleteFree = NULL;
}