diff options
Diffstat (limited to 'tclxml.c')
| -rwxr-xr-x | tclxml.c | 3708 |
1 files changed, 3708 insertions, 0 deletions
diff --git a/tclxml.c b/tclxml.c new file mode 100755 index 0000000..adc2e0f --- /dev/null +++ b/tclxml.c @@ -0,0 +1,3708 @@ +/* + * tclxml.c -- + * + * Entry point for XML parsers, DOM and XSLT. + * + * Copyright (c) 2005-2007 Steve Ball, explain + * http://www.explain.com.au/ + * Copyright (c) 1998-2004 Steve Ball, Zveno Pty Ltd + * + * See the file "LICENSE" for information on usage and + * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * $Id: tclxml.c,v 1.2 2009/03/03 22:55:36 joye Exp $ + * + */ + +#include <tclxml/tclxml.h> +#include <tclxml-libxml2/tclxml-libxml2.h> +#include <tcldom-libxml2/tcldom-libxml2.h> +#include <tclxslt/tclxslt.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))) +#ifdef USE_TCLXML_STUBS +#ifndef TCLXML_DOES_STUBS +# define TCLXML_DOES_STUBS TCL_DOES_STUBS +#endif /* USE_TCLXML_STUBS */ +#endif /* TCL_DOES_STUBS */ + +/* + * The structure below is used to manage package options. + */ + +typedef struct ThreadSpecificData { + int initialized; + + TclXML_ParserClassInfo *defaultParser; /* Current default parser */ + Tcl_HashTable *registeredParsers; /* All known parser classes */ + + /* + * Retain a pointer to the whitespace variable + */ + + Tcl_Obj *whitespaceRE; + + /* + * Counter to generate unique command names + */ + + int uniqueCounter; + + /* + * Callback for external entity resolution + */ + + Tcl_Obj *externalentitycmd; + Tcl_Interp *interp; +} ThreadSpecificData; +static Tcl_ThreadDataKey dataKey; + +/* This string is a backup. Value should be defined in xml package. */ +static char whitespace[] = " \t\r\n"; + +/* + * Configuration option tables + */ + +static CONST84 char *globalConfigureSwitches[] = { + "-externalentitycommand", + (char *) NULL +}; +enum globalConfigureSwitches { + TCLXML_GLOBAL_EXTERNALENTITYCOMMAND +}; + +static CONST84 char *instanceConfigureSwitches[] = { + "-final", + "-validate", + "-baseurl", + "-baseuri", + "-encoding", + "-elementstartcommand", + "-elementendcommand", + "-characterdatacommand", + "-processinginstructioncommand", + "-defaultcommand", + "-unparsedentitydeclcommand", + "-notationdeclcommand", + "-externalentitycommand", + "-unknownencodingcommand", + "-commentcommand", + "-notstandalonecommand", + "-startcdatasectioncommand", + "-endcdatasectioncommand", + "-defaultexpandinternalentities", + "-elementdeclcommand", + "-attlistdeclcommand", + "-startdoctypedeclcommand", + "-enddoctypedeclcommand", + "-paramentityparsing", + "-ignorewhitespace", + "-reportempty", + "-entitydeclcommand", /* added to avoid exception */ + "-parameterentitydeclcommand", /* added to avoid exception */ + "-doctypecommand", /* added to avoid exception */ + "-entityreferencecommand", /* added to avoid exception */ + "-xmldeclcommand", /* added to avoid exception */ + (char *) NULL + }; +enum instanceConfigureSwitches { + TCLXML_FINAL, TCLXML_VALIDATE, TCLXML_BASEURL, TCLXML_BASEURI, + TCLXML_ENCODING, + TCLXML_ELEMENTSTARTCMD, TCLXML_ELEMENTENDCMD, + TCLXML_DATACMD, TCLXML_PICMD, + TCLXML_DEFAULTCMD, + TCLXML_UNPARSEDENTITYCMD, TCLXML_NOTATIONCMD, + TCLXML_EXTERNALENTITYCMD, TCLXML_UNKNOWNENCODINGCMD, + TCLXML_COMMENTCMD, TCLXML_NOTSTANDALONECMD, + TCLXML_STARTCDATASECTIONCMD, TCLXML_ENDCDATASECTIONCMD, + TCLXML_DEFAULTEXPANDINTERNALENTITIES, + TCLXML_ELEMENTDECLCMD, TCLXML_ATTLISTDECLCMD, + TCLXML_STARTDOCTYPEDECLCMD, TCLXML_ENDDOCTYPEDECLCMD, + TCLXML_PARAMENTITYPARSING, + TCLXML_NOWHITESPACE, + TCLXML_REPORTEMPTY, + TCLXML_ENTITYDECLCMD, + TCLXML_PARAMENTITYDECLCMD, + TCLXML_DOCTYPECMD, + TCLXML_ENTITYREFCMD, + TCLXML_XMLDECLCMD +}; + +/* + * Prototypes for procedures defined later in this file: + */ + +static void TclXMLInstanceDeleteCmd _ANSI_ARGS_((ClientData clientData)); +static int TclXMLDestroyParserInstance _ANSI_ARGS_((TclXML_Info *xmlinfo)); +static int TclXMLInstanceCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, struct Tcl_Obj *CONST objv[])); +static int TclXMLCreateParserCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +static int TclXMLParserClassCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +static int TclXMLResetParser _ANSI_ARGS_((Tcl_Interp *interp, TclXML_Info *xmlinfo)); +static int TclXMLConfigureCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); +static Tcl_Obj* FindUniqueCmdName _ANSI_ARGS_((Tcl_Interp *interp)); +static int TclXMLInstanceConfigure _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_Info *xmlinfo, int objc, Tcl_Obj *CONST objv[])); +static int TclXMLCget _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_Info *xmlinfo, int objc, Tcl_Obj *CONST objv[])); +static int TclXMLConfigureParserInstance _ANSI_ARGS_(( + TclXML_Info *xmlinfo, Tcl_Obj *option, Tcl_Obj *value)); +static int TclXMLGet _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_Info *xmlinfo, int objc, Tcl_Obj *CONST objv[])); +static int TclXMLParse _ANSI_ARGS_((Tcl_Interp *interp, + TclXML_Info *xmlinfo, char *data, int len)); +static void TclXMLDispatchPCDATA _ANSI_ARGS_((TclXML_Info *xmlinfo)); + +#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0) + +/* + *---------------------------------------------------------------------------- + * + * Tcl_GetString -- + * + * Compatibility routine for Tcl 8.0 + * + * Results: + * String representation of object.. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static char * +Tcl_GetString (obj) + Tcl_Obj *obj; /* Object to retrieve string from. */ +{ + char *s; + int i; + + s = Tcl_GetStringFromObj(obj, &i); + return s; +} +#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0 */ + +/* + *---------------------------------------------------------------------------- + * + * Tclxml_Init -- + * + * Initialisation routine for loadable module. + * Also calls the initialisation routines for TclDOM and TclXSLT, + * as these were originally separate modules. + * + * Results: + * None. + * + * Side effects: + * Creates commands in the interpreter, + * loads xml, dom and xslt packages. + * + *---------------------------------------------------------------------------- + */ + +int +Tclxml_Init (interp) + Tcl_Interp *interp; /* Interpreter to initialise. */ +{ + ThreadSpecificData *tsdPtr; + +#ifdef USE_TCL_STUBS + if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { + return TCL_ERROR; + } +#endif + + tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + tsdPtr->initialized = 1; + tsdPtr->defaultParser = NULL; + tsdPtr->uniqueCounter = 0; + + /* + tsdPtr->whitespaceRE = Tcl_GetVar2Ex(interp, "::xml::Wsp", NULL, TCL_GLOBAL_ONLY); + if (tsdPtr->whitespaceRE == NULL) { + tsdPtr->whitespaceRE = Tcl_SetVar2Ex(interp, "::xml::Wsp", NULL, Tcl_NewStringObj(whitespace, -1), TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG); + if (tsdPtr->whitespaceRE == NULL) { + return TCL_ERROR; + } + } + Tcl_IncrRefCount(tsdPtr->whitespaceRE); + */ + + tsdPtr->registeredParsers = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable)); + Tcl_InitHashTable(tsdPtr->registeredParsers, TCL_STRING_KEYS); + + tsdPtr->externalentitycmd = NULL; + tsdPtr->interp = interp; + + Tcl_CreateObjCommand(interp, "xml::configure", TclXMLConfigureCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "xml::parser", TclXMLCreateParserCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "xml::parserclass", TclXMLParserClassCmd, NULL, NULL); + + if (Tclxml_libxml2_Init(interp) != TCL_OK) { + return TCL_ERROR; + } + + /* + if (Tcldom_libxml2_Init(interp) != TCL_OK) { + return TCL_ERROR; + } + + if (Tclxslt_libxslt_Init(interp) != TCL_OK) { + return TCL_ERROR; + } + */ + + #if TCLXML_DOES_STUBS + { + extern TclxmlStubs tclxmlStubs; + if (Tcl_PkgProvideEx(interp, "xml::c", TCLXML_VERSION, + (ClientData) &tclxmlStubs) != TCL_OK) { + return TCL_ERROR; + } + } + #else + if (Tcl_PkgProvide(interp, "xml::c", TCLXML_VERSION) != TCL_OK) { + return TCL_ERROR; + } + #endif + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * Tclxml_SafeInit -- + * + * Initialisation routine for loadable module in a safe interpreter. + * + * Results: + * None. + * + * Side effects: + * Creates commands in the interpreter, + * loads xml package. + * + *---------------------------------------------------------------------------- + */ + +int +Tclxml_SafeInit (interp) + Tcl_Interp *interp; /* Interpreter to initialise. */ +{ + return Tclxml_Init(interp); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLConfigureCmd -- + * + * Command for xml::configure command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLConfigureCmd(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int index; + + if (objc < 3) { + Tcl_SetResult(interp, "must specify option", NULL); + return TCL_ERROR; + } else if (objc == 3) { + /* TODO: retrieve option's value */ + return TCL_OK; + } else if (objc % 2 == 1) { + Tcl_SetResult(interp, "value for option missing", NULL); + return TCL_ERROR; + } + + for (objc -= 2, objv += 2; objc; objc -= 2, objv += 2) { + if (Tcl_GetIndexFromObj(interp, objv[0], globalConfigureSwitches, + "switch", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum globalConfigureSwitches) index) { + case TCLXML_GLOBAL_EXTERNALENTITYCOMMAND: + tsdPtr->externalentitycmd = objv[1]; + Tcl_IncrRefCount(tsdPtr->externalentitycmd); + break; + + default: + return TCL_ERROR; + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLParserClassCmd -- + * + * Command for xml::parserclass command. + * + * Results: + * Depends on method. + * + * Side effects: + * Depends on method. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLParserClassCmd(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXML_ParserClassInfo *classinfo; + int method, index; + Tcl_Obj *listPtr; + Tcl_HashEntry *entryPtr; + Tcl_HashSearch search; + + static CONST84 char *methods[] = { + "create", "destroy", "info", + NULL + }; + enum methods { + TCLXML_CREATE, TCLXML_DESTROY, TCLXML_INFO + }; + static CONST84 char *createOptions[] = { + "-createcommand", "-createentityparsercommand", + "-parsecommand", "-configurecommand", + "-deletecommand", "-resetcommand", + NULL + }; + enum createOptions { + TCLXML_CREATEPROC, TCLXML_CREATE_ENTITY_PARSER, + TCLXML_PARSEPROC, TCLXML_CONFIGUREPROC, + TCLXML_DELETEPROC, TCLXML_RESETPROC + }; + static CONST84 char *infoMethods[] = { + "names", "default", + NULL + }; + enum infoMethods { + TCLXML_INFO_NAMES, TCLXML_INFO_DEFAULT + }; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], methods, + "method", 0, &method) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum methods) method) { + case TCLXML_CREATE: + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "create name ?args?"); + return TCL_ERROR; + } + + classinfo = (TclXML_ParserClassInfo *) Tcl_Alloc(sizeof(TclXML_ParserClassInfo)); + classinfo->name = objv[2]; + Tcl_IncrRefCount(classinfo->name); + classinfo->create = NULL; + classinfo->createCmd = NULL; + classinfo->createEntity = NULL; + classinfo->createEntityCmd = NULL; + classinfo->parse = NULL; + classinfo->parseCmd = NULL; + classinfo->configure = NULL; + classinfo->configureCmd = NULL; + classinfo->reset = NULL; + classinfo->resetCmd = NULL; + classinfo->destroy = NULL; + classinfo->destroyCmd = NULL; + + objv += 3; + objc -= 3; + while (objc > 1) { + if (Tcl_GetIndexFromObj(interp, objv[0], createOptions, + "options", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + Tcl_IncrRefCount(objv[1]); + switch ((enum createOptions) index) { + + case TCLXML_CREATEPROC: + + classinfo->createCmd = objv[1]; + break; + + case TCLXML_CREATE_ENTITY_PARSER: + + classinfo->createEntityCmd = objv[1]; + break; + + case TCLXML_PARSEPROC: + + classinfo->parseCmd = objv[1]; + break; + + case TCLXML_CONFIGUREPROC: + + classinfo->configureCmd = objv[1]; + break; + + case TCLXML_RESETPROC: + + classinfo->resetCmd = objv[1]; + break; + + case TCLXML_DELETEPROC: + + classinfo->destroyCmd = objv[1]; + break; + + default: + Tcl_AppendResult(interp, "unknown option \"", Tcl_GetStringFromObj(objv[0], NULL), "\"", NULL); + Tcl_DecrRefCount(objv[1]); + Tcl_DecrRefCount(classinfo->name); + Tcl_Free((char *)classinfo); + return TCL_ERROR; + } + + objc -= 2; + objv += 2; + + } + + if (TclXML_RegisterXMLParser(interp, classinfo) != TCL_OK) { + Tcl_Free((char *)classinfo); + return TCL_ERROR; + } + break; + + case TCLXML_DESTROY: + /* Not yet implemented */ + break; + + case TCLXML_INFO: + if (objc < 3) { + Tcl_WrongNumArgs(interp, 2, objv, "method"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[2], infoMethods, + "method", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum infoMethods) index) { + case TCLXML_INFO_NAMES: + + listPtr = Tcl_NewListObj(0, NULL); + entryPtr = Tcl_FirstHashEntry(tsdPtr->registeredParsers, &search); + while (entryPtr != NULL) { + Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(Tcl_GetHashKey(tsdPtr->registeredParsers, entryPtr), -1)); + entryPtr = Tcl_NextHashEntry(&search); + } + + Tcl_SetObjResult(interp, listPtr); + + break; + + case TCLXML_INFO_DEFAULT: + + if (!tsdPtr->defaultParser) { + Tcl_SetResult(interp, "", NULL); + } else { + Tcl_SetObjResult(interp, tsdPtr->defaultParser->name); + } + + break; + + default: + Tcl_SetResult(interp, "unknown method", NULL); + return TCL_ERROR; + } + break; + + default: + Tcl_SetResult(interp, "unknown method", NULL); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_RegisterXMLParser -- + * + * Adds a new XML parser. + * + * Results: + * Standard Tcl return code. + * + * Side effects: + * New parser is available for use in parser instances. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_RegisterXMLParser(interp, classinfo) + Tcl_Interp *interp; + TclXML_ParserClassInfo *classinfo; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int new; + Tcl_HashEntry *entryPtr; + + entryPtr = Tcl_CreateHashEntry(tsdPtr->registeredParsers, Tcl_GetStringFromObj(classinfo->name, NULL), &new); + if (!new) { + Tcl_Obj *ptr = Tcl_NewStringObj("parser class \"", -1); + Tcl_AppendObjToObj(ptr, classinfo->name); + Tcl_AppendObjToObj(ptr, Tcl_NewStringObj("\" already registered", -1)); + + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, ptr); + return TCL_ERROR; + } + + Tcl_SetHashValue(entryPtr, (ClientData) classinfo); + + /* + * Set default parser - last wins + */ + + tsdPtr->defaultParser = classinfo; + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLCreateParserCmd -- + * + * Creation command for xml::parser command. + * + * Results: + * The name of the newly created parser instance. + * + * Side effects: + * This creates a parser instance. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLCreateParserCmd(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXML_Info *xmlinfo; + int found, i, index, poption; + + static CONST84 char *switches[] = { + "-parser", + (char *) NULL + }; + enum switches { + TCLXML_PARSER + }; + + if (tsdPtr == NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("TclXML package improperly initialised", -1)); + return TCL_ERROR; + } + if (!tsdPtr->defaultParser) { + Tcl_SetResult(interp, "no parsers available", NULL); + return TCL_ERROR; + } + + /* + * Create the data structures for this parser. + */ + + if (!(xmlinfo = (TclXML_Info *) Tcl_Alloc(sizeof(TclXML_Info)))) { + Tcl_SetResult(interp, "unable to create parser", NULL); + return TCL_ERROR; + } + xmlinfo->interp = interp; + xmlinfo->clientData = NULL; + xmlinfo->base = NULL; + xmlinfo->encoding = Tcl_NewStringObj("utf-8", -1); + + /* + * Find unique command name + */ + if (objc < 2) { + xmlinfo->name = FindUniqueCmdName(interp); + } else { + xmlinfo->name = objv[1]; + if (*(Tcl_GetStringFromObj(xmlinfo->name, NULL)) != '-') { + Tcl_IncrRefCount(xmlinfo->name); + objv++; + objc--; + } else { + xmlinfo->name = FindUniqueCmdName(interp); + } + } + + xmlinfo->validate = 0; + xmlinfo->elementstartcommand = NULL; + xmlinfo->elementstart = NULL; + xmlinfo->elementstartdata = 0; + xmlinfo->elementendcommand = NULL; + xmlinfo->elementend = NULL; + xmlinfo->elementenddata = 0; + xmlinfo->datacommand = NULL; + xmlinfo->cdatacb = NULL; + xmlinfo->cdatacbdata = 0; + xmlinfo->picommand = NULL; + xmlinfo->pi = NULL; + xmlinfo->pidata = 0; + xmlinfo->defaultcommand = NULL; + xmlinfo->defaultcb = NULL; + xmlinfo->defaultdata = 0; + xmlinfo->unparsedcommand = NULL; + xmlinfo->unparsed = NULL; + xmlinfo->unparseddata = 0; + xmlinfo->notationcommand = NULL; + xmlinfo->notation = NULL; + xmlinfo->notationdata = 0; + xmlinfo->entitycommand = NULL; + xmlinfo->entity = NULL; + xmlinfo->entitydata = 0; + xmlinfo->unknownencodingcommand = NULL; + xmlinfo->unknownencoding = NULL; + xmlinfo->unknownencodingdata = 0; + /* ericm@scriptics.com */ + xmlinfo->commentCommand = NULL; + xmlinfo->comment = NULL; + xmlinfo->commentdata = 0; + xmlinfo->notStandaloneCommand = NULL; + xmlinfo->notStandalone = NULL; + xmlinfo->notstandalonedata = 0; + xmlinfo->elementDeclCommand = NULL; + xmlinfo->elementDecl = NULL; + xmlinfo->elementdecldata = 0; + xmlinfo->attlistDeclCommand = NULL; + xmlinfo->attlistDecl = NULL; + xmlinfo->attlistdecldata = 0; + xmlinfo->startDoctypeDeclCommand = NULL; + xmlinfo->startDoctypeDecl = NULL; + xmlinfo->startdoctypedecldata = 0; + xmlinfo->endDoctypeDeclCommand = NULL; + xmlinfo->endDoctypeDecl = NULL; + xmlinfo->enddoctypedecldata = 0; +#ifdef TCLXML_CDATASECTIONS + xmlinfo->startCDATASectionCommand = NULL; + xmlinfo->startCDATASection = NULL; + xmlinfo->startcdatasectiondata = 0; + xmlinfo->endCdataSectionCommand = NULL; + xmlinfo->endCdataSection = NULL; + xmlinfo->endcdatasectiondata = 0; +#endif + + /* + * Options may include an explicit desired parser class + * + * SF TclXML Bug 513909 ... + * Start search at first argument! If there was a parser name + * specified we already skipped over it. + * + * Changing the search. Do not stop at the first occurence of + * "-parser". There can be more than one instance of the option in + * the argument list and it is the last instance that counts. + */ + + found = 0; + i = 1; + poption = -1; + + while (i < objc) { + Tcl_ResetResult (interp); + if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index) == TCL_OK) { + poption = i; + found = 1; + } + i += 2; + } + Tcl_ResetResult (interp); + + if (found) { + Tcl_HashEntry *pentry; + + if (poption == (objc - 1)) { + Tcl_SetResult(interp, "no value for option", NULL); + goto error; + } + + /* + * Use given parser class + */ + + pentry = Tcl_FindHashEntry(tsdPtr->registeredParsers, + Tcl_GetStringFromObj(objv[poption + 1], + NULL)); + if (pentry != NULL) { + xmlinfo->parserClass = Tcl_GetHashValue(pentry); + } else { + Tcl_AppendResult(interp, "no such parser class \"", + Tcl_GetStringFromObj(objv[poption + 1], NULL), + "\"", NULL); + goto error; + } + + } else { + /* + * Use default parser + */ + xmlinfo->parserClass = tsdPtr->defaultParser; + } + + if (TclXMLResetParser(interp, xmlinfo) != TCL_OK) { + /* this may leak memory... + Tcl_Free((char *)xmlinfo); + */ + return TCL_ERROR; + } + + /* + * Register a Tcl command for this parser instance. + */ + + Tcl_CreateObjCommand(interp, Tcl_GetStringFromObj(xmlinfo->name, NULL), + TclXMLInstanceCmd, (ClientData) xmlinfo, TclXMLInstanceDeleteCmd); + + /* + * Handle configuration options + * + * SF TclXML Bug 513909 ... + * Note: If the caller used "-parser" to specify a parser class we + * have to take care that it and its argument are *not* seen by + * "TclXMLInstanceConfigure" because this option is not allowed + * during general configuration. + */ + + if (objc > 1) { + if (found) { + /* + * The options contained at least one instance of "-parser + * class". We now go through the whole list of arguments and + * build a new list which contains only the non-"-parser" + * switches. The 'ResetResult' takes care of clearing the + * interpreter result before "Tcl_GetIndexFromObj" tries to + * use it again. + */ + + int res; + int cfgc = 0; + Tcl_Obj** cfgv = (Tcl_Obj**) Tcl_Alloc (objc * sizeof (Tcl_Obj*)); + + i = 1; + while (i < objc) { + Tcl_ResetResult (interp); + if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index) == TCL_OK) { + /* Ignore "-parser" during copying */ + i += 2; + continue; + } + + cfgv [cfgc] = objv [i]; i++ ; cfgc++ ; /* copy option ... */ + cfgv [cfgc] = objv [i]; i++ ; cfgc++ ; /* ... and value */ + } + Tcl_ResetResult (interp); + + res = TclXMLInstanceConfigure(interp, xmlinfo, cfgc, cfgv); + Tcl_Free ((char*) cfgv); + if (res == TCL_ERROR) { + return TCL_ERROR; + } + } else { + /* + * The options contained no "-parser class" specification. We + * can propagate it unchanged. + */ + + if (TclXMLInstanceConfigure(interp, xmlinfo, objc - 1, objv + 1) == TCL_ERROR) { + return TCL_ERROR; + } + } + } + + Tcl_SetObjResult(interp, xmlinfo->name); + return TCL_OK; + + error: +/* this may leak memory + Tcl_Free((char*)xmlinfo); +*/ + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------------- + * + * FindUniqueCmdName -- + * + * Generate new command name in caller's namespace. + * + * Results: + * Returns newly allocated Tcl object containing name. + * + * Side effects: + * Allocates Tcl object. + * + *---------------------------------------------------------------------------- + */ + +static Tcl_Obj * +FindUniqueCmdName(interp) + Tcl_Interp *interp; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + Tcl_Obj *name; + Tcl_CmdInfo cmdinfo; + char s[20]; + + name = Tcl_NewObj(); + Tcl_IncrRefCount(name); + + do { + sprintf(s, "xmlparser%d", tsdPtr->uniqueCounter++); + Tcl_SetStringObj(name, s, -1); + } while (Tcl_GetCommandInfo(interp, Tcl_GetStringFromObj(name, NULL), &cmdinfo)); + + return name; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLResetParser -- + * + * (Re-)Initialise the parser instance structure. + * + * Results: + * Parser made ready for parsing. + * + * Side effects: + * Destroys and creates a parser instance. + * Modifies TclXML_Info fields. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLResetParser(interp, xmlinfo) + Tcl_Interp *interp; + TclXML_Info *xmlinfo; +{ + TclXML_ParserClassInfo *classInfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + if (xmlinfo->base) { + Tcl_DecrRefCount(xmlinfo->base); + xmlinfo->base = NULL; + } + + xmlinfo->final = 1; + xmlinfo->status = TCL_OK; + xmlinfo->result = NULL; + xmlinfo->continueCount = 0; + xmlinfo->context = NULL; + + xmlinfo->cdata = NULL; + xmlinfo->nowhitespace = 0; + + xmlinfo->reportempty = 0; + xmlinfo->expandinternalentities = 1; + xmlinfo->paramentities = 1; + + if (classInfo->reset) { + if ((*classInfo->reset)((ClientData) xmlinfo) != TCL_OK) { + return TCL_ERROR; + } + } else if (classInfo->resetCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->resetCmd); + int result; + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) interp); + Tcl_ListObjAppendElement(interp, cmdPtr, xmlinfo->name); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) interp); + + if (result != TCL_OK) { + Tcl_Free((char*)xmlinfo); + return TCL_ERROR; + } + } else if (classInfo->create) { + + /* + * Otherwise destroy and then create a fresh parser instance + */ + + /* + * Destroy the old parser instance, if it exists + * Could probably just reset it, but this approach + * is pretty much guaranteed to work. + */ + + if (TclXMLDestroyParserInstance(xmlinfo) != TCL_OK) { + return TCL_ERROR; + } + + /* + * Directly invoke the create routine + */ + if ((xmlinfo->clientData = (*classInfo->create)(interp, xmlinfo)) == NULL) { + Tcl_Free((char*)xmlinfo); + return TCL_ERROR; + } + } else if (classInfo->createCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->createCmd); + int result, i; + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) interp); + Tcl_ListObjAppendElement(interp, cmdPtr, xmlinfo->name); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) interp); + + if (result != TCL_OK) { + Tcl_Free((char*)xmlinfo); + return TCL_ERROR; + } else { + + /* + * Return result is parser instance argument + */ + + xmlinfo->clientData = (ClientData) Tcl_GetObjResult(interp); + Tcl_IncrRefCount((Tcl_Obj *) xmlinfo->clientData); + + /* + * Add all of the currently configured callbacks to the + * creation command line. Destroying the parser instance + * just clobbered all of these settings. + */ + + cmdPtr = Tcl_DuplicateObj(classInfo->configureCmd); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) interp); + Tcl_ListObjAppendElement(interp, cmdPtr, xmlinfo->name); + + for (i = 0; instanceConfigureSwitches[i]; i++) { + Tcl_Obj *objPtr = Tcl_NewStringObj(instanceConfigureSwitches[i], -1); + Tcl_ListObjAppendElement(interp, cmdPtr, objPtr); + TclXMLCget(interp, xmlinfo, 1, &objPtr); + Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_GetObjResult(interp)); + } + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) interp); + + if (result != TCL_OK) { + Tcl_Free((char *)xmlinfo); + return TCL_ERROR; + } + + } + + } else { + Tcl_SetResult(interp, "bad parser class data", NULL); + Tcl_Free((char*)xmlinfo); + return TCL_ERROR; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclXMLCreateEntityParser -- + * + * Create an entity parser, based on the original + * parser referred to by parent. + * + * Results: + * New entity parser created and initialized. + * + * Side effects: + * The TclXML_Info struct pointed to by external is modified. + * + *---------------------------------------------------------------------- + */ + +static int +TclXMLCreateEntityParser(interp, external, parent) + Tcl_Interp *interp; + TclXML_Info *external; + TclXML_Info *parent; +{ + TclXML_ParserClassInfo *extClassInfo; + + external->parserClass = parent->parserClass; + extClassInfo = (TclXML_ParserClassInfo *) external->parserClass; + + if (!extClassInfo->createEntity || !extClassInfo->createEntityCmd) { + Tcl_SetResult(interp, "cannot create entity parser", NULL); + return TCL_ERROR; + } + + if (parent->elementstartcommand) { + Tcl_IncrRefCount(parent->elementstartcommand); + } + if (parent->elementendcommand) { + Tcl_IncrRefCount(parent->elementendcommand); + } + if (parent->datacommand) { + Tcl_IncrRefCount(parent->datacommand); + } + if (parent->picommand) { + Tcl_IncrRefCount(parent->picommand); + } + if (parent->defaultcommand) { + Tcl_IncrRefCount(parent->defaultcommand); + } + if (parent->unparsedcommand) { + Tcl_IncrRefCount(parent->unparsedcommand); + } + if (parent->notationcommand) { + Tcl_IncrRefCount(parent->notationcommand); + } + if (parent->entitycommand) { + Tcl_IncrRefCount(parent->entitycommand); + } + if (parent->unknownencodingcommand) { + Tcl_IncrRefCount(parent->unknownencodingcommand); + } + if (parent->commentCommand) { + Tcl_IncrRefCount(parent->commentCommand); + } + if (parent->notStandaloneCommand) { + Tcl_IncrRefCount(parent->notStandaloneCommand); + } +#ifdef TCLXML_CDATASECTIONS + if (parent->startCdataSectionCommand) { + Tcl_IncrRefCount(parent->startCdataSectionCommand); + } + if (parent->endCdataSectionCommand) { + Tcl_IncrRefCount(parent->endCdataSectionCommand); + } +#endif + if (parent->elementDeclCommand) { + Tcl_IncrRefCount(parent->elementDeclCommand); + } + if (parent->attlistDeclCommand) { + Tcl_IncrRefCount(parent->attlistDeclCommand); + } + if (parent->startDoctypeDeclCommand) { + Tcl_IncrRefCount(parent->startDoctypeDeclCommand); + } + if (parent->endDoctypeDeclCommand) { + Tcl_IncrRefCount(parent->endDoctypeDeclCommand); + } + + external->elementstartcommand = parent->elementstartcommand; + external->elementstart = parent->elementstart; + external->elementendcommand = parent->elementendcommand; + external->elementend = parent->elementend; + external->datacommand = parent->datacommand; + external->cdatacb = parent->cdatacb; + external->picommand = parent->picommand; + external->pi = parent->pi; + external->defaultcommand = parent->defaultcommand; + external->defaultcb = parent->defaultcb; + external->unparsedcommand = parent->unparsedcommand; + external->unparsed = parent->unparsed; + external->notationcommand = parent->notationcommand; + external->notation = parent->notation; + external->entitycommand = parent->entitycommand; + external->entity = parent->entity; + external->unknownencodingcommand = parent->unknownencodingcommand; + external->unknownencoding = parent->unknownencoding; + external->commentCommand = parent->commentCommand; + external->comment = parent->comment; + external->notStandaloneCommand = parent->notStandaloneCommand; + external->notStandalone = parent->notStandalone; + external->elementDeclCommand = parent->elementDeclCommand; + external->elementDecl = parent->elementDecl; + external->attlistDeclCommand = parent->attlistDeclCommand; + external->attlistDecl = parent->attlistDecl; + external->startDoctypeDeclCommand = parent->startDoctypeDeclCommand; + external->startDoctypeDecl = parent->startDoctypeDecl; + external->endDoctypeDeclCommand = parent->endDoctypeDeclCommand; + external->endDoctypeDecl = parent->endDoctypeDecl; +#ifdef TCLXML_CDATASECTIONS + external->startCdataSectionCommand = parent->startCdataSectionCommand; + external->startCdataSection = parent->startCdataSection; + external->endCdataSectionCommand = parent->endCdataSectionCommand; + external->endCdataSection = parent->endCdataSection; +#endif + + external->final = 1; + external->validate = parent->validate; + external->status = TCL_OK; + external->result = NULL; + external->continueCount = 0; + external->context = NULL; + external->cdata = NULL; + external->nowhitespace = parent->nowhitespace; + if (parent->encoding) { + external->encoding = Tcl_DuplicateObj(parent->encoding); + } else { + external->encoding = Tcl_NewStringObj("utf-8", -1); + } + + if (extClassInfo->createEntity) { + /* + * Directly invoke the create routine + */ + if ((external->clientData = (*extClassInfo->createEntity)(interp, (ClientData) external)) == NULL) { + Tcl_Free((char*)external); + return TCL_ERROR; + } + } else if (extClassInfo->createEntityCmd) { + int result; + + result = Tcl_GlobalEvalObj(interp, extClassInfo->createEntityCmd); + if (result != TCL_OK) { + Tcl_Free((char*)external); + return TCL_ERROR; + } else { + + /* + * Return result is parser instance argument + */ + + external->clientData = (ClientData) Tcl_GetObjResult(interp); + Tcl_IncrRefCount((Tcl_Obj *) external->clientData); + + } + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLDestroyParserInstance -- + * + * Destroys the parser instance. + * + * Results: + * None. + * + * Side effects: + * Depends on class destroy proc. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLDestroyParserInstance(xmlinfo) + TclXML_Info *xmlinfo; +{ + TclXML_ParserClassInfo *classInfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + if (xmlinfo->clientData) { + if (classInfo->destroy) { + if ((*classInfo->destroy)(xmlinfo->clientData) != TCL_OK) { + if (xmlinfo->encoding) { + Tcl_DecrRefCount(xmlinfo->encoding); + } + Tcl_Free((char *)xmlinfo); + return TCL_ERROR; + } + } else if (classInfo->destroyCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->destroyCmd); + int result; + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, (Tcl_Obj *) xmlinfo->clientData); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + + if (result != TCL_OK) { + if (xmlinfo->encoding) { + Tcl_DecrRefCount(xmlinfo->encoding); + } + Tcl_Free((char *)xmlinfo); + return TCL_ERROR; + } + + Tcl_DecrRefCount((Tcl_Obj *) xmlinfo->clientData); + + } + + xmlinfo->clientData = NULL; + + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLFreeParser -- + * + * Destroy the parser instance structure. + * + * Results: + * None. + * + * Side effects: + * Frees any memory allocated for the XML parser instance. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXMLFreeParser(xmlinfo) + TclXML_Info *xmlinfo; +{ + if (TclXMLDestroyParserInstance(xmlinfo) == TCL_OK) { + if (xmlinfo->encoding) { + Tcl_DecrRefCount(xmlinfo->encoding); + } + Tcl_Free((char*)xmlinfo); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLInstanceCmd -- + * + * Implements instance command for XML parsers. + * + * Results: + * Depends on the method. + * + * Side effects: + * Depends on the method. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLInstanceCmd (clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) clientData; + TclXML_Info *child; + char *encoding, *data; + int len, index, result = TCL_OK; + Tcl_Obj *childNamePtr; + static CONST84 char *options[] = { + "configure", "cget", "entityparser", "free", "get", "parse", "reset", NULL + }; + enum options { + TCLXML_CONFIGURE, TCLXML_CGET, TCLXML_ENTITYPARSER, TCLXML_FREE, TCLXML_GET, + TCLXML_PARSE, TCLXML_RESET + }; + + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "method ?args?"); + return TCL_ERROR; + } + + if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, + &index) != TCL_OK) { + return TCL_ERROR; + } + + switch ((enum options) index) { + case TCLXML_CONFIGURE: + + result = TclXMLInstanceConfigure(interp, xmlinfo, objc - 2, objv + 2); + break; + + case TCLXML_CGET: + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 1, objv, "cget option"); + return TCL_ERROR; + } + + result = TclXMLCget(interp, xmlinfo, objc - 2, objv + 2); + break; + + case TCLXML_ENTITYPARSER: + /* ericm@scriptics.com, 1999.9.13 */ + + /* check for args - Pat Thoyts */ + if (objc == 2) { + childNamePtr = FindUniqueCmdName(interp); + } else if (objc == 3) { + childNamePtr = objv[2]; + } else { + Tcl_WrongNumArgs(interp, 1, objv, "entityparser ?args?"); + return TCL_ERROR; + } + + /* + * Create the data structures for this parser. + */ + if (!(child = (TclXML_Info *) Tcl_Alloc(sizeof(TclXML_Info)))) { + Tcl_Free((char*)child); + Tcl_SetResult(interp, "unable to create parser", NULL); + return TCL_ERROR; + } + + child->interp = interp; + Tcl_IncrRefCount(childNamePtr); + child->name = childNamePtr; + + /* Actually create the parser instance */ + if (TclXMLCreateEntityParser(interp, child, + xmlinfo) != TCL_OK) { + Tcl_DecrRefCount(childNamePtr); + Tcl_Free((char*)child); + return TCL_ERROR; + } + + /* Register a Tcl command for this parser instance */ + Tcl_CreateObjCommand(interp, Tcl_GetString(child->name), + TclXMLInstanceCmd, (ClientData) child, TclXMLInstanceDeleteCmd); + + Tcl_SetObjResult(interp, child->name); + result = TCL_OK; + break; + + case TCLXML_FREE: + + /* ericm@scriptics.com, 1999.9.13 */ + Tcl_DeleteCommand(interp, Tcl_GetString(xmlinfo->name)); + result = TCL_OK; + break; + + case TCLXML_GET: + + /* ericm@scriptics.com, 1999.6.28 */ + result = TclXMLGet(interp, xmlinfo, objc - 2, objv + 2); + break; + + case TCLXML_PARSE: + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "data"); + return TCL_ERROR; + } + + if (xmlinfo->encoding) { + encoding = Tcl_GetStringFromObj(xmlinfo->encoding, NULL); + } else { + encoding = "utf-8"; + } + if (strlen(encoding) == 0 || strcmp(encoding, "utf-8") == 0) { + data = Tcl_GetStringFromObj(objv[2], &len); + } else { + data = (char *) Tcl_GetByteArrayFromObj(objv[2], &len); + } + + result = TclXMLParse(interp, xmlinfo, data, len); + + break; + + case TCLXML_RESET: + + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, ""); + return TCL_ERROR; + } + + TclXMLResetParser(interp, xmlinfo); + break; + + default: + + Tcl_SetResult(interp, "unknown method", NULL); + return TCL_ERROR; + } + + return result; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLParse -- + * + * Invoke parser class' parse proc and check return result. + * + * Results: + * TCL_OK if no errors, TCL_ERROR otherwise. + * + * Side effects: + * Sets interpreter result as appropriate. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLParse (interp, xmlinfo, data, len) + Tcl_Interp *interp; + TclXML_Info *xmlinfo; + char *data; + int len; +{ + int result; + TclXML_ParserClassInfo *classInfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + xmlinfo->status = TCL_OK; + if (xmlinfo->result != NULL) { + Tcl_DecrRefCount(xmlinfo->result); + } + xmlinfo->result = NULL; + + if (classInfo->parse) { + if ((*classInfo->parse)(xmlinfo->clientData, data, len, xmlinfo->final) != TCL_OK) { + return TCL_ERROR; + } + } else if (classInfo->parseCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->parseCmd); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + if (xmlinfo->clientData) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, (Tcl_Obj *) xmlinfo->clientData); + } else if (xmlinfo->name) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, xmlinfo->name); + } + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewStringObj(data, len)); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + + if (result != TCL_OK) { + return TCL_ERROR; + } + + } else { + Tcl_SetResult(interp, "XML parser cannot parse", NULL); + return TCL_ERROR; + } + + switch (xmlinfo->status) { + case TCL_OK: + case TCL_BREAK: + case TCL_CONTINUE: + TclXMLDispatchPCDATA(xmlinfo); + Tcl_ResetResult(interp); + return TCL_OK; + + case TCL_ERROR: + Tcl_SetObjResult(interp, xmlinfo->result); + return TCL_ERROR; + + default: + /* + * Propagate application-specific error condition. + * Patch by Marshall Rose <mrose@dbc.mtview.ca.us> + */ + Tcl_SetObjResult(interp, xmlinfo->result); + return xmlinfo->status; + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLInstanceConfigure -- + * + * Configures a XML parser instance. + * + * Results: + * Depends on the method. + * + * Side effects: + * Depends on the method. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLInstanceConfigure (interp, xmlinfo, objc, objv) + Tcl_Interp *interp; + TclXML_Info *xmlinfo; + int objc; + Tcl_Obj *CONST objv[]; +{ + int index, bool, doParse = 0, result; + TclXML_ParserClassInfo *classinfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + while (objc > 1) { + /* + * Firstly, pass the option to the parser's own + * configuration management routine. + * It may pass back an error or break code to + * stop us from further processing the options. + */ + + if (classinfo->configure) { + result = (*classinfo->configure)(xmlinfo->clientData, objv[0], objv[1]); + if (result == TCL_BREAK) { + objc -= 2; + objv += 2; + continue; + } + if (result != TCL_OK) { + return TCL_ERROR; + } + } else if (classinfo->configureCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classinfo->configureCmd); + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) interp); + + if (xmlinfo->clientData) { + Tcl_ListObjAppendElement(interp, cmdPtr, (Tcl_Obj *) xmlinfo->clientData); + } else if (xmlinfo->name) { + Tcl_ListObjAppendElement(interp, cmdPtr, xmlinfo->name); + } + + Tcl_ListObjAppendElement(interp, cmdPtr, objv[0]); + Tcl_ListObjAppendElement(interp, cmdPtr, objv[1]); + + result = Tcl_GlobalEvalObj(interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) interp); + + if (result == TCL_BREAK) { + objc -= 2; + objv += 2; + continue; + } else if (result != TCL_OK) { + return TCL_ERROR; + } + } + + Tcl_ResetResult (interp); + + if (Tcl_GetIndexFromObj(interp, objv[0], instanceConfigureSwitches, + "switch", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + switch ((enum instanceConfigureSwitches) index) { + case TCLXML_FINAL: /* -final */ + + if (Tcl_GetBooleanFromObj(interp, objv[1], &bool) != TCL_OK) { + return TCL_ERROR; + } + + if (bool && !xmlinfo->final) { + doParse = 1; + + } else if (!bool && xmlinfo->final) { + /* + * Reset the parser for new input + */ + + TclXMLResetParser(interp, xmlinfo); + doParse = 0; + } + xmlinfo->final = bool; + break; + + case TCLXML_ENCODING: /* -encoding */ + if (xmlinfo->encoding) { + Tcl_DecrRefCount(xmlinfo->encoding); + } + xmlinfo->encoding = objv[1]; + Tcl_IncrRefCount(xmlinfo->encoding); + break; + + case TCLXML_VALIDATE: /* -validate */ + if (Tcl_GetBooleanFromObj(interp, objv[1], &bool) != TCL_OK) { + return TCL_ERROR; + } + /* + * If the parser is in the middle of parsing a document, + * this will be ignored. Perhaps an error should be returned? + */ + xmlinfo->validate = bool; + break; + + case TCLXML_BASEURL: /* -baseurl, -baseuri */ + case TCLXML_BASEURI: + if (xmlinfo->base != NULL) { + Tcl_DecrRefCount(xmlinfo->base); + } + + xmlinfo->base = objv[1]; + Tcl_IncrRefCount(xmlinfo->base); + break; + + case TCLXML_DEFAULTEXPANDINTERNALENTITIES: /* -defaultexpandinternalentities */ + /* ericm@scriptics */ + if (Tcl_GetBooleanFromObj(interp, objv[1], &bool) != TCL_OK) { + return TCL_ERROR; + } + xmlinfo->expandinternalentities = bool; + break; + + case TCLXML_PARAMENTITYPARSING: + /* ericm@scriptics */ + case TCLXML_NOWHITESPACE: + case TCLXML_REPORTEMPTY: + /* + * All of these get passed through to the instance's + * configure procedure. + */ + + if (TclXMLConfigureParserInstance(xmlinfo, objv[0], objv[1]) != TCL_OK) { + return TCL_ERROR; + } + break; + + case TCLXML_ELEMENTSTARTCMD: /* -elementstartcommand */ + + if (xmlinfo->elementstartcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->elementstartcommand); + } + xmlinfo->elementstart = NULL; + + xmlinfo->elementstartcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->elementstartcommand); + break; + + case TCLXML_ELEMENTENDCMD: /* -elementendcommand */ + + if (xmlinfo->elementendcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->elementendcommand); + } + xmlinfo->elementend = NULL; + + xmlinfo->elementendcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->elementendcommand); + break; + + case TCLXML_DATACMD: /* -characterdatacommand */ + + if (xmlinfo->datacommand != NULL) { + Tcl_DecrRefCount(xmlinfo->datacommand); + } + xmlinfo->cdatacb = NULL; + + xmlinfo->datacommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->datacommand); + break; + + case TCLXML_PICMD: /* -processinginstructioncommand */ + + if (xmlinfo->picommand != NULL) { + Tcl_DecrRefCount(xmlinfo->picommand); + } + xmlinfo->pi = NULL; + + xmlinfo->picommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->picommand); + break; + + case TCLXML_DEFAULTCMD: /* -defaultcommand */ + + if (xmlinfo->defaultcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->defaultcommand); + } + xmlinfo->defaultcb = NULL; + + xmlinfo->defaultcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->defaultcommand); + break; + + case TCLXML_UNPARSEDENTITYCMD: /* -unparsedentitydeclcommand */ + + if (xmlinfo->unparsedcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->unparsedcommand); + } + xmlinfo->unparsed = NULL; + + xmlinfo->unparsedcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->unparsedcommand); + break; + + case TCLXML_NOTATIONCMD: /* -notationdeclcommand */ + + if (xmlinfo->notationcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->notationcommand); + } + xmlinfo->notation = NULL; + + xmlinfo->notationcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->notationcommand); + break; + + case TCLXML_EXTERNALENTITYCMD: /* -externalentitycommand */ + + if (xmlinfo->entitycommand != NULL) { + Tcl_DecrRefCount(xmlinfo->entitycommand); + } + xmlinfo->entity = NULL; + + xmlinfo->entitycommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->entitycommand); + break; + + case TCLXML_UNKNOWNENCODINGCMD: /* -unknownencodingcommand */ + + /* Not implemented */ + break; + + if (xmlinfo->unknownencodingcommand != NULL) { + Tcl_DecrRefCount(xmlinfo->unknownencodingcommand); + } + xmlinfo->unknownencoding = NULL; + + xmlinfo->unknownencodingcommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->unknownencodingcommand); + break; + + case TCLXML_COMMENTCMD: /* -commentcommand */ + /* ericm@scriptics.com */ + if (xmlinfo->commentCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->commentCommand); + } + xmlinfo->comment = NULL; + + xmlinfo->commentCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->commentCommand); + break; + + case TCLXML_NOTSTANDALONECMD: /* -notstandalonecommand */ + /* ericm@scriptics.com */ + if (xmlinfo->notStandaloneCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->notStandaloneCommand); + } + xmlinfo->notStandalone = NULL; + + xmlinfo->notStandaloneCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->notStandaloneCommand); + break; + +#ifdef TCLXML_CDATASECTIONS + case TCLXML_STARTCDATASECTIONCMD: /* -startcdatasectioncommand */ + /* ericm@scriptics */ + if (xmlinfo->startCdataSectionCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->startCdataSectionCommand); + } + xmlinfo->startCDATASection = NULL; + + xmlinfo->startCdataSectionCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->startCdataSectionCommand); + break; + + case TCLXML_ENDCDATASECTIONCMD: /* -endcdatasectioncommand */ + /* ericm@scriptics */ + if (xmlinfo->endCdataSectionCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->endCdataSectionCommand); + } + xmlinfo->endCDATASection = NULL; + + xmlinfo->endCdataSectionCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->endCdataSectionCommand); + break; +#endif + + case TCLXML_ELEMENTDECLCMD: /* -elementdeclcommand */ + /* ericm@scriptics.com */ + if (xmlinfo->elementDeclCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->elementDeclCommand); + } + xmlinfo->elementDecl = NULL; + + xmlinfo->elementDeclCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->elementDeclCommand); + break; + + case TCLXML_ATTLISTDECLCMD: /* -attlistdeclcommand */ + /* ericm@scriptics.com */ + if (xmlinfo->attlistDeclCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->attlistDeclCommand); + } + xmlinfo->attlistDecl = NULL; + + xmlinfo->attlistDeclCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->attlistDeclCommand); + break; + + case TCLXML_STARTDOCTYPEDECLCMD: /* -startdoctypedeclcommand */ + /* ericm@scriptics.com */ + if (xmlinfo->startDoctypeDeclCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->startDoctypeDeclCommand); + } + xmlinfo->startDoctypeDecl = NULL; + + xmlinfo->startDoctypeDeclCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->startDoctypeDeclCommand); + break; + + case TCLXML_ENDDOCTYPEDECLCMD: /* -enddoctypedeclcommand */ + /* ericm@scriptics.com */ + if (xmlinfo->endDoctypeDeclCommand != NULL) { + Tcl_DecrRefCount(xmlinfo->endDoctypeDeclCommand); + } + xmlinfo->endDoctypeDecl = NULL; + + xmlinfo->endDoctypeDeclCommand = objv[1]; + Tcl_IncrRefCount(xmlinfo->endDoctypeDeclCommand); + break; + + case TCLXML_ENTITYDECLCMD: /* -entitydeclcommand */ + case TCLXML_PARAMENTITYDECLCMD: /* -parameterentitydeclcommand */ + case TCLXML_DOCTYPECMD: /* -doctypecommand */ + case TCLXML_ENTITYREFCMD: /* -entityreferencecommand */ + case TCLXML_XMLDECLCMD: /* -xmldeclcommand */ + /* commands used by tcldom, but not here yet */ + break; + + default: + return TCL_ERROR; + break; + } + + objv += 2; + objc -= 2; + + } + + if (doParse) { + return TclXMLParse(interp, xmlinfo, "", 0); + } else { + return TCL_OK; + } + +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLCget -- + * + * Returns setting of configuration option. + * + * Results: + * Option value. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLCget (interp, xmlinfo, objc, objv) + Tcl_Interp *interp; + TclXML_Info *xmlinfo; + int objc; + Tcl_Obj *CONST objv[]; +{ + int index; + + if (Tcl_GetIndexFromObj(interp, objv[0], instanceConfigureSwitches, "switch", 0, &index) != TCL_OK) { + return TCL_ERROR; + } + + Tcl_SetObjResult(interp, Tcl_NewObj()); + + switch ((enum instanceConfigureSwitches) index) { + case TCLXML_FINAL: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->final)); + break; + case TCLXML_VALIDATE: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->validate)); + break; + case TCLXML_DEFAULTEXPANDINTERNALENTITIES: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->expandinternalentities)); + break; + case TCLXML_REPORTEMPTY: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->reportempty)); + break; + case TCLXML_PARAMENTITYPARSING: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->paramentities)); + break; + case TCLXML_NOWHITESPACE: + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(xmlinfo->nowhitespace)); + break; + case TCLXML_BASEURL: + case TCLXML_BASEURI: + if (xmlinfo->base) { + Tcl_SetObjResult(interp, xmlinfo->base); + } + break; + case TCLXML_ENCODING: + if (xmlinfo->encoding) { + Tcl_SetObjResult(interp, xmlinfo->encoding); + } + break; + case TCLXML_ELEMENTSTARTCMD: + if (xmlinfo->elementstartcommand) { + Tcl_SetObjResult(interp, xmlinfo->elementstartcommand); + } + break; + case TCLXML_ELEMENTENDCMD: + if (xmlinfo->elementendcommand) { + Tcl_SetObjResult(interp, xmlinfo->elementendcommand); + } + break; + case TCLXML_DATACMD: + if (xmlinfo->datacommand) { + Tcl_SetObjResult(interp, xmlinfo->datacommand); + } + break; + case TCLXML_PICMD: + if (xmlinfo->picommand) { + Tcl_SetObjResult(interp, xmlinfo->picommand); + } + break; + case TCLXML_DEFAULTCMD: + if (xmlinfo->defaultcommand) { + Tcl_SetObjResult(interp, xmlinfo->defaultcommand); + } + break; + case TCLXML_UNPARSEDENTITYCMD: + if (xmlinfo->unparsedcommand) { + Tcl_SetObjResult(interp, xmlinfo->unparsedcommand); + } + break; + case TCLXML_NOTATIONCMD: + if (xmlinfo->notationcommand) { + Tcl_SetObjResult(interp, xmlinfo->notationcommand); + } + break; + case TCLXML_EXTERNALENTITYCMD: + if (xmlinfo->entitycommand) { + Tcl_SetObjResult(interp, xmlinfo->entitycommand); + } + break; + case TCLXML_UNKNOWNENCODINGCMD: + if (xmlinfo->unknownencodingcommand) { + Tcl_SetObjResult(interp, xmlinfo->unknownencodingcommand); + } + break; + case TCLXML_COMMENTCMD: + if (xmlinfo->commentCommand) { + Tcl_SetObjResult(interp, xmlinfo->commentCommand); + } + break; + case TCLXML_NOTSTANDALONECMD: + if (xmlinfo->notStandaloneCommand) { + Tcl_SetObjResult(interp, xmlinfo->notStandaloneCommand); + } + break; +#ifdef TCLXML_CDATASECTIONS + case TCLXML_STARTCDATASECTIONCMD: + if (xmlinfo->startCdataSectionCommand) { + Tcl_SetObjResult(interp, xmlinfo->startCdataSectionCommand); + } + break; + case TCLXML_ENDCDATASECTIONCMD: + if (xmlinfo->endCdataSectionCommand) { + Tcl_SetObjResult(interp, xmlinfo->endCdataSectionCommand); + } + break; +#else + case TCLXML_STARTCDATASECTIONCMD: + case TCLXML_ENDCDATASECTIONCMD: + break; +#endif + case TCLXML_ELEMENTDECLCMD: + if (xmlinfo->elementDeclCommand) { + Tcl_SetObjResult(interp, xmlinfo->elementDeclCommand); + } + break; + case TCLXML_ATTLISTDECLCMD: + if (xmlinfo->attlistDeclCommand) { + Tcl_SetObjResult(interp, xmlinfo->attlistDeclCommand); + } + break; + case TCLXML_STARTDOCTYPEDECLCMD: + if (xmlinfo->startDoctypeDeclCommand) { + Tcl_SetObjResult(interp, xmlinfo->startDoctypeDeclCommand); + } + break; + case TCLXML_ENDDOCTYPEDECLCMD: + if (xmlinfo->endDoctypeDeclCommand) { + Tcl_SetObjResult(interp, xmlinfo->endDoctypeDeclCommand); + } + break; + + case TCLXML_ENTITYDECLCMD: + case TCLXML_PARAMENTITYDECLCMD: + case TCLXML_DOCTYPECMD: + case TCLXML_ENTITYREFCMD: + case TCLXML_XMLDECLCMD: + /* These are not (yet) supported) */ + break; + } + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLConfigureParserInstance -- + * + * Set an option in a parser instance. + * + * Results: + * Standard Tcl result. + * + * Side effects: + * Depends on parser class. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLConfigureParserInstance (xmlinfo, option, value) + TclXML_Info *xmlinfo; + Tcl_Obj *option; + Tcl_Obj *value; +{ + TclXML_ParserClassInfo *classInfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + if (classInfo->configure) { + if ((*classInfo->configure)(xmlinfo->clientData, option, value) != TCL_OK) { + return TCL_ERROR; + } + } else if (classInfo->configureCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->configureCmd); + int result; + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + /* SF Bug 514045. + */ + + if (xmlinfo->clientData) { + Tcl_ListObjAppendElement(NULL, cmdPtr, (Tcl_Obj *) xmlinfo->clientData); + } else if (xmlinfo->name) { + Tcl_ListObjAppendElement(NULL, cmdPtr, xmlinfo->name); + } + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, option); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, value); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + + if (result != TCL_OK) { + return TCL_ERROR; + } + } else { + Tcl_SetResult(xmlinfo->interp, "no configure procedure for parser", NULL); + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLGet -- + * + * Returns runtime parser information, depending on option + * ericm@scriptics.com, 1999.6.28 + * + * Results: + * Option value. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------------- + */ + +static int +TclXMLGet (interp, xmlinfo, objc, objv) + Tcl_Interp *interp; + TclXML_Info *xmlinfo; + int objc; + Tcl_Obj *CONST objv[]; +{ + TclXML_ParserClassInfo *classInfo = (TclXML_ParserClassInfo *) xmlinfo->parserClass; + + if (classInfo->get) { + return (*classInfo->get)(xmlinfo->clientData, objc, objv); + } else if (classInfo->getCmd) { + Tcl_Obj *cmdPtr = Tcl_DuplicateObj(classInfo->getCmd); + int i, result; + + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + for (i = 0; i < objc; i++) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, objv[i]); + } + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + + return result; + } else { + Tcl_SetResult(interp, "parser has no get procedure", NULL); + return TCL_ERROR; + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLHandlerResult -- + * + * Manage the result of the application callback. + * + * Results: + * None. + * + * Side Effects: + * Further invocation of callback scripts may be inhibited. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXMLHandlerResult(xmlinfo, result) + TclXML_Info *xmlinfo; + int result; +{ + switch (result) { + case TCL_OK: + xmlinfo->status = TCL_OK; + break; + + case TCL_CONTINUE: + /* + * Skip callbacks until the matching end element event + * occurs for the currently open element. + * Keep a reference count to handle nested + * elements. + */ + xmlinfo->status = TCL_CONTINUE; + xmlinfo->continueCount = 0; + break; + + case TCL_BREAK: + /* + * Skip all further callbacks, but return OK. + */ + xmlinfo->status = TCL_BREAK; + break; + + case TCL_ERROR: + default: + /* + * Skip all further callbacks, and return error. + */ + xmlinfo->status = TCL_ERROR; + xmlinfo->result = Tcl_GetObjResult(xmlinfo->interp); + Tcl_IncrRefCount(xmlinfo->result); + break; + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_ElementStartHandler -- + * + * Called by parser instance for each start tag. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_ElementStartHandler(userData, name, nsuri, atts, nsDecls) + void *userData; + Tcl_Obj *name; + Tcl_Obj *nsuri; + Tcl_Obj *atts; + Tcl_Obj *nsDecls; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if (xmlinfo->status == TCL_CONTINUE) { + + /* + * We're currently skipping elements looking for the + * close of the continued element. + */ + + xmlinfo->continueCount++; + return; + } + + if ((xmlinfo->elementstartcommand == NULL && + xmlinfo->elementstart == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->elementstart) { + result = (xmlinfo->elementstart)(xmlinfo->interp, xmlinfo->elementstartdata, name, nsuri, atts, nsDecls); + } else if (xmlinfo->elementstartcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->elementstartcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, name); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, atts); + if (nsuri) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewStringObj("-namespace", -1)); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, nsuri); + } + if (nsDecls) { + int len; + if ((Tcl_ListObjLength(xmlinfo->interp, nsDecls, &len) == TCL_OK) && (len > 0)) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewStringObj("-namespacedecls", -1)); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, nsDecls); + } + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_ElementEndHandler -- + * + * Called by parser instance for each end tag. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_ElementEndHandler(userData, name) + void *userData; + Tcl_Obj *name; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK;; + + TclXMLDispatchPCDATA(xmlinfo); + + if (xmlinfo->status == TCL_CONTINUE) { + /* + * We're currently skipping elements looking for the + * end of the currently open element. + */ + + if (!--(xmlinfo->continueCount)) { + xmlinfo->status = TCL_OK; + } else { + return; + } + } + + if ((xmlinfo->elementend == NULL && + xmlinfo->elementendcommand == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->elementend) { + result = (xmlinfo->elementend)(xmlinfo->interp, xmlinfo->elementenddata, name); + } else if (xmlinfo->elementendcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->elementendcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, name); + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_CharacterDataHandler -- + * + * Called by parser instance for character data. + * + * Results: + * None. + * + * Side Effects: + * Character data is accumulated in a string object + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_CharacterDataHandler(userData, s) + void *userData; + Tcl_Obj *s; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + if (xmlinfo->cdata == NULL) { + xmlinfo->cdata = s; + Tcl_IncrRefCount(xmlinfo->cdata); + } else { + Tcl_AppendObjToObj(xmlinfo->cdata, s); + } +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLDispatchPCDATA -- + * + * Called to check whether any accumulated character data + * exists, and if so invoke the callback. + * + * Results: + * None. + * + * Side Effects: + * Callback script evaluated. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXMLDispatchPCDATA(xmlinfo) + TclXML_Info *xmlinfo; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + int result = TCL_OK; + + if (xmlinfo->cdata == NULL || + (xmlinfo->datacommand == NULL && xmlinfo->cdatacb == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + /* + * Optionally ignore white-space-only PCDATA + */ + + if (xmlinfo->nowhitespace) { + if (!Tcl_RegExpMatchObj(xmlinfo->interp, xmlinfo->cdata, tsdPtr->whitespaceRE)) { + goto finish; + } + } + + if (xmlinfo->cdatacb) { + result = (xmlinfo->cdatacb)(xmlinfo->interp, xmlinfo->cdatacbdata, xmlinfo->cdata); + } else if (xmlinfo->datacommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->datacommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + if (Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, xmlinfo->cdata) != TCL_OK) { + xmlinfo->status = TCL_ERROR; + return; + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + finish: + Tcl_DecrRefCount(xmlinfo->cdata); + xmlinfo->cdata = NULL; + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_ProcessingInstructionHandler -- + * + * Called by parser instance for processing instructions. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_ProcessingInstructionHandler(userData, target, data) + void *userData; + Tcl_Obj *target; + Tcl_Obj *data; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->picommand == NULL && xmlinfo->pi == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->pi) { + result = (xmlinfo->pi)(xmlinfo->interp, xmlinfo->pidata, target, data); + } else if (xmlinfo->picommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->picommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, target); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, data); + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_DefaultHandler -- + * + * Called by parser instance for processing data which has no other handler. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_DefaultHandler(userData, s) + void *userData; + Tcl_Obj *s; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->defaultcommand == NULL && xmlinfo->defaultcb == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->defaultcb) { + result = (xmlinfo->defaultcb)(xmlinfo->interp, xmlinfo->defaultdata, s); + } else if (xmlinfo->defaultcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->defaultcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, s); + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_UnparsedDeclHandler -- + * + * Called by parser instance for processing an unparsed entity references. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_UnparsedDeclHandler(userData, entityName, base, systemId, publicId, notationName) + void *userData; + Tcl_Obj *entityName; + Tcl_Obj *base; + Tcl_Obj *systemId; + Tcl_Obj *publicId; + Tcl_Obj *notationName; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->unparsedcommand == NULL && xmlinfo->unparsed == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->unparsed) { + result = (xmlinfo->unparsed)(xmlinfo->interp, xmlinfo->unparseddata, entityName, base, systemId, publicId, notationName); + } else if (xmlinfo->unparsedcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->unparsedcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, entityName); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, base); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, systemId); + if (publicId == NULL) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, publicId); + } + if (notationName == NULL) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, notationName); + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_NotationDeclHandler -- + * + * Called by parser instance for processing a notation declaration. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +void +TclXML_NotationDeclHandler(userData, notationName, base, systemId, publicId) + void *userData; + Tcl_Obj *notationName; + Tcl_Obj *base; + Tcl_Obj *systemId; + Tcl_Obj *publicId; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->notationcommand == NULL && xmlinfo->notation == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->notation) { + result = (xmlinfo->notation)(xmlinfo->interp, xmlinfo->notationdata, notationName, base, systemId, publicId); + } else if (xmlinfo->notationcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->notationcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, notationName); + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, base); + if (systemId == NULL) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, systemId); + } + if (publicId == NULL) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, publicId); + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_UnknownEncodingHandler -- + * + * Called by parser instance for processing a reference to a character in an + * unknown encoding. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_UnknownEncodingHandler(encodingHandlerData, name, info) + void *encodingHandlerData; + Tcl_Obj *name; + void *info; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) encodingHandlerData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + Tcl_SetResult(xmlinfo->interp, "not implemented", NULL); + return 0; + + if ((xmlinfo->unknownencodingcommand == NULL && xmlinfo->unknownencoding == NULL) || + xmlinfo->status != TCL_OK) { + return 0; + } + + if (xmlinfo->unknownencoding) { + result = (xmlinfo->unknownencoding)(xmlinfo->interp, xmlinfo->unknownencodingdata, name, info); + } else if (xmlinfo->unknownencodingcommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->unknownencodingcommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + /* + * Setup the arguments + */ + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return 0; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_ExternalEntityRefHandler -- + * + * Called by parser instance for processing external entity references. + * May also be called outside the context of a parser for XInclude + * or XSLT import/include. + * + * Results: + * Returns success code. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_ExternalEntityRefHandler(userData, openEntityNames, base, + systemId, publicId) + ClientData userData; /* NULL if not in parser context, current interp gets result */ + Tcl_Obj *openEntityNames; + Tcl_Obj *base; + Tcl_Obj *systemId; + Tcl_Obj *publicId; +{ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData)); + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + Tcl_Obj *oldContext; + + if (xmlinfo != NULL) { + TclXMLDispatchPCDATA(xmlinfo); + + if (xmlinfo->entitycommand == NULL && xmlinfo->entity == NULL) { + if (Tcl_IsSafe(xmlinfo->interp)) { + return TCL_BREAK; + } else { + return TCL_CONTINUE; + } + } + if (xmlinfo->status != TCL_OK) { + return xmlinfo->status; + } + oldContext = xmlinfo->context; + xmlinfo->context = openEntityNames; + + if (xmlinfo->entity) { + result = (xmlinfo->entity)(xmlinfo->interp, xmlinfo->entitydata, xmlinfo->name, base, systemId, publicId); + } else if (xmlinfo->entitycommand) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(xmlinfo->entitycommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, xmlinfo->name); + + if (base) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, base); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, systemId); + + if (publicId) { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, publicId); + } else { + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, Tcl_NewObj()); + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + /* + * Return results have a different meaning for external entities, + * so don't retain the result for later use. + * TclXMLHandlerResult(xmlinfo, result); + */ + xmlinfo->context = oldContext; + + } else { + /* + * No parser context + */ + + if (tsdPtr->externalentitycmd) { + Tcl_Obj *cmdPtr; + + /* + * Take a copy of the callback script so that arguments may be appended. + */ + + cmdPtr = Tcl_DuplicateObj(tsdPtr->externalentitycmd); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) tsdPtr->interp); + + if (base) { + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, base); + } else { + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewObj()); + } + + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, systemId); + + if (publicId) { + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, publicId); + } else { + Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewObj()); + } + + /* + * It would be desirable to be able to terminate parsing + * if the return result is TCL_ERROR or TCL_BREAK. + */ + result = Tcl_GlobalEvalObj(tsdPtr->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) tsdPtr->interp); + } else if (Tcl_IsSafe(tsdPtr->interp)) { + return TCL_BREAK; + } else { + return TCL_CONTINUE; + } + } + + return result; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_CommentHandler -- + * + * Called by parser instance to handle comments encountered while parsing + * Added by ericm@scriptics.com, 1999.6.25. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ +void +TclXML_CommentHandler(userData, data) + void *userData; + Tcl_Obj *data; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if (xmlinfo->status == TCL_CONTINUE) { + /* Currently skipping elements, looking for the close of the + * continued element. Comments don't have an end tag, so + * don't increment xmlinfo->continueCount + */ + return; + } + + if ((xmlinfo->commentCommand == NULL && xmlinfo->comment == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->comment) { + result = (xmlinfo->comment)(xmlinfo->interp, xmlinfo->commentdata, data); + } else if (xmlinfo->commentCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->commentCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, data); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_NotStandaloneHandler -- + * + * Called by parser instance to handle "not standalone" documents (ie, documents + * that have an external subset or a reference to a parameter entity, + * but do not have standalone="yes") + * Added by ericm@scriptics.com, 1999.6.25. + * + * Results: + * None. + * + * Side Effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_NotStandaloneHandler(userData) + void *userData; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if (xmlinfo->status != TCL_OK) { + return 0; + } else if (xmlinfo->notStandaloneCommand == NULL && xmlinfo->notStandalone == NULL) { + return 1; + } + + if (xmlinfo->notStandalone) { + result = (xmlinfo->notStandalone)(xmlinfo->interp, xmlinfo->notstandalonedata); + } else if (xmlinfo->notStandaloneCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->notStandaloneCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return 1; +} + +/* + *---------------------------------------------------------------------- + * + * TclXML_ElementDeclHandler -- + * + * Called by expat to handle <!ELEMENT declarations. + * + * Results: + * None. + * + * Side effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------- + */ + +void +TclXML_ElementDeclHandler(userData, name, contentspec) + void *userData; + Tcl_Obj *name; + Tcl_Obj *contentspec; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->elementDeclCommand == NULL && xmlinfo->elementDecl == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->elementDecl) { + result = (xmlinfo->elementDecl)(xmlinfo->interp, xmlinfo->elementdecldata, name, contentspec); + } else if (xmlinfo->elementDeclCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->elementDeclCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, name); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, contentspec); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------- + * + * TclXML_AttlistDeclHandler -- + * + * Called by parser instance to handle <!ATTLIST declarations. + * + * Results: + * None. + * + * Side effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------- + */ + +void +TclXML_AttlistDeclHandler(userData, name, attributes) + void *userData; + Tcl_Obj *name; + Tcl_Obj *attributes; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->attlistDeclCommand == NULL && xmlinfo->attlistDecl == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->attlistDecl) { + result = (xmlinfo->attlistDecl)(xmlinfo->interp, xmlinfo->attlistdecldata, name, attributes); + } else if (xmlinfo->attlistDeclCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->attlistDeclCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, name); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, attributes); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------- + * + * TclXML_StartDoctypeDeclHandler -- + * + * Called by parser instance to handle the start of <!DOCTYPE declarations. + * + * Results: + * None. + * + * Side effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------- + */ + +void +TclXML_StartDoctypeDeclHandler(userData, name) + void *userData; + Tcl_Obj *name; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->startDoctypeDeclCommand == NULL && xmlinfo->startDoctypeDecl == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->startDoctypeDecl) { + result = (xmlinfo->startDoctypeDecl)(xmlinfo->interp, xmlinfo->startdoctypedecldata, name); + } else if (xmlinfo->startDoctypeDeclCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->startDoctypeDeclCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + Tcl_ListObjAppendElement(xmlinfo->interp, cmdPtr, name); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------- + * + * TclXML_EndDoctypeDeclHandler -- + * + * Called by parser instance to handle the end of <!DOCTYPE declarations. + * + * Results: + * None. + * + * Side effects: + * Callback script is invoked. + * + *---------------------------------------------------------------------- + */ + +void +TclXML_EndDoctypeDeclHandler(userData) + void *userData; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) userData; + int result = TCL_OK; + + TclXMLDispatchPCDATA(xmlinfo); + + if ((xmlinfo->endDoctypeDeclCommand == NULL && xmlinfo->endDoctypeDecl == NULL) || + xmlinfo->status != TCL_OK) { + return; + } + + if (xmlinfo->endDoctypeDecl) { + result = (xmlinfo->endDoctypeDecl)(xmlinfo->interp, xmlinfo->enddoctypedecldata); + } else if (xmlinfo->endDoctypeDeclCommand) { + Tcl_Obj *cmdPtr; + + cmdPtr = Tcl_DuplicateObj(xmlinfo->endDoctypeDeclCommand); + Tcl_IncrRefCount(cmdPtr); + Tcl_Preserve((ClientData) xmlinfo->interp); + + result = Tcl_GlobalEvalObj(xmlinfo->interp, cmdPtr); + + Tcl_DecrRefCount(cmdPtr); + Tcl_Release((ClientData) xmlinfo->interp); + } + + TclXMLHandlerResult(xmlinfo, result); + + return; +} + +/* + *---------------------------------------------------------------------------- + * + * TclXMLInstanceDeleteCmd -- + * + * Called when a parser instance is deleted. + * + * Results: + * None. + * + * Side Effects: + * Memory structures are freed. + * + *---------------------------------------------------------------------------- + */ + +static void +TclXMLInstanceDeleteCmd(clientData) + ClientData clientData; +{ + TclXML_Info *xmlinfo = (TclXML_Info *) clientData; + + Tcl_DecrRefCount(xmlinfo->name); + + if (xmlinfo->cdata) { + Tcl_DecrRefCount(xmlinfo->cdata); + xmlinfo->cdata = NULL; + } + + if (xmlinfo->elementstartcommand) { + Tcl_DecrRefCount(xmlinfo->elementstartcommand); + } + if (xmlinfo->elementendcommand) { + Tcl_DecrRefCount(xmlinfo->elementendcommand); + } + if (xmlinfo->datacommand) { + Tcl_DecrRefCount(xmlinfo->datacommand); + } + if (xmlinfo->picommand) { + Tcl_DecrRefCount(xmlinfo->picommand); + } + if (xmlinfo->entitycommand) { + Tcl_DecrRefCount(xmlinfo->entitycommand); + } + + if (xmlinfo->unknownencodingcommand) { + Tcl_DecrRefCount(xmlinfo->unknownencodingcommand); + } + + if (xmlinfo->commentCommand) { + Tcl_DecrRefCount(xmlinfo->commentCommand); + } + + if (xmlinfo->notStandaloneCommand) { + Tcl_DecrRefCount(xmlinfo->notStandaloneCommand); + } + + if (xmlinfo->elementDeclCommand) { + Tcl_DecrRefCount(xmlinfo->elementDeclCommand); + } + + if (xmlinfo->attlistDeclCommand) { + Tcl_DecrRefCount(xmlinfo->attlistDeclCommand); + } + + if (xmlinfo->startDoctypeDeclCommand) { + Tcl_DecrRefCount(xmlinfo->startDoctypeDeclCommand); + } + + if (xmlinfo->endDoctypeDeclCommand) { + Tcl_DecrRefCount(xmlinfo->endDoctypeDeclCommand); + } + + TclXMLFreeParser(xmlinfo); +} + +/* + *---------------------------------------------------------------------------- + * + * TclXML_Register*Cmd -- + * + * Configures a direct callback handler. + * + * Results: + * None. + * + * Side Effects: + * Parser data structure modified. + * + *---------------------------------------------------------------------------- + */ + +int +TclXML_RegisterElementStartProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_ElementStartProc *callback; +{ + parser->elementstart = callback; + parser->elementstartdata = clientData; + + if (parser->elementstartcommand) { + Tcl_DecrRefCount(parser->elementstartcommand); + parser->elementstartcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterElementEndProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_ElementEndProc *callback; +{ + parser->elementend = callback; + parser->elementenddata = clientData; + + if (parser->elementendcommand) { + Tcl_DecrRefCount(parser->elementendcommand); + parser->elementendcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterCharacterDataProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_CharacterDataProc *callback; +{ + parser->cdatacb = callback; + parser->cdatacbdata = clientData; + + if (parser->datacommand) { + Tcl_DecrRefCount(parser->datacommand); + parser->datacommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterPIProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_PIProc *callback; +{ + parser->pi = callback; + parser->pidata = clientData; + + if (parser->picommand) { + Tcl_DecrRefCount(parser->picommand); + parser->picommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterDefaultProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_DefaultProc *callback; +{ + parser->defaultcb = callback; + parser->defaultdata = clientData; + + if (parser->defaultcommand) { + Tcl_DecrRefCount(parser->defaultcommand); + parser->defaultcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterUnparsedProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_UnparsedProc *callback; +{ + parser->unparsed = callback; + parser->unparseddata = clientData; + + if (parser->unparsedcommand) { + Tcl_DecrRefCount(parser->unparsedcommand); + parser->unparsedcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterNotationDeclProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_NotationDeclProc *callback; +{ + parser->notation = callback; + parser->notationdata = clientData; + + if (parser->notationcommand) { + Tcl_DecrRefCount(parser->notationcommand); + parser->notationcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterEntityProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_EntityProc *callback; +{ + parser->entity = callback; + parser->entitydata = clientData; + + if (parser->entitycommand) { + Tcl_DecrRefCount(parser->entitycommand); + parser->entitycommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterUnknownEncodingProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_UnknownEncodingProc *callback; +{ + parser->unknownencoding = callback; + parser->unknownencodingdata = clientData; + + if (parser->unknownencodingcommand) { + Tcl_DecrRefCount(parser->unknownencodingcommand); + parser->unknownencodingcommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterCommentProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_CommentProc *callback; +{ + parser->comment = callback; + parser->commentdata = clientData; + + if (parser->commentCommand) { + Tcl_DecrRefCount(parser->commentCommand); + parser->commentCommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterNotStandaloneProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_NotStandaloneProc *callback; +{ + parser->notStandalone = callback; + parser->notstandalonedata = clientData; + + if (parser->notStandaloneCommand) { + Tcl_DecrRefCount(parser->notStandaloneCommand); + parser->notStandaloneCommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterElementDeclProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_ElementDeclProc *callback; +{ + parser->elementDecl = callback; + parser->elementdecldata = clientData; + + if (parser->elementDeclCommand) { + Tcl_DecrRefCount(parser->elementDeclCommand); + parser->elementDeclCommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterAttListDeclProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_AttlistDeclProc *callback; +{ + parser->attlistDecl = callback; + parser->attlistdecldata = clientData; + + if (parser->attlistDeclCommand) { + Tcl_DecrRefCount(parser->attlistDeclCommand); + parser->attlistDeclCommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterStartDoctypeDeclProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_StartDoctypeDeclProc *callback; +{ + parser->startDoctypeDecl = callback; + parser->startdoctypedecldata = clientData; + + if (parser->startDoctypeDeclCommand) { + Tcl_DecrRefCount(parser->startDoctypeDeclCommand); + parser->startDoctypeDeclCommand = NULL; + } + + return TCL_OK; +} + +int +TclXML_RegisterEndDoctypeDeclProc(interp, parser, clientData, callback) + Tcl_Interp *interp; + TclXML_Info *parser; + ClientData clientData; + TclXML_EndDoctypeDeclProc *callback; +{ + parser->endDoctypeDecl = callback; + parser->enddoctypedecldata = clientData; + + if (parser->endDoctypeDeclCommand) { + Tcl_DecrRefCount(parser->endDoctypeDeclCommand); + parser->endDoctypeDeclCommand = NULL; + } + + return TCL_OK; +} |