Tcl Source Code

'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 Scriptics Corportation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: RegExp.3,v 1.1.2.2 1999/04/05 22:20:26 rjohnson Exp $
'\" 
.so man.macros
.TH Tcl_RegExpMatch 3 7.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_GetRegExpFromObj, Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange \- Pattern matching with regular expressions
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_RegExp
\fBTcl_GetRegExpFromObj\fR(\fIinterp\fR, \fIpatObj\fR, \fIflags\fR)
.sp
int
\fBTcl_RegExpMatch\fR(\fIinterp\fR, \fIstring\fR, \fIpattern\fR)
.sp
Tcl_RegExp
\fBTcl_RegExpCompile\fR(\fIinterp\fR, \fIpattern\fR)
.sp
int
\fBTcl_RegExpExec\fR(\fIinterp\fR, \fIregexp\fR, \fIstring\fR, \fIstart\fR)
.sp
\fBTcl_RegExpRange\fR(\fIregexp\fR, \fIindex\fR, \fIstartPtr\fR, \fIendPtr\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Tcl interpreter to use for error reporting.
.AP char *string in
String to check for a match with a regular expression.
.AP char *pattern in
String in the form of a regular expression pattern.
.AP Tcl_Obj *patObj in
Refers to the object from which to get a compiled regular expression.
.AP int flags in
Various flags to control regular expression compile options.
.AP Tcl_RegExp regexp in
Compiled regular expression.  Must have been returned previously
by \fBTcl_GetRegExpFromObj\fR.
.AP char *start in
If \fIstring\fR is just a portion of some other string, this argument
identifies the beginning of the larger string.
If it isn't the same as \fIstring\fR, then no \fB^\fR matches
will be allowed.
.AP int index in
Specifies which range is desired:  0 means the range of the entire
match, 1 or greater means the range that matched a parenthesized
sub-expression.
.AP char **startPtr out
The address of the first character in the range is stored here, or
NULL if there is no such range.
.AP char **endPtr out
The address of the character just after the last one in the range
is stored here, or NULL if there is no such range.
.BE

.SH DESCRIPTION
.PP
\fBTcl_GetRegExpFromObj\fR attepts to return a compiled regular 
expression from the Tcl obj \fIpatObj\fR.  If the object does not
already contain a compiled regular expression it will attempt to
create one from the string in the Tcl obj and assign it to the
internal representation of the \fIpatObj\fR.  The return value
of this function is of type \fBTcl_RegExp\fR.
.PP
\fBTcl_RegExpMatch\fR determines whether its \fIpattern\fR argument
matches \fIregexp\fR, where \fIregexp\fR is interpreted
as a regular expression using the same rules as for the
\fBregexp\fR Tcl command.
If there is a match then \fBTcl_RegExpMatch\fR returns 1.
If there is no match then \fBTcl_RegExpMatch\fR returns 0.

# tcl.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Tcl library via the stubs table.
#	This file is used to generate the tclDecls.h, tclPlatDecls.h,
#	tclStub.c, and tclPlatStub.c files.
#	
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# RCS: @(#) $Id: tcl.decls,v 1.3.2.14 1999/04/05 22:20:27 rjohnson Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private

    char * Tcl_UniCharToUtfDString(CONST Tcl_UniChar *string, int numChars, \
 	    Tcl_DString *dsPtr)
}
declare 355 generic {
    Tcl_UniChar * Tcl_UtfToUniCharDString(CONST char *string, int length, \
	    Tcl_DString *dsPtr)
}
declare 356 generic {
    Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags)
}

##############################################################################

# Define the platform specific public Tcl interface.  These functions are
# only available on the designated platform.

interface tclPlat

/* 
 * tclCmdMZ.c --
 *
 *	This file contains the top-level command routines for most of
 *	the Tcl built-in commands whose names begin with the letters
 *	M to Z.  It contains only commands in the generic core (i.e.
 *	those that don't depend much upon UNIX facilities).
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCmdMZ.c,v 1.1.2.11 1999/04/05 22:20:27 rjohnson Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
#include "tclRegexp.h"

	Tcl_WrongNumArgs(interp, 1, objv,
		"?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
	return TCL_ERROR;
    }
    objc -= i;
    objv += i;

    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
    if (regExpr == NULL) {
	return TCL_ERROR;
    }

    if (about) {
	if (TclRegAbout(interp, regExpr) < 0) {
	    return TCL_ERROR;

    if (objc - i != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?switches? exp string subSpec varName");
	return TCL_ERROR;
    }

    objv += i;
    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], flags | REG_ADVANCED);
    if (regExpr == NULL) {
	return TCL_ERROR;
    }

    result = TCL_OK;
    string = Tcl_GetStringFromObj(objv[1], &stringLength);
    subspec = Tcl_GetString(objv[2]);

/*
 * tclDecls.h --
 *
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclDecls.h,v 1.3.2.15 1999/04/05 22:20:28 rjohnson Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl

EXTERN char *		Tcl_UniCharToUtfDString _ANSI_ARGS_((
				CONST Tcl_UniChar * string, int numChars, 
				Tcl_DString * dsPtr));
/* 355 */
EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString _ANSI_ARGS_((
				CONST char * string, int length, 
				Tcl_DString * dsPtr));
