c4_View MkView::View(Tcl_Interp *interp, Tcl_Obj *obj) { const char *name = Tcl_GetStringFromObj(obj, 0); Tcl_CmdInfo ci; if (!Tcl_GetCommandInfo(interp, (char*)name, &ci) || ci.objProc != MkView ::Dispatcher) { //Fail("no such view"); c4_View temp; return temp; } else { MkView *v = (MkView*)ci.objClientData; return v->view; } }
void TclpInitLibraryPath( char **valuePtr, int *lengthPtr, Tcl_Encoding *encodingPtr) { #define LIBRARY_SIZE 64 Tcl_Obj *pathPtr; char installLib[LIBRARY_SIZE]; char *bytes; pathPtr = Tcl_NewObj(); /* * Initialize the substring used when locating the script library. The * installLib variable computes the script library path relative to the * installed DLL. */ sprintf(installLib, "lib/tcl%s", TCL_VERSION); /* * Look for the library relative to the TCL_LIBRARY env variable. If the * last dirname in the TCL_LIBRARY path does not match the last dirname in * the installLib variable, use the last dir name of installLib in * addition to the orginal TCL_LIBRARY path. */ AppendEnvironment(pathPtr, installLib); /* * Look for the library in its default location. */ Tcl_ListObjAppendElement(NULL, pathPtr, TclGetProcessGlobalValue(&defaultLibraryDir)); /* * Look for the library in its source checkout location. */ Tcl_ListObjAppendElement(NULL, pathPtr, TclGetProcessGlobalValue(&sourceLibraryDir)); *encodingPtr = NULL; bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr); *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1); memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1); Tcl_DecrRefCount(pathPtr); }
void ObjToSqliteContextValue(Tcl_Obj *objP, sqlite3_context *sqlctxP) { unsigned char *data; int len; if (objP->typePtr) { /* * Note there is no return code checking here. Once the typePtr * is checked, the corresponding Tcl_Get* function should * always succeed. */ if (objP->typePtr == gTclStringTypeP) { /* * Do nothing, fall thru below to handle as default type. * This check is here just so the most common case of text * columns does not needlessly go through other type checks. */ } else if (objP->typePtr == gTclIntTypeP) { int ival; Tcl_GetIntFromObj(NULL, objP, &ival); sqlite3_result_int(sqlctxP, ival); return; } else if (objP->typePtr == gTclWideIntTypeP) { Tcl_WideInt i64val; Tcl_GetWideIntFromObj(NULL, objP, &i64val); sqlite3_result_int64(sqlctxP, i64val); return; } else if (objP->typePtr == gTclDoubleTypeP) { double dval; Tcl_GetDoubleFromObj(NULL, objP, &dval); sqlite3_result_double(sqlctxP, dval); return; } else if (objP->typePtr == gTclBooleanTypeP || objP->typePtr == gTclBooleanStringTypeP) { int bval; Tcl_GetBooleanFromObj(NULL, objP, &bval); sqlite3_result_int(sqlctxP, bval); return; } else if (objP->typePtr == gTclByteArrayTypeP) { /* TBD */ data = Tcl_GetByteArrayFromObj(objP, &len); sqlite3_result_blob(sqlctxP, data, len, SQLITE_TRANSIENT); return; } } /* Handle everything else as text by default */ data = (unsigned char *)Tcl_GetStringFromObj(objP, &len); sqlite3_result_text(sqlctxP, data, len, SQLITE_TRANSIENT); }
/* convert to a string from a var */ Tcl_DString* TSP_Util_lang_convert_string_var(Tcl_DString* targetVarName, Tcl_Obj* sourceVarName) { char* str; int len; if (targetVarName != NULL) { Tcl_DStringSetLength(targetVarName, 0); } else { targetVarName = (Tcl_DString*) ckalloc(sizeof(Tcl_DString));; Tcl_DStringInit(targetVarName); } str = Tcl_GetStringFromObj(sourceVarName, &len); Tcl_DStringAppend(targetVarName, str, len); return targetVarName; }
void TclVerifyLocalLiteralTable( CompileEnv *envPtr) /* Points to CompileEnv whose literal table is * to be validated. */ { register LiteralTable *localTablePtr = &(envPtr->localLitTable); register LiteralEntry *localPtr; char *bytes; register int i; int length, count; count = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; if (localPtr->refCount != -1) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" had bad refCount %d", (length>60? 60 : length), bytes, localPtr->refCount); } if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, localPtr->objPtr) == NULL) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); Tcl_Panic("TclVerifyLocalLiteralTable: local literal \"%.*s\" is not global", (length>60? 60 : length), bytes); } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("TclVerifyLocalLiteralTable: literal has NULL string rep"); } } } if (count != localTablePtr->numEntries) { Tcl_Panic("TclVerifyLocalLiteralTable: local literal table had %d entries, should be %d", count, localTablePtr->numEntries); } }
void remove_region_attrs(Tcl_Obj *obj) { int len = 0; Tcl_Obj **objs; char *key; int i, j; int found_material = 0; if (Tcl_ListObjGetElements(INTERP, obj, &len, &objs) != TCL_OK) { fprintf(stderr, "Cannot get length of attributes for %s\n", Tcl_GetStringFromObj(obj, NULL)); bu_exit(1, NULL); } if (len == 0) return; for (i=len-1; i>0; i -= 2) { key = Tcl_GetStringFromObj(objs[i-1], NULL); j = 0; while (region_attrs[j]) { if (BU_STR_EQUAL(key, region_attrs[j])) { Tcl_ListObjReplace(INTERP, obj, i-1, 2, 0, NULL); break; } j++; } if (!found_material && BU_STR_EQUAL(key, "material")) { found_material = 1; if (!bu_strncmp(Tcl_GetStringFromObj(objs[i], NULL), "gift", 4)) { Tcl_ListObjReplace(INTERP, obj, i-1, 2, 0, NULL); } } } }
ClientData TclNativeCreateNativeRep( Tcl_Obj *pathPtr) { char *nativePathPtr; Tcl_DString ds; Tcl_Obj *validPathPtr; int len; char *str; 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 = Tcl_GetStringFromObj(validPathPtr, &len); 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((unsigned) len); memcpy((void*)nativePathPtr, (void*)Tcl_DStringValue(&ds), (size_t) len); Tcl_DStringFree(&ds); return (ClientData)nativePathPtr; }
/* * TclSwitchCompare * * Performs a partial string comparison for a single switch. This behavior * is consistent with Tcl commands that accept one switch argument, such * as 'string match' and 'string map'. * * Arguments: * objPtr - The string value of this object is compared against "name". * switchName - Full name of the switch. * * Returns: * If "name" and the string value of "objPtr" match partially or completely, * the return value is non-zero. If they do not match, the return value is zero. */ int TclSwitchCompare( Tcl_Obj *objPtr, const char *switchName ) { int optionLength; char *option = Tcl_GetStringFromObj(objPtr, &optionLength); /* * The user supplied switch must be at least two characters in * length, to account for the switch prefix and first letter. */ return (optionLength > 2 && strncmp(switchName, option, optionLength) == 0); }
int TnmGetPositiveFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr) { int code; code = Tcl_GetIntFromObj(interp, objPtr, intPtr); if (code != TCL_OK || *intPtr < 1) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "expected positive integer but got \"", Tcl_GetStringFromObj(objPtr, NULL), "\"", (char *) NULL); return TCL_ERROR; } return TCL_OK; }
static void CloseLibraryResource() { if (ourResFile != kResFileNotOpened) { #ifdef TCL_REGISTER_LIBRARY int length; TclMacUnRegisterResourceFork( Tcl_GetStringFromObj(ourResToken, &length), NULL); Tcl_DecrRefCount(ourResToken); #endif CloseResFile(ourResFile); ourResFile = kResFileNotOpened; } }
static int LiquidValidate_Command(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { // * Check the number of arguments if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "<templates> <root template>"); return TCL_ERROR; } // Parse the data into a file system TclLiquid::FileSystem fileSystem(interp, objv[1]); // Get the template name const char* templateNameChars = Tcl_GetStringFromObj(objv[2], NULL); std::string templateName(templateNameChars); // Try to get the template source std::string templateSource; if (!fileSystem.TryFind(templateName, templateSource)) LiquidError(LiquidDataError, "Template not found in template list"); // Try to parse the template Liquid::ParserError parserError; Liquid::RenderError renderError; Liquid::Strainer strainer; Liquid::Template* templ = Liquid::Template::Parse(templateSource, strainer, parserError); if (!templ) { // Set the error std::stringstream errorStream; errorStream << parserError; LiquidError(LiquidParseError, errorStream.str().c_str()); } // Clean up the data. delete templ; return TCL_OK; }
int TnmGetTableKeyFromObj(Tcl_Interp *interp, TnmTable *table, Tcl_Obj *objPtr, char *what) { char *name; int value; name = Tcl_GetStringFromObj(objPtr, NULL); value = TnmGetTableKey(table, name); if (value == -1 && interp) { Tcl_ResetResult(interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown ", what, " \"", name, "\": should be ", TnmGetTableValues(table), (char *) NULL); } return value; }
/* string must be used immediately */ Tcl_DString* TSP_Util_lang_get_string_var(Tcl_Obj* sourceVarName) { static int doInit = 1; static Tcl_DString ds; int len; char* str; if (doInit) { Tcl_DStringInit(&ds); doInit = 0; } else { Tcl_DStringSetLength(&ds, 0); } str = Tcl_GetStringFromObj(sourceVarName, &len); Tcl_DStringAppend(&ds, str, len); return &ds; }
/************************************************************************* * FUNCTION : RPMPRoblem_Obj::Get_stringrep * * ARGUMENTS : none * * RETURNS : Tcl_Alloc'ed string rep of an object * * EXCEPTIONS : none * * PURPOSE : Return the string rep of an RPM header * *************************************************************************/ char *RPMPRoblem_Obj::Get_stringrep(int &len) { // Get our parts as a TCL list Tcl_Obj *name = Get_parts(); Tcl_IncrRefCount(name); // we must return dynamaically allocated space, so allocate that int size = 0; char *from = Tcl_GetStringFromObj(name,&size); char *space = Tcl_Alloc(size+1); assert(space); strncpy(space,from,size); space[size] = 0; Tcl_DecrRefCount(name); len = size; return space; }
static int GroupCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { TnmMapItem *itemPtr = (TnmMapItem *) clientData; int result = TnmMapItemObjCmd(itemPtr, interp, objc, objv); if (result == TCL_CONTINUE) { Tcl_AppendResult(interp, "bad option \"", Tcl_GetStringFromObj(objv[1], NULL), "\": should be ", (char *) NULL); TnmMapItemCmdList(itemPtr, interp); result = TCL_ERROR; } return result; }
unsigned TclUtils::getUInt(Tcl_Interp *interp, Tcl_Obj *objPtr) { long ret; if ( TCL_OK != Tcl_GetLongFromObj(interp, objPtr, &ret) || ret < std::numeric_limits<unsigned>::min() || ret > std::numeric_limits<unsigned>::max()) { std::string msg("expected unsigned integer but got \""); msg += Tcl_GetStringFromObj(objPtr, NULL); msg += "\""; throw wrong_args_value_exception(msg.c_str()); } return static_cast<unsigned>(ret); }
/* ** Register an EvalEvent to evaluate the script pScript in the ** parent interpreter/thread of SqlThread p. */ static void postToParent(SqlThread *p, Tcl_Obj *pScript){ EvalEvent *pEvent; char *zMsg; int nMsg; zMsg = Tcl_GetStringFromObj(pScript, &nMsg); pEvent = (EvalEvent *)ckalloc(sizeof(EvalEvent)+nMsg+1); pEvent->base.nextPtr = 0; pEvent->base.proc = tclScriptEvent; pEvent->zScript = (char *)&pEvent[1]; memcpy(pEvent->zScript, zMsg, nMsg+1); pEvent->interp = p->interp; Tcl_ThreadQueueEvent(p->parent, (Tcl_Event *)pEvent, TCL_QUEUE_TAIL); Tcl_ThreadAlert(p->parent); }
int ngx_http_tcl_getv_cmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { ngx_http_request_t *r = getrequest(clientData); ngx_http_variable_value_t *vv; Tcl_Obj *varObj; ngx_str_t varname; int rc; int len; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "varname ?default?"); return TCL_ERROR; } varObj = objv[1]; /* TODO: check return */ rc = SetVarFromAny(interp, varObj); if (rc != TCL_OK) { return rc; } Tcl_GetStringFromObj(varObj, &len); varname.len = len; varname.data = (u_char*)varObj->internalRep.ptrAndLongRep.ptr; vv = ngx_http_get_variable(r, &varname, vartype_get_hash(varObj)); if (vv->not_found) { if (objc == 3) { Tcl_SetObjResult(interp, objv[2]); return TCL_OK; } Tcl_ResetResult(interp); Tcl_AppendResult(interp, "variable \"", Tcl_GetString(varObj), "\" doesn't exist", NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewStringObj((char*)vv->data, vv->len)); return TCL_OK; }
static char* proxenet_tcl_execute_function(interpreter_t* interpreter, request_t *request) { char *buf, *uri; Tcl_Interp* tcl_interpreter; Tcl_Obj* tcl_cmds_ptr; size_t len; int i; uri = request->http_infos.uri; if (!uri) return NULL; tcl_interpreter = (Tcl_Interp*) interpreter->vm; /* create the list of commands to be executed by TCL interpreter */ tcl_cmds_ptr = Tcl_NewListObj (0, NULL); Tcl_IncrRefCount(tcl_cmds_ptr); if (request->type == REQUEST) Tcl_ListObjAppendElement(tcl_interpreter, tcl_cmds_ptr, Tcl_NewStringObj(CFG_REQUEST_PLUGIN_FUNCTION, -1)); else Tcl_ListObjAppendElement(tcl_interpreter, tcl_cmds_ptr, Tcl_NewStringObj(CFG_RESPONSE_PLUGIN_FUNCTION, -1)); /* pushing arguments */ Tcl_ListObjAppendElement(tcl_interpreter, tcl_cmds_ptr, Tcl_NewIntObj(request->id)); Tcl_ListObjAppendElement(tcl_interpreter, tcl_cmds_ptr, Tcl_NewStringObj(request->data, request->size)); Tcl_ListObjAppendElement(tcl_interpreter, tcl_cmds_ptr, Tcl_NewStringObj(uri, -1)); /* execute the commands */ if (Tcl_EvalObjEx(tcl_interpreter, tcl_cmds_ptr, TCL_EVAL_DIRECT) != TCL_OK) { return NULL; } /* get the result */ Tcl_DecrRefCount(tcl_cmds_ptr); buf = Tcl_GetStringFromObj( Tcl_GetObjResult(tcl_interpreter), &i); if (!buf || i<=0) return NULL; len = (size_t)i; buf = proxenet_xstrdup(buf, len); if (!buf) return NULL; request->size = len; return buf; }
static AP_Result tcl_coerce_atom(AP_World *w, AP_Obj interp_name, AP_Obj item, AP_Obj atom) { Tcl_Interp *interp; AP_Obj result; interp = GetInterp(w, interp_name); if (!interp) return AP_EXCEPTION; if (AP_ObjType(w, item) == AP_ATOM) result = item; else { Tcl_Obj *tcl_obj = PrologToTclObj(w, item, interp); result = AP_NewUIAFromStr(w, Tcl_GetStringFromObj(tcl_obj, NULL)); Tcl_DecrRefCount(tcl_obj); } return AP_Unify(w, result, atom); }
void TnmListFromList(Tcl_Obj *objPtr, Tcl_Obj *listPtr, char *pattern) { int i, objc, code; Tcl_Obj **objv; code = Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv); if (code != TCL_OK) return; for (i = 0; i < objc; i++) { char *s = Tcl_GetStringFromObj(objv[i], NULL); if (pattern && !Tcl_StringMatch(s, pattern)) { continue; } Tcl_ListObjAppendElement((Tcl_Interp *) NULL, listPtr, objv[i]); } }
int MatrixSetOption( ClientData clientData, Tcl_Interp *interp, /* Current interp; may be used for errors. */ Tk_Window tkwin, /* Window for which option is being set. */ Tcl_Obj **value, /* Pointer to the pointer to the value object. * We use a pointer to the pointer because * we may need to return a value (NULL). */ char *recordPtr, /* Pointer to storage for the widget record. */ int internalOffset, /* Offset within *recordPtr at which the internal value is to be stored. */ char *oldInternalPtr, /* Pointer to storage for the old value. */ int flags) /* Flags for the option, set Tk_SetOptions. */ { char *internalPtr; /* Points to location in record where * internal representation of value should * be stored, or NULL. */ char *list; int length; Tcl_Obj *valuePtr; TMatrix *newPtr; valuePtr = *value; if (internalOffset >= 0) { internalPtr = recordPtr + internalOffset; } else { internalPtr = NULL; } if ((flags & TK_OPTION_NULL_OK) && ObjectIsEmpty(valuePtr)) { valuePtr = NULL; } if (internalPtr != NULL) { if (valuePtr != NULL) { list = Tcl_GetStringFromObj(valuePtr, &length); newPtr = (TMatrix *) ckalloc(sizeof(TMatrix)); if (PathGetTMatrix(interp, list, newPtr) != TCL_OK) { ckfree((char *) newPtr); return TCL_ERROR; } } else { newPtr = NULL; } *((TMatrix **) oldInternalPtr) = *((TMatrix **) internalPtr); *((TMatrix **) internalPtr) = newPtr; } return TCL_OK; }
int TnmGetIntRangeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int min, int max, int *intPtr) { int code; char buffer[40]; code = Tcl_GetIntFromObj(interp, objPtr, intPtr); if (code != TCL_OK || *intPtr < min || *intPtr > max) { Tcl_ResetResult(interp); sprintf(buffer, "%d and %d", min, max); Tcl_AppendResult(interp, "expected integer between ", buffer, " but got \"", Tcl_GetStringFromObj(objPtr, NULL), "\"", (char *) NULL); return TCL_ERROR; } return TCL_OK; }
SEXP RTcl_StringFromObj(SEXP args) { char *str; SEXP so; char *s; Tcl_DString s_ds; Tcl_Obj *obj; obj = (Tcl_Obj *) R_ExternalPtrAddr(CADR(args)); if (!obj) error(_("invalid tclObj -- perhaps saved from another session?")); Tcl_DStringInit(&s_ds); str = Tcl_GetStringFromObj(obj, NULL); /* FIXME: could use UTF-8 here */ s = Tcl_UtfToExternalDString(NULL, str, -1, &s_ds); so = mkString(s); Tcl_DStringFree(&s_ds); return(so); }
static int SetOp(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Tk_Window tkwin = clientData; int buffer; char *string; int length; buffer = 0; if (objc == 4) { if (GetCutNumberFromObj(interp, objv[3], &buffer) != TCL_OK) { return TCL_ERROR; } } string = Tcl_GetStringFromObj(objv[2], &length); XStoreBuffer(Tk_Display(tkwin), string, length + 1, buffer); return TCL_OK; }
void TnmSnmpAuthOutMsg(int algorithm, Tcl_Obj *authKey, u_char *msg, int msgLen, u_char *msgAuthenticationParameters) { char *keyBytes; int keyLen; keyBytes = Tcl_GetStringFromObj(authKey, &keyLen); switch (algorithm) { case TNM_SNMP_AUTH_MD5: if (keyLen != 16) { Tcl_Panic("illegal length of the MD5 authentication key"); } MD5AuthOutMsg(keyBytes, msg, msgLen, msgAuthenticationParameters); break; default: Tcl_Panic("unknown authentication algorithm"); } }
std::vector<std::string> TclUtils::getStringVector(Tcl_Interp *interp, Tcl_Obj *objPtr) { int length; int rc = Tcl_ListObjLength(interp, objPtr, &length); if (TCL_OK != rc) { throw wrong_args_value_exception(error_message::bad_list_argument); } std::vector<std::string> ret; for (int i = 0; i < length; ++i) { Tcl_Obj* v; rc = Tcl_ListObjIndex(interp, objPtr, i, &v); if (TCL_OK != rc) { throw wrong_args_value_exception(error_message::bad_list_argument); } ret.push_back(std::string(Tcl_GetStringFromObj(v, NULL))); } return ret; }
int TclGetPathFromObj( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_DString *buffer ) { char *path; int pathLenth; Tcl_Obj *translatedObj; assert(interp != NULL); assert(objPtr != NULL); assert(buffer != NULL); translatedObj = Tcl_FSGetTranslatedPath(interp, objPtr); if (translatedObj == NULL) { return TCL_ERROR; } /* Create a dynamic string from the translated path. */ Tcl_DStringInit(buffer); path = Tcl_GetStringFromObj(translatedObj, &pathLenth); Tcl_DStringAppend(buffer, path, pathLenth); Tcl_DecrRefCount(translatedObj); #ifdef _WINDOWS { char *p = Tcl_DStringValue(buffer); /* Convert forward slashes to backslashes for Windows paths. */ while (*p) { if (*p == '/') { *p = '\\'; } p++; } } #endif /* _WINDOWS */ return TCL_OK; }
/*++ PartialSwitchCompare Performs a partial string comparison for a single switch. This behaviour is consistent with Tcl commands that accept one switch argument, such as 'string match' and 'string map'. Arguments: objPtr - The string value of this object is compared against "name". switchName - Full name of the switch. Return Value: If "name" and the string value of "objPtr" match partially or completely, the return value is non-zero. If they do not match, the return value is zero. --*/ int PartialSwitchCompare( Tcl_Obj *objPtr, const char *switchName ) { int optionLength; char *option; assert(objPtr != NULL); assert(switchName != NULL); option = Tcl_GetStringFromObj(objPtr, &optionLength); // // The user supplied switch must be at least two characters in // length, to account for the switch prefix and first letter. // return (optionLength > 2 && strncmp(switchName, option, optionLength) == 0); }
/*----------------------------------------------------------------------------- * ChmodFileNameObj -- * Change the mode of a file by name. * * Parameters: * o interp - Pointer to the current interpreter, error messages will be * returned in the result. * o modeInfo - Infomation with the mode to set the file to. * o fileName - Name of the file to change. * Returns: * TCL_OK or TCL_ERROR. *----------------------------------------------------------------------------- */ static int ChmodFileNameObj (Tcl_Interp *interp, modeInfo_t modeInfo, Tcl_Obj *fileNameObj) { char *filePath; struct stat fileStat; Tcl_DString pathBuf; int newMode; char *fileName; Tcl_DStringInit (&pathBuf); fileName = Tcl_GetStringFromObj (fileNameObj, NULL); filePath = Tcl_TranslateFileName (interp, fileName, &pathBuf); if (filePath == NULL) { Tcl_DStringFree (&pathBuf); return TCL_ERROR; } if (modeInfo.symMode != NULL) { if (stat (filePath, &fileStat) != 0) goto fileError; newMode = ConvSymMode (interp, modeInfo.symMode, fileStat.st_mode & 07777); if (newMode < 0) goto errorExit; } else { newMode = modeInfo.absMode; } if (TclXOSchmod (interp, filePath, (unsigned short) newMode) < 0) return TCL_ERROR; Tcl_DStringFree (&pathBuf); return TCL_OK; fileError: TclX_AppendObjResult (interp, filePath, ": ", Tcl_PosixError (interp), (char *) NULL); errorExit: Tcl_DStringFree (&pathBuf); return TCL_ERROR; }