Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Save work. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | linkvar |
| Files: | files | file ages | folders |
| SHA3-256: |
8b206fdd93284f8d85549749f3029b7b |
| User & Date: | rolf 2020-01-18 01:32:05 |
Context
|
2020-01-18
| ||
| 01:32 | Save work. Leaf check-in: 8b206fdd93 user: rolf tags: linkvar | |
|
2020-01-11
| ||
| 02:18 | Merged from trunk. check-in: 8cd9ca1c3a user: rolf tags: schema | |
Changes
Changes to generic/schema.c.
6484 6485 6486 6487 6488 6489 6490 6491 6492 6493 6494 6495 6496 6497 6498 .... 7175 7176 7177 7178 7179 7180 7181 7182 7183 7184 7185 7186 7187 7188 .... 7315 7316 7317 7318 7319 7320 7321 7322 7323 7324 7325 |
{
int nrArg;
Tcl_Obj **evalStub;
SchemaData *sdata;
SchemaCP *cp;
} splitTclTCData;
static int
splitTclImpl (
Tcl_Interp *interp,
void *constraintData,
char *text
)
{
................................................................................
ADD_CONSTRAINT (sdata, sc)
sc->constraint = setvarImpl;
sc->freeData = setvarImplFree;
sc->constraintData = tdomstrdup (Tcl_GetString (objv[1]));
return TCL_OK;
}
void
tDOM_SchemaInit (
Tcl_Interp *interp
)
{
Tcl_CreateObjCommand (interp, "tdom::schema", tDOM_SchemaObjCmd,
NULL, NULL);
................................................................................
unsignedIntTypesTCObjCmd, (ClientData) 1, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedInt",
unsignedIntTypesTCObjCmd, (ClientData) 2, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedLong",
unsignedIntTypesTCObjCmd, (ClientData) 3, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::setvar",
setvarTCObjCmd, (ClientData) 3, NULL);
}
#endif /* #ifndef TDOM_NO_SCHEMA */
|
< > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
6484 6485 6486 6487 6488 6489 6490 6491 6492 6493 6494 6495 6496 6497 .... 7174 7175 7176 7177 7178 7179 7180 7181 7182 7183 7184 7185 7186 7187 7188 7189 7190 7191 7192 7193 7194 7195 7196 7197 7198 7199 7200 7201 7202 7203 7204 7205 7206 7207 7208 7209 7210 7211 7212 7213 7214 7215 7216 7217 7218 7219 7220 7221 7222 7223 7224 7225 7226 7227 7228 7229 7230 7231 7232 7233 7234 7235 7236 7237 7238 7239 7240 7241 7242 7243 7244 7245 7246 7247 7248 7249 7250 7251 .... 7378 7379 7380 7381 7382 7383 7384 7385 7386 7387 7388 7389 7390 |
{
int nrArg;
Tcl_Obj **evalStub;
SchemaData *sdata;
SchemaCP *cp;
} splitTclTCData;
static int
splitTclImpl (
Tcl_Interp *interp,
void *constraintData,
char *text
)
{
................................................................................
ADD_CONSTRAINT (sdata, sc)
sc->constraint = setvarImpl;
sc->freeData = setvarImplFree;
sc->constraintData = tdomstrdup (Tcl_GetString (objv[1]));
return TCL_OK;
}
typedef struct
{
char *varname;
char *value;
Tcl_Interp *interp;
} linkvarTCData;
static void
linkvarImplFree (
void *constraintData
)
{
linkvarTCData *linkvarData = (linkvarTCData *) constraintData;
Tcl_UnlinkVar (linkvarData->interp, linkvarData->varname);
if (linkvarData->value) FREE (linkvarData->value);
FREE (linkvarData->varname);
FREE (linkvarData);
}
static int
linkvarImpl (
Tcl_Interp *interp,
void *constraintData,
char *text
)
{
linkvarTCData *linkvarData = (linkvarTCData *) constraintData;
if (linkvarData->value) FREE (linkvarData->value);
linkvarData->value = tdomstrdup (text);
return 1;
}
static int
linkvarTCObjCmd (
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
)
{
SchemaData *sdata = GETASI;
linkvarTCData *linkvarData;
SchemaConstraint *sc;
CHECK_TI
checkNrArgs (2,2,"<tcl variable name>");
linkvarData = TMALLOC (linkvarTCData);
memset (linkvarData, 0, sizeof (linkvarTCData));
if (Tcl_LinkVar (interp, Tcl_GetString (objv[1]),
(char *) &(linkvarData->value),
TCL_LINK_STRING | TCL_LINK_READ_ONLY)) {
FREE (linkvarData);
return TCL_ERROR;
}
linkvarData->varname = tdomstrdup (Tcl_GetString (objv[1]));
linkvarData->interp = interp;
ADD_CONSTRAINT (sdata, sc)
sc->constraint = linkvarImpl;
sc->freeData = linkvarImplFree;
sc->constraintData = linkvarData;
return TCL_OK;
}
void
tDOM_SchemaInit (
Tcl_Interp *interp
)
{
Tcl_CreateObjCommand (interp, "tdom::schema", tDOM_SchemaObjCmd,
NULL, NULL);
................................................................................
unsignedIntTypesTCObjCmd, (ClientData) 1, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedInt",
unsignedIntTypesTCObjCmd, (ClientData) 2, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedLong",
unsignedIntTypesTCObjCmd, (ClientData) 3, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::setvar",
setvarTCObjCmd, (ClientData) 3, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::linkvar",
linkvarTCObjCmd, (ClientData) 3, NULL);
}
#endif /* #ifndef TDOM_NO_SCHEMA */
|
Changes to tests/schema.test.
5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 |
element a ! {text {setvar from_schema-14.44}}
element b ! {text {setvar from_schema-14.44}}
}
set result [s validate "<doc><a>a</a><b>b</b></doc>"]
s delete
lappend result ${from_schema-14.44}
} {1 b}
test schema-15.1 {constraint cmd tcl} {
tdom::schema s
s define {
defelement a {
tcl append ::schema-15.1
element b
|
> > > > > > > > > > > > > > > > > > > > > > > |
5168 5169 5170 5171 5172 5173 5174 5175 5176 5177 5178 5179 5180 5181 5182 5183 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 5203 5204 |
element a ! {text {setvar from_schema-14.44}}
element b ! {text {setvar from_schema-14.44}}
}
set result [s validate "<doc><a>a</a><b>b</b></doc>"]
s delete
lappend result ${from_schema-14.44}
} {1 b}
proc schema-14.45 {args} {
lappend ::result ${::from_schema-14.45} ${::schema-14.45::foo}
return 1
}
test schema-14.45 {text constraint linkvar} {
tdom::schema s
namespace eval ::schema-14.45 { }
set ::schema-14.45::foo "foo from namespace"
set from_schema-14.45 "foo"
set result [list]
s defelement doc {
text {
linkvar from_schema-14.45
linkvar ::schema-14.45::foo
tcl schema-14.45
}
}
s validate "<doc>this</doc>"
s delete
list ${::schema-14.45::foo} ${from_schema-14.45}
} {this this}
test schema-15.1 {constraint cmd tcl} {
tdom::schema s
s define {
defelement a {
tcl append ::schema-15.1
element b
|