/* 356 */
EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj * patObj, 
				int flags));

typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;
    struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

    int (*tcl_UniCharIsSpace) _ANSI_ARGS_((int ch)); /* 349 */
    int (*tcl_UniCharIsUpper) _ANSI_ARGS_((int ch)); /* 350 */
    int (*tcl_UniCharIsWordChar) _ANSI_ARGS_((int ch)); /* 351 */
    int (*tcl_UniCharLen) _ANSI_ARGS_((Tcl_UniChar * str)); /* 352 */
    int (*tcl_UniCharNcmp) _ANSI_ARGS_((const Tcl_UniChar * cs, const Tcl_UniChar * ct, size_t n)); /* 353 */
    char * (*tcl_UniCharToUtfDString) _ANSI_ARGS_((CONST Tcl_UniChar * string, int numChars, Tcl_DString * dsPtr)); /* 354 */
    Tcl_UniChar * (*tcl_UtfToUniCharDString) _ANSI_ARGS_((CONST char * string, int length, Tcl_DString * dsPtr)); /* 355 */
    Tcl_RegExp (*tcl_GetRegExpFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * patObj, int flags)); /* 356 */
} TclStubs;

extern TclStubs *tclStubsPtr;

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)

/*

#define Tcl_UniCharToUtfDString \
	(tclStubsPtr->tcl_UniCharToUtfDString) /* 354 */
