1/* 2 * tcldompro.c -- 3 * 4 * This file implements the TclDomPro extension. 5 * 6 * Copyright (c) 1998-2000 Ajuba Solutions. 7 * 8 * See the file "license.terms" for information on usage and redistribution 9 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 10 * 11 * $Id: tcldompro.c,v 1.15 2003/04/02 22:48:14 jenglish Exp $ 12 */ 13 14#include "tclDomProInt.h" 15 16/* 17 * Option definitions shared by cget and configure commands 18 */ 19 20static CONST84 char *nodeOptions[] = { 21 "-nodeName", "-nodeType", "-parentNode", 22 "-childNodes", "-firstChild", "-lastChild", "-previousSibling", 23 "-nextSibling", "-attributes", "-nodeValue", 24 "-startLine", "-startColumn", "-endLine", "-endColumn", 25 "-startWidth", "-endWidth", "-parsingComplete", 26 "-startCloseLine", "-startCloseColumn", 27 "-endCloseLine", "-endCloseColumn", 28 "-startSpan", "-endSpan", 29 NULL 30}; 31 32 33enum nodeOptions { 34 NODE_NAME, NODE_TYPE, PARENT_NODE, CHILD_NODES, 35 FIRST_CHILD, LAST_CHILD, PREVIOUS_SIBLING, 36 NEXT_SIBLING, ATTRIBUTES, NODE_VALUE, 37 START_LINE, START_COLUMN, END_LINE, END_COLUMN, 38 START_WIDTH, END_WIDTH, PARSE_COMPLETE, 39 START_CLOSE_LINE, START_CLOSE_COLUMN, END_CLOSE_LINE, END_CLOSE_COLUMN, 40 START_SPAN, END_SPAN 41}; 42 43static CONST84 char *treeWalkerOptions[] = { 44 "-show", "-filter", "-expandEntities", "-currentNode", NULL 45}; 46 47enum treeWalkerOptions { 48 WHAT_TO_SHOW, NODE_FILTER, EXPAND_ENTITY_REFERENCES, CURRENT_NODE 49}; 50 51/* 52 * W3C DOM / TclDOM incompatibilities: 53 * 54 * According to the W3C DOM spec, the [dom::document createXXX] 55 * methods create nodes as unattached, parentless nodes. 56 * 57 * In the TclDOM implementation, newly created nodes are 58 * added as children of the specified parent node. 59 * 60 * By default, dom::c now follows the dom::tcl implementation. 61 * Compile with -DW3C_CONSTRUCTOR_BEHAVIOR=1 to get the W3C behaviour, 62 */ 63 64#if W3C_CONSTRUCTOR_BEHAVIOR 65# define AddCreatedNode(interp,interpDataPtr,subjectNode,child) /*no-op*/ 66#else 67# define AddCreatedNode(interp,interpDataPtr,subjectNode,child) \ 68 if ( \ 69 TclDomAppendChild(interp,interpDataPtr,subjectNode,child) \ 70 != TCL_OK) return TCL_ERROR; 71#endif 72 73/* 74 * Forward declarations 75 */ 76 77static int DOMImplementationCmd (ClientData clientData, Tcl_Interp *interp, 78 int objc, Tcl_Obj *CONST objv[]); 79static int TclDomDoctypeCmd (ClientData clientData, Tcl_Interp *interp, 80 int objc, Tcl_Obj *CONST objv[]); 81static int TclDomNodeCmd (ClientData clientData, Tcl_Interp *interp, 82 int objc, Tcl_Obj *CONST objv[]); 83static void TclDomInterpDataDeleteProc (ClientData clientData, 84 Tcl_Interp *interp); 85static int TclDomElementCmd (ClientData clientData, Tcl_Interp *interp, 86 int objc, Tcl_Obj *CONST objv[]); 87static int TclDomDocumentCmd (ClientData clientData, Tcl_Interp *interp, 88 int objc, Tcl_Obj *CONST objv[]); 89static int TclDomDocumentTraversalCmd (ClientData clientData, 90 Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); 91static int TclDomNodeIteratorCmd (ClientData clientData, Tcl_Interp *interp, 92 int objc, Tcl_Obj *CONST objv[]); 93static int TclDomTreeWalkerCmd (ClientData clientData, Tcl_Interp *interp, 94 int objc, Tcl_Obj *CONST objv[]); 95static int TclDomIteratorCGetCmd(ClientData clientData, Tcl_Interp *interp, 96 int objc, Tcl_Obj *CONST objv[]); 97static int TclDomTreeWalkerCGetCmd(ClientData clientData, Tcl_Interp *interp, 98 int objc, Tcl_Obj *CONST objv[]); 99static int TclDomTreeWalkerConfigureCmd(ClientData clientData, 100 Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); 101 102 103/* 104 *-------------------------------------------------------------- 105 * 106 * Tcldom_Init -- 107 * 108 * Initializes the Tcl-DOM package. 109 * 110 * Results: 111 * Returns a standard Tcl completion code, and leaves an error 112 * message in interp->result if an error occurs. 113 * 114 * Side effects: 115 * Initializes DOM. 116 * 117 *-------------------------------------------------------------- 118 */ 119int 120TCLDOMAPI 121Tcldom_Init( 122 Tcl_Interp *interp) /* The interpreter for the extension */ 123{ 124 TclDomInterpData *interpDataPtr; 125 126#ifdef USE_TCL_STUBS 127 if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) { 128 return TCL_ERROR; 129 } 130#endif 131 132 /* 133 * Do once-per-extension initialization 134 */ 135 136 interpDataPtr = (TclDomInterpData *) ckalloc(sizeof(TclDomInterpData)); 137 memset(interpDataPtr, 0, sizeof(TclDomInterpData)); 138 Tcl_SetAssocData(interp, PACKAGE_NAME, 139 TclDomInterpDataDeleteProc, (ClientData)interpDataPtr); 140 141 Tcl_InitHashTable(&interpDataPtr->documentHashTable, TCL_STRING_KEYS); 142 Tcl_InitHashTable(&interpDataPtr->nodeHashTable, TCL_STRING_KEYS); 143 Tcl_InitHashTable(&interpDataPtr->iteratorHashTable, TCL_STRING_KEYS); 144 Tcl_InitHashTable(&interpDataPtr->treeWalkerHashTable, TCL_STRING_KEYS); 145 146 /* 147 * Create additional commands. 148 */ 149 150 Tcl_CreateObjCommand(interp, NAMESPACE "DOMImplementation", 151 DOMImplementationCmd, (ClientData) interpDataPtr, 152 (Tcl_CmdDeleteProc *) NULL); 153 154 Tcl_CreateObjCommand(interp, NAMESPACE "node", TclDomNodeCmd, 155 (ClientData) interpDataPtr, (Tcl_CmdDeleteProc *) NULL); 156 157 Tcl_CreateObjCommand(interp, NAMESPACE "element", TclDomElementCmd, 158 (ClientData) interpDataPtr, (Tcl_CmdDeleteProc *) NULL); 159 160 Tcl_CreateObjCommand(interp, NAMESPACE "document", TclDomDocumentCmd, 161 (ClientData) interpDataPtr, (Tcl_CmdDeleteProc *) NULL); 162 163 Tcl_CreateObjCommand(interp, NAMESPACE "doctype", TclDomDoctypeCmd, 164 (ClientData) interpDataPtr, (Tcl_CmdDeleteProc *) NULL); 165 166 Tcl_CreateObjCommand(interp, NAMESPACE "DocumentTraversal", 167 TclDomDocumentTraversalCmd, (ClientData) interpDataPtr, 168 (Tcl_CmdDeleteProc *) NULL); 169 170 Tcl_CreateObjCommand(interp, NAMESPACE "nodeIterator", 171 TclDomNodeIteratorCmd, (ClientData) interpDataPtr, 172 (Tcl_CmdDeleteProc *) NULL); 173 174 Tcl_CreateObjCommand(interp, NAMESPACE "treeWalker", TclDomTreeWalkerCmd, 175 (ClientData) interpDataPtr, (Tcl_CmdDeleteProc *) NULL); 176 177 /* 178 * Create constants for node filter return values 179 */ 180 181 Tcl_ObjSetVar2(interp, Tcl_NewStringObj("::dom::accept", -1), NULL, 182 Tcl_NewIntObj(DOM_ACCEPT), 0); 183 184 Tcl_ObjSetVar2(interp, Tcl_NewStringObj("::dom::skip", -1), NULL, 185 Tcl_NewIntObj(DOM_SKIP), 0); 186 187 Tcl_ObjSetVar2(interp, Tcl_NewStringObj("::dom::reject", -1), NULL, 188 Tcl_NewIntObj(DOM_REJECT), 0); 189 190 Tcl_PkgProvide(interp, "tcldom", VERSION); 191 Tcl_PkgProvide(interp, "dom::c", VERSION); 192 Tcl_PkgProvide(interp, "dom", VERSION); 193 return TCL_OK; 194} 195 196 197/* 198 *-------------------------------------------------------------- 199 * 200 * Tcldom_SafeInit -- 201 * 202 * Initializes the tcldompro package for a safe interpreter. 203 * 204 * Results: 205 * Returns a standard Tcl completion code, and leaves an error 206 * message in interp->result if an error occurs. 207 * 208 * Side effects: 209 * None. 210 * 211 *-------------------------------------------------------------- 212 */ 213 214int 215TCLDOMAPI 216Tcldom_SafeInit( 217 Tcl_Interp *interp) /* Safe Interpreter for the extension */ 218{ 219 /* 220 * This package does not provide any unsafe capabilities, so we 221 * just call the regular initializer. 222 */ 223 224 return Tcldom_Init(interp); 225} 226 227 228/* 229 *-------------------------------------------------------------- 230 * 231 * TclDomInterpDataDeleteProc -- 232 * 233 * This procedure is called when the extension's 234 * interpreter is deleted. 235 * 236 * Results: 237 * None. 238 * 239 * Side effects: 240 * Frees resources. 241 * 242 *-------------------------------------------------------------- 243 */ 244 245static void 246TclDomInterpDataDeleteProc( 247 ClientData clientData, /* Per interpreter data */ 248 Tcl_Interp *interp) /* Interpreter being deleted */ 249{ 250 TclDomInterpData *interpDataPtr = (TclDomInterpData *) clientData; 251 if (interpDataPtr) { 252 Tcl_HashEntry *entry; 253 Tcl_HashSearch search; 254 TclDomDocument *documentPtr; 255 TclDomNodeIterator *nodeIteratorPtr; 256 TclDomTreeWalker *treeWalkerPtr; 257 258 /* 259 * Delete any dangling objects 260 */ 261 262 if (interpDataPtr->parserInfo.documentPtr) { 263 TclDomDeleteDocument(interp, interpDataPtr, 264 interpDataPtr->parserInfo.documentPtr); 265 } 266 267 for (entry = Tcl_FirstHashEntry(&interpDataPtr->documentHashTable, 268 &search); entry; entry = Tcl_NextHashEntry(&search)) { 269 documentPtr = (TclDomDocument *) Tcl_GetHashValue(entry); 270 TclDomDeleteDocument(interp, interpDataPtr, documentPtr); 271 } 272 273 for (entry = Tcl_FirstHashEntry(&interpDataPtr->iteratorHashTable, 274 &search); entry; entry = Tcl_NextHashEntry(&search)) { 275 nodeIteratorPtr = (TclDomNodeIterator *) Tcl_GetHashValue(entry); 276 TclDomDeleteNodeIterator(nodeIteratorPtr); 277 } 278 279 for (entry = Tcl_FirstHashEntry(&interpDataPtr->treeWalkerHashTable, 280 &search); entry; entry = Tcl_NextHashEntry(&search)) { 281 treeWalkerPtr = (TclDomTreeWalker *) Tcl_GetHashValue(entry); 282 TclDomDeleteTreeWalker(treeWalkerPtr); 283 } 284 285 Tcl_DeleteHashTable(&interpDataPtr->documentHashTable); 286 Tcl_DeleteHashTable(&interpDataPtr->nodeHashTable); 287 Tcl_DeleteHashTable(&interpDataPtr->iteratorHashTable); 288 Tcl_DeleteHashTable(&interpDataPtr->treeWalkerHashTable); 289 290 291 if (interpDataPtr->parser) { 292 XML_ParserFree(interpDataPtr->parser); 293 } 294 295 ckfree((char *) interpDataPtr); 296 } 297} 298 299 300/* 301 *-------------------------------------------------------------- 302 * 303 * TclDomCGetNodeCmd -- 304 * 305 * This procedure handles the cget method for a 306 * TclDom node command. 307 * 308 * Results: 309 * Return TCL_OK if a valid attribute is requested; 310 * otherwise return TCL_ERROR. 311 * 312 * Side effects: 313 * None. 314 * 315 *-------------------------------------------------------------- 316 */ 317 318static int 319TclDomCGetNodeCmd( 320 ClientData clientData, /* State data for this interp */ 321 Tcl_Interp *interp, /* Current interpreter. */ 322 int objc, /* Number of arguments. */ 323 Tcl_Obj *CONST objv[]) /* The argument objects. */ 324{ 325 int optionIndex; 326 TclDomInterpData *interpDataPtr; 327 TclDomNode *nodePtr; 328 329 if (objc != 4) { 330 Tcl_WrongNumArgs(interp, 2, objv, "node option"); 331 return TCL_ERROR; 332 } 333 334 if (Tcl_GetIndexFromObj(interp, objv[3], nodeOptions, "option", 0, 335 &optionIndex) != TCL_OK) { 336 return TCL_ERROR; 337 } 338 339 interpDataPtr = (TclDomInterpData *) clientData; 340 341 nodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[2]); 342 if (nodePtr == NULL) { 343 return TCL_ERROR; 344 } 345 346 switch ((enum nodeOptions) optionIndex) { 347 case NODE_NAME: 348 return TclDomGetNodeName(interp, nodePtr); 349 350 case NODE_TYPE: 351 return TclDomNodeTypeName(interp, nodePtr); 352 353 case PARENT_NODE: 354 return TclDomSetNodeResult(interp, interpDataPtr, 355 nodePtr->parentNodePtr); 356 357 case CHILD_NODES: 358 return TclDomGetChildNodeList(interp, interpDataPtr, nodePtr); 359 360 case FIRST_CHILD: 361 if (TclDomHasChildren(nodePtr)) { 362 return TclDomSetNodeResult(interp, interpDataPtr, 363 nodePtr->firstChildPtr); 364 } else { 365 return TCL_OK; 366 } 367 368 case LAST_CHILD: 369 if (TclDomHasChildren(nodePtr)) { 370 return TclDomSetNodeResult(interp, interpDataPtr, 371 nodePtr->lastChildPtr); 372 } else { 373 return TCL_OK; 374 } 375 376 case PREVIOUS_SIBLING: 377 return TclDomSetNodeResult(interp, interpDataPtr, 378 nodePtr->previousSiblingPtr); 379 380 case NEXT_SIBLING: 381 return TclDomSetNodeResult(interp, interpDataPtr, 382 nodePtr->nextSiblingPtr); 383 384 case ATTRIBUTES: 385 return TclDomAttributeArray(interp, interpDataPtr, nodePtr); 386 387 case NODE_VALUE: 388 if (nodePtr->nodeValue) { 389 Tcl_SetObjResult(interp, 390 Tcl_NewStringObj(nodePtr->nodeValue, -1)); 391 } 392 return TCL_OK; 393 394 case START_LINE: 395 Tcl_SetObjResult(interp, Tcl_NewIntObj(nodePtr->startLine)); 396 return TCL_OK; 397 398 case START_COLUMN: 399 Tcl_SetObjResult(interp, Tcl_NewIntObj(nodePtr->startColumn)); 400 return TCL_OK; 401 402 case END_LINE: 403 Tcl_SetObjResult(interp, Tcl_NewIntObj(nodePtr->endLine)); 404 return TCL_OK; 405 406 case END_COLUMN: 407 Tcl_SetObjResult(interp, Tcl_NewIntObj(nodePtr->endColumn)); 408 return TCL_OK; 409 410 case START_WIDTH: 411 Tcl_SetObjResult(interp, Tcl_NewIntObj(nodePtr->startWidth)); 412 return TCL_OK; 413 414 case END_WIDTH: 415 Tcl_SetObjResult(interp, Tcl_NewIntObj(nodePtr->endWidth)); 416 return TCL_OK; 417 418 case START_CLOSE_LINE: 419 Tcl_SetObjResult(interp, Tcl_NewIntObj(nodePtr->startLineClose)); 420 return TCL_OK; 421 422 case START_CLOSE_COLUMN: 423 Tcl_SetObjResult(interp, Tcl_NewIntObj(nodePtr->startColumnClose)); 424 return TCL_OK; 425 426 case END_CLOSE_LINE: 427 Tcl_SetObjResult(interp, Tcl_NewIntObj(nodePtr->endLineClose)); 428 return TCL_OK; 429 430 case END_CLOSE_COLUMN: 431 Tcl_SetObjResult(interp, Tcl_NewIntObj(nodePtr->endColumnClose)); 432 return TCL_OK; 433 434 case START_SPAN: { 435 Tcl_Obj *spanPtr; 436 spanPtr = Tcl_NewListObj(0, NULL); 437 Tcl_ListObjAppendElement(interp, spanPtr, Tcl_NewIntObj(nodePtr->startLine)); 438 Tcl_ListObjAppendElement(interp, spanPtr, Tcl_NewIntObj(nodePtr->startColumn)); 439 Tcl_ListObjAppendElement(interp, spanPtr, Tcl_NewIntObj(nodePtr->startLineClose)); 440 Tcl_ListObjAppendElement(interp, spanPtr, Tcl_NewIntObj(nodePtr->startColumnClose)); 441 Tcl_SetObjResult(interp, spanPtr); 442 return TCL_OK; 443 } 444 445 case END_SPAN: { 446 Tcl_Obj *spanPtr; 447 spanPtr = Tcl_NewListObj(0, NULL); 448 Tcl_ListObjAppendElement(interp, spanPtr, Tcl_NewIntObj(nodePtr->endLine)); 449 Tcl_ListObjAppendElement(interp, spanPtr, Tcl_NewIntObj(nodePtr->endColumn)); 450 Tcl_ListObjAppendElement(interp, spanPtr, Tcl_NewIntObj(nodePtr->endLineClose)); 451 Tcl_ListObjAppendElement(interp, spanPtr, Tcl_NewIntObj(nodePtr->endColumnClose)); 452 Tcl_SetObjResult(interp, spanPtr); 453 return TCL_OK; 454 } 455 456 case PARSE_COMPLETE: 457 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(nodePtr->nodeComplete)); 458 return TCL_OK; 459 460 default: 461 Tcl_SetResult(interp, "unknown option", TCL_STATIC); 462 return TCL_ERROR; 463 } 464 /*NOTREACHED*/ 465} 466 467 468/* 469 *-------------------------------------------------------------- 470 * 471 * TclDomConfigureNodeCmd -- 472 * 473 * This procedure handles the configure method for a 474 * TclDom node command. 475 * 476 * Results: 477 * Return TCL_OK if a valid attribute is requested; 478 * otherwise return TCL_ERROR. 479 * 480 * Side effects: 481 * None. 482 * 483 *-------------------------------------------------------------- 484 */ 485 486static int 487TclDomConfigureNodeCmd( 488 ClientData clientData, /* State data for this interp */ 489 Tcl_Interp *interp, /* Current interpreter. */ 490 int objc, /* Number of arguments. */ 491 Tcl_Obj *CONST objv[]) /* The argument objects. */ 492{ 493 int optionIndex; 494 char *value; 495 TclDomInterpData *interpDataPtr; 496 TclDomNode *nodePtr; 497 498 static CONST84 char *writableNodeOptions[] = { 499 "-nodeValue", 500 NULL 501 }; 502 503 enum writableNodeOptions { 504 NODE_VALUE, 505 }; 506 507 if (objc != 5) { 508 return TclDomCGetNodeCmd(clientData, interp, objc, objv); 509 } 510 511 if (Tcl_GetIndexFromObj(interp, objv[3], nodeOptions, "option", 0, 512 &optionIndex) != TCL_OK) { 513 return TCL_ERROR; 514 } 515 516 if (Tcl_GetIndexFromObj(interp, objv[3], writableNodeOptions, 517 "writable option", 0, &optionIndex) != TCL_OK) { 518 Tcl_SetResult(interp, NO_MODIFICATION_ALLOWED_ERR_TEXT, TCL_STATIC); 519 return TCL_ERROR; 520 } 521 522 interpDataPtr = (TclDomInterpData *) clientData; 523 524 nodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[2]); 525 if (nodePtr == NULL) { 526 return TCL_ERROR; 527 } 528 529 value = Tcl_GetStringFromObj(objv[4], NULL); 530 531 switch ((enum nodeOptions) optionIndex) { 532 case NODE_VALUE: { 533 TdpDomError status; 534 status = TclDomSetNodeValue(nodePtr, value); 535 if (status != TDP_OK) { 536 TclDomSetDomError(interp, status); 537 return TCL_ERROR; 538 } 539 break; 540 } 541 542 default: 543 Tcl_SetResult(interp, "unknown option", TCL_STATIC); 544 return TCL_ERROR; 545 } 546 return TCL_OK; 547} 548 549 550/* 551 *-------------------------------------------------------------- 552 * 553 * TclDomDestroy -- 554 * 555 * This procedure handles the destroy method for a 556 * TclDom implementation. 557 * 558 * Results: 559 * Return TCL_OK if the request is for a valid document 560 * node; otherwise return TCL_ERROR: 561 * 562 * Side effects: 563 * Deletes a DOM node. 564 * 565 *-------------------------------------------------------------- 566 */ 567 568static int 569TclDomDestroy( 570 ClientData clientData, /* State data for this interp */ 571 Tcl_Interp *interp, /* Current interpreter. */ 572 int objc, /* Number of arguments. */ 573 Tcl_Obj *CONST objv[]) /* The argument objects. */ 574{ 575 TclDomInterpData *interpDataPtr; 576 TclDomNode *nodePtr; 577 char *temp; 578 579 if (objc != 3) { 580 Tcl_WrongNumArgs(interp, 2, objv, "token"); 581 return TCL_ERROR; 582 } 583 584 interpDataPtr = (TclDomInterpData *) clientData; 585 586 nodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[2]); 587 588 if (nodePtr == NULL) { 589 return TCL_ERROR; 590 } /* else */ 591 592 /* If this is a DOCUMENT node, delete the whole document: 593 */ 594 595 if (nodePtr->nodeType == DOCUMENT_NODE) { 596 TclDomDeleteDocument(interp, interpDataPtr, 597 nodePtr->containingDocumentPtr); 598 } else { 599 /* @@ Just unlink the child from the tree, don't actually destroy it; 600 * It will be destroyed when the document itself is. 601 */ 602 if (nodePtr->parentNodePtr) { 603 TclDomRemoveChild(interp, interpDataPtr, 604 nodePtr->parentNodePtr, nodePtr); 605 } 606 } 607 return TCL_OK; 608} 609 610 611/* 612 *-------------------------------------------------------------- 613 * 614 * TclDomDestroyTraversalObject -- 615 * 616 * This procedure handles the destroy method for a 617 * TclDom Traversal implementation. 618 * 619 * Results: 620 * Return TCL_OK if the request is for a valid document 621 * node; otherwise return TCL_ERROR: 622 * 623 * Side effects: 624 * Deletes a DOM TreeWalker or NodeIterator. 625 * 626 *-------------------------------------------------------------- 627 */ 628 629static int 630TclDomDestroyTraversalObject( 631 ClientData clientData, /* State data for this interp */ 632 Tcl_Interp *interp, /* Current interpreter. */ 633 int objc, /* Number of arguments. */ 634 Tcl_Obj *CONST objv[]) /* The argument objects. */ 635{ 636 TclDomInterpData *interpDataPtr; 637 TclDomTreeWalker *treeWalkerPtr; 638 TclDomNodeIterator *nodeIteratorPtr; 639 if (objc != 3) { 640 Tcl_WrongNumArgs(interp, 2, objv, "token"); 641 return TCL_ERROR; 642 } 643 644 interpDataPtr = (TclDomInterpData *) clientData; 645 646 treeWalkerPtr = TclDomGetTreeWalkerFromToken(interp, interpDataPtr, 647 objv[2]); 648 if (treeWalkerPtr == NULL) { 649 Tcl_ResetResult(interp); 650 nodeIteratorPtr = TclDomGetNodeIteratorFromToken(interp, 651 interpDataPtr, objv[2]); 652 if (nodeIteratorPtr == NULL) { 653 return TCL_ERROR; 654 } 655 TclDomDeleteNodeIterator(nodeIteratorPtr); 656 } else { 657 TclDomDeleteTreeWalker(treeWalkerPtr); 658 } 659 return TCL_OK; 660} 661 662 663/* 664 *-------------------------------------------------------------- 665 * 666 * TclDomParse -- 667 * 668 * This procedure handles the parse method for a 669 * TclDom implementation. 670 * 671 * Results: 672 * Return TCL_OK if the input XML source is successfully 673 * parsed; otherwise returns TCL_ERROR. 674 * 675 * Side effects: 676 * Invokes the expat parser to create a parse tree for the 677 * input XML. Creates a handle for the document. 678 * 679 *-------------------------------------------------------------- 680 */ 681 682static int TclDomParse( 683 ClientData clientData, /* State data for this interp */ 684 Tcl_Interp *interp, /* Current interpreter. */ 685 int objc, /* Number of arguments. */ 686 Tcl_Obj *CONST objv[]) /* The argument objects. */ 687{ 688 char *xmlSource; 689 char *progressCmd; 690 long chunkSize; 691 TclDomInterpData *interpDataPtr; 692 int length, index, i; 693 int final = 1; 694 int trim = 0; 695 int validate = 0; 696 697 static CONST84 char *options[] = { 698 "-chunksize", "-final", "-parser", "-progressCmd", "-trim", 699 "-validate", NULL 700 }; 701 enum options { 702 OPT_CHUNKSIZE, OPT_FINAL, OPT_PARSER, OPT_PROGRESSCMD, OPT_TRIM, 703 OPT_VALIDATE 704 }; 705 706 if (objc < 3) { 707 Tcl_WrongNumArgs(interp, 2, objv, "data ?options?"); 708 return TCL_ERROR; 709 } 710 711 /* 712 * Check for matched option / value pairs 713 */ 714 715 for (i = 3; i < objc; i++) { 716 if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, 717 &index) != TCL_OK) { 718 return TCL_ERROR; 719 } 720 if ((index != OPT_TRIM) && (i == objc-1)) { 721 Tcl_AppendResult(interp, "missing option value", (char *) NULL); 722 return TCL_ERROR; 723 } 724 725 switch (index) { 726 case OPT_PARSER: 727 i++; 728 if (strcmp("expat", Tcl_GetStringFromObj(objv[i], NULL)) 729 != 0) { 730 Tcl_AppendResult(interp, "parser must be expat", 731 (char *) NULL); 732 return TCL_ERROR; 733 } 734 break; 735 736 case OPT_PROGRESSCMD: 737 i++; 738 progressCmd = Tcl_GetStringFromObj(objv[i], NULL); 739 break; 740 741 case OPT_CHUNKSIZE: 742 i++; 743 if (Tcl_GetLongFromObj(interp, objv[i], &chunkSize) 744 != TCL_OK) { 745 return TCL_ERROR; 746 } 747 break; 748 749 case OPT_FINAL: 750 i++; 751 if (Tcl_GetBooleanFromObj(interp, objv[i], &final) != TCL_OK) { 752 return TCL_ERROR; 753 } 754 break; 755 756 case OPT_TRIM: 757 trim = 1; 758 break; 759 760 case OPT_VALIDATE: 761 i++; 762 if (Tcl_GetBooleanFromObj(interp, objv[i], &validate) != TCL_OK) { 763 return TCL_ERROR; 764 } 765 break; 766 } 767 } 768 769 interpDataPtr = (TclDomInterpData *) clientData; 770 771 xmlSource = Tcl_GetStringFromObj(objv[2], &length); 772 773 return TclDomReadDocument(interp, interpDataPtr, xmlSource, length, final, 774 trim); 775} 776 777 778/* 779 *-------------------------------------------------------------- 780 * 781 * TclDomImplemenationCmd -- 782 * 783 * This procedure handles the DOMImplementation command. 784 * Refer to the user documenation for details. 785 * 786 * Results: 787 * Return TCL_OK if a method succeeded; TCL_ERROR 788 * otherwise. 789 * 790 * Side effects: 791 * Depends on the command methods. 792 * 793 *-------------------------------------------------------------- 794 */ 795 796int 797DOMImplementationCmd( 798 ClientData clientData, /* State data for this interp */ 799 Tcl_Interp *interp, /* Current interpreter. */ 800 int objc, /* Number of arguments. */ 801 Tcl_Obj *CONST objv[]) /* The argument objects. */ 802{ 803 int methodIndex; 804 char *requestedVersion; 805 TclDomInterpData *interpDataPtr; 806 TclDomNode *nodePtr; 807 808 static CONST84 char *methods[] = { 809 "create", "hasFeature", "destroy", 810 "parse", "serialize", "trim", NULL 811 }; 812 813 enum methods { 814 CREATE, HASFEATURE, DESTROY, PARSE, SERIALIZE, TRIM 815 }; 816 817 if (objc < 2) { 818 Tcl_WrongNumArgs(interp, 1, objv, "method ?arg arg ...?"); 819 return TCL_ERROR; 820 } 821 822 if (Tcl_GetIndexFromObj(interp, objv[1], methods, "method", 0, 823 &methodIndex) != TCL_OK) { 824 return TCL_ERROR; 825 } 826 827 interpDataPtr = (TclDomInterpData *) clientData; 828 829 switch ((enum methods) methodIndex) { 830 case CREATE: 831 if (objc == 3) { 832 /* 833 * Make a special check for an optional "arrayName" 834 * which some versions of tcldom may support, but which 835 * we do not support. See the tcldom documentation for further 836 * explanation. 837 */ 838 839 Tcl_AppendResult(interp, 840 "the 'arrayName' option is not supported", 841 (char *) NULL); 842 return TCL_ERROR; 843 } 844 if (objc != 2) { 845 Tcl_WrongNumArgs(interp, 2, objv, NULL); 846 return TCL_ERROR; 847 } 848 return TclDomCreateEmptyDocumentNode(interp, interpDataPtr); 849 850 case HASFEATURE: 851 if (objc != 4) { 852 Tcl_WrongNumArgs(interp, 2, objv, "feature"); 853 return TCL_ERROR; 854 } 855 /* 856 * Check if the feature is valid 857 */ 858 859 if (Tcl_GetIndexFromObj(interp, objv[2], methods, "", 0, 860 &methodIndex) != TCL_OK) { 861 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); 862 return TCL_OK; 863 } 864 requestedVersion = Tcl_GetStringFromObj(objv[3], NULL); 865 if (strcmp(requestedVersion, "1.0") == 0) { 866 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); 867 } else { 868 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); 869 } 870 return TCL_OK; 871 872 case DESTROY: 873 if (objc != 3) { 874 Tcl_WrongNumArgs(interp, 2, objv, "token"); 875 return TCL_ERROR; 876 } 877 return TclDomDestroy(clientData, interp, objc, objv); 878 879 case PARSE: 880 return TclDomParse(clientData, interp, objc, objv); 881 882 case SERIALIZE: 883 if (objc < 3) { 884 Tcl_WrongNumArgs(interp, 2, objv, "token ?options?"); 885 return TCL_ERROR; 886 } 887 nodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[2]); 888 if (nodePtr == NULL) { 889 return TCL_ERROR; 890 } 891 if (objc >= 4) { 892 char *option = Tcl_GetStringFromObj(objv[3], NULL); 893 if (strcmp(option, "-newline") == 0) { 894 /* 895 * We don't support this as yet; the intent is to provide 896 * a list of element tags for which newlines will be 897 * appended. 898 */ 899 } else { 900 Tcl_AppendResult(interp, "invalid option ", option, 901 (char *) NULL); 902 return TCL_ERROR; 903 } 904 } 905 906 return TclDomSerialize(interp, nodePtr); 907 908 case TRIM: 909 if (objc != 3) { 910 Tcl_WrongNumArgs(interp, 2, objv, "token"); 911 return TCL_ERROR; 912 } 913 Tcl_AppendResult(interp, "trim method not implemented", 914 (char *) NULL); 915 return TCL_ERROR; 916 917 default: 918 Tcl_SetResult(interp, "unknown method", TCL_STATIC); 919 return TCL_ERROR; 920 } 921 922 /*NOTREACHED*/ 923} 924 925 926/* 927 *-------------------------------------------------------------- 928 * 929 * TclDomNodeCmd -- 930 * 931 * This procedure processes commands for DOM Node objects. 932 * Refer to the user documentation to see what it does. 933 * 934 * Results: 935 * Return TCL_OK if a method succeeded; TCL_ERROR 936 * otherwise. 937 * 938 * Side effects: 939 * Depends on the command methods. 940 * 941 *-------------------------------------------------------------- 942 */ 943 944static int 945TclDomNodeCmd( 946 ClientData clientData, /* State data for this interp */ 947 Tcl_Interp *interp, /* Current interpreter. */ 948 int objc, /* Number of arguments. */ 949 Tcl_Obj *CONST objv[]) /* The argument objects. */ 950{ 951 int methodIndex; 952 TclDomInterpData *interpDataPtr; 953 TclDomNode *nodePtr; 954 TclDomNode *childPtr, *refChildPtr, *newChildPtr, *oldChildPtr; 955 int hasChildren, deepFlag; 956 957 static CONST84 char *methods[] = { 958 "cget", "configure", "insertBefore", "replaceChild", 959 "removeChild", "appendChild", "hasChildNodes", "cloneNode", 960 "children", "parent", NULL 961 }; 962 963 enum methods { 964 CGET, CONFIGURE, INSERT_BEFORE, REPLACE_CHILD, REMOVE_CHILD, 965 APPEND_CHILD, HAS_CHILD_NODES, CLONE_NODE, CHILDREN, PARENT 966 }; 967 968 if (objc < 2) { 969 Tcl_WrongNumArgs(interp, 1, objv, "method token ?arg ...?"); 970 return TCL_ERROR; 971 } 972 973 if (Tcl_GetIndexFromObj(interp, objv[1], methods, "method", 0, 974 &methodIndex) != TCL_OK) { 975 return TCL_ERROR; 976 } 977 978 interpDataPtr = (TclDomInterpData *) clientData; 979 980 nodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[2]); 981 if (nodePtr == NULL) { 982 return TCL_ERROR; 983 } 984 985 switch ((enum methods) methodIndex) { 986 case CGET: 987 return TclDomCGetNodeCmd(clientData, interp, objc, objv); 988 989 case CONFIGURE: 990 return TclDomConfigureNodeCmd(clientData, interp, objc, objv); 991 992 case INSERT_BEFORE: 993 if (objc < 4 || objc > 5) { 994 Tcl_WrongNumArgs(interp, 2, objv, 995 "token newchild ?refchild?"); 996 return TCL_ERROR; 997 } 998 childPtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[3]); 999 if (childPtr == NULL) { 1000 return TCL_ERROR; 1001 } 1002 if (TclDomValidateChildType(interp, nodePtr, childPtr) != TCL_OK) { 1003 return TCL_ERROR; 1004 } 1005 if (objc == 5) { 1006 refChildPtr = TclDomGetNodeFromToken(interp, interpDataPtr, 1007 objv[4]); 1008 if (refChildPtr == NULL) { 1009 return TCL_ERROR; 1010 } 1011 if (TclDomValidateChildType(interp, nodePtr, refChildPtr) 1012 != TCL_OK) { 1013 return TCL_ERROR; 1014 } 1015 } else { 1016 refChildPtr = NULL; 1017 } 1018 1019 if (refChildPtr) { 1020 return TclDomInsertBefore(interp, interpDataPtr, nodePtr, 1021 childPtr, refChildPtr); 1022 } else { 1023 return TclDomAppendChild(interp, interpDataPtr, nodePtr, 1024 childPtr); 1025 } 1026 1027 case REPLACE_CHILD: 1028 if (objc != 5) { 1029 Tcl_WrongNumArgs(interp, 2, objv, "token newchild oldchild"); 1030 return TCL_ERROR; 1031 } 1032 newChildPtr = TclDomGetNodeFromToken(interp, interpDataPtr, 1033 objv[3]); 1034 if (newChildPtr == NULL) { 1035 return TCL_ERROR; 1036 } 1037 if (TclDomValidateChildType(interp, nodePtr, newChildPtr) 1038 != TCL_OK) { 1039 return TCL_ERROR; 1040 } 1041 oldChildPtr = TclDomGetNodeFromToken(interp, interpDataPtr, 1042 objv[4]); 1043 if (oldChildPtr == NULL) { 1044 return TCL_ERROR; 1045 } 1046 return TclDomReplaceChild(interp, interpDataPtr, nodePtr, 1047 newChildPtr, oldChildPtr); 1048 1049 case REMOVE_CHILD: 1050 if (objc != 4) { 1051 Tcl_WrongNumArgs(interp, 2, objv, "token oldchild"); 1052 return TCL_ERROR; 1053 } 1054 childPtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[3]); 1055 if (childPtr == NULL) { 1056 return TCL_ERROR; 1057 } 1058 return TclDomRemoveChild(interp, interpDataPtr, nodePtr, childPtr); 1059 1060 case APPEND_CHILD: 1061 if (objc != 4) { 1062 Tcl_WrongNumArgs(interp, 2, objv, "token newchild"); 1063 return TCL_ERROR; 1064 } 1065 1066 childPtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[3]); 1067 if (childPtr == NULL) { 1068 return TCL_ERROR; 1069 } 1070 if (TclDomValidateChildType(interp, nodePtr, childPtr) != TCL_OK) { 1071 return TCL_ERROR; 1072 } 1073 return TclDomAppendChild(interp, interpDataPtr, nodePtr, childPtr); 1074 1075 case HAS_CHILD_NODES: 1076 nodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[2]); 1077 if (nodePtr == NULL) { 1078 return TCL_ERROR; 1079 } 1080 hasChildren = ((nodePtr->nodeType == ELEMENT_NODE 1081 || nodePtr->nodeType == DOCUMENT_NODE) 1082 && (nodePtr->firstChildPtr != NULL)); 1083 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(hasChildren)); 1084 return TCL_OK; 1085 1086 case CLONE_NODE: 1087 if (objc != 3 && objc != 5) { 1088 Tcl_WrongNumArgs(interp, 2, objv, 1089 "token ?-deep deepFlag?"); 1090 return TCL_ERROR; 1091 } 1092 if (objc == 5) { 1093 char *option; 1094 int result; 1095 option = Tcl_GetStringFromObj(objv[3], NULL); 1096 if (strcmp(option, "-deep")) { 1097 Tcl_AppendResult(interp, 1098 "invalid option, should be \"-deep\""); 1099 return TCL_ERROR; 1100 } 1101 result = Tcl_GetBooleanFromObj(interp, objv[4], &deepFlag); 1102 if (result != TCL_OK) { 1103 return result; 1104 } 1105 } 1106 return TclDomCloneNode(interp, interpDataPtr, nodePtr, 1107 deepFlag); 1108 1109 case CHILDREN: 1110 { 1111 Tcl_Obj *result; 1112 if (objc != 3) { 1113 Tcl_WrongNumArgs(interp, 2, objv, "token"); 1114 return TCL_ERROR; 1115 } 1116 result = TclDomGetChildren(interp, interpDataPtr, nodePtr); 1117 if (result == NULL) 1118 return TCL_ERROR; 1119 Tcl_SetObjResult(interp, result); 1120 return TCL_OK; 1121 } 1122 case PARENT: 1123 if (objc != 3) { 1124 Tcl_WrongNumArgs(interp, 2, objv, "token"); 1125 return TCL_ERROR; 1126 } 1127 return TclDomSetNodeResult(interp, interpDataPtr, 1128 nodePtr->parentNodePtr); 1129 1130 default: 1131 Tcl_SetResult(interp, "unknown method", TCL_STATIC); 1132 return TCL_ERROR; 1133 } 1134 1135 /*NOTREACHED*/ 1136} 1137 1138 1139/* 1140 *-------------------------------------------------------------- 1141 * 1142 * TclDomElementCmd -- 1143 * 1144 * This procedure processes commands for DOM Element objects. 1145 * Refer to the user documentation to see what it does. 1146 * 1147 * Results: 1148 * Return TCL_OK if a method succeeded; TCL_ERROR 1149 * otherwise. 1150 * 1151 * Side effects: 1152 * Depends on the command methods. 1153 * 1154 *-------------------------------------------------------------- 1155 */ 1156 1157static int 1158TclDomElementCmd( 1159 ClientData clientData, /* State data for this interp */ 1160 Tcl_Interp *interp, /* Current interpreter. */ 1161 int objc, /* Number of arguments. */ 1162 Tcl_Obj *CONST objv[]) /* The argument objects. */ 1163{ 1164 int methodIndex; 1165 TclDomInterpData *interpDataPtr; 1166 TclDomNode *nodePtr; 1167 TclDomAttributeNode *attributeNodePtr; 1168 char *option, *attributeName, *tagname, *name, *value; 1169 1170 static CONST84 char *methods[] = { 1171 "cget", "configure", "getAttribute", "setAttribute", 1172 "removeAttribute", "getAttributeNode", "setAttributeNode", 1173 "removeAttributeNode", "getElementsByTagName", "normalize", NULL 1174 }; 1175 1176 enum methods { 1177 CGET, CONFIGURE, 1178 GET_ATTRIBUTE, SET_ATTRIBUTE, REMOVE_ATTRIBUTE, 1179 GET_ATTRIBUTE_NODE, SET_ATTRIBUTE_NODE, REMOVE_ATTRIBUTE_NODE, 1180 GET_ELEMENTS_BY_TAGNAME, NORMALIZE 1181 }; 1182 1183 if (Tcl_GetIndexFromObj(interp, objv[1], methods, "method", 0, 1184 &methodIndex) != TCL_OK) { 1185 return TCL_ERROR; 1186 } 1187 1188 interpDataPtr = (TclDomInterpData *) clientData; 1189 1190 nodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[2]); 1191 if (nodePtr == NULL) { 1192 return TCL_ERROR; 1193 } 1194 1195 if (nodePtr->nodeType != ELEMENT_NODE) { 1196 Tcl_AppendResult(interp, "not an element type node", (char *) NULL); 1197 return TCL_ERROR; 1198 } 1199 1200 switch ((enum methods) methodIndex) { 1201 case CGET: 1202 if (objc != 4) { 1203 Tcl_WrongNumArgs(interp, 2, objv, "token option"); 1204 return TCL_ERROR; 1205 } 1206 option = Tcl_GetStringFromObj(objv[3], NULL); 1207 if (strcmp(option, "-tagName") == 0) { 1208 if (nodePtr->nodeName) { 1209 Tcl_SetObjResult(interp, 1210 Tcl_NewStringObj(nodePtr->nodeName, -1)); 1211 } 1212 return TCL_OK; 1213 } else if (strcmp(option, "-empty") == 0) { 1214 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); 1215 return TCL_OK; 1216 } else { 1217 Tcl_AppendResult(interp, "unknown option '", option, 1218 "', should be -empty or -tagName", (char *) NULL); 1219 return TCL_ERROR; 1220 } 1221 1222 case CONFIGURE: 1223 Tcl_AppendResult(interp, 1224 "element configure method not implemented", (char *) NULL); 1225 return TCL_ERROR; 1226 1227 case GET_ATTRIBUTE: 1228 if (objc != 4) { 1229 Tcl_WrongNumArgs(interp, 2, objv, "token name"); 1230 return TCL_ERROR; 1231 } 1232 attributeName = Tcl_GetStringFromObj(objv[3], NULL); 1233 attributeNodePtr = nodePtr->firstAttributePtr; 1234 while (attributeNodePtr && strcmp(attributeName, 1235 attributeNodePtr->nodeName)) { 1236 attributeNodePtr = attributeNodePtr->nextSiblingPtr; 1237 } 1238 1239 if (attributeNodePtr) { 1240 Tcl_SetObjResult(interp, 1241 Tcl_NewStringObj(attributeNodePtr->nodeValue, -1)); 1242 return TCL_OK; 1243 } else { 1244 return TCL_OK; 1245 } 1246 1247 case SET_ATTRIBUTE: 1248 if (objc != 5) { 1249 Tcl_WrongNumArgs(interp, 2, objv, "token name value"); 1250 return TCL_ERROR; 1251 } 1252 name = Tcl_GetStringFromObj(objv[3], NULL); 1253 if (!TclDomIsName(name)) { 1254 Tcl_AppendResult(interp, INVALID_CHARACTER_ERR_TEXT, 1255 (char *) NULL); 1256 return TCL_ERROR; 1257 } 1258 value = Tcl_GetStringFromObj(objv[4], NULL); 1259 return TclDomSetAttribute(interp, interpDataPtr, nodePtr, name, 1260 value); 1261 1262 case REMOVE_ATTRIBUTE: 1263 if (objc != 4) { 1264 Tcl_WrongNumArgs(interp, 2, objv, "token name"); 1265 return TCL_ERROR; 1266 } 1267 name = Tcl_GetStringFromObj(objv[3], NULL); 1268 return TclDomRemoveAttribute(interp, interpDataPtr, nodePtr, name); 1269 1270 case GET_ATTRIBUTE_NODE: 1271 if (objc != 4) { 1272 Tcl_WrongNumArgs(interp, 2, objv, "token name"); 1273 return TCL_ERROR; 1274 } 1275 Tcl_AppendResult(interp, "getAttribute method not implemented", 1276 (char *) NULL); 1277 return TCL_ERROR; 1278 1279 case SET_ATTRIBUTE_NODE: 1280 if (objc != 4) { 1281 Tcl_WrongNumArgs(interp, 2, objv, "token name"); 1282 return TCL_ERROR; 1283 } 1284 Tcl_AppendResult(interp, "setAttribute method not implemented", 1285 (char *) NULL); 1286 return TCL_ERROR; 1287 1288 case REMOVE_ATTRIBUTE_NODE: 1289 if (objc != 4) { 1290 Tcl_WrongNumArgs(interp, 2, objv, "token name"); 1291 return TCL_ERROR; 1292 } 1293 return TCL_ERROR; 1294 1295 case GET_ELEMENTS_BY_TAGNAME: 1296 if (objc != 4) { 1297 Tcl_WrongNumArgs(interp, 2, objv, "token name"); 1298 return TCL_ERROR; 1299 } 1300 tagname = Tcl_GetStringFromObj(objv[3], NULL); 1301 return TclDomGetElementsByTagname(interp, interpDataPtr, tagname, 1302 nodePtr); 1303 1304 case NORMALIZE: 1305 if (objc != 3) { 1306 Tcl_WrongNumArgs(interp, 2, objv, "token"); 1307 return TCL_ERROR; 1308 } 1309 Tcl_AppendResult(interp, "normalize method not implemented", 1310 (char *) NULL); 1311 return TCL_ERROR; 1312 1313 default: 1314 Tcl_SetResult(interp, "unknown method", TCL_STATIC); 1315 return TCL_ERROR; 1316 } 1317 1318 /*NOTREACHED*/ 1319} 1320 1321 1322/* 1323 *-------------------------------------------------------------- 1324 * 1325 * TclDomDoctypeCmd -- 1326 * 1327 * This procedure processes commands for DOM Doctype objects. 1328 * Refer to the user documentation to see what it does. 1329 * 1330 * Results: 1331 * Return TCL_OK if a method succeeded; TCL_ERROR 1332 * otherwise. 1333 * 1334 * Side effects: 1335 * Depends on the command methods. 1336 * 1337 *-------------------------------------------------------------- 1338 */ 1339 1340static int 1341TclDomDoctypeCmd( 1342 ClientData clientData, /* State data for this interp */ 1343 Tcl_Interp *interp, /* Current interpreter. */ 1344 int objc, /* Number of arguments. */ 1345 Tcl_Obj *CONST objv[]) /* The argument objects. */ 1346{ 1347 int methodIndex; 1348 TclDomInterpData *interpDataPtr; 1349 TclDomNode *nodePtr; 1350 TclDomDocTypeNode *docTypePtr; 1351 char *option; 1352 1353 static CONST84 char *methods[] = { 1354 "cget", "configure", NULL 1355 }; 1356 1357 enum methods { 1358 CGET, CONFIGURE 1359 }; 1360 1361 if (objc < 2) { 1362 Tcl_WrongNumArgs(interp, 1, objv, 1363 "method ?args...?"); 1364 return TCL_ERROR; 1365 } 1366 if (Tcl_GetIndexFromObj(interp, objv[1], methods, "method", 0, 1367 &methodIndex) != TCL_OK) { 1368 return TCL_ERROR; 1369 } 1370 1371 interpDataPtr = (TclDomInterpData *) clientData; 1372 1373 nodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[2]); 1374 if (nodePtr == NULL) { 1375 return TCL_ERROR; 1376 } 1377 1378 if (nodePtr->nodeType != DOCUMENT_TYPE_NODE) { 1379 Tcl_AppendResult(interp, "not a doctype type node", (char *) NULL); 1380 return TCL_ERROR; 1381 } 1382 docTypePtr = (TclDomDocTypeNode*) nodePtr; 1383 1384 switch ((enum methods) methodIndex) { 1385 case CGET: 1386 if (objc != 4) { 1387 Tcl_WrongNumArgs(interp, 2, objv, "token option"); 1388 return TCL_ERROR; 1389 } 1390 option = Tcl_GetStringFromObj(objv[3], NULL); 1391 if (strcmp(option, "-systemId") == 0) { 1392 if (docTypePtr->systemId) { 1393 Tcl_SetObjResult(interp, 1394 Tcl_NewStringObj(docTypePtr->systemId, -1)); 1395 } 1396 return TCL_OK; 1397 } else if (strcmp(option, "-nodeName") == 0) { 1398 if (docTypePtr->nodeName) { 1399 Tcl_SetObjResult(interp, 1400 Tcl_NewStringObj(docTypePtr->nodeName, -1)); 1401 } 1402 return TCL_OK; 1403 } else if (strcmp(option, "-publicId") == 0) { 1404 if (docTypePtr->publicId) { 1405 Tcl_SetObjResult(interp, 1406 Tcl_NewStringObj(docTypePtr->publicId, -1)); 1407 } 1408 return TCL_OK; 1409 } else if (strcmp(option, "-internalSubset") == 0) { 1410 if (docTypePtr->internalSubset) { 1411 Tcl_SetObjResult(interp, 1412 Tcl_NewStringObj(docTypePtr->internalSubset, -1)); 1413 } 1414 return TCL_OK; 1415 } else { 1416 Tcl_AppendResult(interp, "unknown option '", option, 1417 "', should be -internalSubset, -nodeName, -publicId, or -systemId", (char *) NULL); 1418 return TCL_ERROR; 1419 } 1420 1421 case CONFIGURE: 1422 Tcl_AppendResult(interp, 1423 "doctype configure method not implemented", (char *) NULL); 1424 return TCL_ERROR; 1425 default: 1426 Tcl_SetResult(interp, "unknown method", TCL_STATIC); 1427 return TCL_ERROR; 1428 } 1429 1430 /*NOTREACHED*/ 1431} 1432 1433 1434/* 1435 *-------------------------------------------------------------- 1436 * 1437 * TclDomDocumentCmd -- 1438 * 1439 * This procedure processes commands for DOM Document objects. 1440 * Refer to the user documentation to see what it does. 1441 * 1442 * Results: 1443 * Return TCL_OK if a method succeeded; TCL_ERROR 1444 * otherwise. 1445 * 1446 * Side effects: 1447 * Depends on the command methods. 1448 * 1449 *-------------------------------------------------------------- 1450 */ 1451 1452static int 1453TclDomDocumentCmd( 1454 ClientData clientData, /* State data for this interp */ 1455 Tcl_Interp *interp, /* Current interpreter. */ 1456 int objc, /* Number of arguments. */ 1457 Tcl_Obj *CONST objv[]) /* The argument objects. */ 1458{ 1459 int methodIndex, attributeIndex; 1460 TclDomInterpData *interpDataPtr; 1461 TclDomDocument *documentPtr; 1462 TclDomNode *subjectNodePtr; 1463 TclDomNode *importNodePtr; 1464 int deepFlag = 0; /* for import node */ 1465 TclDomNode *nodePtr; 1466 TclDomTextNode *textNodePtr; 1467 char *tagName, *text, *target; 1468 1469 static CONST84 char *methods[] = { 1470 "cget", "configure", 1471 "createElement", "createDocumentFragment", "createTextNode", 1472 "createComment", "createCDATASection", "createProcessingInstruction", 1473 "createAttribute", "createEntity", "createEntityReference", 1474 "createDocTypeDecl", "getElementsByTagName", 1475 "importNode", NULL 1476 }; 1477 1478 enum methods { 1479 CGET, CONFIGURE, 1480 CREATE_ELEMENT, CREATE_DOCUMENT_FRAGMENT, CREATE_TEXT_NODE, 1481 CREATE_COMMENT, CREATE_CDATA_SECTION, CREATE_PROCESSING_INSTRUCTION, 1482 CREATE_ATTRIBUTE, CREATE_ENTITY, CREATE_ENTITY_REFERENCE, 1483 CREATE_DOCTYPE_DECL, GET_ELEMENTS_BY_TAGNAME, 1484 IMPORT_NODE 1485 }; 1486 1487 static CONST84 char *attributes[] = { 1488 "-doctype", "-implementation", "-documentElement", NULL 1489 }; 1490 1491 enum attributes { 1492 DOCTYPE, IMPLEMENTATION, DOCUMENT_ELEMENT 1493 }; 1494 1495 if (objc < 3) { 1496 Tcl_WrongNumArgs(interp, 1, objv, "method token ..."); 1497 return TCL_ERROR; 1498 } 1499 1500 if (Tcl_GetIndexFromObj(interp, objv[1], methods, "method", 0, 1501 &methodIndex) != TCL_OK) { 1502 return TCL_ERROR; 1503 } 1504 1505 interpDataPtr = (TclDomInterpData *) clientData; 1506 1507 subjectNodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[2]); 1508 if (subjectNodePtr == NULL) { 1509 return TCL_ERROR; 1510 } 1511 documentPtr = subjectNodePtr->containingDocumentPtr; 1512 1513 switch ((enum methods) methodIndex) { 1514 case CONFIGURE: 1515 case CGET: 1516 if (Tcl_GetIndexFromObj(interp, objv[3], attributes, "attribute", 1517 0, &attributeIndex) != TCL_OK) { 1518 return TCL_ERROR; 1519 } 1520 if (methodIndex == CONFIGURE) { 1521 if (objc < 4 || objc > 5) { 1522 Tcl_WrongNumArgs(interp, 2, objv, 1523 "token option ?value?"); 1524 return TCL_ERROR; 1525 } 1526 if (objc == 5) { 1527 char *optionName = Tcl_GetStringFromObj(objv[3], NULL); 1528 Tcl_AppendResult(interp, "attribute \"", optionName, 1529 "\" is read-only", (char *) NULL); 1530 return TCL_ERROR; 1531 } 1532 } else { 1533 if (objc != 4) { 1534 Tcl_WrongNumArgs(interp, 2, objv, "token option"); 1535 return TCL_ERROR; 1536 } 1537 } 1538 if (attributeIndex == DOCTYPE) { 1539 return TclDomSetNodeResult(interp, interpDataPtr, 1540 TclDomGetDoctypeNode(documentPtr)); 1541 } else if (attributeIndex == IMPLEMENTATION) { 1542 Tcl_SetObjResult(interp, 1543 Tcl_NewStringObj("::dom::DOMImplementation", -1)); 1544 return TCL_OK; 1545 } else if (attributeIndex == DOCUMENT_ELEMENT) { 1546 return TclDomSetNodeResult(interp, interpDataPtr, 1547 TclDomGetDocumentElement(documentPtr)); 1548 } else { 1549 Tcl_AppendResult(interp, "unknown option", (char *) NULL); 1550 return TCL_ERROR; 1551 } 1552 1553 case CREATE_ELEMENT: 1554 if (objc != 4) { 1555 Tcl_WrongNumArgs(interp, 2, objv, "token type"); 1556 return TCL_ERROR; 1557 } 1558 tagName = Tcl_GetStringFromObj(objv[3], NULL); 1559 if (!TclDomIsName(tagName)) { 1560 Tcl_AppendResult(interp, INVALID_CHARACTER_ERR_TEXT, 1561 (char *) NULL); 1562 return TCL_ERROR; 1563 } 1564 nodePtr = TclDomCreateElement(interp, interpDataPtr, documentPtr, 1565 tagName); 1566 AddCreatedNode(interp, interpDataPtr, subjectNodePtr, nodePtr); 1567 return TclDomSetNodeResult(interp, interpDataPtr, nodePtr); 1568 1569 case CREATE_DOCUMENT_FRAGMENT: 1570 if (objc != 3) { 1571 Tcl_WrongNumArgs(interp, 2, objv, "token"); 1572 return TCL_ERROR; 1573 } 1574 nodePtr = TclDomCreateDocumentFragment(interp, interpDataPtr, 1575 documentPtr); 1576 return TclDomSetNodeResult(interp, interpDataPtr, nodePtr); 1577 1578 case CREATE_TEXT_NODE: 1579 if (objc != 4) { 1580 Tcl_WrongNumArgs(interp, 2, objv, "token text"); 1581 return TCL_ERROR; 1582 } 1583 text = Tcl_GetStringFromObj(objv[3], NULL); 1584 textNodePtr = TclDomCreateTextNode(interp, interpDataPtr, 1585 documentPtr, text); 1586 AddCreatedNode(interp, interpDataPtr, subjectNodePtr, 1587 (TclDomNode*)textNodePtr); 1588 return TclDomSetNodeResult(interp, interpDataPtr, 1589 (TclDomNode *) textNodePtr); 1590 1591 case CREATE_COMMENT: 1592 if (objc != 4) { 1593 Tcl_WrongNumArgs(interp, 2, objv, "token data"); 1594 return TCL_ERROR; 1595 } 1596 text = Tcl_GetStringFromObj(objv[3], NULL); 1597 nodePtr = TclDomCreateCommentNode(interp, interpDataPtr, 1598 documentPtr, text); 1599 AddCreatedNode(interp, interpDataPtr, subjectNodePtr, nodePtr); 1600 return TclDomSetNodeResult(interp, interpDataPtr, nodePtr); 1601 1602 case CREATE_CDATA_SECTION: 1603 if (objc != 4) { 1604 Tcl_WrongNumArgs(interp, 2, objv, "token text"); 1605 return TCL_ERROR; 1606 } 1607 text = Tcl_GetStringFromObj(objv[3], NULL); 1608 nodePtr = TclDomCreateCDATANode(interp, interpDataPtr, 1609 documentPtr, text); 1610 AddCreatedNode(interp, interpDataPtr, subjectNodePtr, nodePtr); 1611 return TclDomSetNodeResult(interp, interpDataPtr, nodePtr); 1612 1613 case CREATE_PROCESSING_INSTRUCTION: 1614 if (objc != 5) { 1615 Tcl_WrongNumArgs(interp, 2, objv, "token target data"); 1616 return TCL_ERROR; 1617 } 1618 target = Tcl_GetStringFromObj(objv[3], NULL); 1619 text = Tcl_GetStringFromObj(objv[4], NULL); 1620 nodePtr = TclDomCreateProcessingInstructionNode(interp, 1621 interpDataPtr, documentPtr, 1622 target, text); 1623 AddCreatedNode(interp, interpDataPtr, subjectNodePtr, nodePtr); 1624 return TclDomSetNodeResult(interp, interpDataPtr, nodePtr); 1625 1626 case CREATE_ATTRIBUTE: 1627 if (objc != 4) { 1628 Tcl_WrongNumArgs(interp, 2, objv, "token name"); 1629 return TCL_ERROR; 1630 } 1631 return TCL_ERROR; 1632 1633 case CREATE_ENTITY: 1634 if (objc != 3) { 1635 Tcl_WrongNumArgs(interp, 2, objv, "token"); 1636 return TCL_ERROR; 1637 } 1638 Tcl_AppendResult(interp, 1639 "document createEntity method not implemented", 1640 (char *) NULL); 1641 return TCL_ERROR; 1642 1643 case CREATE_ENTITY_REFERENCE: 1644 if (objc != 3) { 1645 Tcl_WrongNumArgs(interp, 2, objv, "token"); 1646 return TCL_ERROR; 1647 } 1648 Tcl_AppendResult(interp, 1649 "document createEntityReference method not implemented", 1650 (char *) NULL); 1651 return TCL_ERROR; 1652 1653 case CREATE_DOCTYPE_DECL: 1654 if (objc != 8) { 1655 Tcl_WrongNumArgs(interp, 2, objv, 1656 "token name external id dtd entities notations"); 1657 return TCL_ERROR; 1658 } 1659 Tcl_AppendResult(interp, 1660 "document createDocType method not implemented", 1661 (char *) NULL); 1662 return TCL_ERROR; 1663 1664 case GET_ELEMENTS_BY_TAGNAME: 1665 if (objc != 4) { 1666 Tcl_WrongNumArgs(interp, 2, objv, "token name"); 1667 return TCL_ERROR; 1668 } 1669 tagName = Tcl_GetStringFromObj(objv[3], NULL); 1670 return TclDomGetElementsByTagname(interp, interpDataPtr, tagName, 1671 documentPtr->selfPtr); 1672 1673 case IMPORT_NODE: 1674 if (objc != 4 && objc != 6) { 1675 Tcl_WrongNumArgs(interp, 2, objv, 1676 "token token ?-deep deepFlag?"); 1677 return TCL_ERROR; 1678 } 1679 if (objc == 6) { 1680 char *option; 1681 int result; 1682 option = Tcl_GetStringFromObj(objv[4], NULL); 1683 if (strcmp(option, "-deep")) { 1684 Tcl_AppendResult(interp, 1685 "invalid option, should be \"-deep\""); 1686 return TCL_ERROR; 1687 } 1688 result = Tcl_GetBooleanFromObj(interp, objv[5], &deepFlag); 1689 if (result != TCL_OK) { 1690 return result; 1691 } 1692 } 1693 importNodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, 1694 objv[3]); 1695 if (importNodePtr == NULL) { 1696 return TCL_ERROR; 1697 } 1698 nodePtr = TclDomImportNode(interp, interpDataPtr, 1699 documentPtr, importNodePtr, deepFlag); 1700 if (nodePtr) { 1701 return TclDomSetNodeResult(interp, interpDataPtr, nodePtr); 1702 } else { 1703 return TCL_ERROR; 1704 } 1705 1706 default: 1707 Tcl_SetResult(interp, "unknown method", TCL_STATIC); 1708 return TCL_ERROR; 1709 } 1710 1711 /*NOTREACHED*/ 1712} 1713 1714 1715/* 1716 *-------------------------------------------------------------- 1717 * 1718 * TclDomDocumentTraversalCmd -- 1719 * 1720 * This procedure implements the DOM DocumentTraversal 1721 * interface. 1722 * Refer to the user documentation to see what it does. 1723 * 1724 * Results: 1725 * Return TCL_OK if a method succeeded; TCL_ERROR 1726 * otherwise. 1727 * 1728 * Side effects: 1729 * Depends on the command methods. 1730 * 1731 *-------------------------------------------------------------- 1732 */ 1733 1734static int 1735TclDomDocumentTraversalCmd( 1736 ClientData clientData, /* State data for this interp */ 1737 Tcl_Interp *interp, /* Current interpreter. */ 1738 int objc, /* Number of arguments. */ 1739 Tcl_Obj *CONST objv[]) /* The argument objects. */ 1740{ 1741 int methodIndex; 1742 TclDomInterpData *interpDataPtr; 1743 int i, j, numberNodeTypes; 1744 char *option, *nodeName; 1745 TclDomNode *nodePtr; 1746 int expandEntityReferences; 1747 Tcl_Obj *listObjPtr, *nodeNameObjPtr; 1748 unsigned int whatToShow = SHOW_ALL; 1749 unsigned int nodeType; 1750 Tcl_Obj *filterObjPtr = NULL; 1751 1752 static CONST84 char *methods[] = { 1753 "createNodeIterator", "createTreeWalker", "destroy", NULL 1754 }; 1755 1756 enum methods { 1757 CREATE_NODE_ITERATOR, CREATE_TREE_WALKER, DESTROY 1758 }; 1759 1760 1761 if (objc < 3) { 1762 Tcl_WrongNumArgs(interp, 1, objv, "method token ..."); 1763 return TCL_ERROR; 1764 } 1765 1766 if (Tcl_GetIndexFromObj(interp, objv[1], methods, "method", 0, 1767 &methodIndex) != TCL_OK) { 1768 return TCL_ERROR; 1769 } 1770 1771 if (methodIndex == DESTROY) { 1772 return TclDomDestroyTraversalObject(clientData, interp, objc, objv); 1773 } 1774 1775 if (objc > 3 && ((objc & 0x1) == 0)) { 1776 Tcl_AppendResult(interp, "missing option value", (char *) NULL); 1777 return TCL_ERROR; 1778 } 1779 1780 for (i = 3; i < objc; i++) { 1781 option = Tcl_GetStringFromObj(objv[i], NULL); 1782 if (strcmp(option, "-show") == 0) { 1783 i++; 1784 listObjPtr = objv[i]; 1785 if (Tcl_ListObjLength(interp, listObjPtr, &numberNodeTypes) 1786 != TCL_OK) { 1787 Tcl_AppendResult(interp, "invalid list of node types to show", 1788 (char *) NULL); 1789 return TCL_ERROR; 1790 } 1791 whatToShow = 0; 1792 for (j = 0; j < numberNodeTypes; j++) { 1793 if (Tcl_ListObjIndex(interp, listObjPtr, j, &nodeNameObjPtr) 1794 != TCL_OK) { 1795 Tcl_AppendResult(interp, 1796 "invalid list of node types to show", 1797 (char *) NULL); 1798 return TCL_ERROR; 1799 } 1800 nodeName = Tcl_GetStringFromObj(nodeNameObjPtr, NULL); 1801 if (*nodeName == '-') { 1802 if (TclDomGetTypeMaskFromName(interp, nodeName+1, 1803 &nodeType) != TCL_OK) { 1804 return TCL_ERROR; 1805 } 1806 whatToShow &= (~nodeType); 1807 } else if (*nodeName == '+') { 1808 if (TclDomGetTypeMaskFromName(interp, nodeName+1, 1809 &nodeType) != TCL_OK) { 1810 return TCL_ERROR; 1811 } 1812 whatToShow |= nodeType; 1813 } else { 1814 if (TclDomGetTypeMaskFromName(interp, nodeName, 1815 &nodeType) != TCL_OK) { 1816 return TCL_ERROR; 1817 } 1818 whatToShow |= nodeType; 1819 } 1820 } 1821 } else if (strcmp(option, "-filter") == 0) { 1822 i++; 1823 filterObjPtr = objv[i]; 1824 } else if (strcmp(option, "-expandEntities") == 0) { 1825 i++; 1826 if (Tcl_GetBooleanFromObj(interp, objv[i], 1827 &expandEntityReferences) != TCL_OK) { 1828 return TCL_ERROR; 1829 } 1830 } else { 1831 Tcl_AppendResult(interp, "invalid option", (char *) NULL); 1832 return TCL_ERROR; 1833 } 1834 } 1835 1836 interpDataPtr = (TclDomInterpData *) clientData; 1837 1838 nodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[2]); 1839 if (nodePtr == NULL) { 1840 return TCL_ERROR; 1841 } 1842 1843 switch ((enum methods) methodIndex) { 1844 case CREATE_NODE_ITERATOR: 1845 return TclDomCreateNodeIterator(interp, interpDataPtr, nodePtr, 1846 whatToShow, filterObjPtr, expandEntityReferences); 1847 1848 case CREATE_TREE_WALKER: 1849 return TclDomCreateTreeWalker(interp, interpDataPtr, nodePtr, 1850 whatToShow, filterObjPtr, expandEntityReferences); 1851 1852 default: 1853 Tcl_SetResult(interp, "unknown method", TCL_STATIC); 1854 return TCL_ERROR; 1855 } 1856 1857 /*NOTREACHED*/ 1858} 1859 1860 1861/* 1862 *-------------------------------------------------------------- 1863 * 1864 * TclDomNodeIteratorCmd -- 1865 * 1866 * This procedure processes commands for DOM NodeIterator 1867 * objects. 1868 * Refer to the user documentation to see what it does. 1869 * 1870 * Results: 1871 * Return TCL_OK if a method succeeded; TCL_ERROR 1872 * otherwise. 1873 * 1874 * Side effects: 1875 * Depends on the command methods. 1876 * 1877 *-------------------------------------------------------------- 1878 */ 1879 1880static int 1881TclDomNodeIteratorCmd( 1882 ClientData clientData, /* State data for this interp */ 1883 Tcl_Interp *interp, /* Current interpreter. */ 1884 int objc, /* Number of arguments. */ 1885 Tcl_Obj *CONST objv[]) /* The argument objects. */ 1886{ 1887 int methodIndex; 1888 TclDomInterpData *interpDataPtr; 1889 TclDomNodeIterator *nodeIteratorPtr; 1890 int result; 1891 1892 static CONST84 char *methods[] = { 1893 "cget", "configure", "previousNode", "nextNode", NULL 1894 }; 1895 1896 enum methods { 1897 CGET, CONFIGURE, PREVIOUS_NODE, NEXT_NODE, 1898 }; 1899 1900 if (objc < 2) { 1901 Tcl_WrongNumArgs(interp, 1, objv, "method handle ?arg ...?"); 1902 return TCL_ERROR; 1903 } 1904 1905 if (Tcl_GetIndexFromObj(interp, objv[1], methods, "method", 0, 1906 &methodIndex) != TCL_OK) { 1907 return TCL_ERROR; 1908 } 1909 1910 interpDataPtr = (TclDomInterpData *) clientData; 1911 1912 nodeIteratorPtr = TclDomGetNodeIteratorFromToken(interp, interpDataPtr, 1913 objv[2]); 1914 if (nodeIteratorPtr == NULL) { 1915 return TCL_ERROR; 1916 } 1917 1918 if (methodIndex > CONFIGURE) { 1919 if (objc != 3) { 1920 Tcl_WrongNumArgs(interp, 1, objv, "method handle"); 1921 return TCL_ERROR; 1922 } 1923 } 1924 1925 Tcl_Preserve((ClientData) nodeIteratorPtr); 1926 1927 switch ((enum methods) methodIndex) { 1928 case CGET: 1929 result = TclDomIteratorCGetCmd(clientData, interp, objc, objv); 1930 break; 1931 1932 case CONFIGURE: 1933 if (objc == 5) { 1934 Tcl_SetResult(interp, NO_MODIFICATION_ALLOWED_ERR_TEXT, 1935 TCL_STATIC); 1936 return TCL_ERROR; 1937 } 1938 result = TclDomIteratorCGetCmd(clientData, interp, objc, objv); 1939 break; 1940 1941 case PREVIOUS_NODE: 1942 result = TclDomGetPreviousNodeFromIterator(interp, interpDataPtr, 1943 nodeIteratorPtr); 1944 break; 1945 1946 case NEXT_NODE: 1947 result = TclDomGetNextNodeFromIterator(interp, interpDataPtr, 1948 nodeIteratorPtr); 1949 break; 1950 1951 default: 1952 Tcl_SetResult(interp, "unknown method", TCL_STATIC); 1953 result = TCL_ERROR; 1954 } 1955 1956 Tcl_Release((ClientData) nodeIteratorPtr); 1957 1958 return result; 1959} 1960 1961 1962/* 1963 *-------------------------------------------------------------- 1964 * 1965 * TclDomTreeWalkerCmd -- 1966 * 1967 * This procedure processes commands for DOM TreeWalker 1968 * objects. 1969 * Refer to the user documentation to see what it does. 1970 * 1971 * Results: 1972 * Return TCL_OK if a method succeeded; TCL_ERROR 1973 * otherwise. 1974 * 1975 * Side effects: 1976 * Depends on the command methods. 1977 * 1978 *-------------------------------------------------------------- 1979 */ 1980 1981static int 1982TclDomTreeWalkerCmd( 1983 ClientData clientData, /* State data for this interp */ 1984 Tcl_Interp *interp, /* Current interpreter. */ 1985 int objc, /* Number of arguments. */ 1986 Tcl_Obj *CONST objv[]) /* The argument objects. */ 1987{ 1988 int methodIndex; 1989 TclDomInterpData *interpDataPtr; 1990 TclDomTreeWalker *treeWalkerPtr; 1991 int result; 1992 1993 static CONST84 char *methods[] = { 1994 "cget", "configure", "parentNode", "firstChild", "lastChild", 1995 "previousSibling", "nextSibling", "previousNode", "nextNode", 1996 NULL 1997 }; 1998 1999 enum methods { 2000 CGET, CONFIGURE, PARENT_NODE, FIRST_CHILD, LAST_CHILD, 2001 PREVIOUS_SIBLING, NEXT_SIBLING, PREVIOUS_NODE, NEXT_NODE 2002 }; 2003 2004 if (objc < 2) { 2005 Tcl_WrongNumArgs(interp, 1, objv, "method handle ?arg ...?"); 2006 return TCL_ERROR; 2007 } 2008 2009 if (Tcl_GetIndexFromObj(interp, objv[1], methods, "method", 0, 2010 &methodIndex) != TCL_OK) { 2011 return TCL_ERROR; 2012 } 2013 2014 if (methodIndex > CONFIGURE) { 2015 if (objc != 3) { 2016 Tcl_WrongNumArgs(interp, 1, objv, "method handle"); 2017 return TCL_ERROR; 2018 } 2019 } 2020 2021 interpDataPtr = (TclDomInterpData *) clientData; 2022 2023 treeWalkerPtr = TclDomGetTreeWalkerFromToken(interp, interpDataPtr, 2024 objv[2]); 2025 if (treeWalkerPtr == NULL) { 2026 return TCL_ERROR; 2027 } 2028 2029 Tcl_Preserve((ClientData) treeWalkerPtr); 2030 2031 switch ((enum methods) methodIndex) { 2032 case CGET: 2033 result = TclDomTreeWalkerCGetCmd(clientData, interp, objc, objv); 2034 break; 2035 2036 case CONFIGURE: 2037 result = TclDomTreeWalkerConfigureCmd(clientData, interp, objc, 2038 objv); 2039 break; 2040 2041 case PARENT_NODE: 2042 result = TclDomGetParentNodeFromTreeWalker(interp, interpDataPtr, 2043 treeWalkerPtr); 2044 break; 2045 2046 case FIRST_CHILD: 2047 return TclDomGetFirstChildFromTreeWalker(interp, interpDataPtr, 2048 treeWalkerPtr); 2049 2050 case LAST_CHILD: 2051 result = TclDomGetLastChildFromTreeWalker(interp, interpDataPtr, 2052 treeWalkerPtr); 2053 break; 2054 2055 case PREVIOUS_SIBLING: 2056 result = TclDomGetPreviousSiblingFromTreeWalker(interp, 2057 interpDataPtr, treeWalkerPtr); 2058 break; 2059 2060 case NEXT_SIBLING: 2061 result = TclDomGetNextSiblingFromTreeWalker(interp, interpDataPtr, 2062 treeWalkerPtr); 2063 break; 2064 2065 case PREVIOUS_NODE: 2066 result = TclDomGetPreviousNodeFromTreeWalker(interp, interpDataPtr, 2067 treeWalkerPtr); 2068 break; 2069 2070 case NEXT_NODE: 2071 result = TclDomGetNextNodeFromTreeWalker(interp, interpDataPtr, 2072 treeWalkerPtr); 2073 break; 2074 2075 default: 2076 Tcl_SetResult(interp, "unknown method", TCL_STATIC); 2077 result = TCL_ERROR; 2078 break; 2079 } 2080 2081 Tcl_Release((ClientData) treeWalkerPtr); 2082 2083 return result; 2084} 2085 2086 2087/* 2088 *-------------------------------------------------------------- 2089 * 2090 * TclDomIteratorCGetCmd -- 2091 * 2092 * This procedure handles the cget method for a 2093 * TclDom node command. 2094 * 2095 * Results: 2096 * Return TCL_OK if a valid attribute is requested; 2097 * otherwise return TCL_ERROR. 2098 * 2099 * Side effects: 2100 * None. 2101 * 2102 *-------------------------------------------------------------- 2103 */ 2104 2105static int 2106TclDomIteratorCGetCmd( 2107 ClientData clientData, /* State data for this interp */ 2108 Tcl_Interp *interp, /* Current interpreter. */ 2109 int objc, /* Number of arguments. */ 2110 Tcl_Obj *CONST objv[]) /* The argument objects. */ 2111{ 2112 int optionIndex; 2113 TclDomInterpData *interpDataPtr; 2114 TclDomNodeIterator *nodeIteratorPtr; 2115 char *nodeName; 2116 int i; 2117 2118 static CONST84 char *iteratorOptions[] = {"-show", "-filter", 2119 "-expandEntities", NULL 2120 }; 2121 2122 enum iteratorOptions { 2123 WHAT_TO_SHOW, NODE_FILTER, EXPAND_ENTITY_REFERENCES 2124 }; 2125 2126 if (objc != 4) { 2127 Tcl_WrongNumArgs(interp, 2, objv, "iterator option"); 2128 return TCL_ERROR; 2129 } 2130 2131 if (Tcl_GetIndexFromObj(interp, objv[3], iteratorOptions, "option", 0, 2132 &optionIndex) != TCL_OK) { 2133 return TCL_ERROR; 2134 } 2135 2136 interpDataPtr = (TclDomInterpData *) clientData; 2137 2138 nodeIteratorPtr = TclDomGetNodeIteratorFromToken(interp, interpDataPtr, 2139 objv[2]); 2140 if (nodeIteratorPtr == NULL) { 2141 return TCL_ERROR; 2142 } 2143 2144 switch ((enum iteratorOptions) optionIndex) { 2145 case NODE_FILTER: 2146 if (nodeIteratorPtr->filterPtr->filterCmdPtr) { 2147 Tcl_SetObjResult(interp, 2148 nodeIteratorPtr->filterPtr->filterCmdPtr); 2149 } 2150 return TCL_OK; 2151 2152 case EXPAND_ENTITY_REFERENCES: 2153 Tcl_SetObjResult(interp, 2154 Tcl_NewBooleanObj(nodeIteratorPtr->expandEntityReferences)); 2155 return TCL_OK; 2156 2157 case WHAT_TO_SHOW: 2158 /* 2159 * convert bitmap to list of element types 2160 */ 2161 for (i = 1; i < 13; i++) { 2162 if (nodeIteratorPtr->whatToShow & (1 << (i-1))) { 2163 TclDomGetNameFromEnum(i, &nodeName); 2164 Tcl_AppendElement(interp, nodeName); 2165 } 2166 } 2167 return TCL_OK; 2168 2169 default: 2170 Tcl_SetResult(interp, "unknown option", TCL_STATIC); 2171 return TCL_ERROR; 2172 } 2173 /*NOTREACHED*/ 2174} 2175 2176 2177/* 2178 *-------------------------------------------------------------- 2179 * 2180 * TclDomTreeWalkerCGetCmd -- 2181 * 2182 * This procedure handles the cget method for a 2183 * TclDom node command. 2184 * 2185 * Results: 2186 * Return TCL_OK if a valid attribute is requested; 2187 * otherwise return TCL_ERROR. 2188 * 2189 * Side effects: 2190 * None. 2191 * 2192 *-------------------------------------------------------------- 2193 */ 2194 2195static int 2196TclDomTreeWalkerCGetCmd( 2197 ClientData clientData, /* State data for this interp */ 2198 Tcl_Interp *interp, /* Current interpreter. */ 2199 int objc, /* Number of arguments. */ 2200 Tcl_Obj *CONST objv[]) /* The argument objects. */ 2201{ 2202 int optionIndex; 2203 TclDomInterpData *interpDataPtr; 2204 TclDomTreeWalker *treeWalkerPtr; 2205 char *nodeName; 2206 int i; 2207 2208 if (objc != 4) { 2209 Tcl_WrongNumArgs(interp, 2, objv, "treewalker option"); 2210 return TCL_ERROR; 2211 } 2212 2213 if (Tcl_GetIndexFromObj(interp, objv[3], treeWalkerOptions, "option", 0, 2214 &optionIndex) != TCL_OK) { 2215 return TCL_ERROR; 2216 } 2217 2218 interpDataPtr = (TclDomInterpData *) clientData; 2219 2220 treeWalkerPtr = TclDomGetTreeWalkerFromToken(interp, interpDataPtr, 2221 objv[2]); 2222 if (treeWalkerPtr == NULL) { 2223 return TCL_ERROR; 2224 } 2225 2226 switch ((enum treeWalkerOptions) optionIndex) { 2227 case NODE_FILTER: 2228 if (treeWalkerPtr->filterPtr->filterCmdPtr) { 2229 Tcl_SetObjResult(interp, 2230 treeWalkerPtr->filterPtr->filterCmdPtr); 2231 } 2232 return TCL_OK; 2233 2234 case EXPAND_ENTITY_REFERENCES: 2235 Tcl_SetObjResult(interp, 2236 Tcl_NewBooleanObj(treeWalkerPtr->expandEntityReferences)); 2237 return TCL_OK; 2238 2239 case WHAT_TO_SHOW: 2240 /* 2241 * convert bitmap to list of element types 2242 */ 2243 for (i = 1; i < 13; i++) { /* %%% <<== 13 */ 2244 if (treeWalkerPtr->whatToShow & (1 << (i-1))) { 2245 TclDomGetNameFromEnum(i, &nodeName); 2246 Tcl_AppendElement(interp, nodeName); 2247 } 2248 } 2249 return TCL_OK; 2250 2251 case CURRENT_NODE: 2252 if (treeWalkerPtr->currentNodePtr != NULL) { 2253 return TclDomSetNodeResult(interp, interpDataPtr, 2254 treeWalkerPtr->currentNodePtr); 2255 } else { 2256 return TCL_OK; 2257 } 2258 2259 default: 2260 Tcl_SetResult(interp, "unknown option", TCL_STATIC); 2261 return TCL_ERROR; 2262 } 2263 /*NOTREACHED*/ 2264} 2265 2266 2267/* 2268 *-------------------------------------------------------------- 2269 * 2270 * TclDomTreeWalkerConfigureCmd -- 2271 * 2272 * This procedure handles the configure method for a 2273 * TclDom node command. 2274 * 2275 * Results: 2276 * Return TCL_OK if a valid attribute is requested; 2277 * otherwise return TCL_ERROR. 2278 * 2279 * Side effects: 2280 * None. 2281 * 2282 *-------------------------------------------------------------- 2283 */ 2284 2285static int 2286TclDomTreeWalkerConfigureCmd( 2287 ClientData clientData, /* State data for this interp */ 2288 Tcl_Interp *interp, /* Current interpreter. */ 2289 int objc, /* Number of arguments. */ 2290 Tcl_Obj *CONST objv[]) /* The argument objects. */ 2291{ 2292 int optionIndex; 2293 TclDomInterpData *interpDataPtr; 2294 TclDomTreeWalker *treeWalkerPtr; 2295 TclDomNode *nodePtr; 2296 2297 static CONST84 char *writableNodeOptions[] = { 2298 "-currentNode", 2299 NULL 2300 }; 2301 2302 enum writableNodeOptions { 2303 CURRENT_NODE, 2304 }; 2305 2306 if (objc != 5) { 2307 return TclDomTreeWalkerCGetCmd(clientData, interp, objc, objv); 2308 } 2309 2310 if (Tcl_GetIndexFromObj(interp, objv[3], treeWalkerOptions, "option", 0, 2311 &optionIndex) != TCL_OK) { 2312 return TCL_ERROR; 2313 } 2314 2315 if (Tcl_GetIndexFromObj(interp, objv[3], writableNodeOptions, 2316 "writable option", 0, &optionIndex) != TCL_OK) { 2317 Tcl_SetResult(interp, NO_MODIFICATION_ALLOWED_ERR_TEXT, TCL_STATIC); 2318 return TCL_ERROR; 2319 } 2320 2321 interpDataPtr = (TclDomInterpData *) clientData; 2322 2323 treeWalkerPtr = TclDomGetTreeWalkerFromToken(interp, interpDataPtr, 2324 objv[2]); 2325 if (treeWalkerPtr == NULL) { 2326 return TCL_ERROR; 2327 } 2328 2329 switch ((enum nodeOptions) optionIndex) { 2330 case CURRENT_NODE: 2331 nodePtr = TclDomGetNodeFromToken(interp, interpDataPtr, objv[4]); 2332 if (nodePtr == NULL) { 2333 return TCL_ERROR; 2334 } 2335 treeWalkerPtr->currentNodePtr = nodePtr; 2336 return TCL_OK; 2337 2338 default: 2339 Tcl_SetResult(interp, "unknown option", TCL_STATIC); 2340 return TCL_ERROR; 2341 } 2342 /*NOTREACHED*/ 2343} 2344