diff options
Diffstat (limited to 'tclxml/tclxml.c')
| -rwxr-xr-x | tclxml/tclxml.c | 3708 |
1 files changed, 0 insertions, 3708 deletions
diff --git a/tclxml/tclxml.c b/tclxml/tclxml.c deleted file mode 100755 index adc2e0f..0000000 --- a/tclxml/tclxml.c +++ /dev/null @@ -1,3708 +0,0 @@ -/* - * 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; -} |