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 * Zveno Pty Ltd makes this software and associated documentation 9 * available free of charge for any purpose. You may make copies 10 * of the software but you must include all of this notice on any copy. 11 * 12 * Zveno Pty Ltd does not warrant that this software is error free 13 * or fit for any purpose. Zveno Pty Ltd disclaims any liability for 14 * all claims, expenses, losses, damages and costs any user may incur 15 * as a result of using, copying or modifying the software. 16 * 17 * $Id: tclexpat.c,v 1.1 2004/05/23 22:50:39 neumann Exp $ 18 * 19 */ 20 21#include <tcl.h> 22#include <xotcl.h> 23#include <string.h> 24#include "xmlparse.h" 25 26 27/* 28 * The structure below is used to refer to an expat parser object. 29 */ 30 31typedef struct TclExpatInfo { 32 XML_Parser parser; /* The expat parser structure */ 33 Tcl_Interp *interp; /* Interpreter for this instance */ 34 Tcl_Obj *name; /* name of this instance */ 35 36 int final; /* input data complete? */ 37 38 int status; /* application status */ 39 Tcl_Obj *result; /* application return result */ 40 41 int continueCount; /* reference count for continue */ 42 43 Tcl_Obj *elementstartcommand; /* Script for element start */ 44 Tcl_Obj *elementendcommand; /* Script for element end */ 45 Tcl_Obj *datacommand; /* Script for character data */ 46 Tcl_Obj *picommand; /* Script for processing instruction */ 47 Tcl_Obj *defaultcommand; /* Script for default data */ 48 Tcl_Obj *unparsedcommand; /* Script for unparsed entity declaration */ 49 Tcl_Obj *notationcommand; /* Script for notation declaration */ 50 Tcl_Obj *externalentitycommand; /* Script for external entity */ 51 Tcl_Obj *unknownencodingcommand; /* Script for unknown character encoding */ 52 53} TclExpatInfo; 54 55/* 56 * Prototypes for procedures defined later in this file: 57 */ 58 59static Tcl_ObjCmdProc TclExpatObjCmd; 60static Tcl_ObjCmdProc TclExpatInstanceCmd; 61static Tcl_CmdDeleteProc TclExpatDeleteCmd; 62static int (TclExpatCreateParser) _ANSI_ARGS_((Tcl_Interp *interp, 63 TclExpatInfo *expat)); 64static void (TclExpatFreeParser) _ANSI_ARGS_((TclExpatInfo *expat)); 65static int (TclExpatParse) _ANSI_ARGS_((Tcl_Interp *interp, 66 TclExpatInfo *expat, 67 char *data, 68 size_t len)); 69static int (TclExpatConfigure) _ANSI_ARGS_((Tcl_Interp *interp, 70 TclExpatInfo *expat, 71 int objc, 72 Tcl_Obj *CONST objv[])); 73static int (TclExpatCget) _ANSI_ARGS_((Tcl_Interp *interp, 74 TclExpatInfo *expat, 75 int objc, 76 Tcl_Obj *CONST objv[])); 77 78static void * (TclExpatElementStartHandler) _ANSI_ARGS_((void *userdata, 79 const XML_Char *name, 80 const XML_Char **atts)); 81static void * (TclExpatElementEndHandler) _ANSI_ARGS_((void *userData, 82 const XML_Char *name)); 83static void * (TclExpatCharacterDataHandler) _ANSI_ARGS_((void *userData, 84 const XML_Char *s, 85 int len)); 86static void * (TclExpatProcessingInstructionHandler) _ANSI_ARGS_((void *userData, 87 const XML_Char *target, 88 const XML_Char *data)); 89static void * (TclExpatExternalEntityRefHandler) _ANSI_ARGS_((XML_Parser parser, 90 const XML_Char *openEntityNames, 91 const XML_Char *base, 92 const XML_Char *systemId, 93 const XML_Char *publicId)); 94static void * (TclExpatDefaultHandler) _ANSI_ARGS_ ((void *userData, 95 const XML_Char *s, 96 int len)); 97static void * (TclExpatUnparsedDeclHandler) _ANSI_ARGS_ ((void *userData, 98 const XML_Char *entityname, 99 const XML_Char *base, 100 const XML_Char *systemId, 101 const XML_Char *publicId, 102 const XML_Char *notationName)); 103static void * (TclExpatNotationDeclHandler) _ANSI_ARGS_ ((void *userData, 104 const XML_Char *notationName, 105 const XML_Char *base, 106 const XML_Char *systemId, const XML_Char *publicId)); 107static int (TclExpatUnknownEncodingHandler) _ANSI_ARGS_ ((void *encodingHandlerData, 108 const XML_Char *name, 109 XML_Encoding *info)); 110 111#if defined(PRE81) 112 113/* 114 *---------------------------------------------------------------------------- 115 * 116 * Tcl_GetString -- 117 * 118 * Compatibility routine for Tcl 8.0 119 * 120 * Results: 121 * String representation of object.. 122 * 123 * Side effects: 124 * None. 125 * 126 *---------------------------------------------------------------------------- 127 */ 128 129char * 130Tcl_GetString (obj) 131 Tcl_Obj *obj; /* Object to retrieve string from. */ 132{ 133 char *s; 134 int i; 135 136 s = Tcl_GetStringFromObj(obj, &i); 137 return s; 138} 139#endif 140 141/* 142 *---------------------------------------------------------------------------- 143 * 144 * TclExpat_Init -- 145 * 146 * Initialisation routine for loadable module 147 * 148 * Results: 149 * None. 150 * 151 * Side effects: 152 * Defines "expat" command in the interpreter. 153 * 154 *---------------------------------------------------------------------------- 155 */ 156 157/* this should be done via the stubs ... for the time being 158 simply export */ 159#ifdef VISUAL_CC 160DLLEXPORT extern int Xotclexpat_Init(Tcl_Interp * interp); 161# define CONST_XOTCL_EXPAT 162#else 163# if defined(PRE84) 164# define CONST_XOTCL_EXPAT 165# else 166# define CONST_XOTCL_EXPAT CONST84 167# endif 168#endif 169 170extern int 171Xotclexpat_Init (interp) 172 Tcl_Interp *interp; /* Interpreter to initialise. */ 173{ 174#ifdef USE_TCL_STUBS 175 if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { 176 return TCL_ERROR; 177 } 178#ifdef USE_XOTCL_STUBS 179 if (Xotcl_InitStubs(interp, "1.1", 0) == NULL) { 180 return TCL_ERROR; 181 } 182#endif 183#else 184 if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) { 185 return TCL_ERROR; 186 } 187#endif 188 189 190 Tcl_PkgProvide(interp, "xotcl::xml::expat", PACKAGE_VERSION); 191 192 Tcl_CreateObjCommand(interp, "expat", TclExpatObjCmd, NULL, NULL); 193 194 return TCL_OK; 195} 196 197/* 198 *---------------------------------------------------------------------------- 199 * 200 * TclExpatObjCmd -- 201 * 202 * Creation command for expat class. 203 * 204 * Results: 205 * The name of the newly created parser instance. 206 * 207 * Side effects: 208 * This creates an expat parser. 209 * 210 *---------------------------------------------------------------------------- 211 */ 212 213int 214TclExpatObjCmd(dummy, interp, objc, objv) 215 ClientData dummy; 216 Tcl_Interp *interp; 217 int objc; 218 Tcl_Obj *CONST objv[]; 219{ 220 TclExpatInfo *expat; 221 222 if (objc < 2) { 223 Tcl_WrongNumArgs(interp, 1, objv, "name ?args?"); 224 return TCL_ERROR; 225 } 226 227 /* 228 * Create the data structures for this parser. 229 */ 230 231 if (!(expat = (TclExpatInfo *) ckalloc(sizeof(TclExpatInfo)))) { 232 ckfree((char*)expat); 233 Tcl_SetResult(interp, "unable to create parser", NULL); 234 return TCL_ERROR; 235 } 236 expat->interp = interp; 237 Tcl_IncrRefCount(objv[1]); 238 expat->name = objv[1]; 239 240 expat->elementstartcommand = NULL; 241 expat->elementendcommand = NULL; 242 expat->datacommand = NULL; 243 expat->picommand = NULL; 244 expat->defaultcommand = NULL; 245 expat->unparsedcommand = NULL; 246 expat->notationcommand = NULL; 247 expat->externalentitycommand = NULL; 248 expat->unknownencodingcommand = NULL; 249 250 if (TclExpatCreateParser(interp, expat) != TCL_OK) { 251 ckfree((char*)expat); 252 return TCL_ERROR; 253 } 254 255 /* 256 * Register a Tcl command for this parser instance. 257 */ 258 259 Tcl_CreateObjCommand(interp, Tcl_GetString(expat->name), TclExpatInstanceCmd, (ClientData) expat, TclExpatDeleteCmd); 260 261 /* 262 * Handle configuration options 263 */ 264 265 if (objc > 2) { 266 TclExpatConfigure(interp, expat, objc - 2, objv + 2); 267 } 268 269 Tcl_SetObjResult(interp, expat->name); 270 271 return TCL_OK; 272} 273 274/* 275 *---------------------------------------------------------------------------- 276 * 277 * TclExpatCreateParser -- 278 * 279 * Create the expat parser and initialise (some of) the TclExpatInfo 280 * structure. 281 * 282 * Note that callback commands are not affected by this routine, 283 * to allow a reset to leave these intact. 284 * 285 * Results: 286 * New parser instance created and initialised. 287 * 288 * Side effects: 289 * Creates an expat parser. 290 * Modifies TclExpatInfo fields. 291 * 292 *---------------------------------------------------------------------------- 293 */ 294 295int 296TclExpatCreateParser(interp, expat) 297 Tcl_Interp *interp; 298 TclExpatInfo *expat; 299{ 300 if (!(expat->parser = XML_ParserCreate(NULL))) { 301 Tcl_SetResult(interp, "unable to create expat parser", NULL); 302 return TCL_ERROR; 303 } 304 305 expat->final = 1; 306 expat->status = TCL_OK; 307 expat->result = NULL; 308 expat->continueCount = 0; 309 310 /* 311 * Set handlers for the parser to routines in this module. 312 */ 313 314 XML_SetElementHandler(expat->parser, 315 (XML_StartElementHandler) TclExpatElementStartHandler, 316 (XML_EndElementHandler) TclExpatElementEndHandler); 317 XML_SetCharacterDataHandler(expat->parser, 318 (XML_CharacterDataHandler) TclExpatCharacterDataHandler); 319 XML_SetProcessingInstructionHandler(expat->parser, 320 (XML_ProcessingInstructionHandler) TclExpatProcessingInstructionHandler); 321 XML_SetDefaultHandler(expat->parser, 322 (XML_DefaultHandler) TclExpatDefaultHandler); 323 XML_SetUnparsedEntityDeclHandler(expat->parser, 324 (XML_UnparsedEntityDeclHandler) TclExpatUnparsedDeclHandler); 325 XML_SetNotationDeclHandler(expat->parser, 326 (XML_NotationDeclHandler) TclExpatNotationDeclHandler); 327 XML_SetExternalEntityRefHandler(expat->parser, 328 (XML_ExternalEntityRefHandler) TclExpatExternalEntityRefHandler); 329 XML_SetUnknownEncodingHandler(expat->parser, 330 (XML_UnknownEncodingHandler) TclExpatUnknownEncodingHandler, 331 (void *) expat); 332 XML_SetUserData(expat->parser, 333 (void *) expat); 334 335 return TCL_OK; 336} 337 338/* 339 *---------------------------------------------------------------------------- 340 * 341 * TclExpatFreeParser -- 342 * 343 * Destroy the expat parser structure. 344 * 345 * Results: 346 * None. 347 * 348 * Side effects: 349 * Frees any memory allocated for the XML parser. 350 * 351 *---------------------------------------------------------------------------- 352 */ 353 354void 355TclExpatFreeParser(expat) 356 TclExpatInfo *expat; 357{ 358 XML_ParserFree(expat->parser); 359 expat->parser = NULL; 360} 361 362/* 363 *---------------------------------------------------------------------------- 364 * 365 * TclExpatInstanceCmd -- 366 * 367 * Implements instance command for expat class objects. 368 * 369 * Results: 370 * Depends on the method. 371 * 372 * Side effects: 373 * Depends on the method. 374 * 375 *---------------------------------------------------------------------------- 376 */ 377 378int 379TclExpatInstanceCmd (clientData, interp, objc, objv) 380 ClientData clientData; 381 Tcl_Interp *interp; 382 int objc; 383 Tcl_Obj *CONST objv[]; 384{ 385 TclExpatInfo *expat = (TclExpatInfo *) clientData; 386 char *data; 387 int len; 388 int index, result = TCL_OK; 389 static char CONST_XOTCL_EXPAT *options[] = { 390 "configure", "cget", "parse", "reset", NULL 391 }; 392 enum options { 393 EXPAT_CONFIGURE, EXPAT_CGET, EXPAT_PARSE, EXPAT_RESET 394 }; 395 396 if (objc < 2) { 397 Tcl_WrongNumArgs(interp, 1, objv, "method ?args?"); 398 return TCL_ERROR; 399 } 400 401 if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, 402 &index) != TCL_OK) { 403 return TCL_ERROR; 404 } 405 406 switch ((enum options) index) { 407 case EXPAT_CONFIGURE: 408 409 result = TclExpatConfigure(interp, (TclExpatInfo *) clientData, objc - 2, objv + 2); 410 break; 411 412 case EXPAT_CGET: 413 414 result = TclExpatCget(interp, (TclExpatInfo *) clientData, objc - 2, objv + 2); 415 break; 416 417 case EXPAT_PARSE: 418 419 if (objc != 3) { 420 Tcl_WrongNumArgs(interp, 2, objv, "data"); 421 return TCL_ERROR; 422 } 423 424 data = Tcl_GetStringFromObj(objv[2], &len); 425 426 result = TclExpatParse(interp, expat, data, (size_t)len); 427 428 break; 429 430 case EXPAT_RESET: 431 432 if (objc > 2) { 433 Tcl_WrongNumArgs(interp, 1, objv, ""); 434 return TCL_ERROR; 435 } 436 437 /* 438 * Destroy the parser and create a fresh one. 439 */ 440 441 TclExpatFreeParser(expat); 442 TclExpatCreateParser(interp, expat); 443 444 break; 445 446 default: 447 448 Tcl_SetResult(interp, "unknown method", NULL); 449 return TCL_ERROR; 450 451 } 452 453 return result; 454} 455 456/* 457 *---------------------------------------------------------------------------- 458 * 459 * TclExpatParse -- 460 * 461 * Wrapper to invoke expat parser and check return result. 462 * 463 * Results: 464 * TCL_OK if no errors, TCL_ERROR otherwise. 465 * 466 * Side effects: 467 * Sets interpreter result as appropriate. 468 * 469 *---------------------------------------------------------------------------- 470 */ 471 472int 473TclExpatParse (interp, expat, data, len) 474 Tcl_Interp *interp; 475 TclExpatInfo *expat; 476 char *data; 477 size_t len; 478{ 479 int result; 480 char s[255]; 481 482 expat->status = TCL_OK; 483 if (expat->result != NULL) { 484 Tcl_DecrRefCount(expat->result); 485 } 486 expat->result = NULL; 487 488 result = XML_Parse(expat->parser, 489 data, len, 490 expat->final); 491 492 if (!result) { 493 Tcl_ResetResult(interp); 494 sprintf(s, "%d", XML_GetCurrentLineNumber(expat->parser)); 495 Tcl_AppendResult(interp, "error \"", 496 XML_ErrorString(XML_GetErrorCode(expat->parser)), 497 "\" at line ", s, " character ", NULL); 498 sprintf(s, "%d", XML_GetCurrentColumnNumber(expat->parser)); 499 Tcl_AppendResult(interp, s, NULL); 500 501 return TCL_ERROR; 502 } 503 504 switch (expat->status) { 505 case TCL_OK: 506 case TCL_BREAK: 507 case TCL_CONTINUE: 508 Tcl_ResetResult(interp); 509 return TCL_OK; 510 511 case TCL_ERROR: 512 Tcl_SetObjResult(interp, expat->result); 513 return TCL_ERROR; 514 515 default: 516 Tcl_SetResult(interp, "unknown parsing status", NULL); 517 return TCL_ERROR; 518 } 519 520} 521 522/* 523 *---------------------------------------------------------------------------- 524 * 525 * TclExpatConfigure -- 526 * 527 * Implements instance command for expat class objects. 528 * 529 * Results: 530 * Depends on the method. 531 * 532 * Side effects: 533 * Depends on the method. 534 * 535 *---------------------------------------------------------------------------- 536 */ 537 538int 539TclExpatConfigure (interp, expat, objc, objv) 540 Tcl_Interp *interp; 541 TclExpatInfo *expat; 542 int objc; 543 Tcl_Obj *CONST objv[]; 544{ 545 static CONST_XOTCL_EXPAT char *switchTable[] = { 546 "-final", 547 "-baseurl", 548 "-elementstartcommand", 549 "-elementendcommand", 550 "-characterdatacommand", 551 "-processinginstructioncommand", 552 "-defaultcommand", 553 "-unparsedentitydeclcommand", 554 "-notationdeclcommand", 555 "-externalentitycommand", 556 "-unknownencodingcommand", 557 (char *) NULL 558 }; 559 enum switches { 560 EXPAT_FINAL, EXPAT_BASE, 561 EXPAT_ELEMENTSTARTCMD, EXPAT_ELEMENTENDCMD, 562 EXPAT_DATACMD, EXPAT_PICMD, 563 EXPAT_DEFAULTCMD, 564 EXPAT_UNPARSEDENTITYCMD, EXPAT_NOTATIONCMD, 565 EXPAT_EXTERNALENTITYCMD, EXPAT_UNKNOWNENCODINGCMD 566 }; 567 int index, bool, doParse = 0; 568 Tcl_Obj *CONST *objPtr = objv; 569 570 while (objc > 1) { 571 if (Tcl_GetIndexFromObj(interp, objPtr[0], switchTable, 572 "switch", 0, &index) != TCL_OK) { 573 return TCL_ERROR; 574 } 575 switch ((enum switches) index) { 576 case EXPAT_FINAL: /* -final */ 577 578 if (Tcl_GetBooleanFromObj(interp, objPtr[1], &bool) != TCL_OK) { 579 return TCL_ERROR; 580 } 581 582 if (bool && !expat->final) { 583 584 expat->final = bool; 585 doParse = 1; 586 587 } else if (!bool && expat->final) { 588 589 /* 590 * Reset the parser for new input 591 */ 592 593 TclExpatFreeParser(expat); 594 TclExpatCreateParser(interp, expat); 595 doParse = 0; 596 597 } 598 599 break; 600 601 case EXPAT_BASE: /* -base */ 602 603 if (XML_SetBase(expat->parser, Tcl_GetString(objPtr[1])) == 0) { 604 Tcl_SetResult(interp, "unable to set base URL", NULL); 605 return TCL_ERROR; 606 } 607 break; 608 609 case EXPAT_ELEMENTSTARTCMD: /* -elementstartcommand */ 610 611 if (expat->elementstartcommand != NULL) { 612 Tcl_DecrRefCount(expat->elementstartcommand); 613 } 614 615 expat->elementstartcommand = objPtr[1]; 616 Tcl_IncrRefCount(expat->elementstartcommand); 617 618 break; 619 620 case EXPAT_ELEMENTENDCMD: /* -elementendcommand */ 621 622 if (expat->elementendcommand != NULL) { 623 Tcl_DecrRefCount(expat->elementendcommand); 624 } 625 626 expat->elementendcommand = objPtr[1]; 627 Tcl_IncrRefCount(expat->elementendcommand); 628 629 break; 630 631 case EXPAT_DATACMD: /* -characterdatacommand */ 632 633 if (expat->datacommand != NULL) { 634 Tcl_DecrRefCount(expat->datacommand); 635 } 636 637 expat->datacommand = objPtr[1]; 638 Tcl_IncrRefCount(expat->datacommand); 639 640 break; 641 642 case EXPAT_PICMD: /* -processinginstructioncommand */ 643 644 if (expat->picommand != NULL) { 645 Tcl_DecrRefCount(expat->picommand); 646 } 647 648 expat->picommand = objPtr[1]; 649 Tcl_IncrRefCount(expat->picommand); 650 651 break; 652 653 case EXPAT_DEFAULTCMD: /* -defaultcommand */ 654 655 if (expat->defaultcommand != NULL) { 656 Tcl_DecrRefCount(expat->defaultcommand); 657 } 658 659 expat->defaultcommand = objPtr[1]; 660 Tcl_IncrRefCount(expat->defaultcommand); 661 662 break; 663 664 case EXPAT_UNPARSEDENTITYCMD: /* -unparsedentitydeclcommand */ 665 666 if (expat->unparsedcommand != NULL) { 667 Tcl_DecrRefCount(expat->unparsedcommand); 668 } 669 670 expat->unparsedcommand = objPtr[1]; 671 Tcl_IncrRefCount(expat->unparsedcommand); 672 673 break; 674 675 case EXPAT_NOTATIONCMD: /* -notationdeclcommand */ 676 677 if (expat->notationcommand != NULL) { 678 Tcl_DecrRefCount(expat->notationcommand); 679 } 680 681 expat->notationcommand = objPtr[1]; 682 Tcl_IncrRefCount(expat->notationcommand); 683 684 break; 685 686 case EXPAT_EXTERNALENTITYCMD: /* -externalentitycommand */ 687 688 if (expat->externalentitycommand != NULL) { 689 Tcl_DecrRefCount(expat->externalentitycommand); 690 } 691 692 expat->externalentitycommand = objPtr[1]; 693 Tcl_IncrRefCount(expat->externalentitycommand); 694 695 break; 696 697 case EXPAT_UNKNOWNENCODINGCMD: /* -unknownencodingcommand */ 698 699 /* Not implemented */ 700 break; 701 702 if (expat->unknownencodingcommand != NULL) { 703 Tcl_DecrRefCount(expat->unknownencodingcommand); 704 } 705 706 expat->unknownencodingcommand = objPtr[1]; 707 Tcl_IncrRefCount(expat->unknownencodingcommand); 708 709 break; 710 711 } 712 713 objPtr += 2; 714 objc -= 2; 715 716 } 717 718 if (doParse) { 719 return TclExpatParse(interp, expat->parser, "", 0); 720 } else { 721 return TCL_OK; 722 } 723 724} 725 726/* 727 *---------------------------------------------------------------------------- 728 * 729 * TclExpatCget -- 730 * 731 * Returns setting of configuration option. 732 * Not yet implemented. 733 * 734 * Results: 735 * Option value. 736 * 737 * Side effects: 738 * None. 739 * 740 *---------------------------------------------------------------------------- 741 */ 742 743int 744TclExpatCget (interp, expat, objc, objv) 745 Tcl_Interp *interp; 746 TclExpatInfo *expat; 747 int objc; 748 Tcl_Obj *CONST objv[]; 749{ 750 Tcl_SetResult(interp, "method not implemented", NULL); 751 return TCL_ERROR; 752} 753 754/* 755 *---------------------------------------------------------------------------- 756 * 757 * TclExpatHandlerResult -- 758 * 759 * Manage the result of the application callback. 760 * 761 * Results: 762 * None. 763 * 764 * Side Effects: 765 * Further invocation of callback scripts may be inhibited. 766 * 767 *---------------------------------------------------------------------------- 768 */ 769 770void 771TclExpatHandlerResult(expat, result) 772 TclExpatInfo *expat; 773 int result; 774{ 775 switch (result) { 776 case TCL_OK: 777 expat->status = TCL_OK; 778 break; 779 780 case TCL_CONTINUE: 781 /* 782 * Skip callbacks until the matching end element event 783 * occurs for the currently open element. 784 * Keep a reference count to handle nested 785 * elements. 786 */ 787 expat->status = TCL_CONTINUE; 788 expat->continueCount = 1; 789 break; 790 791 case TCL_BREAK: 792 /* 793 * Skip all further callbacks, but return OK. 794 */ 795 expat->status = TCL_BREAK; 796 break; 797 798 case TCL_ERROR: 799 /* 800 * Skip all further callbacks, and return error. 801 */ 802 default: 803 expat->status = TCL_ERROR; 804 expat->result = Tcl_GetObjResult(expat->interp); 805 Tcl_IncrRefCount(expat->result); 806 break; 807 } 808} 809 810/* 811 *---------------------------------------------------------------------------- 812 * 813 * TclExpatElementStartHandler -- 814 * 815 * Called by expat for each start tag. 816 * 817 * Results: 818 * None. 819 * 820 * Side Effects: 821 * Callback script is invoked. 822 * 823 *---------------------------------------------------------------------------- 824 */ 825 826static void * 827TclExpatElementStartHandler(userData, name, atts) 828 void *userData; 829 const char *name; 830 const char **atts; 831{ 832 TclExpatInfo *expat = (TclExpatInfo *) userData; 833 Tcl_Obj *atList, *cmdPtr; 834 const char **atPtr; 835 int result; 836 837 if (expat->status == TCL_CONTINUE) { 838 839 /* 840 * We're currently skipping elements looking for the 841 * close of the continued element. 842 */ 843 844 expat->continueCount++; 845 return NULL; 846 } 847 848 if (expat->elementstartcommand == NULL || 849 expat->status != TCL_OK) { 850 return NULL; 851 } 852 853 /* 854 * Convert the attribute list into a Tcl key-value paired list. 855 */ 856 857 atList = Tcl_NewListObj(0, NULL); 858 for (atPtr = atts; atPtr[0] && atPtr[1]; atPtr += 2) { 859 Tcl_ListObjAppendElement(expat->interp, atList, Tcl_NewStringObj((char *)atPtr[0], strlen(atPtr[0]))); 860 Tcl_ListObjAppendElement(expat->interp, atList, Tcl_NewStringObj((char *)atPtr[1], strlen(atPtr[1]))); 861 } 862 863 /* 864 * Take a copy of the callback script so that arguments may be appended. 865 */ 866 867 cmdPtr = Tcl_DuplicateObj(expat->elementstartcommand); 868 Tcl_IncrRefCount(cmdPtr); 869 Tcl_Preserve((ClientData) expat->interp); 870 871 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)name, strlen(name))); 872 Tcl_ListObjAppendElement(expat->interp, cmdPtr, atList); 873 874 /* 875 * It would be desirable to be able to terminate parsing 876 * if the return result is TCL_ERROR or TCL_BREAK. 877 */ 878#if defined(PRE81) 879 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 880#elif defined(PRE82) 881 result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 882#else 883 result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 884#endif 885 886 Tcl_DecrRefCount(cmdPtr); 887 Tcl_Release((ClientData) expat->interp); 888 889 TclExpatHandlerResult(expat, result); 890 891 return NULL; 892} 893 894/* 895 *---------------------------------------------------------------------------- 896 * 897 * TclExpatElementEndHandler -- 898 * 899 * Called by expat for each end tag. 900 * 901 * Results: 902 * None. 903 * 904 * Side Effects: 905 * Callback script is invoked. 906 * 907 *---------------------------------------------------------------------------- 908 */ 909 910static void * 911TclExpatElementEndHandler(userData, name) 912 void *userData; 913 CONST char *name; 914{ 915 TclExpatInfo *expat = (TclExpatInfo *) userData; 916 Tcl_Obj *cmdPtr; 917 int result; 918 919 if (expat->status == TCL_CONTINUE) { 920 /* 921 * We're currently skipping elements looking for the 922 * end of the currently open element. 923 */ 924 925 if (!--(expat->continueCount)) { 926 expat->status = TCL_OK; 927 return NULL; 928 } 929 } 930 931 if (expat->elementendcommand == NULL || 932 expat->status != TCL_OK) { 933 return NULL; 934 } 935 936 /* 937 * Take a copy of the callback script so that arguments may be appended. 938 */ 939 940 cmdPtr = Tcl_DuplicateObj(expat->elementendcommand); 941 Tcl_IncrRefCount(cmdPtr); 942 Tcl_Preserve((ClientData) expat->interp); 943 944 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)name, strlen(name))); 945 946 /* 947 * It would be desirable to be able to terminate parsing 948 * if the return result is TCL_ERROR or TCL_BREAK. 949 */ 950#if defined(PRE81) 951 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 952#elif defined(PRE82) 953 result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 954#else 955 result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 956#endif 957 958 Tcl_DecrRefCount(cmdPtr); 959 Tcl_Release((ClientData) expat->interp); 960 961 TclExpatHandlerResult(expat, result); 962 963 return NULL; 964} 965 966/* 967 *---------------------------------------------------------------------------- 968 * 969 * TclExpatCharacterDataHandler -- 970 * 971 * Called by expat for character data. 972 * 973 * Results: 974 * None. 975 * 976 * Side Effects: 977 * Callback script is invoked. 978 * 979 *---------------------------------------------------------------------------- 980 */ 981 982static void * 983TclExpatCharacterDataHandler(userData, s, len) 984 void *userData; 985 CONST char *s; 986 int len; 987{ 988 TclExpatInfo *expat = (TclExpatInfo *) userData; 989 Tcl_Obj *cmdPtr; 990 int result; 991 992 if (expat->datacommand == NULL || 993 expat->status != TCL_OK) { 994 return NULL; 995 } 996 997 /* 998 * Take a copy of the callback script so that arguments may be appended. 999 */ 1000 1001 cmdPtr = Tcl_DuplicateObj(expat->datacommand); 1002 Tcl_IncrRefCount(cmdPtr); 1003 Tcl_Preserve((ClientData) expat->interp); 1004 1005 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)s, len)); 1006 1007 /* 1008 * It would be desirable to be able to terminate parsing 1009 * if the return result is TCL_ERROR or TCL_BREAK. 1010 */ 1011#if defined(PRE81) 1012 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 1013#elif defined(PRE82) 1014 result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1015#else 1016 result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1017#endif 1018 1019 Tcl_DecrRefCount(cmdPtr); 1020 Tcl_Release((ClientData) expat->interp); 1021 1022 TclExpatHandlerResult(expat, result); 1023 1024 return NULL; 1025} 1026 1027/* 1028 *---------------------------------------------------------------------------- 1029 * 1030 * TclExpatProcessingInstructionHandler -- 1031 * 1032 * Called by expat for processing instructions. 1033 * 1034 * Results: 1035 * None. 1036 * 1037 * Side Effects: 1038 * Callback script is invoked. 1039 * 1040 *---------------------------------------------------------------------------- 1041 */ 1042 1043static void * 1044TclExpatProcessingInstructionHandler(userData, target, data) 1045 void *userData; 1046 CONST char *target; 1047 CONST char *data; 1048{ 1049 TclExpatInfo *expat = (TclExpatInfo *) userData; 1050 Tcl_Obj *cmdPtr; 1051 int result; 1052 1053 if (expat->picommand == NULL || 1054 expat->status != TCL_OK) { 1055 return NULL; 1056 } 1057 1058 /* 1059 * Take a copy of the callback script so that arguments may be appended. 1060 */ 1061 1062 cmdPtr = Tcl_DuplicateObj(expat->picommand); 1063 Tcl_IncrRefCount(cmdPtr); 1064 Tcl_Preserve((ClientData) expat->interp); 1065 1066 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)target, strlen(target))); 1067 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)data, strlen(data))); 1068 1069 /* 1070 * It would be desirable to be able to terminate parsing 1071 * if the return result is TCL_ERROR or TCL_BREAK. 1072 */ 1073#if defined(PRE81) 1074 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 1075#elif defined(PRE82) 1076 result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1077#else 1078 result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1079#endif 1080 1081 Tcl_DecrRefCount(cmdPtr); 1082 Tcl_Release((ClientData) expat->interp); 1083 1084 TclExpatHandlerResult(expat, result); 1085 1086 return NULL; 1087} 1088 1089/* 1090 *---------------------------------------------------------------------------- 1091 * 1092 * TclExpatDefaultHandler -- 1093 * 1094 * Called by expat for processing data which has no other handler. 1095 * 1096 * Results: 1097 * None. 1098 * 1099 * Side Effects: 1100 * Callback script is invoked. 1101 * 1102 *---------------------------------------------------------------------------- 1103 */ 1104 1105static void * 1106TclExpatDefaultHandler(userData, s, len) 1107 void *userData; 1108 CONST char *s; 1109 int len; 1110{ 1111 TclExpatInfo *expat = (TclExpatInfo *) userData; 1112 Tcl_Obj *cmdPtr; 1113 int result; 1114 1115 if (expat->defaultcommand == NULL || 1116 expat->status != TCL_OK) { 1117 return NULL; 1118 } 1119 1120 /* 1121 * Take a copy of the callback script so that arguments may be appended. 1122 */ 1123 1124 cmdPtr = Tcl_DuplicateObj(expat->defaultcommand); 1125 Tcl_IncrRefCount(cmdPtr); 1126 Tcl_Preserve((ClientData) expat->interp); 1127 1128 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)s, len)); 1129 1130 /* 1131 * It would be desirable to be able to terminate parsing 1132 * if the return result is TCL_ERROR or TCL_BREAK. 1133 */ 1134#if defined(PRE81) 1135 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 1136#elif defined(PRE82) 1137 result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1138#else 1139 result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1140#endif 1141 1142 Tcl_DecrRefCount(cmdPtr); 1143 Tcl_Release((ClientData) expat->interp); 1144 1145 TclExpatHandlerResult(expat, result); 1146 1147 return NULL; 1148} 1149 1150/* 1151 *---------------------------------------------------------------------------- 1152 * 1153 * TclExpatUnparsedDeclHandler -- 1154 * 1155 * Called by expat for processing an unparsed entity references. 1156 * 1157 * Results: 1158 * None. 1159 * 1160 * Side Effects: 1161 * Callback script is invoked. 1162 * 1163 *---------------------------------------------------------------------------- 1164 */ 1165 1166static void * 1167TclExpatUnparsedDeclHandler(userData, entityname, base, systemId, publicId, notationName) 1168 void *userData; 1169 CONST char *entityname; 1170 CONST char *base; 1171 CONST char *systemId; 1172 CONST char *publicId; 1173 CONST char *notationName; 1174{ 1175 TclExpatInfo *expat = (TclExpatInfo *) userData; 1176 Tcl_Obj *cmdPtr; 1177 int result; 1178 1179 if (expat->unparsedcommand == NULL || 1180 expat->status != TCL_OK) { 1181 return NULL; 1182 } 1183 1184 /* 1185 * Take a copy of the callback script so that arguments may be appended. 1186 */ 1187 1188 cmdPtr = Tcl_DuplicateObj(expat->unparsedcommand); 1189 Tcl_IncrRefCount(cmdPtr); 1190 Tcl_Preserve((ClientData) expat->interp); 1191 1192 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)entityname, strlen(entityname))); 1193 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)base, strlen(base))); 1194 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)systemId, strlen(systemId))); 1195 if (publicId == NULL) { 1196 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL)); 1197 } else { 1198 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)publicId, strlen(publicId))); 1199 } 1200 if (notationName == NULL) { 1201 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL)); 1202 } else { 1203 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)notationName, strlen(notationName))); 1204 } 1205 1206 /* 1207 * It would be desirable to be able to terminate parsing 1208 * if the return result is TCL_ERROR or TCL_BREAK. 1209 */ 1210#if defined(PRE81) 1211 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 1212#elif defined(PRE82) 1213 result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1214#else 1215 result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1216#endif 1217 1218 Tcl_DecrRefCount(cmdPtr); 1219 Tcl_Release((ClientData) expat->interp); 1220 1221 TclExpatHandlerResult(expat, result); 1222 1223 return NULL; 1224} 1225 1226/* 1227 *---------------------------------------------------------------------------- 1228 * 1229 * TclExpatNotationDeclHandler -- 1230 * 1231 * Called by expat for processing a notation declaration. 1232 * 1233 * Results: 1234 * None. 1235 * 1236 * Side Effects: 1237 * Callback script is invoked. 1238 * 1239 *---------------------------------------------------------------------------- 1240 */ 1241 1242static void * 1243TclExpatNotationDeclHandler(userData, notationName, base, systemId, publicId) 1244 void *userData; 1245 CONST char *notationName; 1246 CONST char *base; 1247 CONST char *systemId; 1248 CONST char *publicId; 1249{ 1250 TclExpatInfo *expat = (TclExpatInfo *) userData; 1251 Tcl_Obj *cmdPtr; 1252 int result; 1253 1254 if (expat->notationcommand == NULL || 1255 expat->status != TCL_OK) { 1256 return NULL; 1257 } 1258 1259 /* 1260 * Take a copy of the callback script so that arguments may be appended. 1261 */ 1262 1263 cmdPtr = Tcl_DuplicateObj(expat->notationcommand); 1264 Tcl_IncrRefCount(cmdPtr); 1265 Tcl_Preserve((ClientData) expat->interp); 1266 1267 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)notationName, strlen(notationName))); 1268 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)base, strlen(base))); 1269 if (systemId == NULL) { 1270 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL)); 1271 } else { 1272 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)systemId, strlen(systemId))); 1273 } 1274 if (publicId == NULL) { 1275 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL)); 1276 } else { 1277 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)publicId, strlen(publicId))); 1278 } 1279 1280 /* 1281 * It would be desirable to be able to terminate parsing 1282 * if the return result is TCL_ERROR or TCL_BREAK. 1283 */ 1284#if defined(PRE81) 1285 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 1286#elif defined(PRE82) 1287 result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1288#else 1289 result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1290#endif 1291 1292 Tcl_DecrRefCount(cmdPtr); 1293 Tcl_Release((ClientData) expat->interp); 1294 1295 TclExpatHandlerResult(expat, result); 1296 1297 return NULL; 1298} 1299 1300/* 1301 *---------------------------------------------------------------------------- 1302 * 1303 * TclExpatUnknownEncodingHandler -- 1304 * 1305 * Called by expat for processing a reference to a character in an 1306 * unknown encoding. 1307 * 1308 * Results: 1309 * None. 1310 * 1311 * Side Effects: 1312 * Callback script is invoked. 1313 * 1314 *---------------------------------------------------------------------------- 1315 */ 1316 1317static int 1318TclExpatUnknownEncodingHandler(encodingHandlerData, name, info) 1319 void *encodingHandlerData; 1320 CONST char *name; 1321 XML_Encoding *info; 1322{ 1323 TclExpatInfo *expat = (TclExpatInfo *) encodingHandlerData; 1324 Tcl_Obj *cmdPtr; 1325 int result; 1326 1327 Tcl_SetResult(expat->interp, "not implemented", NULL); 1328 return 0; 1329 1330 if (expat->unknownencodingcommand == NULL || 1331 expat->status != TCL_OK) { 1332 return 0; 1333 } 1334 1335 /* 1336 * Take a copy of the callback script so that arguments may be appended. 1337 */ 1338 1339 cmdPtr = Tcl_DuplicateObj(expat->unknownencodingcommand); 1340 Tcl_IncrRefCount(cmdPtr); 1341 Tcl_Preserve((ClientData) expat->interp); 1342 1343 /* 1344 * Setup the arguments 1345 */ 1346 1347 /* 1348 * It would be desirable to be able to terminate parsing 1349 * if the return result is TCL_ERROR or TCL_BREAK. 1350 */ 1351#if defined(PRE81) 1352 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 1353#elif defined(PRE82) 1354 result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1355#else 1356 result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1357#endif 1358 1359 Tcl_DecrRefCount(cmdPtr); 1360 Tcl_Release((ClientData) expat->interp); 1361 1362 TclExpatHandlerResult(expat, result); 1363 1364 /* 1365 * NOTE: have to decide whether to return 0 or 1 here, 1366 * since Expat is waiting for an answer. 1367 */ 1368 return 0; 1369} 1370 1371/* 1372 *---------------------------------------------------------------------------- 1373 * 1374 * TclExpatExternalEntityRefHandler -- 1375 * 1376 * Called by expat for processing external entity references. 1377 * 1378 * Results: 1379 * None. 1380 * 1381 * Side Effects: 1382 * Callback script is invoked. 1383 * 1384 *---------------------------------------------------------------------------- 1385 */ 1386 1387static void * 1388TclExpatExternalEntityRefHandler(parser, openEntityNames, base, systemId, publicId) 1389 XML_Parser parser; 1390 CONST char *openEntityNames; 1391 CONST char *base; 1392 CONST char *systemId; 1393 CONST char *publicId; 1394{ 1395 TclExpatInfo *expat = (TclExpatInfo *) XML_GetUserData(parser); 1396 Tcl_Obj *cmdPtr; 1397 int result; 1398 1399 if (expat->externalentitycommand == NULL || 1400 expat->status != TCL_OK) { 1401 return NULL; 1402 } 1403 1404 /* 1405 * Take a copy of the callback script so that arguments may be appended. 1406 */ 1407 1408 cmdPtr = Tcl_DuplicateObj(expat->externalentitycommand); 1409 Tcl_IncrRefCount(cmdPtr); 1410 Tcl_Preserve((ClientData) expat->interp); 1411 1412 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)openEntityNames, strlen(openEntityNames))); 1413 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)base, strlen(base))); 1414 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)systemId, strlen(systemId))); 1415 Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)publicId, strlen(publicId))); 1416 1417 /* 1418 * It would be desirable to be able to terminate parsing 1419 * if the return result is TCL_ERROR or TCL_BREAK. 1420 */ 1421#if defined(PRE81) 1422 result = Tcl_GlobalEvalObj(expat->interp, cmdPtr); 1423#elif defined(PRE82) 1424 result = Tcl_EvalObj(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1425#else 1426 result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL); 1427#endif 1428 1429 Tcl_DecrRefCount(cmdPtr); 1430 Tcl_Release((ClientData) expat->interp); 1431 1432 TclExpatHandlerResult(expat, result); 1433 1434 return NULL; 1435} 1436 1437/* 1438 *---------------------------------------------------------------------------- 1439 * 1440 * TclExpatDeleteCmd -- 1441 * 1442 * Called when a expat parser is deleted. 1443 * 1444 * Results: 1445 * None. 1446 * 1447 * Side Effects: 1448 * Memory structures are freed. 1449 * 1450 *---------------------------------------------------------------------------- 1451 */ 1452 1453static void 1454TclExpatDeleteCmd(clientData) 1455 ClientData clientData; 1456{ 1457 TclExpatInfo *expat = (TclExpatInfo *) clientData; 1458 1459 TclExpatFreeParser(expat); 1460 1461 Tcl_DecrRefCount(expat->name); 1462 1463 if (expat->elementstartcommand) { 1464 Tcl_DecrRefCount(expat->elementstartcommand); 1465 } 1466 if (expat->elementendcommand) { 1467 Tcl_DecrRefCount(expat->elementendcommand); 1468 } 1469 if (expat->datacommand) { 1470 Tcl_DecrRefCount(expat->datacommand); 1471 } 1472 if (expat->picommand) { 1473 Tcl_DecrRefCount(expat->picommand); 1474 } 1475 if (expat->externalentitycommand) { 1476 Tcl_DecrRefCount(expat->externalentitycommand); 1477 } 1478} 1479