예제 #1
0
enum MqErrorE NS(ProcCall) (
  struct MqS * const mqctx,
  MQ_PTR const dataP
)
{
  SETUP_tclctx
  SETUP_interp
  Tcl_Obj *lobjv[2];
  int ret;
  Tcl_Obj *proc = (Tcl_Obj*) dataP;

  // 0. clean all old errors
  //Tcl_ResetResult(interp);

  // the "BqError" have to survive the following line -> skip it
  //MqErrorReset(mqctx);

  // 1. add service handler
  lobjv[0] = proc;

  // 2. setup Command (e.g. the ContextS)
  lobjv[1] = ((Tcl_Obj*)tclctx->mqctx.self);

  // 3. evaluate the script
  Tcl_IncrRefCount(lobjv[0]);
  Tcl_IncrRefCount(lobjv[1]);
  ret = Tcl_EvalObjv (interp, 2, lobjv, TCL_EVAL_GLOBAL);
  Tcl_DecrRefCount(lobjv[1]);
  Tcl_DecrRefCount(lobjv[0]);

  return ret == TCL_OK ? Tcl_ResetResult(interp),MqErrorGetCodeI(mqctx) : NS(ProcError) (tclctx, "ErrorSet");
}
예제 #2
0
파일: If.C 프로젝트: vruge/hqp
//-----------------------------------------------------------------------
extern "C" int If_SetInt(const char *name, int val)
{
  if (!theInterp)
    return IF_ERROR;

#if 0
  // unfortunately Tcl_EvalObjv was not available under Tcl 8.0
  Tcl_Obj *objv[2];

  objv[0] = Tcl_NewStringObj((char *)name, -1);
  objv[1] = Tcl_NewIntObj(val);

  int retcode;
  retcode = Tcl_EvalObjv(theInterp, 2, objv, 0);

  Tcl_DecrRefCount(objv[0]);
  Tcl_DecrRefCount(objv[1]);

  if (retcode != TCL_OK)
    return IF_ERROR;
#else
  char valstr[50];
  sprintf(valstr, "%d", val);
  if (Tcl_VarEval(theInterp, (char *)name, " ", valstr, NULL) != TCL_OK)
    return IF_ERROR;
#endif

  Tcl_ResetResult(theInterp); // reset result as val was accepted
  return IF_OK;
}
예제 #3
0
static Tcl_Obj*
getImageCompressed(HtmlImage2 *pImage)
{
    if (!pImage->pCompressed) {
        Tcl_Interp *interp = pImage->pImageServer->pTree->interp;
        Tcl_Obj *apObj[3];
        apObj[0] = pImage->pImageName;
        apObj[1] = Tcl_NewStringObj("cget", -1);
        apObj[2] = Tcl_NewStringObj("-data", -1);
    
        Tcl_IncrRefCount(apObj[0]);
        Tcl_IncrRefCount(apObj[1]);
        Tcl_IncrRefCount(apObj[2]);
        if (TCL_OK == Tcl_EvalObjv(interp, 3, apObj, TCL_EVAL_GLOBAL)) {
	    int nData;
	    Tcl_Obj *pData = Tcl_GetObjResult(interp);
	    Tcl_GetByteArrayFromObj(pData, &nData);
	    if (nData>0){
                pImage->pCompressed = pData;
                Tcl_IncrRefCount(pData);
	    }
        }
        Tcl_DecrRefCount(apObj[2]);
        Tcl_DecrRefCount(apObj[1]);
        Tcl_DecrRefCount(apObj[0]);
    }
    return pImage->pCompressed;
}
예제 #4
0
파일: tcltk.c 프로젝트: kmillar/rho
SEXP dotTclObjv(SEXP args)
{
    SEXP t,
	avec = CADR(args),
	nm = getAttrib(avec, R_NamesSymbol);
    int objc, i, result;
    Tcl_Obj **objv;
    const void *vmax = vmaxget();

    for (objc = 0, i = 0; i < length(avec); i++){
	if (!isNull(VECTOR_ELT(avec, i)))
	    objc++;
	if (!isNull(nm) && strlen(translateChar(STRING_ELT(nm, i))))
	    objc++;
    }

    objv = (Tcl_Obj **) R_alloc(objc, sizeof(Tcl_Obj *));

    for (objc = i = 0; i < length(avec); i++){
	const char *s;
	char *tmp;
	if (!isNull(nm) && strlen(s = translateChar(STRING_ELT(nm, i)))){
	    tmp = calloc(strlen(s)+2, sizeof(char));
	    *tmp = '-';
	    strcpy(tmp+1, s);
	    objv[objc++] = Tcl_NewStringObj(tmp, -1);
	    free(tmp);
	}
	if (!isNull(t = VECTOR_ELT(avec, i)))
	    objv[objc++] = (Tcl_Obj *) R_ExternalPtrAddr(t);
    }

    for (i = objc; i--; ) Tcl_IncrRefCount(objv[i]);
    result = Tcl_EvalObjv(RTcl_interp, objc, objv, 0);
    for (i = objc; i--; ) Tcl_DecrRefCount(objv[i]);

    if (result == TCL_ERROR)
    {
	char p[512];
	if (strlen(Tcl_GetStringResult(RTcl_interp)) > 500)
	    strcpy(p, _("tcl error.\n"));
	else {
	    char *res;
	    Tcl_DString  res_ds;
	    Tcl_DStringInit(&res_ds);
	    res = Tcl_UtfToExternalDString(NULL,
					   Tcl_GetStringResult(RTcl_interp),
					   -1, &res_ds);
	    snprintf(p, sizeof(p), "[tcl] %s.\n", res);
	    Tcl_DStringFree(&res_ds);
	}
	error(p);
    }

    SEXP res = makeRTclObject(Tcl_GetObjResult(RTcl_interp));
    vmaxset(vmax);
    return res;
}
예제 #5
0
static void tvfsExecTcl(
  Testvfs *p, 
  const char *zMethod,
  Tcl_Obj *arg1,
  Tcl_Obj *arg2,
  Tcl_Obj *arg3
){
  int rc;                         /* Return code from Tcl_EvalObj() */
  int nArg;                       /* Elements in eval'd list */
  int nScript;
  Tcl_Obj ** ap;

  assert( p->pScript );

  if( !p->apScript ){
    int nByte;
    int i;
    if( TCL_OK!=Tcl_ListObjGetElements(p->interp, p->pScript, &nScript, &ap) ){
      Tcl_BackgroundError(p->interp);
      Tcl_ResetResult(p->interp);
      return;
    }
    p->nScript = nScript;
    nByte = (nScript+TESTVFS_MAX_ARGS)*sizeof(Tcl_Obj *);
    p->apScript = (Tcl_Obj **)ckalloc(nByte);
    memset(p->apScript, 0, nByte);
    for(i=0; i<nScript; i++){
      p->apScript[i] = ap[i];
    }
  }

  p->apScript[p->nScript] = Tcl_NewStringObj(zMethod, -1);
  p->apScript[p->nScript+1] = arg1;
  p->apScript[p->nScript+2] = arg2;
  p->apScript[p->nScript+3] = arg3;

  for(nArg=p->nScript; p->apScript[nArg]; nArg++){
    Tcl_IncrRefCount(p->apScript[nArg]);
  }

  rc = Tcl_EvalObjv(p->interp, nArg, p->apScript, TCL_EVAL_GLOBAL);
  if( rc!=TCL_OK ){
    Tcl_BackgroundError(p->interp);
    Tcl_ResetResult(p->interp);
  }

  for(nArg=p->nScript; p->apScript[nArg]; nArg++){
    Tcl_DecrRefCount(p->apScript[nArg]);
    p->apScript[nArg] = 0;
  }
}
예제 #6
0
파일: tpm.c 프로젝트: st3fan/libreswan
stf_status tpm_call_it(Tcl_Obj **objv, int objc)
{
    int   ret;
    const char *res;

    passert(objc>=4);

    DBG(DBG_CONTROLMORE, DBG_log("TPM call %s %s %s %s %s"
				 , Tcl_GetString(objv[0])
				 , Tcl_GetString(objv[1])
				 , Tcl_GetString(objv[2])
				 , Tcl_GetString(objv[3])
				 , objc>4 ? Tcl_GetString(objv[4]) : ""));
		 
    ret = Tcl_EvalObjv(PlutoInterp, objc, objv, TCL_EVAL_GLOBAL);

    res = Tcl_GetStringResult(PlutoInterp);
    
    DBG(DBG_CONTROL, DBG_log("TPM %s(%s,%s,%s,%s) => %s"
			     , Tcl_GetString(objv[0])
			     , Tcl_GetString(objv[1])
			     , Tcl_GetString(objv[2])
			     , Tcl_GetString(objv[3])
			     , objc>4 ? Tcl_GetString(objv[4]) : ""
			     , res));
		 
    if(strcmp(res, "ignore")==0 || strcmp(res, "nothing")==0 || res[0]=='\0') {
	/* just quietly return */
	return STF_OK;
    }

    libreswan_log("TPM result: %s",res);
    if(ret != TCL_OK) {
	libreswan_log("TPM result failed");
    }

    if(strcmp(res, "stf_stolen")==0) {
	return STF_STOLEN;
    }

    if(strcmp(res, "stf_ignore")==0) {
	return STF_IGNORE;
    }

    return STF_OK;
}
예제 #7
0
/*
 * Invoke the command for the specified virtual table with the additional
 * args passed in. Note the additional arg objs are unref'ed eventually so 
 * caller must protect them with ref counts if they accessed on return.
 */
