Example #1
0
static int
ScaleCoordsCommand(
    void *recordPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
    Scale *scalePtr = recordPtr;
    double value;
    int r = TCL_OK;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?");
	return TCL_ERROR;
    }

    if (objc == 3) {
	r = Tcl_GetDoubleFromObj(interp, objv[2], &value);
    } else {
	r = Tcl_GetDoubleFromObj(interp, scalePtr->scale.valueObj, &value);
    }

    if (r == TCL_OK) {
	Tcl_Obj *point[2];
	XPoint pt = ValueToPoint(scalePtr, value);
	point[0] = Tcl_NewIntObj(pt.x);
	point[1] = Tcl_NewIntObj(pt.y);
	Tcl_SetObjResult(interp, Tcl_NewListObj(2, point));
    }
    return r;
}
Example #2
0
File: tkColor.c Project: arazaq/ns2
Tcl_Obj *
TkDebugColor(
    Tk_Window tkwin,		/* The window in which the color will be used
				 * (not currently used). */
    char *name)			/* Name of the desired color. */
{
    Tcl_HashEntry *hashPtr;
    Tcl_Obj *resultPtr;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;

    resultPtr = Tcl_NewObj();
    hashPtr = Tcl_FindHashEntry(&dispPtr->colorNameTable, name);
    if (hashPtr != NULL) {
        TkColor *tkColPtr = Tcl_GetHashValue(hashPtr);

        if (tkColPtr == NULL) {
            Tcl_Panic("TkDebugColor found empty hash table entry");
        }
        for ( ; (tkColPtr != NULL); tkColPtr = tkColPtr->nextPtr) {
            Tcl_Obj *objPtr = Tcl_NewObj();

            Tcl_ListObjAppendElement(NULL, objPtr,
                                     Tcl_NewIntObj(tkColPtr->resourceRefCount));
            Tcl_ListObjAppendElement(NULL, objPtr,
                                     Tcl_NewIntObj(tkColPtr->objRefCount));
            Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
        }
    }
    return resultPtr;
}
static int
PrologToTclResult(Tcl_Interp *interp, AP_World *w, AP_Result prolog_result)
{
	switch (prolog_result) {
	case AP_SUCCESS:
	default:
		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
		return TCL_OK;
		break;
	case AP_FAIL:
		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
		return TCL_OK;
		break;
	case AP_EXCEPTION: {
		AP_Obj term_to_string, string;
		term_to_string = AP_NewInitStructure(w,
						AP_NewSymbolFromStr(w, "term_to_string"),
						2,
						AP_GetException(w),
						AP_UNBOUND_OBJ);
		AP_Call(w, tcltk_module, &term_to_string); // ignore result
		string = AP_GetArgument(w, term_to_string, 2);
		
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp,
			"prolog exception: ",
			AP_GetAtomStr(w, string),
			NULL);
		return TCL_ERROR;
		break;
		}
	}
}
Example #4
0
static Tcl_Obj *_make_value(jackctl_parameter_t *parameter, union jackctl_parameter_value value) {
  switch (jackctl_parameter_get_type(parameter)) {
  case JackParamInt: return Tcl_NewIntObj(value.i);
  case JackParamUInt: return Tcl_NewIntObj(value.ui);
  case JackParamChar: return Tcl_NewStringObj(&value.c, 1);
  case JackParamString: return Tcl_NewStringObj(value.str, -1);
  case JackParamBool: return Tcl_NewBooleanObj(value.b);
  default: return Tcl_ObjPrintf("unknown type %d returned by jackctl_parameter_get_type", jackctl_parameter_get_type(parameter));
  }
}
Example #5
0
static int _version(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) {
  _t *dp = (_t *)clientData;
  if (argc != 2) return fw_error_str(interp, "jack-client version");
  int major, minor, micro, proto;
  jack_get_version(&major, &minor, &micro, &proto);
  Tcl_Obj *result[] = {
    Tcl_NewIntObj(major), Tcl_NewIntObj(minor), Tcl_NewIntObj(micro), Tcl_NewIntObj(proto), NULL
  };
  Tcl_SetObjResult(interp, Tcl_NewListObj(4, result));
  return TCL_OK;
}
Example #6
0
Tcl_Obj *
Ttk_NewBoxObj(Ttk_Box box)
{
    Tcl_Obj *result[4];

    result[0] = Tcl_NewIntObj(box.x);
    result[1] = Tcl_NewIntObj(box.y);
    result[2] = Tcl_NewIntObj(box.width);
    result[3] = Tcl_NewIntObj(box.height);

    return Tcl_NewListObj(4, result);
}
Example #7
0
/* Sets up a Tcl interpreter for the game. Adds commands to implement our
   scripting interface. */