#endif
#ifndef Tcl_UtfToUniCharDString
#define Tcl_UtfToUniCharDString \
	(tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */
#endif
#ifndef Tcl_GetRegExpFromObj
#define Tcl_GetRegExpFromObj \
	(tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#endif /* _TCLDECLS */

/* 
 * tclFileName.c --
 *
 *	This file contains routines for converting file names betwen
 *	native and network form.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclFileName.c,v 1.1.2.11 1999/04/05 22:20:30 rjohnson Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"

/*

     * Initialize the path name parser for Windows path names.
     */

    if (!initialized) {
	FileNameInit();
    }

    re = Tcl_GetRegExpFromObj(NULL, winRootPatternPtr, REG_ADVANCED);

    /*
     * Match the root portion of a Windows path name.
     */

    if (!Tcl_RegExpExec(NULL, re, path, path)) {
	return path;

		 * Since we have eliminated the easy cases, use the
		 * root pattern to look for the other types.
		 */

		if (!initialized) {
		    FileNameInit();
		}
		re = Tcl_GetRegExpFromObj(NULL, macRootPatternPtr, REG_ADVANCED);

		if (!Tcl_RegExpExec(NULL, re, path, path)) {
		    type = TCL_PATH_RELATIVE;
		} else {
		    char *unixRoot, *dummy;

		    Tcl_RegExpRange(re, 2, &unixRoot, &dummy);

		 * Since we have eliminated the easy cases, check for
		 * drive relative paths using the regular expression.
		 */

		if (!initialized) {
		    FileNameInit();
		}
		re = Tcl_GetRegExpFromObj(NULL, winRootPatternPtr, REG_ADVANCED);

		if (Tcl_RegExpExec(NULL, re, path, path)) {
		    char *drive, *dummy, *unixRoot, *lastSlash;

		    Tcl_RegExpRange(re, 2, &drive, &dummy);
		    Tcl_RegExpRange(re, 5, &unixRoot, &dummy);
		    Tcl_RegExpRange(re, 6, &lastSlash, &dummy);

    }

    /*
     * Match the root portion of a Mac path name.
     */

    i = 0;			/* Needed only to prevent gcc warnings. */
    re = Tcl_GetRegExpFromObj(NULL, macRootPatternPtr, REG_ADVANCED);

    if (Tcl_RegExpExec(NULL, re, path, path) == 1) {
	char *start, *end;

	/*
	 * Treat degenerate absolute paths like / and /../.. as
	 * Mac relative file names for lack of anything else to do.

/* 
 * tclRegexp.c --
 *
 *	This file contains the public interfaces to the Tcl regular
 *	expression mechanism.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclRegexp.c,v 1.1.2.8 1999/04/05 22:20:30 rjohnson Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"

/*

 */

int
Tcl_RegExpExec(interp, re, string, start)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    Tcl_RegExp re;		/* Compiled regular expression;  must have
				 * been returned by previous call to
				 * Tcl_GetRegExpFromObj. */
    CONST char *string;		/* String against which to match re. */
    CONST char *start;		/* If string is part of a larger string,
				 * this identifies beginning of larger
				 * string, so that "^" won't match. */
{
    int result, numChars;
    Tcl_DString stringBuffer;

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

int
TclRegExpExecUniChar(interp, re, wString, numChars, nmatches, flags)
    Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
    Tcl_RegExp re;		/* Compiled regular expression; returned by
				 * a previous call to Tcl_GetRegExpFromObj */

    CONST Tcl_UniChar *wString;	/* String against which to match re. */
    int numChars;		/* Length of string in Tcl_UniChars (must
				 * be >= 0). */
    int nmatches;		/* How many subexpression matches (counting
				 * the whole match as subexpression 0) are
				 * of interest.  -1 means "don't know". */
    int flags;			/* Regular expression flags. */

    Tcl_Interp *interp;		/* Used for error reporting. */
    char *string;		/* String. */
    Tcl_Obj *patObj;		/* Regular expression to match against
				 * string. */
{
    Tcl_RegExp re;

    re = Tcl_GetRegExpFromObj(interp, patObj, REG_ADVANCED);
    if (re == NULL) {
	return -1;
    }
    return Tcl_RegExpExec(interp, re, string, string);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetRegExpFromObj --
 *
 *	Compile a regular expression into a form suitable for fast
 *	matching.  This procedure caches the result in a Tcl_Obj.
 *
 * Results:
 *	The return value is a pointer to the compiled form of string,
 *	suitable for passing to Tcl_RegExpExec.  If an error occurred
 *	while compiling the pattern, then NULL is returned and an error
 *	message is left in the interp's result.
 *
 * Side effects:
 *	Updates the native rep of the Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

Tcl_RegExp
Tcl_GetRegExpFromObj(interp, objPtr, flags)
    Tcl_Interp *interp;		/* For use in error reporting. */
    Tcl_Obj *objPtr;		/* Object whose string rep contains regular
				 * expression pattern.  Internal rep will be
				 * changed to compiled form of this regular
				 * expression. */
    int flags;			/* Regular expression compilation flags. */
{

 */

static int
SetRegexpFromAny(interp, objPtr)
    Tcl_Interp *interp;		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr;		/* The object to convert. */
{
    if (Tcl_GetRegExpFromObj(interp, objPtr, REG_ADVANCED) == NULL) {
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------

 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 * 
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclRegexp.h,v 1.1.2.5 1999/04/05 22:20:31 rjohnson Exp $
 */

#ifndef _TCLREGEXP
#define _TCLREGEXP

#include "regex.h"

				 * of subexpressions. */
} TclRegexp;

/*
 * Functions exported for use within the rest of Tcl.
 */



EXTERN int		TclRegAbout _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_RegExp re));
EXTERN VOID		TclRegXflags _ANSI_ARGS_((char *string, int length,
			    int *cflagsPtr, int *eflagsPtr));
EXTERN int		TclRegExpExecUniChar _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_RegExp re, CONST Tcl_UniChar *uniString,
			    int numChars, int nmatches, int flags));

/* 
 * tclStubInit.c --
 *
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.3.2.11 1999/04/05 22:20:31 rjohnson Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * Remove macros that will interfere with the definitions below.

    Tcl_UniCharIsSpace, /* 349 */
    Tcl_UniCharIsUpper, /* 350 */
    Tcl_UniCharIsWordChar, /* 351 */
    Tcl_UniCharLen, /* 352 */
    Tcl_UniCharNcmp, /* 353 */
    Tcl_UniCharToUtfDString, /* 354 */
    Tcl_UtfToUniCharDString, /* 355 */
    Tcl_GetRegExpFromObj, /* 356 */
};

TclIntStubs tclIntStubs = {
    TCL_STUB_MAGIC,
    NULL,
    TclAccess, /* 0 */
    TclAccessDeleteProc, /* 1 */

/* 
 * tclTest.c --
 *
 *	This file contains C command procedures for a bunch of additional
 *	Tcl commands that are used for testing out Tcl's C interfaces.
 *	These commands are not normally included in Tcl applications;
 *	they're only used for testing.
 *
 * Copyright (c) 1993-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTest.c,v 1.1.2.15 1999/04/05 22:20:31 rjohnson Exp $
 */

#define TCL_TEST

#include "tclInt.h"
#include "tclPort.h"
#include "tclRegexp.h"

    if (hasxflags) {
	string = Tcl_GetStringFromObj(objv[0], &stringLength);
	TestregexpXflags(string, stringLength, &cflags, &eflags);
	objc--;
	objv++;
    }

    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
    if (regExpr == NULL) {
	return TCL_ERROR;
    }

    if (about) {
	if (TclRegAbout(interp, regExpr) < 0) {
	    return TCL_ERROR;