static int VTableInvokeCmd(Tcl_Interp *interp, VTableInfo *vtabP,
                           const char *command, int argobjc, Tcl_Obj **argobjv)
{
    Tcl_Obj *objv[32];
    Tcl_Obj **prefix;
    int nprefix;
    int objc;
    int i;
    int status;
    
    Tcl_ListObjGetElements(interp, vtabP->cmdprefixP, &nprefix, &prefix);
    objc = nprefix + 1 + 1 + argobjc;
    if (objc > (sizeof(objv)/sizeof(objv[0]))) {
        Tcl_SetResult(interp, "Exceeded limit on number of arguments allowed for virtual table method", TCL_STATIC);
        return TCL_ERROR;
    }

    for (i = 0 ; i < nprefix; ++i) {
        objv[i] = prefix[i];
        Tcl_IncrRefCount(objv[i]);
    }

    /* Tack on method such as "update" */
    objv[nprefix] = Tcl_NewStringObj(command, -1);
    Tcl_IncrRefCount(objv[nprefix]);

    /* Tack on virtual table handle */
    objv[nprefix+1] = vtabP->vthandleP;
    Tcl_IncrRefCount(objv[nprefix+1]);

    nprefix += 2;

    /* Finally, extra arguments */
    for (i = 0; i < argobjc; ++i) {
        objv[i + nprefix] = argobjv[i];
        Tcl_IncrRefCount(argobjv[i]);
    }

    status = Tcl_EvalObjv(interp, objc, objv, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);

    for (i = 0; i < objc; ++i) {
        Tcl_DecrRefCount(objv[i]);
    }

    return status;
}
예제 #8
0
char*
completion_generator(const char* text, int state)
{
	const char* match = NULL;
	if (completion_interp && generator_word) {
		Tcl_Obj* objv[4];
		objv[0] = generator_word;
		objv[1] = Tcl_NewStringObj(text, -1);
		objv[2] = Tcl_NewIntObj(state);
		objv[3] = NULL;
		
		if (TCL_OK == Tcl_EvalObjv(completion_interp, 3, objv, TCL_EVAL_DIRECT)) {
			match = Tcl_GetStringResult(completion_interp);
		}
	}
	
	return (match && *match) ? strdup(match) : NULL;
}
예제 #9
0
int
TkBackgroundEvalObjv(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv,
    int flags)
{
    Tcl_InterpState state;
    int n, r = TCL_OK;

    /*
     * Record the state of the interpreter.
     */

    Tcl_Preserve(interp);
    state = Tcl_SaveInterpState(interp, TCL_OK);

    /*
     * Evaluate the command and handle any error.
     */

    for (n = 0; n < objc; ++n) {
	Tcl_IncrRefCount(objv[n]);
    }
    r = Tcl_EvalObjv(interp, objc, objv, flags);
    for (n = 0; n < objc; ++n) {
	Tcl_DecrRefCount(objv[n]);
    }
    if (r == TCL_ERROR) {
	Tcl_AddErrorInfo(interp, "\n    (background event handler)");
	Tcl_BackgroundException(interp, r);
    }

    /*
     * Restore the state of the interpreter.
     */

    (void) Tcl_RestoreInterpState(interp, state);
    Tcl_Release(interp);

    return r;
}
예제 #10
0
파일: tclf.c 프로젝트: nektomk/tcl-f
static int
resolveTypes(Tcl_Interp *interp) {
	Tcl_Obj *objv[6];
	Tcl_Obj *list;
	Tcl_Obj *dict;
	// определение типа lambdaExpr
	objv[0]=Tcl_NewStringObj("apply",-1); 
	objv[1]=Tcl_NewStringObj("x { expr $x + 1}",-1);
	objv[2]=Tcl_NewIntObj(1),-1;
	Tcl_IncrRefCount(objv[0]);
	Tcl_IncrRefCount(objv[1]);
	Tcl_IncrRefCount(objv[2]);
	if (Tcl_EvalObjv(interp,3,objv,0)!=TCL_OK) {
		ERR("in call apply");
		INSPECT_ARRAY(-1,3,objv,"command");
		return TCL_ERROR;
	}
	cmdNameType=objv[0]->typePtr;
	lambdaExprType=objv[1]->typePtr;
	// определение типа List
	
	list=Tcl_NewListObj(3,objv);
	listType=list->typePtr;
	if (listType==NULL || listType->name==NULL || listType->name[0]=='\0') {
		ERR("in resolve listType");
		return TCL_ERROR;
	}
	Tcl_DecrRefCount(list);
	Tcl_DecrRefCount(objv[0]);
	Tcl_DecrRefCount(objv[1]);
	Tcl_DecrRefCount(objv[2]);
	// определение типа dict
	dict=Tcl_NewDictObj();
	if (dict==NULL || dict->typePtr==NULL) {
		ERR("in resolve dictType");
		return TCL_ERROR;
	}
	dictType=dict->typePtr;
	return TCL_OK;
}
예제 #11
0
static int InitNullValueForDB(Tcl_Interp *interp, VTableDB *vtdbP)
{
    Tcl_Obj *objv[2];
    int status;

    objv[0] = vtdbP->dbcmd_objP; /* No need to IncrRef this as vtdbP
                                    already ensures that */
    objv[1] = Tcl_NewStringObj("nullvalue", -1);
    Tcl_IncrRefCount(objv[1]);

    status = Tcl_EvalObjv(interp, 2, objv, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
    Tcl_DecrRefCount(objv[1]);

    if (status == TCL_ERROR)
        return TCL_ERROR;

    if (vtdbP->null_objP)
        Tcl_DecrRefCount(vtdbP->null_objP);
    vtdbP->null_objP = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(vtdbP->null_objP);
    return TCL_OK;
}
예제 #12
0
static PyObject *
Tkapp_Call(PyObject *self, PyObject *args)
{
	Tcl_Obj *objStore[ARGSZ];
	Tcl_Obj **objv = NULL;
	int objc = 0, i;
	PyObject *res = NULL;
	Tcl_Interp *interp = Tkapp_Interp(self);
	/* Could add TCL_EVAL_GLOBAL if wrapped by GlobalCall... */
	int flags = TCL_EVAL_DIRECT;

	objv = objStore;

	if (args == NULL)
		objc = 0;

	else if (!PyTuple_Check(args)) {
		objc = 1;
		objv[0] = AsObj(args);
		if (objv[0] == 0)
			goto finally;
		Tcl_IncrRefCount(objv[0]);
	}
	else {
		objc = PyTuple_Size(args);

		if (objc > ARGSZ) {
			objv = (Tcl_Obj **)ckalloc(objc * sizeof(char *));
			if (objv == NULL) {
				PyErr_NoMemory();
				goto finally;
			}
		}

		for (i = 0; i < objc; i++) {
			PyObject *v = PyTuple_GetItem(args, i);
			if (v == Py_None) {
				objc = i;
				break;
			}
			objv[i] = AsObj(v);
			if (!objv[i])
				goto finally;
			Tcl_IncrRefCount(objv[i]);
		}
	}

	ENTER_TCL

	i = Tcl_EvalObjv(interp, objc, objv, flags);

	ENTER_OVERLAP
	if (i == TCL_ERROR)
		Tkinter_Error(self);
	else {
		/* We could request the object result here, but doing
		   so would confuse applications that expect a string. */
		char *s = Tcl_GetStringResult(interp);
		char *p = s;
		/* If the result contains any bytes with the top bit set,
		   it's UTF-8 and we should decode it to Unicode */
		while (*p != '\0') {
			if (*p & 0x80)
				break;
			p++;
		}
		if (*p == '\0')
			res = PyString_FromStringAndSize(s, (int)(p-s));
		else {
			/* Convert UTF-8 to Unicode string */
			p = strchr(p, '\0');
			res = PyUnicode_DecodeUTF8(s, (int)(p-s), "strict");
			if (res == NULL) {
			    PyErr_Clear();
			    res = PyString_FromStringAndSize(s, (int)(p-s));
			}
		}
	}

	LEAVE_OVERLAP_TCL

  finally:
	for (i = 0; i < objc; i++)
		Tcl_DecrRefCount(objv[i]);
	if (objv != objStore)
		ckfree(FREECAST objv);
	return res;
}
예제 #13
0
파일: cgmap.cpp 프로젝트: CG-it/CG-it
static int obj_Cgmap(ClientData /*UNUSED*/, Tcl_Interp *interp, int argc, Tcl_Obj * const objv[])
{

    Tcl_Obj *atomselect = NULL;
    Tcl_Obj *object = NULL;
    Tcl_Obj *bytes = NULL;
    Tcl_Obj *bytes_append = NULL;
    Tcl_Obj *sel = NULL;
    float *coords = NULL;
    float *coords_append = NULL;
    const char *blockid_field = "user";
    const char *order_field = "user2";
    const char *weight_field= "user3";

    int nframes, natoms, ncoords, result, length;
    int first, last, stride;
    int molid, append_molid;

    natoms = ncoords = result = 0;
    molid = append_molid = 0;
    first = last = 0;
    stride = 1;
    nframes = 1;

    std::vector<float> weight;
    std::vector<int> bead;
    std::vector<int> index;

    // Parse Arguments
    int n = 1;
    while (n < argc) {
        const char *cmd = Tcl_GetString(objv[n]);
        if (!strncmp(cmd, "-molid", 7)) {
            if (Tcl_GetIntFromObj(interp,objv[n+1], &molid) != TCL_OK) {return TCL_ERROR;}
            n += 2;

        } else if (!strncmp(cmd, "-append", 8)) {
            if (Tcl_GetIntFromObj(interp,objv[n+1], &append_molid) != TCL_OK) {return TCL_ERROR;}
            n += 2;

        } else if (!strncmp(cmd, "-sel", 5)) {
            sel = objv[n+1];
            n += 2;

        } else if (!strncmp(cmd, "-first", 5)) {
            if (Tcl_GetIntFromObj(interp,objv[n+1], &first) != TCL_OK) {return TCL_ERROR;}
            n += 2;

        } else if (!strncmp(cmd, "-last", 4)) {
            if (Tcl_GetIntFromObj(interp,objv[n+1], &last) != TCL_OK) {return TCL_ERROR;}
            n += 2;

        } else if (!strncmp(cmd, "-stride", 6)) {
            if (Tcl_GetIntFromObj(interp,objv[n+1], &stride) != TCL_OK) {return TCL_ERROR;}
            n += 2;

        } else if (!strncmp(cmd, "-weight", 7)) {
            weight_field = Tcl_GetString(objv[n+1]);
            n += 2;

        } else if (!strncmp(cmd, "-blockid", 7)) {
            blockid_field = Tcl_GetString(objv[n+1]);
            n += 2;

        } else if (!strncmp(cmd, "-order", 6)) {
            order_field = Tcl_GetString(objv[n+1]);
            n += 2;

        } else {
            Tcl_WrongNumArgs(interp,1,objv, (char *)"molid");
            return TCL_ERROR;
        }
    }

    // Create an internal selection that we can manipulate if none was defined
    // Note that a passed selection overides the passed molid
    if (!sel) {
        Tcl_Obj *script = Tcl_ObjPrintf("atomselect %i all", molid);
        if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
            Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect", TCL_STATIC);
            return TCL_ERROR;
        }
        atomselect = Tcl_GetObjResult(interp);
        Tcl_IncrRefCount(atomselect);

    } else {
        // Create a internal selection that is a COPY of the passed selection
        atomselect = Tcl_DuplicateObj(sel);
        Tcl_IncrRefCount(atomselect);

        // Get the molid
        Tcl_Obj *script = Tcl_DuplicateObj(sel);
        Tcl_AppendToObj(script, " molid", -1);
        if(Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
            Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect", TCL_STATIC);
            return TCL_ERROR;
        }
        Tcl_Obj *molid_result =  Tcl_GetObjResult(interp);
        if (Tcl_GetIntFromObj(interp, molid_result, &molid) != TCL_OK) {return TCL_ERROR;}
    }

    // Get the number of frames
    Tcl_Obj *script = Tcl_ObjPrintf("molinfo %i get numframes", molid);
    if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
        Tcl_SetResult(interp, (char *) "Cgmap: error calling molinfo for nframes", TCL_STATIC);
        return TCL_ERROR;
    }
    object = Tcl_GetObjResult(interp);
    if (Tcl_GetIntFromObj(interp, object, &nframes) != TCL_OK) {
        Tcl_SetResult(interp, (char *) "Cgmap: error parsing number of frames", TCL_STATIC);
        return TCL_ERROR;
    }

    if ( first < 0 || first >= nframes ) {
        Tcl_SetResult(interp, (char *) "Cgmap: illegal value of first_frame", TCL_STATIC);
        return TCL_ERROR;
    }
    if ( last == -1 || last > nframes || last < first ) last = nframes;

    // Get the number of atoms from selection
    script = Tcl_DuplicateObj(atomselect);
    Tcl_AppendToObj(script, " num", -1);
    if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
        Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect", TCL_STATIC);
        return TCL_ERROR;
    }
    object = Tcl_GetObjResult(interp);
    if (Tcl_GetIntFromObj(interp, object, &natoms) != TCL_OK) {
        Tcl_SetResult(interp, (char *) "Cgmap: error parsing number of atoms", TCL_STATIC);
        return TCL_ERROR;
    }

    // Make sure we actually have some atoms
    if (natoms == 0) {
        Tcl_SetResult(interp, (char *) "Cgmap: Selection or molecule contains no atoms", TCL_STATIC);
        return TCL_ERROR;
    }

    // Get the weights (mass)
    script = Tcl_DuplicateObj(atomselect);
    Tcl_AppendPrintfToObj (script, " get %s", weight_field);
    if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
        Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect for weights", TCL_STATIC);
        return TCL_ERROR;
    }
    ncoords = parse_vector(Tcl_GetObjResult(interp), weight, interp);
    if (ncoords == -1) {
        Tcl_SetResult(interp, (char *) "Cgmap: error parsing atomselect result", TCL_STATIC);
        return TCL_ERROR;
    }

    // Get the bead IDs
    script = Tcl_DuplicateObj(atomselect);
    Tcl_AppendPrintfToObj (script, " get %s", blockid_field);
    if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
        Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect for blocks", TCL_STATIC);
        return TCL_ERROR;
    }
    ncoords = parse_ivector(Tcl_GetObjResult(interp), bead, interp, true);
    if (ncoords == -1) {
        Tcl_SetResult(interp, (char *) "Cgmap: error parsing atomselect result", TCL_STATIC);
        return TCL_ERROR;
    }

    // Get the atom IDs, we use these as a map when accessing the coordinate array
    // user2 is set via ::CGit::setBeadID
    script = Tcl_DuplicateObj(atomselect);
    Tcl_AppendPrintfToObj (script, " get %s", order_field);
    if (Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT) != TCL_OK) {
        Tcl_SetResult(interp, (char *) "Cgmap: error calling atomselect for order", TCL_STATIC);
        return TCL_ERROR;
    }
    ncoords = parse_ivector(Tcl_GetObjResult(interp), index, interp, true);
    if (ncoords == -1) {
        Tcl_SetResult(interp, (char *) "Cgmap: error parsing atomselect result", TCL_STATIC);
        return TCL_ERROR;
    }

    // Get current frame of the target mol
    script = Tcl_ObjPrintf("molinfo %d get frame", append_molid);
    if (Tcl_EvalObjEx(interp, script,  TCL_EVAL_DIRECT) != TCL_OK) {
        Tcl_SetResult(interp, (char *) "Cgmap: error getting append mol's current frame", TCL_STATIC);
        return TCL_ERROR;
    }
    int append_frame = 0;
    object = Tcl_GetObjResult(interp);
    if (Tcl_GetIntFromObj(interp, object, &append_frame) != TCL_OK) {
        Tcl_SetResult(interp, (char *) "Cgmap: error parsing append mol's current frame", TCL_STATIC);
        return TCL_ERROR;
    }

    //Get number of atoms in target (append) mol
    script = Tcl_ObjPrintf("molinfo %i get numatoms", append_molid);
    if (Tcl_EvalObjEx(interp, script,  TCL_EVAL_DIRECT) != TCL_OK) {
        Tcl_SetResult(interp, (char *) "Cgmap: error getting append mol's number of atoms", TCL_STATIC);
        return TCL_ERROR;
    }
    int append_natoms = 0;
    object = Tcl_GetObjResult(interp);
    if (Tcl_GetIntFromObj(interp, object, &append_natoms) != TCL_OK) {
        Tcl_SetResult(interp, (char *) "Cgmap: error parsing append mol's number of atoms", TCL_STATIC);
        return TCL_ERROR;
    }

    int print = ((last - first) / 10);
    if (print < 10) print = 10;
    if (print > 100) print = 100;

    //Loop over frames, calculate COMS, set coordinates in target mol
    for (int frame = first;
         frame <= last && frame < nframes;
         frame += stride) {

        if (frame % print == 0) {
            //Tcl_Obj *msg = Tcl_ObjPrintf ("puts \"Mapping frame %i\"", frame);
            Tcl_Obj *msg = Tcl_ObjPrintf ("vmdcon -info \"CGit> Mapping frame %i\"", frame);
            result = Tcl_EvalObjEx(interp, msg, TCL_EVAL_DIRECT);
            if (result != TCL_OK) { return TCL_ERROR; }
        }

        //Update the frames
        Tcl_Obj *mol_chgframe = Tcl_ObjPrintf ("molinfo top set frame %i", frame);
        if (Tcl_EvalObjEx(interp, mol_chgframe, TCL_EVAL_DIRECT) != TCL_OK)
            return TCL_ERROR;

        // Get the coordinates of the molecules in the reference mol
        Tcl_Obj *get_ts = Tcl_ObjPrintf("gettimestep %d %i", molid, frame);
        if (Tcl_EvalObjEx(interp, get_ts,  TCL_EVAL_DIRECT) != TCL_OK) {
            Tcl_SetResult(interp, (char *) "Cgmap: error getting coordinates", TCL_STATIC);
            return TCL_ERROR;
        }

        bytes = Tcl_GetObjResult(interp);
        Tcl_IncrRefCount(bytes);
        Tcl_InvalidateStringRep (bytes);
        coords = reinterpret_cast<float *> (Tcl_GetByteArrayFromObj(bytes, &length));

        /** Create a new frame for append_mol **/
        Tcl_ObjPrintf("animate dup %i", append_molid);
        if (Tcl_EvalObjEx(interp, get_ts,  TCL_EVAL_DIRECT) != TCL_OK) {
            Tcl_SetResult(interp, (char *) "Cgmap: error adding frame to append mol", TCL_STATIC);
            return TCL_ERROR;
        }
        append_frame++;

        Tcl_Obj *setframe = Tcl_ObjPrintf("molinfo %i set frame %i; display update", molid, frame);
        if (Tcl_EvalObjEx(interp, setframe,  TCL_EVAL_DIRECT) != TCL_OK) {
            Tcl_SetResult(interp, (char *) "Cgmap: error updating source frame", TCL_STATIC);
            return TCL_ERROR;
        }

        // Copy PBC conditions
        Tcl_Obj *setpbc = Tcl_ObjPrintf("molinfo %i set {a b c} [molinfo %i get {a b c}]", append_molid, molid);
        if (Tcl_EvalObjEx(interp, setpbc,  TCL_EVAL_DIRECT) != TCL_OK) {
            Tcl_SetResult(interp, (char *) "Cgmap: error updating PBC", TCL_STATIC);
            return TCL_ERROR;
        }

        // Get the coordinates of the molecules in the target (append) mol
        get_ts = Tcl_ObjPrintf("gettimestep %d %i", append_molid, append_frame);
        if (Tcl_EvalObjEx(interp, get_ts,  TCL_EVAL_DIRECT) != TCL_OK) {
            Tcl_SetResult(interp, (char *) "Cgmap: error getting coordinates", TCL_STATIC);
            return TCL_ERROR;
        }

        bytes_append = Tcl_GetObjResult(interp);
        Tcl_IncrRefCount(bytes_append);
        Tcl_InvalidateStringRep(bytes_append);
        coords_append = reinterpret_cast<float *> (Tcl_GetByteArrayFromObj(bytes_append, &length));


        //loop over coordinates and beads, calculate COMs
        int current_bead, current_atom;
        current_bead = current_atom = 0;

        // Nested loop to work on each bead at a time
        float w,x,y,z;
        int j = 0;
        for (int start_atom = 0; start_atom < natoms; ) {
            current_bead = bead[start_atom];

            w = x = y = z = 0;
            // Calculate COM for each bead
            for ( current_atom = start_atom;
                  current_atom < natoms && bead[current_atom] == current_bead;
                  current_atom++) {

                //Lookup the atom index from the selection
                unsigned int idx = index[current_atom];
                float tw = weight[current_atom];

                w += tw;
                x += tw * coords[3*idx];
                y += tw * coords[3*idx+1];
                z += tw * coords[3*idx+2];
            }

            if (w == 0) {
                Tcl_SetResult(interp, (char *) "Cgmap: Bad weight can't total zero", TCL_STATIC);
                return TCL_ERROR;
            }

            // Insert calculated COMS into append_mols coordinate array
            // Need to figure out some kind of bounds checking here...
            coords_append[3 * j    ] = x / w;
            coords_append[3 * j + 1] = y / w;
            coords_append[3 * j + 2] = z / w;

            start_atom = current_atom;
            j++;
        } // bead loop

        // call rawtimestep to set byte array for append_mol
        Tcl_Obj *set_ts[5];

        set_ts[0] = Tcl_NewStringObj("rawtimestep", -1);
        set_ts[1] = Tcl_ObjPrintf("%d",append_molid);
        set_ts[2] = bytes_append;
        set_ts[3] = Tcl_NewStringObj("-frame", -1);
        set_ts[4] = Tcl_NewIntObj(append_frame);

        if (Tcl_EvalObjv (interp, 5, set_ts, 0) != TCL_OK)
            return TCL_ERROR;

        //Cleanup
        Tcl_DecrRefCount(bytes);
        Tcl_DecrRefCount(bytes_append);

    } // Frame loop

    //Cleanup
    Tcl_DecrRefCount(atomselect);

    Tcl_SetResult(interp, (char *) "", TCL_STATIC);
    return TCL_OK;
}
예제 #14
0
void ics_tcl_handler(struct ics_server *ics, struct ics_trigger *trig, struct ics_data *data)
{
	int ret;
	Tcl_Obj *command;
	Tcl_Obj *ics_label;
	Tcl_Obj *who;
	Tcl_Obj *action;
	Tcl_Obj *message;
	Tcl_Obj *sender;
	Tcl_Obj *game_id;
	Tcl_Obj *white;
	Tcl_Obj *black;
	Tcl_Obj *winner;
	Tcl_Obj *loser;
	Tcl_Obj *result;
	Tcl_Obj *style12;
	Tcl_Obj *initial_time;
	Tcl_Obj *time_increment;
	Tcl_Obj **objv;
	char    *hackpad;
	size_t hackpad_len;

	switch (trig->type)
	{
		/* alecmao(U) tells you: hi */
		case ICS_TRIG_TELL:
			command        = Tcl_NewStringObj(trig->command,    strlen(trig->command));
			ics_label      = Tcl_NewStringObj(ics->label,       strlen(ics->label));

			for (hackpad_len=0; data->tokens[0][hackpad_len] != '\0' && data->tokens[0][hackpad_len] != '('; hackpad_len++);

			hackpad = tmalloc0(hackpad_len + 1);
	
			strncpy(hackpad, data->tokens[0], hackpad_len);

			sender         = Tcl_NewStringObj(hackpad, strlen(hackpad));
			
			hackpad        = &data->txt_packet[strlen(data->tokens[0]) + strlen(data->tokens[1]) + strlen(data->tokens[2]) + 3];
			message        = Tcl_NewStringObj(hackpad, strlen(hackpad));

			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(ics_label);
			Tcl_IncrRefCount(sender);
			Tcl_IncrRefCount(message);

			objv = tmalloc(sizeof(Tcl_Obj *) * 4);

			objv[0] = command;
			objv[1] = ics_label;
			objv[2] = sender;
			objv[3] = message;

			ret = Tcl_EvalObjv(ics->tclinterp, 4, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(ics_label);
			Tcl_DecrRefCount(sender);
			Tcl_DecrRefCount(message);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
			}

			free(objv);

			break;
		/* <ICS Label> <game id> <white> <black> <winner> <loser> <result> <message> */
		case ICS_TRIG_ENDGAME:
			command        = Tcl_NewStringObj(trig->command,    strlen(trig->command));
			ics_label      = Tcl_NewStringObj(ics->label,       strlen(ics->label));
			game_id        = Tcl_NewIntObj(ics->game->game_number);
			white          = Tcl_NewStringObj(ics->game->white_name,    strlen(ics->game->white_name));
			black          = Tcl_NewStringObj(ics->game->black_name,    strlen(ics->game->black_name));
			winner         = Tcl_NewStringObj(ics->game->winner_name,   strlen(ics->game->winner_name));
			loser          = Tcl_NewStringObj(ics->game->loser_name,    strlen(ics->game->loser_name));
			result         = Tcl_NewStringObj(ics->game->end_result,    strlen(ics->game->end_result));
			message        = Tcl_NewStringObj(ics->game->end_message,   strlen(ics->game->end_message));

			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(ics_label);
			Tcl_IncrRefCount(game_id);
			Tcl_IncrRefCount(white);
			Tcl_IncrRefCount(black);
			Tcl_IncrRefCount(winner);
			Tcl_IncrRefCount(loser);
			Tcl_IncrRefCount(result);
			Tcl_IncrRefCount(message);

			objv = tmalloc(sizeof(Tcl_Obj *) * 9);

			objv[0] = command;
			objv[1] = ics_label;
			objv[2] = game_id;
			objv[3] = white;
			objv[4] = black;
			objv[5] = winner;
			objv[6] = loser;
			objv[7] = result;
			objv[8] = message;

			ret = Tcl_EvalObjv(ics->tclinterp, 9, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(ics_label);
			Tcl_DecrRefCount(game_id);
			Tcl_DecrRefCount(white);
			Tcl_DecrRefCount(black);
			Tcl_DecrRefCount(winner);
			Tcl_DecrRefCount(loser);
			Tcl_DecrRefCount(result);
			Tcl_DecrRefCount(message);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
			}

			free(objv);

			break;
		/* <ICS Label> <game id> <white> <black> <initial time> <time increment> */
		case ICS_TRIG_GAME: 
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command        = Tcl_NewStringObj(trig->command,    strlen(trig->command));
			ics_label      = Tcl_NewStringObj(ics->label,       strlen(ics->label));
			game_id        = Tcl_NewIntObj(ics->game->game_number);
			white          = Tcl_NewStringObj(ics->game->white_name, strlen(ics->game->white_name));
			black          = Tcl_NewStringObj(ics->game->black_name, strlen(ics->game->black_name));
			initial_time   = Tcl_NewIntObj(ics->game->initial_time);
			time_increment = Tcl_NewIntObj(ics->game->increment_time);

			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(ics_label);
			Tcl_IncrRefCount(game_id);
			Tcl_IncrRefCount(white);
			Tcl_IncrRefCount(black);
			Tcl_IncrRefCount(initial_time);
			Tcl_IncrRefCount(time_increment);

			objv = tmalloc(sizeof(Tcl_Obj *) * 7);

			objv[0] = command;
			objv[1] = ics_label;
			objv[2] = game_id;
			objv[3] = white;
			objv[4] = black;
			objv[5] = initial_time;
			objv[6] = time_increment;

			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(ics->tclinterp, 7, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(ics_label);
			Tcl_DecrRefCount(game_id);
			Tcl_DecrRefCount(white);
			Tcl_DecrRefCount(black);
			Tcl_DecrRefCount(initial_time);
			Tcl_DecrRefCount(time_increment);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
			}

			free(objv);

			break;

		/* <ICS Label> <Message> */
		case ICS_TRIG_MSG: 
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command   = Tcl_NewStringObj(trig->command,    strlen(trig->command));
			ics_label = Tcl_NewStringObj(ics->label,       strlen(ics->label));
			message   = Tcl_NewStringObj(data->txt_packet, strlen(data->txt_packet));

			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(ics_label);
			Tcl_IncrRefCount(message);

			objv = tmalloc(sizeof(Tcl_Obj *) * 3);

			objv[0] = command;
			objv[1] = ics_label;
			objv[2] = message;

			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(ics->tclinterp, 3, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(ics_label);
			Tcl_DecrRefCount(message);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
			}

			free(objv);

			break;

		case ICS_TRIG_CONNECT: 
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command   = Tcl_NewStringObj(trig->command,   strlen(trig->command));
			ics_label = Tcl_NewStringObj(ics->label,      strlen(ics->label));
			who       = Tcl_NewStringObj(data->tokens[1], strlen(data->tokens[1]));

			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(ics_label);
			Tcl_IncrRefCount(who);

			objv = tmalloc(sizeof(Tcl_Obj *) * 3);

			objv[0] = command;
			objv[1] = ics_label;
			objv[2] = who;

			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(ics->tclinterp, 3, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(ics_label);
			Tcl_DecrRefCount(who);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
			}

			free(objv);

			break;
		case ICS_TRIG_MOVE:
			command   = Tcl_NewStringObj(trig->command, strlen(trig->command));
			ics_label = Tcl_NewStringObj(ics->label,    strlen(ics->label));
			style12   = Tcl_NewStringObj(ics->game->style_twelve, strlen(ics->game->style_twelve));

			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(ics_label);
			Tcl_IncrRefCount(style12);

			/* I don't need a NULL last array element */
			objv = tmalloc(sizeof(Tcl_Obj *) * 3);

			objv[0] = command;
			objv[1] = ics_label;
			objv[2] = style12;
	
			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(ics->tclinterp, 3, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(ics_label);
			Tcl_DecrRefCount(style12);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
			}

			free(objv);
			break;
		case ICS_TRIG_NOTIFY: 
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command   = Tcl_NewStringObj(trig->command,   strlen(trig->command));
			ics_label = Tcl_NewStringObj(ics->label,      strlen(ics->label));
			who       = Tcl_NewStringObj(data->tokens[1], strlen(data->tokens[1]));
			action    = Tcl_NewStringObj(data->tokens[3], strlen(data->tokens[3]));

			/* We need to increase the reference count, because if TCL suddenly gets some
			 * time for GC, it will notice a zero reference count
			 */
			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(ics_label);
			Tcl_IncrRefCount(who);
			Tcl_IncrRefCount(action);

			/* I don't need a NULL last array element */
			objv = tmalloc(sizeof(Tcl_Obj *) * 4);

			objv[0] = command;
			objv[1] = ics_label;
			objv[2] = who;
			objv[3] = action;
	
			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(ics->tclinterp, 4, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(ics_label);
			Tcl_DecrRefCount(who);
			Tcl_DecrRefCount(action);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(ics->tclinterp));
			}

			free(objv);
			break;
	}

	return;
}
예제 #15
0
/* This handles all triggers which have a handler of tcl, or was set that way through
 * a bind in a TCL script. 
 *
 * Rewritten to use the proper way, instead of doing that Tcl_ValEval() garbage.
 */