void InitScripting(void)
{

    /* First, create an interpreter and make sure it's valid. */
    interp = Tcl_CreateInterp();
    if (interp == NULL) {
	fprintf(stderr, "Unable to initialize Tcl.\n");
	exit(1);
    }

    /* Add the "fireWeapon" command. */
    if (Tcl_CreateObjCommand(interp, "fireWeapon",
			     HandleFireWeaponCmd, (ClientData) 0,
			     NULL) == NULL) {
	fprintf(stderr, "Error creating Tcl command.\n");
	exit(1);
    }

    /* Link the important parts of our player data structures to global
       variables in Tcl. (Ignore the char * typecast; Tcl will treat the data
       as the requested type, in this case double.) */
    Tcl_LinkVar(interp, "player_x", (char *) &player.world_x,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "player_y", (char *) &player.world_y,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "player_angle", (char *) &player.angle,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "player_accel", (char *) &player.accel,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "computer_x", (char *) &opponent.world_x,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "computer_y", (char *) &opponent.world_y,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "computer_angle", (char *) &opponent.angle,
		TCL_LINK_DOUBLE);
    Tcl_LinkVar(interp, "computer_accel", (char *) &opponent.accel,
		TCL_LINK_DOUBLE);

    /* Make the constants in gamedefs.h available to the script. The script
       should play by the game's rules, just like the human player.
       Tcl_SetVar2Ex is part of the Tcl_SetVar family of functions, which
       you can read about in the manpage. It simply sets a variable to a new
       value given by a Tcl_Obj structure. */
    Tcl_SetVar2Ex(interp, "world_width", NULL, Tcl_NewIntObj(WORLD_WIDTH),
		  0);
    Tcl_SetVar2Ex(interp, "world_height", NULL,
		  Tcl_NewIntObj(WORLD_HEIGHT), 0);
    Tcl_SetVar2Ex(interp, "player_forward_thrust", NULL,
		  Tcl_NewIntObj(PLAYER_FORWARD_THRUST), 0);
    Tcl_SetVar2Ex(interp, "player_reverse_thrust", NULL,
		  Tcl_NewIntObj(PLAYER_REVERSE_THRUST), 0);
}
Example #8
0
int MkView::RestrictCmd() {
  int index = asIndex(view, objv[2], false);
  int pos = tcl_GetIntFromObj(objv[3]);
  int count = tcl_GetIntFromObj(objv[4]);

  int result = view.RestrictSearch(view[index], pos, count);

  Tcl_Obj *r = tcl_GetObjResult();
  tcl_ListObjAppendElement(r, Tcl_NewIntObj(result));
  tcl_ListObjAppendElement(r, Tcl_NewIntObj(pos));
  tcl_ListObjAppendElement(r, Tcl_NewIntObj(count));
  return _error;
}
Example #9
0
int NS(pErrorFromMq) (
  Tcl_Interp * interp,
  struct MqS * const mqctx
)
{
  Tcl_Obj *objv[4];
  objv[0] = Tcl_NewStringObj ("TCLMSGQUE", -1);
  objv[1] = Tcl_NewIntObj (MqErrorGetNumI(mqctx));
  objv[2] = Tcl_NewIntObj (MqErrorGetCodeI(mqctx));
  objv[3] = Tcl_NewStringObj (MqErrorGetText(mqctx), -1);
  Tcl_SetObjErrorCode (interp, Tcl_NewListObj (4, objv));
  Tcl_SetResult(interp, (MQ_STR) MqErrorGetText(mqctx), TCL_VOLATILE);
  MqErrorReset(mqctx);
  return TCL_ERROR;
}
Example #10
0
static int
TestwinclockCmd(
    ClientData dummy,		/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Argument count */
    Tcl_Obj *const objv[])	/* Argument vector */
{
    static const FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
				/* The Posix epoch, expressed as a Windows
				 * FILETIME */
    Tcl_Time tclTime;		/* Tcl clock */
    FILETIME sysTime;		/* System clock */
    Tcl_Obj *result;		/* Result of the command */
    LARGE_INTEGER t1, t2;
    LARGE_INTEGER p1, p2;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }

    QueryPerformanceCounter(&p1);

    Tcl_GetTime(&tclTime);
    GetSystemTimeAsFileTime(&sysTime);
    t1.LowPart = posixEpoch.dwLowDateTime;
    t1.HighPart = posixEpoch.dwHighDateTime;
    t2.LowPart = sysTime.dwLowDateTime;
    t2.HighPart = sysTime.dwHighDateTime;
    t2.QuadPart -= t1.QuadPart;

    QueryPerformanceCounter(&p2);

    result = Tcl_NewObj();
    Tcl_ListObjAppendElement(interp, result,
	    Tcl_NewIntObj((int) (t2.QuadPart / 10000000)));
    Tcl_ListObjAppendElement(interp, result,
	    Tcl_NewIntObj((int) ((t2.QuadPart / 10) % 1000000)));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.sec));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.usec));

    Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart));

    Tcl_SetObjResult(interp, result);

    return TCL_OK;
}
Example #11
0
int xFilter(sqlite3_vtab_cursor *cursorP, int idx, const char *idxstrP,
            int argc, sqlite3_value **argv)
{
    VTableInfo *vtabP = (VTableInfo *) cursorP->pVtab;
    Tcl_Obj *objv[4];
    Tcl_Interp *interp;
    int i;

    if (vtabP->vtdbP == NULL || (interp = vtabP->vtdbP->vticP->interp) == NULL) {
        /* Should not really happen */
        SetVTableError(vtabP, gNullInterpError);
        return SQLITE_ERROR;
    }

    objv[0] = ObjFromPtr(cursorP, "sqlite3_vtab_cursor*");
    objv[1] = Tcl_NewIntObj(idx);
    objv[2] = Tcl_NewStringObj(idxstrP ? idxstrP : "", -1);
    objv[3] = Tcl_NewListObj(0, NULL);
    for (i = 0; i < argc; ++i) {
        Tcl_ListObjAppendElement(NULL, objv[3], ObjFromSqliteValue(argv[i], vtabP->vtdbP));
    }

    if (VTableInvokeCmd(interp, vtabP, "xFilter", 4 , objv) != TCL_OK) {
        SetVTableErrorFromInterp(vtabP, interp);
        return SQLITE_ERROR;
    }
    return SQLITE_OK;
}
Example #12
0
static int
rcSeek (ClientData cd_, long offset, int seekMode, int* errorCodePtr)
{
  ReflectingChannel* chan = (ReflectingChannel*) cd_;
  int n = -1;

  Tcl_SavedResult sr;
  Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_seek);
  Tcl_Interp* ip = chan->_interp;

  Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewLongObj(offset));
  Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(seekMode));
  Tcl_SaveResult(ip, &sr);

  if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK &&
      Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n) == TCL_OK)
    chan->_watchMask = chan->_validMask;

  Tcl_RestoreResult(ip, &sr);
  Tcl_DecrRefCount(cmd);

  if (n < 0)
    *errorCodePtr = EINVAL;
  return n;
}
Example #13
0
static int
rcInput (ClientData cd_, char* buf, int toRead, int* errorCodePtr)
{
  ReflectingChannel* chan = (ReflectingChannel*) cd_;
  int n = -1;

  if (chan->_validMask & TCL_READABLE) {
    Tcl_SavedResult sr;
    Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_read);
    Tcl_Interp* ip = chan->_interp;

    Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(toRead));
    Tcl_SaveResult(ip, &sr);

    if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK) {
      void* s = Tcl_GetByteArrayFromObj(Tcl_GetObjResult(ip), &n);
      if (0 <= n && n <= toRead)
      	if (n > 0)
      	  memcpy(buf, s, n);
      	else
      	  chan->_watchMask &= ~TCL_READABLE;
      else
      	n = -1;
    }

    Tcl_RestoreResult(ip, &sr);
    Tcl_DecrRefCount(cmd);
  }

  if (n < 0)
    *errorCodePtr = EINVAL;
  return n;
}
Example #14
0
/*
 * Tcl callback to allow reading of game configuration variables from Tcl.
 */
