Example #1
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 #2
0
static int _get(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) {
  if (argc != 2)
    return fw_error_obj(interp, Tcl_ObjPrintf("usage: %s get", Tcl_GetString(objv[0])));
  _t *data = (_t *)clientData;
  if ( ! data->started)
    return fw_error_obj(interp, Tcl_ObjPrintf("audio-tap %s is not running", Tcl_GetString(objv[0])));
  // figure out where to read from
  while (1) {
    // start with no choice
    buffer_t *choice = NULL;
    // look for the oldest unread buffer
    for (int i = 0; i < data->buff_n; i += 1)
      if ( ! data->buffs[i].bread && (choice == NULL || choice->bframe > data->buffs[i].bframe))
	choice = &data->buffs[i];
    // if nothing was found, return an empty string
    if (choice == NULL) {
      Tcl_Obj *result[] = { Tcl_NewLongObj(0), Tcl_NewStringObj("", -1), NULL };
      return fw_success_obj(interp, Tcl_NewListObj(2, result));
    }
    // attempt to grab the choice
    Tcl_IncrRefCount(choice->buff);
    // if it's now marked as read, then the process callback grabbed it
    // loop back and try again
    if (choice->bread) {
      Tcl_DecrRefCount(choice->buff);
      continue;
    }
    // it's ours now that the ref count incremented
    Tcl_Obj *result[] = { Tcl_NewLongObj(choice->bframe), choice->buff, NULL };
    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
    Tcl_DecrRefCount(choice->buff);
    choice->bread = 1;
    return TCL_OK;
  }
}
Example #3
0
void
TkpGetSubFonts(
    Tcl_Interp *interp,
    Tk_Font tkfont)
{
    Tcl_Obj *objv[3], *listPtr, *resultPtr;
    UnixFtFont *fontPtr = (UnixFtFont *) tkfont;
    FcPattern *pattern;
    char *family = "Unknown", **familyPtr = &family;
    char *foundry = "Unknown", **foundryPtr = &foundry;
    char *encoding = "Unknown", **encodingPtr = &encoding;
    int i;

    resultPtr = Tcl_NewListObj(0, NULL);

    for (i = 0; i < fontPtr->nfaces ; ++i) {
 	pattern = FcFontRenderPrepare(0, fontPtr->pattern,
		fontPtr->faces[i].source);

	XftPatternGetString(pattern, XFT_FAMILY, 0, familyPtr);
	XftPatternGetString(pattern, XFT_FOUNDRY, 0, foundryPtr);
	XftPatternGetString(pattern, XFT_ENCODING, 0, encodingPtr);
	objv[0] = Tcl_NewStringObj(family, -1);
	objv[1] = Tcl_NewStringObj(foundry, -1);
	objv[2] = Tcl_NewStringObj(encoding, -1);
	listPtr = Tcl_NewListObj(3, objv);
	Tcl_ListObjAppendElement(NULL, resultPtr, listPtr);
    }
    Tcl_SetObjResult(interp, resultPtr);
}
Example #4
0
static TclObject
parameterToListObj (const Parameter &parameter)
{
    TclObject list(Tcl_NewListObj(0, 0));

    // Put parameter passing modes.
    TclObject modes(Tcl_NewListObj(0, 0));

    if (parameter.flags() & PARAMFLAG_FIN) {
        modes.lappend(Tcl_NewStringObj("in", -1));
    }
    if (parameter.flags() & PARAMFLAG_FOUT) {
        modes.lappend(Tcl_NewStringObj("out", -1));
    }
    list.lappend(modes);

    // Put parameter type.
    list.lappend(typeToListObj(parameter.type()));

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

    return list;
}
Example #5
0
void TclTextInterp::graph_label_cb(const char *type, const int *ids, int n) {
  Tcl_Obj *itemlist = Tcl_NewListObj(0, NULL);
  for (int i=0; i<n; i++) {
    Tcl_Obj *item = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(interp, item, Tcl_NewStringObj(type, -1));
    Tcl_ListObjAppendElement(interp, item, Tcl_NewIntObj(ids[i]));
    Tcl_ListObjAppendElement(interp, itemlist, item);
  }
  Tcl_Obj *varname = Tcl_NewStringObj("vmd_graph_label", -1);
  if (!Tcl_ObjSetVar2(interp, varname, NULL, itemlist, 
        TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY)) {
    msgErr << "Error graphing labels: " << Tcl_GetStringResult(interp) << sendmsg;
  }
}
Example #6
0
void
TkpGetFontFamilies(
    Tcl_Interp *interp,		/* Interp to hold result. */
    Tk_Window tkwin)		/* For display to query. */
{
    Tcl_Obj *resultPtr;
    XftFontSet *list;
    int i;

    resultPtr = Tcl_NewListObj(0, NULL);

    list = XftListFonts(Tk_Display(tkwin), Tk_ScreenNumber(tkwin),
		(char*)0,		/* pattern elements */
		XFT_FAMILY, (char*)0);	/* fields */
    for (i = 0; i < list->nfont; i++) {
	char *family, **familyPtr = &family;
	if (XftPatternGetString(list->fonts[i], XFT_FAMILY, 0, familyPtr)
		== XftResultMatch)
	{
	    Tcl_Obj *strPtr = Tcl_NewStringObj(family, -1);
	    Tcl_ListObjAppendElement(NULL, resultPtr, strPtr);
	}
    }
    XftFontSetDestroy(list);

    Tcl_SetObjResult(interp, resultPtr);
}
Example #7
0
/* usage: async_exec_names
   Return list of names of registered async executors
 */
