Пример #1
0
int
Pg_conndefaults(ClientData cData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
{
	PQconninfoOption *options = PQconndefaults();
	PQconninfoOption *option;
	Tcl_DString result;
	char		ibuf[32];

	if (options)
	{
		Tcl_DStringInit(&result);

		for (option = options; option->keyword != NULL; option++)
		{
			char	   *val = option->val ? option->val : "";

			sprintf(ibuf, "%d", option->dispsize);
			Tcl_DStringStartSublist(&result);
			Tcl_DStringAppendElement(&result, option->keyword);
			Tcl_DStringAppendElement(&result, option->label);
			Tcl_DStringAppendElement(&result, option->dispchar);
			Tcl_DStringAppendElement(&result, ibuf);
			Tcl_DStringAppendElement(&result, val);
			Tcl_DStringEndSublist(&result);
		}
		Tcl_DStringResult(interp, &result);

		PQconninfoFree(options);
	}

	return TCL_OK;
}
Пример #2
0
void 
ParadynTkGUI::registerValidVisis (pdvector<VM_visiInfo> *via) {
  int i;
  int count;
  Tcl_DString namelist;
  Tcl_DString numlist;
  char num[8];

  count = via->size();  
  via->sort (compare_visi_names);
  Tcl_DStringInit(&namelist);
  Tcl_DStringInit(&numlist);
  
  for (i = 0; i < count; i++) {
    Tcl_DStringAppendElement(&namelist, (*via)[i].name.c_str());
    sprintf (num, "%d", ((*via)[i]).visiTypeId);
    Tcl_DStringAppendElement(&numlist, num);
  }
  Tcl_SetVar (interp, "vnames", Tcl_DStringValue(&namelist), 0);
  Tcl_SetVar (interp, "vnums", Tcl_DStringValue(&numlist), 0);
  Tcl_DStringFree (&namelist);
  Tcl_DStringFree (&numlist);
  sprintf (num, "%d", count);
  Tcl_SetVar (interp, "vcount", num, 0);
  delete via;
}
Пример #3
0
long int
rde_ot_intern2 (RDE_STATE p,
		const char* operator,
		Tcl_Obj* detail1,
		Tcl_Obj* detail2)
{
    long int id;
    Tcl_DString buf;

    TRACE (("rde_ot_intern2 (%p, '%s' %p = '%s', %p = '%s')", p, operator,
	    detail1, Tcl_GetString(detail1)
	    detail2, Tcl_GetString(detail2)));
    if (IsCached (p, detail1, &id)) {
	return id;
    }

    TRACE (("INTERNALIZE"));

    /* Create a list of operator + detail1 + detail2.
     * Using a DString.
     */

    Tcl_DStringInit (&buf);
    Tcl_DStringAppendElement (&buf, operator);
    Tcl_DStringAppendElement (&buf, Tcl_GetString (detail1));
    Tcl_DStringAppendElement (&buf, Tcl_GetString (detail2));

    id = Make (p, detail1, Tcl_DStringValue (&buf));

    Tcl_DStringFree (&buf);
    return id;
}
Пример #4
0
void
Tcl_GetMemoryInfo(
    Tcl_DString *dsPtr)
{
    Cache *cachePtr;
    char buf[200];
    unsigned int n;

    Tcl_MutexLock(listLockPtr);
    cachePtr = firstCachePtr;
    while (cachePtr != NULL) {
	Tcl_DStringStartSublist(dsPtr);
	if (cachePtr == sharedPtr) {
	    Tcl_DStringAppendElement(dsPtr, "shared");
	} else {
	    sprintf(buf, "thread%p", cachePtr->owner);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
	for (n = 0; n < NBUCKETS; ++n) {
	    sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld",
		    (unsigned long) bucketInfo[n].blockSize,
		    cachePtr->buckets[n].numFree,
		    cachePtr->buckets[n].numRemoves,
		    cachePtr->buckets[n].numInserts,
		    cachePtr->buckets[n].totalAssigned,
		    cachePtr->buckets[n].numLocks,
		    cachePtr->buckets[n].numWaits);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
	Tcl_DStringEndSublist(dsPtr);
	cachePtr = cachePtr->nextPtr;
    }
    Tcl_MutexUnlock(listLockPtr);
}
Пример #5
0
int NS(ProcCheck) (
  Tcl_Interp * interp,
  struct Tcl_Obj * cmdObj,
  char const * const wrongNrStr
)
{
  int ret,len;
  Tcl_DString cmd;
  if (!Tcl_GetCommandFromObj (interp, cmdObj)) {
    Tcl_WrongNumArgs (interp, 0, NULL, wrongNrStr);
    return TCL_ERROR;
  }
  Tcl_DStringInit(&cmd);
  Tcl_DStringAppendElement(&cmd,"info");
  Tcl_DStringAppendElement(&cmd,"args");
  Tcl_DStringAppendElement(&cmd,Tcl_GetString(cmdObj));
  ret = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd), TCL_EVAL_GLOBAL);
  Tcl_DStringFree(&cmd);
  TclErrorCheck(ret);
  TclErrorCheck(Tcl_ListObjLength(interp, Tcl_GetObjResult(interp), &len));
  if (len != 1) {
    Tcl_DString msg;
    Tcl_DStringInit(&msg);
    Tcl_DStringAppend(&msg,"wrong # args: ", -1);
    if (len > 1) Tcl_DStringAppend(&msg,"only ", -1);
    Tcl_DStringAppend(&msg,"one argument for procedure \"", -1);
    Tcl_DStringAppend(&msg,Tcl_GetString(cmdObj), -1);
    Tcl_DStringAppend(&msg,"\" is required", -1);
    Tcl_DStringResult(interp, &msg);
    Tcl_DStringFree(&msg);
    return TCL_ERROR;
  }
  return TCL_OK;
}
Пример #6
0
void
Ns_ThreadList(Tcl_DString *dsPtr, Ns_ThreadArgProc *proc)
{
    Thread *thrPtr;
    char buf[100];

    Ns_MutexLock(&threadlock);
    thrPtr = firstThreadPtr;
    while (thrPtr != NULL) {
	Tcl_DStringStartSublist(dsPtr);
	Tcl_DStringAppendElement(dsPtr, thrPtr->name);
	Tcl_DStringAppendElement(dsPtr, thrPtr->parent);
	sprintf(buf, " %d %d %ld", thrPtr->tid,
		(thrPtr->flags & FLAG_DETACHED) ? NS_THREAD_DETACHED : 0,
		thrPtr->ctime.sec);
	Tcl_DStringAppend(dsPtr, buf, -1);
	if (proc != NULL) {
	    (*proc)(dsPtr, (void *) thrPtr->proc, thrPtr->arg);
	} else {
	    sprintf(buf, " %p %p", thrPtr->proc, thrPtr->arg);
	    Tcl_DStringAppend(dsPtr, buf, -1);
	}
	Tcl_DStringEndSublist(dsPtr);
	thrPtr = thrPtr->nextPtr;
    }
    Ns_MutexUnlock(&threadlock);
}
Пример #7
0
/*
** Append all the arguments of the given markup to the given
** DString.
**
** Example:  If the markup is <IMG SRC=image.gif ALT="hello!">
** then the following text is appended to the DString:
**
**       "src image.gif alt hello!"
**
** Notice how all attribute names are converted to lower case.
** This conversion happens in the parser.
*/
void HtmlAppendArglist(Tcl_DString *str, HtmlElement *pElem){
  int i;
  for(i=0; i+1<pElem->base.count; i+=2){
    char *z = pElem->markup.argv[i+1];
    Tcl_DStringAppendElement(str, pElem->markup.argv[i]);
    Tcl_DStringAppendElement(str, z);
  }
}
Пример #8
0
int
TkpTestembedCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int all;
    Container *containerPtr;
    Tcl_DString dString;
    char buffer[50];
    ThreadSpecificData *tsdPtr =
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if ((argc > 1) && (strcmp(argv[1], "all") == 0)) {
	all = 1;
    } else {
	all = 0;
    }
    Tcl_DStringInit(&dString);
    for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	Tcl_DStringStartSublist(&dString);
	if (containerPtr->parent == None) {
	    Tcl_DStringAppendElement(&dString, "");
	} else if (all) {
	    sprintf(buffer, "0x%x", (int) containerPtr->parent);
	    Tcl_DStringAppendElement(&dString, buffer);
	} else {
	    Tcl_DStringAppendElement(&dString, "XXX");
	}
	if (containerPtr->parentPtr == NULL) {
	    Tcl_DStringAppendElement(&dString, "");
	} else {
	    Tcl_DStringAppendElement(&dString,
		    containerPtr->parentPtr->pathName);
	}
	if (containerPtr->wrapper == None) {
	    Tcl_DStringAppendElement(&dString, "");
	} else if (all) {
	    sprintf(buffer, "0x%x", (int) containerPtr->wrapper);
	    Tcl_DStringAppendElement(&dString, buffer);
	} else {
	    Tcl_DStringAppendElement(&dString, "XXX");
	}
	if (containerPtr->embeddedPtr == NULL) {
	    Tcl_DStringAppendElement(&dString, "");
	} else {
	    Tcl_DStringAppendElement(&dString,
		    containerPtr->embeddedPtr->pathName);
	}
	Tcl_DStringEndSublist(&dString);
    }
    Tcl_DStringResult(interp, &dString);
    return TCL_OK;
}
Пример #9
0
int AsnTypeDesc::TclGetDesc (Tcl_DString *desc) const
{
  Tcl_DStringStartSublist (desc);
  Tcl_DStringAppendElement (desc, getmodule() ? (char*) getmodule()->name : "");
  Tcl_DStringAppendElement (desc, getname() ? (char*) getname() : "");
  Tcl_DStringEndSublist (desc);
  Tcl_DStringAppendElement (desc, ispdu() ? "pdu" : "sub");
  Tcl_DStringAppendElement (desc, (char*) typenames[gettype()]);

  return TCL_OK;
}
Пример #10
0
int
TkpTestembedCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument strings. */
{
    int all;
    Container *containerPtr;
    Tcl_DString dString;
    char buffer[50];

    if ((objc > 1) && (strcmp(Tcl_GetString(objv[1]), "all") == 0)) {
	all = 1;
    } else {
	all = 0;
    }
    Tcl_DStringInit(&dString);
    for (containerPtr = firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	Tcl_DStringStartSublist(&dString);
	if (containerPtr->parent == None) {
	    Tcl_DStringAppendElement(&dString, "");
	} else if (all) {
	    sprintf(buffer, "0x%x", (int) containerPtr->parent);
	    Tcl_DStringAppendElement(&dString, buffer);
	} else {
	    Tcl_DStringAppendElement(&dString, "XXX");
	}
	if (containerPtr->parentPtr == NULL) {
	    Tcl_DStringAppendElement(&dString, "");
	} else {
	    Tcl_DStringAppendElement(&dString,
		    containerPtr->parentPtr->pathName);
	}
	if (containerPtr->embedded == None) {
	    Tcl_DStringAppendElement(&dString, "");
	} else if (all) {
	    sprintf(buffer, "0x%x", (int) containerPtr->embedded);
	    Tcl_DStringAppendElement(&dString, buffer);
	} else {
	    Tcl_DStringAppendElement(&dString, "XXX");
	}
	if (containerPtr->embeddedPtr == NULL) {
	    Tcl_DStringAppendElement(&dString, "");
	} else {
	    Tcl_DStringAppendElement(&dString,
		    containerPtr->embeddedPtr->pathName);
	}
	Tcl_DStringEndSublist(&dString);
    }
    Tcl_DStringResult(interp, &dString);
    return TCL_OK;
}
Пример #11
0
void
NsAppendRequest(Tcl_DString *dsPtr, Ns_Request *request)
{
    if (request == NULL) {
	Tcl_DStringAppend(dsPtr, " ? ?", -1);
    } else {
    	Ns_MutexLock(&reqlock);
	Tcl_DStringAppendElement(dsPtr, request->method);
	Tcl_DStringAppendElement(dsPtr, request->url);
    	Ns_MutexUnlock(&reqlock);
    }
}
Пример #12
0
/* Provide mechanism for simulator to report which instructions are in
   which stages */
