Tcl Source Code

Check-in [cc7406af37]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment: Moved TclRegCompObj to Tcl_GetRegExpFromObj - also added info to man page.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: cc7406af37d2b2ebd824c1cb3a6a3d98969c0165
User & Date: rjohnson 1999-04-05 22:20:26
Context
1999-04-05
22:21
Fix DDE tests, don't run on Unix (pcOnly). check-in: 3fb0791223 user: redman tags: core-8-1-branch-old
22:20
Moved TclRegCompObj to Tcl_GetRegExpFromObj - also added info to man page. check-in: cc7406af37 user: rjohnson tags: core-8-1-branch-old
22:18
*** empty log message *** check-in: 3b3a73e766 user: stanton tags: core-8-1-branch-old
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/RegExp.3.

1
2
3

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18



19
20
21
22
23
24
25
..
30
31
32
33
34
35
36




37
38
39

40
41
42
43
44
45
46
..
51
52
53
54
55
56
57







58
59
60
61
62
63
64
'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.

'\"
'\" 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.1 1998/09/24 23:58:26 stanton Exp $
'\" 
.so man.macros
.TH Tcl_RegExpMatch 3 7.4 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange \- Pattern matching with regular expressions
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp



int
\fBTcl_RegExpMatch\fR(\fIinterp\fR, \fIstring\fR, \fIpattern\fR)
.sp
Tcl_RegExp
\fBTcl_RegExpCompile\fR(\fIinterp\fR, \fIpattern\fR)
.sp
int
................................................................................
.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_RegExp regexp in
Compiled regular expression.  Must have been returned previously
by \fBTcl_RegExpCompile\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
................................................................................
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_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.


>




|





|




>
>
>







 







>
>
>
>


<
>







 







>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
..
34
35
36
37
38
39
40
41
42
43
44
45
46

47
48
49
50
51
52
53
54
..
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
'\"
'\" 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
................................................................................
.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
................................................................................
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.

Changes to generic/tcl.decls.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
1205
1206
1207
1208
1209
1210
1211



1212
1213
1214
1215
1216
1217
1218
#	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.13 1999/04/02 23:44:53 stanton 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)
}




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

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

interface tclPlat






|







 







>
>
>







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
#	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

Changes to generic/tclCmdMZ.c.

4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19
20
21
22
...
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
...
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
 *	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.

 *
 * 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.10 1999/04/02 23:44:55 stanton 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 = TclRegCompObj(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 = TclRegCompObj(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]);






>




|







 







|







 







|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
...
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
 *	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]);

Changes to generic/tclDecls.h.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
1075
1076
1077
1078
1079
1080
1081




1082
1083
1084
1085
1086
1087
1088
....
1466
1467
1468
1469
1470
1471
1472

1473
1474
1475
1476
1477
1478
1479
....
2888
2889
2890
2891
2892
2893
2894




2895
2896
2897
2898
2899
2900
2901
 *	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.14 1999/04/02 23:44:55 stanton 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));





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 */

} 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





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

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

#endif /* _TCLDECLS */







|







 







>
>
>
>







 







>







 







>
>
>
>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
....
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
....
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
 *	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 */

Changes to generic/tclFileName.c.

1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16
17
18
19
...
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
...
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
...
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
...
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
/* 
 * tclFileName.c --
 *
 *	This file contains routines for converting file names betwen
 *	native and network form.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.

 *
 * 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.10 1999/03/30 23:56:18 stanton Exp $
 */

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

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

    if (!initialized) {
	FileNameInit();
    }

    re = TclRegCompObj(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 = TclRegCompObj(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 = TclRegCompObj(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 = TclRegCompObj(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.






>




|







 







|







 







|







 







|







 







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
...
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
...
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
...
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
/* 
 * 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.

Changes to generic/tclRegexp.c.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17
18
19
20
...
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
...
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
...
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
...
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
...
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
/* 
 * tclRegexp.c --
 *
 *	This file contains the public interfaces to the Tcl regular
 *	expression mechanism.
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 * Copyright (c) 1998 by Sun Microsystems, Inc.

 *
 * 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.7 1999/04/02 23:44:57 stanton 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_RegExpCompile or TclRegCompObj. */
    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_RegExpCompile() or
				 * TclRegCompObj(). */
    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 = TclRegCompObj(interp, patObj, REG_ADVANCED);
    if (re == NULL) {
	return -1;
    }
    return Tcl_RegExpExec(interp, re, string, string);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclRegCompObj --
 *
 *	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
................................................................................
 * Side effects:
 *	Updates the native rep of the Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

Tcl_RegExp
TclRegCompObj(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 (TclRegCompObj(interp, objPtr, REG_ADVANCED) == NULL) {
	return TCL_ERROR;
    }
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------





<

>




|







 







|







 







|
<







 







|









|







 







|







 







|







1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
...
305
306
307
308
309
310
311
312

313
314
315
316
317
318
319
...
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
...
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
...
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
/* 
 * 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
................................................................................
 * 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;
}
 
/*
 *---------------------------------------------------------------------------

Changes to generic/tclRegexp.h.

23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39
40
41
42
43
..
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
 * 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 Scriptics Corporation.
 * Copyright (c) 1998 by Sun Microsystems, Inc.

 *
 * 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.4 1998/11/11 01:44:54 stanton Exp $
 */

#ifndef _TCLREGEXP
#define _TCLREGEXP

#include "regex.h"

................................................................................
				 * of subexpressions. */
} TclRegexp;

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

EXTERN Tcl_RegExp	TclRegCompObj _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Obj *patObj, int flags));
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));






<

>




|







 







<
<







23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38
39
40
41
42
43
..
66
67
68
69
70
71
72


73
74
75
76
77
78
79
 * 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));

Changes to generic/tclStubInit.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
421
422
423
424
425
426
427

428
429
430
431
432
433
434
 *	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.10 1999/04/02 23:44:57 stanton 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 */

};

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






|







 







>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
 *	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 */

Changes to generic/tclTest.c.

4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19
20
21
22
....
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
 *	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.

 *
 * 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.14 1999/04/02 23:44:58 stanton 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 = TclRegCompObj(interp, objv[0], cflags);
    if (regExpr == NULL) {
	return TCL_ERROR;
    }

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






>




|







 







|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
....
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
 *	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;