static int
Async_Exec_Names_Cmd(ClientData cdata, Tcl_Interp* interp,
                        int objc, Tcl_Obj* const objv[])
{
  TCL_ARGS(1);

  turbine_code tc;

  const int names_size = TURBINE_ASYNC_EXEC_LIMIT;
  const char *names[names_size];
  int n;
  tc = turbine_async_exec_names(names, names_size, &n);
  TCL_CONDITION(tc == TURBINE_SUCCESS, "Error enumerating executors");

  assert(n >= 0 && n <= names_size);

  Tcl_Obj * name_objs[n];

  for (int i = 0; i < n; i++)
  {
    const char *exec_name = names[i];
    assert(exec_name != NULL);

    name_objs[i] = Tcl_NewStringObj(exec_name, -1);
    TCL_CONDITION(name_objs[i] != NULL, "Error allocating string");
  }

  Tcl_SetObjResult(interp, Tcl_NewListObj(n, name_objs));
  return TCL_OK;
}
Example #8
0
static int alsa_pcm_list(ClientData clientData, Tcl_Interp *interp)
{
  void **hints, **n;
  Tcl_Obj *pcm = Tcl_NewListObj(0, NULL);

  if (snd_device_name_hint(-1, "pcm", &hints) >= 0) {
    n = hints;
    while (*n != NULL) {
      char *name, *descr, *io;
      name = snd_device_name_get_hint(*n, "NAME");
      descr = snd_device_name_get_hint(*n, "DESC");
      io = snd_device_name_get_hint(*n, "IOID");
      Tcl_ListObjAppendElement(interp, pcm, Tcl_ObjPrintf("%s %s %s", name?name:"(null)", descr?descr:"(null)", io?io:"(null)"));
      if (name != NULL)
	free(name);
      if (descr != NULL)
	free(descr);
      if (io != NULL)
	free(io);
      n++;
    }
    snd_device_name_free_hint(hints);
  }
  Tcl_SetObjResult(interp, pcm);
  return TCL_OK;
}
Example #9
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 #10
0
static Tcl_Obj *ObjFromPtr(void *p, char *name)
{
    Tcl_Obj *objs[2];
    objs[0] = Tcl_NewWideIntObj((Tcl_WideInt)p);
    objs[1] = Tcl_NewStringObj(name ? name : "void*", -1);
    return Tcl_NewListObj(2, objs);
}
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
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 #13
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 #14
0
/* + style element options $element --
 * 	Return list of element options for specified element
 */
