Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tdomNodeType Excluding Merge-Ins
This is equivalent to a diff from 12ce2296e4 to 7148e12240
|
2014-01-10
| ||
| 01:11 | Improved speed of operations in node token mode notable. This is achieved by introducing a Tcl_Obj type tdomNodeType. Tcl_Objs of type tdomNodeType are created without string representation, saving malloc costs until string representation is needed (which typically isn't needed). Additionally, DOM node identification from token is faster with tdomNodeType Tcl_Objs. check-in: 8f70a39a92 user: rolf tags: trunk | |
|
2014-01-01
| ||
| 22:08 | Enhanced bench suite. Closed-Leaf check-in: 7148e12240 user: rolf tags: tdomNodeType | |
| 04:03 | Made tcldom_returnNodeOjb static. check-in: 40b95f4a60 user: rolf tags: tdomNodeType | |
|
2013-12-29
| ||
| 01:29 | Update from trunk. check-in: 6b6f0a48b7 user: rolf tags: tdomNodeType | |
| 01:25 | Minor test suite correction and addition. check-in: 12ce2296e4 user: rolf tags: trunk | |
|
2013-12-27
| ||
| 21:56 | More #ifdefery, to handle tip 388 changes to tcl.h. check-in: ebe56a3001 user: rolf tags: trunk | |
Changes to generic/tcldom.c.
355 355 \---------------------------------------------------------------------------*/ 356 356 357 357 typedef struct XsltMsgCBInfo { 358 358 Tcl_Interp * interp; 359 359 Tcl_Obj * msgcmd; 360 360 } XsltMsgCBInfo; 361 361 362 + 363 +static void UpdateStringOfTdomNode(Tcl_Obj *objPtr); 364 +static int SetTdomNodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); 365 + 366 +const Tcl_ObjType tdomNodeType = { 367 + "tdom-node", 368 + NULL, 369 + NULL, 370 + UpdateStringOfTdomNode, 371 + SetTdomNodeFromAny 372 +}; 373 + 362 374 /*---------------------------------------------------------------------------- 363 375 | Prototypes for procedures defined later in this file: 364 376 | 365 377 \---------------------------------------------------------------------------*/ 366 378 367 379 static Tcl_VarTraceProc tcldom_docTrace; 368 -static Tcl_VarTraceProc tcldom_nodeTrace; 369 380 370 381 static Tcl_CmdDeleteProc tcldom_docCmdDeleteProc; 371 -static Tcl_CmdDeleteProc tcldom_nodeCmdDeleteProc; 372 382 373 383 #ifdef TCL_THREADS 374 384 375 385 static int tcldom_EvalLocked(Tcl_Interp* interp, Tcl_Obj** objv, 376 386 domDocument* doc, int flag); 377 387 378 388 static int tcldom_RegisterDocShared(domDocument* doc); ................................................................................ 481 491 } 482 492 483 493 tcldom_deleteDoc(dinfo->interp, doc); 484 494 485 495 FREE((void*)dinfo); 486 496 } 487 497 488 - 489 -/*---------------------------------------------------------------------------- 490 -| tcldom_nodeCmdDeleteProc 491 -| 492 -\---------------------------------------------------------------------------*/ 493 -static 494 -void tcldom_nodeCmdDeleteProc ( 495 - ClientData clientData 496 -) 497 -{ 498 - domDeleteInfo *dinfo = (domDeleteInfo *)clientData; 499 - char *var = dinfo->traceVarName; 500 - 501 - DBG(fprintf (stderr, "--> tcldom_nodeCmdDeleteProc node %p\n", 502 - dinfo->node)); 503 - 504 - if (var) { 505 - DBG(fprintf(stderr, "--> tcldom_nodeCmdDeleteProc calls " 506 - "Tcl_UntraceVar for \"%s\"\n", var)); 507 - Tcl_UntraceVar(dinfo->interp, var, 508 - TCL_TRACE_WRITES|TCL_TRACE_UNSETS, 509 - tcldom_nodeTrace, clientData); 510 - FREE(var); 511 - dinfo->traceVarName = NULL; 512 - } 513 - FREE((void*)dinfo); 514 -} 515 - 516 - 517 498 /*---------------------------------------------------------------------------- 518 499 | tcldom_docTrace 519 500 | 520 501 \---------------------------------------------------------------------------*/ 521 502 static 522 503 char * tcldom_docTrace ( 523 504 ClientData clientData, ................................................................................ 544 525 DBG(fprintf(stderr, "--> tcldom_docTrace delete doc %p\n", doc)); 545 526 Tcl_DeleteCommand(interp, objCmdName); 546 527 } 547 528 548 529 return NULL; 549 530 } 550 531 551 - 552 -/*---------------------------------------------------------------------------- 553 -| tcldom_nodeTrace 554 -| 555 -\---------------------------------------------------------------------------*/ 556 -static 557 -char * tcldom_nodeTrace ( 558 - ClientData clientData, 559 - Tcl_Interp *interp, 560 - CONST84 char *name1, 561 - CONST84 char *name2, 562 - int flags 563 -) 564 -{ 565 - domDeleteInfo *dinfo = (domDeleteInfo*)clientData; 566 - domNode *node = dinfo->node; 567 - char objCmdName[80]; 568 - 569 - DBG(fprintf(stderr, "--> tcldom_nodeTrace %x %p\n", flags, node)); 570 - 571 - if (flags & TCL_INTERP_DESTROYED) { 572 - return NULL; 573 - } 574 - if (flags & TCL_TRACE_WRITES) { 575 - return "var is read-only"; 576 - } 577 - if (flags & TCL_TRACE_UNSETS) { 578 - NODE_CMD(objCmdName, node); 579 - DBG(fprintf(stderr, "--> tcldom_nodeTrace delete node %p\n", node)); 580 - Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES | TCL_TRACE_UNSETS, 581 - tcldom_nodeTrace, clientData); 582 - Tcl_DeleteCommand(interp, objCmdName); 583 - node->nodeFlags &= ~VISIBLE_IN_TCL; 584 - } 585 - 586 - return NULL; 587 -} 588 - 532 +/*---------------------------------------------------------------------------- 533 +| UpdateStringOfTdomNode 534 +| 535 +\---------------------------------------------------------------------------*/ 536 +static void 537 +UpdateStringOfTdomNode( 538 + Tcl_Obj *objPtr) 539 +{ 540 + char nodeName[80]; 541 + int len; 542 + 543 + NODE_CMD(nodeName, objPtr->internalRep.otherValuePtr); 544 + len = strlen(nodeName); 545 + objPtr->bytes = (ckalloc((unsigned char) len+1)); 546 + memcpy(objPtr->bytes, nodeName, len+1); 547 + objPtr->length = len; 548 +} 549 + 550 +/*---------------------------------------------------------------------------- 551 +| SetTdomNodeFromAny 552 +| 553 +\---------------------------------------------------------------------------*/ 554 +static int 555 +SetTdomNodeFromAny( 556 + Tcl_Interp *interp, /* Tcl interpreter or NULL */ 557 + Tcl_Obj *objPtr) /* Pointer to the object to parse */ 558 +{ 559 + Tcl_CmdInfo cmdInfo; 560 + domNode *node = NULL; 561 + char *nodeName; 562 + 563 + if (objPtr->typePtr == &tdomNodeType) { 564 + return TCL_OK; 565 + } 566 + 567 + nodeName = Tcl_GetString(objPtr); 568 + if (strncmp(nodeName, "domNode", 7)) { 569 + if (interp) { 570 + SetResult("parameter not a domNode!"); 571 + return TCL_ERROR; 572 + } 573 + } 574 + if (sscanf(&nodeName[7], "%p", &node) != 1) { 575 + if (!Tcl_GetCommandInfo(interp, nodeName, &cmdInfo)) { 576 + if (interp) { 577 + SetResult("parameter not a domNode!"); 578 + return TCL_ERROR; 579 + } 580 + } 581 + if ( (cmdInfo.isNativeObjectProc == 0) 582 + || (cmdInfo.objProc != (Tcl_ObjCmdProc*)tcldom_NodeObjCmd)) { 583 + if (interp) { 584 + SetResult("parameter not a domNode object command"); 585 + return TCL_ERROR; 586 + } 587 + } 588 + node = (domNode*)cmdInfo.objClientData; 589 + } 590 + if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc) { 591 + objPtr->typePtr->freeIntRepProc(objPtr); 592 + } 593 + objPtr->internalRep.otherValuePtr = node; 594 + objPtr->typePtr = &tdomNodeType; 595 + 596 + return TCL_OK; 597 +} 589 598 590 599 /*---------------------------------------------------------------------------- 591 600 | tcldom_createNodeObj 592 601 | 593 602 \---------------------------------------------------------------------------*/ 594 603 void tcldom_createNodeObj ( 595 604 Tcl_Interp * interp, ................................................................................ 609 618 (ClientData) node, 610 619 (Tcl_CmdDeleteProc*)NULL); 611 620 node->nodeFlags |= VISIBLE_IN_TCL; 612 621 } 613 622 } 614 623 615 624 /*---------------------------------------------------------------------------- 616 -| tcldom_returnNodeObj 625 +| tcldom_setInterpAndReturnVar 617 626 | 618 627 \---------------------------------------------------------------------------*/ 619 628 static 620 -int tcldom_returnNodeObj ( 629 +int tcldom_setInterpAndReturnVar ( 621 630 Tcl_Interp *interp, 622 631 domNode *node, 623 632 int setVariable, 624 633 Tcl_Obj *var_name 625 634 ) 626 635 { 627 - char objCmdName[80], *objVar; 628 - domDeleteInfo * dinfo; 629 - Tcl_CmdInfo cmdInfo; 630 - 636 + char objCmdName[80], *objVar; 637 + Tcl_Obj *resultObj; 638 + 631 639 GetTcldomTSD() 632 640 633 641 if (node == NULL) { 634 642 if (setVariable) { 635 643 objVar = Tcl_GetString(var_name); 636 - Tcl_UnsetVar(interp, objVar, 0); 637 644 Tcl_SetVar(interp, objVar, "", 0); 638 645 } 639 646 SetResult(""); 640 647 return TCL_OK; 641 648 } 642 - tcldom_createNodeObj(interp, node, objCmdName); 643 - if (TSD(dontCreateObjCommands)) { 649 + if (TSD(dontCreateObjCommands) == 0) { 650 + tcldom_createNodeObj(interp, node, objCmdName); 644 651 if (setVariable) { 645 652 objVar = Tcl_GetString(var_name); 646 - Tcl_SetVar(interp, objVar, objCmdName, 0); 653 + Tcl_SetVar (interp, objVar, objCmdName, 0); 647 654 } 655 + SetResult(objCmdName); 648 656 } else { 657 + resultObj = Tcl_NewObj(); 658 + resultObj->bytes = NULL; 659 + resultObj->length = 0; 660 + resultObj->internalRep.otherValuePtr = node; 661 + resultObj->typePtr = &tdomNodeType; 662 + Tcl_SetObjResult (interp, resultObj); 649 663 if (setVariable) { 664 + NODE_CMD(objCmdName, node); 650 665 objVar = Tcl_GetString(var_name); 651 - Tcl_UnsetVar(interp, objVar, 0); 652 666 Tcl_SetVar (interp, objVar, objCmdName, 0); 653 - Tcl_GetCommandInfo(interp, objCmdName, &cmdInfo); 654 - if (0) { 655 - dinfo = (domDeleteInfo*)MALLOC(sizeof(domDeleteInfo)); 656 - dinfo->interp = interp; 657 - dinfo->node = node; 658 - dinfo->traceVarName = NULL; 659 - Tcl_TraceVar(interp, objVar, 660 - TCL_TRACE_WRITES | TCL_TRACE_UNSETS, 661 - (Tcl_VarTraceProc*)tcldom_nodeTrace, 662 - (ClientData)dinfo); 663 - dinfo->traceVarName = tdomstrdup(objVar); 664 - 665 - /* Patch node object command to remove above trace 666 - on teardown */ 667 - cmdInfo.deleteData = (ClientData)dinfo; 668 - cmdInfo.deleteProc = tcldom_nodeCmdDeleteProc; 669 - Tcl_SetCommandInfo(interp, objCmdName, &cmdInfo); 670 - } 671 - } 672 - } 673 - 674 - SetResult(objCmdName); 675 - return TCL_OK; 667 + } 668 + } 669 + return TCL_OK; 670 +} 671 + 672 +/*---------------------------------------------------------------------------- 673 +| tcldom_returnNodeObj 674 +| 675 +\---------------------------------------------------------------------------*/ 676 +static 677 +Tcl_Obj *tcldom_returnNodeObj ( 678 + Tcl_Interp *interp, 679 + domNode *node) 680 +{ 681 + char objCmdName[80]; 682 + Tcl_Obj *resultObj; 683 + 684 + GetTcldomTSD() 685 + 686 + resultObj = Tcl_NewObj(); 687 + if (node == NULL) { 688 + return resultObj; 689 + } 690 + if (TSD(dontCreateObjCommands) == 0) { 691 + tcldom_createNodeObj(interp, node, objCmdName); 692 + } 693 + resultObj->bytes = NULL; 694 + resultObj->length = 0; 695 + resultObj->internalRep.otherValuePtr = node; 696 + resultObj->typePtr = &tdomNodeType; 697 + return resultObj; 676 698 } 677 699 678 700 /*---------------------------------------------------------------------------- 679 701 | tcldom_returnDocumentObj 680 702 | 681 703 \---------------------------------------------------------------------------*/ 682 704 int tcldom_returnDocumentObj ( ................................................................................ 757 779 domNode *node, 758 780 int nsIndex, 759 781 const char *uri 760 782 ) 761 783 { 762 784 int result; 763 785 domNode *child; 764 - char prefix[MAX_PREFIX_LEN], objCmdName[80]; 786 + char prefix[MAX_PREFIX_LEN]; 765 787 const char *localName; 766 788 Tcl_Obj *namePtr, *resultPtr; 767 789 768 790 /* nsIndex == -1 ==> DOM 1 no NS i.e getElementsByTagName 769 791 nsIndex != -1 are the NS aware cases 770 792 nsIndex == -2 ==> more than one namespace in the document with the 771 793 requested namespace, we have to strcmp the URI ................................................................................ 792 814 if (nsIndex == -1) { 793 815 localName = node->nodeName; 794 816 } else { 795 817 domSplitQName(node->nodeName, prefix, &localName); 796 818 } 797 819 if (Tcl_StringMatch(localName, namePattern)) { 798 820 resultPtr = Tcl_GetObjResult(interp); 799 - tcldom_createNodeObj(interp, node, objCmdName); 800 - namePtr = Tcl_NewStringObj(objCmdName, -1); 821 + namePtr = tcldom_returnNodeObj(interp, node); 801 822 result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr); 802 823 if (result != TCL_OK) { 803 824 Tcl_DecrRefCount(namePtr); 804 825 return result; 805 826 } 806 827 } 807 828 } ................................................................................ 869 890 domNode * node, 870 891 void * clientData 871 892 ) 872 893 { 873 894 Tcl_Interp * interp = (Tcl_Interp*)clientData; 874 895 Tcl_Obj * resultPtr = Tcl_GetObjResult(interp); 875 896 Tcl_Obj * namePtr; 876 - char objCmdName[80]; 877 897 int result; 878 898 879 899 880 - tcldom_createNodeObj(interp, node, objCmdName); 881 - namePtr = Tcl_NewStringObj(objCmdName, -1); 900 + namePtr = tcldom_returnNodeObj(interp, node); 882 901 result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr); 883 902 if (result != TCL_OK) { 884 903 Tcl_DecrRefCount(namePtr); 885 904 } 886 905 return result; 887 906 } 888 907 ................................................................................ 987 1006 } 988 1007 if (result != 0) { 989 1008 return TCL_ERROR; 990 1009 } 991 1010 return TCL_OK; 992 1011 } 993 1012 1013 + 1014 +/*---------------------------------------------------------------------------- 1015 +| tcldom_getNodeFromObj 1016 +| 1017 +\---------------------------------------------------------------------------*/ 1018 +domNode * tcldom_getNodeFromObj ( 1019 + Tcl_Interp *interp, 1020 + Tcl_Obj *nodeObj 1021 +) 1022 +{ 1023 + Tcl_CmdInfo cmdInfo; 1024 + domNode *node = NULL; 1025 + char *nodeName; 1026 + 1027 + GetTcldomTSD() 1028 + 1029 + if (nodeObj->typePtr == &tdomNodeType) { 1030 + return (domNode*)nodeObj->internalRep.otherValuePtr; 1031 + } 1032 + 1033 + if (TSD(dontCreateObjCommands)) { 1034 + if (SetTdomNodeFromAny (interp, nodeObj) == TCL_OK) { 1035 + return (domNode*)nodeObj->internalRep.otherValuePtr; 1036 + } 1037 + return NULL; 1038 + } 1039 + 1040 + nodeName = Tcl_GetString(nodeObj); 1041 + if (strncmp(nodeName, "domNode", 7)) { 1042 + SetResult("parameter not a domNode!"); 1043 + return NULL; 1044 + } 1045 + if (sscanf(&nodeName[7], "%p", &node) != 1) { 1046 + if (!Tcl_GetCommandInfo(interp, nodeName, &cmdInfo)) { 1047 + SetResult("parameter not a domNode!"); 1048 + return NULL; 1049 + } 1050 + if ( (cmdInfo.isNativeObjectProc == 0) 1051 + || (cmdInfo.objProc != (Tcl_ObjCmdProc*)tcldom_NodeObjCmd)) { 1052 + SetResult("parameter not a domNode object command!"); 1053 + return NULL; 1054 + } 1055 + node = (domNode*)cmdInfo.objClientData; 1056 + } 1057 + 1058 + return node; 1059 +} 994 1060 995 1061 /*---------------------------------------------------------------------------- 996 1062 | tcldom_getNodeFromName 997 1063 | 998 1064 \---------------------------------------------------------------------------*/ 999 1065 domNode * tcldom_getNodeFromName ( 1000 1066 Tcl_Interp *interp, ................................................................................ 1157 1223 nodeToAppend = doc->rootNode->firstChild; 1158 1224 while (nodeToAppend) { 1159 1225 domAppendChild(node, nodeToAppend); 1160 1226 nodeToAppend = nodeToAppend->nextSibling; 1161 1227 } 1162 1228 domFreeDocument(doc, NULL, NULL); 1163 1229 1164 - return tcldom_returnNodeObj(interp, node, 0, NULL); 1230 + return tcldom_setInterpAndReturnVar(interp, node, 0, NULL); 1165 1231 #endif 1166 1232 } 1167 1233 1168 1234 1169 1235 /*---------------------------------------------------------------------------- 1170 1236 | tcldom_xpathResultSet 1171 1237 | ................................................................................ 1176 1242 xpathResultSet *rs, 1177 1243 Tcl_Obj *type, 1178 1244 Tcl_Obj *value 1179 1245 ) 1180 1246 { 1181 1247 int rc, i; 1182 1248 Tcl_Obj *namePtr, *objv[2]; 1183 - char objCmdName[80]; 1184 1249 domAttrNode *attr; 1185 1250 domNodeType startType; 1186 1251 int mixedNodeSet; 1187 1252 1188 1253 switch (rs->type) { 1189 1254 case EmptyResult: 1190 1255 Tcl_SetStringObj(type, "empty", -1); ................................................................................ 1235 1300 if (rs->nodes[i]->nodeType == ATTRIBUTE_NODE) { 1236 1301 attr = (domAttrNode*)rs->nodes[i]; 1237 1302 objv[0] = Tcl_NewStringObj(attr->nodeName, -1); 1238 1303 objv[1] = Tcl_NewStringObj(attr->nodeValue, 1239 1304 attr->valueLength); 1240 1305 namePtr = Tcl_NewListObj(2, objv); 1241 1306 } else { 1242 - tcldom_createNodeObj(interp, rs->nodes[i], objCmdName); 1243 - namePtr = Tcl_NewStringObj(objCmdName, -1); 1307 + namePtr = tcldom_returnNodeObj(interp, rs->nodes[i]); 1244 1308 } 1245 1309 rc = Tcl_ListObjAppendElement(interp, value, namePtr); 1246 1310 if (rc != TCL_OK) { 1247 1311 Tcl_DecrRefCount(namePtr); 1248 1312 return rc; 1249 1313 } 1250 1314 } ................................................................................ 1279 1343 xpathResultSets *args, 1280 1344 xpathResultSet *result, 1281 1345 char **errMsg 1282 1346 ) 1283 1347 { 1284 1348 Tcl_Interp *interp = (Tcl_Interp*) clientData; 1285 1349 char tclxpathFuncName[200], objCmdName[80]; 1286 - char *errStr, *typeStr, *nodeName; 1350 + char *errStr, *typeStr; 1287 1351 Tcl_Obj *resultPtr, *objv[MAX_REWRITE_ARGS], *type, *value, *nodeObj, 1288 1352 *tmpObj; 1289 1353 Tcl_CmdInfo cmdInfo; 1290 1354 int objc, rc, i, errStrLen, listLen, intValue, res; 1291 1355 double doubleValue; 1292 1356 domNode *node; 1293 1357 ................................................................................ 1321 1385 tmpObj = Tcl_NewListObj(0, NULL); 1322 1386 Tcl_ListObjAppendElement(interp, tmpObj, 1323 1387 Tcl_NewStringObj(objCmdName, -1)); 1324 1388 Tcl_ListObjAppendElement( 1325 1389 interp, tmpObj, 1326 1390 Tcl_NewStringObj(((domAttrNode*)ctxNode)->nodeName, -1)); 1327 1391 } else { 1328 - tcldom_createNodeObj(interp, ctxNode, objCmdName); 1329 - tmpObj = Tcl_NewStringObj(objCmdName, -1); 1392 + tmpObj = tcldom_returnNodeObj(interp, ctxNode); 1330 1393 } 1331 1394 objv[objc] = tmpObj; 1332 1395 Tcl_IncrRefCount(objv[objc++]); 1333 1396 1334 1397 objv[objc] = Tcl_NewIntObj(position); 1335 1398 Tcl_IncrRefCount(objv[objc++]); 1336 1399 ................................................................................ 1392 1455 if (rc != TCL_OK) { 1393 1456 *errMsg = tdomstrdup("value not a node list!"); 1394 1457 res = XPATH_EVAL_ERR; 1395 1458 goto funcCallCleanup; 1396 1459 } 1397 1460 for (i=0; i < listLen; i++) { 1398 1461 rc = Tcl_ListObjIndex(interp, value, i, &nodeObj); 1399 - nodeName = Tcl_GetString(nodeObj); 1400 - node = tcldom_getNodeFromName(interp, nodeName, &errStr); 1462 + node = tcldom_getNodeFromObj(interp, nodeObj); 1401 1463 if (node == NULL) { 1402 - *errMsg = tdomstrdup(errStr); 1464 + *errMsg = tdomstrdup(Tcl_GetStringResult(interp)); 1403 1465 res = XPATH_EVAL_ERR; 1404 1466 goto funcCallCleanup; 1405 1467 } 1406 1468 rsAddNode(result, node); 1407 1469 } 1408 1470 sortByDocOrder(result); 1409 1471 } else ................................................................................ 1959 2021 return rc; 1960 2022 } 1961 2023 if ((rc = tcldom_appendFromTclList(interp, newnode, childObj)) 1962 2024 != TCL_OK) { 1963 2025 return rc; 1964 2026 } 1965 2027 } 1966 - return tcldom_returnNodeObj(interp, node, 0, NULL); 2028 + return tcldom_setInterpAndReturnVar(interp, node, 0, NULL); 1967 2029 } 1968 2030 1969 2031 1970 2032 /*---------------------------------------------------------------------------- 1971 2033 | tcldom_treeAsTclList 1972 2034 | 1973 2035 \---------------------------------------------------------------------------*/ ................................................................................ 3321 3383 domDocument *doc, 3322 3384 Tcl_Interp *interp, 3323 3385 int objc, 3324 3386 Tcl_Obj *CONST objv[] 3325 3387 ) 3326 3388 { 3327 3389 int len, i, hnew; 3328 - char *errMsg; 3329 3390 Tcl_HashEntry *h; 3330 3391 Tcl_Obj *objPtr; 3331 3392 domNode *node; 3332 3393 3333 3394 CheckArgs (4,4,0, "<domDoc> renameNode nodeList name"); 3334 3395 if (Tcl_ListObjLength (interp, objv[2], &len) != TCL_OK) { 3335 3396 SetResult ("The first argument to the renameNode method" ................................................................................ 3336 3397 " must be a list of element nodes."); 3337 3398 return TCL_ERROR; 3338 3399 } 3339 3400 h = Tcl_CreateHashEntry(&HASHTAB(doc,tdom_tagNames), 3340 3401 Tcl_GetString(objv[3]), &hnew); 3341 3402 for (i = 0; i < len; i++) { 3342 3403 Tcl_ListObjIndex (interp, objv[2], i, &objPtr); 3343 - node = tcldom_getNodeFromName (interp, Tcl_GetString (objPtr), 3344 - &errMsg); 3404 + node = tcldom_getNodeFromObj (interp, objPtr); 3345 3405 if (node == NULL) { 3346 - SetResult (errMsg); 3347 - if (errMsg) FREE (errMsg); 3348 3406 return TCL_ERROR; 3349 3407 } 3350 3408 node->nodeName = (char *)&(h->key); 3351 3409 } 3352 3410 return TCL_OK; 3353 3411 } 3354 3412 ................................................................................ 3661 3719 { 3662 3720 GetTcldomTSD() 3663 3721 3664 3722 domNode *node, *child, *refChild, *oldChild, *refNode; 3665 3723 domNS *ns; 3666 3724 domAttrNode *attrs; 3667 3725 domException exception; 3668 - char tmp[200], objCmdName[80], prefix[MAX_PREFIX_LEN], 3669 - *method, *nodeName, *str, *attr_name, *attr_val, *filter, 3670 - *errMsg; 3726 + char tmp[200], prefix[MAX_PREFIX_LEN], *method, *nodeName, 3727 + *str, *attr_name, *attr_val, *filter; 3671 3728 const char *localName, *uri, *nsStr; 3672 3729 int result, length, methodIndex, i, line, column; 3673 3730 int nsIndex, bool, hnew, legacy; 3674 3731 Tcl_Obj *namePtr, *resultPtr; 3675 3732 Tcl_Obj *mobjv[MAX_REWRITE_ARGS]; 3676 3733 Tcl_CmdInfo cmdInfo; 3677 3734 Tcl_HashEntry *h; ................................................................................ 3729 3786 if (objc < 3) { 3730 3787 SetResult(node_usage); 3731 3788 return TCL_ERROR; 3732 3789 } 3733 3790 if (TSD(domCreateCmdMode) == DOM_CREATECMDMODE_AUTO) { 3734 3791 TSD(dontCreateObjCommands) = 1; 3735 3792 } 3736 - nodeName = Tcl_GetString(objv[1]); 3737 - node = tcldom_getNodeFromName(interp, nodeName, &errMsg); 3793 + node = tcldom_getNodeFromObj(interp, objv[1]); 3738 3794 if (node == NULL) { 3739 - SetResult(errMsg); 3740 3795 return TCL_ERROR; 3741 3796 } 3742 3797 objc--; 3743 3798 objv++; 3744 3799 } 3745 3800 if (objc < 2) { 3746 3801 SetResult(node_usage); ................................................................................ 3868 3923 case m_selectNodes: 3869 3924 return tcldom_selectNodes (interp, node, --objc, ++objv); 3870 3925 3871 3926 case m_find: 3872 3927 CheckArgs(4,5,2,"attrName attrVal ?nodeObjVar?"); 3873 3928 attr_name = Tcl_GetStringFromObj(objv[2], NULL); 3874 3929 attr_val = Tcl_GetStringFromObj(objv[3], &length); 3875 - return tcldom_returnNodeObj 3930 + return tcldom_setInterpAndReturnVar 3876 3931 (interp, tcldom_find(node, attr_name, attr_val, length), 3877 3932 (objc == 5), (objc == 5) ? objv[4] : NULL); 3878 3933 3879 3934 case m_child: 3880 3935 CheckArgs(3,6,2,"instance|all ?type? ?attr value?"); 3881 3936 return tcldom_xpointerSearch(interp, XP_CHILD, node, objc, objv); 3882 3937 ................................................................................ 3897 3952 return tcldom_xpointerSearch(interp, XP_PSIBLING, node,objc,objv); 3898 3953 3899 3954 case m_root: 3900 3955 CheckArgs(2,3,2,"?nodeObjVar?"); 3901 3956 while (node->parentNode) { 3902 3957 node = node->parentNode; 3903 3958 } 3904 - return tcldom_returnNodeObj(interp, node, (objc == 3), 3959 + return tcldom_setInterpAndReturnVar(interp, node, (objc == 3), 3905 3960 (objc == 3) ? objv[2] : NULL); 3906 3961 3907 3962 case m_text: 3908 3963 CheckArgs(2,2,2,""); 3909 3964 if (node->nodeType != ELEMENT_NODE) { 3910 3965 SetResult("NOT_AN_ELEMENT"); 3911 3966 return TCL_ERROR; ................................................................................ 4040 4095 for ( i = 2; i < objc; ) { 4041 4096 attr_name = Tcl_GetString(objv[i++]); 4042 4097 CheckName (interp, attr_name, "attribute", 0); 4043 4098 attr_val = Tcl_GetString(objv[i++]); 4044 4099 CheckText (interp, attr_val, "attribute"); 4045 4100 domSetAttribute(node, attr_name, attr_val); 4046 4101 } 4047 - return tcldom_returnNodeObj(interp, node, 0, NULL); 4102 + return tcldom_setInterpAndReturnVar(interp, node, 0, NULL); 4048 4103 4049 4104 case m_setAttributeNS: 4050 4105 if (node->nodeType != ELEMENT_NODE) { 4051 4106 SetResult("NOT_AN_ELEMENT : there are no attributes"); 4052 4107 return TCL_ERROR; 4053 4108 } 4054 4109 if ((objc < 5) || (((objc - 2) % 3) != 0)) { ................................................................................ 4070 4125 SetResult("For all prefixed attributes with prefixes " 4071 4126 "other than 'xml' or 'xmlns' " 4072 4127 "you have to provide a namespace URI"); 4073 4128 } 4074 4129 return TCL_ERROR; 4075 4130 } 4076 4131 } 4077 - return tcldom_returnNodeObj(interp, node, 0, NULL); 4132 + return tcldom_setInterpAndReturnVar(interp, node, 0, NULL); 4078 4133 4079 4134 case m_hasAttribute: 4080 4135 CheckArgs(3,3,2,"attrName"); 4081 4136 if (node->nodeType != ELEMENT_NODE) { 4082 4137 SetResult("NOT_AN_ELEMENT : there are no attributes"); 4083 4138 return TCL_ERROR; 4084 4139 } ................................................................................ 4128 4183 result = domRemoveAttribute(node, attr_name); 4129 4184 if (result) { 4130 4185 SetResult("can't remove attribute '"); 4131 4186 AppendResult(attr_name); 4132 4187 AppendResult("'"); 4133 4188 return TCL_ERROR; 4134 4189 } 4135 - return tcldom_returnNodeObj(interp, node, 0, NULL); 4190 + return tcldom_setInterpAndReturnVar(interp, node, 0, NULL); 4136 4191 4137 4192 case m_removeAttributeNS: 4138 4193 CheckArgs(4,4,2,"uri attrName"); 4139 4194 if (node->nodeType != ELEMENT_NODE) { 4140 4195 SetResult("NOT_AN_ELEMENT : there are no attributes"); 4141 4196 return TCL_ERROR; 4142 4197 } ................................................................................ 4145 4200 result = domRemoveAttributeNS(node, uri, localName); 4146 4201 if (result < 0) { 4147 4202 SetResult("can't remove attribute with localName '"); 4148 4203 AppendResult(localName); 4149 4204 AppendResult("'"); 4150 4205 return TCL_ERROR; 4151 4206 } 4152 - return tcldom_returnNodeObj(interp, node, 0, NULL); 4207 + return tcldom_setInterpAndReturnVar(interp, node, 0, NULL); 4153 4208 4154 4209 case m_nextSibling: 4155 4210 CheckArgs(2,3,2,"?nodeObjVar?"); 4156 - return tcldom_returnNodeObj(interp, node->nextSibling, 4211 + return tcldom_setInterpAndReturnVar(interp, node->nextSibling, 4157 4212 (objc == 3), 4158 4213 (objc == 3) ? objv[2] : NULL); 4159 4214 case m_previousSibling: 4160 4215 CheckArgs(2,3,2,"?nodeObjVar?"); 4161 - return tcldom_returnNodeObj(interp, node->previousSibling, 4216 + return tcldom_setInterpAndReturnVar(interp, node->previousSibling, 4162 4217 (objc == 3), 4163 4218 (objc == 3) ? objv[2] : NULL); 4164 4219 case m_firstChild: 4165 4220 CheckArgs(2,3,2,"?nodeObjVar?"); 4166 4221 if (node->nodeType == ELEMENT_NODE) { 4167 - return tcldom_returnNodeObj(interp, node->firstChild, 4222 + return tcldom_setInterpAndReturnVar(interp, node->firstChild, 4168 4223 (objc == 3), 4169 4224 (objc == 3) ? objv[2] : NULL); 4170 4225 } 4171 - return tcldom_returnNodeObj(interp, NULL, (objc == 3), 4226 + return tcldom_setInterpAndReturnVar(interp, NULL, (objc == 3), 4172 4227 (objc == 3) ? objv[2] : NULL); 4173 4228 case m_lastChild: 4174 4229 CheckArgs(2,3,2,"?nodeObjVar?"); 4175 4230 if (node->nodeType == ELEMENT_NODE) { 4176 - return tcldom_returnNodeObj(interp, node->lastChild, 4231 + return tcldom_setInterpAndReturnVar(interp, node->lastChild, 4177 4232 (objc == 3), 4178 4233 (objc == 3) ? objv[2] : NULL); 4179 4234 } 4180 - return tcldom_returnNodeObj(interp, NULL, (objc == 3), 4235 + return tcldom_setInterpAndReturnVar(interp, NULL, (objc == 3), 4181 4236 (objc == 3) ? objv[2] : NULL); 4182 4237 case m_parentNode: 4183 4238 CheckArgs(2,3,2,"?nodeObjVar?"); 4184 - return tcldom_returnNodeObj(interp, node->parentNode, (objc == 3), 4239 + return tcldom_setInterpAndReturnVar(interp, node->parentNode, (objc == 3), 4185 4240 (objc == 3) ? objv[2] : NULL); 4186 4241 case m_appendFromList: 4187 4242 CheckArgs(3,3,2,"list"); 4188 4243 return tcldom_appendFromTclList(interp, node, objv[2]); 4189 4244 4190 4245 case m_appendFromScript: 4191 4246 CheckArgs(3,3,2,"script"); 4192 4247 if (nodecmd_appendFromScript(interp, node, objv[2]) != TCL_OK) { 4193 4248 return TCL_ERROR; 4194 4249 } 4195 - return tcldom_returnNodeObj(interp, node, 0, NULL); 4250 + return tcldom_setInterpAndReturnVar(interp, node, 0, NULL); 4196 4251 4197 4252 case m_insertBeforeFromScript: 4198 4253 CheckArgs(4,4,2, "script refChild"); 4199 - nodeName = Tcl_GetString (objv[3]); 4200 - if (nodeName[0] == '\0') { 4201 - refChild = NULL; 4254 + if (objv[3]->typePtr == &tdomNodeType) { 4255 + refChild = objv[3]->internalRep.otherValuePtr; 4202 4256 } else { 4203 - refChild = tcldom_getNodeFromName (interp, nodeName, &errMsg); 4204 - if (refChild == NULL) { 4205 - SetResult ( errMsg ); 4206 - return TCL_ERROR; 4257 + nodeName = Tcl_GetString (objv[3]); 4258 + if (nodeName[0] == '\0') { 4259 + refChild = NULL; 4260 + } else { 4261 + refChild = tcldom_getNodeFromObj (interp, objv[3]); 4262 + if (refChild == NULL) { 4263 + return TCL_ERROR; 4264 + } 4207 4265 } 4208 4266 } 4209 4267 if (nodecmd_insertBeforeFromScript(interp, node, objv[2], refChild) 4210 4268 != TCL_OK) { 4211 4269 return TCL_ERROR; 4212 4270 } 4213 - return tcldom_returnNodeObj (interp, node, 0, NULL); 4271 + return tcldom_setInterpAndReturnVar (interp, node, 0, NULL); 4214 4272 4215 4273 case m_appendXML: 4216 4274 CheckArgs(3,3,2,"xmlString"); 4217 4275 return tcldom_appendXML(interp, node, objv[2]); 4218 4276 4219 4277 case m_appendChild: 4220 4278 CheckArgs(3,3,2,"nodeToAppend"); 4221 - nodeName = Tcl_GetString(objv[2]); 4222 - child = tcldom_getNodeFromName(interp, nodeName, &errMsg); 4279 + child = tcldom_getNodeFromObj(interp, objv[2]); 4223 4280 if (child == NULL) { 4224 - SetResult(errMsg); 4225 4281 return TCL_ERROR; 4226 4282 } 4227 4283 exception = domAppendChild (node, child); 4228 4284 if (exception != OK) { 4229 4285 SetResult(domException2String(exception)); 4230 4286 return TCL_ERROR; 4231 4287 } 4232 - return tcldom_returnNodeObj(interp, child, 0, NULL); 4288 + return tcldom_setInterpAndReturnVar(interp, child, 0, NULL); 4233 4289 4234 4290 case m_cloneNode: 4235 4291 CheckArgs(2,3,2,"?-deep?"); 4236 4292 if (objc == 3) { 4237 4293 if (!strcmp(Tcl_GetString(objv[2]), "-deep")) { 4238 - return tcldom_returnNodeObj(interp, domCloneNode(node, 1), 4294 + return tcldom_setInterpAndReturnVar(interp, domCloneNode(node, 1), 4239 4295 0, NULL); 4240 4296 } 4241 4297 SetResult("unknown option! Options: ?-deep? "); 4242 4298 return TCL_ERROR; 4243 4299 } 4244 - return tcldom_returnNodeObj(interp, domCloneNode(node, 0), 0, NULL); 4300 + return tcldom_setInterpAndReturnVar(interp, domCloneNode(node, 0), 0, NULL); 4245 4301 4246 4302 case m_removeChild: 4247 4303 CheckArgs(3,3,2,"childToRemove"); 4248 - nodeName = Tcl_GetString(objv[2]); 4249 - child = tcldom_getNodeFromName(interp, nodeName, &errMsg); 4304 + child = tcldom_getNodeFromObj(interp, objv[2]); 4250 4305 if (child == NULL) { 4251 - SetResult(errMsg); 4252 4306 return TCL_ERROR; 4253 4307 } 4254 4308 exception = domRemoveChild (node, child); 4255 4309 if (exception != OK) { 4256 4310 SetResult (domException2String (exception)); 4257 4311 return TCL_ERROR; 4258 4312 } 4259 - return tcldom_returnNodeObj(interp, child, 0, NULL); 4313 + return tcldom_setInterpAndReturnVar(interp, child, 0, NULL); 4260 4314 4261 4315 case m_insertBefore: 4262 4316 CheckArgs(4,4,2,"childToInsert refChild"); 4263 - nodeName = Tcl_GetString(objv[2]); 4264 - child = tcldom_getNodeFromName(interp, nodeName, &errMsg); 4317 + child = tcldom_getNodeFromObj(interp, objv[2]); 4265 4318 if (child == NULL) { 4266 - SetResult(errMsg); 4267 4319 return TCL_ERROR; 4268 4320 } 4269 4321 4270 - nodeName = Tcl_GetString (objv[3]); 4271 - if (nodeName[0] == '\0') { 4272 - refChild = NULL; 4322 + if (objv[3]->typePtr == &tdomNodeType) { 4323 + refChild = objv[3]->internalRep.otherValuePtr; 4273 4324 } else { 4274 - refChild = tcldom_getNodeFromName (interp, nodeName, &errMsg); 4275 - if (refChild == NULL) { 4276 - SetResult ( errMsg ); 4277 - return TCL_ERROR; 4325 + nodeName = Tcl_GetString (objv[3]); 4326 + if (nodeName[0] == '\0') { 4327 + refChild = NULL; 4328 + } else { 4329 + refChild = tcldom_getNodeFromObj (interp, objv[3]); 4330 + if (refChild == NULL) { 4331 + return TCL_ERROR; 4332 + } 4278 4333 } 4279 4334 } 4280 4335 exception = domInsertBefore(node, child, refChild); 4281 4336 if (exception != OK) { 4282 4337 SetResult(domException2String(exception)); 4283 4338 return TCL_ERROR; 4284 4339 } 4285 - return tcldom_returnNodeObj(interp, child, 0, NULL); 4340 + return tcldom_setInterpAndReturnVar(interp, child, 0, NULL); 4286 4341 4287 4342 case m_replaceChild: 4288 4343 CheckArgs(4,4,2,"new old"); 4289 - nodeName = Tcl_GetString(objv[2]); 4290 - child = tcldom_getNodeFromName(interp, nodeName, &errMsg); 4344 + child = tcldom_getNodeFromObj(interp, objv[2]); 4291 4345 if (child == NULL) { 4292 - SetResult(errMsg); 4293 4346 return TCL_ERROR; 4294 4347 } 4295 - 4296 - nodeName = Tcl_GetString(objv[3]); 4297 - oldChild = tcldom_getNodeFromName(interp, nodeName, &errMsg); 4348 + oldChild = tcldom_getNodeFromObj(interp, objv[3]); 4298 4349 if (oldChild == NULL) { 4299 - SetResult(errMsg); 4300 4350 return TCL_ERROR; 4301 4351 } 4302 4352 exception = domReplaceChild(node, child, oldChild); 4303 4353 if (exception != OK) { 4304 4354 SetResult(domException2String(exception)); 4305 4355 return TCL_ERROR; 4306 4356 } 4307 - return tcldom_returnNodeObj(interp, oldChild, 0, NULL); 4357 + return tcldom_setInterpAndReturnVar(interp, oldChild, 0, NULL); 4308 4358 4309 4359 case m_hasChildNodes: 4310 4360 CheckArgs(2,2,2,""); 4311 4361 if (node->nodeType == ELEMENT_NODE) { 4312 4362 SetIntResult(node->firstChild ? 1 : 0); 4313 4363 } else { 4314 4364 SetIntResult(0); ................................................................................ 4317 4367 4318 4368 case m_childNodes: 4319 4369 CheckArgs(2,2,2,""); 4320 4370 resultPtr = Tcl_GetObjResult(interp); 4321 4371 if (node->nodeType == ELEMENT_NODE) { 4322 4372 child = node->firstChild; 4323 4373 while (child != NULL) { 4324 - tcldom_createNodeObj(interp, child, objCmdName); 4325 - namePtr = Tcl_NewStringObj(objCmdName, -1); 4374 + namePtr = tcldom_returnNodeObj(interp, child); 4326 4375 result = Tcl_ListObjAppendElement(interp, resultPtr, 4327 4376 namePtr); 4328 4377 if (result != TCL_OK) { 4329 4378 Tcl_DecrRefCount(namePtr); 4330 4379 return result; 4331 4380 } 4332 4381 child = child->nextSibling; ................................................................................ 4386 4435 case m_getElementById: 4387 4436 CheckArgs(3,3,2,"id"); 4388 4437 if (node->ownerDocument->ids) { 4389 4438 str = Tcl_GetString(objv[2]); 4390 4439 h = Tcl_FindHashEntry(node->ownerDocument->ids, str); 4391 4440 if (h) { 4392 4441 domNode *node = Tcl_GetHashValue(h); 4393 - return tcldom_returnNodeObj(interp, node, 0, NULL); 4442 + return tcldom_setInterpAndReturnVar(interp, node, 0, NULL); 4394 4443 } 4395 4444 } 4396 4445 SetResult(""); 4397 4446 return TCL_OK; 4398 4447 4399 4448 case m_nodeName: 4400 4449 CheckArgs(2,2,2,""); ................................................................................ 4619 4668 node->nodeFlags &= (~DISABLE_OUTPUT_ESCAPING); 4620 4669 } 4621 4670 } 4622 4671 break; 4623 4672 4624 4673 case m_precedes: 4625 4674 CheckArgs(3,3,2, "node"); 4626 - nodeName = Tcl_GetString(objv[2]); 4627 - refNode = tcldom_getNodeFromName(interp, nodeName, &errMsg); 4675 + refNode = tcldom_getNodeFromObj(interp, objv[2]); 4628 4676 if (refNode == NULL) { 4629 - SetResult(errMsg); 4630 4677 return TCL_ERROR; 4631 4678 } 4632 4679 if (node->ownerDocument != refNode->ownerDocument) { 4633 4680 SetResult("Cannot compare the relative order of nodes " 4634 4681 "out of different documents."); 4635 4682 return TCL_ERROR; 4636 4683 } ................................................................................ 4676 4723 node->ownerDocument, LOCK_WRITE); 4677 4724 case m_readlock: 4678 4725 CheckArgs(3,3,2,"script"); 4679 4726 return tcldom_EvalLocked(interp, (Tcl_Obj**)objv, 4680 4727 node->ownerDocument, LOCK_READ); 4681 4728 ) 4682 4729 } 4683 - return TCL_OK; 4684 -} 4730 + return TCL_OK;} 4731 + 4685 4732 4686 4733 4687 4734 /*---------------------------------------------------------------------------- 4688 4735 | tcldom_DocObjCmd 4689 4736 | 4690 4737 \---------------------------------------------------------------------------*/ 4691 4738 int tcldom_DocObjCmd ( ................................................................................ 4824 4871 | 4825 4872 \---------------------------------------------------------------------*/ 4826 4873 4827 4874 switch ((enum docMethod) methodIndex ) { 4828 4875 4829 4876 case m_documentElement: 4830 4877 CheckArgs(2,3,2,""); 4831 - return tcldom_returnNodeObj(interp, doc->documentElement, 4878 + return tcldom_setInterpAndReturnVar(interp, doc->documentElement, 4832 4879 (objc == 3), 4833 4880 (objc == 3) ? objv[2] : NULL); 4834 4881 case m_getElementsByTagName: 4835 4882 CheckArgs(3,3,2,"elementName"); 4836 4883 return tcldom_getElementsByTagName(interp, Tcl_GetString(objv[2]), 4837 4884 doc->documentElement, -1, NULL); 4838 4885 case m_getElementsByTagNameNS: ................................................................................ 4869 4916 doc->documentElement, nsIndex, 4870 4917 uri); 4871 4918 case m_createElement: 4872 4919 CheckArgs(3,4,2,"elementName ?newObjVar?"); 4873 4920 tag = Tcl_GetString(objv[2]); 4874 4921 CheckName (interp, tag, "tag", 0); 4875 4922 n = domNewElementNode(doc, tag, ELEMENT_NODE); 4876 - return tcldom_returnNodeObj(interp, n, (objc == 4), 4923 + return tcldom_setInterpAndReturnVar(interp, n, (objc == 4), 4877 4924 (objc == 4) ? objv[3] : NULL); 4878 4925 4879 4926 case m_createElementNS: 4880 4927 CheckArgs(4,5,2,"elementName uri ?newObjVar?"); 4881 4928 uri = Tcl_GetString(objv[2]); 4882 4929 tag = Tcl_GetString(objv[3]); 4883 4930 CheckName (interp, tag, "full qualified tag", 1); 4884 4931 n = domNewElementNodeNS(doc, tag, uri, ELEMENT_NODE); 4885 - return tcldom_returnNodeObj(interp, n, (objc == 5), 4932 + return tcldom_setInterpAndReturnVar(interp, n, (objc == 5), 4886 4933 (objc == 5) ? objv[4] : NULL); 4887 4934 4888 4935 case m_createTextNode: 4889 4936 CheckArgs(3,4,2,"data ?newObjVar?"); 4890 4937 data = Tcl_GetStringFromObj(objv[2], &data_length); 4891 4938 CheckText (interp, data, "text"); 4892 4939 n = (domNode*)domNewTextNode(doc, data, data_length, TEXT_NODE); 4893 - return tcldom_returnNodeObj(interp, n, (objc == 4), 4940 + return tcldom_setInterpAndReturnVar(interp, n, (objc == 4), 4894 4941 (objc == 4) ? objv[3] : NULL); 4895 4942 4896 4943 case m_createCDATASection: 4897 4944 CheckArgs(3,4,2,"data ?newObjVar?"); 4898 4945 data = Tcl_GetStringFromObj(objv[2], &data_length); 4899 4946 CheckCDATA (interp, data); 4900 4947 n = (domNode*)domNewTextNode(doc, data, data_length, 4901 4948 CDATA_SECTION_NODE); 4902 - return tcldom_returnNodeObj(interp, n, (objc == 4), 4949 + return tcldom_setInterpAndReturnVar(interp, n, (objc == 4), 4903 4950 (objc == 4) ? objv[3] : NULL); 4904 4951 4905 4952 case m_createComment: 4906 4953 CheckArgs(3,4,2,"data ?newObjVar?"); 4907 4954 data = Tcl_GetStringFromObj(objv[2], &data_length); 4908 4955 CheckComment(interp, data); 4909 4956 n = (domNode*)domNewTextNode(doc, data, data_length, COMMENT_NODE); 4910 - return tcldom_returnNodeObj(interp, n, (objc == 4), 4957 + return tcldom_setInterpAndReturnVar(interp, n, (objc == 4), 4911 4958 (objc == 4) ? objv[3] : NULL); 4912 4959 4913 4960 case m_createProcessingInstruction: 4914 4961 CheckArgs(4,5,2,"target data ?newObjVar?"); 4915 4962 target = Tcl_GetStringFromObj(objv[2], &target_length); 4916 4963 CheckPIName (interp, target); 4917 4964 data = Tcl_GetStringFromObj(objv[3], &data_length); 4918 4965 CheckPIValue (interp, data); 4919 4966 n = (domNode*)domNewProcessingInstructionNode(doc, target, 4920 4967 target_length, data, 4921 4968 data_length); 4922 - return tcldom_returnNodeObj(interp, n, (objc == 5), 4969 + return tcldom_setInterpAndReturnVar(interp, n, (objc == 5), 4923 4970 (objc == 5) ? objv[4] : NULL); 4924 4971 4925 4972 case m_delete: 4926 4973 CheckArgs(2,2,2,""); 4927 4974 if (clientData != NULL) { 4928 4975 Tcl_DeleteCommand(interp, Tcl_GetString (objv[0])); 4929 4976 } else {
Added tests/dom.bench.
1 +# -*- tcl -*- 2 +# Tcl Benchmark File 3 +# 4 +# This file contains a number of benchmarks for the dom methods. 5 +# This allow developers to monitor/gauge/track package performance. 6 +# 7 +# (c) 2013 Rolf Ade <rolf@pointsman.de> 8 + 9 + 10 +# ### ### ### ######### ######### ######### ########################### 11 +## Setting up the environment ... 12 + 13 +package require tdom 14 + 15 +# ### ### ### ######### ######### ######### ########################### 16 +## Benchmarks. 17 + 18 +dom createNodeCmd elementNode e1 19 + 20 +foreach nrOf {1 10 100 1000} { 21 + 22 + bench -desc "getElementsByTagName: $nrOf returned nodes" -pre { 23 + dom createDocument root doc 24 + $doc documentElement root 25 + $root appendFromScript { 26 + for {set x 0} {$x < $nrOf} {incr x} { 27 + e1 28 + } 29 + } 30 + } -body { 31 + $doc getElementsByTagName e1 32 + } -post { 33 + $doc delete 34 + } 35 + 36 +} 37 + 38 +foreach nrOf {1 10 100 1000} { 39 + 40 + bench -desc "getElementsByTagName: $nrOf returned node tokens" -pre { 41 + dom createDocument root doc 42 + $doc documentElement root 43 + $root appendFromScript { 44 + for {set x 0} {$x < $nrOf} {incr x} { 45 + e1 46 + } 47 + } 48 + dom setObjectCommands token 49 + } -body { 50 + $doc getElementsByTagName e1 51 + } -post { 52 + dom setObjectCommands automatic 53 + $doc delete 54 + } 55 + 56 +} 57 + 58 +proc cloneImitated {source target} { 59 + foreach att [$source attributes] { 60 + $target setAttribute $att [$source @$att] 61 + } 62 + set targetDoc [$target ownerDocument] 63 + foreach child [$source childNodes] { 64 + switch [$child nodeType] { 65 + "ELEMENT_NODE" { 66 + set targetChild [$targetDoc createElement [$child nodeName]] 67 + } 68 + "TEXT_NODE" { 69 + set targetChild [$targetDoc createTextNode [$child nodeValue]] 70 + } 71 + "CDATA_SECTION_NODE" { 72 + set targetChild [$targetDoc createCDATASection \ 73 + [$child nodeValue]] 74 + } 75 + "PROCESSING_INSTRUCTION_NODE" { 76 + set targetChild [$targetDoc createProcessingInstruction \ 77 + [$child nodeName] [$child nodeValue]] 78 + } 79 + "COMMENT_NODE" { 80 + set targetChild [$targetDoc createComment [$child nodeValue]] 81 + } 82 + default { 83 + error "Unexpected node type [$child nodeType]" 84 + } 85 + } 86 + $target appendChild $targetChild 87 + cloneImitated $child $targetChild 88 + } 89 +} 90 + 91 +proc cloneImitated2 {source target} { 92 + foreach att [$source attributes] { 93 + $target setAttribute $att [$source @$att] 94 + } 95 + set targetDoc [$target ownerDocument] 96 + foreach child [$source childNodes] { 97 + switch [$child nodeType] { 98 + "ELEMENT_NODE" { 99 + $targetDoc createElement [$child nodeName] targetChild 100 + } 101 + "TEXT_NODE" { 102 + $targetDoc createTextNode [$child nodeValue] targetChild 103 + } 104 + "CDATA_SECTION_NODE" { 105 + $targetDoc createCDATASection [$child nodeValue] targetChild 106 + } 107 + "PROCESSING_INSTRUCTION_NODE" { 108 + $targetDoc createProcessingInstruction [$child nodeName] \ 109 + targetChild 110 + } 111 + "COMMENT_NODE" { 112 + $targetDoc createComment [$child nodeValue] targetChild 113 + } 114 + default { 115 + error "Unexpected node type [$child nodeType]" 116 + } 117 + } 118 + $target appendChild $targetChild 119 + cloneImitated2 $child $targetChild 120 + } 121 +} 122 + 123 +proc cloneImitatedToken {source target} { 124 + foreach att [domNode $source attributes] { 125 + domNode $target setAttribute $att [domNode $source @$att] 126 + } 127 + set targetDoc [domNode $target ownerDocument] 128 + foreach child [domNode $source childNodes] { 129 + switch [domNode $child nodeType] { 130 + "ELEMENT_NODE" { 131 + set targetChild [$targetDoc createElement \ 132 + [domNode $child nodeName]] 133 + } 134 + "TEXT_NODE" { 135 + set targetChild [$targetDoc createTextNode \ 136 + [domNode $child nodeValue]] 137 + } 138 + "CDATA_SECTION_NODE" { 139 + set targetChild [$targetDoc createCDATASection \ 140 + [domNode $child nodeValue]] 141 + } 142 + "PROCESSING_INSTRUCTION_NODE" { 143 + set targetChild [$targetDoc createProcessingInstruction \ 144 + [domNode $child nodeName] \ 145 + [domNode $child nodeValue]] 146 + } 147 + "COMMENT_NODE" { 148 + set targetChild [$targetDoc createComment \ 149 + [domNode $child nodeValue]] 150 + } 151 + default { 152 + error "Unexpected node type [domNode $child nodeType]" 153 + } 154 + } 155 + domNode $target appendChild $targetChild 156 + cloneImitatedToken $child $targetChild 157 + } 158 +} 159 + 160 +bench -desc "clone dom tree without clone method - cmds" -pre { 161 + set fd [open [file join [file dir [info script]] ../tests/data/mondial-europe.xml]] 162 + fconfigure $fd -encoding utf-8 163 + set doc [dom parse -channel $fd] 164 + close $fd 165 + set root [$doc documentElement] 166 + set clone [dom createDocument [$root nodeName]] 167 + set cloneRoot [$clone documentElement] 168 +} -iters 5 -body { 169 + cloneImitated $root $cloneRoot 170 +} -post { 171 + $doc delete 172 + $clone delete 173 +} 174 + 175 +bench -desc "clone dom tree without clone method - cmds 2" -pre { 176 + set fd [open [file join [file dir [info script]] ../tests/data/mondial-europe.xml]] 177 + fconfigure $fd -encoding utf-8 178 + set doc [dom parse -channel $fd] 179 + close $fd 180 + set root [$doc documentElement] 181 + set clone [dom createDocument [$root nodeName]] 182 + set cloneRoot [$clone documentElement] 183 +} -iters 5 -body { 184 + cloneImitated2 $root $cloneRoot 185 +} -post { 186 + $doc delete 187 + $clone delete 188 +} 189 + 190 +bench -desc "clone dom tree without clone method - token" -pre { 191 + set fd [open [file join [file dir [info script]] ../tests/data/mondial-europe.xml]] 192 + fconfigure $fd -encoding utf-8 193 + set doc [dom parse -channel $fd] 194 + close $fd 195 + set root [$doc documentElement] 196 + set clone [dom createDocument [$root nodeName]] 197 + set cloneRoot [$clone documentElement] 198 + dom setObjectCommands token 199 +} -iters 5 -body { 200 + cloneImitatedToken $root $cloneRoot 201 +} -post { 202 + $doc delete 203 + $clone delete 204 + dom setObjectCommands automatic 205 +}
Changes to tests/domNode.bench.
202 202 } -body { 203 203 $doc selectNodes -cache 1 count(/root/e1) 204 204 } -post { 205 205 $doc delete 206 206 } 207 207 208 208 } 209 + 210 +foreach nrOf {1 10 100 1000} { 211 + 212 + bench -desc "getElementsByTagName: $nrOf returned nodes" -pre { 213 + dom createDocument root doc 214 + $doc documentElement root 215 + $root appendFromScript { 216 + for {set x 0} {$x < $nrOf} {incr x} { 217 + e1 218 + } 219 + } 220 + } -body { 221 + $doc getElementsByTagName e1 222 + } -post { 223 + $doc delete 224 + } 225 + 226 +} 227 + 228 +foreach nrOf {1 10 100 1000} { 229 + 230 + bench -desc "getElementsByTagName: $nrOf returned node tokens" -pre { 231 + dom createDocument root doc 232 + $doc documentElement root 233 + $root appendFromScript { 234 + for {set x 0} {$x < $nrOf} {incr x} { 235 + e1 236 + } 237 + } 238 + dom setObjectCommands token 239 + } -body { 240 + $doc getElementsByTagName e1 241 + } -post { 242 + dom setObjectCommands automatic 243 + $doc delete 244 + } 245 + 246 +} 247 + 248 + 249 +bench -desc "firstChild node cmd" -pre { 250 + dom parse <root><e/></root> doc 251 + $doc documentElement root 252 +} -body { 253 + $root firstChild 254 +} -post { 255 + $doc delete 256 +} 257 + 258 +bench -desc "firstChild node token" -pre { 259 + dom parse <root><e/></root> doc 260 + $doc documentElement root 261 + dom setObjectCommands token 262 +} -body { 263 + $root firstChild 264 +} -post { 265 + $doc delete 266 + dom setObjectCommands automatic 267 +} 268 + 269 +bench -desc "firstChild node token from node token" -pre { 270 + dom parse <root><e/></root> doc 271 + dom setObjectCommands token 272 + $doc documentElement root 273 +} -body { 274 + domNode $root firstChild 275 +} -post { 276 + $doc delete 277 + dom setObjectCommands automatic 278 +} 209 279 210 280 dom parse <root/> doc 211 281 $doc documentElement root 212 282 213 283 bench -desc "Check for text-only element - xpath - empty" -body { 214 284 for {set x 0} {$x < 100} {incr x} { 215 285 $doc selectNodes -cache 1 {count(node()) = 1 and node() = text()}