void tcl_handler(struct network *net, struct trigger *trig, struct irc_data *data, struct dcc_session *dcc, const char *dccbuf)
{
	int ret;
	char *my_arg;
	Tcl_Obj *command;
	Tcl_Obj *nick;
	Tcl_Obj *uhost;
	Tcl_Obj *hand;
	Tcl_Obj *chan;
	Tcl_Obj *arg;
	Tcl_Obj *msg;
	Tcl_Obj *from;
	Tcl_Obj *keyword;
	Tcl_Obj *text;
	Tcl_Obj **objv;

	switch (trig->type)
	{
		case TRIG_PUB: 
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command = Tcl_NewStringObj(trig->command,      strlen(trig->command));
			nick    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			uhost   = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
			hand    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			chan    = Tcl_NewStringObj(data->c_params[0],  strlen(data->c_params[0]));

			/* We do this because I'm retarded and have no way of figuring out what should happen after the mask */
			my_arg = tstrdup(troll_makearg(data->rest_str,trig->mask));
			arg     = Tcl_NewStringObj(my_arg, strlen(my_arg));

			/* We need to increase the reference count, because if TCL suddenly gets some
			 * time for GC, it will notice a zero reference count
			 */
			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(nick);
			Tcl_IncrRefCount(uhost);
			Tcl_IncrRefCount(hand);
			Tcl_IncrRefCount(chan);
			Tcl_IncrRefCount(arg);

			/* I don't need a NULL last array element */
			objv = tmalloc(sizeof(Tcl_Obj *) * 6);

			objv[0] = command;
			objv[1] = nick;
			objv[2] = uhost;
			objv[3] = hand;
			objv[4] = chan;
			objv[5] = arg;
	
			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(net->tclinterp, 6, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(nick);
			Tcl_DecrRefCount(uhost);
			Tcl_DecrRefCount(hand);
			Tcl_DecrRefCount(chan);
			Tcl_DecrRefCount(arg);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
			}

			free(my_arg);
			free(objv);

			break;
		case TRIG_PUBM:
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command = Tcl_NewStringObj(trig->command,      strlen(trig->command));
			nick    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			uhost   = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
			hand    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			chan    = Tcl_NewStringObj(data->c_params[0],  strlen(data->c_params[0]));
			text    = Tcl_NewStringObj(data->rest_str,     strlen(data->rest_str));

			/* We need to increase the reference count, because if TCL suddenly gets some
			 * time for GC, it will notice a zero reference count
			 */
			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(nick);
			Tcl_IncrRefCount(uhost);
			Tcl_IncrRefCount(hand);
			Tcl_IncrRefCount(chan);
			Tcl_IncrRefCount(text);

			/* I don't need a NULL last array element */
			objv = tmalloc(sizeof(Tcl_Obj *) * 6);

			objv[0] = command;
			objv[1] = nick;
			objv[2] = uhost;
			objv[3] = hand;
			objv[4] = chan;
			objv[5] = text;
	
			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(net->tclinterp, 6, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(nick);
			Tcl_DecrRefCount(uhost);
			Tcl_DecrRefCount(hand);
			Tcl_DecrRefCount(chan);
			Tcl_DecrRefCount(text);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
			}

			free(objv);

			break;
		case TRIG_MSG:
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command = Tcl_NewStringObj(trig->command,      strlen(trig->command));
			nick    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			uhost   = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
			hand    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));

			/* This is stupid, I don't even remember why the hell I did this */
			my_arg  = ((&data->rest_str[strlen(trig->mask)] == NULL) || &data->rest_str[strlen(trig->mask)+1] == NULL) ? "" : &data->rest_str[strlen(trig->mask)+1];
			text    = Tcl_NewStringObj(my_arg,     strlen(my_arg));

			/* We need to increase the reference count, because if TCL suddenly gets some
			 * time for GC, it will notice a zero reference count
			 */
			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(nick);
			Tcl_IncrRefCount(uhost);
			Tcl_IncrRefCount(hand);
			Tcl_IncrRefCount(text);

			/* I don't need a NULL last array element */
			objv = tmalloc(sizeof(Tcl_Obj *) * 5);

			objv[0] = command;
			objv[1] = nick;
			objv[2] = uhost;
			objv[3] = hand;
			objv[4] = text;
	
			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(net->tclinterp, 5, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(nick);
			Tcl_DecrRefCount(uhost);
			Tcl_DecrRefCount(hand);
			Tcl_DecrRefCount(text);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
			}

			free(objv);
			break;
		case TRIG_MSGM:
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command = Tcl_NewStringObj(trig->command,      strlen(trig->command));
			nick    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			uhost   = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
			hand    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));

			/* This is stupid, I don't even remember why the hell I did this */
			text    = Tcl_NewStringObj(data->rest_str,     strlen(data->rest_str));

			/* We need to increase the reference count, because if TCL suddenly gets some
			 * time for GC, it will notice a zero reference count
			 */
			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(nick);
			Tcl_IncrRefCount(uhost);
			Tcl_IncrRefCount(hand);
			Tcl_IncrRefCount(text);

			/* I don't need a NULL last array element */
			objv = tmalloc(sizeof(Tcl_Obj *) * 5);

			objv[0] = command;
			objv[1] = nick;
			objv[2] = uhost;
			objv[3] = hand;
			objv[4] = text;
	
			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(net->tclinterp, 5, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(nick);
			Tcl_DecrRefCount(uhost);
			Tcl_DecrRefCount(hand);
			Tcl_DecrRefCount(text);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
			}

			free(objv);
			break;
		case TRIG_TOPC:
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command = Tcl_NewStringObj(trig->command,      strlen(trig->command));
			nick    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			uhost   = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
			hand    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			chan    = Tcl_NewStringObj(data->c_params[0],  strlen(data->c_params[0]));
			text    = Tcl_NewStringObj(data->rest_str,     strlen(data->rest_str));

			/* We need to increase the reference count, because if TCL suddenly gets some
			 * time for GC, it will notice a zero reference count
			 */
			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(nick);
			Tcl_IncrRefCount(uhost);
			Tcl_IncrRefCount(hand);
			Tcl_IncrRefCount(chan);
			Tcl_IncrRefCount(text);

			/* I don't need a NULL last array element */
			objv = tmalloc(sizeof(Tcl_Obj *) * 6);

			objv[0] = command;
			objv[1] = nick;
			objv[2] = uhost;
			objv[3] = hand;
			objv[4] = chan;
			objv[5] = text;
	
			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(net->tclinterp, 6, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(nick);
			Tcl_DecrRefCount(uhost);
			Tcl_DecrRefCount(hand);
			Tcl_DecrRefCount(chan);
			Tcl_DecrRefCount(text);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
			}

			free(objv);
			break;
		case TRIG_RAW:
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command = Tcl_NewStringObj(trig->command,      strlen(trig->command));
			from    = Tcl_NewStringObj(data->c_params[0],  strlen(data->c_params[0]));
			keyword = Tcl_NewStringObj(trig->command,      strlen(trig->command));
			text    = Tcl_NewStringObj(data->rest_str,     strlen(data->rest_str));

			/* We need to increase the reference count, because if TCL suddenly gets some
			 * time for GC, it will notice a zero reference count
			 */
			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(from);
			Tcl_IncrRefCount(keyword);
			Tcl_IncrRefCount(text);

			/* I don't need a NULL last array element */
			objv = tmalloc(sizeof(Tcl_Obj *) * 4);

			objv[0] = command;
			objv[1] = from;
			objv[2] = keyword;
			objv[3] = text;
	
			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(net->tclinterp, 4, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(from);
			Tcl_DecrRefCount(keyword);
			Tcl_DecrRefCount(text);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
			}

			free(objv);
			break;
		/* :[email protected] JOIN :#test */
		case TRIG_JOIN:
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command = Tcl_NewStringObj(trig->command,      strlen(trig->command));
			nick    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			uhost   = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
			hand    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			chan    = Tcl_NewStringObj(data->rest_str,     strlen(data->rest_str));

			/* We need to increase the reference count, because if TCL suddenly gets some
			 * time for GC, it will notice a zero reference count
			 */
			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(nick);
			Tcl_IncrRefCount(uhost);
			Tcl_IncrRefCount(hand);
			Tcl_IncrRefCount(chan);


			/* I don't need a NULL last array element */
			objv = tmalloc(sizeof(Tcl_Obj *) * 5);

			objv[0] = command;
			objv[1] = nick;
			objv[2] = uhost;
			objv[3] = hand;
			objv[4] = chan;

			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(net->tclinterp, 5, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(nick);
			Tcl_DecrRefCount(uhost);
			Tcl_DecrRefCount(hand);
			Tcl_DecrRefCount(chan);

			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
			}

			free(objv);
	
			break;
		/* :[email protected] PART #boo :eat my shit */
		case TRIG_PART:
			/* The proper way of doing things, according to #tcl on freenode (they'd know) */
			command = Tcl_NewStringObj(trig->command,      strlen(trig->command));
			nick    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			uhost   = Tcl_NewStringObj(data->prefix->host, strlen(data->prefix->host));
			hand    = Tcl_NewStringObj(data->prefix->nick, strlen(data->prefix->nick));
			chan    = Tcl_NewStringObj(data->c_params[0],  strlen(data->c_params[0]));
			msg     = Tcl_NewStringObj(data->rest_str,     strlen(data->rest_str));


			/* We need to increase the reference count, because if TCL suddenly gets some
			 * time for GC, it will notice a zero reference count
			 */
			Tcl_IncrRefCount(command);
			Tcl_IncrRefCount(nick);
			Tcl_IncrRefCount(uhost);
			Tcl_IncrRefCount(hand);
			Tcl_IncrRefCount(chan);
			Tcl_IncrRefCount(msg);


			/* I don't need a NULL last array element */
			objv = tmalloc(sizeof(Tcl_Obj *) * 6);

			objv[0] = command;
			objv[1] = nick;
			objv[2] = uhost;
			objv[3] = hand;
			objv[4] = chan;
			objv[5] = msg;

			/* Call <command> <nick> <uhost> <hand> <chan> <arg> */
			ret = Tcl_EvalObjv(net->tclinterp, 6, objv, TCL_EVAL_GLOBAL);

			/* Decrement the reference count so the GC will catch it */
			Tcl_DecrRefCount(command);
			Tcl_DecrRefCount(nick);
			Tcl_DecrRefCount(uhost);
			Tcl_DecrRefCount(hand);
			Tcl_DecrRefCount(chan);
			Tcl_DecrRefCount(msg);


			/* If we returned an error, send it to trollbot's warning channel */
			if (ret == TCL_ERROR)
			{
				troll_debug(LOG_WARN,"TCL Error: %s\n",Tcl_GetStringResult(net->tclinterp));
			}

			free(objv);
	
			break;
	}  
}
예제 #16
0
파일: tclHistory.c 프로젝트: nawawi/tcl
int
Tcl_RecordAndEvalObj(
    Tcl_Interp *interp,		/* Token for interpreter in which command will
				 * be executed. */
    Tcl_Obj *cmdPtr,		/* Points to object holding the command to
				 * record and execute. */
    int flags)			/* Additional flags. TCL_NO_EVAL means record
				 * only: don't execute the command.
				 * TCL_EVAL_GLOBAL means evaluate the script
				 * in global variable context instead of the
				 * current procedure. */
{
    int result, call = 1;
    Tcl_CmdInfo info;
    HistoryObjs *histObjsPtr =
	    Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);

    /*
     * Create the references to the [::history add] command if necessary.
     */

    if (histObjsPtr == NULL) {
	histObjsPtr = Tcl_Alloc(sizeof(HistoryObjs));
	TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
	TclNewLiteralStringObj(histObjsPtr->addObj, "add");
	Tcl_IncrRefCount(histObjsPtr->historyObj);
	Tcl_IncrRefCount(histObjsPtr->addObj);
	Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
		histObjsPtr);
    }

    /*
     * Do not call [history] if it has been replaced by an empty proc
     */

    result = Tcl_GetCommandInfo(interp, "::history", &info);
    if (result && (info.deleteProc == TclProcDeleteProc)) {
	Proc *procPtr = (Proc *) info.objClientData;
	call = (procPtr->cmdPtr->compileProc != TclCompileNoOp);
    }

    if (call) {
	Tcl_Obj *list[3];

	/*
	 * Do recording by eval'ing a tcl history command: history add $cmd.
	 */

	list[0] = histObjsPtr->historyObj;
	list[1] = histObjsPtr->addObj;
	list[2] = cmdPtr;

	Tcl_IncrRefCount(cmdPtr);
	(void) Tcl_EvalObjv(interp, 3, list, TCL_EVAL_GLOBAL);
	Tcl_DecrRefCount(cmdPtr);

	/*
	 * One possible failure mode above: exceeding a resource limit.
	 */

	if (Tcl_LimitExceeded(interp)) {
	    return TCL_ERROR;
	}
    }

    /*
     * Execute the command.
     */

    result = TCL_OK;
    if (!(flags & TCL_NO_EVAL)) {
	result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL);
    }
    return result;
}
예제 #17
0
Tk_Image
HtmlImageImage(HtmlImage2 *pImage)
{
    assert(pImage && (pImage->isValid == 1 || pImage->isValid == 0));
    if (!pImage->isValid) {
        /* pImage->image is invalid. This happens if the underlying Tk
         * image, or the image that this is a scaled copy of, is changed
         * or deleted. It also happens the first time this function is
         * called after a call to HtmlImageScale().
         */ 
        Tk_PhotoHandle photo;
        Tk_PhotoImageBlock block;
        Tcl_Interp *interp = pImage->pImageServer->pTree->interp;
        HtmlImage2 *pUnscaled = pImage->pUnscaled;

        if (pUnscaled->pixmap) {
            Tcl_Obj *apObj[4];
            int rc;

/*printf("TODO: BAD. Have to recreate image to make scaled copy.\n");*/

            apObj[0] = pUnscaled->pImageName;
            apObj[1] = Tcl_NewStringObj("configure", -1);
            apObj[2] = Tcl_NewStringObj("-data", -1);
            apObj[3] = pUnscaled->pCompressed;

            Tcl_IncrRefCount(apObj[1]);
            Tcl_IncrRefCount(apObj[2]);
            Tcl_IncrRefCount(apObj[3]);
            pUnscaled->nIgnoreChange++;
            rc = Tcl_EvalObjv(interp, 4, apObj, TCL_EVAL_GLOBAL);
            pUnscaled->nIgnoreChange--;
            assert(rc==TCL_OK);
            Tcl_IncrRefCount(apObj[3]);
            Tcl_DecrRefCount(apObj[2]);
            Tcl_DecrRefCount(apObj[1]);
        }

        assert(pUnscaled);
        if (!pImage->pImageName) {
            /* If pImageName is still NULL, then create a new photo
             * image to write the scaled data to. Todo: Is it possible
             * to do this without invoking a script, creating the Tcl
             * command etc.?
             */
            Tk_Window win = pImage->pImageServer->pTree->tkwin;
            Tcl_Interp *interp = pImage->pImageServer->pTree->interp;
            const char *z;

            Tcl_Eval(interp, "image create photo");
            pImage->pImageName = Tcl_GetObjResult(interp);
            Tcl_IncrRefCount(pImage->pImageName);
            assert(0 == pImage->pDelete);
            assert(0 == pImage->image);

            z = Tcl_GetString(pImage->pImageName);
            pImage->image = Tk_GetImage(interp, win, z, imageChanged, pImage);
        }
        assert(pImage->image);

        CHECK_INTEGER_PLAUSIBILITY(pImage->width);
        CHECK_INTEGER_PLAUSIBILITY(pImage->height);
        CHECK_INTEGER_PLAUSIBILITY(pUnscaled->width);
        CHECK_INTEGER_PLAUSIBILITY(pUnscaled->height);

        /* Write the scaled data into image pImage->image */
        photo = Tk_FindPhoto(interp, Tcl_GetString(pUnscaled->pImageName));
        if (photo) {
            Tk_PhotoGetImage(photo, &block);
        }
        if (photo && block.pixelPtr) { 
            int x, y;                /* Iterator variables */
            int w, h;                /* Width and height of unscaled image */
            int sw, sh;              /* Width and height of scaled image */
            Tk_PhotoHandle s_photo;
            Tk_PhotoImageBlock s_block;

            sw = pImage->width;
            sh = pImage->height;
            w = pUnscaled->width;
            h = pUnscaled->height;
            s_photo = Tk_FindPhoto(interp, Tcl_GetString(pImage->pImageName));

            s_block.pixelPtr = (unsigned char *)HtmlAlloc("temp", sw * sh * 4);
            s_block.width = sw;
            s_block.height = sh;
            s_block.pitch = sw * 4;
            s_block.pixelSize = 4;
            s_block.offset[0] = 0;
            s_block.offset[1] = 1;
            s_block.offset[2] = 2;
            s_block.offset[3] = 3;

            for (x=0; x<sw; x++) {
                int orig_x = ((x * w) / sw);
                for (y=0; y<sh; y++) {
                    unsigned char *zOrig;
                    unsigned char *zScale;
                    int orig_y = ((y * h) / sh);

                    zOrig = &block.pixelPtr[
                        orig_x * block.pixelSize + orig_y * block.pitch];
                    zScale = &s_block.pixelPtr[
                        x * s_block.pixelSize + y * s_block.pitch];

                    zScale[0] = zOrig[block.offset[0]];
                    zScale[1] = zOrig[block.offset[1]];
                    zScale[2] = zOrig[block.offset[2]];
                    zScale[3] = zOrig[block.offset[3]];
                }
            }
            photoputblock(interp, s_photo, &s_block, 0, 0, sw, sh, 0);
            HtmlFree(s_block.pixelPtr);
        } else {
            return HtmlImageImage(pImage->pUnscaled);
        }

        pImage->isValid = 1;
        if (pUnscaled->pixmap) {
            Tcl_Obj *apObj[4];

            apObj[0] = Tcl_NewStringObj("image", -1);
            apObj[1] = Tcl_NewStringObj("create", -1);
            apObj[2] = Tcl_NewStringObj("photo", -1);
            apObj[3] = pUnscaled->pImageName;

            Tcl_IncrRefCount(apObj[0]);
            Tcl_IncrRefCount(apObj[1]);
            Tcl_IncrRefCount(apObj[2]);
            pUnscaled->nIgnoreChange++;
            Tcl_EvalObjv(interp, 4, apObj, TCL_EVAL_GLOBAL);
            pUnscaled->nIgnoreChange--;
            Tcl_DecrRefCount(apObj[2]);
            Tcl_DecrRefCount(apObj[1]);
            Tcl_IncrRefCount(apObj[0]);
        }
    }

    return pImage->image;
}
예제 #18
0
파일: tickle.cpp 프로젝트: demize/shroudbnc
void CallBinds(binding_type_e type, const char* user, CClientConnection *client, int argc, const char** argv) {
	Tcl_Obj** listv;
	CUser *User = NULL;

	int idx = 1;
	Tcl_Obj* objv[3];
	bool lazyConversionDone = false;

	for (int i = 0; i < g_BindCount; i++) {
		if (g_Binds[i].valid && g_Binds[i].type == type) {
			Tcl_DString dsProc;

			if (user && strcasecmp(g_Binds[i].user, user) != 0 && !strcasecmp(g_Binds[i].user, "*") == 0)
				continue;

			bool Match = false;

			if (g_Binds[i].pattern == NULL || strcmp(g_Binds[i].pattern, "*") == 0)
				Match = true;

			if (!Match) {
				for (int a = 0; a < argc; a++) {
					if (strcasecmp(g_Binds[i].pattern, argv[a]) == 0) {
					//if (g_Bouncer->Match(g_Binds[i].pattern, argv[a])) {
						Match = true;

						break;
					}
				}
			}

			if (Match) {
				if (!lazyConversionDone) {
					if (user) {
						Tcl_DString dsUser;

						Tcl_ExternalToUtfDString(g_Encoding, user ? user : "", -1, &dsUser);
						objv[idx++] = Tcl_NewStringObj(Tcl_DStringValue(&dsUser), Tcl_DStringLength(&dsUser));
						Tcl_DStringFree(&dsUser);

						Tcl_IncrRefCount(objv[idx - 1]);
					}

					if (argc) {
						listv = (Tcl_Obj**)malloc(sizeof(Tcl_Obj*) * argc);

						for (int a = 0; a < argc; a++) {
							Tcl_DString dsString;

							Tcl_ExternalToUtfDString(g_Encoding, argv[a], -1, &dsString);
							listv[a] = Tcl_NewStringObj(Tcl_DStringValue(&dsString), Tcl_DStringLength(&dsString));
							Tcl_DStringFree(&dsString);

							Tcl_IncrRefCount(listv[a]);
						}

						objv[idx++] = Tcl_NewListObj(argc, listv);
						Tcl_IncrRefCount(objv[idx - 1]);

						for (int a = 0; a < argc; a++) {
							Tcl_DecrRefCount(listv[a]);
						}

						free(listv);
					}

					lazyConversionDone = true;
				}

				Tcl_ExternalToUtfDString(g_Encoding, g_Binds[i].proc, -1, &dsProc);
				objv[0] = Tcl_NewStringObj(Tcl_DStringValue(&dsProc), Tcl_DStringLength(&dsProc));
				Tcl_DStringFree(&dsProc);

				Tcl_IncrRefCount(objv[0]);

				if (User == NULL) {
					User = g_Bouncer->GetUser(user);
				}

				if (User != NULL) {
					setctx(user);
				}

				g_CurrentClient = client;

				Tcl_EvalObjv(g_Interp, idx, objv, TCL_EVAL_GLOBAL);

				Tcl_DecrRefCount(objv[0]);
			}
		}
	}

	if (lazyConversionDone) {
		for (int i = 1; i < idx; i++) {
			if (objv[i])
				Tcl_DecrRefCount(objv[i]);
		}
	}
}