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;
}
void
TnmSnmpDumpPDU(Tcl_Interp *interp, TnmSnmpPdu *pdu)
{
if (hexdump) {
int i, code, argc;
const char **argv;
char *name, *status;
char buffer[80];
Tcl_DString dst;
Tcl_Channel channel;
Tcl_DStringInit(&dst);
name = TnmGetTableValue(tnmSnmpPDUTable, (unsigned) pdu->type);
if (name == NULL) {
name = "(unknown PDU type)";
}
status = TnmGetTableValue(tnmSnmpErrorTable, (unsigned) pdu->errorStatus);
if (status == NULL) {
status = "(unknown error code)";
}
if (pdu->type == ASN1_SNMP_GETBULK) {
sprintf(buffer, "%s %d non-repeaters %d max-repetitions %d\n",
name, pdu->requestId,
pdu->errorStatus, pdu->errorIndex);
} else if (pdu->type == ASN1_SNMP_TRAP1) {
sprintf(buffer, "%s\n", name);
} else if (pdu->errorStatus == TNM_SNMP_NOERROR) {
sprintf(buffer, "%s %d %s\n", name, pdu->requestId, status);
} else {
sprintf(buffer, "%s %d %s at %d\n",
name, pdu->requestId, status, pdu->errorIndex);
}
Tcl_DStringAppend(&dst, buffer, -1);
code = Tcl_SplitList(interp, Tcl_DStringValue(&pdu->varbind),
&argc, &argv);
if (code == TCL_OK) {
for (i = 0; i < argc; i++) {
sprintf(buffer, "%4d.\t", i+1);
Tcl_DStringAppend(&dst, buffer, -1);
Tcl_DStringAppend(&dst, argv[i], -1);
Tcl_DStringAppend(&dst, "\n", -1);
}
ckfree((char *) argv);
}
Tcl_ResetResult(interp);
channel = Tcl_GetStdChannel(TCL_STDOUT);
if (channel) {
Tcl_Write(channel,
Tcl_DStringValue(&dst), Tcl_DStringLength(&dst));
}
Tcl_DStringFree(&dst);
}
}
static int
DoCopyFile(
Tcl_DString *srcPtr, /* Pathname of file to be copied (native). */
Tcl_DString *dstPtr) /* Pathname of file to copy to (native). */
{
CONST TCHAR *nativeSrc, *nativeDst;
nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
/*
* Would throw an exception under NT if one of the arguments is a char
* block device.
*/
__try {
if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
return TCL_OK;
}
} __except (-1) {}
TclWinConvertError(GetLastError());
if (Tcl_GetErrno() == EBADF) {
Tcl_SetErrno(EACCES);
return TCL_ERROR;
}
if (Tcl_GetErrno() == EACCES) {
DWORD srcAttr, dstAttr;
srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
if (srcAttr != 0xffffffff) {
if (dstAttr == 0xffffffff) {
dstAttr = 0;
}
if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
(dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
Tcl_SetErrno(EISDIR);
}
if (dstAttr & FILE_ATTRIBUTE_READONLY) {
(*tclWinProcs->setFileAttributesProc)(nativeDst,
dstAttr & ~FILE_ATTRIBUTE_READONLY);
if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
return TCL_OK;
}
/*
* Still can't copy onto dst. Return that error, and
* restore attributes of dst.
*/
TclWinConvertError(GetLastError());
(*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
}
}
}
return TCL_ERROR;
}
static HRESULT
RegisterInterp(
const char *name,
RegisteredInterp *riPtr)
{
HRESULT hr = S_OK;
LPRUNNINGOBJECTTABLE pROT = NULL;
LPMONIKER pmk = NULL;
int i, offset;
const char *actualName = name;
Tcl_DString dString;
Tcl_DStringInit(&dString);
hr = GetRunningObjectTable(0, &pROT);
if (SUCCEEDED(hr)) {
offset = 0;
for (i = 1; SUCCEEDED(hr); i++) {
if (i > 1) {
if (i == 2) {
Tcl_DStringInit(&dString);
Tcl_DStringAppend(&dString, name, -1);
Tcl_DStringAppend(&dString, " #", 2);
offset = Tcl_DStringLength(&dString);
Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE);
actualName = Tcl_DStringValue(&dString);
}
sprintf(Tcl_DStringValue(&dString) + offset, "%d", i);
}
hr = BuildMoniker(actualName, &pmk);
if (SUCCEEDED(hr)) {
hr = pROT->lpVtbl->Register(pROT,
ROTFLAGS_REGISTRATIONKEEPSALIVE,
riPtr->obj, pmk, &riPtr->cookie);
pmk->lpVtbl->Release(pmk);
}
if (hr == MK_S_MONIKERALREADYREGISTERED) {
pROT->lpVtbl->Revoke(pROT, riPtr->cookie);
} else if (hr == S_OK) {
break;
}
}
pROT->lpVtbl->Release(pROT);
}
if (SUCCEEDED(hr)) {
riPtr->name = strdup(actualName);
}
Tcl_DStringFree(&dString);
return hr;
}
const char *
Tcl_GetEncodingNameFromEnvironment(
Tcl_DString *bufPtr)
{
Tcl_DStringInit(bufPtr);
Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
return Tcl_DStringValue(bufPtr);
}
int lexinput_tktext(char *buf, int max_size, int buf_size, void *index1, void *index2)
{
int length, nbytes;
Tcl_DString internal, temp;
static int first = 1;
static Tcl_DString external;
static Tcl_Encoding encoding;
if(first) {
/* The lexers require ASCII encoding. */
encoding = Tcl_GetEncoding(NULL, "ascii");
if(encoding == NULL) {
/* No ASCII encoding available. */
return 0;
}
Tcl_DStringInit(&external);
first = 0;
}
Tcl_DStringInit(&internal);
if(Tcl_DStringLength(&external) == 0) {
/* Translate the text to `external'. */
if(tk_text_buffer(&internal, buf_size, index1, index2) > 0) {
Tcl_UtfToExternalDString(encoding, Tcl_DStringValue(&internal), Tcl_DStringLength(&internal), &external);
} else {
return 0;
}
}
/* Fill up the user-provided buffer as much as possible. */
length = Tcl_DStringLength(&external);
nbytes = (length > max_size) ? max_size : length;
memcpy(buf, Tcl_DStringValue(&external), nbytes);
/* I wish DStrings had a copy constructor. In fact, sometimes I wish
Tcl was written in C++. */
if(length > nbytes) {
Tcl_DStringInit(&temp);
Tcl_DStringAppend(&temp, Tcl_DStringValue(&external) + nbytes, length - nbytes);
Tcl_DStringFree(&external);
Tcl_DStringInit(&external);
Tcl_DStringAppend(&external, Tcl_DStringValue(&temp), Tcl_DStringLength(&temp));
Tcl_DStringFree(&temp);
} else {
Tcl_DStringFree(&external);
Tcl_DStringInit(&external);
}
/* Clean up. */
Tcl_DStringFree(&internal);
return nbytes;
}
int init_emboss_graph_create(Tcl_Interp *interp,
int seq_id,
int start,
int end,
char *filename,
Tcl_Obj **graph_obj,
int *id)
{
int seq_num, seq_len;
in_emboss *input;
Tcl_DString input_params;
text_emboss *text_data;
e_graph *data = NULL;
seq_num = GetSeqNum(seq_id);
seq_len = GetSeqLength(seq_num);
/* if the end has not been defined, set it to be the sequence length */
if (end == -1) {
end = seq_len;
}
seq_len = end - start + 1;
if (NULL == (input = (in_emboss *)xmalloc (sizeof(in_emboss))))
return -1;
read_emboss_data_file(filename, &data, graph_obj, &text_data);
if (!data) {
verror(ERR_FATAL,"emboss", "error in reading results\n");
return -1;
}
/* create inputs parameters */
Tcl_DStringInit(&input_params);
vTcl_DStringAppend(&input_params, "sequence %s: from %d to %d\n",
GetSeqName(seq_num), start, end);
vfuncparams("%s", Tcl_DStringValue(&input_params));
input->params = strdup(Tcl_DStringValue(&input_params));
Tcl_DStringFree(&input_params);
if (-1 == (*id = store_emboss_graph(seq_num, start, end, data, input,
text_data, graph_obj))) {
verror(ERR_FATAL,"emboss", "error in saving results\n");
return -1;
}
xfree(data);
return 0;
}
ClientData
TclNativeCreateNativeRep(
Tcl_Obj *pathPtr)
{
char *nativePathPtr;
const char *str;
Tcl_DString ds;
Tcl_Obj *validPathPtr;
size_t len;
if (TclFSCwdIsNative()) {
/*
* The cwd is native, which means we can use the translated path
* without worrying about normalization (this will also usually be
* shorter so the utf-to-external conversion will be somewhat faster).
*/
validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
if (validPathPtr == NULL) {
return NULL;
}
} else {
/*
* Make sure the normalized path is set.
*/
validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (validPathPtr == NULL) {
return NULL;
}
Tcl_IncrRefCount(validPathPtr);
}
str = TclGetString(validPathPtr);
len = validPathPtr->length;
Tcl_UtfToExternalDString(NULL, str, len, &ds);
len = Tcl_DStringLength(&ds) + sizeof(char);
if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
/* See bug [3118489]: NUL in filenames */
Tcl_DecrRefCount(validPathPtr);
Tcl_DStringFree(&ds);
return NULL;
}
Tcl_DecrRefCount(validPathPtr);
nativePathPtr = ckalloc(len);
memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
Tcl_DStringFree(&ds);
return nativePathPtr;
}
static void expandPercentsEval(Tcl_Interp * interp, /* interpreter context */
register char *before, /* Command with percent expressions */
char *r, /* vgpaneHandle string to substitute for "%r" */
int npts, /* number of coordinates */
point * ppos /* Cordinates to substitute for %t */
)
{
register char *string;
Tcl_DString scripts;
Tcl_DStringInit(&scripts);
while (1) {
/*
* Find everything up to the next % character and append it to the
* result string.
*/
for (string = before; (*string != 0) && (*string != '%'); string++) {
/* Empty loop body. */
}
if (string != before) {
Tcl_DStringAppend(&scripts, before, string - before);
before = string;
}
if (*before == 0) {
break;
}
/*
* There's a percent sequence here. Process it.
*/
switch (before[1]) {
case 'r':
Tcl_DStringAppend(&scripts, r, strlen(r)); /* vgcanvasHandle */
break;
case 't':
dgsprintxy(&scripts, npts, ppos);
break;
default:
Tcl_DStringAppend(&scripts, before + 1, 1);
break;
}
before += 2;
}
if (Tcl_GlobalEval(interp, Tcl_DStringValue(&scripts)) != TCL_OK)
fprintf(stderr, "%s while in binding: %s\n\n",
Tcl_GetStringResult(interp), Tcl_DStringValue(&scripts));
Tcl_DStringFree(&scripts);
}
int ScriptTcl::Tcl_replicaSendrecv(ClientData, Tcl_Interp *interp, int argc, char **argv) {
if ( argc < 3 || argc > 4 ) {
Tcl_SetResult(interp,"args: data dest ?source?",TCL_VOLATILE);
return TCL_ERROR;
}
Tcl_DString recvstr;
Tcl_DStringInit(&recvstr);
int sendcount = strlen(argv[1]);
int recvcount = 0;
int dest = atoi(argv[2]);
int source = -1;
if ( argc > 3 ) source = atoi(argv[3]);
#if CMK_HAS_PARTITION
if (dest == CmiMyPartition()) {
Tcl_DStringSetLength(&recvstr,sendcount);
memcpy(Tcl_DStringValue(&recvstr),argv[1],sendcount);
} else {
DataMessage *recvMsg = NULL;
replica_sendRecv(argv[1], sendcount, dest, CkMyPe(), &recvMsg, source, CkMyPe());
CmiAssert(recvMsg != NULL);
Tcl_DStringAppend(&recvstr, recvMsg->data, recvMsg->size);
CmiFree(recvMsg);
}
#endif
Tcl_DStringResult(interp, &recvstr);
Tcl_DStringFree(&recvstr);
return TCL_OK;
}
/* compare two Tcl_DStrings */
int
TSP_Util_string_compare(Tcl_DString* s1, Tcl_DString* s2) {
char* string2;
int length2;
return TSP_Util_string_compare_const(s1, Tcl_DStringValue(s2), Tcl_DStringLength(s2));
}
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;
}
/*
*----------------------------------------------------------------------
*
* Nsf_PointerAdd --
*
* Add an entry to our locally maintained hash table and set its
* value to the provided valuePtr. The keys are generated based on
* the passed type and the counter obtained from the type
* registration.
*
* Results:
* Tcl result code
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Nsf_PointerAdd(Tcl_Interp *interp, char *buffer, size_t size, const char *typeName, void *valuePtr) {
int *counterPtr;
nonnull_assert(interp != NULL);
nonnull_assert(buffer != NULL);
nonnull_assert(typeName != NULL);
nonnull_assert(valuePtr != NULL);
counterPtr = Nsf_PointerTypeLookup(typeName);
if (counterPtr != NULL) {
Tcl_DString ds, *dsPtr = &ds;
Tcl_HashEntry *hPtr;
int isNew;
Tcl_DStringInit(dsPtr);
Tcl_DStringAppend(dsPtr, typeName, -1);
Tcl_DStringAppend(dsPtr, ":%d", 3);
NsfMutexLock(&pointerMutex);
snprintf(buffer, size, Tcl_DStringValue(dsPtr), (*counterPtr)++);
hPtr = Tcl_CreateHashEntry(pointerHashTablePtr, buffer, &isNew);
NsfMutexUnlock(&pointerMutex);
Tcl_SetHashValue(hPtr, valuePtr);
/*fprintf(stderr, "Nsf_PointerAdd key '%s' prefix '%s' => %p value %p\n", buffer, typeName, hPtr, valuePtr);*/
Tcl_DStringFree(dsPtr);
} else {
return NsfPrintError(interp, "no type converter for %s registered", typeName);
}
return TCL_OK;
}
/*
** Usage: sqlite_exec_printf DB FORMAT STRING
**
** Invoke the sqlite_exec_printf() interface using the open database
** DB. The SQL is the string FORMAT. The format string should contain
** one %s or %q. STRING is the value inserted into %s or %q.
*/
static int test_exec_printf(
void *NotUsed,
Tcl_Interp *interp, /* The TCL interpreter that invoked this command */
int argc, /* Number of arguments */
char **argv /* Text of each argument */
){
sqlite *db;
Tcl_DString str;
int rc;
char *zErr = 0;
char zBuf[30];
if( argc!=4 ){
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" DB FORMAT STRING", 0);
return TCL_ERROR;
}
if( getDbPointer(interp, argv[1], &db) ) return TCL_ERROR;
Tcl_DStringInit(&str);
rc = sqlite_exec_printf(db, argv[2], exec_printf_cb, &str, &zErr, argv[3]);
sprintf(zBuf, "%d", rc);
Tcl_AppendElement(interp, zBuf);
Tcl_AppendElement(interp, rc==SQLITE_OK ? Tcl_DStringValue(&str) : zErr);
Tcl_DStringFree(&str);
if( zErr ) free(zErr);
return TCL_OK;
}
Tcl_PackageInitProc *
TclpFindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
CONST char *symbol)
{
Tcl_DString newName;
Tcl_PackageInitProc *proc = NULL;
shl_t handle = (shl_t)loadHandle;
/*
* Some versions of the HP system software still use "_" at the beginning
* of exported symbols while others don't; try both forms of each name.
*/
if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE,
(void *) &proc) != 0) {
Tcl_DStringInit(&newName);
Tcl_DStringAppend(&newName, "_", 1);
Tcl_DStringAppend(&newName, symbol, -1);
if (shl_findsym(&handle, Tcl_DStringValue(&newName),
(short) TYPE_PROCEDURE, (void *) &proc) != 0) {
proc = NULL;
}
Tcl_DStringFree(&newName);
}
return proc;
}
static int
TraversalDelete(
Tcl_DString *srcPtr, /* Source pathname to delete. */
Tcl_DString *dstPtr, /* Not used. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
{
TCHAR *nativeSrc;
switch (type) {
case DOTREE_F: {
if (DoDeleteFile(srcPtr) == TCL_OK) {
return TCL_OK;
}
break;
}
case DOTREE_PRED: {
return TCL_OK;
}
case DOTREE_POSTD: {
if (DoRemoveDirectory(srcPtr, 0, NULL) == TCL_OK) {
return TCL_OK;
}
break;
}
}
if (errorPtr != NULL) {
nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
}
return TCL_ERROR;
}
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;
}
char *
TclpReadlink(
const char *path, /* Path of file to readlink (UTF-8). */
Tcl_DString *linkPtr) /* Uninitialized or free DString filled with
* contents of link (UTF-8). */
{
#ifndef DJGPP
char link[MAXPATHLEN];
int length;
const char *native;
Tcl_DString ds;
native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
length = readlink(native, link, sizeof(link)); /* INTL: Native. */
Tcl_DStringFree(&ds);
if (length < 0) {
return NULL;
}
Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
return Tcl_DStringValue(linkPtr);
#else
return NULL;
#endif /* !DJGPP */
}
void
XOTclProfileFillTable(Tcl_HashTable* table, Tcl_DString* key,
double totalMicroSec) {
Tcl_HashEntry* hPtr;
char* keyStr = Tcl_DStringValue(key);
long int* value;
hPtr = Tcl_FindHashEntry(table, keyStr);
if (!hPtr) {
int nw;
hPtr = Tcl_CreateHashEntry(table, keyStr, &nw);
if (!nw)
return;
value = (long int*) ckalloc (sizeof(long int));
*value = 0;
Tcl_SetHashValue(hPtr, (ClientData) value);
} else
value = (long int*) Tcl_GetHashValue (hPtr);
*value += totalMicroSec;
/* {
long int* d = (long int*) Tcl_GetHashValue (hPtr);
fprintf(stderr, "Entered %s ... %ld\n", Tcl_GetHashKey(table, hPtr), *d);
}*/
}
const char *
TclGetEnv(
const char *name, /* Name of environment variable to find
* (UTF-8). */
Tcl_DString *valuePtr) /* Uninitialized or free DString in which the
* value of the environment variable is
* stored. */
{
int length, index;
const char *result;
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
result = NULL;
if (index != -1) {
Tcl_DString envStr;
result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
result += length;
if (*result == '=') {
result++;
Tcl_DStringInit(valuePtr);
Tcl_DStringAppend(valuePtr, result, -1);
result = Tcl_DStringValue(valuePtr);
} else {
result = NULL;
}
Tcl_DStringFree(&envStr);
}
Tcl_MutexUnlock(&envMutex);
return result;
}
/*
** This is an alternative callback for database queries. Instead
** of invoking a TCL script to handle the result, this callback just
** appends each column of the result to a list. After the query
** is complete, the list is returned.
*/
static int DbEvalCallback2(
void *clientData, /* An instance of CallbackData */
int nCol, /* Number of columns in the result */
char ** azCol, /* Data for each column */
char ** azN /* Name for each column */
){
Tcl_Obj *pList = (Tcl_Obj*)clientData;
int i;
if( azCol==0 ) return 0;
for(i=0; i<nCol; i++){
Tcl_Obj *pElem;
if( azCol[i] && *azCol[i] ){
#ifdef UTF_TRANSLATION_NEEDED
Tcl_DString dCol;
Tcl_DStringInit(&dCol);
Tcl_ExternalToUtfDString(NULL, azCol[i], -1, &dCol);
pElem = Tcl_NewStringObj(Tcl_DStringValue(&dCol), -1);
Tcl_DStringFree(&dCol);
#else
pElem = Tcl_NewStringObj(azCol[i], -1);
#endif
}else{
pElem = Tcl_NewObj();
}
Tcl_ListObjAppendElement(0, pList, pElem);
}
return 0;
}
static void StateSpecUpdateString(Tcl_Obj *objPtr)
{
unsigned int onbits = (objPtr->internalRep.longValue & 0xFFFF0000) >> 16;
unsigned int offbits = objPtr->internalRep.longValue & 0x0000FFFF;
unsigned int mask = onbits | offbits;
Tcl_DString result;
int i, len;
Tcl_DStringInit(&result);
for (i=0; stateNames[i] != NULL; ++i) {
if (mask & (1<<i)) {
if (offbits & (1<<i))
Tcl_DStringAppend(&result, "!", 1);
Tcl_DStringAppend(&result, stateNames[i], -1);
Tcl_DStringAppend(&result, " ", 1);
}
}
len = Tcl_DStringLength(&result);
if (len) {
/* 'len' includes extra trailing ' ' */
objPtr->bytes = Tcl_Alloc((unsigned)len);
objPtr->length = len-1;
strncpy(objPtr->bytes, Tcl_DStringValue(&result), (size_t)len-1);
objPtr->bytes[len-1] = '\0';
} else {
/* empty string */
objPtr->length = 0;
objPtr->bytes = Tcl_Alloc(1);
*objPtr->bytes = '\0';
}
Tcl_DStringFree(&result);
}
static NSVGimage *
GetCachedSVG(
Tcl_Interp *interp,
ClientData dataOrChan,
Tcl_Obj *formatObj,
RastOpts *ropts)
{
int length;
const char *data;
NSVGcache *cachePtr = GetCachePtr(interp);
NSVGimage *nsvgImage = NULL;
if ((cachePtr != NULL) && (cachePtr->nsvgImage != NULL) &&
(cachePtr->dataOrChan == dataOrChan)) {
if (formatObj != NULL) {
data = Tcl_GetStringFromObj(formatObj, &length);
if (strcmp(data, Tcl_DStringValue(&cachePtr->formatString)) == 0) {
nsvgImage = cachePtr->nsvgImage;
*ropts = cachePtr->ropts;
cachePtr->nsvgImage = NULL;
}
} else if (Tcl_DStringLength(&cachePtr->formatString) == 0) {
nsvgImage = cachePtr->nsvgImage;
*ropts = cachePtr->ropts;
cachePtr->nsvgImage = NULL;
}
}
CleanCache(interp);
return nsvgImage;
}
const char *
TkpGetString(
TkWindow *winPtr, /* Window where event occurred: needed to get
* input context. */
XEvent *eventPtr, /* X keyboard event. */
Tcl_DString *dsPtr) /* Uninitialized or empty string to hold
* result. */
{
XKeyEvent *keyEv = &eventPtr->xkey;
Tcl_DStringInit(dsPtr);
if (keyEv->send_event == -1) {
if (keyEv->nbytes > 0) {
Tcl_ExternalToUtfDString(TkWinGetKeyInputEncoding(),
keyEv->trans_chars, keyEv->nbytes, dsPtr);
}
} else if (keyEv->send_event == -2) {
/*
* Special case for win2000 multi-lingal IME input. xkey.trans_chars[]
* already contains a UNICODE char.
*/
int unichar;
char buf[TCL_UTF_MAX];
int len;
unichar = keyEv->trans_chars[1] & 0xff;
unichar <<= 8;
unichar |= keyEv->trans_chars[0] & 0xff;
len = Tcl_UniCharToUtf((Tcl_UniChar) unichar, buf);
Tcl_DStringAppend(dsPtr, buf, len);
} else if (keyEv->send_event == -3) {
/*
* Special case for WM_UNICHAR. xkey.trans_chars[] already contains a
* UTF-8 char.
*/
Tcl_DStringAppend(dsPtr, keyEv->trans_chars, keyEv->nbytes);
} else {
/*
* This is an event generated from generic code. It has no nchars or
* trans_chars members.
*/
KeySym keysym = KeycodeToKeysym(keyEv->keycode, keyEv->state, 0);
if (((keysym != NoSymbol) && (keysym > 0) && (keysym < 256))
|| (keysym == XK_Return) || (keysym == XK_Tab)) {
char buf[TCL_UTF_MAX];
int len;
len = Tcl_UniCharToUtf((Tcl_UniChar) (keysym & 255), buf);
Tcl_DStringAppend(dsPtr, buf, len);
}
}
return Tcl_DStringValue(dsPtr);
}
static int
TraversalCopy(
Tcl_DString *srcPtr, /* Source pathname to copy. */
Tcl_DString *dstPtr, /* Destination pathname of copy. */
int type, /* Reason for call - see TraverseWinTree() */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString filled
* with UTF-8 name of file causing error. */
{
TCHAR *nativeDst, *nativeSrc;
DWORD attr;
switch (type) {
case DOTREE_F: {
if (DoCopyFile(srcPtr, dstPtr) == TCL_OK) {
return TCL_OK;
}
break;
}
case DOTREE_PRED: {
if (DoCreateDirectory(dstPtr) == TCL_OK) {
nativeSrc = (TCHAR *) Tcl_DStringValue(srcPtr);
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) {
return TCL_OK;
}
TclWinConvertError(GetLastError());
}
break;
}
case DOTREE_POSTD: {
return TCL_OK;
}
}
/*
* There shouldn't be a problem with src, because we already
* checked it to get here.
*/
if (errorPtr != NULL) {
nativeDst = (TCHAR *) Tcl_DStringValue(dstPtr);
Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
}
return TCL_ERROR;
}
/*
* Further on, in UNICODE mode, we need to use Tcl_NewUnicodeObj,
* while otherwise NewNativeObj is needed (which provides proper
* conversion from native encoding to UTF-8).
*/
#ifdef UNICODE
# define NewNativeObj Tcl_NewUnicodeObj
#else /* !UNICODE */
static Tcl_Obj *NewNativeObj(char *string, int length) {
Tcl_Obj *obj;
Tcl_DString ds;
Tcl_ExternalToUtfDString(NULL, string, length, &ds);
obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
Tcl_DStringFree(&ds);
return obj;
}
Tcl_Obj *Tcl_NewWStringObj(const wchar_t *str)
{
Tcl_DString ds;
Tcl_WinTCharToUtf(str, -1, &ds);
Tcl_Obj *result = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
Tcl_DStringFree(&ds);
return result;
};
/* assign a var from an string */
Tcl_Obj*
TSP_Util_lang_assign_var_string(Tcl_Obj* targetVarName, Tcl_DString* sourceVarName) {
if (targetVarName != NULL) {
Tcl_DecrRefCount(targetVarName);
}
targetVarName = Tcl_NewStringObj(Tcl_DStringValue(sourceVarName), Tcl_DStringLength(sourceVarName));
Tcl_IncrRefCount(targetVarName);
return targetVarName;
}
/* convert to an int from a string */
int
TSP_Util_lang_convert_int_string(Tcl_Interp* interp, Tcl_DString* sourceVarName, Tcl_WideInt* targetVarName) {
int rc;
Tcl_Obj* obj = Tcl_NewStringObj(Tcl_DStringValue(sourceVarName), Tcl_DStringLength(sourceVarName));
Tcl_IncrRefCount(obj);
rc = Tcl_GetWideIntFromObj(interp, obj, targetVarName);
Tcl_DecrRefCount(obj);
return rc;
}
Tcl_Obj *Tcl_NewGuidObj(const GUID& Guid)
{
wchar_t guidstr[37];
FSF.sprintf(guidstr,L"%08x-%04x-%04x-%02x%02x-%02x%02x%02x%02x%02x%02x",Guid.Data1,Guid.Data2,Guid.Data3,Guid.Data4[0],Guid.Data4[1],Guid.Data4[2],Guid.Data4[3],Guid.Data4[4],Guid.Data4[5],Guid.Data4[6],Guid.Data4[7]);
Tcl_DString ds;
Tcl_WinTCharToUtf(guidstr, -1, &ds);
Tcl_Obj *result = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
Tcl_DStringFree(&ds);
return result;
};
