1/* tcldom-libxml.c --
2 *
3 *	A Tcl wrapper for libxml's node tree API,
4 *	conformant to the TclDOM API.
5 *
6 * Copyright (c) 2001-2003 Zveno Pty Ltd
7 * http://www.zveno.com/
8 *
9 * Zveno Pty Ltd makes this software and associated documentation
10 * available free of charge for any purpose.  You may make copies
11 * of the software but you must include all of this notice on any copy.
12 *
13 * Zveno Pty Ltd does not warrant that this software is error free
14 * or fit for any purpose.  Zveno Pty Ltd disclaims any liability for
15 * all claims, expenses, losses, damages and costs any user may incur
16 * as a result of using, copying or modifying the software.
17 *
18 * $Id: tcldom-libxml2.c,v 1.57 2003/03/09 11:12:49 balls Exp $
19 */
20
21#include "tcldom-libxml2.h"
22#include <libxml/xpath.h>
23#include <libxml/xpathInternals.h>
24#include <libxml/xmlIO.h>
25#include <libxml/HTMLtree.h>
26#include <libxml/globals.h>
27
28#define TCL_DOES_STUBS \
29    (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 || \
30    (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)))
31
32#undef TCL_STORAGE_CLASS
33#define TCL_STORAGE_CLASS DLLEXPORT
34
35#define NUM_EVENT_TYPES 17
36
37/*
38 * Data structures for internal functions.
39 */
40
41typedef struct ParserClientData {
42  Tcl_Interp *interp;
43  Tcl_Obj *externalentityloader;	/* Callback for loading an external entity */
44} ParserClientData;
45
46typedef struct TclDOMDocument {
47  char *token;
48
49  xmlDocPtr docPtr;
50
51  Tcl_HashTable *nodes;
52  int nodeCntr;
53  Tcl_HashTable *events;
54  int eventCntr;
55  int listening[NUM_EVENT_TYPES];
56
57} TclDOMDocument;
58
59/*
60 * Data structures to support Events
61 */
62
63typedef struct TclDOMEvent {
64  Tcl_Interp *interp;
65  Tcl_Obj *objPtr;	/* Tcl object that wraps this structure */
66  Tcl_Command cmd;	/* Tcl command that accesses this structure */
67  char *cmdname;	/* Name of that command */
68
69  TclDOMDocument *ownerDocument;	/* Toplevel Document for this event */
70
71  int stopPropagation;
72  int preventDefault;
73  int dispatched;
74
75  Tcl_Obj *altKey;
76  Tcl_Obj *attrName;
77  Tcl_Obj *attrChange;
78  Tcl_Obj *bubbles;
79  Tcl_Obj *button;
80  Tcl_Obj *cancelable;
81  Tcl_Obj *clientX;
82  Tcl_Obj *clientY;
83  Tcl_Obj *ctrlKey;
84  Tcl_Obj *currentNode;
85  Tcl_Obj *detail;
86  Tcl_Obj *eventPhase;
87  Tcl_Obj *metaKey;
88  Tcl_Obj *newValue;
89  Tcl_Obj *prevValue;
90  Tcl_Obj *relatedNode;
91  Tcl_Obj *screenX;
92  Tcl_Obj *screenY;
93  Tcl_Obj *shiftKey;
94  Tcl_Obj *target;
95  Tcl_Obj *timeStamp;
96  Tcl_Obj *type;
97  Tcl_Obj *view;
98} TclDOMEvent;
99
100/*
101 * Prototypes for procedures defined later in this file:
102 */
103
104Tcl_FreeInternalRepProc	TclDOM_DocFree;
105Tcl_DupInternalRepProc	TclDOM_DocDup;
106Tcl_UpdateStringProc	TclDOM_DocUpdate;
107Tcl_SetFromAnyProc	TclDOM_DocSetFromAny;
108
109Tcl_FreeInternalRepProc	TclDOM_NodeFree;
110Tcl_DupInternalRepProc	TclDOM_NodeDup;
111Tcl_UpdateStringProc	TclDOM_NodeUpdate;
112Tcl_SetFromAnyProc	TclDOM_NodeSetFromAny;
113
114Tcl_FreeInternalRepProc	TclDOM_EventFree;
115Tcl_DupInternalRepProc	TclDOM_EventDup;
116Tcl_UpdateStringProc	TclDOM_EventUpdate;
117Tcl_SetFromAnyProc	TclDOM_EventSetFromAny;
118
119/*
120 * Forward declarations for private functions.
121 */
122
123static void TclDOMGenericError _ANSI_ARGS_((void *ctx, const char *msg, ...));
124
125static int TclDOM_GetDoc2FromObj _ANSI_ARGS_((Tcl_Interp *interp,
126                                              Tcl_Obj *objPtr,
127                                              TclDOMDocument **doc));
128
129Tcl_Obj * TclDOM_CreateObjFromNode _ANSI_ARGS_((xmlNodePtr nodePtr));
130Tcl_Obj * TclDOM_CreateObjFromDoc  _ANSI_ARGS_((xmlDocPtr  docPtr));
131
132static int TclDOMDestroyDocument _ANSI_ARGS_((TclDOMDocument *docPtr));
133static int TclDOMDestroyNode _ANSI_ARGS_((xmlNodePtr nodePtr, Tcl_Obj *objPtr));
134/* see below for destroy event */
135
136static char * TclDOMLiveNodeListNode _ANSI_ARGS_((ClientData clientData,
137						  Tcl_Interp *interp,
138						  char *name1,
139						  char *name2,
140						  int flags));
141static char * TclDOMLiveNodeListDoc _ANSI_ARGS_((ClientData clientData,
142						  Tcl_Interp *interp,
143						  char *name1,
144						  char *name2,
145						  int flags));
146static char * TclDOMLiveNamedNodeMap _ANSI_ARGS_((ClientData clientData,
147						  Tcl_Interp *interp,
148						  char *name1,
149						  char *name2,
150						  int flags));
151static int TclDOMSetLiveNodeListNode _ANSI_ARGS_((Tcl_Interp *interp,
152						  char *varname,
153						  xmlNodePtr nodePtr));
154static int TclDOMSetLiveNodeListDoc _ANSI_ARGS_((Tcl_Interp *interp,
155						  char *varname,
156						  xmlDocPtr docPtr));
157static int TclDOMSetLiveNamedNodeMap _ANSI_ARGS_((Tcl_Interp *interp,
158						  char *varname,
159						  xmlNodePtr nodePtr));
160
161/*
162 * Forward declarations of commands
163 */
164
165static int TclDOMDOMImplementationCommand _ANSI_ARGS_((ClientData dummy,
166						       Tcl_Interp *interp,
167						       int objc,
168						       Tcl_Obj *CONST objv[]));
169static int TclDOMDocumentCommand _ANSI_ARGS_((ClientData dummy,
170					      Tcl_Interp *interp,
171					      int objc,
172					      Tcl_Obj *CONST objv[]));
173static int TclDOMNodeCommand _ANSI_ARGS_((ClientData dummy,
174					  Tcl_Interp *interp,
175					  int objc,
176					  Tcl_Obj *CONST objv[]));
177static int TclDOMElementCommand _ANSI_ARGS_((ClientData dummy,
178					     Tcl_Interp *interp,
179					     int objc,
180					     Tcl_Obj *CONST objv[]));
181static int TclDOMEventCommand _ANSI_ARGS_((ClientData dummy,
182					   Tcl_Interp *interp,
183					   int objc,
184					   Tcl_Obj *CONST objv[]));
185
186/*
187 * Functions that implement the TclDOM_Implementation interface
188 */
189
190static int TclDOM_HasFeatureCommand _ANSI_ARGS_((ClientData dummy,
191					    Tcl_Interp *interp,
192					    int objc,
193					    Tcl_Obj *CONST objv[]));
194static int TclDOMCreateCommand _ANSI_ARGS_((ClientData dummy,
195					    Tcl_Interp *interp,
196					    int objc,
197					    Tcl_Obj *CONST objv[]));
198static int TclDOMDestroyCommand _ANSI_ARGS_((ClientData dummy,
199					    Tcl_Interp *interp,
200					    int objc,
201					    Tcl_Obj *CONST objv[]));
202static int TclDOMParseCommand _ANSI_ARGS_((ClientData dummy,
203					    Tcl_Interp *interp,
204					    int objc,
205					    Tcl_Obj *CONST objv[]));
206static int TclDOMSerializeCommand _ANSI_ARGS_((ClientData dummy,
207					    Tcl_Interp *interp,
208					    int objc,
209					    Tcl_Obj *CONST objv[]));
210static int TclDOMSelectNodeCommand _ANSI_ARGS_((ClientData dummy,
211					    Tcl_Interp *interp,
212					    int objc,
213					    Tcl_Obj *CONST objv[]));
214
215/*
216 * Additional features
217 */
218
219static int TclDOMValidateCommand _ANSI_ARGS_((ClientData dummy,
220					    Tcl_Interp *interp,
221					    int objc,
222					    Tcl_Obj *CONST objv[]));
223
224static int TclDOMXIncludeCommand _ANSI_ARGS_((ClientData dummy,
225					      Tcl_Interp *interp,
226					      int objc,
227					      Tcl_Obj *CONST objv[]));
228
229static int TclDOMPrefix2NSCommand _ANSI_ARGS_((ClientData dummy,
230					       Tcl_Interp *interp,
231					       int objc,
232					       Tcl_Obj *CONST objv[]));
233
234static void TclDOMDeleteEvent _ANSI_ARGS_((ClientData clientData));
235
236/*
237 * Functions for event support
238 */
239
240static Tcl_Obj * TclDOMNewEvent _ANSI_ARGS_((Tcl_Interp *interp,
241					     xmlDocPtr doc,
242                                             Tcl_Obj *type));
243/*
244 * Other utilities
245 */
246
247static Tcl_Obj * TclDOMGetPath _ANSI_ARGS_((Tcl_Interp *interp,
248					    xmlNodePtr nodePtr));
249
250/*
251 * Externally visible functions
252 */
253
254EXTERN int Tcldomxml_Init _ANSI_ARGS_((Tcl_Interp *interp));
255
256/*
257 * libxml2 callbacks
258 */
259
260static xmlParserInputPtr TclDOMExternalEntityLoader _ANSI_ARGS_((const char *URL,
261								 const char *ID,
262								 xmlParserCtxtPtr ctxt));
263
264/*
265 * Private libxml2 functions
266 */
267
268EXTERN xmlParserCtxtPtr xmlCreateMemoryParserCtxt _ANSI_ARGS_((const char *buffer,
269							      int size));
270
271Tcl_ObjType TclDOM_DocObjType = {
272  "libxml2-doc",
273  TclDOM_DocFree,
274  TclDOM_DocDup,
275  TclDOM_DocUpdate,
276  TclDOM_DocSetFromAny
277};
278
279Tcl_ObjType TclDOM_NodeObjType = {
280  "libxml2-node",
281  TclDOM_NodeFree,
282  TclDOM_NodeDup,
283  TclDOM_NodeUpdate,
284  TclDOM_NodeSetFromAny
285};
286
287Tcl_ObjType TclDOM_EventObjType = {
288  "tcldom-event",
289  TclDOM_EventFree,
290  TclDOM_EventDup,
291  TclDOM_EventUpdate,
292  TclDOM_EventSetFromAny
293};
294
295/*
296 * Hash tables for mapping string reps to doc structure:
297 * one by string rep, the other by xmlDocPtr.
298 * NB. nodes and events are now stored in a per-document hash table.
299 */
300
301static Tcl_HashTable documents;
302static Tcl_HashTable docByPtr;
303static int docCntr = 0;
304
305/*
306 * Event support.
307 *
308 * Each table is indexed by xmlNodePtr.
309 * The value of an entry is a pointer to a hash table
310 * for that node containing listeners, indexed by
311 * event type.
312 */
313
314static Tcl_HashTable captureListeners;
315static Tcl_HashTable bubbleListeners;
316
317/*
318 * default loader is overridden while parsing
319 */
320
321static xmlExternalEntityLoader defaultLoader;
322
323/*
324 * Accessor function for event objects
325 */
326
327static int TclDOM_GetEventFromObj _ANSI_ARGS_((Tcl_Interp *interp,
328					       Tcl_Obj *objPtr,
329					       TclDOMEvent **eventPtr));
330static int TclDOM_GetDoc2FromObj _ANSI_ARGS_((Tcl_Interp *interp,
331					       Tcl_Obj *objPtr,
332					       TclDOMDocument **docPtr));
333
334/*
335 * Destructor function for event objects
336 */
337
338static int TclDOMDestroyEvent _ANSI_ARGS_((TclDOMEvent *eventPtr, Tcl_Obj *objPtr));
339
340/*
341 * Event management
342 */
343
344static void TclDOMInitEvent _ANSI_ARGS_((TclDOMEvent *eventPtr,
345                                         Tcl_Obj *typePtr,
346                                         Tcl_Obj *bubblesPtr,
347                                         Tcl_Obj *cancelablePtr));
348static void TclDOMInitUIEvent _ANSI_ARGS_((TclDOMEvent *eventPtr,
349                                           Tcl_Obj *typePtr,
350                                           Tcl_Obj *bubblesPtr,
351                                           Tcl_Obj *cancelablePtr,
352                                           Tcl_Obj *viewPtr,
353                                           Tcl_Obj *detailPtr));
354static void TclDOMInitMouseEvent _ANSI_ARGS_((TclDOMEvent *eventPtr,
355                                              Tcl_Obj *typePtr,
356                                              Tcl_Obj *bubblesPtr,
357                                              Tcl_Obj *cancelablePtr,
358                                              Tcl_Obj *viewPtr,
359                                              Tcl_Obj *detailPtr,
360                                              Tcl_Obj *screenXPtr,
361                                              Tcl_Obj *screenYPtr,
362                                              Tcl_Obj *clientXPtr,
363                                              Tcl_Obj *clientYPtr,
364                                              Tcl_Obj *ctrlKeyPtr,
365                                              Tcl_Obj *altKeyPtr,
366                                              Tcl_Obj *shiftKeyPtr,
367                                              Tcl_Obj *metaKeyPtr,
368                                              Tcl_Obj *relatedNodePtr));
369static void TclDOMInitMutationEvent _ANSI_ARGS_((TclDOMEvent *eventPtr,
370                                              Tcl_Obj *typePtr,
371                                              Tcl_Obj *bubblesPtr,
372                                              Tcl_Obj *cancelablePtr,
373                                              Tcl_Obj *relatedNodePtr,
374                                              Tcl_Obj *prevValuePtr,
375                                              Tcl_Obj *newValuePtr,
376                                              Tcl_Obj *attrNamePtr,
377                                              Tcl_Obj *attrChangePtr));
378static int TclDOM_PostUIEvent _ANSI_ARGS_((Tcl_Interp *interp,
379                                           xmlDocPtr docPtr,
380                                           Tcl_Obj *nodeObjPtr,
381                                           Tcl_Obj *typePtr,
382                                           Tcl_Obj *bubblesPtr,
383                                           Tcl_Obj *cancelablePtr,
384                                           Tcl_Obj *viewPtr,
385                                           Tcl_Obj *detailPtr));
386static int TclDOM_PostMouseEvent _ANSI_ARGS_((Tcl_Interp *interp,
387                                              xmlDocPtr docPtr,
388                                              Tcl_Obj *nodeObjPtr,
389                                              Tcl_Obj *typePtr,
390                                              Tcl_Obj *bubblesPtr,
391                                              Tcl_Obj *cancelablePtr,
392                                              Tcl_Obj *viewPtr,
393                                              Tcl_Obj *detailPtr,
394                                              Tcl_Obj *screenXPtr,
395                                              Tcl_Obj *screenYPtr,
396                                              Tcl_Obj *clientXPtr,
397                                              Tcl_Obj *clientYPtr,
398                                              Tcl_Obj *ctrlKeyPtr,
399                                              Tcl_Obj *altKeyPtr,
400                                              Tcl_Obj *shiftKeyPtr,
401                                              Tcl_Obj *metaKeyPtr,
402                                              Tcl_Obj *relatedNodePtr));
403static int TclDOM_PostMutationEvent _ANSI_ARGS_((Tcl_Interp *interp,
404                                              xmlDocPtr docPtr,
405                                              Tcl_Obj *nodeObjPtr,
406                                              Tcl_Obj *typePtr,
407                                              Tcl_Obj *bubblesPtr,
408                                              Tcl_Obj *cancelablePtr,
409                                              Tcl_Obj *relatedNodePtr,
410                                              Tcl_Obj *prevValuePtr,
411                                              Tcl_Obj *newValuePtr,
412                                              Tcl_Obj *attrNamePtr,
413                                              Tcl_Obj *attrChangePtr));
414static int TclDOM_AddEventListener _ANSI_ARGS_((Tcl_Interp *interp,
415                                                TclDOMDocument *tcldomdocPtr,
416                                                void *tokenPtr,
417                                                Tcl_Obj *typePtr,
418                                                Tcl_Obj *listenerPtr,
419                                                int capturing));
420static int TclDOM_RemoveEventListener _ANSI_ARGS_((Tcl_Interp *interp,
421                                                TclDOMDocument *tcldomdocPtr,
422                                                void *tokenPtr,
423                                                Tcl_Obj *typePtr,
424                                                Tcl_Obj *listenerPtr,
425                                                int capturing));
426static int TclDOM_DispatchEvent _ANSI_ARGS_((Tcl_Interp *interp,
427                                             Tcl_Obj *nodePtr,
428                                             Tcl_Obj *eventObjPtr,
429                                             TclDOMEvent *eventPtr));
430
431/*
432 * For additional checks when creating nodes
433 */
434
435static Tcl_Obj *checkName;
436static Tcl_Obj *checkQName;
437
438/*
439 * For debugging
440 */
441
442static Tcl_Channel stderrChan;
443static char dbgbuf[200];
444
445/*
446 * Switch tables
447 */
448
449#ifndef CONST84
450#define CONST84 /* Before 8.4 no 'const' required */
451#endif
452
453static CONST84 char *DOMImplementationCommandMethods[] = {
454  "hasFeature",
455  "createDocument",
456  "create",
457  "createDocumentType",
458  "createNode",
459  "destroy",
460  "isNode",
461  "parse",
462  "selectNode",
463  "serialize",
464  "trim",
465  (char *) NULL
466};
467enum DOMImplementationCommandMethods {
468  TCLDOM_IMPL_HASFEATURE,
469  TCLDOM_IMPL_CREATEDOCUMENT,
470  TCLDOM_IMPL_CREATE,
471  TCLDOM_IMPL_CREATEDOCUMENTYPE,
472  TCLDOM_IMPL_CREATENODE,
473  TCLDOM_IMPL_DESTROY,
474  TCLDOM_IMPL_ISNODE,
475  TCLDOM_IMPL_PARSE,
476  TCLDOM_IMPL_SELECTNODE,
477  TCLDOM_IMPL_SERIALIZE,
478  TCLDOM_IMPL_TRIM
479};
480static CONST84 char *DocumentCommandMethods[] = {
481  "cget",
482  "configure",
483  "createElement",
484  "createDocumentFragment",
485  "createTextNode",
486  "createComment",
487  "createCDATASection",
488  "createProcessingInstruction",
489  "createAttribute",
490  "createEntity",
491  "createEntityReference",
492  "createDocTypeDecl",
493  "importNode",
494  "createElementNS",
495  "createAttributeNS",
496  "getElementsByTagNameNS",
497  "getElementsById",
498  "createEvent",
499  "getElementsByTagName",
500  (char *) NULL
501};
502enum DocumentCommandMethods {
503  TCLDOM_DOCUMENT_CGET,
504  TCLDOM_DOCUMENT_CONFIGURE,
505  TCLDOM_DOCUMENT_CREATEELEMENT,
506  TCLDOM_DOCUMENT_CREATEDOCUMENTFRAGMENT,
507  TCLDOM_DOCUMENT_CREATETEXTNODE,
508  TCLDOM_DOCUMENT_CREATECOMMENT,
509  TCLDOM_DOCUMENT_CREATECDATASECTION,
510  TCLDOM_DOCUMENT_CREATEPI,
511  TCLDOM_DOCUMENT_CREATEATTRIBUTE,
512  TCLDOM_DOCUMENT_CREATEENTITY,
513  TCLDOM_DOCUMENT_CREATEENTITYREFERENCE,
514  TCLDOM_DOCUMENT_CREATEDOCTYPEDECL,
515  TCLDOM_DOCUMENT_IMPORTNODE,
516  TCLDOM_DOCUMENT_CREATEELEMENTNS,
517  TCLDOM_DOCUMENT_CREATEATTRIBUTENS,
518  TCLDOM_DOCUMENT_GETELEMENTSBYTAGNAMENS,
519  TCLDOM_DOCUMENT_GETELEMENTSBYID,
520  TCLDOM_DOCUMENT_CREATEEVENT,
521  TCLDOM_DOCUMENT_GETELEMENTSBYTAGNAME
522};
523static CONST84 char *DocumentCommandOptions[] = {
524  "-doctype",
525  "-implementation",
526  "-documentElement",
527  (char *) NULL
528};
529enum DocumentCommandOptions {
530  TCLDOM_DOCUMENT_DOCTYPE,
531  TCLDOM_DOCUMENT_IMPLEMENTATION,
532  TCLDOM_DOCUMENT_DOCELEMENT
533};
534static CONST84 char *NodeCommandMethods[] = {
535  "cget",
536  "configure",
537  "insertBefore",
538  "replaceChild",
539  "removeChild",
540  "appendChild",
541  "hasChildNodes",
542  "cloneNode",
543  "children",
544  "parent",
545  "path",
546  "createNode",
547  "selectNode",
548  "stringValue",
549  "addEventListener",
550  "removeEventListener",
551  "dispatchEvent",
552  "isSameNode",
553  (char *) NULL
554};
555enum NodeCommandMethods {
556  TCLDOM_NODE_CGET,
557  TCLDOM_NODE_CONFIGURE,
558  TCLDOM_NODE_INSERTBEFORE,
559  TCLDOM_NODE_REPLACECHILD,
560  TCLDOM_NODE_REMOVECHILD,
561  TCLDOM_NODE_APPENDCHILD,
562  TCLDOM_NODE_HASCHILDNODES,
563  TCLDOM_NODE_CLONENODE,
564  TCLDOM_NODE_CHILDREN,
565  TCLDOM_NODE_PARENT,
566  TCLDOM_NODE_PATH,
567  TCLDOM_NODE_CREATENODE,
568  TCLDOM_NODE_SELECTNODE,
569  TCLDOM_NODE_STRINGVALUE,
570  TCLDOM_NODE_ADDEVENTLISTENER,
571  TCLDOM_NODE_REMOVEEVENTLISTENER,
572  TCLDOM_NODE_DISPATCHEVENT,
573  TCLDOM_NODE_ISSAMENODE
574};
575static CONST84 char *NodeCommandOptions[] = {
576  "-nodeType",
577  "-parentNode",
578  "-childNodes",
579  "-firstChild",
580  "-lastChild",
581  "-previousSibling",
582  "-nextSibling",
583  "-attributes",
584  "-namespaceURI",
585  "-prefix",
586  "-localName",
587  "-nodeValue",
588  "-cdatasection",
589  "-nodeName",
590  "-ownerDocument",
591  (char *) NULL
592};
593enum NodeCommandOptions {
594  TCLDOM_NODE_NODETYPE,
595  TCLDOM_NODE_PARENTNODE,
596  TCLDOM_NODE_CHILDNODES,
597  TCLDOM_NODE_FIRSTCHILD,
598  TCLDOM_NODE_LASTCHILD,
599  TCLDOM_NODE_PREVIOUSSIBLING,
600  TCLDOM_NODE_NEXTSIBLING,
601  TCLDOM_NODE_ATTRIBUTES,
602  TCLDOM_NODE_NAMESPACEURI,
603  TCLDOM_NODE_PREFIX,
604  TCLDOM_NODE_LOCALNAME,
605  TCLDOM_NODE_NODEVALUE,
606  TCLDOM_NODE_CDATASECTION,
607  TCLDOM_NODE_NODENAME,
608  TCLDOM_NODE_OWNERDOCUMENT
609};
610static CONST84 char *NodeCommandAddEventListenerOptions[] = {
611  "-usecapture",
612  (char *) NULL
613};
614enum NodeCommandAddEventListenerOptions {
615  TCLDOM_NODE_ADDEVENTLISTENER_USECAPTURE
616};
617static CONST84 char *ElementCommandMethods[] = {
618  "cget",
619  "configure",
620  "getAttribute",
621  "setAttribute",
622  "removeAttribute",
623  "getAttributeNS",
624  "setAttributeNS",
625  "removeAttributeNS",
626  "getAttributeNode",
627  "setAttributeNode",
628  "removeAttributeNode",
629  "getAttributeNodeNS",
630  "setAttributeNodeNS",
631  "removeAttributeNodeNS",
632  "getElementsByTagName",
633  "normalize",
634  (char *) NULL
635};
636enum ElementCommandMethods {
637  TCLDOM_ELEMENT_CGET,
638  TCLDOM_ELEMENT_CONFIGURE,
639  TCLDOM_ELEMENT_GETATTRIBUTE,
640  TCLDOM_ELEMENT_SETATTRIBUTE,
641  TCLDOM_ELEMENT_REMOVEATTRIBUTE,
642  TCLDOM_ELEMENT_GETATTRIBUTENS,
643  TCLDOM_ELEMENT_SETATTRIBUTENS,
644  TCLDOM_ELEMENT_REMOVEATTRIBUTENS,
645  TCLDOM_ELEMENT_GETATTRIBUTENODE,
646  TCLDOM_ELEMENT_SETATTRIBUTENODE,
647  TCLDOM_ELEMENT_REMOVEATTRIBUTENODE,
648  TCLDOM_ELEMENT_GETATTRIBUTENODENS,
649  TCLDOM_ELEMENT_SETATTRIBUTENODENS,
650  TCLDOM_ELEMENT_REMOVEATTRIBUTENODENS,
651  TCLDOM_ELEMENT_GETELEMENTSBYTAGNAME,
652  TCLDOM_ELEMENT_NORMALIZE
653};
654static CONST84 char *ElementCommandOptions[] = {
655  "-tagName",
656  "-empty",
657  (char *) NULL
658};
659enum ElementCommandOptions {
660  TCLDOM_ELEMENT_TAGNAME,
661  TCLDOM_ELEMENT_EMPTY
662};
663static CONST84 char *EventCommandMethods[] = {
664  "cget",
665  "configure",
666  "stopPropagation",
667  "preventDefault",
668  "initEvent",
669  "initUIEvent",
670  "initMouseEvent",
671  "initMutationEvent",
672  "postUIEvent",
673  "postMouseEvent",
674  "postMutationEvent",
675  (char *) NULL
676};
677enum EventCommandMethods {
678  TCLDOM_EVENT_CGET,
679  TCLDOM_EVENT_CONFIGURE,
680  TCLDOM_EVENT_STOPPROPAGATION,
681  TCLDOM_EVENT_PREVENTDEFAULT,
682  TCLDOM_EVENT_INITEVENT,
683  TCLDOM_EVENT_INITUIEVENT,
684  TCLDOM_EVENT_INITMOUSEEVENT,
685  TCLDOM_EVENT_INITMUTATIONEVENT,
686  TCLDOM_EVENT_POSTUIEVENT,
687  TCLDOM_EVENT_POSTMOUSEEVENT,
688  TCLDOM_EVENT_POSTMUTATIONEVENT
689};
690static CONST84 char *EventCommandOptions[] = {
691  "-altKey",
692  "-attrName",
693  "-attrChange",
694  "-bubbles",
695  "-button",
696  "-cancelable",
697  "-clientX",
698  "-clientY",
699  "-ctrlKey",
700  "-currentNode",
701  "-detail",
702  "-eventPhase",
703  "-metaKey",
704  "-newValue",
705  "-prevValue",
706  "-relatedNode",
707  "-screenX",
708  "-screenY",
709  "-shiftKey",
710  "-target",
711  "-timeStamp",
712  "-type",
713  "-view",
714  (char *) NULL
715};
716enum EventCommandOptions {
717  TCLDOM_EVENT_ALTKEY,
718  TCLDOM_EVENT_ATTRNAME,
719  TCLDOM_EVENT_ATTRCHANGE,
720  TCLDOM_EVENT_BUBBLES,
721  TCLDOM_EVENT_BUTTON,
722  TCLDOM_EVENT_CANCELABLE,
723  TCLDOM_EVENT_CLIENTX,
724  TCLDOM_EVENT_CLIENTY,
725  TCLDOM_EVENT_CTRLKEY,
726  TCLDOM_EVENT_CURRENTNODE,
727  TCLDOM_EVENT_DETAIL,
728  TCLDOM_EVENT_EVENTPHASE,
729  TCLDOM_EVENT_METAKEY,
730  TCLDOM_EVENT_NEWVALUE,
731  TCLDOM_EVENT_PREVVALUE,
732  TCLDOM_EVENT_RELATEDNODE,
733  TCLDOM_EVENT_SCREENX,
734  TCLDOM_EVENT_SCREENY,
735  TCLDOM_EVENT_SHIFTKEY,
736  TCLDOM_EVENT_TARGET,
737  TCLDOM_EVENT_TIMESTAMP,
738  TCLDOM_EVENT_TYPE,
739  TCLDOM_EVENT_VIEW
740};
741static CONST84 char *EventTypes[] = {
742  "DOMFocusIn",
743  "DOMFocusOut",
744  "DOMActivate",
745  "click",
746  "mousedown",
747  "mouseup",
748  "mouseover",
749  "mousemove",
750  "mouseout",
751  "DOMSubtreeModified",
752  "DOMNodeInserted",
753  "DOMNodeRemoved",
754  "DOMNodeInsertedIntoDocument",
755  "DOMNodeRemovedFromDocument",
756  "DOMAttrModified",
757  "DOMCharacterDataModified"
758};
759enum EventTypes {
760  TCLDOM_EVENT_DOMFOCUSIN,
761  TCLDOM_EVENT_DOMFOCUSOUT,
762  TCLDOM_EVENT_DOMACTIVATE,
763  TCLDOM_EVENT_CLICK,
764  TCLDOM_EVENT_MOUSEDOWN,
765  TCLDOM_EVENT_MOUSEUP,
766  TCLDOM_EVENT_MOUSEOVER,
767  TCLDOM_EVENT_MOUSEMOVE,
768  TCLDOM_EVENT_MOUSEOUT,
769  TCLDOM_EVENT_DOMSUBTREEMODIFIED,
770  TCLDOM_EVENT_DOMNODEINSERTED,
771  TCLDOM_EVENT_DOMNODEREMOVED,
772  TCLDOM_EVENT_DOMNODEINSERTEDINTODOCUMENT,
773  TCLDOM_EVENT_DOMNODEREMOVEDFROMDOCUMENT,
774  TCLDOM_EVENT_DOMATTRMODIFIED,
775  TCLDOM_EVENT_DOMCHARACTERDATAMODIFIED
776};
777
778static CONST84 char *ParseCommandOptions[] = {
779  "-baseuri",
780  "-externalentitycommand",
781  (char *) NULL
782};
783enum ParseCommandOptions {
784  TCLDOM_PARSE_BASEURI,
785  TCLDOM_PARSE_EXTERNALENTITYCOMMAND
786};
787static CONST84 char *SerializeCommandOptions[] = {
788  "-indent",
789  "-method",
790  (char *) NULL
791};
792enum SerializeCommandOptions {
793  TCLDOM_SERIALIZE_INDENT,
794  TCLDOM_SERIALIZE_METHOD,
795};
796static CONST84 char *SerializeMethods[] = {
797  "xml",
798  "html",
799  "text",
800  (char *) NULL
801};
802enum SerializeMethods {
803  TCLDOM_SERIALIZE_METHOD_XML,
804  TCLDOM_SERIALIZE_METHOD_HTML,
805  TCLDOM_SERIALIZE_METHOD_TEXT
806};
807static CONST84 char *SelectNodeOptions[] = {
808  "-namespaces",
809  (char *) NULL
810};
811enum SelectNodeOptions {
812  TCLDOM_SELECTNODE_OPTION_NAMESPACES
813};
814
815/*
816 * Error context for passing error result back to caller.
817 */
818
819typedef struct GenericError_Info {
820  Tcl_Interp *interp;
821  int code;
822  Tcl_Obj *msg;
823} GenericError_Info;
824
825/*
826 * Default values
827 */
828
829EXTERN int xmlLoadExtDtdDefaultValue;
830
831
832/*
833 *----------------------------------------------------------------------------
834 *
835 * Tcldomxml_Init --
836 *
837 *  Initialisation routine for loadable module
838 *
839 * Results:
840 *  None.
841 *
842 * Side effects:
843 *  Creates commands in the interpreter,
844 *
845 *----------------------------------------------------------------------------
846 */
847
848int
849Tcldomxml_Init (interp)
850     Tcl_Interp *interp;	/* Interpreter to initialise */
851{
852  TclDOM_Implementation *implPtr;
853  int dbgMode;
854
855#ifdef USE_TCL_STUBS
856  if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
857    return TCL_ERROR;
858  }
859#endif
860#ifdef USE_TCLDOM_STUBS
861  if (Tcldom_InitStubs(interp, TCLDOM_VERSION, 1) == NULL) {
862    return TCL_ERROR;
863  }
864#endif
865
866  if (Tcl_PkgRequire(interp, "xml", TCLDOMXML_VERSION, 0) == NULL) {
867    Tcl_SetResult(interp, "unable to load XML package", NULL);
868    return TCL_ERROR;
869  }
870
871  stderrChan = Tcl_GetChannel(interp, "stderr", &dbgMode);
872
873  /* Configure the libxml2 parser */
874  xmlInitMemory();
875  xmlSubstituteEntitiesDefault(1);
876
877  /*
878   * 6 will load external entities.
879   * 0 will not.
880   * TODO: provide configuration option for setting this value.
881   */
882  xmlLoadExtDtdDefaultValue = 6;
883
884  xmlXPathInit();
885
886  Tcl_RegisterObjType(&TclDOM_DocObjType);
887  Tcl_RegisterObjType(&TclDOM_NodeObjType);
888  Tcl_RegisterObjType(&TclDOM_EventObjType);
889
890  /*
891   * Register this DOM implementation with the TclDOM
892   * generic layer.  We must do this for each separate
893   * Tcl object type.
894   */
895
896  implPtr = (TclDOM_Implementation *) Tcl_Alloc(sizeof(TclDOM_Implementation));
897  implPtr->name = Tcl_NewStringObj("libxml2-doc", -1);
898  Tcl_IncrRefCount(implPtr->name);
899  implPtr->type = &TclDOM_DocObjType;
900  implPtr->create = TclDOMCreateCommand;
901  implPtr->parse = TclDOMParseCommand;
902  implPtr->serialize = TclDOMSerializeCommand;
903  implPtr->document = TclDOMDocumentCommand;
904  implPtr->documentfragment = NULL;
905  implPtr->node = TclDOMNodeCommand;
906  implPtr->element = NULL;
907  implPtr->select = TclDOMSelectNodeCommand;
908  TclDOM_Register(interp, implPtr);
909
910  implPtr = (TclDOM_Implementation *) Tcl_Alloc(sizeof(TclDOM_Implementation));
911  implPtr->name = Tcl_NewStringObj("libxml2-node", -1);
912  Tcl_IncrRefCount(implPtr->name);
913  implPtr->type = &TclDOM_NodeObjType;
914  implPtr->create = TclDOMCreateCommand;
915  implPtr->parse = TclDOMParseCommand;
916  implPtr->serialize = TclDOMSerializeCommand;
917  implPtr->document = TclDOMDocumentCommand;
918  implPtr->documentfragment = NULL;
919  implPtr->node = TclDOMNodeCommand;
920  implPtr->element = TclDOMElementCommand;
921  implPtr->select = TclDOMSelectNodeCommand;
922  TclDOM_Register(interp, implPtr);
923
924  Tcl_CreateObjCommand(interp, "dom::libxml2::DOMImplementation", TclDOMDOMImplementationCommand, NULL, NULL);
925  Tcl_CreateObjCommand(interp, "dom::DOMImplementation", TclDOMDOMImplementationCommand, NULL, NULL);
926  Tcl_CreateObjCommand(interp, "dom::libxml2::hasfeature", TclDOM_HasFeatureCommand, NULL, NULL);
927  Tcl_CreateObjCommand(interp, "dom::hasfeature", TclDOM_HasFeatureCommand, NULL, NULL);
928  Tcl_CreateObjCommand(interp, "dom::libxml2::document", TclDOMDocumentCommand, NULL, NULL);
929  Tcl_CreateObjCommand(interp, "dom::document", TclDOMDocumentCommand, NULL, NULL);
930  Tcl_CreateObjCommand(interp, "dom::libxml2::node", TclDOMNodeCommand, NULL, NULL);
931  Tcl_CreateObjCommand(interp, "dom::node", TclDOMNodeCommand, NULL, NULL);
932  Tcl_CreateObjCommand(interp, "dom::libxml2::create", TclDOMCreateCommand, NULL, NULL);
933  Tcl_CreateObjCommand(interp, "dom::create", TclDOMCreateCommand, NULL, NULL);
934  Tcl_CreateObjCommand(interp, "dom::libxml2::parse", TclDOMParseCommand, NULL, NULL);
935  Tcl_CreateObjCommand(interp, "dom::parse", TclDOMParseCommand, NULL, NULL);
936  Tcl_CreateObjCommand(interp, "dom::libxml2::serialize", TclDOMSerializeCommand, NULL, NULL);
937  Tcl_CreateObjCommand(interp, "dom::serialize", TclDOMSerializeCommand, NULL, NULL);
938  Tcl_CreateObjCommand(interp, "dom::libxml2::selectnode", TclDOMSelectNodeCommand, NULL, NULL);
939  Tcl_CreateObjCommand(interp, "dom::selectNode", TclDOMSelectNodeCommand, NULL, NULL);
940  Tcl_CreateObjCommand(interp, "dom::libxml2::element", TclDOMElementCommand, NULL, NULL);
941  Tcl_CreateObjCommand(interp, "dom::element", TclDOMElementCommand, NULL, NULL);
942  Tcl_CreateObjCommand(interp, "dom::libxml2::event", TclDOMEventCommand, NULL, NULL);
943  Tcl_CreateObjCommand(interp, "dom::event", TclDOMEventCommand, NULL, NULL);
944  Tcl_CreateObjCommand(interp, "dom::libxml2::validate", TclDOMValidateCommand, NULL, NULL);
945  Tcl_CreateObjCommand(interp, "dom::validate", TclDOMValidateCommand, NULL, NULL);
946  Tcl_CreateObjCommand(interp, "dom::libxml2::xinclude", TclDOMXIncludeCommand, NULL, NULL);
947  Tcl_CreateObjCommand(interp, "dom::xinclude", TclDOMXIncludeCommand, NULL, NULL);
948  Tcl_CreateObjCommand(interp, "dom::libxml2::prefix2namespaceURI", TclDOMPrefix2NSCommand, NULL, NULL);
949  Tcl_CreateObjCommand(interp, "dom::prefix2namespaceURI", TclDOMPrefix2NSCommand, NULL, NULL);
950  Tcl_CreateObjCommand(interp, "dom::libxml2::destroy", TclDOMDestroyCommand, NULL, NULL);
951  Tcl_CreateObjCommand(interp, "dom::destroy", TclDOMDestroyCommand, NULL, NULL);
952
953  Tcl_InitHashTable(&documents, TCL_STRING_KEYS);
954  Tcl_InitHashTable(&docByPtr, TCL_ONE_WORD_KEYS);
955  Tcl_InitHashTable(&captureListeners, TCL_ONE_WORD_KEYS);
956  Tcl_InitHashTable(&bubbleListeners, TCL_ONE_WORD_KEYS);
957
958  /* Setup name checking REs */
959  checkName = Tcl_NewStringObj("^", -1);
960  Tcl_AppendObjToObj(checkName, Tcl_GetVar2Ex(interp, "::xml::Name", NULL, 0));
961  Tcl_AppendToObj(checkName, "$", -1);
962  Tcl_IncrRefCount(checkName);
963  checkQName = Tcl_NewStringObj("^", -1);
964  Tcl_AppendObjToObj(checkQName, Tcl_GetVar2Ex(interp, "::xml::QName", NULL, 0));
965  Tcl_AppendToObj(checkQName, "$", -1);
966  Tcl_IncrRefCount(checkQName);
967
968  #if TCL_DOES_STUBS
969    {
970      extern TcldomxmlStubs tcldomxmlStubs;
971      if (Tcl_PkgProvideEx(interp, "dom::libxml2", TCLDOMXML_VERSION,
972	(ClientData) &tcldomxmlStubs) != TCL_OK) {
973        return TCL_ERROR;
974      }
975    }
976  #else
977    if (Tcl_PkgProvide(interp, "dom::libxml2", TCLDOMXML_VERSION) != TCL_OK) {
978      return TCL_ERROR;
979    }
980  #endif
981
982  return TCL_OK;
983}
984
985/*
986 *----------------------------------------------------------------------------
987 *
988 * TclDOM_HasFeatureCommand --
989 *
990 *  Implements dom::libxml2::hasfeature command
991 *
992 * Results:
993 *  Returns boolean.
994 *
995 * Side effects:
996 *  None.
997 *
998 *----------------------------------------------------------------------------
999 */
1000
1001int
1002TclDOM_HasFeatureCommand (dummy, interp, objc, objv)
1003     ClientData dummy;
1004     Tcl_Interp *interp;
1005     int objc;
1006     Tcl_Obj *CONST objv[];
1007{
1008  if (objc != 3) {
1009    Tcl_WrongNumArgs(interp, 0, objv, "hasfeature feature version");
1010    return TCL_ERROR;
1011  }
1012
1013  if (Tcl_RegExpMatchObj(interp, objv[1], Tcl_NewStringObj("create|destroy|parse|query|serialize|trim|Events|UIEvents|isNode", -1)) == 1) {
1014    if (Tcl_StringMatch(Tcl_GetStringFromObj(objv[2], NULL), "1.0") == 1) {
1015      Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
1016    } else {
1017      Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
1018    }
1019  } else {
1020    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
1021  }
1022
1023  return TCL_OK;
1024}
1025
1026
1027/*
1028 *----------------------------------------------------------------------------
1029 *
1030 * TclDOMCreateCommand --
1031 *
1032 *  Implements dom::libxml2::create command
1033 *
1034 * Results:
1035 *  Creates a new document.
1036 *
1037 * Side effects:
1038 *  Allocates memory.
1039 *
1040 *----------------------------------------------------------------------------
1041 */
1042
1043int
1044TclDOMCreateCommand (dummy, interp, objc, objv)
1045     ClientData dummy;
1046     Tcl_Interp *interp;
1047     int objc;
1048     Tcl_Obj *CONST objv[];
1049{
1050  if (objc != 1) {
1051    Tcl_WrongNumArgs(interp, 1, objv, "");
1052    return TCL_ERROR;
1053  }
1054
1055  Tcl_SetObjResult(interp, TclDOM_NewDoc(interp));
1056  return TCL_OK;
1057}
1058
1059/*
1060 *----------------------------------------------------------------------------
1061 *
1062 * TclDOMDestroyCommand --
1063 *
1064 *  Implements dom::libxml2::destroy command
1065 *
1066 * Results:
1067 *  Frees document or node.
1068 *
1069 * Side effects:
1070 *  Deallocates memory.
1071 *
1072 *----------------------------------------------------------------------------
1073 */
1074
1075int
1076TclDOMDestroyCommand (dummy, interp, objc, objv)
1077     ClientData dummy;
1078     Tcl_Interp *interp;
1079     int objc;
1080     Tcl_Obj *CONST objv[];
1081{
1082  TclDOMDocument *doc;
1083  xmlNodePtr node;
1084  TclDOMEvent *event;
1085
1086  if (objc != 2) {
1087    Tcl_WrongNumArgs(interp, 1, objv, "token");
1088    return TCL_ERROR;
1089  }
1090
1091  if (TclDOM_GetDoc2FromObj(interp, objv[1], &doc) == TCL_OK) {
1092    if (TclDOMDestroyDocument(doc) != TCL_OK) {
1093      return TCL_ERROR;
1094    }
1095  } else if (TclDOM_GetNodeFromObj(interp, objv[1], &node) == TCL_OK) {
1096    if (TclDOMDestroyNode(node, objv[1]) != TCL_OK) {
1097      return TCL_ERROR;
1098    }
1099  } else if (TclDOM_GetEventFromObj(interp, objv[1], &event) == TCL_OK) {
1100    if (TclDOMDestroyEvent(event, objv[1]) != TCL_OK) {
1101      return TCL_ERROR;
1102    }
1103  } else {
1104    Tcl_SetResult(interp, "not a DOM node", NULL);
1105    return TCL_ERROR;
1106  }
1107
1108  /* Invalidate the internal rep */
1109  objv[1]->typePtr = NULL;
1110  objv[1]->internalRep.otherValuePtr = NULL;
1111
1112  return TCL_OK;
1113}
1114
1115/*
1116 *----------------------------------------------------------------------------
1117 *
1118 * TclDOMDestroyDocument --
1119 *
1120 *  Destroys an entire document
1121 *
1122 * Results:
1123 *  Frees document.
1124 *
1125 * Side effects:
1126 *  Deallocates memory.
1127 *
1128 *----------------------------------------------------------------------------
1129 */
1130
1131int
1132TclDOMDestroyDocument (doc)
1133    TclDOMDocument *doc;
1134{
1135  Tcl_HashEntry *entry;
1136  Tcl_HashSearch search;
1137  xmlNodePtr node;
1138  TclDOMEvent *event;
1139  Tcl_Obj *objPtr;
1140
1141  entry = Tcl_FindHashEntry(&documents, doc->token);
1142  if (!entry) {
1143    return TCL_ERROR;
1144  }
1145  Tcl_DeleteHashEntry(entry);
1146  /* Patch: rnurmi bug #593190 */
1147  entry = Tcl_FindHashEntry(&docByPtr, (ClientData) doc->docPtr);
1148  if (!entry) {
1149    return TCL_ERROR;
1150  }
1151  Tcl_DeleteHashEntry(entry);
1152
1153  Tcl_Free(doc->token);
1154
1155  entry = Tcl_FirstHashEntry(doc->nodes, &search);
1156  while (entry) {
1157    node = (xmlNodePtr) Tcl_GetHashValue(entry);
1158    objPtr = (Tcl_Obj *) node->_private;
1159    if (objPtr) {
1160      objPtr->typePtr = NULL;
1161      objPtr->internalRep.otherValuePtr = NULL;
1162      Tcl_DecrRefCount(objPtr);
1163    }
1164    entry = Tcl_NextHashEntry(&search);
1165  }
1166  Tcl_DeleteHashTable(doc->nodes);
1167  Tcl_Free((char*) doc->nodes);
1168
1169  entry = Tcl_FirstHashEntry(doc->events, &search);
1170  while (entry) {
1171    event = (TclDOMEvent *) Tcl_GetHashValue(entry);
1172    objPtr = (Tcl_Obj *) event->objPtr;
1173    if (objPtr) {
1174      objPtr->typePtr = NULL;
1175      objPtr->internalRep.otherValuePtr = NULL;
1176    }
1177    Tcl_DeleteCommandFromToken(event->interp, event->cmd);
1178
1179    entry = Tcl_NextHashEntry(&search);
1180  }
1181  Tcl_DeleteHashTable(doc->events);
1182  Tcl_Free((char*) doc->events);
1183
1184  xmlFreeDoc(doc->docPtr);
1185  Tcl_Free((char *) doc);
1186
1187  return TCL_OK;
1188}
1189/*
1190 *----------------------------------------------------------------------------
1191 *
1192 * TclDOMDestroyNode --
1193 *
1194 *  Destroys a node
1195 *
1196 * Results:
1197 *  Frees node.
1198 *
1199 * Side effects:
1200 *  Deallocates memory.
1201 *
1202 *----------------------------------------------------------------------------
1203 */
1204
1205int
1206TclDOMForgetNode (node, objPtr)
1207    xmlNodePtr node;
1208    Tcl_Obj *objPtr;
1209{
1210  xmlDocPtr doc = node->doc;
1211  TclDOMDocument *tcldomDoc;
1212  Tcl_HashEntry *entry;
1213
1214  entry = Tcl_FindHashEntry(&docByPtr, (ClientData) doc);
1215  if (!entry) {
1216    return TCL_ERROR;
1217  }
1218  tcldomDoc = (TclDOMDocument *) Tcl_GetHashValue(entry);
1219
1220  entry = Tcl_FindHashEntry(tcldomDoc->nodes, Tcl_GetStringFromObj(objPtr, NULL));
1221  if (entry) {
1222    Tcl_DeleteHashEntry(entry);
1223  }
1224
1225  node->_private = NULL;
1226
1227  return TCL_OK;
1228}
1229
1230int
1231TclDOMDestroyNode (node, objPtr)
1232    xmlNodePtr node;
1233    Tcl_Obj *objPtr;
1234{
1235  TclDOMForgetNode(node, objPtr);
1236  xmlFreeNode(node);
1237
1238  return TCL_OK;
1239}
1240
1241/*
1242 *----------------------------------------------------------------------------
1243 *
1244 * TclDOMDestroyEvent --
1245 *
1246 *  Destroys an event node
1247 *
1248 * Results:
1249 *  Frees node.
1250 *
1251 * Side effects:
1252 *  Deallocates memory.
1253 *
1254 *----------------------------------------------------------------------------
1255 */
1256
1257static void
1258TclDOMDeleteEvent(clientData)
1259    ClientData clientData;
1260{
1261  TclDOMEvent *event = (TclDOMEvent *) clientData;
1262  TclDOMDocument *doc = event->ownerDocument;
1263  Tcl_HashEntry *entry;
1264
1265  entry = Tcl_FindHashEntry(doc->events, event->cmdname);
1266  if (entry) {
1267    Tcl_DeleteHashEntry(entry);
1268  }
1269
1270  Tcl_Free((char *) event);
1271
1272}
1273
1274int
1275TclDOMDestroyEvent (event, objPtr)
1276    TclDOMEvent *event;
1277    Tcl_Obj *objPtr;
1278{
1279  Tcl_DeleteCommandFromToken(event->interp, event->cmd);
1280
1281  return TCL_OK;
1282}
1283
1284/*
1285 *----------------------------------------------------------------------------
1286 *
1287 * TclDOMParseCommand --
1288 *
1289 *  Implements dom::libxml2::parse command
1290 *
1291 * Results:
1292 *  Depends on method.
1293 *
1294 * Side effects:
1295 *  Depends on method.
1296 *
1297 *----------------------------------------------------------------------------
1298 */
1299
1300int
1301TclDOMParseCommand (dummy, interp, objc, objv)
1302     ClientData dummy;
1303     Tcl_Interp *interp;
1304     int objc;
1305     Tcl_Obj *CONST objv[];
1306{
1307  char *buf;
1308  int len, new, option;
1309  xmlParserCtxtPtr ctxt;
1310  xmlDocPtr docPtr;
1311  Tcl_Obj *objPtr;
1312  Tcl_HashEntry *entryPtr;
1313  Tcl_Obj *baseuriPtr = NULL;
1314  Tcl_Obj *extentity = NULL;
1315  ParserClientData *clientData;
1316  GenericError_Info *errorInfoPtr;
1317  void *oldErrorCtx;
1318  xmlGenericErrorFunc old_xmlGenericError;
1319  TclDOMDocument *tcldomDoc;
1320
1321  if (objc < 2) {
1322    Tcl_WrongNumArgs(interp, 1, objv, "xml ?args ...?");
1323    return TCL_ERROR;
1324  }
1325
1326  buf = Tcl_GetStringFromObj(objv[1], &len);
1327  if (buf == NULL) {
1328    Tcl_SetResult(interp, "unable to get document to parse", NULL);
1329    return TCL_ERROR;
1330  }
1331
1332  /*
1333   * Process options
1334   */
1335
1336  objc -= 2;
1337  objv += 2;
1338  while (objc) {
1339    if (objc == 1) {
1340      Tcl_Obj *msgPtr;
1341
1342      msgPtr = Tcl_NewStringObj("missing value for configuration option \"", -1);
1343      Tcl_AppendObjToObj(msgPtr, objv[0]);
1344      Tcl_AppendStringsToObj(msgPtr, "\"", (char *) NULL);
1345      Tcl_SetObjResult(interp, msgPtr);
1346      return TCL_ERROR;
1347    }
1348
1349    if (Tcl_GetIndexFromObj(interp, objv[0], ParseCommandOptions,
1350			    "option", 0, &option) != TCL_OK) {
1351      return TCL_ERROR;
1352    }
1353
1354    switch ((enum ParseCommandOptions) option) {
1355    case TCLDOM_PARSE_BASEURI:
1356      baseuriPtr = objv[1];
1357      break;
1358
1359    case TCLDOM_PARSE_EXTERNALENTITYCOMMAND:
1360      extentity = objv[1];
1361      break;
1362    }
1363
1364    objc -= 2;
1365    objv += 2;
1366  }
1367
1368  /*
1369   * This does the real work
1370   */
1371
1372  xmlInitParser();
1373  ctxt = xmlCreateMemoryParserCtxt(buf, len);
1374  if (ctxt == NULL) {
1375    /* Out of memory - we're in big trouble... */
1376    Tcl_SetResult(interp, "unable to allocate parser context", NULL);
1377    return TCL_ERROR;
1378  }
1379
1380  /*
1381   * Use the _private field to store TclDOM data
1382   */
1383
1384  clientData = (ParserClientData *) Tcl_Alloc(sizeof(ParserClientData));
1385  ctxt->_private = (char *) clientData;
1386  clientData->interp = interp;
1387
1388  if (baseuriPtr) {
1389    ctxt->input->filename = Tcl_GetStringFromObj(baseuriPtr, NULL);
1390  }
1391
1392  defaultLoader = xmlGetExternalEntityLoader();
1393  if (extentity) {
1394    clientData->externalentityloader = extentity;
1395    xmlSetExternalEntityLoader(TclDOMExternalEntityLoader);
1396  }
1397
1398  /*
1399   * Create a generic error handler... just in case
1400   */
1401
1402  errorInfoPtr = (GenericError_Info *) Tcl_Alloc(sizeof(GenericError_Info));
1403  errorInfoPtr->msg = NULL;
1404  errorInfoPtr->interp = interp;
1405  errorInfoPtr->code = TCL_OK;
1406
1407  /*
1408   * Save the previous error context so that it can
1409   * be restored upon completion of parsing.
1410   */
1411  old_xmlGenericError = xmlGenericError;
1412  oldErrorCtx = xmlGenericErrorContext;
1413
1414  xmlSetGenericErrorFunc((void *) errorInfoPtr, TclDOMGenericError);
1415
1416  /* docPtr = xmlParseMemory(buf, len); */
1417  if (xmlParseDocument(ctxt) != 0) {
1418    docPtr = NULL;
1419  } else {
1420    docPtr = ctxt->myDoc;
1421  }
1422
1423  xmlSetExternalEntityLoader(defaultLoader);
1424  /* SF bug #590473: murmi: moved to here, before xmlFreeParserCtxt */
1425  Tcl_Free(ctxt->_private);
1426  xmlFreeParserCtxt(ctxt);
1427  xmlCleanupParser();
1428
1429  xmlSetGenericErrorFunc((void *) oldErrorCtx, old_xmlGenericError);
1430
1431  if (docPtr == NULL) {
1432    if (errorInfoPtr->msg) {
1433      int code = errorInfoPtr->code;
1434      Tcl_SetObjResult(interp, errorInfoPtr->msg);
1435      Tcl_DecrRefCount(errorInfoPtr->msg);
1436      Tcl_Free((char *) errorInfoPtr);
1437      return code;
1438    } else {
1439      Tcl_SetResult(interp, "unable to parse document", NULL);
1440    }
1441    Tcl_Free((char *) errorInfoPtr);
1442    return TCL_ERROR;
1443  }
1444
1445  Tcl_Free((char *) errorInfoPtr);
1446
1447  /*
1448   * Make sure base URI is stored in the document.
1449   * Setting the input filename is insufficient.
1450   */
1451
1452  if (baseuriPtr && docPtr->URL == NULL) {
1453    buf = Tcl_GetStringFromObj(baseuriPtr, &len);
1454    docPtr->URL = Tcl_Alloc(len + 1);
1455    strcpy((char *) docPtr->URL, buf);
1456  }
1457
1458  /*
1459   * Wrap the document pointer in a Tcl object
1460   */
1461
1462  tcldomDoc = (TclDOMDocument *) Tcl_Alloc(sizeof(TclDOMDocument));
1463
1464  tcldomDoc->docPtr = docPtr;
1465
1466  tcldomDoc->token = Tcl_Alloc(20);
1467  sprintf(tcldomDoc->token, "doc%d", docCntr++);
1468
1469  entryPtr = Tcl_CreateHashEntry(&documents, tcldomDoc->token, &new);
1470  if (!new) {
1471    Tcl_Free(tcldomDoc->token);
1472    Tcl_SetResult(interp, "internal error: previously allocated token", NULL);
1473    return TCL_ERROR;
1474  }
1475  Tcl_SetHashValue(entryPtr, (void *) tcldomDoc);
1476  entryPtr = Tcl_CreateHashEntry(&docByPtr, (char *) docPtr, &new);
1477  if (!new) {
1478    Tcl_Free(buf);
1479    /* Delete above hash entry... */
1480    Tcl_SetResult(interp, "internal error: previously allocated token", NULL);
1481    return TCL_ERROR;
1482  }
1483  Tcl_SetHashValue(entryPtr, (void *) tcldomDoc);
1484
1485  objPtr = Tcl_NewObj();
1486  objPtr->internalRep.otherValuePtr = (VOID *) tcldomDoc;
1487  objPtr->typePtr = &TclDOM_DocObjType;
1488  objPtr->bytes = Tcl_Alloc(20);
1489  strcpy(objPtr->bytes, tcldomDoc->token);
1490  objPtr->length = strlen(tcldomDoc->token);
1491
1492  tcldomDoc->nodes = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
1493  tcldomDoc->nodeCntr = 0;
1494  Tcl_InitHashTable(tcldomDoc->nodes, TCL_STRING_KEYS);
1495  tcldomDoc->events = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
1496  tcldomDoc->eventCntr = 0;
1497  Tcl_InitHashTable(tcldomDoc->events, TCL_STRING_KEYS);
1498  for (new = 0; new < NUM_EVENT_TYPES; new++) {
1499    tcldomDoc->listening[new] = 0;
1500  }
1501
1502  /*
1503   * Use the _private field to point back to the wrapping
1504   * object.  This allows convenient reuse of the
1505   * object.
1506   */
1507
1508  docPtr->_private = (void *) objPtr;
1509
1510  Tcl_SetObjResult(interp, objPtr);
1511
1512  return TCL_OK;
1513}
1514
1515/*
1516 * Interpose on resolving external entity references.
1517 *
1518 * The return code of the script evaluation determines
1519 * the behaviour:
1520 * TCL_OK - return value is to be used as the entity data
1521 * TCL_CONTINUE - use the default libxml2 entity loader
1522 * TCL_BREAK - forget about this entity
1523 * TCL_ERROR - background error
1524 */
1525
1526static xmlParserInputPtr
1527TclDOMExternalEntityLoader(url, id, ctxt)
1528     const char *url;
1529     const char *id;
1530     xmlParserCtxtPtr ctxt;
1531{
1532  ParserClientData *clientData = (ParserClientData *) ctxt->_private;
1533  Tcl_Obj *cmdPtr;
1534
1535  if (clientData) {
1536    cmdPtr = Tcl_DuplicateObj(clientData->externalentityloader);
1537  } else {
1538    return NULL;
1539  }
1540
1541  if (url) {
1542    Tcl_ListObjAppendElement(clientData->interp, cmdPtr, Tcl_NewStringObj(url, -1));
1543  } else {
1544    Tcl_ListObjAppendElement(clientData->interp, cmdPtr, Tcl_NewListObj(0, NULL));
1545  }
1546  if (id) {
1547    Tcl_ListObjAppendElement(clientData->interp, cmdPtr, Tcl_NewStringObj(id, -1));
1548  } else {
1549    Tcl_ListObjAppendElement(clientData->interp, cmdPtr, Tcl_NewListObj(0, NULL));
1550  }
1551
1552  switch (Tcl_GlobalEvalObj(clientData->interp, cmdPtr)) {
1553
1554  case TCL_OK:
1555    /* TODO: Use the return value as the input */
1556    return (defaultLoader)(url, id, ctxt);
1557
1558  case TCL_CONTINUE:
1559    /* Use the default libxml2 loader */
1560    return (defaultLoader)(url, id, ctxt);
1561
1562  case TCL_BREAK:
1563    /* Do not load external entity, but no error */
1564    return NULL;
1565
1566  default:
1567    Tcl_BackgroundError(clientData->interp);
1568    return NULL;
1569  }
1570}
1571
1572/*
1573 *----------------------------------------------------------------------------
1574 *
1575 * TclDOMSerializeCommand --
1576 *
1577 *  Implements dom::libxml2::serialize command
1578 *
1579 * Results:
1580 *  Depends on method.
1581 *
1582 * Side effects:
1583 *  Depends on method.
1584 *
1585 *----------------------------------------------------------------------------
1586 */
1587
1588int
1589TclDOMSerializeCommand (dummy, interp, objc, objv)
1590     ClientData dummy;
1591     Tcl_Interp *interp;
1592     int objc;
1593     Tcl_Obj *CONST objv[];
1594{
1595  xmlDocPtr docPtr;
1596  xmlNodePtr nodePtr;
1597  xmlChar *result;
1598  int option, method = TCLDOM_SERIALIZE_METHOD_XML, indent = 0, len;
1599  char *buf;
1600
1601  if (objc < 2) {
1602    Tcl_WrongNumArgs(interp, 1, objv, "node ?option value ...?");
1603    return TCL_ERROR;
1604  }
1605
1606  if (TclDOM_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
1607    if (TclDOM_GetNodeFromObj(interp, objv[1], &nodePtr) == TCL_OK) {
1608      /* Serialize just the node */
1609      Tcl_SetResult(interp, "not yet implemented - serialize whole document", NULL);
1610      return TCL_ERROR;
1611    } else {
1612      Tcl_SetResult(interp, "not a libxml2 node", NULL);
1613      return TCL_ERROR;
1614    }
1615  }
1616
1617  if (objc > 2) {
1618    objc -= 2;
1619    objv += 2;
1620
1621    while (objc) {
1622
1623      if (objc == 1) {
1624	Tcl_Obj *msgPtr;
1625
1626	msgPtr = Tcl_NewStringObj("missing value for configuration option \"", -1);
1627	Tcl_AppendObjToObj(msgPtr, objv[0]);
1628	Tcl_AppendStringsToObj(msgPtr, "\"", (char *) NULL);
1629	Tcl_SetObjResult(interp, msgPtr);
1630	return TCL_ERROR;
1631      }
1632
1633      if (Tcl_GetIndexFromObj(interp, objv[0], SerializeCommandOptions,
1634			    "option", 0, &option) != TCL_OK) {
1635	return TCL_ERROR;
1636      }
1637
1638      switch ((enum SerializeCommandOptions) option) {
1639      case TCLDOM_SERIALIZE_METHOD:
1640
1641	buf = Tcl_GetStringFromObj(objv[1], &len);
1642	if (len == 0) {
1643	  method = TCLDOM_SERIALIZE_METHOD_XML;
1644	} else if (Tcl_GetIndexFromObj(interp, objv[1], SerializeMethods,
1645				       "method", 0, &method) != TCL_OK) {
1646	  return TCL_ERROR;
1647	}
1648
1649	break;
1650
1651      case TCLDOM_SERIALIZE_INDENT:
1652
1653	if (Tcl_GetBooleanFromObj(interp, objv[1], &indent) != TCL_OK) {
1654	  return TCL_ERROR;
1655	}
1656
1657	break;
1658
1659      default:
1660	Tcl_SetResult(interp, "unknown option", NULL);
1661	return TCL_ERROR;
1662      }
1663
1664      objc -= 2;
1665      objv += 2;
1666    }
1667  }
1668
1669  /* This code substantially borrowed from libxslt xsltutil.c */
1670
1671  switch ((enum SerializeMethods) method) {
1672  case TCLDOM_SERIALIZE_METHOD_XML:
1673    xmlDocDumpFormatMemory(docPtr, &result, &len, indent);
1674    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, len));
1675    free(result);
1676
1677    break;
1678
1679  case TCLDOM_SERIALIZE_METHOD_HTML:
1680
1681    htmlSetMetaEncoding(docPtr, (const xmlChar *) "UTF-8");
1682    htmlDocDumpMemory(docPtr, &result, &len);
1683    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, len));
1684    free(result);
1685
1686    break;
1687
1688  case TCLDOM_SERIALIZE_METHOD_TEXT:
1689
1690    nodePtr = docPtr->children;
1691
1692    while (nodePtr != NULL) {
1693      if (nodePtr->type = XML_TEXT_NODE)
1694	Tcl_AppendResult(interp, (char *) nodePtr->content, NULL);
1695
1696      if (nodePtr->children != NULL) {
1697	if ((nodePtr->children->type != XML_ENTITY_DECL) &&
1698	    (nodePtr->children->type != XML_ENTITY_REF_NODE) &&
1699	    (nodePtr->children->type != XML_ENTITY_NODE)) {
1700	  nodePtr = nodePtr->children;
1701	  continue;
1702	}
1703      }
1704
1705      if (nodePtr->next != NULL) {
1706	nodePtr = nodePtr->next;
1707	continue;
1708      }
1709
1710      do {
1711	nodePtr = nodePtr->parent;
1712	if (nodePtr == NULL)
1713	  break;
1714	if (nodePtr == (xmlNodePtr) docPtr) {
1715	  nodePtr = NULL;
1716	  break;
1717	}
1718	if (nodePtr->next != NULL) {
1719	  nodePtr = nodePtr->next;
1720	  break;
1721	}
1722      } while (nodePtr != NULL);
1723    }
1724
1725    break;
1726
1727  default:
1728    Tcl_SetResult(interp, "internal error", NULL);
1729    return TCL_ERROR;
1730  }
1731
1732  return TCL_OK;
1733}
1734
1735/*
1736 *----------------------------------------------------------------------------
1737 *
1738 * TclDOMDOMImplementationCommand --
1739 *
1740 *  Implements dom::libxml2::DOMImplementation command
1741 *
1742 * Results:
1743 *  Depends on method.
1744 *
1745 * Side effects:
1746 *  Depends on method.
1747 *
1748 *----------------------------------------------------------------------------
1749 */
1750
1751int
1752TclDOMDOMImplementationCommand (dummy, interp, objc, objv)
1753     ClientData dummy;
1754     Tcl_Interp *interp;
1755     int objc;
1756     Tcl_Obj *CONST objv[];
1757{
1758  int method;
1759
1760  if (objc < 2) {
1761    Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?");
1762    return TCL_ERROR;
1763  }
1764
1765  if (Tcl_GetIndexFromObj(interp, objv[1], DOMImplementationCommandMethods,
1766			  "method", 0, &method) != TCL_OK) {
1767    return TCL_ERROR;
1768  }
1769
1770  switch ((enum DOMImplementationCommandMethods) method) {
1771  case TCLDOM_IMPL_HASFEATURE:
1772    return TclDOM_HasFeatureCommand(dummy, interp, objc - 1, objv + 1);
1773  case TCLDOM_IMPL_CREATE:
1774    if (objc == 2) {
1775      return TclDOMCreateCommand(dummy, interp, 1, objv);
1776    } else if (objc == 3) {
1777      Tcl_Obj *objPtr;
1778      xmlDocPtr docPtr;
1779      xmlNodePtr nodePtr;
1780
1781      if (TclDOMCreateCommand(dummy, interp, 0, NULL) != TCL_OK) {
1782	return TCL_ERROR;
1783      }
1784      objPtr = Tcl_GetObjResult(interp);
1785      TclDOM_GetDocFromObj(interp, objPtr, &docPtr);
1786      nodePtr = xmlNewDocNode(docPtr, NULL, Tcl_GetStringFromObj(objv[2], NULL), NULL);
1787      if (nodePtr == NULL) {
1788	Tcl_SetResult(interp, "unable to create document element", NULL);
1789        TclDOMDestroyDocument((TclDOMDocument *) objPtr->internalRep.otherValuePtr);
1790	Tcl_DecrRefCount(objPtr);
1791	return TCL_ERROR;
1792      }
1793
1794      Tcl_SetObjResult(interp, objPtr);
1795    } else {
1796      Tcl_WrongNumArgs(interp, 1, objv, "create ?doc?");
1797      return TCL_ERROR;
1798    }
1799
1800    break;
1801
1802  case TCLDOM_IMPL_PARSE:
1803    return TclDOMParseCommand(dummy, interp, objc - 1, objv + 1);
1804
1805  case TCLDOM_IMPL_SERIALIZE:
1806    return TclDOMSerializeCommand(dummy, interp, objc - 1, objv + 1);
1807
1808  case TCLDOM_IMPL_SELECTNODE:
1809    return TclDOMSelectNodeCommand(dummy, interp, objc - 1, objv + 1);
1810
1811  case TCLDOM_IMPL_DESTROY:
1812    return TclDOMDestroyCommand(dummy, interp, objc - 1, objv + 1);
1813
1814  default:
1815    Tcl_SetResult(interp, "method \"", NULL);
1816    Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL));
1817    Tcl_AppendResult(interp, "\" not yet implemented", NULL);
1818    return TCL_ERROR;
1819  }
1820
1821  return TCL_OK;
1822}
1823
1824/*
1825 *----------------------------------------------------------------------------
1826 *
1827 * TclDOMValidateCommand --
1828 *
1829 *  Implements dom::libxml2::validate command.
1830 *
1831 * Results:
1832 *  Returns result of validation on XML document.
1833 *
1834 * Side effects:
1835 *  None.
1836 *
1837 *----------------------------------------------------------------------------
1838 */
1839
1840#ifdef WIN32
1841#if !defined (__CYGWIN__)
1842#define vsnprintf _vsnprintf
1843#endif /* __CYGWIN__ */
1844#endif /* WIN32 */
1845
1846static void
1847TclDOMValidityError(void *userData, const char *format, ...)
1848{
1849  va_list args;
1850  Tcl_Interp *interp = (Tcl_Interp *) userData;
1851  char buf[1025];
1852
1853  va_start(args,format);
1854  vsnprintf(buf, 1024, format, args);
1855  Tcl_AppendResult(interp, buf, NULL);
1856  va_end(args);
1857
1858}
1859
1860static void
1861TclDOMValidityWarning(void *userData, const char *format, ...)
1862{
1863  va_list args;
1864  Tcl_Interp *interp = (Tcl_Interp *) userData;
1865  char buf[1025];
1866
1867  va_start(args,format);
1868  vsnprintf(buf, 1024, format, args);
1869  Tcl_AppendResult(interp, buf, NULL);
1870  va_end(args);
1871
1872}
1873
1874int
1875TclDOMValidateCommand (dummy, interp, objc, objv)
1876     ClientData dummy;
1877     Tcl_Interp *interp;
1878     int objc;
1879     Tcl_Obj *CONST objv[];
1880{
1881  xmlDocPtr docPtr;
1882  xmlValidCtxt ctxt;
1883  GenericError_Info *errorInfoPtr;
1884  void *oldErrorCtx;
1885  xmlGenericErrorFunc old_xmlGenericError;
1886
1887  if (objc != 2) {
1888    Tcl_WrongNumArgs(interp, 1, objv, "doc");
1889    return TCL_ERROR;
1890  }
1891
1892  if (TclDOM_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
1893    return TCL_ERROR;
1894  }
1895
1896  errorInfoPtr = (GenericError_Info *) Tcl_Alloc(sizeof(GenericError_Info));
1897  errorInfoPtr->msg = NULL;
1898  errorInfoPtr->interp = interp;
1899  errorInfoPtr->code = TCL_OK;
1900
1901  /*
1902   * Save the previous error context so that it can
1903   * be restored upon completion of parsing.
1904   */
1905  old_xmlGenericError = xmlGenericError;
1906  oldErrorCtx = xmlGenericErrorContext;
1907
1908  xmlSetGenericErrorFunc((void *) errorInfoPtr, TclDOMGenericError);
1909
1910  ctxt.userData = (void *) interp;
1911  ctxt.error = (xmlValidityErrorFunc) TclDOMValidityError;
1912  ctxt.warning = (xmlValidityWarningFunc) TclDOMValidityWarning;
1913
1914  Tcl_SetResult(interp, "document is not valid\n", NULL);
1915
1916  if (!xmlValidateDocument(&ctxt, docPtr)) {
1917    if (errorInfoPtr->msg) {
1918      Tcl_AppendObjToObj(Tcl_GetObjResult(interp), errorInfoPtr->msg);
1919    }
1920    Tcl_Free((char *) errorInfoPtr);
1921    xmlSetGenericErrorFunc((void *) oldErrorCtx, old_xmlGenericError);
1922    return TCL_ERROR;
1923  }
1924
1925  xmlSetGenericErrorFunc((void *) oldErrorCtx, old_xmlGenericError);
1926
1927  Tcl_ResetResult(interp);
1928  Tcl_Free((char *) errorInfoPtr);
1929
1930  return TCL_OK;
1931}
1932
1933/*
1934 *----------------------------------------------------------------------------
1935 *
1936 * TclDOMXIncludeCommand --
1937 *
1938 *  Implements dom::libxml2::xinclude command.
1939 *
1940 * Results:
1941 *  Performs XInclude processing on a document.
1942 *
1943 * Side effects:
1944 *  The supplied DOM tree may be modified.
1945 *
1946 *----------------------------------------------------------------------------
1947 */
1948int
1949TclDOMXIncludeCommand (dummy, interp, objc, objv)
1950     ClientData dummy;
1951     Tcl_Interp *interp;
1952     int objc;
1953     Tcl_Obj *CONST objv[];
1954{
1955  xmlDocPtr docPtr;
1956  int subs;
1957
1958  if (objc != 2) {
1959    Tcl_WrongNumArgs(interp, 1, objv, "doc");
1960    return TCL_ERROR;
1961  }
1962
1963  if (TclDOM_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
1964    return TCL_ERROR;
1965  }
1966
1967  subs = xmlXIncludeProcess(docPtr);
1968  if (subs < 0) {
1969    Tcl_SetResult(interp, "unable to complete XInclude processing", NULL);
1970    return TCL_ERROR;
1971  }
1972
1973  Tcl_SetObjResult(interp, Tcl_NewIntObj(subs));
1974  return TCL_OK;
1975}
1976
1977/*
1978 *----------------------------------------------------------------------------
1979 *
1980 * TclDOMPrefix2NSCommand --
1981 *
1982 *  Implements dom::libxml2::prefix2namespaceURI command.
1983 *
1984 * Results:
1985 *  Returns namespace URI for a given prefix.
1986 *
1987 * Side effects:
1988 *  None.
1989 *
1990 *----------------------------------------------------------------------------
1991 */
1992int
1993TclDOMPrefix2NSCommand (dummy, interp, objc, objv)
1994     ClientData dummy;
1995     Tcl_Interp *interp;
1996     int objc;
1997     Tcl_Obj *CONST objv[];
1998{
1999  xmlNodePtr nodePtr;
2000  xmlNsPtr nsPtr;
2001
2002  if (objc != 3) {
2003    Tcl_WrongNumArgs(interp, 1, objv, "node prefix");
2004    return TCL_ERROR;
2005  }
2006
2007  if (TclDOM_GetNodeFromObj(interp, objv[1], &nodePtr) != TCL_OK) {
2008    return TCL_ERROR;
2009  }
2010
2011  nsPtr = xmlSearchNs(nodePtr->doc, nodePtr, Tcl_GetStringFromObj(objv[2], NULL));
2012
2013  if (!nsPtr) {
2014    Tcl_SetResult(interp, "no XML Namespace declaration", NULL);
2015    return TCL_ERROR;
2016  }
2017
2018  Tcl_SetObjResult(interp, Tcl_NewStringObj(nsPtr->href, -1));
2019  return TCL_OK;
2020}
2021
2022/*
2023 *----------------------------------------------------------------------------
2024 *
2025 * TclDOMSelectNodeCommand --
2026 *
2027 *  Implements dom::libxml2::selectnode command.
2028 *
2029 * Results:
2030 *  Returns result of XPath expression evaluation.
2031 *
2032 * Side effects:
2033 *  Memory is allocated for Tcl object to return result.
2034 *
2035 *----------------------------------------------------------------------------
2036 */
2037
2038int
2039TclDOMSelectNodeCommand (dummy, interp, objc, objv)
2040     ClientData dummy;
2041     Tcl_Interp *interp;
2042     int objc;
2043     Tcl_Obj *CONST objv[];
2044{
2045  int i, len, option;
2046  char *path;
2047  Tcl_Obj *objPtr, *nsOptPtr = NULL;
2048  xmlDocPtr docPtr;
2049  xmlNodePtr nodePtr = NULL;
2050  xmlXPathContextPtr ctxt;
2051  xmlXPathObjectPtr xpathObj;
2052  GenericError_Info *errorInfoPtr;
2053  void *oldErrorCtx;
2054  xmlGenericErrorFunc old_xmlGenericError;
2055
2056  if (objc < 3) {
2057    Tcl_WrongNumArgs(interp, 1, objv, "doc location-path ?option value...?");
2058    return TCL_ERROR;
2059  }
2060
2061  path = Tcl_GetStringFromObj(objv[2], &len);
2062  if (len == 0) {
2063    return TCL_OK;
2064  }
2065
2066  if (TclDOM_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
2067    if (TclDOM_GetNodeFromObj(interp, objv[1], &nodePtr) == TCL_OK) {
2068      docPtr = nodePtr->doc;
2069    } else {
2070      return TCL_ERROR;
2071    }
2072  }
2073
2074  for (i = 3; i < objc; i += 2) {
2075    if (i == objc - 1) {
2076      Tcl_AppendResult(interp, "missing value for option \"", Tcl_GetStringFromObj(objv[i], NULL), "\"", NULL);
2077      return TCL_ERROR;
2078    }
2079    if (Tcl_GetIndexFromObj(interp, objv[i], SelectNodeOptions,
2080			  "option", 0, &option) != TCL_OK) {
2081      goto opt_error;
2082    }
2083    switch ((enum SelectNodeOptions) option) {
2084
2085    case TCLDOM_SELECTNODE_OPTION_NAMESPACES:
2086      if (nsOptPtr) {
2087        if (Tcl_ListObjAppendList(interp, nsOptPtr, objv[i + 1]) != TCL_OK) {
2088          Tcl_SetResult(interp, "-namespaces option value must be a list", NULL);
2089          goto opt_error;
2090        }
2091      } else {
2092        nsOptPtr = Tcl_DuplicateObj(objv[i + 1]);
2093      }
2094      if (Tcl_ListObjLength(interp, nsOptPtr, &len) != TCL_OK) {
2095        Tcl_SetResult(interp, "-namespaces option value must be a list", NULL);
2096        goto opt_error;
2097      } else if (len % 2 != 0) {
2098        Tcl_SetResult(interp, "value missing from namespaces list", NULL);
2099        goto opt_error;
2100      }
2101
2102      break;
2103
2104    default:
2105      Tcl_AppendResult(interp, "unknown option \"", Tcl_GetStringFromObj(objv[i], NULL), "\"", NULL);
2106      goto opt_error;
2107    }
2108  }
2109
2110  ctxt = xmlXPathNewContext(docPtr);
2111  if (ctxt == NULL) {
2112    Tcl_SetResult(interp, "unable to create XPath context", NULL);
2113    return TCL_ERROR;
2114  }
2115
2116  if (nodePtr) {
2117    ctxt->node = nodePtr;
2118  }
2119
2120  /*
2121   * Create a generic error handler... just in case
2122   */
2123
2124  errorInfoPtr = (GenericError_Info *) Tcl_Alloc(sizeof(GenericError_Info));
2125  errorInfoPtr->msg = NULL;
2126  errorInfoPtr->interp = interp;
2127  errorInfoPtr->code = TCL_OK;
2128
2129  /*
2130   * Save the previous error context so that it can
2131   * be restored upon completion of parsing.
2132   */
2133  old_xmlGenericError = xmlGenericError;
2134  oldErrorCtx = xmlGenericErrorContext;
2135
2136  xmlSetGenericErrorFunc((void *) errorInfoPtr, TclDOMGenericError);
2137
2138  /*
2139   * Setup any XML Namespace prefixes given as arguments
2140   */
2141  if (nsOptPtr) {
2142    Tcl_ListObjLength(interp, nsOptPtr, &len);
2143    for (i = 0; i < len; i += 2) {
2144      Tcl_Obj *prefixPtr, *nsURIPtr;
2145
2146      Tcl_ListObjIndex(interp, nsOptPtr, i, &prefixPtr);
2147      Tcl_ListObjIndex(interp, nsOptPtr, i + 1, &nsURIPtr);
2148      if (xmlXPathRegisterNs(ctxt, Tcl_GetStringFromObj(prefixPtr, NULL), Tcl_GetStringFromObj(nsURIPtr, NULL))) {
2149        Tcl_ResetResult(interp);
2150        Tcl_AppendResult(interp, "unable to register XML Namespace \"", Tcl_GetStringFromObj(nsURIPtr, NULL), "\"", NULL);
2151        goto error;
2152      }
2153    }
2154  }
2155
2156  xpathObj = xmlXPathEval(path, ctxt);
2157
2158  xmlSetGenericErrorFunc((void *) oldErrorCtx, old_xmlGenericError);
2159
2160  if (xpathObj == NULL) {
2161    if (errorInfoPtr->msg) {
2162      Tcl_SetObjResult(interp, errorInfoPtr->msg);
2163      Tcl_DecrRefCount(errorInfoPtr->msg);
2164      goto error;
2165    } else {
2166      Tcl_SetResult(interp, "error evaluating XPath location path", NULL);
2167      goto error;
2168    }
2169  }
2170  Tcl_Free((char *) errorInfoPtr);
2171
2172  objPtr = Tcl_NewObj();
2173  switch (xpathObj->type) {
2174
2175  case XPATH_NODESET:
2176    len = xmlXPathNodeSetGetLength(xpathObj->nodesetval);
2177    for (i = 0; i < len; i++) {
2178      nodePtr = xmlXPathNodeSetItem(xpathObj->nodesetval, i);
2179      Tcl_ListObjAppendElement(interp, objPtr, TclDOM_CreateObjFromNode(nodePtr));
2180    }
2181    break;
2182
2183  case XPATH_BOOLEAN:
2184    Tcl_SetBooleanObj(objPtr, xpathObj->boolval);
2185    break;
2186
2187  case XPATH_NUMBER:
2188    Tcl_SetDoubleObj(objPtr, xpathObj->floatval);
2189    break;
2190
2191  case XPATH_STRING:
2192    Tcl_SetStringObj(objPtr, xpathObj->stringval, strlen(xpathObj->stringval));
2193    break;
2194
2195  default:
2196    Tcl_SetResult(interp, "bad XPath object type", NULL);
2197    goto error2;
2198  }
2199
2200  if (nsOptPtr) {
2201    Tcl_DecrRefCount(nsOptPtr);
2202  }
2203  xmlXPathFreeObject(xpathObj);
2204  xmlXPathFreeContext(ctxt);
2205
2206  Tcl_SetObjResult(interp, objPtr);
2207  return TCL_OK;
2208
2209 opt_error:
2210  if (nsOptPtr) {
2211    Tcl_DecrRefCount(nsOptPtr);
2212    return TCL_ERROR;
2213  }
2214
2215 error2:
2216  if (nsOptPtr) {
2217    Tcl_DecrRefCount(nsOptPtr);
2218  }
2219  xmlXPathFreeObject(xpathObj);
2220  xmlXPathFreeContext(ctxt);
2221  return TCL_ERROR;
2222
2223 error:
2224  if (nsOptPtr) {
2225    Tcl_DecrRefCount(nsOptPtr);
2226  }
2227  Tcl_Free((char *) errorInfoPtr);
2228  xmlXPathFreeContext(ctxt);
2229  return TCL_ERROR;
2230}
2231
2232/*
2233 *----------------------------------------------------------------------------
2234 *
2235 * TclDOMDocumentCommand --
2236 *
2237 *  Implements dom::libxml2::document command.
2238 *
2239 * Results:
2240 *  Depends on method.
2241 *
2242 * Side effects:
2243 *  Depends on method.
2244 *
2245 *----------------------------------------------------------------------------
2246 */
2247
2248int
2249TclDOMDocumentCommand (dummy, interp, objc, objv)
2250     ClientData dummy;
2251     Tcl_Interp *interp;
2252     int objc;
2253     Tcl_Obj *CONST objv[];
2254{
2255  int method, option, postMutationEvent = 0;
2256  xmlDocPtr docPtr = NULL;
2257  xmlNodePtr nodePtr = NULL, newNodePtr = NULL;
2258  xmlNsPtr nsPtr = NULL;
2259  Tcl_Obj *nodeObjPtr, *newNodeObjPtr = NULL;
2260  char *buf, *bufptr;
2261
2262  if (objc < 3) {
2263    Tcl_WrongNumArgs(interp, 2, objv, "method token ?args...?");
2264    return TCL_ERROR;
2265  }
2266
2267  if (Tcl_GetIndexFromObj(interp, objv[1], DocumentCommandMethods,
2268			  "method", 0, &method) != TCL_OK) {
2269    return TCL_ERROR;
2270  }
2271
2272  if (TclDOM_GetDocFromObj(interp, objv[2], &docPtr) != TCL_OK) {
2273    docPtr = NULL;
2274    if (TclDOM_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
2275      return TCL_ERROR;
2276    } else {
2277      nodeObjPtr = objv[2];
2278    }
2279  }
2280
2281  switch ((enum DocumentCommandMethods) method) {
2282
2283  case TCLDOM_DOCUMENT_CGET:
2284
2285    if (objc != 4) {
2286      Tcl_WrongNumArgs(interp, 3, objv, "cget option");
2287      return TCL_ERROR;
2288    }
2289
2290    if (!docPtr) {
2291      Tcl_SetResult(interp, "not a document", NULL);
2292      return TCL_ERROR;
2293    }
2294
2295    if (Tcl_GetIndexFromObj(interp, objv[3], DocumentCommandOptions,
2296			    "option", 0, &option) != TCL_OK) {
2297      return TCL_ERROR;
2298    }
2299
2300    switch ((enum DocumentCommandOptions) option) {
2301
2302    case TCLDOM_DOCUMENT_DOCTYPE:
2303      Tcl_SetResult(interp, "cget option \"", NULL);
2304      Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[3], NULL), NULL);
2305      Tcl_AppendResult(interp, "\" not yet implemented", NULL);
2306      return TCL_ERROR;
2307
2308    case TCLDOM_DOCUMENT_IMPLEMENTATION:
2309      Tcl_SetResult(interp, "::dom::libxml2::DOMImplementation", NULL);
2310      return TCL_ERROR;
2311
2312    case TCLDOM_DOCUMENT_DOCELEMENT:
2313
2314      nodePtr = xmlDocGetRootElement(docPtr);
2315
2316      if (nodePtr) {
2317	Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(nodePtr));
2318      } else {
2319	Tcl_ResetResult(interp);
2320	return TCL_OK;
2321      }
2322
2323      break;
2324
2325    default:
2326      Tcl_SetResult(interp, "unknown option", NULL);
2327      return TCL_ERROR;
2328    }
2329
2330    break;
2331
2332  case TCLDOM_DOCUMENT_CONFIGURE:
2333
2334    if (objc == 4) {
2335      Tcl_Obj *newobjv[4];
2336
2337      newobjv[0] = objv[0];
2338      newobjv[1] = Tcl_NewStringObj("cget", -1);
2339      newobjv[2] = objv[2];
2340      newobjv[3] = objv[3];
2341
2342      if (TclDOMDocumentCommand(NULL, interp, 4, newobjv) != TCL_OK) {
2343	return TCL_ERROR;
2344      }
2345
2346    } else {
2347      Tcl_ResetResult(interp);
2348      Tcl_AppendResult(interp, "attribute \"", Tcl_GetStringFromObj(objv[3], NULL), "\" is read-only", NULL);
2349      return TCL_ERROR;
2350    }
2351
2352    break;
2353
2354  case TCLDOM_DOCUMENT_CREATEELEMENTNS:
2355    if (objc != 5) {
2356      Tcl_WrongNumArgs(interp, 2, objv, "token nsuri qualname");
2357      return TCL_ERROR;
2358    }
2359
2360    /*
2361     * libxml2 doesn't check for invalid element name,
2362     * so must do that here.
2363     */
2364    if (Tcl_RegExpMatchObj(interp, objv[4], checkQName) == 0) {
2365      Tcl_SetResult(interp, "invalid element name", NULL);
2366      return TCL_ERROR;
2367    }
2368
2369    /* Find localName of element */
2370    buf = Tcl_GetStringFromObj(objv[4], NULL);
2371    for (bufptr = buf; *bufptr != ':'; bufptr++) ;
2372    bufptr += 1;
2373
2374    if (docPtr) {
2375      /* We're creating the document element, so must create the namespace too */
2376      xmlNodePtr old;
2377      char *prefix;
2378
2379      newNodePtr = xmlNewDocNode(docPtr, NULL, bufptr, NULL);
2380      if (newNodePtr == NULL) {
2381        Tcl_SetResult(interp, "unable to create element node", NULL);
2382        return TCL_ERROR;
2383      }
2384      old = xmlDocSetRootElement(docPtr, newNodePtr);
2385      if (old) {
2386	xmlDocSetRootElement(docPtr, old);
2387	xmlFreeNode(newNodePtr);
2388	Tcl_SetResult(interp, "document element already exists", NULL);
2389	return TCL_ERROR;
2390      }
2391
2392      prefix = Tcl_Alloc(bufptr - buf);
2393      strncpy(prefix, buf, bufptr - buf - 1);
2394      prefix[bufptr - buf - 1] = '\0';
2395
2396      nsPtr = xmlNewNs(newNodePtr, Tcl_GetStringFromObj(objv[3], NULL), prefix);
2397      if (nsPtr == NULL) {
2398	Tcl_SetResult(interp, "unable to create XML Namespace", NULL);
2399	Tcl_Free(prefix);
2400	xmlUnlinkNode(newNodePtr);
2401	xmlFreeNode(newNodePtr);
2402	return TCL_ERROR;
2403      }
2404
2405      xmlSetNs(newNodePtr, nsPtr);
2406      Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(newNodePtr));
2407
2408    } else {
2409      /* Find XML Namespace */
2410      nsPtr = xmlSearchNsByHref(nodePtr->doc, nodePtr, Tcl_GetStringFromObj(objv[3], NULL));
2411      if (nsPtr == NULL) {
2412	char *prefix;
2413
2414	prefix = Tcl_Alloc(bufptr - buf);
2415	strncpy(prefix, buf, bufptr - buf - 1);
2416	prefix[bufptr - buf - 1] = '\0';
2417
2418	newNodePtr = xmlNewChild(nodePtr, NULL, bufptr, NULL);
2419	nsPtr = xmlNewNs(newNodePtr, Tcl_GetStringFromObj(objv[3], NULL), prefix);
2420	if (nsPtr == NULL) {
2421	  Tcl_SetResult(interp, "unable to create XML Namespace", NULL);
2422	  return TCL_ERROR;
2423	}
2424	xmlSetNs(newNodePtr, nsPtr);
2425
2426      } else {
2427	newNodePtr = xmlNewChild(nodePtr, nsPtr, bufptr, NULL);
2428	if (newNodePtr == NULL) {
2429	  Tcl_SetResult(interp, "unable to create element node", NULL);
2430	  return TCL_ERROR;
2431	}
2432      }
2433
2434      newNodeObjPtr = TclDOM_CreateObjFromNode(newNodePtr);
2435
2436      postMutationEvent = 1;
2437    }
2438
2439    break;
2440
2441  case TCLDOM_DOCUMENT_CREATEELEMENT:
2442
2443    if (objc != 4) {
2444      Tcl_WrongNumArgs(interp, 2, objv, "token name");
2445      return TCL_ERROR;
2446    }
2447
2448    /*
2449     * libxml2 doesn't check for invalid element name,
2450     * so must do that here.
2451     */
2452    if (Tcl_RegExpMatchObj(interp, objv[3], checkName) == 0) {
2453      Tcl_ResetResult(interp);
2454      Tcl_AppendResult(interp, "invalid element name \"", Tcl_GetStringFromObj(objv[3], NULL), "\"", NULL);
2455      return TCL_ERROR;
2456    }
2457
2458    if (docPtr) {
2459      xmlNodePtr old;
2460      newNodePtr = xmlNewDocNode(docPtr, NULL, Tcl_GetStringFromObj(objv[3], NULL), NULL);
2461      if (newNodePtr == NULL) {
2462        Tcl_SetResult(interp, "unable to create element node", NULL);
2463        return TCL_ERROR;
2464      }
2465      old = xmlDocSetRootElement(docPtr, newNodePtr);
2466      if (old) {
2467	xmlDocSetRootElement(docPtr, old);
2468	xmlFreeNode(newNodePtr);
2469	Tcl_SetResult(interp, "document element already exists", NULL);
2470	return TCL_ERROR;
2471      }
2472      newNodeObjPtr = TclDOM_CreateObjFromNode(newNodePtr);
2473    } else {
2474      newNodePtr = xmlNewChild(nodePtr, NULL, Tcl_GetStringFromObj(objv[3], NULL), NULL);
2475      if (newNodePtr == NULL) {
2476        Tcl_SetResult(interp, "unable to create element node", NULL);
2477        return TCL_ERROR;
2478      }
2479      newNodeObjPtr = TclDOM_CreateObjFromNode(newNodePtr);
2480    }
2481
2482    postMutationEvent = 1;
2483
2484    break;
2485
2486  case TCLDOM_DOCUMENT_CREATEDOCUMENTFRAGMENT:
2487
2488    if (objc != 3) {
2489      Tcl_WrongNumArgs(interp, 2, objv, "token");
2490      return TCL_ERROR;
2491    }
2492
2493    if (docPtr) {
2494      newNodePtr = xmlNewDocFragment(docPtr);
2495    } else {
2496      newNodePtr = xmlNewDocFragment(nodePtr->doc);
2497    }
2498    if (newNodePtr == NULL) {
2499      Tcl_SetResult(interp, "unable to create document fragment", NULL);
2500      return TCL_ERROR;
2501    }
2502    Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(newNodePtr));
2503
2504    /* The node hasn't been inserted into the tree yet */
2505    postMutationEvent = 0;
2506
2507    break;
2508
2509  case TCLDOM_DOCUMENT_CREATETEXTNODE:
2510
2511    if (objc != 4) {
2512      Tcl_WrongNumArgs(interp, 2, objv, "token text");
2513      return TCL_ERROR;
2514    }
2515
2516    if (docPtr) {
2517      char *content;
2518      int len;
2519
2520      content = Tcl_GetStringFromObj(objv[3], &len);
2521      newNodePtr = xmlNewDocTextLen(docPtr, content, len);
2522      if (newNodePtr == NULL) {
2523        Tcl_SetResult(interp, "unable to create text node", NULL);
2524        return TCL_ERROR;
2525      }
2526      Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(newNodePtr));
2527
2528      postMutationEvent = 0;
2529
2530    } else {
2531      xmlNodePtr returnNode;
2532      char *content;
2533      int len;
2534
2535      content = Tcl_GetStringFromObj(objv[3], &len);
2536      newNodePtr = xmlNewTextLen(content, len);
2537      if (newNodePtr == NULL) {
2538	Tcl_SetResult(interp, "creating text node failed", NULL);
2539	return TCL_ERROR;
2540      }
2541      returnNode = xmlAddChild(nodePtr, newNodePtr);
2542      if (returnNode == NULL) {
2543	xmlFreeNode(newNodePtr);
2544	Tcl_SetResult(interp, "add child failed", NULL);
2545	return TCL_ERROR;
2546      }
2547
2548      newNodeObjPtr = TclDOM_CreateObjFromNode(newNodePtr);
2549
2550      postMutationEvent = 1;
2551    }
2552
2553    break;
2554
2555  case TCLDOM_DOCUMENT_CREATECOMMENT:
2556
2557    if (objc != 4) {
2558      Tcl_WrongNumArgs(interp, 2, objv, "token data");
2559      return TCL_ERROR;
2560    }
2561
2562    if (docPtr) {
2563      newNodePtr = xmlNewComment(Tcl_GetStringFromObj(objv[3], NULL));
2564      if (newNodePtr == NULL) {
2565        Tcl_SetResult(interp, "unable to create comment node", NULL);
2566        return TCL_ERROR;
2567      }
2568      Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(newNodePtr));
2569
2570      postMutationEvent = 0;
2571
2572    } else {
2573      newNodePtr = xmlNewDocComment(nodePtr->doc, Tcl_GetStringFromObj(objv[3], NULL));
2574      if (newNodePtr == NULL) {
2575        Tcl_SetResult(interp, "unable to create comment node", NULL);
2576        return TCL_ERROR;
2577      }
2578      xmlAddChild(nodePtr, newNodePtr);
2579
2580      newNodeObjPtr = TclDOM_CreateObjFromNode(newNodePtr);
2581
2582      postMutationEvent = 1;
2583    }
2584
2585    break;
2586
2587  case TCLDOM_DOCUMENT_CREATECDATASECTION:
2588
2589    if (objc != 4) {
2590      Tcl_WrongNumArgs(interp, 2, objv, "token text");
2591      return TCL_ERROR;
2592    }
2593
2594    if (docPtr) {
2595      char *content;
2596      int len;
2597
2598      content = Tcl_GetStringFromObj(objv[3], &len);
2599      newNodePtr = xmlNewDocTextLen(docPtr, content, len);
2600      if (newNodePtr == NULL) {
2601        Tcl_SetResult(interp, "unable to create text node", NULL);
2602        return TCL_ERROR;
2603      }
2604      Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(newNodePtr));
2605
2606      postMutationEvent = 0;
2607
2608    } else {
2609      char *content;
2610      int len;
2611
2612      content = Tcl_GetStringFromObj(objv[3], &len);
2613      newNodePtr = xmlNewTextLen(content, len);
2614      if (newNodePtr == NULL) {
2615        Tcl_SetResult(interp, "unable to create text node", NULL);
2616        return TCL_ERROR;
2617      }
2618      xmlAddChild(nodePtr, newNodePtr);
2619
2620      newNodeObjPtr = TclDOM_CreateObjFromNode(newNodePtr);
2621
2622      postMutationEvent = 1;
2623    }
2624
2625    break;
2626
2627  case TCLDOM_DOCUMENT_CREATEPI:
2628    if (objc != 5) {
2629      Tcl_WrongNumArgs(interp, 2, objv, "token target data");
2630      return TCL_ERROR;
2631    }
2632
2633    newNodePtr = xmlNewPI(Tcl_GetStringFromObj(objv[3], NULL), Tcl_GetStringFromObj(objv[4], NULL));
2634    if (newNodePtr == NULL) {
2635      Tcl_SetResult(interp, "unable to create processing instruction node", NULL);
2636      return TCL_ERROR;
2637    }
2638
2639    if (docPtr) {
2640      Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(newNodePtr));
2641
2642      postMutationEvent = 0;
2643
2644    } else {
2645      xmlAddChild(nodePtr, newNodePtr);
2646
2647      newNodeObjPtr = TclDOM_CreateObjFromNode(newNodePtr);
2648
2649      postMutationEvent = 1;
2650    }
2651
2652    break;
2653
2654  case TCLDOM_DOCUMENT_CREATEEVENT:
2655
2656    if (objc != 4) {
2657      Tcl_WrongNumArgs(interp, 2, objv, "token type");
2658    }
2659
2660    if (!docPtr) {
2661      docPtr = nodePtr->doc;
2662    }
2663
2664    Tcl_SetObjResult(interp, TclDOMNewEvent(interp, docPtr, objv[3]));
2665
2666    break;
2667
2668  case TCLDOM_DOCUMENT_CREATEATTRIBUTE:
2669  case TCLDOM_DOCUMENT_CREATEENTITY:
2670  case TCLDOM_DOCUMENT_CREATEENTITYREFERENCE:
2671  case TCLDOM_DOCUMENT_CREATEDOCTYPEDECL:
2672  default:
2673    Tcl_SetResult(interp, "method \"", NULL);
2674    Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL);
2675    return TCL_ERROR;
2676  }
2677
2678  if (postMutationEvent) {
2679
2680
2681    TclDOM_PostMutationEvent(interp, docPtr == NULL ? nodePtr->doc : docPtr, newNodeObjPtr, Tcl_NewStringObj("DOMNodeInserted", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), objv[2], NULL, NULL, NULL, NULL);
2682    TclDOM_PostMutationEvent(interp, docPtr == NULL ? nodePtr->doc : docPtr, newNodeObjPtr, Tcl_NewStringObj("DOMNodeInsertedIntoDocument", -1), Tcl_NewIntObj(0), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
2683
2684    if (nodePtr) {
2685      TclDOM_PostMutationEvent(interp, nodePtr->doc, nodeObjPtr, Tcl_NewStringObj("DOMSubtreeModified", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
2686    } else {
2687      /*
2688       * We just added the document element.
2689       */
2690    }
2691
2692    Tcl_SetObjResult(interp, newNodeObjPtr);
2693  }
2694
2695  return TCL_OK;
2696}
2697
2698/*
2699 *----------------------------------------------------------------------------
2700 *
2701 * TriggerEventListeners --
2702 *
2703 *  Iterates through the list of event listeners for
2704 *  a node or document and fires events.
2705 *
2706 * Results:
2707 *  Depends on listeners.
2708 *
2709 * Side effects:
2710 *  Depends on listeners.
2711 *
2712 *----------------------------------------------------------------------------
2713 */
2714
2715static int
2716TriggerEventListeners(interp, type, tokenPtr, eventObjPtr, eventPtr)
2717     Tcl_Interp *interp;
2718     Tcl_HashTable *type;
2719     void *tokenPtr;
2720     Tcl_Obj *eventObjPtr;
2721     TclDOMEvent *eventPtr;
2722{
2723  Tcl_HashEntry *entryPtr;
2724  Tcl_HashTable *tablePtr;
2725  Tcl_Obj *listenerListPtr;
2726  int listenerLen, listenerIdx;
2727
2728  entryPtr = Tcl_FindHashEntry(type, tokenPtr);
2729  if (!entryPtr) {
2730    return TCL_OK;
2731  }
2732  tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr);
2733
2734  entryPtr = Tcl_FindHashEntry(tablePtr, Tcl_GetStringFromObj(eventPtr->type, NULL));
2735  if (!entryPtr) {
2736    return TCL_OK;
2737  }
2738  listenerListPtr = (Tcl_Obj *) Tcl_GetHashValue(entryPtr);
2739
2740  /*
2741   * DOM L2 specifies that the ancestors are determined
2742   * at the moment of event dispatch, so using a static
2743   * list is the correct thing to do.
2744   */
2745
2746  Tcl_ListObjLength(interp, listenerListPtr, &listenerLen);
2747  for (listenerIdx = 0; listenerIdx < listenerLen; listenerIdx++) {
2748    Tcl_Obj *listenerObj;
2749    Tcl_Obj **objv;
2750    int objc;
2751
2752    Tcl_ListObjIndex(interp, listenerListPtr, listenerIdx, &listenerObj);
2753
2754    /*
2755     * BUG workaround: eval'ing the command loses the event
2756     * object's internal rep.  By the time it gets to EventSetFromAny
2757     * the Tcl object seems to be corrupt.  As a workaround,
2758     * assume that the listener script is a single command
2759     * and invoke directly.
2760     *
2761
2762    cmdPtr = Tcl_DuplicateObj(listenerObj);
2763    if (Tcl_ListObjAppendElement(interp, cmdPtr, eventPtr) != TCL_OK) {
2764      return TCL_ERROR;
2765    }
2766    if (Tcl_GlobalEvalObj(interp, cmdPtr) != TCL_OK) {
2767      Tcl_BackgroundError(interp);
2768    }
2769    */
2770
2771    if (Tcl_ListObjGetElements(interp, listenerObj, &objc, &objv) != TCL_OK) {
2772      Tcl_BackgroundError(interp);
2773    } else {
2774      Tcl_Obj **newobjv = (Tcl_Obj **) Tcl_Alloc((objc + 2) * sizeof(Tcl_Obj *));
2775      int count;
2776
2777      for (count = 0; count < objc; count++) {
2778	newobjv[count] = objv[count];
2779      }
2780      newobjv[count] = eventObjPtr;
2781      newobjv[count + 1] = NULL;
2782
2783      if (Tcl_EvalObjv(interp, count + 1, newobjv, TCL_EVAL_GLOBAL) != TCL_OK) {
2784	Tcl_BackgroundError(interp);
2785      }
2786    }
2787
2788  }
2789
2790  return TCL_OK;
2791}
2792
2793static int
2794TclDOMSetLiveNodeListNode(interp, varName, nodePtr)
2795    Tcl_Interp *interp;
2796    char *varName;
2797    xmlNodePtr nodePtr;
2798{
2799  Tcl_Obj *valuePtr = Tcl_NewListObj(0, NULL);
2800  xmlNodePtr childPtr;
2801
2802  for (childPtr = nodePtr->children; childPtr; childPtr = childPtr->next) {
2803    Tcl_ListObjAppendElement(interp, valuePtr, TclDOM_CreateObjFromNode(childPtr));
2804  }
2805
2806  Tcl_SetVar2Ex(interp, varName, NULL, valuePtr, TCL_GLOBAL_ONLY);
2807
2808  return TCL_OK;
2809}
2810
2811static int
2812TclDOMSetLiveNodeListDoc(interp, varName, docPtr)
2813    Tcl_Interp *interp;
2814    char *varName;
2815    xmlDocPtr docPtr;
2816{
2817  Tcl_Obj *valuePtr = Tcl_NewListObj(0, NULL);
2818  xmlNodePtr childPtr;
2819
2820  for (childPtr = docPtr->children; childPtr; childPtr = childPtr->next) {
2821    Tcl_ListObjAppendElement(interp, valuePtr, TclDOM_CreateObjFromNode(childPtr));
2822  }
2823
2824  Tcl_SetVar2Ex(interp, varName, NULL, valuePtr, TCL_GLOBAL_ONLY);
2825
2826  return TCL_OK;
2827}
2828
2829static char *
2830TclDOMLiveNodeListNode(clientData, interp, name1, name2, flags)
2831    ClientData clientData;
2832    Tcl_Interp *interp;
2833    char *name1;
2834    char *name2;
2835    int flags;
2836{
2837  xmlNodePtr nodePtr = (xmlNodePtr) clientData;
2838
2839  if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
2840    return NULL;
2841  } else if (flags & TCL_TRACE_READS) {
2842    TclDOMSetLiveNodeListNode(interp, name1, nodePtr);
2843  } else if (flags & TCL_TRACE_WRITES) {
2844    TclDOMSetLiveNodeListNode(interp, name1, nodePtr);
2845    return "variable is read-only";
2846  } else if (flags & TCL_TRACE_UNSETS) {
2847  }
2848
2849  return NULL;
2850}
2851static char *
2852TclDOMLiveNodeListDoc(clientData, interp, name1, name2, flags)
2853    ClientData clientData;
2854    Tcl_Interp *interp;
2855    char *name1;
2856    char *name2;
2857    int flags;
2858{
2859  xmlDocPtr docPtr = (xmlDocPtr) clientData;
2860
2861  if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
2862    return NULL;
2863  } else if (flags & TCL_TRACE_READS) {
2864    TclDOMSetLiveNodeListDoc(interp, name1, docPtr);
2865  } else if (flags & TCL_TRACE_WRITES) {
2866    TclDOMSetLiveNodeListDoc(interp, name1, docPtr);
2867    return "variable is read-only";
2868  } else if (flags & TCL_TRACE_UNSETS) {
2869  }
2870
2871  return NULL;
2872}
2873
2874static int
2875TclDOMSetLiveNamedNodeMap(interp, varName, nodePtr)
2876    Tcl_Interp *interp;
2877    char *varName;
2878    xmlNodePtr nodePtr;
2879{
2880  xmlAttrPtr attrPtr;
2881
2882  Tcl_UnsetVar(interp, varName, TCL_GLOBAL_ONLY);
2883
2884  for (attrPtr = nodePtr->properties; attrPtr; attrPtr = attrPtr->next) {
2885
2886    if (Tcl_SetVar2Ex(interp, varName, (char *) attrPtr->name, Tcl_NewStringObj(xmlGetProp(nodePtr, attrPtr->name), -1), TCL_GLOBAL_ONLY) == NULL) {
2887      Tcl_ResetResult(interp);
2888      Tcl_AppendResult(interp, "unable to set attribute \"", attrPtr->name, "\"", NULL);
2889      return TCL_ERROR;
2890    }
2891
2892    if (Tcl_TraceVar2(interp, varName, (char *) attrPtr->name, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, TclDOMLiveNamedNodeMap, (ClientData) nodePtr) != TCL_OK) {
2893      return TCL_ERROR;
2894    }
2895  }
2896
2897  return TCL_OK;
2898}
2899
2900static char *
2901TclDOMLiveNamedNodeMap(clientData, interp, name1, name2, flags)
2902    ClientData clientData;
2903    Tcl_Interp *interp;
2904    char *name1;
2905    char *name2;
2906    int flags;
2907{
2908  xmlNodePtr nodePtr = (xmlNodePtr) clientData;
2909
2910  if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
2911    return NULL;
2912  } else if (flags & TCL_TRACE_READS && name2 == NULL) {
2913    TclDOMSetLiveNamedNodeMap(interp, name1, nodePtr);
2914  } else if (flags & TCL_TRACE_READS && name2 != NULL) {
2915    if (Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewStringObj(xmlGetProp(nodePtr, name2), -1), TCL_GLOBAL_ONLY) == NULL) {
2916      return "unable to set attribute";
2917    }
2918  } else if (flags & TCL_TRACE_WRITES) {
2919    TclDOMSetLiveNamedNodeMap(interp, name1, nodePtr);
2920    return "variable is read-only";
2921  } else if (flags & TCL_TRACE_UNSETS) {
2922  }
2923
2924  return NULL;
2925}
2926
2927/*
2928 *----------------------------------------------------------------------------
2929 *
2930 * TclDOMNodeCommand --
2931 *
2932 *  Implements dom::libxml2::node command.
2933 *
2934 * Results:
2935 *  Depends on method.
2936 *
2937 * Side effects:
2938 *  Depends on method.
2939 *
2940 *----------------------------------------------------------------------------
2941 */
2942
2943int
2944TclDOMNodeCommand (dummy, interp, objc, objv)
2945     ClientData dummy;
2946     Tcl_Interp *interp;
2947     int objc;
2948     Tcl_Obj *CONST objv[];
2949{
2950  int method, option, len, usecapture = 0;
2951  char *buf, varname[100];
2952  xmlNodePtr nodePtr = NULL, childNodePtr, refPtr, newPtr, oldParent;
2953  xmlDocPtr docPtr = NULL;
2954  Tcl_Obj *nodeObjPtr = NULL;
2955  Tcl_Obj *docObjPtr = NULL;
2956  Tcl_Obj *objPtr, *resultPtr, *livePtr;
2957
2958  if (objc < 2) {
2959    Tcl_WrongNumArgs(interp, 1, objv, "method token ?arg ...?");
2960    return TCL_ERROR;
2961  }
2962
2963/*
2964  Tcl_WriteChars(stderrChan, "NodeCommand", -1);
2965  for (method = 0; method < objc; method++) {
2966    char *dbgtype;
2967    char dbgnodebuf[200];
2968    sprintf(dbgnodebuf, "");
2969    if (objv[method]->typePtr) {
2970      dbgtype = objv[method]->typePtr->name;
2971      if (objv[method]->typePtr == &TclDOM_NodeObjType) {
2972        xmlNodePtr dbgnodeptr = (xmlNodePtr) objv[method]->internalRep.otherValuePtr;
2973        sprintf(dbgnodebuf, " name \"%s\" value \"%s\"", dbgnodeptr->name, XML_GET_CONTENT(dbgnodeptr));
2974      }
2975    } else {
2976      dbgtype = "(null)";
2977    }
2978    sprintf(dbgbuf, " \"%s\" (obj x%x type %s int x%x%s)", Tcl_GetStringFromObj(objv[method], NULL), objv[method], dbgtype, objv[method]->internalRep.otherValuePtr, dbgnodebuf);
2979    Tcl_WriteChars(stderrChan, dbgbuf, -1);
2980  }
2981  Tcl_WriteChars(stderrChan, "\n", -1);
2982*/
2983
2984  if (Tcl_GetIndexFromObj(interp, objv[1], NodeCommandMethods,
2985			  "method", 0, &method) != TCL_OK) {
2986    return TCL_ERROR;
2987  }
2988
2989  if (TclDOM_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
2990    if (TclDOM_GetDocFromObj(interp, objv[2], &docPtr) != TCL_OK) {
2991      return TCL_ERROR;
2992    } else {
2993      docObjPtr = objv[2];
2994      nodePtr = NULL;
2995    }
2996  } else {
2997    nodeObjPtr = objv[2];
2998    docPtr = NULL;
2999  }
3000
3001  switch ((enum NodeCommandMethods) method) {
3002
3003  case TCLDOM_NODE_CGET:
3004
3005    if (objc != 4) {
3006      Tcl_WrongNumArgs(interp, 3, objv, "cget option");
3007      return TCL_ERROR;
3008    }
3009
3010    if (Tcl_GetIndexFromObj(interp, objv[3], NodeCommandOptions,
3011			    "option", 0, &option) != TCL_OK) {
3012      return TCL_ERROR;
3013    }
3014
3015    switch ((enum NodeCommandOptions) option) {
3016
3017    case TCLDOM_NODE_NODETYPE:
3018
3019      if (docPtr) {
3020	Tcl_SetResult(interp, "document", NULL);
3021	break;
3022      }
3023
3024      switch (nodePtr->type) {
3025      case XML_ELEMENT_NODE:
3026	Tcl_SetResult(interp, "element", NULL);
3027	break;
3028      case XML_ATTRIBUTE_NODE:
3029	Tcl_SetResult(interp, "attribute", NULL);
3030	break;
3031      case XML_TEXT_NODE:
3032      case XML_CDATA_SECTION_NODE:
3033	Tcl_SetResult(interp, "textNode", NULL);
3034	break;
3035      case XML_ENTITY_REF_NODE:
3036	Tcl_SetResult(interp, "entityReference", NULL);
3037	break;
3038      case XML_ENTITY_NODE:
3039	Tcl_SetResult(interp, "entity", NULL);
3040	break;
3041      case XML_PI_NODE:
3042	Tcl_SetResult(interp, "processingInstruction", NULL);
3043	break;
3044      case XML_COMMENT_NODE:
3045	Tcl_SetResult(interp, "comment", NULL);
3046	break;
3047      case XML_DOCUMENT_NODE:
3048	Tcl_SetResult(interp, "document", NULL);
3049	break;
3050      case XML_DOCUMENT_TYPE_NODE:
3051	Tcl_SetResult(interp, "docType", NULL);
3052	break;
3053      case XML_DOCUMENT_FRAG_NODE:
3054	Tcl_SetResult(interp, "documentFragment", NULL);
3055	break;
3056      case XML_NOTATION_NODE:
3057	Tcl_SetResult(interp, "notation", NULL);
3058	break;
3059      case XML_HTML_DOCUMENT_NODE:
3060	Tcl_SetResult(interp, "HTMLdocument", NULL);
3061	break;
3062      case XML_DTD_NODE:
3063	Tcl_SetResult(interp, "dtd", NULL);
3064	break;
3065      case XML_ELEMENT_DECL:
3066	Tcl_SetResult(interp, "elementDecl", NULL);
3067	break;
3068      case XML_ATTRIBUTE_DECL:
3069	Tcl_SetResult(interp, "attributeDecl", NULL);
3070	break;
3071      case XML_ENTITY_DECL:
3072	Tcl_SetResult(interp, "entityDecl", NULL);
3073	break;
3074      case XML_NAMESPACE_DECL:
3075	Tcl_SetResult(interp, "namespaceDecl", NULL);
3076	break;
3077      case XML_XINCLUDE_START:
3078	Tcl_SetResult(interp, "xincludeStart", NULL);
3079	break;
3080      case XML_XINCLUDE_END:
3081	Tcl_SetResult(interp, "xincludeEnd", NULL);
3082	break;
3083      default:
3084	Tcl_SetResult(interp, "unknown", NULL);
3085      }
3086
3087      break;
3088
3089    case TCLDOM_NODE_LOCALNAME:
3090    case TCLDOM_NODE_NODENAME:
3091
3092      /* This isn't quite right: nodeName should return the expanded name */
3093
3094      if (docPtr) {
3095	Tcl_SetResult(interp, "#document", NULL);
3096	break;
3097      }
3098      /* libxml2 doesn't maintain the correct DOM node name */
3099      switch (nodePtr->type) {
3100      case XML_ELEMENT_NODE:
3101      case XML_ATTRIBUTE_NODE:
3102      case XML_ENTITY_REF_NODE:
3103      case XML_ENTITY_NODE:
3104      case XML_PI_NODE:
3105      case XML_DOCUMENT_TYPE_NODE:
3106      case XML_NOTATION_NODE:
3107	Tcl_SetObjResult(interp, Tcl_NewStringObj(nodePtr->name, -1));
3108	break;
3109      case XML_TEXT_NODE:
3110	Tcl_SetResult(interp, "#text", NULL);
3111	break;
3112      case XML_CDATA_SECTION_NODE:
3113	Tcl_SetResult(interp, "#cdata-section", NULL);
3114	break;
3115      case XML_COMMENT_NODE:
3116	Tcl_SetResult(interp, "#comment", NULL);
3117	break;
3118      case XML_DOCUMENT_NODE:
3119	/* Already handled above */
3120	Tcl_SetResult(interp, "#document", NULL);
3121	break;
3122      case XML_DOCUMENT_FRAG_NODE:
3123	Tcl_SetResult(interp, "#document-fragment", NULL);
3124	break;
3125      case XML_HTML_DOCUMENT_NODE:
3126	/* Not standard DOM */
3127	Tcl_SetResult(interp, "#HTML-document", NULL);
3128	break;
3129      case XML_DTD_NODE:
3130	/* Not standard DOM */
3131	Tcl_SetResult(interp, "#dtd", NULL);
3132	break;
3133      case XML_ELEMENT_DECL:
3134	/* Not standard DOM */
3135	Tcl_SetResult(interp, "#element-declaration", NULL);
3136	break;
3137      case XML_ATTRIBUTE_DECL:
3138	/* Not standard DOM */
3139	Tcl_SetResult(interp, "#attribute-declaration", NULL);
3140	break;
3141      case XML_ENTITY_DECL:
3142	/* Not standard DOM */
3143	Tcl_SetResult(interp, "#entity-declaration", NULL);
3144	break;
3145      case XML_NAMESPACE_DECL:
3146	/* Not standard DOM */
3147	Tcl_SetResult(interp, "#namespace-declaration", NULL);
3148	break;
3149      case XML_XINCLUDE_START:
3150	/* Not standard DOM */
3151	Tcl_SetResult(interp, "#xinclude-start", NULL);
3152	break;
3153      case XML_XINCLUDE_END:
3154	/* Not standard DOM */
3155	Tcl_SetResult(interp, "#xinclude-end", NULL);
3156	break;
3157      default:
3158	Tcl_SetResult(interp, "#unknown", NULL);
3159      }
3160
3161      break;
3162
3163    case TCLDOM_NODE_NODEVALUE:
3164
3165      if (docPtr) {
3166	break;
3167      }
3168
3169      if (XML_GET_CONTENT(nodePtr) != NULL) {
3170	Tcl_SetObjResult(interp, Tcl_NewStringObj(XML_GET_CONTENT(nodePtr), -1));
3171      }
3172
3173      break;
3174
3175    case TCLDOM_NODE_OWNERDOCUMENT:
3176
3177      if (docPtr) {
3178	Tcl_SetObjResult(interp, objv[2]);
3179	break;
3180      }
3181
3182      Tcl_SetObjResult(interp, TclDOM_CreateObjFromDoc(nodePtr->doc));
3183
3184      break;
3185
3186    case TCLDOM_NODE_PARENTNODE:
3187
3188      if (docPtr) {
3189	Tcl_ResetResult(interp);
3190	break;
3191      }
3192
3193      if (nodePtr->parent) {
3194	Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(nodePtr->parent));
3195      } else {
3196	Tcl_SetObjResult(interp, TclDOM_CreateObjFromDoc(nodePtr->doc));
3197      }
3198
3199      break;
3200
3201    case TCLDOM_NODE_CHILDNODES:
3202
3203      /* Set up live NodeList variable */
3204
3205      if (docPtr) {
3206	sprintf(varname, "::dom::libxml2::nodelist.%s", Tcl_GetStringFromObj(docObjPtr, NULL));
3207      } else {
3208	sprintf(varname, "::dom::libxml2::nodelist.%s", Tcl_GetStringFromObj(nodeObjPtr, NULL));
3209      }
3210      livePtr = Tcl_GetVar2Ex(interp, varname, NULL, TCL_GLOBAL_ONLY);
3211      if (!livePtr) {
3212	Tcl_Obj *nodelistPtr = Tcl_NewListObj(0, NULL);
3213
3214	Tcl_SetVar2Ex(interp, varname, NULL, nodelistPtr, TCL_GLOBAL_ONLY);
3215	Tcl_IncrRefCount(nodelistPtr);
3216
3217	if (docPtr) {
3218	  if (Tcl_TraceVar(interp, varname, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, TclDOMLiveNodeListDoc, (ClientData) docPtr) != TCL_OK) {
3219	    Tcl_DecrRefCount(nodelistPtr);
3220	    return TCL_ERROR;
3221	  } else {
3222	    TclDOMLiveNodeListDoc((ClientData) docPtr, interp, varname, NULL, TCL_TRACE_READS);
3223	  }
3224	} else {
3225	  if (Tcl_TraceVar(interp, varname, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, TclDOMLiveNodeListNode, (ClientData) nodePtr) != TCL_OK) {
3226	    Tcl_DecrRefCount(nodelistPtr);
3227	    return TCL_ERROR;
3228	  } else {
3229	    TclDOMLiveNodeListNode((ClientData) nodePtr, interp, varname, NULL, TCL_TRACE_READS);
3230	  }
3231	}
3232      }
3233
3234      Tcl_SetObjResult(interp, Tcl_NewStringObj(varname, -1));
3235
3236      break;
3237
3238    case TCLDOM_NODE_FIRSTCHILD:
3239
3240      if (docPtr) {
3241	childNodePtr = docPtr->children;
3242      } else {
3243	childNodePtr = nodePtr->children;
3244      }
3245
3246      Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(childNodePtr));
3247
3248      break;
3249
3250    case TCLDOM_NODE_LASTCHILD:
3251
3252      if (docPtr) {
3253	childNodePtr = docPtr->last;
3254      } else {
3255	childNodePtr = xmlGetLastChild(nodePtr);
3256      }
3257      if (childNodePtr != NULL) {
3258	Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(childNodePtr));
3259      }
3260
3261      break;
3262
3263    case TCLDOM_NODE_NEXTSIBLING:
3264      if (!docPtr && nodePtr->next) {
3265        Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(nodePtr->next));
3266      }
3267
3268      break;
3269
3270    case TCLDOM_NODE_PREVIOUSSIBLING:
3271      if (!docPtr && nodePtr->prev) {
3272        Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(nodePtr->prev));
3273      }
3274
3275      break;
3276
3277    case TCLDOM_NODE_ATTRIBUTES:
3278
3279      if (docPtr) {
3280        Tcl_ResetResult(interp);
3281        return TCL_OK;
3282      } else if (nodePtr->type != XML_ELEMENT_NODE) {
3283        Tcl_SetResult(interp, "wrong object type", NULL);
3284        return TCL_ERROR;
3285      } else {
3286        /* Set up live NamedNodeMap variable */
3287
3288        /* If there's already a variable, return it */
3289        sprintf(varname, "::dom::libxml2::att.%s", Tcl_GetStringFromObj(nodeObjPtr, NULL));
3290        livePtr = Tcl_GetVar2Ex(interp, varname, NULL, TCL_GLOBAL_ONLY);
3291        if (!livePtr) {
3292	  if (TclDOMSetLiveNamedNodeMap(interp, varname, (ClientData) nodePtr) != TCL_OK) {
3293	    Tcl_UnsetVar(interp, varname, TCL_GLOBAL_ONLY);
3294	    return TCL_ERROR;
3295	  }
3296
3297          if (Tcl_TraceVar(interp, varname, TCL_TRACE_ARRAY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, TclDOMLiveNamedNodeMap, (ClientData) nodePtr) != TCL_OK) {
3298            Tcl_UnsetVar(interp, varname, TCL_GLOBAL_ONLY);
3299            return TCL_ERROR;
3300          }
3301        }
3302
3303        Tcl_SetObjResult(interp, Tcl_NewStringObj(varname, -1));
3304
3305      }
3306
3307      break;
3308
3309    case TCLDOM_NODE_NAMESPACEURI:
3310
3311      if (!docPtr && nodePtr->ns) {
3312        if (nodePtr->ns->href) {
3313          Tcl_SetObjResult(interp, Tcl_NewStringObj(nodePtr->ns->href, -1));
3314        }
3315      }
3316
3317      break;
3318
3319    case TCLDOM_NODE_PREFIX:
3320
3321      if (!docPtr && nodePtr->ns) {
3322        if (nodePtr->ns->prefix) {
3323          Tcl_SetObjResult(interp, Tcl_NewStringObj(nodePtr->ns->prefix, -1));
3324        }
3325      }
3326
3327      break;
3328
3329    default:
3330      Tcl_SetResult(interp, "unknown option or not yet implemented", NULL);
3331      return TCL_ERROR;
3332    }
3333
3334    break;
3335
3336  case TCLDOM_NODE_PATH:
3337
3338    if (docPtr) {
3339      Tcl_Obj *newobjv[2];
3340
3341      newobjv[0] = TclDOM_CreateObjFromDoc(docPtr);
3342      newobjv[1] = NULL;
3343      Tcl_SetObjResult(interp, Tcl_NewListObj(1, newobjv));
3344    } else {
3345      Tcl_SetObjResult(interp, TclDOMGetPath(interp, nodePtr));
3346    }
3347
3348    break;
3349
3350  case TCLDOM_NODE_CONFIGURE:
3351
3352    if (objc < 4) {
3353      Tcl_WrongNumArgs(interp, 3, objv, "configure token option ?value? ?option value ...?");
3354      return TCL_ERROR;
3355    }
3356
3357    if (objc == 4) {
3358      /* equivalent to cget */
3359      Tcl_Obj *newobjv[5];
3360      newobjv[0] = objv[0];
3361      newobjv[1] = Tcl_NewStringObj("cget", -1);
3362      newobjv[2] = objv[2];
3363      newobjv[3] = objv[3];
3364      newobjv[4] = NULL;
3365      return TclDOMNodeCommand(dummy, interp, 4, newobjv);
3366    }
3367
3368    objc -= 3;
3369    objv += 3;
3370    while (objc) {
3371      if (objc == 1) {
3372	Tcl_SetResult(interp, "missing value", NULL);
3373	return TCL_ERROR;
3374      }
3375
3376      if (Tcl_GetIndexFromObj(interp, objv[0], NodeCommandOptions,
3377			    "option", 0, &option) != TCL_OK) {
3378	return TCL_ERROR;
3379      }
3380
3381      switch ((enum NodeCommandOptions) option) {
3382      case TCLDOM_NODE_NODETYPE:
3383      case TCLDOM_NODE_NODENAME:
3384      case TCLDOM_NODE_PARENTNODE:
3385      case TCLDOM_NODE_CHILDNODES:
3386      case TCLDOM_NODE_FIRSTCHILD:
3387      case TCLDOM_NODE_LASTCHILD:
3388      case TCLDOM_NODE_PREVIOUSSIBLING:
3389      case TCLDOM_NODE_NEXTSIBLING:
3390      case TCLDOM_NODE_ATTRIBUTES:
3391      case TCLDOM_NODE_NAMESPACEURI:
3392      case TCLDOM_NODE_PREFIX:
3393      case TCLDOM_NODE_LOCALNAME:
3394      case TCLDOM_NODE_OWNERDOCUMENT:
3395
3396	Tcl_ResetResult(interp);
3397	Tcl_AppendResult(interp, "attribute \"", Tcl_GetStringFromObj(objv[0], NULL), "\" is read-only", NULL);
3398	return TCL_ERROR;
3399
3400      case TCLDOM_NODE_NODEVALUE:
3401
3402        if (docPtr) {
3403	  Tcl_ResetResult(interp);
3404	  return TCL_OK;
3405	} else {
3406          docPtr = nodePtr->doc;
3407        }
3408
3409	switch (nodePtr->type) {
3410	case XML_ELEMENT_NODE:
3411	case XML_DOCUMENT_NODE:
3412	case XML_DOCUMENT_FRAG_NODE:
3413	case XML_DOCUMENT_TYPE_NODE:
3414	case XML_ENTITY_NODE:
3415	case XML_ENTITY_REF_NODE:
3416	case XML_NOTATION_NODE:
3417	case XML_HTML_DOCUMENT_NODE:
3418	case XML_DTD_NODE:
3419	case XML_ELEMENT_DECL:
3420	case XML_ATTRIBUTE_DECL:
3421	case XML_ENTITY_DECL:
3422	case XML_NAMESPACE_DECL:
3423	case XML_XINCLUDE_START:
3424	case XML_XINCLUDE_END:
3425	  /*
3426	   * DOM defines these nodes as not having a node value.
3427	   * libxml2 clobbers existing content if the value is set,
3428	   * so don't do it!
3429	   */
3430	  Tcl_ResetResult(interp);
3431	  return TCL_OK;
3432
3433	default:
3434	  /* fall-through */
3435	  break;
3436	}
3437
3438        objPtr = Tcl_NewStringObj(xmlNodeGetContent(nodePtr), -1);
3439
3440	buf = Tcl_GetStringFromObj(objv[1], &len);
3441	xmlNodeSetContentLen(nodePtr, buf, len);
3442
3443        TclDOM_PostMutationEvent(interp, docPtr, nodeObjPtr, Tcl_NewStringObj("DOMCharacterDataModified", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, objPtr, objv[1], NULL, NULL);
3444
3445        Tcl_DecrRefCount(objPtr);
3446
3447	break;
3448
3449      case TCLDOM_NODE_CDATASECTION:
3450
3451	break;
3452      }
3453
3454      objc -= 2;
3455      objv += 2;
3456
3457    }
3458
3459    break;
3460
3461  case TCLDOM_NODE_INSERTBEFORE:
3462    if (objc < 4 || objc > 5) {
3463      Tcl_WrongNumArgs(interp, 2, objv, "token ref ?new?");
3464      return TCL_ERROR;
3465    } else if (docPtr) {
3466      /* TODO: allow appending comments & PIs */
3467      Tcl_SetResult(interp, "document already has document element", NULL);
3468      return TCL_ERROR;
3469    } else if (objc == 4) {
3470      xmlNodePtr oldSibling;
3471
3472      /* No reference child specified - new appended to child list */
3473      if (TclDOM_GetNodeFromObj(interp, objv[3], &newPtr) != TCL_OK) {
3474        return TCL_ERROR;
3475      }
3476      refPtr = newPtr;
3477      oldParent = newPtr->parent;
3478      oldSibling = newPtr->next;
3479      if (oldParent != nodePtr) {
3480        TclDOM_PostMutationEvent(interp, nodePtr->doc, objv[3], Tcl_NewStringObj("DOMNodeRemoved", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), TclDOM_CreateObjFromNode(newPtr->parent), NULL, NULL, NULL, NULL);
3481      }
3482      /* Although xmlAddChild claims to release the child from its previous context,
3483       * that doesn't appear to actually happen.
3484       */
3485      xmlUnlinkNode(newPtr);
3486      if (xmlAddChild(nodePtr, newPtr) == NULL) {
3487	if (oldSibling) {
3488	  xmlAddPrevSibling(oldSibling, newPtr);
3489	} else {
3490	  xmlAddChild(oldParent, newPtr);
3491	}
3492        Tcl_SetResult(interp, "unable to insert node", NULL);
3493        return TCL_ERROR;
3494      }
3495    } else if (objc == 5) {
3496      if (TclDOM_GetNodeFromObj(interp, objv[3], &newPtr) != TCL_OK) {
3497        return TCL_ERROR;
3498      }
3499      if (TclDOM_GetNodeFromObj(interp, objv[4], &refPtr) != TCL_OK) {
3500        return TCL_ERROR;
3501      }
3502      oldParent = newPtr->parent;
3503      if (oldParent != refPtr->parent) {
3504        TclDOM_PostMutationEvent(interp, nodePtr->doc, objv[4], Tcl_NewStringObj("DOMNodeRemoved", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), TclDOM_CreateObjFromNode(newPtr->parent), NULL, NULL, NULL, NULL);
3505      }
3506      if (xmlAddPrevSibling(refPtr, newPtr) == NULL) {
3507        Tcl_SetResult(interp, "unable to insert node", NULL);
3508        return TCL_ERROR;
3509      }
3510    }
3511
3512    /* If parent has changed, notify old parent */
3513    if (oldParent != NULL && oldParent != refPtr->parent) {
3514      TclDOM_PostMutationEvent(interp, nodePtr->doc, TclDOM_CreateObjFromNode(oldParent), Tcl_NewStringObj("DOMSubtreeModified", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
3515    }
3516    /* Notify new parent */
3517    TclDOM_PostMutationEvent(interp, nodePtr->doc, TclDOM_CreateObjFromNode(newPtr->parent), Tcl_NewStringObj("DOMSubtreeModified", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
3518    /* Inserted event */
3519    TclDOM_PostMutationEvent(interp, nodePtr->doc, TclDOM_CreateObjFromNode(newPtr), Tcl_NewStringObj("DOMNodeInserted", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
3520
3521    break;
3522
3523  case TCLDOM_NODE_REPLACECHILD:
3524    if (objc !=  5) {
3525      Tcl_WrongNumArgs(interp, 2, objv, "token ref new");
3526      return TCL_ERROR;
3527    } else if (docPtr) {
3528      /* TODO: allow replacing comments & PIs */
3529      Tcl_SetResult(interp, "document already has document element", NULL);
3530      return TCL_ERROR;
3531    } else {
3532      if (TclDOM_GetNodeFromObj(interp, objv[3], &refPtr) != TCL_OK) {
3533        return TCL_ERROR;
3534      }
3535      if (TclDOM_GetNodeFromObj(interp, objv[4], &newPtr) != TCL_OK) {
3536        return TCL_ERROR;
3537      }
3538      oldParent = newPtr->parent;
3539      if (oldParent != refPtr->parent) {
3540        TclDOM_PostMutationEvent(interp, nodePtr->doc, TclDOM_CreateObjFromNode(newPtr), Tcl_NewStringObj("DOMNodeRemoved", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), TclDOM_CreateObjFromNode(newPtr->parent), NULL, NULL, NULL, NULL);
3541      }
3542      if (xmlReplaceNode(refPtr, newPtr) == NULL) {
3543        Tcl_SetResult(interp, "unable to replace node", NULL);
3544        return TCL_ERROR;
3545      }
3546    }
3547
3548    /* If parent has changed, notify old parent */
3549    if (oldParent != NULL && oldParent != newPtr->parent) {
3550      TclDOM_PostMutationEvent(interp, nodePtr->doc, TclDOM_CreateObjFromNode(oldParent), Tcl_NewStringObj("DOMSubtreeModified", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
3551    }
3552    /* Notify new parent */
3553    TclDOM_PostMutationEvent(interp, nodePtr->doc, TclDOM_CreateObjFromNode(newPtr->parent), Tcl_NewStringObj("DOMSubtreeModified", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
3554    /* Inserted event */
3555    TclDOM_PostMutationEvent(interp, nodePtr->doc, TclDOM_CreateObjFromNode(newPtr), Tcl_NewStringObj("DOMNodeInserted", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
3556
3557    break;
3558
3559  case TCLDOM_NODE_REMOVECHILD:
3560    if (objc !=  4) {
3561      Tcl_WrongNumArgs(interp, 2, objv, "node child");
3562      return TCL_ERROR;
3563    } else if (docPtr) {
3564      /* TODO: allow removing comments & PIs */
3565      Tcl_SetResult(interp, "document must have document element", NULL);
3566      return TCL_ERROR;
3567    } else {
3568      xmlNodePtr childPtr;
3569      if (TclDOM_GetNodeFromObj(interp, objv[3], &childPtr) != TCL_OK) {
3570        return TCL_ERROR;
3571      }
3572      oldParent = childPtr->parent;
3573      TclDOM_PostMutationEvent(interp, nodePtr->doc, objv[3], Tcl_NewStringObj("DOMNodeRemoved", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), TclDOM_CreateObjFromNode(oldParent), NULL, NULL, NULL, NULL);
3574      TclDOM_PostMutationEvent(interp, nodePtr->doc, objv[3], Tcl_NewStringObj("DOMNodeRemovedFromDocument", -1), Tcl_NewIntObj(0), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
3575      xmlUnlinkNode(childPtr);
3576      Tcl_SetObjResult(interp, objv[3]);
3577      TclDOM_PostMutationEvent(interp, nodePtr->doc, TclDOM_CreateObjFromNode(oldParent), Tcl_NewStringObj("DOMSubtreeModified", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
3578    }
3579
3580    break;
3581
3582  case TCLDOM_NODE_APPENDCHILD:
3583    if (objc !=  4) {
3584      Tcl_WrongNumArgs(interp, 2, objv, "node child");
3585      return TCL_ERROR;
3586    } else if (docPtr) {
3587      xmlNodePtr oldPtr;
3588
3589      if (TclDOM_GetNodeFromObj(interp, objv[3], &childNodePtr) != TCL_OK) {
3590        return TCL_ERROR;
3591      }
3592      /* TODO: allow appending comments & PIs */
3593      oldPtr = xmlDocSetRootElement(docPtr, childNodePtr);
3594      if (oldPtr) {
3595        xmlDocSetRootElement(docPtr, oldPtr);
3596        Tcl_SetResult(interp, "document element already exists", NULL);
3597        return TCL_ERROR;
3598      }
3599    } else {
3600      if (TclDOM_GetNodeFromObj(interp, objv[3], &childNodePtr) != TCL_OK) {
3601        return TCL_ERROR;
3602      }
3603      oldParent = childNodePtr->parent;
3604      if (oldParent != NULL && oldParent != nodePtr) {
3605        TclDOM_PostMutationEvent(interp, nodePtr->doc, objv[3], Tcl_NewStringObj("DOMNodeRemoved", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), TclDOM_CreateObjFromNode(oldParent), NULL, NULL, NULL, NULL);
3606      }
3607      if (xmlAddChild(nodePtr, childNodePtr) == NULL) {
3608        Tcl_SetResult(interp, "unable to append node", NULL);
3609        return TCL_ERROR;
3610      }
3611
3612      /* If parent has changed, notify old parent */
3613      if (oldParent != NULL && oldParent != nodePtr) {
3614        TclDOM_PostMutationEvent(interp, nodePtr->doc, TclDOM_CreateObjFromNode(oldParent), Tcl_NewStringObj("DOMSubtreeModified", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
3615      }
3616      /* Notify new parent */
3617      TclDOM_PostMutationEvent(interp, nodePtr->doc, nodeObjPtr, Tcl_NewStringObj("DOMSubtreeModified", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
3618      /* Inserted event */
3619      TclDOM_PostMutationEvent(interp, nodePtr->doc, objv[3], Tcl_NewStringObj("DOMNodeInserted", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), objv[2], NULL, NULL, NULL, NULL);
3620
3621    }
3622
3623    break;
3624
3625  case TCLDOM_NODE_HASCHILDNODES:
3626    if (docPtr) {
3627      if (docPtr->children) {
3628       Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
3629      } else {
3630       Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3631      }
3632    } else {
3633      if (nodePtr->children) {
3634       Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
3635      } else {
3636       Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3637      }
3638    }
3639
3640    break;
3641
3642  case TCLDOM_NODE_ISSAMENODE:
3643    /* DOM Level 3 method */
3644
3645    if (objc != 4) {
3646      Tcl_WrongNumArgs(interp, 1, objv, "isSameNode node ref");
3647      return TCL_ERROR;
3648    }
3649
3650    if (docPtr) {
3651      xmlDocPtr docRefPtr;
3652
3653      if (TclDOM_GetDocFromObj(interp, objv[3], &docRefPtr) != TCL_OK) {
3654	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3655	return TCL_OK;
3656      }
3657
3658      Tcl_SetObjResult(interp, Tcl_NewBooleanObj(docPtr == docRefPtr));
3659
3660    } else {
3661      if (TclDOM_GetNodeFromObj(interp, objv[3], &refPtr) != TCL_OK) {
3662	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
3663	return TCL_OK;
3664      }
3665
3666      Tcl_SetObjResult(interp, Tcl_NewBooleanObj(nodePtr == refPtr));
3667    }
3668
3669    break;
3670
3671  case TCLDOM_NODE_CLONENODE:
3672    if (objc != 3 && objc != 5) {
3673      Tcl_WrongNumArgs(interp, 1, objv, "cloneNode token ?-deep boolean?");
3674      return TCL_ERROR;
3675    } else if (docPtr) {
3676      Tcl_SetResult(interp, "documents cannot be cloned", NULL);
3677      return TCL_ERROR;
3678    } else {
3679      int deep = 0;
3680      xmlNodePtr copyPtr;
3681
3682      if (objc == 5) {
3683	if (Tcl_RegExpMatchObj(interp, objv[3], Tcl_NewStringObj("-de?e?p?", -1)) == 0) {
3684	  Tcl_ResetResult(interp);
3685	  Tcl_AppendResult(interp, "invalid option \"", Tcl_GetStringFromObj(objv[3], NULL), "\", must be \"-deep\"", NULL);
3686	  return TCL_ERROR;
3687	}
3688        if (Tcl_GetBooleanFromObj(interp, objv[4], &deep) != TCL_OK) {
3689          return TCL_ERROR;
3690        }
3691      }
3692      copyPtr = xmlDocCopyNode(nodePtr, nodePtr->doc, deep);
3693      if (copyPtr == NULL) {
3694        Tcl_SetResult(interp, "unable to copy node", NULL);
3695        return TCL_ERROR;
3696      }
3697      Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(copyPtr));
3698    }
3699    break;
3700
3701  case TCLDOM_NODE_PARENT:
3702
3703    if (docPtr) {
3704      break;
3705    }
3706
3707    if (nodePtr->parent) {
3708      Tcl_SetObjResult(interp, TclDOM_CreateObjFromNode(nodePtr->parent));
3709    } else {
3710      Tcl_SetObjResult(interp, TclDOM_CreateObjFromDoc(nodePtr->doc));
3711    }
3712
3713    break;
3714
3715  case TCLDOM_NODE_CHILDREN:
3716
3717    resultPtr = Tcl_NewListObj(0, NULL);
3718
3719    if (docPtr) {
3720      childNodePtr = docPtr->children;
3721    } else {
3722      childNodePtr = nodePtr->children;
3723    }
3724
3725    while (childNodePtr) {
3726      Tcl_ListObjAppendElement(interp, resultPtr, TclDOM_CreateObjFromNode(childNodePtr));
3727      childNodePtr = childNodePtr->next;
3728    }
3729
3730    Tcl_SetObjResult(interp, resultPtr);
3731
3732    break;
3733
3734  case TCLDOM_NODE_ADDEVENTLISTENER:
3735
3736    if (objc < 5) {
3737      Tcl_WrongNumArgs(interp, 2, objv, "addEventListener token type listener ?-usecapture boolean?");
3738      return TCL_ERROR;
3739    } else {
3740      Tcl_Obj *typePtr, *listenerPtr;
3741      void *tokenPtr = NULL;
3742      TclDOMDocument *tcldomdocPtr;
3743
3744      if (nodePtr) {
3745	tokenPtr = (void *) nodePtr;
3746      } else {
3747	tokenPtr = (void *) docPtr;
3748      }
3749
3750      typePtr = objv[3];
3751      listenerPtr = objv[4];
3752
3753      objc -= 5;
3754      objv += 5;
3755      while (objc) {
3756	if (objc == 1) {
3757	  Tcl_SetResult(interp, "missing value", NULL);
3758	  return TCL_ERROR;
3759	}
3760	if (Tcl_GetIndexFromObj(interp, objv[0], NodeCommandAddEventListenerOptions,
3761				"option", 0, &option) != TCL_OK) {
3762	  return TCL_ERROR;
3763	}
3764	switch ((enum NodeCommandAddEventListenerOptions) option) {
3765	case TCLDOM_NODE_ADDEVENTLISTENER_USECAPTURE:
3766
3767	  if (Tcl_GetBooleanFromObj(interp, objv[1], &usecapture) != TCL_OK) {
3768	    return TCL_ERROR;
3769	  }
3770
3771	  break;
3772
3773	default:
3774	  Tcl_SetResult(interp, "unknown option", NULL);
3775	  return TCL_ERROR;
3776	}
3777
3778	objc -= 2;
3779	objv += 2;
3780      }
3781
3782      if (nodePtr) {
3783	docObjPtr = TclDOM_CreateObjFromDoc(nodePtr->doc);
3784      } else {
3785	docObjPtr = TclDOM_CreateObjFromDoc(docPtr);
3786      }
3787      TclDOM_GetDoc2FromObj(interp, docObjPtr, &tcldomdocPtr);
3788
3789      return TclDOM_AddEventListener(interp, tcldomdocPtr, tokenPtr, typePtr, listenerPtr, usecapture);
3790    }
3791
3792  case TCLDOM_NODE_REMOVEEVENTLISTENER:
3793
3794    if (objc < 5) {
3795      Tcl_WrongNumArgs(interp, 2, objv, "removeEventListener token type listener ?-usecapture boolean?");
3796      return TCL_ERROR;
3797    } else {
3798      Tcl_Obj *typePtr, *listenerPtr;
3799      void *tokenPtr = NULL;
3800      TclDOMDocument *tcldomdocPtr;
3801
3802      if (nodePtr) {
3803        tokenPtr = (void *) nodePtr;
3804      } else {
3805        tokenPtr = (void *) docPtr;
3806      }
3807
3808      typePtr = objv[3];
3809      listenerPtr = objv[4];
3810
3811      objc -= 5;
3812      objv += 5;
3813      while (objc) {
3814	if (Tcl_GetIndexFromObj(interp, objv[0], NodeCommandAddEventListenerOptions,
3815				"option", 0, &option) != TCL_OK) {
3816	  return TCL_ERROR;
3817	}
3818	switch ((enum NodeCommandAddEventListenerOptions) option) {
3819	case TCLDOM_NODE_ADDEVENTLISTENER_USECAPTURE:
3820
3821	  if (Tcl_GetBooleanFromObj(interp, objv[1], &usecapture) != TCL_OK) {
3822	    return TCL_ERROR;
3823	  }
3824
3825	  break;
3826
3827	default:
3828	  Tcl_SetResult(interp, "unknown option", NULL);
3829	  return TCL_ERROR;
3830	}
3831
3832	objc -= 2;
3833	objv += 2;
3834      }
3835
3836      if (nodePtr) {
3837	docObjPtr = TclDOM_CreateObjFromDoc(nodePtr->doc);
3838      } else {
3839	docObjPtr = TclDOM_CreateObjFromDoc(docPtr);
3840      }
3841      TclDOM_GetDoc2FromObj(interp, docObjPtr, &tcldomdocPtr);
3842
3843      return TclDOM_RemoveEventListener(interp, tcldomdocPtr, tokenPtr, typePtr, listenerPtr, usecapture);
3844    }
3845
3846    break;
3847
3848  case TCLDOM_NODE_DISPATCHEVENT:
3849
3850    if (objc != 4) {
3851      Tcl_WrongNumArgs(interp, 2, objv, "dispatchEvent token event");
3852      return TCL_ERROR;
3853    } else {
3854      TclDOMEvent *eventPtr;
3855
3856      if (TclDOM_GetEventFromObj(interp, objv[3], &eventPtr) != TCL_OK) {
3857	return TCL_ERROR;
3858      }
3859
3860      return TclDOM_DispatchEvent(interp, objv[2], objv[3], eventPtr);
3861    }
3862
3863    break;
3864
3865  case TCLDOM_NODE_STRINGVALUE:
3866
3867    if (nodePtr) {
3868      buf = xmlNodeGetContent(nodePtr);
3869      Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
3870      xmlFree (buf);
3871    } else if (docPtr) {
3872      nodePtr = xmlDocGetRootElement(docPtr);
3873      if (nodePtr) {
3874        buf = xmlNodeGetContent(nodePtr);
3875        Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
3876        xmlFree (buf);
3877      }
3878    } else {
3879      Tcl_SetResult(interp, "cannot determine string value: internal error", NULL);
3880      return TCL_ERROR;
3881    }
3882
3883    break;
3884
3885  case TCLDOM_NODE_SELECTNODE:
3886
3887    Tcl_ResetResult(interp);
3888
3889    return TclDOMSelectNodeCommand(dummy, interp, objc - 1, objv + 1);
3890
3891    break;
3892
3893  default:
3894    Tcl_SetResult(interp, "method \"", NULL);
3895    Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL);
3896    return TCL_ERROR;
3897  }
3898
3899  return TCL_OK;
3900}
3901
3902/*
3903 *----------------------------------------------------------------------------
3904 *
3905 * TclDOM_AddEventListener --
3906 *
3907 *  Register an event listener.
3908 *
3909 * Results:
3910 *  Event listener stored.
3911 *
3912 * Side effects:
3913 *  None.
3914 *
3915 *----------------------------------------------------------------------------
3916 */
3917
3918int
3919TclDOM_AddEventListener(interp, tcldomdocPtr, tokenPtr, typePtr, listenerPtr, capturer)
3920    Tcl_Interp *interp;
3921    TclDOMDocument *tcldomdocPtr;
3922    void *tokenPtr;
3923    Tcl_Obj *typePtr;
3924    Tcl_Obj *listenerPtr;
3925    int capturer;
3926{
3927  Tcl_HashTable *tablePtr;
3928  Tcl_HashEntry *entryPtr;
3929  int new, eventType;
3930
3931  if (capturer) {
3932    tablePtr = &captureListeners;
3933  } else {
3934    tablePtr = &bubbleListeners;
3935  }
3936
3937  entryPtr = Tcl_CreateHashEntry(tablePtr, tokenPtr, &new);
3938  if (new) {
3939    tablePtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
3940    Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
3941    Tcl_SetHashValue(entryPtr, (char *) tablePtr);
3942  } else {
3943    tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr);
3944  }
3945
3946  entryPtr = Tcl_CreateHashEntry(tablePtr, Tcl_GetStringFromObj(typePtr, NULL), &new);
3947  if (new) {
3948    Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL);
3949
3950    Tcl_IncrRefCount(listenerPtr);
3951    Tcl_IncrRefCount(listPtr);
3952    Tcl_ListObjAppendElement(interp, listPtr, listenerPtr);
3953    Tcl_SetHashValue(entryPtr, (char *) listPtr);
3954
3955  } else {
3956    Tcl_Obj *listPtr = (Tcl_Obj *) Tcl_GetHashValue(entryPtr);
3957    Tcl_Obj *curPtr;
3958    int idx, len, listenerLen, len2, listlen;
3959    char *listenerBuf, *buf2;
3960
3961    if (Tcl_ListObjLength(interp, listPtr, &len) != TCL_OK) {
3962      Tcl_SetResult(interp, "internal error - bad list", NULL);
3963      return TCL_ERROR;
3964    }
3965    listenerBuf = Tcl_GetStringFromObj(listenerPtr, &listenerLen);
3966
3967    /*
3968      sprintf(dbgbuf, "looking for listener \"%s\" in existing list of listeners\n", listenerBuf);
3969      Tcl_WriteChars(stderrChan, dbgbuf, -1);
3970     */
3971
3972    new = 0;
3973    for (idx = 0; idx < len; idx++) {
3974      Tcl_ListObjIndex(interp, listPtr, idx, &curPtr);
3975      buf2 = Tcl_GetStringFromObj(curPtr, &len2);
3976
3977      /*
3978	sprintf(dbgbuf, "comparing against list entry \"%s\"\n", buf2);
3979	Tcl_WriteChars(stderrChan, dbgbuf, -1);
3980       */
3981
3982      if (listenerLen == len2 &&
3983          !strncmp(listenerBuf, buf2, listenerLen)) {
3984        /* Tcl_WriteChars(stderrChan, "found it\n", -1); */
3985        new = 1;
3986        break;
3987      } /* else {
3988	  Tcl_WriteChars(stderrChan, "keep looking\n", -1);
3989	  } */
3990    }
3991
3992    if (Tcl_ListObjLength(interp, listPtr, &listlen) != TCL_OK) {
3993      return TCL_ERROR;
3994    }
3995
3996    /*
3997      sprintf(dbgbuf, "replacing %d entry %d in list of length %d\n", new, idx, listlen);
3998      Tcl_WriteChars(stderrChan, dbgbuf, -1);
3999     */
4000
4001    Tcl_ListObjReplace(interp, listPtr, idx, new, 1, &listenerPtr);
4002
4003  }
4004
4005  /*
4006   * Performance optimization:
4007   * Keep track of which event types have listeners registered.
4008   * If there are no listeners for an event type, then there's
4009   * no point in dispatching that type of event.
4010   * NB. This does not keep track of user-defined events types.
4011   */
4012
4013  if (Tcl_GetIndexFromObj(interp, typePtr, EventTypes,
4014                          "type", TCL_EXACT, &eventType) == TCL_OK) {
4015    tcldomdocPtr->listening[eventType]++;
4016  } /* else this is a user-defined event type - it won't be tracked */
4017
4018  return TCL_OK;
4019}
4020/*
4021 *----------------------------------------------------------------------------
4022 *
4023 * TclDOM_RemoveEventListener --
4024 *
4025 *  Deregister an event listener.
4026 *
4027 * Results:
4028 *  Event listener data deleted.
4029 *
4030 * Side effects:
4031 *  May free Tcl objects.
4032 *
4033 *----------------------------------------------------------------------------
4034 */
4035
4036int
4037TclDOM_RemoveEventListener(interp, tcldomdocPtr, tokenPtr, typePtr, listenerPtr, capturer)
4038    Tcl_Interp *interp;
4039    TclDOMDocument *tcldomdocPtr;
4040    void *tokenPtr;
4041    Tcl_Obj *typePtr;
4042    Tcl_Obj *listenerPtr;
4043    int capturer;
4044{
4045  Tcl_HashTable *tablePtr;
4046  Tcl_HashEntry *entryPtr;
4047  int eventType;
4048
4049  if (capturer) {
4050    tablePtr = &captureListeners;
4051  } else {
4052    tablePtr = &bubbleListeners;
4053  }
4054
4055  entryPtr = Tcl_FindHashEntry(tablePtr, tokenPtr);
4056  if (entryPtr) {
4057    tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr);
4058
4059    entryPtr = Tcl_FindHashEntry(tablePtr, Tcl_GetStringFromObj(typePtr, NULL));
4060    if (entryPtr) {
4061      Tcl_Obj *listPtr = (Tcl_Obj *) Tcl_GetHashValue(entryPtr);
4062      Tcl_Obj *curPtr;
4063      int idx, listenerLen, len, len2;
4064      char *listenerBuf, *buf2;
4065
4066      if (Tcl_ListObjLength(interp, listPtr, &len) != TCL_OK) {
4067        Tcl_SetResult(interp, "internal error - bad list", NULL);
4068        return TCL_ERROR;
4069      }
4070      listenerBuf = Tcl_GetStringFromObj(listenerPtr, &listenerLen);
4071      for (idx = 0; idx < len; idx++) {
4072        Tcl_ListObjIndex(interp, listPtr, idx, &curPtr);
4073        buf2 = Tcl_GetStringFromObj(curPtr, &len2);
4074        if (listenerLen != len2 ||
4075            strncmp(listenerBuf, buf2, listenerLen)) {
4076          continue;
4077        }
4078      }
4079
4080      if (idx == len) {
4081        Tcl_SetResult(interp, "no listener registered", NULL);
4082        return TCL_ERROR;
4083      } else {
4084        Tcl_ListObjReplace(interp, listPtr, idx, 1, 0, NULL);
4085
4086        /*
4087         * Keep track of which event types have listeners registered.
4088         */
4089
4090        if (Tcl_GetIndexFromObj(interp, typePtr, EventTypes,
4091			         "type", TCL_EXACT, &eventType) == TCL_OK) {
4092	    tcldomdocPtr->listening[eventType]--;
4093	  } /* else user-defined event type - not being tracked */
4094	}
4095      } else {
4096	Tcl_SetResult(interp, "no listeners registered", NULL);
4097	return TCL_ERROR;
4098      }
4099    } else {
4100      Tcl_SetResult(interp, "no listeners registered", NULL);
4101      return TCL_ERROR;
4102    }
4103
4104    return TCL_OK;
4105}
4106
4107/*
4108 *----------------------------------------------------------------------------
4109 *
4110 * TclDOM_DispatchEvent --
4111 *
4112 *  Dispatch an event object.
4113 *
4114 * Results:
4115 *  Event propagtes through the DOM tree.
4116 *
4117 * Side effects:
4118 *  Depends on event listeners.
4119 *
4120 *----------------------------------------------------------------------------
4121 */
4122
4123int
4124TclDOM_DispatchEvent(interp, nodeObjPtr, eventObjPtr, eventPtr)
4125    Tcl_Interp *interp;
4126    Tcl_Obj *nodeObjPtr;
4127    Tcl_Obj *eventObjPtr;
4128    TclDOMEvent *eventPtr;
4129{
4130  xmlNodePtr nodePtr;
4131  xmlDocPtr docPtr;
4132  TclDOMDocument *tcldomdocPtr;
4133  char *phase;
4134  Tcl_Obj *docObjPtr, *pathPtr = NULL;
4135  int eventType, idx, len, cancelable;
4136  void *tokenPtr;
4137
4138  /*
4139    sprintf(dbgbuf, "dispatchEvent node %s event type %s\n", Tcl_GetStringFromObj(nodeObjPtr, NULL), Tcl_GetStringFromObj(eventPtr->type, NULL));
4140    Tcl_WriteChars(stderrChan, dbgbuf, -1);
4141  */
4142
4143  /*
4144   * Performance optimization:
4145   * If there are no listeners registered for this event type,
4146   * then there is no point in propagating the event.
4147   */
4148
4149  if (TclDOM_GetNodeFromObj(interp, nodeObjPtr, &nodePtr) != TCL_OK) {
4150    if (TclDOM_GetDocFromObj(interp, nodeObjPtr, &docPtr) != TCL_OK) {
4151      Tcl_SetResult(interp, "unrecognised token", NULL);
4152      return TCL_ERROR;
4153    } else {
4154      docObjPtr = nodeObjPtr;
4155      nodeObjPtr = NULL;
4156      nodePtr = NULL;
4157    }
4158  } else {
4159    docPtr = nodePtr->doc;
4160    docObjPtr = TclDOM_CreateObjFromDoc(docPtr);
4161  }
4162
4163  if (Tcl_GetIndexFromObj(interp, eventPtr->type, EventTypes,
4164                          "type", TCL_EXACT, &eventType) == TCL_OK) {
4165    TclDOM_GetDoc2FromObj(interp, docObjPtr, &tcldomdocPtr);
4166    if (tcldomdocPtr->listening[eventType] <= 0) {
4167      eventPtr->dispatched = 1;
4168      return TCL_OK;
4169    }
4170  } /* else this is a user-defined event so continue as normal */
4171
4172  phase = Tcl_GetStringFromObj(eventPtr->eventPhase, &len);
4173
4174  if (!len) {
4175    /*
4176     * This is the initial dispatch of the event.
4177     * First trigger any capturing event listeners
4178     * Starting from the root, proceed downward
4179     */
4180
4181    Tcl_SetStringObj(eventPtr->eventPhase, "capturing_phase", -1);
4182    eventPtr->target = nodeObjPtr;
4183
4184    if (nodePtr) {
4185      pathPtr = TclDOMGetPath(interp, nodePtr);
4186    } else {
4187      pathPtr = Tcl_NewObj();
4188    }
4189    if (TriggerEventListeners(interp, &captureListeners, (void *) docObjPtr, eventObjPtr, eventPtr) != TCL_OK) {
4190      Tcl_DecrRefCount(pathPtr);
4191      return TCL_ERROR;
4192    }
4193
4194    if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) {
4195      Tcl_DecrRefCount(pathPtr);
4196      return TCL_ERROR;
4197    }
4198    if (cancelable && eventPtr->stopPropagation) {
4199      goto stop_propagation;
4200    }
4201
4202    Tcl_ListObjLength(interp, pathPtr, &len);
4203    Tcl_ListObjReplace(interp, pathPtr, len - 1, 1, 0, NULL);
4204    Tcl_ListObjReplace(interp, pathPtr, 0, 1, 0, NULL);
4205    Tcl_ListObjLength(interp, pathPtr, &len);
4206    for (idx = 0; idx < len; idx++) {
4207      Tcl_Obj *ancestorObjPtr;
4208      xmlNodePtr ancestorPtr;
4209
4210      Tcl_ListObjIndex(interp, pathPtr, idx, &ancestorObjPtr);
4211      eventPtr->currentNode = ancestorObjPtr;
4212      Tcl_IncrRefCount(ancestorObjPtr);
4213      if (TclDOM_GetNodeFromObj(interp, ancestorObjPtr, &ancestorPtr) != TCL_OK) {
4214        Tcl_SetResult(interp, "cannot find ancestor node \"", NULL);
4215        Tcl_AppendResult(interp, Tcl_GetStringFromObj(ancestorObjPtr, NULL), "\"", NULL);
4216        return TCL_ERROR;
4217      }
4218
4219      if (TriggerEventListeners(interp, &captureListeners, (void *) ancestorPtr, eventObjPtr, eventPtr) != TCL_OK) {
4220        return TCL_ERROR;
4221      }
4222
4223      /*
4224       * A listener may stop propagation,
4225       * but we check here to let all of the
4226       * listeners at that level complete.
4227       */
4228
4229      if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) {
4230        return TCL_ERROR;
4231      }
4232      if (cancelable && eventPtr->stopPropagation) {
4233        Tcl_DecrRefCount(ancestorObjPtr);
4234        goto stop_propagation;
4235      }
4236
4237      Tcl_DecrRefCount(ancestorObjPtr);
4238
4239    }
4240
4241    /* Prepare for the next phase */
4242
4243    if (Tcl_IsShared(eventPtr->eventPhase)) {
4244      Tcl_DecrRefCount(eventPtr->eventPhase);
4245      eventPtr->eventPhase = Tcl_NewStringObj("at_target", -1);
4246      Tcl_IncrRefCount(eventPtr->eventPhase);
4247    } else {
4248      Tcl_SetStringObj(eventPtr->eventPhase, "at_target", -1);
4249    }
4250  }
4251
4252  if (nodePtr) {
4253    eventPtr->currentNode = nodeObjPtr;
4254    tokenPtr = (void *) nodePtr;
4255  } else {
4256    eventPtr->currentNode = docObjPtr;
4257    tokenPtr = (void *) docPtr;
4258  }
4259
4260  if (TriggerEventListeners(interp, &bubbleListeners, tokenPtr, eventObjPtr, eventPtr) != TCL_OK) {
4261    return TCL_ERROR;
4262  }
4263
4264  if (Tcl_IsShared(eventPtr->eventPhase)) {
4265    Tcl_DecrRefCount(eventPtr->eventPhase);
4266    eventPtr->eventPhase = Tcl_NewStringObj("bubbling_phase", -1);
4267    Tcl_IncrRefCount(eventPtr->eventPhase);
4268  } else {
4269    Tcl_SetStringObj(eventPtr->eventPhase, "bubbling_phase", -1);
4270  }
4271
4272  if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) {
4273    return TCL_ERROR;
4274  }
4275  if (cancelable && eventPtr->stopPropagation) {
4276    /* Do no more */
4277  } else if (nodePtr && nodePtr->parent && nodePtr->parent != (xmlNodePtr) nodePtr->doc) {
4278    return TclDOM_DispatchEvent(interp, TclDOM_CreateObjFromNode(nodePtr->parent), eventObjPtr, eventPtr);
4279  } else if (nodePtr && nodePtr->parent) {
4280    return TclDOM_DispatchEvent(interp, TclDOM_CreateObjFromDoc(nodePtr->doc), eventObjPtr, eventPtr);
4281  }
4282
4283stop_propagation:
4284  eventPtr->dispatched = 1;
4285
4286  if (pathPtr) {
4287    Tcl_DecrRefCount(pathPtr);
4288  }
4289
4290  return TCL_OK;
4291}
4292
4293/*
4294 *----------------------------------------------------------------------------
4295 *
4296 * TclDOMElementCommand --
4297 *
4298 *  Implements dom::libxml2::element command.
4299 *
4300 * Results:
4301 *  Depends on method.
4302 *
4303 * Side effects:
4304 *  Depends on method.
4305 *
4306 *----------------------------------------------------------------------------
4307 */
4308
4309int
4310TclDOMElementCommand (dummy, interp, objc, objv)
4311     ClientData dummy;
4312     Tcl_Interp *interp;
4313     int objc;
4314     Tcl_Obj *CONST objv[];
4315{
4316  int method, option;
4317  xmlNodePtr nodePtr;
4318  char *value;
4319  xmlAttrPtr attrPtr;
4320  xmlNsPtr nsPtr;
4321
4322  if (objc < 2) {
4323    Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?");
4324    return TCL_ERROR;
4325  }
4326
4327  if (Tcl_GetIndexFromObj(interp, objv[1], ElementCommandMethods,
4328			  "method", 0, &method) != TCL_OK) {
4329    return TCL_ERROR;
4330  }
4331
4332  if (TclDOM_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
4333    return TCL_ERROR;
4334  }
4335
4336  /* Should check that the node is of element type */
4337
4338  switch ((enum ElementCommandMethods) method) {
4339
4340  case TCLDOM_ELEMENT_CGET:
4341    if (objc != 4) {
4342      Tcl_WrongNumArgs(interp, 1, objv, "cget element option");
4343      return TCL_ERROR;
4344    }
4345
4346    if (Tcl_GetIndexFromObj(interp, objv[3], ElementCommandOptions,
4347			    "option", 0, &option) != TCL_OK) {
4348      return TCL_ERROR;
4349    }
4350
4351    switch ((enum ElementCommandOptions) option) {
4352    case TCLDOM_ELEMENT_TAGNAME:
4353      Tcl_SetObjResult(interp, Tcl_NewStringObj(nodePtr->name, -1));
4354      break;
4355
4356    case TCLDOM_ELEMENT_EMPTY:
4357      Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
4358      break;
4359
4360    default:
4361      Tcl_SetResult(interp, "unknown option", NULL);
4362      return TCL_ERROR;
4363    }
4364
4365    break;
4366
4367  case TCLDOM_ELEMENT_CONFIGURE:
4368    Tcl_SetResult(interp, "option cannot be changed", NULL);
4369    return TCL_ERROR;
4370
4371  case TCLDOM_ELEMENT_GETATTRIBUTE:
4372    if (objc != 4) {
4373      Tcl_WrongNumArgs(interp, 1, objv, "getAttribute element attr");
4374      return TCL_ERROR;
4375    }
4376
4377    value = xmlGetProp(nodePtr, Tcl_GetStringFromObj(objv[3], NULL));
4378    if (value) {
4379      Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1));
4380    }
4381
4382    break;
4383
4384  case TCLDOM_ELEMENT_GETATTRIBUTENS:
4385    if (objc != 5) {
4386      Tcl_WrongNumArgs(interp, 1, objv, "getAttribute element ns attr");
4387      return TCL_ERROR;
4388    }
4389
4390    value = xmlGetNsProp(nodePtr, Tcl_GetStringFromObj(objv[4], NULL), Tcl_GetStringFromObj(objv[3], NULL));
4391    if (value) {
4392      Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1));
4393    }
4394
4395    break;
4396
4397  case TCLDOM_ELEMENT_SETATTRIBUTE:
4398    if (objc != 5) {
4399      Tcl_WrongNumArgs(interp, 1, objv, "getAttribute element attr value");
4400      return TCL_ERROR;
4401    }
4402
4403    value = xmlGetProp(nodePtr, Tcl_GetStringFromObj(objv[3], NULL));
4404    attrPtr = xmlSetProp(nodePtr, Tcl_GetStringFromObj(objv[3], NULL), Tcl_GetStringFromObj(objv[4], NULL));
4405
4406    if (!attrPtr) {
4407      Tcl_SetResult(interp, "unable to set attribute", NULL);
4408      return TCL_ERROR;
4409    }
4410
4411    TclDOM_PostMutationEvent(interp, nodePtr->doc, objv[2], Tcl_NewStringObj("DOMAttrModified", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, Tcl_NewStringObj(value, -1), objv[4], objv[3], value == NULL? Tcl_NewStringObj("modification", -1) : Tcl_NewStringObj("addition", -1));
4412
4413    Tcl_SetObjResult(interp, objv[4]);
4414
4415    break;
4416
4417  case TCLDOM_ELEMENT_SETATTRIBUTENS:
4418    if (objc != 6) {
4419      Tcl_WrongNumArgs(interp, 1, objv, "getAttribute element ns attr value");
4420      return TCL_ERROR;
4421    }
4422
4423    nsPtr = xmlSearchNsByHref(nodePtr->doc, nodePtr, Tcl_GetStringFromObj(objv[3], NULL));
4424    if (!nsPtr) {
4425      Tcl_SetResult(interp, "no XML Namespace declaration for namespace", NULL);
4426      return TCL_ERROR;
4427    }
4428
4429    value = xmlGetNsProp(nodePtr, Tcl_GetStringFromObj(objv[4], NULL), Tcl_GetStringFromObj(objv[5], NULL));
4430    attrPtr = xmlSetNsProp(nodePtr, nsPtr, Tcl_GetStringFromObj(objv[4], NULL), Tcl_GetStringFromObj(objv[5], NULL));
4431
4432    if (!attrPtr) {
4433      Tcl_SetResult(interp, "unable to set attribute", NULL);
4434      return TCL_ERROR;
4435    }
4436
4437    TclDOM_PostMutationEvent(interp, nodePtr->doc, objv[2], Tcl_NewStringObj("DOMAttrModified", -1), Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, Tcl_NewStringObj(value, -1), objv[5], objv[4], value == NULL? Tcl_NewStringObj("modification", -1) : Tcl_NewStringObj("addition", -1));
4438
4439    break;
4440
4441  case TCLDOM_ELEMENT_REMOVEATTRIBUTE:
4442
4443    if (objc != 4) {
4444      Tcl_WrongNumArgs(interp, 1, objv, "removeAttribute element attr");
4445      return TCL_ERROR;
4446    }
4447
4448    Tcl_ResetResult(interp);
4449
4450    /* It doesn't matter if this fails due to a non-existant attribute */
4451    xmlUnsetProp(nodePtr, Tcl_GetStringFromObj(objv[3], NULL));
4452
4453    break;
4454
4455  default:
4456    Tcl_SetResult(interp, "method \"", NULL);
4457    Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL);
4458    return TCL_ERROR;
4459  }
4460
4461  return TCL_OK;
4462}
4463
4464/*
4465 *----------------------------------------------------------------------------
4466 *
4467 * TclDOMInitEvent --
4468 *
4469 *  Initializes an event object.
4470 *
4471 * Results:
4472 *  Tcl_Obj references stored.
4473 *
4474 * Side effects:
4475 *  Tcl_Obj's reference count changed.
4476 *
4477 *----------------------------------------------------------------------------
4478 */
4479
4480void
4481TclDOMInitEvent(eventPtr, typePtr, bubblesPtr, cancelablePtr)
4482    TclDOMEvent *eventPtr;
4483    Tcl_Obj *typePtr;
4484    Tcl_Obj *bubblesPtr;
4485    Tcl_Obj *cancelablePtr;
4486{
4487    if (eventPtr->type != typePtr) {
4488      Tcl_DecrRefCount(eventPtr->type);
4489      eventPtr->type = typePtr;
4490      Tcl_IncrRefCount(eventPtr->type);
4491    }
4492
4493    if (bubblesPtr && eventPtr->bubbles != bubblesPtr) {
4494      Tcl_DecrRefCount(eventPtr->bubbles);
4495      eventPtr->bubbles = bubblesPtr;
4496      Tcl_IncrRefCount(eventPtr->bubbles);
4497    }
4498    if (cancelablePtr && eventPtr->cancelable != cancelablePtr) {
4499      Tcl_DecrRefCount(eventPtr->cancelable);
4500      eventPtr->cancelable = cancelablePtr;
4501      Tcl_IncrRefCount(eventPtr->cancelable);
4502    }
4503}
4504
4505
4506/*
4507 *----------------------------------------------------------------------------
4508 *
4509 * TclDOMInitUIEvent --
4510 *
4511 *  Initializes an event object.
4512 *
4513 * Results:
4514 *  Tcl_Obj references stored.
4515 *
4516 * Side effects:
4517 *  Tcl_Obj's reference count changed.
4518 *
4519 *----------------------------------------------------------------------------
4520 */
4521
4522void
4523TclDOMInitUIEvent(eventPtr, typePtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr)
4524    TclDOMEvent *eventPtr;
4525    Tcl_Obj *typePtr;
4526    Tcl_Obj *bubblesPtr;
4527    Tcl_Obj *cancelablePtr;
4528    Tcl_Obj *viewPtr;
4529    Tcl_Obj *detailPtr;
4530{
4531    TclDOMInitEvent(eventPtr, typePtr, bubblesPtr, cancelablePtr);
4532
4533    if (viewPtr && eventPtr->view != viewPtr) {
4534      Tcl_DecrRefCount(eventPtr->view);
4535      eventPtr->view = viewPtr;
4536      Tcl_IncrRefCount(eventPtr->view);
4537    }
4538    if (detailPtr && eventPtr->detail != detailPtr) {
4539      Tcl_DecrRefCount(eventPtr->detail);
4540      eventPtr->detail = detailPtr;
4541      Tcl_IncrRefCount(eventPtr->detail);
4542    } else if (detailPtr == NULL) {
4543      Tcl_DecrRefCount(eventPtr->detail);
4544      eventPtr->detail = Tcl_NewObj();
4545    }
4546}
4547
4548
4549/*
4550 *----------------------------------------------------------------------------
4551 *
4552 * TclDOMInitMouseEvent --
4553 *
4554 *  Initializes an event object.
4555 *
4556 * Results:
4557 *  Tcl_Obj references stored.
4558 *
4559 * Side effects:
4560 *  Tcl_Obj's reference count changed.
4561 *
4562 *----------------------------------------------------------------------------
4563 */
4564
4565void
4566TclDOMInitMouseEvent(eventPtr, typePtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, altKeyPtr, shiftKeyPtr, metaKeyPtr, relatedNodePtr)
4567    TclDOMEvent *eventPtr;
4568    Tcl_Obj *typePtr;
4569    Tcl_Obj *bubblesPtr;
4570    Tcl_Obj *cancelablePtr;
4571    Tcl_Obj *viewPtr;
4572    Tcl_Obj *detailPtr;
4573    Tcl_Obj *screenXPtr;
4574    Tcl_Obj *screenYPtr;
4575    Tcl_Obj *clientXPtr;
4576    Tcl_Obj *clientYPtr;
4577    Tcl_Obj *ctrlKeyPtr;
4578    Tcl_Obj *altKeyPtr;
4579    Tcl_Obj *shiftKeyPtr;
4580    Tcl_Obj *metaKeyPtr;
4581    Tcl_Obj *relatedNodePtr;
4582{
4583    TclDOMInitUIEvent(eventPtr, typePtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr);
4584
4585    if (screenXPtr && eventPtr->screenX != screenXPtr) {
4586      Tcl_DecrRefCount(eventPtr->screenX);
4587      eventPtr->screenX = screenXPtr;
4588      Tcl_IncrRefCount(eventPtr->screenX);
4589    }
4590    if (screenYPtr && eventPtr->screenY != screenYPtr) {
4591      Tcl_DecrRefCount(eventPtr->screenY);
4592      eventPtr->screenY = screenYPtr;
4593      Tcl_IncrRefCount(eventPtr->screenY);
4594    }
4595
4596    if (clientXPtr && eventPtr->clientX != clientXPtr) {
4597      Tcl_DecrRefCount(eventPtr->clientX);
4598      eventPtr->clientX = clientXPtr;
4599      Tcl_IncrRefCount(eventPtr->clientX);
4600    }
4601    if (clientYPtr && eventPtr->clientY != clientYPtr) {
4602      Tcl_DecrRefCount(eventPtr->clientY);
4603      eventPtr->clientY = clientYPtr;
4604      Tcl_IncrRefCount(eventPtr->clientY);
4605    }
4606
4607    if (ctrlKeyPtr && eventPtr->ctrlKey != ctrlKeyPtr) {
4608      Tcl_DecrRefCount(eventPtr->ctrlKey);
4609      eventPtr->ctrlKey = ctrlKeyPtr;
4610      Tcl_IncrRefCount(eventPtr->ctrlKey);
4611    }
4612    if (ctrlKeyPtr && eventPtr->altKey != altKeyPtr) {
4613      Tcl_DecrRefCount(eventPtr->altKey);
4614      eventPtr->altKey = altKeyPtr;
4615      Tcl_IncrRefCount(eventPtr->altKey);
4616    }
4617    if (ctrlKeyPtr && eventPtr->shiftKey != shiftKeyPtr) {
4618      Tcl_DecrRefCount(eventPtr->shiftKey);
4619      eventPtr->shiftKey = shiftKeyPtr;
4620      Tcl_IncrRefCount(eventPtr->shiftKey);
4621    }
4622    if (ctrlKeyPtr && eventPtr->metaKey != metaKeyPtr) {
4623      Tcl_DecrRefCount(eventPtr->metaKey);
4624      eventPtr->metaKey = metaKeyPtr;
4625      Tcl_IncrRefCount(eventPtr->metaKey);
4626    }
4627
4628    if (relatedNodePtr && eventPtr->relatedNode != relatedNodePtr) {
4629      Tcl_DecrRefCount(eventPtr->relatedNode);
4630      eventPtr->relatedNode = relatedNodePtr;
4631      Tcl_IncrRefCount(eventPtr->relatedNode);
4632    }
4633}
4634
4635
4636/*
4637 *----------------------------------------------------------------------------
4638 *
4639 * TclDOMInitMutationEvent --
4640 *
4641 *  Initializes an event object.
4642 *
4643 * Results:
4644 *  Tcl_Obj references stored.
4645 *
4646 * Side effects:
4647 *  Tcl_Obj's reference count changed.
4648 *
4649 *----------------------------------------------------------------------------
4650 */
4651
4652void
4653TclDOMInitMutationEvent(eventPtr, typePtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr)
4654    TclDOMEvent *eventPtr;
4655    Tcl_Obj *typePtr;
4656    Tcl_Obj *bubblesPtr;
4657    Tcl_Obj *cancelablePtr;
4658    Tcl_Obj *relatedNodePtr;
4659    Tcl_Obj *prevValuePtr;
4660    Tcl_Obj *newValuePtr;
4661    Tcl_Obj *attrNamePtr;
4662    Tcl_Obj *attrChangePtr;
4663{
4664    TclDOMInitEvent(eventPtr, typePtr, bubblesPtr, cancelablePtr);
4665
4666    if (relatedNodePtr && eventPtr->relatedNode != relatedNodePtr) {
4667      Tcl_DecrRefCount(eventPtr->relatedNode);
4668      eventPtr->relatedNode = relatedNodePtr;
4669      Tcl_IncrRefCount(eventPtr->relatedNode);
4670    }
4671
4672    if (prevValuePtr && eventPtr->prevValue != prevValuePtr) {
4673      Tcl_DecrRefCount(eventPtr->prevValue);
4674      eventPtr->prevValue = prevValuePtr;
4675      Tcl_IncrRefCount(eventPtr->prevValue);
4676    }
4677    if (newValuePtr && eventPtr->newValue != newValuePtr) {
4678      Tcl_DecrRefCount(eventPtr->newValue);
4679      eventPtr->newValue = newValuePtr;
4680      Tcl_IncrRefCount(eventPtr->newValue);
4681    }
4682    if (attrNamePtr && eventPtr->attrName != attrNamePtr) {
4683      Tcl_DecrRefCount(eventPtr->attrName);
4684      eventPtr->attrName = attrNamePtr;
4685      Tcl_IncrRefCount(eventPtr->attrName);
4686    }
4687    if (attrChangePtr && eventPtr->attrChange != attrChangePtr) {
4688      Tcl_DecrRefCount(eventPtr->attrChange);
4689      eventPtr->attrChange = attrChangePtr;
4690      Tcl_IncrRefCount(eventPtr->attrChange);
4691    }
4692}
4693
4694
4695/*
4696 *----------------------------------------------------------------------------
4697 *
4698 * TclDOM_PostUIEvent --
4699 *
4700 *  Post an event and cleanup afterward.
4701 *
4702 * Results:
4703 *  Event created and propagated.
4704 *
4705 * Side effects:
4706 *  Depends on event listeners.
4707 *
4708 *----------------------------------------------------------------------------
4709 */
4710
4711int
4712TclDOM_PostUIEvent(interp, docPtr, nodeObjPtr, typePtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr)
4713     Tcl_Interp *interp;
4714     xmlDocPtr docPtr;
4715     Tcl_Obj *nodeObjPtr;
4716     Tcl_Obj *typePtr;
4717     Tcl_Obj *bubblesPtr;
4718     Tcl_Obj *cancelablePtr;
4719     Tcl_Obj *viewPtr;
4720     Tcl_Obj *detailPtr;
4721{
4722    Tcl_Obj *eventObj = TclDOMNewEvent(interp, docPtr, typePtr);
4723    TclDOMEvent *eventPtr = (TclDOMEvent *) eventObj->internalRep.otherValuePtr;
4724    int result;
4725
4726    TclDOMInitUIEvent(eventPtr, typePtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr);
4727
4728    Tcl_ResetResult(interp);
4729    result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr);
4730
4731    TclDOMDestroyEvent(eventPtr, eventObj);
4732
4733    return result;
4734}
4735
4736
4737/*
4738 *----------------------------------------------------------------------------
4739 *
4740 * TclDOM_PostMouseEvent --
4741 *
4742 *  Post an event and cleanup afterward.
4743 *
4744 * Results:
4745 *  Event created and propagated.
4746 *
4747 * Side effects:
4748 *  Depends on event listeners.
4749 *
4750 *----------------------------------------------------------------------------
4751 */
4752
4753int
4754TclDOM_PostMouseEvent(interp, docPtr, nodeObjPtr, typePtr, bubblesPtr, cancelablePtr, relatedNodePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr)
4755     Tcl_Interp *interp;
4756     xmlDocPtr docPtr;
4757     Tcl_Obj *nodeObjPtr;
4758     Tcl_Obj *typePtr;
4759     Tcl_Obj *bubblesPtr;
4760     Tcl_Obj *cancelablePtr;
4761     Tcl_Obj *relatedNodePtr;
4762     Tcl_Obj *viewPtr;
4763     Tcl_Obj *detailPtr;
4764     Tcl_Obj *screenXPtr;
4765     Tcl_Obj *screenYPtr;
4766     Tcl_Obj *clientXPtr;
4767     Tcl_Obj *clientYPtr;
4768     Tcl_Obj *ctrlKeyPtr;
4769     Tcl_Obj *shiftKeyPtr;
4770     Tcl_Obj *metaKeyPtr;
4771     Tcl_Obj *buttonPtr;
4772{
4773    Tcl_Obj *eventObj = TclDOMNewEvent(interp, docPtr, typePtr);
4774    TclDOMEvent *eventPtr = (TclDOMEvent *) eventObj->internalRep.otherValuePtr;
4775    int result;
4776
4777    TclDOMInitMouseEvent(eventPtr, typePtr, bubblesPtr, cancelablePtr, relatedNodePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr);
4778
4779    Tcl_ResetResult(interp);
4780    result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr);
4781
4782    TclDOMDestroyEvent(eventPtr, eventObj);
4783
4784    return result;
4785}
4786
4787
4788/*
4789 *----------------------------------------------------------------------------
4790 *
4791 * TclDOM_PostMutationEvent --
4792 *
4793 *  Post an event and cleanup afterward.
4794 *
4795 * Results:
4796 *  Event created and propagated.
4797 *
4798 * Side effects:
4799 *  Depends on event listeners.
4800 *
4801 *----------------------------------------------------------------------------
4802 */
4803
4804int
4805TclDOM_PostMutationEvent(interp, docPtr, nodeObjPtr, typePtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr)
4806     Tcl_Interp *interp;
4807     xmlDocPtr docPtr;
4808     Tcl_Obj *nodeObjPtr;
4809     Tcl_Obj *typePtr;
4810     Tcl_Obj *bubblesPtr;
4811     Tcl_Obj *cancelablePtr;
4812     Tcl_Obj *relatedNodePtr;
4813     Tcl_Obj *prevValuePtr;
4814     Tcl_Obj *newValuePtr;
4815     Tcl_Obj *attrNamePtr;
4816     Tcl_Obj *attrChangePtr;
4817{
4818    Tcl_Obj *eventObj = TclDOMNewEvent(interp, docPtr, typePtr);
4819    TclDOMEvent *eventPtr;
4820    int result;
4821
4822    if (eventObj == NULL) {
4823      Tcl_SetResult(interp, "unable to create event", NULL);
4824      return TCL_ERROR;
4825    }
4826
4827    eventPtr = (TclDOMEvent *) eventObj->internalRep.otherValuePtr;
4828    TclDOMInitMutationEvent(eventPtr, typePtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr);
4829
4830    Tcl_ResetResult(interp);
4831    result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr);
4832
4833    TclDOMDestroyEvent(eventPtr, eventObj);
4834
4835    return result;
4836}
4837
4838
4839/*
4840 *----------------------------------------------------------------------------
4841 *
4842 * TclDOMEventCommand --
4843 *
4844 *  Implements dom::libxml2::event command.
4845 *
4846 * Results:
4847 *  Depends on method.
4848 *
4849 * Side effects:
4850 *  Depends on method.
4851 *
4852 *----------------------------------------------------------------------------
4853 */
4854
4855int
4856TclDOMEventCommand (clientData, interp, objc, objv)
4857     ClientData clientData;
4858     Tcl_Interp *interp;
4859     int objc;
4860     Tcl_Obj *CONST objv[];
4861{
4862  int method, option;
4863  TclDOMEvent *eventPtr;
4864  xmlDocPtr docPtr;
4865  xmlNodePtr nodePtr;
4866  Tcl_Obj *eventObj, *nodeObj;
4867  Tcl_Obj *bubblesPtr, *cancelablePtr, *viewPtr, *detailPtr;
4868  Tcl_Obj *relatedNodePtr, *screenXPtr, *screenYPtr, *clientXPtr, *clientYPtr;
4869  Tcl_Obj *ctrlKeyPtr, *shiftKeyPtr, *metaKeyPtr, *buttonPtr;
4870  Tcl_Obj *prevValuePtr, *newValuePtr, *attrNamePtr, *attrChangePtr;
4871  Tcl_Obj **argPtr;
4872
4873  if (objc < 2) {
4874    Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?");
4875    return TCL_ERROR;
4876  }
4877
4878  if (Tcl_GetIndexFromObj(interp, objv[1], EventCommandMethods,
4879			  "method", 0, &method) != TCL_OK) {
4880    return TCL_ERROR;
4881  }
4882
4883  switch ((enum EventCommandMethods) method) {
4884
4885  case TCLDOM_EVENT_CGET:
4886    if (objc != 4) {
4887      Tcl_WrongNumArgs(interp, 3, objv, "cget event option");
4888      return TCL_ERROR;
4889    }
4890
4891    if (Tcl_GetIndexFromObj(interp, objv[3], EventCommandOptions,
4892			    "option", 0, &option) != TCL_OK) {
4893      return TCL_ERROR;
4894    }
4895
4896    if (clientData) {
4897      eventObj = (Tcl_Obj *) clientData;
4898      eventPtr = (TclDOMEvent *) eventObj->internalRep.otherValuePtr;
4899    } else {
4900      eventObj = objv[2];
4901      if (TclDOM_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
4902	return TCL_ERROR;
4903      }
4904    }
4905
4906    switch ((enum EventCommandOptions) option) {
4907    case TCLDOM_EVENT_ALTKEY:
4908      Tcl_SetObjResult(interp, eventPtr->altKey);
4909      break;
4910    case TCLDOM_EVENT_ATTRNAME:
4911      Tcl_SetObjResult(interp, eventPtr->attrName);
4912      break;
4913    case TCLDOM_EVENT_ATTRCHANGE:
4914      Tcl_SetObjResult(interp, eventPtr->attrChange);
4915      break;
4916    case TCLDOM_EVENT_BUBBLES:
4917      Tcl_SetObjResult(interp, eventPtr->bubbles);
4918      break;
4919    case TCLDOM_EVENT_BUTTON:
4920      Tcl_SetObjResult(interp, eventPtr->button);
4921      break;
4922    case TCLDOM_EVENT_CANCELABLE:
4923      Tcl_SetObjResult(interp, eventPtr->cancelable);
4924      break;
4925    case TCLDOM_EVENT_CLIENTX:
4926      Tcl_SetObjResult(interp, eventPtr->clientX);
4927      break;
4928    case TCLDOM_EVENT_CLIENTY:
4929      Tcl_SetObjResult(interp, eventPtr->clientY);
4930      break;
4931    case TCLDOM_EVENT_CTRLKEY:
4932      Tcl_SetObjResult(interp, eventPtr->ctrlKey);
4933      break;
4934    case TCLDOM_EVENT_CURRENTNODE:
4935      Tcl_SetObjResult(interp, eventPtr->currentNode);
4936      break;
4937    case TCLDOM_EVENT_DETAIL:
4938      Tcl_SetObjResult(interp, eventPtr->detail);
4939      break;
4940    case TCLDOM_EVENT_EVENTPHASE:
4941      Tcl_SetObjResult(interp, eventPtr->eventPhase);
4942      break;
4943    case TCLDOM_EVENT_METAKEY:
4944      Tcl_SetObjResult(interp, eventPtr->metaKey);
4945      break;
4946    case TCLDOM_EVENT_NEWVALUE:
4947      Tcl_SetObjResult(interp, eventPtr->newValue);
4948      break;
4949    case TCLDOM_EVENT_PREVVALUE:
4950      Tcl_SetObjResult(interp, eventPtr->prevValue);
4951      break;
4952    case TCLDOM_EVENT_RELATEDNODE:
4953      Tcl_SetObjResult(interp, eventPtr->relatedNode);
4954      break;
4955    case TCLDOM_EVENT_SCREENX:
4956      Tcl_SetObjResult(interp, eventPtr->screenX);
4957      break;
4958    case TCLDOM_EVENT_SCREENY:
4959      Tcl_SetObjResult(interp, eventPtr->screenY);
4960      break;
4961    case TCLDOM_EVENT_SHIFTKEY:
4962      Tcl_SetObjResult(interp, eventPtr->shiftKey);
4963      break;
4964    case TCLDOM_EVENT_TARGET:
4965      Tcl_SetObjResult(interp, eventPtr->target);
4966      break;
4967    case TCLDOM_EVENT_TIMESTAMP:
4968      Tcl_SetObjResult(interp, eventPtr->timeStamp);
4969      break;
4970    case TCLDOM_EVENT_TYPE:
4971      Tcl_SetObjResult(interp, eventPtr->type);
4972      break;
4973    case TCLDOM_EVENT_VIEW:
4974      Tcl_SetObjResult(interp, eventPtr->view);
4975      break;
4976    default:
4977      Tcl_SetResult(interp, "unknown option", NULL);
4978      return TCL_ERROR;
4979    }
4980
4981    break;
4982
4983  case TCLDOM_EVENT_CONFIGURE:
4984    if (objc < 2) {
4985      Tcl_WrongNumArgs(interp, 3, objv, "configure option ?value?");
4986      return TCL_ERROR;
4987    }
4988
4989    /* No event options are writable */
4990    Tcl_SetResult(interp, "option cannot be modified", NULL);
4991    return TCL_ERROR;
4992
4993    break;
4994
4995  case TCLDOM_EVENT_STOPPROPAGATION:
4996
4997    if (clientData) {
4998      eventObj = (Tcl_Obj *) clientData;
4999      eventPtr = (TclDOMEvent *) eventObj->internalRep.otherValuePtr;
5000    } else {
5001      eventObj = objv[2];
5002      if (TclDOM_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
5003	return TCL_ERROR;
5004      }
5005    }
5006
5007    if (objc != 0) {
5008      Tcl_WrongNumArgs(interp, 1, objv, "");
5009      return TCL_ERROR;
5010    }
5011
5012    eventPtr->stopPropagation = 1;
5013
5014    break;
5015
5016  case TCLDOM_EVENT_PREVENTDEFAULT:
5017
5018    if (clientData) {
5019      eventObj = (Tcl_Obj *) clientData;
5020      eventPtr = (TclDOMEvent *) eventObj->internalRep.otherValuePtr;
5021    } else {
5022      eventObj = objv[2];
5023      if (TclDOM_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
5024	return TCL_ERROR;
5025      }
5026    }
5027
5028    if (objc != 0) {
5029      Tcl_WrongNumArgs(interp, 2, objv, "");
5030      return TCL_ERROR;
5031    }
5032
5033    eventPtr->preventDefault = 1;
5034
5035    break;
5036
5037  case TCLDOM_EVENT_INITEVENT:
5038
5039    if (objc != 3) {
5040      Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable");
5041      return TCL_ERROR;
5042    }
5043
5044    if (clientData) {
5045      eventObj = (Tcl_Obj *) clientData;
5046      eventPtr = (TclDOMEvent *) eventObj->internalRep.otherValuePtr;
5047      argPtr = (Tcl_Obj **) &objv[2];
5048      objc -= 2;
5049    } else {
5050      eventObj = objv[2];
5051      if (TclDOM_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
5052	return TCL_ERROR;
5053      }
5054      argPtr = (Tcl_Obj **) &objv[3];
5055      objc -= 3;
5056    }
5057
5058    if (eventPtr->dispatched) {
5059      Tcl_SetResult(interp, "event has been dispatched", NULL);
5060      return TCL_ERROR;
5061    }
5062
5063    TclDOMInitEvent(eventPtr, argPtr[0], argPtr[1], argPtr[2]);
5064
5065    break;
5066
5067  case TCLDOM_EVENT_INITUIEVENT:
5068
5069    if (objc < 4 || objc > 5) {
5070      Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable view ?detail?");
5071      return TCL_ERROR;
5072    }
5073
5074    if (clientData) {
5075      eventObj = (Tcl_Obj *) clientData;
5076      eventPtr = (TclDOMEvent *) eventObj->internalRep.otherValuePtr;
5077      argPtr = (Tcl_Obj **) &objv[2];
5078      objc -= 2;
5079    } else {
5080      eventObj = objv[2];
5081      if (TclDOM_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
5082	return TCL_ERROR;
5083      }
5084      argPtr = (Tcl_Obj **) &objv[3];
5085      objc -= 3;
5086    }
5087
5088    if (eventPtr->dispatched) {
5089      Tcl_SetResult(interp, "event has been dispatched", NULL);
5090      return TCL_ERROR;
5091    }
5092
5093    TclDOMInitUIEvent(eventPtr, argPtr[0], argPtr[1], argPtr[2], argPtr[3], objc == 5 ? argPtr[4] : NULL);
5094
5095    break;
5096
5097  case TCLDOM_EVENT_INITMOUSEEVENT:
5098
5099    if (objc != 18) {
5100      Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable view detail screenX screenY clientX clientY ctrlKey altKey shiftKey metaKey button relatedNode");
5101      return TCL_ERROR;
5102    }
5103
5104    if (clientData) {
5105      eventObj = (Tcl_Obj *) clientData;
5106      eventPtr = (TclDOMEvent *) eventObj->internalRep.otherValuePtr;
5107      argPtr = (Tcl_Obj **) &objv[2];
5108      objc -= 2;
5109    } else {
5110      eventObj = objv[2];
5111      if (TclDOM_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
5112	return TCL_ERROR;
5113      }
5114      argPtr = (Tcl_Obj **) &objv[3];
5115      objc -= 3;
5116    }
5117
5118    if (eventPtr->dispatched) {
5119      Tcl_SetResult(interp, "event has been dispatched", NULL);
5120      return TCL_ERROR;
5121    }
5122
5123    TclDOMInitMouseEvent(eventPtr, argPtr[0], argPtr[1], argPtr[2], argPtr[3], argPtr[4], argPtr[5], argPtr[6], argPtr[7], argPtr[8], argPtr[9], argPtr[10], argPtr[11], argPtr[12], argPtr[13]);
5124
5125    break;
5126
5127  case TCLDOM_EVENT_INITMUTATIONEVENT:
5128
5129    if (objc != 10) {
5130      Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable relatedNode prevValue newValue attrName attrChange");
5131      return TCL_ERROR;
5132    }
5133
5134    if (clientData) {
5135      eventObj = (Tcl_Obj *) clientData;
5136      eventPtr = (TclDOMEvent *) eventObj->internalRep.otherValuePtr;
5137      argPtr = (Tcl_Obj **) &objv[2];
5138      objc -= 2;
5139    } else {
5140      eventObj = objv[2];
5141      if (TclDOM_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
5142	return TCL_ERROR;
5143      }
5144      argPtr = (Tcl_Obj **) &objv[3];
5145      objc -= 3;
5146    }
5147
5148    if (eventPtr->dispatched) {
5149      Tcl_SetResult(interp, "event has been dispatched", NULL);
5150      return TCL_ERROR;
5151    }
5152
5153    TclDOMInitMutationEvent(eventPtr, argPtr[0], argPtr[1], argPtr[2], argPtr[3], argPtr[4], argPtr[5], argPtr[6], argPtr[7]);
5154
5155    break;
5156
5157  case TCLDOM_EVENT_POSTUIEVENT:
5158
5159    if (objc < 4) {
5160      Tcl_WrongNumArgs(interp, 1, objv, "postUIEvent node type ?args ...?");
5161      return TCL_ERROR;
5162    }
5163
5164    if (TclDOM_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
5165      return TCL_ERROR;
5166    }
5167
5168    bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
5169    if (!bubblesPtr) {
5170      return TCL_ERROR;
5171    }
5172    Tcl_IncrRefCount(bubblesPtr);
5173    cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
5174    if (!cancelablePtr) {
5175      Tcl_DecrRefCount(bubblesPtr);
5176      return TCL_ERROR;
5177    }
5178    Tcl_IncrRefCount(cancelablePtr);
5179
5180    viewPtr = Tcl_NewObj();
5181    detailPtr = Tcl_NewObj();
5182
5183    objc -= 4;
5184    objv += 4;
5185    while (objc) {
5186
5187      if (objc == 1) {
5188	Tcl_SetResult(interp, "value missing", NULL);
5189        Tcl_DecrRefCount(bubblesPtr);
5190        Tcl_DecrRefCount(cancelablePtr);
5191        Tcl_DecrRefCount(viewPtr);
5192        Tcl_DecrRefCount(detailPtr);
5193	return TCL_ERROR;
5194      }
5195
5196      if (Tcl_GetIndexFromObj(interp, objv[0], EventCommandOptions,
5197			      "option", 0, &option) != TCL_OK) {
5198        Tcl_DecrRefCount(bubblesPtr);
5199        Tcl_DecrRefCount(cancelablePtr);
5200        Tcl_DecrRefCount(viewPtr);
5201        Tcl_DecrRefCount(detailPtr);
5202	return TCL_ERROR;
5203      }
5204      switch ((enum EventCommandOptions) option) {
5205      case TCLDOM_EVENT_BUBBLES:
5206	Tcl_DecrRefCount(bubblesPtr);
5207	bubblesPtr = objv[1];
5208	Tcl_IncrRefCount(bubblesPtr);
5209	break;
5210      case TCLDOM_EVENT_CANCELABLE:
5211	Tcl_DecrRefCount(cancelablePtr);
5212	cancelablePtr = objv[1];
5213	Tcl_IncrRefCount(cancelablePtr);
5214	break;
5215      case TCLDOM_EVENT_VIEW:
5216	Tcl_DecrRefCount(viewPtr);
5217	viewPtr = objv[1];
5218	Tcl_IncrRefCount(viewPtr);
5219	break;
5220      case TCLDOM_EVENT_DETAIL:
5221	Tcl_DecrRefCount(detailPtr);
5222	detailPtr = objv[1];
5223	Tcl_IncrRefCount(detailPtr);
5224	break;
5225      default:
5226	Tcl_SetResult(interp, "bad option", NULL);
5227        Tcl_DecrRefCount(bubblesPtr);
5228        Tcl_DecrRefCount(cancelablePtr);
5229        Tcl_DecrRefCount(viewPtr);
5230        Tcl_DecrRefCount(detailPtr);
5231	return TCL_ERROR;
5232      }
5233
5234      objc -= 2;
5235      objv += 2;
5236    }
5237
5238    if (TclDOM_PostUIEvent(interp, nodePtr->doc, objv[2], objv[3], bubblesPtr, cancelablePtr, viewPtr, detailPtr) != TCL_OK) {
5239      Tcl_DecrRefCount(bubblesPtr);
5240      Tcl_DecrRefCount(cancelablePtr);
5241      Tcl_DecrRefCount(viewPtr);
5242      Tcl_DecrRefCount(detailPtr);
5243      return TCL_ERROR;
5244    }
5245
5246    break;
5247
5248  case TCLDOM_EVENT_POSTMOUSEEVENT:
5249
5250    if (objc < 4) {
5251      Tcl_WrongNumArgs(interp, 1, objv, "postMouseEvent node type ?args ...?");
5252      return TCL_ERROR;
5253    }
5254
5255    if (TclDOM_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
5256      return TCL_ERROR;
5257    }
5258    nodeObj = objv[2];
5259    docPtr = nodePtr->doc;
5260
5261    bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
5262    if (!bubblesPtr) {
5263      return TCL_ERROR;
5264    }
5265    Tcl_IncrRefCount(bubblesPtr);
5266    cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
5267    if (!cancelablePtr) {
5268      Tcl_DecrRefCount(bubblesPtr);
5269      return TCL_ERROR;
5270    }
5271    Tcl_IncrRefCount(cancelablePtr);
5272
5273    viewPtr = Tcl_NewObj();
5274    detailPtr = Tcl_NewObj();
5275    relatedNodePtr = Tcl_NewObj();
5276    screenXPtr = Tcl_NewObj();
5277    screenYPtr = Tcl_NewObj();
5278    clientXPtr = Tcl_NewObj();
5279    clientYPtr = Tcl_NewObj();
5280    ctrlKeyPtr = Tcl_NewObj();
5281    shiftKeyPtr = Tcl_NewObj();
5282    metaKeyPtr = Tcl_NewObj();
5283    buttonPtr = Tcl_NewObj();
5284
5285    objc -= 4;
5286    objv += 4;
5287    while (objc) {
5288
5289      if (objc == 1) {
5290	Tcl_SetResult(interp, "value missing", NULL);
5291        goto mouse_error;
5292      }
5293
5294      if (Tcl_GetIndexFromObj(interp, objv[0], EventCommandOptions,
5295			      "option", 0, &option) != TCL_OK) {
5296        goto mouse_error;
5297      }
5298      switch ((enum EventCommandOptions) option) {
5299      case TCLDOM_EVENT_BUBBLES:
5300	Tcl_DecrRefCount(bubblesPtr);
5301	bubblesPtr = objv[1];
5302	Tcl_IncrRefCount(bubblesPtr);
5303	break;
5304      case TCLDOM_EVENT_CANCELABLE:
5305	Tcl_DecrRefCount(cancelablePtr);
5306	cancelablePtr = objv[1];
5307	Tcl_IncrRefCount(cancelablePtr);
5308	break;
5309      case TCLDOM_EVENT_RELATEDNODE:
5310	Tcl_DecrRefCount(relatedNodePtr);
5311	relatedNodePtr = objv[1];
5312	Tcl_IncrRefCount(relatedNodePtr);
5313	break;
5314      case TCLDOM_EVENT_VIEW:
5315	Tcl_DecrRefCount(viewPtr);
5316	viewPtr = objv[1];
5317	Tcl_IncrRefCount(viewPtr);
5318	break;
5319      case TCLDOM_EVENT_DETAIL:
5320	Tcl_DecrRefCount(detailPtr);
5321	detailPtr = objv[1];
5322	Tcl_IncrRefCount(detailPtr);
5323	break;
5324      case TCLDOM_EVENT_SCREENX:
5325	Tcl_DecrRefCount(screenXPtr);
5326	screenXPtr = objv[1];
5327	Tcl_IncrRefCount(screenXPtr);
5328	break;
5329      case TCLDOM_EVENT_SCREENY:
5330	Tcl_DecrRefCount(screenYPtr);
5331	screenYPtr = objv[1];
5332	Tcl_IncrRefCount(screenYPtr);
5333	break;
5334      case TCLDOM_EVENT_CLIENTX:
5335	Tcl_DecrRefCount(clientXPtr);
5336	clientXPtr = objv[1];
5337	Tcl_IncrRefCount(clientXPtr);
5338	break;
5339      case TCLDOM_EVENT_CLIENTY:
5340	Tcl_DecrRefCount(clientYPtr);
5341	clientYPtr = objv[1];
5342	Tcl_IncrRefCount(clientYPtr);
5343	break;
5344      case TCLDOM_EVENT_CTRLKEY:
5345	Tcl_DecrRefCount(ctrlKeyPtr);
5346	ctrlKeyPtr = objv[1];
5347	Tcl_IncrRefCount(ctrlKeyPtr);
5348	break;
5349      case TCLDOM_EVENT_SHIFTKEY:
5350	Tcl_DecrRefCount(shiftKeyPtr);
5351	shiftKeyPtr = objv[1];
5352	Tcl_IncrRefCount(shiftKeyPtr);
5353	break;
5354      case TCLDOM_EVENT_METAKEY:
5355	Tcl_DecrRefCount(metaKeyPtr);
5356	metaKeyPtr = objv[1];
5357	Tcl_IncrRefCount(metaKeyPtr);
5358	break;
5359      case TCLDOM_EVENT_BUTTON:
5360	Tcl_DecrRefCount(buttonPtr);
5361	buttonPtr = objv[1];
5362	Tcl_IncrRefCount(buttonPtr);
5363	break;
5364      default:
5365	Tcl_SetResult(interp, "bad option", NULL);
5366	goto mouse_error;
5367      }
5368
5369      objc -= 2;
5370      objv += 2;
5371    }
5372
5373    if (TclDOM_PostMouseEvent(interp, nodePtr->doc, objv[2], objv[3], bubblesPtr, cancelablePtr, relatedNodePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr) != TCL_OK) {
5374      goto mouse_error;
5375    }
5376
5377    break;
5378
5379mouse_error:
5380    Tcl_DecrRefCount(bubblesPtr);
5381    Tcl_DecrRefCount(cancelablePtr);
5382    Tcl_DecrRefCount(viewPtr);
5383    Tcl_DecrRefCount(detailPtr);
5384    Tcl_DecrRefCount(relatedNodePtr);
5385    Tcl_DecrRefCount(screenXPtr);
5386    Tcl_DecrRefCount(screenYPtr);
5387    Tcl_DecrRefCount(clientXPtr);
5388    Tcl_DecrRefCount(clientYPtr);
5389    Tcl_DecrRefCount(ctrlKeyPtr);
5390    Tcl_DecrRefCount(shiftKeyPtr);
5391    Tcl_DecrRefCount(metaKeyPtr);
5392    Tcl_DecrRefCount(buttonPtr);
5393
5394    return TCL_ERROR;
5395
5396  case TCLDOM_EVENT_POSTMUTATIONEVENT:
5397
5398    if (objc < 4) {
5399      Tcl_WrongNumArgs(interp, 1, objv, "postMutationEvent node type ?args ...?");
5400      return TCL_ERROR;
5401    }
5402
5403    if (TclDOM_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
5404      return TCL_ERROR;
5405    }
5406    nodeObj = objv[2];
5407    docPtr = nodePtr->doc;
5408
5409    bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
5410    if (!bubblesPtr) {
5411      return TCL_ERROR;
5412    }
5413    Tcl_IncrRefCount(bubblesPtr);
5414    cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
5415    if (!cancelablePtr) {
5416      Tcl_DecrRefCount(bubblesPtr);
5417      return TCL_ERROR;
5418    }
5419    Tcl_IncrRefCount(cancelablePtr);
5420
5421    relatedNodePtr = Tcl_NewObj();
5422    prevValuePtr = Tcl_NewObj();
5423    newValuePtr = Tcl_NewObj();
5424    attrNamePtr = Tcl_NewObj();
5425    attrChangePtr = Tcl_NewObj();
5426
5427    objc -= 4;
5428    objv += 4;
5429    while (objc) {
5430
5431      if (objc == 1) {
5432	Tcl_SetResult(interp, "value missing", NULL);
5433        goto mutation_error;
5434      }
5435
5436      if (Tcl_GetIndexFromObj(interp, objv[0], EventCommandOptions,
5437			      "option", 0, &option) != TCL_OK) {
5438        goto mutation_error;
5439      }
5440      switch ((enum EventCommandOptions) option) {
5441      case TCLDOM_EVENT_BUBBLES:
5442	Tcl_DecrRefCount(bubblesPtr);
5443	bubblesPtr = objv[1];
5444	Tcl_IncrRefCount(bubblesPtr);
5445	break;
5446      case TCLDOM_EVENT_CANCELABLE:
5447	Tcl_DecrRefCount(cancelablePtr);
5448	cancelablePtr = objv[1];
5449	Tcl_IncrRefCount(cancelablePtr);
5450	break;
5451      case TCLDOM_EVENT_RELATEDNODE:
5452	Tcl_DecrRefCount(relatedNodePtr);
5453	relatedNodePtr = objv[1];
5454	Tcl_IncrRefCount(relatedNodePtr);
5455	break;
5456      case TCLDOM_EVENT_PREVVALUE:
5457	Tcl_DecrRefCount(prevValuePtr);
5458	prevValuePtr = objv[1];
5459	Tcl_IncrRefCount(prevValuePtr);
5460	break;
5461      case TCLDOM_EVENT_NEWVALUE:
5462	Tcl_DecrRefCount(newValuePtr);
5463	newValuePtr = objv[1];
5464	Tcl_IncrRefCount(newValuePtr);
5465	break;
5466      case TCLDOM_EVENT_ATTRNAME:
5467	Tcl_DecrRefCount(attrNamePtr);
5468	attrNamePtr = objv[1];
5469	Tcl_IncrRefCount(attrNamePtr);
5470	break;
5471      case TCLDOM_EVENT_ATTRCHANGE:
5472	Tcl_DecrRefCount(attrChangePtr);
5473	attrChangePtr = objv[1];
5474	Tcl_IncrRefCount(attrChangePtr);
5475	break;
5476      default:
5477	Tcl_SetResult(interp, "bad option", NULL);
5478        goto mutation_error;
5479      }
5480
5481      objc -= 2;
5482      objv += 2;
5483    }
5484
5485    if (TclDOM_PostMutationEvent(interp, nodePtr->doc, objv[2], objv[3], bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr) != TCL_OK) {
5486      goto mutation_error;
5487    }
5488
5489    break;
5490
5491mutation_error:
5492    Tcl_DecrRefCount(bubblesPtr);
5493    Tcl_DecrRefCount(cancelablePtr);
5494    Tcl_DecrRefCount(relatedNodePtr);
5495    Tcl_DecrRefCount(prevValuePtr);
5496    Tcl_DecrRefCount(newValuePtr);
5497    Tcl_DecrRefCount(attrNamePtr);
5498    Tcl_DecrRefCount(attrChangePtr);
5499
5500    return TCL_ERROR;
5501
5502  default:
5503
5504    Tcl_SetResult(interp, "unknown method", NULL);
5505    return TCL_ERROR;
5506
5507  }
5508
5509  return TCL_OK;
5510}
5511
5512/*
5513 *----------------------------------------------------------------------------
5514 *
5515 * TclDOMNewEvent --
5516 *
5517 *  Create a Tcl_Obj for an event.
5518 *
5519 * Results:
5520 *  Returns Tcl_Obj*.
5521 *
5522 * Side effects:
5523 *  Allocates object.
5524 *
5525 *----------------------------------------------------------------------------
5526 */
5527
5528Tcl_Obj *
5529TclDOMNewEvent (interp, doc, type)
5530     Tcl_Interp *interp;
5531     xmlDocPtr doc;
5532     Tcl_Obj *type;
5533{
5534  Tcl_Obj *newPtr;
5535  TclDOMEvent *eventPtr;
5536  TclDOMDocument *tcldomDoc;
5537  Tcl_Time time;
5538  Tcl_HashEntry *entry;
5539  int inew;
5540
5541  entry = Tcl_FindHashEntry(&docByPtr, (char *) doc);
5542  if (!entry) {
5543    return NULL;
5544  }
5545  tcldomDoc = (TclDOMDocument *) Tcl_GetHashValue(entry);
5546
5547  eventPtr = (TclDOMEvent *) Tcl_Alloc(sizeof(TclDOMEvent));
5548  eventPtr->interp = interp;
5549  eventPtr->cmdname = Tcl_Alloc(30);
5550  sprintf(eventPtr->cmdname, "%s.event%d", tcldomDoc->token, tcldomDoc->eventCntr++);
5551  eventPtr->ownerDocument = tcldomDoc;
5552
5553  newPtr = Tcl_NewObj();
5554  newPtr->bytes = Tcl_Alloc(30);
5555  strcpy(newPtr->bytes, eventPtr->cmdname);
5556  newPtr->length = strlen(newPtr->bytes);
5557
5558  eventPtr->objPtr = newPtr;
5559
5560  entry = Tcl_CreateHashEntry(tcldomDoc->events, newPtr->bytes, &inew);
5561  Tcl_SetHashValue(entry, (void *) eventPtr);
5562  Tcl_IncrRefCount(newPtr);
5563
5564  eventPtr->stopPropagation = 0;
5565  eventPtr->preventDefault = 0;
5566  eventPtr->dispatched = 0;
5567
5568  eventPtr->altKey = Tcl_NewObj();
5569  Tcl_IncrRefCount(eventPtr->altKey);
5570  eventPtr->attrName = Tcl_NewObj();
5571  Tcl_IncrRefCount(eventPtr->attrName);
5572  eventPtr->attrChange = Tcl_NewObj();
5573  Tcl_IncrRefCount(eventPtr->attrChange);
5574  eventPtr->bubbles = Tcl_NewIntObj(1);
5575  Tcl_IncrRefCount(eventPtr->bubbles);
5576  eventPtr->button = Tcl_NewObj();
5577  Tcl_IncrRefCount(eventPtr->button);
5578  eventPtr->cancelable = Tcl_NewIntObj(1);
5579  Tcl_IncrRefCount(eventPtr->cancelable);
5580  eventPtr->clientX = Tcl_NewObj();
5581  Tcl_IncrRefCount(eventPtr->clientX);
5582  eventPtr->clientY = Tcl_NewObj();
5583  Tcl_IncrRefCount(eventPtr->clientY);
5584  eventPtr->ctrlKey = Tcl_NewObj();
5585  Tcl_IncrRefCount(eventPtr->ctrlKey);
5586  eventPtr->currentNode = Tcl_NewObj();
5587  Tcl_IncrRefCount(eventPtr->currentNode);
5588  eventPtr->detail = Tcl_NewObj();
5589  Tcl_IncrRefCount(eventPtr->detail);
5590  eventPtr->eventPhase = Tcl_NewObj();
5591  Tcl_IncrRefCount(eventPtr->eventPhase);
5592  eventPtr->metaKey = Tcl_NewObj();
5593  Tcl_IncrRefCount(eventPtr->metaKey);
5594  eventPtr->newValue = Tcl_NewObj();
5595  Tcl_IncrRefCount(eventPtr->newValue);
5596  eventPtr->prevValue = Tcl_NewObj();
5597  Tcl_IncrRefCount(eventPtr->prevValue);
5598  eventPtr->relatedNode = Tcl_NewObj();
5599  Tcl_IncrRefCount(eventPtr->relatedNode);
5600  eventPtr->screenX = Tcl_NewObj();
5601  Tcl_IncrRefCount(eventPtr->screenX);
5602  eventPtr->screenY = Tcl_NewObj();
5603  Tcl_IncrRefCount(eventPtr->screenY);
5604  eventPtr->shiftKey = Tcl_NewObj();
5605  Tcl_IncrRefCount(eventPtr->shiftKey);
5606  eventPtr->target = Tcl_NewObj();
5607  Tcl_IncrRefCount(eventPtr->target);
5608
5609  /* Timestamping of DOM events is not available in Tcl 8.3.x.
5610   * The required API (Tcl_GetTime) is public only since 8.4.0.
5611   */
5612
5613#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION > 3))
5614  Tcl_GetTime(&time);
5615  eventPtr->timeStamp = Tcl_NewLongObj(time.sec*1000 + time.usec/1000);
5616#else
5617  eventPtr->timeStamp = Tcl_NewLongObj (0);
5618#endif
5619  Tcl_IncrRefCount(eventPtr->timeStamp);
5620
5621  eventPtr->type = type;
5622  Tcl_IncrRefCount(eventPtr->type);
5623  eventPtr->view = Tcl_NewObj();
5624  Tcl_IncrRefCount(eventPtr->view);
5625
5626  newPtr->internalRep.otherValuePtr = (VOID *) eventPtr;
5627  newPtr->typePtr = &TclDOM_EventObjType;
5628
5629  eventPtr->cmd = Tcl_CreateObjCommand(interp, newPtr->bytes, TclDOMEventCommand, (ClientData) eventPtr, TclDOMDeleteEvent);
5630
5631  return newPtr;
5632}
5633
5634/*
5635 *----------------------------------------------------------------------------
5636 *
5637 * TclDOMInitDoc --
5638 *
5639 *  Initialise a TclDOMDocument structure.
5640 *
5641 * Results:
5642 *  Structure is initialised for use.
5643 *
5644 * Side effects:
5645 *  Allocates memory.
5646 *
5647 *----------------------------------------------------------------------------
5648 */
5649
5650void
5651TclDOMInitDoc (tcldomDoc)
5652  TclDOMDocument *tcldomDoc;
5653{
5654    Tcl_HashEntry *entry;
5655    int new;
5656
5657    tcldomDoc->token = Tcl_Alloc(20);
5658    sprintf(tcldomDoc->token, "doc%d", docCntr++);
5659    tcldomDoc->docPtr = NULL;
5660
5661    tcldomDoc->nodes = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
5662    Tcl_InitHashTable(tcldomDoc->nodes, TCL_STRING_KEYS);
5663    tcldomDoc->nodeCntr = 0;
5664    tcldomDoc->events = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
5665    Tcl_InitHashTable(tcldomDoc->events, TCL_STRING_KEYS);
5666    tcldomDoc->eventCntr = 0;
5667    for (new = 0; new < NUM_EVENT_TYPES; new++) {
5668      tcldomDoc->listening[new] = 0;
5669    }
5670
5671    entry = Tcl_CreateHashEntry(&documents, tcldomDoc->token, &new);
5672    Tcl_SetHashValue(entry, tcldomDoc);
5673
5674}
5675
5676/*
5677 *----------------------------------------------------------------------------
5678 *
5679 * TclDOM_CreateObjFromDoc --
5680 *
5681 *  Create a Tcl_Obj to wrap a document.
5682 *
5683 * Results:
5684 *  Returns Tcl_Obj*.
5685 *
5686 * Side effects:
5687 *  Allocates object.
5688 *
5689 *----------------------------------------------------------------------------
5690 */
5691
5692Tcl_Obj *
5693TclDOM_CreateObjFromDoc (docPtr)
5694  xmlDocPtr docPtr;
5695{
5696  Tcl_HashEntry *entry;
5697  int new;
5698
5699  /*
5700   * This document may have already been wrapped by a Tcl_Object.
5701   */
5702
5703  if (docPtr->_private) {
5704    Tcl_IncrRefCount((Tcl_Obj *) docPtr->_private);
5705    return (Tcl_Obj *) docPtr->_private;
5706  } else {
5707    TclDOMDocument *tcldomDoc;
5708    Tcl_Obj *objPtr;
5709
5710    tcldomDoc = (TclDOMDocument *) Tcl_Alloc(sizeof(TclDOMDocument));
5711    TclDOMInitDoc(tcldomDoc);
5712    tcldomDoc->docPtr = docPtr;
5713    entry = Tcl_CreateHashEntry(&docByPtr, (char *) docPtr, &new);
5714    Tcl_SetHashValue(entry, tcldomDoc);
5715
5716    objPtr = Tcl_NewObj();
5717    Tcl_IncrRefCount(objPtr);
5718    objPtr->internalRep.otherValuePtr = (VOID *) tcldomDoc;
5719    objPtr->typePtr = &TclDOM_DocObjType;
5720    objPtr->bytes = Tcl_Alloc(20);
5721    strcpy(objPtr->bytes, tcldomDoc->token);
5722    objPtr->length = strlen(tcldomDoc->token);
5723
5724    docPtr->_private = (void *) objPtr;
5725
5726    return objPtr;
5727  }
5728}
5729
5730/*
5731 *----------------------------------------------------------------------------
5732 *
5733 * TclDOM_CreateObjFromNode --
5734 *
5735 *  Create a Tcl_Obj to wrap a tree node.
5736 *
5737 *  NB. We could get alot fancier in generating a
5738 *  string rep, eg. to allow mapping from a string
5739 *  rep back to an xmlNodePtr.  However, this will
5740 *  use alot more memory since there may be many
5741 *  nodes.  So, the application will have to
5742 *  keep hold of the internal rep.
5743 *
5744 * Results:
5745 *  Returns Tcl_Obj*.
5746 *
5747 * Side effects:
5748 *  Allocates object.
5749 *
5750 *----------------------------------------------------------------------------
5751 */
5752
5753Tcl_Obj *
5754TclDOM_CreateObjFromNode (nodePtr)
5755  xmlNodePtr nodePtr;
5756{
5757  if (nodePtr->_private) {
5758    Tcl_IncrRefCount((Tcl_Obj *) nodePtr->_private);
5759    return (Tcl_Obj *) nodePtr->_private;
5760  } else {
5761    TclDOMDocument *tcldomDoc;
5762    Tcl_Obj *objPtr;
5763    Tcl_HashEntry *entry;
5764    int new;
5765
5766    entry = Tcl_FindHashEntry(&docByPtr, (char *) nodePtr->doc);
5767    if (!entry) {
5768      return NULL;
5769    }
5770    tcldomDoc = (TclDOMDocument *) Tcl_GetHashValue(entry);
5771
5772    objPtr = Tcl_NewObj();
5773    Tcl_IncrRefCount(objPtr);
5774    objPtr->internalRep.otherValuePtr = (VOID *) nodePtr;
5775    objPtr->typePtr = &TclDOM_NodeObjType;
5776
5777    objPtr->bytes = Tcl_Alloc(30);
5778    sprintf(objPtr->bytes, "%s.node%d", tcldomDoc->token, tcldomDoc->nodeCntr++);
5779    objPtr->length = strlen(objPtr->bytes);
5780
5781    nodePtr->_private = (void *) objPtr;
5782
5783    entry = Tcl_CreateHashEntry(tcldomDoc->nodes, objPtr->bytes, &new);
5784    if (!new) {
5785      /* internal error: this should never occur */
5786      return NULL;
5787    }
5788    Tcl_SetHashValue(entry, (void *) nodePtr);
5789
5790    return objPtr;
5791  }
5792}
5793
5794/*
5795 *	Manage TclDOM objects
5796 */
5797
5798/*
5799 *----------------------------------------------------------------------------
5800 *
5801 * TclDOM_GetDocFromObj --
5802 *
5803 *  Gets an xmlDocPtr from a Tcl_Obj.
5804 *
5805 * Results:
5806 *  Returns success code.
5807 *
5808 * Side effects:
5809 *  None.
5810 *
5811 *----------------------------------------------------------------------------
5812 */
5813
5814int
5815TclDOM_GetDocFromObj (interp, objPtr, docPtr)
5816     Tcl_Interp *interp;
5817     Tcl_Obj *objPtr;
5818     xmlDocPtr *docPtr;
5819{
5820  TclDOMDocument *tcldomDoc;
5821
5822  if (objPtr->typePtr == &TclDOM_DocObjType) {
5823    tcldomDoc = (TclDOMDocument *) objPtr->internalRep.otherValuePtr;
5824    *docPtr = tcldomDoc->docPtr;
5825  } else if (TclDOM_DocSetFromAny(interp, objPtr) == TCL_OK) {
5826    tcldomDoc = (TclDOMDocument *) objPtr->internalRep.otherValuePtr;
5827    *docPtr = tcldomDoc->docPtr;
5828  } else {
5829    return TCL_ERROR;
5830  }
5831
5832  return TCL_OK;
5833}
5834
5835/*
5836 *----------------------------------------------------------------------------
5837 *
5838 * TclDOM_GetDoc2FromObj --
5839 *
5840 *  Gets a TclDOMDocument from a Tcl_Obj.
5841 *
5842 * Results:
5843 *  Returns success code.
5844 *
5845 * Side effects:
5846 *  None.
5847 *
5848 *----------------------------------------------------------------------------
5849 */
5850
5851int
5852TclDOM_GetDoc2FromObj (interp, objPtr, docPtr)
5853     Tcl_Interp *interp;
5854     Tcl_Obj *objPtr;
5855     TclDOMDocument **docPtr;
5856{
5857
5858  if (objPtr->typePtr == &TclDOM_DocObjType) {
5859    *docPtr = (TclDOMDocument *) objPtr->internalRep.otherValuePtr;
5860  } else if (TclDOM_DocSetFromAny(interp, objPtr) == TCL_OK) {
5861    *docPtr = (TclDOMDocument *) objPtr->internalRep.otherValuePtr;
5862  } else {
5863    return TCL_ERROR;
5864  }
5865
5866  return TCL_OK;
5867}
5868
5869/*
5870 *----------------------------------------------------------------------------
5871 *
5872 * TclDOM_GetNodeFromObj --
5873 *
5874 *  Gets an xmlNodePtr from a Tcl_Obj.
5875 *
5876 * Results:
5877 *  Returns success code.
5878 *
5879 * Side effects:
5880 *  None.
5881 *
5882 *----------------------------------------------------------------------------
5883 */
5884
5885int
5886TclDOM_GetNodeFromObj (interp, objPtr, nodePtr)
5887     Tcl_Interp *interp;
5888     Tcl_Obj *objPtr;
5889     xmlNodePtr *nodePtr;
5890{
5891
5892  if (objPtr->typePtr == &TclDOM_NodeObjType) {
5893     *nodePtr = objPtr->internalRep.otherValuePtr;
5894  } else if (TclDOM_NodeSetFromAny(interp, objPtr) == TCL_OK) {
5895    *nodePtr = objPtr->internalRep.otherValuePtr;
5896  } else {
5897    return TCL_ERROR;
5898  }
5899
5900  return TCL_OK;
5901}
5902
5903/*
5904 *----------------------------------------------------------------------------
5905 *
5906 * TclDOM_NewDoc --
5907 *
5908 *  Creates a new xmlDocPtr and wraps it in a Tcl_Obj.
5909 *
5910 * Results:
5911 *  Returns a *TclObj
5912 *
5913 * Side effects:
5914 *  Objects allocated.
5915 *
5916 *----------------------------------------------------------------------------
5917 */
5918
5919Tcl_Obj *
5920TclDOM_NewDoc(interp)
5921     Tcl_Interp *interp;
5922{
5923  xmlDocPtr new;
5924
5925  new = xmlNewDoc("1.0");
5926  if (!new) {
5927    Tcl_SetResult(interp, "unable to create document", NULL);
5928    return NULL;
5929  }
5930
5931  return TclDOM_CreateObjFromDoc(new);
5932}
5933
5934int
5935TclDOM_DocSetFromAny(interp, objPtr)
5936     Tcl_Interp *interp;
5937     Tcl_Obj *objPtr;
5938{
5939  Tcl_HashEntry *entryPtr;
5940
5941  entryPtr = Tcl_FindHashEntry(&documents, Tcl_GetStringFromObj(objPtr, NULL));
5942
5943  if (entryPtr) {
5944
5945    if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
5946      objPtr->typePtr->freeIntRepProc(objPtr);
5947    }
5948
5949    objPtr->internalRep.otherValuePtr = Tcl_GetHashValue(entryPtr);
5950    objPtr->typePtr = &TclDOM_DocObjType;
5951
5952  } else {
5953    char fmt[] = "token \"%s\" is not a DOM Document";
5954    char *result, *string;
5955    int len;
5956
5957    string = Tcl_GetStringFromObj(objPtr, &len);
5958    result = Tcl_Alloc(len + strlen(fmt) + 1);
5959    sprintf(result, fmt, string);
5960    Tcl_ResetResult(interp);
5961    Tcl_AppendToObj(Tcl_GetObjResult(interp), result, -1);
5962
5963    Tcl_Free (result);
5964
5965    return TCL_ERROR;
5966  }
5967
5968  return TCL_OK;
5969}
5970
5971void
5972TclDOM_DocUpdate(objPtr)
5973     Tcl_Obj *objPtr;
5974{
5975  Tcl_HashEntry *entryPtr;
5976  Tcl_HashSearch search;
5977
5978  entryPtr = Tcl_FirstHashEntry(&documents, &search);
5979  while (entryPtr && objPtr->internalRep.otherValuePtr != Tcl_GetHashValue(entryPtr)) {
5980    entryPtr = Tcl_NextHashEntry(&search);
5981  }
5982  Tcl_InvalidateStringRep(objPtr);
5983  if (entryPtr == NULL) {
5984    objPtr->bytes = NULL;
5985    objPtr->length = 0;
5986  } else {
5987    objPtr->length = strlen(Tcl_GetHashKey(&documents, entryPtr));
5988    objPtr->bytes = Tcl_Alloc(objPtr->length + 1);
5989    strcpy(objPtr->bytes, Tcl_GetHashKey(&documents, entryPtr));
5990  }
5991}
5992
5993void
5994TclDOM_DocDup(srcPtr, dstPtr)
5995     Tcl_Obj *srcPtr;
5996     Tcl_Obj *dstPtr;
5997{
5998  TclDOMDocument *srcTcldomDoc, *dstTcldomDoc;
5999  xmlDocPtr dstDoc;
6000  Tcl_HashEntry *entry;
6001  int new;
6002
6003  srcTcldomDoc = (TclDOMDocument *) srcPtr->internalRep.otherValuePtr;
6004
6005  dstDoc = xmlCopyDoc(srcTcldomDoc->docPtr, 1);
6006  if (dstDoc == NULL) {
6007    return;
6008  }
6009
6010  /*
6011   * xmlCopyDoc doesn't copy some of the fields.
6012   */
6013
6014  if (srcTcldomDoc->docPtr->URL) {
6015    dstDoc->URL = Tcl_Alloc(strlen(srcTcldomDoc->docPtr->URL) + 1);
6016    strcpy((char *) dstDoc->URL, srcTcldomDoc->docPtr->URL);
6017  }
6018
6019  Tcl_InvalidateStringRep(dstPtr);
6020
6021  dstTcldomDoc = (TclDOMDocument *) Tcl_Alloc(sizeof(TclDOMDocument));
6022  TclDOMInitDoc(dstTcldomDoc);
6023  dstTcldomDoc->docPtr = dstDoc;
6024  entry = Tcl_CreateHashEntry(&docByPtr, (char *) dstDoc, &new);
6025  Tcl_SetHashValue(entry, dstTcldomDoc);
6026  dstPtr->typePtr = &TclDOM_DocObjType;
6027  dstPtr->internalRep.otherValuePtr = (ClientData) dstTcldomDoc;
6028  dstPtr->bytes = Tcl_Alloc(20);
6029  strcpy(dstPtr->bytes, dstTcldomDoc->token);
6030  dstPtr->length = strlen(dstTcldomDoc->token);
6031  dstDoc->_private = (void *) dstPtr;
6032}
6033
6034void
6035TclDOM_DocFree(objPtr)
6036     Tcl_Obj *objPtr;
6037{
6038  /* Nothing to do */
6039}
6040
6041int
6042TclDOM_NodeSetFromAny(interp, objPtr)
6043     Tcl_Interp *interp;
6044     Tcl_Obj *objPtr;
6045{
6046  TclDOMDocument *tcldomDoc;
6047  Tcl_HashEntry *entry;
6048  char *id, doc[21], node[21];
6049  int i, idlen, len;
6050
6051  /* Parse string rep for doc and node ids */
6052  id = Tcl_GetStringFromObj(objPtr, &idlen);
6053  for (i = 0; i < idlen && id[i] != '.' && i < 20; i++) {
6054    if (!((id[i] >= 'a' && id[i] <= 'z') || (id[i] >= '0' && id[i] <= '9'))) {
6055        /* only lowercase chars and digits are found in a token */
6056        Tcl_Obj *tmpPtr = Tcl_NewStringObj("malformed node token \"", -1);
6057        Tcl_AppendObjToObj(tmpPtr, objPtr);
6058        Tcl_AppendStringsToObj(tmpPtr, "\"", NULL);
6059        Tcl_SetObjResult(interp, tmpPtr);
6060        return TCL_ERROR;
6061    }
6062    doc[i] = id[i];
6063  }
6064  if (i == idlen || id[i] != '.') {
6065    Tcl_Obj *tmpPtr = Tcl_NewStringObj("malformed node token \"", -1);
6066    Tcl_AppendObjToObj(tmpPtr, objPtr);
6067    Tcl_AppendStringsToObj(tmpPtr, "\"", NULL);
6068    Tcl_SetObjResult(interp, tmpPtr);
6069    return TCL_ERROR;
6070  }
6071  doc[i] = '\0';
6072  for (len = i + 1, i = 0; i + len < idlen && i < 20; i++) {
6073    node[i] = id[len + i];
6074  }
6075  node[i] = '\0';
6076
6077  entry = Tcl_FindHashEntry(&documents, doc);
6078  if (!entry) {
6079    Tcl_SetResult(interp, "invalid node token", NULL);
6080    return TCL_ERROR;
6081  }
6082  tcldomDoc = (TclDOMDocument *) Tcl_GetHashValue(entry);
6083
6084/*
6085  sprintf(dbgbuf, "Looking for node \"%s\"\nDocument node table contains:\n", id);
6086  Tcl_WriteChars(stderrChan, dbgbuf, -1);
6087  {
6088    Tcl_HashSearch search;
6089
6090    entry = Tcl_FirstHashEntry(tcldomDoc->nodes, &search);
6091    while (entry) {
6092      xmlNodePtr tmp;
6093
6094      tmp = (xmlNodePtr) Tcl_GetHashValue(entry);
6095      sprintf(dbgbuf, "node \"%s\", name \"%s\"\n", Tcl_GetHashKey(tcldomDoc->nodes, entry), tmp->name);
6096      Tcl_WriteChars(stderrChan, dbgbuf, -1);
6097
6098      entry = Tcl_NextHashEntry(&search);
6099    }
6100  }
6101*/
6102
6103  entry = Tcl_FindHashEntry(tcldomDoc->nodes, id);
6104  if (entry) {
6105
6106    if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
6107      objPtr->typePtr->freeIntRepProc(objPtr);
6108    }
6109
6110    objPtr->internalRep.otherValuePtr = Tcl_GetHashValue(entry);
6111    objPtr->typePtr = &TclDOM_NodeObjType;
6112
6113    return TCL_OK;
6114
6115  } else {
6116    Tcl_SetResult(interp, "not a DOM node", NULL);
6117    return TCL_ERROR;
6118  }
6119}
6120
6121void
6122TclDOM_NodeUpdate(objPtr)
6123     Tcl_Obj *objPtr;
6124{
6125  xmlNodePtr nodePtr = (xmlNodePtr) objPtr->internalRep.otherValuePtr;
6126  TclDOMDocument *tcldomDoc;
6127  Tcl_HashEntry *entry;
6128  Tcl_HashSearch search;
6129
6130  entry = Tcl_FindHashEntry(&docByPtr, (char *) nodePtr->doc);
6131  if (entry) {
6132    tcldomDoc = (TclDOMDocument *) Tcl_GetHashValue(entry);
6133    entry = Tcl_FirstHashEntry(tcldomDoc->nodes, &search);
6134    while (entry && objPtr->internalRep.otherValuePtr != Tcl_GetHashValue(entry)) {
6135      entry = Tcl_NextHashEntry(&search);
6136    }
6137    Tcl_InvalidateStringRep(objPtr);
6138    if (entry == NULL) {
6139      objPtr->bytes = NULL;
6140      objPtr->length = 0;
6141    } else {
6142      objPtr->length = strlen(Tcl_GetHashKey(tcldomDoc->nodes, entry));
6143      objPtr->bytes = Tcl_Alloc(objPtr->length + 1);
6144      strcpy(objPtr->bytes, Tcl_GetHashKey(tcldomDoc->nodes, entry));
6145    }
6146  }
6147}
6148
6149/* This operation is not supported */
6150void
6151TclDOM_NodeDup(srcPtr, dstPtr)
6152     Tcl_Obj *srcPtr;
6153     Tcl_Obj *dstPtr;
6154{
6155  Tcl_InvalidateStringRep(dstPtr);
6156}
6157
6158void
6159TclDOM_NodeFree(objPtr)
6160     Tcl_Obj *objPtr;
6161{
6162  /* TclDOMForgetNode((xmlNodePtr) objPtr->internalRep.otherValuePtr, objPtr); */
6163}
6164
6165int
6166TclDOM_EventSetFromAny(interp, objPtr)
6167     Tcl_Interp *interp;
6168     Tcl_Obj *objPtr;
6169{
6170  TclDOMDocument *tcldomDoc;
6171  Tcl_HashEntry *entry;
6172  char *id, doc[20], event[20];
6173  int i, idlen, len;
6174
6175  /* Parse string rep for doc and event ids */
6176  id = Tcl_GetStringFromObj(objPtr, &idlen);
6177  for (i = 0; i < idlen && id[i] != '.'; i++) {
6178    doc[i] = id[i];
6179  }
6180  if (i == idlen || id[i] != '.') {
6181    Tcl_SetResult(interp, "malformed event token", NULL);
6182    return TCL_ERROR;
6183  }
6184  doc[i] = '\0';
6185  for (len = i + 1, i = 0; i + len < idlen; i++) {
6186    event[i] = id[len + i];
6187  }
6188  event[i] = '\0';
6189
6190  entry = Tcl_FindHashEntry(&documents, doc);
6191  if (!entry) {
6192    Tcl_SetResult(interp, "invalid event token", NULL);
6193    return TCL_ERROR;
6194  }
6195  tcldomDoc = (TclDOMDocument *) Tcl_GetHashValue(entry);
6196
6197  entry = Tcl_FindHashEntry(tcldomDoc->events, id);
6198  if (entry) {
6199
6200    if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
6201      objPtr->typePtr->freeIntRepProc(objPtr);
6202    }
6203
6204    objPtr->internalRep.otherValuePtr = Tcl_GetHashValue(entry);
6205    objPtr->typePtr = &TclDOM_EventObjType;
6206  } else {
6207    Tcl_SetResult(interp, "unable to find event", NULL);
6208    return TCL_ERROR;
6209  }
6210
6211  return TCL_OK;
6212}
6213
6214void
6215TclDOM_EventUpdate(objPtr)
6216     Tcl_Obj *objPtr;
6217{
6218  TclDOMEvent *event = (TclDOMEvent *) objPtr->internalRep.otherValuePtr;
6219  TclDOMDocument *tcldomDoc = event->ownerDocument;
6220  Tcl_HashEntry *entry;
6221  Tcl_HashSearch search;
6222
6223  entry = Tcl_FirstHashEntry(tcldomDoc->events, &search);
6224  while (entry && objPtr->internalRep.otherValuePtr != Tcl_GetHashValue(entry)) {
6225    entry = Tcl_NextHashEntry(&search);
6226  }
6227  Tcl_InvalidateStringRep(objPtr);
6228  if (entry == NULL) {
6229    objPtr->bytes = NULL;
6230    objPtr->length = 0;
6231  } else {
6232    objPtr->length = strlen(Tcl_GetHashKey(tcldomDoc->events, entry));
6233    objPtr->bytes = Tcl_Alloc(objPtr->length + 1);
6234    strcpy(objPtr->bytes, Tcl_GetHashKey(tcldomDoc->events, entry));
6235  }
6236}
6237
6238/* This operation is not supported */
6239void
6240TclDOM_EventDup(srcPtr, dstPtr)
6241     Tcl_Obj *srcPtr;
6242     Tcl_Obj *dstPtr;
6243{
6244  Tcl_InvalidateStringRep(dstPtr);
6245}
6246
6247/* This operation does nothing - app should use dom::event interface */
6248void
6249TclDOM_EventFree(objPtr)
6250     Tcl_Obj *objPtr;
6251{
6252    TclDOMEvent *event = (TclDOMEvent *) objPtr->internalRep.otherValuePtr;
6253    event->objPtr = NULL;
6254}
6255
6256/*
6257 *----------------------------------------------------------------------------
6258 *
6259 * TclDOMGetPath --
6260 *
6261 *  Constructs a list of ancestor nodes.
6262 *
6263 * Results:
6264 *  Returns list as a Tcl_Obj.
6265 *
6266 * Side effects:
6267 *  Allocates Tcl_Obj structures.
6268 *
6269 *----------------------------------------------------------------------------
6270 */
6271
6272static Tcl_Obj *
6273TclDOMGetPath (interp, nodePtr)
6274     Tcl_Interp *interp;
6275     xmlNodePtr nodePtr;
6276{
6277  Tcl_Obj *listPtr, *resultPtr;
6278  Tcl_Obj *objv[2];
6279
6280  if (nodePtr) {
6281    objv[0] = TclDOM_CreateObjFromNode(nodePtr);
6282    objv[1] = NULL;
6283
6284    listPtr = Tcl_NewListObj(1, objv);
6285    if (nodePtr->parent) {
6286      resultPtr = TclDOMGetPath(interp, nodePtr->parent);
6287      Tcl_ListObjAppendList(interp, resultPtr, listPtr);
6288    } else {
6289      resultPtr = listPtr;
6290    }
6291    return resultPtr;
6292  } else {
6293    return Tcl_NewObj();
6294  }
6295}
6296
6297/*
6298 *----------------------------------------------------------------------------
6299 *
6300 * TclDOM_GetEventFromObj --
6301 *
6302 *  Returns TclDOMEvent pointer from Tcl object.
6303 *
6304 * Results:
6305 *  Returns success code and assigns event pointer.
6306 *
6307 * Side effects:
6308 *  May invalidate object's internal rep.
6309 *
6310 *----------------------------------------------------------------------------
6311 */
6312
6313static int
6314TclDOM_GetEventFromObj (interp, objPtr, eventPtr)
6315     Tcl_Interp *interp;
6316     Tcl_Obj *objPtr;
6317     TclDOMEvent **eventPtr;
6318{
6319  if (!objPtr) {
6320    Tcl_SetResult(interp, "null object", NULL);
6321    return TCL_ERROR;
6322  }
6323  if (objPtr->typePtr == &TclDOM_EventObjType) {
6324    *eventPtr = (TclDOMEvent *) objPtr->internalRep.otherValuePtr;
6325  } else if (TclDOM_EventSetFromAny(interp, objPtr) == TCL_OK) {
6326    *eventPtr = (TclDOMEvent *) objPtr->internalRep.otherValuePtr;
6327  } else {
6328    return TCL_ERROR;
6329  }
6330  return TCL_OK;
6331}
6332
6333/*
6334 *----------------------------------------------------------------------------
6335 *
6336 * TclDOMGenericError --
6337 *
6338 *  Handler for parse errors.
6339 *
6340 * Results:
6341 *  Stores error message.
6342 *
6343 * Side effects:
6344 *  Transform will return error condition.
6345 *
6346 *----------------------------------------------------------------------------
6347 */
6348
6349static void
6350TclDOMGenericError (void *ctx, const char *msg, ...)
6351{
6352  va_list args;
6353  GenericError_Info *errorInfoPtr = (GenericError_Info *) ctx;
6354  char buf[2048];
6355  int len;
6356
6357  errorInfoPtr->code = TCL_ERROR;
6358
6359  if (!errorInfoPtr->msg) {
6360    errorInfoPtr->msg = Tcl_NewObj();
6361    Tcl_IncrRefCount(errorInfoPtr->msg);
6362  }
6363
6364  va_start(args,msg);
6365  len = vsnprintf(buf, 2047, msg, args);
6366  va_end(args);
6367
6368  Tcl_AppendToObj(errorInfoPtr->msg, buf, len);
6369
6370}
6371
6372