1 /* tcldom-libxml2.c --
2 *
3 * A Tcl wrapper for libxml's node tree API,
4 * conformant to the TclDOM API.
5 *
6 * Copyright (c) 2005-2009 by Explain.
7 * http://www.explain.com.au/
8 * Copyright (c) 2001-2004 Zveno Pty Ltd
9 * http://www.zveno.com/
10 *
11 * See the file "LICENSE" for information on usage and
12 * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 *
14 * $Id: tcldomlibxml2.c,v 1.2 2005/05/24 21:09:56 balls Exp $
15 */
16
17 #include <tcldom/tcldom.h>
18 #include <tcldom-libxml2/tcldom-libxml2.h>
19 #include <tclxml-libxml2/docObj.h>
20 #include <libxml/xpath.h>
21 #include <libxml/xpathInternals.h>
22 #include <libxml/xmlIO.h>
23 #include <libxml/HTMLtree.h>
24 #include <libxml/globals.h>
25 #include <libxml/xinclude.h>
26 #include <libxml/parserInternals.h>
27 #include <libxml/xmlschemas.h>
28 #include <libxml/xmlschemastypes.h>
29 #include <libxml/relaxng.h>
30 #include <libxml/xmlsave.h>
31 #include <string.h>
32
33 #define TCL_DOES_STUBS \
34 (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 || \
35 (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)))
36
37 #undef TCL_STORAGE_CLASS
38 #define TCL_STORAGE_CLASS DLLEXPORT
39
40 /*
41 * Manage lists of Tcl_Obj's
42 */
43
44 typedef struct ObjList {
45 Tcl_Obj *objPtr;
46 struct ObjList *next;
47 } ObjList;
48
49 /*
50 * Forward declarations for private functions.
51 */
52
53 static void FreeDocument _ANSI_ARGS_((ClientData clientData));
54 static TclDOM_libxml2_Document * GetDOMDocument _ANSI_ARGS_((Tcl_Interp *interp,
55 TclXML_libxml2_Document *tDocPtr));
56
57 static void TclDOM_libxml2_DestroyNode _ANSI_ARGS_((Tcl_Interp *interp, TclDOM_libxml2_Node *tNodePtr));
58 static void TclDOM_libxml2_InvalidateNode _ANSI_ARGS_((TclDOM_libxml2_Node *tNodePtr));
59
60 static char * TclDOMLiveNodeListNode _ANSI_ARGS_((ClientData clientData,
61 Tcl_Interp *interp,
62 char *name1,
63 char *name2,
64 int flags));
65 static char * TclDOMLiveNodeListDoc _ANSI_ARGS_((ClientData clientData,
66 Tcl_Interp *interp,
67 char *name1,
68 char *name2,
69 int flags));
70 static char * TclDOMLiveNamedNodeMap _ANSI_ARGS_((ClientData clientData,
71 Tcl_Interp *interp,
72 char *name1,
73 char *name2,
74 int flags));
75 static int TclDOMSetLiveNodeListNode _ANSI_ARGS_((Tcl_Interp *interp,
76 char *varname,
77 xmlNodePtr nodePtr));
78 static int TclDOMSetLiveNodeListDoc _ANSI_ARGS_((Tcl_Interp *interp,
79 char *varname,
80 xmlDocPtr docPtr));
81 static int TclDOMSetLiveNamedNodeMap _ANSI_ARGS_((Tcl_Interp *interp,
82 char *varname,
83 xmlNodePtr nodePtr));
84
85 /*
86 * Forward declarations of commands
87 */
88
89 static int TclDOMDOMImplementationCommand _ANSI_ARGS_((ClientData dummy,
90 Tcl_Interp *interp,
91 int objc,
92 Tcl_Obj *CONST objv[]));
93 static int TclDOMDocumentCommand _ANSI_ARGS_((ClientData dummy,
94 Tcl_Interp *interp,
95 int objc,
96 Tcl_Obj *CONST objv[]));
97 static void DocumentNodeCmdDelete _ANSI_ARGS_((ClientData clientdata));
98 static int TclDOMNodeCommand _ANSI_ARGS_((ClientData dummy,
99 Tcl_Interp *interp,
100 int objc,
101 Tcl_Obj *CONST objv[]));
102 static void TclDOMNodeCommandDelete _ANSI_ARGS_((ClientData clientdata));
103 static int TclDOMElementCommand _ANSI_ARGS_((ClientData dummy,
104 Tcl_Interp *interp,
105 int objc,
106 Tcl_Obj *CONST objv[]));
107 static int TclDOMEventCommand _ANSI_ARGS_((ClientData dummy,
108 Tcl_Interp *interp,
109 int objc,
110 Tcl_Obj *CONST objv[]));
111 static void TclDOMEventCommandDelete _ANSI_ARGS_((ClientData clientdata));
112 static Tcl_Obj * TclDOM_libxml2_NewEventObj _ANSI_ARGS_((Tcl_Interp *interp,
113 xmlDocPtr docPtr,
114 enum TclDOM_EventTypes type,
115 Tcl_Obj *typeObjPtr));
116
117 /*
118 * Functions that implement the TclDOM_Implementation interface
119 */
120
121 static int TclDOM_HasFeatureCommand _ANSI_ARGS_((ClientData dummy,
122 Tcl_Interp *interp,
123 int objc,
124 Tcl_Obj *CONST objv[]));
125 static int TclDOMCreateCommand _ANSI_ARGS_((ClientData dummy,
126 Tcl_Interp *interp,
127 int objc,
128 Tcl_Obj *CONST objv[]));
129 static int TclDOMDestroyCommand _ANSI_ARGS_((ClientData dummy,
130 Tcl_Interp *interp,
131 int objc,
132 Tcl_Obj *CONST objv[]));
133 static int TclDOMParseCommand _ANSI_ARGS_((ClientData dummy,
134 Tcl_Interp *interp,
135 int objc,
136 Tcl_Obj *CONST objv[]));
137 static int TclDOMSerializeCommand _ANSI_ARGS_((ClientData dummy,
138 Tcl_Interp *interp,
139 int objc,
140 Tcl_Obj *CONST objv[]));
141 static int TclDOMSelectNodeCommand _ANSI_ARGS_((ClientData dummy,
142 Tcl_Interp *interp,
143 int objc,
144 Tcl_Obj *CONST objv[]));
145 static int TclDOMIsNodeCommand _ANSI_ARGS_((ClientData dummy,
146 Tcl_Interp *interp,
147 int objc,
148 Tcl_Obj *CONST objv[]));
149 static int TclDOMAdoptCommand _ANSI_ARGS_((ClientData dummy,
150 Tcl_Interp *interp,
151 int objc,
152 Tcl_Obj *CONST objv[]));
153
154 /*
155 * Additional features
156 */
157
158 static int TclDOMXIncludeCommand _ANSI_ARGS_((ClientData dummy,
159 Tcl_Interp *interp,
160 int objc,
161 Tcl_Obj *CONST objv[]));
162
163 static int TclDOMPrefix2NSCommand _ANSI_ARGS_((ClientData dummy,
164 Tcl_Interp *interp,
165 int objc,
166 Tcl_Obj *CONST objv[]));
167 static int TclDOMTrimCommand _ANSI_ARGS_((ClientData dummy,
168 Tcl_Interp *interp,
169 int objc,
170 Tcl_Obj *CONST objv[]));
171
172 static void TrimDocument _ANSI_ARGS_((Tcl_Interp *interp, xmlDocPtr docPtr));
173 static int AdoptDocument _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr));
174
175 static int DocumentCget _ANSI_ARGS_((Tcl_Interp *interp,
176 xmlDocPtr docPtr,
177 Tcl_Obj *CONST objPtr));
178 static int DocumentConfigure _ANSI_ARGS_((Tcl_Interp *interp,
179 xmlDocPtr docPtr,
180 int objc,
181 Tcl_Obj *CONST objv[]));
182 static int NodeCget _ANSI_ARGS_((Tcl_Interp *interp,
183 xmlDocPtr docPtr,
184 xmlNodePtr nodePtr,
185 Tcl_Obj *CONST objPtr));
186 static int NodeConfigure _ANSI_ARGS_((Tcl_Interp *interp,
187 xmlNodePtr nodePtr,
188 int objc,
189 Tcl_Obj *CONST objPtr[]));
190 static int ElementCget _ANSI_ARGS_((Tcl_Interp *interp,
191 xmlNodePtr nodePtr,
192 Tcl_Obj *CONST objPtr));
193
194 static int TclDOM_NodeAppendChild _ANSI_ARGS_((Tcl_Interp *interp,
195 xmlNodePtr nodePtr,
196 xmlNodePtr newPtr));
197 static int TclDOM_NodeInsertBefore _ANSI_ARGS_((Tcl_Interp *interp,
198 xmlNodePtr refPtr,
199 xmlNodePtr newPtr));
200
201 static void PostMutationEvents _ANSI_ARGS_((Tcl_Interp *interp,
202 TclXML_libxml2_Document *tDocPtr,
203 xmlNodePtr nodePtr,
204 xmlNodePtr refPtr,
205 xmlNodePtr newPtr,
206 xmlNodePtr oldParent,
207 xmlNodePtr newParent));
208
209 static int DTDValidate _ANSI_ARGS_((Tcl_Interp *interp,
210 TclDOM_libxml2_Document *domDocPtr));
211 static int SchemaCompile _ANSI_ARGS_((Tcl_Interp *interp,
212 TclDOM_libxml2_Document *domDocPtr));
213 static int SchemaValidate _ANSI_ARGS_((Tcl_Interp *interp,
214 TclDOM_libxml2_Document *domDocPtr,
215 xmlDocPtr instancePtr));
216 static int RelaxNGCompile _ANSI_ARGS_((Tcl_Interp *interp,
217 TclDOM_libxml2_Document *domDocPtr));
218 static int RelaxNGValidate _ANSI_ARGS_((Tcl_Interp *interp,
219 TclDOM_libxml2_Document *domDocPtr,
220 xmlDocPtr instance));
221
222 static void NodeAddObjRef _ANSI_ARGS_((TclDOM_libxml2_Node *tNodePtr,
223 Tcl_Obj *objPtr));
224 #if 0
225 static void DumpNode _ANSI_ARGS_((TclDOM_libxml2_Node *tNodePtr));
226 #endif
227
228 /*
229 * Other utilities
230 */
231
232 static Tcl_Obj * GetPath _ANSI_ARGS_((Tcl_Interp *interp,
233 xmlNodePtr nodePtr));
234
235 /*
236 * MS VC++ oddities
237 */
238
239 #ifdef WIN32
240 #if !defined (__CYGWIN__)
241 #define vsnprintf _vsnprintf
242 #define snprintf _snprintf
243 #endif /* __CYGWIN__ */
244 #endif /* WIN32 */
245
246 /*
247 * Nodes as Tcl Objects (overloaded to also support event nodes).
248 */
249
250 Tcl_FreeInternalRepProc NodeTypeFree;
251 Tcl_DupInternalRepProc NodeTypeDup;
252 Tcl_UpdateStringProc NodeTypeUpdate;
253 Tcl_SetFromAnyProc NodeTypeSetFromAny;
254
255 Tcl_ObjType NodeObjType = {
256 "libxml2-node",
257 NodeTypeFree,
258 NodeTypeDup,
259 NodeTypeUpdate,
260 NodeTypeSetFromAny
261 };
262
263 /*
264 * For additional checks when creating nodes.
265 * These are setup at initialisation-time, but thereafter are read-only.
266 */
267
268 static Tcl_Obj *checkName;
269 static Tcl_Obj *checkQName;
270
271 /*
272 * libxml2 is mostly thread-safe, but there are issues with error callbacks
273 */
274
275 TCL_DECLARE_MUTEX(libxml2)
276
277 /*
278 * Statically include the definitions of option tables:
279 * Due to linking problems on Windows, using MS VC++.
280 */
281
282 #include "tcldom.c"
283
284 /*
285 *----------------------------------------------------------------------------
286 *
287 * Tcldom_libxml2_Init --
288 *
289 * Initialisation routine for module.
290 * This is no longer loaded as a separate module.
291 *
292 * Results:
293 * None.
294 *
295 * Side effects:
296 * Creates commands in the interpreter,
297 *
298 *----------------------------------------------------------------------------
299 */
300
301 int
302 Tcldom_libxml2_Init (interp)
303 Tcl_Interp *interp; /* Interpreter to initialise */
304 {
305
306 Tcl_MutexLock(&libxml2);
307 xmlXPathInit();
308 Tcl_MutexUnlock(&libxml2);
309
310 /*
311 * Provide a handler for nodes for structured error reporting
312 */
313
314 TclXML_libxml2_SetErrorNodeFunc(interp,
315 (TclXML_ErrorNodeHandlerProc *) TclDOM_libxml2_CreateObjFromNode);
316
317 /*
318 * For each of the standard commands, register the command
319 * in both the ::dom and ::dom::libxml2 Tcl namespaces -
320 * they are equivalent.
321 */
322
323 Tcl_CreateObjCommand(interp, "dom::libxml2::DOMImplementation",
324 TclDOMDOMImplementationCommand, NULL, NULL);
325 Tcl_CreateObjCommand(interp, "dom::DOMImplementation",
326 TclDOMDOMImplementationCommand, NULL, NULL);
327 Tcl_CreateObjCommand(interp, "dom::libxml2::hasfeature",
328 TclDOM_HasFeatureCommand, NULL, NULL);
329 Tcl_CreateObjCommand(interp, "dom::hasfeature",
330 TclDOM_HasFeatureCommand, NULL, NULL);
331 Tcl_CreateObjCommand(interp, "dom::libxml2::document",
332 TclDOMDocumentCommand, NULL, NULL);
333 Tcl_CreateObjCommand(interp, "dom::document",
334 TclDOMDocumentCommand, NULL, NULL);
335 Tcl_CreateObjCommand(interp, "dom::libxml2::node",
336 TclDOMNodeCommand, NULL, NULL);
337 Tcl_CreateObjCommand(interp, "dom::node",
338 TclDOMNodeCommand, NULL, NULL);
339 Tcl_CreateObjCommand(interp, "dom::libxml2::create",
340 TclDOMCreateCommand, NULL, NULL);
341 Tcl_CreateObjCommand(interp, "dom::create",
342 TclDOMCreateCommand, NULL, NULL);
343
344 /*
345 * Implemented in Tcl (for the moment)
346 Tcl_CreateObjCommand(interp, "dom::libxml2::parse",
347 TclDOMParseCommand, NULL, NULL);
348 Tcl_CreateObjCommand(interp, "dom::parse",
349 TclDOMParseCommand, NULL, NULL);
350 */
351 Tcl_CreateObjCommand(interp, "dom::libxml2::adoptdocument",
352 TclDOMAdoptCommand, NULL, NULL);
353
354 Tcl_CreateObjCommand(interp, "dom::libxml2::serialize",
355 TclDOMSerializeCommand, NULL, NULL);
356 Tcl_CreateObjCommand(interp, "dom::serialize",
357 TclDOMSerializeCommand, NULL, NULL);
358 Tcl_CreateObjCommand(interp, "dom::libxml2::selectnode",
359 TclDOMSelectNodeCommand, NULL, NULL);
360 Tcl_CreateObjCommand(interp, "dom::selectNode",
361 TclDOMSelectNodeCommand, NULL, NULL);
362 Tcl_CreateObjCommand(interp, "dom::libxml2::isNode",
363 TclDOMIsNodeCommand, NULL, NULL);
364 Tcl_CreateObjCommand(interp, "dom::isNode",
365 TclDOMIsNodeCommand, NULL, NULL);
366 Tcl_CreateObjCommand(interp, "dom::libxml2::element",
367 TclDOMElementCommand, NULL, NULL);
368 Tcl_CreateObjCommand(interp, "dom::element",
369 TclDOMElementCommand, NULL, NULL);
370 Tcl_CreateObjCommand(interp, "dom::libxml2::event",
371 TclDOMEventCommand, NULL, NULL);
372 Tcl_CreateObjCommand(interp, "dom::event",
373 TclDOMEventCommand, NULL, NULL);
374 Tcl_CreateObjCommand(interp, "dom::libxml2::xinclude",
375 TclDOMXIncludeCommand, NULL, NULL);
376 Tcl_CreateObjCommand(interp, "dom::xinclude",
377 TclDOMXIncludeCommand, NULL, NULL);
378 Tcl_CreateObjCommand(interp, "dom::libxml2::prefix2namespaceURI",
379 TclDOMPrefix2NSCommand, NULL, NULL);
380 Tcl_CreateObjCommand(interp, "dom::prefix2namespaceURI",
381 TclDOMPrefix2NSCommand, NULL, NULL);
382 Tcl_CreateObjCommand(interp, "dom::libxml2::destroy",
383 TclDOMDestroyCommand, NULL, NULL);
384 Tcl_CreateObjCommand(interp, "dom::destroy",
385 TclDOMDestroyCommand, NULL, NULL);
386 Tcl_CreateObjCommand(interp, "dom::libxml2::trim",
387 TclDOMTrimCommand, NULL, NULL);
388 Tcl_CreateObjCommand(interp, "dom::trim",
389 TclDOMTrimCommand, NULL, NULL);
390
391 /* Setup name checking REs */
392 checkName = Tcl_NewStringObj("^", -1);
393 Tcl_AppendObjToObj(checkName, Tcl_GetVar2Ex(interp, "::xml::Name", NULL, 0));
394 Tcl_AppendToObj(checkName, "$", -1);
395 Tcl_IncrRefCount(checkName);
396 checkQName = Tcl_NewStringObj("^", -1);
397 Tcl_AppendObjToObj(checkQName, Tcl_GetVar2Ex(interp, "::xml::QName", NULL, 0));
398 Tcl_AppendToObj(checkQName, "$", -1);
399 Tcl_IncrRefCount(checkQName);
400
401 TclDOM_SetVars(interp);
402
403 Tcl_RegisterObjType(&NodeObjType);
404
405 return TCL_OK;
406 }
407
408 /*
409 * DOM is safe, since it is merely an in-memory representation of the document tree.
410 * However, XInclude is not safe. This is still OK because XInclude uses the external
411 * entity mechanism to load remote documents and TclXML/libxml2 intercepts those calls.
412 */
413 int
Tcldom_libxml2_SafeInit(interp)414 Tcldom_libxml2_SafeInit (interp)
415 Tcl_Interp *interp; /* Interpreter to initialise */
416 {
417 return Tcldom_libxml2_Init(interp);
418 }
419
420 #if 0
421 void
422 DumpDocNodeTable(domDocPtr)
423 TclDOM_libxml2_Document *domDocPtr;
424 {
425 return;
426
427 /*
428 TclDOM_libxml2_Node *tNodePtr;
429 Tcl_HashEntry *entryPtr;
430 Tcl_HashSearch search;
431
432 sprintf(dbgbuf, " Nodes in doc \"%s\":\n", domDocPtr->tDocPtr->token);
433 Tcl_WriteChars(stderrChan, dbgbuf, -1);
434
435 for (entryPtr = Tcl_FirstHashEntry(domDocPtr->nodes, &search);
436 entryPtr;
437 entryPtr = Tcl_NextHashEntry(&search)) {
438 tNodePtr = (TclDOM_libxml2_Node *) Tcl_GetHashValue(entryPtr);
439 sprintf(dbgbuf, " Hash entry \"%s\" (x%x)\n", Tcl_GetHashKey(domDocPtr->nodes, entryPtr), tNodePtr);
440 Tcl_WriteChars(stderrChan, dbgbuf, -1);
441 sprintf(dbgbuf, " Node \"%s\"\n", tNodePtr->token);
442 Tcl_WriteChars(stderrChan, dbgbuf, -1);
443 }
444 */
445 }
446 #endif
447
448 /*
449 *----------------------------------------------------------------------------
450 *
451 * TclDOM_HasFeatureCommand --
452 *
453 * Implements dom::libxml2::hasfeature command
454 *
455 * Results:
456 * Returns boolean.
457 *
458 * Side effects:
459 * None.
460 *
461 *----------------------------------------------------------------------------
462 */
463
464 int
TclDOM_HasFeatureCommand(dummy,interp,objc,objv)465 TclDOM_HasFeatureCommand (dummy, interp, objc, objv)
466 ClientData dummy;
467 Tcl_Interp *interp;
468 int objc;
469 Tcl_Obj *CONST objv[];
470 {
471 if (objc != 3) {
472 Tcl_WrongNumArgs(interp, 0, objv, "hasfeature feature version");
473 return TCL_ERROR;
474 }
475
476 if (Tcl_RegExpMatchObj(interp, objv[1], Tcl_NewStringObj("create|destroy|parse|query|serialize|trim|Events|UIEvents|isNode", -1)) == 1) {
477 if (Tcl_StringMatch(Tcl_GetStringFromObj(objv[2], NULL), "1.0") == 1) {
478 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
479 } else {
480 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
481 }
482 } else {
483 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
484 }
485
486 return TCL_OK;
487 }
488
489 /*
490 *----------------------------------------------------------------------------
491 *
492 * TclDOMCreateCommand --
493 *
494 * Implements dom::libxml2::create command
495 *
496 * Results:
497 * Creates a new document.
498 *
499 * Side effects:
500 * Allocates memory.
501 *
502 *----------------------------------------------------------------------------
503 */
504
505 int
TclDOMCreateCommand(dummy,interp,objc,objv)506 TclDOMCreateCommand (dummy, interp, objc, objv)
507 ClientData dummy;
508 Tcl_Interp *interp;
509 int objc;
510 Tcl_Obj *CONST objv[];
511 {
512 Tcl_Obj *objPtr;
513
514 if (objc != 1) {
515 Tcl_WrongNumArgs(interp, 1, objv, "");
516 return TCL_ERROR;
517 }
518
519 objPtr = TclXML_libxml2_NewDocObj(interp);
520 if (!objPtr) {
521 return TCL_ERROR;
522 }
523 TclXML_libxml2_DocKeep(objPtr, TCLXML_LIBXML2_DOCUMENT_KEEP);
524
525 if (AdoptDocument(interp, objPtr) != TCL_OK) {
526 return TCL_ERROR;
527 }
528
529 return TCL_OK;
530 }
531 int
AdoptDocument(interp,objPtr)532 AdoptDocument(interp, objPtr)
533 Tcl_Interp *interp;
534 Tcl_Obj *objPtr;
535 {
536 TclXML_libxml2_Document *tDocPtr;
537 TclDOM_libxml2_Document *domDocPtr;
538
539 /*
540 * Claim this object so the document will not be destroyed
541 * underneath us.
542 */
543 Tcl_IncrRefCount(objPtr);
544
545 if (TclXML_libxml2_GetTclDocFromObj(interp, objPtr, &tDocPtr) != TCL_OK) {
546 return TCL_ERROR;
547 }
548
549 domDocPtr = (TclDOM_libxml2_Document *) Tcl_Alloc(sizeof(TclDOM_libxml2_Document));
550 domDocPtr->interp = interp;
551 domDocPtr->tDocPtr = tDocPtr;
552 domDocPtr->objPtr = objPtr;
553
554 domDocPtr->schema = NULL;
555 domDocPtr->relaxng = NULL;
556
557 domDocPtr->nodes = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
558 Tcl_InitHashTable(domDocPtr->nodes, TCL_STRING_KEYS);
559 domDocPtr->nodeCntr = 0;
560
561 domDocPtr->captureListeners = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
562 Tcl_InitHashTable(domDocPtr->captureListeners, TCL_ONE_WORD_KEYS);
563 domDocPtr->bubbleListeners = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
564 Tcl_InitHashTable(domDocPtr->bubbleListeners, TCL_ONE_WORD_KEYS);
565 memset(domDocPtr->listening, 0, TCLDOM_NUM_EVENT_TYPES * sizeof(int));
566
567 /*
568 * When the document is eventually destroyed,
569 * make sure all memory is freed.
570 */
571 tDocPtr->dom = (ClientData) domDocPtr;
572 tDocPtr->domfree = FreeDocument;
573
574 /*
575 * Create a Tcl namespace for this document
576 */
577
578 Tcl_VarEval(interp, "namespace eval ::dom::", tDocPtr->token, " {}\n", NULL);
579
580 /*
581 * Create a DOM command to control the document.
582 */
583
584 domDocPtr->cmd = Tcl_CreateObjCommand(interp, tDocPtr->token, TclDOMDocumentCommand, (ClientData) domDocPtr, DocumentNodeCmdDelete);
585
586 Tcl_SetObjResult(interp, objPtr);
587
588 return TCL_OK;
589 }
590
591 /*
592 *----------------------------------------------------------------------------
593 *
594 * TclDOM_libxml2_CreateObjFromDoc --
595 *
596 * Wrapper for TclXML_libxml2_CreateObjFromDoc
597 *
598 * Results:
599 * Returns Tcl_Obj.
600 *
601 * Side effects:
602 * Allocates memory.
603 *
604 *----------------------------------------------------------------------------
605 */
606
607 Tcl_Obj *
TclDOM_libxml2_CreateObjFromDoc(interp,docPtr)608 TclDOM_libxml2_CreateObjFromDoc (interp, docPtr)
609 Tcl_Interp *interp;
610 xmlDocPtr docPtr;
611 {
612 Tcl_Obj *newPtr;
613
614 newPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
615
616 if (AdoptDocument(interp, newPtr) != TCL_OK) {
617 Tcl_DecrRefCount(newPtr);
618 return NULL;
619 }
620
621 return newPtr;
622 }
623
624 /*
625 *----------------------------------------------------------------------------
626 *
627 * TclDOMDestroyCommand --
628 *
629 * Implements dom::libxml2::destroy command
630 *
631 * Results:
632 * Frees document or node.
633 *
634 * Side effects:
635 * Deallocates memory.
636 *
637 *----------------------------------------------------------------------------
638 */
639
640 int
TclDOMDestroyCommand(dummy,interp,objc,objv)641 TclDOMDestroyCommand (dummy, interp, objc, objv)
642 ClientData dummy;
643 Tcl_Interp *interp;
644 int objc;
645 Tcl_Obj *CONST objv[];
646 {
647 TclXML_libxml2_Document *tDocPtr;
648 TclDOM_libxml2_Node *tNodePtr;
649
650 if (objc != 2) {
651 Tcl_WrongNumArgs(interp, 1, objv, "token");
652 return TCL_ERROR;
653 }
654
655 if (TclXML_libxml2_GetTclDocFromObj(interp, objv[1], &tDocPtr) == TCL_OK) {
656 TclDOM_libxml2_Document *domDocPtr = GetDOMDocument(interp, tDocPtr);
657
658 if (domDocPtr == NULL) {
659 /* This is an error! */
660 TclXML_libxml2_DestroyDocument(tDocPtr);
661 } else {
662 Tcl_DeleteCommandFromToken(interp, domDocPtr->cmd);
663 }
664
665 } else if (TclDOM_libxml2_GetTclNodeFromObj(interp, objv[1], &tNodePtr) == TCL_OK) {
666 TclDOM_libxml2_DestroyNode(interp, tNodePtr);
667 } else if (TclDOM_libxml2_GetTclEventFromObj(interp, objv[1], &tNodePtr) == TCL_OK) {
668 TclDOM_libxml2_DestroyNode(interp, tNodePtr);
669 } else {
670 Tcl_SetResult(interp, "not a DOM node", NULL);
671 return TCL_ERROR;
672 }
673
674 return TCL_OK;
675 }
676
677 /*
678 *----------------------------------------------------------------------------
679 *
680 * DocumentNodeCmdDelete --
681 *
682 * Invoked when a DOM document's command is deleted.
683 *
684 * Results:
685 * Frees document.
686 *
687 * Side effects:
688 * Deallocates memory.
689 *
690 *----------------------------------------------------------------------------
691 */
692
693 void
DocumentNodeCmdDelete(clientData)694 DocumentNodeCmdDelete (clientData)
695 ClientData clientData;
696 {
697 TclDOM_libxml2_Document *domDocPtr = (TclDOM_libxml2_Document *) clientData;
698
699 #ifndef WIN32
700 TclXML_libxml2_DestroyDocument(domDocPtr->tDocPtr);
701 #endif /* not WIN32 */
702 #ifdef WIN32
703 /*
704 * Workaround bug in TclXML/libxml2.
705 * This will, of course, leak memory.
706 */
707
708 /* FreeDocument((ClientData) domDocPtr); */
709 #endif /* WIN32 */
710 }
711
712 /*
713 *----------------------------------------------------------------------------
714 *
715 * FreeDocument --
716 *
717 * Frees resources associated with a document.
718 *
719 * Results:
720 * None.
721 *
722 * Side effects:
723 * Deallocates memory.
724 *
725 *----------------------------------------------------------------------------
726 */
727
728 #ifdef WIN32
729 /*
730 * Using Tcl internal functions appears to cause linking problems
731 * when using MS VC++, so avoid the problem by invoking a script instead.
732 */
733
DeleteNamespace(interp,ns)734 void DeleteNamespace (interp, ns)
735 Tcl_Interp *interp;
736 char *ns;
737 {
738 Tcl_Obj *cmdPtr = Tcl_NewObj();
739
740 Tcl_AppendStringsToObj(cmdPtr, "namespace delete ", ns, NULL);
741 Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
742 Tcl_DecrRefCount(cmdPtr);
743 }
744 #else /* not WIN32 */
745 /*
746 * Internal Tcl functions
747 */
748
749 #if (TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5))
750
751 /*
752 * SRB: 2005-12-29: This should use #include <tclInt.h>, but private sources may not be available.
753 */
754
755 EXTERN Tcl_Namespace * Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp * interp,
756 CONST char * name,
757 Tcl_Namespace * contextNsPtr,
758 int flags));
759 EXTERN void Tcl_DeleteNamespace _ANSI_ARGS_((Tcl_Namespace * nsPtr));
760
761 #endif /* Tcl < 8.5 */
762
DeleteNamespace(interp,ns)763 void DeleteNamespace (interp, ns)
764 Tcl_Interp *interp;
765 char *ns;
766 {
767 Tcl_Namespace *namespacePtr;
768 namespacePtr = Tcl_FindNamespace(interp, ns,
769 (Tcl_Namespace *) NULL, 0);
770 if (namespacePtr) {
771 Tcl_DeleteNamespace(namespacePtr);
772 } /* else internal error */
773 }
774 #endif /* WIN32 */
775
776 void
FreeDocument(clientData)777 FreeDocument (clientData)
778 ClientData clientData;
779 {
780 TclDOM_libxml2_Document *domDocPtr = (TclDOM_libxml2_Document *) clientData;
781 char buf[1024];
782
783 snprintf(buf, 1023, "::dom::%s", domDocPtr->tDocPtr->token);
784 DeleteNamespace(domDocPtr->interp, buf);
785
786 /*
787 * Deleting the namespace deletes all of the node commands,
788 * which in turn invalidates the node references.
789 * So no need to do it again here.
790 *
791 entry = Tcl_FirstHashEntry(domDocPtr->nodes, &search);
792 while (entry) {
793 tNodePtr = (TclDOM_libxml2_Node *) Tcl_GetHashValue(entry);
794 TclDOM_libxml2_InvalidateNode(tNodePtr);
795 entry = Tcl_NextHashEntry(&search);
796 }
797 */
798 Tcl_DeleteHashTable(domDocPtr->nodes);
799 Tcl_Free((char *) domDocPtr->nodes);
800
801 if (domDocPtr->schema) {
802 Tcl_MutexLock(&libxml2);
803 /* This also frees the copy of the document used by the schema context */
804 xmlSchemaFree(domDocPtr->schema);
805 Tcl_MutexUnlock(&libxml2);
806 }
807
808 if (domDocPtr->relaxng) {
809 Tcl_MutexLock(&libxml2);
810 /* This also frees the copy of the document used by the schema context */
811 xmlRelaxNGFree(domDocPtr->relaxng);
812 Tcl_MutexUnlock(&libxml2);
813 }
814
815 Tcl_Free((char *) domDocPtr->captureListeners);
816 Tcl_Free((char *) domDocPtr->bubbleListeners);
817
818 /* Workaround win32 destroy bug, see above */
819 #ifndef WIN32
820 Tcl_DecrRefCount(domDocPtr->objPtr);
821 #endif /* not WIN32 */
822
823 Tcl_Free((char *) domDocPtr);
824 }
825
826 /*
827 *----------------------------------------------------------------------------
828 *
829 * GetDOMDocument --
830 *
831 * Retrieves the DOM document structure associated with a libxml2 document.
832 * libxslt synthesizes documents, so it is often the case that a node
833 * must be processed that has not had its document "adopted".
834 *
835 * Results:
836 * Returns pointer to DOM structure.
837 *
838 * Side effects:
839 * Document is "adopted" if necessary.
840 *
841 *----------------------------------------------------------------------------
842 */
843
844 TclDOM_libxml2_Document *
GetDOMDocument(interp,tDocPtr)845 GetDOMDocument(interp, tDocPtr)
846 Tcl_Interp *interp;
847 TclXML_libxml2_Document *tDocPtr;
848 {
849 if (tDocPtr->dom != NULL) {
850 return (TclDOM_libxml2_Document *) tDocPtr->dom;
851 } else if (interp == NULL) {
852 return NULL;
853 } else {
854 Tcl_Obj *objPtr;
855
856 objPtr = TclXML_libxml2_CreateObjFromDoc(tDocPtr->docPtr);
857 if (AdoptDocument(interp, objPtr) != TCL_OK) {
858 Tcl_DecrRefCount(objPtr);
859 return NULL;
860 } else {
861 return (TclDOM_libxml2_Document *) tDocPtr->dom;
862 }
863 }
864 }
865
866 /*
867 *----------------------------------------------------------------------------
868 *
869 * TclDOMParseCommand --
870 *
871 * Implements dom::libxml2::parse command
872 *
873 * Not implemented here at present - calls Tcl script
874 *
875 * Results:
876 * Depends on method.
877 *
878 * Side effects:
879 * Depends on method.
880 *
881 *----------------------------------------------------------------------------
882 */
883
884 int
TclDOMParseCommand(dummy,interp,objc,objv)885 TclDOMParseCommand (dummy, interp, objc, objv)
886 ClientData dummy;
887 Tcl_Interp *interp;
888 int objc;
889 Tcl_Obj *CONST objv[];
890 {
891 /* Tcl_Obj *objPtr; */
892 Tcl_Obj **newobjv;
893 int i;
894
895 if (objc < 2) {
896 Tcl_WrongNumArgs(interp, 1, objv, "xml ?args ...?");
897 return TCL_ERROR;
898 }
899
900 newobjv = (Tcl_Obj **) Tcl_Alloc((objc + 1) * sizeof(Tcl_Obj *));
901 newobjv[0] = Tcl_NewStringObj("::dom::libxml2::parse", -1);
902 for (i = 1; i < objc; i++) {
903 newobjv[i] = objv[i];
904 }
905 newobjv[i] = NULL;
906
907 return Tcl_EvalObjv(interp, objc, newobjv, 0);
908
909 /*
910 if (TclXML_CreateParser(interp, objc, objv) != TCL_OK) {
911 return TCL_ERROR;
912 }
913 parserObj = Tcl_GetObjResult(interp);
914 if (TclXML_Parse(interp, parserObj, objc, objv) != TCL_OK) {
915 return TCL_ERROR;
916 }
917
918 if (TclXML_Get(interp, parserObj, "document") != TCL_OK) {
919 return TCL_ERROR;
920 }
921
922 Tcl_SetObjResult(interp, objPtr);
923 */
924
925 return TCL_OK;
926 }
927 int
TclDOMAdoptCommand(dummy,interp,objc,objv)928 TclDOMAdoptCommand (dummy, interp, objc, objv)
929 ClientData dummy;
930 Tcl_Interp *interp;
931 int objc;
932 Tcl_Obj *CONST objv[];
933 {
934 if (objc != 2) {
935 Tcl_WrongNumArgs(interp, 1, objv, "doc");
936 return TCL_ERROR;
937 }
938
939 return AdoptDocument(interp, objv[1]);
940 }
941
942 /*
943 *----------------------------------------------------------------------------
944 *
945 * TclDOMSerializeCommand --
946 *
947 * Implements dom::libxml2::serialize command
948 *
949 * Results:
950 * Depends on method.
951 *
952 * Side effects:
953 * Depends on method.
954 *
955 *----------------------------------------------------------------------------
956 */
957
958 int
TclDOMSerializeCommand(dummy,interp,objc,objv)959 TclDOMSerializeCommand (dummy, interp, objc, objv)
960 ClientData dummy;
961 Tcl_Interp *interp;
962 int objc;
963 Tcl_Obj *CONST objv[];
964 {
965 xmlDocPtr docPtr;
966 xmlNodePtr nodePtr;
967 xmlBufferPtr bufptr = NULL;
968 xmlSaveCtxtPtr savectxtptr = NULL;
969 xmlChar *result = NULL;
970 Tcl_Obj *encodingPtr = NULL;
971 int option, method = TCLDOM_SERIALIZE_METHOD_XML, indent = 0, len = 0, omitXMLDeclaration = 0, saveoptions = 0;
972 char *buf, *encoding;
973 Tcl_Encoding tclencoding;
974 Tcl_DString *serialized;
975
976 if (objc < 2) {
977 Tcl_WrongNumArgs(interp, 1, objv, "node ?option value ...?");
978 return TCL_ERROR;
979 }
980
981 if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
982 if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) == TCL_OK) {
983 /* Serialize just the node */
984 Tcl_SetResult(interp, "not yet implemented - serialize whole document", NULL);
985 return TCL_ERROR;
986 } else {
987 Tcl_SetResult(interp, "not a libxml2 node", NULL);
988 return TCL_ERROR;
989 }
990 }
991
992 if (objc > 2) {
993 objc -= 2;
994 objv += 2;
995
996 while (objc) {
997
998 if (objc == 1) {
999 Tcl_Obj *msgPtr;
1000
1001 msgPtr = Tcl_NewStringObj("missing value for configuration option \"", -1);
1002 Tcl_AppendObjToObj(msgPtr, objv[0]);
1003 Tcl_AppendStringsToObj(msgPtr, "\"", (char *) NULL);
1004 Tcl_SetObjResult(interp, msgPtr);
1005 return TCL_ERROR;
1006 }
1007
1008 if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_SerializeCommandOptions,
1009 "option", 0, &option) != TCL_OK) {
1010 return TCL_ERROR;
1011 }
1012
1013 switch ((enum TclDOM_SerializeCommandOptions) option) {
1014 case TCLDOM_SERIALIZE_METHOD:
1015
1016 buf = Tcl_GetStringFromObj(objv[1], &len);
1017 if (len == 0) {
1018 method = TCLDOM_SERIALIZE_METHOD_XML;
1019 } else if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_SerializeMethods,
1020 "method", 0, &method) != TCL_OK) {
1021 return TCL_ERROR;
1022 }
1023
1024 break;
1025
1026 case TCLDOM_SERIALIZE_INDENT:
1027
1028 if (Tcl_GetBooleanFromObj(interp, objv[1], &indent) != TCL_OK) {
1029 return TCL_ERROR;
1030 }
1031
1032 break;
1033
1034 case TCLDOM_SERIALIZE_OMIT_XML_DECLARATION:
1035
1036 if (Tcl_GetBooleanFromObj(interp, objv[1], &omitXMLDeclaration) != TCL_OK) {
1037 return TCL_ERROR;
1038 }
1039
1040 break;
1041
1042 case TCLDOM_SERIALIZE_ENCODING:
1043 encodingPtr = objv[1];
1044
1045 break;
1046
1047 default:
1048 Tcl_SetResult(interp, "unknown option", NULL);
1049 return TCL_ERROR;
1050 }
1051
1052 objc -= 2;
1053 objv += 2;
1054 }
1055 }
1056
1057 switch ((enum TclDOM_SerializeMethods) method) {
1058
1059 case TCLDOM_SERIALIZE_METHOD_XML:
1060
1061 serialized = (Tcl_DString *) Tcl_Alloc(sizeof(Tcl_DString));
1062 Tcl_DStringInit(serialized);
1063
1064 if (encodingPtr) {
1065 encoding = Tcl_GetStringFromObj(encodingPtr, NULL);
1066 } else {
1067 encoding = "utf-8";
1068 }
1069 tclencoding = Tcl_GetEncoding(interp, encoding);
1070
1071 Tcl_MutexLock(&libxml2);
1072
1073 if ((bufptr = xmlBufferCreate()) == NULL) {
1074 Tcl_MutexUnlock(&libxml2);
1075 Tcl_Free((void *)serialized);
1076 Tcl_SetResult(interp, "unable to allocate output buffer", NULL);
1077 return TCL_ERROR;
1078 }
1079
1080 if (indent) {
1081 saveoptions |= XML_SAVE_FORMAT;
1082 }
1083 if (omitXMLDeclaration) {
1084 saveoptions |= XML_SAVE_NO_DECL;
1085 }
1086 if ((savectxtptr = xmlSaveToBuffer(bufptr, encoding, saveoptions)) == NULL) {
1087 Tcl_MutexUnlock(&libxml2);
1088 Tcl_Free((void *)serialized);
1089 xmlBufferFree(bufptr);
1090 Tcl_SetResult(interp, "unable to create save context", NULL);
1091 return TCL_ERROR;
1092 }
1093
1094 xmlSaveDoc(savectxtptr, docPtr);
1095 xmlSaveClose(savectxtptr);
1096
1097 Tcl_MutexUnlock(&libxml2);
1098
1099 Tcl_ExternalToUtfDString(tclencoding, (CONST char *) xmlBufferContent(bufptr), xmlBufferLength(bufptr), serialized);
1100 Tcl_DStringResult(interp, serialized);
1101
1102 Tcl_MutexLock(&libxml2);
1103 xmlBufferFree(bufptr);
1104 Tcl_MutexUnlock(&libxml2);
1105
1106 break;
1107
1108 case TCLDOM_SERIALIZE_METHOD_HTML:
1109
1110 Tcl_MutexLock(&libxml2);
1111 htmlSetMetaEncoding(docPtr, (const xmlChar *) "UTF-8");
1112 htmlDocDumpMemory(docPtr, &result, &len);
1113 Tcl_MutexUnlock(&libxml2);
1114 Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) result, len));
1115 xmlFree(result);
1116
1117 break;
1118
1119 case TCLDOM_SERIALIZE_METHOD_TEXT:
1120
1121 nodePtr = docPtr->children;
1122
1123 while (nodePtr != NULL) {
1124 if (nodePtr->type == XML_TEXT_NODE)
1125 Tcl_AppendResult(interp, (char *) nodePtr->content, NULL);
1126
1127 if (nodePtr->children != NULL) {
1128 if ((nodePtr->children->type != XML_ENTITY_DECL) &&
1129 (nodePtr->children->type != XML_ENTITY_REF_NODE) &&
1130 (nodePtr->children->type != XML_ENTITY_NODE)) {
1131 nodePtr = nodePtr->children;
1132 continue;
1133 }
1134 }
1135
1136 if (nodePtr->next != NULL) {
1137 nodePtr = nodePtr->next;
1138 continue;
1139 }
1140
1141 do {
1142 nodePtr = nodePtr->parent;
1143 if (nodePtr == NULL)
1144 break;
1145 if (nodePtr == (xmlNodePtr) docPtr) {
1146 nodePtr = NULL;
1147 break;
1148 }
1149 if (nodePtr->next != NULL) {
1150 nodePtr = nodePtr->next;
1151 break;
1152 }
1153 } while (nodePtr != NULL);
1154 }
1155
1156 break;
1157
1158 default:
1159 Tcl_SetResult(interp, "internal error", NULL);
1160 return TCL_ERROR;
1161 }
1162
1163 return TCL_OK;
1164 }
1165
1166 /*
1167 *----------------------------------------------------------------------------
1168 *
1169 * TclDOMDOMImplementationCommand --
1170 *
1171 * Implements dom::libxml2::DOMImplementation command
1172 *
1173 * Results:
1174 * Depends on method.
1175 *
1176 * Side effects:
1177 * Depends on method.
1178 *
1179 *----------------------------------------------------------------------------
1180 */
1181
1182 int
TclDOMDOMImplementationCommand(dummy,interp,objc,objv)1183 TclDOMDOMImplementationCommand (dummy, interp, objc, objv)
1184 ClientData dummy;
1185 Tcl_Interp *interp;
1186 int objc;
1187 Tcl_Obj *CONST objv[];
1188 {
1189 int method;
1190
1191 if (objc < 2) {
1192 Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?");
1193 return TCL_ERROR;
1194 }
1195
1196 if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_DOMImplementationCommandMethods,
1197 "method", 0, &method) != TCL_OK) {
1198 return TCL_ERROR;
1199 }
1200
1201 switch ((enum TclDOM_DOMImplementationCommandMethods) method) {
1202 case TCLDOM_IMPL_HASFEATURE:
1203 return TclDOM_HasFeatureCommand(dummy, interp, objc - 1, objv + 1);
1204 case TCLDOM_IMPL_CREATE:
1205 if (objc == 2) {
1206 return TclDOMCreateCommand(dummy, interp, 1, objv);
1207 } else if (objc == 3) {
1208 Tcl_Obj *objPtr;
1209 xmlDocPtr docPtr;
1210 xmlNodePtr nodePtr;
1211
1212 if (TclDOMCreateCommand(dummy, interp, 0, NULL) != TCL_OK) {
1213 return TCL_ERROR;
1214 }
1215 objPtr = Tcl_GetObjResult(interp);
1216 TclXML_libxml2_GetDocFromObj(interp, objPtr, &docPtr);
1217 Tcl_MutexLock(&libxml2);
1218 nodePtr = xmlNewDocNode(docPtr, NULL, (const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL), NULL);
1219 Tcl_MutexUnlock(&libxml2);
1220 if (nodePtr == NULL) {
1221 Tcl_SetResult(interp, "unable to create document element", NULL);
1222 return TCL_ERROR;
1223 }
1224
1225 Tcl_SetObjResult(interp, objPtr);
1226 } else {
1227 Tcl_WrongNumArgs(interp, 1, objv, "create ?doc?");
1228 return TCL_ERROR;
1229 }
1230
1231 break;
1232
1233 case TCLDOM_IMPL_PARSE:
1234 return TclDOMParseCommand(dummy, interp, objc - 1, objv + 1);
1235
1236 case TCLDOM_IMPL_SERIALIZE:
1237 return TclDOMSerializeCommand(dummy, interp, objc - 1, objv + 1);
1238
1239 case TCLDOM_IMPL_SELECTNODE:
1240 return TclDOMSelectNodeCommand(dummy, interp, objc - 1, objv + 1);
1241
1242 case TCLDOM_IMPL_DESTROY:
1243 return TclDOMDestroyCommand(dummy, interp, objc - 1, objv + 1);
1244
1245 case TCLDOM_IMPL_ISNODE:
1246 return TclDOMIsNodeCommand(dummy, interp, objc - 1, objv + 1);
1247
1248 default:
1249 Tcl_SetResult(interp, "method \"", NULL);
1250 Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL));
1251 Tcl_AppendResult(interp, "\" not yet implemented", NULL);
1252 return TCL_ERROR;
1253 }
1254
1255 return TCL_OK;
1256 }
1257
1258 /*
1259 *----------------------------------------------------------------------------
1260 *
1261 * [Schema|RNG][Compile|Validate] --
1262 *
1263 * Implements DTD, XML Schema and RelaxNG parsing and validation
1264 *
1265 * Results:
1266 * Depends on method.
1267 *
1268 * Side effects:
1269 * May create or destroy validation contexts.
1270 *
1271 *----------------------------------------------------------------------------
1272 */
1273
1274 int
DTDValidate(interp,domDocPtr)1275 DTDValidate (interp, domDocPtr)
1276 Tcl_Interp *interp;
1277 TclDOM_libxml2_Document *domDocPtr;
1278 {
1279 xmlValidCtxtPtr ctxt;
1280
1281 TclXML_libxml2_ResetError(interp);
1282
1283 Tcl_MutexLock(&libxml2);
1284
1285 ctxt = xmlNewValidCtxt();
1286 if (ctxt == NULL) {
1287 Tcl_MutexUnlock(&libxml2);
1288
1289 Tcl_SetResult(interp, "unable to prepare validation context", NULL);
1290 return TCL_ERROR;
1291 }
1292
1293 Tcl_SetResult(interp, "document is not valid", NULL);
1294
1295 if (xmlValidateDocument(ctxt, domDocPtr->tDocPtr->docPtr) == 0) {
1296 Tcl_Obj *errObjPtr;
1297
1298 Tcl_MutexUnlock(&libxml2);
1299
1300 errObjPtr = TclXML_libxml2_GetErrorObj(interp);
1301
1302 if (errObjPtr) {
1303 Tcl_IncrRefCount(errObjPtr);
1304 Tcl_SetObjResult(interp, errObjPtr);
1305 }
1306 return TCL_ERROR;
1307 }
1308
1309 Tcl_MutexUnlock(&libxml2);
1310
1311 Tcl_ResetResult(interp);
1312
1313 return TCL_OK;
1314 }
1315
1316 int
SchemaCompile(interp,domDocPtr)1317 SchemaCompile (interp, domDocPtr)
1318 Tcl_Interp *interp;
1319 TclDOM_libxml2_Document *domDocPtr;
1320 {
1321 xmlDocPtr schemaDocPtr;
1322 xmlSchemaParserCtxtPtr ctxt = NULL;
1323
1324 if (domDocPtr->schema) {
1325 /* Re-compile */
1326 Tcl_MutexLock(&libxml2);
1327 xmlSchemaFree(domDocPtr->schema);
1328 Tcl_MutexUnlock(&libxml2);
1329 domDocPtr->schema = NULL;
1330 }
1331
1332 Tcl_MutexLock(&libxml2);
1333
1334 schemaDocPtr = xmlCopyDoc(domDocPtr->tDocPtr->docPtr, 1);
1335
1336 if (schemaDocPtr == NULL) {
1337 Tcl_MutexUnlock(&libxml2);
1338 Tcl_SetResult(interp, "unable to prepare schema document", NULL);
1339 return TCL_ERROR;
1340 }
1341
1342 ctxt = xmlSchemaNewDocParserCtxt(schemaDocPtr);
1343 if (ctxt == NULL) {
1344 xmlFreeDoc(schemaDocPtr);
1345 Tcl_MutexUnlock(&libxml2);
1346 Tcl_SetResult(interp, "unable to create schema context", NULL);
1347 return TCL_ERROR;
1348 }
1349
1350 TclXML_libxml2_ResetError(interp);
1351
1352 Tcl_SetResult(interp, "unable to parse schema document", NULL);
1353 domDocPtr->schema = xmlSchemaParse(ctxt);
1354 #if 0
1355 xmlSchemaFreeParserCtxt(ctxt); /* This frees the doc */
1356 #endif
1357 Tcl_MutexUnlock(&libxml2);
1358
1359 if (domDocPtr->schema == NULL) {
1360 Tcl_Obj * errObjPtr = TclXML_libxml2_GetErrorObj(interp);
1361
1362 if (errObjPtr) {
1363 Tcl_SetObjResult(interp, errObjPtr);
1364 }
1365
1366 return TCL_ERROR;
1367 }
1368
1369 Tcl_ResetResult(interp);
1370
1371 return TCL_OK;
1372 }
1373
1374 int
SchemaValidate(interp,domDocPtr,instancePtr)1375 SchemaValidate (interp, domDocPtr, instancePtr)
1376 Tcl_Interp *interp;
1377 TclDOM_libxml2_Document *domDocPtr;
1378 xmlDocPtr instancePtr;
1379 {
1380 xmlSchemaValidCtxtPtr ctxt = NULL;
1381 Tcl_Obj *errObjPtr;
1382 int ret;
1383
1384 if (domDocPtr->schema == NULL) {
1385 Tcl_SetResult(interp, "schema not compiled", NULL);
1386 return TCL_ERROR;
1387 }
1388
1389 TclXML_libxml2_ResetError(interp);
1390
1391 Tcl_MutexLock(&libxml2);
1392
1393 ctxt = xmlSchemaNewValidCtxt(domDocPtr->schema);
1394
1395 Tcl_SetResult(interp, "document is not valid", NULL);
1396
1397 ret = xmlSchemaValidateDoc(ctxt, instancePtr);
1398 errObjPtr = TclXML_libxml2_GetErrorObj(interp);
1399 if (ret > 0) {
1400 if (errObjPtr) {
1401 Tcl_SetObjResult(interp, errObjPtr);
1402 }
1403 goto error;
1404 } else if (ret < 0) {
1405 Tcl_SetResult(interp, "schema processor internal error", NULL);
1406
1407 if (errObjPtr) {
1408 Tcl_SetObjResult(interp, errObjPtr);
1409 }
1410 goto error;
1411 }
1412
1413 xmlSchemaFreeValidCtxt(ctxt);
1414
1415 Tcl_MutexUnlock(&libxml2);
1416
1417 /* There may be warnings */
1418
1419 if (errObjPtr) {
1420 Tcl_SetObjResult(interp, errObjPtr);
1421 } else {
1422 Tcl_ResetResult(interp);
1423 }
1424
1425 return TCL_OK;
1426
1427 error:
1428 if (ctxt) {
1429 xmlSchemaFreeValidCtxt(ctxt);
1430 }
1431
1432 Tcl_MutexUnlock(&libxml2);
1433
1434 return TCL_ERROR;
1435 }
1436
1437 /*
1438 * RelaxNG validation.
1439 */
1440 int
RelaxNGCompile(interp,domDocPtr)1441 RelaxNGCompile (interp, domDocPtr)
1442 Tcl_Interp *interp;
1443 TclDOM_libxml2_Document *domDocPtr;
1444 {
1445 xmlDocPtr relaxNGDocPtr;
1446 xmlRelaxNGParserCtxtPtr ctxt = NULL;
1447
1448 if (domDocPtr->relaxng) {
1449 /* Re-compile */
1450 Tcl_MutexLock(&libxml2);
1451 xmlRelaxNGFree(domDocPtr->relaxng);
1452 Tcl_MutexUnlock(&libxml2);
1453 domDocPtr->relaxng = NULL;
1454 }
1455
1456 Tcl_MutexLock(&libxml2);
1457
1458 relaxNGDocPtr = xmlCopyDoc(domDocPtr->tDocPtr->docPtr, 1);
1459
1460 if (relaxNGDocPtr == NULL) {
1461 Tcl_MutexUnlock(&libxml2);
1462 Tcl_SetResult(interp, "unable to prepare RELAX NG schema document", NULL);
1463 return TCL_ERROR;
1464 }
1465
1466 ctxt = xmlRelaxNGNewDocParserCtxt(relaxNGDocPtr);
1467 if (ctxt == NULL) {
1468 xmlFreeDoc(relaxNGDocPtr);
1469 Tcl_MutexUnlock(&libxml2);
1470 Tcl_SetResult(interp, "unable to create RELAX NG schema context", NULL);
1471 return TCL_ERROR;
1472 }
1473
1474 TclXML_libxml2_ResetError(interp);
1475
1476 /* TODO: setup warning and error callbacks */
1477
1478 Tcl_SetResult(interp, "unable to parse RELAX NG schema document", NULL);
1479 domDocPtr->relaxng = xmlRelaxNGParse(ctxt);
1480
1481 Tcl_MutexUnlock(&libxml2);
1482
1483 if (domDocPtr->relaxng == NULL) {
1484 Tcl_Obj * errObjPtr = TclXML_libxml2_GetErrorObj(interp);
1485
1486 if (errObjPtr) {
1487 Tcl_SetObjResult(interp, errObjPtr);
1488 }
1489
1490 return TCL_ERROR;
1491 }
1492
1493 Tcl_ResetResult(interp);
1494
1495 return TCL_OK;
1496 }
1497
1498 int
RelaxNGValidate(interp,domDocPtr,instancePtr)1499 RelaxNGValidate (interp, domDocPtr, instancePtr)
1500 Tcl_Interp *interp;
1501 TclDOM_libxml2_Document *domDocPtr;
1502 xmlDocPtr instancePtr;
1503 {
1504 xmlRelaxNGValidCtxtPtr ctxt = NULL;
1505 Tcl_Obj *errObjPtr;
1506 int ret;
1507
1508 if (domDocPtr->relaxng == NULL) {
1509 Tcl_SetResult(interp, "RELAX NG schema not compiled", NULL);
1510 return TCL_ERROR;
1511 }
1512
1513 TclXML_libxml2_ResetError(interp);
1514
1515 Tcl_MutexLock(&libxml2);
1516
1517 ctxt = xmlRelaxNGNewValidCtxt(domDocPtr->relaxng);
1518
1519 Tcl_SetResult(interp, "document is not valid", NULL);
1520
1521 ret = xmlRelaxNGValidateDoc(ctxt, instancePtr);
1522 errObjPtr = TclXML_libxml2_GetErrorObj(interp);
1523 if (ret > 0) {
1524 if (errObjPtr) {
1525 Tcl_SetObjResult(interp, errObjPtr);
1526 }
1527 goto error;
1528 } else if (ret < 0) {
1529 Tcl_SetResult(interp, "RELAX NG schema processor internal error", NULL);
1530
1531 if (errObjPtr) {
1532 Tcl_SetObjResult(interp, errObjPtr);
1533 }
1534 goto error;
1535 }
1536
1537 xmlRelaxNGFreeValidCtxt(ctxt);
1538
1539 Tcl_MutexUnlock(&libxml2);
1540
1541 /* There may be warnings */
1542
1543 if (errObjPtr) {
1544 Tcl_SetObjResult(interp, errObjPtr);
1545 } else {
1546 Tcl_ResetResult(interp);
1547 }
1548
1549 return TCL_OK;
1550
1551 error:
1552 if (ctxt) {
1553 xmlRelaxNGFreeValidCtxt(ctxt);
1554 }
1555
1556 Tcl_MutexUnlock(&libxml2);
1557
1558 return TCL_ERROR;
1559 }
1560
1561 int
TclDOMTrimCommand(dummy,interp,objc,objv)1562 TclDOMTrimCommand (dummy, interp, objc, objv)
1563 ClientData dummy;
1564 Tcl_Interp *interp;
1565 int objc;
1566 Tcl_Obj *CONST objv[];
1567 {
1568 xmlDocPtr docPtr;
1569
1570 if (objc != 2) {
1571 Tcl_WrongNumArgs(interp, 1, objv, "doc");
1572 }
1573
1574 if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
1575 return TCL_ERROR;
1576 }
1577
1578 TrimDocument(interp, docPtr);
1579
1580 return TCL_OK;
1581 }
1582
1583 /*
1584 * Remove all blank text nodes
1585 *
1586 * NB. This code mostly copied from xmlschemas.c
1587 */
1588
1589 /** Copied directly from xmlschemas.c:
1590 *
1591 * xmlSchemaIsBlank:
1592 * @str: a string
1593 *
1594 * Check if a string is ignorable
1595 *
1596 * Returns 1 if the string is NULL or made of blanks chars, 0 otherwise
1597 */
1598 /* SRB: 2008-11-24: Updated against libxml2 2.7.2.
1599 */
1600 #define IS_BLANK_NODE(n) \
1601 (((n)->type == XML_TEXT_NODE) && (xmlSchemaIsBlank((n)->content, -1)))
1602
1603 /*
1604 * SRB: 2008-06-12: Updated against libxml2 2.6.32.
1605 * See also SF bug 1943963.
1606 */
1607
1608 static int
xmlSchemaIsBlank(xmlChar * str,int len)1609 xmlSchemaIsBlank(xmlChar *str, int len) {
1610 if (str == NULL)
1611 return(1);
1612 if (len < 0) {
1613 while (*str != 0) {
1614 if (!(IS_BLANK_CH(*str))) return(0);
1615 str++;
1616 }
1617 } else {
1618 while ((*str != 0) && (len != 0)) {
1619 if (!(IS_BLANK_CH(*str))) return (0);
1620 str++;
1621 len--;
1622 }
1623 }
1624 return(1);
1625 }
1626
1627 static void
TrimDocument(interp,docPtr)1628 TrimDocument(interp, docPtr)
1629 Tcl_Interp *interp;
1630 xmlDocPtr docPtr;
1631 {
1632 xmlNodePtr root, cur, delete;
1633 Tcl_Obj *nodeObjPtr;
1634 TclDOM_libxml2_Node *tNodePtr = NULL;
1635
1636 delete = NULL;
1637 root = xmlDocGetRootElement(docPtr);
1638 if (root == NULL) {
1639 return;
1640 }
1641 cur = root;
1642
1643 while (cur != NULL) {
1644 if (delete != NULL) {
1645 nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, delete);
1646 TclDOM_libxml2_GetTclNodeFromObj(interp, nodeObjPtr, &tNodePtr);
1647 TclDOM_libxml2_InvalidateNode(tNodePtr);
1648 Tcl_DecrRefCount(nodeObjPtr);
1649 xmlUnlinkNode(delete);
1650 xmlFreeNode(delete);
1651 delete = NULL;
1652 }
1653 if (cur->type == XML_TEXT_NODE) {
1654 if (IS_BLANK_NODE(cur)) {
1655 if (xmlNodeGetSpacePreserve(cur) != 1) {
1656 delete = cur;
1657 }
1658 }
1659 } else if ((cur->type != XML_ELEMENT_NODE) &&
1660 (cur->type != XML_CDATA_SECTION_NODE)) {
1661 delete = cur;
1662 goto skip_children;
1663 }
1664
1665 /*
1666 * Skip to next node
1667 */
1668 if (cur->children != NULL) {
1669 if ((cur->children->type != XML_ENTITY_DECL) &&
1670 (cur->children->type != XML_ENTITY_REF_NODE) &&
1671 (cur->children->type != XML_ENTITY_NODE)) {
1672 cur = cur->children;
1673 continue;
1674 }
1675 }
1676 skip_children:
1677 if (cur->next != NULL) {
1678 cur = cur->next;
1679 continue;
1680 }
1681
1682 do {
1683 cur = cur->parent;
1684 if (cur == NULL)
1685 break;
1686 if (cur == root) {
1687 cur = NULL;
1688 break;
1689 }
1690 if (cur->next != NULL) {
1691 cur = cur->next;
1692 break;
1693 }
1694 } while (cur != NULL);
1695 }
1696 if (delete != NULL) {
1697 nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, delete);
1698 TclDOM_libxml2_GetTclNodeFromObj(interp, nodeObjPtr, &tNodePtr);
1699 TclDOM_libxml2_InvalidateNode(tNodePtr);
1700 Tcl_DecrRefCount(nodeObjPtr);
1701 xmlUnlinkNode(delete);
1702 xmlFreeNode(delete);
1703 delete = NULL;
1704 }
1705
1706 return;
1707 }
1708
1709 /*
1710 *----------------------------------------------------------------------------
1711 *
1712 * TclDOMXIncludeCommand --
1713 *
1714 * Implements dom::libxml2::xinclude command.
1715 *
1716 * Results:
1717 * Performs XInclude processing on a document.
1718 *
1719 * Side effects:
1720 * The supplied DOM tree may be modified.
1721 *
1722 *----------------------------------------------------------------------------
1723 */
1724 int
TclDOMXIncludeCommand(dummy,interp,objc,objv)1725 TclDOMXIncludeCommand (dummy, interp, objc, objv)
1726 ClientData dummy;
1727 Tcl_Interp *interp;
1728 int objc;
1729 Tcl_Obj *CONST objv[];
1730 {
1731 xmlDocPtr docPtr;
1732 int subs;
1733
1734 if (objc != 2) {
1735 Tcl_WrongNumArgs(interp, 1, objv, "doc");
1736 return TCL_ERROR;
1737 }
1738
1739 if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
1740 return TCL_ERROR;
1741 }
1742
1743 Tcl_MutexLock(&libxml2);
1744 subs = xmlXIncludeProcess(docPtr);
1745 Tcl_MutexUnlock(&libxml2);
1746
1747 if (subs < 0) {
1748 Tcl_SetResult(interp, "unable to complete XInclude processing", NULL);
1749 return TCL_ERROR;
1750 }
1751
1752 Tcl_SetObjResult(interp, Tcl_NewIntObj(subs));
1753 return TCL_OK;
1754 }
1755
1756 /*
1757 *----------------------------------------------------------------------------
1758 *
1759 * TclDOMPrefix2NSCommand --
1760 *
1761 * Implements dom::libxml2::prefix2namespaceURI command.
1762 *
1763 * Results:
1764 * Returns namespace URI for a given prefix.
1765 *
1766 * Side effects:
1767 * None.
1768 *
1769 *----------------------------------------------------------------------------
1770 */
1771 int
TclDOMPrefix2NSCommand(dummy,interp,objc,objv)1772 TclDOMPrefix2NSCommand (dummy, interp, objc, objv)
1773 ClientData dummy;
1774 Tcl_Interp *interp;
1775 int objc;
1776 Tcl_Obj *CONST objv[];
1777 {
1778 xmlNodePtr nodePtr;
1779 xmlNsPtr nsPtr;
1780
1781 if (objc != 3) {
1782 Tcl_WrongNumArgs(interp, 1, objv, "node prefix");
1783 return TCL_ERROR;
1784 }
1785
1786 if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) != TCL_OK) {
1787 return TCL_ERROR;
1788 }
1789
1790 nsPtr = xmlSearchNs(nodePtr->doc, nodePtr, (const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL));
1791
1792 if (!nsPtr) {
1793 Tcl_SetResult(interp, "no XML Namespace declaration", NULL);
1794 return TCL_ERROR;
1795 }
1796
1797 Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nsPtr->href, -1));
1798 return TCL_OK;
1799 }
1800
1801 /*
1802 *----------------------------------------------------------------------------
1803 *
1804 * TclDOMIsNodeCommand --
1805 *
1806 * Implements dom::libxml2::isNode command.
1807 *
1808 * Results:
1809 * Returns boolean.
1810 *
1811 * Side effects:
1812 * Tcl object may be converted to internal rep.
1813 *
1814 *----------------------------------------------------------------------------
1815 */
1816
1817 int
TclDOMIsNodeCommand(dummy,interp,objc,objv)1818 TclDOMIsNodeCommand (dummy, interp, objc, objv)
1819 ClientData dummy;
1820 Tcl_Interp *interp;
1821 int objc;
1822 Tcl_Obj *CONST objv[];
1823 {
1824 xmlDocPtr docPtr;
1825 xmlNodePtr nodePtr;
1826 TclDOM_libxml2_Node *tNodePtr;
1827
1828 if (objc != 2) {
1829 Tcl_WrongNumArgs(interp, 1, objv, "token");
1830 return TCL_ERROR;
1831 }
1832
1833 if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) != TCL_OK) {
1834 if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
1835 if (TclDOM_libxml2_GetTclEventFromObj(interp, objv[1], &tNodePtr) != TCL_OK) {
1836 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
1837 } else {
1838 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
1839 }
1840 } else {
1841 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
1842 }
1843 } else {
1844 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
1845 }
1846
1847 return TCL_OK;
1848 }
1849
1850 /*
1851 *----------------------------------------------------------------------------
1852 *
1853 * TclDOMSelectNodeCommand --
1854 *
1855 * Implements dom::libxml2::selectnode command.
1856 *
1857 * Results:
1858 * Returns result of XPath expression evaluation.
1859 *
1860 * Side effects:
1861 * Memory is allocated for Tcl object to return result.
1862 *
1863 *----------------------------------------------------------------------------
1864 */
1865
1866 int
TclDOMSelectNodeCommand(dummy,interp,objc,objv)1867 TclDOMSelectNodeCommand (dummy, interp, objc, objv)
1868 ClientData dummy;
1869 Tcl_Interp *interp;
1870 int objc;
1871 Tcl_Obj *CONST objv[];
1872 {
1873 int i, len, option;
1874 char *path;
1875 Tcl_Obj *objPtr, *nsOptPtr = NULL, *nodeObjPtr;
1876 xmlDocPtr docPtr;
1877 xmlNodePtr nodePtr = NULL;
1878 xmlXPathContextPtr ctxt = NULL;
1879 xmlXPathObjectPtr xpathObj = NULL;
1880
1881 if (objc < 3) {
1882 Tcl_WrongNumArgs(interp, 1, objv, "doc location-path ?option value...?");
1883 return TCL_ERROR;
1884 }
1885
1886 path = Tcl_GetStringFromObj(objv[2], &len);
1887 if (len == 0) {
1888 return TCL_OK;
1889 }
1890
1891 if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
1892 if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) == TCL_OK) {
1893 docPtr = nodePtr->doc;
1894 } else {
1895 return TCL_ERROR;
1896 }
1897 }
1898
1899 for (i = 3; i < objc; i += 2) {
1900 if (i == objc - 1) {
1901 Tcl_AppendResult(interp, "missing value for option \"", Tcl_GetStringFromObj(objv[i], NULL), "\"", NULL);
1902 return TCL_ERROR;
1903 }
1904 if (Tcl_GetIndexFromObj(interp, objv[i], TclDOM_SelectNodeOptions,
1905 "option", 0, &option) != TCL_OK) {
1906 goto opt_error;
1907 }
1908 switch ((enum TclDOM_SelectNodeOptions) option) {
1909
1910 case TCLDOM_SELECTNODE_OPTION_NAMESPACES:
1911 if (nsOptPtr) {
1912 if (Tcl_ListObjAppendList(interp, nsOptPtr, objv[i + 1]) != TCL_OK) {
1913 Tcl_SetResult(interp, "-namespaces option value must be a list", NULL);
1914 goto opt_error;
1915 }
1916 } else {
1917 nsOptPtr = Tcl_DuplicateObj(objv[i + 1]);
1918 }
1919 if (Tcl_ListObjLength(interp, nsOptPtr, &len) != TCL_OK) {
1920 Tcl_SetResult(interp, "-namespaces option value must be a list", NULL);
1921 goto opt_error;
1922 } else if (len % 2 != 0) {
1923 Tcl_SetResult(interp, "value missing from namespaces list", NULL);
1924 goto opt_error;
1925 }
1926
1927 break;
1928
1929 default:
1930 Tcl_AppendResult(interp, "unknown option \"", Tcl_GetStringFromObj(objv[i], NULL), "\"", NULL);
1931 goto opt_error;
1932 }
1933 }
1934
1935 Tcl_MutexLock(&libxml2);
1936 ctxt = xmlXPathNewContext(docPtr);
1937 if (ctxt == NULL) {
1938 Tcl_SetResult(interp, "unable to create XPath context", NULL);
1939 return TCL_ERROR;
1940 }
1941
1942 if (nodePtr) {
1943 ctxt->node = nodePtr;
1944 }
1945
1946 TclXML_libxml2_ResetError(interp);
1947
1948 /*
1949 * Setup any XML Namespace prefixes given as arguments
1950 */
1951 if (nsOptPtr) {
1952 Tcl_ListObjLength(interp, nsOptPtr, &len);
1953 for (i = 0; i < len; i += 2) {
1954 Tcl_Obj *prefixPtr, *nsURIPtr;
1955
1956 Tcl_ListObjIndex(interp, nsOptPtr, i, &prefixPtr);
1957 Tcl_ListObjIndex(interp, nsOptPtr, i + 1, &nsURIPtr);
1958 if (xmlXPathRegisterNs(ctxt,
1959 (const xmlChar *) Tcl_GetStringFromObj(prefixPtr, NULL),
1960 (const xmlChar *) Tcl_GetStringFromObj(nsURIPtr, NULL))) {
1961 Tcl_ResetResult(interp);
1962 Tcl_AppendResult(interp, "unable to register XML Namespace \"", Tcl_GetStringFromObj(nsURIPtr, NULL), "\"", NULL);
1963 goto error;
1964 }
1965 }
1966 }
1967
1968 xpathObj = xmlXPathEval((const xmlChar *) path, ctxt);
1969
1970 if (xpathObj == NULL) {
1971 Tcl_Obj *errObjPtr = TclXML_libxml2_GetErrorObj(interp);
1972
1973 if (errObjPtr) {
1974 Tcl_SetObjResult(interp, errObjPtr);
1975 goto error;
1976 } else {
1977 Tcl_SetResult(interp, "error evaluating XPath location path", NULL);
1978 goto error;
1979 }
1980 }
1981
1982 objPtr = Tcl_NewObj();
1983 switch (xpathObj->type) {
1984
1985 case XPATH_NODESET:
1986 len = xmlXPathNodeSetGetLength(xpathObj->nodesetval);
1987 for (i = 0; i < len; i++) {
1988 nodePtr = xmlXPathNodeSetItem(xpathObj->nodesetval, i);
1989 nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, nodePtr);
1990 if (nodeObjPtr != NULL) {
1991 Tcl_ListObjAppendElement(interp, objPtr, nodeObjPtr);
1992 } else {
1993 Tcl_MutexUnlock(&libxml2);
1994 Tcl_DecrRefCount(objPtr);
1995 return TCL_ERROR;
1996 }
1997 }
1998 break;
1999
2000 case XPATH_BOOLEAN:
2001 Tcl_SetBooleanObj(objPtr, xpathObj->boolval);
2002 break;
2003
2004 case XPATH_NUMBER:
2005 Tcl_SetDoubleObj(objPtr, xpathObj->floatval);
2006 break;
2007
2008 case XPATH_STRING:
2009 Tcl_SetStringObj(objPtr,
2010 (CONST char *) xpathObj->stringval,
2011 strlen((char *) xpathObj->stringval));
2012 break;
2013
2014 default:
2015 Tcl_SetResult(interp, "bad XPath object type", NULL);
2016 goto error2;
2017 }
2018
2019 if (nsOptPtr) {
2020 Tcl_DecrRefCount(nsOptPtr);
2021 }
2022 xmlXPathFreeObject(xpathObj);
2023 xmlXPathFreeContext(ctxt);
2024
2025 Tcl_MutexUnlock(&libxml2);
2026
2027 Tcl_SetObjResult(interp, objPtr);
2028 return TCL_OK;
2029
2030 opt_error:
2031
2032 Tcl_MutexUnlock(&libxml2);
2033
2034 if (nsOptPtr) {
2035 Tcl_DecrRefCount(nsOptPtr);
2036 return TCL_ERROR;
2037 }
2038
2039 error2:
2040 if (nsOptPtr) {
2041 Tcl_DecrRefCount(nsOptPtr);
2042 }
2043 xmlXPathFreeObject(xpathObj);
2044 xmlXPathFreeContext(ctxt);
2045
2046 Tcl_MutexUnlock(&libxml2);
2047
2048 return TCL_ERROR;
2049
2050 error:
2051 if (nsOptPtr) {
2052 Tcl_DecrRefCount(nsOptPtr);
2053 }
2054 xmlXPathFreeContext(ctxt);
2055
2056 Tcl_MutexUnlock(&libxml2);
2057
2058 return TCL_ERROR;
2059 }
2060
2061 /*
2062 *----------------------------------------------------------------------------
2063 *
2064 * TclDOMDocumentCommand --
2065 *
2066 * Implements dom::libxml2::document command.
2067 *
2068 * Results:
2069 * Depends on method.
2070 *
2071 * Side effects:
2072 * Depends on method.
2073 *
2074 *----------------------------------------------------------------------------
2075 */
2076
2077 int
TclDOMDocumentCommand(clientData,interp,objc,objv)2078 TclDOMDocumentCommand (clientData, interp, objc, objv)
2079 ClientData clientData;
2080 Tcl_Interp *interp;
2081 int objc;
2082 Tcl_Obj *CONST objv[];
2083 {
2084 TclXML_libxml2_Document *tDocPtr;
2085 TclDOM_libxml2_Document *domDocPtr = NULL;
2086 enum TclDOM_EventTypes type;
2087 int method, optobjc, wrongidx = 1, postMutationEvent = 0, idx, len;
2088 xmlDocPtr docPtr = NULL;
2089 xmlNodePtr nodePtr = NULL, newNodePtr = NULL;
2090 xmlNsPtr nsPtr = NULL;
2091 Tcl_Obj *nodeObjPtr = NULL, *newNodeObjPtr = NULL;
2092 Tcl_Obj *CONST *optobjv;
2093 char *buf, *bufptr, *prefix;
2094
2095 if (clientData == NULL) {
2096 if (objc < 3) {
2097 Tcl_WrongNumArgs(interp, 2, objv, "method token ?args...?");
2098 return TCL_ERROR;
2099 }
2100
2101 if (TclXML_libxml2_GetTclDocFromObj(interp, objv[2], &tDocPtr) != TCL_OK) {
2102 tDocPtr = NULL;
2103 docPtr = NULL;
2104 if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
2105 return TCL_ERROR;
2106 } else {
2107 nodeObjPtr = objv[2];
2108 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
2109 return TCL_ERROR;
2110 }
2111 }
2112 } else {
2113 docPtr = tDocPtr->docPtr;
2114 domDocPtr = GetDOMDocument(interp, tDocPtr);
2115 if (domDocPtr == NULL) {
2116 Tcl_SetResult(interp, "internal error", NULL);
2117 return TCL_ERROR;
2118 }
2119 }
2120
2121 optobjv = objv + 3;
2122 optobjc = objc - 3;
2123 wrongidx = 3;
2124
2125 } else {
2126 if (objc < 2) {
2127 Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?");
2128 return TCL_ERROR;
2129 }
2130
2131 domDocPtr = (TclDOM_libxml2_Document *) clientData;
2132 tDocPtr = domDocPtr->tDocPtr;
2133 docPtr = tDocPtr->docPtr;
2134
2135 optobjv = objv + 2;
2136 optobjc = objc - 2;
2137 wrongidx = 2;
2138 }
2139
2140 if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_DocumentCommandMethods,
2141 "method", 0, &method) != TCL_OK) {
2142 return TCL_ERROR;
2143 }
2144
2145 Tcl_ResetResult(interp);
2146
2147 switch ((enum TclDOM_DocumentCommandMethods) method) {
2148
2149 case TCLDOM_DOCUMENT_CGET:
2150
2151 if (optobjc != 1) {
2152 Tcl_WrongNumArgs(interp, wrongidx, objv, "option");
2153 return TCL_ERROR;
2154 }
2155
2156 if (!docPtr) {
2157 Tcl_SetResult(interp, "not a document", NULL);
2158 return TCL_ERROR;
2159 }
2160
2161 return DocumentCget(interp, docPtr, optobjv[0]);
2162
2163 break;
2164
2165 case TCLDOM_DOCUMENT_CONFIGURE:
2166
2167 if (!docPtr) {
2168 Tcl_SetResult(interp, "not a document", NULL);
2169 return TCL_ERROR;
2170 }
2171
2172 if (optobjc == 1) {
2173 return DocumentCget(interp, docPtr, optobjv[0]);
2174 } else {
2175 return DocumentConfigure(interp, docPtr, optobjc, optobjv);
2176 }
2177
2178 break;
2179
2180 case TCLDOM_DOCUMENT_CREATEELEMENTNS:
2181 if (optobjc != 2) {
2182 Tcl_WrongNumArgs(interp, wrongidx, objv, "nsuri qualname");
2183 return TCL_ERROR;
2184 }
2185
2186 /*
2187 * libxml2 doesn't check for invalid element name,
2188 * so must do that here.
2189 */
2190 if (Tcl_RegExpMatchObj(interp, optobjv[1], checkQName) == 0) {
2191 Tcl_SetResult(interp, "invalid element name", NULL);
2192 return TCL_ERROR;
2193 }
2194
2195 /* Find localName of element */
2196 buf = Tcl_GetStringFromObj(optobjv[1], &len);
2197 for (idx = 0; buf[idx] != ':' && idx < len; idx++) ;
2198 if (idx == len) {
2199 /* no prefix was given */
2200 bufptr = buf;
2201 } else {
2202 /* NB. name must have a local part, since it is a valid QName */
2203 bufptr = &buf[idx + 1];
2204 }
2205
2206 if (docPtr && clientData == NULL) {
2207 /* We're creating the document element, so must create the namespace too */
2208 xmlNodePtr old;
2209
2210 Tcl_MutexLock(&libxml2);
2211 newNodePtr = xmlNewDocNode(docPtr, NULL, (const xmlChar *) bufptr, NULL);
2212 if (newNodePtr == NULL) {
2213 Tcl_SetResult(interp, "unable to create element node", NULL);
2214 Tcl_MutexUnlock(&libxml2);
2215 return TCL_ERROR;
2216 }
2217 old = xmlDocSetRootElement(docPtr, newNodePtr);
2218 if (old) {
2219 xmlDocSetRootElement(docPtr, old);
2220 xmlFreeNode(newNodePtr);
2221 Tcl_SetResult(interp, "document element already exists", NULL);
2222 Tcl_MutexUnlock(&libxml2);
2223 return TCL_ERROR;
2224 }
2225
2226 if (idx < len) {
2227 prefix = Tcl_Alloc(bufptr - buf);
2228 strncpy(prefix, buf, bufptr - buf - 1);
2229 prefix[bufptr - buf - 1] = '\0';
2230 } else {
2231 /* synthesize prefix for this XML Namespace */
2232 prefix = Tcl_Alloc(20);
2233 sprintf(prefix, "ns%d", domDocPtr->nodeCntr++);
2234 }
2235
2236 nsPtr = xmlNewNs(newNodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), (const xmlChar *) prefix);
2237 if (nsPtr == NULL) {
2238 Tcl_SetResult(interp, "unable to create XML Namespace", NULL);
2239 Tcl_Free(prefix);
2240 xmlUnlinkNode(newNodePtr);
2241 xmlFreeNode(newNodePtr);
2242 Tcl_MutexUnlock(&libxml2);
2243 return TCL_ERROR;
2244 }
2245
2246 xmlSetNs(newNodePtr, nsPtr);
2247
2248 Tcl_MutexUnlock(&libxml2);
2249
2250 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2251 if (newNodeObjPtr == NULL) {
2252 Tcl_MutexLock(&libxml2);
2253 xmlFreeNode(newNodePtr);
2254 Tcl_MutexUnlock(&libxml2);
2255
2256 return TCL_ERROR;
2257 }
2258
2259 postMutationEvent = 1;
2260
2261 } else if (docPtr && clientData != NULL) {
2262 /* Create an unattached element node */
2263 Tcl_MutexLock(&libxml2);
2264 newNodePtr = xmlNewDocNode(docPtr, NULL, (const xmlChar *) bufptr, NULL);
2265
2266 if (idx < len) {
2267 prefix = Tcl_Alloc(bufptr - buf);
2268 strncpy(prefix, buf, bufptr - buf - 1);
2269 prefix[bufptr - buf - 1] = '\0';
2270 } else {
2271 /* synthesize prefix for this XML Namespace */
2272 prefix = Tcl_Alloc(20);
2273 sprintf(prefix, "ns%d", domDocPtr->nodeCntr);
2274 }
2275
2276 nsPtr = xmlNewNs(newNodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), (const xmlChar *) prefix);
2277 if (nsPtr == NULL) {
2278 Tcl_SetResult(interp, "unable to create XML Namespace", NULL);
2279 Tcl_Free(prefix);
2280 xmlUnlinkNode(newNodePtr);
2281 xmlFreeNode(newNodePtr);
2282 Tcl_MutexUnlock(&libxml2);
2283 return TCL_ERROR;
2284 }
2285
2286 xmlSetNs(newNodePtr, nsPtr);
2287
2288 Tcl_MutexUnlock(&libxml2);
2289
2290 if (newNodePtr == NULL) {
2291 Tcl_SetResult(interp, "unable to create element node", NULL);
2292 return TCL_ERROR;
2293 }
2294
2295 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2296 if (newNodeObjPtr == NULL) {
2297 Tcl_MutexLock(&libxml2);
2298 xmlFreeNode(newNodePtr);
2299 Tcl_MutexUnlock(&libxml2);
2300 return TCL_ERROR;
2301 } else {
2302 Tcl_SetObjResult(interp, newNodeObjPtr);
2303 }
2304
2305 /*
2306 * The tree hasn't changed yet, so no events need to be fired.
2307 */
2308 postMutationEvent = 0;
2309
2310 } else {
2311
2312 Tcl_MutexLock(&libxml2);
2313 /* Find XML Namespace */
2314 nsPtr = xmlSearchNsByHref(nodePtr->doc,
2315 nodePtr,
2316 (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
2317 if (nsPtr == NULL) {
2318 if (idx < len) {
2319 prefix = Tcl_Alloc(bufptr - buf);
2320 strncpy(prefix, buf, bufptr - buf - 1);
2321 prefix[bufptr - buf - 1] = '\0';
2322 } else {
2323 prefix = Tcl_Alloc(20);
2324 sprintf(prefix, "ns%d", domDocPtr->nodeCntr++);
2325 }
2326
2327 newNodePtr = xmlNewChild(nodePtr, NULL, (const xmlChar *) bufptr, NULL);
2328 nsPtr = xmlNewNs(newNodePtr,
2329 (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
2330 (const xmlChar *) prefix);
2331 if (nsPtr == NULL) {
2332 Tcl_SetResult(interp, "unable to create XML Namespace", NULL);
2333 Tcl_MutexUnlock(&libxml2);
2334 return TCL_ERROR;
2335 }
2336 xmlSetNs(newNodePtr, nsPtr);
2337
2338 } else {
2339 newNodePtr = xmlNewChild(nodePtr, nsPtr, (const xmlChar *) bufptr, NULL);
2340 if (newNodePtr == NULL) {
2341 Tcl_SetResult(interp, "unable to create element node", NULL);
2342 Tcl_MutexUnlock(&libxml2);
2343 return TCL_ERROR;
2344 }
2345 }
2346
2347 Tcl_MutexUnlock(&libxml2);
2348
2349 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2350 if (newNodeObjPtr == NULL) {
2351 Tcl_MutexLock(&libxml2);
2352 xmlFreeNode(newNodePtr);
2353 Tcl_MutexUnlock(&libxml2);
2354 return TCL_ERROR;
2355 }
2356
2357 postMutationEvent = 1;
2358 }
2359
2360 break;
2361
2362 case TCLDOM_DOCUMENT_CREATEELEMENT:
2363
2364 if (optobjc != 1) {
2365 Tcl_WrongNumArgs(interp, wrongidx, objv, "name");
2366 return TCL_ERROR;
2367 }
2368
2369 /*
2370 * libxml2 doesn't check for invalid element name,
2371 * so must do that here.
2372 */
2373 if (Tcl_RegExpMatchObj(interp, optobjv[0], checkName) == 0) {
2374 Tcl_AppendResult(interp, "invalid element name \"", Tcl_GetStringFromObj(optobjv[0], NULL), "\"", NULL);
2375 return TCL_ERROR;
2376 }
2377
2378 Tcl_MutexLock(&libxml2);
2379
2380 if (docPtr && clientData == NULL) {
2381 xmlNodePtr old;
2382 newNodePtr = xmlNewDocNode(docPtr,
2383 NULL,
2384 (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
2385 NULL);
2386 if (newNodePtr == NULL) {
2387 Tcl_SetResult(interp, "unable to create element node", NULL);
2388 Tcl_MutexUnlock(&libxml2);
2389 return TCL_ERROR;
2390 }
2391 old = xmlDocSetRootElement(docPtr, newNodePtr);
2392 if (old) {
2393 xmlDocSetRootElement(docPtr, old);
2394 xmlFreeNode(newNodePtr);
2395 Tcl_SetResult(interp, "document element already exists", NULL);
2396 Tcl_MutexUnlock(&libxml2);
2397 return TCL_ERROR;
2398 }
2399
2400 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2401 if (newNodeObjPtr == NULL) {
2402 xmlFreeNode(newNodePtr);
2403 Tcl_MutexUnlock(&libxml2);
2404 return TCL_ERROR;
2405 }
2406
2407 postMutationEvent = 1;
2408 } else if (docPtr && clientData != NULL) {
2409 /* Create an unattached element node */
2410 newNodePtr = xmlNewDocNode(docPtr,
2411 NULL,
2412 (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
2413 NULL);
2414 if (newNodePtr == NULL) {
2415 Tcl_SetResult(interp, "unable to create element node", NULL);
2416 Tcl_MutexUnlock(&libxml2);
2417 return TCL_ERROR;
2418 }
2419
2420 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2421 if (newNodeObjPtr == NULL) {
2422 xmlFreeNode(newNodePtr);
2423 Tcl_MutexUnlock(&libxml2);
2424 return TCL_ERROR;
2425 } else {
2426 Tcl_SetObjResult(interp, newNodeObjPtr);
2427 }
2428
2429 /*
2430 * The tree hasn't changed yet, so no events need to be fired.
2431 */
2432 postMutationEvent = 0;
2433 } else {
2434 newNodePtr = xmlNewChild(nodePtr,
2435 NULL,
2436 (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
2437 NULL);
2438 if (newNodePtr == NULL) {
2439 Tcl_SetResult(interp, "unable to create element node", NULL);
2440 Tcl_MutexUnlock(&libxml2);
2441 return TCL_ERROR;
2442 }
2443 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2444 if (newNodeObjPtr == NULL) {
2445 xmlFreeNode(newNodePtr);
2446 Tcl_MutexUnlock(&libxml2);
2447 return TCL_ERROR;
2448 }
2449 postMutationEvent = 1;
2450 }
2451
2452 Tcl_MutexUnlock(&libxml2);
2453
2454 break;
2455
2456 case TCLDOM_DOCUMENT_CREATEDOCUMENTFRAGMENT:
2457
2458 if (optobjc != 0) {
2459 Tcl_WrongNumArgs(interp, wrongidx, objv, "");
2460 return TCL_ERROR;
2461 }
2462
2463 Tcl_MutexLock(&libxml2);
2464
2465 if (docPtr) {
2466 newNodePtr = xmlNewDocFragment(docPtr);
2467 } else {
2468 newNodePtr = xmlNewDocFragment(nodePtr->doc);
2469 }
2470 if (newNodePtr == NULL) {
2471 Tcl_SetResult(interp, "unable to create document fragment", NULL);
2472 Tcl_MutexUnlock(&libxml2);
2473 return TCL_ERROR;
2474 }
2475
2476 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2477 if (newNodeObjPtr == NULL) {
2478 xmlFreeNode(newNodePtr);
2479 Tcl_MutexUnlock(&libxml2);
2480 return TCL_ERROR;
2481 } else {
2482 Tcl_SetObjResult(interp, newNodeObjPtr);
2483 }
2484
2485 Tcl_MutexUnlock(&libxml2);
2486
2487 /* The node hasn't been inserted into the tree yet */
2488 postMutationEvent = 0;
2489
2490 break;
2491
2492 case TCLDOM_DOCUMENT_CREATETEXTNODE:
2493
2494 if (optobjc != 1) {
2495 Tcl_WrongNumArgs(interp, wrongidx, objv, "text");
2496 return TCL_ERROR;
2497 }
2498
2499 Tcl_MutexLock(&libxml2);
2500
2501 if (docPtr) {
2502 char *content;
2503 int len;
2504
2505 content = Tcl_GetStringFromObj(optobjv[0], &len);
2506 newNodePtr = xmlNewDocTextLen(docPtr, (const xmlChar *) content, len);
2507 if (newNodePtr == NULL) {
2508 Tcl_SetResult(interp, "unable to create text node", NULL);
2509 Tcl_MutexUnlock(&libxml2);
2510 return TCL_ERROR;
2511 }
2512
2513 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2514 if (newNodeObjPtr == NULL) {
2515 xmlFreeNode(newNodePtr);
2516 Tcl_MutexUnlock(&libxml2);
2517 return TCL_ERROR;
2518 } else {
2519 Tcl_SetObjResult(interp, newNodeObjPtr);
2520 }
2521
2522 Tcl_MutexUnlock(&libxml2);
2523
2524 postMutationEvent = 0;
2525
2526 } else {
2527 xmlNodePtr returnNode;
2528 char *content;
2529 int len;
2530
2531 content = Tcl_GetStringFromObj(optobjv[0], &len);
2532 newNodePtr = xmlNewTextLen((const xmlChar *) content, len);
2533 if (newNodePtr == NULL) {
2534 Tcl_SetResult(interp, "creating text node failed", NULL);
2535 Tcl_MutexUnlock(&libxml2);
2536 return TCL_ERROR;
2537 }
2538 returnNode = xmlAddChild(nodePtr, newNodePtr);
2539 if (returnNode == NULL) {
2540 xmlFreeNode(newNodePtr);
2541 Tcl_SetResult(interp, "add child failed", NULL);
2542 Tcl_MutexUnlock(&libxml2);
2543 return TCL_ERROR;
2544 }
2545
2546 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2547 if (newNodeObjPtr == NULL) {
2548 xmlFreeNode(newNodePtr);
2549 Tcl_MutexUnlock(&libxml2);
2550 return TCL_ERROR;
2551 }
2552
2553 Tcl_MutexUnlock(&libxml2);
2554
2555 postMutationEvent = 1;
2556 }
2557
2558 break;
2559
2560 case TCLDOM_DOCUMENT_CREATECOMMENT:
2561
2562 if (optobjc != 1) {
2563 Tcl_WrongNumArgs(interp, wrongidx, objv, "data");
2564 return TCL_ERROR;
2565 }
2566
2567 Tcl_MutexLock(&libxml2);
2568
2569 if (docPtr) {
2570 newNodePtr = xmlNewDocComment(docPtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
2571 if (newNodePtr == NULL) {
2572 Tcl_SetResult(interp, "unable to create comment node", NULL);
2573 Tcl_MutexUnlock(&libxml2);
2574 return TCL_ERROR;
2575 }
2576 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2577 if (newNodeObjPtr == NULL) {
2578 xmlFreeNode(newNodePtr);
2579 Tcl_MutexUnlock(&libxml2);
2580 return TCL_ERROR;
2581 } else {
2582 Tcl_SetObjResult(interp, newNodeObjPtr);
2583 }
2584
2585 postMutationEvent = 0;
2586
2587 } else {
2588 newNodePtr = xmlNewDocComment(nodePtr->doc, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
2589 if (newNodePtr == NULL) {
2590 Tcl_SetResult(interp, "unable to create comment node", NULL);
2591 Tcl_MutexUnlock(&libxml2);
2592 return TCL_ERROR;
2593 }
2594 xmlAddChild(nodePtr, newNodePtr);
2595
2596 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2597 if (newNodeObjPtr == NULL) {
2598 xmlFreeNode(newNodePtr);
2599 Tcl_MutexUnlock(&libxml2);
2600 return TCL_ERROR;
2601 }
2602
2603 postMutationEvent = 1;
2604 }
2605
2606 Tcl_MutexUnlock(&libxml2);
2607
2608 break;
2609
2610 case TCLDOM_DOCUMENT_CREATECDATASECTION:
2611
2612 if (optobjc != 1) {
2613 Tcl_WrongNumArgs(interp, wrongidx, objv, "text");
2614 return TCL_ERROR;
2615 }
2616
2617 Tcl_MutexLock(&libxml2);
2618
2619 if (docPtr) {
2620 char *content;
2621 int len;
2622
2623 content = Tcl_GetStringFromObj(optobjv[0], &len);
2624 newNodePtr = xmlNewDocTextLen(docPtr, (const xmlChar *) content, len);
2625 if (newNodePtr == NULL) {
2626 Tcl_SetResult(interp, "unable to create text node", NULL);
2627 Tcl_MutexUnlock(&libxml2);
2628 return TCL_ERROR;
2629 }
2630 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2631 if (newNodeObjPtr == NULL) {
2632 xmlFreeNode(newNodePtr);
2633 Tcl_MutexUnlock(&libxml2);
2634 return TCL_ERROR;
2635 } else {
2636 Tcl_SetObjResult(interp, newNodeObjPtr);
2637 }
2638
2639 postMutationEvent = 0;
2640
2641 } else {
2642 char *content;
2643 int len;
2644
2645 content = Tcl_GetStringFromObj(optobjv[0], &len);
2646 newNodePtr = xmlNewTextLen((const xmlChar *) content, len);
2647 if (newNodePtr == NULL) {
2648 Tcl_SetResult(interp, "unable to create text node", NULL);
2649 Tcl_MutexUnlock(&libxml2);
2650 return TCL_ERROR;
2651 }
2652 xmlAddChild(nodePtr, newNodePtr);
2653
2654 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2655 if (newNodeObjPtr == NULL) {
2656 xmlFreeNode(newNodePtr);
2657 Tcl_MutexUnlock(&libxml2);
2658 return TCL_ERROR;
2659 }
2660
2661 postMutationEvent = 1;
2662 }
2663
2664 Tcl_MutexUnlock(&libxml2);
2665
2666 break;
2667
2668 case TCLDOM_DOCUMENT_CREATEPI:
2669 if (optobjc != 2) {
2670 Tcl_WrongNumArgs(interp, wrongidx, objv, "target data");
2671 return TCL_ERROR;
2672 }
2673
2674 Tcl_MutexLock(&libxml2);
2675
2676 newNodePtr = xmlNewPI((const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
2677 (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL));
2678 if (newNodePtr == NULL) {
2679 Tcl_SetResult(interp, "unable to create processing instruction node", NULL);
2680 Tcl_MutexUnlock(&libxml2);
2681 return TCL_ERROR;
2682 }
2683
2684 if (docPtr) {
2685 /*
2686 * libxml2 does not provide 'xmlNewDocPI' so the PI must be added to the tree
2687 * before we wrap it in an object. We'll use the document element as a placeholder
2688 * for the PI node; the user may move it from there.
2689 */
2690 xmlNodePtr docElPtr = xmlDocGetRootElement(docPtr);
2691
2692 if (docElPtr == NULL) {
2693 xmlFreeNode(newNodePtr);
2694 Tcl_MutexUnlock(&libxml2);
2695 Tcl_SetResult(interp, "document element must exist before adding a PI", NULL);
2696 return TCL_ERROR;
2697 }
2698 xmlAddNextSibling(docElPtr, newNodePtr);
2699
2700 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2701 if (newNodeObjPtr == NULL) {
2702 xmlFreeNode(newNodePtr);
2703 Tcl_MutexUnlock(&libxml2);
2704 return TCL_ERROR;
2705 } else {
2706 Tcl_SetObjResult(interp, newNodeObjPtr);
2707 }
2708
2709 postMutationEvent = 0;
2710
2711 } else {
2712 xmlAddChild(nodePtr, newNodePtr);
2713
2714 newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
2715 if (newNodeObjPtr == NULL) {
2716 xmlFreeNode(newNodePtr);
2717 Tcl_MutexUnlock(&libxml2);
2718 return TCL_ERROR;
2719 }
2720
2721 postMutationEvent = 1;
2722 }
2723
2724 Tcl_MutexUnlock(&libxml2);
2725
2726 break;
2727
2728 case TCLDOM_DOCUMENT_CREATEEVENT:
2729
2730 if (optobjc != 1) {
2731 Tcl_WrongNumArgs(interp, wrongidx, objv, "type");
2732 return TCL_ERROR;
2733 }
2734
2735 if (!docPtr) {
2736 docPtr = nodePtr->doc;
2737 }
2738
2739 if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_EventTypes,
2740 "type", TCL_EXACT, &method) == TCL_OK) {
2741 type = (enum TclDOM_EventTypes) method;
2742 } else {
2743 type = TCLDOM_EVENT_USERDEFINED;
2744 }
2745
2746 newNodeObjPtr = TclDOM_libxml2_NewEventObj(interp, docPtr, type, optobjv[0]);
2747 if (newNodeObjPtr == NULL) {
2748 return TCL_ERROR;
2749 } else {
2750 Tcl_SetObjResult(interp, newNodeObjPtr);
2751 }
2752
2753 postMutationEvent = 0;
2754
2755 break;
2756
2757 case TCLDOM_DOCUMENT_SCHEMA:
2758
2759 if (optobjc < 1) {
2760 Tcl_WrongNumArgs(interp, wrongidx, objv, "submethod ?args ...?");
2761 return TCL_ERROR;
2762 }
2763
2764 if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_DocumentSchemaSubmethods,
2765 "submethod", 0, &method) != TCL_OK) {
2766 return TCL_ERROR;
2767 }
2768
2769 switch ((enum TclDOM_DocumentSchemaSubmethods) method) {
2770 case TCLDOM_DOCUMENT_SCHEMA_COMPILE:
2771 if (optobjc != 1) {
2772 Tcl_WrongNumArgs(interp, wrongidx, objv, "compile");
2773 return TCL_ERROR;
2774 }
2775 return SchemaCompile(interp, domDocPtr);
2776
2777 case TCLDOM_DOCUMENT_SCHEMA_VALIDATE:
2778 if (optobjc != 2) {
2779 Tcl_WrongNumArgs(interp, wrongidx, objv, "validate instance");
2780 return TCL_ERROR;
2781 } else {
2782 xmlDocPtr instancePtr;
2783
2784 if (TclXML_libxml2_GetDocFromObj(interp, optobjv[1], &instancePtr) != TCL_OK) {
2785 return TCL_ERROR;
2786 }
2787
2788 return SchemaValidate(interp, domDocPtr, instancePtr);
2789 }
2790
2791 break;
2792
2793 default:
2794 Tcl_ResetResult(interp);
2795 Tcl_AppendResult(interp, "unknown submethod \"",
2796 Tcl_GetStringFromObj(optobjv[0], NULL), "\"", NULL);
2797 return TCL_ERROR;
2798 }
2799
2800 break;
2801
2802 case TCLDOM_DOCUMENT_RELAXNG:
2803
2804 if (optobjc < 1) {
2805 Tcl_WrongNumArgs(interp, wrongidx, objv, "submethod ?args ...?");
2806 return TCL_ERROR;
2807 }
2808
2809 if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_DocumentRelaxNGSubmethods,
2810 "submethod", 0, &method) != TCL_OK) {
2811 return TCL_ERROR;
2812 }
2813
2814 switch ((enum TclDOM_DocumentRelaxNGSubmethods) method) {
2815 case TCLDOM_DOCUMENT_RELAXNG_COMPILE:
2816 if (optobjc != 1) {
2817 Tcl_WrongNumArgs(interp, wrongidx, objv, "compile");
2818 return TCL_ERROR;
2819 }
2820 return RelaxNGCompile(interp, domDocPtr);
2821
2822 case TCLDOM_DOCUMENT_RELAXNG_VALIDATE:
2823 if (optobjc != 2) {
2824 Tcl_WrongNumArgs(interp, wrongidx, objv, "validate instance");
2825 return TCL_ERROR;
2826 } else {
2827 xmlDocPtr instancePtr;
2828
2829 if (TclXML_libxml2_GetDocFromObj(interp, optobjv[1], &instancePtr) != TCL_OK) {
2830 return TCL_ERROR;
2831 }
2832
2833 return RelaxNGValidate(interp, domDocPtr, instancePtr);
2834 }
2835
2836 break;
2837
2838 default:
2839 Tcl_ResetResult(interp);
2840 Tcl_AppendResult(interp, "unknown submethod \"",
2841 Tcl_GetStringFromObj(optobjv[0], NULL), "\"", NULL);
2842 return TCL_ERROR;
2843 }
2844
2845 break;
2846
2847 case TCLDOM_DOCUMENT_DTD:
2848
2849 if (optobjc < 1) {
2850 Tcl_WrongNumArgs(interp, wrongidx, objv, "submethod ?args...?");
2851 return TCL_ERROR;
2852 }
2853
2854 if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_DocumentDTDSubmethods,
2855 "submethod", 0, &method) != TCL_OK) {
2856 return TCL_ERROR;
2857 }
2858
2859 switch ((enum TclDOM_DocumentDTDSubmethods) method) {
2860 case TCLDOM_DOCUMENT_DTD_VALIDATE:
2861 if (optobjc != 1) {
2862 Tcl_WrongNumArgs(interp, wrongidx, objv, "validate");
2863 return TCL_ERROR;
2864 } else {
2865 return DTDValidate(interp, domDocPtr);
2866 }
2867 default:
2868 Tcl_SetResult(interp, "unknown submethod", NULL);
2869 return TCL_ERROR;
2870 }
2871
2872 break;
2873
2874 case TCLDOM_DOCUMENT_CREATEATTRIBUTE:
2875 case TCLDOM_DOCUMENT_CREATEENTITY:
2876 case TCLDOM_DOCUMENT_CREATEENTITYREFERENCE:
2877 case TCLDOM_DOCUMENT_CREATEDOCTYPEDECL:
2878 default:
2879 Tcl_SetResult(interp, "method \"", NULL);
2880 Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL);
2881 return TCL_ERROR;
2882 }
2883
2884 if (postMutationEvent) {
2885
2886 TclDOM_PostMutationEvent(interp, tDocPtr, newNodeObjPtr, TCLDOM_EVENT_DOMNODEINSERTED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), objv[2], NULL, NULL, NULL, NULL);
2887 TclDOM_PostMutationEvent(interp, tDocPtr, newNodeObjPtr, TCLDOM_EVENT_DOMNODEINSERTEDINTODOCUMENT, NULL, Tcl_NewIntObj(0), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
2888
2889 if (nodePtr) {
2890 TclDOM_PostMutationEvent(interp, tDocPtr, nodeObjPtr, TCLDOM_EVENT_DOMSUBTREEMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
2891 } else {
2892 /*
2893 * We just added the document element.
2894 */
2895 }
2896
2897 Tcl_SetObjResult(interp, newNodeObjPtr);
2898 }
2899
2900 return TCL_OK;
2901 }
2902
2903 int
DocumentCget(interp,docPtr,optObj)2904 DocumentCget(interp, docPtr, optObj)
2905 Tcl_Interp *interp;
2906 xmlDocPtr docPtr;
2907 Tcl_Obj *CONST optObj;
2908 {
2909 TclXML_libxml2_Document *tDocPtr;
2910 xmlNodePtr nodePtr;
2911 int option;
2912
2913 if (Tcl_GetIndexFromObj(interp, optObj, TclDOM_DocumentCommandOptions,
2914 "option", 0, &option) != TCL_OK) {
2915 return TCL_ERROR;
2916 }
2917
2918 switch ((enum TclDOM_DocumentCommandOptions) option) {
2919
2920 case TCLDOM_DOCUMENT_DOCTYPE:
2921 Tcl_SetResult(interp, "cget option \"", NULL);
2922 Tcl_AppendResult(interp, Tcl_GetStringFromObj(optObj, NULL), NULL);
2923 Tcl_AppendResult(interp, "\" not yet implemented", NULL);
2924 return TCL_ERROR;
2925
2926 case TCLDOM_DOCUMENT_IMPLEMENTATION:
2927 Tcl_SetResult(interp, "::dom::libxml2::DOMImplementation", NULL);
2928 break;
2929
2930 case TCLDOM_DOCUMENT_DOCELEMENT:
2931
2932 Tcl_MutexLock(&libxml2);
2933 nodePtr = xmlDocGetRootElement(docPtr);
2934 Tcl_MutexUnlock(&libxml2);
2935
2936 if (nodePtr) {
2937 Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr));
2938 } else {
2939 Tcl_ResetResult(interp);
2940 return TCL_OK;
2941 }
2942
2943 break;
2944
2945 case TCLDOM_DOCUMENT_KEEP:
2946
2947 if (TclXML_libxml2_GetTclDocFromDoc(interp, docPtr, &tDocPtr) != TCL_OK) {
2948 return TCL_ERROR;
2949 }
2950
2951 if (tDocPtr->keep == TCLXML_LIBXML2_DOCUMENT_KEEP) {
2952 Tcl_SetResult(interp, "normal", NULL);
2953 } else if (tDocPtr->keep == TCLXML_LIBXML2_DOCUMENT_IMPLICIT) {
2954 Tcl_SetResult(interp, "implicit", NULL);
2955 } else {
2956 Tcl_SetResult(interp, "internal error", NULL);
2957 return TCL_ERROR;
2958 }
2959 return TCL_OK;
2960
2961 case TCLDOM_DOCUMENT_BASEURI:
2962
2963 Tcl_SetObjResult(interp, TclXML_libxml2_GetBaseURIFromDoc(docPtr));
2964 return TCL_OK;
2965
2966 default:
2967 Tcl_SetResult(interp, "unknown option", NULL);
2968 return TCL_ERROR;
2969 }
2970
2971 return TCL_OK;
2972 }
2973
2974 int
DocumentConfigure(interp,docPtr,objc,objv)2975 DocumentConfigure(interp, docPtr, objc, objv)
2976 Tcl_Interp *interp;
2977 xmlDocPtr docPtr;
2978 int objc;
2979 Tcl_Obj *CONST objv[];
2980 {
2981 TclXML_libxml2_Document *tDocPtr;
2982 int option;
2983
2984 /* TODO: set up these tables in the TclXML/libxml2 includes */
2985 CONST84 char *KeepOptions[] = {
2986 "normal",
2987 "implicit",
2988 NULL
2989 };
2990 enum KeepOptions {
2991 OPTION_KEEP_NORMAL,
2992 OPTION_KEEP_IMPLICIT
2993 };
2994
2995 if (objc <= 1) {
2996 Tcl_SetResult(interp, "missing option value", NULL);
2997 return TCL_ERROR;
2998 }
2999
3000 while (objc > 1) {
3001 if (objc == 1) {
3002 Tcl_SetResult(interp, "missing option value", NULL);
3003 return TCL_ERROR;
3004 }
3005
3006 if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_DocumentCommandOptions,
3007 "option", 0, &option) != TCL_OK) {
3008 return TCL_ERROR;
3009 }
3010
3011 switch ((enum TclDOM_DocumentCommandOptions) option) {
3012
3013 case TCLDOM_DOCUMENT_KEEP:
3014
3015 if (TclXML_libxml2_GetTclDocFromDoc(interp, docPtr, &tDocPtr) != TCL_OK) {
3016 return TCL_ERROR;
3017 }
3018
3019 if (Tcl_GetIndexFromObj(interp, objv[1], KeepOptions,
3020 "value", 0, &option) != TCL_OK) {
3021 return TCL_ERROR;
3022 }
3023
3024 switch ((enum KeepOptions) option) {
3025 case OPTION_KEEP_NORMAL:
3026 tDocPtr->keep = TCLXML_LIBXML2_DOCUMENT_KEEP;
3027 break;
3028 case OPTION_KEEP_IMPLICIT:
3029 tDocPtr->keep = TCLXML_LIBXML2_DOCUMENT_IMPLICIT;
3030 break;
3031 default:
3032 Tcl_SetResult(interp, "unknown value", NULL);
3033 return TCL_ERROR;
3034 }
3035
3036 break;
3037
3038 case TCLDOM_DOCUMENT_BASEURI:
3039
3040 Tcl_ResetResult(interp);
3041 if (TclXML_libxml2_SetBaseURI(interp, docPtr, objv[1]) != TCL_OK) {
3042 return TCL_ERROR;
3043 }
3044
3045 break;
3046
3047 default:
3048 Tcl_SetResult(interp, "read-only option", NULL);
3049 return TCL_ERROR;
3050 }
3051
3052 objc -= 2;
3053 objv += 2;
3054 }
3055
3056 return TCL_OK;
3057 }
3058
3059 /*
3060 *----------------------------------------------------------------------------
3061 *
3062 * TriggerEventListeners --
3063 *
3064 * Iterates through the list of event listeners for
3065 * a node or document and fires events.
3066 *
3067 * Results:
3068 * Depends on listeners.
3069 *
3070 * Side effects:
3071 * Depends on listeners.
3072 *
3073 *----------------------------------------------------------------------------
3074 */
3075
3076 static int
TriggerEventListeners(interp,type,tokenPtr,eventObjPtr,eventPtr)3077 TriggerEventListeners(interp, type, tokenPtr, eventObjPtr, eventPtr)
3078 Tcl_Interp *interp;
3079 Tcl_HashTable *type;
3080 void *tokenPtr;
3081 Tcl_Obj *eventObjPtr;
3082 TclDOM_libxml2_Event *eventPtr;
3083 {
3084 Tcl_HashTable *listenerTablePtr;
3085 Tcl_HashEntry *entryPtr, *listenerEntryPtr;
3086 Tcl_Obj *listenerListPtr;
3087 int listenerLen, listenerIdx;
3088 char *eventType;
3089
3090 entryPtr = Tcl_FindHashEntry(type, tokenPtr);
3091 if (entryPtr == NULL) {
3092 return TCL_OK;
3093 }
3094 listenerTablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr);
3095
3096 if (eventPtr->type != TCLDOM_EVENT_USERDEFINED) {
3097 eventType = (char *) TclDOM_EventTypes[eventPtr->type];
3098 } else {
3099 eventType = Tcl_GetStringFromObj(eventPtr->typeObjPtr, NULL);
3100 }
3101 listenerEntryPtr = Tcl_FindHashEntry(listenerTablePtr, eventType);
3102 if (listenerEntryPtr == NULL) {
3103 return TCL_OK;
3104 }
3105 listenerListPtr = (Tcl_Obj *) Tcl_GetHashValue(listenerEntryPtr);
3106
3107 /*
3108 * DOM L2 specifies that the ancestors are determined
3109 * at the moment of event dispatch, so using a static
3110 * list is the correct thing to do.
3111 */
3112
3113 Tcl_ListObjLength(interp, listenerListPtr, &listenerLen);
3114
3115 /* Preserve the event object until all listeners are triggered */
3116 Tcl_IncrRefCount(eventObjPtr);
3117
3118 for (listenerIdx = 0; listenerIdx < listenerLen; listenerIdx++) {
3119 Tcl_Obj *listenerObj, *cmdPtr;
3120
3121 Tcl_ListObjIndex(interp, listenerListPtr, listenerIdx, &listenerObj);
3122
3123 cmdPtr = Tcl_DuplicateObj(listenerObj);
3124 Tcl_IncrRefCount(cmdPtr);
3125 if (Tcl_ListObjAppendElement(interp, cmdPtr, eventObjPtr) != TCL_OK) {
3126 Tcl_DecrRefCount(eventObjPtr);
3127 Tcl_DecrRefCount(cmdPtr);
3128 return TCL_ERROR;
3129 }
3130 Tcl_Preserve((ClientData) interp);
3131 if (Tcl_GlobalEvalObj(interp, cmdPtr) != TCL_OK) {
3132 Tcl_BackgroundError(interp);
3133 }
3134 Tcl_Release((ClientData) interp);
3135 Tcl_DecrRefCount(cmdPtr);
3136 }
3137
3138 /* Event object may be released now */
3139 Tcl_DecrRefCount(eventObjPtr);
3140
3141 return TCL_OK;
3142 }
3143
3144 static int
TclDOMSetLiveNodeListNode(interp,varName,nodePtr)3145 TclDOMSetLiveNodeListNode(interp, varName, nodePtr)
3146 Tcl_Interp *interp;
3147 char *varName;
3148 xmlNodePtr nodePtr;
3149 {
3150 Tcl_Obj *valuePtr = Tcl_NewListObj(0, NULL);
3151 xmlNodePtr childPtr;
3152
3153 for (childPtr = nodePtr->children; childPtr; childPtr = childPtr->next) {
3154 Tcl_ListObjAppendElement(interp, valuePtr, TclDOM_libxml2_CreateObjFromNode(interp, childPtr));
3155 }
3156
3157 Tcl_SetVar2Ex(interp, varName, NULL, valuePtr, TCL_GLOBAL_ONLY);
3158
3159 return TCL_OK;
3160 }
3161
3162 static int
TclDOMSetLiveNodeListDoc(interp,varName,docPtr)3163 TclDOMSetLiveNodeListDoc(interp, varName, docPtr)
3164 Tcl_Interp *interp;
3165 char *varName;
3166 xmlDocPtr docPtr;
3167 {
3168 Tcl_Obj *valuePtr = Tcl_NewListObj(0, NULL);
3169 xmlNodePtr childPtr;
3170
3171 for (childPtr = docPtr->children; childPtr; childPtr = childPtr->next) {
3172 Tcl_ListObjAppendElement(interp, valuePtr, TclDOM_libxml2_CreateObjFromNode(interp, childPtr));
3173 }
3174
3175 Tcl_SetVar2Ex(interp, varName, NULL, valuePtr, TCL_GLOBAL_ONLY);
3176
3177 return TCL_OK;
3178 }
3179
3180 static char *
TclDOMLiveNodeListNode(clientData,interp,name1,name2,flags)3181 TclDOMLiveNodeListNode(clientData, interp, name1, name2, flags)
3182 ClientData clientData;
3183 Tcl_Interp *interp;
3184 char *name1;
3185 char *name2;
3186 int flags;
3187 {
3188 xmlNodePtr nodePtr = (xmlNodePtr) clientData;
3189
3190 if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
3191 return NULL;
3192 } else if (flags & TCL_TRACE_READS) {
3193 TclDOMSetLiveNodeListNode(interp, name1, nodePtr);
3194 } else if (flags & TCL_TRACE_WRITES) {
3195 TclDOMSetLiveNodeListNode(interp, name1, nodePtr);
3196 return "variable is read-only";
3197 } else if (flags & TCL_TRACE_UNSETS) {
3198 }
3199
3200 return NULL;
3201 }
3202 static char *
TclDOMLiveNodeListDoc(clientData,interp,name1,name2,flags)3203 TclDOMLiveNodeListDoc(clientData, interp, name1, name2, flags)
3204 ClientData clientData;
3205 Tcl_Interp *interp;
3206 char *name1;
3207 char *name2;
3208 int flags;
3209 {
3210 xmlDocPtr docPtr = (xmlDocPtr) clientData;
3211
3212 if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
3213 return NULL;
3214 } else if (flags & TCL_TRACE_READS) {
3215 TclDOMSetLiveNodeListDoc(interp, name1, docPtr);
3216 } else if (flags & TCL_TRACE_WRITES) {
3217 TclDOMSetLiveNodeListDoc(interp, name1, docPtr);
3218 return "variable is read-only";
3219 } else if (flags & TCL_TRACE_UNSETS) {
3220 }
3221
3222 return NULL;
3223 }
3224
3225 static int
TclDOMSetLiveNamedNodeMap(interp,varName,nodePtr)3226 TclDOMSetLiveNamedNodeMap(interp, varName, nodePtr)
3227 Tcl_Interp *interp;
3228 char *varName;
3229 xmlNodePtr nodePtr;
3230 {
3231 xmlAttrPtr attrPtr;
3232
3233 Tcl_UnsetVar(interp, varName, TCL_GLOBAL_ONLY);
3234
3235 for (attrPtr = nodePtr->properties; attrPtr; attrPtr = attrPtr->next) {
3236
3237 if (Tcl_SetVar2Ex(interp, varName, (char *) attrPtr->name, Tcl_NewStringObj((CONST char *) xmlGetProp(nodePtr, attrPtr->name), -1), TCL_GLOBAL_ONLY) == NULL) {
3238 Tcl_ResetResult(interp);
3239 Tcl_AppendResult(interp, "unable to set attribute \"", attrPtr->name, "\"", NULL);
3240 return TCL_ERROR;
3241 }
3242
3243 if (Tcl_TraceVar2(interp, varName, (char *) attrPtr->name, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNamedNodeMap, (ClientData) nodePtr) != TCL_OK) {
3244 return TCL_ERROR;
3245 }
3246 }
3247
3248 return TCL_OK;
3249 }
3250
3251 static char *
TclDOMLiveNamedNodeMap(clientData,interp,name1,name2,flags)3252 TclDOMLiveNamedNodeMap(clientData, interp, name1, name2, flags)
3253 ClientData clientData;
3254 Tcl_Interp *interp;
3255 char *name1;
3256 char *name2;
3257 int flags;
3258 {
3259 xmlNodePtr nodePtr = (xmlNodePtr) clientData;
3260
3261 if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
3262 return NULL;
3263 } else if (flags & TCL_TRACE_READS && name2 == NULL) {
3264 TclDOMSetLiveNamedNodeMap(interp, name1, nodePtr);
3265 } else if (flags & TCL_TRACE_READS && name2 != NULL) {
3266 if (Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewStringObj((CONST char *) xmlGetProp(nodePtr, (const xmlChar *) name2), -1), TCL_GLOBAL_ONLY) == NULL) {
3267 return "unable to set attribute";
3268 }
3269 } else if (flags & TCL_TRACE_WRITES) {
3270 TclDOMSetLiveNamedNodeMap(interp, name1, nodePtr);
3271 return "variable is read-only";
3272 } else if (flags & TCL_TRACE_UNSETS) {
3273 }
3274
3275 return NULL;
3276 }
3277
3278 /*
3279 *----------------------------------------------------------------------------
3280 *
3281 * TclDOMNodeCommand --
3282 *
3283 * Implements dom::libxml2::node command.
3284 *
3285 * Results:
3286 * Depends on method.
3287 *
3288 * Side effects:
3289 * Depends on method.
3290 *
3291 *----------------------------------------------------------------------------
3292 */
3293
3294 int
TclDOMNodeCommand(clientData,interp,objc,objv)3295 TclDOMNodeCommand (clientData, interp, objc, objv)
3296 ClientData clientData;
3297 Tcl_Interp *interp;
3298 int objc;
3299 Tcl_Obj *CONST objv[];
3300 {
3301 TclXML_libxml2_Document *tDocPtr;
3302 TclDOM_libxml2_Node *tNodePtr;
3303 int method, optobjc, option, wrongidx, usecapture = 0;
3304 char *buf;
3305 xmlNodePtr nodePtr = NULL, childNodePtr, refPtr, newPtr, oldParent;
3306 xmlDocPtr docPtr = NULL;
3307 Tcl_Obj *nodeObjPtr = NULL;
3308 Tcl_Obj *docObjPtr = NULL;
3309 Tcl_Obj *resultPtr;
3310 Tcl_Obj *CONST *optobjv;
3311
3312 if (clientData == NULL) {
3313
3314 if (objc < 3) {
3315 Tcl_WrongNumArgs(interp, 1, objv, "method token ?arg ...?");
3316 return TCL_ERROR;
3317 }
3318
3319 if (TclDOM_libxml2_GetTclNodeFromObj(interp, objv[2], &tNodePtr) != TCL_OK) {
3320 if (TclXML_libxml2_GetTclDocFromObj(interp, objv[2], &tDocPtr) != TCL_OK) {
3321 Tcl_ResetResult(interp);
3322 Tcl_AppendResult(interp, "\"", Tcl_GetStringFromObj(objv[2], NULL), "\" is neither a DOM document nor a DOM node", NULL);
3323 return TCL_ERROR;
3324 } else {
3325 Tcl_ResetResult(interp);
3326 docObjPtr = objv[2];
3327 docPtr = tDocPtr->docPtr;
3328 nodeObjPtr = NULL;
3329 nodePtr = NULL;
3330 }
3331 } else {
3332 nodePtr = tNodePtr->ptr.nodePtr;
3333 nodeObjPtr = objv[2];
3334 docPtr = NULL;
3335 docObjPtr = NULL;
3336 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
3337 return TCL_ERROR;
3338 }
3339 }
3340
3341 optobjc = objc - 3;
3342 optobjv = objv + 3;
3343 wrongidx = 3;
3344
3345 } else {
3346 if (objc < 2) {
3347 Tcl_WrongNumArgs(interp, 1, objv, "method ?arg ...?");
3348 return TCL_ERROR;
3349 }
3350
3351 tNodePtr = (TclDOM_libxml2_Node *) clientData;
3352 nodePtr = tNodePtr->ptr.nodePtr;
3353 nodeObjPtr = NULL;
3354 docPtr = NULL;
3355 docObjPtr = NULL;
3356 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
3357 return TCL_ERROR;
3358 }
3359
3360 optobjc = objc - 2;
3361 optobjv = objv + 2;
3362 wrongidx = 2;
3363
3364 }
3365
3366 if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_NodeCommandMethods,
3367 "method", 0, &method) != TCL_OK) {
3368 return TCL_ERROR;
3369 }
3370
3371 switch ((enum TclDOM_NodeCommandMethods) method) {
3372
3373 case TCLDOM_NODE_CGET:
3374
3375 if (optobjc != 1) {
3376 Tcl_WrongNumArgs(interp, wrongidx, objv, "option");
3377 return TCL_ERROR;
3378 }
3379
3380 NodeCget(interp, docPtr, nodePtr, optobjv[0]);
3381
3382 break;
3383
3384 case TCLDOM_NODE_PATH:
3385
3386 if (docPtr) {
3387 Tcl_Obj *newobjv[2];
3388
3389 newobjv[0] = TclXML_libxml2_CreateObjFromDoc(docPtr);
3390 newobjv[1] = NULL;
3391 Tcl_SetObjResult(interp, Tcl_NewListObj(1, newobjv));
3392 } else {
3393 Tcl_SetObjResult(interp, GetPath(interp, nodePtr));
3394 }
3395
3396 break;
3397
3398 case TCLDOM_NODE_CONFIGURE:
3399
3400 if (optobjc < 1) {
3401 Tcl_WrongNumArgs(interp, wrongidx, objv, "option ?value? ?option value ...?");
3402 return TCL_ERROR;
3403 }
3404
3405 if (optobjc == 1) {
3406 return NodeCget(interp, docPtr, nodePtr, optobjv[0]);
3407 }
3408
3409 if (optobjc % 2 == 1) {
3410 Tcl_WrongNumArgs(interp, wrongidx, objv, "option ?value? ?option value ...?");
3411 return TCL_ERROR;
3412 }
3413
3414 return NodeConfigure(interp, nodePtr, optobjc, optobjv);
3415 break;
3416
3417 case TCLDOM_NODE_INSERTBEFORE:
3418 if (optobjc < 1 || optobjc > 2) {
3419 Tcl_WrongNumArgs(interp, wrongidx, objv, "ref ?new?");
3420 return TCL_ERROR;
3421 } else if (docPtr) {
3422 /* TODO: allow comments & PIs in document prologue */
3423 Tcl_SetResult(interp, "document already has document element", NULL);
3424 return TCL_ERROR;
3425 } else if (optobjc == 1) {
3426 /* No reference child specified - new appended to child list */
3427 if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &newPtr) != TCL_OK) {
3428 return TCL_ERROR;
3429 }
3430 return TclDOM_NodeAppendChild(interp, nodePtr, newPtr);
3431 } else if (optobjc == 2) {
3432 if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &newPtr) != TCL_OK) {
3433 return TCL_ERROR;
3434 }
3435 if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[1], &refPtr) != TCL_OK) {
3436 return TCL_ERROR;
3437 }
3438 return TclDOM_NodeInsertBefore(interp, refPtr, newPtr);
3439 }
3440
3441 break;
3442
3443 case TCLDOM_NODE_REPLACECHILD:
3444 if (optobjc != 2) {
3445 Tcl_WrongNumArgs(interp, wrongidx, objv, "new old");
3446 return TCL_ERROR;
3447 } else if (docPtr) {
3448 /* TODO: allow replacing comments & PIs */
3449 Tcl_SetResult(interp, "document already has document element", NULL);
3450 return TCL_ERROR;
3451 } else {
3452 if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &newPtr) != TCL_OK) {
3453 return TCL_ERROR;
3454 }
3455 if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[1], &refPtr) != TCL_OK) {
3456 return TCL_ERROR;
3457 }
3458 oldParent = newPtr->parent;
3459 if (oldParent != refPtr->parent) {
3460 TclDOM_PostMutationEvent(interp,
3461 tDocPtr,
3462 TclDOM_libxml2_CreateObjFromNode(interp, newPtr),
3463 TCLDOM_EVENT_DOMNODEREMOVED,
3464 NULL,
3465 Tcl_NewIntObj(1), Tcl_NewIntObj(0),
3466 TclDOM_libxml2_CreateObjFromNode(interp, newPtr->parent),
3467 NULL, NULL, NULL, NULL);
3468 }
3469
3470 Tcl_MutexLock(&libxml2);
3471
3472 if (xmlReplaceNode(refPtr, newPtr) == NULL) {
3473 Tcl_SetResult(interp, "unable to replace node", NULL);
3474 Tcl_MutexUnlock(&libxml2);
3475 return TCL_ERROR;
3476 }
3477
3478 Tcl_MutexUnlock(&libxml2);
3479
3480 }
3481
3482 PostMutationEvents(interp, tDocPtr, nodePtr, refPtr, newPtr, oldParent, refPtr->parent);
3483
3484 Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, refPtr));
3485
3486 break;
3487
3488 case TCLDOM_NODE_REMOVECHILD:
3489 if (optobjc != 1) {
3490 Tcl_WrongNumArgs(interp, wrongidx, objv, "child");
3491 return TCL_ERROR;
3492 } else if (docPtr) {
3493 /* TODO: allow removing comments & PIs */
3494 Tcl_SetResult(interp, "document must have document element", NULL);
3495 return TCL_ERROR;
3496 } else {
3497 xmlNodePtr childPtr;
3498 if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &childPtr) != TCL_OK) {
3499 return TCL_ERROR;
3500 }
3501 if (nodePtr != childPtr->parent) {
3502 Tcl_SetResult(interp, "not found: \"", NULL);
3503 Tcl_AppendResult(interp, Tcl_GetStringFromObj(optobjv[0], NULL),
3504 "\" is not a child", NULL);
3505 if (nodeObjPtr) {
3506 Tcl_AppendResult(interp, " of \"",
3507 Tcl_GetStringFromObj(nodeObjPtr, NULL), "\"", NULL);
3508 }
3509 return TCL_ERROR;
3510 }
3511 oldParent = childPtr->parent;
3512 TclDOM_PostMutationEvent(interp,
3513 tDocPtr, optobjv[0],
3514 TCLDOM_EVENT_DOMNODEREMOVED,
3515 NULL,
3516 Tcl_NewIntObj(1), Tcl_NewIntObj(0),
3517 TclDOM_libxml2_CreateObjFromNode(interp, oldParent),
3518 NULL, NULL, NULL, NULL);
3519 TclDOM_PostMutationEvent(interp,
3520 tDocPtr, optobjv[0],
3521 TCLDOM_EVENT_DOMNODEREMOVEDFROMDOCUMENT,
3522 NULL,
3523 Tcl_NewIntObj(0), Tcl_NewIntObj(0),
3524 NULL, NULL, NULL, NULL, NULL);
3525
3526 Tcl_MutexLock(&libxml2);
3527 xmlUnlinkNode(childPtr);
3528 Tcl_MutexUnlock(&libxml2);
3529
3530 Tcl_SetObjResult(interp, optobjv[0]);
3531 TclDOM_PostMutationEvent(interp,
3532 tDocPtr,
3533 TclDOM_libxml2_CreateObjFromNode(interp, oldParent),
3534 TCLDOM_EVENT_DOMSUBTREEMODIFIED,
3535 NULL,
3536 Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
3537 }
3538
3539 break;
3540
3541 case TCLDOM_NODE_APPENDCHILD:
3542 if (optobjc != 1) {
3543 Tcl_WrongNumArgs(interp, wrongidx, objv, "child");
3544 return TCL_ERROR;
3545 } else if (docPtr) {
3546 xmlNodePtr oldPtr;
3547
3548 if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &childNodePtr) != TCL_OK) {
3549 return TCL_ERROR;
3550 }
3551
3552 Tcl_MutexLock(&libxml2);
3553
3554 /* TODO: allow appending comments & PIs */
3555 oldPtr = xmlDocSetRootElement(docPtr, childNodePtr);
3556 if (oldPtr) {
3557 xmlDocSetRootElement(docPtr, oldPtr);
3558 Tcl_SetResult(interp, "document element already exists", NULL);
3559 Tcl_MutexUnlock(&libxml2);
3560 return TCL_ERROR;
3561 }
3562
3563 Tcl_MutexUnlock(&libxml2);
3564
3565 Tcl_SetObjResult(interp, optobjv[0]);
3566
3567 } else {
3568 if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &childNodePtr) != TCL_OK) {
3569 return TCL_ERROR;
3570 }
3571
3572 return TclDOM_NodeAppendChild(interp, nodePtr, childNodePtr);
3573 }
3574
3575 break;
3576
3577 case TCLDOM_NODE_HASCHILDNODES:
3578 if (docPtr) {
3579 if (docPtr->children) {
3580 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
3581 } else {
3582 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3583 }
3584 } else {
3585 if (nodePtr->children) {
3586 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
3587 } else {
3588 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3589 }
3590 }
3591
3592 break;
3593
3594 case TCLDOM_NODE_ISSAMENODE:
3595 /* DOM Level 3 method */
3596
3597 if (optobjc != 1) {
3598 Tcl_WrongNumArgs(interp, wrongidx, objv, "ref");
3599 return TCL_ERROR;
3600 }
3601
3602 if (docPtr) {
3603 xmlDocPtr docRefPtr;
3604
3605 if (TclXML_libxml2_GetDocFromObj(interp, optobjv[0], &docRefPtr) != TCL_OK) {
3606 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3607 return TCL_OK;
3608 }
3609
3610 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(docPtr == docRefPtr));
3611
3612 } else {
3613 if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &refPtr) != TCL_OK) {
3614 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3615 return TCL_OK;
3616 }
3617
3618 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(nodePtr == refPtr));
3619 }
3620
3621 break;
3622
3623 case TCLDOM_NODE_CLONENODE:
3624 if (optobjc != 0 && optobjc != 2) {
3625 Tcl_WrongNumArgs(interp, wrongidx, objv, "?-deep boolean?");
3626 return TCL_ERROR;
3627 } else if (docPtr) {
3628 Tcl_SetResult(interp, "documents cannot be cloned", NULL);
3629 return TCL_ERROR;
3630 } else {
3631 int deep = 0;
3632 xmlNodePtr copyPtr;
3633
3634 if (optobjc == 2) {
3635 if (Tcl_RegExpMatchObj(interp, optobjv[0], Tcl_NewStringObj("-de?e?p?", -1)) == 0) {
3636 Tcl_ResetResult(interp);
3637 Tcl_AppendResult(interp, "invalid option \"", Tcl_GetStringFromObj(optobjv[0], NULL), "\", must be \"-deep\"", NULL);
3638 return TCL_ERROR;
3639 }
3640 if (Tcl_GetBooleanFromObj(interp, optobjv[1], &deep) != TCL_OK) {
3641 return TCL_ERROR;
3642 }
3643 }
3644
3645 Tcl_MutexLock(&libxml2);
3646 copyPtr = xmlDocCopyNode(nodePtr, nodePtr->doc, deep);
3647 Tcl_MutexUnlock(&libxml2);
3648
3649 if (copyPtr == NULL) {
3650 Tcl_SetResult(interp, "unable to copy node", NULL);
3651 return TCL_ERROR;
3652 }
3653 Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, copyPtr));
3654 }
3655 break;
3656
3657 case TCLDOM_NODE_PARENT:
3658
3659 if (docPtr) {
3660 break;
3661 }
3662
3663 if (nodePtr->parent) {
3664 Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->parent));
3665 } else {
3666 Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc));
3667 }
3668
3669 break;
3670
3671 case TCLDOM_NODE_CHILDREN:
3672
3673 resultPtr = Tcl_NewListObj(0, NULL);
3674
3675 if (docPtr) {
3676 childNodePtr = docPtr->children;
3677 } else {
3678 childNodePtr = nodePtr->children;
3679 }
3680
3681 while (childNodePtr) {
3682 Tcl_ListObjAppendElement(interp, resultPtr, TclDOM_libxml2_CreateObjFromNode(interp, childNodePtr));
3683 childNodePtr = childNodePtr->next;
3684 }
3685
3686 Tcl_SetObjResult(interp, resultPtr);
3687
3688 break;
3689
3690 case TCLDOM_NODE_ADDEVENTLISTENER:
3691
3692 /* TODO: type optional, missing type returns all types that have a listener */
3693
3694 if (optobjc < 1) {
3695 Tcl_WrongNumArgs(interp, wrongidx, objv, "type ?listener? ?-usecapture boolean?");
3696 return TCL_ERROR;
3697 } else {
3698 enum TclDOM_EventTypes type;
3699 Tcl_Obj *typeObjPtr, *listenerPtr = NULL;
3700 void *tokenPtr = NULL;
3701
3702 if (nodePtr) {
3703 tokenPtr = (void *) nodePtr;
3704 } else {
3705 tokenPtr = (void *) docPtr;
3706 }
3707
3708 if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_EventTypes,
3709 "type", TCL_EXACT, &option) == TCL_OK) {
3710 type = (enum TclDOM_EventTypes) option;
3711 } else {
3712 type = TCLDOM_EVENT_USERDEFINED;
3713 }
3714 typeObjPtr = optobjv[0];
3715 Tcl_ResetResult(interp);
3716 optobjc -= 1;
3717 optobjv += 1;
3718
3719 if (optobjc > 0 && *Tcl_GetStringFromObj(optobjv[0], NULL) != '-') {
3720 listenerPtr = optobjv[0];
3721 optobjc -= 1;
3722 optobjv += 1;
3723 } /* else we will return the registered listener */
3724
3725 while (optobjc) {
3726 if (optobjc == 1) {
3727 Tcl_SetResult(interp, "missing value", NULL);
3728 return TCL_ERROR;
3729 }
3730 if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_NodeCommandAddEventListenerOptions,
3731 "option", 0, &option) != TCL_OK) {
3732 return TCL_ERROR;
3733 }
3734 switch ((enum TclDOM_NodeCommandAddEventListenerOptions) option) {
3735 case TCLDOM_NODE_ADDEVENTLISTENER_USECAPTURE:
3736
3737 if (Tcl_GetBooleanFromObj(interp, optobjv[1], &usecapture) != TCL_OK) {
3738 return TCL_ERROR;
3739 }
3740
3741 break;
3742
3743 default:
3744 Tcl_SetResult(interp, "unknown option", NULL);
3745 return TCL_ERROR;
3746 }
3747
3748 optobjc -= 2;
3749 optobjv += 2;
3750 }
3751
3752 if (nodePtr) {
3753 docObjPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc);
3754 } else {
3755 docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
3756 }
3757 TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr);
3758
3759 if (listenerPtr == NULL) {
3760 listenerPtr = TclDOM_GetEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, usecapture);
3761 if (listenerPtr) {
3762 Tcl_SetObjResult(interp, listenerPtr);
3763 } else {
3764 Tcl_SetResult(interp, "unable to find listeners", NULL);
3765 return TCL_ERROR;
3766 }
3767 } else {
3768 return TclDOM_AddEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, usecapture);
3769 }
3770 }
3771
3772 break;
3773
3774 case TCLDOM_NODE_REMOVEEVENTLISTENER:
3775
3776 if (optobjc < 2) {
3777 Tcl_WrongNumArgs(interp, wrongidx, objv, "type listener ?-usecapture boolean?");
3778 return TCL_ERROR;
3779 } else {
3780 Tcl_Obj *typeObjPtr, *listenerPtr;
3781 void *tokenPtr = NULL;
3782 TclXML_libxml2_Document *tDocPtr;
3783 enum TclDOM_EventTypes type;
3784
3785 if (nodePtr) {
3786 tokenPtr = (void *) nodePtr;
3787 } else {
3788 tokenPtr = (void *) docPtr;
3789 }
3790
3791 typeObjPtr = optobjv[0];
3792 if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_EventTypes,
3793 "type", TCL_EXACT, &option) == TCL_OK) {
3794 type = (enum TclDOM_EventTypes) option;
3795 } else {
3796 type = TCLDOM_EVENT_USERDEFINED;
3797 }
3798 listenerPtr = optobjv[1];
3799
3800 optobjc -= 2;
3801 optobjv += 2;
3802 while (optobjc) {
3803 if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_NodeCommandAddEventListenerOptions,
3804 "option", 0, &option) != TCL_OK) {
3805 return TCL_ERROR;
3806 }
3807 switch ((enum TclDOM_NodeCommandAddEventListenerOptions) option) {
3808 case TCLDOM_NODE_ADDEVENTLISTENER_USECAPTURE:
3809
3810 if (Tcl_GetBooleanFromObj(interp, optobjv[1], &usecapture) != TCL_OK) {
3811 return TCL_ERROR;
3812 }
3813
3814 break;
3815
3816 default:
3817 Tcl_SetResult(interp, "unknown option", NULL);
3818 return TCL_ERROR;
3819 }
3820
3821 optobjc -= 2;
3822 optobjv += 2;
3823 }
3824
3825 if (nodePtr) {
3826 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
3827 return TCL_ERROR;
3828 }
3829 } else {
3830 docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
3831 if (TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr) != TCL_OK) {
3832 return TCL_ERROR;
3833 }
3834 }
3835
3836 return TclDOM_RemoveEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, usecapture);
3837 }
3838
3839 break;
3840
3841 case TCLDOM_NODE_DISPATCHEVENT:
3842
3843 if (optobjc != 1) {
3844 Tcl_WrongNumArgs(interp, wrongidx, objv, "event");
3845 return TCL_ERROR;
3846 } else {
3847 TclDOM_libxml2_Event *eventPtr;
3848
3849 if (TclDOM_libxml2_GetEventFromObj(interp, optobjv[0], &eventPtr) != TCL_OK) {
3850 return TCL_ERROR;
3851 }
3852
3853 if (nodeObjPtr) {
3854 return TclDOM_DispatchEvent(interp, nodeObjPtr, optobjv[0], eventPtr);
3855 } else if (nodePtr) {
3856 return TclDOM_DispatchEvent(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr), optobjv[0], eventPtr);
3857 } else if (docObjPtr) {
3858 return TclDOM_DispatchEvent(interp, docObjPtr, optobjv[0], eventPtr);
3859 } else {
3860 Tcl_SetResult(interp, "unable to dispatch event", NULL);
3861 return TCL_ERROR;
3862 }
3863 }
3864
3865 break;
3866
3867 case TCLDOM_NODE_STRINGVALUE:
3868
3869 if (optobjc != 0) {
3870 Tcl_WrongNumArgs(interp, wrongidx, objv, "");
3871 return TCL_ERROR;
3872 }
3873
3874 Tcl_ResetResult(interp);
3875
3876 Tcl_MutexLock(&libxml2);
3877
3878 if (nodePtr) {
3879 buf = (char *) xmlNodeGetContent(nodePtr);
3880 Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
3881 xmlFree (buf);
3882 } else if (docPtr) {
3883 nodePtr = xmlDocGetRootElement(docPtr);
3884 if (nodePtr) {
3885 buf = (char *) xmlNodeGetContent(nodePtr);
3886 Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
3887 xmlFree (buf);
3888 } else {
3889 nodePtr = docPtr->children;
3890 while (nodePtr != NULL) {
3891 if (nodePtr->type == XML_TEXT_NODE) {
3892 Tcl_AppendResult(interp, (char *) nodePtr->content, NULL);
3893 }
3894 nodePtr = nodePtr->next;
3895 }
3896 }
3897 } else {
3898 Tcl_SetResult(interp, "cannot determine string value: internal error", NULL);
3899 Tcl_MutexUnlock(&libxml2);
3900 return TCL_ERROR;
3901 }
3902
3903 Tcl_MutexUnlock(&libxml2);
3904
3905 break;
3906
3907 case TCLDOM_NODE_SELECTNODE:
3908
3909 Tcl_ResetResult(interp);
3910
3911 return TclDOMSelectNodeCommand(clientData, interp, objc - 1, objv + 1);
3912
3913 break;
3914
3915 default:
3916 Tcl_SetResult(interp, "method \"", NULL);
3917 Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL);
3918 return TCL_ERROR;
3919 }
3920
3921 return TCL_OK;
3922 }
3923 int
NodeCget(interp,docPtr,nodePtr,optPtr)3924 NodeCget(interp, docPtr, nodePtr, optPtr)
3925 Tcl_Interp *interp;
3926 xmlDocPtr docPtr;
3927 xmlNodePtr nodePtr;
3928 Tcl_Obj *CONST optPtr;
3929 {
3930 TclXML_libxml2_Document *tDocPtr;
3931 TclDOM_libxml2_Document *domDocPtr;
3932 Tcl_Obj *objPtr;
3933 xmlNodePtr childNodePtr;
3934 int option;
3935 unsigned long val;
3936 char varname[100];
3937 Tcl_Obj *livePtr;
3938
3939 if (Tcl_GetIndexFromObj(interp, optPtr, TclDOM_NodeCommandOptions,
3940 "option", 0, &option) != TCL_OK) {
3941 return TCL_ERROR;
3942 }
3943
3944 switch ((enum TclDOM_NodeCommandOptions) option) {
3945
3946 case TCLDOM_NODE_NODETYPE:
3947
3948 if (docPtr) {
3949 Tcl_SetResult(interp, "document", NULL);
3950 break;
3951 }
3952
3953 switch (nodePtr->type) {
3954 case XML_ELEMENT_NODE:
3955 Tcl_SetResult(interp, "element", NULL);
3956 break;
3957 case XML_ATTRIBUTE_NODE:
3958 Tcl_SetResult(interp, "attribute", NULL);
3959 break;
3960 case XML_TEXT_NODE:
3961 case XML_CDATA_SECTION_NODE:
3962 Tcl_SetResult(interp, "textNode", NULL);
3963 break;
3964 case XML_ENTITY_REF_NODE:
3965 Tcl_SetResult(interp, "entityReference", NULL);
3966 break;
3967 case XML_ENTITY_NODE:
3968 Tcl_SetResult(interp, "entity", NULL);
3969 break;
3970 case XML_PI_NODE:
3971 Tcl_SetResult(interp, "processingInstruction", NULL);
3972 break;
3973 case XML_COMMENT_NODE:
3974 Tcl_SetResult(interp, "comment", NULL);
3975 break;
3976 case XML_DOCUMENT_NODE:
3977 Tcl_SetResult(interp, "document", NULL);
3978 break;
3979 case XML_DOCUMENT_TYPE_NODE:
3980 Tcl_SetResult(interp, "docType", NULL);
3981 break;
3982 case XML_DOCUMENT_FRAG_NODE:
3983 Tcl_SetResult(interp, "documentFragment", NULL);
3984 break;
3985 case XML_NOTATION_NODE:
3986 Tcl_SetResult(interp, "notation", NULL);
3987 break;
3988 case XML_HTML_DOCUMENT_NODE:
3989 Tcl_SetResult(interp, "HTMLdocument", NULL);
3990 break;
3991 case XML_DTD_NODE:
3992 Tcl_SetResult(interp, "dtd", NULL);
3993 break;
3994 case XML_ELEMENT_DECL:
3995 Tcl_SetResult(interp, "elementDecl", NULL);
3996 break;
3997 case XML_ATTRIBUTE_DECL:
3998 Tcl_SetResult(interp, "attributeDecl", NULL);
3999 break;
4000 case XML_ENTITY_DECL:
4001 Tcl_SetResult(interp, "entityDecl", NULL);
4002 break;
4003 case XML_NAMESPACE_DECL:
4004 Tcl_SetResult(interp, "namespaceDecl", NULL);
4005 break;
4006 case XML_XINCLUDE_START:
4007 Tcl_SetResult(interp, "xincludeStart", NULL);
4008 break;
4009 case XML_XINCLUDE_END:
4010 Tcl_SetResult(interp, "xincludeEnd", NULL);
4011 break;
4012 default:
4013 Tcl_SetResult(interp, "unknown", NULL);
4014 }
4015
4016 break;
4017
4018 case TCLDOM_NODE_LOCALNAME:
4019 case TCLDOM_NODE_NODENAME:
4020
4021 /* This isn't quite right: nodeName should return the expanded name */
4022
4023 if (docPtr) {
4024 Tcl_SetResult(interp, "#document", NULL);
4025 break;
4026 }
4027 /* libxml2 doesn't maintain the correct DOM node name */
4028 switch (nodePtr->type) {
4029 case XML_ELEMENT_NODE:
4030 case XML_ATTRIBUTE_NODE:
4031 case XML_ENTITY_REF_NODE:
4032 case XML_ENTITY_NODE:
4033 case XML_PI_NODE:
4034 case XML_DOCUMENT_TYPE_NODE:
4035 case XML_NOTATION_NODE:
4036 Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->name, -1));
4037 break;
4038 case XML_TEXT_NODE:
4039 Tcl_SetResult(interp, "#text", NULL);
4040 break;
4041 case XML_CDATA_SECTION_NODE:
4042 Tcl_SetResult(interp, "#cdata-section", NULL);
4043 break;
4044 case XML_COMMENT_NODE:
4045 Tcl_SetResult(interp, "#comment", NULL);
4046 break;
4047 case XML_DOCUMENT_NODE:
4048 /* Already handled above */
4049 Tcl_SetResult(interp, "#document", NULL);
4050 break;
4051 case XML_DOCUMENT_FRAG_NODE:
4052 Tcl_SetResult(interp, "#document-fragment", NULL);
4053 break;
4054 case XML_HTML_DOCUMENT_NODE:
4055 /* Not standard DOM */
4056 Tcl_SetResult(interp, "#HTML-document", NULL);
4057 break;
4058 case XML_DTD_NODE:
4059 /* Not standard DOM */
4060 Tcl_SetResult(interp, "#dtd", NULL);
4061 break;
4062 case XML_ELEMENT_DECL:
4063 /* Not standard DOM */
4064 Tcl_SetResult(interp, "#element-declaration", NULL);
4065 break;
4066 case XML_ATTRIBUTE_DECL:
4067 /* Not standard DOM */
4068 Tcl_SetResult(interp, "#attribute-declaration", NULL);
4069 break;
4070 case XML_ENTITY_DECL:
4071 /* Not standard DOM */
4072 Tcl_SetResult(interp, "#entity-declaration", NULL);
4073 break;
4074 case XML_NAMESPACE_DECL:
4075 /* Not standard DOM */
4076 Tcl_SetResult(interp, "#namespace-declaration", NULL);
4077 break;
4078 case XML_XINCLUDE_START:
4079 /* Not standard DOM */
4080 Tcl_SetResult(interp, "#xinclude-start", NULL);
4081 break;
4082 case XML_XINCLUDE_END:
4083 /* Not standard DOM */
4084 Tcl_SetResult(interp, "#xinclude-end", NULL);
4085 break;
4086 default:
4087 Tcl_SetResult(interp, "#unknown", NULL);
4088 }
4089
4090 break;
4091
4092 case TCLDOM_NODE_NODEVALUE:
4093
4094 if (docPtr) {
4095 break;
4096 }
4097
4098 Tcl_MutexLock(&libxml2);
4099
4100 if (XML_GET_CONTENT(nodePtr) != NULL) {
4101 Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) XML_GET_CONTENT(nodePtr), -1));
4102 }
4103
4104 Tcl_MutexUnlock(&libxml2);
4105
4106 break;
4107
4108 case TCLDOM_NODE_OWNERDOCUMENT:
4109
4110 if (docPtr) {
4111 Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(docPtr));
4112 break;
4113 }
4114
4115 Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc));
4116
4117 break;
4118
4119 case TCLDOM_NODE_PARENTNODE:
4120
4121 if (docPtr) {
4122 Tcl_ResetResult(interp);
4123 break;
4124 }
4125
4126 if (nodePtr->parent) {
4127 if (nodePtr->parent->type == XML_DOCUMENT_NODE ||
4128 nodePtr->parent->type == XML_HTML_DOCUMENT_NODE) {
4129 Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc));
4130 } else {
4131 Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->parent));
4132 }
4133 } else {
4134 Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc));
4135 }
4136
4137 break;
4138
4139 case TCLDOM_NODE_CHILDNODES:
4140
4141 /* Set up live NodeList variable */
4142
4143 if (docPtr) {
4144 objPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
4145 if (TclXML_libxml2_GetTclDocFromObj(interp, objPtr, &tDocPtr) != TCL_OK) {
4146 return TCL_ERROR;
4147 }
4148 } else {
4149 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
4150 return TCL_ERROR;
4151 }
4152 }
4153 domDocPtr = GetDOMDocument(interp, tDocPtr);
4154 if (domDocPtr == NULL) {
4155 Tcl_SetResult(interp, "internal error", NULL);
4156 return TCL_ERROR;
4157 }
4158 sprintf(varname, "::dom::%s::nodelist.%d", tDocPtr->token, domDocPtr->nodeCntr++);
4159 livePtr = Tcl_GetVar2Ex(interp, varname, NULL, TCL_GLOBAL_ONLY);
4160 if (!livePtr) {
4161 Tcl_Obj *nodelistPtr = Tcl_NewListObj(0, NULL);
4162
4163 Tcl_SetVar2Ex(interp, varname, NULL, nodelistPtr, TCL_GLOBAL_ONLY);
4164 Tcl_IncrRefCount(nodelistPtr);
4165
4166 if (docPtr) {
4167 if (Tcl_TraceVar(interp, varname, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNodeListDoc, (ClientData) docPtr) != TCL_OK) {
4168 Tcl_DecrRefCount(nodelistPtr);
4169 return TCL_ERROR;
4170 } else {
4171 TclDOMLiveNodeListDoc((ClientData) tDocPtr->docPtr, interp, varname, NULL, TCL_TRACE_READS);
4172 }
4173 } else {
4174 if (Tcl_TraceVar(interp, varname, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNodeListNode, (ClientData) nodePtr) != TCL_OK) {
4175 Tcl_DecrRefCount(nodelistPtr);
4176 return TCL_ERROR;
4177 } else {
4178 TclDOMLiveNodeListNode((ClientData) nodePtr, interp, varname, NULL, TCL_TRACE_READS);
4179 }
4180 }
4181 }
4182
4183 Tcl_SetObjResult(interp, Tcl_NewStringObj(varname, -1));
4184
4185 break;
4186
4187 case TCLDOM_NODE_FIRSTCHILD:
4188
4189 /*
4190 * Handle case where no children are present
4191 * Bug #1089114 w/- patch by dwcollins
4192 */
4193
4194 if (docPtr) {
4195 childNodePtr = docPtr->children;
4196 } else {
4197 childNodePtr = nodePtr->children;
4198 }
4199
4200 if (childNodePtr != NULL) {
4201 Tcl_SetObjResult(interp,
4202 TclDOM_libxml2_CreateObjFromNode(interp, childNodePtr));
4203 }
4204
4205 break;
4206
4207 case TCLDOM_NODE_LASTCHILD:
4208
4209 if (docPtr) {
4210 childNodePtr = docPtr->last;
4211 } else {
4212 Tcl_MutexLock(&libxml2);
4213 childNodePtr = xmlGetLastChild(nodePtr);
4214 Tcl_MutexUnlock(&libxml2);
4215 }
4216 if (childNodePtr != NULL) {
4217 Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, childNodePtr));
4218 }
4219
4220 break;
4221
4222 case TCLDOM_NODE_NEXTSIBLING:
4223 if (!docPtr && nodePtr->next) {
4224 Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->next));
4225 }
4226
4227 break;
4228
4229 case TCLDOM_NODE_PREVIOUSSIBLING:
4230 if (!docPtr && nodePtr->prev) {
4231 Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->prev));
4232 }
4233
4234 break;
4235
4236 case TCLDOM_NODE_ATTRIBUTES:
4237
4238 if (docPtr) {
4239 Tcl_ResetResult(interp);
4240 return TCL_OK;
4241 } else if (nodePtr->type != XML_ELEMENT_NODE) {
4242 Tcl_SetResult(interp, "wrong object type", NULL);
4243 return TCL_ERROR;
4244 } else {
4245 /* Set up live NamedNodeMap variable */
4246
4247 /* If there's already a variable, return it */
4248 objPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc);
4249 TclXML_libxml2_GetTclDocFromObj(interp, objPtr, &tDocPtr);
4250 domDocPtr = GetDOMDocument(interp, tDocPtr);
4251 if (domDocPtr == NULL) {
4252 Tcl_SetResult(interp, "internal error", NULL);
4253 return TCL_ERROR;
4254 }
4255 sprintf(varname, "::dom::%s::att%d", tDocPtr->token, domDocPtr->nodeCntr++);
4256 livePtr = Tcl_GetVar2Ex(interp, varname, NULL, TCL_GLOBAL_ONLY);
4257 if (!livePtr) {
4258 if (TclDOMSetLiveNamedNodeMap(interp, varname, (ClientData) nodePtr) != TCL_OK) {
4259 Tcl_UnsetVar(interp, varname, TCL_GLOBAL_ONLY);
4260 return TCL_ERROR;
4261 }
4262
4263 if (Tcl_TraceVar(interp, varname, TCL_TRACE_ARRAY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNamedNodeMap, (ClientData) nodePtr) != TCL_OK) {
4264 Tcl_UnsetVar(interp, varname, TCL_GLOBAL_ONLY);
4265 return TCL_ERROR;
4266 }
4267 }
4268
4269 Tcl_SetObjResult(interp, Tcl_NewStringObj(varname, -1));
4270
4271 }
4272
4273 break;
4274
4275 case TCLDOM_NODE_NAMESPACEURI:
4276
4277 if (!docPtr && nodePtr->ns) {
4278 if (nodePtr->ns->href) {
4279 Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->ns->href, -1));
4280 }
4281 }
4282
4283 break;
4284
4285 case TCLDOM_NODE_PREFIX:
4286
4287 if (!docPtr && nodePtr->ns) {
4288 if (nodePtr->ns->prefix) {
4289 Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->ns->prefix, -1));
4290 }
4291 }
4292
4293 break;
4294
4295 case TCLDOM_NODE_ID:
4296
4297 /* Code borrowed from libxslt-1.1.24 functions.c xsltGenerateIdFunction */
4298
4299 val = (unsigned long)((char *)nodePtr - (char *)0);
4300 val /= sizeof(xmlNode);
4301 sprintf(varname, "id%ld", val);
4302 Tcl_SetObjResult(interp, Tcl_NewStringObj(varname, -1));
4303
4304 break;
4305
4306 default:
4307 Tcl_SetResult(interp, "unknown option or not yet implemented", NULL);
4308 return TCL_ERROR;
4309 }
4310
4311 return TCL_OK;
4312 }
4313 int
NodeConfigure(interp,nodePtr,objc,objv)4314 NodeConfigure(interp, nodePtr, objc, objv)
4315 Tcl_Interp *interp;
4316 xmlNodePtr nodePtr;
4317 int objc;
4318 Tcl_Obj *CONST objv[];
4319 {
4320 TclXML_libxml2_Document *tDocPtr;
4321 Tcl_Obj *objPtr;
4322 char *buf;
4323 int option, len;
4324
4325 while (objc) {
4326 if (objc == 1) {
4327 Tcl_SetResult(interp, "missing value", NULL);
4328 return TCL_ERROR;
4329 }
4330
4331 if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_NodeCommandOptions,
4332 "option", 0, &option) != TCL_OK) {
4333 return TCL_ERROR;
4334 }
4335
4336 switch ((enum TclDOM_NodeCommandOptions) option) {
4337 case TCLDOM_NODE_NODETYPE:
4338 case TCLDOM_NODE_NODENAME:
4339 case TCLDOM_NODE_PARENTNODE:
4340 case TCLDOM_NODE_CHILDNODES:
4341 case TCLDOM_NODE_FIRSTCHILD:
4342 case TCLDOM_NODE_LASTCHILD:
4343 case TCLDOM_NODE_PREVIOUSSIBLING:
4344 case TCLDOM_NODE_NEXTSIBLING:
4345 case TCLDOM_NODE_ATTRIBUTES:
4346 case TCLDOM_NODE_NAMESPACEURI:
4347 case TCLDOM_NODE_PREFIX:
4348 case TCLDOM_NODE_LOCALNAME:
4349 case TCLDOM_NODE_OWNERDOCUMENT:
4350 case TCLDOM_NODE_ID:
4351
4352 Tcl_ResetResult(interp);
4353 Tcl_AppendResult(interp, "attribute \"", Tcl_GetStringFromObj(objv[0], NULL), "\" is read-only", NULL);
4354 return TCL_ERROR;
4355
4356 case TCLDOM_NODE_NODEVALUE:
4357
4358 if (!nodePtr) {
4359 Tcl_ResetResult(interp);
4360 return TCL_OK;
4361 }
4362
4363 switch (nodePtr->type) {
4364 case XML_ELEMENT_NODE:
4365 case XML_DOCUMENT_NODE:
4366 case XML_DOCUMENT_FRAG_NODE:
4367 case XML_DOCUMENT_TYPE_NODE:
4368 case XML_ENTITY_NODE:
4369 case XML_ENTITY_REF_NODE:
4370 case XML_NOTATION_NODE:
4371 case XML_HTML_DOCUMENT_NODE:
4372 case XML_DTD_NODE:
4373 case XML_ELEMENT_DECL:
4374 case XML_ATTRIBUTE_DECL:
4375 case XML_ENTITY_DECL:
4376 case XML_NAMESPACE_DECL:
4377 case XML_XINCLUDE_START:
4378 case XML_XINCLUDE_END:
4379 /*
4380 * DOM defines these nodes as not having a node value.
4381 * libxml2 clobbers existing content if the value is set,
4382 * so don't do it!
4383 */
4384 Tcl_ResetResult(interp);
4385 return TCL_OK;
4386
4387 default:
4388 /* fall-through */
4389 break;
4390 }
4391
4392 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
4393 return TCL_ERROR;
4394 }
4395
4396 Tcl_MutexLock(&libxml2);
4397
4398 objPtr = Tcl_NewStringObj((CONST char *) xmlNodeGetContent(nodePtr), -1);
4399
4400 buf = Tcl_GetStringFromObj(objv[1], &len);
4401 xmlNodeSetContentLen(nodePtr, (const xmlChar *) buf, len);
4402
4403 Tcl_MutexUnlock(&libxml2);
4404
4405 TclDOM_PostMutationEvent(interp,
4406 tDocPtr, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr),
4407 TCLDOM_EVENT_DOMCHARACTERDATAMODIFIED, NULL,
4408 Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, objPtr, objv[1], NULL, NULL);
4409
4410 Tcl_DecrRefCount(objPtr);
4411
4412 break;
4413
4414 case TCLDOM_NODE_CDATASECTION:
4415
4416 break;
4417 }
4418
4419 objc -= 2;
4420 objv += 2;
4421
4422 }
4423
4424 return TCL_OK;
4425 }
4426
4427 int
TclDOM_NodeAppendChild(interp,nodePtr,childPtr)4428 TclDOM_NodeAppendChild(interp, nodePtr, childPtr)
4429 Tcl_Interp *interp;
4430 xmlNodePtr nodePtr;
4431 xmlNodePtr childPtr;
4432 {
4433 TclXML_libxml2_Document *tDocPtr;
4434 xmlNodePtr oldParent;
4435 xmlNodePtr oldSibling;
4436
4437 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
4438 return TCL_ERROR;
4439 }
4440
4441 oldParent = childPtr->parent;
4442 oldSibling = childPtr->next;
4443
4444 if (oldParent && oldParent != nodePtr) {
4445 TclDOM_PostMutationEvent(interp,
4446 tDocPtr,
4447 TclDOM_libxml2_CreateObjFromNode(interp, childPtr),
4448 TCLDOM_EVENT_DOMNODEREMOVED, NULL,
4449 Tcl_NewIntObj(1), Tcl_NewIntObj(0),
4450 TclDOM_libxml2_CreateObjFromNode(interp, oldParent),
4451 NULL, NULL, NULL, NULL);
4452 }
4453
4454 Tcl_MutexLock(&libxml2);
4455
4456 /* Although xmlAddChild claims to release the child from its previous context,
4457 * that doesn't appear to actually happen.
4458 */
4459 xmlUnlinkNode(childPtr);
4460 if (xmlAddChild(nodePtr, childPtr) == NULL) {
4461 if (oldSibling) {
4462 xmlAddPrevSibling(oldSibling, childPtr);
4463 } else {
4464 xmlAddChild(oldParent, childPtr);
4465 }
4466
4467 Tcl_SetResult(interp, "unable to insert node", NULL);
4468 Tcl_MutexUnlock(&libxml2);
4469 return TCL_ERROR;
4470 }
4471
4472 Tcl_MutexUnlock(&libxml2);
4473
4474 PostMutationEvents(interp, tDocPtr, nodePtr, childPtr, childPtr, oldParent, childPtr->parent);
4475
4476 Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, childPtr));
4477
4478 return TCL_OK;
4479 }
4480
4481 int
TclDOM_NodeInsertBefore(interp,refPtr,newPtr)4482 TclDOM_NodeInsertBefore(interp, refPtr, newPtr)
4483 Tcl_Interp *interp;
4484 xmlNodePtr refPtr;
4485 xmlNodePtr newPtr;
4486 {
4487 TclXML_libxml2_Document *tDocPtr;
4488 xmlNodePtr oldParent;
4489
4490 if (TclXML_libxml2_GetTclDocFromNode(interp, refPtr, &tDocPtr) != TCL_OK) {
4491 return TCL_ERROR;
4492 }
4493
4494 oldParent = newPtr->parent;
4495 if (oldParent != refPtr->parent) {
4496 TclDOM_PostMutationEvent(interp,
4497 tDocPtr,
4498 TclDOM_libxml2_CreateObjFromNode(interp, refPtr),
4499 TCLDOM_EVENT_DOMNODEREMOVED, NULL,
4500 Tcl_NewIntObj(1), Tcl_NewIntObj(0),
4501 TclDOM_libxml2_CreateObjFromNode(interp, newPtr->parent),
4502 NULL, NULL, NULL, NULL);
4503 }
4504
4505 Tcl_MutexLock(&libxml2);
4506
4507 if (xmlAddPrevSibling(refPtr, newPtr) == NULL) {
4508 Tcl_SetResult(interp, "unable to insert node", NULL);
4509 Tcl_MutexUnlock(&libxml2);
4510 return TCL_ERROR;
4511 }
4512
4513 Tcl_MutexUnlock(&libxml2);
4514
4515 PostMutationEvents(interp, tDocPtr, refPtr, refPtr, newPtr, oldParent, refPtr->parent);
4516
4517 return TCL_OK;
4518 }
4519
PostMutationEvents(interp,tDocPtr,nodePtr,refPtr,newPtr,oldParent,newParent)4520 void PostMutationEvents(interp, tDocPtr, nodePtr, refPtr, newPtr, oldParent, newParent)
4521 Tcl_Interp *interp;
4522 TclXML_libxml2_Document *tDocPtr;
4523 xmlNodePtr nodePtr;
4524 xmlNodePtr refPtr;
4525 xmlNodePtr newPtr;
4526 xmlNodePtr oldParent;
4527 xmlNodePtr newParent;
4528 {
4529 /* If parent has changed, notify old parent */
4530 if (oldParent != NULL && oldParent != newParent) {
4531 TclDOM_PostMutationEvent(interp,
4532 tDocPtr,
4533 TclDOM_libxml2_CreateObjFromNode(interp, oldParent),
4534 TCLDOM_EVENT_DOMSUBTREEMODIFIED, NULL,
4535 Tcl_NewIntObj(1), Tcl_NewIntObj(0),
4536 NULL, NULL, NULL, NULL, NULL);
4537 }
4538 /* Notify new parent */
4539 if (newParent != NULL) {
4540 TclDOM_PostMutationEvent(interp,
4541 tDocPtr,
4542 TclDOM_libxml2_CreateObjFromNode(interp, newParent),
4543 TCLDOM_EVENT_DOMSUBTREEMODIFIED, NULL,
4544 Tcl_NewIntObj(1), Tcl_NewIntObj(0),
4545 NULL, NULL, NULL, NULL, NULL);
4546 }
4547
4548 /* Inserted event */
4549 if (newPtr != NULL) {
4550 TclDOM_PostMutationEvent(interp,
4551 tDocPtr,
4552 TclDOM_libxml2_CreateObjFromNode(interp, newPtr),
4553 TCLDOM_EVENT_DOMNODEINSERTED, NULL,
4554 Tcl_NewIntObj(1), Tcl_NewIntObj(0),
4555 NULL, NULL, NULL, NULL, NULL);
4556 }
4557 }
4558
4559 /*
4560 *----------------------------------------------------------------------------
4561 *
4562 * TclDOM_AddEventListener --
4563 *
4564 * Register an event listener.
4565 *
4566 * Results:
4567 * Success code.
4568 *
4569 * Side effects:
4570 * Event listener stored.
4571 *
4572 *----------------------------------------------------------------------------
4573 */
4574
4575 int
TclDOM_AddEventListener(interp,tDocPtr,tokenPtr,type,typeObjPtr,listenerPtr,capturer)4576 TclDOM_AddEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, capturer)
4577 Tcl_Interp *interp;
4578 TclXML_libxml2_Document *tDocPtr;
4579 void *tokenPtr; /* xmlNodePtr or xmlDocPtr */
4580 enum TclDOM_EventTypes type;
4581 Tcl_Obj *typeObjPtr;
4582 Tcl_Obj *listenerPtr;
4583 int capturer;
4584 {
4585 TclDOM_libxml2_Document *domDocPtr;
4586 Tcl_HashTable *tablePtr, *listenerTablePtr;
4587 Tcl_HashEntry *entryPtr, *listenerEntryPtr;
4588 int new;
4589
4590 domDocPtr = GetDOMDocument(interp, tDocPtr);
4591 if (domDocPtr == NULL) {
4592 Tcl_SetResult(interp, "internal error", NULL);
4593 return TCL_ERROR;
4594 }
4595
4596 if (capturer) {
4597 tablePtr = domDocPtr->captureListeners;
4598 } else {
4599 tablePtr = domDocPtr->bubbleListeners;
4600 }
4601
4602 entryPtr = Tcl_CreateHashEntry(tablePtr, tokenPtr, &new);
4603 if (new) {
4604 listenerTablePtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
4605 Tcl_InitHashTable(listenerTablePtr, TCL_STRING_KEYS);
4606 Tcl_SetHashValue(entryPtr, (char *) listenerTablePtr);
4607 } else {
4608 listenerTablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr);
4609 }
4610
4611 if (type == TCLDOM_EVENT_USERDEFINED) {
4612 listenerEntryPtr = Tcl_CreateHashEntry(listenerTablePtr,
4613 Tcl_GetStringFromObj(typeObjPtr, NULL),
4614 &new);
4615 } else {
4616 listenerEntryPtr = Tcl_CreateHashEntry(listenerTablePtr, TclDOM_EventTypes[type], &new);
4617 }
4618 if (new) {
4619 Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL);
4620
4621 Tcl_IncrRefCount(listenerPtr);
4622 Tcl_IncrRefCount(listPtr);
4623 Tcl_ListObjAppendElement(interp, listPtr, listenerPtr);
4624 Tcl_SetHashValue(listenerEntryPtr, (char *) listPtr);
4625
4626 } else {
4627 Tcl_Obj *listPtr = (Tcl_Obj *) Tcl_GetHashValue(listenerEntryPtr);
4628 Tcl_Obj *curPtr;
4629 int idx, len, listenerLen, len2;
4630 char *listenerBuf, *buf2;
4631
4632 if (Tcl_ListObjLength(interp, listPtr, &len) != TCL_OK) {
4633 Tcl_SetResult(interp, "internal error - bad list", NULL);
4634 return TCL_ERROR;
4635 }
4636 listenerBuf = Tcl_GetStringFromObj(listenerPtr, &listenerLen);
4637
4638 /* Don't allow duplicates in the list */
4639 new = 0;
4640 for (idx = 0; idx < len; idx++) {
4641 Tcl_ListObjIndex(interp, listPtr, idx, &curPtr);
4642 buf2 = Tcl_GetStringFromObj(curPtr, &len2);
4643
4644 if (listenerLen == len2 &&
4645 !strncmp(listenerBuf, buf2, listenerLen)) {
4646 new = 1;
4647 break;
4648 }
4649 }
4650
4651 if (Tcl_ListObjReplace(interp, listPtr, idx, new, 1, &listenerPtr) != TCL_OK) {
4652 return TCL_ERROR;
4653 }
4654
4655 }
4656
4657 /*
4658 * Performance optimization:
4659 * Keep track of which event types have listeners registered.
4660 * If there are no listeners for an event type, then there's
4661 * no point in dispatching that type of event.
4662 * NB. This does not keep track of user-defined events types.
4663 */
4664
4665 if (type != TCLDOM_EVENT_USERDEFINED) {
4666 domDocPtr->listening[type]++;
4667 } /* else this is a user-defined event type - it won't be tracked */
4668
4669 return TCL_OK;
4670 }
4671
4672 /*
4673 *----------------------------------------------------------------------------
4674 *
4675 * TclDOM_GetEventListener --
4676 *
4677 * Find the listener registered for an event type.
4678 *
4679 * Results:
4680 * Event listener returned.
4681 *
4682 * Side effects:
4683 * None.
4684 *
4685 *----------------------------------------------------------------------------
4686 */
4687
4688 Tcl_Obj *
TclDOM_GetEventListener(interp,tDocPtr,tokenPtr,type,typeObjPtr,capturer)4689 TclDOM_GetEventListener(interp,tDocPtr, tokenPtr, type, typeObjPtr, capturer)
4690 Tcl_Interp *interp;
4691 TclXML_libxml2_Document *tDocPtr;
4692 void *tokenPtr;
4693 enum TclDOM_EventTypes type;
4694 Tcl_Obj *typeObjPtr;
4695 int capturer;
4696 {
4697 TclDOM_libxml2_Document *domDocPtr;
4698 Tcl_HashTable *tablePtr;
4699 Tcl_HashEntry *entryPtr;
4700
4701 domDocPtr = GetDOMDocument(interp, tDocPtr);
4702 if (domDocPtr == NULL) {
4703 Tcl_SetResult(interp, "internal error", NULL);
4704 return NULL;
4705 }
4706
4707 if (capturer) {
4708 tablePtr = domDocPtr->captureListeners;
4709 } else {
4710 tablePtr = domDocPtr->bubbleListeners;
4711 }
4712
4713 entryPtr = Tcl_FindHashEntry(tablePtr, tokenPtr);
4714 if (entryPtr) {
4715 tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr);
4716
4717 if (type == TCLDOM_EVENT_USERDEFINED) {
4718 entryPtr = Tcl_FindHashEntry(tablePtr, Tcl_GetStringFromObj(typeObjPtr, NULL));
4719 } else {
4720 entryPtr = Tcl_FindHashEntry(tablePtr, TclDOM_EventTypes[type]);
4721 }
4722 if (entryPtr) {
4723 return (Tcl_Obj *) Tcl_GetHashValue(entryPtr);
4724 }
4725 }
4726
4727 return Tcl_NewObj();
4728 }
4729
4730 /*
4731 *----------------------------------------------------------------------------
4732 *
4733 * TclDOM_RemoveEventListener --
4734 *
4735 * Deregister an event listener.
4736 *
4737 * Results:
4738 * Success code.
4739 *
4740 * Side effects:
4741 * May free Tcl objects.
4742 *
4743 *----------------------------------------------------------------------------
4744 */
4745
4746 int
TclDOM_RemoveEventListener(interp,tDocPtr,tokenPtr,type,typeObjPtr,listenerPtr,capturer)4747 TclDOM_RemoveEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, capturer)
4748 Tcl_Interp *interp;
4749 TclXML_libxml2_Document *tDocPtr;
4750 void *tokenPtr;
4751 enum TclDOM_EventTypes type;
4752 Tcl_Obj *typeObjPtr;
4753 Tcl_Obj *listenerPtr;
4754 int capturer;
4755 {
4756 TclDOM_libxml2_Document *domDocPtr;
4757 Tcl_HashTable *tablePtr;
4758 Tcl_HashEntry *entryPtr;
4759
4760 domDocPtr = GetDOMDocument(interp, tDocPtr);
4761 if (domDocPtr == NULL) {
4762 Tcl_SetResult(interp, "internal error", NULL);
4763 return TCL_ERROR;
4764 }
4765
4766 if (capturer) {
4767 tablePtr = domDocPtr->captureListeners;
4768 } else {
4769 tablePtr = domDocPtr->bubbleListeners;
4770 }
4771
4772 entryPtr = Tcl_FindHashEntry(tablePtr, tokenPtr);
4773 if (entryPtr) {
4774 tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr);
4775
4776 if (type == TCLDOM_EVENT_USERDEFINED) {
4777 entryPtr = Tcl_FindHashEntry(tablePtr, Tcl_GetStringFromObj(typeObjPtr, NULL));
4778 } else {
4779 entryPtr = Tcl_FindHashEntry(tablePtr, TclDOM_EventTypes[type]);
4780 }
4781 if (entryPtr) {
4782 Tcl_Obj *listPtr = (Tcl_Obj *) Tcl_GetHashValue(entryPtr);
4783 Tcl_Obj *curPtr;
4784 int idx, listenerLen, len, len2, found;
4785 char *listenerBuf, *buf2;
4786
4787 if (Tcl_ListObjLength(interp, listPtr, &len) != TCL_OK) {
4788 Tcl_SetResult(interp, "internal error - bad list", NULL);
4789 return TCL_ERROR;
4790 }
4791 listenerBuf = Tcl_GetStringFromObj(listenerPtr, &listenerLen);
4792 found = 0;
4793 for (idx = 0; idx < len; idx++) {
4794 Tcl_ListObjIndex(interp, listPtr, idx, &curPtr);
4795 buf2 = Tcl_GetStringFromObj(curPtr, &len2);
4796 if (listenerLen == len2 &&
4797 !strncmp(listenerBuf, buf2, listenerLen)) {
4798 found = 1;
4799 break;
4800 }
4801 }
4802
4803 if (!found) {
4804 Tcl_SetResult(interp, "listener not found", NULL);
4805 return TCL_ERROR;
4806 } else {
4807 Tcl_ListObjReplace(interp, listPtr, idx, 1, 0, NULL);
4808
4809 /*
4810 * Keep track of which event types have listeners registered.
4811 */
4812
4813 if (type != TCLDOM_EVENT_USERDEFINED) {
4814 domDocPtr->listening[type]--;
4815 } /* else user-defined event type - not being tracked */
4816 }
4817 } else {
4818 Tcl_SetResult(interp, "no listeners registered", NULL);
4819 return TCL_ERROR;
4820 }
4821 } else {
4822 Tcl_SetResult(interp, "no listeners registered", NULL);
4823 return TCL_ERROR;
4824 }
4825
4826 return TCL_OK;
4827 }
4828
4829 /*
4830 *----------------------------------------------------------------------------
4831 *
4832 * HasListener --
4833 *
4834 * Check whether an event listener is registered for an event type.
4835 *
4836 * Results:
4837 * Returns boolean.
4838 *
4839 * Side effects:
4840 * None.
4841 *
4842 *----------------------------------------------------------------------------
4843 */
4844
4845 int
HasListener(interp,tDocPtr,eventType)4846 HasListener(interp, tDocPtr, eventType)
4847 Tcl_Interp *interp;
4848 TclXML_libxml2_Document *tDocPtr;
4849 enum TclDOM_EventTypes eventType;
4850 {
4851 TclDOM_libxml2_Document *domDocPtr = GetDOMDocument(interp, tDocPtr);
4852
4853 if (domDocPtr == NULL) {
4854 return 0;
4855 }
4856
4857 if (eventType == TCLDOM_EVENT_USERDEFINED) {
4858 /*
4859 * We don't know whether there is a listener or not,
4860 * so play it safe.
4861 */
4862 return 1;
4863 }
4864
4865 if (domDocPtr->listening[eventType] > 0) {
4866 return 1;
4867 }
4868
4869 return 0;
4870 }
4871
4872 /*
4873 *----------------------------------------------------------------------------
4874 *
4875 * TclDOM_DispatchEvent --
4876 *
4877 * Dispatch an event object.
4878 *
4879 * Results:
4880 * Event propagates through the DOM tree.
4881 *
4882 * Side effects:
4883 * Depends on event listeners.
4884 *
4885 *----------------------------------------------------------------------------
4886 */
4887
4888 int
TclDOM_DispatchEvent(interp,nodeObjPtr,eventObjPtr,eventPtr)4889 TclDOM_DispatchEvent(interp, nodeObjPtr, eventObjPtr, eventPtr)
4890 Tcl_Interp *interp;
4891 Tcl_Obj *nodeObjPtr;
4892 Tcl_Obj *eventObjPtr;
4893 TclDOM_libxml2_Event *eventPtr;
4894 {
4895 xmlNodePtr nodePtr;
4896 xmlDocPtr docPtr;
4897 TclXML_libxml2_Document *tDocPtr;
4898 TclDOM_libxml2_Document *domDocPtr;
4899 char *phase;
4900 Tcl_Obj *docObjPtr, *pathPtr = NULL;
4901 int idx, len, cancelable;
4902 void *tokenPtr;
4903
4904 if (TclDOM_libxml2_GetNodeFromObj(interp, nodeObjPtr, &nodePtr) != TCL_OK) {
4905 if (TclXML_libxml2_GetTclDocFromObj(interp, nodeObjPtr, &tDocPtr) != TCL_OK) {
4906 Tcl_SetResult(interp, "unrecognised token", NULL);
4907 return TCL_ERROR;
4908 } else {
4909 docObjPtr = nodeObjPtr;
4910 docPtr = tDocPtr->docPtr;
4911 nodeObjPtr = NULL;
4912 nodePtr = NULL;
4913 tokenPtr = (void *) docPtr;
4914 }
4915 } else {
4916 docPtr = nodePtr->doc;
4917 docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
4918 if (TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr) != TCL_OK) {
4919 Tcl_SetResult(interp, "unknown document", NULL);
4920 return TCL_ERROR;
4921 }
4922 tokenPtr = (void *) nodePtr;
4923 }
4924 Tcl_ResetResult(interp);
4925
4926 /*
4927 * Performance optimization:
4928 * If there are no listeners registered for this event type,
4929 * then there is no point in propagating the event.
4930 */
4931 if (!HasListener(interp, tDocPtr, eventPtr->type)) {
4932 return TCL_OK;
4933 }
4934
4935 domDocPtr = GetDOMDocument(interp, tDocPtr);
4936 if (domDocPtr == NULL) {
4937 Tcl_SetResult(interp, "internal error", NULL);
4938 return TCL_ERROR;
4939 }
4940
4941 phase = Tcl_GetStringFromObj(eventPtr->eventPhase, &len);
4942
4943 if (!len) {
4944 /*
4945 * This is the initial dispatch of the event.
4946 * First trigger any capturing event listeners
4947 * Starting from the root, proceed downward
4948 */
4949
4950 Tcl_SetStringObj(eventPtr->eventPhase, "capturing_phase", -1);
4951 eventPtr->target = nodeObjPtr;
4952 Tcl_IncrRefCount(nodeObjPtr);
4953
4954 if (nodePtr) {
4955 pathPtr = GetPath(interp, nodePtr);
4956 } else {
4957 pathPtr = Tcl_NewObj();
4958 }
4959 if (eventPtr->currentNode) {
4960 Tcl_DecrRefCount(eventPtr->currentNode);
4961 }
4962 eventPtr->currentNode = docObjPtr;
4963 Tcl_IncrRefCount(docObjPtr);
4964 if (TriggerEventListeners(interp, domDocPtr->captureListeners, (void *) docPtr, eventObjPtr, eventPtr) != TCL_OK) {
4965 Tcl_DecrRefCount(pathPtr);
4966 return TCL_ERROR;
4967 }
4968
4969 if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) {
4970 Tcl_DecrRefCount(pathPtr);
4971 return TCL_ERROR;
4972 }
4973 if (cancelable && eventPtr->stopPropagation) {
4974 goto stop_propagation;
4975 }
4976
4977 Tcl_ListObjLength(interp, pathPtr, &len);
4978 Tcl_ListObjReplace(interp, pathPtr, len - 1, 1, 0, NULL);
4979 Tcl_ListObjReplace(interp, pathPtr, 0, 1, 0, NULL);
4980 Tcl_ListObjLength(interp, pathPtr, &len);
4981 for (idx = 0; idx < len; idx++) {
4982 Tcl_Obj *ancestorObjPtr;
4983 xmlNodePtr ancestorPtr;
4984
4985 Tcl_ListObjIndex(interp, pathPtr, idx, &ancestorObjPtr);
4986 if (eventPtr->currentNode) {
4987 Tcl_DecrRefCount(eventPtr->currentNode);
4988 }
4989 eventPtr->currentNode = ancestorObjPtr;
4990 Tcl_IncrRefCount(ancestorObjPtr);
4991 if (TclDOM_libxml2_GetNodeFromObj(interp, ancestorObjPtr, &ancestorPtr) != TCL_OK) {
4992 Tcl_SetResult(interp, "cannot find ancestor node \"", NULL);
4993 Tcl_AppendResult(interp, Tcl_GetStringFromObj(ancestorObjPtr, NULL), "\"", NULL);
4994 return TCL_ERROR;
4995 }
4996
4997 if (TriggerEventListeners(interp, domDocPtr->captureListeners, (void *) ancestorPtr, eventObjPtr, eventPtr) != TCL_OK) {
4998 return TCL_ERROR;
4999 }
5000
5001 /*
5002 * A listener may stop propagation,
5003 * but we check here to let all of the
5004 * listeners at that level complete.
5005 */
5006
5007 if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) {
5008 Tcl_DecrRefCount(ancestorObjPtr);
5009 return TCL_ERROR;
5010 }
5011 if (cancelable && eventPtr->stopPropagation) {
5012 Tcl_DecrRefCount(ancestorObjPtr);
5013 goto stop_propagation;
5014 }
5015
5016 Tcl_DecrRefCount(ancestorObjPtr);
5017
5018 }
5019
5020 /* Prepare for the next phase */
5021
5022 if (Tcl_IsShared(eventPtr->eventPhase)) {
5023 Tcl_DecrRefCount(eventPtr->eventPhase);
5024 eventPtr->eventPhase = Tcl_NewStringObj("at_target", -1);
5025 Tcl_IncrRefCount(eventPtr->eventPhase);
5026 } else {
5027 Tcl_SetStringObj(eventPtr->eventPhase, "at_target", -1);
5028 }
5029 }
5030
5031 if (eventPtr->currentNode) {
5032 Tcl_DecrRefCount(eventPtr->currentNode);
5033 }
5034 if (nodePtr) {
5035 eventPtr->currentNode = nodeObjPtr;
5036 tokenPtr = (void *) nodePtr;
5037 } else {
5038 eventPtr->currentNode = docObjPtr;
5039 tokenPtr = (void *) docPtr;
5040 }
5041 Tcl_IncrRefCount(eventPtr->currentNode);
5042
5043 if (TriggerEventListeners(interp, domDocPtr->bubbleListeners, tokenPtr, eventObjPtr, eventPtr) != TCL_OK) {
5044 return TCL_ERROR;
5045 }
5046
5047 if (Tcl_IsShared(eventPtr->eventPhase)) {
5048 Tcl_DecrRefCount(eventPtr->eventPhase);
5049 eventPtr->eventPhase = Tcl_NewStringObj("bubbling_phase", -1);
5050 Tcl_IncrRefCount(eventPtr->eventPhase);
5051 } else {
5052 Tcl_SetStringObj(eventPtr->eventPhase, "bubbling_phase", -1);
5053 }
5054
5055 if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) {
5056 return TCL_ERROR;
5057 }
5058 if (cancelable && eventPtr->stopPropagation) {
5059 /* Do no more */
5060 } else if (nodePtr && nodePtr->parent && nodePtr->parent != (xmlNodePtr) nodePtr->doc) {
5061 Tcl_Obj *objPtr;
5062
5063 objPtr = TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->parent);
5064 if (objPtr == NULL) {
5065 return TCL_ERROR;
5066 }
5067 return TclDOM_DispatchEvent(interp,
5068 objPtr,
5069 eventObjPtr, eventPtr);
5070 } else if (nodePtr && nodePtr->parent) {
5071 Tcl_Obj *objPtr;
5072
5073 objPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc);
5074 if (objPtr == NULL) {
5075 return TCL_ERROR;
5076 }
5077 return TclDOM_DispatchEvent(interp,
5078 objPtr,
5079 eventObjPtr, eventPtr);
5080 }
5081
5082 stop_propagation:
5083 eventPtr->dispatched = 1;
5084
5085 if (pathPtr) {
5086 Tcl_DecrRefCount(pathPtr);
5087 }
5088
5089 return TCL_OK;
5090 }
5091
5092 /*
5093 *----------------------------------------------------------------------------
5094 *
5095 * TclDOMElementCommand --
5096 *
5097 * Implements dom::libxml2::element command.
5098 *
5099 * Results:
5100 * Depends on method.
5101 *
5102 * Side effects:
5103 * Depends on method.
5104 *
5105 *----------------------------------------------------------------------------
5106 */
5107
5108 int
TclDOMElementCommand(clientData,interp,objc,objv)5109 TclDOMElementCommand (clientData, interp, objc, objv)
5110 ClientData clientData;
5111 Tcl_Interp *interp;
5112 int objc;
5113 Tcl_Obj *CONST objv[];
5114 {
5115 int method, optobjc;
5116 Tcl_Obj *CONST *optobjv;
5117 xmlNodePtr nodePtr;
5118 TclXML_libxml2_Document *tDocPtr;
5119 char *value;
5120 xmlAttrPtr attrPtr;
5121 xmlNsPtr nsPtr;
5122
5123 if (clientData == NULL) {
5124 if (objc < 3) {
5125 Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?");
5126 return TCL_ERROR;
5127 }
5128
5129 if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
5130 return TCL_ERROR;
5131 }
5132
5133 optobjv = objv + 3;
5134 optobjc = objc - 3;
5135
5136 } else {
5137
5138 nodePtr = (xmlNodePtr) clientData;
5139
5140 optobjv = objv + 2;
5141 optobjc = objc - 2;
5142 }
5143
5144 if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_ElementCommandMethods,
5145 "method", 0, &method) != TCL_OK) {
5146 return TCL_ERROR;
5147 }
5148
5149 /* Should check that the node is of element type */
5150
5151 Tcl_ResetResult(interp);
5152
5153 switch ((enum TclDOM_ElementCommandMethods) method) {
5154
5155 case TCLDOM_ELEMENT_CGET:
5156 if (optobjc != 1) {
5157 Tcl_WrongNumArgs(interp, 1, objv, "option");
5158 return TCL_ERROR;
5159 }
5160
5161 return ElementCget(interp, nodePtr, optobjv[0]);
5162
5163 break;
5164
5165 case TCLDOM_ELEMENT_CONFIGURE:
5166
5167 if (optobjc == 1) {
5168 return ElementCget(interp, nodePtr, optobjv[0]);
5169 } else {
5170 Tcl_AppendResult(interp, "option \"", Tcl_GetStringFromObj(optobjv[0], NULL), "\" cannot be modified", NULL);
5171 return TCL_ERROR;
5172 }
5173
5174 break;
5175
5176 case TCLDOM_ELEMENT_GETATTRIBUTE:
5177 if (optobjc != 1) {
5178 Tcl_WrongNumArgs(interp, 1, objv, "attr");
5179 return TCL_ERROR;
5180 }
5181
5182 Tcl_MutexLock(&libxml2);
5183 value = (char *) xmlGetProp(nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
5184 Tcl_MutexUnlock(&libxml2);
5185
5186 if (value) {
5187 Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1));
5188 }
5189
5190 break;
5191
5192 case TCLDOM_ELEMENT_GETATTRIBUTENS:
5193 if (optobjc != 2) {
5194 Tcl_WrongNumArgs(interp, 1, objv, "ns attr");
5195 return TCL_ERROR;
5196 }
5197
5198 Tcl_MutexLock(&libxml2);
5199 value = (char *) xmlGetNsProp(nodePtr,
5200 (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL),
5201 (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
5202 Tcl_MutexUnlock(&libxml2);
5203
5204 if (value) {
5205 Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1));
5206 }
5207
5208 break;
5209
5210 case TCLDOM_ELEMENT_SETATTRIBUTE:
5211 if (optobjc != 2) {
5212 Tcl_WrongNumArgs(interp, 1, objv, "attr value");
5213 return TCL_ERROR;
5214 }
5215
5216 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
5217 return TCL_ERROR;
5218 }
5219
5220 Tcl_MutexLock(&libxml2);
5221 value = (char *) xmlGetProp(nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
5222 attrPtr = xmlSetProp(nodePtr,
5223 (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
5224 (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL));
5225 Tcl_MutexUnlock(&libxml2);
5226
5227 if (!attrPtr) {
5228 Tcl_SetResult(interp, "unable to set attribute", NULL);
5229 return TCL_ERROR;
5230 }
5231
5232 TclDOM_PostMutationEvent(interp, tDocPtr, objv[2], TCLDOM_EVENT_DOMATTRMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, Tcl_NewStringObj(value, -1), optobjv[1], optobjv[0], value == NULL? Tcl_NewStringObj("modification", -1) : Tcl_NewStringObj("addition", -1));
5233
5234 Tcl_SetObjResult(interp, optobjv[1]);
5235
5236 break;
5237
5238 case TCLDOM_ELEMENT_SETATTRIBUTENS:
5239 if (optobjc != 3) {
5240 Tcl_WrongNumArgs(interp, 1, objv, "ns attr value");
5241 return TCL_ERROR;
5242 }
5243
5244 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
5245 return TCL_ERROR;
5246 }
5247
5248 Tcl_MutexLock(&libxml2);
5249
5250 nsPtr = xmlSearchNsByHref(nodePtr->doc, nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
5251 if (!nsPtr) {
5252 Tcl_SetResult(interp, "no XML Namespace declaration for namespace", NULL);
5253 Tcl_MutexUnlock(&libxml2);
5254 return TCL_ERROR;
5255 }
5256
5257 value = (char *) xmlGetNsProp(nodePtr,
5258 (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL),
5259 (const xmlChar *) Tcl_GetStringFromObj(optobjv[2], NULL));
5260 attrPtr = xmlSetNsProp(nodePtr,
5261 nsPtr,
5262 (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL),
5263 (const xmlChar *) Tcl_GetStringFromObj(optobjv[3], NULL));
5264
5265 Tcl_MutexUnlock(&libxml2);
5266
5267 if (!attrPtr) {
5268 Tcl_SetResult(interp, "unable to set attribute", NULL);
5269 return TCL_ERROR;
5270 }
5271
5272 TclDOM_PostMutationEvent(interp, tDocPtr, objv[2], TCLDOM_EVENT_DOMATTRMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, Tcl_NewStringObj(value, -1), optobjv[3], optobjv[2], value == NULL? Tcl_NewStringObj("modification", -1) : Tcl_NewStringObj("addition", -1));
5273
5274 break;
5275
5276 case TCLDOM_ELEMENT_REMOVEATTRIBUTE:
5277
5278 if (optobjc != 1) {
5279 Tcl_WrongNumArgs(interp, 1, objv, "attr");
5280 return TCL_ERROR;
5281 }
5282
5283 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
5284 return TCL_ERROR;
5285 }
5286
5287 /* It doesn't matter if this fails due to a non-existant attribute */
5288 Tcl_MutexLock(&libxml2);
5289 xmlUnsetProp(nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
5290 Tcl_MutexUnlock(&libxml2);
5291
5292 TclDOM_PostMutationEvent(interp, tDocPtr, objv[2], TCLDOM_EVENT_DOMATTRMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, optobjv[2], Tcl_NewStringObj("removed", -1));
5293
5294 break;
5295
5296 default:
5297 Tcl_SetResult(interp, "method \"", NULL);
5298 Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL);
5299 return TCL_ERROR;
5300 }
5301
5302 return TCL_OK;
5303 }
5304
5305 int
ElementCget(interp,nodePtr,optObj)5306 ElementCget(interp, nodePtr, optObj)
5307 Tcl_Interp *interp;
5308 xmlNodePtr nodePtr;
5309 Tcl_Obj *CONST optObj;
5310 {
5311 int option;
5312
5313 if (Tcl_GetIndexFromObj(interp, optObj, TclDOM_ElementCommandOptions,
5314 "option", 0, &option) != TCL_OK) {
5315 return TCL_ERROR;
5316 }
5317
5318 switch ((enum TclDOM_ElementCommandOptions) option) {
5319 case TCLDOM_ELEMENT_TAGNAME:
5320 Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->name, -1));
5321 break;
5322
5323 case TCLDOM_ELEMENT_EMPTY:
5324 Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
5325 break;
5326
5327 default:
5328 Tcl_SetResult(interp, "unknown option", NULL);
5329 return TCL_ERROR;
5330 }
5331
5332 return TCL_OK;
5333 }
5334
5335 /*
5336 *----------------------------------------------------------------------------
5337 *
5338 * TclDOM_InitEvent --
5339 *
5340 * Initializes an event object.
5341 *
5342 * Results:
5343 * Tcl_Obj references stored.
5344 *
5345 * Side effects:
5346 * Tcl_Obj's reference count changed.
5347 *
5348 *----------------------------------------------------------------------------
5349 */
5350
5351 void
TclDOM_InitEvent(eventPtr,type,typeObjPtr,bubblesPtr,cancelablePtr)5352 TclDOM_InitEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr)
5353 TclDOM_libxml2_Event *eventPtr;
5354 enum TclDOM_EventTypes type;
5355 Tcl_Obj *typeObjPtr;
5356 Tcl_Obj *bubblesPtr;
5357 Tcl_Obj *cancelablePtr;
5358 {
5359 if (type != TCLDOM_EVENT_USERDEFINED) {
5360 if (eventPtr->type != type) {
5361 if (eventPtr->typeObjPtr) {
5362 Tcl_DecrRefCount(eventPtr->typeObjPtr);
5363 eventPtr->typeObjPtr = NULL;
5364 }
5365 eventPtr->type = type;
5366 }
5367 } else {
5368 char *oldType, *newType;
5369 int oldLen, newLen;
5370
5371 oldType = Tcl_GetStringFromObj(eventPtr->typeObjPtr, &oldLen);
5372 newType = Tcl_GetStringFromObj(typeObjPtr, &newLen);
5373 if (oldLen != newLen ||
5374 strncmp(oldType, newType, oldLen)) {
5375 Tcl_DecrRefCount(eventPtr->typeObjPtr);
5376 eventPtr->typeObjPtr = typeObjPtr;
5377 Tcl_IncrRefCount(typeObjPtr);
5378 eventPtr->type = TCLDOM_EVENT_USERDEFINED;
5379 }
5380 }
5381
5382 if (bubblesPtr && eventPtr->bubbles != bubblesPtr) {
5383 Tcl_DecrRefCount(eventPtr->bubbles);
5384 eventPtr->bubbles = bubblesPtr;
5385 Tcl_IncrRefCount(eventPtr->bubbles);
5386 }
5387 if (cancelablePtr && eventPtr->cancelable != cancelablePtr) {
5388 Tcl_DecrRefCount(eventPtr->cancelable);
5389 eventPtr->cancelable = cancelablePtr;
5390 Tcl_IncrRefCount(eventPtr->cancelable);
5391 }
5392 }
5393
5394 /*
5395 *----------------------------------------------------------------------------
5396 *
5397 * TclDOM_InitUIEvent --
5398 *
5399 * Initializes an event object.
5400 *
5401 * Results:
5402 * Tcl_Obj references stored.
5403 *
5404 * Side effects:
5405 * Tcl_Obj's reference count changed.
5406 *
5407 *----------------------------------------------------------------------------
5408 */
5409
5410 void
TclDOM_InitUIEvent(eventPtr,type,typeObjPtr,bubblesPtr,cancelablePtr,viewPtr,detailPtr)5411 TclDOM_InitUIEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr)
5412 TclDOM_libxml2_Event *eventPtr;
5413 enum TclDOM_EventTypes type;
5414 Tcl_Obj *typeObjPtr;
5415 Tcl_Obj *bubblesPtr;
5416 Tcl_Obj *cancelablePtr;
5417 Tcl_Obj *viewPtr;
5418 Tcl_Obj *detailPtr;
5419 {
5420 TclDOM_InitEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr);
5421
5422 if (viewPtr && eventPtr->view != viewPtr) {
5423 Tcl_DecrRefCount(eventPtr->view);
5424 eventPtr->view = viewPtr;
5425 Tcl_IncrRefCount(eventPtr->view);
5426 }
5427 if (detailPtr && eventPtr->detail != detailPtr) {
5428 Tcl_DecrRefCount(eventPtr->detail);
5429 eventPtr->detail = detailPtr;
5430 Tcl_IncrRefCount(eventPtr->detail);
5431 } else if (detailPtr == NULL) {
5432 Tcl_DecrRefCount(eventPtr->detail);
5433 eventPtr->detail = Tcl_NewObj();
5434 }
5435 }
5436
5437 /*
5438 *----------------------------------------------------------------------------
5439 *
5440 * TclDOM_InitMouseEvent --
5441 *
5442 * Initializes an event object.
5443 *
5444 * Results:
5445 * Tcl_Obj references stored.
5446 *
5447 * Side effects:
5448 * Tcl_Obj's reference count changed.
5449 *
5450 *----------------------------------------------------------------------------
5451 */
5452
5453 void
TclDOM_InitMouseEvent(eventPtr,type,typeObjPtr,bubblesPtr,cancelablePtr,viewPtr,detailPtr,screenXPtr,screenYPtr,clientXPtr,clientYPtr,ctrlKeyPtr,altKeyPtr,shiftKeyPtr,metaKeyPtr,buttonPtr,relatedNodePtr)5454 TclDOM_InitMouseEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, altKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr, relatedNodePtr)
5455 TclDOM_libxml2_Event *eventPtr;
5456 enum TclDOM_EventTypes type;
5457 Tcl_Obj *typeObjPtr;
5458 Tcl_Obj *bubblesPtr;
5459 Tcl_Obj *cancelablePtr;
5460 Tcl_Obj *viewPtr;
5461 Tcl_Obj *detailPtr;
5462 Tcl_Obj *screenXPtr;
5463 Tcl_Obj *screenYPtr;
5464 Tcl_Obj *clientXPtr;
5465 Tcl_Obj *clientYPtr;
5466 Tcl_Obj *ctrlKeyPtr;
5467 Tcl_Obj *altKeyPtr;
5468 Tcl_Obj *shiftKeyPtr;
5469 Tcl_Obj *metaKeyPtr;
5470 Tcl_Obj *buttonPtr;
5471 Tcl_Obj *relatedNodePtr;
5472 {
5473 TclDOM_InitUIEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr);
5474
5475 if (screenXPtr && eventPtr->screenX != screenXPtr) {
5476 Tcl_DecrRefCount(eventPtr->screenX);
5477 eventPtr->screenX = screenXPtr;
5478 Tcl_IncrRefCount(eventPtr->screenX);
5479 }
5480 if (screenYPtr && eventPtr->screenY != screenYPtr) {
5481 Tcl_DecrRefCount(eventPtr->screenY);
5482 eventPtr->screenY = screenYPtr;
5483 Tcl_IncrRefCount(eventPtr->screenY);
5484 }
5485
5486 if (clientXPtr && eventPtr->clientX != clientXPtr) {
5487 Tcl_DecrRefCount(eventPtr->clientX);
5488 eventPtr->clientX = clientXPtr;
5489 Tcl_IncrRefCount(eventPtr->clientX);
5490 }
5491 if (clientYPtr && eventPtr->clientY != clientYPtr) {
5492 Tcl_DecrRefCount(eventPtr->clientY);
5493 eventPtr->clientY = clientYPtr;
5494 Tcl_IncrRefCount(eventPtr->clientY);
5495 }
5496
5497 if (ctrlKeyPtr && eventPtr->ctrlKey != ctrlKeyPtr) {
5498 Tcl_DecrRefCount(eventPtr->ctrlKey);
5499 eventPtr->ctrlKey = ctrlKeyPtr;
5500 Tcl_IncrRefCount(eventPtr->ctrlKey);
5501 }
5502 if (altKeyPtr && eventPtr->altKey != altKeyPtr) {
5503 Tcl_DecrRefCount(eventPtr->altKey);
5504 eventPtr->altKey = altKeyPtr;
5505 Tcl_IncrRefCount(eventPtr->altKey);
5506 }
5507 if (shiftKeyPtr && eventPtr->shiftKey != shiftKeyPtr) {
5508 Tcl_DecrRefCount(eventPtr->shiftKey);
5509 eventPtr->shiftKey = shiftKeyPtr;
5510 Tcl_IncrRefCount(eventPtr->shiftKey);
5511 }
5512 if (metaKeyPtr && eventPtr->metaKey != metaKeyPtr) {
5513 Tcl_DecrRefCount(eventPtr->metaKey);
5514 eventPtr->metaKey = metaKeyPtr;
5515 Tcl_IncrRefCount(eventPtr->metaKey);
5516 }
5517 if (buttonPtr && eventPtr->button != buttonPtr) {
5518 Tcl_DecrRefCount(eventPtr->button);
5519 eventPtr->button = buttonPtr;
5520 Tcl_IncrRefCount(eventPtr->button);
5521 }
5522
5523 if (relatedNodePtr && eventPtr->relatedNode != relatedNodePtr) {
5524 Tcl_DecrRefCount(eventPtr->relatedNode);
5525 eventPtr->relatedNode = relatedNodePtr;
5526 Tcl_IncrRefCount(eventPtr->relatedNode);
5527 }
5528 }
5529
5530 /*
5531 *----------------------------------------------------------------------------
5532 *
5533 * TclDOM_InitMutationEvent --
5534 *
5535 * Initializes an event object.
5536 *
5537 * Results:
5538 * Tcl_Obj references stored.
5539 *
5540 * Side effects:
5541 * Tcl_Obj's reference count changed.
5542 *
5543 *----------------------------------------------------------------------------
5544 */
5545
5546 void
TclDOM_InitMutationEvent(eventPtr,type,typeObjPtr,bubblesPtr,cancelablePtr,relatedNodePtr,prevValuePtr,newValuePtr,attrNamePtr,attrChangePtr)5547 TclDOM_InitMutationEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr)
5548 TclDOM_libxml2_Event *eventPtr;
5549 enum TclDOM_EventTypes type;
5550 Tcl_Obj *typeObjPtr;
5551 Tcl_Obj *bubblesPtr;
5552 Tcl_Obj *cancelablePtr;
5553 Tcl_Obj *relatedNodePtr;
5554 Tcl_Obj *prevValuePtr;
5555 Tcl_Obj *newValuePtr;
5556 Tcl_Obj *attrNamePtr;
5557 Tcl_Obj *attrChangePtr;
5558 {
5559 TclDOM_InitEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr);
5560
5561 if (relatedNodePtr && eventPtr->relatedNode != relatedNodePtr) {
5562 Tcl_DecrRefCount(eventPtr->relatedNode);
5563 eventPtr->relatedNode = relatedNodePtr;
5564 Tcl_IncrRefCount(eventPtr->relatedNode);
5565 }
5566
5567 if (prevValuePtr && eventPtr->prevValue != prevValuePtr) {
5568 Tcl_DecrRefCount(eventPtr->prevValue);
5569 eventPtr->prevValue = prevValuePtr;
5570 Tcl_IncrRefCount(eventPtr->prevValue);
5571 }
5572 if (newValuePtr && eventPtr->newValue != newValuePtr) {
5573 Tcl_DecrRefCount(eventPtr->newValue);
5574 eventPtr->newValue = newValuePtr;
5575 Tcl_IncrRefCount(eventPtr->newValue);
5576 }
5577 if (attrNamePtr && eventPtr->attrName != attrNamePtr) {
5578 Tcl_DecrRefCount(eventPtr->attrName);
5579 eventPtr->attrName = attrNamePtr;
5580 Tcl_IncrRefCount(eventPtr->attrName);
5581 }
5582 if (attrChangePtr && eventPtr->attrChange != attrChangePtr) {
5583 Tcl_DecrRefCount(eventPtr->attrChange);
5584 eventPtr->attrChange = attrChangePtr;
5585 Tcl_IncrRefCount(eventPtr->attrChange);
5586 }
5587 }
5588
5589 /*
5590 *----------------------------------------------------------------------------
5591 *
5592 * TclDOM_PostUIEvent --
5593 *
5594 * Post an event and cleanup afterward.
5595 *
5596 * Results:
5597 * Event created and propagated.
5598 *
5599 * Side effects:
5600 * Depends on event listeners.
5601 *
5602 *----------------------------------------------------------------------------
5603 */
5604
5605 int
TclDOM_PostUIEvent(interp,tDocPtr,nodeObjPtr,type,typeObjPtr,bubblesPtr,cancelablePtr,viewPtr,detailPtr)5606 TclDOM_PostUIEvent(interp, tDocPtr, nodeObjPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr)
5607 Tcl_Interp *interp;
5608 TclXML_libxml2_Document *tDocPtr;
5609 Tcl_Obj *nodeObjPtr;
5610 enum TclDOM_EventTypes type;
5611 Tcl_Obj *typeObjPtr;
5612 Tcl_Obj *bubblesPtr;
5613 Tcl_Obj *cancelablePtr;
5614 Tcl_Obj *viewPtr;
5615 Tcl_Obj *detailPtr;
5616 {
5617 Tcl_Obj *eventObj;
5618 TclDOM_libxml2_Event *eventPtr = NULL;
5619 int result;
5620
5621 /*
5622 * Performance optimisation: if there are no event listeners for this
5623 * event type then don't bother creating an event.
5624 */
5625 if (!HasListener(interp, tDocPtr, type)) {
5626 return TCL_OK;
5627 }
5628
5629 eventObj = TclDOM_libxml2_NewEventObj(interp, tDocPtr->docPtr, type, typeObjPtr);
5630 if (eventObj == NULL) {
5631 Tcl_SetResult(interp, "unable to create event", NULL);
5632 return TCL_ERROR;
5633 }
5634
5635 TclDOM_libxml2_GetEventFromObj(interp, eventObj, &eventPtr);
5636
5637 TclDOM_InitUIEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr);
5638
5639 Tcl_ResetResult(interp);
5640 result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr);
5641
5642 TclDOM_libxml2_DestroyNode(interp, eventPtr->tNodePtr);
5643
5644 return result;
5645 }
5646
5647 /*
5648 *----------------------------------------------------------------------------
5649 *
5650 * TclDOM_PostMouseEvent --
5651 *
5652 * Post an event and cleanup afterward.
5653 *
5654 * Results:
5655 * Event created and propagated.
5656 *
5657 * Side effects:
5658 * Depends on event listeners.
5659 *
5660 *----------------------------------------------------------------------------
5661 */
5662
5663 int
TclDOM_PostMouseEvent(interp,tDocPtr,nodeObjPtr,type,typeObjPtr,bubblesPtr,cancelablePtr,relatedNodePtr,viewPtr,detailPtr,screenXPtr,screenYPtr,clientXPtr,clientYPtr,ctrlKeyPtr,altKeyPtr,shiftKeyPtr,metaKeyPtr,buttonPtr)5664 TclDOM_PostMouseEvent(interp, tDocPtr, nodeObjPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, altKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr)
5665 Tcl_Interp *interp;
5666 TclXML_libxml2_Document *tDocPtr;
5667 Tcl_Obj *nodeObjPtr;
5668 enum TclDOM_EventTypes type;
5669 Tcl_Obj *typeObjPtr;
5670 Tcl_Obj *bubblesPtr;
5671 Tcl_Obj *cancelablePtr;
5672 Tcl_Obj *relatedNodePtr;
5673 Tcl_Obj *viewPtr;
5674 Tcl_Obj *detailPtr;
5675 Tcl_Obj *screenXPtr;
5676 Tcl_Obj *screenYPtr;
5677 Tcl_Obj *clientXPtr;
5678 Tcl_Obj *clientYPtr;
5679 Tcl_Obj *ctrlKeyPtr;
5680 Tcl_Obj *altKeyPtr;
5681 Tcl_Obj *shiftKeyPtr;
5682 Tcl_Obj *metaKeyPtr;
5683 Tcl_Obj *buttonPtr;
5684 {
5685 Tcl_Obj *eventObj;
5686 TclDOM_libxml2_Event *eventPtr = NULL;
5687 int result;
5688
5689 /*
5690 * Performance optimisation: if there are no event listeners for this
5691 * event type then don't bother creating an event.
5692 */
5693 if (!HasListener(interp, tDocPtr, type)) {
5694 return TCL_OK;
5695 }
5696
5697 eventObj = TclDOM_libxml2_NewEventObj(interp, tDocPtr->docPtr, type, typeObjPtr);
5698 if (eventObj == NULL) {
5699 Tcl_SetResult(interp, "unable to create event", NULL);
5700 return TCL_ERROR;
5701 }
5702
5703 TclDOM_libxml2_GetEventFromObj(interp, eventObj, &eventPtr);
5704
5705 TclDOM_InitMouseEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr,
5706 viewPtr, detailPtr,
5707 screenXPtr, screenYPtr, clientXPtr, clientYPtr,
5708 ctrlKeyPtr, altKeyPtr, shiftKeyPtr, metaKeyPtr,
5709 buttonPtr, relatedNodePtr);
5710
5711 Tcl_ResetResult(interp);
5712 result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr);
5713
5714 TclDOM_libxml2_DestroyNode(interp, eventPtr->tNodePtr);
5715
5716 return result;
5717 }
5718
5719 /*
5720 *----------------------------------------------------------------------------
5721 *
5722 * TclDOM_PostMutationEvent --
5723 *
5724 * Post an event and cleanup afterward.
5725 *
5726 * Results:
5727 * Event created and propagated.
5728 *
5729 * Side effects:
5730 * Depends on event listeners.
5731 *
5732 *----------------------------------------------------------------------------
5733 */
5734
5735 int
TclDOM_PostMutationEvent(interp,tDocPtr,nodeObjPtr,type,typeObjPtr,bubblesPtr,cancelablePtr,relatedNodePtr,prevValuePtr,newValuePtr,attrNamePtr,attrChangePtr)5736 TclDOM_PostMutationEvent(interp, tDocPtr, nodeObjPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr)
5737 Tcl_Interp *interp;
5738 TclXML_libxml2_Document *tDocPtr;
5739 Tcl_Obj *nodeObjPtr;
5740 enum TclDOM_EventTypes type;
5741 Tcl_Obj *typeObjPtr;
5742 Tcl_Obj *bubblesPtr;
5743 Tcl_Obj *cancelablePtr;
5744 Tcl_Obj *relatedNodePtr;
5745 Tcl_Obj *prevValuePtr;
5746 Tcl_Obj *newValuePtr;
5747 Tcl_Obj *attrNamePtr;
5748 Tcl_Obj *attrChangePtr;
5749 {
5750 Tcl_Obj *eventObj;
5751 TclDOM_libxml2_Event *eventPtr = NULL;
5752 int result;
5753
5754 /*
5755 * Performance optimisation: if there are no event listeners for this
5756 * event type then don't bother creating an event.
5757 */
5758 if (!HasListener(interp, tDocPtr, type)) {
5759 return TCL_OK;
5760 }
5761
5762 eventObj = TclDOM_libxml2_NewEventObj(interp, tDocPtr->docPtr, type, typeObjPtr);
5763 if (eventObj == NULL) {
5764 Tcl_SetResult(interp, "unable to create event", NULL);
5765 return TCL_ERROR;
5766 }
5767
5768 TclDOM_libxml2_GetEventFromObj(interp, eventObj, &eventPtr);
5769
5770 TclDOM_InitMutationEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr);
5771
5772 Tcl_ResetResult(interp);
5773 result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr);
5774
5775 TclDOM_libxml2_DestroyNode(interp, eventPtr->tNodePtr);
5776
5777 return result;
5778 }
5779
5780 /*
5781 *----------------------------------------------------------------------------
5782 *
5783 * TclDOMEventCommand --
5784 *
5785 * Implements dom::libxml2::event command.
5786 *
5787 * Results:
5788 * Depends on method.
5789 *
5790 * Side effects:
5791 * Depends on method.
5792 *
5793 *----------------------------------------------------------------------------
5794 */
5795
5796 int
TclDOMEventCommand(clientData,interp,objc,objv)5797 TclDOMEventCommand (clientData, interp, objc, objv)
5798 ClientData clientData;
5799 Tcl_Interp *interp;
5800 int objc;
5801 Tcl_Obj *CONST objv[];
5802 {
5803 int method, option;
5804 TclXML_libxml2_Document *tDocPtr;
5805 TclDOM_libxml2_Node *tNodePtr;
5806 TclDOM_libxml2_Event *eventPtr;
5807 xmlNodePtr nodePtr;
5808 enum TclDOM_EventTypes type;
5809 Tcl_Obj *typeObjPtr = NULL;
5810 Tcl_Obj *nodeObj;
5811 Tcl_Obj *bubblesPtr, *cancelablePtr, *viewPtr, *detailPtr;
5812 Tcl_Obj *relatedNodePtr, *screenXPtr, *screenYPtr, *clientXPtr, *clientYPtr;
5813 Tcl_Obj *ctrlKeyPtr, *shiftKeyPtr, *metaKeyPtr, *buttonPtr;
5814 Tcl_Obj *prevValuePtr, *newValuePtr, *attrNamePtr, *attrChangePtr;
5815
5816 if (objc < 2) {
5817 if (clientData == NULL) {
5818 Tcl_WrongNumArgs(interp, 1, objv, "method token ?args...?");
5819 } else {
5820 Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?");
5821 }
5822 return TCL_ERROR;
5823 }
5824
5825 if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_EventCommandMethods,
5826 "method", 0, &method) != TCL_OK) {
5827 return TCL_ERROR;
5828 }
5829
5830 switch ((enum TclDOM_EventCommandMethods) method) {
5831
5832 case TCLDOM_EVENT_CGET:
5833
5834 if (clientData) {
5835 if (objc != 3) {
5836 Tcl_WrongNumArgs(interp, 1, objv, "cget option");
5837 return TCL_ERROR;
5838 }
5839 tNodePtr = (TclDOM_libxml2_Node *) clientData;
5840 if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
5841 Tcl_SetResult(interp, "bad event node", NULL);
5842 return TCL_ERROR;
5843 }
5844 eventPtr = tNodePtr->ptr.eventPtr;
5845 objc -= 2;
5846 objv += 2;
5847 } else {
5848 if (objc != 4) {
5849 Tcl_WrongNumArgs(interp, 3, objv, "cget event option");
5850 return TCL_ERROR;
5851 }
5852 if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
5853 return TCL_ERROR;
5854 }
5855 objc -= 3;
5856 objv += 3;
5857 }
5858
5859 if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions,
5860 "option", 0, &option) != TCL_OK) {
5861 return TCL_ERROR;
5862 }
5863
5864 switch ((enum TclDOM_EventCommandOptions) option) {
5865 case TCLDOM_EVENT_ALTKEY:
5866 Tcl_SetObjResult(interp, eventPtr->altKey);
5867 break;
5868 case TCLDOM_EVENT_ATTRNAME:
5869 Tcl_SetObjResult(interp, eventPtr->attrName);
5870 break;
5871 case TCLDOM_EVENT_ATTRCHANGE:
5872 Tcl_SetObjResult(interp, eventPtr->attrChange);
5873 break;
5874 case TCLDOM_EVENT_BUBBLES:
5875 Tcl_SetObjResult(interp, eventPtr->bubbles);
5876 break;
5877 case TCLDOM_EVENT_BUTTON:
5878 Tcl_SetObjResult(interp, eventPtr->button);
5879 break;
5880 case TCLDOM_EVENT_CANCELABLE:
5881 Tcl_SetObjResult(interp, eventPtr->cancelable);
5882 break;
5883 case TCLDOM_EVENT_CLIENTX:
5884 Tcl_SetObjResult(interp, eventPtr->clientX);
5885 break;
5886 case TCLDOM_EVENT_CLIENTY:
5887 Tcl_SetObjResult(interp, eventPtr->clientY);
5888 break;
5889 case TCLDOM_EVENT_CTRLKEY:
5890 Tcl_SetObjResult(interp, eventPtr->ctrlKey);
5891 break;
5892 case TCLDOM_EVENT_CURRENTNODE:
5893 Tcl_SetObjResult(interp, eventPtr->currentNode);
5894 break;
5895 case TCLDOM_EVENT_DETAIL:
5896 Tcl_SetObjResult(interp, eventPtr->detail);
5897 break;
5898 case TCLDOM_EVENT_EVENTPHASE:
5899 Tcl_SetObjResult(interp, eventPtr->eventPhase);
5900 break;
5901 case TCLDOM_EVENT_METAKEY:
5902 Tcl_SetObjResult(interp, eventPtr->metaKey);
5903 break;
5904 case TCLDOM_EVENT_NEWVALUE:
5905 Tcl_SetObjResult(interp, eventPtr->newValue);
5906 break;
5907 case TCLDOM_EVENT_PREVVALUE:
5908 Tcl_SetObjResult(interp, eventPtr->prevValue);
5909 break;
5910 case TCLDOM_EVENT_RELATEDNODE:
5911 Tcl_SetObjResult(interp, eventPtr->relatedNode);
5912 break;
5913 case TCLDOM_EVENT_SCREENX:
5914 Tcl_SetObjResult(interp, eventPtr->screenX);
5915 break;
5916 case TCLDOM_EVENT_SCREENY:
5917 Tcl_SetObjResult(interp, eventPtr->screenY);
5918 break;
5919 case TCLDOM_EVENT_SHIFTKEY:
5920 Tcl_SetObjResult(interp, eventPtr->shiftKey);
5921 break;
5922 case TCLDOM_EVENT_TARGET:
5923 Tcl_SetObjResult(interp, eventPtr->target);
5924 break;
5925 case TCLDOM_EVENT_TIMESTAMP:
5926 Tcl_SetObjResult(interp, eventPtr->timeStamp);
5927 break;
5928 case TCLDOM_EVENT_TYPE:
5929 if (eventPtr->type == TCLDOM_EVENT_USERDEFINED) {
5930 Tcl_SetObjResult(interp, eventPtr->typeObjPtr);
5931 } else {
5932 Tcl_SetObjResult(interp, Tcl_NewStringObj(TclDOM_EventTypes[eventPtr->type], -1));
5933 }
5934 break;
5935 case TCLDOM_EVENT_VIEW:
5936 Tcl_SetObjResult(interp, eventPtr->view);
5937 break;
5938 default:
5939 Tcl_SetResult(interp, "unknown option", NULL);
5940 return TCL_ERROR;
5941 }
5942
5943 break;
5944
5945 case TCLDOM_EVENT_CONFIGURE:
5946 if (objc < 2) {
5947 Tcl_WrongNumArgs(interp, 3, objv, "configure option ?value?");
5948 return TCL_ERROR;
5949 }
5950
5951 /* No event options are writable */
5952 Tcl_SetResult(interp, "option cannot be modified", NULL);
5953 return TCL_ERROR;
5954
5955 break;
5956
5957 case TCLDOM_EVENT_STOPPROPAGATION:
5958
5959 if (clientData) {
5960 if (objc != 2) {
5961 Tcl_WrongNumArgs(interp, 2, objv, "");
5962 return TCL_ERROR;
5963 }
5964
5965 tNodePtr = (TclDOM_libxml2_Node *) clientData;
5966 if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
5967 Tcl_SetResult(interp, "bad event node", NULL);
5968 return TCL_ERROR;
5969 }
5970 eventPtr = tNodePtr->ptr.eventPtr;
5971 } else {
5972 if (objc != 3) {
5973 Tcl_WrongNumArgs(interp, 3, objv, "");
5974 return TCL_ERROR;
5975 }
5976
5977 if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
5978 return TCL_ERROR;
5979 }
5980 }
5981
5982 eventPtr->stopPropagation = 1;
5983
5984 break;
5985
5986 case TCLDOM_EVENT_PREVENTDEFAULT:
5987
5988 if (clientData) {
5989 if (objc != 2) {
5990 Tcl_WrongNumArgs(interp, 2, objv, "");
5991 return TCL_ERROR;
5992 }
5993
5994 tNodePtr = (TclDOM_libxml2_Node *) clientData;
5995 if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
5996 Tcl_SetResult(interp, "bad event node", NULL);
5997 return TCL_ERROR;
5998 }
5999 eventPtr = tNodePtr->ptr.eventPtr;
6000 } else {
6001 if (objc != 3) {
6002 Tcl_WrongNumArgs(interp, 3, objv, "");
6003 return TCL_ERROR;
6004 }
6005
6006 if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
6007 return TCL_ERROR;
6008 }
6009 }
6010
6011 eventPtr->preventDefault = 1;
6012
6013 break;
6014
6015 case TCLDOM_EVENT_INITEVENT:
6016
6017 if (clientData) {
6018 if (objc != 5) {
6019 Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable");
6020 return TCL_ERROR;
6021 }
6022
6023 tNodePtr = (TclDOM_libxml2_Node *) clientData;
6024 if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
6025 Tcl_SetResult(interp, "bad event node", NULL);
6026 return TCL_ERROR;
6027 }
6028 eventPtr = tNodePtr->ptr.eventPtr;
6029 objc -= 2;
6030 objv += 2;
6031 } else {
6032 if (objc != 6) {
6033 Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable");
6034 return TCL_ERROR;
6035 }
6036
6037 if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
6038 return TCL_ERROR;
6039 }
6040 objc -= 3;
6041 objv += 3;
6042 }
6043
6044 if (eventPtr->dispatched) {
6045 Tcl_SetResult(interp, "event has been dispatched", NULL);
6046 return TCL_ERROR;
6047 }
6048
6049 if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes,
6050 "type", TCL_EXACT, &option) == TCL_OK) {
6051 type = (enum TclDOM_EventTypes) option;
6052 } else {
6053 type = TCLDOM_EVENT_USERDEFINED;
6054 }
6055 Tcl_ResetResult(interp);
6056
6057 TclDOM_InitEvent(eventPtr, type, objv[0], objv[1], objv[2]);
6058
6059 break;
6060
6061 case TCLDOM_EVENT_INITUIEVENT:
6062
6063 if (clientData) {
6064 if (objc < 6 || objc > 7) {
6065 Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable view ?detail?");
6066 return TCL_ERROR;
6067 }
6068
6069 tNodePtr = (TclDOM_libxml2_Node *) clientData;
6070 if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
6071 Tcl_SetResult(interp, "bad event node", NULL);
6072 return TCL_ERROR;
6073 }
6074 eventPtr = tNodePtr->ptr.eventPtr;
6075
6076 objc -= 2;
6077 objv += 2;
6078 } else {
6079 if (objc < 7 || objc > 8) {
6080 Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable view ?detail?");
6081 return TCL_ERROR;
6082 }
6083
6084 if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
6085 return TCL_ERROR;
6086 }
6087
6088 objc -= 3;
6089 objv += 3;
6090 }
6091
6092 if (eventPtr->dispatched) {
6093 Tcl_SetResult(interp, "event has been dispatched", NULL);
6094 return TCL_ERROR;
6095 }
6096
6097 if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes,
6098 "type", TCL_EXACT, &option) == TCL_OK) {
6099 type = (enum TclDOM_EventTypes) option;
6100 } else {
6101 type = TCLDOM_EVENT_USERDEFINED;
6102 }
6103 Tcl_ResetResult(interp);
6104
6105 TclDOM_InitUIEvent(eventPtr, type, objv[0], objv[1], objv[2], objv[3], objc == 5 ? objv[4] : NULL);
6106
6107 break;
6108
6109 case TCLDOM_EVENT_INITMOUSEEVENT:
6110
6111 if (clientData) {
6112 if (objc != 17) {
6113 Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable view detail screenX screenY clientX clientY ctrlKey altKey shiftKey metaKey button relatedNode");
6114 return TCL_ERROR;
6115 }
6116
6117 tNodePtr = (TclDOM_libxml2_Node *) clientData;
6118 if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
6119 Tcl_SetResult(interp, "bad event node", NULL);
6120 return TCL_ERROR;
6121 }
6122 eventPtr = tNodePtr->ptr.eventPtr;
6123
6124 objc -= 2;
6125 objv += 2;
6126 } else {
6127 if (objc != 18) {
6128 Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable view detail screenX screenY clientX clientY ctrlKey altKey shiftKey metaKey button relatedNode");
6129 return TCL_ERROR;
6130 }
6131
6132 if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
6133 return TCL_ERROR;
6134 }
6135
6136 objc -= 3;
6137 objv += 3;
6138 }
6139
6140 if (eventPtr->dispatched) {
6141 Tcl_SetResult(interp, "event has been dispatched", NULL);
6142 return TCL_ERROR;
6143 }
6144
6145 if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes,
6146 "type", TCL_EXACT, &option) == TCL_OK) {
6147 type = (enum TclDOM_EventTypes) option;
6148 } else {
6149 type = TCLDOM_EVENT_USERDEFINED;
6150 }
6151 Tcl_ResetResult(interp);
6152
6153 TclDOM_InitMouseEvent(eventPtr, type, objv[0], objv[1], objv[2], objv[3], objv[4], objv[5], objv[6], objv[7], objv[8], objv[9], objv[10], objv[11], objv[12], objv[13], objv[14]);
6154
6155 break;
6156
6157 case TCLDOM_EVENT_INITMUTATIONEVENT:
6158
6159 if (clientData) {
6160 if (objc != 10) {
6161 Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable relatedNode prevValue newValue attrName attrChange");
6162 return TCL_ERROR;
6163 }
6164
6165 tNodePtr = (TclDOM_libxml2_Node *) clientData;
6166 if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
6167 Tcl_SetResult(interp, "bad event node", NULL);
6168 return TCL_ERROR;
6169 }
6170 eventPtr = tNodePtr->ptr.eventPtr;
6171
6172 objc -= 2;
6173 objv += 2;
6174 } else {
6175 if (objc != 11) {
6176 Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable relatedNode prevValue newValue attrName attrChange");
6177 return TCL_ERROR;
6178 }
6179
6180 if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
6181 return TCL_ERROR;
6182 }
6183
6184 objc -= 3;
6185 objv += 3;
6186 }
6187
6188 if (eventPtr->dispatched) {
6189 Tcl_SetResult(interp, "event has been dispatched", NULL);
6190 return TCL_ERROR;
6191 }
6192
6193 if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes,
6194 "type", TCL_EXACT, &option) == TCL_OK) {
6195 type = (enum TclDOM_EventTypes) option;
6196 } else {
6197 type = TCLDOM_EVENT_USERDEFINED;
6198 }
6199 Tcl_ResetResult(interp);
6200
6201 TclDOM_InitMutationEvent(eventPtr, type, objv[0], objv[1], objv[2], objv[3], objv[4], objv[5], objv[6], objv[7]);
6202
6203 break;
6204
6205 case TCLDOM_EVENT_POSTUIEVENT:
6206
6207 if (clientData) {
6208 Tcl_SetResult(interp, "bad method for event", NULL);
6209 return TCL_ERROR;
6210 }
6211
6212 if (objc < 4) {
6213 Tcl_WrongNumArgs(interp, 1, objv, "postUIEvent node type ?args ...?");
6214 return TCL_ERROR;
6215 }
6216
6217 if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
6218 return TCL_ERROR;
6219 }
6220 nodeObj = objv[2];
6221
6222 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
6223 return TCL_ERROR;
6224 }
6225
6226 if (Tcl_GetIndexFromObj(interp, objv[3], TclDOM_EventTypes,
6227 "type", TCL_EXACT, &option) == TCL_OK) {
6228 type = (enum TclDOM_EventTypes) option;
6229 } else {
6230 type = TCLDOM_EVENT_USERDEFINED;
6231 }
6232 typeObjPtr = objv[3];
6233 Tcl_ResetResult(interp);
6234
6235 bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
6236 if (!bubblesPtr) {
6237 return TCL_ERROR;
6238 }
6239 Tcl_IncrRefCount(bubblesPtr);
6240 cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
6241 if (!cancelablePtr) {
6242 Tcl_DecrRefCount(bubblesPtr);
6243 return TCL_ERROR;
6244 }
6245 Tcl_IncrRefCount(cancelablePtr);
6246
6247 viewPtr = Tcl_NewObj();
6248 detailPtr = Tcl_NewObj();
6249
6250 objc -= 4;
6251 objv += 4;
6252 while (objc) {
6253
6254 if (objc == 1) {
6255 Tcl_SetResult(interp, "value missing", NULL);
6256 Tcl_DecrRefCount(bubblesPtr);
6257 Tcl_DecrRefCount(cancelablePtr);
6258 Tcl_DecrRefCount(viewPtr);
6259 Tcl_DecrRefCount(detailPtr);
6260 return TCL_ERROR;
6261 }
6262
6263 if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions,
6264 "option", 0, &option) != TCL_OK) {
6265 Tcl_DecrRefCount(bubblesPtr);
6266 Tcl_DecrRefCount(cancelablePtr);
6267 Tcl_DecrRefCount(viewPtr);
6268 Tcl_DecrRefCount(detailPtr);
6269 return TCL_ERROR;
6270 }
6271 switch ((enum TclDOM_EventCommandOptions) option) {
6272 case TCLDOM_EVENT_BUBBLES:
6273 Tcl_DecrRefCount(bubblesPtr);
6274 bubblesPtr = objv[1];
6275 Tcl_IncrRefCount(bubblesPtr);
6276 break;
6277 case TCLDOM_EVENT_CANCELABLE:
6278 Tcl_DecrRefCount(cancelablePtr);
6279 cancelablePtr = objv[1];
6280 Tcl_IncrRefCount(cancelablePtr);
6281 break;
6282 case TCLDOM_EVENT_VIEW:
6283 Tcl_DecrRefCount(viewPtr);
6284 viewPtr = objv[1];
6285 Tcl_IncrRefCount(viewPtr);
6286 break;
6287 case TCLDOM_EVENT_DETAIL:
6288 Tcl_DecrRefCount(detailPtr);
6289 detailPtr = objv[1];
6290 Tcl_IncrRefCount(detailPtr);
6291 break;
6292 default:
6293 Tcl_SetResult(interp, "bad option", NULL);
6294 Tcl_DecrRefCount(bubblesPtr);
6295 Tcl_DecrRefCount(cancelablePtr);
6296 Tcl_DecrRefCount(viewPtr);
6297 Tcl_DecrRefCount(detailPtr);
6298 return TCL_ERROR;
6299 }
6300
6301 objc -= 2;
6302 objv += 2;
6303 }
6304
6305 if (TclDOM_PostUIEvent(interp, tDocPtr, nodeObj, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr) != TCL_OK) {
6306 Tcl_DecrRefCount(bubblesPtr);
6307 Tcl_DecrRefCount(cancelablePtr);
6308 Tcl_DecrRefCount(viewPtr);
6309 Tcl_DecrRefCount(detailPtr);
6310 return TCL_ERROR;
6311 }
6312
6313 break;
6314
6315 case TCLDOM_EVENT_POSTMOUSEEVENT:
6316
6317 if (clientData) {
6318 Tcl_SetResult(interp, "bad method for event", NULL);
6319 return TCL_ERROR;
6320 }
6321
6322 if (objc < 4) {
6323 Tcl_WrongNumArgs(interp, 1, objv, "postMouseEvent node type ?args ...?");
6324 return TCL_ERROR;
6325 }
6326
6327 if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
6328 return TCL_ERROR;
6329 }
6330 nodeObj = objv[2];
6331
6332 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
6333 return TCL_ERROR;
6334 }
6335
6336 if (Tcl_GetIndexFromObj(interp, objv[3], TclDOM_EventTypes,
6337 "type", TCL_EXACT, &option) == TCL_OK) {
6338 type = (enum TclDOM_EventTypes) option;
6339 } else {
6340 type = TCLDOM_EVENT_USERDEFINED;
6341 }
6342 typeObjPtr = objv[3];
6343 Tcl_ResetResult(interp);
6344
6345 bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
6346 if (!bubblesPtr) {
6347 return TCL_ERROR;
6348 }
6349 Tcl_IncrRefCount(bubblesPtr);
6350 cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
6351 if (!cancelablePtr) {
6352 Tcl_DecrRefCount(bubblesPtr);
6353 return TCL_ERROR;
6354 }
6355 Tcl_IncrRefCount(cancelablePtr);
6356
6357 viewPtr = Tcl_NewObj();
6358 detailPtr = Tcl_NewObj();
6359 relatedNodePtr = Tcl_NewObj();
6360 screenXPtr = Tcl_NewObj();
6361 screenYPtr = Tcl_NewObj();
6362 clientXPtr = Tcl_NewObj();
6363 clientYPtr = Tcl_NewObj();
6364 ctrlKeyPtr = Tcl_NewObj();
6365 shiftKeyPtr = Tcl_NewObj();
6366 metaKeyPtr = Tcl_NewObj();
6367 buttonPtr = Tcl_NewObj();
6368
6369 objc -= 4;
6370 objv += 4;
6371 while (objc) {
6372
6373 if (objc == 1) {
6374 Tcl_SetResult(interp, "value missing", NULL);
6375 goto mouse_error;
6376 }
6377
6378 if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions,
6379 "option", 0, &option) != TCL_OK) {
6380 goto mouse_error;
6381 }
6382 switch ((enum TclDOM_EventCommandOptions) option) {
6383 case TCLDOM_EVENT_BUBBLES:
6384 Tcl_DecrRefCount(bubblesPtr);
6385 bubblesPtr = objv[1];
6386 Tcl_IncrRefCount(bubblesPtr);
6387 break;
6388 case TCLDOM_EVENT_CANCELABLE:
6389 Tcl_DecrRefCount(cancelablePtr);
6390 cancelablePtr = objv[1];
6391 Tcl_IncrRefCount(cancelablePtr);
6392 break;
6393 case TCLDOM_EVENT_RELATEDNODE:
6394 Tcl_DecrRefCount(relatedNodePtr);
6395 relatedNodePtr = objv[1];
6396 Tcl_IncrRefCount(relatedNodePtr);
6397 break;
6398 case TCLDOM_EVENT_VIEW:
6399 Tcl_DecrRefCount(viewPtr);
6400 viewPtr = objv[1];
6401 Tcl_IncrRefCount(viewPtr);
6402 break;
6403 case TCLDOM_EVENT_DETAIL:
6404 Tcl_DecrRefCount(detailPtr);
6405 detailPtr = objv[1];
6406 Tcl_IncrRefCount(detailPtr);
6407 break;
6408 case TCLDOM_EVENT_SCREENX:
6409 Tcl_DecrRefCount(screenXPtr);
6410 screenXPtr = objv[1];
6411 Tcl_IncrRefCount(screenXPtr);
6412 break;
6413 case TCLDOM_EVENT_SCREENY:
6414 Tcl_DecrRefCount(screenYPtr);
6415 screenYPtr = objv[1];
6416 Tcl_IncrRefCount(screenYPtr);
6417 break;
6418 case TCLDOM_EVENT_CLIENTX:
6419 Tcl_DecrRefCount(clientXPtr);
6420 clientXPtr = objv[1];
6421 Tcl_IncrRefCount(clientXPtr);
6422 break;
6423 case TCLDOM_EVENT_CLIENTY:
6424 Tcl_DecrRefCount(clientYPtr);
6425 clientYPtr = objv[1];
6426 Tcl_IncrRefCount(clientYPtr);
6427 break;
6428 case TCLDOM_EVENT_CTRLKEY:
6429 Tcl_DecrRefCount(ctrlKeyPtr);
6430 ctrlKeyPtr = objv[1];
6431 Tcl_IncrRefCount(ctrlKeyPtr);
6432 break;
6433 case TCLDOM_EVENT_SHIFTKEY:
6434 Tcl_DecrRefCount(shiftKeyPtr);
6435 shiftKeyPtr = objv[1];
6436 Tcl_IncrRefCount(shiftKeyPtr);
6437 break;
6438 case TCLDOM_EVENT_METAKEY:
6439 Tcl_DecrRefCount(metaKeyPtr);
6440 metaKeyPtr = objv[1];
6441 Tcl_IncrRefCount(metaKeyPtr);
6442 break;
6443 case TCLDOM_EVENT_BUTTON:
6444 Tcl_DecrRefCount(buttonPtr);
6445 buttonPtr = objv[1];
6446 Tcl_IncrRefCount(buttonPtr);
6447 break;
6448 default:
6449 Tcl_SetResult(interp, "bad option", NULL);
6450 goto mouse_error;
6451 }
6452
6453 objc -= 2;
6454 objv += 2;
6455 }
6456
6457 if (TclDOM_PostMouseEvent(interp, tDocPtr, nodeObj, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr, relatedNodePtr) != TCL_OK) {
6458 goto mouse_error;
6459 }
6460
6461 break;
6462
6463 mouse_error:
6464 Tcl_DecrRefCount(bubblesPtr);
6465 Tcl_DecrRefCount(cancelablePtr);
6466 Tcl_DecrRefCount(viewPtr);
6467 Tcl_DecrRefCount(detailPtr);
6468 Tcl_DecrRefCount(relatedNodePtr);
6469 Tcl_DecrRefCount(screenXPtr);
6470 Tcl_DecrRefCount(screenYPtr);
6471 Tcl_DecrRefCount(clientXPtr);
6472 Tcl_DecrRefCount(clientYPtr);
6473 Tcl_DecrRefCount(ctrlKeyPtr);
6474 Tcl_DecrRefCount(shiftKeyPtr);
6475 Tcl_DecrRefCount(metaKeyPtr);
6476 Tcl_DecrRefCount(buttonPtr);
6477
6478 return TCL_ERROR;
6479
6480 case TCLDOM_EVENT_POSTMUTATIONEVENT:
6481
6482 if (clientData) {
6483 Tcl_SetResult(interp, "bad method for event", NULL);
6484 return TCL_ERROR;
6485 }
6486
6487 if (objc < 4) {
6488 Tcl_WrongNumArgs(interp, 1, objv, "postMutationEvent node type ?args ...?");
6489 return TCL_ERROR;
6490 }
6491
6492 if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
6493 return TCL_ERROR;
6494 }
6495 nodeObj = objv[2];
6496
6497 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
6498 return TCL_ERROR;
6499 }
6500
6501 if (Tcl_GetIndexFromObj(interp, objv[3], TclDOM_EventTypes,
6502 "type", TCL_EXACT, &option) == TCL_OK) {
6503 type = (enum TclDOM_EventTypes) option;
6504 } else {
6505 type = TCLDOM_EVENT_USERDEFINED;
6506 }
6507 typeObjPtr = objv[3];
6508 Tcl_ResetResult(interp);
6509
6510 bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
6511 if (!bubblesPtr) {
6512 return TCL_ERROR;
6513 }
6514 Tcl_IncrRefCount(bubblesPtr);
6515 cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
6516 if (!cancelablePtr) {
6517 Tcl_DecrRefCount(bubblesPtr);
6518 return TCL_ERROR;
6519 }
6520 Tcl_IncrRefCount(cancelablePtr);
6521
6522 relatedNodePtr = Tcl_NewObj();
6523 prevValuePtr = Tcl_NewObj();
6524 newValuePtr = Tcl_NewObj();
6525 attrNamePtr = Tcl_NewObj();
6526 attrChangePtr = Tcl_NewObj();
6527
6528 objc -= 4;
6529 objv += 4;
6530 while (objc) {
6531
6532 if (objc == 1) {
6533 Tcl_SetResult(interp, "value missing", NULL);
6534 goto mutation_error;
6535 }
6536
6537 if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions,
6538 "option", 0, &option) != TCL_OK) {
6539 goto mutation_error;
6540 }
6541 switch ((enum TclDOM_EventCommandOptions) option) {
6542 case TCLDOM_EVENT_BUBBLES:
6543 Tcl_DecrRefCount(bubblesPtr);
6544 bubblesPtr = objv[1];
6545 Tcl_IncrRefCount(bubblesPtr);
6546 break;
6547 case TCLDOM_EVENT_CANCELABLE:
6548 Tcl_DecrRefCount(cancelablePtr);
6549 cancelablePtr = objv[1];
6550 Tcl_IncrRefCount(cancelablePtr);
6551 break;
6552 case TCLDOM_EVENT_RELATEDNODE:
6553 Tcl_DecrRefCount(relatedNodePtr);
6554 relatedNodePtr = objv[1];
6555 Tcl_IncrRefCount(relatedNodePtr);
6556 break;
6557 case TCLDOM_EVENT_PREVVALUE:
6558 Tcl_DecrRefCount(prevValuePtr);
6559 prevValuePtr = objv[1];
6560 Tcl_IncrRefCount(prevValuePtr);
6561 break;
6562 case TCLDOM_EVENT_NEWVALUE:
6563 Tcl_DecrRefCount(newValuePtr);
6564 newValuePtr = objv[1];
6565 Tcl_IncrRefCount(newValuePtr);
6566 break;
6567 case TCLDOM_EVENT_ATTRNAME:
6568 Tcl_DecrRefCount(attrNamePtr);
6569 attrNamePtr = objv[1];
6570 Tcl_IncrRefCount(attrNamePtr);
6571 break;
6572 case TCLDOM_EVENT_ATTRCHANGE:
6573 Tcl_DecrRefCount(attrChangePtr);
6574 attrChangePtr = objv[1];
6575 Tcl_IncrRefCount(attrChangePtr);
6576 break;
6577 default:
6578 Tcl_SetResult(interp, "bad option", NULL);
6579 goto mutation_error;
6580 }
6581
6582 objc -= 2;
6583 objv += 2;
6584 }
6585
6586 if (TclDOM_PostMutationEvent(interp, tDocPtr, nodeObj, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr) != TCL_OK) {
6587 goto mutation_error;
6588 }
6589
6590 break;
6591
6592 mutation_error:
6593 Tcl_DecrRefCount(bubblesPtr);
6594 Tcl_DecrRefCount(cancelablePtr);
6595 Tcl_DecrRefCount(relatedNodePtr);
6596 Tcl_DecrRefCount(prevValuePtr);
6597 Tcl_DecrRefCount(newValuePtr);
6598 Tcl_DecrRefCount(attrNamePtr);
6599 Tcl_DecrRefCount(attrChangePtr);
6600
6601 return TCL_ERROR;
6602
6603 default:
6604
6605 Tcl_SetResult(interp, "unknown method", NULL);
6606 return TCL_ERROR;
6607
6608 }
6609
6610 return TCL_OK;
6611 }
6612
6613 /*
6614 *----------------------------------------------------------------------------
6615 *
6616 * GetPath --
6617 *
6618 * Constructs a list of ancestor nodes.
6619 *
6620 * Results:
6621 * Returns list as a Tcl_Obj.
6622 *
6623 * Side effects:
6624 * Allocates Tcl_Obj structures.
6625 *
6626 *----------------------------------------------------------------------------
6627 */
6628
6629 static Tcl_Obj *
GetPath(interp,nodePtr)6630 GetPath (interp, nodePtr)
6631 Tcl_Interp *interp;
6632 xmlNodePtr nodePtr;
6633 {
6634 Tcl_Obj *listPtr, *resultPtr;
6635 Tcl_Obj *objv[2];
6636
6637 if (nodePtr) {
6638 if (nodePtr->type == XML_DOCUMENT_NODE) {
6639 objv[0] = TclXML_libxml2_CreateObjFromDoc((xmlDocPtr) nodePtr);
6640 } else {
6641 objv[0] = TclDOM_libxml2_CreateObjFromNode(interp, nodePtr);
6642 }
6643 objv[1] = NULL;
6644
6645 listPtr = Tcl_NewListObj(1, objv);
6646 if (nodePtr->parent) {
6647 resultPtr = GetPath(interp, nodePtr->parent);
6648 Tcl_ListObjAppendList(interp, resultPtr, listPtr);
6649 } else {
6650 resultPtr = listPtr;
6651 }
6652 return resultPtr;
6653 } else {
6654 return Tcl_NewObj();
6655 }
6656 }
6657
6658 /*
6659 *----------------------------------------------------------------------------
6660 *
6661 * Node (and event) Tcl Object management
6662 *
6663 *----------------------------------------------------------------------------
6664 */
6665
6666 /*
6667 *----------------------------------------------------------------------------
6668 *
6669 * TclDOM_libxml2_CreateObjFromNode --
6670 *
6671 * Create a Tcl_Obj to wrap a tree node.
6672 *
6673 * Results:
6674 * Returns Tcl_Obj*.
6675 *
6676 * Side effects:
6677 * Allocates object. Creates node command.
6678 *
6679 *----------------------------------------------------------------------------
6680 */
6681
6682 Tcl_Obj *
TclDOM_libxml2_CreateObjFromNode(interp,nodePtr)6683 TclDOM_libxml2_CreateObjFromNode (interp, nodePtr)
6684 Tcl_Interp *interp;
6685 xmlNodePtr nodePtr;
6686 {
6687 TclDOM_libxml2_Node *tNodePtr;
6688 TclXML_libxml2_Document *tDocPtr;
6689 TclDOM_libxml2_Document *domDocPtr;
6690 Tcl_Obj *objPtr;
6691 Tcl_HashEntry *entry;
6692 int new;
6693
6694 if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
6695 Tcl_SetResult(interp, "unable to find document for node", NULL);
6696 return NULL;
6697 }
6698 if ((domDocPtr = GetDOMDocument(interp, tDocPtr)) == NULL) {
6699 Tcl_SetResult(interp, "internal error", NULL);
6700 return NULL;
6701 }
6702
6703 tNodePtr = (TclDOM_libxml2_Node *) Tcl_Alloc(sizeof(TclDOM_libxml2_Node));
6704 tNodePtr->ptr.nodePtr = nodePtr;
6705 tNodePtr->type = TCLDOM_LIBXML2_NODE_NODE;
6706 tNodePtr->objs = NULL;
6707 tNodePtr->token = Tcl_Alloc(30);
6708 sprintf(tNodePtr->token, "::dom::%s::node%d", tDocPtr->token, domDocPtr->nodeCntr++);
6709
6710 entry = Tcl_CreateHashEntry(domDocPtr->nodes, tNodePtr->token, &new);
6711 if (!new) {
6712 Tcl_Free((char *) tNodePtr->token);
6713 Tcl_Free((char *) tNodePtr);
6714 Tcl_SetResult(interp, "internal error", NULL);
6715 return NULL;
6716 }
6717 Tcl_SetHashValue(entry, (void *) tNodePtr);
6718
6719 tNodePtr->cmd = Tcl_CreateObjCommand(interp, tNodePtr->token, TclDOMNodeCommand, (ClientData) tNodePtr, TclDOMNodeCommandDelete);
6720
6721 objPtr = Tcl_NewObj();
6722 objPtr->internalRep.otherValuePtr = (VOID *) tNodePtr;
6723 objPtr->typePtr = &NodeObjType;
6724
6725 objPtr->bytes = Tcl_Alloc(strlen(tNodePtr->token) + 1);
6726 strcpy(objPtr->bytes, tNodePtr->token);
6727 objPtr->length = strlen(objPtr->bytes);
6728
6729 NodeAddObjRef(tNodePtr, objPtr);
6730
6731 return objPtr;
6732 }
6733
6734 /*
6735 *----------------------------------------------------------------------------
6736 *
6737 * NodeAddObjRef --
6738 *
6739 * Add an object reference to a node wrapper.
6740 *
6741 * Results:
6742 * Adds a reference to the Tcl_Obj for the node.
6743 *
6744 * Side effects:
6745 * Allocates memory.
6746 *
6747 *----------------------------------------------------------------------------
6748 */
6749
6750 static void
NodeAddObjRef(tNodePtr,objPtr)6751 NodeAddObjRef(tNodePtr, objPtr)
6752 TclDOM_libxml2_Node *tNodePtr;
6753 Tcl_Obj *objPtr;
6754 {
6755 ObjList *listPtr;
6756
6757 listPtr = (ObjList *) Tcl_Alloc(sizeof(ObjList));
6758 listPtr->next = tNodePtr->objs;
6759 listPtr->objPtr = objPtr;
6760
6761 tNodePtr->objs = (void *) listPtr;
6762 }
6763
6764 /*
6765 *----------------------------------------------------------------------------
6766 *
6767 * TclDOMNodeCommandDelete --
6768 *
6769 * Invoked when a DOM node's Tcl command is deleted.
6770 *
6771 * Results:
6772 * Invalidates the Tcl_Obj for the node, but doesn't actually destroy the node.
6773 *
6774 * Side effects:
6775 * Frees memory.
6776 *
6777 *----------------------------------------------------------------------------
6778 */
6779
6780 void
TclDOMNodeCommandDelete(clientData)6781 TclDOMNodeCommandDelete (clientData)
6782 ClientData clientData;
6783 {
6784 TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) clientData;
6785
6786 TclDOM_libxml2_InvalidateNode(tNodePtr);
6787 }
6788
6789 /*
6790 *----------------------------------------------------------------------------
6791 *
6792 * TclDOM_libxml2_GetNodeFromObj --
6793 *
6794 * Gets an xmlNodePtr from a Tcl_Obj.
6795 *
6796 * Results:
6797 * Returns success code.
6798 *
6799 * Side effects:
6800 * None.
6801 *
6802 *----------------------------------------------------------------------------
6803 */
6804
6805 int
TclDOM_libxml2_GetNodeFromObj(interp,objPtr,nodePtrPtr)6806 TclDOM_libxml2_GetNodeFromObj (interp, objPtr, nodePtrPtr)
6807 Tcl_Interp *interp;
6808 Tcl_Obj *objPtr;
6809 xmlNodePtr *nodePtrPtr;
6810 {
6811 TclDOM_libxml2_Node *tNodePtr;
6812
6813 if (TclDOM_libxml2_GetTclNodeFromObj(interp, objPtr, &tNodePtr) != TCL_OK) {
6814 return TCL_ERROR;
6815 }
6816
6817 *nodePtrPtr = tNodePtr->ptr.nodePtr;
6818
6819 return TCL_OK;
6820 }
6821
6822 /*
6823 *----------------------------------------------------------------------------
6824 *
6825 * TclDOM_libxml2_GetTclNodeFromObj --
6826 *
6827 * Gets the TclDOM node structure from a Tcl_Obj.
6828 *
6829 * Results:
6830 * Returns success code.
6831 *
6832 * Side effects:
6833 * None.
6834 *
6835 *----------------------------------------------------------------------------
6836 */
6837
6838 int
TclDOM_libxml2_GetTclNodeFromObj(interp,objPtr,tNodePtrPtr)6839 TclDOM_libxml2_GetTclNodeFromObj (interp, objPtr, tNodePtrPtr)
6840 Tcl_Interp *interp;
6841 Tcl_Obj *objPtr;
6842 TclDOM_libxml2_Node **tNodePtrPtr;
6843 {
6844 TclDOM_libxml2_Node *tNodePtr;
6845
6846 if (objPtr->typePtr == &NodeObjType) {
6847 tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
6848 } else if (NodeTypeSetFromAny(interp, objPtr) == TCL_OK) {
6849 tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
6850 } else {
6851 return TCL_ERROR;
6852 }
6853
6854 if (tNodePtr->type != TCLDOM_LIBXML2_NODE_NODE) {
6855 return TCL_ERROR;
6856 }
6857
6858 *tNodePtrPtr = tNodePtr;
6859
6860 return TCL_OK;
6861 }
6862
6863 /*
6864 *----------------------------------------------------------------------------
6865 *
6866 * TclDOM_libxml2_GetEventFromObj --
6867 *
6868 * Gets an eventPtr from a Tcl_Obj.
6869 *
6870 * Results:
6871 * Returns success code.
6872 *
6873 * Side effects:
6874 * None.
6875 *
6876 *----------------------------------------------------------------------------
6877 */
6878
6879 int
TclDOM_libxml2_GetEventFromObj(interp,objPtr,eventPtrPtr)6880 TclDOM_libxml2_GetEventFromObj (interp, objPtr, eventPtrPtr)
6881 Tcl_Interp *interp;
6882 Tcl_Obj *objPtr;
6883 TclDOM_libxml2_Event **eventPtrPtr;
6884 {
6885 TclDOM_libxml2_Node *tNodePtr;
6886
6887 if (TclDOM_libxml2_GetTclEventFromObj(interp, objPtr, &tNodePtr) != TCL_OK) {
6888 return TCL_ERROR;
6889 }
6890
6891 *eventPtrPtr = tNodePtr->ptr.eventPtr;
6892
6893 return TCL_OK;
6894 }
6895
6896 /*
6897 *----------------------------------------------------------------------------
6898 *
6899 * TclDOM_libxml2_GetTclEventFromObj --
6900 *
6901 * Gets the node structure for an event from a Tcl_Obj.
6902 *
6903 * Results:
6904 * Returns success code.
6905 *
6906 * Side effects:
6907 * None.
6908 *
6909 *----------------------------------------------------------------------------
6910 */
6911
6912 int
TclDOM_libxml2_GetTclEventFromObj(interp,objPtr,nodePtrPtr)6913 TclDOM_libxml2_GetTclEventFromObj (interp, objPtr, nodePtrPtr)
6914 Tcl_Interp *interp;
6915 Tcl_Obj *objPtr;
6916 TclDOM_libxml2_Node **nodePtrPtr;
6917 {
6918 TclDOM_libxml2_Node *tNodePtr;
6919
6920 if (objPtr->typePtr == &NodeObjType) {
6921 tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
6922 } else if (NodeTypeSetFromAny(interp, objPtr) == TCL_OK) {
6923 tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
6924 } else {
6925 return TCL_ERROR;
6926 }
6927
6928 if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
6929 return TCL_ERROR;
6930 }
6931
6932 *nodePtrPtr = tNodePtr;
6933
6934 return TCL_OK;
6935 }
6936
6937 /*
6938 *----------------------------------------------------------------------------
6939 *
6940 * TclDOM_libxml2_DestroyNode --
6941 *
6942 * Destroys a node
6943 *
6944 * Results:
6945 * Frees node.
6946 *
6947 * Side effects:
6948 * Deallocates memory.
6949 *
6950 *----------------------------------------------------------------------------
6951 */
6952
6953 static void
TclDOM_libxml2_DeleteNode(clientData)6954 TclDOM_libxml2_DeleteNode(clientData)
6955 ClientData clientData;
6956 {
6957 TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) clientData;
6958 TclDOM_libxml2_Event *eventPtr;
6959 TclXML_libxml2_Document *tDocPtr;
6960 TclDOM_libxml2_Document *domDocPtr;
6961 Tcl_Obj *objPtr;
6962 xmlNodePtr nodePtr;
6963 Tcl_HashEntry *entry;
6964
6965 if (tNodePtr->type == TCLDOM_LIBXML2_NODE_NODE) {
6966 nodePtr = tNodePtr->ptr.nodePtr;
6967 objPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc);
6968 TclXML_libxml2_GetTclDocFromObj(NULL, objPtr, &tDocPtr);
6969 domDocPtr = GetDOMDocument(NULL, tDocPtr);
6970 if (domDocPtr == NULL) {
6971 /* internal error */
6972 return;
6973 }
6974 } else {
6975 eventPtr = tNodePtr->ptr.eventPtr;
6976 domDocPtr = eventPtr->ownerDocument;
6977 Tcl_Free((char *) eventPtr);
6978 }
6979
6980 entry = Tcl_FindHashEntry(domDocPtr->nodes, tNodePtr->token);
6981 if (entry) {
6982 Tcl_DeleteHashEntry(entry);
6983 } else {
6984 fprintf(stderr, "cannot delete node hash entry!\n");
6985 }
6986
6987 TclDOM_libxml2_InvalidateNode(tNodePtr);
6988
6989 if (tNodePtr->appfree) {
6990 (tNodePtr->appfree)(tNodePtr->apphook);
6991 }
6992
6993 Tcl_Free((char *) tNodePtr);
6994 }
6995
6996 void
TclDOM_libxml2_DestroyNode(interp,tNodePtr)6997 TclDOM_libxml2_DestroyNode (interp, tNodePtr)
6998 Tcl_Interp *interp;
6999 TclDOM_libxml2_Node *tNodePtr;
7000 {
7001 Tcl_DeleteCommandFromToken(interp, tNodePtr->cmd);
7002 }
7003
7004 /*
7005 *----------------------------------------------------------------------------
7006 *
7007 * TclDOM_libxml2_InvalidateNode --
7008 *
7009 * Invalidates the internal representation of any Tcl_obj that refers to
7010 * this node. NB. This does not destroy the node, or delete the node command.
7011 *
7012 * Results:
7013 * Tcl_Obj internal reps changed.
7014 *
7015 * Side effects:
7016 * None.
7017 *
7018 *----------------------------------------------------------------------------
7019 */
7020
7021 void
TclDOM_libxml2_InvalidateNode(tNodePtr)7022 TclDOM_libxml2_InvalidateNode (tNodePtr)
7023 TclDOM_libxml2_Node *tNodePtr;
7024 {
7025 ObjList *listPtr, *nextPtr;
7026
7027 for (listPtr = (ObjList *) tNodePtr->objs; listPtr;) {
7028
7029 listPtr->objPtr->internalRep.otherValuePtr = NULL;
7030 listPtr->objPtr->typePtr = NULL;
7031
7032 nextPtr = listPtr->next;
7033 Tcl_Free((char *) listPtr);
7034 listPtr = nextPtr;
7035 }
7036
7037 tNodePtr->objs = NULL;
7038 }
7039
7040 /*
7041 *----------------------------------------------------------------------------
7042 *
7043 * Node object type management
7044 *
7045 *----------------------------------------------------------------------------
7046 */
7047
7048 /*
7049 * NodeTypeSetFromAny --
7050 *
7051 * Sets the internal representation from the string rep.
7052 *
7053 * Results:
7054 * Success code.
7055 *
7056 * Side effects:
7057 * Changes internal rep.
7058 *
7059 *----------------------------------------------------------------------------
7060 */
7061
7062 int
NodeTypeSetFromAny(interp,objPtr)7063 NodeTypeSetFromAny(interp, objPtr)
7064 Tcl_Interp *interp;
7065 Tcl_Obj *objPtr;
7066 {
7067 Tcl_Obj *docObjPtr;
7068 TclXML_libxml2_Document *tDocPtr;
7069 TclDOM_libxml2_Document *domDocPtr;
7070 Tcl_HashEntry *entry;
7071 char *id, doc[21], node[21];
7072 int i, idlen, len;
7073
7074 /* Parse string rep for doc and node ids */
7075 id = Tcl_GetStringFromObj(objPtr, &idlen);
7076 /* node tokens are prefixed with "::dom::" */
7077 if (idlen < 7 || strncmp("::dom::", id, 7) != 0) {
7078 Tcl_ResetResult(interp);
7079 Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL);
7080 return TCL_ERROR;
7081 }
7082 for (i = 0; i < idlen && id[i + 7] != ':' && i < 21; i++) {
7083 if (!((id[i + 7] >= 'a' && id[i + 7] <= 'z') || (id[i + 7] >= '0' && id[i + 7] <= '9'))) {
7084 /* only lowercase chars and digits are found in a token */
7085 Tcl_ResetResult(interp);
7086 Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL);
7087 return TCL_ERROR;
7088 }
7089 doc[i] = id[i + 7];
7090 }
7091 if (i == idlen || id[i + 7] != ':') {
7092 Tcl_ResetResult(interp);
7093 Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL);
7094 return TCL_ERROR;
7095 }
7096 doc[i] = '\0';
7097 i++;
7098
7099 if (i == idlen || id[i + 7] != ':') {
7100 Tcl_ResetResult(interp);
7101 Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL);
7102 return TCL_ERROR;
7103 }
7104 i++;
7105 for (len = i + 7, i = 0; i + len < idlen && i < 21; i++) {
7106 node[i] = id[len + i];
7107 }
7108 node[i] = '\0';
7109
7110 docObjPtr = Tcl_NewStringObj(doc, -1);
7111 if (TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr) != TCL_OK) {
7112 Tcl_DecrRefCount(docObjPtr);
7113 Tcl_SetResult(interp, "invalid node token", NULL);
7114 return TCL_ERROR;
7115 }
7116 domDocPtr = GetDOMDocument(interp, tDocPtr);
7117 if (domDocPtr == NULL) {
7118 Tcl_SetResult(interp, "internal error", NULL);
7119 return TCL_ERROR;
7120 }
7121
7122 entry = Tcl_FindHashEntry(domDocPtr->nodes, id);
7123 if (entry) {
7124 TclDOM_libxml2_Node *tNodePtr;
7125
7126 if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
7127 objPtr->typePtr->freeIntRepProc(objPtr);
7128 }
7129
7130 tNodePtr = (TclDOM_libxml2_Node *) Tcl_GetHashValue(entry);
7131 objPtr->internalRep.otherValuePtr = (void *) tNodePtr;
7132 objPtr->typePtr = &NodeObjType;
7133 NodeAddObjRef(tNodePtr, objPtr);
7134
7135 } else {
7136 Tcl_DecrRefCount(docObjPtr);
7137 Tcl_SetResult(interp, "not a DOM node", NULL);
7138 return TCL_ERROR;
7139 }
7140
7141 Tcl_DecrRefCount(docObjPtr);
7142
7143 return TCL_OK;
7144 }
7145
7146 void
NodeTypeUpdate(objPtr)7147 NodeTypeUpdate(objPtr)
7148 Tcl_Obj *objPtr;
7149 {
7150 TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
7151
7152 objPtr->bytes = Tcl_Alloc(strlen(tNodePtr->token) + 1);
7153 strcpy(objPtr->bytes, tNodePtr->token);
7154 objPtr->length = strlen(objPtr->bytes);
7155 }
7156
7157 void
NodeTypeDup(srcPtr,dstPtr)7158 NodeTypeDup(srcPtr, dstPtr)
7159 Tcl_Obj *srcPtr;
7160 Tcl_Obj *dstPtr;
7161 {
7162 TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) srcPtr->internalRep.otherValuePtr;
7163
7164 if (dstPtr->typePtr != NULL && dstPtr->typePtr->freeIntRepProc != NULL) {
7165 dstPtr->typePtr->freeIntRepProc(dstPtr);
7166 }
7167
7168 Tcl_InvalidateStringRep(dstPtr);
7169
7170 dstPtr->internalRep.otherValuePtr = (ClientData) tNodePtr;
7171 dstPtr->typePtr = srcPtr->typePtr;
7172
7173 NodeAddObjRef(tNodePtr, dstPtr);
7174 }
7175
7176 /*
7177 * Unlike documents, nodes are not destroyed just because they have no Tcl_Obj's
7178 * referring to them.
7179 */
7180
7181 void
NodeTypeFree(objPtr)7182 NodeTypeFree(objPtr)
7183 Tcl_Obj *objPtr;
7184 {
7185 TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
7186 ObjList *listPtr = tNodePtr->objs;
7187 ObjList *prevPtr = NULL;
7188
7189 while (listPtr) {
7190 if (listPtr->objPtr == objPtr) {
7191 break;
7192 }
7193 prevPtr = listPtr;
7194 listPtr = listPtr->next;
7195 }
7196
7197 if (listPtr == NULL) {
7198 /* internal error */
7199 } else if (prevPtr == NULL) {
7200 tNodePtr->objs = listPtr->next;
7201 } else {
7202 prevPtr->next = listPtr->next;
7203 }
7204 Tcl_Free((char *) listPtr);
7205
7206 objPtr->internalRep.otherValuePtr = NULL;
7207 objPtr->typePtr = NULL;
7208 }
7209 #if 0
7210 static void
7211 DumpNode(tNodePtr)
7212 TclDOM_libxml2_Node *tNodePtr;
7213 {
7214 ObjList *listPtr;
7215
7216 fprintf(stderr, " node token \"%s\" type %d ptr x%x\n",
7217 tNodePtr->token, tNodePtr->type,
7218 tNodePtr->ptr.nodePtr);
7219 listPtr = (ObjList *) tNodePtr->objs;
7220 if (listPtr) {
7221 fprintf(stderr, " objects:");
7222 while (listPtr) {
7223 fprintf(stderr, " objPtr x%x", listPtr->objPtr);
7224 listPtr = listPtr->next;
7225 fprintf(stderr, "\n");
7226 }
7227 } else {
7228 fprintf(stderr, " no objects\n");
7229 }
7230 }
7231 #endif
7232
7233 /*
7234 *----------------------------------------------------------------------------
7235 *
7236 * TclDOM_libxml2_NewEventObj --
7237 *
7238 * Create a Tcl_Obj for an event.
7239 *
7240 * Results:
7241 * Returns Tcl_Obj*.
7242 *
7243 * Side effects:
7244 * Allocates object.
7245 *
7246 *----------------------------------------------------------------------------
7247 */
7248
7249 Tcl_Obj *
TclDOM_libxml2_NewEventObj(interp,docPtr,type,typeObjPtr)7250 TclDOM_libxml2_NewEventObj (interp, docPtr, type, typeObjPtr)
7251 Tcl_Interp *interp;
7252 xmlDocPtr docPtr;
7253 enum TclDOM_EventTypes type;
7254 Tcl_Obj *typeObjPtr; /* NULL for standard types */
7255 {
7256 Tcl_Obj *objPtr, *docObjPtr;
7257 TclDOM_libxml2_Node *tNodePtr;
7258 TclDOM_libxml2_Event *eventPtr;
7259 TclXML_libxml2_Document *tDocPtr;
7260 TclDOM_libxml2_Document *domDocPtr;
7261 Tcl_HashEntry *entry;
7262 int new;
7263
7264 docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
7265 TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr);
7266 domDocPtr = GetDOMDocument(interp, tDocPtr);
7267 if (domDocPtr == NULL) {
7268 Tcl_SetResult(interp, "internal error", NULL);
7269 return NULL;
7270 }
7271
7272 tNodePtr = (TclDOM_libxml2_Node *) Tcl_Alloc(sizeof(TclDOM_libxml2_Node));
7273 tNodePtr->token = Tcl_Alloc(30);
7274 sprintf(tNodePtr->token, "::dom::%s::event%d", tDocPtr->token, domDocPtr->nodeCntr++);
7275 tNodePtr->type = TCLDOM_LIBXML2_NODE_EVENT;
7276 tNodePtr->objs = NULL;
7277 tNodePtr->apphook = NULL;
7278 tNodePtr->appfree = NULL;
7279
7280 entry = Tcl_CreateHashEntry(domDocPtr->nodes, tNodePtr->token, &new);
7281 if (!new) {
7282 Tcl_Free((char *) tNodePtr->token);
7283 Tcl_Free((char *) tNodePtr);
7284 return NULL;
7285 }
7286 Tcl_SetHashValue(entry, (void *) tNodePtr);
7287
7288 tNodePtr->cmd = Tcl_CreateObjCommand(interp, tNodePtr->token, TclDOMEventCommand, (ClientData) tNodePtr, TclDOMEventCommandDelete);
7289
7290 eventPtr = (TclDOM_libxml2_Event *) Tcl_Alloc(sizeof(TclDOM_libxml2_Event));
7291 eventPtr->ownerDocument = domDocPtr;
7292 eventPtr->tNodePtr = tNodePtr;
7293
7294 /*
7295 * Overload the node pointer to refer to the event structure.
7296 */
7297 tNodePtr->ptr.eventPtr = eventPtr;
7298
7299 objPtr = Tcl_NewObj();
7300 objPtr->internalRep.otherValuePtr = (VOID *) tNodePtr;
7301 objPtr->typePtr = &NodeObjType;
7302
7303 objPtr->bytes = Tcl_Alloc(strlen(tNodePtr->token) + 1);
7304 strcpy(objPtr->bytes, tNodePtr->token);
7305 objPtr->length = strlen(objPtr->bytes);
7306
7307 NodeAddObjRef(tNodePtr, objPtr);
7308
7309 eventPtr->type = type;
7310 if (type == TCLDOM_EVENT_USERDEFINED) {
7311 eventPtr->typeObjPtr = typeObjPtr;
7312 Tcl_IncrRefCount(eventPtr->typeObjPtr);
7313 } else {
7314 eventPtr->typeObjPtr = NULL;
7315 }
7316
7317 eventPtr->stopPropagation = 0;
7318 eventPtr->preventDefault = 0;
7319 eventPtr->dispatched = 0;
7320
7321 eventPtr->altKey = Tcl_NewObj();
7322 Tcl_IncrRefCount(eventPtr->altKey);
7323 eventPtr->attrName = Tcl_NewObj();
7324 Tcl_IncrRefCount(eventPtr->attrName);
7325 eventPtr->attrChange = Tcl_NewObj();
7326 Tcl_IncrRefCount(eventPtr->attrChange);
7327 eventPtr->bubbles = Tcl_NewIntObj(1);
7328 Tcl_IncrRefCount(eventPtr->bubbles);
7329 eventPtr->button = Tcl_NewObj();
7330 Tcl_IncrRefCount(eventPtr->button);
7331 eventPtr->cancelable = Tcl_NewIntObj(1);
7332 Tcl_IncrRefCount(eventPtr->cancelable);
7333 eventPtr->clientX = Tcl_NewObj();
7334 Tcl_IncrRefCount(eventPtr->clientX);
7335 eventPtr->clientY = Tcl_NewObj();
7336 Tcl_IncrRefCount(eventPtr->clientY);
7337 eventPtr->ctrlKey = Tcl_NewObj();
7338 Tcl_IncrRefCount(eventPtr->ctrlKey);
7339 eventPtr->currentNode = Tcl_NewObj();
7340 Tcl_IncrRefCount(eventPtr->currentNode);
7341 eventPtr->detail = Tcl_NewObj();
7342 Tcl_IncrRefCount(eventPtr->detail);
7343 eventPtr->eventPhase = Tcl_NewObj();
7344 Tcl_IncrRefCount(eventPtr->eventPhase);
7345 eventPtr->metaKey = Tcl_NewObj();
7346 Tcl_IncrRefCount(eventPtr->metaKey);
7347 eventPtr->newValue = Tcl_NewObj();
7348 Tcl_IncrRefCount(eventPtr->newValue);
7349 eventPtr->prevValue = Tcl_NewObj();
7350 Tcl_IncrRefCount(eventPtr->prevValue);
7351 eventPtr->relatedNode = Tcl_NewObj();
7352 Tcl_IncrRefCount(eventPtr->relatedNode);
7353 eventPtr->screenX = Tcl_NewObj();
7354 Tcl_IncrRefCount(eventPtr->screenX);
7355 eventPtr->screenY = Tcl_NewObj();
7356 Tcl_IncrRefCount(eventPtr->screenY);
7357 eventPtr->shiftKey = Tcl_NewObj();
7358 Tcl_IncrRefCount(eventPtr->shiftKey);
7359 eventPtr->target = Tcl_NewObj();
7360 Tcl_IncrRefCount(eventPtr->target);
7361
7362 /* Timestamping of DOM events is not available in Tcl 8.3.x.
7363 * The required API (Tcl_GetTime) is public only since 8.4.0.
7364 */
7365
7366 eventPtr->timeStamp = Tcl_NewLongObj(0);
7367 #if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION > 3))
7368 {
7369 Tcl_Time time;
7370
7371 Tcl_GetTime(&time);
7372 Tcl_SetLongObj(eventPtr->timeStamp, time.sec*1000 + time.usec/1000);
7373 }
7374 #endif
7375 Tcl_IncrRefCount(eventPtr->timeStamp);
7376
7377 eventPtr->view = Tcl_NewObj();
7378 Tcl_IncrRefCount(eventPtr->view);
7379
7380 return objPtr;
7381 }
7382 /*
7383 *----------------------------------------------------------------------------
7384 *
7385 * TclDOMEventCommandDelete --
7386 *
7387 * Invoked when a DOM event node's Tcl command is deleted.
7388 *
7389 * Results:
7390 * Destroy the node.
7391 *
7392 * Side effects:
7393 * Frees memory.
7394 *
7395 *----------------------------------------------------------------------------
7396 */
7397
7398 void
TclDOMEventCommandDelete(clientData)7399 TclDOMEventCommandDelete (clientData)
7400 ClientData clientData;
7401 {
7402 TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) clientData;
7403 TclDOM_libxml2_Event *eventPtr;
7404
7405 if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
7406 return; /* internal error. should this panic? */
7407 }
7408 eventPtr = tNodePtr->ptr.eventPtr;
7409
7410 if (eventPtr->typeObjPtr) {
7411 Tcl_DecrRefCount(eventPtr->typeObjPtr);
7412 }
7413 if (eventPtr->altKey) {
7414 Tcl_DecrRefCount(eventPtr->altKey);
7415 }
7416 if (eventPtr->attrName) {
7417 Tcl_DecrRefCount(eventPtr->attrName);
7418 }
7419 if (eventPtr->attrChange) {
7420 Tcl_DecrRefCount(eventPtr->attrChange);
7421 }
7422 if (eventPtr->bubbles) {
7423 Tcl_DecrRefCount(eventPtr->bubbles);
7424 }
7425 if (eventPtr->button) {
7426 Tcl_DecrRefCount(eventPtr->button);
7427 }
7428 if (eventPtr->cancelable) {
7429 Tcl_DecrRefCount(eventPtr->cancelable);
7430 }
7431 if (eventPtr->clientX) {
7432 Tcl_DecrRefCount(eventPtr->clientX);
7433 }
7434 if (eventPtr->clientY) {
7435 Tcl_DecrRefCount(eventPtr->clientY);
7436 }
7437 if (eventPtr->ctrlKey) {
7438 Tcl_DecrRefCount(eventPtr->ctrlKey);
7439 }
7440 if (eventPtr->currentNode) {
7441 Tcl_DecrRefCount(eventPtr->currentNode);
7442 }
7443 if (eventPtr->detail) {
7444 Tcl_DecrRefCount(eventPtr->detail);
7445 }
7446 if (eventPtr->eventPhase) {
7447 Tcl_DecrRefCount(eventPtr->eventPhase);
7448 }
7449 if (eventPtr->metaKey) {
7450 Tcl_DecrRefCount(eventPtr->metaKey);
7451 }
7452 if (eventPtr->newValue) {
7453 Tcl_DecrRefCount(eventPtr->newValue);
7454 }
7455 if (eventPtr->prevValue) {
7456 Tcl_DecrRefCount(eventPtr->prevValue);
7457 }
7458 if (eventPtr->relatedNode) {
7459 Tcl_DecrRefCount(eventPtr->relatedNode);
7460 }
7461 if (eventPtr->screenX) {
7462 Tcl_DecrRefCount(eventPtr->screenX);
7463 }
7464 if (eventPtr->screenY) {
7465 Tcl_DecrRefCount(eventPtr->screenY);
7466 }
7467 if (eventPtr->shiftKey) {
7468 Tcl_DecrRefCount(eventPtr->shiftKey);
7469 }
7470 if (eventPtr->target) {
7471 Tcl_DecrRefCount(eventPtr->target);
7472 }
7473 if (eventPtr->timeStamp) {
7474 Tcl_DecrRefCount(eventPtr->timeStamp);
7475 }
7476 if (eventPtr->view) {
7477 Tcl_DecrRefCount(eventPtr->view);
7478 }
7479
7480 /* Invalidates all referring objects and frees all data structures */
7481 TclDOM_libxml2_DeleteNode((ClientData) tNodePtr);
7482 }
7483
7484