static int StyleElementOptionsCmd(
    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
    StylePackageData *pkgPtr = clientData;
    Ttk_Theme theme = pkgPtr->currentTheme;
    const char *elementName;
    Ttk_ElementClass *elementClass;

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

    elementName = Tcl_GetString(objv[3]);
    elementClass = Ttk_GetElement(theme, elementName);
    if (elementClass) {
	Ttk_ElementSpec *specPtr = elementClass->specPtr;
	Ttk_ElementOptionSpec *option = specPtr->options;
	Tcl_Obj *result = Tcl_NewListObj(0,0);

	while (option->optionName) {
	    Tcl_ListObjAppendElement(
		interp, result, Tcl_NewStringObj(option->optionName,-1));
	    ++option;
	}

	Tcl_SetObjResult(interp, result);
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	"element %s not found", elementName));
    Tcl_SetErrorCode(interp, "TTK", "LOOKUP", "ELEMENT", elementName, NULL);
    return TCL_ERROR;
}
Example #15
0
void
Sv_RegisterListCommands(void)
{
    static int initialized = 0;

    if (initialized == 0) {
        Tcl_MutexLock(&initMutex);
        if (initialized == 0) {
            /* Create list with 1 empty element. */
            Tcl_Obj *listobj = Tcl_NewObj();
            listobj = Tcl_NewListObj(1, &listobj);
            Sv_RegisterObjType(listobj->typePtr, DupListObjShared);
            Tcl_DecrRefCount(listobj);

            Sv_RegisterCommand("lpop",     SvLpopObjCmd,     NULL, 0);
            Sv_RegisterCommand("lpush",    SvLpushObjCmd,    NULL, 0);
            Sv_RegisterCommand("lappend",  SvLappendObjCmd,  NULL, 0);
            Sv_RegisterCommand("lreplace", SvLreplaceObjCmd, NULL, 0);
            Sv_RegisterCommand("linsert",  SvLinsertObjCmd,  NULL, 0);
            Sv_RegisterCommand("llength",  SvLlengthObjCmd,  NULL, 0);
            Sv_RegisterCommand("lindex",   SvLindexObjCmd,   NULL, 0);
            Sv_RegisterCommand("lrange",   SvLrangeObjCmd,   NULL, 0);
            Sv_RegisterCommand("lsearch",  SvLsearchObjCmd,  NULL, 0);
            Sv_RegisterCommand("lset",     SvLsetObjCmd,     NULL, 0);

            initialized = 1;
        }
        Tcl_MutexUnlock(&initMutex);
    }
}
Example #16
0
static void
get_register_types (int regnum, map_arg arg)
{ 
  struct type *reg_vtype;
  int i,n;

  reg_vtype = register_type (get_current_arch (), regnum);
  
  if (TYPE_CODE (reg_vtype) == TYPE_CODE_UNION)
    {
      n = TYPE_NFIELDS (reg_vtype);
      /* limit to 16 types */
      if (n > 16) 
	n = 16;
      
      for (i = 0; i < n; i++)
	{
	  Tcl_Obj *ar[3], *list;
	  char *buff;
	  buff = xstrprintf ("%lx", (long)TYPE_FIELD_TYPE (reg_vtype, i));
	  ar[0] = Tcl_NewStringObj (TYPE_FIELD_NAME (reg_vtype, i), -1);
	  ar[1] = Tcl_NewStringObj (buff, -1);
	  if (TYPE_CODE (TYPE_FIELD_TYPE (reg_vtype, i)) == TYPE_CODE_FLT)
	    ar[2] = Tcl_NewStringObj ("float", -1);
	  else
	    ar[2] = Tcl_NewStringObj ("int", -1);	    
	  list = Tcl_NewListObj (3, ar);
	  Tcl_ListObjAppendElement (gdbtk_interp, result_ptr->obj_ptr, list);
	  xfree (buff);
	}
    }
  else
    {
      Tcl_Obj *ar[3], *list;
      char *buff;
      buff = xstrprintf ("%lx", (long)reg_vtype);
      ar[0] = Tcl_NewStringObj (TYPE_NAME(reg_vtype), -1);
      ar[1] = Tcl_NewStringObj (buff, -1);
      if (TYPE_CODE (reg_vtype) == TYPE_CODE_FLT)
	ar[2] = Tcl_NewStringObj ("float", -1);
      else
	ar[2] = Tcl_NewStringObj ("int", -1);	    
      list = Tcl_NewListObj (3, ar);
      xfree (buff);
      Tcl_ListObjAppendElement (gdbtk_interp, result_ptr->obj_ptr, list);
    }
}
Example #17
0
/****
 * implementation of shape2list (from RFshape creates a list { {a p} {a p} ... }
 ****/