void report_pc(unsigned fpc, unsigned char fpcv,
	       unsigned dpc, unsigned char dpcv,
	       unsigned epc, unsigned char epcv,
	       unsigned mpc, unsigned char mpcv,
	       unsigned wpc, unsigned char wpcv)
{
    int status;
    char addr[10];
    char code[12];
    Tcl_DString cmd;
    Tcl_DStringInit(&cmd);
    Tcl_DStringAppend(&cmd, "simLabel ", -1);
    Tcl_DStringStartSublist(&cmd);
    if (fpcv) {
	sprintf(addr, "%u", fpc);
	Tcl_DStringAppendElement(&cmd, addr);
    }
    if (dpcv) {
	sprintf(addr, "%u", dpc);
	Tcl_DStringAppendElement(&cmd, addr);
    }
    if (epcv) {
	sprintf(addr, "%u", epc);
	Tcl_DStringAppendElement(&cmd, addr);
    }
    if (mpcv) {
	sprintf(addr, "%u", mpc);
	Tcl_DStringAppendElement(&cmd, addr);
    }
    if (wpcv) {
	sprintf(addr, "%u", wpc);
	Tcl_DStringAppendElement(&cmd, addr);
    }
    Tcl_DStringEndSublist(&cmd);
    Tcl_DStringStartSublist(&cmd);
    sprintf(code, "%s %s %s %s %s",
	    fpcv ? "F" : "",
	    dpcv ? "D" : "",
	    epcv ? "E" : "",
	    mpcv ? "M" : "",
	    wpcv ? "W" : "");
    Tcl_DStringAppend(&cmd, code, -1);
    Tcl_DStringEndSublist(&cmd);
    /* Debug 
       fprintf(stderr, "Code '%s'\n", Tcl_DStringValue(&cmd));
    */
    status = Tcl_Eval(sim_interp, Tcl_DStringValue(&cmd));
    if (status != TCL_OK) {
	fprintf(stderr, "Failed to report pipe code '%s'\n", code);
	fprintf(stderr, "Error Message was '%s'\n", sim_interp->result);
    }
}
Пример #13
0
Файл: tlsIO.c Проект: fahkri/tls
/*
 *-------------------------------------------------------------------
 *
 * TlsGetOptionProc --
 *
 *	Computes an option value for a SSL socket based channel, or a
 *	list of all options and their values.
 *
 * Results:
 *	A standard Tcl result. The value of the specified option or a
 *	list of all options and	their values is returned in the
 *	supplied DString.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------
 */
