/* ARGSUSED */
int
Tcl_FconfigureObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
char *optionName, *valueName;
Tcl_Channel chan; /* The channel to set a mode on. */
int i; /* Iterate over arg-value pairs. */
if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
Tcl_WrongNumArgs(interp, 1, objv,
"channelId ?optionName? ?value? ?optionName value?...");
return TCL_ERROR;
}
if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
if (objc == 2) {
Tcl_DString ds; /* DString to hold result of calling
* Tcl_GetChannelOption. */
Tcl_DStringInit(&ds);
if (Tcl_GetChannelOption(interp, chan, NULL, &ds) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringResult(interp, &ds);
return TCL_OK;
} else if (objc == 3) {
Tcl_DString ds; /* DString to hold result of calling
* Tcl_GetChannelOption. */
Tcl_DStringInit(&ds);
optionName = TclGetString(objv[2]);
if (Tcl_GetChannelOption(interp, chan, optionName, &ds) != TCL_OK) {
Tcl_DStringFree(&ds);
return TCL_ERROR;
}
Tcl_DStringResult(interp, &ds);
return TCL_OK;
}
for (i = 3; i < objc; i += 2) {
optionName = TclGetString(objv[i-1]);
valueName = TclGetString(objv[i]);
if (Tcl_SetChannelOption(interp, chan, optionName, valueName)
!= TCL_OK) {
return TCL_ERROR;
}
}
return TCL_OK;
}
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;
}
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;
}
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;
}
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;
}
/*
*---------------------------------------------------------------------------
*
* PbmToPictures --
*
* Reads a PBM file and converts it into a picture.
*
* Results:
* The picture is returned. If an error occured, such
* as the designated file could not be opened, NULL is returned.
*
*---------------------------------------------------------------------------
*/
static Blt_Chain
PbmToPictures(Tcl_Interp *interp, const char *fileName, Blt_DBuffer dbuffer,
PbmImportSwitches *switchesPtr)
{
Blt_Chain chain;
Blt_Picture picture;
Pbm pbm;
PbmMessage message;
pbmMessagePtr = &message;
message.nWarnings = 0;
memset(&pbm, 0, sizeof(pbm)); /* Clear the structure. */
pbm.dbuffer = dbuffer;
Tcl_DStringInit(&message.errors);
Tcl_DStringInit(&message.warnings);
Tcl_DStringAppend(&message.errors, "error reading \"", -1);
Tcl_DStringAppend(&message.errors, fileName, -1);
Tcl_DStringAppend(&message.errors, "\": ", -1);
Tcl_DStringAppend(&message.warnings, "\"", -1);
Tcl_DStringAppend(&message.warnings, fileName, -1);
Tcl_DStringAppend(&message.warnings, "\": ", -1);
if (setjmp(message.jmpbuf)) {
Tcl_DStringResult(interp, &message.errors);
Tcl_DStringFree(&message.warnings);
if (pbm.picture != NULL) {
Blt_FreePicture(pbm.picture);
}
return NULL;
}
chain = NULL;
if (!IsPbm(pbm.dbuffer)) {
PbmError("bad PBM header");
}
Blt_DBuffer_ResetCursor(pbm.dbuffer);
chain = Blt_Chain_Create();
while (Blt_DBuffer_BytesLeft(pbm.dbuffer) > 0) {
picture = PbmImage(&pbm);
Blt_Chain_Append(chain, picture);
}
if (switchesPtr->gamma != 1.0) {
Blt_GammaCorrectPicture(picture, picture, switchesPtr->gamma);
}
if (message.nWarnings > 0) {
Tcl_SetErrorCode(interp, "PICTURE", "PBM_READ_WARNINGS",
Tcl_DStringValue(&message.warnings), (char *)NULL);
} else {
Tcl_SetErrorCode(interp, "NONE", (char *)NULL);
}
Tcl_DStringFree(&message.warnings);
Tcl_DStringFree(&message.errors);
return chain;
}
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;
}
extern int JSMinCmd(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
{
int res;
tcljsminCtx *ctx;
jsminCtx *jctx;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "Usage: jsmin string");
return TCL_ERROR;
}
ctx=ckalloc(sizeof(tcljsminCtx));
ctx->in = Tcl_GetStringFromObj(objv[1], &ctx->len);
ctx->pos = 0;
Tcl_DStringInit(&ctx->out);
Tcl_DStringInit(&ctx->err);
jctx=jsminInit(ctx, tcljsminInput, tcljsminOutput, tcljsminError);
switch (jsmin(jctx)) {
case JSMIN_ERROR:
Tcl_DStringResult(interp, &ctx->err);
res=TCL_ERROR;
break;
case JSMIN_OK:
Tcl_DStringResult(interp, &ctx->out);
res=TCL_OK;
break;
}
jsminCleanup(jctx);
Tcl_DStringFree(&ctx->out);
Tcl_DStringFree(&ctx->err);
ckfree(ctx);
return res;
}
int
NsTclQuoteHtmlCmd(ClientData dummy, Tcl_Interp *interp, int argc, char **argv)
{
Ns_DString ds;
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " html\"", NULL);
return TCL_ERROR;
}
Ns_DStringInit(&ds);
Ns_QuoteHtml(&ds, argv[1]);
Tcl_DStringResult(interp, &ds);
return TCL_OK;
}
/*
** Return all tokens between the two elements as a Tcl list.
*/
void HtmlTclizeList(Tcl_Interp *interp, HtmlElement *p, HtmlElement *pEnd){
Tcl_DString str;
int i;
char *zName;
char zLine[100];
Tcl_DStringInit(&str);
while( p && p!=pEnd ){
switch( p->base.type ){
case Html_Block:
break;
case Html_Text:
Tcl_DStringStartSublist(&str);
Tcl_DStringAppendElement(&str,"Text");
Tcl_DStringAppendElement(&str, p->text.zText);
Tcl_DStringEndSublist(&str);
break;
case Html_Space:
sprintf(zLine,"Space %d %d",
p->base.count, (p->base.flags & HTML_NewLine)!=0);
Tcl_DStringAppendElement(&str,zLine);
break;
case Html_Unknown:
Tcl_DStringAppendElement(&str,"Unknown");
break;
default:
Tcl_DStringStartSublist(&str);
Tcl_DStringAppendElement(&str,"Markup");
if( p->base.type >= HtmlMarkupMap[0].type
&& p->base.type <= HtmlMarkupMap[HTML_MARKUP_COUNT-1].type ){
zName = HtmlMarkupMap[p->base.type - HtmlMarkupMap[0].type].zName;
}else{
zName = "Unknown";
}
Tcl_DStringAppendElement(&str, zName);
for(i=0; i<p->base.count; i++){
Tcl_DStringAppendElement(&str, p->markup.argv[i]);
}
Tcl_DStringEndSublist(&str);
break;
}
p = p->pNext;
}
Tcl_DStringResult(interp, &str);
}
/*
** Return all tokens between the two elements as a Text.
*/
void HtmlTclizeAscii(Tcl_Interp *interp, HtmlIndex *s, HtmlIndex *e){
int j, nsub=0;
HtmlElement* p=s->p;
Tcl_DString str;
if (p && p->base.type==Html_Text) {
nsub=s->i;
}
Tcl_DStringInit(&str);
while( p) {
switch( p->base.type ){
case Html_Block:
break;
case Html_Text:
j=strlen(p->text.zText);
if (j<nsub) nsub=j;
if (p==e->p) {
j= (e->i-nsub+1);
}
Tcl_DStringAppend(&str, p->text.zText+nsub,j-nsub);
nsub=0;
break;
case Html_Space:
for (j=0; j< p->base.count; j++) {
if (nsub-->0) continue;
Tcl_DStringAppend(&str, " ", 1);
}
if ((p->base.flags & HTML_NewLine)!=0)
Tcl_DStringAppend(&str, "\n",1);
nsub=0;
break;
case Html_P:
case Html_BR:
Tcl_DStringAppend(&str, "\n",1);
break;
case Html_Unknown:
break;
default:
break;
}
if (p==e->p) break;
p = p->pNext;
}
Tcl_DStringResult(interp, &str);
}
/*
* Return string corresponding to full path to ~/.irssi
*/
int
cmd_irssi_dir(ClientData clientData, Tcl_Interp* interp, int objc,
Tcl_Obj* const objv[])
{
(void) clientData;
(void) objv;
if (objc != 1) {
Tcl_Obj* str = Tcl_ObjPrintf("wrong # args: should be \"irssi_dir\"");
Tcl_SetObjResult(interp, str);
return TCL_ERROR;
}
Tcl_DString dsPtr;
Tcl_DStringInit(&dsPtr);
irssi_dir_ds(&dsPtr, "");
Tcl_DStringResult(interp, &dsPtr);
Tcl_DStringFree(&dsPtr);
return TCL_OK;
}
int ScriptTcl::Tcl_replicaRecv(ClientData, Tcl_Interp *interp, int argc, char **argv) {
if (argc != 2 ) {
Tcl_SetResult(interp,"args: source",TCL_VOLATILE);
return TCL_ERROR;
}
Tcl_DString recvstr;
Tcl_DStringInit(&recvstr);
int recvcount = 0;
int source = atoi(argv[1]);
#if CMK_HAS_PARTITION
DataMessage *recvMsg = NULL;
replica_recv(&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;
}
int ScriptTcl::Tcl_replicaEval(ClientData, Tcl_Interp *interp, int argc, char **argv) {
if ( argc != 3 ) {
Tcl_SetResult(interp,"args: dest script",TCL_VOLATILE);
return TCL_ERROR;
}
int dest = atoi(argv[1]);
CHECK_REPLICA(dest);
#if CMK_HAS_PARTITION
Tcl_DString recvstr;
Tcl_DStringInit(&recvstr);
DataMessage *recvMsg = NULL;
replica_eval(argv[2], dest, CkMyPe(), &recvMsg);
CmiAssert(recvMsg != NULL);
int code = recvMsg->code;
Tcl_DStringAppend(&recvstr, recvMsg->data, recvMsg->size);
Tcl_DStringResult(interp, &recvstr);
Tcl_DStringFree(&recvstr);
CmiFree(recvMsg);
return code;
#else
return Tcl_EvalEx(interp,argv[2],-1,TCL_EVAL_GLOBAL);
#endif
}
/* 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;
}
int
cross_services(ClientData clientData,
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
char **argv) /* Argument strings. */
{
Tcl_CmdInfo infoPtr;
ClientData wcdata;
Tcl_CmdProc* wcmd;
char *wname;
char *command, *contents;
int pargc, i, size;
char *pline, *q;
int result, ret = TCL_OK;
wname = argv[1];
if (wname[0])
{
if (!Tcl_GetCommandInfo(interp, wname, &infoPtr))
{
Tcl_AppendResult(interp, "wrong # \"",
wname, "\" does not exist", (char *) NULL);
return TCL_ERROR;
}
wcdata = infoPtr.clientData;
wcmd = (Tcl_CmdProc *)infoPtr.proc;
}
Tcl_ResetResult (interp);
pargc = 2;
command = argv[pargc++];
contents = argv[pargc++];
if (argc == 12 && *command == 'f' && strcmp (command, "filter") == 0)
{
char *refartStr, *testline, *shown_scopes, *ref_access;
char *file = NULL;
enum RefTypes refart;
char **tfields, **lfields=NULL, **oldfields=NULL;
char *tmpline;
int tmpline_size = 512;
int uniq, have, accept_static, accept_param, fsize, tsize;
int AddRefArt=0;
int length;
char *line[line_arg_count], AddRefartStr[16] = {0};
Tcl_DString res, erg;
refartStr = argv[pargc++];
testline = argv[pargc++];
uniq = atoi (argv[pargc++]);
have = atoi (argv[pargc++]);
accept_param = atoi (argv[pargc++]);
accept_static= atoi (argv[pargc++]);
shown_scopes = argv[pargc++];
ref_access = argv[pargc++];
if (accept_static)
{
/* Information to the actual scope */
if (Tcl_SplitList (interp, testline, &tsize, &tfields) != TCL_OK)
{
return TCL_ERROR;
}
file = tfields[file1_pos];
}
if (strcmp (refartStr, "to") == 0)
{
refart = REF_TO;
}
else
{
refart = REF_BY;
}
/* init some variables */
for (i=0; i<line_arg_count; i++)
{
line[i] = "";
}
Tcl_DStringInit(&res);
Tcl_DStringInit(&erg);
tmpline = (char*)ckalloc (tmpline_size); tmpline[0] = 0;
for (length=strlen(contents), q = contents; 1;)
{
char *prevlist = q;
result = TclFindElement(interp, q, length, &pline, &q, &size, NULL);
if (result != TCL_OK || size == 0)
{
break;
}
length -= q - prevlist;
if (size > tmpline_size)
{
tmpline_size += size;
tmpline = ckrealloc (tmpline, tmpline_size);
}
memcpy (tmpline, pline, size);
tmpline[size] = 0;
if (Tcl_SplitList (interp, tmpline, &fsize, &lfields) != TCL_OK)
{
continue;
}
if (fsize != DB_COUNT)
{
ckfree ((char*)lfields);
continue;
}
if (*shown_scopes && strstr (shown_scopes, lfields[DB_SCP2]) == NULL)
{
continue;
}
if (*ref_access && strstr (ref_access, lfields[DB_REFA]) == NULL)
{
continue;
}
if (uniq && oldfields)
{
if (strcmp (oldfields[DB_CLS2], lfields[DB_CLS2]) == 0 &&
strcmp (oldfields[DB_SYM2], lfields[DB_SYM2]) == 0 &&
strcmp (oldfields[DB_SCP2], lfields[DB_SCP2]) == 0 &&
(! accept_param ||
(accept_param && strcmp (oldfields[DB_PRM2], lfields[DB_PRM2]) == 0)))
{
if (!AddRefartStr[0] ||
(lfields[DB_REFA][0] && strchr (AddRefartStr, lfields[DB_REFA][0]) == NULL))
{
strcat (AddRefartStr, lfields[DB_REFA]);
}
ckfree ((char *) lfields);
continue;
}
}
/* Static functions and variables */
if (accept_static && refart == REF_TO && lfields[DB_REFA][0] != 0 && ! cross_is_type_with_classes(lfields[DB_SCP2]))
{
int attr;
if (Tcl_GetInt(interp, lfields[DB_REFA], &attr) == TCL_OK &&
(! (attr&PAF_STATIC) || strcmp (lfields[DB_FILE], file) != 0))
{
ckfree ((char*)lfields);
continue;
}
}
if (have)
{
ckfree ((char *) lfields);
Tcl_DStringAppendElement (&erg, "yes");
break;
}
if (AddRefArt)
{
Tcl_DStringAppendElement(&res, AddRefartStr);
Tcl_DStringAppendElement(&erg, Tcl_DStringValue(&res));
}
else
{
AddRefArt = 1;
}
strcpy (AddRefartStr, lfields[DB_REFA]);
line[class1_pos] = lfields[DB_CLS2];
line[item1_pos] = lfields[DB_SYM2];
line[what1_pos] = lfields[DB_SCP2];
line[param1_pos] = lfields[DB_PRM2];
line[file_pos] = lfields[DB_FILE];
line[file_line_pos] = lfields[DB_LINE];
Tcl_DStringFree (&res);
for (i=0; i<refart_pos; i++)
{
Tcl_DStringAppendElement (&res, line[i]);
}
/* Store last line */
if (oldfields)
{
ckfree ((char*)oldfields);
}
oldfields = lfields;
}
if (AddRefArt)
{
Tcl_DStringAppendElement(&res, AddRefartStr);
Tcl_DStringAppendElement(&erg, Tcl_DStringValue(&res));
AddRefartStr[0] = 0;
}
Tcl_DStringFree (&res);
if (accept_static)
{
ckfree ((char*)tfields);
}
if (oldfields)
{
ckfree ((char*)oldfields);
}
ckfree (tmpline);
Tcl_DStringResult(interp, &erg);
Tcl_DStringFree (&erg);
}
else if (argc == 7 && *command == 'i' && strcmp (command, "insert") == 0)
{
}
else
{
char tmp[32];
sprintf (tmp, "%i", argc);
Tcl_AppendResult(interp, "wrong # args(", tmp, "): should be \"", argv[0],
" filter \"\" contents RefArt line unique have accept_param accept_static shown_scopes ref_access |\n"
"insert widget contents RefArt id line\n",
"\"",
(char *) NULL);
ret = TCL_ERROR;
}
return ret;
}
static int
HandleTclCommand(
ClientData clientData, /* Information about command to execute. */
int offset, /* Return selection bytes starting at this
* offset. */
char *buffer, /* Place to store converted selection. */
int maxBytes) /* Maximum # of bytes to store at buffer. */
{
CommandInfo *cmdInfoPtr = clientData;
int spaceNeeded, length;
#define MAX_STATIC_SIZE 100
char staticSpace[MAX_STATIC_SIZE];
char *command, *string;
Tcl_Interp *interp = cmdInfoPtr->interp;
Tcl_DString oldResult;
int extraBytes, charOffset, count, numChars;
const char *p;
/*
* We must also protect the interpreter and the command from being deleted
* too soon.
*/
Tcl_Preserve(clientData);
Tcl_Preserve(interp);
/*
* Compute the proper byte offset in the case where the last chunk split a
* character.
*/
if (offset == cmdInfoPtr->byteOffset) {
charOffset = cmdInfoPtr->charOffset;
extraBytes = strlen(cmdInfoPtr->buffer);
if (extraBytes > 0) {
strcpy(buffer, cmdInfoPtr->buffer);
maxBytes -= extraBytes;
buffer += extraBytes;
}
} else {
cmdInfoPtr->byteOffset = 0;
cmdInfoPtr->charOffset = 0;
extraBytes = 0;
charOffset = 0;
}
/*
* First, generate a command by taking the command string and appending
* the offset and maximum # of bytes.
*/
spaceNeeded = cmdInfoPtr->cmdLength + 30;
if (spaceNeeded < MAX_STATIC_SIZE) {
command = staticSpace;
} else {
command = (char *) ckalloc((unsigned) spaceNeeded);
}
sprintf(command, "%s %d %d", cmdInfoPtr->command, charOffset, maxBytes);
/*
* Execute the command. Be sure to restore the state of the interpreter
* after executing the command.
*/
Tcl_DStringInit(&oldResult);
Tcl_DStringGetResult(interp, &oldResult);
if (TkCopyAndGlobalEval(interp, command) == TCL_OK) {
string = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
count = (length > maxBytes) ? maxBytes : length;
memcpy(buffer, string, (size_t) count);
buffer[count] = '\0';
/*
* Update the partial character information for the next retrieval if
* the command has not been deleted.
*/
if (cmdInfoPtr->interp != NULL) {
if (length <= maxBytes) {
cmdInfoPtr->charOffset += Tcl_NumUtfChars(string, -1);
cmdInfoPtr->buffer[0] = '\0';
} else {
p = string;
string += count;
numChars = 0;
while (p < string) {
p = Tcl_UtfNext(p);
numChars++;
}
cmdInfoPtr->charOffset += numChars;
length = p - string;
if (length > 0) {
strncpy(cmdInfoPtr->buffer, string, (size_t) length);
}
cmdInfoPtr->buffer[length] = '\0';
}
cmdInfoPtr->byteOffset += count + extraBytes;
}
count += extraBytes;
} else {
count = -1;
}
Tcl_DStringResult(interp, &oldResult);
if (command != staticSpace) {
ckfree(command);
}
Tcl_Release(clientData);
Tcl_Release(interp);
return count;
}
int
Tk_SelectionObjCmd(
ClientData clientData, /* Main window associated with
* interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tk_Window tkwin = clientData;
char *path = NULL;
Atom selection;
char *selName = NULL, *string;
int count, index;
Tcl_Obj **objs;
static const char *const optionStrings[] = {
"clear", "get", "handle", "own", NULL
};
enum options {
SELECTION_CLEAR, SELECTION_GET, SELECTION_HANDLE, SELECTION_OWN
};
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case SELECTION_CLEAR: {
static const char *const clearOptionStrings[] = {
"-displayof", "-selection", NULL
};
enum clearOptions { CLEAR_DISPLAYOF, CLEAR_SELECTION };
int clearIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0], clearOptionStrings,
"option", 0, &clearIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum clearOptions) clearIndex) {
case CLEAR_DISPLAYOF:
path = Tcl_GetString(objs[1]);
break;
case CLEAR_SELECTION:
selName = Tcl_GetString(objs[1]);
break;
}
}
if (count == 1) {
path = Tcl_GetString(objs[0]);
} else if (count > 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
return TCL_ERROR;
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
Tk_ClearSelection(tkwin, selection);
break;
}
case SELECTION_GET: {
Atom target;
char *targetName = NULL;
Tcl_DString selBytes;
int result;
static const char *const getOptionStrings[] = {
"-displayof", "-selection", "-type", NULL
};
enum getOptions { GET_DISPLAYOF, GET_SELECTION, GET_TYPE };
int getIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count>0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0], getOptionStrings,
"option", 0, &getIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum getOptions) getIndex) {
case GET_DISPLAYOF:
path = Tcl_GetString(objs[1]);
break;
case GET_SELECTION:
selName = Tcl_GetString(objs[1]);
break;
case GET_TYPE:
targetName = Tcl_GetString(objs[1]);
break;
}
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
if (count > 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
return TCL_ERROR;
} else if (count == 1) {
target = Tk_InternAtom(tkwin, Tcl_GetString(objs[0]));
} else if (targetName != NULL) {
target = Tk_InternAtom(tkwin, targetName);
} else {
target = XA_STRING;
}
Tcl_DStringInit(&selBytes);
result = Tk_GetSelection(interp, tkwin, selection, target,
SelGetProc, &selBytes);
if (result == TCL_OK) {
Tcl_DStringResult(interp, &selBytes);
} else {
Tcl_DStringFree(&selBytes);
}
return result;
}
case SELECTION_HANDLE: {
Atom target, format;
char *targetName = NULL;
char *formatName = NULL;
register CommandInfo *cmdInfoPtr;
int cmdLength;
static const char *const handleOptionStrings[] = {
"-format", "-selection", "-type", NULL
};
enum handleOptions {
HANDLE_FORMAT, HANDLE_SELECTION, HANDLE_TYPE
};
int handleIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0],handleOptionStrings,
"option", 0, &handleIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum handleOptions) handleIndex) {
case HANDLE_FORMAT:
formatName = Tcl_GetString(objs[1]);
break;
case HANDLE_SELECTION:
selName = Tcl_GetString(objs[1]);
break;
case HANDLE_TYPE:
targetName = Tcl_GetString(objs[1]);
break;
}
}
if ((count < 2) || (count > 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? window command");
return TCL_ERROR;
}
tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
if (tkwin == NULL) {
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
if (count > 2) {
target = Tk_InternAtom(tkwin, Tcl_GetString(objs[2]));
} else if (targetName != NULL) {
target = Tk_InternAtom(tkwin, targetName);
} else {
target = XA_STRING;
}
if (count > 3) {
format = Tk_InternAtom(tkwin, Tcl_GetString(objs[3]));
} else if (formatName != NULL) {
format = Tk_InternAtom(tkwin, formatName);
} else {
format = XA_STRING;
}
string = Tcl_GetStringFromObj(objs[1], &cmdLength);
if (cmdLength == 0) {
Tk_DeleteSelHandler(tkwin, selection, target);
} else {
cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
sizeof(CommandInfo) - 3 + cmdLength));
cmdInfoPtr->interp = interp;
cmdInfoPtr->charOffset = 0;
cmdInfoPtr->byteOffset = 0;
cmdInfoPtr->buffer[0] = '\0';
cmdInfoPtr->cmdLength = cmdLength;
strcpy(cmdInfoPtr->command, string);
Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
cmdInfoPtr, format);
}
return TCL_OK;
}
case SELECTION_OWN: {
register LostCommand *lostPtr;
char *script = NULL;
int cmdLength;
static const char *const ownOptionStrings[] = {
"-command", "-displayof", "-selection", NULL
};
enum ownOptions { OWN_COMMAND, OWN_DISPLAYOF, OWN_SELECTION };
int ownIndex;
for (count = objc-2, objs = ((Tcl_Obj **)objv)+2; count > 0;
count-=2, objs+=2) {
string = Tcl_GetString(objs[0]);
if (string[0] != '-') {
break;
}
if (count < 2) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objs[0], ownOptionStrings,
"option", 0, &ownIndex) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum ownOptions) ownIndex) {
case OWN_COMMAND:
script = Tcl_GetString(objs[1]);
break;
case OWN_DISPLAYOF:
path = Tcl_GetString(objs[1]);
break;
case OWN_SELECTION:
selName = Tcl_GetString(objs[1]);
break;
}
}
if (count > 2) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? ?window?");
return TCL_ERROR;
}
if (selName != NULL) {
selection = Tk_InternAtom(tkwin, selName);
} else {
selection = XA_PRIMARY;
}
if (count == 0) {
TkSelectionInfo *infoPtr;
TkWindow *winPtr;
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
winPtr = (TkWindow *)tkwin;
for (infoPtr = winPtr->dispPtr->selectionInfoPtr;
infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
if (infoPtr->selection == selection) {
break;
}
}
/*
* Ignore the internal clipboard window.
*/
if ((infoPtr != NULL)
&& (infoPtr->owner != winPtr->dispPtr->clipWindow)) {
Tcl_SetResult(interp, Tk_PathName(infoPtr->owner), TCL_STATIC);
}
return TCL_OK;
}
tkwin = Tk_NameToWindow(interp, Tcl_GetString(objs[0]), tkwin);
if (tkwin == NULL) {
return TCL_ERROR;
}
if (count == 2) {
script = Tcl_GetString(objs[1]);
}
if (script == NULL) {
Tk_OwnSelection(tkwin, selection, NULL, NULL);
return TCL_OK;
}
cmdLength = strlen(script);
lostPtr = (LostCommand *)
ckalloc((unsigned) (sizeof(LostCommand) - 3 + cmdLength));
lostPtr->interp = interp;
strcpy(lostPtr->command, script);
Tk_OwnSelection(tkwin, selection, LostSelection, lostPtr);
return TCL_OK;
}
}
return TCL_OK;
}
/*
*---------------------------------------------------------------------------
*
* PictureToTif --
*
* Writes a TIFF format image to the provided data buffer.
*
* Results:
* A standard TCL result. If an error occured, TCL_ERROR is
* returned and an error message will be place in the interpreter
* result. Otherwise, the data sink will contain the binary
* output of the image.
*
* Side Effects:
* Memory is allocated for the data sink.
*
*---------------------------------------------------------------------------
*/
static int
PictureToTif(Tcl_Interp *interp, Blt_Picture picture, Blt_DBuffer dbuffer,
TifExportSwitches *switchesPtr)
{
TIFF *tifPtr;
TIFFErrorHandler oldErrorHandler, oldWarningHandler;
TifMessage message;
int photometric, samplesPerPixel;
int compress, result, nColors;
Picture *srcPtr;
compress = tifCompressionSchemes[switchesPtr->compress];
if (compress == COMPRESSION_NONE) {
fprintf(stderr, "not compressing TIFF output\n");
}
#ifdef notdef
if (!TIFFIsCODECConfigured((unsigned short int)compress)) {
compress = COMPRESSION_NONE;
}
#endif
srcPtr = picture;
Tcl_DStringInit(&message.errors);
Tcl_DStringInit(&message.warnings);
Tcl_DStringAppend(&message.errors, "error writing TIF output: ", -1);
tifMessagePtr = &message;
message.nErrors = message.nWarnings = 0;
oldErrorHandler = TIFFSetErrorHandler(TifError);
oldWarningHandler = TIFFSetWarningHandler(TifWarning);
tifPtr = TIFFClientOpen("data buffer", "w", (thandle_t)dbuffer,
TifRead, /* TIFFReadWriteProc */
TifWrite, /* TIFFReadWriteProc */
TifSeek, /* TIFFSeekProc */
TifClose, /* TIFFCloseProc */
TifSize, /* TIFFSizeProc */
TifMapFile, /* TIFFMapFileProc */
TifUnmapFile); /* TIFFUnmapFileProc */
if (tifPtr == NULL) {
Tcl_AppendResult(interp, "can't register TIF procs: ", (char *)NULL);
return TCL_ERROR;
}
nColors = Blt_QueryColors(srcPtr, (Blt_HashTable *)NULL);
if (Blt_PictureIsColor(srcPtr)) {
samplesPerPixel = (Blt_PictureIsOpaque(srcPtr)) ? 3 : 4;
photometric = PHOTOMETRIC_RGB;
} else {
if (!Blt_PictureIsOpaque(srcPtr)) {
Blt_Picture background;
Blt_Pixel white;
/* Blend picture with solid color background. */
background = Blt_CreatePicture(srcPtr->width, srcPtr->height);
white.u32 = 0xFFFFFFFF;
Blt_BlankPicture(background, &white); /* White background. */
Blt_BlendPictures(background, srcPtr, 0, 0, srcPtr->width,
srcPtr->height, 0, 0);
srcPtr = background;
}
samplesPerPixel = 1;
photometric = PHOTOMETRIC_MINISBLACK;
}
TIFFSetField(tifPtr, TIFFTAG_BITSPERSAMPLE, 8);
TIFFSetField(tifPtr, TIFFTAG_COMPRESSION, (unsigned short int)compress);
TIFFSetField(tifPtr, TIFFTAG_IMAGELENGTH, srcPtr->height);
TIFFSetField(tifPtr, TIFFTAG_IMAGEWIDTH, srcPtr->width);
TIFFSetField(tifPtr, TIFFTAG_ORIENTATION, ORIENTATION_TOPLEFT);
TIFFSetField(tifPtr, TIFFTAG_PHOTOMETRIC, photometric);
TIFFSetField(tifPtr, TIFFTAG_PLANARCONFIG, PLANARCONFIG_CONTIG);
TIFFSetField(tifPtr, TIFFTAG_RESOLUTIONUNIT, 2);
TIFFSetField(tifPtr, TIFFTAG_ROWSPERSTRIP, srcPtr->height);
TIFFSetField(tifPtr, TIFFTAG_SAMPLESPERPIXEL, samplesPerPixel);
TIFFSetField(tifPtr, TIFFTAG_SOFTWARE, TIFFGetVersion());
TIFFSetField(tifPtr, TIFFTAG_XRESOLUTION, 300.0f);
TIFFSetField(tifPtr, TIFFTAG_YRESOLUTION, 300.0f);
#ifdef WORD_BIGENDIAN
TIFFSetField(tifPtr, TIFFTAG_FILLORDER, FILLORDER_MSB2LSB);
#else
TIFFSetField(tifPtr, TIFFTAG_FILLORDER, FILLORDER_LSB2MSB);
#endif
result = -1;
{
Blt_Pixel *srcRowPtr;
int destBitsSize;
int y;
unsigned char *destBits;
unsigned char *dp;
destBitsSize = srcPtr->width * srcPtr->height * sizeof(uint32);
destBits = (unsigned char *)_TIFFmalloc(destBitsSize);
if (destBits == NULL) {
TIFFError("tiff", "can't allocate space for TIF buffer");
TIFFClose(tifPtr);
return TCL_ERROR;
}
dp = destBits;
srcRowPtr = srcPtr->bits;
switch (samplesPerPixel) {
case 4:
for (y = 0; y < srcPtr->height; y++) {
Blt_Pixel *sp;
int x;
sp = srcRowPtr;
for (x = 0; x < srcPtr->width; x++) {
dp[0] = sp->Red;
dp[1] = sp->Green;
dp[2] = sp->Blue;
dp[3] = sp->Alpha;
dp += 4, sp++;
}
srcRowPtr += srcPtr->pixelsPerRow;
}
break;
case 3: /* RGB, 100% opaque image. */
for (y = 0; y < srcPtr->height; y++) {
Blt_Pixel *sp;
int x;
sp = srcRowPtr;
for (x = 0; x < srcPtr->width; x++) {
dp[0] = sp->Red;
dp[1] = sp->Green;
dp[2] = sp->Blue;
dp += 3, sp++;
}
srcRowPtr += srcPtr->pixelsPerRow;
}
break;
case 1:
for (y = 0; y < srcPtr->height; y++) {
Blt_Pixel *sp;
int x;
sp = srcRowPtr;
for (x = 0; x < srcPtr->width; x++) {
*dp++ = sp->Red;
sp++;
}
srcRowPtr += srcPtr->pixelsPerRow;
}
break;
}
result = TIFFWriteEncodedStrip(tifPtr, 0, destBits, destBitsSize);
if (result < 0) {
Tcl_AppendResult(interp, "error writing TIFF encoded strip",
(char *)NULL);
}
_TIFFfree(destBits);
}
TIFFClose(tifPtr);
if (result == -1) {
Blt_DBuffer_Free(dbuffer);
}
TIFFSetErrorHandler(oldErrorHandler);
TIFFSetWarningHandler(oldWarningHandler);
if (message.nWarnings > 0) {
Tcl_SetErrorCode(interp, "PICTURE", "TIF_WRITE_WARNINGS",
Tcl_DStringValue(&message.warnings), (char *)NULL);
} else {
Tcl_SetErrorCode(interp, "NONE", (char *)NULL);
}
Tcl_DStringFree(&message.warnings);
if (message.nErrors > 0) {
Tcl_DStringResult(interp, &message.errors);
}
Tcl_DStringFree(&message.errors);
if (srcPtr != picture) {
Blt_FreePicture(srcPtr);
}
return (result == -1) ? TCL_ERROR : TCL_OK;
}
static int
elTclSignal(ClientData data, Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[])
{
ElTclInterpInfo *iinfo = data;
ElTclSignalContext *ctx;
sigset_t set, oset;
int i, signum;
char *action;
if (objc < 2 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv,
"signal ?script|-ignore|-default|-block|-unblock?");
return TCL_ERROR;
}
if (objc == 2 &&
!strcmp(Tcl_GetStringFromObj(objv[1], NULL), "names")) {
/* [signal names] */
Tcl_DString dstring;
Tcl_DStringInit(&dstring);
for(i=0; i<ELTCL_MAXSIG; i++) if (signalNames[i] != NULL) {
Tcl_DStringAppendElement(&dstring, signalNames[i]);
}
Tcl_DStringResult(interp, &dstring);
return TCL_OK;
}
/* objv[1] must be a signal name */
signum = -1;
for(i=0; i<ELTCL_MAXSIG; i++) if (signalNames[i] != NULL)
if (!strcmp(Tcl_GetStringFromObj(objv[1], NULL), signalNames[i])) {
signum = i;
break;
}
if (signum < 0) {
/* or an integer */
if (Tcl_GetIntFromObj(interp, objv[1], &signum) == TCL_ERROR)
return TCL_ERROR;
}
/* prepare the interpreter result so that this command returns the
* previous action for that signal */
ctx = getSignalContext(signum, iinfo);
if (ctx == NULL || ctx->script == ELTCL_SIGDFL) {
Tcl_SetResult(interp, "-default", TCL_STATIC);
} else if (ctx->script == ELTCL_SIGIGN) {
Tcl_SetResult(interp, "-ignore", TCL_STATIC);
} else {
Tcl_SetObjResult(interp, ctx->script);
}
/* if no action given, return current script associated with
* signal */
if (objc == 2) { return TCL_OK; }
/* get the given action */
action = Tcl_GetStringFromObj(objv[2], NULL);
/* check if signal should be reset to default */
if (!strcmp(action, "-default")) {
/* special case of SIGWINCH, which we must keep processing */
#ifdef SIGWINCH
if (signum != SIGWINCH)
#endif
if (signal(signum, SIG_DFL) == (void *)-1) goto error;
if (ctx == NULL) return TCL_OK;
if (ctx->script != ELTCL_SIGDFL && ctx->script != ELTCL_SIGIGN) {
Tcl_DecrRefCount(ctx->script);
Tcl_AsyncDelete(ctx->asyncH);
}
ctx->script = ELTCL_SIGDFL;
return TCL_OK;
}
/* check if signal should be ignored */
if (!strcmp(action, "-ignore")) {
if (ctx == NULL) {
ctx = createSignalContext(signum, iinfo);
if (ctx == NULL) goto error;
}
/* special case of SIGWINCH, which we must keep processing */
#ifdef SIGWINCH
if (signum != SIGWINCH)
#endif
if (signal(signum, SIG_IGN) == (void *)-1) goto error;
if (ctx->script != ELTCL_SIGDFL && ctx->script != ELTCL_SIGIGN) {
Tcl_DecrRefCount(ctx->script);
Tcl_AsyncDelete(ctx->asyncH);
}
ctx->script = ELTCL_SIGIGN;
return TCL_OK;
}
/* check if signal should be (un)blocked */
if (!strcmp(action, "-block") || !strcmp(action, "-unblock")) {
Tcl_DString dstring;
int code;
sigemptyset(&set);
sigemptyset(&oset);
sigaddset(&set, signum);
if (!strcmp(action, "-block"))
code = sigprocmask(SIG_BLOCK, &set, &oset);
else
code = sigprocmask(SIG_UNBLOCK, &set, &oset);
if (code) goto error;
/* return the previous mask */
Tcl_DStringInit(&dstring);
for(i=0; i<ELTCL_MAXSIG; i++) if (signalNames[i] != NULL) {
if (sigismember(&oset, i))
Tcl_DStringAppendElement(&dstring, signalNames[i]);
}
Tcl_DStringResult(interp, &dstring);
return TCL_OK;
}
/* a script was given: create async handler and register signal */
if (ctx == NULL) {
ctx = createSignalContext(signum, iinfo);
if (ctx == NULL) goto error;
}
/* block signal while installing handler */
sigemptyset(&set);
sigaddset(&set, signum);
if (sigprocmask(SIG_BLOCK, &set, &oset)) goto error;
#ifdef SIGWINCH
if (signum != SIGWINCH)
#endif
if (signal(signum, signalHandler) == (void *)-1) {
sigprocmask(SIG_SETMASK, &oset, NULL);
goto error;
}
if (ctx->script != ELTCL_SIGDFL && ctx->script != ELTCL_SIGIGN) {
Tcl_DecrRefCount(ctx->script);
Tcl_AsyncDelete(ctx->asyncH);
}
ctx->script = objv[2];
Tcl_IncrRefCount(ctx->script);
ctx->asyncH = Tcl_AsyncCreate(asyncSignalHandler, ctx);
sigprocmask(SIG_SETMASK, &oset, NULL);
return TCL_OK;
error:
Tcl_SetResult(interp, (char *)Tcl_ErrnoMsg(errno), TCL_VOLATILE);
Tcl_SetErrno(errno);
Tcl_PosixError(interp);
return TCL_ERROR;
}
int
rt_binunif_tclget(Tcl_Interp *interp, const struct rt_db_internal *intern, const char *attr )
{
register struct rt_binunif_internal *bip=(struct rt_binunif_internal *)intern->idb_ptr;
struct bu_external ext;
Tcl_DString ds;
struct bu_vls vls;
int status=TCL_OK;
int i;
unsigned char *c;
RT_CHECK_BINUNIF( bip );
Tcl_DStringInit( &ds );
bu_vls_init( &vls );
if ( attr == (char *)NULL )
{
/* export the object to get machine independent form */
if ( rt_binunif_export5( &ext, intern, 1.0, NULL, NULL, intern->idb_minor_type ) ) {
bu_vls_strcpy( &vls, "Failed to export binary object!!\n" );
status = TCL_ERROR;
} else {
bu_vls_strcpy( &vls, "binunif" );
bu_vls_printf( &vls, " T %d D {", bip->type );
c = ext.ext_buf;
for ( i=0; i<ext.ext_nbytes; i++, c++ ) {
if ( i%40 == 0 ) bu_vls_strcat( &vls, "\n" );
bu_vls_printf( &vls, "%2.2x", *c );
}
bu_vls_strcat( &vls, "}" );
bu_free_external( &ext );
}
} else {
if ( !strcmp( attr, "T" ) ) {
bu_vls_printf( &vls, "%d", bip->type );
} else if ( !strcmp( attr, "D" ) ) {
/* export the object to get machine independent form */
if ( rt_binunif_export5( &ext, intern, 1.0, NULL, NULL,
intern->idb_minor_type ) ) {
bu_vls_strcpy( &vls, "Failed to export binary object!!\n" );
status = TCL_ERROR;
} else {
c = ext.ext_buf;
for ( i=0; i<ext.ext_nbytes; i++, c++ ) {
if ( i != 0 && i%40 == 0 ) bu_vls_strcat( &vls, "\n" );
bu_vls_printf( &vls, "%2.2x", *c );
}
bu_free_external( &ext );
}
} else {
bu_vls_printf( &vls, "Binary object has no attribute '%s'", attr );
status = TCL_ERROR;
}
}
Tcl_DStringAppend( &ds, bu_vls_addr( &vls ), -1 );
Tcl_DStringResult( interp, &ds );
Tcl_DStringFree( &ds );
bu_vls_free( &vls );
return( status );
}
int cmd_tcl_cswfibc(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) {
char pathToCatalog[STRING_COMMON_LENGTH];
double ra = 0.;
double dec = 0.;
double radius = 0.;
double magMin = 0.;
double magMax = 0.;
int indexOfZone;
int numberOfZones;
char fileName[1024];
FILE* offsetFileStream;
searchZoneWfibc mySearchZoneWfibc;
raZone* raZones;
Tcl_DString dsptr;
/* Decode inputs */
if(decodeInputs(outputLogChar, argc, argv, pathToCatalog, &ra, &dec, &radius, &magMin, &magMax)) {
Tcl_SetResult(interp,outputLogChar,TCL_VOLATILE);
return (TCL_ERROR);
}
/* Define search zone */
mySearchZoneWfibc = findSearchZoneWfibc(ra,dec,radius,magMin,magMax);
/* Read the accelerator file */
numberOfZones = (int)((RA_END - RA_START) / RA_STEP) + 1;
raZones = readAcceleratorFileWfbic(pathToCatalog,numberOfZones);
if(raZones == NULL) {
Tcl_SetResult(interp,outputLogChar,TCL_VOLATILE);
return (TCL_ERROR);
}
/* Open the offset file */
sprintf(fileName,"%s%s",pathToCatalog,OFFSET_TABLE);
offsetFileStream = fopen(fileName,"rt");
if(offsetFileStream == NULL) {
sprintf(outputLogChar,"File %s not found\n",fileName);
Tcl_SetResult(interp,outputLogChar,TCL_VOLATILE);
free(raZones);
return (TCL_ERROR);
}
/* Now we loop over the concerned catalog and send to TCL the results */
Tcl_DStringInit(&dsptr);
Tcl_DStringAppend(&dsptr,"{ { WFIBC { } { RA_deg DEC_deg error_AlphaCosDelta error_Delta JD PM_AlphaCosDelta PM_Delta error_PM_AlphaCosDelta"
" error_PM_Delta magR error_magR} } } ",-1);
/* start of main list */
Tcl_DStringAppend(&dsptr,"{ ",-1);
if(mySearchZoneWfibc.subSearchZone.isArroundZeroRa) {
for(indexOfZone = mySearchZoneWfibc.indexOfFirstRightAscensionZone; indexOfZone < numberOfZones; indexOfZone++) {
if(processOneZone(&dsptr,offsetFileStream,&(raZones[indexOfZone]),&mySearchZoneWfibc,pathToCatalog)) {
Tcl_SetResult(interp,outputLogChar,TCL_VOLATILE);
free(raZones);
fclose(offsetFileStream);
return (TCL_ERROR);
}
}
for(indexOfZone = 0; indexOfZone <= mySearchZoneWfibc.indexOfLastRightAscensionZone; indexOfZone++) {
if(processOneZone(&dsptr,offsetFileStream,&(raZones[indexOfZone]),&mySearchZoneWfibc,pathToCatalog)) {
Tcl_SetResult(interp,outputLogChar,TCL_VOLATILE);
free(raZones);
fclose(offsetFileStream);
return (TCL_ERROR);
}
}
} else {
for(indexOfZone = mySearchZoneWfibc.indexOfFirstRightAscensionZone; indexOfZone <= mySearchZoneWfibc.indexOfLastRightAscensionZone; indexOfZone++) {
if(processOneZone(&dsptr,offsetFileStream,&(raZones[indexOfZone]),&mySearchZoneWfibc,pathToCatalog)) {
Tcl_SetResult(interp,outputLogChar,TCL_VOLATILE);
free(raZones);
fclose(offsetFileStream);
return (TCL_ERROR);
}
}
}
/* end of sources list */
Tcl_DStringAppend(&dsptr,"}",-1);
Tcl_DStringResult(interp,&dsptr);
Tcl_DStringFree(&dsptr);
fclose(offsetFileStream);
free(raZones);
return (TCL_OK);
}
int
Tk_ClipboardObjCmd(
ClientData clientData, /* Main window associated with interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
{
Tk_Window tkwin = (Tk_Window) clientData;
const char *path = NULL;
Atom selection;
static const char *const optionStrings[] = { "append", "clear", "get", NULL };
enum options { CLIPBOARD_APPEND, CLIPBOARD_CLEAR, CLIPBOARD_GET };
int index, i;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
&index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
case CLIPBOARD_APPEND: {
Atom target, format;
const char *targetName = NULL;
const char *formatName = NULL;
const char *string;
static const char *const appendOptionStrings[] = {
"-displayof", "-format", "-type", NULL
};
enum appendOptions { APPEND_DISPLAYOF, APPEND_FORMAT, APPEND_TYPE };
int subIndex, length;
for (i = 2; i < objc - 1; i++) {
string = Tcl_GetStringFromObj(objv[i], &length);
if (string[0] != '-') {
break;
}
/*
* If the argument is "--", it signifies the end of arguments.
*/
if (string[1] == '-' && length == 2) {
i++;
break;
}
if (Tcl_GetIndexFromObj(interp, objv[i], appendOptionStrings,
"option", 0, &subIndex) != TCL_OK) {
return TCL_ERROR;
}
/*
* Increment i so that it points to the value for the flag instead
* of the flag itself.
*/
i++;
if (i >= objc) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
switch ((enum appendOptions) subIndex) {
case APPEND_DISPLAYOF:
path = Tcl_GetString(objv[i]);
break;
case APPEND_FORMAT:
formatName = Tcl_GetString(objv[i]);
break;
case APPEND_TYPE:
targetName = Tcl_GetString(objv[i]);
break;
}
}
if (objc - i != 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...? data");
return TCL_ERROR;
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
if (targetName != NULL) {
target = Tk_InternAtom(tkwin, targetName);
} else {
target = XA_STRING;
}
if (formatName != NULL) {
format = Tk_InternAtom(tkwin, formatName);
} else {
format = XA_STRING;
}
return Tk_ClipboardAppend(interp, tkwin, target, format,
Tcl_GetString(objv[i]));
}
case CLIPBOARD_CLEAR: {
static const char *const clearOptionStrings[] = { "-displayof", NULL };
enum clearOptions { CLEAR_DISPLAYOF };
int subIndex;
if (objc != 2 && objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
return TCL_ERROR;
}
if (objc == 4) {
if (Tcl_GetIndexFromObj(interp, objv[2], clearOptionStrings,
"option", 0, &subIndex) != TCL_OK) {
return TCL_ERROR;
}
if ((enum clearOptions) subIndex == CLEAR_DISPLAYOF) {
path = Tcl_GetString(objv[3]);
}
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
return Tk_ClipboardClear(interp, tkwin);
}
case CLIPBOARD_GET: {
Atom target;
const char *targetName = NULL;
Tcl_DString selBytes;
int result;
const char *string;
static const char *const getOptionStrings[] = {
"-displayof", "-type", NULL
};
enum getOptions { APPEND_DISPLAYOF, APPEND_TYPE };
int subIndex;
for (i = 2; i < objc; i++) {
string = Tcl_GetString(objv[i]);
if (string[0] != '-') {
break;
}
if (Tcl_GetIndexFromObj(interp, objv[i], getOptionStrings,
"option", 0, &subIndex) != TCL_OK) {
return TCL_ERROR;
}
i++;
if (i >= objc) {
Tcl_AppendResult(interp, "value for \"", string,
"\" missing", NULL);
return TCL_ERROR;
}
switch ((enum getOptions) subIndex) {
case APPEND_DISPLAYOF:
path = Tcl_GetString(objv[i]);
break;
case APPEND_TYPE:
targetName = Tcl_GetString(objv[i]);
break;
}
}
if (path != NULL) {
tkwin = Tk_NameToWindow(interp, path, tkwin);
}
if (tkwin == NULL) {
return TCL_ERROR;
}
selection = Tk_InternAtom(tkwin, "CLIPBOARD");
if (objc - i > 1) {
Tcl_WrongNumArgs(interp, 2, objv, "?-option value ...?");
return TCL_ERROR;
} else if (objc - i == 1) {
target = Tk_InternAtom(tkwin, Tcl_GetString(objv[i]));
} else if (targetName != NULL) {
target = Tk_InternAtom(tkwin, targetName);
} else {
target = XA_STRING;
}
Tcl_DStringInit(&selBytes);
result = Tk_GetSelection(interp, tkwin, selection, target,
ClipboardGetProc, &selBytes);
if (result == TCL_OK) {
Tcl_DStringResult(interp, &selBytes);
} else {
Tcl_DStringFree(&selBytes);
}
return result;
}
}
return TCL_OK;
}
int
NsTclServerObjCmd(ClientData arg, Tcl_Interp *interp, int objc,
Tcl_Obj **objv)
{
Pool *poolPtr;
char buf[100], *pool;
Tcl_DString ds;
static CONST char *opts[] = {
"active", "all", "connections", "keepalive", "pools", "queued",
"threads", "waiting", NULL,
};
enum {
SActiveIdx, SAllIdx, SConnectionsIdx, SKeepaliveIdx, SPoolsIdx,
SQueuedIdx, SThreadsIdx, SWaitingIdx,
} _nsmayalias opt;
if (objc != 2 && objc != 3) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?pool?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0,
(int *) &opt) != TCL_OK) {
return TCL_ERROR;
}
if (opt == SPoolsIdx) {
return NsTclListPoolsObjCmd(arg, interp, objc, objv);
}
if (objc == 2) {
pool = "default";
} else {
pool = Tcl_GetString(objv[2]);
}
if (NsTclGetPool(interp, pool, &poolPtr) != TCL_OK) {
return TCL_ERROR;
}
Ns_MutexLock(&poolPtr->lock);
switch (opt) {
case SPoolsIdx:
/* NB: Silence compiler. */
break;
case SWaitingIdx:
Tcl_SetObjResult(interp, Tcl_NewIntObj(poolPtr->queue.wait.num));
break;
case SKeepaliveIdx:
Tcl_SetObjResult(interp, Tcl_NewIntObj(0/*nsconf.keepalive.npending*/));
break;
case SConnectionsIdx:
Tcl_SetObjResult(interp, Tcl_NewIntObj((int) poolPtr->threads.nextid));
break;
case SThreadsIdx:
sprintf(buf, "min %d", poolPtr->threads.min);
Tcl_AppendElement(interp, buf);
sprintf(buf, "max %d", poolPtr->threads.max);
Tcl_AppendElement(interp, buf);
sprintf(buf, "current %d", poolPtr->threads.current);
Tcl_AppendElement(interp, buf);
sprintf(buf, "idle %d", poolPtr->threads.idle);
Tcl_AppendElement(interp, buf);
sprintf(buf, "stopping 0");
Tcl_AppendElement(interp, buf);
break;
case SActiveIdx:
case SQueuedIdx:
case SAllIdx:
Tcl_DStringInit(&ds);
if (opt != SQueuedIdx) {
AppendConnList(&ds, poolPtr->queue.active.firstPtr, "running");
}
if (opt != SActiveIdx) {
AppendConnList(&ds, poolPtr->queue.wait.firstPtr, "queued");
}
Tcl_DStringResult(interp, &ds);
}
Ns_MutexUnlock(&poolPtr->lock);
return TCL_OK;
}
int cmd_tcl_csucac2(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) {
int resultOfFunction;
int counterDec;
int counterRa;
int idOfStar;
char pathToCatalog[STRING_COMMON_LENGTH];
double ra = 0.;
double dec = 0.;
double radius = 0.;
double magMin = 0.;
double magMax = 0.;
indexTableUcac** indexTable;
starUcac2 oneStar;
searchZoneUcac2 mySearchZoneUcac2;
arrayTwoDOfStarUcac2 unFilteredStars;
arrayOneDOfStarUcac2 oneSetOfStar;
starUcac2* allStars;
Tcl_DString dsptr;
/* Decode inputs */
if(decodeInputs(outputLogChar, argc, argv, pathToCatalog, &ra, &dec, &radius, &magMin, &magMax)) {
Tcl_SetResult(interp,outputLogChar,TCL_VOLATILE);
return (TCL_ERROR);
}
/* Define search zone */
mySearchZoneUcac2 = findSearchZoneUcac2(ra,dec,radius,magMin,magMax);
/* Read the index file */
indexTable = readIndexFileUcac2(pathToCatalog);
if(indexTable == NULL) {
Tcl_SetResult(interp,outputLogChar,TCL_VOLATILE);
return (TCL_ERROR);
}
/* Now read the catalog and retrieve stars */
resultOfFunction = retrieveUnfilteredStarsUcac2(pathToCatalog,&mySearchZoneUcac2,indexTable,&unFilteredStars);
if(resultOfFunction) {
releaseDoubleArray((void**)indexTable, INDEX_TABLE_DEC_DIMENSION_UCAC2AND3);
Tcl_SetResult(interp,outputLogChar,TCL_VOLATILE);
return (TCL_ERROR);
}
/* Print the filtered stars */
Tcl_DStringInit(&dsptr);
Tcl_DStringAppend(&dsptr,"{ { UCAC2 { } "
"{ ID ra_deg dec_deg U2Rmag_mag e_RAm_deg e_DEm_deg nobs e_pos_deg ncat cflg "
"EpRAm_deg EpDEm_deg pmRA_masperyear pmDEC_masperyear e_pmRA_masperyear e_pmDE_masperyear "
"q_pmRA q_pmDE 2m_id 2m_J 2m_H 2m_Ks 2m_ph 2m_cc} } } ",-1);
Tcl_DStringAppend(&dsptr,"{",-1); // start of sources list
for(counterDec = 0; counterDec < unFilteredStars.length; counterDec++) {
oneSetOfStar = unFilteredStars.arrayTwoD[counterDec];
allStars = oneSetOfStar.arrayOneD;
idOfStar = oneSetOfStar.idOfFirstStarInArray;
for(counterRa = 0; counterRa < oneSetOfStar.length; counterRa++) {
idOfStar++;
oneStar = allStars[counterRa];
if(isGoodStarUcac2(&oneStar,&mySearchZoneUcac2)) {
Tcl_DStringAppend(&dsptr,"{ { UCAC2 { } {",-1);
sprintf(outputLogChar,
"%d %.8f %+.8f %.3f %.8f %.8f %d %.8f %d %d "
"%.8f %.8f %.8f %.8f %.8f %.8f "
"%.5f %.5f %d %.3f %.3f %.3f %d %d",
idOfStar,
(double)oneStar.raInMas / DEG2MAS,
(double)oneStar.decInMas / DEG2MAS,
(double)oneStar.ucacMagInCentiMag / MAG2CENTIMAG,
(double)oneStar.errorRaInMas / DEG2MAS,
(double)oneStar.errorDecInMas / DEG2MAS,
oneStar.numberOfObservations,
(double)oneStar.errorOnUcacPositionInMas / DEG2MAS,
oneStar.numberOfCatalogsForPosition,
oneStar.majorCatalogIdForPosition,
(double)oneStar.centralEpochForMeanRaInMas / DEG2MAS,
(double)oneStar.centralEpochForMeanDecInMas / DEG2MAS,
(double)oneStar.raProperMotionInOneTenthMasPerYear / 10.,
(double)oneStar.decProperMotionInOneTenthMasPerYear / 10.,
(double)oneStar.errorOnRaProperMotionInOneTenthMasPerYear / 10.,
(double)oneStar.errorOnDecProperMotionInOneTenthMasPerYear / 10.,
(double)oneStar.raProperMotionGoodnessOfFit * 0.05,
(double)oneStar.decProperMotionGoodnessOfFit * 0.05,
oneStar.idFrom2Mass,
(double)oneStar.jMagnitude2MassInMilliMag / MAG2MILLIMAG,
(double)oneStar.hMagnitude2MassInMilliMag / MAG2MILLIMAG,
(double)oneStar.kMagnitude2MassInMilliMag / MAG2MILLIMAG,
oneStar.qualityFlag2Mass,
oneStar.ccFlag2Mass);
Tcl_DStringAppend(&dsptr,outputLogChar,-1);
Tcl_DStringAppend(&dsptr,"} } } ",-1);
}
}
}
Tcl_DStringAppend(&dsptr,"}",-1); // end of main list
Tcl_DStringResult(interp,&dsptr);
Tcl_DStringFree(&dsptr);
/* Release the memory */
releaseDoubleArray((void**)indexTable, INDEX_TABLE_DEC_DIMENSION_UCAC2AND3);
releaseMemoryArrayTwoDOfStarUcac2(&unFilteredStars);
return (TCL_OK);
}