int tclShape2List(ClientData data,Tcl_Interp* interp,int argc, char *argv[])
{
  Tcl_Obj *lptr1, *lptr2;
  Tcl_Obj *elemptr[2];
  int i, slot;

  if (argc != 2)
    return TclError(interp,"Usage: <list> shape2list <RFshape>");

  if (Tcl_GetInt(interp,argv[1],&slot) == TCL_ERROR) 
    return TclError(interp,"shape2list: argument must be integer <RFshape>");
 
  /* check for RFshape existence */
  if (!RFshapes[slot])
     return TclError(interp,"shape2list: trying to acces non-existing RFshape");

  /* create list objects */
  lptr1 = Tcl_NewListObj(0,NULL);
  if (!lptr1) return TclError(interp,"shape2list unable to create outer list");
  
  for (i=1; i<=RFshapes_len(slot); i++) {
     elemptr[0] = Tcl_NewDoubleObj(RFshapes[slot][i].ampl);
     if (!elemptr[0]) {
        /* Tcl_Free(lptr2);
	Tcl_Free(lptr1); */
	return TclError(interp,"shape2list unable to create double from RFshape amplitude element %d",i);
     }
     elemptr[1] = Tcl_NewDoubleObj(RFshapes[slot][i].phase);
     if (!elemptr[1]) {
        /* Tcl_Free(lptr2);
	Tcl_Free(lptr1); */
	return TclError(interp,"shape2list unable to create double from RFshape amplitude element %d",i);
     }
     lptr2 = Tcl_NewListObj(2,elemptr);
     if (!lptr2) return TclError(interp,"shape2list unable to create inner list");

     if ( Tcl_ListObjAppendElement(interp,lptr1,lptr2) != TCL_OK ) {
        /* Tcl_Free(lptr2);
	Tcl_Free(lptr1); */
	return TclError(interp,"shape2list unable to append element %d to oute list",i);
     }
  }
  
  Tcl_SetObjResult(interp,lptr1);
  
  return TCL_OK;
} 
Example #18
0
void TclTextInterp::mouse_pos_cb(float x, float y, int buttondown) {
  Tcl_Obj *poslist = Tcl_NewListObj(0, NULL);
  Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(x));
  Tcl_ListObjAppendElement(interp, poslist, Tcl_NewDoubleObj(y));
  Tcl_ListObjAppendElement(interp, poslist, Tcl_NewIntObj(buttondown));
  Tcl_Obj *varname = Tcl_NewStringObj("vmd_mouse_pos", -1);
  Tcl_ObjSetVar2(interp, varname, NULL, poslist, TCL_LEAVE_ERR_MSG | TCL_GLOBAL_ONLY);
}
Example #19
0
	Tcl_Obj* TclUtils::toListOfDouble(Tcl_Interp *interp, const std::vector<double>& v) {
		Tcl_Obj *ret = Tcl_NewListObj(0, NULL);

		for (std::vector<double>::const_iterator i = v.begin(), end = v.end(); i != end; ++i) {
			Tcl_ListObjAppendElement(interp, ret, Tcl_NewDoubleObj(*i));
		}

		return ret;
	}