static int get_param_cb ( ClientData cd, Tcl_Interp *ip, 
			  int argc, const char *argv[]) 
{
    int i;
    int num_params;
    struct param *parm;

    if ( argc != 2 ) {
        Tcl_AppendResult(ip, argv[0], ": invalid number of arguments\n", 
			 "Usage: ", argv[0], " <parameter name>",
			 (char *)0 );
        return TCL_ERROR;
    } 

    /* Search for parameter */
    parm = NULL;
    num_params = sizeof(Params)/sizeof(struct param);
    for (i=0; i<num_params; i++) {
	parm = (struct param*)&Params + i;

	if ( strcmp( parm->name, argv[1] ) == 0 ) {
	    break;
	}
    }

    /* If can't find parameter, report error */
    if ( parm == NULL || i == num_params ) {
	Tcl_AppendResult(ip, argv[0], ": invalid parameter `",
			 argv[1], "'", (char *)0 );
	return TCL_ERROR;
    }

    /* Get value of parameter */
    switch ( parm->type ) {
    case PARAM_STRING:
	fetch_param_string( parm );
	Tcl_SetObjResult( ip, Tcl_NewStringObj( parm->val.string_val, -1 ) );
	break;

    case PARAM_CHAR:
	fetch_param_char( parm );
	Tcl_SetObjResult( ip, Tcl_NewStringObj( &parm->val.char_val, 1 ) );
	break;

    case PARAM_INT:
	fetch_param_int( parm );
	Tcl_SetObjResult( ip, Tcl_NewIntObj( parm->val.int_val ) );
	break;

    case PARAM_BOOL:
	fetch_param_bool( parm );
	Tcl_SetObjResult( ip, Tcl_NewBooleanObj( parm->val.bool_val ) );
	break;

    default:
	code_not_reached();
    }

    return TCL_OK;
} 
static int
Tcl_DoOneEventCmd(ClientData data, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv)
{
	int index, result;
	
	enum {EVENT_WAIT, EVENT_DONT_WAIT};
	const char *eventOptions[] = {"wait", "dont_wait", NULL};

	if (objc != 2) {
		Tcl_WrongNumArgs(interp, 1, objv, (char *)"option");
		return TCL_ERROR;
	}
	
    if (Tcl_GetIndexFromObj(interp, objv[1], eventOptions, (char *)"option", 0, &index)
	    != TCL_OK) {
    	return TCL_ERROR;
    }

	switch (index) {
	case EVENT_WAIT:
		result = Tcl_DoOneEvent(0);
		break;
	case EVENT_DONT_WAIT:
		result = Tcl_DoOneEvent(TCL_DONT_WAIT);
		break;
	default:
	  result = 0;
	  break;
	}
	
	Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
	return TCL_OK;
}
Example #16
0
static int _list_ports(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) {
  if (argc != 2) return fw_error_str(interp, "jack-client list-ports");
  _t *dp = (_t *)clientData;
  Tcl_Obj *dict = Tcl_NewDictObj();
  const char **portv[] = {
    jack_get_ports (dp->fw.client, NULL, JACK_DEFAULT_AUDIO_TYPE, 0),
    jack_get_ports (dp->fw.client, NULL, JACK_DEFAULT_MIDI_TYPE, 0)
  };
  for (int p = 0; p < 2; p += 1)
    if (portv[p] != NULL) {
      for (int i = 0; portv[p][i] != NULL; i += 1) {
	jack_port_t *port = jack_port_by_name(dp->fw.client, portv[p][i]);
	if (port != NULL) {
	  Tcl_Obj *pdict = Tcl_NewDictObj();
	  int flags = jack_port_flags(port);
	  Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("direction", -1), flags & JackPortIsInput ? Tcl_NewStringObj("input", -1) : Tcl_NewStringObj("output", -1) );
	  Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("physical", -1), Tcl_NewIntObj(flags & JackPortIsPhysical ? 1 : 0));
	  Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("type", -1), p == 0 ? Tcl_NewStringObj("audio", -1) : Tcl_NewStringObj("midi", -1));
	  const char **connv = jack_port_get_all_connections(dp->fw.client, port);
	  Tcl_Obj *list = Tcl_NewListObj(0, NULL);
	  if (connv != NULL) {
	    for (int j = 0; connv[j] != NULL; j += 1)
	      Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(connv[j], -1));
	    jack_free(connv);
	  }
	  Tcl_DictObjPut(interp, pdict, Tcl_NewStringObj("connections", -1), list);
	  Tcl_DictObjPut(interp, dict, Tcl_NewStringObj(portv[p][i], -1), pdict);
	}
      }
      jack_free(portv[p]);
    }
  Tcl_SetObjResult(interp, dict);
  return TCL_OK;
}
Example #17
0
/**
\brief
    Description yet to be added.
**/
static int notebookNext ( GtkNotebook *notebook, Tcl_Interp *interp,
						  int objc, Tcl_Obj * const objv[], int isNext )
{
	int cur = gtk_notebook_get_current_page ( notebook );
	int num = 1;

	/* widget next ?count? */

	if ( objc < 2 || objc > 3 )
	{
		Tcl_WrongNumArgs ( interp, 2, objv, "?count?" );
		return TCL_ERROR;
	}

	if ( objc == 3 && Tcl_GetIntFromObj ( interp, objv[2], &num ) != TCL_OK )
		return TCL_ERROR;

	if ( isNext )
	{
		cur = gtk_notebook_get_current_page ( notebook );
		gtk_notebook_set_current_page ( notebook, cur + num );
	}

	else if ( objc == 3 ) /* current val */
		gtk_notebook_set_current_page ( notebook, num );

	cur = gtk_notebook_get_current_page ( notebook );

	Tcl_SetObjResult ( interp, Tcl_NewIntObj ( cur ) );

	return TCL_OK;
}
Example #18
0
void
TclGetAndDetachPids(
    Tcl_Interp *interp,		/* Interpreter to append the PIDs to. */
    Tcl_Channel chan)		/* Handle for the pipeline. */
{
    PipeState *pipePtr;
    const Tcl_ChannelType *chanTypePtr;
    Tcl_Obj *pidsObj;
    int i;

    /*
     * Punt if the channel is not a command channel.
     */

    chanTypePtr = Tcl_GetChannelType(chan);
    if (chanTypePtr != &pipeChannelType) {
        return;
    }

    pipePtr = Tcl_GetChannelInstanceData(chan);
    TclNewObj(pidsObj);
    for (i = 0; i < pipePtr->numPids; i++) {
        Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewIntObj(
                                     PTR2INT(pipePtr->pidPtr[i])));
        Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
        ckfree(pipePtr->pidPtr);
        pipePtr->numPids = 0;
    }
}
Example #19
0
int xColumn(sqlite3_vtab_cursor *cursorP, sqlite3_context *ctxP, int colindex)
{
    VTableInfo *vtabP = (VTableInfo *) cursorP->pVtab;
    Tcl_Obj *objv[2];
    Tcl_Interp *interp;

    if (vtabP->vtdbP == NULL || (interp = vtabP->vtdbP->vticP->interp) == NULL) {
        /* Should not really happen */
        SetVTableError(vtabP, gNullInterpError);
        return SQLITE_ERROR;
    }

    objv[0] = ObjFromPtr(cursorP, "sqlite3_vtab_cursor*");
    objv[1] = Tcl_NewIntObj(colindex);
    switch (VTableInvokeCmd(interp, vtabP, "xColumn", 2, objv)) {
    case TCL_OK:
        ObjToSqliteContextValue(Tcl_GetObjResult(interp), ctxP);
        return SQLITE_OK;
    case TCL_RETURN:
        /* Treat as SQL NULL value. Simply don't call any sqlite3_result_* */
        return SQLITE_OK;
    default:
        sqlite3_result_error(ctxP, Tcl_GetStringResult(interp), -1); 
        return SQLITE_ERROR;
    }
}
Example #20
0
File: midi.c Project: recri/keyer
static int _state(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) {
  _t *data = (_t *)clientData;
  if (argc != 2)
    return fw_error_obj(interp, Tcl_ObjPrintf("usage: %s state", Tcl_GetString(objv[0])));
  Tcl_SetObjResult(interp, Tcl_NewIntObj(data->started));
  return TCL_OK;
}
Example #21
0
static void
get_register_size (int regnum, map_arg arg)
{
  Tcl_ListObjAppendElement (gdbtk_interp, result_ptr->obj_ptr,
			    Tcl_NewIntObj (register_size (get_current_arch (),
							  regnum)));
}
Example #22
0
int NS(ReadGetNumItems) (NS_ARGS)
{
  SETUP_mqctx
  CHECK_NOARGS
  Tcl_SetObjResult(interp, Tcl_NewIntObj(MqReadGetNumItems(mqctx)));
  RETURN_TCL
}
Example #23
0
/*************************************************************************
* FUNCTION      :   RPMPRoblem_Obj::Get_part                             *
* ARGUMENTS     :   enum of part to get                                  *
* RETURNS       :   part as a Tcl_Obj with a 0 refcount                  *
* EXCEPTIONS    :   none                                                 *
* PURPOSE       :   Get a part of the problem report                     *
*************************************************************************/
Tcl_Obj *RPMPRoblem_Obj::Get_part(PARTS x)
{
    switch (x)
    {
        case PACKAGE:
        return Tcl_NewStringObj(problem.pkgNEVR?problem.pkgNEVR:"",-1);
        
        case ALT:
        return Tcl_NewStringObj(problem.altNEVR?problem.altNEVR:"",-1);
        
        case KEY:
        return Tcl_NewLongObj((long)problem.key);
        
        case TYPE:
        return Tcl_NewStringObj(Prob_to_string(problem.type),-1);
        
        case IGNORE:
        return Tcl_NewIntObj(problem.ignoreProblem);
        
        case STRING:
        return  Tcl_NewStringObj(problem.str1?problem.str1:"",-1);
        
        case INT:
        return Tcl_NewLongObj(problem.ulong1);
    }
    return 0;
}
Example #24
0
/*
** sqlite3BitvecBuiltinTest SIZE PROGRAM
**
** Invoke the SQLITE_TESTCTRL_BITVEC_TEST operator on test_control.
** See comments on sqlite3BitvecBuiltinTest() for additional information.
*/
static int testBitvecBuiltinTest(
  void *NotUsed,
  Tcl_Interp *interp,    /* The TCL interpreter that invoked this command */
  int argc,              /* Number of arguments */
  const char **argv      /* Text of each argument */
){
  int sz, rc;
  int nProg = 0;
  int aProg[100];
  const char *z;
  if( argc!=3 ){
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                     " SIZE PROGRAM\"", (void*)0);
  }
  if( Tcl_GetInt(interp, argv[1], &sz) ) return TCL_ERROR;
  z = argv[2];
  while( nProg<99 && *z ){
    while( *z && !sqlite3Isdigit(*z) ){ z++; }
    if( *z==0 ) break;
    aProg[nProg++] = atoi(z);
    while( sqlite3Isdigit(*z) ){ z++; }
  }
  aProg[nProg] = 0;
  rc = sqlite3_test_control(SQLITE_TESTCTRL_BITVEC_TEST, sz, aProg);
  Tcl_SetObjResult(interp, Tcl_NewIntObj(rc));
  return TCL_OK;
}  
Example #25
0
static int
TestwincpuidCmd(
    ClientData dummy,
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    int status, index, i;
    unsigned int regs[4];
    Tcl_Obj *regsObjs[4];

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "eax");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
	return TCL_ERROR;
    }
    status = TclWinCPUID((unsigned) index, regs);
    if (status != TCL_OK) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("operation not available", -1));
	return status;
    }
    for (i=0 ; i<4 ; ++i) {
	regsObjs[i] = Tcl_NewIntObj((int) regs[i]);
    }
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
    return TCL_OK;
}
Example #26
0
static TclObject
methodToListObj (const Method &method)
{
    TclObject list(Tcl_NewListObj(0, 0));

    // Put member id.
    list.lappend(Tcl_NewIntObj(method.memberid()));

    // Put return type.
    list.lappend(typeToListObj(method.type()));

    // Put method name.
    list.lappend(
        Tcl_NewStringObj(const_cast<char *>(method.name().c_str()), -1));

    // Put parameters.
    TclObject parameterList(Tcl_NewListObj(0, 0));

    const Method::Parameters &parameters = method.parameters();
    for (Method::Parameters::const_iterator p = parameters.begin();
     p != parameters.end(); ++p) {
        parameterList.lappend(parameterToListObj(*p));
    }

    list.lappend(parameterList);

    return list;
}
Example #27
0
/*
** Write data to an tvfs-file.
*/
static int tvfsWrite(
  sqlite3_file *pFile, 
  const void *zBuf, 
  int iAmt, 
  sqlite_int64 iOfst
){
  int rc = SQLITE_OK;
  TestvfsFd *pFd = tvfsGetFd(pFile);
  Testvfs *p = (Testvfs *)pFd->pVfs->pAppData;

  if( p->pScript && p->mask&TESTVFS_WRITE_MASK ){
    tvfsExecTcl(p, "xWrite", 
        Tcl_NewStringObj(pFd->zFilename, -1), pFd->pShmId, 
        Tcl_NewWideIntObj(iOfst), Tcl_NewIntObj(iAmt)
    );
    tvfsResultCode(p, &rc);
  }

  if( rc==SQLITE_OK && tvfsInjectFullerr(p) ){
    rc = SQLITE_FULL;
  }
  if( rc==SQLITE_OK && p->mask&TESTVFS_WRITE_MASK && tvfsInjectIoerr(p) ){
    rc = SQLITE_IOERR;
  }
  
  if( rc==SQLITE_OK ){
    rc = sqlite3OsWrite(pFd->pReal, zBuf, iAmt, iOfst);
  }
  return rc;
}
Example #28
0
/**
\brief      Load and configure widget styles using a resource (.rsc) file.
\author     William j Giddings
\date       25-FEB-2009
**/
int gnoclResourceFileCmd (
	ClientData data,
	Tcl_Interp *interp,
	int objc,
	Tcl_Obj * const objv[] )
{
	g_print ( "gnoclResourceFileCmd\n" ) ;

	int nMax = 500;
	int n;

	if ( objc != 2 )
	{
		Tcl_WrongNumArgs ( interp, 1, objv, NULL );
		return TCL_ERROR;
	}

	char * str = Tcl_GetString ( objv[1] );

	gtk_rc_parse ( str );

	Tcl_SetObjResult ( interp, Tcl_NewIntObj ( n ) );

	return TCL_OK;
}
Example #29
0
File: If.C Project: 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;
}
Example #30
0
static int
TestforkObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)		/* Argument strings. */
{
    pid_t pid;

    if (objc != 1) {
        Tcl_WrongNumArgs(interp, 1, objv, "");
        return TCL_ERROR;
    }
    pid = fork();
    if (pid == -1) {
        Tcl_AppendResult(interp,
                "Cannot fork", NULL);
        return TCL_ERROR;
    }
    /* Only needed when pthread_atfork is not present,
     * should not hurt otherwise. */
    if (pid==0) {
	Tcl_InitNotifier();
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
    return TCL_OK;
}