1/* 2 * tclexpat.c -- 3 * 4 * A Tcl interface to James Clark's expat XML parser 5 * 6 * Copyright (c) 1998 Steve Ball, Zveno Pty Ltd 7 * 8 * with modifications 9 * by Jochen Loewer(loewerj@hotmail.com) (July 1999) 10 * by ericm@scriptics.com, 1999.6.25 11 * by Rolf Ade (rolf@pointsman.de) (2000, 2001) 12 * 13 * 14 * Zveno Pty Ltd makes this software and associated documentation 15 * available free of charge for any purpose. You may make copies 16 * of the software but you must include all of this notice on any copy. 17 * 18 * Zveno Pty Ltd does not warrant that this software is error free 19 * or fit for any purpose. Zveno Pty Ltd disclaims any liability for 20 * all claims, expenses, losses, damages and costs any user may incur 21 * as a result of using, copying or modifying the software. 22 * 23 * Jochen Loewer does not warrant that this software is error free 24 * or fit for any purpose. Jochen Loewer disclaims any liability for 25 * all claims, expenses, losses, damages and costs any user may incur 26 * as a result of using, copying or modifying the software. 27 * 28 * 2001-2007 Rolf Ade All changes and enhancements. 29 * 30 */ 31 32 33/*---------------------------------------------------------------------------- 34| Includes 35| 36\---------------------------------------------------------------------------*/ 37#include <tcl.h> 38#include <string.h> 39#include <dom.h> 40#include <tclexpat.h> 41#include <fcntl.h> 42 43#ifdef _MSC_VER 44#include <io.h> 45#endif 46 47#ifdef _POSIX_SOURCE 48#include <unistd.h> 49#endif 50 51/* Used internal als status, like TCL_OK, TCL_ERROR etc. As a 52 consequent, application specific error codes must be at least 53 greater than 5 */ 54#define ERROR_IN_EXTREFHANDLER 5 55 56#define READ_SIZE (1024*8) 57#ifndef O_BINARY 58#ifdef _O_BINARY 59#define O_BINARY _O_BINARY 60#else 61#define O_BINARY 0 62#endif 63#endif 64 65 66/*---------------------------------------------------------------------------- 67| Macros 68| 69\---------------------------------------------------------------------------*/ 70#define DBG(x) 71#define SetResult(interp,str) \ 72 (Tcl_SetStringObj (Tcl_GetObjResult (interp), (str), -1)) 73#define SetIntResult(interp,i) \ 74 (Tcl_SetIntObj (Tcl_GetObjResult (interp), (i) )) 75#define AppendResult(interp,str) \ 76 (Tcl_AppendToObj (Tcl_GetObjResult (interp), (str), -1)) 77#define CheckArgs(min,max,n,msg) \ 78 if ((objc < min) || (objc >max)) { \ 79 Tcl_WrongNumArgs(interp, n, objv, msg); \ 80 return TCL_ERROR; \ 81 } 82#define CheckDefaultTclHandlerSet \ 83 if (!activeTclHandlerSet) { \ 84 activeTclHandlerSet = CreateTclHandlerSet("default");\ 85 tmpTclHandlerSet = expat->firstTclHandlerSet; \ 86 expat->firstTclHandlerSet = activeTclHandlerSet; \ 87 activeTclHandlerSet->nextHandlerSet = tmpTclHandlerSet; \ 88 } 89 90/*---------------------------------------------------------------------------- 91| typedefs 92| 93\---------------------------------------------------------------------------*/ 94 95typedef enum { 96 EXPAT_INPUT_STRING, 97 EXPAT_INPUT_CHANNEL, 98 EXPAT_INPUT_FILENAME 99} TclExpat_InputType; 100 101 102 103/*---------------------------------------------------------------------------- 104| local globals 105| 106\---------------------------------------------------------------------------*/ 107 108static int uniqueCounter = 0; /* Counter to generate unique command names 109 */ 110TDomThreaded(static Tcl_Mutex counterMutex;) /* Protect the counter (zv) */ 111 112/*---------------------------------------------------------------------------- 113| Prototypes for procedures defined later in this file: 114| 115\---------------------------------------------------------------------------*/ 116int TclExpatObjCmd _ANSI_ARGS_((ClientData dummy, 117 Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); 118static int TclExpatInstanceCmd _ANSI_ARGS_((ClientData dummy, 119 Tcl_Interp *interp, int objc, struct Tcl_Obj *CONST objv[])); 120static void TclExpatDeleteCmd _ANSI_ARGS_((ClientData clientData)); 121 122static Tcl_Obj* FindUniqueCmdName _ANSI_ARGS_((Tcl_Interp *interp)); 123static int TclExpatCheckWhiteData _ANSI_ARGS_((char *pc, int len)); 124 125static int TclExpatInitializeParser _ANSI_ARGS_((Tcl_Interp *interp, 126 TclGenExpatInfo *expat, int resetOptions )); 127static void TclExpatFreeParser _ANSI_ARGS_((TclGenExpatInfo *expat)); 128static int TclExpatParse _ANSI_ARGS_((Tcl_Interp *interp, 129 TclGenExpatInfo *expat, char *data, int len, 130 TclExpat_InputType type)); 131static int TclExpatConfigure _ANSI_ARGS_((Tcl_Interp *interp, 132 TclGenExpatInfo *expat, int objc, Tcl_Obj *CONST objv[])); 133static int TclExpatCget _ANSI_ARGS_((Tcl_Interp *interp, 134 TclGenExpatInfo *expat, int objc, Tcl_Obj *CONST objv[])); 135 136static int TclExpatGet _ANSI_ARGS_((Tcl_Interp *interp, 137 TclGenExpatInfo *expat, int objc, Tcl_Obj *CONST objv[])); 138static void TclExpatDispatchPCDATA _ANSI_ARGS_((TclGenExpatInfo *expat)); 139static void TclGenExpatElementStartHandler _ANSI_ARGS_((void *userdata, 140 const XML_Char *name, 141 const XML_Char **atts)); 142static void TclGenExpatElementEndHandler _ANSI_ARGS_((void *userData, 143 const XML_Char *name)); 144static void TclGenExpatCharacterDataHandler _ANSI_ARGS_((void *userData, 145 const XML_Char *s, 146 int len)); 147 148static void TclGenExpatProcessingInstructionHandler _ANSI_ARGS_(( 149 void *userData, const XML_Char *target, 150 const XML_Char *data)); 151static int TclGenExpatExternalEntityRefHandler _ANSI_ARGS_(( 152 XML_Parser parser, const XML_Char *openEntityNames, 153 const XML_Char *base, const XML_Char *systemId, 154 const XML_Char *publicId)); 155static void TclGenExpatDefaultHandler _ANSI_ARGS_ ((void *userData, 156 const XML_Char *s, int len)); 157static void TclGenExpatNotationDeclHandler _ANSI_ARGS_ ((void *userData, 158 const XML_Char *notationName, const XML_Char *base, 159 const XML_Char *systemId, const XML_Char *publicId)); 160static int TclGenExpatUnknownEncodingHandler _ANSI_ARGS_ (( 161 void *encodingHandlerData, const XML_Char *name, 162 XML_Encoding *info)); 163 164static void TclGenExpatStartNamespaceDeclHandler _ANSI_ARGS_((void *userdata, 165 const XML_Char *prefix, 166 const XML_Char *uri)); 167static void TclGenExpatEndNamespaceDeclHandler _ANSI_ARGS_((void *userData, 168 const XML_Char *prefix)); 169 170 171/* Following added by ericm@scriptics, 1999.6.25 */ 172/* Prototype definition for the TclExpat comment handler */ 173static void TclGenExpatCommentHandler _ANSI_ARGS_ ((void *userData, 174 const XML_Char *data)); 175/* Prototype for TclExpat Not Standalone Handler */ 176static int TclGenExpatNotStandaloneHandler _ANSI_ARGS_ ((void *userData)); 177 178/* Prototype for TclExpat {Start|End}CdataSectionHandler */ 179static void TclGenExpatStartCdataSectionHandler _ANSI_ARGS_((void *userData)); 180static void TclGenExpatEndCdataSectionHandler _ANSI_ARGS_((void *userData)); 181 182/* Added by ericm@scriptics.com, 1999.09.13 */ 183/* Prototype for TclExpat (Element|Attlist) Declaration Handlers */ 184static void TclGenExpatElementDeclHandler _ANSI_ARGS_((void *userData, 185 const XML_Char *name, XML_Content *model)); 186static void TclGenExpatAttlistDeclHandler _ANSI_ARGS_((void *userData, 187 const XML_Char *elname, const XML_Char *name, 188 const XML_Char *type, const XML_Char *dflt, 189 int isrequired)); 190/* Prototypes for the TclExpat Doctype Decl handlers */ 191static void TclGenExpatStartDoctypeDeclHandler _ANSI_ARGS_((void *userData, 192 const XML_Char *doctypeName, const XML_Char *sysid, 193 const XML_Char *pubid, int has_internal_subset)); 194static void TclGenExpatEndDoctypeDeclHandler _ANSI_ARGS_((void *userData)); 195static void TclGenExpatXmlDeclHandler _ANSI_ARGS_((void *userData, 196 const XML_Char *version, 197 const XML_Char *encoding, 198 int standalone)); 199static void TclGenExpatEntityDeclHandler _ANSI_ARGS_((void *userData, 200 const XML_Char *entityname, 201 int is_param, 202 const XML_Char *value, 203 int length, 204 CONST XML_Char *base, 205 CONST XML_Char *systemId, 206 CONST XML_Char *publicId, 207 CONST XML_Char *notationName)); 208 209 210/* 211 *---------------------------------------------------------------------------- 212 * 213 * CreateTclHandlerSet -- 214 * 215 * Malloc's and initializes a tclHandlerSet. 216 * 217 * Results: 218 * None. 219 * 220 * Side effects: 221 * Mallocs memory for the structure and the 'name' field, sets all 222 * handler scripts to NULL and inits some other fields. 223 * 224 *---------------------------------------------------------------------------- 225 */ 226 227static TclHandlerSet* 228CreateTclHandlerSet (name) 229 char *name; 230{ 231 TclHandlerSet *handlerSet; 232 233 handlerSet = (TclHandlerSet*) MALLOC (sizeof (TclHandlerSet)); \ 234 handlerSet->name = tdomstrdup (name); 235 handlerSet->ignoreWhiteCDATAs = 0; 236 handlerSet->status = TCL_OK; 237 handlerSet->continueCount = 0; 238 handlerSet->nextHandlerSet = NULL; 239 240 handlerSet->elementstartcommand = NULL; 241 handlerSet->elementendcommand = NULL; 242 handlerSet->startnsdeclcommand = NULL; 243 handlerSet->endnsdeclcommand = NULL; 244 handlerSet->datacommand = NULL; 245 handlerSet->picommand = NULL; 246 handlerSet->defaultcommand = NULL; 247 handlerSet->notationcommand = NULL; 248 handlerSet->externalentitycommand = NULL; 249 handlerSet->unknownencodingcommand = NULL; 250 handlerSet->commentCommand = NULL; 251 handlerSet->notStandaloneCommand = NULL; 252 handlerSet->startCdataSectionCommand = NULL; 253 handlerSet->endCdataSectionCommand = NULL; 254 handlerSet->elementDeclCommand = NULL; 255 handlerSet->attlistDeclCommand = NULL; 256 handlerSet->startDoctypeDeclCommand = NULL; 257 handlerSet->endDoctypeDeclCommand = NULL; 258 handlerSet->xmlDeclCommand = NULL; 259 handlerSet->entityDeclCommand = NULL; 260 return handlerSet; 261} 262 263/* 264 *---------------------------------------------------------------------------- 265 * 266 * CHandlerSetCreate -- 267 * 268 * Initializes a CHandlerSet. 269 * 270 * Results: 271 * None. 272 * 273 * Side effects: 274 * Mallocs memory for the 'name' of the structure, sets all 275 * handler functions to NULL and inits some other fields. 276 * 277 *---------------------------------------------------------------------------- 278 */ 279 280CHandlerSet* 281CHandlerSetCreate (name) 282 char *name; 283{ 284 CHandlerSet *handlerSet; 285 286 handlerSet = (CHandlerSet *) MALLOC (sizeof (CHandlerSet)); 287 handlerSet->name = tdomstrdup (name); 288 handlerSet->ignoreWhiteCDATAs = 0; 289 handlerSet->nextHandlerSet = NULL; 290 291 handlerSet->userData = NULL; 292 293 handlerSet->resetProc = NULL; 294 handlerSet->freeProc = NULL; 295 handlerSet->initParseProc = NULL; 296 handlerSet->parserResetProc = NULL; 297 298 handlerSet->elementstartcommand = NULL; 299 handlerSet->elementendcommand = NULL; 300 handlerSet->startnsdeclcommand = NULL; 301 handlerSet->endnsdeclcommand = NULL; 302 handlerSet->datacommand = NULL; 303 handlerSet->picommand = NULL; 304 handlerSet->defaultcommand = NULL; 305 handlerSet->notationcommand = NULL; 306 handlerSet->externalentitycommand = NULL; 307 handlerSet->unknownencodingcommand = NULL; 308 handlerSet->commentCommand = NULL; 309 handlerSet->notStandaloneCommand = NULL; 310 handlerSet->startCdataSectionCommand = NULL; 311 handlerSet->endCdataSectionCommand = NULL; 312 handlerSet->elementDeclCommand = NULL; 313 handlerSet->attlistDeclCommand = NULL; 314 handlerSet->startDoctypeDeclCommand = NULL; 315 handlerSet->endDoctypeDeclCommand = NULL; 316 handlerSet->xmlDeclCommand = NULL; 317 handlerSet->entityDeclCommand = NULL; 318 return handlerSet; 319} 320 321/* 322 *---------------------------------------------------------------------------- 323 * 324 * TclExpatObjCmd -- 325 * 326 * Creation command for expat class. 327 * 328 * Results: 329 * The name of the newly created parser instance. 330 * 331 * Side effects: 332 * This creates an expat parser. 333 * 334 *---------------------------------------------------------------------------- 335 */ 336 337int 338TclExpatObjCmd(dummy, interp, objc, objv) 339 ClientData dummy; 340 Tcl_Interp *interp; 341 int objc; 342 Tcl_Obj *CONST objv[]; 343{ 344 TclGenExpatInfo *genexpat; 345 int ns_mode = 0; 346 char *nsoption; 347 348 349 /* 350 * Create the data structures for this parser. 351 */ 352 353 if (!(genexpat = (TclGenExpatInfo *) MALLOC(sizeof(TclGenExpatInfo)))) { 354 FREE( (char*) genexpat); 355 Tcl_SetResult(interp, "unable to create parser", NULL); 356 return TCL_ERROR; 357 } 358 memset (genexpat, 0, sizeof (TclGenExpatInfo)); 359 genexpat->interp = interp; 360 genexpat->final = 1; 361 362 /* 363 * Find unique command name 364 */ 365 if (objc < 2) { 366 genexpat->name = FindUniqueCmdName(interp); 367 } else { 368 genexpat->name = objv[1]; 369 if (*(Tcl_GetString(genexpat->name)) != '-') { 370 Tcl_IncrRefCount(genexpat->name); 371 objv++; 372 objc--; 373 } else { 374 genexpat->name = FindUniqueCmdName(interp); 375 } 376 } 377 378 genexpat->paramentityparsing = XML_PARAM_ENTITY_PARSING_NEVER; 379 380 if (objc > 1) { 381 nsoption = Tcl_GetString(objv[1]); 382 if (strcmp(nsoption,"-namespace")==0) { 383 ns_mode = 1; 384 objv++; 385 objc--; 386 } 387 } 388 genexpat->ns_mode = ns_mode; 389 genexpat->nsSeparator = ':'; 390 391 if (TclExpatInitializeParser(interp, genexpat, 0) != TCL_OK) { 392 FREE( (char*) genexpat); 393 return TCL_ERROR; 394 } 395 396 /* 397 * Register a Tcl command for this parser instance. 398 */ 399 400 Tcl_CreateObjCommand(interp, Tcl_GetString(genexpat->name), 401 TclExpatInstanceCmd, (ClientData) genexpat, 402 TclExpatDeleteCmd); 403 /* 404 * Handle configuration options 405 */ 406 407 if (objc > 1) { 408 if (TclExpatConfigure(interp, genexpat, objc - 1, objv + 1) != TCL_OK) { 409 return TCL_ERROR; 410 } 411 } 412 413 Tcl_SetObjResult(interp, genexpat->name); 414 415 return TCL_OK; 416} 417 418 419/* 420 *---------------------------------------------------------------------------- 421 * 422 * FindUniqueCmdName -- 423 * 424 * Generate new command name in caller's namespace. 425 * 426 * Results: 427 * Returns newly allocated Tcl object containing name. 428 * 429 * Side effects: 430 * Allocates Tcl object. 431 * 432 *---------------------------------------------------------------------------- 433 */ 434 435static Tcl_Obj * 436FindUniqueCmdName(interp) 437 Tcl_Interp *interp; 438{ 439 Tcl_Obj *name; 440 Tcl_CmdInfo info; 441 char s[20]; 442 443 name = Tcl_NewStringObj("", 0); 444 Tcl_IncrRefCount(name); 445 446 do { 447 TDomThreaded(Tcl_MutexLock(&counterMutex);) 448 sprintf(s, "xmlparser%d", uniqueCounter++); 449 TDomThreaded(Tcl_MutexUnlock(&counterMutex);) 450 Tcl_SetStringObj(name, s, -1); 451 452 } while (Tcl_GetCommandInfo(interp, Tcl_GetString(name), &info)); 453 454 return name; 455} 456 457/* 458 *---------------------------------------------------------------------------- 459 * 460 * TclExpatInitializeParser -- 461 * 462 * Create or re-initializes (if it already exists) the expat 463 * parser and initialise (some of) the TclExpatInfo structure. 464 * 465 * Note that callback commands are not affected by this routine, 466 * to allow a reset to leave these intact. 467 * 468 * Results: 469 * A flag, signaling success or error. 470 * 471 * Side effects: 472 * Creates or reset an expat parser. 473 * Modifies TclExpatInfo fields. 474 * 475 *---------------------------------------------------------------------------- 476 */ 477 478static int 479TclExpatInitializeParser(interp, expat, resetOptions) 480 Tcl_Interp *interp; 481 TclGenExpatInfo *expat; 482 int resetOptions; 483{ 484 CHandlerSet *activeCHandlerSet; 485 ExpatElemContent *eContent, *eContentSave; 486 487 if (expat->parser) { 488 XML_ParserReset (expat->parser, NULL); 489 activeCHandlerSet = expat->firstCHandlerSet; 490 while (activeCHandlerSet) { 491 if (activeCHandlerSet->resetProc) { 492 activeCHandlerSet->resetProc (expat->interp, 493 activeCHandlerSet->userData); 494 } 495 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 496 } 497 } else { 498 if (expat->ns_mode) { 499 if (!(expat->parser = 500 XML_ParserCreate_MM(NULL, MEM_SUITE, &expat->nsSeparator))) { 501 Tcl_SetResult(interp, "unable to create expat parserNs", NULL); 502 return TCL_ERROR; 503 } 504 } else { 505 if (!(expat->parser = 506 XML_ParserCreate_MM(NULL, MEM_SUITE, NULL))) { 507 Tcl_SetResult(interp, "unable to create expat parser", NULL); 508 return TCL_ERROR; 509 } 510 } 511 } 512 513 expat->status = TCL_OK; 514 if (expat->result) { 515 Tcl_DecrRefCount (expat->result); 516 expat->result = NULL; 517 } 518 if (expat->cdata) { 519 Tcl_DecrRefCount (expat->cdata); 520 } 521 expat->cdata = NULL; 522 eContent = expat->eContents; 523 while (eContent) { 524 XML_FreeContentModel (expat->parser, eContent->content); 525 eContentSave = eContent; 526 eContent = eContent->next; 527 FREE((char *) eContentSave); 528 } 529 expat->eContents = NULL; 530 expat->finished = 0; 531 expat->parsingState = 0; 532 533 if (resetOptions) { 534 expat->final = 1; 535 expat->needWSCheck = 0; 536 expat->noexpand = 0; 537 expat->useForeignDTD = 0; 538 expat->paramentityparsing = XML_PARAM_ENTITY_PARSING_NEVER; 539 if (expat->baseURI) { 540 Tcl_DecrRefCount (expat->baseURI); 541 expat->baseURI = NULL; 542 } 543 } 544 545 if (expat->baseURI) { 546 XML_SetBase (expat->parser, Tcl_GetString (expat->baseURI)); 547 Tcl_DecrRefCount (expat->baseURI); 548 expat->baseURI = NULL; 549 } 550 551 /* 552 * Set handlers for the parser to routines in this module. 553 */ 554 555 XML_SetElementHandler(expat->parser, 556 (XML_StartElementHandler) TclGenExpatElementStartHandler, 557 (XML_EndElementHandler) TclGenExpatElementEndHandler); 558 XML_SetNamespaceDeclHandler(expat->parser, 559 (XML_StartNamespaceDeclHandler) TclGenExpatStartNamespaceDeclHandler, 560 (XML_EndNamespaceDeclHandler) TclGenExpatEndNamespaceDeclHandler); 561 XML_SetCharacterDataHandler(expat->parser, 562 (XML_CharacterDataHandler) TclGenExpatCharacterDataHandler); 563 XML_SetProcessingInstructionHandler(expat->parser, 564 (XML_ProcessingInstructionHandler) TclGenExpatProcessingInstructionHandler); 565 XML_SetDefaultHandlerExpand(expat->parser, 566 (XML_DefaultHandler) TclGenExpatDefaultHandler); 567 568 XML_SetNotationDeclHandler(expat->parser, 569 (XML_NotationDeclHandler) TclGenExpatNotationDeclHandler); 570 XML_SetExternalEntityRefHandler(expat->parser, 571 (XML_ExternalEntityRefHandler) TclGenExpatExternalEntityRefHandler); 572 XML_SetUnknownEncodingHandler(expat->parser, 573 (XML_UnknownEncodingHandler) TclGenExpatUnknownEncodingHandler, 574 (void *) expat); 575 576 577 XML_SetCommentHandler(expat->parser, TclGenExpatCommentHandler); 578 579 XML_SetNotStandaloneHandler(expat->parser, TclGenExpatNotStandaloneHandler); 580 581 XML_SetCdataSectionHandler(expat->parser, TclGenExpatStartCdataSectionHandler, 582 TclGenExpatEndCdataSectionHandler); 583 584 XML_SetElementDeclHandler(expat->parser, TclGenExpatElementDeclHandler); 585 586 XML_SetAttlistDeclHandler(expat->parser, TclGenExpatAttlistDeclHandler); 587 588 XML_SetDoctypeDeclHandler(expat->parser, 589 TclGenExpatStartDoctypeDeclHandler, 590 TclGenExpatEndDoctypeDeclHandler); 591 592 XML_SetXmlDeclHandler (expat->parser, TclGenExpatXmlDeclHandler); 593 594 XML_SetEntityDeclHandler (expat->parser, 595 TclGenExpatEntityDeclHandler); 596 if (expat->noexpand) { 597 XML_SetDefaultHandlerExpand(expat->parser, NULL); 598 XML_SetDefaultHandler(expat->parser, 599 (XML_DefaultHandler) TclGenExpatDefaultHandler); 600 } else { 601 XML_SetDefaultHandler(expat->parser, NULL); 602 XML_SetDefaultHandlerExpand(expat->parser, 603 (XML_DefaultHandler) TclGenExpatDefaultHandler); 604 } 605 606 XML_SetUserData(expat->parser, (void *) expat); 607 608 return TCL_OK; 609} 610 611/* 612 *---------------------------------------------------------------------------- 613 * 614 * TclExpatFreeParser -- 615 * 616 * Destroy the expat parser structure and frees the stored content models, 617 * if there one. 618 * 619 * Results: 620 * None. 621 * 622 * Side effects: 623 * Frees any memory allocated for the XML parser and (if still present) 624 * the stored content models. 625 * 626 *---------------------------------------------------------------------------- 627 */ 628 629static void 630TclExpatFreeParser(expat) 631 TclGenExpatInfo *expat; 632{ 633 ExpatElemContent *eContent, *eContentSave; 634 635 eContent = expat->eContents; 636 while (eContent) { 637 XML_FreeContentModel (expat->parser, eContent->content); 638 eContentSave = eContent; 639 eContent = eContent->next; 640 FREE((char *) eContentSave); 641 } 642 expat->eContents = NULL; 643 644 XML_ParserFree(expat->parser); 645 expat->parser = NULL; 646} 647 648/* 649 *---------------------------------------------------------------------------- 650 * 651 * TclExpatInstanceCmd -- 652 * 653 * Implements instance command for expat class objects. 654 * 655 * Results: 656 * Depends on the method. 657 * 658 * Side effects: 659 * Depends on the method. 660 * 661 *---------------------------------------------------------------------------- 662 */ 663 664static int 665TclExpatInstanceCmd (clientData, interp, objc, objv) 666 ClientData clientData; 667 Tcl_Interp *interp; 668 int objc; 669 Tcl_Obj *CONST objv[]; 670{ 671 TclGenExpatInfo *expat = (TclGenExpatInfo *) clientData; 672 char *data; 673 int len = 0, optionIndex, result = TCL_OK; 674 675 static CONST84 char *options[] = { 676 "configure", "cget", "free", "get", 677 "parse", "parsechannel", "parsefile", "reset", NULL 678 }; 679 enum options { 680 EXPAT_CONFIGURE, EXPAT_CGET, EXPAT_FREE, EXPAT_GET, 681 EXPAT_PARSE, EXPAT_PARSECHANNEL, EXPAT_PARSEFILE, EXPAT_RESET 682 }; 683 684 685 if (objc < 2) { 686 Tcl_SetResult (interp, 687 "wrong # args: should be \"parserCmd method ?arg ...?\"", 688 TCL_STATIC); 689 return TCL_ERROR; 690 } 691 if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, 692 &optionIndex) != TCL_OK) { 693 return TCL_ERROR; 694 } 695 696 switch ((enum options) optionIndex) { 697 case EXPAT_CONFIGURE: 698 699 if (objc < 3) { 700 Tcl_SetResult (interp, "wrong # args: should be " 701 "\"parserCmd configure <option> ?value ...?\"", 702 TCL_STATIC); 703 return TCL_ERROR; 704 } 705 result = TclExpatConfigure(interp, expat, objc - 2, objv + 2); 706 break; 707 708 case EXPAT_CGET: 709 710 CheckArgs (3,5,2, "?-handlerset handlersetname? switch"); 711 result = TclExpatCget(interp, expat, objc - 2, objv + 2); 712 break; 713 714 case EXPAT_FREE: 715 716 CheckArgs (2,2,1,""); 717 718 if (expat->parsingState > 1) { 719 Tcl_SetResult (interp, "parser freeing not allowed from within " 720 "callback", TCL_STATIC); 721 result = TCL_ERROR; 722 } else { 723 Tcl_DeleteCommand(interp, Tcl_GetString(expat->name)); 724 result = TCL_OK; 725 } 726 break; 727 728 case EXPAT_GET: 729 730 /* ericm@scriptics.com, 1999.6.28 */ 731 result = TclExpatGet(interp, expat, objc - 2, objv + 2); 732 break; 733 734 case EXPAT_PARSE: 735 736 CheckArgs (3,3,2,"<XML-String>"); 737 if (expat->parsingState > 1) { 738 Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC); 739 result = TCL_ERROR; 740 break; 741 } 742 data = Tcl_GetStringFromObj(objv[2], &len); 743 result = TclExpatParse(interp, expat, data, len, EXPAT_INPUT_STRING); 744 if (expat->final || result != TCL_OK) { 745 expat->final = 1; 746 expat->finished = 1; 747 } 748 break; 749 750 case EXPAT_PARSECHANNEL: 751 752 CheckArgs (3,3,2,"<Tcl-Channel>"); 753 if (expat->parsingState > 1) { 754 Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC); 755 result = TCL_ERROR; 756 break; 757 } 758 data = Tcl_GetString(objv[2]); 759 result = TclExpatParse(interp, expat, data, len, EXPAT_INPUT_CHANNEL); 760 if (expat->final || result != TCL_OK) { 761 expat->final = 1; 762 expat->finished = 1; 763 } 764 break; 765 766 case EXPAT_PARSEFILE: 767 768 CheckArgs (3,3,2, "<filename>"); 769 if (expat->parsingState > 1) { 770 Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC); 771 result = TCL_ERROR; 772 break; 773 } 774 data = Tcl_GetString(objv[2]); 775 result = TclExpatParse (interp, expat, data, len, 776 EXPAT_INPUT_FILENAME); 777 if (expat->final || result != TCL_OK) { 778 expat->final = 1; 779 expat->finished = 1; 780 } 781 break; 782 783 case EXPAT_RESET: 784 785 CheckArgs (2,2,1,""); 786 787 if (expat->parsingState > 1) { 788 Tcl_SetResult (interp, "parser reset not allowed from within " 789 "callback", TCL_STATIC); 790 result = TCL_ERROR; 791 } else { 792 result = TclExpatInitializeParser (interp, expat, 1); 793 } 794 break; 795 796 } 797 798 return result; 799} 800 801 802/* 803 *---------------------------------------------------------------------------- 804 * 805 * TclExpatParse -- 806 * 807 * Wrapper to invoke expat parser and check return result. 808 * 809 * Results: 810 * TCL_OK if no errors, TCL_ERROR otherwise. 811 * 812 * Side effects: 813 * Sets interpreter result as appropriate. 814 * 815 *---------------------------------------------------------------------------- 816 */ 817 818static int 819TclExpatParse (interp, expat, data, len, type) 820 Tcl_Interp *interp; 821 TclGenExpatInfo *expat; 822 char *data; 823 int len; 824 TclExpat_InputType type; 825{ 826 int result, mode, done; 827 size_t bytesread; 828 char s[255], buf[8*1024]; 829 int fd; 830 XML_Parser parser; 831 Tcl_Channel channel = NULL; 832 CHandlerSet *activeCHandlerSet; 833#if !TclOnly8Bits 834 Tcl_Obj *bufObj = NULL; 835 Tcl_DString dStr; 836 int useBinary; 837 char *str; 838#endif 839 840 if (expat->finished) { 841 if ((result = TclExpatInitializeParser (interp, expat, 0)) != TCL_OK) 842 return TCL_ERROR; 843 } 844 845 if (!expat->parsingState) { 846 activeCHandlerSet = expat->firstCHandlerSet; 847 while (activeCHandlerSet) { 848 if (activeCHandlerSet->initParseProc) { 849 activeCHandlerSet->initParseProc (expat->interp, 850 activeCHandlerSet->userData); 851 } 852 if (activeCHandlerSet->ignoreWhiteCDATAs) { 853 expat->needWSCheck = 1; 854 } 855 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 856 } 857 expat->parsingState = 1; 858 } 859 860 Tcl_ResetResult (interp); 861 result = 1; 862 switch (type) { 863 864 case EXPAT_INPUT_STRING: 865 expat->parsingState = 2; 866 result = XML_Parse(expat->parser, 867 data, len, 868 expat->final); 869 expat->parsingState = 1; 870 break; 871 872 case EXPAT_INPUT_CHANNEL: 873 channel = Tcl_GetChannel (interp, data, &mode); 874 if (channel == NULL) { 875 Tcl_ResetResult (interp); 876 Tcl_AppendResult (interp, "\"", data, 877 "\" isn't a Tcl channel in this interpreter", 878 (char *) NULL); 879 return TCL_ERROR; 880 } 881 if (!(mode & TCL_READABLE)) { 882 Tcl_ResetResult (interp); 883 Tcl_AppendResult (interp, "channel \"", data, 884 "wasn't opened for reading", (char *) NULL); 885 return TCL_ERROR; 886 } 887#if !TclOnly8Bits 888 Tcl_DStringInit (&dStr); 889 if (Tcl_GetChannelOption (interp, channel, "-encoding", &dStr) 890 != TCL_OK) { 891 return TCL_ERROR; 892 } 893 if (strcmp (Tcl_DStringValue (&dStr), "binary")==0 ) useBinary = 1; 894 else useBinary = 0; 895 Tcl_DStringFree (&dStr); 896 expat->parsingState = 2; 897 if (useBinary) { 898 do { 899 bytesread = Tcl_Read (channel, buf, sizeof (buf)); 900 done = bytesread < sizeof (buf); 901 if (done) { 902 result = XML_Parse (expat->parser, buf, bytesread, done); 903 } else { 904 if (!XML_Parse (expat->parser, buf, bytesread, done)) { 905 result = 0; 906 break; 907 } 908 } 909 } while (!done); 910 } else { 911 bufObj = Tcl_NewObj(); 912 Tcl_IncrRefCount (bufObj); 913 Tcl_SetObjLength (bufObj, 6144); 914 do { 915 len = Tcl_ReadChars (channel, bufObj, 1024, 0); 916 done = (len < 1024); 917 str = Tcl_GetStringFromObj (bufObj, &len); 918 if (!XML_Parse (expat->parser, str, len, done)) { 919 result = 0; 920 break; 921 } 922 } while (!done); 923 /* In case of a parsing error we need the string rep of the 924 bufObj until the error reporting is done (otherwise, 925 calling XML_GetCurrentLineNumber() results in invalid mem 926 reads */ 927 if (result) { 928 Tcl_DecrRefCount (bufObj); 929 } 930 } 931#else 932 expat->parsingState = 2; 933 do { 934 bytesread = Tcl_Read (channel, buf, sizeof (buf)); 935 done = bytesread < sizeof (buf); 936 if (done) { 937 result = XML_Parse (expat->parser, buf, bytesread, done); 938 } else { 939 if (!XML_Parse (expat->parser, buf, bytesread, done)) { 940 result = 0; 941 break; 942 } 943 } 944 } while (!done); 945#endif /* !TclOnly8Bits */ 946 expat->parsingState = 1; 947 break; 948 949 case EXPAT_INPUT_FILENAME: 950 fd = open(data, O_BINARY|O_RDONLY); 951 if (fd < 0) { 952 Tcl_ResetResult (interp); 953 Tcl_AppendResult (interp, "error opening file \"", 954 data, "\"", (char *) NULL); 955 return TCL_ERROR; 956 } 957 parser = expat->parser; 958 expat->parsingState = 2; 959 for (;;) { 960 int nread; 961 char *fbuf = XML_GetBuffer (parser, READ_SIZE); 962 if (!fbuf) { 963 close (fd); 964 Tcl_ResetResult (interp); 965 Tcl_SetResult (interp, "Out of memory\n", NULL); 966 expat->parsingState = 1; 967 return TCL_ERROR; 968 } 969 nread = read(fd, fbuf, READ_SIZE); 970 if (nread < 0) { 971 close (fd); 972 Tcl_ResetResult (interp); 973 Tcl_AppendResult (interp, "error reading from file \"", 974 data, "\"", (char *) NULL); 975 expat->parsingState = 1; 976 return TCL_ERROR; 977 } 978 if (!XML_ParseBuffer (parser, nread, nread == 0)) { 979 close (fd); 980 result = 0; 981 break; 982 } 983 if (nread == 0) { 984 close(fd); 985 break; 986 } 987 } 988 expat->parsingState = 1; 989 break; 990 } 991 992 if (!result) { 993 if (expat->status == ERROR_IN_EXTREFHANDLER) { 994 Tcl_SetObjResult (interp, expat->result); 995 } 996 else { 997 Tcl_ResetResult(interp); 998 sprintf(s, "%ld", XML_GetCurrentLineNumber(expat->parser)); 999 Tcl_AppendResult(interp, "error \"", 1000 XML_ErrorString(XML_GetErrorCode(expat->parser)), 1001 "\" at line ", s, " character ", NULL); 1002 sprintf(s, "%ld", XML_GetCurrentColumnNumber(expat->parser)); 1003 Tcl_AppendResult(interp, s, NULL); 1004 } 1005#if !TclOnly8Bits 1006 if (bufObj) { 1007 Tcl_DecrRefCount (bufObj); 1008 } 1009#endif 1010 return TCL_ERROR; 1011 } 1012 switch (expat->status) { 1013 case TCL_OK: 1014 case TCL_BREAK: 1015 case TCL_CONTINUE: 1016 Tcl_ResetResult(interp); 1017 return TCL_OK; 1018 1019 case TCL_ERROR: 1020 Tcl_SetObjResult(interp, expat->result); 1021 return TCL_ERROR; 1022 1023 default: 1024 /* 1025 * Propagate application-specific error condition. 1026 * Patch by Marshall Rose <mrose@dbc.mtview.ca.us> 1027 */ 1028 Tcl_SetObjResult(interp, expat->result); 1029 return expat->status; 1030 } 1031} 1032 1033/* 1034 *---------------------------------------------------------------------------- 1035 * 1036 * TclExpatConfigure -- 1037 * 1038 * Implements instance command for expat class objects. 1039 * 1040 * Results: 1041 * Depends on the method. 1042 * 1043 * Side effects: 1044 * Depends on the method. 1045 * 1046 *---------------------------------------------------------------------------- 1047 */ 1048 1049static int 1050TclExpatConfigure (interp, expat, objc, objv) 1051 Tcl_Interp *interp; 1052 TclGenExpatInfo *expat; 1053 int objc; 1054 Tcl_Obj *CONST objv[]; 1055{ 1056 static CONST84 char *switches[] = { 1057 "-final", 1058 "-baseurl", 1059 "-elementstartcommand", 1060 "-elementendcommand", 1061 "-characterdatacommand", 1062 "-processinginstructioncommand", 1063 "-defaultcommand", 1064 "-notationdeclcommand", 1065 "-externalentitycommand", 1066 "-unknownencodingcommand", 1067 "-startnamespacedeclcommand", 1068 "-endnamespacedeclcommand", 1069 "-ignorewhitecdata", 1070 "-useForeignDTD", 1071 1072 "-commentcommand", 1073 "-notstandalonecommand", 1074 "-startcdatasectioncommand", 1075 "-endcdatasectioncommand", 1076 "-elementdeclcommand", 1077 "-attlistdeclcommand", 1078 "-startdoctypedeclcommand", 1079 "-enddoctypedeclcommand", 1080 "-xmldeclcommand", 1081 "-paramentityparsing", 1082 "-entitydeclcommand", 1083 "-ignorewhitespace", 1084 "-handlerset", 1085 "-noexpand", 1086 (char *) NULL 1087 }; 1088 enum switches { 1089 EXPAT_FINAL, EXPAT_BASE, 1090 EXPAT_ELEMENTSTARTCMD, EXPAT_ELEMENTENDCMD, 1091 EXPAT_DATACMD, EXPAT_PICMD, 1092 EXPAT_DEFAULTCMD, 1093 EXPAT_NOTATIONCMD, 1094 EXPAT_EXTERNALENTITYCMD, EXPAT_UNKNOWNENCODINGCMD, 1095 EXPAT_STARTNAMESPACEDECLCMD, 1096 EXPAT_ENDNAMESPACEDECLCMD, 1097 EXPAT_IGNOREWHITECDATA, 1098 EXPAT_USEFOREIGNDTD, 1099 1100 EXPAT_COMMENTCMD, EXPAT_NOTSTANDALONECMD, 1101 EXPAT_STARTCDATASECTIONCMD, EXPAT_ENDCDATASECTIONCMD, 1102 EXPAT_ELEMENTDECLCMD, EXPAT_ATTLISTDECLCMD, 1103 EXPAT_STARTDOCTYPEDECLCMD, EXPAT_ENDDOCTYPEDECLCMD, 1104 EXPAT_XMLDECLCMD, 1105 EXPAT_PARAMENTITYPARSING, 1106 EXPAT_ENTITYDECLCOMMAND, 1107 EXPAT_NOWHITESPACE, 1108 EXPAT_HANDLERSET, 1109 EXPAT_NOEXPAND 1110 }; 1111 static CONST84 char *paramEntityParsingValues[] = { 1112 "always", 1113 "never", 1114 "notstandalone", 1115 (char *) NULL 1116 }; 1117 enum paramEntityParsingValues { 1118 EXPAT_PARAMENTITYPARSINGALWAYS, 1119 EXPAT_PARAMENTITYPARSINGNEVER, 1120 EXPAT_PARAMENTITYPARSINGNOTSTANDALONE 1121 }; 1122 int optionIndex, value, bool; 1123 Tcl_Obj *CONST *objPtr = objv; 1124 Tcl_CmdInfo cmdInfo; 1125 int rc; 1126 char *handlerSetName = NULL; 1127 TclHandlerSet *tmpTclHandlerSet, *activeTclHandlerSet = NULL; 1128 1129 if (expat->firstTclHandlerSet 1130 && (strcmp ("default", expat->firstTclHandlerSet->name)==0)) { 1131 activeTclHandlerSet = expat->firstTclHandlerSet; 1132 } 1133 while (objc > 1) { 1134 if (Tcl_GetIndexFromObj(interp, objPtr[0], switches, 1135 "switch", 0, &optionIndex) != TCL_OK) { 1136 return TCL_ERROR; 1137 } 1138 switch ((enum switches) optionIndex) { 1139 case EXPAT_FINAL: /* -final */ 1140 1141 if (Tcl_GetBooleanFromObj(interp, objPtr[1], &bool) != TCL_OK) { 1142 return TCL_ERROR; 1143 } 1144 1145 expat->final = bool; 1146 break; 1147 1148 case EXPAT_BASE: /* -base */ 1149 1150 if (expat->finished) { 1151 if (expat->baseURI) { 1152 Tcl_DecrRefCount (expat->baseURI); 1153 } 1154 expat->baseURI = objPtr[1]; 1155 Tcl_IncrRefCount (expat->baseURI); 1156 } else { 1157 if (XML_SetBase(expat->parser, Tcl_GetString(objPtr[1])) 1158 == 0) { 1159 Tcl_SetResult(interp, "unable to set base URL", NULL); 1160 return TCL_ERROR; 1161 } 1162 } 1163 break; 1164 1165 case EXPAT_ELEMENTSTARTCMD: /* -elementstartcommand */ 1166 1167 CheckDefaultTclHandlerSet; 1168 if (activeTclHandlerSet->elementstartcommand != NULL) { 1169 Tcl_DecrRefCount(activeTclHandlerSet->elementstartcommand); 1170 } 1171 1172 activeTclHandlerSet->elementstartcommand = objPtr[1]; 1173 Tcl_IncrRefCount(activeTclHandlerSet->elementstartcommand); 1174 rc = Tcl_GetCommandInfo(interp, Tcl_GetString(objPtr[1]), &cmdInfo); 1175 if (rc && cmdInfo.isNativeObjectProc) { 1176 activeTclHandlerSet->elementstartObjProc = cmdInfo.objProc; 1177 activeTclHandlerSet->elementstartclientData 1178 = cmdInfo.objClientData; 1179 } else { 1180 /* hmoreau 22 May 2003 */ 1181 activeTclHandlerSet->elementstartObjProc = NULL; 1182 } 1183 break; 1184 1185 case EXPAT_ELEMENTENDCMD: /* -elementendcommand */ 1186 1187 CheckDefaultTclHandlerSet; 1188 if (activeTclHandlerSet->elementendcommand != NULL) { 1189 Tcl_DecrRefCount(activeTclHandlerSet->elementendcommand); 1190 } 1191 1192 activeTclHandlerSet->elementendcommand = objPtr[1]; 1193 Tcl_IncrRefCount(activeTclHandlerSet->elementendcommand); 1194 rc = Tcl_GetCommandInfo(interp, Tcl_GetString(objPtr[1]), &cmdInfo); 1195 if (rc && cmdInfo.isNativeObjectProc) { 1196 activeTclHandlerSet->elementendObjProc = cmdInfo.objProc; 1197 activeTclHandlerSet->elementendclientData = cmdInfo.objClientData; 1198 } else { 1199 /* hmoreau 22 May 2003 */ 1200 activeTclHandlerSet->elementendObjProc = NULL; 1201 } 1202 break; 1203 1204 case EXPAT_STARTNAMESPACEDECLCMD: /* -startnamespacedeclcommand */ 1205 1206 CheckDefaultTclHandlerSet; 1207 if (activeTclHandlerSet->startnsdeclcommand != NULL) { 1208 Tcl_DecrRefCount(activeTclHandlerSet->startnsdeclcommand); 1209 } 1210 1211 activeTclHandlerSet->startnsdeclcommand = objPtr[1]; 1212 Tcl_IncrRefCount(activeTclHandlerSet->startnsdeclcommand); 1213 1214 break; 1215 1216 case EXPAT_ENDNAMESPACEDECLCMD: /* -endnamespacedeclcommand */ 1217 1218 CheckDefaultTclHandlerSet; 1219 if (activeTclHandlerSet->endnsdeclcommand != NULL) { 1220 Tcl_DecrRefCount(activeTclHandlerSet->endnsdeclcommand); 1221 } 1222 1223 activeTclHandlerSet->endnsdeclcommand = objPtr[1]; 1224 Tcl_IncrRefCount(activeTclHandlerSet->endnsdeclcommand); 1225 1226 break; 1227 1228 case EXPAT_DATACMD: /* -characterdatacommand */ 1229 1230 CheckDefaultTclHandlerSet; 1231 if (activeTclHandlerSet->datacommand != NULL) { 1232 Tcl_DecrRefCount(activeTclHandlerSet->datacommand); 1233 } 1234 1235 activeTclHandlerSet->datacommand = objPtr[1]; 1236 Tcl_IncrRefCount(activeTclHandlerSet->datacommand); 1237 rc = Tcl_GetCommandInfo (interp, Tcl_GetString(objPtr[1]), &cmdInfo); 1238 if (rc && cmdInfo.isNativeObjectProc) { 1239 activeTclHandlerSet->datacommandObjProc = cmdInfo.objProc; 1240 activeTclHandlerSet->datacommandclientData = cmdInfo.objClientData; 1241 } else { 1242 /* hmoreau 22 May 2003 */ 1243 activeTclHandlerSet->datacommandObjProc = NULL; 1244 } 1245 break; 1246 1247 case EXPAT_PICMD: /* -processinginstructioncommand */ 1248 1249 CheckDefaultTclHandlerSet; 1250 if (activeTclHandlerSet->picommand != NULL) { 1251 Tcl_DecrRefCount(activeTclHandlerSet->picommand); 1252 } 1253 1254 activeTclHandlerSet->picommand = objPtr[1]; 1255 Tcl_IncrRefCount(activeTclHandlerSet->picommand); 1256 1257 break; 1258 1259 case EXPAT_DEFAULTCMD: /* -defaultcommand */ 1260 1261 CheckDefaultTclHandlerSet; 1262 if (activeTclHandlerSet->defaultcommand != NULL) { 1263 Tcl_DecrRefCount(activeTclHandlerSet->defaultcommand); 1264 } 1265 1266 activeTclHandlerSet->defaultcommand = objPtr[1]; 1267 Tcl_IncrRefCount(activeTclHandlerSet->defaultcommand); 1268 1269 break; 1270 1271 case EXPAT_NOTATIONCMD: /* -notationdeclcommand */ 1272 1273 CheckDefaultTclHandlerSet; 1274 if (activeTclHandlerSet->notationcommand != NULL) { 1275 Tcl_DecrRefCount(activeTclHandlerSet->notationcommand); 1276 } 1277 1278 activeTclHandlerSet->notationcommand = objPtr[1]; 1279 Tcl_IncrRefCount(activeTclHandlerSet->notationcommand); 1280 1281 break; 1282 1283 case EXPAT_EXTERNALENTITYCMD: /* -externalentitycommand */ 1284 1285 CheckDefaultTclHandlerSet; 1286 if (activeTclHandlerSet->externalentitycommand != NULL) { 1287 Tcl_DecrRefCount(activeTclHandlerSet->externalentitycommand); 1288 } 1289 1290 activeTclHandlerSet->externalentitycommand = objPtr[1]; 1291 Tcl_IncrRefCount(activeTclHandlerSet->externalentitycommand); 1292 1293 break; 1294 1295 case EXPAT_UNKNOWNENCODINGCMD: /* -unknownencodingcommand */ 1296 1297 /* Not implemented */ 1298 break; 1299 1300 CheckDefaultTclHandlerSet; 1301 if (activeTclHandlerSet->unknownencodingcommand != NULL) { 1302 Tcl_DecrRefCount(activeTclHandlerSet->unknownencodingcommand); 1303 } 1304 1305 activeTclHandlerSet->unknownencodingcommand = objPtr[1]; 1306 Tcl_IncrRefCount(activeTclHandlerSet->unknownencodingcommand); 1307 1308 break; 1309 1310 case EXPAT_NOWHITESPACE: 1311 case EXPAT_IGNOREWHITECDATA: /* -ignorewhitecdata */ 1312 1313 CheckDefaultTclHandlerSet; 1314 if (Tcl_GetBooleanFromObj (interp, objPtr[1], 1315 &activeTclHandlerSet->ignoreWhiteCDATAs) 1316 != TCL_OK) { 1317 return TCL_ERROR; 1318 } 1319 if (activeTclHandlerSet->ignoreWhiteCDATAs) { 1320 expat->needWSCheck = 1; 1321 } 1322 break; 1323 1324 case EXPAT_USEFOREIGNDTD: /* -useForeignDTD */ 1325 1326 if (Tcl_GetBooleanFromObj (interp, objPtr[1], &bool) != TCL_OK) { 1327 return TCL_ERROR; 1328 } 1329 /* Cannot be changed after parsing as started (which is kind of 1330 understandable). We silently ignore return code. */ 1331 XML_UseForeignDTD (expat->parser, (unsigned char)bool); 1332 break; 1333 1334 case EXPAT_COMMENTCMD: /* -commentcommand */ 1335 /* ericm@scriptics.com */ 1336 CheckDefaultTclHandlerSet; 1337 if (activeTclHandlerSet->commentCommand != NULL) { 1338 Tcl_DecrRefCount(activeTclHandlerSet->commentCommand); 1339 } 1340 1341 activeTclHandlerSet->commentCommand = objPtr[1]; 1342 Tcl_IncrRefCount(activeTclHandlerSet->commentCommand); 1343 1344 break; 1345 1346 case EXPAT_NOTSTANDALONECMD: /* -notstandalonecommand */ 1347 /* ericm@scriptics.com */ 1348 CheckDefaultTclHandlerSet; 1349 if (activeTclHandlerSet->notStandaloneCommand != NULL) { 1350 Tcl_DecrRefCount(activeTclHandlerSet->notStandaloneCommand); 1351 } 1352 1353 activeTclHandlerSet->notStandaloneCommand = objPtr[1]; 1354 Tcl_IncrRefCount(activeTclHandlerSet->notStandaloneCommand); 1355 1356 break; 1357 1358 case EXPAT_STARTCDATASECTIONCMD: /* -startcdatasectioncommand */ 1359 /* ericm@scriptics */ 1360 CheckDefaultTclHandlerSet; 1361 if (activeTclHandlerSet->startCdataSectionCommand != NULL) { 1362 Tcl_DecrRefCount(activeTclHandlerSet->startCdataSectionCommand); 1363 } 1364 1365 activeTclHandlerSet->startCdataSectionCommand = objPtr[1]; 1366 Tcl_IncrRefCount(activeTclHandlerSet->startCdataSectionCommand); 1367 1368 break; 1369 1370 case EXPAT_ENDCDATASECTIONCMD: /* -endcdatasectioncommand */ 1371 /* ericm@scriptics */ 1372 CheckDefaultTclHandlerSet; 1373 if (activeTclHandlerSet->endCdataSectionCommand != NULL) { 1374 Tcl_DecrRefCount(activeTclHandlerSet->endCdataSectionCommand); 1375 } 1376 1377 activeTclHandlerSet->endCdataSectionCommand = objPtr[1]; 1378 Tcl_IncrRefCount(activeTclHandlerSet->endCdataSectionCommand); 1379 1380 break; 1381 1382 case EXPAT_ELEMENTDECLCMD: /* -elementdeclcommand */ 1383 /* ericm@scriptics.com */ 1384 CheckDefaultTclHandlerSet; 1385 if (activeTclHandlerSet->elementDeclCommand != NULL) { 1386 Tcl_DecrRefCount(activeTclHandlerSet->elementDeclCommand); 1387 } 1388 1389 activeTclHandlerSet->elementDeclCommand = objPtr[1]; 1390 Tcl_IncrRefCount(activeTclHandlerSet->elementDeclCommand); 1391 1392 break; 1393 1394 case EXPAT_ATTLISTDECLCMD: /* -attlistdeclcommand */ 1395 /* ericm@scriptics.com */ 1396 CheckDefaultTclHandlerSet; 1397 if (activeTclHandlerSet->attlistDeclCommand != NULL) { 1398 Tcl_DecrRefCount(activeTclHandlerSet->attlistDeclCommand); 1399 } 1400 1401 activeTclHandlerSet->attlistDeclCommand = objPtr[1]; 1402 Tcl_IncrRefCount(activeTclHandlerSet->attlistDeclCommand); 1403 1404 break; 1405 1406 case EXPAT_STARTDOCTYPEDECLCMD: /* -startdoctypedeclcommand */ 1407 /* ericm@scriptics.com */ 1408 CheckDefaultTclHandlerSet; 1409 if (activeTclHandlerSet->startDoctypeDeclCommand != NULL) { 1410 Tcl_DecrRefCount(activeTclHandlerSet->startDoctypeDeclCommand); 1411 } 1412 1413 activeTclHandlerSet->startDoctypeDeclCommand = objPtr[1]; 1414 Tcl_IncrRefCount(activeTclHandlerSet->startDoctypeDeclCommand); 1415 1416 break; 1417 1418 case EXPAT_ENDDOCTYPEDECLCMD: /* -enddoctypedeclcommand */ 1419 /* ericm@scriptics.com */ 1420 CheckDefaultTclHandlerSet; 1421 if (activeTclHandlerSet->endDoctypeDeclCommand != NULL) { 1422 Tcl_DecrRefCount(activeTclHandlerSet->endDoctypeDeclCommand); 1423 } 1424 1425 activeTclHandlerSet->endDoctypeDeclCommand = objPtr[1]; 1426 Tcl_IncrRefCount(activeTclHandlerSet->endDoctypeDeclCommand); 1427 1428 break; 1429 1430 case EXPAT_XMLDECLCMD: /* -xmlDeclCommand */ 1431 CheckDefaultTclHandlerSet; 1432 if (activeTclHandlerSet->xmlDeclCommand != NULL) { 1433 Tcl_DecrRefCount (activeTclHandlerSet->xmlDeclCommand); 1434 } 1435 1436 activeTclHandlerSet->xmlDeclCommand = objPtr[1]; 1437 Tcl_IncrRefCount (activeTclHandlerSet->xmlDeclCommand); 1438 1439 break; 1440 1441 case EXPAT_ENTITYDECLCOMMAND: /* -entitydeclcommand */ 1442 CheckDefaultTclHandlerSet; 1443 if (activeTclHandlerSet->entityDeclCommand != NULL) { 1444 Tcl_DecrRefCount (activeTclHandlerSet->entityDeclCommand); 1445 } 1446 1447 activeTclHandlerSet->entityDeclCommand = objPtr[1]; 1448 Tcl_IncrRefCount (activeTclHandlerSet->entityDeclCommand); 1449 1450 break; 1451 1452 case EXPAT_PARAMENTITYPARSING: /* -paramentityparsing */ 1453 /* ericm@scriptics */ 1454 if (Tcl_GetIndexFromObj(interp, objPtr[1], paramEntityParsingValues, 1455 "value", 0, &value) != TCL_OK) { 1456 return TCL_ERROR; 1457 } 1458 switch ((enum paramEntityParsingValues) value) { 1459 case EXPAT_PARAMENTITYPARSINGALWAYS: 1460 XML_SetParamEntityParsing(expat->parser, 1461 XML_PARAM_ENTITY_PARSING_ALWAYS); 1462 expat->paramentityparsing = XML_PARAM_ENTITY_PARSING_ALWAYS; 1463 break; 1464 case EXPAT_PARAMENTITYPARSINGNEVER: 1465 XML_SetParamEntityParsing(expat->parser, 1466 XML_PARAM_ENTITY_PARSING_NEVER); 1467 expat->paramentityparsing = XML_PARAM_ENTITY_PARSING_NEVER; 1468 break; 1469 case EXPAT_PARAMENTITYPARSINGNOTSTANDALONE: 1470 XML_SetParamEntityParsing(expat->parser, 1471 XML_PARAM_ENTITY_PARSING_UNLESS_STANDALONE); 1472 expat->paramentityparsing = 1473 XML_PARAM_ENTITY_PARSING_UNLESS_STANDALONE; 1474 break; 1475 } 1476 break; 1477 1478 case EXPAT_HANDLERSET: 1479 if ((handlerSetName = Tcl_GetString(objPtr[1])) == NULL) { 1480 return TCL_ERROR; 1481 } 1482 activeTclHandlerSet = expat->firstTclHandlerSet; 1483 while (activeTclHandlerSet) { 1484 if (strcmp (handlerSetName, activeTclHandlerSet->name) == 0) { 1485 break; 1486 } 1487 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 1488 } 1489 if (!activeTclHandlerSet) { 1490 activeTclHandlerSet = CreateTclHandlerSet (handlerSetName); 1491 if (!expat->firstTclHandlerSet) { 1492 expat->firstTclHandlerSet = activeTclHandlerSet; 1493 } 1494 else { 1495 tmpTclHandlerSet = expat->firstTclHandlerSet; 1496 while (tmpTclHandlerSet->nextHandlerSet) { 1497 tmpTclHandlerSet = tmpTclHandlerSet->nextHandlerSet; 1498 } 1499 tmpTclHandlerSet->nextHandlerSet = activeTclHandlerSet; 1500 } 1501 } 1502 break; 1503 1504 case EXPAT_NOEXPAND: 1505 if (Tcl_GetBooleanFromObj (interp, objv[1], &bool) != TCL_OK) { 1506 return TCL_ERROR; 1507 } 1508 if (bool) { 1509 XML_SetDefaultHandlerExpand(expat->parser, NULL); 1510 XML_SetDefaultHandler(expat->parser, 1511 (XML_DefaultHandler) TclGenExpatDefaultHandler); 1512 } 1513 else { 1514 XML_SetDefaultHandler(expat->parser, NULL); 1515 XML_SetDefaultHandlerExpand(expat->parser, 1516 (XML_DefaultHandler) TclGenExpatDefaultHandler); 1517 } 1518 expat->noexpand = bool; 1519 break; 1520 1521 } 1522 1523 objPtr += 2; 1524 objc -= 2; 1525 1526 } 1527 1528 return TCL_OK; 1529} 1530 1531/* 1532 *---------------------------------------------------------------------------- 1533 * 1534 * TclExpatCget -- 1535 * 1536 * Returns setting of configuration option. 1537 * 1538 * Results: 1539 * Option value. 1540 * 1541 * Side effects: 1542 * None. 1543 * 1544 *---------------------------------------------------------------------------- 1545 */ 1546 1547static int 1548TclExpatCget (interp, expat, objc, objv) 1549 Tcl_Interp *interp; 1550 TclGenExpatInfo *expat; 1551 int objc; 1552 Tcl_Obj *CONST objv[]; 1553{ 1554 static CONST84 char *switches[] = { 1555 "-final", 1556 "-baseurl", 1557 "-elementstartcommand", 1558 "-elementendcommand", 1559 "-characterdatacommand", 1560 "-processinginstructioncommand", 1561 "-defaultcommand", 1562 "-notationdeclcommand", 1563 "-externalentitycommand", 1564 "-unknownencodingcommand", 1565 "-startnamespacedeclcommand", 1566 "-endnamespacedeclcommand", 1567 "-ignorewhitecdata", 1568 "-useForeignDTD", 1569 "-commentcommand", 1570 "-notstandalonecommand", 1571 "-startcdatasectioncommand", 1572 "-endcdatasectioncommand", 1573 "-elementdeclcommand", 1574 "-attlistdeclcommand", 1575 "-startdoctypedeclcommand", 1576 "-enddoctypedeclcommand", 1577 "-xmldeclcommand", 1578 "-paramentityparsing", 1579 "-entitydeclcommand", 1580 "-ignorewhitespace", 1581 "-handlerset", 1582 "-noexpand", 1583 "-namespace", 1584 (char *) NULL 1585 }; 1586 enum switches { 1587 EXPAT_FINAL, EXPAT_BASE, 1588 EXPAT_ELEMENTSTARTCMD, EXPAT_ELEMENTENDCMD, 1589 EXPAT_DATACMD, EXPAT_PICMD, 1590 EXPAT_DEFAULTCMD, 1591 EXPAT_NOTATIONCMD, 1592 EXPAT_EXTERNALENTITYCMD, EXPAT_UNKNOWNENCODINGCMD, 1593 EXPAT_STARTNAMESPACEDECLCMD, 1594 EXPAT_ENDNAMESPACEDECLCMD, 1595 EXPAT_IGNOREWHITECDATA, 1596 EXPAT_USEFOREIGNDTD, 1597 1598 EXPAT_COMMENTCMD, EXPAT_NOTSTANDALONECMD, 1599 EXPAT_STARTCDATASECTIONCMD, EXPAT_ENDCDATASECTIONCMD, 1600 EXPAT_ELEMENTDECLCMD, EXPAT_ATTLISTDECLCMD, 1601 EXPAT_STARTDOCTYPEDECLCMD, EXPAT_ENDDOCTYPEDECLCMD, 1602 EXPAT_XMLDECLCMD, 1603 EXPAT_PARAMENTITYPARSING, 1604 EXPAT_ENTITYDECLCOMMAND, 1605 EXPAT_NOWHITESPACE, 1606 EXPAT_HANDLERSET, 1607 EXPAT_NOEXPAND, 1608 EXPAT_NAMESPACE 1609 }; 1610 int optionIndex; 1611 TclHandlerSet *activeTclHandlerSet = NULL; 1612 char *handlerSetName = NULL; 1613 Tcl_Obj* objPtr; 1614 1615 if (Tcl_GetIndexFromObj(interp, objv[0], switches, 1616 "switch", 0, &optionIndex) != TCL_OK) { 1617 return TCL_ERROR; 1618 } 1619 activeTclHandlerSet = expat->firstTclHandlerSet; 1620 1621 if (objc > 1) { 1622 if (objc != 3) { 1623 Tcl_WrongNumArgs (interp, 0, objv, 1624 "?-handlerset handlersetname? switch"); 1625 return TCL_ERROR; 1626 } 1627 if ((enum switches) optionIndex != EXPAT_HANDLERSET) { 1628 Tcl_ResetResult (interp); 1629 Tcl_AppendResult (interp, "usage: parserObj cget ", NULL); 1630 Tcl_AppendResult (interp, "?-handlerset handlersetname? switch", 1631 NULL); 1632 return TCL_ERROR; 1633 } 1634 handlerSetName = Tcl_GetString(objv[1]); 1635 objPtr = objv[2]; 1636 1637 for (activeTclHandlerSet = expat->firstTclHandlerSet; 1638 activeTclHandlerSet != NULL; 1639 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet) { 1640 if (strcmp(activeTclHandlerSet->name, handlerSetName) == 0) { 1641 break; 1642 } 1643 } 1644 1645 if (!activeTclHandlerSet && (strcmp(handlerSetName, "default") != 0)) { 1646 Tcl_ResetResult(interp); 1647 Tcl_AppendResult(interp, "invalid handlerset name: ", 1648 handlerSetName, NULL); 1649 return TCL_ERROR; 1650 } 1651 1652 if (Tcl_GetIndexFromObj(interp, objPtr, switches, 1653 "switch", 0, &optionIndex) != TCL_OK) { 1654 return TCL_ERROR; 1655 } 1656 } 1657 1658 /* We check first the 'overall' (handlerset independent) options, to 1659 be able to report there values even if there isn't any handlerset. */ 1660 switch ((enum switches) optionIndex) { 1661 1662 case EXPAT_FINAL: /* -final */ 1663 1664 Tcl_SetResult(interp, expat->final ? "1" : "0", NULL); 1665 return TCL_OK; 1666 1667 case EXPAT_BASE: /* -base */ 1668 1669 if (expat->finished) { 1670 Tcl_SetResult (interp, expat->baseURI != NULL 1671 ? Tcl_GetString (expat->baseURI) : "", NULL); 1672 } else { 1673 Tcl_SetResult(interp, XML_GetBase(expat->parser) != NULL 1674 ? (char*) XML_GetBase(expat->parser) : "", NULL); 1675 } 1676 return TCL_OK; 1677 1678 case EXPAT_USEFOREIGNDTD: /* -useForeignDTD */ 1679 1680 SetIntResult (interp, expat->useForeignDTD); 1681 return TCL_OK; 1682 1683 case EXPAT_PARAMENTITYPARSING: /* -paramentityparsing */ 1684 1685 switch (expat->paramentityparsing) { 1686 case XML_PARAM_ENTITY_PARSING_NEVER: 1687 Tcl_SetResult (interp, "never", NULL); 1688 break; 1689 case XML_PARAM_ENTITY_PARSING_ALWAYS: 1690 Tcl_SetResult (interp, "always", NULL); 1691 break; 1692 case XML_PARAM_ENTITY_PARSING_UNLESS_STANDALONE: 1693 Tcl_SetResult (interp, "notstandalone", NULL); 1694 break; 1695 default: 1696 domPanic ("Impossible '-paramentityparsing' return value!\n"); 1697 } 1698 return TCL_OK; 1699 1700 case EXPAT_NOEXPAND: /* -noexpand */ 1701 1702 SetIntResult (interp, expat->noexpand); 1703 return TCL_OK; 1704 1705 case EXPAT_NAMESPACE: /* -namespace */ 1706 1707 SetIntResult (interp, expat->ns_mode); 1708 return TCL_OK; 1709 1710 case EXPAT_NOWHITESPACE: 1711 case EXPAT_IGNOREWHITECDATA: /* -ignorewhitecdata */ 1712 1713 if (activeTclHandlerSet == NULL) { 1714 /* Without any handler script, we return a default boolean 1715 value */ 1716 Tcl_SetResult(interp, "0", NULL); 1717 return TCL_OK; 1718 } 1719 default: 1720 /* do nothing */ 1721 break; 1722 } 1723 1724 /* 1725 * If there is no TclHandlerSet return "" for all other requests. 1726 */ 1727 if (activeTclHandlerSet == NULL) { 1728 Tcl_SetResult(interp, "", NULL); 1729 return TCL_OK; 1730 } 1731 1732 switch ((enum switches) optionIndex) { 1733 1734 case EXPAT_ELEMENTSTARTCMD: /* -elementstartcommand */ 1735 1736 if (activeTclHandlerSet->elementstartcommand) { 1737 Tcl_SetObjResult(interp, activeTclHandlerSet->elementstartcommand); 1738 } else { 1739 Tcl_SetResult(interp, "", NULL); 1740 } 1741 return TCL_OK; 1742 1743 case EXPAT_ELEMENTENDCMD: /* -elementendcommand */ 1744 1745 if (activeTclHandlerSet->elementendcommand) { 1746 Tcl_SetObjResult(interp, activeTclHandlerSet->elementendcommand); 1747 } else { 1748 Tcl_SetResult(interp, "", NULL); 1749 } 1750 return TCL_OK; 1751 1752 case EXPAT_STARTNAMESPACEDECLCMD: /* -startnamespacedeclcommand */ 1753 1754 if (activeTclHandlerSet->startnsdeclcommand) { 1755 Tcl_SetObjResult(interp, activeTclHandlerSet->startnsdeclcommand); 1756 } else { 1757 Tcl_SetResult(interp, "", NULL); 1758 } 1759 return TCL_OK; 1760 1761 case EXPAT_ENDNAMESPACEDECLCMD: /* -endnamespacedeclcommand */ 1762 1763 if (activeTclHandlerSet->endnsdeclcommand) { 1764 Tcl_SetObjResult(interp, activeTclHandlerSet->endnsdeclcommand); 1765 } else { 1766 Tcl_SetResult(interp, "", NULL); 1767 } 1768 return TCL_OK; 1769 1770 case EXPAT_DATACMD: /* -characterdatacommand */ 1771 1772 if (activeTclHandlerSet->datacommand) { 1773 Tcl_SetObjResult(interp, activeTclHandlerSet->datacommand); 1774 } else { 1775 Tcl_SetResult(interp, "", NULL); 1776 } 1777 return TCL_OK; 1778 1779 case EXPAT_PICMD: /* -processinginstructioncommand */ 1780 1781 if (activeTclHandlerSet->picommand) { 1782 Tcl_SetObjResult(interp, activeTclHandlerSet->picommand); 1783 } else { 1784 Tcl_SetResult(interp, "", NULL); 1785 } 1786 return TCL_OK; 1787 1788 case EXPAT_DEFAULTCMD: /* -defaultcommand */ 1789 1790 if (activeTclHandlerSet->defaultcommand) { 1791 Tcl_SetObjResult(interp, activeTclHandlerSet->defaultcommand); 1792 } else { 1793 Tcl_SetResult(interp, "", NULL); 1794 } 1795 return TCL_OK; 1796 1797 case EXPAT_NOTATIONCMD: /* -notationdeclcommand */ 1798 1799 if (activeTclHandlerSet->notationcommand) { 1800 Tcl_SetObjResult(interp, activeTclHandlerSet->notationcommand); 1801 } else { 1802 Tcl_SetResult(interp, "", NULL); 1803 } 1804 return TCL_OK; 1805 1806 case EXPAT_EXTERNALENTITYCMD: /* -externalentitycommand */ 1807 1808 if (activeTclHandlerSet->externalentitycommand) { 1809 Tcl_SetObjResult(interp, 1810 activeTclHandlerSet->externalentitycommand); 1811 } else { 1812 Tcl_SetResult(interp, "", NULL); 1813 } 1814 return TCL_OK; 1815 1816 case EXPAT_UNKNOWNENCODINGCMD: /* -unknownencodingcommand */ 1817 1818 /* Not implemented */ 1819 Tcl_SetResult(interp, "", NULL); 1820 return TCL_OK; 1821 1822 case EXPAT_NOWHITESPACE: 1823 case EXPAT_IGNOREWHITECDATA: /* -ignorewhitecdata */ 1824 1825 if (activeTclHandlerSet->ignoreWhiteCDATAs) { 1826 Tcl_SetResult(interp, "1", NULL); 1827 } else { 1828 Tcl_SetResult(interp, "0", NULL); 1829 } 1830 return TCL_OK; 1831 1832 case EXPAT_COMMENTCMD: /* -commentcommand */ 1833 1834 if (activeTclHandlerSet->commentCommand) { 1835 Tcl_SetObjResult(interp, activeTclHandlerSet->commentCommand); 1836 } else { 1837 Tcl_SetResult(interp, "", NULL); 1838 } 1839 return TCL_OK; 1840 1841 case EXPAT_NOTSTANDALONECMD: /* -notstandalonecommand */ 1842 1843 if (activeTclHandlerSet->notStandaloneCommand) { 1844 Tcl_SetObjResult(interp, 1845 activeTclHandlerSet->notStandaloneCommand); 1846 } else { 1847 Tcl_SetResult(interp, "", NULL); 1848 } 1849 return TCL_OK; 1850 1851 case EXPAT_STARTCDATASECTIONCMD: /* -startcdatasectioncommand */ 1852 1853 if (activeTclHandlerSet->startCdataSectionCommand) { 1854 Tcl_SetObjResult(interp, 1855 activeTclHandlerSet->startCdataSectionCommand); 1856 } else { 1857 Tcl_SetResult(interp, "", NULL); 1858 } 1859 return TCL_OK; 1860 1861 case EXPAT_ENDCDATASECTIONCMD: /* -endcdatasectioncommand */ 1862 1863 if (activeTclHandlerSet->endCdataSectionCommand) { 1864 Tcl_SetObjResult(interp, 1865 activeTclHandlerSet->endCdataSectionCommand); 1866 } else { 1867 Tcl_SetResult(interp, "", NULL); 1868 } 1869 return TCL_OK; 1870 1871 case EXPAT_ELEMENTDECLCMD: /* -elementdeclcommand */ 1872 1873 if (activeTclHandlerSet->elementDeclCommand) { 1874 Tcl_SetObjResult(interp, activeTclHandlerSet->elementDeclCommand); 1875 } else { 1876 Tcl_SetResult(interp, "", NULL); 1877 } 1878 return TCL_OK; 1879 1880 case EXPAT_ATTLISTDECLCMD: /* -attlistdeclcommand */ 1881 1882 if (activeTclHandlerSet->attlistDeclCommand) { 1883 Tcl_SetObjResult(interp, activeTclHandlerSet->attlistDeclCommand); 1884 } else { 1885 Tcl_SetResult(interp, "", NULL); 1886 } 1887 return TCL_OK; 1888 1889 case EXPAT_STARTDOCTYPEDECLCMD: /* -startdoctypedeclcommand */ 1890 1891 if (activeTclHandlerSet->startDoctypeDeclCommand) { 1892 Tcl_SetObjResult(interp, 1893 activeTclHandlerSet->startDoctypeDeclCommand); 1894 } else { 1895 Tcl_SetResult(interp, "", NULL); 1896 } 1897 return TCL_OK; 1898 1899 case EXPAT_ENDDOCTYPEDECLCMD: /* -enddoctypedeclcommand */ 1900 1901 if (activeTclHandlerSet->elementendcommand) { 1902 Tcl_SetObjResult(interp, activeTclHandlerSet->elementendcommand); 1903 } else { 1904 Tcl_SetResult(interp, "", NULL); 1905 } 1906 return TCL_OK; 1907 1908 case EXPAT_XMLDECLCMD: /* -xmlDeclCommand */ 1909 1910 if (activeTclHandlerSet->xmlDeclCommand) { 1911 Tcl_SetObjResult(interp, activeTclHandlerSet->xmlDeclCommand); 1912 } else { 1913 Tcl_SetResult(interp, "", NULL); 1914 } 1915 return TCL_OK; 1916 1917 case EXPAT_ENTITYDECLCOMMAND: /* -entitydeclcommand */ 1918 1919 if (activeTclHandlerSet->entityDeclCommand) { 1920 Tcl_SetObjResult(interp, activeTclHandlerSet->entityDeclCommand); 1921 } else { 1922 Tcl_SetResult(interp, "", NULL); 1923 } 1924 return TCL_OK; 1925 1926 default: 1927 /* do nothing */ 1928 break; 1929 } 1930 return TCL_ERROR; 1931} 1932 1933/* 1934 *---------------------------------------------------------------------------- 1935 * 1936 * TclExpatGet -- 1937 * 1938 * Returns runtime parser information, depending on option 1939 * ericm@scriptics.com, 1999.6.28 1940 * 1941 * Results: 1942 * Option value. 1943 * 1944 * Side effects: 1945 * None. 1946 * 1947 *---------------------------------------------------------------------------- 1948 */ 1949static int 1950TclExpatGet (interp, expat, objc, objv) 1951 Tcl_Interp *interp; 1952 TclGenExpatInfo *expat; 1953 int objc; 1954 Tcl_Obj *CONST objv[]; 1955{ 1956 static CONST84 char *getSwitches[] = { 1957 "-specifiedattributecount", 1958 "-currentbytecount", 1959 "-currentlinenumber", 1960 "-currentcolumnnumber", 1961 "-currentbyteindex", 1962 (char *) NULL 1963 }; 1964 enum getSwitch { 1965 EXPAT_SPECIFIEDATTRCOUNT, 1966 EXPAT_CURRENTBYTECOUNT, 1967 EXPAT_CURRENTLINENUMBER, 1968 EXPAT_CURRENTCOLUMNNUMBER, 1969 EXPAT_CURRENTBYTEINDEX 1970 }; 1971 int switchIndex; 1972 Tcl_Obj *resultPtr; 1973 1974 if (objc > 1) { 1975 Tcl_SetResult(interp, "Only one value may be requested at a time", 1976 TCL_STATIC); 1977 return TCL_ERROR; 1978 } 1979 1980 if (Tcl_GetIndexFromObj(interp, objv[0], getSwitches, 1981 "switch", 0, &switchIndex) != TCL_OK) { 1982 return TCL_ERROR; 1983 } 1984 resultPtr = Tcl_GetObjResult(interp); 1985 1986 switch ((enum getSwitch) switchIndex) { 1987 1988 case EXPAT_SPECIFIEDATTRCOUNT: 1989 1990 Tcl_SetIntObj(resultPtr, XML_GetSpecifiedAttributeCount(expat->parser)); 1991 break; 1992 1993 case EXPAT_CURRENTBYTECOUNT: 1994 1995 Tcl_SetIntObj(resultPtr, XML_GetCurrentByteCount(expat->parser)); 1996 break; 1997 1998 case EXPAT_CURRENTLINENUMBER: 1999 2000 Tcl_SetIntObj(resultPtr, XML_GetCurrentLineNumber(expat->parser)); 2001 break; 2002 2003 case EXPAT_CURRENTCOLUMNNUMBER: 2004 2005 Tcl_SetIntObj(resultPtr, XML_GetCurrentColumnNumber(expat->parser)); 2006 break; 2007 2008 case EXPAT_CURRENTBYTEINDEX: 2009 2010 Tcl_SetLongObj(resultPtr, XML_GetCurrentByteIndex(expat->parser)); 2011 break; 2012 2013 } 2014 2015 return TCL_OK; 2016} 2017 2018 2019/* 2020 *---------------------------------------------------------------------------- 2021 * 2022 * TclExpatHandlerResult -- 2023 * 2024 * Manage the result of the application callback. 2025 * 2026 * Results: 2027 * None. 2028 * 2029 * Side Effects: 2030 * Further invocation of callback scripts may be inhibited. 2031 * 2032 *---------------------------------------------------------------------------- 2033 */ 2034 2035static void 2036TclExpatHandlerResult(expat, handlerSet, result) 2037 TclGenExpatInfo *expat; 2038 TclHandlerSet *handlerSet; 2039 int result; 2040{ 2041 switch (result) { 2042 case TCL_OK: 2043 handlerSet->status = TCL_OK; 2044 break; 2045 2046 case TCL_CONTINUE: 2047 /* 2048 * Skip callbacks until the matching end element event 2049 * occurs for the currently open element. 2050 * Keep a reference count to handle nested 2051 * elements. 2052 */ 2053 handlerSet->status = TCL_CONTINUE; 2054 handlerSet->continueCount = 1; 2055 break; 2056 2057 case TCL_BREAK: 2058 /* 2059 * Skip all further callbacks, but return OK. 2060 */ 2061 handlerSet->status = TCL_BREAK; 2062 break; 2063 2064 case TCL_ERROR: 2065 /* 2066 * Skip all further callbacks, and return error. 2067 */ 2068 expat->status = TCL_ERROR; 2069 expat->result = Tcl_GetObjResult(expat->interp); 2070 Tcl_IncrRefCount(expat->result); 2071 break; 2072 2073 default: 2074 /* 2075 * Skip all further callbacks, set return value and return error. 2076 */ 2077 expat->status = result; 2078 expat->result = Tcl_GetObjResult(expat->interp); 2079 Tcl_IncrRefCount(expat->result); 2080 break; 2081 } 2082} 2083 2084/* 2085 *---------------------------------------------------------------------------- 2086 * 2087 * TclGenExpatElementStartHandler -- 2088 * 2089 * Called by expat for each start tag. 2090 * 2091 * Results: 2092 * None. 2093 * 2094 * Side Effects: 2095 * Callback scripts are invoked. 2096 * 2097 *---------------------------------------------------------------------------- 2098 */ 2099 2100static void 2101TclGenExpatElementStartHandler(userData, name, atts) 2102 void *userData; 2103 const char *name; 2104 const char **atts; 2105{ 2106 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 2107 Tcl_Obj *atList = NULL; 2108 const char **atPtr; 2109 int result; 2110 Tcl_Obj *vector[3]; 2111 TclHandlerSet *activeTclHandlerSet; 2112 CHandlerSet *activeCHandlerSet; 2113 Tcl_Obj *cmdPtr; 2114 2115 if (expat->status != TCL_OK) { 2116 return; 2117 } 2118 2119 TclExpatDispatchPCDATA(expat); 2120 2121 activeTclHandlerSet = expat->firstTclHandlerSet; 2122 while (activeTclHandlerSet) { 2123 switch (activeTclHandlerSet->status) { 2124 case TCL_CONTINUE : 2125 /* 2126 * We're currently skipping elements looking for the 2127 * close of the continued element. 2128 */ 2129 2130 activeTclHandlerSet->continueCount++; 2131 goto nextTcl; 2132 break; 2133 case TCL_BREAK: 2134 goto nextTcl; 2135 break; 2136 default: 2137 ; 2138 } 2139 2140 if (activeTclHandlerSet->status == TCL_CONTINUE) { 2141 } 2142 2143 if (activeTclHandlerSet->elementstartcommand == NULL) { 2144 goto nextTcl; 2145 } 2146 2147 /* 2148 * Convert the attribute list into a Tcl key-value paired list. 2149 */ 2150 2151 if (atList == NULL) { 2152 atList = Tcl_NewListObj(0, NULL); 2153 Tcl_IncrRefCount (atList); 2154 for (atPtr = atts; atPtr[0] && atPtr[1]; atPtr += 2) { 2155 Tcl_ListObjAppendElement(expat->interp, atList, Tcl_NewStringObj((char *)atPtr[0], strlen(atPtr[0]))); 2156 Tcl_ListObjAppendElement(expat->interp, atList, Tcl_NewStringObj((char *)atPtr[1], strlen(atPtr[1]))); 2157 } 2158 vector[2] = atList; 2159 } 2160 2161 if (activeTclHandlerSet->elementstartObjProc != NULL) { 2162 vector[0] = activeTclHandlerSet->elementstartcommand; 2163 Tcl_IncrRefCount (vector[0]); 2164 vector[1] = Tcl_NewStringObj((char *)name, -1); 2165 Tcl_IncrRefCount (vector[1]); 2166 result = activeTclHandlerSet->elementstartObjProc( 2167 activeTclHandlerSet->elementstartclientData, expat->interp, 2168 3, vector); 2169 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 2170 Tcl_DecrRefCount (vector[0]); 2171 Tcl_DecrRefCount (vector[1]); 2172 } else { 2173 if (activeTclHandlerSet->elementstartcommand != NULL) { 2174 2175 /* 2176 * Take a copy of the callback script so that arguments may be appended. 2177 */ 2178 2179 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->elementstartcommand); 2180 Tcl_IncrRefCount(cmdPtr); 2181 Tcl_Preserve((ClientData) expat->interp); 2182 2183 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 2184 Tcl_NewStringObj((char *)name, -1)); 2185 Tcl_ListObjAppendElement(expat->interp, cmdPtr, atList); 2186 2187 /* 2188 * It would be desirable to be able to terminate parsing 2189 * if the return result is TCL_ERROR or TCL_BREAK. 2190 */ 2191#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 2192 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 2193#else 2194 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 2195 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 2196#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 2197 2198 Tcl_DecrRefCount(cmdPtr); 2199 Tcl_Release((ClientData) expat->interp); 2200 2201 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 2202 } 2203 } 2204 nextTcl: 2205 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 2206 } 2207 if (atList) { 2208 Tcl_DecrRefCount (atList); 2209 } 2210 2211 activeCHandlerSet = expat->firstCHandlerSet; 2212 while (activeCHandlerSet) { 2213 if (activeCHandlerSet->elementstartcommand) { 2214 activeCHandlerSet->elementstartcommand (activeCHandlerSet->userData, 2215 name, atts); 2216 } 2217 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 2218 } 2219 2220 return; 2221} 2222 2223 2224/* 2225 *---------------------------------------------------------------------------- 2226 * 2227 * TclGenExpatElementEndHandler -- 2228 * 2229 * Called by expat for each end tag. 2230 * 2231 * Results: 2232 * None. 2233 * 2234 * Side Effects: 2235 * Callback scripts are invoked. 2236 * 2237 *---------------------------------------------------------------------------- 2238 */ 2239 2240static void 2241TclGenExpatElementEndHandler(userData, name) 2242 void *userData; 2243 CONST char *name; 2244{ 2245 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 2246 int result; 2247 Tcl_Obj *vector[2], *ename = NULL; 2248 TclHandlerSet *activeTclHandlerSet; 2249 CHandlerSet *activeCHandlerSet; 2250 Tcl_Obj *cmdPtr; 2251 2252 if (expat->status != TCL_OK) { 2253 return; 2254 } 2255 2256 TclExpatDispatchPCDATA(expat); 2257 2258 activeTclHandlerSet = expat->firstTclHandlerSet; 2259 while (activeTclHandlerSet) { 2260 switch (activeTclHandlerSet->status) { 2261 case TCL_CONTINUE: 2262 /* 2263 * We're currently skipping elements looking for the 2264 * end of the currently open element. 2265 */ 2266 2267 if (!--(activeTclHandlerSet->continueCount)) { 2268 activeTclHandlerSet->status = TCL_OK; 2269 break; 2270 } 2271 goto nextTcl; 2272 case TCL_BREAK: 2273 goto nextTcl; 2274 break; 2275 default: 2276 ; 2277 } 2278 2279 if (activeTclHandlerSet->elementendcommand == NULL) { 2280 goto nextTcl; 2281 } 2282 2283 if (activeTclHandlerSet->elementendObjProc != NULL) { 2284 if (ename == NULL) { 2285 ename = Tcl_NewStringObj ((char *)name, -1); 2286 Tcl_IncrRefCount (ename); 2287 } else { 2288 Tcl_SetStringObj (ename, (char *)name, -1); 2289 } 2290 vector[0] = activeTclHandlerSet->elementendcommand; 2291 vector[1] = ename; 2292 Tcl_Preserve((ClientData) expat->interp); 2293 result = activeTclHandlerSet->elementendObjProc( 2294 activeTclHandlerSet->elementendclientData, expat->interp, 2295 2, vector); 2296 Tcl_Release((ClientData) expat->interp); 2297 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 2298 } else { 2299 if (activeTclHandlerSet->elementendcommand != NULL) { 2300 2301 /* 2302 * Take a copy of the callback script so that arguments may be appended. 2303 */ 2304 2305 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->elementendcommand); 2306 Tcl_IncrRefCount(cmdPtr); 2307 Tcl_Preserve((ClientData) expat->interp); 2308 2309 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 2310 Tcl_NewStringObj((char *)name, -1)); 2311 2312 /* 2313 * It would be desirable to be able to terminate parsing 2314 * if the return result is TCL_ERROR or TCL_BREAK. 2315 */ 2316#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 2317 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 2318#else 2319 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 2320 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT ); 2321#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 2322 2323 Tcl_DecrRefCount(cmdPtr); 2324 Tcl_Release((ClientData) expat->interp); 2325 2326 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 2327 } 2328 } 2329 nextTcl: 2330 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 2331 } 2332 if (ename) { 2333 Tcl_DecrRefCount (ename); 2334 } 2335 2336 activeCHandlerSet = expat->firstCHandlerSet; 2337 while (activeCHandlerSet) { 2338 if (activeCHandlerSet->elementendcommand ) { 2339 activeCHandlerSet->elementendcommand (activeCHandlerSet->userData, 2340 name); 2341 } 2342 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 2343 } 2344 2345 return; 2346} 2347 2348 2349/* 2350 *---------------------------------------------------------------------------- 2351 * 2352 * TclGenExpatStartNamespaceDeclHandler -- 2353 * 2354 * Called by expat for each start tag. 2355 * 2356 * Results: 2357 * None. 2358 * 2359 * Side Effects: 2360 * Callback scripts are invoked. 2361 * 2362 *---------------------------------------------------------------------------- 2363 */ 2364 2365static void 2366TclGenExpatStartNamespaceDeclHandler(userData, prefix, uri) 2367 void *userData; 2368 const char *prefix; 2369 const char *uri; 2370{ 2371 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 2372 Tcl_Obj *cmdPtr; 2373 int result; 2374 TclHandlerSet *activeTclHandlerSet; 2375 CHandlerSet *activeCHandlerSet; 2376 2377 if (expat->status != TCL_OK) { 2378 return; 2379 } 2380 2381 activeTclHandlerSet = expat->firstTclHandlerSet; 2382 while (activeTclHandlerSet) { 2383 2384 switch (activeTclHandlerSet->status) { 2385 case TCL_CONTINUE: 2386 /* 2387 * We're currently skipping elements looking for the 2388 * close of the continued element. 2389 */ 2390 2391 activeTclHandlerSet->continueCount++; 2392 goto nextTcl; 2393 break; 2394 case TCL_BREAK: 2395 goto nextTcl; 2396 break; 2397 default: 2398 ; 2399 } 2400 2401 if (activeTclHandlerSet->startnsdeclcommand == NULL) { 2402 goto nextTcl; 2403 } 2404 2405 /* 2406 * Take a copy of the callback script so that arguments may be appended. 2407 */ 2408 2409 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->startnsdeclcommand); 2410 Tcl_IncrRefCount(cmdPtr); 2411 Tcl_Preserve((ClientData) expat->interp); 2412 2413 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 2414 Tcl_NewStringObj((char *)prefix, -1)); 2415 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 2416 Tcl_NewStringObj((char *)uri, -1)); 2417 2418 /* 2419 * It would be desirable to be able to terminate parsing 2420 * if the return result is TCL_ERROR or TCL_BREAK. 2421 */ 2422#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 2423 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 2424#else 2425 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 2426 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 2427#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 2428 2429 Tcl_DecrRefCount(cmdPtr); 2430 Tcl_Release((ClientData) expat->interp); 2431 2432 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 2433 nextTcl: 2434 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 2435 } 2436 2437 activeCHandlerSet = expat->firstCHandlerSet; 2438 while (activeCHandlerSet) { 2439 if (activeCHandlerSet->startnsdeclcommand) { 2440 activeCHandlerSet->startnsdeclcommand (activeCHandlerSet->userData, 2441 prefix, uri); 2442 } 2443 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 2444 } 2445 2446 return; 2447} 2448 2449/* 2450 *---------------------------------------------------------------------------- 2451 * 2452 * TclGenExpatEndNamespaceDeclHandler -- 2453 * 2454 * Called by expat for each end tag. 2455 * 2456 * Results: 2457 * None. 2458 * 2459 * Side Effects: 2460 * Callback scripts are invoked. 2461 * 2462 *---------------------------------------------------------------------------- 2463 */ 2464 2465static void 2466TclGenExpatEndNamespaceDeclHandler(userData, prefix) 2467 void *userData; 2468 CONST char *prefix; 2469{ 2470 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 2471 Tcl_Obj *cmdPtr; 2472 int result; 2473 TclHandlerSet *activeTclHandlerSet; 2474 CHandlerSet *activeCHandlerSet; 2475 2476 if (expat->status != TCL_OK) { 2477 return; 2478 } 2479 2480 activeTclHandlerSet = expat->firstTclHandlerSet; 2481 while (activeTclHandlerSet) { 2482 2483 switch (activeTclHandlerSet->status) { 2484 case TCL_CONTINUE: 2485 /* 2486 * We're currently skipping elements looking for the 2487 * end of the currently open element. 2488 */ 2489 2490 if (!--(activeTclHandlerSet->continueCount)) { 2491 activeTclHandlerSet->status = TCL_OK; 2492 } 2493 goto nextTcl; 2494 break; 2495 case TCL_BREAK: 2496 goto nextTcl; 2497 break; 2498 default: 2499 ; 2500 } 2501 2502 if (activeTclHandlerSet->endnsdeclcommand == NULL) { 2503 goto nextTcl; 2504 } 2505 2506 /* 2507 * Take a copy of the callback script so that arguments may be appended. 2508 */ 2509 2510 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->endnsdeclcommand); 2511 Tcl_IncrRefCount(cmdPtr); 2512 Tcl_Preserve((ClientData) expat->interp); 2513 2514 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)prefix, -1)); 2515 2516 /* 2517 * It would be desirable to be able to terminate parsing 2518 * if the return result is TCL_ERROR or TCL_BREAK. 2519 */ 2520#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 2521 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 2522#else 2523 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 2524 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 2525#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 2526 2527 Tcl_DecrRefCount(cmdPtr); 2528 Tcl_Release((ClientData) expat->interp); 2529 2530 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 2531 nextTcl: 2532 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 2533 } 2534 activeCHandlerSet = expat->firstCHandlerSet; 2535 while (activeCHandlerSet) { 2536 if (activeCHandlerSet->endnsdeclcommand) { 2537 activeCHandlerSet->endnsdeclcommand (activeCHandlerSet->userData, 2538 prefix); 2539 } 2540 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 2541 } 2542 2543 return; 2544} 2545 2546 2547/* 2548 *---------------------------------------------------------------------------- 2549 * 2550 * TclExpatCheckWhiteData -- 2551 * 2552 * Called by expat for character data. 2553 * 2554 * Results: 2555 * 1 if string contains just white characters 2556 * 2557 *---------------------------------------------------------------------------- 2558 */ 2559 2560static int 2561TclExpatCheckWhiteData (pc, len) 2562 char *pc; 2563 int len; 2564{ 2565 for (; len > 0; len--, pc++) { 2566 if ( (*pc != ' ') && 2567 (*pc != '\t') && 2568 (*pc != '\n') && 2569 (*pc != '\r') ) { 2570 return 0; 2571 } 2572 } 2573 return 1; 2574} 2575 2576 2577/* 2578 *---------------------------------------------------------------------------- 2579 * 2580 * TclGenExpatCharacterDataHandler -- 2581 * 2582 * Called by expat for character data. 2583 * 2584 * Results: 2585 * None. 2586 * 2587 * Side Effects: 2588 * Callback script is invoked. 2589 * 2590 *---------------------------------------------------------------------------- 2591 */ 2592 2593static void 2594TclGenExpatCharacterDataHandler(userData, s, len) 2595 void *userData; 2596 CONST char *s; 2597 int len; 2598{ 2599 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 2600 2601 if (expat->status != TCL_OK) { 2602 return; 2603 } 2604 2605 if (!expat->cdata) { 2606 expat->cdata = Tcl_NewObj(); 2607 Tcl_IncrRefCount (expat->cdata); 2608 } 2609 Tcl_AppendToObj (expat->cdata, s, len); 2610 return; 2611} 2612 2613/* 2614 *---------------------------------------------------------------------------- 2615 * 2616 * TclExpatDispatchPCDATA -- 2617 * 2618 * Called to check whether any accumulated character data 2619 * exists, and if so invoke the callback. 2620 * 2621 * Results: 2622 * None. 2623 * 2624 * Side Effects: 2625 * Callback script evaluated. 2626 * 2627 *---------------------------------------------------------------------------- 2628 */ 2629 2630static void 2631TclExpatDispatchPCDATA(expat) 2632 TclGenExpatInfo *expat; 2633{ 2634 int len, result, onlyWhiteSpace = 0; 2635 Tcl_Obj *vector[2]; 2636 TclHandlerSet *activeTclHandlerSet; 2637 CHandlerSet *activeCHandlerSet; 2638 Tcl_Obj* cmdPtr; 2639 char *s; 2640 2641 if (expat->cdata == NULL || 2642 expat->status != TCL_OK 2643 ) { 2644 return; 2645 } 2646 2647 s = Tcl_GetStringFromObj (expat->cdata, &len); 2648 if (expat->needWSCheck) { 2649 onlyWhiteSpace = TclExpatCheckWhiteData (s, len); 2650 } 2651 2652 activeTclHandlerSet = expat->firstTclHandlerSet; 2653 while (activeTclHandlerSet) { 2654 2655 switch (activeTclHandlerSet->status) { 2656 case TCL_CONTINUE: 2657 case TCL_BREAK: 2658 goto nextTcl; 2659 break; 2660 default: 2661 ; 2662 } 2663 2664 if (activeTclHandlerSet->datacommand == NULL) { 2665 goto nextTcl; 2666 } 2667 2668 /* 2669 * Check whether we are in 'trim' mode 2670 */ 2671 if (activeTclHandlerSet->ignoreWhiteCDATAs && onlyWhiteSpace) { 2672 goto nextTcl; 2673 } 2674 2675 if (activeTclHandlerSet->datacommandObjProc != NULL) { 2676 vector[0] = activeTclHandlerSet->datacommand; 2677 vector[1] = Tcl_NewStringObj ((char *)s, len); 2678 Tcl_Preserve((ClientData) expat->interp); 2679 result = activeTclHandlerSet->datacommandObjProc( 2680 activeTclHandlerSet->datacommandclientData, expat->interp, 2681 2, vector); 2682 Tcl_Release((ClientData) expat->interp); 2683 2684 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 2685 } else { 2686 2687 /* 2688 * Take a copy of the callback script so that arguments may 2689 * be appended. 2690 */ 2691 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->datacommand); 2692 Tcl_IncrRefCount(cmdPtr); 2693 Tcl_Preserve((ClientData) expat->interp); 2694 2695 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 2696 Tcl_NewStringObj((char *)s, len)); 2697 2698 /* 2699 * It would be desirable to be able to terminate parsing 2700 * if the return result is TCL_ERROR or TCL_BREAK. 2701 */ 2702#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 2703 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 2704#else 2705 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 2706 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 2707#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 2708 2709 Tcl_DecrRefCount(cmdPtr); 2710 Tcl_Release((ClientData) expat->interp); 2711 2712 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 2713 } 2714 nextTcl: 2715 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 2716 } 2717 2718 activeCHandlerSet = expat->firstCHandlerSet; 2719 while (activeCHandlerSet) { 2720 if (activeCHandlerSet->datacommand) { 2721 /* 2722 * Check whether we are in 'trim' mode 2723 */ 2724 if (!activeCHandlerSet->ignoreWhiteCDATAs || !onlyWhiteSpace) { 2725 activeCHandlerSet->datacommand (activeCHandlerSet->userData, 2726 s, len); 2727 } 2728 } 2729 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 2730 } 2731 Tcl_DecrRefCount (expat->cdata); 2732 expat->cdata = 0; 2733 return; 2734} 2735 2736 2737/* 2738 *---------------------------------------------------------------------------- 2739 * 2740 * TclGenExpatProcessingInstructionHandler -- 2741 * 2742 * Called by expat for processing instructions. 2743 * 2744 * Results: 2745 * None. 2746 * 2747 * Side Effects: 2748 * Callback scripts are invoked. 2749 * 2750 *---------------------------------------------------------------------------- 2751 */ 2752 2753static void 2754TclGenExpatProcessingInstructionHandler(userData, target, data) 2755 void *userData; 2756 CONST char *target; 2757 CONST char *data; 2758{ 2759 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 2760 Tcl_Obj *cmdPtr; 2761 int result; 2762 TclHandlerSet *activeTclHandlerSet; 2763 CHandlerSet *activeCHandlerSet; 2764 2765 if (expat->status != TCL_OK) { 2766 return; 2767 } 2768 2769 TclExpatDispatchPCDATA(expat); 2770 2771 activeTclHandlerSet = expat->firstTclHandlerSet; 2772 while (activeTclHandlerSet) { 2773 2774 switch (activeTclHandlerSet->status) { 2775 case TCL_CONTINUE: 2776 case TCL_BREAK: 2777 goto nextTcl; 2778 break; 2779 default: 2780 ; 2781 } 2782 2783 if (activeTclHandlerSet->picommand == NULL) { 2784 goto nextTcl; 2785 } 2786 2787 /* 2788 * Take a copy of the callback script so that arguments may be appended. 2789 */ 2790 2791 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->picommand); 2792 Tcl_IncrRefCount(cmdPtr); 2793 Tcl_Preserve((ClientData) expat->interp); 2794 2795 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)target, strlen(target))); 2796 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)data, strlen(data))); 2797 2798 /* 2799 * It would be desirable to be able to terminate parsing 2800 * if the return result is TCL_ERROR or TCL_BREAK. 2801 */ 2802#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 2803 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 2804#else 2805 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 2806 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 2807#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 2808 2809 Tcl_DecrRefCount(cmdPtr); 2810 Tcl_Release((ClientData) expat->interp); 2811 2812 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 2813 nextTcl: 2814 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 2815 } 2816 2817 activeCHandlerSet = expat->firstCHandlerSet; 2818 while (activeCHandlerSet) { 2819 if (activeCHandlerSet->picommand) { 2820 activeCHandlerSet->picommand (activeCHandlerSet->userData, 2821 target, data); 2822 } 2823 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 2824 } 2825 return; 2826} 2827 2828/* 2829 *---------------------------------------------------------------------------- 2830 * 2831 * TclGenExpatDefaultHandler -- 2832 * 2833 * Called by expat for processing data which has no other handler. 2834 * 2835 * Results: 2836 * None. 2837 * 2838 * Side Effects: 2839 * Callback scripts are invoked. 2840 * 2841 *---------------------------------------------------------------------------- 2842 */ 2843 2844static void 2845TclGenExpatDefaultHandler(userData, s, len) 2846 void *userData; 2847 CONST char *s; 2848 int len; 2849{ 2850 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 2851 Tcl_Obj *cmdPtr; 2852 int result; 2853 TclHandlerSet *activeTclHandlerSet; 2854 CHandlerSet *activeCHandlerSet; 2855 2856 TclExpatDispatchPCDATA(expat); 2857 2858 if (expat->status != TCL_OK) { 2859 return; 2860 } 2861 2862 activeTclHandlerSet = expat->firstTclHandlerSet; 2863 while (activeTclHandlerSet) { 2864 2865 switch (activeTclHandlerSet->status) { 2866 case TCL_CONTINUE: 2867 case TCL_BREAK: 2868 goto nextTcl; 2869 break; 2870 default: 2871 ; 2872 } 2873 2874 if (activeTclHandlerSet->defaultcommand == NULL) { 2875 goto nextTcl; 2876 } 2877 2878 /* 2879 * Take a copy of the callback script so that arguments may be appended. 2880 */ 2881 2882 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->defaultcommand); 2883 Tcl_IncrRefCount(cmdPtr); 2884 Tcl_Preserve((ClientData) expat->interp); 2885 2886 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)s, len)); 2887 2888 /* 2889 * It would be desirable to be able to terminate parsing 2890 * if the return result is TCL_ERROR or TCL_BREAK. 2891 */ 2892#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 2893 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 2894#else 2895 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 2896 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 2897#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 2898 2899 Tcl_DecrRefCount(cmdPtr); 2900 Tcl_Release((ClientData) expat->interp); 2901 2902 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 2903 nextTcl: 2904 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 2905 } 2906 2907 activeCHandlerSet = expat->firstCHandlerSet; 2908 while (activeCHandlerSet) { 2909 if (activeCHandlerSet->defaultcommand) { 2910 activeCHandlerSet->defaultcommand (activeCHandlerSet->userData, 2911 s, len); 2912 } 2913 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 2914 } 2915 2916 return; 2917} 2918 2919/* 2920 *---------------------------------------------------------------------------- 2921 * 2922 * TclGenExpatEntityDeclHandler -- 2923 * 2924 * Called by expat for processing an unparsed entity references. 2925 * 2926 * Results: 2927 * None. 2928 * 2929 * Side Effects: 2930 * Callback scripts are invoked. 2931 * 2932 *---------------------------------------------------------------------------- 2933 */ 2934 2935static void 2936TclGenExpatEntityDeclHandler(userData, entityname, is_param, value, length, base, systemId, publicId, notationName) 2937 void *userData; 2938 CONST char *entityname; 2939 int is_param; 2940 CONST char *value; 2941 int length; 2942 CONST char *base; 2943 CONST char *systemId; 2944 CONST char *publicId; 2945 CONST char *notationName; 2946{ 2947 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 2948 Tcl_Obj *cmdPtr; 2949 int result; 2950 TclHandlerSet *activeTclHandlerSet; 2951 CHandlerSet *activeCHandlerSet; 2952 2953 TclExpatDispatchPCDATA(expat); 2954 2955 if (expat->status != TCL_OK) { 2956 return; 2957 } 2958 2959 activeTclHandlerSet = expat->firstTclHandlerSet; 2960 while (activeTclHandlerSet) { 2961 2962 switch (activeTclHandlerSet->status) { 2963 case TCL_CONTINUE: 2964 case TCL_BREAK: 2965 goto nextTcl; 2966 break; 2967 default: 2968 ; 2969 } 2970 2971 if (activeTclHandlerSet->entityDeclCommand == NULL) { 2972 goto nextTcl; 2973 } 2974 2975 /* 2976 * Take a copy of the callback script so that arguments may be appended. 2977 */ 2978 2979 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->entityDeclCommand); 2980 Tcl_IncrRefCount(cmdPtr); 2981 Tcl_Preserve((ClientData) expat->interp); 2982 2983 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)entityname, strlen(entityname))); 2984 Tcl_ListObjAppendElement (expat->interp, cmdPtr, Tcl_NewIntObj (is_param)); 2985 if (value == NULL) { 2986 Tcl_ListObjAppendElement (expat->interp, cmdPtr, Tcl_NewListObj (0, NULL)); 2987 } 2988 else { 2989 Tcl_ListObjAppendElement (expat->interp, cmdPtr, Tcl_NewStringObj ((char *) value, length)); 2990 } 2991 if (base == NULL) { 2992 Tcl_ListObjAppendElement (expat->interp, cmdPtr, Tcl_NewListObj (0, NULL)); 2993 } 2994 else { 2995 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)base, strlen(base))); 2996 } 2997 if (systemId == NULL) { 2998 Tcl_ListObjAppendElement (expat->interp, cmdPtr, Tcl_NewListObj (0, NULL)); 2999 } else { 3000 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)systemId, strlen(systemId))); 3001 } 3002 if (publicId == NULL) { 3003 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL)); 3004 } else { 3005 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)publicId, strlen(publicId))); 3006 } 3007 if (notationName == NULL) { 3008 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL)); 3009 } else { 3010 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)notationName, strlen(notationName))); 3011 } 3012 3013 /* 3014 * It would be desirable to be able to terminate parsing 3015 * if the return result is TCL_ERROR or TCL_BREAK. 3016 */ 3017#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 3018 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 3019#else 3020 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 3021 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 3022#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 3023 3024 Tcl_DecrRefCount(cmdPtr); 3025 Tcl_Release((ClientData) expat->interp); 3026 3027 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 3028 nextTcl: 3029 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 3030 } 3031 3032 activeCHandlerSet = expat->firstCHandlerSet; 3033 while (activeCHandlerSet) { 3034 if (activeCHandlerSet->entityDeclCommand) { 3035 activeCHandlerSet->entityDeclCommand (activeCHandlerSet->userData, 3036 entityname, is_param, value, 3037 length, base, systemId, 3038 publicId, notationName); 3039 } 3040 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 3041 } 3042 return; 3043} 3044 3045/* 3046 *---------------------------------------------------------------------------- 3047 * 3048 * TclGenExpatNotationDeclHandler -- 3049 * 3050 * Called by expat for processing a notation declaration. 3051 * 3052 * Results: 3053 * None. 3054 * 3055 * Side Effects: 3056 * Callback scripts are invoked. 3057 * 3058 *---------------------------------------------------------------------------- 3059 */ 3060 3061static void 3062TclGenExpatNotationDeclHandler(userData, notationName, base, systemId, publicId) 3063 void *userData; 3064 CONST char *notationName; 3065 CONST char *base; 3066 CONST char *systemId; 3067 CONST char *publicId; 3068{ 3069 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 3070 Tcl_Obj *cmdPtr; 3071 int result; 3072 TclHandlerSet *activeTclHandlerSet; 3073 CHandlerSet *activeCHandlerSet; 3074 3075 TclExpatDispatchPCDATA(expat); 3076 3077 if (expat->status != TCL_OK) { 3078 return; 3079 } 3080 3081 activeTclHandlerSet = expat->firstTclHandlerSet; 3082 while (activeTclHandlerSet) { 3083 3084 switch (activeTclHandlerSet->status) { 3085 case TCL_CONTINUE: 3086 case TCL_BREAK: 3087 goto nextTcl; 3088 break; 3089 default: 3090 ; 3091 } 3092 if (activeTclHandlerSet->notationcommand == NULL) { 3093 goto nextTcl; 3094 } 3095 3096 /* 3097 * Take a copy of the callback script so that arguments may be appended. 3098 */ 3099 3100 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->notationcommand); 3101 Tcl_IncrRefCount(cmdPtr); 3102 Tcl_Preserve((ClientData) expat->interp); 3103 3104 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)notationName, strlen(notationName))); 3105 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)base, strlen(base))); 3106 if (systemId == NULL) { 3107 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL)); 3108 } else { 3109 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)systemId, strlen(systemId))); 3110 } 3111 if (publicId == NULL) { 3112 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL)); 3113 } else { 3114 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)publicId, strlen(publicId))); 3115 } 3116 3117 /* 3118 * It would be desirable to be able to terminate parsing 3119 * if the return result is TCL_ERROR or TCL_BREAK. 3120 */ 3121#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 3122 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 3123#else 3124 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 3125 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 3126#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 3127 3128 Tcl_DecrRefCount(cmdPtr); 3129 Tcl_Release((ClientData) expat->interp); 3130 3131 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 3132 nextTcl: 3133 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 3134 } 3135 3136 activeCHandlerSet = expat->firstCHandlerSet; 3137 while (activeCHandlerSet) { 3138 if (activeCHandlerSet->notationcommand) { 3139 activeCHandlerSet->notationcommand (activeCHandlerSet->userData, 3140 notationName, base, 3141 systemId, publicId); 3142 } 3143 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 3144 } 3145 return; 3146} 3147 3148/* 3149 *---------------------------------------------------------------------------- 3150 * 3151 * TclGenExpatUnknownEncodingHandler -- 3152 * 3153 * Called by expat for processing a reference to a character in an 3154 * unknown encoding. 3155 * 3156 * Results: 3157 * None. 3158 * 3159 * Side Effects: 3160 * Callback scripts are invoked. 3161 * 3162 *---------------------------------------------------------------------------- 3163 */ 3164 3165static int 3166TclGenExpatUnknownEncodingHandler(encodingHandlerData, name, info) 3167 void *encodingHandlerData; 3168 CONST char *name; 3169 XML_Encoding *info; 3170{ 3171 TclGenExpatInfo *expat = (TclGenExpatInfo *) encodingHandlerData; 3172 CHandlerSet *activeCHandlerSet; 3173 3174 TclExpatDispatchPCDATA(expat); 3175 3176 if (expat->status != TCL_OK) { 3177 return 1; 3178 } 3179 3180 if (expat->firstTclHandlerSet) { 3181 Tcl_SetResult(expat->interp, "not implemented", NULL); 3182 return 0; 3183 } 3184 3185 activeCHandlerSet = expat->firstCHandlerSet; 3186 while (activeCHandlerSet) { 3187 if (activeCHandlerSet->unknownencodingcommand) { 3188 activeCHandlerSet->unknownencodingcommand (activeCHandlerSet->userData, 3189 name, info); 3190 } 3191 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 3192 } 3193 return 1; 3194} 3195 3196/* 3197 *---------------------------------------------------------------------------- 3198 * 3199 * TclGenExpatExternalEntityRefHandler -- 3200 * 3201 * Called by expat for processing external entity references. 3202 * 3203 * Results: 3204 * None. 3205 * 3206 * Side Effects: 3207 * Callback scripts are invoked. 3208 * 3209 *---------------------------------------------------------------------------- 3210 */ 3211static int 3212TclGenExpatExternalEntityRefHandler(parser, openEntityNames, base, systemId, 3213 publicId) 3214 XML_Parser parser; 3215 CONST char *openEntityNames; 3216 CONST char *base; 3217 CONST char *systemId; 3218 CONST char *publicId; 3219{ 3220 TclGenExpatInfo *expat = (TclGenExpatInfo *) XML_GetUserData(parser); 3221 Tcl_Obj *cmdPtr, *resultObj, *resultTypeObj, *extbaseObj, *dataObj; 3222 int result, mode, done, fd, tclLen; 3223 size_t len; 3224 TclHandlerSet *activeTclHandlerSet; 3225 CHandlerSet *activeCHandlerSet; 3226 XML_Parser extparser, oldparser = NULL; 3227 char s[255], buf[8*1024], *dataStr, *resultType, *extbase; 3228 TclExpat_InputType inputType; 3229 Tcl_Channel chan = (Tcl_Channel) NULL; 3230 3231 3232 if (expat->status != TCL_OK) { 3233 return 1; 3234 } 3235 3236 TclExpatDispatchPCDATA(expat); 3237 3238 activeTclHandlerSet = expat->firstTclHandlerSet; 3239 while (activeTclHandlerSet) { 3240 3241 switch (activeTclHandlerSet->status) { 3242 case TCL_CONTINUE: 3243 case TCL_BREAK: 3244 goto nextTcl; 3245 break; 3246 default: 3247 ; 3248 } 3249 if (activeTclHandlerSet->externalentitycommand == NULL) { 3250 goto nextTcl; 3251 } 3252 3253 /* 3254 * Take a copy of the callback script so that arguments may be appended. 3255 */ 3256 3257 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->externalentitycommand); 3258 Tcl_IncrRefCount(cmdPtr); 3259 Tcl_Preserve((ClientData) expat->interp); 3260 3261 if (base) { 3262 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 3263 Tcl_NewStringObj((char *)base, strlen(base))); 3264 } else { 3265 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 3266 Tcl_NewStringObj("", 0)); 3267 } 3268 3269 if (systemId) { 3270 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 3271 Tcl_NewStringObj((char *)systemId, strlen(systemId))); 3272 } else { 3273 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 3274 Tcl_NewStringObj("", 0)); 3275 } 3276 3277 if (publicId) { 3278 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 3279 Tcl_NewStringObj((char *)publicId, strlen(publicId))); 3280 } else { 3281 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 3282 Tcl_NewStringObj("", 0)); 3283 } 3284 3285#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 3286 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 3287#else 3288 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 3289 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 3290#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 3291 3292 Tcl_DecrRefCount(cmdPtr); 3293 Tcl_Release((ClientData) expat->interp); 3294 3295 switch (result) { 3296 case TCL_OK: 3297 break; 3298 case TCL_CONTINUE: 3299 goto nextTcl; 3300 break; 3301 case TCL_ERROR: 3302 TclExpatHandlerResult (expat, activeTclHandlerSet, 3303 ERROR_IN_EXTREFHANDLER); 3304 return 0; 3305 default: 3306 TclExpatHandlerResult (expat, activeTclHandlerSet, result); 3307 return 0; 3308 } 3309 3310 extparser = XML_ExternalEntityParserCreate (parser, openEntityNames, 0); 3311 3312 resultObj = Tcl_GetObjResult (expat->interp); 3313 Tcl_IncrRefCount (resultObj); 3314 3315 result = Tcl_ListObjLength (expat->interp, resultObj, &tclLen); 3316 if ((result != TCL_OK) || (tclLen != 3)) { 3317 goto wrongScriptResult; 3318 } 3319 result = Tcl_ListObjIndex (expat->interp, resultObj, 0, &resultTypeObj); 3320 if (result != TCL_OK) { 3321 goto wrongScriptResult; 3322 } 3323 resultType = Tcl_GetString(resultTypeObj); 3324 if (strcmp (resultType, "string") == 0) { 3325 inputType = EXPAT_INPUT_STRING; 3326 } else if (strcmp (resultType, "channel") == 0) { 3327 inputType = EXPAT_INPUT_CHANNEL; 3328 } else if (strcmp (resultType, "filename") == 0) { 3329 inputType = EXPAT_INPUT_FILENAME; 3330 } else { 3331 goto wrongScriptResult; 3332 } 3333 3334 result = Tcl_ListObjIndex (expat->interp, resultObj, 1, &extbaseObj); 3335 if (result != TCL_OK) { 3336 goto wrongScriptResult; 3337 } 3338 extbase = Tcl_GetString(extbaseObj); 3339 3340 if (!extparser) { 3341 Tcl_DecrRefCount (resultObj); 3342 Tcl_SetResult (expat->interp, 3343 "unable to create expat external entity parser", 3344 NULL); 3345 TclExpatHandlerResult(expat, activeTclHandlerSet, 3346 ERROR_IN_EXTREFHANDLER); 3347 return 0; 3348 } 3349 3350 oldparser = expat->parser; 3351 expat->parser = extparser; 3352 XML_SetBase (extparser, extbase); 3353 3354 result = Tcl_ListObjIndex (expat->interp, resultObj, 2, &dataObj); 3355 if (result != TCL_OK) { 3356 goto wrongScriptResult; 3357 } 3358 3359 activeCHandlerSet = expat->firstCHandlerSet; 3360 while (activeCHandlerSet) { 3361 if (activeCHandlerSet->parserResetProc) { 3362 activeCHandlerSet->parserResetProc (extparser, 3363 activeCHandlerSet->userData); 3364 } 3365 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 3366 } 3367 3368 dataStr = Tcl_GetStringFromObj (dataObj, &tclLen); 3369 switch (inputType) { 3370 case EXPAT_INPUT_STRING: 3371 result = XML_Parse (extparser, dataStr, tclLen, 1); 3372 break; 3373 3374 case EXPAT_INPUT_CHANNEL: 3375 chan = Tcl_GetChannel (expat->interp, dataStr, &mode); 3376 if (chan == (Tcl_Channel) NULL) { 3377 goto wrongScriptResult; 3378 } 3379 if (!(mode & TCL_READABLE)) { 3380 Tcl_UnregisterChannel (expat->interp, chan); 3381 Tcl_ResetResult (expat->interp); 3382 Tcl_AppendResult (expat->interp, "channel \"", dataStr, 3383 "\" returned by the externalentitycommand ", 3384 "wasn't opened for reading", (char *) NULL); 3385 TclExpatHandlerResult (expat, activeTclHandlerSet, 3386 ERROR_IN_EXTREFHANDLER); 3387 Tcl_DecrRefCount (resultObj); 3388 XML_ParserFree (extparser); 3389 expat->parser = oldparser; 3390 return 0; 3391 } 3392 result = 1; 3393 do { 3394 len = Tcl_Read (chan, buf, sizeof (buf)); 3395 done = len < sizeof (buf); 3396 if (!XML_Parse (extparser, buf, len, done)) { 3397 result = 0; 3398 break; 3399 } 3400 } while (!done); 3401 Tcl_UnregisterChannel (expat->interp, chan); 3402 break; 3403 3404 case EXPAT_INPUT_FILENAME: 3405 fd = open(dataStr, O_BINARY|O_RDONLY); 3406 if (fd < 0) { 3407 Tcl_ResetResult (expat->interp); 3408 Tcl_AppendResult (expat->interp, "error opening file \"", 3409 dataStr, "\"", (char *) NULL); 3410 TclExpatHandlerResult (expat, activeTclHandlerSet, 3411 ERROR_IN_EXTREFHANDLER); 3412 Tcl_DecrRefCount (resultObj); 3413 XML_ParserFree (extparser); 3414 expat->parser = oldparser; 3415 return 0; 3416 } 3417 result = 1; 3418 for (;;) { 3419 int nread; 3420 char *fbuf = XML_GetBuffer (extparser, READ_SIZE); 3421 if (!fbuf) { 3422 close (fd); 3423 Tcl_ResetResult (expat->interp); 3424 Tcl_SetResult (expat->interp, "Out of memory\n", NULL); 3425 TclExpatHandlerResult (expat, activeTclHandlerSet, 3426 ERROR_IN_EXTREFHANDLER); 3427 return 0; 3428 } 3429 nread = read(fd, fbuf, READ_SIZE); 3430 if (nread < 0) { 3431 close (fd); 3432 Tcl_ResetResult (expat->interp); 3433 Tcl_AppendResult (expat->interp, 3434 "error reading from file \"", 3435 dataStr, "\"", (char *) NULL); 3436 TclExpatHandlerResult (expat, activeTclHandlerSet, 3437 ERROR_IN_EXTREFHANDLER); 3438 return 0; 3439 } 3440 if (!XML_ParseBuffer (extparser, nread, nread == 0)) { 3441 close (fd); 3442 result = 0; 3443 break; 3444 } 3445 if (nread == 0) { 3446 close(fd); 3447 break; 3448 } 3449 } 3450 break; 3451 } 3452 3453 Tcl_DecrRefCount (resultObj); 3454 if (!result) { 3455 Tcl_ResetResult (expat->interp); 3456 sprintf(s, "%ld", XML_GetCurrentLineNumber(extparser)); 3457 Tcl_AppendResult(expat->interp, "Not wellformed error \"", 3458 XML_ErrorString(XML_GetErrorCode(extparser)), 3459 "\" while parsing external entity: \n\t", 3460 systemId, "\nat line ", s, " character ", NULL); 3461 sprintf(s, "%ld", XML_GetCurrentColumnNumber(extparser)); 3462 Tcl_AppendResult(expat->interp, s, NULL); 3463 XML_ParserFree (extparser); 3464 expat->parser = oldparser; 3465 TclExpatHandlerResult(expat, activeTclHandlerSet, 3466 ERROR_IN_EXTREFHANDLER); 3467 return 0; 3468 } 3469 3470 /* The last node in the external entity may be a text node. To call 3471 TclExpatDispatchPCDATA, before switching back to the old parser 3472 ensures, that that last text node has the right base URI. */ 3473 TclExpatDispatchPCDATA(expat); 3474 3475 XML_ParserFree (extparser); 3476 expat->parser = oldparser; 3477 3478 activeCHandlerSet = expat->firstCHandlerSet; 3479 while (activeCHandlerSet) { 3480 if (activeCHandlerSet->parserResetProc) { 3481 activeCHandlerSet->parserResetProc (oldparser, 3482 activeCHandlerSet->userData); 3483 } 3484 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 3485 } 3486 3487 TclExpatHandlerResult(expat, activeTclHandlerSet, TCL_OK); 3488 return 1; 3489 3490 nextTcl: 3491 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 3492 } 3493 3494 activeCHandlerSet = expat->firstCHandlerSet; 3495 while (activeCHandlerSet) { 3496 if (activeCHandlerSet->externalentitycommand) { 3497 if (activeCHandlerSet->externalentitycommand ( 3498 activeCHandlerSet->userData, openEntityNames, base, systemId, 3499 publicId)) { 3500 return 1; 3501 } 3502 } 3503 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 3504 } 3505 3506 return 0; 3507 3508 wrongScriptResult: 3509 Tcl_DecrRefCount (resultObj); 3510 Tcl_ResetResult (expat->interp); 3511 XML_ParserFree (extparser); 3512 if (oldparser) { 3513 expat->parser = oldparser; 3514 } 3515 Tcl_AppendResult (expat->interp, "The -externalentitycommand script has", 3516 " to return a Tcl list with 3 elements.\n", 3517 "Synatx: {string|channel|filename <baseurl> <data>}\n", 3518 NULL); 3519 TclExpatHandlerResult (expat, activeTclHandlerSet, 3520 ERROR_IN_EXTREFHANDLER); 3521 return 0; 3522} 3523 3524/* 3525 *---------------------------------------------------------------------------- 3526 * 3527 * TclGenExpatCommentHandler -- 3528 * 3529 * Called by expat to handle comments encountered while parsing 3530 * Added by ericm@scriptics.com, 1999.6.25. 3531 * 3532 * Results: 3533 * None. 3534 * 3535 * Side Effects: 3536 * Callback scripts are invoked. 3537 * 3538 *---------------------------------------------------------------------------- 3539 */ 3540static void 3541TclGenExpatCommentHandler(userData, data) 3542 void *userData; 3543 const char *data; 3544{ 3545 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 3546 Tcl_Obj *cmdPtr; 3547 int result; 3548 TclHandlerSet *activeTclHandlerSet; 3549 CHandlerSet *activeCHandlerSet; 3550 3551 3552 if (expat->status != TCL_OK) { 3553 return; 3554 } 3555 3556 TclExpatDispatchPCDATA(expat); 3557 3558 activeTclHandlerSet = expat->firstTclHandlerSet; 3559 while (activeTclHandlerSet) { 3560 3561 switch (activeTclHandlerSet->status) { 3562 case TCL_CONTINUE: 3563 case TCL_BREAK: 3564 goto nextTcl; 3565 break; 3566 default: 3567 ; 3568 } 3569 3570 if (activeTclHandlerSet->commentCommand == NULL) { 3571 goto nextTcl; 3572 } 3573 3574 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->commentCommand); 3575 Tcl_IncrRefCount(cmdPtr); 3576 Tcl_Preserve((ClientData) expat->interp); 3577 3578 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 3579 Tcl_NewStringObj((char *)data, strlen(data))); 3580 3581#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 3582 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 3583#else 3584 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 3585 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 3586#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 3587 3588 Tcl_DecrRefCount(cmdPtr); 3589 Tcl_Release((ClientData) expat->interp); 3590 3591 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 3592 nextTcl: 3593 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 3594 } 3595 3596 activeCHandlerSet = expat->firstCHandlerSet; 3597 while (activeCHandlerSet) { 3598 if (activeCHandlerSet->commentCommand) { 3599 activeCHandlerSet->commentCommand (activeCHandlerSet->userData, 3600 data); 3601 } 3602 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 3603 } 3604 return; 3605} 3606/* 3607 *---------------------------------------------------------------------------- 3608 * 3609 * TclGenExpatNotStandaloneHandler -- 3610 * 3611 * Called by expat to handle "not standalone" documents (ie, documents 3612 * that have an external subset or a reference to a parameter entity, 3613 * but do not have standalone="yes") 3614 * Added by ericm@scriptics.com, 1999.6.25. 3615 * 3616 * Results: 3617 * None. 3618 * 3619 * Side Effects: 3620 * Callback scripts are invoked. 3621 * 3622 *---------------------------------------------------------------------------- 3623 */ 3624static int 3625TclGenExpatNotStandaloneHandler(userData) 3626 void *userData; 3627{ 3628 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 3629 Tcl_Obj *cmdPtr; 3630 int result; 3631 TclHandlerSet *activeTclHandlerSet; 3632 CHandlerSet *activeCHandlerSet; 3633 3634 TclExpatDispatchPCDATA(expat); 3635 3636 if (expat->status != TCL_OK) { 3637 return 1; 3638 } 3639 3640 activeTclHandlerSet = expat->firstTclHandlerSet; 3641 while (activeTclHandlerSet) { 3642 3643 switch (activeTclHandlerSet->status) { 3644 case TCL_CONTINUE: 3645 case TCL_BREAK: 3646 goto nextTcl; 3647 break; 3648 default: 3649 ; 3650 } 3651 3652 if (activeTclHandlerSet->notStandaloneCommand == NULL) { 3653 goto nextTcl; 3654 } 3655 3656 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->notStandaloneCommand); 3657 Tcl_IncrRefCount(cmdPtr); 3658 Tcl_Preserve((ClientData) expat->interp); 3659 3660#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 3661 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 3662#else 3663 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 3664 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 3665#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 3666 3667 Tcl_DecrRefCount(cmdPtr); 3668 Tcl_Release((ClientData) expat->interp); 3669 3670 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 3671 nextTcl: 3672 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 3673 } 3674 3675 activeCHandlerSet = expat->firstCHandlerSet; 3676 while (activeCHandlerSet) { 3677 if (activeCHandlerSet->notStandaloneCommand) { 3678 activeCHandlerSet->notStandaloneCommand (activeCHandlerSet->userData); 3679 } 3680 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 3681 } 3682 return 1; 3683} 3684 3685/* 3686 *---------------------------------------------------------------------------- 3687 * 3688 * TclGenExpatStartCdataSectionHandler -- 3689 * 3690 * Called by expat to handle CDATA section starts. 3691 * Added by ericm@scriptics.com, 1999.6.25. 3692 * 3693 * Results: 3694 * None. 3695 * 3696 * Side Effects: 3697 * Callback scripts are invoked. 3698 * 3699 *---------------------------------------------------------------------------- 3700 */ 3701static void 3702TclGenExpatStartCdataSectionHandler(userData) 3703 void *userData; 3704{ 3705 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 3706 Tcl_Obj *cmdPtr; 3707 int result; 3708 TclHandlerSet *activeTclHandlerSet; 3709 CHandlerSet *activeCHandlerSet; 3710 3711 if (expat->status != TCL_OK) { 3712 return; 3713 } 3714 3715 TclExpatDispatchPCDATA(expat); 3716 3717 activeTclHandlerSet = expat->firstTclHandlerSet; 3718 while (activeTclHandlerSet) { 3719 3720 switch (activeTclHandlerSet->status) { 3721 case TCL_CONTINUE: 3722 /* Currently skipping elements; CDATA Start and End must be 3723 * inside an element content, so we don't have to fiddle 3724 * around with continue counting and just go throw. */ 3725 case TCL_BREAK: 3726 goto nextTcl; 3727 break; 3728 default: 3729 ; 3730 } 3731 3732 if (activeTclHandlerSet->startCdataSectionCommand == NULL) { 3733 goto nextTcl; 3734 } 3735 3736 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->startCdataSectionCommand); 3737 Tcl_IncrRefCount(cmdPtr); 3738 Tcl_Preserve((ClientData) expat->interp); 3739 3740#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 3741 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 3742#else 3743 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 3744 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 3745#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 3746 3747 Tcl_DecrRefCount(cmdPtr); 3748 Tcl_Release((ClientData) expat->interp); 3749 3750 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 3751 nextTcl: 3752 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 3753 } 3754 3755 activeCHandlerSet = expat->firstCHandlerSet; 3756 while (activeCHandlerSet) { 3757 if (activeCHandlerSet->startCdataSectionCommand) { 3758 activeCHandlerSet->startCdataSectionCommand (activeCHandlerSet->userData); 3759 } 3760 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 3761 } 3762 return; 3763} 3764 3765/* 3766 *---------------------------------------------------------------------------- 3767 * 3768 * TclGenExpatEndCdataSectionHandler 3769 * 3770 * Called by expat to handle CDATA section ends 3771 * Added by ericm@scriptics.com, 1999.6.25. 3772 * 3773 * Results: 3774 * None. 3775 * 3776 * Side Effects: 3777 * Callback scripts are invoked. 3778 * 3779 *---------------------------------------------------------------------------- 3780 */ 3781static void 3782TclGenExpatEndCdataSectionHandler(userData) 3783 void *userData; 3784{ 3785 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 3786 Tcl_Obj *cmdPtr; 3787 int result; 3788 TclHandlerSet *activeTclHandlerSet; 3789 CHandlerSet *activeCHandlerSet; 3790 3791 if (expat->status != TCL_OK) { 3792 return; 3793 } 3794 3795 TclExpatDispatchPCDATA(expat); 3796 3797 activeTclHandlerSet = expat->firstTclHandlerSet; 3798 while (activeTclHandlerSet) { 3799 3800 switch (activeTclHandlerSet->status) { 3801 case TCL_CONTINUE: 3802 case TCL_BREAK: 3803 goto nextTcl; 3804 break; 3805 default: 3806 ; 3807 } 3808 3809 if (activeTclHandlerSet->endCdataSectionCommand == NULL) { 3810 goto nextTcl; 3811 } 3812 3813 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->endCdataSectionCommand); 3814 Tcl_IncrRefCount(cmdPtr); 3815 Tcl_Preserve((ClientData) expat->interp); 3816 3817#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 3818 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 3819#else 3820 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 3821 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 3822#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 3823 3824 Tcl_DecrRefCount(cmdPtr); 3825 Tcl_Release((ClientData) expat->interp); 3826 3827 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 3828 nextTcl: 3829 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 3830 } 3831 3832 activeCHandlerSet = expat->firstCHandlerSet; 3833 while (activeCHandlerSet) { 3834 if (activeCHandlerSet->endCdataSectionCommand) { 3835 activeCHandlerSet->endCdataSectionCommand (activeCHandlerSet->userData); 3836 } 3837 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 3838 } 3839 return; 3840} 3841 3842 3843static void 3844generateModel (interp, rep, model) 3845 Tcl_Interp *interp; 3846 Tcl_Obj *rep; 3847 XML_Content *model; 3848{ 3849 Tcl_Obj *cp, *detail; 3850 unsigned int i; 3851 3852 3853 switch (model->type) { 3854 case XML_CTYPE_EMPTY: 3855 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("EMPTY", 5)); 3856 break; 3857 case XML_CTYPE_ANY: 3858 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("ANY", 3)); 3859 break; 3860 case XML_CTYPE_MIXED: 3861 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("MIXED", 5)); 3862 break; 3863 case XML_CTYPE_NAME: 3864 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("NAME", 4)); 3865 break; 3866 case XML_CTYPE_CHOICE: 3867 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("CHOICE", 6)); 3868 break; 3869 case XML_CTYPE_SEQ: 3870 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("SEQ", 3)); 3871 break; 3872 } 3873 switch (model->quant) { 3874 case XML_CQUANT_NONE: 3875 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("", 0)); 3876 break; 3877 case XML_CQUANT_OPT: 3878 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("?", 1)); 3879 break; 3880 case XML_CQUANT_REP: 3881 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("*", 1)); 3882 break; 3883 case XML_CQUANT_PLUS: 3884 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("+", 1)); 3885 break; 3886 } 3887 3888 if (model->name) { 3889 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ((char*)model->name, -1)); 3890 } 3891 else { 3892 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("", 0)); 3893 } 3894 if (model->numchildren) { 3895 cp = Tcl_NewListObj (0, NULL); 3896 for (i = 0; i < model->numchildren; i++) { 3897 detail = Tcl_NewListObj (0, NULL); 3898 generateModel (interp, detail, &model->children[i]); 3899 Tcl_ListObjAppendElement (interp, cp, detail); 3900 } 3901 Tcl_ListObjAppendElement (interp, rep, cp); 3902 } 3903 else { 3904 Tcl_ListObjAppendElement (interp, rep, Tcl_NewStringObj ("", 0)); 3905 } 3906} 3907 3908 3909/* 3910 *---------------------------------------------------------------------- 3911 * 3912 * TclGenExpatElementDeclHandler -- 3913 * 3914 * Called by expat to handle <!ELEMENT declarations. 3915 * 3916 * Results: 3917 * None. 3918 * 3919 * Side effects: 3920 * Callback scripts are invoked. 3921 * 3922 *---------------------------------------------------------------------- 3923 */ 3924 3925static void 3926TclGenExpatElementDeclHandler(userData, name, model) 3927 void *userData; 3928 const XML_Char *name; 3929 XML_Content *model; 3930{ 3931 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 3932 Tcl_Obj *cmdPtr; 3933 Tcl_Obj *content; 3934 int result; 3935 TclHandlerSet *activeTclHandlerSet; 3936 CHandlerSet *activeCHandlerSet; 3937 ExpatElemContent *eContent; 3938 3939 TclExpatDispatchPCDATA(expat); 3940 3941 eContent = (ExpatElemContent *) MALLOC (sizeof (ExpatElemContent)); 3942 eContent->content = model; 3943 eContent->next = expat->eContents; 3944 expat->eContents = eContent; 3945 3946 if (expat->status != TCL_OK) { 3947 return; 3948 } 3949 3950 activeTclHandlerSet = expat->firstTclHandlerSet; 3951 while (activeTclHandlerSet) { 3952 3953 switch (activeTclHandlerSet->status) { 3954 case TCL_CONTINUE: 3955 /* Makes not much sense... */ 3956 case TCL_BREAK: 3957 goto nextTcl; 3958 break; 3959 default: 3960 ; 3961 } 3962 3963 if (activeTclHandlerSet->elementDeclCommand == NULL) { 3964 goto nextTcl; 3965 } 3966 3967 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->elementDeclCommand); 3968 Tcl_IncrRefCount(cmdPtr); 3969 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 3970 Tcl_NewStringObj((char *)name, strlen(name))); 3971 3972 3973 content = Tcl_NewListObj (0, NULL); 3974 generateModel (expat->interp, content, model); 3975 3976 Tcl_ListObjAppendElement(expat->interp, cmdPtr, content); 3977 3978#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 3979 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 3980#else 3981 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 3982 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 3983#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 3984 3985 Tcl_DecrRefCount(cmdPtr); 3986 3987 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 3988 nextTcl: 3989 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 3990 } 3991 3992 activeCHandlerSet = expat->firstCHandlerSet; 3993 while (activeCHandlerSet) { 3994 if (activeCHandlerSet->elementDeclCommand) { 3995 activeCHandlerSet->elementDeclCommand (activeCHandlerSet->userData, 3996 name, model); 3997 } 3998 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 3999 } 4000 4001 return; 4002} 4003 4004/* 4005 *---------------------------------------------------------------------- 4006 * 4007 * TclGenExpatAttlistDeclHandler -- 4008 * 4009 * Called by expat to handle <!ATTLIST declarations. 4010 * 4011 * Results: 4012 * None. 4013 * 4014 * Side effects: 4015 * Callback scripts are invoked. 4016 * 4017 *---------------------------------------------------------------------- 4018 */ 4019 4020static void 4021TclGenExpatAttlistDeclHandler(userData, elname, name, type, dflt, isrequired) 4022 void *userData; 4023 const XML_Char *elname; 4024 const XML_Char *name; 4025 const XML_Char *type; 4026 const XML_Char *dflt; 4027 int isrequired; 4028{ 4029 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 4030 Tcl_Obj *cmdPtr; 4031 int result; 4032 TclHandlerSet *activeTclHandlerSet; 4033 CHandlerSet *activeCHandlerSet; 4034 4035 TclExpatDispatchPCDATA(expat); 4036 4037 if (expat->status != TCL_OK) { 4038 return; 4039 } 4040 4041 activeTclHandlerSet = expat->firstTclHandlerSet; 4042 while (activeTclHandlerSet) { 4043 4044 switch (activeTclHandlerSet->status) { 4045 case TCL_CONTINUE: 4046 /* Make not much sense... */ 4047 case TCL_BREAK: 4048 goto nextTcl; 4049 break; 4050 default: 4051 ; 4052 } 4053 4054 if (activeTclHandlerSet->attlistDeclCommand == NULL) { 4055 goto nextTcl; 4056 } 4057 4058 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->attlistDeclCommand); 4059 Tcl_IncrRefCount(cmdPtr); 4060 Tcl_Preserve((ClientData) expat->interp); 4061 4062 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 4063 Tcl_NewStringObj((char *)elname, strlen (elname))); 4064 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 4065 Tcl_NewStringObj((char *)name, strlen (name))); 4066 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 4067 Tcl_NewStringObj((char *)type, strlen (type))); 4068 if (!dflt) { 4069 Tcl_ListObjAppendElement (expat->interp, cmdPtr, 4070 Tcl_NewStringObj ("", 0)); 4071 } 4072 else { 4073 Tcl_ListObjAppendElement (expat->interp, cmdPtr, 4074 Tcl_NewStringObj ((char*)dflt, strlen (dflt))); 4075 } 4076 Tcl_ListObjAppendElement (expat->interp, cmdPtr, 4077 Tcl_NewIntObj (isrequired)); 4078 4079#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 4080 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 4081#else 4082 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 4083 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 4084#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 4085 4086 Tcl_DecrRefCount(cmdPtr); 4087 Tcl_Release((ClientData) expat->interp); 4088 4089 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 4090 nextTcl: 4091 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 4092 } 4093 4094 activeCHandlerSet = expat->firstCHandlerSet; 4095 while (activeCHandlerSet) { 4096 if (activeCHandlerSet->attlistDeclCommand) { 4097 activeCHandlerSet->attlistDeclCommand (activeCHandlerSet->userData, 4098 elname, name, type, dflt, 4099 isrequired); 4100 } 4101 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 4102 } 4103 return; 4104} 4105 4106/* 4107 *---------------------------------------------------------------------- 4108 * 4109 * TclGenExpatStartDoctypeDeclHandler -- 4110 * 4111 * Called by expat to handle the start of <!DOCTYPE declarations. 4112 * 4113 * Results: 4114 * None. 4115 * 4116 * Side effects: 4117 * Callback scripts are invoked. 4118 * 4119 *---------------------------------------------------------------------- 4120 */ 4121 4122static void 4123TclGenExpatStartDoctypeDeclHandler(userData, doctypeName, sysid, pubid, has_internal_subset) 4124 void *userData; 4125 const XML_Char *doctypeName; 4126 const XML_Char *sysid; 4127 const XML_Char *pubid; 4128 int has_internal_subset; 4129{ 4130 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 4131 Tcl_Obj *cmdPtr; 4132 int result; 4133 TclHandlerSet *activeTclHandlerSet; 4134 CHandlerSet *activeCHandlerSet; 4135 4136 TclExpatDispatchPCDATA(expat); 4137 4138 if (expat->status != TCL_OK) { 4139 return; 4140 } 4141 4142 activeTclHandlerSet = expat->firstTclHandlerSet; 4143 while (activeTclHandlerSet) { 4144 4145 switch (activeTclHandlerSet->status) { 4146 case TCL_CONTINUE: 4147 /* Make not much sense... */ 4148 case TCL_BREAK: 4149 goto nextTcl; 4150 break; 4151 default: 4152 ; 4153 } 4154 4155 if (activeTclHandlerSet->startDoctypeDeclCommand == NULL) { 4156 goto nextTcl; 4157 } 4158 4159 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->startDoctypeDeclCommand); 4160 Tcl_IncrRefCount(cmdPtr); 4161 Tcl_Preserve((ClientData) expat->interp); 4162 4163 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 4164 Tcl_NewStringObj((char *)doctypeName, strlen(doctypeName))); 4165 if (sysid != NULL) { 4166 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 4167 Tcl_NewStringObj((char *)sysid, strlen(sysid))); 4168 } else { 4169 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 4170 Tcl_NewStringObj("NULL", 4)); 4171 } 4172 if (pubid != NULL) { 4173 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 4174 Tcl_NewStringObj((char *)pubid, strlen(sysid))); 4175 } else { 4176 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 4177 Tcl_NewStringObj("NULL", 4)); 4178 } 4179 Tcl_ListObjAppendElement(expat->interp, cmdPtr, 4180 Tcl_NewIntObj(has_internal_subset)); 4181 4182#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 4183 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 4184#else 4185 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 4186 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 4187#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 4188 4189 Tcl_DecrRefCount(cmdPtr); 4190 Tcl_Release((ClientData) expat->interp); 4191 4192 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 4193 nextTcl: 4194 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 4195 } 4196 4197 activeCHandlerSet = expat->firstCHandlerSet; 4198 while (activeCHandlerSet) { 4199 if (activeCHandlerSet->startDoctypeDeclCommand) { 4200 activeCHandlerSet->startDoctypeDeclCommand (activeCHandlerSet->userData, 4201 doctypeName, sysid, 4202 pubid, 4203 has_internal_subset); 4204 } 4205 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 4206 } 4207 return; 4208} 4209 4210/* 4211 *---------------------------------------------------------------------- 4212 * 4213 * TclGenExpatEndDoctypeDeclHandler -- 4214 * 4215 * Called by expat to handle the end of <!DOCTYPE declarations. 4216 * 4217 * Results: 4218 * None. 4219 * 4220 * Side effects: 4221 * Callback script is invoked. 4222 * 4223 *---------------------------------------------------------------------- 4224 */ 4225 4226static void 4227TclGenExpatEndDoctypeDeclHandler(userData) 4228 void *userData; 4229{ 4230 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 4231 Tcl_Obj *cmdPtr; 4232 int result; 4233 TclHandlerSet *activeTclHandlerSet; 4234 CHandlerSet *activeCHandlerSet; 4235 ExpatElemContent *eContent, *eContentSave; 4236 4237 TclExpatDispatchPCDATA(expat); 4238 4239 if (expat->status != TCL_OK) { 4240 return; 4241 } 4242 4243 activeTclHandlerSet = expat->firstTclHandlerSet; 4244 while (activeTclHandlerSet) { 4245 4246 switch (activeTclHandlerSet->status) { 4247 case TCL_CONTINUE: 4248 case TCL_BREAK: 4249 goto nextTcl; 4250 break; 4251 default: 4252 ; 4253 } 4254 4255 if (activeTclHandlerSet->endDoctypeDeclCommand == NULL) { 4256 goto nextTcl; 4257 } 4258 4259 cmdPtr = Tcl_DuplicateObj(activeTclHandlerSet->endDoctypeDeclCommand); 4260 Tcl_IncrRefCount(cmdPtr); 4261 Tcl_Preserve((ClientData) expat->interp); 4262 4263#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 4264 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 4265#else 4266 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 4267 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 4268#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 4269 4270 Tcl_DecrRefCount(cmdPtr); 4271 Tcl_Release((ClientData) expat->interp); 4272 4273 TclExpatHandlerResult(expat, activeTclHandlerSet, result); 4274 nextTcl: 4275 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 4276 } 4277 4278 activeCHandlerSet = expat->firstCHandlerSet; 4279 while (activeCHandlerSet) { 4280 if (activeCHandlerSet->endDoctypeDeclCommand) { 4281 activeCHandlerSet->endDoctypeDeclCommand (activeCHandlerSet->userData); 4282 } 4283 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 4284 } 4285 4286 eContent = expat->eContents; 4287 while (eContent) { 4288 XML_FreeContentModel (expat->parser, eContent->content); 4289 eContentSave = eContent; 4290 eContent = eContent->next; 4291 FREE((char *) eContentSave); 4292 } 4293 expat->eContents = NULL; 4294 4295 return; 4296} 4297 4298 4299/* 4300 *---------------------------------------------------------------------- 4301 * 4302 * TclGenExpatXmlDeclHandler -- 4303 * 4304 * Called by expat for both XML declarations and text declarations. 4305 * 4306 * Results: 4307 * None. 4308 * 4309 * Side effects: 4310 * Callback script is invoked. 4311 * 4312 *---------------------------------------------------------------------- 4313 */ 4314 4315static void 4316TclGenExpatXmlDeclHandler (userData, version, encoding, standalone) 4317 void *userData; 4318 const char *version; 4319 const char *encoding; 4320 int standalone; 4321{ 4322 TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 4323 Tcl_Obj *cmdPtr; 4324 int result; 4325 TclHandlerSet *activeTclHandlerSet; 4326 CHandlerSet *activeCHandlerSet; 4327 4328 if (expat->status != TCL_OK) { 4329 return; 4330 } 4331 4332 activeTclHandlerSet = expat->firstTclHandlerSet; 4333 while (activeTclHandlerSet) { 4334 4335 switch (activeTclHandlerSet->status) { 4336 case TCL_CONTINUE: 4337 /* Make not much sense... */ 4338 case TCL_BREAK: 4339 goto nextTcl; 4340 break; 4341 default: 4342 ; 4343 } 4344 4345 if (activeTclHandlerSet->xmlDeclCommand == NULL) { 4346 goto nextTcl; 4347 } 4348 cmdPtr = Tcl_DuplicateObj (activeTclHandlerSet->xmlDeclCommand); 4349 Tcl_IncrRefCount (cmdPtr); 4350 Tcl_Preserve ((ClientData) expat->interp); 4351 4352 Tcl_ListObjAppendElement (expat->interp, cmdPtr, 4353 Tcl_NewStringObj ((char*)version, -1)); 4354 Tcl_ListObjAppendElement (expat->interp, cmdPtr, 4355 Tcl_NewStringObj ((char*)encoding, -1)); 4356 if (standalone == -1) { 4357 Tcl_ListObjAppendElement (expat->interp, cmdPtr, 4358 Tcl_NewStringObj ("", 0)); 4359 } 4360 else { 4361 Tcl_ListObjAppendElement (expat->interp, cmdPtr, 4362 Tcl_NewBooleanObj (standalone)); 4363 } 4364 4365#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) 4366 result = Tcl_GlobalEvalObj (expat->interp, cmdPtr); 4367#else 4368 result = Tcl_EvalObjEx(expat->interp, cmdPtr, 4369 TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT); 4370#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ 4371 4372 Tcl_DecrRefCount(cmdPtr); 4373 Tcl_Release((ClientData) expat->interp); 4374 4375 TclExpatHandlerResult (expat, activeTclHandlerSet, result); 4376 nextTcl: 4377 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 4378 } 4379 4380 activeCHandlerSet = expat-> firstCHandlerSet; 4381 while (activeCHandlerSet) { 4382 if (activeCHandlerSet->xmlDeclCommand) { 4383 activeCHandlerSet->xmlDeclCommand (activeCHandlerSet->userData, 4384 version, encoding, standalone); 4385 } 4386 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 4387 } 4388 return; 4389} 4390 4391 4392/* 4393 *---------------------------------------------------------------------------- 4394 * 4395 * TclExpatDeleteCmd -- 4396 * 4397 * Called when an expat parser is deleted. 4398 * 4399 * Results: 4400 * None. 4401 * 4402 * Side Effects: 4403 * Memory structures are freed. 4404 * 4405 *---------------------------------------------------------------------------- 4406 */ 4407 4408static void 4409TclExpatDeleteCmd(clientData) 4410 ClientData clientData; 4411{ 4412 TclGenExpatInfo *expat = (TclGenExpatInfo *) clientData; 4413 TclHandlerSet *activeTclHandlerSet, *tmpTclHandlerSet; 4414 CHandlerSet *activeCHandlerSet, *tmpCHandlerSet; 4415 4416 TclExpatFreeParser(expat); 4417 4418 Tcl_DecrRefCount(expat->name); 4419 4420 if (expat->cdata) { 4421 Tcl_DecrRefCount(expat->cdata); 4422 expat->cdata = NULL; 4423 } 4424 4425 if (expat->result) { 4426 Tcl_DecrRefCount(expat->result); 4427 } 4428 4429 if (expat->baseURI) { 4430 Tcl_DecrRefCount (expat->baseURI); 4431 } 4432 activeTclHandlerSet = expat->firstTclHandlerSet; 4433 while (activeTclHandlerSet) { 4434 FREE (activeTclHandlerSet->name); 4435 4436 if (activeTclHandlerSet->elementstartcommand) { 4437 Tcl_DecrRefCount(activeTclHandlerSet->elementstartcommand); 4438 } 4439 if (activeTclHandlerSet->elementendcommand) { 4440 Tcl_DecrRefCount(activeTclHandlerSet->elementendcommand); 4441 } 4442 if (activeTclHandlerSet->startnsdeclcommand) { 4443 Tcl_DecrRefCount(activeTclHandlerSet->startnsdeclcommand); 4444 } 4445 if (activeTclHandlerSet->endnsdeclcommand) { 4446 Tcl_DecrRefCount(activeTclHandlerSet->endnsdeclcommand); 4447 } 4448 if (activeTclHandlerSet->datacommand) { 4449 Tcl_DecrRefCount(activeTclHandlerSet->datacommand); 4450 } 4451 if (activeTclHandlerSet->picommand) { 4452 Tcl_DecrRefCount(activeTclHandlerSet->picommand); 4453 } 4454 if (activeTclHandlerSet->defaultcommand) { 4455 Tcl_DecrRefCount(activeTclHandlerSet->defaultcommand); 4456 } 4457 if (activeTclHandlerSet->notationcommand) { 4458 Tcl_DecrRefCount(activeTclHandlerSet->notationcommand); 4459 } 4460 if (activeTclHandlerSet->externalentitycommand) { 4461 Tcl_DecrRefCount(activeTclHandlerSet->externalentitycommand); 4462 } 4463 if (activeTclHandlerSet->unknownencodingcommand) { 4464 Tcl_DecrRefCount(activeTclHandlerSet->unknownencodingcommand); 4465 } 4466 if (activeTclHandlerSet->commentCommand) { 4467 Tcl_DecrRefCount(activeTclHandlerSet->commentCommand); 4468 } 4469 if (activeTclHandlerSet->notStandaloneCommand) { 4470 Tcl_DecrRefCount(activeTclHandlerSet->notStandaloneCommand); 4471 } 4472 if (activeTclHandlerSet->startCdataSectionCommand) { 4473 Tcl_DecrRefCount(activeTclHandlerSet->startCdataSectionCommand); 4474 } 4475 if (activeTclHandlerSet->elementDeclCommand) { 4476 Tcl_DecrRefCount(activeTclHandlerSet->elementDeclCommand); 4477 } 4478 if (activeTclHandlerSet->attlistDeclCommand) { 4479 Tcl_DecrRefCount(activeTclHandlerSet->attlistDeclCommand); 4480 } 4481 if (activeTclHandlerSet->startDoctypeDeclCommand) { 4482 Tcl_DecrRefCount(activeTclHandlerSet->startDoctypeDeclCommand); 4483 } 4484 if (activeTclHandlerSet->endDoctypeDeclCommand) { 4485 Tcl_DecrRefCount(activeTclHandlerSet->endDoctypeDeclCommand); 4486 } 4487 if (activeTclHandlerSet->xmlDeclCommand) { 4488 Tcl_DecrRefCount (activeTclHandlerSet->xmlDeclCommand); 4489 } 4490 if (activeTclHandlerSet->entityDeclCommand) { 4491 Tcl_DecrRefCount (activeTclHandlerSet->entityDeclCommand); 4492 } 4493 4494 tmpTclHandlerSet = activeTclHandlerSet; 4495 activeTclHandlerSet = activeTclHandlerSet->nextHandlerSet; 4496 FREE ( (char*) tmpTclHandlerSet); 4497 } 4498 4499 activeCHandlerSet = expat->firstCHandlerSet; 4500 while (activeCHandlerSet) { 4501 4502 if (activeCHandlerSet->freeProc) { 4503 activeCHandlerSet->freeProc (expat->interp, 4504 activeCHandlerSet->userData); 4505 } 4506 FREE (activeCHandlerSet->name); 4507 4508 tmpCHandlerSet = activeCHandlerSet; 4509 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 4510 FREE ( (char*) tmpCHandlerSet); 4511 } 4512 4513 FREE( (char*) expat); 4514} 4515 4516 4517int 4518CheckExpatParserObj (interp, nameObj) 4519 Tcl_Interp *interp; 4520 Tcl_Obj *CONST nameObj; 4521{ 4522 Tcl_CmdInfo info; 4523 4524 4525 if (!Tcl_GetCommandInfo (interp, Tcl_GetString(nameObj), &info)) { 4526 return 0; 4527 } 4528 if (!info.isNativeObjectProc || info.objProc != TclExpatInstanceCmd) { 4529 return 0; 4530 } 4531 return 1; 4532} 4533 4534int 4535CHandlerSetInstall (interp, expatObj, handlerSet) 4536 Tcl_Interp *interp; 4537 Tcl_Obj *CONST expatObj; 4538 CHandlerSet *handlerSet; 4539{ 4540 Tcl_CmdInfo info; 4541 TclGenExpatInfo *expat; 4542 CHandlerSet *activeCHandlerSet; 4543 4544 if (!Tcl_GetCommandInfo (interp, Tcl_GetString(expatObj), &info)) { 4545 return 1; 4546 } 4547 expat = (TclGenExpatInfo *) info.objClientData; 4548 if (expat->firstCHandlerSet != NULL) { 4549 activeCHandlerSet = expat->firstCHandlerSet; 4550 while (1) { 4551 if (strcmp (activeCHandlerSet->name, handlerSet->name) == 0) { 4552 return 2; 4553 } 4554 if (activeCHandlerSet->nextHandlerSet == NULL) { 4555 break; 4556 } 4557 else { 4558 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 4559 } 4560 } 4561 activeCHandlerSet->nextHandlerSet = handlerSet; 4562 } 4563 else { 4564 expat->firstCHandlerSet = handlerSet; 4565 } 4566 if (handlerSet->ignoreWhiteCDATAs) { 4567 expat->needWSCheck = 1; 4568 } 4569 return 0; 4570} 4571 4572int 4573CHandlerSetRemove (interp, expatObj, handlerSetName) 4574 Tcl_Interp *interp; 4575 Tcl_Obj *CONST expatObj; 4576 char *handlerSetName; 4577{ 4578 Tcl_CmdInfo info; 4579 TclGenExpatInfo *expat; 4580 CHandlerSet *activeCHandlerSet, *parentHandlerSet = NULL; 4581 4582 if (!Tcl_GetCommandInfo (interp, Tcl_GetString(expatObj), &info)) { 4583 return 1; 4584 } 4585 expat = (TclGenExpatInfo *) info.objClientData; 4586 if (expat->firstCHandlerSet == NULL) { 4587 return 2; 4588 } 4589 4590 activeCHandlerSet = expat->firstCHandlerSet; 4591 while (activeCHandlerSet) { 4592 if (strcmp (activeCHandlerSet->name, handlerSetName) == 0) { 4593 FREE (activeCHandlerSet->name); 4594 if (activeCHandlerSet->freeProc) { 4595 activeCHandlerSet->freeProc (interp, activeCHandlerSet->userData); 4596 } 4597 if (parentHandlerSet) { 4598 parentHandlerSet->nextHandlerSet = 4599 activeCHandlerSet->nextHandlerSet; 4600 } else { 4601 expat->firstCHandlerSet = activeCHandlerSet->nextHandlerSet; 4602 } 4603 FREE ( (char*) activeCHandlerSet); 4604 return 0; 4605 } 4606 parentHandlerSet = activeCHandlerSet; 4607 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 4608 } 4609 return 2; 4610} 4611 4612CHandlerSet * 4613CHandlerSetGet (interp, expatObj, handlerSetName) 4614 Tcl_Interp *interp; 4615 Tcl_Obj *CONST expatObj; 4616 char *handlerSetName; 4617{ 4618 Tcl_CmdInfo info; 4619 TclGenExpatInfo *expat; 4620 CHandlerSet *activeCHandlerSet; 4621 4622 if (!Tcl_GetCommandInfo (interp, Tcl_GetString(expatObj), &info)) { 4623 return NULL; 4624 } 4625 expat = (TclGenExpatInfo *) info.objClientData; 4626 if (expat->firstCHandlerSet == NULL) { 4627 return NULL; 4628 } 4629 activeCHandlerSet = expat->firstCHandlerSet; 4630 while (activeCHandlerSet) { 4631 if (strcmp (activeCHandlerSet->name, handlerSetName) == 0) { 4632 return activeCHandlerSet; 4633 } 4634 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 4635 } 4636 return NULL; 4637} 4638 4639void * 4640CHandlerSetGetUserData (interp, expatObj, handlerSetName) 4641 Tcl_Interp *interp; 4642 Tcl_Obj *CONST expatObj; 4643 char *handlerSetName; 4644{ 4645 Tcl_CmdInfo info; 4646 TclGenExpatInfo *expat; 4647 CHandlerSet *activeCHandlerSet; 4648 4649 if (!Tcl_GetCommandInfo (interp, Tcl_GetString(expatObj), &info)) { 4650 return NULL; 4651 } 4652 expat = (TclGenExpatInfo *) info.objClientData; 4653 if (expat->firstCHandlerSet == NULL) { 4654 return NULL; 4655 } 4656 activeCHandlerSet = expat->firstCHandlerSet; 4657 while (activeCHandlerSet) { 4658 if (strcmp (activeCHandlerSet->name, handlerSetName) == 0) { 4659 return activeCHandlerSet->userData; 4660 } 4661 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 4662 } 4663 return NULL; 4664} 4665 4666TclGenExpatInfo * 4667GetExpatInfo (interp, expatObj) 4668 Tcl_Interp *interp; 4669 Tcl_Obj *CONST expatObj; 4670{ 4671 Tcl_CmdInfo info; 4672 if (!Tcl_GetCommandInfo (interp, Tcl_GetString(expatObj), &info)) { 4673 return NULL; 4674 } 4675 return (TclGenExpatInfo *) info.objClientData; 4676} 4677