summaryrefslogtreecommitdiffstats
path: root/tclxml/tcldom-libxml2.c
diff options
context:
space:
mode:
Diffstat (limited to 'tclxml/tcldom-libxml2.c')
-rw-r--r--tclxml/tcldom-libxml2.c7178
1 files changed, 7178 insertions, 0 deletions
diff --git a/tclxml/tcldom-libxml2.c b/tclxml/tcldom-libxml2.c
new file mode 100644
index 0000000..79960d0
--- /dev/null
+++ b/tclxml/tcldom-libxml2.c
@@ -0,0 +1,7178 @@
+/* tcldom-libxml2.c --
+ *
+ * A Tcl wrapper for libxml's node tree API,
+ * conformant to the TclDOM API.
+ *
+ * Copyright (c) 2005-2008 by Explain.
+ * http://www.explain.com.au/
+ * Copyright (c) 2001-2004 Zveno Pty Ltd
+ * http://www.zveno.com/
+ *
+ * See the file "LICENSE" for information on usage and
+ * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * $Id: tcldom-libxml2.c,v 1.1.1.1 2009/01/16 22:11:49 joye Exp $
+ */
+
+#include <tcldom/tcldom.h>
+#include <tcldom-libxml2/tcldom-libxml2.h>
+#include <libxml/xpath.h>
+#include <libxml/xpathInternals.h>
+#include <libxml/xmlIO.h>
+#include <libxml/HTMLtree.h>
+#include <libxml/globals.h>
+#include <libxml/xinclude.h>
+#include <libxml/parserInternals.h>
+#include <libxml/xmlschemas.h>
+#include <libxml/xmlschemastypes.h>
+#include <libxml/xmlsave.h>
+#include <string.h>
+
+#define TCL_DOES_STUBS \
+ (TCL_MAJOR_VERSION > 8 || TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION > 1 || \
+ (TCL_MINOR_VERSION == 1 && TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)))
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+
+/*
+ * Manage lists of Tcl_Obj's
+ */
+
+typedef struct ObjList {
+ Tcl_Obj *objPtr;
+ struct ObjList *next;
+} ObjList;
+
+/*
+ * Forward declarations for private functions.
+ */
+
+static void FreeDocument _ANSI_ARGS_((ClientData clientData));
+static TclDOM_libxml2_Document * GetDOMDocument _ANSI_ARGS_((Tcl_Interp *interp,
+ TclXML_libxml2_Document *tDocPtr));
+
+static void TclDOM_libxml2_DestroyNode _ANSI_ARGS_((Tcl_Interp *interp, TclDOM_libxml2_Node *tNodePtr));
+static void TclDOM_libxml2_InvalidateNode _ANSI_ARGS_((TclDOM_libxml2_Node *tNodePtr));
+
+static char * TclDOMLiveNodeListNode _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp,
+ char *name1,
+ char *name2,
+ int flags));
+static char * TclDOMLiveNodeListDoc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp,
+ char *name1,
+ char *name2,
+ int flags));
+static char * TclDOMLiveNamedNodeMap _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp,
+ char *name1,
+ char *name2,
+ int flags));
+static int TclDOMSetLiveNodeListNode _ANSI_ARGS_((Tcl_Interp *interp,
+ char *varname,
+ xmlNodePtr nodePtr));
+static int TclDOMSetLiveNodeListDoc _ANSI_ARGS_((Tcl_Interp *interp,
+ char *varname,
+ xmlDocPtr docPtr));
+static int TclDOMSetLiveNamedNodeMap _ANSI_ARGS_((Tcl_Interp *interp,
+ char *varname,
+ xmlNodePtr nodePtr));
+
+/*
+ * Forward declarations of commands
+ */
+
+static int TclDOMDOMImplementationCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static int TclDOMDocumentCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static void DocumentNodeCmdDelete _ANSI_ARGS_((ClientData clientdata));
+static int TclDOMNodeCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static void TclDOMNodeCommandDelete _ANSI_ARGS_((ClientData clientdata));
+static int TclDOMElementCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static int TclDOMEventCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static void TclDOMEventCommandDelete _ANSI_ARGS_((ClientData clientdata));
+static Tcl_Obj * TclDOM_libxml2_NewEventObj _ANSI_ARGS_((Tcl_Interp *interp,
+ xmlDocPtr docPtr,
+ enum TclDOM_EventTypes type,
+ Tcl_Obj *typeObjPtr));
+
+/*
+ * Functions that implement the TclDOM_Implementation interface
+ */
+
+static int TclDOM_HasFeatureCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static int TclDOMCreateCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static int TclDOMDestroyCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static int TclDOMParseCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static int TclDOMSerializeCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static int TclDOMSelectNodeCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static int TclDOMIsNodeCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static int TclDOMAdoptCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+
+/*
+ * Additional features
+ */
+
+static int TclDOMXIncludeCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+
+static int TclDOMPrefix2NSCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+static int TclDOMTrimCommand _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *CONST objv[]));
+
+static void TrimDocument _ANSI_ARGS_((Tcl_Interp *interp, xmlDocPtr docPtr));
+static int AdoptDocument _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *objPtr));
+
+static int DocumentCget _ANSI_ARGS_((Tcl_Interp *interp,
+ xmlDocPtr docPtr,
+ Tcl_Obj *CONST objPtr));
+static int NodeCget _ANSI_ARGS_((Tcl_Interp *interp,
+ xmlDocPtr docPtr,
+ xmlNodePtr nodePtr,
+ Tcl_Obj *CONST objPtr));
+static int NodeConfigure _ANSI_ARGS_((Tcl_Interp *interp,
+ xmlNodePtr nodePtr,
+ int objc,
+ Tcl_Obj *CONST objPtr[]));
+static int ElementCget _ANSI_ARGS_((Tcl_Interp *interp,
+ xmlNodePtr nodePtr,
+ Tcl_Obj *CONST objPtr));
+
+static int TclDOM_NodeAppendChild _ANSI_ARGS_((Tcl_Interp *interp,
+ xmlNodePtr nodePtr,
+ xmlNodePtr newPtr));
+static int TclDOM_NodeInsertBefore _ANSI_ARGS_((Tcl_Interp *interp,
+ xmlNodePtr refPtr,
+ xmlNodePtr newPtr));
+
+static void PostMutationEvents _ANSI_ARGS_((Tcl_Interp *interp,
+ TclXML_libxml2_Document *tDocPtr,
+ xmlNodePtr nodePtr,
+ xmlNodePtr refPtr,
+ xmlNodePtr newPtr,
+ xmlNodePtr oldParent,
+ xmlNodePtr newParent));
+
+static int DTDValidate _ANSI_ARGS_((Tcl_Interp *interp,
+ TclDOM_libxml2_Document *domDocPtr));
+static int SchemaCompile _ANSI_ARGS_((Tcl_Interp *interp,
+ TclDOM_libxml2_Document *domDocPtr));
+static int SchemaValidate _ANSI_ARGS_((Tcl_Interp *interp,
+ TclDOM_libxml2_Document *domDocPtr,
+ xmlDocPtr instancePtr));
+/*
+static int RelaxNGCompile _ANSI_ARGS_((Tcl_Interp *interp,
+ xmlDocPtr doc));
+static int RelaxNGValidate _ANSI_ARGS_((Tcl_Interp *interp,
+ xmlRelaxNGPtr schema,
+ xmlDocPtr instance));
+*/
+
+static void NodeAddObjRef _ANSI_ARGS_((TclDOM_libxml2_Node *tNodePtr,
+ Tcl_Obj *objPtr));
+#if 0
+static void DumpNode _ANSI_ARGS_((TclDOM_libxml2_Node *tNodePtr));
+#endif
+
+/*
+ * Other utilities
+ */
+
+static Tcl_Obj * GetPath _ANSI_ARGS_((Tcl_Interp *interp,
+ xmlNodePtr nodePtr));
+
+/*
+ * MS VC++ oddities
+ */
+
+#ifdef WIN32
+#if !defined (__CYGWIN__)
+#define vsnprintf _vsnprintf
+#define snprintf _snprintf
+#endif /* __CYGWIN__ */
+#endif /* WIN32 */
+
+/*
+ * Nodes as Tcl Objects (overloaded to also support event nodes).
+ */
+
+Tcl_FreeInternalRepProc NodeTypeFree;
+Tcl_DupInternalRepProc NodeTypeDup;
+Tcl_UpdateStringProc NodeTypeUpdate;
+Tcl_SetFromAnyProc NodeTypeSetFromAny;
+
+Tcl_ObjType NodeObjType = {
+ "libxml2-node",
+ NodeTypeFree,
+ NodeTypeDup,
+ NodeTypeUpdate,
+ NodeTypeSetFromAny
+};
+
+/*
+ * For additional checks when creating nodes.
+ * These are setup at initialisation-time, but thereafter are read-only.
+ */
+
+static Tcl_Obj *checkName;
+static Tcl_Obj *checkQName;
+
+/*
+ * libxml2 is mostly thread-safe, but there are issues with error callbacks
+ */
+
+TCL_DECLARE_MUTEX(libxml2)
+
+/*
+ * Statically include the definitions of option tables:
+ * Due to linking problems on Windows, using MS VC++.
+ */
+
+#include "tcldom.c"
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * Tcldom_libxml2_Init --
+ *
+ * Initialisation routine for module.
+ * This is no longer loaded as a separate module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates commands in the interpreter,
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+Tcldom_libxml2_Init (interp)
+ Tcl_Interp *interp; /* Interpreter to initialise */
+{
+
+ Tcl_MutexLock(&libxml2);
+ xmlXPathInit();
+ Tcl_MutexUnlock(&libxml2);
+
+ /*
+ * Provide a handler for nodes for structured error reporting
+ */
+
+ TclXML_libxml2_SetErrorNodeFunc(interp,
+ (TclXML_ErrorNodeHandlerProc *) TclDOM_libxml2_CreateObjFromNode);
+
+ /*
+ * For each of the standard commands, register the command
+ * in both the ::dom and ::dom::libxml2 Tcl namespaces -
+ * they are equivalent.
+ */
+
+ Tcl_CreateObjCommand(interp, "dom::libxml2::DOMImplementation",
+ TclDOMDOMImplementationCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::DOMImplementation",
+ TclDOMDOMImplementationCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::hasfeature",
+ TclDOM_HasFeatureCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::hasfeature",
+ TclDOM_HasFeatureCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::document",
+ TclDOMDocumentCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::document",
+ TclDOMDocumentCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::node",
+ TclDOMNodeCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::node",
+ TclDOMNodeCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::create",
+ TclDOMCreateCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::create",
+ TclDOMCreateCommand, NULL, NULL);
+
+ /*
+ * Implemented in Tcl (for the moment)
+ Tcl_CreateObjCommand(interp, "dom::libxml2::parse",
+ TclDOMParseCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::parse",
+ TclDOMParseCommand, NULL, NULL);
+ */
+ Tcl_CreateObjCommand(interp, "dom::libxml2::adoptdocument",
+ TclDOMAdoptCommand, NULL, NULL);
+
+ Tcl_CreateObjCommand(interp, "dom::libxml2::serialize",
+ TclDOMSerializeCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::serialize",
+ TclDOMSerializeCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::selectnode",
+ TclDOMSelectNodeCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::selectNode",
+ TclDOMSelectNodeCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::isNode",
+ TclDOMIsNodeCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::isNode",
+ TclDOMIsNodeCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::element",
+ TclDOMElementCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::element",
+ TclDOMElementCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::event",
+ TclDOMEventCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::event",
+ TclDOMEventCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::xinclude",
+ TclDOMXIncludeCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::xinclude",
+ TclDOMXIncludeCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::prefix2namespaceURI",
+ TclDOMPrefix2NSCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::prefix2namespaceURI",
+ TclDOMPrefix2NSCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::destroy",
+ TclDOMDestroyCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::destroy",
+ TclDOMDestroyCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::libxml2::trim",
+ TclDOMTrimCommand, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "dom::trim",
+ TclDOMTrimCommand, NULL, NULL);
+
+ /* Setup name checking REs */
+ checkName = Tcl_NewStringObj("^", -1);
+ Tcl_AppendObjToObj(checkName, Tcl_GetVar2Ex(interp, "::xml::Name", NULL, 0));
+ Tcl_AppendToObj(checkName, "$", -1);
+ Tcl_IncrRefCount(checkName);
+ checkQName = Tcl_NewStringObj("^", -1);
+ Tcl_AppendObjToObj(checkQName, Tcl_GetVar2Ex(interp, "::xml::QName", NULL, 0));
+ Tcl_AppendToObj(checkQName, "$", -1);
+ Tcl_IncrRefCount(checkQName);
+
+ TclDOM_SetVars(interp);
+
+ Tcl_RegisterObjType(&NodeObjType);
+
+ return TCL_OK;
+}
+
+/*
+ * DOM is safe, since it is merely an in-memory representation of the document tree.
+ * However, XInclude is not safe. This is still OK because XInclude uses the external
+ * entity mechanism to load remote documents and TclXML/libxml2 intercepts those calls.
+ */
+int
+Tcldom_libxml2_SafeInit (interp)
+ Tcl_Interp *interp; /* Interpreter to initialise */
+{
+ return Tcldom_libxml2_Init(interp);
+}
+
+#if 0
+void
+DumpDocNodeTable(domDocPtr)
+ TclDOM_libxml2_Document *domDocPtr;
+{
+ return;
+
+ /*
+ TclDOM_libxml2_Node *tNodePtr;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+
+ sprintf(dbgbuf, " Nodes in doc \"%s\":\n", domDocPtr->tDocPtr->token);
+ Tcl_WriteChars(stderrChan, dbgbuf, -1);
+
+ for (entryPtr = Tcl_FirstHashEntry(domDocPtr->nodes, &search);
+ entryPtr;
+ entryPtr = Tcl_NextHashEntry(&search)) {
+ tNodePtr = (TclDOM_libxml2_Node *) Tcl_GetHashValue(entryPtr);
+ sprintf(dbgbuf, " Hash entry \"%s\" (x%x)\n", Tcl_GetHashKey(domDocPtr->nodes, entryPtr), tNodePtr);
+ Tcl_WriteChars(stderrChan, dbgbuf, -1);
+ sprintf(dbgbuf, " Node \"%s\"\n", tNodePtr->token);
+ Tcl_WriteChars(stderrChan, dbgbuf, -1);
+ }
+ */
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_HasFeatureCommand --
+ *
+ * Implements dom::libxml2::hasfeature command
+ *
+ * Results:
+ * Returns boolean.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOM_HasFeatureCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 0, objv, "hasfeature feature version");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_RegExpMatchObj(interp, objv[1], Tcl_NewStringObj("create|destroy|parse|query|serialize|trim|Events|UIEvents|isNode", -1)) == 1) {
+ if (Tcl_StringMatch(Tcl_GetStringFromObj(objv[2], NULL), "1.0") == 1) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ }
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMCreateCommand --
+ *
+ * Implements dom::libxml2::create command
+ *
+ * Results:
+ * Creates a new document.
+ *
+ * Side effects:
+ * Allocates memory.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOMCreateCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ Tcl_Obj *objPtr;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "");
+ return TCL_ERROR;
+ }
+
+ objPtr = TclXML_libxml2_NewDocObj(interp);
+ if (!objPtr) {
+ return TCL_ERROR;
+ }
+ TclXML_libxml2_DocKeep(objPtr, TCLXML_LIBXML2_DOCUMENT_KEEP);
+
+ if (AdoptDocument(interp, objPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+int
+AdoptDocument(interp, objPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *objPtr;
+{
+ TclXML_libxml2_Document *tDocPtr;
+ TclDOM_libxml2_Document *domDocPtr;
+
+ /*
+ * Claim this object so the document will not be destroyed
+ * underneath us.
+ */
+ Tcl_IncrRefCount(objPtr);
+
+ if (TclXML_libxml2_GetTclDocFromObj(interp, objPtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ domDocPtr = (TclDOM_libxml2_Document *) Tcl_Alloc(sizeof(TclDOM_libxml2_Document));
+ domDocPtr->interp = interp;
+ domDocPtr->tDocPtr = tDocPtr;
+ domDocPtr->objPtr = objPtr;
+
+ domDocPtr->schema = NULL;
+
+ domDocPtr->nodes = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(domDocPtr->nodes, TCL_STRING_KEYS);
+ domDocPtr->nodeCntr = 0;
+
+ domDocPtr->captureListeners = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(domDocPtr->captureListeners, TCL_ONE_WORD_KEYS);
+ domDocPtr->bubbleListeners = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(domDocPtr->bubbleListeners, TCL_ONE_WORD_KEYS);
+ memset(domDocPtr->listening, 0, TCLDOM_NUM_EVENT_TYPES * sizeof(int));
+
+ /*
+ * When the document is eventually destroyed,
+ * make sure all memory is freed.
+ */
+ tDocPtr->dom = (ClientData) domDocPtr;
+ tDocPtr->domfree = FreeDocument;
+
+ /*
+ * Create a Tcl namespace for this document
+ */
+
+ Tcl_VarEval(interp, "namespace eval ::dom::", tDocPtr->token, " {}\n", NULL);
+
+ /*
+ * Create a DOM command to control the document.
+ */
+
+ domDocPtr->cmd = Tcl_CreateObjCommand(interp, tDocPtr->token, TclDOMDocumentCommand, (ClientData) domDocPtr, DocumentNodeCmdDelete);
+
+ Tcl_SetObjResult(interp, objPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_libxml2_CreateObjFromDoc --
+ *
+ * Wrapper for TclXML_libxml2_CreateObjFromDoc
+ *
+ * Results:
+ * Returns Tcl_Obj.
+ *
+ * Side effects:
+ * Allocates memory.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclDOM_libxml2_CreateObjFromDoc (interp, docPtr)
+ Tcl_Interp *interp;
+ xmlDocPtr docPtr;
+{
+ Tcl_Obj *newPtr;
+
+ newPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
+
+ if (AdoptDocument(interp, newPtr) != TCL_OK) {
+ Tcl_DecrRefCount(newPtr);
+ return NULL;
+ }
+
+ return newPtr;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMDestroyCommand --
+ *
+ * Implements dom::libxml2::destroy command
+ *
+ * Results:
+ * Frees document or node.
+ *
+ * Side effects:
+ * Deallocates memory.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOMDestroyCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ TclXML_libxml2_Document *tDocPtr;
+ TclDOM_libxml2_Node *tNodePtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "token");
+ return TCL_ERROR;
+ }
+
+ if (TclXML_libxml2_GetTclDocFromObj(interp, objv[1], &tDocPtr) == TCL_OK) {
+ TclDOM_libxml2_Document *domDocPtr = GetDOMDocument(interp, tDocPtr);
+
+ if (domDocPtr == NULL) {
+ /* This is an error! */
+ TclXML_libxml2_DestroyDocument(tDocPtr);
+ } else {
+ Tcl_DeleteCommandFromToken(interp, domDocPtr->cmd);
+ }
+
+ } else if (TclDOM_libxml2_GetTclNodeFromObj(interp, objv[1], &tNodePtr) == TCL_OK) {
+ TclDOM_libxml2_DestroyNode(interp, tNodePtr);
+ } else if (TclDOM_libxml2_GetTclEventFromObj(interp, objv[1], &tNodePtr) == TCL_OK) {
+ TclDOM_libxml2_DestroyNode(interp, tNodePtr);
+ } else {
+ Tcl_SetResult(interp, "not a DOM node", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * DocumentNodeCmdDelete --
+ *
+ * Invoked when a DOM document's command is deleted.
+ *
+ * Results:
+ * Frees document.
+ *
+ * Side effects:
+ * Deallocates memory.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+void
+DocumentNodeCmdDelete (clientData)
+ ClientData clientData;
+{
+ TclDOM_libxml2_Document *domDocPtr = (TclDOM_libxml2_Document *) clientData;
+
+#ifndef WIN32
+ TclXML_libxml2_DestroyDocument(domDocPtr->tDocPtr);
+#endif /* not WIN32 */
+#ifdef WIN32
+ /*
+ * Workaround bug in TclXML/libxml2.
+ * This will, of course, leak memory.
+ */
+
+ /* FreeDocument((ClientData) domDocPtr); */
+#endif /* WIN32 */
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * FreeDocument --
+ *
+ * Frees resources associated with a document.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Deallocates memory.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+#ifdef WIN32
+/*
+ * Using Tcl internal functions appears to cause linking problems
+ * when using MS VC++, so avoid the problem by invoking a script instead.
+ */
+
+void DeleteNamespace (interp, ns)
+ Tcl_Interp *interp;
+ char *ns;
+{
+ Tcl_Obj *cmdPtr = Tcl_NewObj();
+
+ Tcl_AppendStringsToObj(cmdPtr, "namespace delete ", ns, NULL);
+ Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(cmdPtr);
+}
+#else /* not WIN32 */
+/*
+ * Internal Tcl functions
+ */
+
+#if (TCL_MAJOR_VERSION < 8 || (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 5))
+
+/*
+ * SRB: 2005-12-29: This should use #include <tclInt.h>, but private sources may not be available.
+ */
+
+EXTERN Tcl_Namespace * Tcl_FindNamespace _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * name,
+ Tcl_Namespace * contextNsPtr,
+ int flags));
+EXTERN void Tcl_DeleteNamespace _ANSI_ARGS_((Tcl_Namespace * nsPtr));
+
+#endif /* Tcl < 8.5 */
+
+void DeleteNamespace (interp, ns)
+ Tcl_Interp *interp;
+ char *ns;
+{
+ Tcl_Namespace *namespacePtr;
+ namespacePtr = Tcl_FindNamespace(interp, ns,
+ (Tcl_Namespace *) NULL, 0);
+ if (namespacePtr) {
+ Tcl_DeleteNamespace(namespacePtr);
+ } /* else internal error */
+}
+#endif /* WIN32 */
+
+void
+FreeDocument (clientData)
+ ClientData clientData;
+{
+ TclDOM_libxml2_Document *domDocPtr = (TclDOM_libxml2_Document *) clientData;
+ char buf[1024];
+
+ snprintf(buf, 1023, "::dom::%s", domDocPtr->tDocPtr->token);
+ DeleteNamespace(domDocPtr->interp, buf);
+
+ /*
+ * Deleting the namespace deletes all of the node commands,
+ * which in turn invalidates the node references.
+ * So no need to do it again here.
+ *
+ entry = Tcl_FirstHashEntry(domDocPtr->nodes, &search);
+ while (entry) {
+ tNodePtr = (TclDOM_libxml2_Node *) Tcl_GetHashValue(entry);
+ TclDOM_libxml2_InvalidateNode(tNodePtr);
+ entry = Tcl_NextHashEntry(&search);
+ }
+ */
+ Tcl_DeleteHashTable(domDocPtr->nodes);
+ Tcl_Free((char *) domDocPtr->nodes);
+
+ if (domDocPtr->schema) {
+ Tcl_MutexLock(&libxml2);
+ /* This also frees the copy of the document used by the schema context */
+ xmlSchemaFree(domDocPtr->schema);
+ Tcl_MutexUnlock(&libxml2);
+ }
+
+ Tcl_Free((char *) domDocPtr->captureListeners);
+ Tcl_Free((char *) domDocPtr->bubbleListeners);
+
+ /* Workaround win32 destroy bug, see above */
+#ifndef WIN32
+ Tcl_DecrRefCount(domDocPtr->objPtr);
+#endif /* not WIN32 */
+
+ Tcl_Free((char *) domDocPtr);
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * GetDOMDocument --
+ *
+ * Retrieves the DOM document structure associated with a libxml2 document.
+ * libxslt synthesizes documents, so it is often the case that a node
+ * must be processed that has not had its document "adopted".
+ *
+ * Results:
+ * Returns pointer to DOM structure.
+ *
+ * Side effects:
+ * Document is "adopted" if necessary.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+TclDOM_libxml2_Document *
+GetDOMDocument(interp, tDocPtr)
+ Tcl_Interp *interp;
+ TclXML_libxml2_Document *tDocPtr;
+{
+ if (tDocPtr->dom != NULL) {
+ return (TclDOM_libxml2_Document *) tDocPtr->dom;
+ } else if (interp == NULL) {
+ return NULL;
+ } else {
+ Tcl_Obj *objPtr;
+
+ objPtr = TclXML_libxml2_CreateObjFromDoc(tDocPtr->docPtr);
+ if (AdoptDocument(interp, objPtr) != TCL_OK) {
+ Tcl_DecrRefCount(objPtr);
+ return NULL;
+ } else {
+ return (TclDOM_libxml2_Document *) tDocPtr->dom;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMParseCommand --
+ *
+ * Implements dom::libxml2::parse command
+ *
+ * Not implemented here at present - calls Tcl script
+ *
+ * Results:
+ * Depends on method.
+ *
+ * Side effects:
+ * Depends on method.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOMParseCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ /* Tcl_Obj *objPtr; */
+ Tcl_Obj **newobjv;
+ int i;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "xml ?args ...?");
+ return TCL_ERROR;
+ }
+
+ newobjv = (Tcl_Obj **) Tcl_Alloc((objc + 1) * sizeof(Tcl_Obj *));
+ newobjv[0] = Tcl_NewStringObj("::dom::libxml2::parse", -1);
+ for (i = 1; i < objc; i++) {
+ newobjv[i] = objv[i];
+ }
+ newobjv[i] = NULL;
+
+ return Tcl_EvalObjv(interp, objc, newobjv, 0);
+
+ /*
+ if (TclXML_CreateParser(interp, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ parserObj = Tcl_GetObjResult(interp);
+ if (TclXML_Parse(interp, parserObj, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (TclXML_Get(interp, parserObj, "document") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, objPtr);
+ */
+
+ return TCL_OK;
+}
+int
+TclDOMAdoptCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "doc");
+ return TCL_ERROR;
+ }
+
+ return AdoptDocument(interp, objv[1]);
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMSerializeCommand --
+ *
+ * Implements dom::libxml2::serialize command
+ *
+ * Results:
+ * Depends on method.
+ *
+ * Side effects:
+ * Depends on method.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOMSerializeCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ xmlDocPtr docPtr;
+ xmlNodePtr nodePtr;
+ xmlBufferPtr bufptr = NULL;
+ xmlSaveCtxtPtr savectxtptr = NULL;
+ xmlChar *result = NULL;
+ Tcl_Obj *encodingPtr = NULL;
+ int option, method = TCLDOM_SERIALIZE_METHOD_XML, indent = 0, len = 0, omitXMLDeclaration = 0, saveoptions = 0;
+ char *buf, *encoding;
+ Tcl_Encoding tclencoding;
+ Tcl_DString *serialized;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "node ?option value ...?");
+ return TCL_ERROR;
+ }
+
+ if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
+ if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) == TCL_OK) {
+ /* Serialize just the node */
+ Tcl_SetResult(interp, "not yet implemented - serialize whole document", NULL);
+ return TCL_ERROR;
+ } else {
+ Tcl_SetResult(interp, "not a libxml2 node", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (objc > 2) {
+ objc -= 2;
+ objv += 2;
+
+ while (objc) {
+
+ if (objc == 1) {
+ Tcl_Obj *msgPtr;
+
+ msgPtr = Tcl_NewStringObj("missing value for configuration option \"", -1);
+ Tcl_AppendObjToObj(msgPtr, objv[0]);
+ Tcl_AppendStringsToObj(msgPtr, "\"", (char *) NULL);
+ Tcl_SetObjResult(interp, msgPtr);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_SerializeCommandOptions,
+ "option", 0, &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum TclDOM_SerializeCommandOptions) option) {
+ case TCLDOM_SERIALIZE_METHOD:
+
+ buf = Tcl_GetStringFromObj(objv[1], &len);
+ if (len == 0) {
+ method = TCLDOM_SERIALIZE_METHOD_XML;
+ } else if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_SerializeMethods,
+ "method", 0, &method) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ break;
+
+ case TCLDOM_SERIALIZE_INDENT:
+
+ if (Tcl_GetBooleanFromObj(interp, objv[1], &indent) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ break;
+
+ case TCLDOM_SERIALIZE_OMIT_XML_DECLARATION:
+
+ if (Tcl_GetBooleanFromObj(interp, objv[1], &omitXMLDeclaration) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ break;
+
+ case TCLDOM_SERIALIZE_ENCODING:
+ encodingPtr = objv[1];
+
+ break;
+
+ default:
+ Tcl_SetResult(interp, "unknown option", NULL);
+ return TCL_ERROR;
+ }
+
+ objc -= 2;
+ objv += 2;
+ }
+ }
+
+ switch ((enum TclDOM_SerializeMethods) method) {
+
+ case TCLDOM_SERIALIZE_METHOD_XML:
+
+ serialized = (Tcl_DString *) Tcl_Alloc(sizeof(Tcl_DString));
+ Tcl_DStringInit(serialized);
+
+ if (encodingPtr) {
+ encoding = Tcl_GetStringFromObj(encodingPtr, NULL);
+ } else {
+ encoding = "utf-8";
+ }
+ tclencoding = Tcl_GetEncoding(interp, encoding);
+
+ Tcl_MutexLock(&libxml2);
+
+ if ((bufptr = xmlBufferCreate()) == NULL) {
+ Tcl_MutexUnlock(&libxml2);
+ Tcl_Free((void *)serialized);
+ Tcl_SetResult(interp, "unable to allocate output buffer", NULL);
+ return TCL_ERROR;
+ }
+
+ if (indent) {
+ saveoptions |= XML_SAVE_FORMAT;
+ }
+ if (omitXMLDeclaration) {
+ saveoptions |= XML_SAVE_NO_DECL;
+ }
+ if ((savectxtptr = xmlSaveToBuffer(bufptr, encoding, saveoptions)) == NULL) {
+ Tcl_MutexUnlock(&libxml2);
+ Tcl_Free((void *)serialized);
+ xmlBufferFree(bufptr);
+ Tcl_SetResult(interp, "unable to create save context", NULL);
+ return TCL_ERROR;
+ }
+
+ xmlSaveDoc(savectxtptr, docPtr);
+ xmlSaveClose(savectxtptr);
+
+ Tcl_MutexUnlock(&libxml2);
+
+ Tcl_ExternalToUtfDString(tclencoding, (CONST char *) xmlBufferContent(bufptr), xmlBufferLength(bufptr), serialized);
+ Tcl_DStringResult(interp, serialized);
+
+ Tcl_MutexLock(&libxml2);
+ xmlBufferFree(bufptr);
+ Tcl_MutexUnlock(&libxml2);
+
+ break;
+
+ case TCLDOM_SERIALIZE_METHOD_HTML:
+
+ Tcl_MutexLock(&libxml2);
+ htmlSetMetaEncoding(docPtr, (const xmlChar *) "UTF-8");
+ htmlDocDumpMemory(docPtr, &result, &len);
+ Tcl_MutexUnlock(&libxml2);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) result, len));
+ xmlFree(result);
+
+ break;
+
+ case TCLDOM_SERIALIZE_METHOD_TEXT:
+
+ nodePtr = docPtr->children;
+
+ while (nodePtr != NULL) {
+ if (nodePtr->type == XML_TEXT_NODE)
+ Tcl_AppendResult(interp, (char *) nodePtr->content, NULL);
+
+ if (nodePtr->children != NULL) {
+ if ((nodePtr->children->type != XML_ENTITY_DECL) &&
+ (nodePtr->children->type != XML_ENTITY_REF_NODE) &&
+ (nodePtr->children->type != XML_ENTITY_NODE)) {
+ nodePtr = nodePtr->children;
+ continue;
+ }
+ }
+
+ if (nodePtr->next != NULL) {
+ nodePtr = nodePtr->next;
+ continue;
+ }
+
+ do {
+ nodePtr = nodePtr->parent;
+ if (nodePtr == NULL)
+ break;
+ if (nodePtr == (xmlNodePtr) docPtr) {
+ nodePtr = NULL;
+ break;
+ }
+ if (nodePtr->next != NULL) {
+ nodePtr = nodePtr->next;
+ break;
+ }
+ } while (nodePtr != NULL);
+ }
+
+ break;
+
+ default:
+ Tcl_SetResult(interp, "internal error", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMDOMImplementationCommand --
+ *
+ * Implements dom::libxml2::DOMImplementation command
+ *
+ * Results:
+ * Depends on method.
+ *
+ * Side effects:
+ * Depends on method.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOMDOMImplementationCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ int method;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_DOMImplementationCommandMethods,
+ "method", 0, &method) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum TclDOM_DOMImplementationCommandMethods) method) {
+ case TCLDOM_IMPL_HASFEATURE:
+ return TclDOM_HasFeatureCommand(dummy, interp, objc - 1, objv + 1);
+ case TCLDOM_IMPL_CREATE:
+ if (objc == 2) {
+ return TclDOMCreateCommand(dummy, interp, 1, objv);
+ } else if (objc == 3) {
+ Tcl_Obj *objPtr;
+ xmlDocPtr docPtr;
+ xmlNodePtr nodePtr;
+
+ if (TclDOMCreateCommand(dummy, interp, 0, NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ objPtr = Tcl_GetObjResult(interp);
+ TclXML_libxml2_GetDocFromObj(interp, objPtr, &docPtr);
+ Tcl_MutexLock(&libxml2);
+ nodePtr = xmlNewDocNode(docPtr, NULL, (const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL), NULL);
+ Tcl_MutexUnlock(&libxml2);
+ if (nodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create document element", NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, objPtr);
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "create ?doc?");
+ return TCL_ERROR;
+ }
+
+ break;
+
+ case TCLDOM_IMPL_PARSE:
+ return TclDOMParseCommand(dummy, interp, objc - 1, objv + 1);
+
+ case TCLDOM_IMPL_SERIALIZE:
+ return TclDOMSerializeCommand(dummy, interp, objc - 1, objv + 1);
+
+ case TCLDOM_IMPL_SELECTNODE:
+ return TclDOMSelectNodeCommand(dummy, interp, objc - 1, objv + 1);
+
+ case TCLDOM_IMPL_DESTROY:
+ return TclDOMDestroyCommand(dummy, interp, objc - 1, objv + 1);
+
+ case TCLDOM_IMPL_ISNODE:
+ return TclDOMIsNodeCommand(dummy, interp, objc - 1, objv + 1);
+
+ default:
+ Tcl_SetResult(interp, "method \"", NULL);
+ Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL));
+ Tcl_AppendResult(interp, "\" not yet implemented", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * [Schema|RNG][Compile|Validate] --
+ *
+ * Implements DTD, XML Schema and RelaxNG parsing and validation
+ *
+ * Results:
+ * Depends on method.
+ *
+ * Side effects:
+ * May create or destroy validation contexts.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+DTDValidate (interp, domDocPtr)
+ Tcl_Interp *interp;
+ TclDOM_libxml2_Document *domDocPtr;
+{
+ xmlValidCtxtPtr ctxt;
+
+ TclXML_libxml2_ResetError(interp);
+
+ Tcl_MutexLock(&libxml2);
+
+ ctxt = xmlNewValidCtxt();
+ if (ctxt == NULL) {
+ Tcl_MutexUnlock(&libxml2);
+
+ Tcl_SetResult(interp, "unable to prepare validation context", NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetResult(interp, "document is not valid", NULL);
+
+ if (xmlValidateDocument(ctxt, domDocPtr->tDocPtr->docPtr) == 0) {
+ Tcl_Obj *errObjPtr;
+
+ Tcl_MutexUnlock(&libxml2);
+
+ errObjPtr = TclXML_libxml2_GetErrorObj(interp);
+
+ if (errObjPtr) {
+ Tcl_IncrRefCount(errObjPtr);
+ Tcl_SetObjResult(interp, errObjPtr);
+ }
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ Tcl_ResetResult(interp);
+
+ return TCL_OK;
+}
+
+int
+SchemaCompile (interp, domDocPtr)
+ Tcl_Interp *interp;
+ TclDOM_libxml2_Document *domDocPtr;
+{
+ xmlDocPtr schemaDocPtr;
+ xmlSchemaParserCtxtPtr ctxt = NULL;
+
+ if (domDocPtr->schema) {
+ /* Re-compile */
+ Tcl_MutexLock(&libxml2);
+ xmlSchemaFree(domDocPtr->schema);
+ Tcl_MutexUnlock(&libxml2);
+ domDocPtr->schema = NULL;
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ schemaDocPtr = xmlCopyDoc(domDocPtr->tDocPtr->docPtr, 1);
+
+ if (schemaDocPtr == NULL) {
+ Tcl_MutexUnlock(&libxml2);
+ Tcl_SetResult(interp, "unable to prepare schema document", NULL);
+ return TCL_ERROR;
+ }
+
+ ctxt = xmlSchemaNewDocParserCtxt(schemaDocPtr);
+ if (ctxt == NULL) {
+ xmlFreeDoc(schemaDocPtr);
+ Tcl_MutexUnlock(&libxml2);
+ Tcl_SetResult(interp, "unable to create schema context", NULL);
+ return TCL_ERROR;
+ }
+
+ TclXML_libxml2_ResetError(interp);
+
+ Tcl_SetResult(interp, "unable to parse schema document", NULL);
+ domDocPtr->schema = xmlSchemaParse(ctxt);
+#if 0
+ xmlSchemaFreeParserCtxt(ctxt); /* This frees the doc */
+#endif
+ Tcl_MutexUnlock(&libxml2);
+
+ if (domDocPtr->schema == NULL) {
+ Tcl_Obj * errObjPtr = TclXML_libxml2_GetErrorObj(interp);
+
+ if (errObjPtr) {
+ Tcl_SetObjResult(interp, errObjPtr);
+ }
+
+ return TCL_ERROR;
+ }
+
+ Tcl_ResetResult(interp);
+
+ return TCL_OK;
+}
+
+int
+SchemaValidate (interp, domDocPtr, instancePtr)
+ Tcl_Interp *interp;
+ TclDOM_libxml2_Document *domDocPtr;
+ xmlDocPtr instancePtr;
+{
+ xmlSchemaValidCtxtPtr ctxt = NULL;
+ Tcl_Obj *errObjPtr;
+ int ret;
+
+ if (domDocPtr->schema == NULL) {
+ Tcl_SetResult(interp, "schema not compiled", NULL);
+ return TCL_ERROR;
+ }
+
+ TclXML_libxml2_ResetError(interp);
+
+ Tcl_MutexLock(&libxml2);
+
+ ctxt = xmlSchemaNewValidCtxt(domDocPtr->schema);
+
+ Tcl_SetResult(interp, "document is not valid", NULL);
+
+ ret = xmlSchemaValidateDoc(ctxt, instancePtr);
+ errObjPtr = TclXML_libxml2_GetErrorObj(interp);
+ if (ret > 0) {
+ if (errObjPtr) {
+ Tcl_SetObjResult(interp, errObjPtr);
+ }
+ goto error;
+ } else if (ret < 0) {
+ Tcl_SetResult(interp, "schema processor internal error", NULL);
+
+ if (errObjPtr) {
+ Tcl_SetObjResult(interp, errObjPtr);
+ }
+ goto error;
+ }
+
+ xmlSchemaFreeValidCtxt(ctxt);
+
+ Tcl_MutexUnlock(&libxml2);
+
+ /* There may be warnings */
+
+ if (errObjPtr) {
+ Tcl_SetObjResult(interp, errObjPtr);
+ } else {
+ Tcl_ResetResult(interp);
+ }
+
+ return TCL_OK;
+
+ error:
+ if (ctxt) {
+ xmlSchemaFreeValidCtxt(ctxt);
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ return TCL_ERROR;
+}
+/*
+ * TODO: RelaxNG validation.
+ */
+
+int
+TclDOMTrimCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ xmlDocPtr docPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "doc");
+ }
+
+ if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ TrimDocument(interp, docPtr);
+
+ return TCL_OK;
+}
+
+/*
+ * Remove all blank text nodes
+ *
+ * NB. This code mostly copied from xmlschemas.c
+ */
+
+/** Copied directly from xmlschemas.c:
+ *
+ * xmlSchemaIsBlank:
+ * @str: a string
+ *
+ * Check if a string is ignorable
+ *
+ * Returns 1 if the string is NULL or made of blanks chars, 0 otherwise
+ */
+/* SRB: 2008-11-24: Updated against libxml2 2.7.2.
+ */
+#define IS_BLANK_NODE(n) \
+ (((n)->type == XML_TEXT_NODE) && (xmlSchemaIsBlank((n)->content, -1)))
+
+/*
+ * SRB: 2008-06-12: Updated against libxml2 2.6.32.
+ * See also SF bug 1943963.
+ */
+
+static int
+xmlSchemaIsBlank(xmlChar *str, int len) {
+ if (str == NULL)
+ return(1);
+ if (len < 0) {
+ while (*str != 0) {
+ if (!(IS_BLANK_CH(*str))) return(0);
+ str++;
+ }
+ } else {
+ while ((*str != 0) && (len != 0)) {
+ if (!(IS_BLANK_CH(*str))) return (0);
+ str++;
+ len--;
+ }
+ }
+ return(1);
+}
+
+static void
+TrimDocument(interp, docPtr)
+ Tcl_Interp *interp;
+ xmlDocPtr docPtr;
+{
+ xmlNodePtr root, cur, delete;
+ Tcl_Obj *nodeObjPtr;
+ TclDOM_libxml2_Node *tNodePtr = NULL;
+
+ delete = NULL;
+ root = xmlDocGetRootElement(docPtr);
+ if (root == NULL) {
+ return;
+ }
+ cur = root;
+
+ while (cur != NULL) {
+ if (delete != NULL) {
+ nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, delete);
+ TclDOM_libxml2_GetTclNodeFromObj(interp, nodeObjPtr, &tNodePtr);
+ TclDOM_libxml2_InvalidateNode(tNodePtr);
+ Tcl_DecrRefCount(nodeObjPtr);
+ xmlUnlinkNode(delete);
+ xmlFreeNode(delete);
+ delete = NULL;
+ }
+ if (cur->type == XML_TEXT_NODE) {
+ if (IS_BLANK_NODE(cur)) {
+ if (xmlNodeGetSpacePreserve(cur) != 1) {
+ delete = cur;
+ }
+ }
+ } else if ((cur->type != XML_ELEMENT_NODE) &&
+ (cur->type != XML_CDATA_SECTION_NODE)) {
+ delete = cur;
+ goto skip_children;
+ }
+
+ /*
+ * Skip to next node
+ */
+ if (cur->children != NULL) {
+ if ((cur->children->type != XML_ENTITY_DECL) &&
+ (cur->children->type != XML_ENTITY_REF_NODE) &&
+ (cur->children->type != XML_ENTITY_NODE)) {
+ cur = cur->children;
+ continue;
+ }
+ }
+ skip_children:
+ if (cur->next != NULL) {
+ cur = cur->next;
+ continue;
+ }
+
+ do {
+ cur = cur->parent;
+ if (cur == NULL)
+ break;
+ if (cur == root) {
+ cur = NULL;
+ break;
+ }
+ if (cur->next != NULL) {
+ cur = cur->next;
+ break;
+ }
+ } while (cur != NULL);
+ }
+ if (delete != NULL) {
+ nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, delete);
+ TclDOM_libxml2_GetTclNodeFromObj(interp, nodeObjPtr, &tNodePtr);
+ TclDOM_libxml2_InvalidateNode(tNodePtr);
+ Tcl_DecrRefCount(nodeObjPtr);
+ xmlUnlinkNode(delete);
+ xmlFreeNode(delete);
+ delete = NULL;
+ }
+
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMXIncludeCommand --
+ *
+ * Implements dom::libxml2::xinclude command.
+ *
+ * Results:
+ * Performs XInclude processing on a document.
+ *
+ * Side effects:
+ * The supplied DOM tree may be modified.
+ *
+ *----------------------------------------------------------------------------
+ */
+int
+TclDOMXIncludeCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ xmlDocPtr docPtr;
+ int subs;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "doc");
+ return TCL_ERROR;
+ }
+
+ if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+ subs = xmlXIncludeProcess(docPtr);
+ Tcl_MutexUnlock(&libxml2);
+
+ if (subs < 0) {
+ Tcl_SetResult(interp, "unable to complete XInclude processing", NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(subs));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMPrefix2NSCommand --
+ *
+ * Implements dom::libxml2::prefix2namespaceURI command.
+ *
+ * Results:
+ * Returns namespace URI for a given prefix.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------------
+ */
+int
+TclDOMPrefix2NSCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ xmlNodePtr nodePtr;
+ xmlNsPtr nsPtr;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "node prefix");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ nsPtr = xmlSearchNs(nodePtr->doc, nodePtr, (const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL));
+
+ if (!nsPtr) {
+ Tcl_SetResult(interp, "no XML Namespace declaration", NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nsPtr->href, -1));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMIsNodeCommand --
+ *
+ * Implements dom::libxml2::isNode command.
+ *
+ * Results:
+ * Returns boolean.
+ *
+ * Side effects:
+ * Tcl object may be converted to internal rep.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOMIsNodeCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ xmlDocPtr docPtr;
+ xmlNodePtr nodePtr;
+ TclDOM_libxml2_Node *tNodePtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "token");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) != TCL_OK) {
+ if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
+ if (TclDOM_libxml2_GetTclEventFromObj(interp, objv[1], &tNodePtr) != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+ }
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+ }
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMSelectNodeCommand --
+ *
+ * Implements dom::libxml2::selectnode command.
+ *
+ * Results:
+ * Returns result of XPath expression evaluation.
+ *
+ * Side effects:
+ * Memory is allocated for Tcl object to return result.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOMSelectNodeCommand (dummy, interp, objc, objv)
+ ClientData dummy;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ int i, len, option;
+ char *path;
+ Tcl_Obj *objPtr, *nsOptPtr = NULL, *nodeObjPtr;
+ xmlDocPtr docPtr;
+ xmlNodePtr nodePtr = NULL;
+ xmlXPathContextPtr ctxt = NULL;
+ xmlXPathObjectPtr xpathObj = NULL;
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "doc location-path ?option value...?");
+ return TCL_ERROR;
+ }
+
+ path = Tcl_GetStringFromObj(objv[2], &len);
+ if (len == 0) {
+ return TCL_OK;
+ }
+
+ if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &docPtr) != TCL_OK) {
+ if (TclDOM_libxml2_GetNodeFromObj(interp, objv[1], &nodePtr) == TCL_OK) {
+ docPtr = nodePtr->doc;
+ } else {
+ return TCL_ERROR;
+ }
+ }
+
+ for (i = 3; i < objc; i += 2) {
+ if (i == objc - 1) {
+ Tcl_AppendResult(interp, "missing value for option \"", Tcl_GetStringFromObj(objv[i], NULL), "\"", NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], TclDOM_SelectNodeOptions,
+ "option", 0, &option) != TCL_OK) {
+ goto opt_error;
+ }
+ switch ((enum TclDOM_SelectNodeOptions) option) {
+
+ case TCLDOM_SELECTNODE_OPTION_NAMESPACES:
+ if (nsOptPtr) {
+ if (Tcl_ListObjAppendList(interp, nsOptPtr, objv[i + 1]) != TCL_OK) {
+ Tcl_SetResult(interp, "-namespaces option value must be a list", NULL);
+ goto opt_error;
+ }
+ } else {
+ nsOptPtr = Tcl_DuplicateObj(objv[i + 1]);
+ }
+ if (Tcl_ListObjLength(interp, nsOptPtr, &len) != TCL_OK) {
+ Tcl_SetResult(interp, "-namespaces option value must be a list", NULL);
+ goto opt_error;
+ } else if (len % 2 != 0) {
+ Tcl_SetResult(interp, "value missing from namespaces list", NULL);
+ goto opt_error;
+ }
+
+ break;
+
+ default:
+ Tcl_AppendResult(interp, "unknown option \"", Tcl_GetStringFromObj(objv[i], NULL), "\"", NULL);
+ goto opt_error;
+ }
+ }
+
+ Tcl_MutexLock(&libxml2);
+ ctxt = xmlXPathNewContext(docPtr);
+ if (ctxt == NULL) {
+ Tcl_SetResult(interp, "unable to create XPath context", NULL);
+ return TCL_ERROR;
+ }
+
+ if (nodePtr) {
+ ctxt->node = nodePtr;
+ }
+
+ TclXML_libxml2_ResetError(interp);
+
+ /*
+ * Setup any XML Namespace prefixes given as arguments
+ */
+ if (nsOptPtr) {
+ Tcl_ListObjLength(interp, nsOptPtr, &len);
+ for (i = 0; i < len; i += 2) {
+ Tcl_Obj *prefixPtr, *nsURIPtr;
+
+ Tcl_ListObjIndex(interp, nsOptPtr, i, &prefixPtr);
+ Tcl_ListObjIndex(interp, nsOptPtr, i + 1, &nsURIPtr);
+ if (xmlXPathRegisterNs(ctxt,
+ (const xmlChar *) Tcl_GetStringFromObj(prefixPtr, NULL),
+ (const xmlChar *) Tcl_GetStringFromObj(nsURIPtr, NULL))) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "unable to register XML Namespace \"", Tcl_GetStringFromObj(nsURIPtr, NULL), "\"", NULL);
+ goto error;
+ }
+ }
+ }
+
+ xpathObj = xmlXPathEval((const xmlChar *) path, ctxt);
+
+ if (xpathObj == NULL) {
+ Tcl_Obj *errObjPtr = TclXML_libxml2_GetErrorObj(interp);
+
+ if (errObjPtr) {
+ Tcl_SetObjResult(interp, errObjPtr);
+ goto error;
+ } else {
+ Tcl_SetResult(interp, "error evaluating XPath location path", NULL);
+ goto error;
+ }
+ }
+
+ objPtr = Tcl_NewObj();
+ switch (xpathObj->type) {
+
+ case XPATH_NODESET:
+ len = xmlXPathNodeSetGetLength(xpathObj->nodesetval);
+ for (i = 0; i < len; i++) {
+ nodePtr = xmlXPathNodeSetItem(xpathObj->nodesetval, i);
+ nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, nodePtr);
+ if (nodeObjPtr != NULL) {
+ Tcl_ListObjAppendElement(interp, objPtr, nodeObjPtr);
+ } else {
+ Tcl_MutexUnlock(&libxml2);
+ Tcl_DecrRefCount(objPtr);
+ return TCL_ERROR;
+ }
+ }
+ break;
+
+ case XPATH_BOOLEAN:
+ Tcl_SetBooleanObj(objPtr, xpathObj->boolval);
+ break;
+
+ case XPATH_NUMBER:
+ Tcl_SetDoubleObj(objPtr, xpathObj->floatval);
+ break;
+
+ case XPATH_STRING:
+ Tcl_SetStringObj(objPtr,
+ (CONST char *) xpathObj->stringval,
+ strlen((char *) xpathObj->stringval));
+ break;
+
+ default:
+ Tcl_SetResult(interp, "bad XPath object type", NULL);
+ goto error2;
+ }
+
+ if (nsOptPtr) {
+ Tcl_DecrRefCount(nsOptPtr);
+ }
+ xmlXPathFreeObject(xpathObj);
+ xmlXPathFreeContext(ctxt);
+
+ Tcl_MutexUnlock(&libxml2);
+
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+
+ opt_error:
+
+ Tcl_MutexUnlock(&libxml2);
+
+ if (nsOptPtr) {
+ Tcl_DecrRefCount(nsOptPtr);
+ return TCL_ERROR;
+ }
+
+ error2:
+ if (nsOptPtr) {
+ Tcl_DecrRefCount(nsOptPtr);
+ }
+ xmlXPathFreeObject(xpathObj);
+ xmlXPathFreeContext(ctxt);
+
+ Tcl_MutexUnlock(&libxml2);
+
+ return TCL_ERROR;
+
+ error:
+ if (nsOptPtr) {
+ Tcl_DecrRefCount(nsOptPtr);
+ }
+ xmlXPathFreeContext(ctxt);
+
+ Tcl_MutexUnlock(&libxml2);
+
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMDocumentCommand --
+ *
+ * Implements dom::libxml2::document command.
+ *
+ * Results:
+ * Depends on method.
+ *
+ * Side effects:
+ * Depends on method.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOMDocumentCommand (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ TclXML_libxml2_Document *tDocPtr;
+ TclDOM_libxml2_Document *domDocPtr = NULL;
+ enum TclDOM_EventTypes type;
+ int method, optobjc, wrongidx = 1, postMutationEvent = 0, idx, len;
+ xmlDocPtr docPtr = NULL;
+ xmlNodePtr nodePtr = NULL, newNodePtr = NULL;
+ xmlNsPtr nsPtr = NULL;
+ Tcl_Obj *nodeObjPtr = NULL, *newNodeObjPtr = NULL;
+ Tcl_Obj *CONST *optobjv;
+ char *buf, *bufptr, *prefix;
+
+ if (clientData == NULL) {
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "method token ?args...?");
+ return TCL_ERROR;
+ }
+
+ if (TclXML_libxml2_GetTclDocFromObj(interp, objv[2], &tDocPtr) != TCL_OK) {
+ tDocPtr = NULL;
+ docPtr = NULL;
+ if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
+ return TCL_ERROR;
+ } else {
+ nodeObjPtr = objv[2];
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ } else {
+ docPtr = tDocPtr->docPtr;
+ domDocPtr = GetDOMDocument(interp, tDocPtr);
+ if (domDocPtr == NULL) {
+ Tcl_SetResult(interp, "internal error", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ optobjv = objv + 3;
+ optobjc = objc - 3;
+ wrongidx = 3;
+
+ } else {
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?");
+ return TCL_ERROR;
+ }
+
+ domDocPtr = (TclDOM_libxml2_Document *) clientData;
+ tDocPtr = domDocPtr->tDocPtr;
+ docPtr = tDocPtr->docPtr;
+
+ optobjv = objv + 2;
+ optobjc = objc - 2;
+ wrongidx = 2;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_DocumentCommandMethods,
+ "method", 0, &method) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_ResetResult(interp);
+
+ switch ((enum TclDOM_DocumentCommandMethods) method) {
+
+ case TCLDOM_DOCUMENT_CGET:
+
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "option");
+ return TCL_ERROR;
+ }
+
+ if (!docPtr) {
+ Tcl_SetResult(interp, "not a document", NULL);
+ return TCL_ERROR;
+ }
+
+ return DocumentCget(interp, docPtr, optobjv[0]);
+
+ break;
+
+ case TCLDOM_DOCUMENT_CONFIGURE:
+
+ if (!docPtr) {
+ Tcl_SetResult(interp, "not a document", NULL);
+ return TCL_ERROR;
+ }
+
+ if (optobjc == 1) {
+ return DocumentCget(interp, docPtr, optobjv[0]);
+ } else {
+ Tcl_AppendResult(interp, "attribute \"", Tcl_GetStringFromObj(optobjv[0], NULL), "\" is read-only", NULL);
+ return TCL_ERROR;
+ }
+
+ break;
+
+ case TCLDOM_DOCUMENT_CREATEELEMENTNS:
+ if (optobjc != 2) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "nsuri qualname");
+ return TCL_ERROR;
+ }
+
+ /*
+ * libxml2 doesn't check for invalid element name,
+ * so must do that here.
+ */
+ if (Tcl_RegExpMatchObj(interp, optobjv[1], checkQName) == 0) {
+ Tcl_SetResult(interp, "invalid element name", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Find localName of element */
+ buf = Tcl_GetStringFromObj(optobjv[1], &len);
+ for (idx = 0; buf[idx] != ':' && idx < len; idx++) ;
+ if (idx == len) {
+ /* no prefix was given */
+ bufptr = buf;
+ } else {
+ /* NB. name must have a local part, since it is a valid QName */
+ bufptr = &buf[idx + 1];
+ }
+
+ if (docPtr && clientData == NULL) {
+ /* We're creating the document element, so must create the namespace too */
+ xmlNodePtr old;
+
+ Tcl_MutexLock(&libxml2);
+ newNodePtr = xmlNewDocNode(docPtr, NULL, (const xmlChar *) bufptr, NULL);
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create element node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+ old = xmlDocSetRootElement(docPtr, newNodePtr);
+ if (old) {
+ xmlDocSetRootElement(docPtr, old);
+ xmlFreeNode(newNodePtr);
+ Tcl_SetResult(interp, "document element already exists", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ if (idx < len) {
+ prefix = Tcl_Alloc(bufptr - buf);
+ strncpy(prefix, buf, bufptr - buf - 1);
+ prefix[bufptr - buf - 1] = '\0';
+ } else {
+ /* synthesize prefix for this XML Namespace */
+ prefix = Tcl_Alloc(20);
+ sprintf(prefix, "ns%d", domDocPtr->nodeCntr++);
+ }
+
+ nsPtr = xmlNewNs(newNodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), (const xmlChar *) prefix);
+ if (nsPtr == NULL) {
+ Tcl_SetResult(interp, "unable to create XML Namespace", NULL);
+ Tcl_Free(prefix);
+ xmlUnlinkNode(newNodePtr);
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ xmlSetNs(newNodePtr, nsPtr);
+
+ Tcl_MutexUnlock(&libxml2);
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ Tcl_MutexLock(&libxml2);
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+
+ return TCL_ERROR;
+ }
+
+ postMutationEvent = 1;
+
+ } else if (docPtr && clientData != NULL) {
+ /* Create an unattached element node */
+ Tcl_MutexLock(&libxml2);
+ newNodePtr = xmlNewDocNode(docPtr, NULL, (const xmlChar *) bufptr, NULL);
+
+ if (idx < len) {
+ prefix = Tcl_Alloc(bufptr - buf);
+ strncpy(prefix, buf, bufptr - buf - 1);
+ prefix[bufptr - buf - 1] = '\0';
+ } else {
+ /* synthesize prefix for this XML Namespace */
+ prefix = Tcl_Alloc(20);
+ sprintf(prefix, "ns%d", domDocPtr->nodeCntr);
+ }
+
+ nsPtr = xmlNewNs(newNodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL), (const xmlChar *) prefix);
+ if (nsPtr == NULL) {
+ Tcl_SetResult(interp, "unable to create XML Namespace", NULL);
+ Tcl_Free(prefix);
+ xmlUnlinkNode(newNodePtr);
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ xmlSetNs(newNodePtr, nsPtr);
+
+ Tcl_MutexUnlock(&libxml2);
+
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create element node", NULL);
+ return TCL_ERROR;
+ }
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ Tcl_MutexLock(&libxml2);
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, newNodeObjPtr);
+ }
+
+ /*
+ * The tree hasn't changed yet, so no events need to be fired.
+ */
+ postMutationEvent = 0;
+
+ } else {
+
+ Tcl_MutexLock(&libxml2);
+ /* Find XML Namespace */
+ nsPtr = xmlSearchNsByHref(nodePtr->doc,
+ nodePtr,
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
+ if (nsPtr == NULL) {
+ if (idx < len) {
+ prefix = Tcl_Alloc(bufptr - buf);
+ strncpy(prefix, buf, bufptr - buf - 1);
+ prefix[bufptr - buf - 1] = '\0';
+ } else {
+ prefix = Tcl_Alloc(20);
+ sprintf(prefix, "ns%d", domDocPtr->nodeCntr++);
+ }
+
+ newNodePtr = xmlNewChild(nodePtr, NULL, (const xmlChar *) bufptr, NULL);
+ nsPtr = xmlNewNs(newNodePtr,
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
+ (const xmlChar *) prefix);
+ if (nsPtr == NULL) {
+ Tcl_SetResult(interp, "unable to create XML Namespace", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+ xmlSetNs(newNodePtr, nsPtr);
+
+ } else {
+ newNodePtr = xmlNewChild(nodePtr, nsPtr, (const xmlChar *) bufptr, NULL);
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create element node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ Tcl_MutexLock(&libxml2);
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ postMutationEvent = 1;
+ }
+
+ break;
+
+ case TCLDOM_DOCUMENT_CREATEELEMENT:
+
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "name");
+ return TCL_ERROR;
+ }
+
+ /*
+ * libxml2 doesn't check for invalid element name,
+ * so must do that here.
+ */
+ if (Tcl_RegExpMatchObj(interp, optobjv[0], checkName) == 0) {
+ Tcl_AppendResult(interp, "invalid element name \"", Tcl_GetStringFromObj(optobjv[0], NULL), "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ if (docPtr && clientData == NULL) {
+ xmlNodePtr old;
+ newNodePtr = xmlNewDocNode(docPtr,
+ NULL,
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
+ NULL);
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create element node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+ old = xmlDocSetRootElement(docPtr, newNodePtr);
+ if (old) {
+ xmlDocSetRootElement(docPtr, old);
+ xmlFreeNode(newNodePtr);
+ Tcl_SetResult(interp, "document element already exists", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ postMutationEvent = 1;
+ } else if (docPtr && clientData != NULL) {
+ /* Create an unattached element node */
+ newNodePtr = xmlNewDocNode(docPtr,
+ NULL,
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
+ NULL);
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create element node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, newNodeObjPtr);
+ }
+
+ /*
+ * The tree hasn't changed yet, so no events need to be fired.
+ */
+ postMutationEvent = 0;
+ } else {
+ newNodePtr = xmlNewChild(nodePtr,
+ NULL,
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
+ NULL);
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create element node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+ postMutationEvent = 1;
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ break;
+
+ case TCLDOM_DOCUMENT_CREATEDOCUMENTFRAGMENT:
+
+ if (optobjc != 0) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "");
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ if (docPtr) {
+ newNodePtr = xmlNewDocFragment(docPtr);
+ } else {
+ newNodePtr = xmlNewDocFragment(nodePtr->doc);
+ }
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create document fragment", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, newNodeObjPtr);
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ /* The node hasn't been inserted into the tree yet */
+ postMutationEvent = 0;
+
+ break;
+
+ case TCLDOM_DOCUMENT_CREATETEXTNODE:
+
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "text");
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ if (docPtr) {
+ char *content;
+ int len;
+
+ content = Tcl_GetStringFromObj(optobjv[0], &len);
+ newNodePtr = xmlNewDocTextLen(docPtr, (const xmlChar *) content, len);
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create text node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, newNodeObjPtr);
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ postMutationEvent = 0;
+
+ } else {
+ xmlNodePtr returnNode;
+ char *content;
+ int len;
+
+ content = Tcl_GetStringFromObj(optobjv[0], &len);
+ newNodePtr = xmlNewTextLen((const xmlChar *) content, len);
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "creating text node failed", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+ returnNode = xmlAddChild(nodePtr, newNodePtr);
+ if (returnNode == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_SetResult(interp, "add child failed", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ postMutationEvent = 1;
+ }
+
+ break;
+
+ case TCLDOM_DOCUMENT_CREATECOMMENT:
+
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "data");
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ if (docPtr) {
+ newNodePtr = xmlNewDocComment(docPtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create comment node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, newNodeObjPtr);
+ }
+
+ postMutationEvent = 0;
+
+ } else {
+ newNodePtr = xmlNewDocComment(nodePtr->doc, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create comment node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+ xmlAddChild(nodePtr, newNodePtr);
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ postMutationEvent = 1;
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ break;
+
+ case TCLDOM_DOCUMENT_CREATECDATASECTION:
+
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "text");
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ if (docPtr) {
+ char *content;
+ int len;
+
+ content = Tcl_GetStringFromObj(optobjv[0], &len);
+ newNodePtr = xmlNewDocTextLen(docPtr, (const xmlChar *) content, len);
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create text node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, newNodeObjPtr);
+ }
+
+ postMutationEvent = 0;
+
+ } else {
+ char *content;
+ int len;
+
+ content = Tcl_GetStringFromObj(optobjv[0], &len);
+ newNodePtr = xmlNewTextLen((const xmlChar *) content, len);
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create text node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+ xmlAddChild(nodePtr, newNodePtr);
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ postMutationEvent = 1;
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ break;
+
+ case TCLDOM_DOCUMENT_CREATEPI:
+ if (optobjc != 2) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "target data");
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ newNodePtr = xmlNewPI((const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL));
+ if (newNodePtr == NULL) {
+ Tcl_SetResult(interp, "unable to create processing instruction node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ if (docPtr) {
+ /*
+ * libxml2 does not provide 'xmlNewDocPI' so the PI must be added to the tree
+ * before we wrap it in an object. We'll use the document element as a placeholder
+ * for the PI node; the user may move it from there.
+ */
+ xmlNodePtr docElPtr = xmlDocGetRootElement(docPtr);
+
+ if (docElPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ Tcl_SetResult(interp, "document element must exist before adding a PI", NULL);
+ return TCL_ERROR;
+ }
+ xmlAddNextSibling(docElPtr, newNodePtr);
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, newNodeObjPtr);
+ }
+
+ postMutationEvent = 0;
+
+ } else {
+ xmlAddChild(nodePtr, newNodePtr);
+
+ newNodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, newNodePtr);
+ if (newNodeObjPtr == NULL) {
+ xmlFreeNode(newNodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ postMutationEvent = 1;
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ break;
+
+ case TCLDOM_DOCUMENT_CREATEEVENT:
+
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "type");
+ return TCL_ERROR;
+ }
+
+ if (!docPtr) {
+ docPtr = nodePtr->doc;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_EventTypes,
+ "type", TCL_EXACT, &method) == TCL_OK) {
+ type = (enum TclDOM_EventTypes) method;
+ } else {
+ type = TCLDOM_EVENT_USERDEFINED;
+ }
+
+ newNodeObjPtr = TclDOM_libxml2_NewEventObj(interp, docPtr, type, optobjv[0]);
+ if (newNodeObjPtr == NULL) {
+ return TCL_ERROR;
+ } else {
+ Tcl_SetObjResult(interp, newNodeObjPtr);
+ }
+
+ postMutationEvent = 0;
+
+ break;
+
+ case TCLDOM_DOCUMENT_SCHEMA:
+
+ if (optobjc < 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "submethod ?args ...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_DocumentSchemaSubmethods,
+ "submethod", 0, &method) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum TclDOM_DocumentSchemaSubmethods) method) {
+ case TCLDOM_DOCUMENT_SCHEMA_COMPILE:
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "compile");
+ return TCL_ERROR;
+ }
+ return SchemaCompile(interp, domDocPtr);
+
+ case TCLDOM_DOCUMENT_SCHEMA_VALIDATE:
+ if (optobjc != 2) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "validate instance");
+ return TCL_ERROR;
+ } else {
+ xmlDocPtr instancePtr;
+
+ if (TclXML_libxml2_GetDocFromObj(interp, optobjv[1], &instancePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return SchemaValidate(interp, domDocPtr, instancePtr);
+ }
+
+ break;
+
+ default:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "unknown submethod \"",
+ Tcl_GetStringFromObj(optobjv[0], NULL), "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ break;
+
+ case TCLDOM_DOCUMENT_DTD:
+
+ if (optobjc < 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "submethod ?args...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_DocumentDTDSubmethods,
+ "submethod", 0, &method) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum TclDOM_DocumentDTDSubmethods) method) {
+ case TCLDOM_DOCUMENT_DTD_VALIDATE:
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "validate");
+ return TCL_ERROR;
+ } else {
+ return DTDValidate(interp, domDocPtr);
+ }
+ default:
+ Tcl_SetResult(interp, "unknown submethod", NULL);
+ return TCL_ERROR;
+ }
+
+ break;
+
+ case TCLDOM_DOCUMENT_CREATEATTRIBUTE:
+ case TCLDOM_DOCUMENT_CREATEENTITY:
+ case TCLDOM_DOCUMENT_CREATEENTITYREFERENCE:
+ case TCLDOM_DOCUMENT_CREATEDOCTYPEDECL:
+ default:
+ Tcl_SetResult(interp, "method \"", NULL);
+ Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL);
+ return TCL_ERROR;
+ }
+
+ if (postMutationEvent) {
+
+ TclDOM_PostMutationEvent(interp, tDocPtr, newNodeObjPtr, TCLDOM_EVENT_DOMNODEINSERTED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), objv[2], NULL, NULL, NULL, NULL);
+ TclDOM_PostMutationEvent(interp, tDocPtr, newNodeObjPtr, TCLDOM_EVENT_DOMNODEINSERTEDINTODOCUMENT, NULL, Tcl_NewIntObj(0), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
+
+ if (nodePtr) {
+ TclDOM_PostMutationEvent(interp, tDocPtr, nodeObjPtr, TCLDOM_EVENT_DOMSUBTREEMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
+ } else {
+ /*
+ * We just added the document element.
+ */
+ }
+
+ Tcl_SetObjResult(interp, newNodeObjPtr);
+ }
+
+ return TCL_OK;
+}
+
+int
+DocumentCget(interp, docPtr, optObj)
+ Tcl_Interp *interp;
+ xmlDocPtr docPtr;
+ Tcl_Obj *CONST optObj;
+{
+ xmlNodePtr nodePtr;
+ int option;
+
+ if (Tcl_GetIndexFromObj(interp, optObj, TclDOM_DocumentCommandOptions,
+ "option", 0, &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum TclDOM_DocumentCommandOptions) option) {
+
+ case TCLDOM_DOCUMENT_DOCTYPE:
+ Tcl_SetResult(interp, "cget option \"", NULL);
+ Tcl_AppendResult(interp, Tcl_GetStringFromObj(optObj, NULL), NULL);
+ Tcl_AppendResult(interp, "\" not yet implemented", NULL);
+ return TCL_ERROR;
+
+ case TCLDOM_DOCUMENT_IMPLEMENTATION:
+ Tcl_SetResult(interp, "::dom::libxml2::DOMImplementation", NULL);
+ break;
+
+ case TCLDOM_DOCUMENT_DOCELEMENT:
+
+ Tcl_MutexLock(&libxml2);
+ nodePtr = xmlDocGetRootElement(docPtr);
+ Tcl_MutexUnlock(&libxml2);
+
+ if (nodePtr) {
+ Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr));
+ } else {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+ break;
+
+ default:
+ Tcl_SetResult(interp, "unknown option", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TriggerEventListeners --
+ *
+ * Iterates through the list of event listeners for
+ * a node or document and fires events.
+ *
+ * Results:
+ * Depends on listeners.
+ *
+ * Side effects:
+ * Depends on listeners.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+static int
+TriggerEventListeners(interp, type, tokenPtr, eventObjPtr, eventPtr)
+ Tcl_Interp *interp;
+ Tcl_HashTable *type;
+ void *tokenPtr;
+ Tcl_Obj *eventObjPtr;
+ TclDOM_libxml2_Event *eventPtr;
+{
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashTable *tablePtr;
+ Tcl_Obj *listenerListPtr;
+ int listenerLen, listenerIdx;
+ char *eventType;
+
+ entryPtr = Tcl_FindHashEntry(type, tokenPtr);
+ if (!entryPtr) {
+ return TCL_OK;
+ }
+ tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr);
+
+ if (eventPtr->type != TCLDOM_EVENT_USERDEFINED) {
+ eventType = (char *) TclDOM_EventTypes[eventPtr->type];
+ } else {
+ eventType = Tcl_GetStringFromObj(eventPtr->typeObjPtr, NULL);
+ }
+ entryPtr = Tcl_FindHashEntry(tablePtr, eventType);
+ if (!entryPtr) {
+ return TCL_OK;
+ }
+ listenerListPtr = (Tcl_Obj *) Tcl_GetHashValue(entryPtr);
+
+ /*
+ * DOM L2 specifies that the ancestors are determined
+ * at the moment of event dispatch, so using a static
+ * list is the correct thing to do.
+ */
+
+ Tcl_ListObjLength(interp, listenerListPtr, &listenerLen);
+ for (listenerIdx = 0; listenerIdx < listenerLen; listenerIdx++) {
+ Tcl_Obj *listenerObj, *cmdPtr;
+
+ Tcl_ListObjIndex(interp, listenerListPtr, listenerIdx, &listenerObj);
+
+ cmdPtr = Tcl_DuplicateObj(listenerObj);
+ Tcl_IncrRefCount(cmdPtr);
+ if (Tcl_ListObjAppendElement(interp, cmdPtr, eventObjPtr) != TCL_OK) {
+ Tcl_DecrRefCount(cmdPtr);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) interp);
+ if (Tcl_GlobalEvalObj(interp, cmdPtr) != TCL_OK) {
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_DecrRefCount(cmdPtr);
+ Tcl_Release((ClientData) interp);
+ }
+
+ return TCL_OK;
+}
+
+static int
+TclDOMSetLiveNodeListNode(interp, varName, nodePtr)
+ Tcl_Interp *interp;
+ char *varName;
+ xmlNodePtr nodePtr;
+{
+ Tcl_Obj *valuePtr = Tcl_NewListObj(0, NULL);
+ xmlNodePtr childPtr;
+
+ for (childPtr = nodePtr->children; childPtr; childPtr = childPtr->next) {
+ Tcl_ListObjAppendElement(interp, valuePtr, TclDOM_libxml2_CreateObjFromNode(interp, childPtr));
+ }
+
+ Tcl_SetVar2Ex(interp, varName, NULL, valuePtr, TCL_GLOBAL_ONLY);
+
+ return TCL_OK;
+}
+
+static int
+TclDOMSetLiveNodeListDoc(interp, varName, docPtr)
+ Tcl_Interp *interp;
+ char *varName;
+ xmlDocPtr docPtr;
+{
+ Tcl_Obj *valuePtr = Tcl_NewListObj(0, NULL);
+ xmlNodePtr childPtr;
+
+ for (childPtr = docPtr->children; childPtr; childPtr = childPtr->next) {
+ Tcl_ListObjAppendElement(interp, valuePtr, TclDOM_libxml2_CreateObjFromNode(interp, childPtr));
+ }
+
+ Tcl_SetVar2Ex(interp, varName, NULL, valuePtr, TCL_GLOBAL_ONLY);
+
+ return TCL_OK;
+}
+
+static char *
+TclDOMLiveNodeListNode(clientData, interp, name1, name2, flags)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ char *name1;
+ char *name2;
+ int flags;
+{
+ xmlNodePtr nodePtr = (xmlNodePtr) clientData;
+
+ if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
+ return NULL;
+ } else if (flags & TCL_TRACE_READS) {
+ TclDOMSetLiveNodeListNode(interp, name1, nodePtr);
+ } else if (flags & TCL_TRACE_WRITES) {
+ TclDOMSetLiveNodeListNode(interp, name1, nodePtr);
+ return "variable is read-only";
+ } else if (flags & TCL_TRACE_UNSETS) {
+ }
+
+ return NULL;
+}
+static char *
+TclDOMLiveNodeListDoc(clientData, interp, name1, name2, flags)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ char *name1;
+ char *name2;
+ int flags;
+{
+ xmlDocPtr docPtr = (xmlDocPtr) clientData;
+
+ if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
+ return NULL;
+ } else if (flags & TCL_TRACE_READS) {
+ TclDOMSetLiveNodeListDoc(interp, name1, docPtr);
+ } else if (flags & TCL_TRACE_WRITES) {
+ TclDOMSetLiveNodeListDoc(interp, name1, docPtr);
+ return "variable is read-only";
+ } else if (flags & TCL_TRACE_UNSETS) {
+ }
+
+ return NULL;
+}
+
+static int
+TclDOMSetLiveNamedNodeMap(interp, varName, nodePtr)
+ Tcl_Interp *interp;
+ char *varName;
+ xmlNodePtr nodePtr;
+{
+ xmlAttrPtr attrPtr;
+
+ Tcl_UnsetVar(interp, varName, TCL_GLOBAL_ONLY);
+
+ for (attrPtr = nodePtr->properties; attrPtr; attrPtr = attrPtr->next) {
+
+ if (Tcl_SetVar2Ex(interp, varName, (char *) attrPtr->name, Tcl_NewStringObj((CONST char *) xmlGetProp(nodePtr, attrPtr->name), -1), TCL_GLOBAL_ONLY) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "unable to set attribute \"", attrPtr->name, "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_TraceVar2(interp, varName, (char *) attrPtr->name, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNamedNodeMap, (ClientData) nodePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ return TCL_OK;
+}
+
+static char *
+TclDOMLiveNamedNodeMap(clientData, interp, name1, name2, flags)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ char *name1;
+ char *name2;
+ int flags;
+{
+ xmlNodePtr nodePtr = (xmlNodePtr) clientData;
+
+ if (flags & (TCL_INTERP_DESTROYED | TCL_TRACE_DESTROYED)) {
+ return NULL;
+ } else if (flags & TCL_TRACE_READS && name2 == NULL) {
+ TclDOMSetLiveNamedNodeMap(interp, name1, nodePtr);
+ } else if (flags & TCL_TRACE_READS && name2 != NULL) {
+ if (Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewStringObj((CONST char *) xmlGetProp(nodePtr, (const xmlChar *) name2), -1), TCL_GLOBAL_ONLY) == NULL) {
+ return "unable to set attribute";
+ }
+ } else if (flags & TCL_TRACE_WRITES) {
+ TclDOMSetLiveNamedNodeMap(interp, name1, nodePtr);
+ return "variable is read-only";
+ } else if (flags & TCL_TRACE_UNSETS) {
+ }
+
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMNodeCommand --
+ *
+ * Implements dom::libxml2::node command.
+ *
+ * Results:
+ * Depends on method.
+ *
+ * Side effects:
+ * Depends on method.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOMNodeCommand (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ TclXML_libxml2_Document *tDocPtr;
+ TclDOM_libxml2_Node *tNodePtr;
+ int method, optobjc, option, wrongidx, usecapture = 0;
+ char *buf;
+ xmlNodePtr nodePtr = NULL, childNodePtr, refPtr, newPtr, oldParent;
+ xmlDocPtr docPtr = NULL;
+ Tcl_Obj *nodeObjPtr = NULL;
+ Tcl_Obj *docObjPtr = NULL;
+ Tcl_Obj *resultPtr;
+ Tcl_Obj *CONST *optobjv;
+
+ if (clientData == NULL) {
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "method token ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetTclNodeFromObj(interp, objv[2], &tNodePtr) != TCL_OK) {
+ if (TclXML_libxml2_GetTclDocFromObj(interp, objv[2], &tDocPtr) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "\"", Tcl_GetStringFromObj(objv[2], NULL), "\" is neither a DOM document nor a DOM node", NULL);
+ return TCL_ERROR;
+ } else {
+ Tcl_ResetResult(interp);
+ docObjPtr = objv[2];
+ docPtr = tDocPtr->docPtr;
+ nodeObjPtr = NULL;
+ nodePtr = NULL;
+ }
+ } else {
+ nodePtr = tNodePtr->ptr.nodePtr;
+ nodeObjPtr = objv[2];
+ docPtr = NULL;
+ docObjPtr = NULL;
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ optobjc = objc - 3;
+ optobjv = objv + 3;
+ wrongidx = 3;
+
+ } else {
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "method ?arg ...?");
+ return TCL_ERROR;
+ }
+
+ tNodePtr = (TclDOM_libxml2_Node *) clientData;
+ nodePtr = tNodePtr->ptr.nodePtr;
+ nodeObjPtr = NULL;
+ docPtr = NULL;
+ docObjPtr = NULL;
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ optobjc = objc - 2;
+ optobjv = objv + 2;
+ wrongidx = 2;
+
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_NodeCommandMethods,
+ "method", 0, &method) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum TclDOM_NodeCommandMethods) method) {
+
+ case TCLDOM_NODE_CGET:
+
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "option");
+ return TCL_ERROR;
+ }
+
+ NodeCget(interp, docPtr, nodePtr, optobjv[0]);
+
+ break;
+
+ case TCLDOM_NODE_PATH:
+
+ if (docPtr) {
+ Tcl_Obj *newobjv[2];
+
+ newobjv[0] = TclXML_libxml2_CreateObjFromDoc(docPtr);
+ newobjv[1] = NULL;
+ Tcl_SetObjResult(interp, Tcl_NewListObj(1, newobjv));
+ } else {
+ Tcl_SetObjResult(interp, GetPath(interp, nodePtr));
+ }
+
+ break;
+
+ case TCLDOM_NODE_CONFIGURE:
+
+ if (optobjc < 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "option ?value? ?option value ...?");
+ return TCL_ERROR;
+ }
+
+ if (optobjc == 1) {
+ return NodeCget(interp, docPtr, nodePtr, optobjv[0]);
+ }
+
+ if (optobjc % 2 == 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "option ?value? ?option value ...?");
+ return TCL_ERROR;
+ }
+
+ return NodeConfigure(interp, nodePtr, optobjc, optobjv);
+ break;
+
+ case TCLDOM_NODE_INSERTBEFORE:
+ if (optobjc < 1 || optobjc > 2) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "ref ?new?");
+ return TCL_ERROR;
+ } else if (docPtr) {
+ /* TODO: allow comments & PIs in document prologue */
+ Tcl_SetResult(interp, "document already has document element", NULL);
+ return TCL_ERROR;
+ } else if (optobjc == 1) {
+ /* No reference child specified - new appended to child list */
+ if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &newPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TclDOM_NodeAppendChild(interp, nodePtr, newPtr);
+ } else if (optobjc == 2) {
+ if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &newPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[1], &refPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TclDOM_NodeInsertBefore(interp, refPtr, newPtr);
+ }
+
+ break;
+
+ case TCLDOM_NODE_REPLACECHILD:
+ if (optobjc != 2) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "new old");
+ return TCL_ERROR;
+ } else if (docPtr) {
+ /* TODO: allow replacing comments & PIs */
+ Tcl_SetResult(interp, "document already has document element", NULL);
+ return TCL_ERROR;
+ } else {
+ if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &newPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[1], &refPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ oldParent = newPtr->parent;
+ if (oldParent != refPtr->parent) {
+ TclDOM_PostMutationEvent(interp,
+ tDocPtr,
+ TclDOM_libxml2_CreateObjFromNode(interp, newPtr),
+ TCLDOM_EVENT_DOMNODEREMOVED,
+ NULL,
+ Tcl_NewIntObj(1), Tcl_NewIntObj(0),
+ TclDOM_libxml2_CreateObjFromNode(interp, newPtr->parent),
+ NULL, NULL, NULL, NULL);
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ if (xmlReplaceNode(refPtr, newPtr) == NULL) {
+ Tcl_SetResult(interp, "unable to replace node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ }
+
+ PostMutationEvents(interp, tDocPtr, nodePtr, refPtr, newPtr, oldParent, refPtr->parent);
+
+ Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, refPtr));
+
+ break;
+
+ case TCLDOM_NODE_REMOVECHILD:
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "child");
+ return TCL_ERROR;
+ } else if (docPtr) {
+ /* TODO: allow removing comments & PIs */
+ Tcl_SetResult(interp, "document must have document element", NULL);
+ return TCL_ERROR;
+ } else {
+ xmlNodePtr childPtr;
+ if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &childPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (nodePtr != childPtr->parent) {
+ Tcl_SetResult(interp, "not found: \"", NULL);
+ Tcl_AppendResult(interp, Tcl_GetStringFromObj(optobjv[0], NULL),
+ "\" is not a child", NULL);
+ if (nodeObjPtr) {
+ Tcl_AppendResult(interp, " of \"",
+ Tcl_GetStringFromObj(nodeObjPtr, NULL), "\"", NULL);
+ }
+ return TCL_ERROR;
+ }
+ oldParent = childPtr->parent;
+ TclDOM_PostMutationEvent(interp,
+ tDocPtr, optobjv[0],
+ TCLDOM_EVENT_DOMNODEREMOVED,
+ NULL,
+ Tcl_NewIntObj(1), Tcl_NewIntObj(0),
+ TclDOM_libxml2_CreateObjFromNode(interp, oldParent),
+ NULL, NULL, NULL, NULL);
+ TclDOM_PostMutationEvent(interp,
+ tDocPtr, optobjv[0],
+ TCLDOM_EVENT_DOMNODEREMOVEDFROMDOCUMENT,
+ NULL,
+ Tcl_NewIntObj(0), Tcl_NewIntObj(0),
+ NULL, NULL, NULL, NULL, NULL);
+
+ Tcl_MutexLock(&libxml2);
+ xmlUnlinkNode(childPtr);
+ Tcl_MutexUnlock(&libxml2);
+
+ Tcl_SetObjResult(interp, optobjv[0]);
+ TclDOM_PostMutationEvent(interp,
+ tDocPtr,
+ TclDOM_libxml2_CreateObjFromNode(interp, oldParent),
+ TCLDOM_EVENT_DOMSUBTREEMODIFIED,
+ NULL,
+ Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, NULL, NULL);
+ }
+
+ break;
+
+ case TCLDOM_NODE_APPENDCHILD:
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "child");
+ return TCL_ERROR;
+ } else if (docPtr) {
+ xmlNodePtr oldPtr;
+
+ if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &childNodePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ /* TODO: allow appending comments & PIs */
+ oldPtr = xmlDocSetRootElement(docPtr, childNodePtr);
+ if (oldPtr) {
+ xmlDocSetRootElement(docPtr, oldPtr);
+ Tcl_SetResult(interp, "document element already exists", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ Tcl_SetObjResult(interp, optobjv[0]);
+
+ } else {
+ if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &childNodePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return TclDOM_NodeAppendChild(interp, nodePtr, childNodePtr);
+ }
+
+ break;
+
+ case TCLDOM_NODE_HASCHILDNODES:
+ if (docPtr) {
+ if (docPtr->children) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ }
+ } else {
+ if (nodePtr->children) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ }
+ }
+
+ break;
+
+ case TCLDOM_NODE_ISSAMENODE:
+ /* DOM Level 3 method */
+
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "ref");
+ return TCL_ERROR;
+ }
+
+ if (docPtr) {
+ xmlDocPtr docRefPtr;
+
+ if (TclXML_libxml2_GetDocFromObj(interp, optobjv[0], &docRefPtr) != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ return TCL_OK;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(docPtr == docRefPtr));
+
+ } else {
+ if (TclDOM_libxml2_GetNodeFromObj(interp, optobjv[0], &refPtr) != TCL_OK) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ return TCL_OK;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(nodePtr == refPtr));
+ }
+
+ break;
+
+ case TCLDOM_NODE_CLONENODE:
+ if (optobjc != 0 && optobjc != 2) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "?-deep boolean?");
+ return TCL_ERROR;
+ } else if (docPtr) {
+ Tcl_SetResult(interp, "documents cannot be cloned", NULL);
+ return TCL_ERROR;
+ } else {
+ int deep = 0;
+ xmlNodePtr copyPtr;
+
+ if (optobjc == 2) {
+ if (Tcl_RegExpMatchObj(interp, optobjv[0], Tcl_NewStringObj("-de?e?p?", -1)) == 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "invalid option \"", Tcl_GetStringFromObj(optobjv[0], NULL), "\", must be \"-deep\"", NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetBooleanFromObj(interp, optobjv[1], &deep) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ Tcl_MutexLock(&libxml2);
+ copyPtr = xmlDocCopyNode(nodePtr, nodePtr->doc, deep);
+ Tcl_MutexUnlock(&libxml2);
+
+ if (copyPtr == NULL) {
+ Tcl_SetResult(interp, "unable to copy node", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, copyPtr));
+ }
+ break;
+
+ case TCLDOM_NODE_PARENT:
+
+ if (docPtr) {
+ break;
+ }
+
+ if (nodePtr->parent) {
+ Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->parent));
+ } else {
+ Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc));
+ }
+
+ break;
+
+ case TCLDOM_NODE_CHILDREN:
+
+ resultPtr = Tcl_NewListObj(0, NULL);
+
+ if (docPtr) {
+ childNodePtr = docPtr->children;
+ } else {
+ childNodePtr = nodePtr->children;
+ }
+
+ while (childNodePtr) {
+ Tcl_ListObjAppendElement(interp, resultPtr, TclDOM_libxml2_CreateObjFromNode(interp, childNodePtr));
+ childNodePtr = childNodePtr->next;
+ }
+
+ Tcl_SetObjResult(interp, resultPtr);
+
+ break;
+
+ case TCLDOM_NODE_ADDEVENTLISTENER:
+
+ /* TODO: type optional, missing type returns all types that have a listener */
+
+ if (optobjc < 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "type ?listener? ?-usecapture boolean?");
+ return TCL_ERROR;
+ } else {
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr, *listenerPtr = NULL;
+ void *tokenPtr = NULL;
+
+ if (nodePtr) {
+ tokenPtr = (void *) nodePtr;
+ } else {
+ tokenPtr = (void *) docPtr;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_EventTypes,
+ "type", TCL_EXACT, &option) == TCL_OK) {
+ type = (enum TclDOM_EventTypes) option;
+ } else {
+ type = TCLDOM_EVENT_USERDEFINED;
+ }
+ typeObjPtr = optobjv[0];
+ Tcl_ResetResult(interp);
+ optobjc -= 1;
+ optobjv += 1;
+
+ if (optobjc > 0 && *Tcl_GetStringFromObj(optobjv[0], NULL) != '-') {
+ listenerPtr = optobjv[0];
+ optobjc -= 1;
+ optobjv += 1;
+ } /* else we will return the registered listener */
+
+ while (optobjc) {
+ if (optobjc == 1) {
+ Tcl_SetResult(interp, "missing value", NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_NodeCommandAddEventListenerOptions,
+ "option", 0, &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum TclDOM_NodeCommandAddEventListenerOptions) option) {
+ case TCLDOM_NODE_ADDEVENTLISTENER_USECAPTURE:
+
+ if (Tcl_GetBooleanFromObj(interp, optobjv[1], &usecapture) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ break;
+
+ default:
+ Tcl_SetResult(interp, "unknown option", NULL);
+ return TCL_ERROR;
+ }
+
+ optobjc -= 2;
+ optobjv += 2;
+ }
+
+ if (nodePtr) {
+ docObjPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc);
+ } else {
+ docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
+ }
+ TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr);
+
+ if (listenerPtr == NULL) {
+ listenerPtr = TclDOM_GetEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, usecapture);
+ if (listenerPtr) {
+ Tcl_SetObjResult(interp, listenerPtr);
+ } else {
+ Tcl_SetResult(interp, "unable to find listeners", NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ return TclDOM_AddEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, usecapture);
+ }
+ }
+
+ break;
+
+
+ case TCLDOM_NODE_REMOVEEVENTLISTENER:
+
+ if (optobjc < 2) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "type listener ?-usecapture boolean?");
+ return TCL_ERROR;
+ } else {
+ Tcl_Obj *typeObjPtr, *listenerPtr;
+ void *tokenPtr = NULL;
+ TclXML_libxml2_Document *tDocPtr;
+ enum TclDOM_EventTypes type;
+
+ if (nodePtr) {
+ tokenPtr = (void *) nodePtr;
+ } else {
+ tokenPtr = (void *) docPtr;
+ }
+
+ typeObjPtr = optobjv[0];
+ if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_EventTypes,
+ "type", TCL_EXACT, &option) == TCL_OK) {
+ type = (enum TclDOM_EventTypes) option;
+ } else {
+ type = TCLDOM_EVENT_USERDEFINED;
+ }
+ listenerPtr = optobjv[1];
+
+ optobjc -= 2;
+ optobjv += 2;
+ while (optobjc) {
+ if (Tcl_GetIndexFromObj(interp, optobjv[0], TclDOM_NodeCommandAddEventListenerOptions,
+ "option", 0, &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch ((enum TclDOM_NodeCommandAddEventListenerOptions) option) {
+ case TCLDOM_NODE_ADDEVENTLISTENER_USECAPTURE:
+
+ if (Tcl_GetBooleanFromObj(interp, optobjv[1], &usecapture) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ break;
+
+ default:
+ Tcl_SetResult(interp, "unknown option", NULL);
+ return TCL_ERROR;
+ }
+
+ optobjc -= 2;
+ optobjv += 2;
+ }
+
+ if (nodePtr) {
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
+ if (TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ return TclDOM_RemoveEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, usecapture);
+ }
+
+ break;
+
+ case TCLDOM_NODE_DISPATCHEVENT:
+
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "event");
+ return TCL_ERROR;
+ } else {
+ TclDOM_libxml2_Event *eventPtr;
+
+ if (TclDOM_libxml2_GetEventFromObj(interp, optobjv[0], &eventPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (nodeObjPtr) {
+ return TclDOM_DispatchEvent(interp, nodeObjPtr, optobjv[0], eventPtr);
+ } else if (nodePtr) {
+ return TclDOM_DispatchEvent(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr), optobjv[0], eventPtr);
+ } else if (docObjPtr) {
+ return TclDOM_DispatchEvent(interp, docObjPtr, optobjv[0], eventPtr);
+ } else {
+ Tcl_SetResult(interp, "unable to dispatch event", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ break;
+
+ case TCLDOM_NODE_STRINGVALUE:
+
+ if (optobjc != 0) {
+ Tcl_WrongNumArgs(interp, wrongidx, objv, "");
+ return TCL_ERROR;
+ }
+
+ Tcl_ResetResult(interp);
+
+ Tcl_MutexLock(&libxml2);
+
+ if (nodePtr) {
+ buf = (char *) xmlNodeGetContent(nodePtr);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
+ xmlFree (buf);
+ } else if (docPtr) {
+ nodePtr = xmlDocGetRootElement(docPtr);
+ if (nodePtr) {
+ buf = (char *) xmlNodeGetContent(nodePtr);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
+ xmlFree (buf);
+ } else {
+ nodePtr = docPtr->children;
+ while (nodePtr != NULL) {
+ if (nodePtr->type == XML_TEXT_NODE) {
+ Tcl_AppendResult(interp, (char *) nodePtr->content, NULL);
+ }
+ nodePtr = nodePtr->next;
+ }
+ }
+ } else {
+ Tcl_SetResult(interp, "cannot determine string value: internal error", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ break;
+
+ case TCLDOM_NODE_SELECTNODE:
+
+ Tcl_ResetResult(interp);
+
+ return TclDOMSelectNodeCommand(clientData, interp, objc - 1, objv + 1);
+
+ break;
+
+ default:
+ Tcl_SetResult(interp, "method \"", NULL);
+ Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+int
+NodeCget(interp, docPtr, nodePtr, optPtr)
+ Tcl_Interp *interp;
+ xmlDocPtr docPtr;
+ xmlNodePtr nodePtr;
+ Tcl_Obj *CONST optPtr;
+{
+ TclXML_libxml2_Document *tDocPtr;
+ TclDOM_libxml2_Document *domDocPtr;
+ Tcl_Obj *objPtr;
+ xmlNodePtr childNodePtr;
+ int option;
+ char varname[100];
+ Tcl_Obj *livePtr;
+
+ if (Tcl_GetIndexFromObj(interp, optPtr, TclDOM_NodeCommandOptions,
+ "option", 0, &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum TclDOM_NodeCommandOptions) option) {
+
+ case TCLDOM_NODE_NODETYPE:
+
+ if (docPtr) {
+ Tcl_SetResult(interp, "document", NULL);
+ break;
+ }
+
+ switch (nodePtr->type) {
+ case XML_ELEMENT_NODE:
+ Tcl_SetResult(interp, "element", NULL);
+ break;
+ case XML_ATTRIBUTE_NODE:
+ Tcl_SetResult(interp, "attribute", NULL);
+ break;
+ case XML_TEXT_NODE:
+ case XML_CDATA_SECTION_NODE:
+ Tcl_SetResult(interp, "textNode", NULL);
+ break;
+ case XML_ENTITY_REF_NODE:
+ Tcl_SetResult(interp, "entityReference", NULL);
+ break;
+ case XML_ENTITY_NODE:
+ Tcl_SetResult(interp, "entity", NULL);
+ break;
+ case XML_PI_NODE:
+ Tcl_SetResult(interp, "processingInstruction", NULL);
+ break;
+ case XML_COMMENT_NODE:
+ Tcl_SetResult(interp, "comment", NULL);
+ break;
+ case XML_DOCUMENT_NODE:
+ Tcl_SetResult(interp, "document", NULL);
+ break;
+ case XML_DOCUMENT_TYPE_NODE:
+ Tcl_SetResult(interp, "docType", NULL);
+ break;
+ case XML_DOCUMENT_FRAG_NODE:
+ Tcl_SetResult(interp, "documentFragment", NULL);
+ break;
+ case XML_NOTATION_NODE:
+ Tcl_SetResult(interp, "notation", NULL);
+ break;
+ case XML_HTML_DOCUMENT_NODE:
+ Tcl_SetResult(interp, "HTMLdocument", NULL);
+ break;
+ case XML_DTD_NODE:
+ Tcl_SetResult(interp, "dtd", NULL);
+ break;
+ case XML_ELEMENT_DECL:
+ Tcl_SetResult(interp, "elementDecl", NULL);
+ break;
+ case XML_ATTRIBUTE_DECL:
+ Tcl_SetResult(interp, "attributeDecl", NULL);
+ break;
+ case XML_ENTITY_DECL:
+ Tcl_SetResult(interp, "entityDecl", NULL);
+ break;
+ case XML_NAMESPACE_DECL:
+ Tcl_SetResult(interp, "namespaceDecl", NULL);
+ break;
+ case XML_XINCLUDE_START:
+ Tcl_SetResult(interp, "xincludeStart", NULL);
+ break;
+ case XML_XINCLUDE_END:
+ Tcl_SetResult(interp, "xincludeEnd", NULL);
+ break;
+ default:
+ Tcl_SetResult(interp, "unknown", NULL);
+ }
+
+ break;
+
+ case TCLDOM_NODE_LOCALNAME:
+ case TCLDOM_NODE_NODENAME:
+
+ /* This isn't quite right: nodeName should return the expanded name */
+
+ if (docPtr) {
+ Tcl_SetResult(interp, "#document", NULL);
+ break;
+ }
+ /* libxml2 doesn't maintain the correct DOM node name */
+ switch (nodePtr->type) {
+ case XML_ELEMENT_NODE:
+ case XML_ATTRIBUTE_NODE:
+ case XML_ENTITY_REF_NODE:
+ case XML_ENTITY_NODE:
+ case XML_PI_NODE:
+ case XML_DOCUMENT_TYPE_NODE:
+ case XML_NOTATION_NODE:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->name, -1));
+ break;
+ case XML_TEXT_NODE:
+ Tcl_SetResult(interp, "#text", NULL);
+ break;
+ case XML_CDATA_SECTION_NODE:
+ Tcl_SetResult(interp, "#cdata-section", NULL);
+ break;
+ case XML_COMMENT_NODE:
+ Tcl_SetResult(interp, "#comment", NULL);
+ break;
+ case XML_DOCUMENT_NODE:
+ /* Already handled above */
+ Tcl_SetResult(interp, "#document", NULL);
+ break;
+ case XML_DOCUMENT_FRAG_NODE:
+ Tcl_SetResult(interp, "#document-fragment", NULL);
+ break;
+ case XML_HTML_DOCUMENT_NODE:
+ /* Not standard DOM */
+ Tcl_SetResult(interp, "#HTML-document", NULL);
+ break;
+ case XML_DTD_NODE:
+ /* Not standard DOM */
+ Tcl_SetResult(interp, "#dtd", NULL);
+ break;
+ case XML_ELEMENT_DECL:
+ /* Not standard DOM */
+ Tcl_SetResult(interp, "#element-declaration", NULL);
+ break;
+ case XML_ATTRIBUTE_DECL:
+ /* Not standard DOM */
+ Tcl_SetResult(interp, "#attribute-declaration", NULL);
+ break;
+ case XML_ENTITY_DECL:
+ /* Not standard DOM */
+ Tcl_SetResult(interp, "#entity-declaration", NULL);
+ break;
+ case XML_NAMESPACE_DECL:
+ /* Not standard DOM */
+ Tcl_SetResult(interp, "#namespace-declaration", NULL);
+ break;
+ case XML_XINCLUDE_START:
+ /* Not standard DOM */
+ Tcl_SetResult(interp, "#xinclude-start", NULL);
+ break;
+ case XML_XINCLUDE_END:
+ /* Not standard DOM */
+ Tcl_SetResult(interp, "#xinclude-end", NULL);
+ break;
+ default:
+ Tcl_SetResult(interp, "#unknown", NULL);
+ }
+
+ break;
+
+ case TCLDOM_NODE_NODEVALUE:
+
+ if (docPtr) {
+ break;
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ if (XML_GET_CONTENT(nodePtr) != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) XML_GET_CONTENT(nodePtr), -1));
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ break;
+
+ case TCLDOM_NODE_OWNERDOCUMENT:
+
+ if (docPtr) {
+ Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(docPtr));
+ break;
+ }
+
+ Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc));
+
+ break;
+
+ case TCLDOM_NODE_PARENTNODE:
+
+ if (docPtr) {
+ Tcl_ResetResult(interp);
+ break;
+ }
+
+ if (nodePtr->parent) {
+ if (nodePtr->parent->type == XML_DOCUMENT_NODE ||
+ nodePtr->parent->type == XML_HTML_DOCUMENT_NODE) {
+ Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc));
+ } else {
+ Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->parent));
+ }
+ } else {
+ Tcl_SetObjResult(interp, TclXML_libxml2_CreateObjFromDoc(nodePtr->doc));
+ }
+
+ break;
+
+ case TCLDOM_NODE_CHILDNODES:
+
+ /* Set up live NodeList variable */
+
+ if (docPtr) {
+ objPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
+ if (TclXML_libxml2_GetTclDocFromObj(interp, objPtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ domDocPtr = GetDOMDocument(interp, tDocPtr);
+ if (domDocPtr == NULL) {
+ Tcl_SetResult(interp, "internal error", NULL);
+ return TCL_ERROR;
+ }
+ sprintf(varname, "::dom::%s::nodelist.%d", tDocPtr->token, domDocPtr->nodeCntr++);
+ livePtr = Tcl_GetVar2Ex(interp, varname, NULL, TCL_GLOBAL_ONLY);
+ if (!livePtr) {
+ Tcl_Obj *nodelistPtr = Tcl_NewListObj(0, NULL);
+
+ Tcl_SetVar2Ex(interp, varname, NULL, nodelistPtr, TCL_GLOBAL_ONLY);
+ Tcl_IncrRefCount(nodelistPtr);
+
+ if (docPtr) {
+ if (Tcl_TraceVar(interp, varname, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNodeListDoc, (ClientData) docPtr) != TCL_OK) {
+ Tcl_DecrRefCount(nodelistPtr);
+ return TCL_ERROR;
+ } else {
+ TclDOMLiveNodeListDoc((ClientData) tDocPtr->docPtr, interp, varname, NULL, TCL_TRACE_READS);
+ }
+ } else {
+ if (Tcl_TraceVar(interp, varname, TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNodeListNode, (ClientData) nodePtr) != TCL_OK) {
+ Tcl_DecrRefCount(nodelistPtr);
+ return TCL_ERROR;
+ } else {
+ TclDOMLiveNodeListNode((ClientData) nodePtr, interp, varname, NULL, TCL_TRACE_READS);
+ }
+ }
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(varname, -1));
+
+ break;
+
+ case TCLDOM_NODE_FIRSTCHILD:
+
+ /*
+ * Handle case where no children are present
+ * Bug #1089114 w/- patch by dwcollins
+ */
+
+ if (docPtr) {
+ childNodePtr = docPtr->children;
+ } else {
+ childNodePtr = nodePtr->children;
+ }
+
+ if (childNodePtr != NULL) {
+ Tcl_SetObjResult(interp,
+ TclDOM_libxml2_CreateObjFromNode(interp, childNodePtr));
+ }
+
+ break;
+
+ case TCLDOM_NODE_LASTCHILD:
+
+ if (docPtr) {
+ childNodePtr = docPtr->last;
+ } else {
+ Tcl_MutexLock(&libxml2);
+ childNodePtr = xmlGetLastChild(nodePtr);
+ Tcl_MutexUnlock(&libxml2);
+ }
+ if (childNodePtr != NULL) {
+ Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, childNodePtr));
+ }
+
+ break;
+
+ case TCLDOM_NODE_NEXTSIBLING:
+ if (!docPtr && nodePtr->next) {
+ Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->next));
+ }
+
+ break;
+
+ case TCLDOM_NODE_PREVIOUSSIBLING:
+ if (!docPtr && nodePtr->prev) {
+ Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->prev));
+ }
+
+ break;
+
+ case TCLDOM_NODE_ATTRIBUTES:
+
+ if (docPtr) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ } else if (nodePtr->type != XML_ELEMENT_NODE) {
+ Tcl_SetResult(interp, "wrong object type", NULL);
+ return TCL_ERROR;
+ } else {
+ /* Set up live NamedNodeMap variable */
+
+ /* If there's already a variable, return it */
+ objPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc);
+ TclXML_libxml2_GetTclDocFromObj(interp, objPtr, &tDocPtr);
+ domDocPtr = GetDOMDocument(interp, tDocPtr);
+ if (domDocPtr == NULL) {
+ Tcl_SetResult(interp, "internal error", NULL);
+ return TCL_ERROR;
+ }
+ sprintf(varname, "::dom::%s::att%d", tDocPtr->token, domDocPtr->nodeCntr++);
+ livePtr = Tcl_GetVar2Ex(interp, varname, NULL, TCL_GLOBAL_ONLY);
+ if (!livePtr) {
+ if (TclDOMSetLiveNamedNodeMap(interp, varname, (ClientData) nodePtr) != TCL_OK) {
+ Tcl_UnsetVar(interp, varname, TCL_GLOBAL_ONLY);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_TraceVar(interp, varname, TCL_TRACE_ARRAY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS|TCL_GLOBAL_ONLY, (Tcl_VarTraceProc *) TclDOMLiveNamedNodeMap, (ClientData) nodePtr) != TCL_OK) {
+ Tcl_UnsetVar(interp, varname, TCL_GLOBAL_ONLY);
+ return TCL_ERROR;
+ }
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(varname, -1));
+
+ }
+
+ break;
+
+ case TCLDOM_NODE_NAMESPACEURI:
+
+ if (!docPtr && nodePtr->ns) {
+ if (nodePtr->ns->href) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->ns->href, -1));
+ }
+ }
+
+ break;
+
+ case TCLDOM_NODE_PREFIX:
+
+ if (!docPtr && nodePtr->ns) {
+ if (nodePtr->ns->prefix) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->ns->prefix, -1));
+ }
+ }
+
+ break;
+
+ default:
+ Tcl_SetResult(interp, "unknown option or not yet implemented", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+int
+NodeConfigure(interp, nodePtr, objc, objv)
+ Tcl_Interp *interp;
+ xmlNodePtr nodePtr;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ TclXML_libxml2_Document *tDocPtr;
+ Tcl_Obj *objPtr;
+ char *buf;
+ int option, len;
+
+ while (objc) {
+ if (objc == 1) {
+ Tcl_SetResult(interp, "missing value", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_NodeCommandOptions,
+ "option", 0, &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum TclDOM_NodeCommandOptions) option) {
+ case TCLDOM_NODE_NODETYPE:
+ case TCLDOM_NODE_NODENAME:
+ case TCLDOM_NODE_PARENTNODE:
+ case TCLDOM_NODE_CHILDNODES:
+ case TCLDOM_NODE_FIRSTCHILD:
+ case TCLDOM_NODE_LASTCHILD:
+ case TCLDOM_NODE_PREVIOUSSIBLING:
+ case TCLDOM_NODE_NEXTSIBLING:
+ case TCLDOM_NODE_ATTRIBUTES:
+ case TCLDOM_NODE_NAMESPACEURI:
+ case TCLDOM_NODE_PREFIX:
+ case TCLDOM_NODE_LOCALNAME:
+ case TCLDOM_NODE_OWNERDOCUMENT:
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "attribute \"", Tcl_GetStringFromObj(objv[0], NULL), "\" is read-only", NULL);
+ return TCL_ERROR;
+
+ case TCLDOM_NODE_NODEVALUE:
+
+ if (!nodePtr) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+ switch (nodePtr->type) {
+ case XML_ELEMENT_NODE:
+ case XML_DOCUMENT_NODE:
+ case XML_DOCUMENT_FRAG_NODE:
+ case XML_DOCUMENT_TYPE_NODE:
+ case XML_ENTITY_NODE:
+ case XML_ENTITY_REF_NODE:
+ case XML_NOTATION_NODE:
+ case XML_HTML_DOCUMENT_NODE:
+ case XML_DTD_NODE:
+ case XML_ELEMENT_DECL:
+ case XML_ATTRIBUTE_DECL:
+ case XML_ENTITY_DECL:
+ case XML_NAMESPACE_DECL:
+ case XML_XINCLUDE_START:
+ case XML_XINCLUDE_END:
+ /*
+ * DOM defines these nodes as not having a node value.
+ * libxml2 clobbers existing content if the value is set,
+ * so don't do it!
+ */
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+
+ default:
+ /* fall-through */
+ break;
+ }
+
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ objPtr = Tcl_NewStringObj((CONST char *) xmlNodeGetContent(nodePtr), -1);
+
+ buf = Tcl_GetStringFromObj(objv[1], &len);
+ xmlNodeSetContentLen(nodePtr, (const xmlChar *) buf, len);
+
+ Tcl_MutexUnlock(&libxml2);
+
+ TclDOM_PostMutationEvent(interp,
+ tDocPtr, TclDOM_libxml2_CreateObjFromNode(interp, nodePtr),
+ TCLDOM_EVENT_DOMCHARACTERDATAMODIFIED, NULL,
+ Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, objPtr, objv[1], NULL, NULL);
+
+ Tcl_DecrRefCount(objPtr);
+
+ break;
+
+ case TCLDOM_NODE_CDATASECTION:
+
+ break;
+ }
+
+ objc -= 2;
+ objv += 2;
+
+ }
+
+ return TCL_OK;
+}
+
+int
+TclDOM_NodeAppendChild(interp, nodePtr, childPtr)
+ Tcl_Interp *interp;
+ xmlNodePtr nodePtr;
+ xmlNodePtr childPtr;
+{
+ TclXML_libxml2_Document *tDocPtr;
+ xmlNodePtr oldParent;
+ xmlNodePtr oldSibling;
+
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ oldParent = childPtr->parent;
+ oldSibling = childPtr->next;
+
+ if (oldParent && oldParent != nodePtr) {
+ TclDOM_PostMutationEvent(interp,
+ tDocPtr,
+ TclDOM_libxml2_CreateObjFromNode(interp, childPtr),
+ TCLDOM_EVENT_DOMNODEREMOVED, NULL,
+ Tcl_NewIntObj(1), Tcl_NewIntObj(0),
+ TclDOM_libxml2_CreateObjFromNode(interp, oldParent),
+ NULL, NULL, NULL, NULL);
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ /* Although xmlAddChild claims to release the child from its previous context,
+ * that doesn't appear to actually happen.
+ */
+ xmlUnlinkNode(childPtr);
+ if (xmlAddChild(nodePtr, childPtr) == NULL) {
+ if (oldSibling) {
+ xmlAddPrevSibling(oldSibling, childPtr);
+ } else {
+ xmlAddChild(oldParent, childPtr);
+ }
+
+ Tcl_SetResult(interp, "unable to insert node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ PostMutationEvents(interp, tDocPtr, nodePtr, childPtr, childPtr, oldParent, childPtr->parent);
+
+ Tcl_SetObjResult(interp, TclDOM_libxml2_CreateObjFromNode(interp, childPtr));
+
+ return TCL_OK;
+}
+
+int
+TclDOM_NodeInsertBefore(interp, refPtr, newPtr)
+ Tcl_Interp *interp;
+ xmlNodePtr refPtr;
+ xmlNodePtr newPtr;
+{
+ TclXML_libxml2_Document *tDocPtr;
+ xmlNodePtr oldParent;
+
+ if (TclXML_libxml2_GetTclDocFromNode(interp, refPtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ oldParent = newPtr->parent;
+ if (oldParent != refPtr->parent) {
+ TclDOM_PostMutationEvent(interp,
+ tDocPtr,
+ TclDOM_libxml2_CreateObjFromNode(interp, refPtr),
+ TCLDOM_EVENT_DOMNODEREMOVED, NULL,
+ Tcl_NewIntObj(1), Tcl_NewIntObj(0),
+ TclDOM_libxml2_CreateObjFromNode(interp, newPtr->parent),
+ NULL, NULL, NULL, NULL);
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ if (xmlAddPrevSibling(refPtr, newPtr) == NULL) {
+ Tcl_SetResult(interp, "unable to insert node", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexUnlock(&libxml2);
+
+ PostMutationEvents(interp, tDocPtr, refPtr, refPtr, newPtr, oldParent, refPtr->parent);
+
+ return TCL_OK;
+}
+
+void PostMutationEvents(interp, tDocPtr, nodePtr, refPtr, newPtr, oldParent, newParent)
+ Tcl_Interp *interp;
+ TclXML_libxml2_Document *tDocPtr;
+ xmlNodePtr nodePtr;
+ xmlNodePtr refPtr;
+ xmlNodePtr newPtr;
+ xmlNodePtr oldParent;
+ xmlNodePtr newParent;
+{
+ /* If parent has changed, notify old parent */
+ if (oldParent != NULL && oldParent != newParent) {
+ TclDOM_PostMutationEvent(interp,
+ tDocPtr,
+ TclDOM_libxml2_CreateObjFromNode(interp, oldParent),
+ TCLDOM_EVENT_DOMSUBTREEMODIFIED, NULL,
+ Tcl_NewIntObj(1), Tcl_NewIntObj(0),
+ NULL, NULL, NULL, NULL, NULL);
+ }
+ /* Notify new parent */
+ if (newParent != NULL) {
+ TclDOM_PostMutationEvent(interp,
+ tDocPtr,
+ TclDOM_libxml2_CreateObjFromNode(interp, newParent),
+ TCLDOM_EVENT_DOMSUBTREEMODIFIED, NULL,
+ Tcl_NewIntObj(1), Tcl_NewIntObj(0),
+ NULL, NULL, NULL, NULL, NULL);
+ }
+
+ /* Inserted event */
+ if (newPtr != NULL) {
+ TclDOM_PostMutationEvent(interp,
+ tDocPtr,
+ TclDOM_libxml2_CreateObjFromNode(interp, newPtr),
+ TCLDOM_EVENT_DOMNODEINSERTED, NULL,
+ Tcl_NewIntObj(1), Tcl_NewIntObj(0),
+ NULL, NULL, NULL, NULL, NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_AddEventListener --
+ *
+ * Register an event listener.
+ *
+ * Results:
+ * Success code.
+ *
+ * Side effects:
+ * Event listener stored.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOM_AddEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, capturer)
+ Tcl_Interp *interp;
+ TclXML_libxml2_Document *tDocPtr;
+ void *tokenPtr; /* xmlNodePtr or xmlDocPtr */
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr;
+ Tcl_Obj *listenerPtr;
+ int capturer;
+{
+ TclDOM_libxml2_Document *domDocPtr;
+ Tcl_HashTable *tablePtr;
+ Tcl_HashEntry *entryPtr;
+ int new;
+
+ domDocPtr = GetDOMDocument(interp, tDocPtr);
+ if (domDocPtr == NULL) {
+ Tcl_SetResult(interp, "internal error", NULL);
+ return TCL_ERROR;
+ }
+
+ if (capturer) {
+ tablePtr = domDocPtr->captureListeners;
+ } else {
+ tablePtr = domDocPtr->bubbleListeners;
+ }
+
+ entryPtr = Tcl_CreateHashEntry(tablePtr, tokenPtr, &new);
+ if (new) {
+ tablePtr = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr, TCL_STRING_KEYS);
+ Tcl_SetHashValue(entryPtr, (char *) tablePtr);
+ } else {
+ tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr);
+ }
+
+ if (type == TCLDOM_EVENT_USERDEFINED) {
+ entryPtr = Tcl_CreateHashEntry(tablePtr, Tcl_GetStringFromObj(typeObjPtr, NULL), &new);
+ } else {
+ entryPtr = Tcl_CreateHashEntry(tablePtr, TclDOM_EventTypes[type], &new);
+ }
+ if (new) {
+ Tcl_Obj *listPtr = Tcl_NewListObj(0, NULL);
+
+ Tcl_IncrRefCount(listenerPtr);
+ Tcl_IncrRefCount(listPtr);
+ Tcl_ListObjAppendElement(interp, listPtr, listenerPtr);
+ Tcl_SetHashValue(entryPtr, (char *) listPtr);
+
+ } else {
+ Tcl_Obj *listPtr = (Tcl_Obj *) Tcl_GetHashValue(entryPtr);
+ Tcl_Obj *curPtr;
+ int idx, len, listenerLen, len2, listlen;
+ char *listenerBuf, *buf2;
+
+ if (Tcl_ListObjLength(interp, listPtr, &len) != TCL_OK) {
+ Tcl_SetResult(interp, "internal error - bad list", NULL);
+ return TCL_ERROR;
+ }
+ listenerBuf = Tcl_GetStringFromObj(listenerPtr, &listenerLen);
+
+ new = 0;
+ for (idx = 0; idx < len; idx++) {
+ Tcl_ListObjIndex(interp, listPtr, idx, &curPtr);
+ buf2 = Tcl_GetStringFromObj(curPtr, &len2);
+
+ if (listenerLen == len2 &&
+ !strncmp(listenerBuf, buf2, listenerLen)) {
+ new = 1;
+ break;
+ }
+ }
+
+ if (Tcl_ListObjLength(interp, listPtr, &listlen) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_ListObjReplace(interp, listPtr, idx, new, 1, &listenerPtr);
+
+ }
+
+ /*
+ * Performance optimization:
+ * Keep track of which event types have listeners registered.
+ * If there are no listeners for an event type, then there's
+ * no point in dispatching that type of event.
+ * NB. This does not keep track of user-defined events types.
+ */
+
+ if (type != TCLDOM_EVENT_USERDEFINED) {
+ domDocPtr->listening[type]++;
+ } /* else this is a user-defined event type - it won't be tracked */
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_GetEventListener --
+ *
+ * Find the listener registered for an event type.
+ *
+ * Results:
+ * Event listener returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclDOM_GetEventListener(interp,tDocPtr, tokenPtr, type, typeObjPtr, capturer)
+ Tcl_Interp *interp;
+ TclXML_libxml2_Document *tDocPtr;
+ void *tokenPtr;
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr;
+ int capturer;
+{
+ TclDOM_libxml2_Document *domDocPtr;
+ Tcl_HashTable *tablePtr;
+ Tcl_HashEntry *entryPtr;
+
+ domDocPtr = GetDOMDocument(interp, tDocPtr);
+ if (domDocPtr == NULL) {
+ Tcl_SetResult(interp, "internal error", NULL);
+ return NULL;
+ }
+
+ if (capturer) {
+ tablePtr = domDocPtr->captureListeners;
+ } else {
+ tablePtr = domDocPtr->bubbleListeners;
+ }
+
+ entryPtr = Tcl_FindHashEntry(tablePtr, tokenPtr);
+ if (entryPtr) {
+ tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr);
+
+ if (type == TCLDOM_EVENT_USERDEFINED) {
+ entryPtr = Tcl_FindHashEntry(tablePtr, Tcl_GetStringFromObj(typeObjPtr, NULL));
+ } else {
+ entryPtr = Tcl_FindHashEntry(tablePtr, TclDOM_EventTypes[type]);
+ }
+ if (entryPtr) {
+ return (Tcl_Obj *) Tcl_GetHashValue(entryPtr);
+ }
+ }
+
+ return Tcl_NewObj();
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_RemoveEventListener --
+ *
+ * Deregister an event listener.
+ *
+ * Results:
+ * Success code.
+ *
+ * Side effects:
+ * May free Tcl objects.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOM_RemoveEventListener(interp, tDocPtr, tokenPtr, type, typeObjPtr, listenerPtr, capturer)
+ Tcl_Interp *interp;
+ TclXML_libxml2_Document *tDocPtr;
+ void *tokenPtr;
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr;
+ Tcl_Obj *listenerPtr;
+ int capturer;
+{
+ TclDOM_libxml2_Document *domDocPtr;
+ Tcl_HashTable *tablePtr;
+ Tcl_HashEntry *entryPtr;
+
+ domDocPtr = GetDOMDocument(interp, tDocPtr);
+ if (domDocPtr == NULL) {
+ Tcl_SetResult(interp, "internal error", NULL);
+ return TCL_ERROR;
+ }
+
+ if (capturer) {
+ tablePtr = domDocPtr->captureListeners;
+ } else {
+ tablePtr = domDocPtr->bubbleListeners;
+ }
+
+ entryPtr = Tcl_FindHashEntry(tablePtr, tokenPtr);
+ if (entryPtr) {
+ tablePtr = (Tcl_HashTable *) Tcl_GetHashValue(entryPtr);
+
+ if (type == TCLDOM_EVENT_USERDEFINED) {
+ entryPtr = Tcl_FindHashEntry(tablePtr, Tcl_GetStringFromObj(typeObjPtr, NULL));
+ } else {
+ entryPtr = Tcl_FindHashEntry(tablePtr, TclDOM_EventTypes[type]);
+ }
+ if (entryPtr) {
+ Tcl_Obj *listPtr = (Tcl_Obj *) Tcl_GetHashValue(entryPtr);
+ Tcl_Obj *curPtr;
+ int idx, listenerLen, len, len2, found;
+ char *listenerBuf, *buf2;
+
+ if (Tcl_ListObjLength(interp, listPtr, &len) != TCL_OK) {
+ Tcl_SetResult(interp, "internal error - bad list", NULL);
+ return TCL_ERROR;
+ }
+ listenerBuf = Tcl_GetStringFromObj(listenerPtr, &listenerLen);
+ found = 0;
+ for (idx = 0; idx < len; idx++) {
+ Tcl_ListObjIndex(interp, listPtr, idx, &curPtr);
+ buf2 = Tcl_GetStringFromObj(curPtr, &len2);
+ if (listenerLen == len2 &&
+ !strncmp(listenerBuf, buf2, listenerLen)) {
+ found = 1;
+ break;
+ }
+ }
+
+ if (!found) {
+ Tcl_SetResult(interp, "listener not found", NULL);
+ return TCL_ERROR;
+ } else {
+ Tcl_ListObjReplace(interp, listPtr, idx, 1, 0, NULL);
+
+ /*
+ * Keep track of which event types have listeners registered.
+ */
+
+ if (type != TCLDOM_EVENT_USERDEFINED) {
+ domDocPtr->listening[type]--;
+ } /* else user-defined event type - not being tracked */
+ }
+ } else {
+ Tcl_SetResult(interp, "no listeners registered", NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_SetResult(interp, "no listeners registered", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * HasListener --
+ *
+ * Check whether an event listener is registered for an event type.
+ *
+ * Results:
+ * Returns boolean.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+HasListener(interp, tDocPtr, eventType)
+ Tcl_Interp *interp;
+ TclXML_libxml2_Document *tDocPtr;
+ enum TclDOM_EventTypes eventType;
+{
+ TclDOM_libxml2_Document *domDocPtr = GetDOMDocument(interp, tDocPtr);
+
+ if (domDocPtr == NULL) {
+ return 0;
+ }
+
+ if (eventType == TCLDOM_EVENT_USERDEFINED) {
+ /*
+ * We don't know whether there is a listener or not,
+ * so play it safe.
+ */
+ return 1;
+ }
+
+ if (domDocPtr->listening[eventType] > 0) {
+ return 1;
+ }
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_DispatchEvent --
+ *
+ * Dispatch an event object.
+ *
+ * Results:
+ * Event propagates through the DOM tree.
+ *
+ * Side effects:
+ * Depends on event listeners.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOM_DispatchEvent(interp, nodeObjPtr, eventObjPtr, eventPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *nodeObjPtr;
+ Tcl_Obj *eventObjPtr;
+ TclDOM_libxml2_Event *eventPtr;
+{
+ xmlNodePtr nodePtr;
+ xmlDocPtr docPtr;
+ TclXML_libxml2_Document *tDocPtr;
+ TclDOM_libxml2_Document *domDocPtr;
+ char *phase;
+ Tcl_Obj *docObjPtr, *pathPtr = NULL;
+ int idx, len, cancelable;
+ void *tokenPtr;
+
+ if (TclDOM_libxml2_GetNodeFromObj(interp, nodeObjPtr, &nodePtr) != TCL_OK) {
+ if (TclXML_libxml2_GetTclDocFromObj(interp, nodeObjPtr, &tDocPtr) != TCL_OK) {
+ Tcl_SetResult(interp, "unrecognised token", NULL);
+ return TCL_ERROR;
+ } else {
+ docObjPtr = nodeObjPtr;
+ docPtr = tDocPtr->docPtr;
+ nodeObjPtr = NULL;
+ nodePtr = NULL;
+ tokenPtr = (void *) docPtr;
+ }
+ } else {
+ docPtr = nodePtr->doc;
+ docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
+ if (TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr) != TCL_OK) {
+ Tcl_SetResult(interp, "unknown document", NULL);
+ return TCL_ERROR;
+ }
+ tokenPtr = (void *) nodePtr;
+ }
+ Tcl_ResetResult(interp);
+
+ /*
+ * Performance optimization:
+ * If there are no listeners registered for this event type,
+ * then there is no point in propagating the event.
+ */
+ if (!HasListener(interp, tDocPtr, eventPtr->type)) {
+ return TCL_OK;
+ }
+
+ domDocPtr = GetDOMDocument(interp, tDocPtr);
+ if (domDocPtr == NULL) {
+ Tcl_SetResult(interp, "internal error", NULL);
+ return TCL_ERROR;
+ }
+
+ phase = Tcl_GetStringFromObj(eventPtr->eventPhase, &len);
+
+ if (!len) {
+ /*
+ * This is the initial dispatch of the event.
+ * First trigger any capturing event listeners
+ * Starting from the root, proceed downward
+ */
+
+ Tcl_SetStringObj(eventPtr->eventPhase, "capturing_phase", -1);
+ eventPtr->target = nodeObjPtr;
+ Tcl_IncrRefCount(nodeObjPtr);
+
+ if (nodePtr) {
+ pathPtr = GetPath(interp, nodePtr);
+ } else {
+ pathPtr = Tcl_NewObj();
+ }
+ if (eventPtr->currentNode) {
+ Tcl_DecrRefCount(eventPtr->currentNode);
+ }
+ eventPtr->currentNode = docObjPtr;
+ Tcl_IncrRefCount(docObjPtr);
+ if (TriggerEventListeners(interp, domDocPtr->captureListeners, (void *) docPtr, eventObjPtr, eventPtr) != TCL_OK) {
+ Tcl_DecrRefCount(pathPtr);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) {
+ Tcl_DecrRefCount(pathPtr);
+ return TCL_ERROR;
+ }
+ if (cancelable && eventPtr->stopPropagation) {
+ goto stop_propagation;
+ }
+
+ Tcl_ListObjLength(interp, pathPtr, &len);
+ Tcl_ListObjReplace(interp, pathPtr, len - 1, 1, 0, NULL);
+ Tcl_ListObjReplace(interp, pathPtr, 0, 1, 0, NULL);
+ Tcl_ListObjLength(interp, pathPtr, &len);
+ for (idx = 0; idx < len; idx++) {
+ Tcl_Obj *ancestorObjPtr;
+ xmlNodePtr ancestorPtr;
+
+ Tcl_ListObjIndex(interp, pathPtr, idx, &ancestorObjPtr);
+ if (eventPtr->currentNode) {
+ Tcl_DecrRefCount(eventPtr->currentNode);
+ }
+ eventPtr->currentNode = ancestorObjPtr;
+ Tcl_IncrRefCount(ancestorObjPtr);
+ if (TclDOM_libxml2_GetNodeFromObj(interp, ancestorObjPtr, &ancestorPtr) != TCL_OK) {
+ Tcl_SetResult(interp, "cannot find ancestor node \"", NULL);
+ Tcl_AppendResult(interp, Tcl_GetStringFromObj(ancestorObjPtr, NULL), "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ if (TriggerEventListeners(interp, domDocPtr->captureListeners, (void *) ancestorPtr, eventObjPtr, eventPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A listener may stop propagation,
+ * but we check here to let all of the
+ * listeners at that level complete.
+ */
+
+ if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) {
+ Tcl_DecrRefCount(ancestorObjPtr);
+ return TCL_ERROR;
+ }
+ if (cancelable && eventPtr->stopPropagation) {
+ Tcl_DecrRefCount(ancestorObjPtr);
+ goto stop_propagation;
+ }
+
+ Tcl_DecrRefCount(ancestorObjPtr);
+
+ }
+
+ /* Prepare for the next phase */
+
+ if (Tcl_IsShared(eventPtr->eventPhase)) {
+ Tcl_DecrRefCount(eventPtr->eventPhase);
+ eventPtr->eventPhase = Tcl_NewStringObj("at_target", -1);
+ Tcl_IncrRefCount(eventPtr->eventPhase);
+ } else {
+ Tcl_SetStringObj(eventPtr->eventPhase, "at_target", -1);
+ }
+ }
+
+ if (eventPtr->currentNode) {
+ Tcl_DecrRefCount(eventPtr->currentNode);
+ }
+ if (nodePtr) {
+ eventPtr->currentNode = nodeObjPtr;
+ tokenPtr = (void *) nodePtr;
+ } else {
+ eventPtr->currentNode = docObjPtr;
+ tokenPtr = (void *) docPtr;
+ }
+ Tcl_IncrRefCount(eventPtr->currentNode);
+
+ if (TriggerEventListeners(interp, domDocPtr->bubbleListeners, tokenPtr, eventObjPtr, eventPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_IsShared(eventPtr->eventPhase)) {
+ Tcl_DecrRefCount(eventPtr->eventPhase);
+ eventPtr->eventPhase = Tcl_NewStringObj("bubbling_phase", -1);
+ Tcl_IncrRefCount(eventPtr->eventPhase);
+ } else {
+ Tcl_SetStringObj(eventPtr->eventPhase, "bubbling_phase", -1);
+ }
+
+ if (Tcl_GetBooleanFromObj(interp, eventPtr->cancelable, &cancelable) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (cancelable && eventPtr->stopPropagation) {
+ /* Do no more */
+ } else if (nodePtr && nodePtr->parent && nodePtr->parent != (xmlNodePtr) nodePtr->doc) {
+ Tcl_Obj *objPtr;
+
+ objPtr = TclDOM_libxml2_CreateObjFromNode(interp, nodePtr->parent);
+ if (objPtr == NULL) {
+ return TCL_ERROR;
+ }
+ return TclDOM_DispatchEvent(interp,
+ objPtr,
+ eventObjPtr, eventPtr);
+ } else if (nodePtr && nodePtr->parent) {
+ Tcl_Obj *objPtr;
+
+ objPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc);
+ if (objPtr == NULL) {
+ return TCL_ERROR;
+ }
+ return TclDOM_DispatchEvent(interp,
+ objPtr,
+ eventObjPtr, eventPtr);
+ }
+
+stop_propagation:
+ eventPtr->dispatched = 1;
+
+ if (pathPtr) {
+ Tcl_DecrRefCount(pathPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMElementCommand --
+ *
+ * Implements dom::libxml2::element command.
+ *
+ * Results:
+ * Depends on method.
+ *
+ * Side effects:
+ * Depends on method.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOMElementCommand (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ int method, optobjc;
+ Tcl_Obj *CONST *optobjv;
+ xmlNodePtr nodePtr;
+ TclXML_libxml2_Document *tDocPtr;
+ char *value;
+ xmlAttrPtr attrPtr;
+ xmlNsPtr nsPtr;
+
+ if (clientData == NULL) {
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ optobjv = objv + 3;
+ optobjc = objc - 3;
+
+ } else {
+
+ nodePtr = (xmlNodePtr) clientData;
+
+ optobjv = objv + 2;
+ optobjc = objc - 2;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_ElementCommandMethods,
+ "method", 0, &method) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Should check that the node is of element type */
+
+ Tcl_ResetResult(interp);
+
+ switch ((enum TclDOM_ElementCommandMethods) method) {
+
+ case TCLDOM_ELEMENT_CGET:
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option");
+ return TCL_ERROR;
+ }
+
+ return ElementCget(interp, nodePtr, optobjv[0]);
+
+ break;
+
+ case TCLDOM_ELEMENT_CONFIGURE:
+
+ if (optobjc == 1) {
+ return ElementCget(interp, nodePtr, optobjv[0]);
+ } else {
+ Tcl_AppendResult(interp, "option \"", Tcl_GetStringFromObj(optobjv[0], NULL), "\" cannot be modified", NULL);
+ return TCL_ERROR;
+ }
+
+ break;
+
+ case TCLDOM_ELEMENT_GETATTRIBUTE:
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "attr");
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+ value = (char *) xmlGetProp(nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
+ Tcl_MutexUnlock(&libxml2);
+
+ if (value) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1));
+ }
+
+ break;
+
+ case TCLDOM_ELEMENT_GETATTRIBUTENS:
+ if (optobjc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "ns attr");
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+ value = (char *) xmlGetNsProp(nodePtr,
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL),
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
+ Tcl_MutexUnlock(&libxml2);
+
+ if (value) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1));
+ }
+
+ break;
+
+ case TCLDOM_ELEMENT_SETATTRIBUTE:
+ if (optobjc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "attr value");
+ return TCL_ERROR;
+ }
+
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+ value = (char *) xmlGetProp(nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
+ attrPtr = xmlSetProp(nodePtr,
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL),
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL));
+ Tcl_MutexUnlock(&libxml2);
+
+ if (!attrPtr) {
+ Tcl_SetResult(interp, "unable to set attribute", NULL);
+ return TCL_ERROR;
+ }
+
+ TclDOM_PostMutationEvent(interp, tDocPtr, objv[2], TCLDOM_EVENT_DOMATTRMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, Tcl_NewStringObj(value, -1), optobjv[1], optobjv[0], value == NULL? Tcl_NewStringObj("modification", -1) : Tcl_NewStringObj("addition", -1));
+
+ Tcl_SetObjResult(interp, optobjv[1]);
+
+ break;
+
+ case TCLDOM_ELEMENT_SETATTRIBUTENS:
+ if (optobjc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "ns attr value");
+ return TCL_ERROR;
+ }
+
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_MutexLock(&libxml2);
+
+ nsPtr = xmlSearchNsByHref(nodePtr->doc, nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
+ if (!nsPtr) {
+ Tcl_SetResult(interp, "no XML Namespace declaration for namespace", NULL);
+ Tcl_MutexUnlock(&libxml2);
+ return TCL_ERROR;
+ }
+
+ value = (char *) xmlGetNsProp(nodePtr,
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL),
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[2], NULL));
+ attrPtr = xmlSetNsProp(nodePtr,
+ nsPtr,
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[1], NULL),
+ (const xmlChar *) Tcl_GetStringFromObj(optobjv[3], NULL));
+
+ Tcl_MutexUnlock(&libxml2);
+
+ if (!attrPtr) {
+ Tcl_SetResult(interp, "unable to set attribute", NULL);
+ return TCL_ERROR;
+ }
+
+ TclDOM_PostMutationEvent(interp, tDocPtr, objv[2], TCLDOM_EVENT_DOMATTRMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, Tcl_NewStringObj(value, -1), optobjv[3], optobjv[2], value == NULL? Tcl_NewStringObj("modification", -1) : Tcl_NewStringObj("addition", -1));
+
+ break;
+
+ case TCLDOM_ELEMENT_REMOVEATTRIBUTE:
+
+ if (optobjc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "attr");
+ return TCL_ERROR;
+ }
+
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* It doesn't matter if this fails due to a non-existant attribute */
+ Tcl_MutexLock(&libxml2);
+ xmlUnsetProp(nodePtr, (const xmlChar *) Tcl_GetStringFromObj(optobjv[0], NULL));
+ Tcl_MutexUnlock(&libxml2);
+
+ TclDOM_PostMutationEvent(interp, tDocPtr, objv[2], TCLDOM_EVENT_DOMATTRMODIFIED, NULL, Tcl_NewIntObj(1), Tcl_NewIntObj(0), NULL, NULL, NULL, optobjv[2], Tcl_NewStringObj("removed", -1));
+
+ break;
+
+ default:
+ Tcl_SetResult(interp, "method \"", NULL);
+ Tcl_AppendResult(interp, Tcl_GetStringFromObj(objv[1], NULL), "\" not yet implemented", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+int
+ElementCget(interp, nodePtr, optObj)
+ Tcl_Interp *interp;
+ xmlNodePtr nodePtr;
+ Tcl_Obj *CONST optObj;
+{
+ int option;
+
+ if (Tcl_GetIndexFromObj(interp, optObj, TclDOM_ElementCommandOptions,
+ "option", 0, &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum TclDOM_ElementCommandOptions) option) {
+ case TCLDOM_ELEMENT_TAGNAME:
+ Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) nodePtr->name, -1));
+ break;
+
+ case TCLDOM_ELEMENT_EMPTY:
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ break;
+
+ default:
+ Tcl_SetResult(interp, "unknown option", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_InitEvent --
+ *
+ * Initializes an event object.
+ *
+ * Results:
+ * Tcl_Obj references stored.
+ *
+ * Side effects:
+ * Tcl_Obj's reference count changed.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+void
+TclDOM_InitEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr)
+ TclDOM_libxml2_Event *eventPtr;
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr;
+ Tcl_Obj *bubblesPtr;
+ Tcl_Obj *cancelablePtr;
+{
+ if (type != TCLDOM_EVENT_USERDEFINED) {
+ if (eventPtr->type != type) {
+ if (eventPtr->typeObjPtr) {
+ Tcl_DecrRefCount(eventPtr->typeObjPtr);
+ eventPtr->typeObjPtr = NULL;
+ }
+ eventPtr->type = type;
+ }
+ } else {
+ char *oldType, *newType;
+ int oldLen, newLen;
+
+ oldType = Tcl_GetStringFromObj(eventPtr->typeObjPtr, &oldLen);
+ newType = Tcl_GetStringFromObj(typeObjPtr, &newLen);
+ if (oldLen != newLen ||
+ strncmp(oldType, newType, oldLen)) {
+ Tcl_DecrRefCount(eventPtr->typeObjPtr);
+ eventPtr->typeObjPtr = typeObjPtr;
+ Tcl_IncrRefCount(typeObjPtr);
+ eventPtr->type = TCLDOM_EVENT_USERDEFINED;
+ }
+ }
+
+ if (bubblesPtr && eventPtr->bubbles != bubblesPtr) {
+ Tcl_DecrRefCount(eventPtr->bubbles);
+ eventPtr->bubbles = bubblesPtr;
+ Tcl_IncrRefCount(eventPtr->bubbles);
+ }
+ if (cancelablePtr && eventPtr->cancelable != cancelablePtr) {
+ Tcl_DecrRefCount(eventPtr->cancelable);
+ eventPtr->cancelable = cancelablePtr;
+ Tcl_IncrRefCount(eventPtr->cancelable);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_InitUIEvent --
+ *
+ * Initializes an event object.
+ *
+ * Results:
+ * Tcl_Obj references stored.
+ *
+ * Side effects:
+ * Tcl_Obj's reference count changed.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+void
+TclDOM_InitUIEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr)
+ TclDOM_libxml2_Event *eventPtr;
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr;
+ Tcl_Obj *bubblesPtr;
+ Tcl_Obj *cancelablePtr;
+ Tcl_Obj *viewPtr;
+ Tcl_Obj *detailPtr;
+{
+ TclDOM_InitEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr);
+
+ if (viewPtr && eventPtr->view != viewPtr) {
+ Tcl_DecrRefCount(eventPtr->view);
+ eventPtr->view = viewPtr;
+ Tcl_IncrRefCount(eventPtr->view);
+ }
+ if (detailPtr && eventPtr->detail != detailPtr) {
+ Tcl_DecrRefCount(eventPtr->detail);
+ eventPtr->detail = detailPtr;
+ Tcl_IncrRefCount(eventPtr->detail);
+ } else if (detailPtr == NULL) {
+ Tcl_DecrRefCount(eventPtr->detail);
+ eventPtr->detail = Tcl_NewObj();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_InitMouseEvent --
+ *
+ * Initializes an event object.
+ *
+ * Results:
+ * Tcl_Obj references stored.
+ *
+ * Side effects:
+ * Tcl_Obj's reference count changed.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+void
+TclDOM_InitMouseEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, altKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr, relatedNodePtr)
+ TclDOM_libxml2_Event *eventPtr;
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr;
+ Tcl_Obj *bubblesPtr;
+ Tcl_Obj *cancelablePtr;
+ Tcl_Obj *viewPtr;
+ Tcl_Obj *detailPtr;
+ Tcl_Obj *screenXPtr;
+ Tcl_Obj *screenYPtr;
+ Tcl_Obj *clientXPtr;
+ Tcl_Obj *clientYPtr;
+ Tcl_Obj *ctrlKeyPtr;
+ Tcl_Obj *altKeyPtr;
+ Tcl_Obj *shiftKeyPtr;
+ Tcl_Obj *metaKeyPtr;
+ Tcl_Obj *buttonPtr;
+ Tcl_Obj *relatedNodePtr;
+{
+ TclDOM_InitUIEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr);
+
+ if (screenXPtr && eventPtr->screenX != screenXPtr) {
+ Tcl_DecrRefCount(eventPtr->screenX);
+ eventPtr->screenX = screenXPtr;
+ Tcl_IncrRefCount(eventPtr->screenX);
+ }
+ if (screenYPtr && eventPtr->screenY != screenYPtr) {
+ Tcl_DecrRefCount(eventPtr->screenY);
+ eventPtr->screenY = screenYPtr;
+ Tcl_IncrRefCount(eventPtr->screenY);
+ }
+
+ if (clientXPtr && eventPtr->clientX != clientXPtr) {
+ Tcl_DecrRefCount(eventPtr->clientX);
+ eventPtr->clientX = clientXPtr;
+ Tcl_IncrRefCount(eventPtr->clientX);
+ }
+ if (clientYPtr && eventPtr->clientY != clientYPtr) {
+ Tcl_DecrRefCount(eventPtr->clientY);
+ eventPtr->clientY = clientYPtr;
+ Tcl_IncrRefCount(eventPtr->clientY);
+ }
+
+ if (ctrlKeyPtr && eventPtr->ctrlKey != ctrlKeyPtr) {
+ Tcl_DecrRefCount(eventPtr->ctrlKey);
+ eventPtr->ctrlKey = ctrlKeyPtr;
+ Tcl_IncrRefCount(eventPtr->ctrlKey);
+ }
+ if (altKeyPtr && eventPtr->altKey != altKeyPtr) {
+ Tcl_DecrRefCount(eventPtr->altKey);
+ eventPtr->altKey = altKeyPtr;
+ Tcl_IncrRefCount(eventPtr->altKey);
+ }
+ if (shiftKeyPtr && eventPtr->shiftKey != shiftKeyPtr) {
+ Tcl_DecrRefCount(eventPtr->shiftKey);
+ eventPtr->shiftKey = shiftKeyPtr;
+ Tcl_IncrRefCount(eventPtr->shiftKey);
+ }
+ if (metaKeyPtr && eventPtr->metaKey != metaKeyPtr) {
+ Tcl_DecrRefCount(eventPtr->metaKey);
+ eventPtr->metaKey = metaKeyPtr;
+ Tcl_IncrRefCount(eventPtr->metaKey);
+ }
+ if (buttonPtr && eventPtr->button != buttonPtr) {
+ Tcl_DecrRefCount(eventPtr->button);
+ eventPtr->button = buttonPtr;
+ Tcl_IncrRefCount(eventPtr->button);
+ }
+
+ if (relatedNodePtr && eventPtr->relatedNode != relatedNodePtr) {
+ Tcl_DecrRefCount(eventPtr->relatedNode);
+ eventPtr->relatedNode = relatedNodePtr;
+ Tcl_IncrRefCount(eventPtr->relatedNode);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_InitMutationEvent --
+ *
+ * Initializes an event object.
+ *
+ * Results:
+ * Tcl_Obj references stored.
+ *
+ * Side effects:
+ * Tcl_Obj's reference count changed.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+void
+TclDOM_InitMutationEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr)
+ TclDOM_libxml2_Event *eventPtr;
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr;
+ Tcl_Obj *bubblesPtr;
+ Tcl_Obj *cancelablePtr;
+ Tcl_Obj *relatedNodePtr;
+ Tcl_Obj *prevValuePtr;
+ Tcl_Obj *newValuePtr;
+ Tcl_Obj *attrNamePtr;
+ Tcl_Obj *attrChangePtr;
+{
+ TclDOM_InitEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr);
+
+ if (relatedNodePtr && eventPtr->relatedNode != relatedNodePtr) {
+ Tcl_DecrRefCount(eventPtr->relatedNode);
+ eventPtr->relatedNode = relatedNodePtr;
+ Tcl_IncrRefCount(eventPtr->relatedNode);
+ }
+
+ if (prevValuePtr && eventPtr->prevValue != prevValuePtr) {
+ Tcl_DecrRefCount(eventPtr->prevValue);
+ eventPtr->prevValue = prevValuePtr;
+ Tcl_IncrRefCount(eventPtr->prevValue);
+ }
+ if (newValuePtr && eventPtr->newValue != newValuePtr) {
+ Tcl_DecrRefCount(eventPtr->newValue);
+ eventPtr->newValue = newValuePtr;
+ Tcl_IncrRefCount(eventPtr->newValue);
+ }
+ if (attrNamePtr && eventPtr->attrName != attrNamePtr) {
+ Tcl_DecrRefCount(eventPtr->attrName);
+ eventPtr->attrName = attrNamePtr;
+ Tcl_IncrRefCount(eventPtr->attrName);
+ }
+ if (attrChangePtr && eventPtr->attrChange != attrChangePtr) {
+ Tcl_DecrRefCount(eventPtr->attrChange);
+ eventPtr->attrChange = attrChangePtr;
+ Tcl_IncrRefCount(eventPtr->attrChange);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_PostUIEvent --
+ *
+ * Post an event and cleanup afterward.
+ *
+ * Results:
+ * Event created and propagated.
+ *
+ * Side effects:
+ * Depends on event listeners.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOM_PostUIEvent(interp, tDocPtr, nodeObjPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr)
+ Tcl_Interp *interp;
+ TclXML_libxml2_Document *tDocPtr;
+ Tcl_Obj *nodeObjPtr;
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr;
+ Tcl_Obj *bubblesPtr;
+ Tcl_Obj *cancelablePtr;
+ Tcl_Obj *viewPtr;
+ Tcl_Obj *detailPtr;
+{
+ Tcl_Obj *eventObj;
+ TclDOM_libxml2_Event *eventPtr = NULL;
+ int result;
+
+ /*
+ * Performance optimisation: if there are no event listeners for this
+ * event type then don't bother creating an event.
+ */
+ if (!HasListener(interp, tDocPtr, type)) {
+ return TCL_OK;
+ }
+
+ eventObj = TclDOM_libxml2_NewEventObj(interp, tDocPtr->docPtr, type, typeObjPtr);
+ if (eventObj == NULL) {
+ Tcl_SetResult(interp, "unable to create event", NULL);
+ return TCL_ERROR;
+ }
+
+ TclDOM_libxml2_GetEventFromObj(interp, eventObj, &eventPtr);
+
+ TclDOM_InitUIEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr);
+
+ Tcl_ResetResult(interp);
+ result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr);
+
+ TclDOM_libxml2_DestroyNode(interp, eventPtr->tNodePtr);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_PostMouseEvent --
+ *
+ * Post an event and cleanup afterward.
+ *
+ * Results:
+ * Event created and propagated.
+ *
+ * Side effects:
+ * Depends on event listeners.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOM_PostMouseEvent(interp, tDocPtr, nodeObjPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, altKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr)
+ Tcl_Interp *interp;
+ TclXML_libxml2_Document *tDocPtr;
+ Tcl_Obj *nodeObjPtr;
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr;
+ Tcl_Obj *bubblesPtr;
+ Tcl_Obj *cancelablePtr;
+ Tcl_Obj *relatedNodePtr;
+ Tcl_Obj *viewPtr;
+ Tcl_Obj *detailPtr;
+ Tcl_Obj *screenXPtr;
+ Tcl_Obj *screenYPtr;
+ Tcl_Obj *clientXPtr;
+ Tcl_Obj *clientYPtr;
+ Tcl_Obj *ctrlKeyPtr;
+ Tcl_Obj *altKeyPtr;
+ Tcl_Obj *shiftKeyPtr;
+ Tcl_Obj *metaKeyPtr;
+ Tcl_Obj *buttonPtr;
+{
+ Tcl_Obj *eventObj;
+ TclDOM_libxml2_Event *eventPtr = NULL;
+ int result;
+
+ /*
+ * Performance optimisation: if there are no event listeners for this
+ * event type then don't bother creating an event.
+ */
+ if (!HasListener(interp, tDocPtr, type)) {
+ return TCL_OK;
+ }
+
+ eventObj = TclDOM_libxml2_NewEventObj(interp, tDocPtr->docPtr, type, typeObjPtr);
+ if (eventObj == NULL) {
+ Tcl_SetResult(interp, "unable to create event", NULL);
+ return TCL_ERROR;
+ }
+
+ TclDOM_libxml2_GetEventFromObj(interp, eventObj, &eventPtr);
+
+ TclDOM_InitMouseEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr,
+ viewPtr, detailPtr,
+ screenXPtr, screenYPtr, clientXPtr, clientYPtr,
+ ctrlKeyPtr, altKeyPtr, shiftKeyPtr, metaKeyPtr,
+ buttonPtr, relatedNodePtr);
+
+ Tcl_ResetResult(interp);
+ result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr);
+
+ TclDOM_libxml2_DestroyNode(interp, eventPtr->tNodePtr);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_PostMutationEvent --
+ *
+ * Post an event and cleanup afterward.
+ *
+ * Results:
+ * Event created and propagated.
+ *
+ * Side effects:
+ * Depends on event listeners.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOM_PostMutationEvent(interp, tDocPtr, nodeObjPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr)
+ Tcl_Interp *interp;
+ TclXML_libxml2_Document *tDocPtr;
+ Tcl_Obj *nodeObjPtr;
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr;
+ Tcl_Obj *bubblesPtr;
+ Tcl_Obj *cancelablePtr;
+ Tcl_Obj *relatedNodePtr;
+ Tcl_Obj *prevValuePtr;
+ Tcl_Obj *newValuePtr;
+ Tcl_Obj *attrNamePtr;
+ Tcl_Obj *attrChangePtr;
+{
+ Tcl_Obj *eventObj;
+ TclDOM_libxml2_Event *eventPtr = NULL;
+ int result;
+
+ /*
+ * Performance optimisation: if there are no event listeners for this
+ * event type then don't bother creating an event.
+ */
+ if (!HasListener(interp, tDocPtr, type)) {
+ return TCL_OK;
+ }
+
+ eventObj = TclDOM_libxml2_NewEventObj(interp, tDocPtr->docPtr, type, typeObjPtr);
+ if (eventObj == NULL) {
+ Tcl_SetResult(interp, "unable to create event", NULL);
+ return TCL_ERROR;
+ }
+
+ TclDOM_libxml2_GetEventFromObj(interp, eventObj, &eventPtr);
+
+ TclDOM_InitMutationEvent(eventPtr, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr);
+
+ Tcl_ResetResult(interp);
+ result = TclDOM_DispatchEvent(interp, nodeObjPtr, eventObj, eventPtr);
+
+ TclDOM_libxml2_DestroyNode(interp, eventPtr->tNodePtr);
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMEventCommand --
+ *
+ * Implements dom::libxml2::event command.
+ *
+ * Results:
+ * Depends on method.
+ *
+ * Side effects:
+ * Depends on method.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOMEventCommand (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ int method, option;
+ TclXML_libxml2_Document *tDocPtr;
+ TclDOM_libxml2_Node *tNodePtr;
+ TclDOM_libxml2_Event *eventPtr;
+ xmlNodePtr nodePtr;
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr = NULL;
+ Tcl_Obj *nodeObj;
+ Tcl_Obj *bubblesPtr, *cancelablePtr, *viewPtr, *detailPtr;
+ Tcl_Obj *relatedNodePtr, *screenXPtr, *screenYPtr, *clientXPtr, *clientYPtr;
+ Tcl_Obj *ctrlKeyPtr, *shiftKeyPtr, *metaKeyPtr, *buttonPtr;
+ Tcl_Obj *prevValuePtr, *newValuePtr, *attrNamePtr, *attrChangePtr;
+
+ if (objc < 2) {
+ if (clientData == NULL) {
+ Tcl_WrongNumArgs(interp, 1, objv, "method token ?args...?");
+ } else {
+ Tcl_WrongNumArgs(interp, 1, objv, "method ?args...?");
+ }
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], TclDOM_EventCommandMethods,
+ "method", 0, &method) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum TclDOM_EventCommandMethods) method) {
+
+ case TCLDOM_EVENT_CGET:
+
+ if (clientData) {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "cget option");
+ return TCL_ERROR;
+ }
+ tNodePtr = (TclDOM_libxml2_Node *) clientData;
+ if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
+ Tcl_SetResult(interp, "bad event node", NULL);
+ return TCL_ERROR;
+ }
+ eventPtr = tNodePtr->ptr.eventPtr;
+ objc -= 2;
+ objv += 2;
+ } else {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 3, objv, "cget event option");
+ return TCL_ERROR;
+ }
+ if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ objc -= 3;
+ objv += 3;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions,
+ "option", 0, &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum TclDOM_EventCommandOptions) option) {
+ case TCLDOM_EVENT_ALTKEY:
+ Tcl_SetObjResult(interp, eventPtr->altKey);
+ break;
+ case TCLDOM_EVENT_ATTRNAME:
+ Tcl_SetObjResult(interp, eventPtr->attrName);
+ break;
+ case TCLDOM_EVENT_ATTRCHANGE:
+ Tcl_SetObjResult(interp, eventPtr->attrChange);
+ break;
+ case TCLDOM_EVENT_BUBBLES:
+ Tcl_SetObjResult(interp, eventPtr->bubbles);
+ break;
+ case TCLDOM_EVENT_BUTTON:
+ Tcl_SetObjResult(interp, eventPtr->button);
+ break;
+ case TCLDOM_EVENT_CANCELABLE:
+ Tcl_SetObjResult(interp, eventPtr->cancelable);
+ break;
+ case TCLDOM_EVENT_CLIENTX:
+ Tcl_SetObjResult(interp, eventPtr->clientX);
+ break;
+ case TCLDOM_EVENT_CLIENTY:
+ Tcl_SetObjResult(interp, eventPtr->clientY);
+ break;
+ case TCLDOM_EVENT_CTRLKEY:
+ Tcl_SetObjResult(interp, eventPtr->ctrlKey);
+ break;
+ case TCLDOM_EVENT_CURRENTNODE:
+ Tcl_SetObjResult(interp, eventPtr->currentNode);
+ break;
+ case TCLDOM_EVENT_DETAIL:
+ Tcl_SetObjResult(interp, eventPtr->detail);
+ break;
+ case TCLDOM_EVENT_EVENTPHASE:
+ Tcl_SetObjResult(interp, eventPtr->eventPhase);
+ break;
+ case TCLDOM_EVENT_METAKEY:
+ Tcl_SetObjResult(interp, eventPtr->metaKey);
+ break;
+ case TCLDOM_EVENT_NEWVALUE:
+ Tcl_SetObjResult(interp, eventPtr->newValue);
+ break;
+ case TCLDOM_EVENT_PREVVALUE:
+ Tcl_SetObjResult(interp, eventPtr->prevValue);
+ break;
+ case TCLDOM_EVENT_RELATEDNODE:
+ Tcl_SetObjResult(interp, eventPtr->relatedNode);
+ break;
+ case TCLDOM_EVENT_SCREENX:
+ Tcl_SetObjResult(interp, eventPtr->screenX);
+ break;
+ case TCLDOM_EVENT_SCREENY:
+ Tcl_SetObjResult(interp, eventPtr->screenY);
+ break;
+ case TCLDOM_EVENT_SHIFTKEY:
+ Tcl_SetObjResult(interp, eventPtr->shiftKey);
+ break;
+ case TCLDOM_EVENT_TARGET:
+ Tcl_SetObjResult(interp, eventPtr->target);
+ break;
+ case TCLDOM_EVENT_TIMESTAMP:
+ Tcl_SetObjResult(interp, eventPtr->timeStamp);
+ break;
+ case TCLDOM_EVENT_TYPE:
+ if (eventPtr->type == TCLDOM_EVENT_USERDEFINED) {
+ Tcl_SetObjResult(interp, eventPtr->typeObjPtr);
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(TclDOM_EventTypes[eventPtr->type], -1));
+ }
+ break;
+ case TCLDOM_EVENT_VIEW:
+ Tcl_SetObjResult(interp, eventPtr->view);
+ break;
+ default:
+ Tcl_SetResult(interp, "unknown option", NULL);
+ return TCL_ERROR;
+ }
+
+ break;
+
+ case TCLDOM_EVENT_CONFIGURE:
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 3, objv, "configure option ?value?");
+ return TCL_ERROR;
+ }
+
+ /* No event options are writable */
+ Tcl_SetResult(interp, "option cannot be modified", NULL);
+ return TCL_ERROR;
+
+ break;
+
+ case TCLDOM_EVENT_STOPPROPAGATION:
+
+ if (clientData) {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "");
+ return TCL_ERROR;
+ }
+
+ tNodePtr = (TclDOM_libxml2_Node *) clientData;
+ if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
+ Tcl_SetResult(interp, "bad event node", NULL);
+ return TCL_ERROR;
+ }
+ eventPtr = tNodePtr->ptr.eventPtr;
+ } else {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, "");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ eventPtr->stopPropagation = 1;
+
+ break;
+
+ case TCLDOM_EVENT_PREVENTDEFAULT:
+
+ if (clientData) {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "");
+ return TCL_ERROR;
+ }
+
+ tNodePtr = (TclDOM_libxml2_Node *) clientData;
+ if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
+ Tcl_SetResult(interp, "bad event node", NULL);
+ return TCL_ERROR;
+ }
+ eventPtr = tNodePtr->ptr.eventPtr;
+ } else {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 3, objv, "");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ eventPtr->preventDefault = 1;
+
+ break;
+
+ case TCLDOM_EVENT_INITEVENT:
+
+ if (clientData) {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable");
+ return TCL_ERROR;
+ }
+
+ tNodePtr = (TclDOM_libxml2_Node *) clientData;
+ if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
+ Tcl_SetResult(interp, "bad event node", NULL);
+ return TCL_ERROR;
+ }
+ eventPtr = tNodePtr->ptr.eventPtr;
+ objc -= 2;
+ objv += 2;
+ } else {
+ if (objc != 6) {
+ Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ objc -= 3;
+ objv += 3;
+ }
+
+ if (eventPtr->dispatched) {
+ Tcl_SetResult(interp, "event has been dispatched", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes,
+ "type", TCL_EXACT, &option) == TCL_OK) {
+ type = (enum TclDOM_EventTypes) option;
+ } else {
+ type = TCLDOM_EVENT_USERDEFINED;
+ }
+ Tcl_ResetResult(interp);
+
+ TclDOM_InitEvent(eventPtr, type, objv[0], objv[1], objv[2]);
+
+ break;
+
+ case TCLDOM_EVENT_INITUIEVENT:
+
+ if (clientData) {
+ if (objc < 6 || objc > 7) {
+ Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable view ?detail?");
+ return TCL_ERROR;
+ }
+
+ tNodePtr = (TclDOM_libxml2_Node *) clientData;
+ if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
+ Tcl_SetResult(interp, "bad event node", NULL);
+ return TCL_ERROR;
+ }
+ eventPtr = tNodePtr->ptr.eventPtr;
+
+ objc -= 2;
+ objv += 2;
+ } else {
+ if (objc < 7 || objc > 8) {
+ Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable view ?detail?");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ objc -= 3;
+ objv += 3;
+ }
+
+ if (eventPtr->dispatched) {
+ Tcl_SetResult(interp, "event has been dispatched", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes,
+ "type", TCL_EXACT, &option) == TCL_OK) {
+ type = (enum TclDOM_EventTypes) option;
+ } else {
+ type = TCLDOM_EVENT_USERDEFINED;
+ }
+ Tcl_ResetResult(interp);
+
+ TclDOM_InitUIEvent(eventPtr, type, objv[0], objv[1], objv[2], objv[3], objc == 5 ? objv[4] : NULL);
+
+ break;
+
+ case TCLDOM_EVENT_INITMOUSEEVENT:
+
+ if (clientData) {
+ if (objc != 17) {
+ Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable view detail screenX screenY clientX clientY ctrlKey altKey shiftKey metaKey button relatedNode");
+ return TCL_ERROR;
+ }
+
+ tNodePtr = (TclDOM_libxml2_Node *) clientData;
+ if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
+ Tcl_SetResult(interp, "bad event node", NULL);
+ return TCL_ERROR;
+ }
+ eventPtr = tNodePtr->ptr.eventPtr;
+
+ objc -= 2;
+ objv += 2;
+ } else {
+ if (objc != 18) {
+ Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable view detail screenX screenY clientX clientY ctrlKey altKey shiftKey metaKey button relatedNode");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ objc -= 3;
+ objv += 3;
+ }
+
+ if (eventPtr->dispatched) {
+ Tcl_SetResult(interp, "event has been dispatched", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes,
+ "type", TCL_EXACT, &option) == TCL_OK) {
+ type = (enum TclDOM_EventTypes) option;
+ } else {
+ type = TCLDOM_EVENT_USERDEFINED;
+ }
+ Tcl_ResetResult(interp);
+
+ TclDOM_InitMouseEvent(eventPtr, type, objv[0], objv[1], objv[2], objv[3], objv[4], objv[5], objv[6], objv[7], objv[8], objv[9], objv[10], objv[11], objv[12], objv[13], objv[14]);
+
+ break;
+
+ case TCLDOM_EVENT_INITMUTATIONEVENT:
+
+ if (clientData) {
+ if (objc != 10) {
+ Tcl_WrongNumArgs(interp, 2, objv, "type bubbles cancelable relatedNode prevValue newValue attrName attrChange");
+ return TCL_ERROR;
+ }
+
+ tNodePtr = (TclDOM_libxml2_Node *) clientData;
+ if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
+ Tcl_SetResult(interp, "bad event node", NULL);
+ return TCL_ERROR;
+ }
+ eventPtr = tNodePtr->ptr.eventPtr;
+
+ objc -= 2;
+ objv += 2;
+ } else {
+ if (objc != 11) {
+ Tcl_WrongNumArgs(interp, 3, objv, "type bubbles cancelable relatedNode prevValue newValue attrName attrChange");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetEventFromObj(interp, objv[2], &eventPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ objc -= 3;
+ objv += 3;
+ }
+
+ if (eventPtr->dispatched) {
+ Tcl_SetResult(interp, "event has been dispatched", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventTypes,
+ "type", TCL_EXACT, &option) == TCL_OK) {
+ type = (enum TclDOM_EventTypes) option;
+ } else {
+ type = TCLDOM_EVENT_USERDEFINED;
+ }
+ Tcl_ResetResult(interp);
+
+ TclDOM_InitMutationEvent(eventPtr, type, objv[0], objv[1], objv[2], objv[3], objv[4], objv[5], objv[6], objv[7]);
+
+ break;
+
+ case TCLDOM_EVENT_POSTUIEVENT:
+
+ if (clientData) {
+ Tcl_SetResult(interp, "bad method for event", NULL);
+ return TCL_ERROR;
+ }
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "postUIEvent node type ?args ...?");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ nodeObj = objv[2];
+
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], TclDOM_EventTypes,
+ "type", TCL_EXACT, &option) == TCL_OK) {
+ type = (enum TclDOM_EventTypes) option;
+ } else {
+ type = TCLDOM_EVENT_USERDEFINED;
+ }
+ typeObjPtr = objv[3];
+ Tcl_ResetResult(interp);
+
+ bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ if (!bubblesPtr) {
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(bubblesPtr);
+ cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ if (!cancelablePtr) {
+ Tcl_DecrRefCount(bubblesPtr);
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(cancelablePtr);
+
+ viewPtr = Tcl_NewObj();
+ detailPtr = Tcl_NewObj();
+
+ objc -= 4;
+ objv += 4;
+ while (objc) {
+
+ if (objc == 1) {
+ Tcl_SetResult(interp, "value missing", NULL);
+ Tcl_DecrRefCount(bubblesPtr);
+ Tcl_DecrRefCount(cancelablePtr);
+ Tcl_DecrRefCount(viewPtr);
+ Tcl_DecrRefCount(detailPtr);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions,
+ "option", 0, &option) != TCL_OK) {
+ Tcl_DecrRefCount(bubblesPtr);
+ Tcl_DecrRefCount(cancelablePtr);
+ Tcl_DecrRefCount(viewPtr);
+ Tcl_DecrRefCount(detailPtr);
+ return TCL_ERROR;
+ }
+ switch ((enum TclDOM_EventCommandOptions) option) {
+ case TCLDOM_EVENT_BUBBLES:
+ Tcl_DecrRefCount(bubblesPtr);
+ bubblesPtr = objv[1];
+ Tcl_IncrRefCount(bubblesPtr);
+ break;
+ case TCLDOM_EVENT_CANCELABLE:
+ Tcl_DecrRefCount(cancelablePtr);
+ cancelablePtr = objv[1];
+ Tcl_IncrRefCount(cancelablePtr);
+ break;
+ case TCLDOM_EVENT_VIEW:
+ Tcl_DecrRefCount(viewPtr);
+ viewPtr = objv[1];
+ Tcl_IncrRefCount(viewPtr);
+ break;
+ case TCLDOM_EVENT_DETAIL:
+ Tcl_DecrRefCount(detailPtr);
+ detailPtr = objv[1];
+ Tcl_IncrRefCount(detailPtr);
+ break;
+ default:
+ Tcl_SetResult(interp, "bad option", NULL);
+ Tcl_DecrRefCount(bubblesPtr);
+ Tcl_DecrRefCount(cancelablePtr);
+ Tcl_DecrRefCount(viewPtr);
+ Tcl_DecrRefCount(detailPtr);
+ return TCL_ERROR;
+ }
+
+ objc -= 2;
+ objv += 2;
+ }
+
+ if (TclDOM_PostUIEvent(interp, tDocPtr, nodeObj, type, typeObjPtr, bubblesPtr, cancelablePtr, viewPtr, detailPtr) != TCL_OK) {
+ Tcl_DecrRefCount(bubblesPtr);
+ Tcl_DecrRefCount(cancelablePtr);
+ Tcl_DecrRefCount(viewPtr);
+ Tcl_DecrRefCount(detailPtr);
+ return TCL_ERROR;
+ }
+
+ break;
+
+ case TCLDOM_EVENT_POSTMOUSEEVENT:
+
+ if (clientData) {
+ Tcl_SetResult(interp, "bad method for event", NULL);
+ return TCL_ERROR;
+ }
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "postMouseEvent node type ?args ...?");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ nodeObj = objv[2];
+
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], TclDOM_EventTypes,
+ "type", TCL_EXACT, &option) == TCL_OK) {
+ type = (enum TclDOM_EventTypes) option;
+ } else {
+ type = TCLDOM_EVENT_USERDEFINED;
+ }
+ typeObjPtr = objv[3];
+ Tcl_ResetResult(interp);
+
+ bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ if (!bubblesPtr) {
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(bubblesPtr);
+ cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ if (!cancelablePtr) {
+ Tcl_DecrRefCount(bubblesPtr);
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(cancelablePtr);
+
+ viewPtr = Tcl_NewObj();
+ detailPtr = Tcl_NewObj();
+ relatedNodePtr = Tcl_NewObj();
+ screenXPtr = Tcl_NewObj();
+ screenYPtr = Tcl_NewObj();
+ clientXPtr = Tcl_NewObj();
+ clientYPtr = Tcl_NewObj();
+ ctrlKeyPtr = Tcl_NewObj();
+ shiftKeyPtr = Tcl_NewObj();
+ metaKeyPtr = Tcl_NewObj();
+ buttonPtr = Tcl_NewObj();
+
+ objc -= 4;
+ objv += 4;
+ while (objc) {
+
+ if (objc == 1) {
+ Tcl_SetResult(interp, "value missing", NULL);
+ goto mouse_error;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions,
+ "option", 0, &option) != TCL_OK) {
+ goto mouse_error;
+ }
+ switch ((enum TclDOM_EventCommandOptions) option) {
+ case TCLDOM_EVENT_BUBBLES:
+ Tcl_DecrRefCount(bubblesPtr);
+ bubblesPtr = objv[1];
+ Tcl_IncrRefCount(bubblesPtr);
+ break;
+ case TCLDOM_EVENT_CANCELABLE:
+ Tcl_DecrRefCount(cancelablePtr);
+ cancelablePtr = objv[1];
+ Tcl_IncrRefCount(cancelablePtr);
+ break;
+ case TCLDOM_EVENT_RELATEDNODE:
+ Tcl_DecrRefCount(relatedNodePtr);
+ relatedNodePtr = objv[1];
+ Tcl_IncrRefCount(relatedNodePtr);
+ break;
+ case TCLDOM_EVENT_VIEW:
+ Tcl_DecrRefCount(viewPtr);
+ viewPtr = objv[1];
+ Tcl_IncrRefCount(viewPtr);
+ break;
+ case TCLDOM_EVENT_DETAIL:
+ Tcl_DecrRefCount(detailPtr);
+ detailPtr = objv[1];
+ Tcl_IncrRefCount(detailPtr);
+ break;
+ case TCLDOM_EVENT_SCREENX:
+ Tcl_DecrRefCount(screenXPtr);
+ screenXPtr = objv[1];
+ Tcl_IncrRefCount(screenXPtr);
+ break;
+ case TCLDOM_EVENT_SCREENY:
+ Tcl_DecrRefCount(screenYPtr);
+ screenYPtr = objv[1];
+ Tcl_IncrRefCount(screenYPtr);
+ break;
+ case TCLDOM_EVENT_CLIENTX:
+ Tcl_DecrRefCount(clientXPtr);
+ clientXPtr = objv[1];
+ Tcl_IncrRefCount(clientXPtr);
+ break;
+ case TCLDOM_EVENT_CLIENTY:
+ Tcl_DecrRefCount(clientYPtr);
+ clientYPtr = objv[1];
+ Tcl_IncrRefCount(clientYPtr);
+ break;
+ case TCLDOM_EVENT_CTRLKEY:
+ Tcl_DecrRefCount(ctrlKeyPtr);
+ ctrlKeyPtr = objv[1];
+ Tcl_IncrRefCount(ctrlKeyPtr);
+ break;
+ case TCLDOM_EVENT_SHIFTKEY:
+ Tcl_DecrRefCount(shiftKeyPtr);
+ shiftKeyPtr = objv[1];
+ Tcl_IncrRefCount(shiftKeyPtr);
+ break;
+ case TCLDOM_EVENT_METAKEY:
+ Tcl_DecrRefCount(metaKeyPtr);
+ metaKeyPtr = objv[1];
+ Tcl_IncrRefCount(metaKeyPtr);
+ break;
+ case TCLDOM_EVENT_BUTTON:
+ Tcl_DecrRefCount(buttonPtr);
+ buttonPtr = objv[1];
+ Tcl_IncrRefCount(buttonPtr);
+ break;
+ default:
+ Tcl_SetResult(interp, "bad option", NULL);
+ goto mouse_error;
+ }
+
+ objc -= 2;
+ objv += 2;
+ }
+
+ if (TclDOM_PostMouseEvent(interp, tDocPtr, nodeObj, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, viewPtr, detailPtr, screenXPtr, screenYPtr, clientXPtr, clientYPtr, ctrlKeyPtr, shiftKeyPtr, metaKeyPtr, buttonPtr, relatedNodePtr) != TCL_OK) {
+ goto mouse_error;
+ }
+
+ break;
+
+mouse_error:
+ Tcl_DecrRefCount(bubblesPtr);
+ Tcl_DecrRefCount(cancelablePtr);
+ Tcl_DecrRefCount(viewPtr);
+ Tcl_DecrRefCount(detailPtr);
+ Tcl_DecrRefCount(relatedNodePtr);
+ Tcl_DecrRefCount(screenXPtr);
+ Tcl_DecrRefCount(screenYPtr);
+ Tcl_DecrRefCount(clientXPtr);
+ Tcl_DecrRefCount(clientYPtr);
+ Tcl_DecrRefCount(ctrlKeyPtr);
+ Tcl_DecrRefCount(shiftKeyPtr);
+ Tcl_DecrRefCount(metaKeyPtr);
+ Tcl_DecrRefCount(buttonPtr);
+
+ return TCL_ERROR;
+
+ case TCLDOM_EVENT_POSTMUTATIONEVENT:
+
+ if (clientData) {
+ Tcl_SetResult(interp, "bad method for event", NULL);
+ return TCL_ERROR;
+ }
+
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "postMutationEvent node type ?args ...?");
+ return TCL_ERROR;
+ }
+
+ if (TclDOM_libxml2_GetNodeFromObj(interp, objv[2], &nodePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ nodeObj = objv[2];
+
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[3], TclDOM_EventTypes,
+ "type", TCL_EXACT, &option) == TCL_OK) {
+ type = (enum TclDOM_EventTypes) option;
+ } else {
+ type = TCLDOM_EVENT_USERDEFINED;
+ }
+ typeObjPtr = objv[3];
+ Tcl_ResetResult(interp);
+
+ bubblesPtr = Tcl_GetVar2Ex(interp, "::dom::bubbles", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ if (!bubblesPtr) {
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(bubblesPtr);
+ cancelablePtr = Tcl_GetVar2Ex(interp, "::dom::cancelable", Tcl_GetStringFromObj(objv[3], NULL), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG);
+ if (!cancelablePtr) {
+ Tcl_DecrRefCount(bubblesPtr);
+ return TCL_ERROR;
+ }
+ Tcl_IncrRefCount(cancelablePtr);
+
+ relatedNodePtr = Tcl_NewObj();
+ prevValuePtr = Tcl_NewObj();
+ newValuePtr = Tcl_NewObj();
+ attrNamePtr = Tcl_NewObj();
+ attrChangePtr = Tcl_NewObj();
+
+ objc -= 4;
+ objv += 4;
+ while (objc) {
+
+ if (objc == 1) {
+ Tcl_SetResult(interp, "value missing", NULL);
+ goto mutation_error;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[0], TclDOM_EventCommandOptions,
+ "option", 0, &option) != TCL_OK) {
+ goto mutation_error;
+ }
+ switch ((enum TclDOM_EventCommandOptions) option) {
+ case TCLDOM_EVENT_BUBBLES:
+ Tcl_DecrRefCount(bubblesPtr);
+ bubblesPtr = objv[1];
+ Tcl_IncrRefCount(bubblesPtr);
+ break;
+ case TCLDOM_EVENT_CANCELABLE:
+ Tcl_DecrRefCount(cancelablePtr);
+ cancelablePtr = objv[1];
+ Tcl_IncrRefCount(cancelablePtr);
+ break;
+ case TCLDOM_EVENT_RELATEDNODE:
+ Tcl_DecrRefCount(relatedNodePtr);
+ relatedNodePtr = objv[1];
+ Tcl_IncrRefCount(relatedNodePtr);
+ break;
+ case TCLDOM_EVENT_PREVVALUE:
+ Tcl_DecrRefCount(prevValuePtr);
+ prevValuePtr = objv[1];
+ Tcl_IncrRefCount(prevValuePtr);
+ break;
+ case TCLDOM_EVENT_NEWVALUE:
+ Tcl_DecrRefCount(newValuePtr);
+ newValuePtr = objv[1];
+ Tcl_IncrRefCount(newValuePtr);
+ break;
+ case TCLDOM_EVENT_ATTRNAME:
+ Tcl_DecrRefCount(attrNamePtr);
+ attrNamePtr = objv[1];
+ Tcl_IncrRefCount(attrNamePtr);
+ break;
+ case TCLDOM_EVENT_ATTRCHANGE:
+ Tcl_DecrRefCount(attrChangePtr);
+ attrChangePtr = objv[1];
+ Tcl_IncrRefCount(attrChangePtr);
+ break;
+ default:
+ Tcl_SetResult(interp, "bad option", NULL);
+ goto mutation_error;
+ }
+
+ objc -= 2;
+ objv += 2;
+ }
+
+ if (TclDOM_PostMutationEvent(interp, tDocPtr, nodeObj, type, typeObjPtr, bubblesPtr, cancelablePtr, relatedNodePtr, prevValuePtr, newValuePtr, attrNamePtr, attrChangePtr) != TCL_OK) {
+ goto mutation_error;
+ }
+
+ break;
+
+mutation_error:
+ Tcl_DecrRefCount(bubblesPtr);
+ Tcl_DecrRefCount(cancelablePtr);
+ Tcl_DecrRefCount(relatedNodePtr);
+ Tcl_DecrRefCount(prevValuePtr);
+ Tcl_DecrRefCount(newValuePtr);
+ Tcl_DecrRefCount(attrNamePtr);
+ Tcl_DecrRefCount(attrChangePtr);
+
+ return TCL_ERROR;
+
+ default:
+
+ Tcl_SetResult(interp, "unknown method", NULL);
+ return TCL_ERROR;
+
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * GetPath --
+ *
+ * Constructs a list of ancestor nodes.
+ *
+ * Results:
+ * Returns list as a Tcl_Obj.
+ *
+ * Side effects:
+ * Allocates Tcl_Obj structures.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+GetPath (interp, nodePtr)
+ Tcl_Interp *interp;
+ xmlNodePtr nodePtr;
+{
+ Tcl_Obj *listPtr, *resultPtr;
+ Tcl_Obj *objv[2];
+
+ if (nodePtr) {
+ if (nodePtr->type == XML_DOCUMENT_NODE) {
+ objv[0] = TclXML_libxml2_CreateObjFromDoc((xmlDocPtr) nodePtr);
+ } else {
+ objv[0] = TclDOM_libxml2_CreateObjFromNode(interp, nodePtr);
+ }
+ objv[1] = NULL;
+
+ listPtr = Tcl_NewListObj(1, objv);
+ if (nodePtr->parent) {
+ resultPtr = GetPath(interp, nodePtr->parent);
+ Tcl_ListObjAppendList(interp, resultPtr, listPtr);
+ } else {
+ resultPtr = listPtr;
+ }
+ return resultPtr;
+ } else {
+ return Tcl_NewObj();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * Node (and event) Tcl Object management
+ *
+ *----------------------------------------------------------------------------
+ */
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_libxml2_CreateObjFromNode --
+ *
+ * Create a Tcl_Obj to wrap a tree node.
+ *
+ * Results:
+ * Returns Tcl_Obj*.
+ *
+ * Side effects:
+ * Allocates object. Creates node command.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclDOM_libxml2_CreateObjFromNode (interp, nodePtr)
+ Tcl_Interp *interp;
+ xmlNodePtr nodePtr;
+{
+ TclDOM_libxml2_Node *tNodePtr;
+ TclXML_libxml2_Document *tDocPtr;
+ TclDOM_libxml2_Document *domDocPtr;
+ Tcl_Obj *objPtr;
+ Tcl_HashEntry *entry;
+ int new;
+
+ if (TclXML_libxml2_GetTclDocFromNode(interp, nodePtr, &tDocPtr) != TCL_OK) {
+ Tcl_SetResult(interp, "unable to find document for node", NULL);
+ return NULL;
+ }
+ if ((domDocPtr = GetDOMDocument(interp, tDocPtr)) == NULL) {
+ Tcl_SetResult(interp, "internal error", NULL);
+ return NULL;
+ }
+
+ tNodePtr = (TclDOM_libxml2_Node *) Tcl_Alloc(sizeof(TclDOM_libxml2_Node));
+ tNodePtr->ptr.nodePtr = nodePtr;
+ tNodePtr->type = TCLDOM_LIBXML2_NODE_NODE;
+ tNodePtr->objs = NULL;
+ tNodePtr->token = Tcl_Alloc(30);
+ sprintf(tNodePtr->token, "::dom::%s::node%d", tDocPtr->token, domDocPtr->nodeCntr++);
+
+ entry = Tcl_CreateHashEntry(domDocPtr->nodes, tNodePtr->token, &new);
+ if (!new) {
+ Tcl_Free((char *) tNodePtr->token);
+ Tcl_Free((char *) tNodePtr);
+ Tcl_SetResult(interp, "internal error", NULL);
+ return NULL;
+ }
+ Tcl_SetHashValue(entry, (void *) tNodePtr);
+
+ tNodePtr->cmd = Tcl_CreateObjCommand(interp, tNodePtr->token, TclDOMNodeCommand, (ClientData) tNodePtr, TclDOMNodeCommandDelete);
+
+ objPtr = Tcl_NewObj();
+ objPtr->internalRep.otherValuePtr = (VOID *) tNodePtr;
+ objPtr->typePtr = &NodeObjType;
+
+ objPtr->bytes = Tcl_Alloc(strlen(tNodePtr->token) + 1);
+ strcpy(objPtr->bytes, tNodePtr->token);
+ objPtr->length = strlen(objPtr->bytes);
+
+ NodeAddObjRef(tNodePtr, objPtr);
+
+ return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * NodeAddObjRef --
+ *
+ * Add an object reference to a node wrapper.
+ *
+ * Results:
+ * Adds a reference to the Tcl_Obj for the node.
+ *
+ * Side effects:
+ * Allocates memory.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+static void
+NodeAddObjRef(tNodePtr, objPtr)
+ TclDOM_libxml2_Node *tNodePtr;
+ Tcl_Obj *objPtr;
+{
+ ObjList *listPtr;
+
+ listPtr = (ObjList *) Tcl_Alloc(sizeof(ObjList));
+ listPtr->next = tNodePtr->objs;
+ listPtr->objPtr = objPtr;
+
+ tNodePtr->objs = (void *) listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMNodeCommandDelete --
+ *
+ * Invoked when a DOM node's Tcl command is deleted.
+ *
+ * Results:
+ * Invalidates the Tcl_Obj for the node, but doesn't actually destroy the node.
+ *
+ * Side effects:
+ * Frees memory.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+void
+TclDOMNodeCommandDelete (clientData)
+ ClientData clientData;
+{
+ TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) clientData;
+
+ TclDOM_libxml2_InvalidateNode(tNodePtr);
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_libxml2_GetNodeFromObj --
+ *
+ * Gets an xmlNodePtr from a Tcl_Obj.
+ *
+ * Results:
+ * Returns success code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOM_libxml2_GetNodeFromObj (interp, objPtr, nodePtrPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *objPtr;
+ xmlNodePtr *nodePtrPtr;
+{
+ TclDOM_libxml2_Node *tNodePtr;
+
+ if (TclDOM_libxml2_GetTclNodeFromObj(interp, objPtr, &tNodePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ *nodePtrPtr = tNodePtr->ptr.nodePtr;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_libxml2_GetTclNodeFromObj --
+ *
+ * Gets the TclDOM node structure from a Tcl_Obj.
+ *
+ * Results:
+ * Returns success code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOM_libxml2_GetTclNodeFromObj (interp, objPtr, tNodePtrPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *objPtr;
+ TclDOM_libxml2_Node **tNodePtrPtr;
+{
+ TclDOM_libxml2_Node *tNodePtr;
+
+ if (objPtr->typePtr == &NodeObjType) {
+ tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
+ } else if (NodeTypeSetFromAny(interp, objPtr) == TCL_OK) {
+ tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
+ } else {
+ return TCL_ERROR;
+ }
+
+ if (tNodePtr->type != TCLDOM_LIBXML2_NODE_NODE) {
+ return TCL_ERROR;
+ }
+
+ *tNodePtrPtr = tNodePtr;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_libxml2_GetEventFromObj --
+ *
+ * Gets an eventPtr from a Tcl_Obj.
+ *
+ * Results:
+ * Returns success code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOM_libxml2_GetEventFromObj (interp, objPtr, eventPtrPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *objPtr;
+ TclDOM_libxml2_Event **eventPtrPtr;
+{
+ TclDOM_libxml2_Node *tNodePtr;
+
+ if (TclDOM_libxml2_GetTclEventFromObj(interp, objPtr, &tNodePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ *eventPtrPtr = tNodePtr->ptr.eventPtr;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_libxml2_GetTclEventFromObj --
+ *
+ * Gets the node structure for an event from a Tcl_Obj.
+ *
+ * Results:
+ * Returns success code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+TclDOM_libxml2_GetTclEventFromObj (interp, objPtr, nodePtrPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *objPtr;
+ TclDOM_libxml2_Node **nodePtrPtr;
+{
+ TclDOM_libxml2_Node *tNodePtr;
+
+ if (objPtr->typePtr == &NodeObjType) {
+ tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
+ } else if (NodeTypeSetFromAny(interp, objPtr) == TCL_OK) {
+ tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
+ } else {
+ return TCL_ERROR;
+ }
+
+ if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
+ return TCL_ERROR;
+ }
+
+ *nodePtrPtr = tNodePtr;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_libxml2_DestroyNode --
+ *
+ * Destroys a node
+ *
+ * Results:
+ * Frees node.
+ *
+ * Side effects:
+ * Deallocates memory.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+static void
+TclDOM_libxml2_DeleteNode(clientData)
+ ClientData clientData;
+{
+ TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) clientData;
+ TclDOM_libxml2_Event *eventPtr;
+ TclXML_libxml2_Document *tDocPtr;
+ TclDOM_libxml2_Document *domDocPtr;
+ Tcl_Obj *objPtr;
+ xmlNodePtr nodePtr;
+ Tcl_HashEntry *entry;
+
+ if (tNodePtr->type == TCLDOM_LIBXML2_NODE_NODE) {
+ nodePtr = tNodePtr->ptr.nodePtr;
+ objPtr = TclXML_libxml2_CreateObjFromDoc(nodePtr->doc);
+ TclXML_libxml2_GetTclDocFromObj(NULL, objPtr, &tDocPtr);
+ domDocPtr = GetDOMDocument(NULL, tDocPtr);
+ if (domDocPtr == NULL) {
+ /* internal error */
+ return;
+ }
+ } else {
+ eventPtr = tNodePtr->ptr.eventPtr;
+ domDocPtr = eventPtr->ownerDocument;
+ Tcl_Free((char *) eventPtr);
+ }
+
+ entry = Tcl_FindHashEntry(domDocPtr->nodes, tNodePtr->token);
+ if (entry) {
+ Tcl_DeleteHashEntry(entry);
+ } else {
+ fprintf(stderr, "cannot delete node hash entry!\n");
+ }
+
+ TclDOM_libxml2_InvalidateNode(tNodePtr);
+
+ if (tNodePtr->appfree) {
+ (tNodePtr->appfree)(tNodePtr->apphook);
+ }
+
+ Tcl_Free((char *) tNodePtr);
+}
+
+void
+TclDOM_libxml2_DestroyNode (interp, tNodePtr)
+ Tcl_Interp *interp;
+ TclDOM_libxml2_Node *tNodePtr;
+{
+ Tcl_DeleteCommandFromToken(interp, tNodePtr->cmd);
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_libxml2_InvalidateNode --
+ *
+ * Invalidates the internal representation of any Tcl_obj that refers to
+ * this node. NB. This does not destroy the node, or delete the node command.
+ *
+ * Results:
+ * Tcl_Obj internal reps changed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+void
+TclDOM_libxml2_InvalidateNode (tNodePtr)
+ TclDOM_libxml2_Node *tNodePtr;
+{
+ ObjList *listPtr, *nextPtr;
+
+ for (listPtr = (ObjList *) tNodePtr->objs; listPtr;) {
+
+ listPtr->objPtr->internalRep.otherValuePtr = NULL;
+ listPtr->objPtr->typePtr = NULL;
+
+ nextPtr = listPtr->next;
+ Tcl_Free((char *) listPtr);
+ listPtr = nextPtr;
+ }
+
+ tNodePtr->objs = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * Node object type management
+ *
+ *----------------------------------------------------------------------------
+ */
+
+/*
+ * NodeTypeSetFromAny --
+ *
+ * Sets the internal representation from the string rep.
+ *
+ * Results:
+ * Success code.
+ *
+ * Side effects:
+ * Changes internal rep.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+int
+NodeTypeSetFromAny(interp, objPtr)
+ Tcl_Interp *interp;
+ Tcl_Obj *objPtr;
+{
+ Tcl_Obj *docObjPtr;
+ TclXML_libxml2_Document *tDocPtr;
+ TclDOM_libxml2_Document *domDocPtr;
+ Tcl_HashEntry *entry;
+ char *id, doc[21], node[21];
+ int i, idlen, len;
+
+ /* Parse string rep for doc and node ids */
+ id = Tcl_GetStringFromObj(objPtr, &idlen);
+ /* node tokens are prefixed with "::dom::" */
+ if (idlen < 7 || strncmp("::dom::", id, 7) != 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL);
+ return TCL_ERROR;
+ }
+ for (i = 0; i < idlen && id[i + 7] != ':' && i < 21; i++) {
+ if (!((id[i + 7] >= 'a' && id[i + 7] <= 'z') || (id[i + 7] >= '0' && id[i + 7] <= '9'))) {
+ /* only lowercase chars and digits are found in a token */
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL);
+ return TCL_ERROR;
+ }
+ doc[i] = id[i + 7];
+ }
+ if (i == idlen || id[i + 7] != ':') {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL);
+ return TCL_ERROR;
+ }
+ doc[i] = '\0';
+ i++;
+
+ if (i == idlen || id[i + 7] != ':') {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "malformed node token \"", id, "\"", NULL);
+ return TCL_ERROR;
+ }
+ i++;
+ for (len = i + 7, i = 0; i + len < idlen && i < 21; i++) {
+ node[i] = id[len + i];
+ }
+ node[i] = '\0';
+
+ docObjPtr = Tcl_NewStringObj(doc, -1);
+ if (TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr) != TCL_OK) {
+ Tcl_DecrRefCount(docObjPtr);
+ Tcl_SetResult(interp, "invalid node token", NULL);
+ return TCL_ERROR;
+ }
+ domDocPtr = GetDOMDocument(interp, tDocPtr);
+ if (domDocPtr == NULL) {
+ Tcl_SetResult(interp, "internal error", NULL);
+ return TCL_ERROR;
+ }
+
+ entry = Tcl_FindHashEntry(domDocPtr->nodes, id);
+ if (entry) {
+ TclDOM_libxml2_Node *tNodePtr;
+
+ if (objPtr->typePtr != NULL && objPtr->typePtr->freeIntRepProc != NULL) {
+ objPtr->typePtr->freeIntRepProc(objPtr);
+ }
+
+ tNodePtr = (TclDOM_libxml2_Node *) Tcl_GetHashValue(entry);
+ objPtr->internalRep.otherValuePtr = (void *) tNodePtr;
+ objPtr->typePtr = &NodeObjType;
+ NodeAddObjRef(tNodePtr, objPtr);
+
+ } else {
+ Tcl_DecrRefCount(docObjPtr);
+ Tcl_SetResult(interp, "not a DOM node", NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_DecrRefCount(docObjPtr);
+
+ return TCL_OK;
+}
+
+void
+NodeTypeUpdate(objPtr)
+ Tcl_Obj *objPtr;
+{
+ TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
+
+ objPtr->bytes = Tcl_Alloc(strlen(tNodePtr->token) + 1);
+ strcpy(objPtr->bytes, tNodePtr->token);
+ objPtr->length = strlen(objPtr->bytes);
+}
+
+void
+NodeTypeDup(srcPtr, dstPtr)
+ Tcl_Obj *srcPtr;
+ Tcl_Obj *dstPtr;
+{
+ TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) srcPtr->internalRep.otherValuePtr;
+
+ if (dstPtr->typePtr != NULL && dstPtr->typePtr->freeIntRepProc != NULL) {
+ dstPtr->typePtr->freeIntRepProc(dstPtr);
+ }
+
+ Tcl_InvalidateStringRep(dstPtr);
+
+ dstPtr->internalRep.otherValuePtr = (ClientData) tNodePtr;
+ dstPtr->typePtr = srcPtr->typePtr;
+
+ NodeAddObjRef(tNodePtr, dstPtr);
+}
+
+/*
+ * Unlike documents, nodes are not destroyed just because they have no Tcl_Obj's
+ * referring to them.
+ */
+
+void
+NodeTypeFree(objPtr)
+ Tcl_Obj *objPtr;
+{
+ TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) objPtr->internalRep.otherValuePtr;
+ ObjList *listPtr = tNodePtr->objs;
+ ObjList *prevPtr = NULL;
+
+ while (listPtr) {
+ if (listPtr->objPtr == objPtr) {
+ break;
+ }
+ prevPtr = listPtr;
+ listPtr = listPtr->next;
+ }
+
+ if (listPtr == NULL) {
+ /* internal error */
+ } else if (prevPtr == NULL) {
+ tNodePtr->objs = listPtr->next;
+ } else {
+ prevPtr->next = listPtr->next;
+ }
+ Tcl_Free((char *) listPtr);
+
+ objPtr->internalRep.otherValuePtr = NULL;
+ objPtr->typePtr = NULL;
+}
+#if 0
+static void
+DumpNode(tNodePtr)
+TclDOM_libxml2_Node *tNodePtr;
+{
+ ObjList *listPtr;
+
+ fprintf(stderr, " node token \"%s\" type %d ptr x%x\n",
+ tNodePtr->token, tNodePtr->type,
+ tNodePtr->ptr.nodePtr);
+ listPtr = (ObjList *) tNodePtr->objs;
+ if (listPtr) {
+ fprintf(stderr, " objects:");
+ while (listPtr) {
+ fprintf(stderr, " objPtr x%x", listPtr->objPtr);
+ listPtr = listPtr->next;
+ fprintf(stderr, "\n");
+ }
+ } else {
+ fprintf(stderr, " no objects\n");
+ }
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOM_libxml2_NewEventObj --
+ *
+ * Create a Tcl_Obj for an event.
+ *
+ * Results:
+ * Returns Tcl_Obj*.
+ *
+ * Side effects:
+ * Allocates object.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclDOM_libxml2_NewEventObj (interp, docPtr, type, typeObjPtr)
+ Tcl_Interp *interp;
+ xmlDocPtr docPtr;
+ enum TclDOM_EventTypes type;
+ Tcl_Obj *typeObjPtr; /* NULL for standard types */
+{
+ Tcl_Obj *objPtr, *docObjPtr;
+ TclDOM_libxml2_Node *tNodePtr;
+ TclDOM_libxml2_Event *eventPtr;
+ TclXML_libxml2_Document *tDocPtr;
+ TclDOM_libxml2_Document *domDocPtr;
+ Tcl_HashEntry *entry;
+ int new;
+
+ docObjPtr = TclXML_libxml2_CreateObjFromDoc(docPtr);
+ TclXML_libxml2_GetTclDocFromObj(interp, docObjPtr, &tDocPtr);
+ domDocPtr = GetDOMDocument(interp, tDocPtr);
+ if (domDocPtr == NULL) {
+ Tcl_SetResult(interp, "internal error", NULL);
+ return NULL;
+ }
+
+ tNodePtr = (TclDOM_libxml2_Node *) Tcl_Alloc(sizeof(TclDOM_libxml2_Node));
+ tNodePtr->token = Tcl_Alloc(30);
+ sprintf(tNodePtr->token, "::dom::%s::event%d", tDocPtr->token, domDocPtr->nodeCntr++);
+ tNodePtr->type = TCLDOM_LIBXML2_NODE_EVENT;
+ tNodePtr->objs = NULL;
+ tNodePtr->apphook = NULL;
+ tNodePtr->appfree = NULL;
+
+ entry = Tcl_CreateHashEntry(domDocPtr->nodes, tNodePtr->token, &new);
+ if (!new) {
+ Tcl_Free((char *) tNodePtr->token);
+ Tcl_Free((char *) tNodePtr);
+ return NULL;
+ }
+ Tcl_SetHashValue(entry, (void *) tNodePtr);
+
+ tNodePtr->cmd = Tcl_CreateObjCommand(interp, tNodePtr->token, TclDOMEventCommand, (ClientData) tNodePtr, TclDOMEventCommandDelete);
+
+ eventPtr = (TclDOM_libxml2_Event *) Tcl_Alloc(sizeof(TclDOM_libxml2_Event));
+ eventPtr->ownerDocument = domDocPtr;
+ eventPtr->tNodePtr = tNodePtr;
+
+ /*
+ * Overload the node pointer to refer to the event structure.
+ */
+ tNodePtr->ptr.eventPtr = eventPtr;
+
+ objPtr = Tcl_NewObj();
+ objPtr->internalRep.otherValuePtr = (VOID *) tNodePtr;
+ objPtr->typePtr = &NodeObjType;
+
+ objPtr->bytes = Tcl_Alloc(strlen(tNodePtr->token) + 1);
+ strcpy(objPtr->bytes, tNodePtr->token);
+ objPtr->length = strlen(objPtr->bytes);
+
+ NodeAddObjRef(tNodePtr, objPtr);
+
+ eventPtr->type = type;
+ if (type == TCLDOM_EVENT_USERDEFINED) {
+ eventPtr->typeObjPtr = typeObjPtr;
+ Tcl_IncrRefCount(eventPtr->typeObjPtr);
+ } else {
+ eventPtr->typeObjPtr = NULL;
+ }
+
+ eventPtr->stopPropagation = 0;
+ eventPtr->preventDefault = 0;
+ eventPtr->dispatched = 0;
+
+ eventPtr->altKey = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->altKey);
+ eventPtr->attrName = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->attrName);
+ eventPtr->attrChange = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->attrChange);
+ eventPtr->bubbles = Tcl_NewIntObj(1);
+ Tcl_IncrRefCount(eventPtr->bubbles);
+ eventPtr->button = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->button);
+ eventPtr->cancelable = Tcl_NewIntObj(1);
+ Tcl_IncrRefCount(eventPtr->cancelable);
+ eventPtr->clientX = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->clientX);
+ eventPtr->clientY = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->clientY);
+ eventPtr->ctrlKey = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->ctrlKey);
+ eventPtr->currentNode = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->currentNode);
+ eventPtr->detail = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->detail);
+ eventPtr->eventPhase = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->eventPhase);
+ eventPtr->metaKey = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->metaKey);
+ eventPtr->newValue = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->newValue);
+ eventPtr->prevValue = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->prevValue);
+ eventPtr->relatedNode = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->relatedNode);
+ eventPtr->screenX = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->screenX);
+ eventPtr->screenY = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->screenY);
+ eventPtr->shiftKey = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->shiftKey);
+ eventPtr->target = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->target);
+
+ /* Timestamping of DOM events is not available in Tcl 8.3.x.
+ * The required API (Tcl_GetTime) is public only since 8.4.0.
+ */
+
+ eventPtr->timeStamp = Tcl_NewLongObj(0);
+#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION > 3))
+ {
+ Tcl_Time time;
+
+ Tcl_GetTime(&time);
+ Tcl_SetLongObj(eventPtr->timeStamp, time.sec*1000 + time.usec/1000);
+ }
+#endif
+ Tcl_IncrRefCount(eventPtr->timeStamp);
+
+ eventPtr->view = Tcl_NewObj();
+ Tcl_IncrRefCount(eventPtr->view);
+
+ return objPtr;
+}
+/*
+ *----------------------------------------------------------------------------
+ *
+ * TclDOMEventCommandDelete --
+ *
+ * Invoked when a DOM event node's Tcl command is deleted.
+ *
+ * Results:
+ * Destroy the node.
+ *
+ * Side effects:
+ * Frees memory.
+ *
+ *----------------------------------------------------------------------------
+ */
+
+void
+TclDOMEventCommandDelete (clientData)
+ClientData clientData;
+{
+ TclDOM_libxml2_Node *tNodePtr = (TclDOM_libxml2_Node *) clientData;
+ TclDOM_libxml2_Event *eventPtr;
+
+ if (tNodePtr->type != TCLDOM_LIBXML2_NODE_EVENT) {
+ return; /* internal error. should this panic? */
+ }
+ eventPtr = tNodePtr->ptr.eventPtr;
+
+ if (eventPtr->typeObjPtr) {
+ Tcl_DecrRefCount(eventPtr->typeObjPtr);
+ }
+ if (eventPtr->altKey) {
+ Tcl_DecrRefCount(eventPtr->altKey);
+ }
+ if (eventPtr->attrName) {
+ Tcl_DecrRefCount(eventPtr->attrName);
+ }
+ if (eventPtr->attrChange) {
+ Tcl_DecrRefCount(eventPtr->attrChange);
+ }
+ if (eventPtr->bubbles) {
+ Tcl_DecrRefCount(eventPtr->bubbles);
+ }
+ if (eventPtr->button) {
+ Tcl_DecrRefCount(eventPtr->button);
+ }
+ if (eventPtr->cancelable) {
+ Tcl_DecrRefCount(eventPtr->cancelable);
+ }
+ if (eventPtr->clientX) {
+ Tcl_DecrRefCount(eventPtr->clientX);
+ }
+ if (eventPtr->clientY) {
+ Tcl_DecrRefCount(eventPtr->clientY);
+ }
+ if (eventPtr->ctrlKey) {
+ Tcl_DecrRefCount(eventPtr->ctrlKey);
+ }
+ if (eventPtr->currentNode) {
+ Tcl_DecrRefCount(eventPtr->currentNode);
+ }
+ if (eventPtr->detail) {
+ Tcl_DecrRefCount(eventPtr->detail);
+ }
+ if (eventPtr->eventPhase) {
+ Tcl_DecrRefCount(eventPtr->eventPhase);
+ }
+ if (eventPtr->metaKey) {
+ Tcl_DecrRefCount(eventPtr->metaKey);
+ }
+ if (eventPtr->newValue) {
+ Tcl_DecrRefCount(eventPtr->newValue);
+ }
+ if (eventPtr->prevValue) {
+ Tcl_DecrRefCount(eventPtr->prevValue);
+ }
+ if (eventPtr->relatedNode) {
+ Tcl_DecrRefCount(eventPtr->relatedNode);
+ }
+ if (eventPtr->screenX) {
+ Tcl_DecrRefCount(eventPtr->screenX);
+ }
+ if (eventPtr->screenY) {
+ Tcl_DecrRefCount(eventPtr->screenY);
+ }
+ if (eventPtr->shiftKey) {
+ Tcl_DecrRefCount(eventPtr->shiftKey);
+ }
+ if (eventPtr->target) {
+ Tcl_DecrRefCount(eventPtr->target);
+ }
+ if (eventPtr->timeStamp) {
+ Tcl_DecrRefCount(eventPtr->timeStamp);
+ }
+ if (eventPtr->view) {
+ Tcl_DecrRefCount(eventPtr->view);
+ }
+
+ /* Invalidates all referring objects and frees all data structures */
+ TclDOM_libxml2_DeleteNode((ClientData) tNodePtr);
+}
+