Example #20
0
static Tcl_Obj *ObjFromSqliteValueArray(int argc, sqlite3_value *argv[], VTableDB *vtdbP)
{
    Tcl_Obj *objP = Tcl_NewListObj(0, NULL);
    int i;
    for (i = 0; i < argc; ++i) {
        Tcl_ListObjAppendElement(NULL, objP, ObjFromSqliteValue(argv[i], vtdbP));
    }
    return objP;
}
Example #21
0
/* helper function: create tcl list from complex number */
static Tcl_Obj *make_list_cpx(Tcl_Interp *interp, Tcl_Obj *list, kiss_fft_cpx *num)
{
    Tcl_Obj *cmplx;
    cmplx = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(interp, cmplx, Tcl_NewDoubleObj(num->r));
    Tcl_ListObjAppendElement(interp, cmplx, Tcl_NewDoubleObj(num->i));
    Tcl_ListObjAppendElement(interp, list, cmplx);
    return list;
}
Example #22
0
File: midi.c Project: recri/keyer
static int _get(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) {
  if (argc != 2)
    return fw_error_obj(interp, Tcl_ObjPrintf("usage: %s get", Tcl_GetString(objv[0])));
  _t *data = (_t *)clientData;
  if ( ! data->started)
    return fw_error_obj(interp, Tcl_ObjPrintf("midi %s is not running", Tcl_GetString(objv[0])));

  /* return the collected events */
  Tcl_Obj *list = Tcl_NewListObj(0, NULL);
  jack_nframes_t frame;
  Tcl_Obj *bytes;
  while (_read(data, &frame, &bytes)) {
    Tcl_Obj *element[] = { Tcl_NewIntObj(frame), bytes, NULL };
    Tcl_ListObjAppendElement(interp, list, Tcl_NewListObj(2, element));
  }
  Tcl_SetObjResult(interp, list);
  return TCL_OK;
}
Example #23
0
TnmSnmp*
TnmSnmpCreateSession(Tcl_Interp *interp, char type)
{
    TnmSnmp *session;
    const char *user;

    session = (TnmSnmp *) ckalloc(sizeof(TnmSnmp));
    memset((char *) session, 0, sizeof(TnmSnmp));

    session->interp = interp;
    session->maddr.sin_family = AF_INET;
    if (type == TNM_SNMP_GENERATOR || type == TNM_SNMP_NOTIFIER) {
       session->maddr.sin_addr.s_addr = htonl(INADDR_LOOPBACK);
    } else {
       session->maddr.sin_addr.s_addr = htonl(INADDR_ANY);
    }
    if (type == TNM_SNMP_LISTENER || type == TNM_SNMP_NOTIFIER) {
	session->maddr.sin_port = htons((unsigned short) TNM_SNMP_TRAPPORT);
    } else {
	session->maddr.sin_port = htons((unsigned short) TNM_SNMP_PORT);
    }
    session->version = TNM_SNMPv1;
    session->domain = TNM_SNMP_UDP_DOMAIN;
    session->type = type;
    session->community = Tcl_NewStringObj("public", 6);
    Tcl_IncrRefCount(session->community);
    session->context = Tcl_NewStringObj("", 0);
    Tcl_IncrRefCount(session->context);

    user = Tcl_GetVar2(interp, "tnm", "user", TCL_GLOBAL_ONLY);
    if (! user) {
	user = "******";
    }
    session->user = Tcl_NewStringObj(user, (int) strlen(user));
    Tcl_IncrRefCount(session->user);
    session->engineID = Tcl_NewStringObj("", 0);
    Tcl_IncrRefCount(session->engineID);
    session->maxSize = TNM_SNMP_MAXSIZE;
    session->securityLevel = TNM_SNMP_AUTH_NONE | TNM_SNMP_PRIV_NONE;
    session->maxSize = TNM_SNMP_MAXSIZE;
    session->authPassWord = Tcl_NewStringObj("public", 6);
    Tcl_IncrRefCount(session->authPassWord);
    session->privPassWord = Tcl_NewStringObj("private", 6);
    Tcl_IncrRefCount(session->privPassWord);
    session->retries = TNM_SNMP_RETRIES;
    session->timeout = TNM_SNMP_TIMEOUT;
    session->window  = TNM_SNMP_WINDOW;
    session->delay   = TNM_SNMP_DELAY;
    session->tagList = Tcl_NewListObj(0, NULL);
    Tcl_IncrRefCount(session->tagList);

    TnmOidInit(&session->enterpriseOid);
    TnmOidFromString(&session->enterpriseOid, "1.3.6.1.4.1.1575");

    return session;
}
Example #24
0
int sasfit_load_plugin(Tcl_Interp * interp, 
			Tcl_Obj * filename_obj, 
			int func_count)
{
	int retcode = 0, i = 0;
	const char * filename = 0;
	Tcl_Obj * retlist = 0;
	Tcl_PackageInitProc * proc = 0;
	Tcl_FSUnloadFileProc * unload_proc = 0;
	Tcl_LoadHandle load_handle;
	sasfit_plugin_api_t plugin_api;

	if ( !interp || !filename_obj )
	{
		sasfit_err("One of the supplied arguments is NULL!\n");
		return TCL_ERROR;
	}

	filename = Tcl_GetStringFromObj(filename_obj, 0);

	sasfit_plugin_api_reset(&plugin_api);

	for(i=0; i < SASFIT_PLUGIN_API_NUM ;i++)
	{
		proc = 0;
		retcode = Tcl_FSLoadFile(interp, filename_obj, 
					plugin_api.names[i], 0, &proc, 0, 
					&load_handle, &unload_proc);

		// check for error while loading
		if ( retcode != TCL_OK || !proc ) 
		{
			sasfit_err("Could not load function '%s'!\n%s\n", 
					plugin_api.names[i], 
					Tcl_GetStringResult(interp));

			if ( !proc && unload_proc ) (*unload_proc)(load_handle);
			return TCL_ERROR;
		}
		sasfit_plugin_api_set(&plugin_api, i, (void *) proc);
//		sasfit_plugin_api_print(&plugin_api);
	}

	retlist = Tcl_NewListObj(0, 0);

	if ( add_functions_to_db_and_list(interp, &plugin_api, retlist, func_count) == TCL_ERROR )
	{
		if ( unload_proc ) (*unload_proc)(load_handle);
		Tcl_DecrRefCount(retlist);
		return TCL_ERROR;
	}

	Tcl_SetObjResult(interp, retlist);

	return TCL_OK;
}
Example #25
0
// void jackctl_parameter_get_range_constraint(jackctl_parameter_t * parameter, union jackctl_parameter_value * min_ptr, union jackctl_parameter_value * max_ptr);
static int _parameter_get_range_constraint(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) {
  if (argc != 3) return fw_error_str(interp, "usage: jack-ctl parameter-get-range-constraint parameter");
  jackctl_parameter_t * parameter;
  if (_get_pointer(interp, objv[2], (void**)&parameter) != TCL_OK)
    return TCL_ERROR;
  union jackctl_parameter_value min, max;
  jackctl_parameter_get_range_constraint(parameter, &min, &max);
  Tcl_Obj *result[] = { _make_value(parameter, min), _make_value(parameter, max), NULL };
  return fw_success_obj(interp, Tcl_NewListObj(2, result));
}
Example #26
0
static Tcl_Obj*
AsObj(PyObject *value)
{
	Tcl_Obj *result;

	if (PyString_Check(value))
		return Tcl_NewStringObj(PyString_AS_STRING(value),
					PyString_GET_SIZE(value));
	else if (PyInt_Check(value))
		return Tcl_NewLongObj(PyInt_AS_LONG(value));
	else if (PyFloat_Check(value))
		return Tcl_NewDoubleObj(PyFloat_AS_DOUBLE(value));
	else if (PyTuple_Check(value)) {
		Tcl_Obj **argv = (Tcl_Obj**)
			ckalloc(PyTuple_Size(value)*sizeof(Tcl_Obj*));
		int i;
		if(!argv)
		  return 0;
		for(i=0;i<PyTuple_Size(value);i++)
		  argv[i] = AsObj(PyTuple_GetItem(value,i));
		result = Tcl_NewListObj(PyTuple_Size(value), argv);
		ckfree(FREECAST argv);
		return result;
	}
	else if (PyUnicode_Check(value)) {
#if TKMAJORMINOR <= 8001
		/* In Tcl 8.1 we must use UTF-8 */
		PyObject* utf8 = PyUnicode_AsUTF8String(value);
		if (!utf8)
			return 0;
		result = Tcl_NewStringObj(PyString_AS_STRING(utf8),
					  PyString_GET_SIZE(utf8));
		Py_DECREF(utf8);
		return result;
#else /* TKMAJORMINOR > 8001 */
		/* In Tcl 8.2 and later, use Tcl_NewUnicodeObj() */
		if (sizeof(Py_UNICODE) != sizeof(Tcl_UniChar)) {
			/* XXX Should really test this at compile time */
			PyErr_SetString(PyExc_SystemError,
				"Py_UNICODE and Tcl_UniChar differ in size");
			return 0;
		}
		return Tcl_NewUnicodeObj(PyUnicode_AS_UNICODE(value),
					 PyUnicode_GET_SIZE(value));
#endif /* TKMAJORMINOR > 8001 */
	}
	else {
		PyObject *v = PyObject_Str(value);
		if (!v)
			return 0;
		result = AsObj(v);
		Py_DECREF(v);
		return result;
	}
}
/* Ttk_NewTagSetObj --
 * 	Construct a fresh Tcl_Obj * from a tag set.
 */