static int
TlsGetOptionProc(ClientData instanceData,	/* Socket state. */
	Tcl_Interp *interp,		/* For errors - can be NULL. */
	CONST84 char *optionName,	/* Name of the option to
					 * retrieve the value for, or
					 * NULL to get all options and
					 * their values. */
	Tcl_DString *dsPtr)		/* Where to store the computed value
					 * initialized by caller. */
{
    State *statePtr = (State *) instanceData;

    if (channelTypeVersion == TLS_CHANNEL_VERSION_2) {
	Tcl_Channel downChan = Tls_GetParent(statePtr);
	Tcl_DriverGetOptionProc *getOptionProc;

	getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
	if (getOptionProc != NULL) {
	    return (*getOptionProc)(Tcl_GetChannelInstanceData(downChan),
		    interp, optionName, dsPtr);
	} else if (optionName == (char*) NULL) {
	    /*
	     * Request is query for all options, this is ok.
	     */
	    return TCL_OK;
	}
	/*
	 * Request for a specific option has to fail, we don't have any.
	 */
	return TCL_ERROR;
    } else {
	size_t len = 0;

	if (optionName != (char *) NULL) {
	    len = strlen(optionName);
	}
#if 0
	if ((len == 0) || ((len > 1) && (optionName[1] == 'c') &&
		(strncmp(optionName, "-cipher", len) == 0))) {
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-cipher");
	    }
	    Tcl_DStringAppendElement(dsPtr, SSL_get_cipher(statePtr->ssl));
	    if (len) {
		return TCL_OK;
	    }
	}
#endif
	return TCL_OK;
    }
}
Пример #14
0
/*
** The callback routine for sqlite_exec_printf().
*/
static int exec_printf_cb(void *pArg, int argc, char **argv, char **name){
  Tcl_DString *str = (Tcl_DString*)pArg;
  int i;

  if( Tcl_DStringLength(str)==0 ){
    for(i=0; i<argc; i++){
      Tcl_DStringAppendElement(str, name[i] ? name[i] : "NULL");
    }
  }
  for(i=0; i<argc; i++){
    Tcl_DStringAppendElement(str, argv[i] ? argv[i] : "NULL");
  }
  return 0;
}
Пример #15
0
/*
 *----------------------------------------------------------------------
 *
 * TcpHostPortList --
 *
 *	This function is called by the -gethostname and -getpeername
 *	switches of TcpGetOptionProc() to add three list elements
 *	with the textual representation of the given address to the
 *	given DString.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds three elements do dsPtr
 *
 *----------------------------------------------------------------------
 */
