Tcl Source Code

2012-12-31  Donal K. Fellows  <[email protected]>

	* doc/string.n: Noted the obsolescence of the 'bytelength',
	'wordstart' and 'wordend' subcommands, and moved them to later in the
	file.

2012-12-27  Jan Nijtmans  <[email protected]>

	* generic/tclListObj.c: [Bug 3598580]: Tcl_ListObjReplace may release
	deleted elements too early

2012-12-21  Jan Nijtmans  <[email protected]>

.BE

.SH DESCRIPTION
.PP
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP










\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR
Perform a character-by-character comparison of strings \fIstring1\fR
and \fIstring2\fR.  Returns \-1, 0, or 1, depending on whether
\fIstring1\fR is lexicographically less than, equal to, or greater
than \fIstring2\fR.  If \fB\-length\fR is specified, then only the
first \fIlength\fR characters are used in the comparison.  If
\fB\-length\fR is negative, it is ignored.  If \fB\-nocase\fR is

\fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR
Returns 1 if \fIstring\fR is a valid member of the specified character
class, otherwise returns 0.  If \fB\-strict\fR is specified, then an
empty string returns 0, otherwise an empty string will return 1 on
any class.  If \fB\-failindex\fR is specified, then if the function
returns 0, the index in the string where the class was no longer valid
will be stored in the variable named \fIvarname\fR.  The \fIvarname\fR
will not be set if \fBstring is\fR returns 1.  The following character
classes are recognized (the class name can be abbreviated):
.RS
.IP \fBalnum\fR 12
Any Unicode alphabet or digit character.
.IP \fBalpha\fR 12
Any Unicode alphabet character.
.IP \fBascii\fR 12

tabs, newlines, and carriage returns).
.TP
\fBstring trimright \fIstring\fR ?\fIchars\fR?
Returns a value equal to \fIstring\fR except that any trailing
characters present in the string given by \fIchars\fR are removed.  If
\fIchars\fR is not specified then white space is removed (spaces,
tabs, newlines, and carriage returns).
.SH "OBSOLETE SUBCOMMANDS"
.PP
These subcommands are currently supported, but are likely to go away in a
future release as their functionality is either virtually never used or highly
misleading.
.TP
\fBstring bytelength \fIstring\fR
Returns a decimal string giving the number of bytes used to represent
\fIstring\fR in memory.  Because UTF\-8 uses one to three bytes to
represent Unicode characters, the byte length will not be the same as
the character length in general.  The cases where a script cares about
the byte length are rare.  In almost all cases, you should use the
\fBstring length\fR operation (including determining the length of a
Tcl ByteArray object).  Refer to the \fBTcl_NumUtfChars\fR manual
entry for more details on the UTF\-8 representation.
.TP
\fBstring wordend \fIstring charIndex\fR
Returns the index of the character just after the last one in the word
containing character \fIcharIndex\fR of \fIstring\fR.  \fIcharIndex\fR
may be specified as for the \fBindex\fR method.  A word is
considered to be any contiguous range of alphanumeric (Unicode letters
or decimal digits) or underscore (Unicode connector punctuation)

single character other than these.
.SH EXAMPLE
Test if the string in the variable \fIstring\fR is a proper non-empty
prefix of the string \fBfoobar\fR.
.CS
set length [\fBstring length\fR $string]
if {$length == 0} {
    set isPrefix 0
} else {
    set isPrefix [\fBstring equal\fR -length $length $string "foobar"]
}
.CE

.SH "SEE ALSO"
expr(n), list(n)

.SH KEYWORDS
case conversion, compare, index, match, pattern, string, word, equal,
ctype, character, reverse

.\" Local Variables:
.\" mode: nroff
.\" End:

/*
 * An instance of the following structure contains all information that is
 * passed into a new thread when the thread is created using either the
 * "thread create" Tcl command or the TclCreateThread() C function.
 */

typedef struct ThreadCtrl {
    const char *script;	/* The Tcl command this thread should
				 * execute */
    int flags;			/* Initial value of the "flags" field in the
				 * ThreadSpecificData structure for the new
				 * thread. Might contain TP_Detached or
				 * TP_TclThread. */
    Tcl_Condition condWait;	/* This condition variable is used to
				 * synchronize the parent and child threads.

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT

EXTERN int		TclThread_Init(Tcl_Interp *interp);
EXTERN int		Tcl_ThreadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
EXTERN int		TclCreateThread(Tcl_Interp *interp, const char *script,
			    int joinable);
EXTERN int		TclThreadList(Tcl_Interp *interp);
EXTERN int		TclThreadSend(Tcl_Interp *interp, Tcl_ThreadId id,
			    const char *script, int wait);

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

Tcl_ThreadCreateType	NewTestThread(ClientData clientData);
static void		ListRemove(ThreadSpecificData *tsdPtr);
static void		ListUpdateInner(ThreadSpecificData *tsdPtr);

	ListUpdateInner(tsdPtr);
	Tcl_CreateThreadExitHandler(ThreadExitProc, NULL);
	Tcl_MutexUnlock(&threadMutex);
    }

    switch ((enum options)option) {
    case THREAD_CREATE: {
	const char *script;
	int joinable, len;

	if (objc == 2) {
	    /*
	     * Neither joinable nor special script
	     */

	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	return TclThreadList(interp);
    case THREAD_SEND: {
	long id;
	const char *script;
	int wait, arg;

	if ((objc != 4) && (objc != 5)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
	    return TCL_ERROR;
	}
	if (objc == 5) {

 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
TclCreateThread(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *script,		/* Script to execute */
    int joinable)		/* Flag, joinable thread or not */
{
    ThreadCtrl ctrl;
    Tcl_ThreadId id;

    ctrl.script = script;
    ctrl.condWait = NULL;
    ctrl.flags = 0;

    joinable = joinable ? TCL_THREAD_JOINABLE : TCL_THREAD_NOFLAGS;

    Tcl_MutexLock(&threadMutex);
    if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl,
	    TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
	Tcl_MutexUnlock(&threadMutex);
        Tcl_AppendResult(interp, "can't create a new thread", NULL);

	return TCL_ERROR;
    }

    /*
     * Wait for the thread to start because it is using something on our stack!
     */

 *------------------------------------------------------------------------
 */

int
TclThreadSend(
    Tcl_Interp *interp,		/* The current interpreter. */
    Tcl_ThreadId id,		/* Thread Id of other interpreter. */
    const char *script,		/* The script to evaluate. */
    int wait)			/* If 1, we block for the result. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ThreadEvent *threadEventPtr;
    ThreadEventResult *resultPtr;
    int found, code;
    Tcl_ThreadId threadId = (Tcl_ThreadId) id;

	} else if (resultPtr->dstThreadId == self) {
	    /*
	     * Dang. The target is going away. Unblock the caller. The result
	     * string must be dynamically allocated because the main thread is
	     * going to call free on it.
	     */

	    const char *msg = "target thread died";

	    resultPtr->result = ckalloc(strlen(msg)+1);
	    strcpy(resultPtr->result, msg);
	    resultPtr->code = TCL_ERROR;
	    Tcl_ConditionNotify(&resultPtr->done);
	}
    }

 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#ifndef Tcl_GetErrorLine
#   define Tcl_GetErrorLine(interp) ((interp)->errorLine)
#endif

static int
Pkgb_SubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    int first, second;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "num num");
	return TCL_ERROR;
    }
    if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
	    || (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
	char buf[TCL_INTEGER_SPACE];
	sprintf(buf, "%d", Tcl_GetErrorLine(interp));
	Tcl_AppendResult(interp, " in line: ", buf, NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
    return TCL_OK;
}

/*