Tcl_Obj *Ttk_NewTagSetObj(Ttk_TagSet tagset)
{
    Tcl_Obj *result = Tcl_NewListObj(0,0);
    int i;

    for (i = 0; i < tagset->nTags; ++i) {
	Tcl_ListObjAppendElement(
	    NULL, result, Tcl_NewStringObj(tagset->tags[i]->tagName, -1));
    }
    return result;
}
Example #28
0
/*
 *----------------------------------------------------------------------
 *
 * casstcl_logging_eventProc --
 *
 *    this routine is called by the Tcl event handler to process callbacks
 *    we have set up from logging callbacks we've gotten from Cassandra
 *    loop is
 *
 * Results:
 *    returns 1 to say we handled the event and the dispatcher can delete it
 *
 *----------------------------------------------------------------------
 */
int
casstcl_logging_eventProc (Tcl_Event *tevPtr, int flags) {

	// we got called with a Tcl_Event pointer but really it's a pointer to
	// our casstcl_loggingEvent structure that has the Tcl_Event plus a pointer
	// to casstcl_sessionClientData, which is our key to the kindgdom.
	// Go get that.

	casstcl_loggingEvent *evPtr = (casstcl_loggingEvent *)tevPtr;
	Tcl_Interp *interp = evPtr->interp;

#define CASSTCL_LOG_CALLBACK_LISTCOUNT 12

	Tcl_Obj *listObjv[CASSTCL_LOG_CALLBACK_LISTCOUNT];

	// probably won't happen but if we get a logging callback and have
	// no callback object, return 1 saying we handled it and let the
	// dispatcher delete the message NB this isn't exactly cool
	if (casstcl_loggingCallbackObj == NULL) {
		return 1;
	}

	// construct a list of key-value pairs representing the log message

	listObjv[0] = Tcl_NewStringObj ("clock", -1);
	listObjv[1] = Tcl_NewDoubleObj (evPtr->message.time_ms / 1000.0);

	listObjv[2] = Tcl_NewStringObj ("severity", -1);
	listObjv[3] = Tcl_NewStringObj (casstcl_cass_log_level_to_string (evPtr->message.severity), -1);

	listObjv[4] = Tcl_NewStringObj ("file", -1);
	listObjv[5] = Tcl_NewStringObj (evPtr->message.file, -1);

	listObjv[6] = Tcl_NewStringObj ("line", -1);
	listObjv[7] = Tcl_NewIntObj (evPtr->message.line);

	listObjv[8] = Tcl_NewStringObj ("function", -1);
	listObjv[9] = Tcl_NewStringObj (evPtr->message.function, -1);

	listObjv[10] = Tcl_NewStringObj ("message", -1);
	int messageLength = strnlen (evPtr->message.message, CASS_LOG_MAX_MESSAGE_SIZE);
	listObjv[11] = Tcl_NewStringObj (evPtr->message.message, messageLength);

	Tcl_Obj *listObj = Tcl_NewListObj (CASSTCL_LOG_CALLBACK_LISTCOUNT, listObjv);

	// even if this fails we still want the event taken off the queue
	// this function will do the background error thing if there is a tcl
	// error running the callback
	casstcl_invoke_callback_with_argument (interp, casstcl_loggingCallbackObj, listObj);

	// tell the dispatcher we handled it.  0 would mean we didn't deal with
	// it and don't want it removed from the queue
	return 1;
}
Example #29
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 #30
0
static int _get(ClientData clientData, Tcl_Interp *interp, int argc, Tcl_Obj* const *objv) {
  if (argc != 2)
    return fw_error_obj(interp, Tcl_ObjPrintf("usage: %s get", Tcl_GetString(objv[0])));
  _t *data = (_t *)clientData;
  Tcl_Obj *result[] = {
    Tcl_NewIntObj(jack_frame_time(data->fw.client)),
    Tcl_NewDoubleObj(data->sam.pll.freq.f),
    NULL
  };
  Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
  return TCL_OK;
}