static void
TcpHostPortList(
    Tcl_Interp *interp,
    Tcl_DString *dsPtr,
    address addr,
    socklen_t salen)
{
#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
    char host[NI_MAXHOST], nhost[NI_MAXHOST], nport[NI_MAXSERV];
    int flags = 0;

    getnameinfo(&addr.sa, salen,
                nhost, sizeof(nhost), nport, sizeof(nport),
                NI_NUMERICHOST | NI_NUMERICSERV);
    Tcl_DStringAppendElement(dsPtr, nhost);
    /*
     * We don't want to resolve INADDR_ANY and sin6addr_any; they
     * can sometimes cause problems (and never have a name).
     */
    if (addr.sa.sa_family == AF_INET) {
        if (addr.sa4.sin_addr.s_addr == INADDR_ANY) {
            flags |= NI_NUMERICHOST;
        }
#ifndef NEED_FAKE_RFC2553
    } else if (addr.sa.sa_family == AF_INET6) {
        if ((IN6_ARE_ADDR_EQUAL(&addr.sa6.sin6_addr,
                                &in6addr_any))
            || (IN6_IS_ADDR_V4MAPPED(&addr.sa6.sin6_addr) &&
                addr.sa6.sin6_addr.s6_addr[12] == 0 &&
                addr.sa6.sin6_addr.s6_addr[13] == 0 &&
                addr.sa6.sin6_addr.s6_addr[14] == 0 &&
                addr.sa6.sin6_addr.s6_addr[15] == 0)) {
            flags |= NI_NUMERICHOST;
        }
#endif /* NEED_FAKE_RFC2553 */
    }
    /* Check if reverse DNS has been switched off globally */
    if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
        flags |= NI_NUMERICHOST;
    }
    if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0, flags) == 0) {
        /* Reverse mapping worked */
        Tcl_DStringAppendElement(dsPtr, host);
    } else {
        /* Reverse mappong failed - use the numeric rep once more */
        Tcl_DStringAppendElement(dsPtr, nhost);
    }
    Tcl_DStringAppendElement(dsPtr, nport);
}
Пример #16
0
void
NsAppendConn(Tcl_DString *dsPtr, Conn *connPtr, char *state)
{
    Ns_Time now, diff;

    Ns_GetTime(&now);
    Ns_DiffTime(&now, &connPtr->times.queue, &diff);
    Tcl_DStringStartSublist(dsPtr);
    Ns_DStringPrintf(dsPtr, "%d", connPtr->id);
    Tcl_DStringAppendElement(dsPtr, Ns_ConnPeer((Ns_Conn *) connPtr));
    Tcl_DStringAppendElement(dsPtr, state);
    NsAppendRequest(dsPtr, connPtr->request);
    Ns_DStringPrintf(dsPtr, " %ld.%ld %d",
		     diff.sec, diff.usec, connPtr->nContentSent);
    Tcl_DStringEndSublist(dsPtr);
}
Пример #17
0
static void dgsprintxy(Tcl_DString * result, int npts, point p[])
{
    int i;
    char buf[20];

    if (npts != 1)
	Tcl_DStringStartSublist(result);
    for (i = 0; i < npts; i++) {
	sprintf(buf, "%g", p[i].x);
	Tcl_DStringAppendElement(result, buf);
	sprintf(buf, "%g", p[i].y);
	Tcl_DStringAppendElement(result, buf);
    }
    if (npts != 1)
	Tcl_DStringEndSublist(result);
}
Пример #18
0
void
NsTclArgProc(Tcl_DString *dsPtr, void *arg)
{
     TclCallback *cbPtr = arg;

     Tcl_DStringAppendElement(dsPtr, cbPtr->script);
}
Пример #19
0
static void
DumpPercents(
    QE_ExpandArgs *args,	/* %-substitution args. */
    QE_ExpandProc proc,		/* Function to return value for a given
				 * %-char. */
    CONST char *chars		/* NULL-terminated list of %-chars. */
    )
{
    char which = args->which;
    char buf[2];
    int i;

    buf[1] = '\0';

    Tcl_DStringStartSublist(args->result);
    for (i = 0; chars[i]; i++) {
	args->which = chars[i];
	buf[0] = chars[i];
	Tcl_DStringAppendElement(args->result, buf);
	Tcl_DStringAppend(args->result, " ", 1);
	(*proc)(args);
    }
    Tcl_DStringEndSublist(args->result);
    args->which = which;
}
Пример #20
0
/*
** The "p" argument points to a <select>.  This routine scans all
** subsequent elements (up to the next </select>) looking for
** <option> tags.  For each option tag, it appends three elements
** to the "str" DString:
**
**     *        1 or 0 to indicated whether or not the element is
**              selected.
**
**     *        The value returned if this element is selected.
**
**     *        The text displayed for this element.
*/
static void AddSelectOptions(
  Tcl_DString *str,      /* Add text here */
  HtmlElement *p,        /* The <SELECT> markup */
  HtmlElement *pEnd      /* The </SELECT> markup */
){
  while( p && p!=pEnd && p->base.type!=Html_EndSELECT ){
    if( p->base.type==Html_OPTION ){
      char *zValue;
      Tcl_DStringStartSublist(str);
      if( HtmlMarkupArg(p, "selected", 0)==0 ){
        Tcl_DStringAppend(str, "0 ", 2);
      }else{
        Tcl_DStringAppend(str, "1 ", 2);
      }
      zValue = HtmlMarkupArg(p, "value", "");
      Tcl_DStringAppendElement(str, zValue);
      Tcl_DStringStartSublist(str);
      p = p->pNext;
      while( p && p!=pEnd && p->base.type!=Html_EndOPTION 
        && p->base.type!=Html_OPTION && p->base.type!=Html_EndSELECT ){
        if( p->base.type==Html_Text ){
          Tcl_DStringAppend(str, p->text.zText, -1);
        }else if( p->base.type==Html_Space ){
          Tcl_DStringAppend(str, " ", 1);
        }
        p = p->pNext;
      }
      Tcl_DStringEndSublist(str);
      Tcl_DStringEndSublist(str);
    }else{
      p = p->pNext;
    }
  }
}
Пример #21
0
// for BIT STRING and INTEGER:
int AsnNamesTypeDesc::TclGetDesc2 (Tcl_DString *desc) const
{
  Tcl_DStringStartSublist (desc);
  const AsnNameDesc *n;
  if (n = names)
    for (; n->name; n++)
    {
      Tcl_DStringStartSublist (desc);
      Tcl_DStringAppendElement (desc, (char*) n->name);
      char buf[32];
      sprintf (buf, "%d", n->value);
      Tcl_DStringAppendElement (desc, buf);
      Tcl_DStringEndSublist (desc);
    }
  Tcl_DStringEndSublist (desc);

  return TCL_OK;
}
Пример #22
0
void
Ns_MutexList(Tcl_DString *dsPtr)
{
    Mutex *mutexPtr;
    char buf[100];

    Ns_MasterLock();
    mutexPtr = firstMutexPtr;
    while (mutexPtr != NULL) {
	Tcl_DStringStartSublist(dsPtr);
	Tcl_DStringAppendElement(dsPtr, mutexPtr->name);
	Tcl_DStringAppendElement(dsPtr, "");
	sprintf(buf, " %d %lu %lu", mutexPtr->id, mutexPtr->nlock, mutexPtr->nbusy);
	Tcl_DStringAppend(dsPtr, buf, -1);
	Tcl_DStringEndSublist(dsPtr);
	mutexPtr = mutexPtr->nextPtr;
    }
    Ns_MasterUnlock();
}
Пример #23
0
int AsnEnumTypeDesc::TclGetDesc2 (Tcl_DString *desc) const
{
  Tcl_DStringStartSublist (desc);
  const AsnNameDesc *n;
  if (n = names)
    for (; n->name; n++)
      Tcl_DStringAppendElement (desc, (char*) n->name);
  Tcl_DStringEndSublist (desc);

  return TCL_OK;
}
Пример #24
0
/*
** This routine is called by the SQLite trace handler whenever a new
** block of SQL is executed.  The TCL script in pDb->zTrace is executed.
*/
static void DbTraceHandler(void *cd, const char *zSql){
  SqliteDb *pDb = (SqliteDb*)cd;
  Tcl_DString str;

  Tcl_DStringInit(&str);
  Tcl_DStringAppend(&str, pDb->zTrace, -1);
  Tcl_DStringAppendElement(&str, zSql);
  Tcl_Eval(pDb->interp, Tcl_DStringValue(&str));
  Tcl_DStringFree(&str);
  Tcl_ResetResult(pDb->interp);
}
Пример #25
0
void
TnmAttrDump(Tcl_HashTable *tablePtr, char *name, Tcl_DString *dsPtr)
{
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    char *key, *value;
    
    entryPtr = Tcl_FirstHashEntry(tablePtr, &search);
    while (entryPtr != NULL) {
	key = Tcl_GetHashKey(tablePtr, entryPtr);
	value = (char *) Tcl_GetHashValue(entryPtr);
	if (isupper(*key) || *key == ':') {
	    Tcl_DStringAppend(dsPtr, name, -1);
	    Tcl_DStringAppend(dsPtr, " attribute ", -1);
	    Tcl_DStringAppendElement(dsPtr, key);
	    Tcl_DStringAppendElement(dsPtr, value);
	    Tcl_DStringAppend(dsPtr, "\n", 1);
	}
	entryPtr = Tcl_NextHashEntry(&search);
    }
}
Пример #26
0
char*
Tnm_SnmpMergeVBList(int varBindSize, SNMP_VarBind *varBindPtr)
{
    static Tcl_DString list;
    int i;

    Tcl_DStringInit(&list);

    for (i = 0; i < varBindSize; i++) {
        Tcl_DStringStartSublist(&list);
	Tcl_DStringAppendElement(&list, 
			     varBindPtr[i].soid ? varBindPtr[i].soid : "");
	Tcl_DStringAppendElement(&list, 
			     varBindPtr[i].syntax ? varBindPtr[i].syntax : "");
	Tcl_DStringAppendElement(&list, 
			     varBindPtr[i].value ? varBindPtr[i].value : "");
	Tcl_DStringEndSublist(&list);
    }

    return ckstrdup(Tcl_DStringValue(&list));
}
Пример #27
0
static void
Scalarize(pTHX_ SV *sv, AV *av)
{
 int n    = av_len(av)+1;
 if (n == 0)
  sv_setpvn(sv,"",0);
 else
  {
   SV **svp;
   if (n == 1 && (svp = av_fetch(av, 0, 0)))
    {
     STRLEN len = 0;
     char *s  = SvPV(*svp,len);
#ifdef SvUTF8
     int utf8 = SvUTF8(*svp);
     sv_setpvn(sv,s,len);
     if (utf8)
      SvUTF8_on(sv);
#else
     sv_setpvn(sv,s,len);
#endif
    }
   else
    {
     Tcl_DString ds;
     int i;
     Tcl_DStringInit(&ds);
     for (i=0; i < n; i++)
      {
       if ((svp = av_fetch(av, i, 0)))
        {
         SV *el = *svp;
         int temp = 0;
         if (SvROK(el) && !SvOBJECT(SvRV(el)) && SvTYPE(SvRV(el)) == SVt_PVAV)
          {
           el = newSVpv("",0);
           temp = 1;
           if ((AV *) SvRV(*svp) == av)
            abort();
           Scalarize(aTHX_ el,(AV *) SvRV(*svp));
          }
         Tcl_DStringAppendElement(&ds,Tcl_GetString(el));
         if (temp)
          SvREFCNT_dec(el);
        }
      }
     sv_setpvn(sv,Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
     sv_maybe_utf8(sv);
     Tcl_DStringFree(&ds);
    }
  }
}
Пример #28
0
void
NsConnArgProc(Tcl_DString *dsPtr, void *arg)
{
    ConnData *dataPtr = arg;
    
    Ns_MutexLock(&connlock);
    if (dataPtr->connPtr != NULL) {
        NsAppendConn(dsPtr, dataPtr->connPtr, "running");
    } else {
    	Tcl_DStringAppendElement(dsPtr, "");
    }
    Ns_MutexUnlock(&connlock);
}
Пример #29
0
int AsnMemberDesc::TclGetDesc (Tcl_DString *desc) const
{
  if (name)
  {
    Tcl_DStringStartSublist (desc);
    Tcl_DStringAppendElement (desc, (char*)name);
    this->desc->AsnTypeDesc::TclGetDesc (desc);
    TclGetDesc2 (desc);
    Tcl_DStringEndSublist (desc);
    return TCL_OK;
  }
  else
    return TCL_BREAK;
}
Пример #30
0
/* Old string based version. This also doesn't take a list as the input */
int tcl_dir_or_file(ClientData clientData, Tcl_Interp *interp,
		    int argc,  char **argv) {
    Tcl_DString files;
    Tcl_DString dirs;
    Tcl_DString result;
    int i;
    struct stat st;

    if (argc < 2) {
	Tcl_SetResult(interp,
		      "wrong # args: should be \"dir_or_file "
		      "filename ...\"\n", TCL_STATIC);
	return TCL_ERROR;
    }
    Tcl_DStringInit(&files);
    Tcl_DStringInit(&dirs);
    Tcl_DStringInit(&result);

    for (i=1; i<argc; i++) {
	if (stat(argv[i], &st) != -1) {
	    if (S_ISDIR(st.st_mode))
		Tcl_DStringAppendElement(&dirs, argv[i]);
	    else
		Tcl_DStringAppendElement(&files, argv[i]);
	}
    }

    Tcl_DStringAppendElement(&result, Tcl_DStringValue(&dirs));
    Tcl_DStringAppendElement(&result, Tcl_DStringValue(&files));

    Tcl_DStringFree(&dirs);
    Tcl_DStringFree(&files);

    Tcl_DStringResult(interp, &result);

    return TCL_OK;
}