Logo Search packages:      
Sourcecode: tclexpat version File versions

tclexpat.c

/*
 * tclexpat.c --
 *
 *    A Tcl interface to James Clark's expat XML parser
 *
 * Copyright (c) 1998 Steve Ball, Zveno Pty Ltd
 *
 * Zveno Pty Ltd makes this software and associated documentation
 * available free of charge for any purpose.  You may make copies
 * of the software but you must include all of this notice on any copy.
 *
 * Zveno Pty Ltd does not warrant that this software is error free
 * or fit for any purpose.  Zveno Pty Ltd disclaims any liability for
 * all claims, expenses, losses, damages and costs any user may incur
 * as a result of using, copying or modifying the software.
 *
 * $Id: tclexpat.c,v 1.4 1998/08/18 23:59:41 steve Exp $
 *
 */

#include <tcl8.4/tcl.h>
#include "xmlparse.h"

/*
 * The structure below is used to refer to an expat parser object.
 */

typedef struct TclExpatInfo {
  XML_Parser parser;          /* The expat parser structure */
  Tcl_Interp *interp;         /* Interpreter for this instance */
  Tcl_Obj *name;        /* name of this instance */

  int final;                  /* input data complete? */

  int status;                 /* application status */
  Tcl_Obj *result;            /* application return result */

  int continueCount;          /* reference count for continue */

  Tcl_Obj *elementstartcommand;     /* Script for element start */
  Tcl_Obj *elementendcommand; /* Script for element end */
  Tcl_Obj *datacommand;       /* Script for character data */
  Tcl_Obj *picommand;         /* Script for processing instruction */
  Tcl_Obj *defaultcommand;    /* Script for default data */
  Tcl_Obj *unparsedcommand;   /* Script for unparsed entity declaration */
  Tcl_Obj *notationcommand;   /* Script for notation declaration */
  Tcl_Obj *externalentitycommand;   /* Script for external entity */
  Tcl_Obj *unknownencodingcommand;  /* Script for unknown character encoding */

} TclExpatInfo;

/*
 * Prototypes for procedures defined later in this file:
 */

static Tcl_ObjCmdProc TclExpatObjCmd;
static Tcl_ObjCmdProc TclExpatInstanceCmd;
static Tcl_CmdDeleteProc TclExpatDeleteCmd;
static int (TclExpatCreateParser) _ANSI_ARGS_((Tcl_Interp *interp,
                                     TclExpatInfo *expat));
static void (TclExpatFreeParser)  _ANSI_ARGS_((TclExpatInfo *expat));
static int (TclExpatParse) _ANSI_ARGS_((Tcl_Interp *interp, 
                              TclExpatInfo *expat, 
                              char *data, 
                              int len));
static int (TclExpatConfigure) _ANSI_ARGS_((Tcl_Interp *interp,
                                  TclExpatInfo *expat,
                                  int objc,
                                  Tcl_Obj *CONST objv[]));
static int (TclExpatCget) _ANSI_ARGS_((Tcl_Interp *interp,
                               TclExpatInfo *expat,
                               int objc,
                               Tcl_Obj *CONST objv[]));

static void * (TclExpatElementStartHandler) _ANSI_ARGS_((void *userdata,
                                           const XML_Char *name,
                                           const XML_Char **atts));
static void * (TclExpatElementEndHandler) _ANSI_ARGS_((void *userData,
                                           const XML_Char *name));
static void * (TclExpatCharacterDataHandler) _ANSI_ARGS_((void *userData,
                                            const XML_Char *s,
                                            int len));
static void * (TclExpatProcessingInstructionHandler) _ANSI_ARGS_((void *userData,
                                                  const XML_Char *target,
                                                  const XML_Char *data));
static void * (TclExpatExternalEntityRefHandler) _ANSI_ARGS_((XML_Parser parser,
                                                const XML_Char *openEntityNames,
                                                const XML_Char *base,
                                                const XML_Char *systemId,
                                                const XML_Char *publicId));
static void * (TclExpatDefaultHandler) _ANSI_ARGS_ ((void *userData,
                                         const XML_Char *s,
                                         int len));
static void * (TclExpatUnparsedDeclHandler) _ANSI_ARGS_ ((void *userData,
                                            const XML_Char *entityname,
                                            const XML_Char *base,
                                            const XML_Char *systemId,
                                            const XML_Char *publicId,
                                            const XML_Char *notationName));
static void * (TclExpatNotationDeclHandler) _ANSI_ARGS_ ((void *userData,
                                            const XML_Char *notationName,
                                            const XML_Char *base,
                                            const XML_Char *systemId,
                                            const XML_Char *publicId));
static int (TclExpatUnknownEncodingHandler) _ANSI_ARGS_ ((void *encodingHandlerData,
                                           const XML_Char *name,
                                           XML_Encoding *info));

#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.
 *
 *----------------------------------------------------------------------------
 */

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 */

/*
 *----------------------------------------------------------------------------
 *
 * TclExpat_Init --
 *
 *    Initialisation routine for loadable module
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Defines "expat" command in the interpreter.
 *
 *----------------------------------------------------------------------------
 */

int
Tclexpat_Init (interp)
     Tcl_Interp *interp; /* Interpreter to initialise. */
{

  Tcl_PkgProvide(interp, "expat", "1.1");

  Tcl_CreateObjCommand(interp, "expat", TclExpatObjCmd, NULL, NULL);

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatObjCmd --
 *
 *    Creation command for expat class.
 *
 * Results:
 *    The name of the newly created parser instance.
 *
 * Side effects:
 *    This creates an expat parser.
 *
 *----------------------------------------------------------------------------
 */

int
TclExpatObjCmd(dummy, interp, objc, objv)
     ClientData dummy;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
{
  TclExpatInfo *expat;

  if (objc < 2) {
    Tcl_WrongNumArgs(interp, 1, objv, "name ?args?");
    return TCL_ERROR;
  }

  /*
   * Create the data structures for this parser.
   */

  if (!(expat = (TclExpatInfo *) ckalloc(sizeof(TclExpatInfo)))) {
    free(expat);
    Tcl_SetResult(interp, "unable to create parser", NULL);
    return TCL_ERROR;
  }
  expat->interp = interp;
  Tcl_IncrRefCount(objv[1]);
  expat->name = objv[1];

  expat->elementstartcommand = NULL;
  expat->elementendcommand = NULL;
  expat->datacommand = NULL;
  expat->picommand = NULL;
  expat->defaultcommand = NULL;
  expat->unparsedcommand = NULL;
  expat->notationcommand = NULL;
  expat->externalentitycommand = NULL;
  expat->unknownencodingcommand = NULL;

  if (TclExpatCreateParser(interp, expat) != TCL_OK) {
    free(expat);
    return TCL_ERROR;
  }

  /*
   * Register a Tcl command for this parser instance.
   */

  Tcl_CreateObjCommand(interp, Tcl_GetString(expat->name), TclExpatInstanceCmd, (ClientData) expat, TclExpatDeleteCmd);

  /*
   * Handle configuration options
   */

  if (objc > 2) {
    TclExpatConfigure(interp, expat, objc - 2, objv + 2);
  }

  Tcl_SetObjResult(interp, expat->name);

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatCreateParser --
 *
 *    Create the expat parser and initialise (some of) the TclExpatInfo 
 *    structure.
 *
 *    Note that callback commands are not affected by this routine,
 *    to allow a reset to leave these intact.
 *
 * Results:
 *    New parser instance created and initialised.
 *
 * Side effects:
 *    Creates an expat parser.
 *    Modifies TclExpatInfo fields.
 *
 *----------------------------------------------------------------------------
 */

int
TclExpatCreateParser(interp, expat)
     Tcl_Interp *interp;
     TclExpatInfo *expat;
{
  int len;

  if (!(expat->parser = XML_ParserCreate(NULL))) {
    Tcl_SetResult(interp, "unable to create expat parser", NULL);
    return TCL_ERROR;
  }

  expat->final = 1;
  expat->status = TCL_OK;
  expat->result = NULL;
  expat->continueCount = 0;

  /*
   * Set handlers for the parser to routines in this module.
   */

  XML_SetElementHandler(expat->parser,
                  (XML_StartElementHandler) TclExpatElementStartHandler,
                  (XML_EndElementHandler) TclExpatElementEndHandler);
  XML_SetCharacterDataHandler(expat->parser,
                        (XML_CharacterDataHandler) TclExpatCharacterDataHandler);
  XML_SetProcessingInstructionHandler(expat->parser,
                              (XML_ProcessingInstructionHandler) TclExpatProcessingInstructionHandler);
  XML_SetDefaultHandler(expat->parser,
                  (XML_DefaultHandler) TclExpatDefaultHandler);
  XML_SetUnparsedEntityDeclHandler(expat->parser,
                           (XML_UnparsedEntityDeclHandler) TclExpatUnparsedDeclHandler);
  XML_SetNotationDeclHandler(expat->parser,
                       (XML_NotationDeclHandler) TclExpatNotationDeclHandler);
  XML_SetExternalEntityRefHandler(expat->parser,
                          (XML_ExternalEntityRefHandler) TclExpatExternalEntityRefHandler);
  XML_SetUnknownEncodingHandler(expat->parser,
                        (XML_UnknownEncodingHandler) TclExpatUnknownEncodingHandler,
                        (void *) expat);
  XML_SetUserData(expat->parser,
              (void *) expat);

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatFreeParser --
 *
 *    Destroy the expat parser structure.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    Frees any memory allocated for the XML parser.
 *
 *----------------------------------------------------------------------------
 */

void
TclExpatFreeParser(expat)
     TclExpatInfo *expat;
{
  int len;

  XML_ParserFree(expat->parser);
  expat->parser = NULL;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatInstanceCmd --
 *
 *    Implements instance command for expat class objects.
 *
 * Results:
 *    Depends on the method.
 *
 * Side effects:
 *    Depends on the method.
 *
 *----------------------------------------------------------------------------
 */

int
TclExpatInstanceCmd (clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
{
  TclExpatInfo *expat = (TclExpatInfo *) clientData;
  char *method, *data;
  int len, index, result = TCL_OK;
  static char *options[] = {
    "configure", "cget", "parse", "reset", NULL
  };
  enum options {
    EXPAT_CONFIGURE, EXPAT_CGET, EXPAT_PARSE, EXPAT_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 EXPAT_CONFIGURE:

      result = TclExpatConfigure(interp, clientData, objc - 2, objv + 2);
      break;

    case EXPAT_CGET:

      result = TclExpatCget(interp, clientData, objc - 2, objv + 2);
      break;

    case EXPAT_PARSE:

      if (objc != 3) {
      Tcl_WrongNumArgs(interp, 2, objv, "data");
      return TCL_ERROR;
      }

      data = Tcl_GetStringFromObj(objv[2], &len);

      result = TclExpatParse(interp, expat, data, len);

      break;

    case EXPAT_RESET:

      if (objc > 2) {
      Tcl_WrongNumArgs(interp, 1, objv, "");
      return TCL_ERROR;
      }

      /*
       * Destroy the parser and create a fresh one.
       */

      TclExpatFreeParser(expat);
      TclExpatCreateParser(interp, expat);

      break;

    default:

      Tcl_SetResult(interp, "unknown method", NULL);
      return TCL_ERROR;

  }

  return result;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatParse --
 *
 *    Wrapper to invoke expat parser and check return result.
 *
 * Results:
 *     TCL_OK if no errors, TCL_ERROR otherwise.
 *
 * Side effects:
 *     Sets interpreter result as appropriate.
 *
 *----------------------------------------------------------------------------
 */

int
TclExpatParse (interp, expat, data, len)
     Tcl_Interp *interp;
     TclExpatInfo *expat;
     char *data;
     int len;
{
  int result;
  char s[255];

  expat->status = TCL_OK;
  if (expat->result != NULL) {
    Tcl_DecrRefCount(expat->result);
  }
  expat->result = NULL;

  result = XML_Parse(expat->parser, 
                 data, len, 
                 expat->final);

  if (!result) {
    Tcl_ResetResult(interp);
    sprintf(s, "%d", XML_GetCurrentLineNumber(expat->parser));
    Tcl_AppendResult(interp, "error \"", XML_ErrorString(XML_GetErrorCode(expat->parser)),
                 "\" at line ", s, " character ", NULL);
    sprintf(s, "%d", XML_GetCurrentColumnNumber(expat->parser));
    Tcl_AppendResult(interp, s, NULL);

    return TCL_ERROR;
  }

  switch (expat->status) {
    case TCL_OK:
    case TCL_BREAK:
    case TCL_CONTINUE:
      Tcl_ResetResult(interp);
      return TCL_OK;

    case TCL_ERROR:
      Tcl_SetObjResult(interp, expat->result);
      return TCL_ERROR;

    default:
      Tcl_SetResult(interp, "unknown parsing status", NULL);
      return TCL_ERROR;
  }

}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatConfigure --
 *
 *    Implements instance command for expat class objects.
 *
 * Results:
 *    Depends on the method.
 *
 * Side effects:
 *    Depends on the method.
 *
 *----------------------------------------------------------------------------
 */

int
TclExpatConfigure (interp, expat, objc, objv)
     Tcl_Interp *interp;
     TclExpatInfo *expat;
     int objc;
     Tcl_Obj *CONST objv[];
{
  static char *switches[] = {
    "-final",
    "-baseurl", 
    "-elementstartcommand",
    "-elementendcommand",
    "-characterdatacommand",
    "-processinginstructioncommand",
    "-defaultcommand",
    "-unparsedentitydeclcommand",
    "-notationdeclcommand",
    "-externalentitycommand",
    "-unknownencodingcommand",
    (char *) NULL
  };
  enum switches {
    EXPAT_FINAL, EXPAT_BASE, 
    EXPAT_ELEMENTSTARTCMD, EXPAT_ELEMENTENDCMD,
    EXPAT_DATACMD, EXPAT_PICMD, 
    EXPAT_DEFAULTCMD,
    EXPAT_UNPARSEDENTITYCMD, EXPAT_NOTATIONCMD,
    EXPAT_EXTERNALENTITYCMD, EXPAT_UNKNOWNENCODINGCMD
  };
  int index, bool, doParse = 0;
  Tcl_Obj *CONST *objPtr = objv;

  while (objc > 1) {
    if (Tcl_GetIndexFromObj(interp, objPtr[0], switches,
                      "switch", 0, &index) != TCL_OK) {
      return TCL_ERROR;
    }
    switch ((enum switches) index) {
      case EXPAT_FINAL:             /* -final */

      if (Tcl_GetBooleanFromObj(interp, objPtr[1], &bool) != TCL_OK) {
        return TCL_ERROR;
      }

      if (bool && !expat->final) {

        expat->final = bool;
        doParse = 1;

      } else if (!bool && expat->final) {

        /*
         * Reset the parser for new input
         */

        TclExpatFreeParser(expat);
        TclExpatCreateParser(interp, expat);
        doParse = 0;

      }

      break;

      case EXPAT_BASE:              /* -base */

      if (XML_SetBase(expat->parser, Tcl_GetString(objPtr[1])) == 0) {
        Tcl_SetResult(interp, "unable to set base URL", NULL);
        return TCL_ERROR;
      }
      break;

      case EXPAT_ELEMENTSTARTCMD:   /* -elementstartcommand */

      if (expat->elementstartcommand != NULL) {
        Tcl_DecrRefCount(expat->elementstartcommand);
      }

      expat->elementstartcommand = objPtr[1];
      Tcl_IncrRefCount(expat->elementstartcommand);

      break;

      case EXPAT_ELEMENTENDCMD:           /* -elementendcommand */

      if (expat->elementendcommand != NULL) {
        Tcl_DecrRefCount(expat->elementendcommand);
      }

      expat->elementendcommand = objPtr[1];
      Tcl_IncrRefCount(expat->elementendcommand);

      break;

      case EXPAT_DATACMD:           /* -characterdatacommand */

      if (expat->datacommand != NULL) {
        Tcl_DecrRefCount(expat->datacommand);
      }

      expat->datacommand = objPtr[1];
      Tcl_IncrRefCount(expat->datacommand);

      break;

      case EXPAT_PICMD:             /* -processinginstructioncommand */

      if (expat->picommand != NULL) {
        Tcl_DecrRefCount(expat->picommand);
      }

      expat->picommand = objPtr[1];
      Tcl_IncrRefCount(expat->picommand);

      break;

      case EXPAT_DEFAULTCMD:        /* -defaultcommand */

      if (expat->defaultcommand != NULL) {
        Tcl_DecrRefCount(expat->defaultcommand);
      }

      expat->defaultcommand = objPtr[1];
      Tcl_IncrRefCount(expat->defaultcommand);

      break;

      case EXPAT_UNPARSEDENTITYCMD:       /* -unparsedentitydeclcommand */

      if (expat->unparsedcommand != NULL) {
        Tcl_DecrRefCount(expat->unparsedcommand);
      }

      expat->unparsedcommand = objPtr[1];
      Tcl_IncrRefCount(expat->unparsedcommand);

      break;

      case EXPAT_NOTATIONCMD:             /* -notationdeclcommand */

      if (expat->notationcommand != NULL) {
        Tcl_DecrRefCount(expat->notationcommand);
      }

      expat->notationcommand = objPtr[1];
      Tcl_IncrRefCount(expat->notationcommand);

      break;

      case EXPAT_EXTERNALENTITYCMD: /* -externalentitycommand */

      if (expat->externalentitycommand != NULL) {
        Tcl_DecrRefCount(expat->externalentitycommand);
      }

      expat->externalentitycommand = objPtr[1];
      Tcl_IncrRefCount(expat->externalentitycommand);

      break;

      case EXPAT_UNKNOWNENCODINGCMD:            /* -unknownencodingcommand */

      /* Not implemented */
      break;

      if (expat->unknownencodingcommand != NULL) {
        Tcl_DecrRefCount(expat->unknownencodingcommand);
      }

      expat->unknownencodingcommand = objPtr[1];
      Tcl_IncrRefCount(expat->unknownencodingcommand);

      break;

    }

    objPtr += 2;
    objc -= 2;

  }

  if (doParse) {
    return TclExpatParse(interp, expat->parser, "", 0);
  } else {
    return TCL_OK;
  }

}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatCget --
 *
 *    Returns setting of configuration option.
 *    Not yet implemented.
 *
 * Results:
 *    Option value.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------------
 */

int
TclExpatCget (interp, expat, objc, objv)
     Tcl_Interp *interp;
     TclExpatInfo *expat;
     int objc;
     Tcl_Obj *CONST objv[];
{
  Tcl_SetResult(interp, "method not implemented", NULL);
  return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatHandlerResult --
 *
 *    Manage the result of the application callback.
 *
 * Results:
 *    None.
 *
 * Side Effects:
 *    Further invocation of callback scripts may be inhibited.
 *
 *----------------------------------------------------------------------------
 */

void
TclExpatHandlerResult(expat, result)
     TclExpatInfo *expat;
     int result;
{
  switch (result) {
    case TCL_OK:
      expat->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.
       */
      expat->status = TCL_CONTINUE;
      expat->continueCount = 1;
      break;

    case TCL_BREAK:
      /*
       * Skip all further callbacks, but return OK.
       */
      expat->status = TCL_BREAK;
      break;

    case TCL_ERROR:
      /*
       * Skip all further callbacks, and return error.
       */
    default:
      expat->status = TCL_ERROR;
      expat->result = Tcl_GetObjResult(expat->interp);
      Tcl_IncrRefCount(expat->result);
      break;
  }
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatElementStartHandler --
 *
 *    Called by expat for each start tag.
 *
 * Results:
 *    None.
 *
 * Side Effects:
 *    Callback script is invoked.
 *
 *----------------------------------------------------------------------------
 */

static void *
TclExpatElementStartHandler(userData, name, atts)
     void *userData;
     const char *name;
     const char **atts;
{
  TclExpatInfo *expat = (TclExpatInfo *) userData;
  Tcl_Obj *atList, *cmdPtr;
  const char **atPtr;
  int result;

  if (expat->status == TCL_CONTINUE) {

    /*
     * We're currently skipping elements looking for the 
     * close of the continued element.
     */

    expat->continueCount++;
    return;
  }

  if (expat->elementstartcommand == NULL || 
      expat->status != TCL_OK) {
    return;
  }

  /*
   * Convert the attribute list into a Tcl key-value paired list.
   */

  atList = Tcl_NewListObj(0, NULL);
  for (atPtr = atts; atPtr[0] && atPtr[1]; atPtr += 2) {
    Tcl_ListObjAppendElement(expat->interp, atList, Tcl_NewStringObj((char *)atPtr[0], strlen(atPtr[0])));
    Tcl_ListObjAppendElement(expat->interp, atList, Tcl_NewStringObj((char *)atPtr[1], strlen(atPtr[1])));
  }

  /*
   * Take a copy of the callback script so that arguments may be appended.
   */

  cmdPtr = Tcl_DuplicateObj(expat->elementstartcommand);
  Tcl_IncrRefCount(cmdPtr);
  Tcl_Preserve((ClientData) expat->interp);

  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)name, strlen(name)));
  Tcl_ListObjAppendElement(expat->interp, cmdPtr, atList);

  /*
   * It would be desirable to be able to terminate parsing
   * if the return result is TCL_ERROR or TCL_BREAK.
   */
#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0)
  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
#else
  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
#endif /* TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION */

  Tcl_DecrRefCount(cmdPtr);
  Tcl_Release((ClientData) expat->interp);

  TclExpatHandlerResult(expat, result);

  return;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatElementEndHandler --
 *
 *    Called by expat for each end tag.
 *
 * Results:
 *    None.
 *
 * Side Effects:
 *    Callback script is invoked.
 *
 *----------------------------------------------------------------------------
 */

static void *
TclExpatElementEndHandler(userData, name)
     void *userData;
     CONST char *name;
{
  TclExpatInfo *expat = (TclExpatInfo *) userData;
  Tcl_Obj *cmdPtr;
  int result;

  if (expat->status == TCL_CONTINUE) {
    /*
     * We're currently skipping elements looking for the
     * end of the currently open element.
     */

    if (!--(expat->continueCount)) {
      expat->status = TCL_OK;
      return;
    }
  }

  if (expat->elementendcommand == NULL ||
      expat->status != TCL_OK) {
    return;
  }

  /*
   * Take a copy of the callback script so that arguments may be appended.
   */

  cmdPtr = Tcl_DuplicateObj(expat->elementendcommand);
  Tcl_IncrRefCount(cmdPtr);
  Tcl_Preserve((ClientData) expat->interp);

  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)name, strlen(name)));

  /*
   * It would be desirable to be able to terminate parsing
   * if the return result is TCL_ERROR or TCL_BREAK.
   */
#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0)
  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
#else
  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION */

  Tcl_DecrRefCount(cmdPtr);
  Tcl_Release((ClientData) expat->interp);

  TclExpatHandlerResult(expat, result);

  return;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatCharacterDataHandler --
 *
 *    Called by expat for character data.
 *
 * Results:
 *    None.
 *
 * Side Effects:
 *    Callback script is invoked.
 *
 *----------------------------------------------------------------------------
 */

static void *
TclExpatCharacterDataHandler(userData, s, len)
     void *userData;
     CONST char *s;
     int len;
{
  TclExpatInfo *expat = (TclExpatInfo *) userData;
  Tcl_Obj *cmdPtr;
  int result;

  if (expat->datacommand == NULL ||
      expat->status != TCL_OK) {
    return;
  }

  /*
   * Take a copy of the callback script so that arguments may be appended.
   */

  cmdPtr = Tcl_DuplicateObj(expat->datacommand);
  Tcl_IncrRefCount(cmdPtr);
  Tcl_Preserve((ClientData) expat->interp);

  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)s, len));

  /*
   * It would be desirable to be able to terminate parsing
   * if the return result is TCL_ERROR or TCL_BREAK.
   */
#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0)
  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
#else
  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION */

  Tcl_DecrRefCount(cmdPtr);
  Tcl_Release((ClientData) expat->interp);

  TclExpatHandlerResult(expat, result);

  return;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatProcessingInstructionHandler --
 *
 *    Called by expat for processing instructions.
 *
 * Results:
 *    None.
 *
 * Side Effects:
 *    Callback script is invoked.
 *
 *----------------------------------------------------------------------------
 */

static void *
TclExpatProcessingInstructionHandler(userData, target, data)
     void *userData;
     CONST char *target;
     CONST char *data;
{
  TclExpatInfo *expat = (TclExpatInfo *) userData;
  Tcl_Obj *cmdPtr;
  int result;

  if (expat->picommand == NULL ||
      expat->status != TCL_OK) {
    return;
  }

  /*
   * Take a copy of the callback script so that arguments may be appended.
   */

  cmdPtr = Tcl_DuplicateObj(expat->picommand);
  Tcl_IncrRefCount(cmdPtr);
  Tcl_Preserve((ClientData) expat->interp);

  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)target, strlen(target)));
  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)data, strlen(data)));

  /*
   * It would be desirable to be able to terminate parsing
   * if the return result is TCL_ERROR or TCL_BREAK.
   */
#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0)
  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
#else
  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION */

  Tcl_DecrRefCount(cmdPtr);
  Tcl_Release((ClientData) expat->interp);

  TclExpatHandlerResult(expat, result);

  return;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatDefaultHandler --
 *
 *    Called by expat for processing data which has no other handler.
 *
 * Results:
 *    None.
 *
 * Side Effects:
 *    Callback script is invoked.
 *
 *----------------------------------------------------------------------------
 */

static void *
TclExpatDefaultHandler(userData, s, len)
     void *userData;
     CONST char *s;
     int len;
{
  TclExpatInfo *expat = (TclExpatInfo *) userData;
  Tcl_Obj *cmdPtr;
  int result;

  if (expat->defaultcommand == NULL ||
      expat->status != TCL_OK) {
    return;
  }

  /*
   * Take a copy of the callback script so that arguments may be appended.
   */

  cmdPtr = Tcl_DuplicateObj(expat->defaultcommand);
  Tcl_IncrRefCount(cmdPtr);
  Tcl_Preserve((ClientData) expat->interp);

  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)s, len));

  /*
   * It would be desirable to be able to terminate parsing
   * if the return result is TCL_ERROR or TCL_BREAK.
   */
#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0)
  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
#else
  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION */

  Tcl_DecrRefCount(cmdPtr);
  Tcl_Release((ClientData) expat->interp);

  TclExpatHandlerResult(expat, result);

  return;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatUnparsedDeclHandler --
 *
 *    Called by expat for processing an unparsed entity references.
 *
 * Results:
 *    None.
 *
 * Side Effects:
 *    Callback script is invoked.
 *
 *----------------------------------------------------------------------------
 */

static void *
TclExpatUnparsedDeclHandler(userData, entityname, base, systemId, publicId, notationName)
     void *userData;
     CONST char *entityname;
     CONST char *base;
     CONST char *systemId;
     CONST char *publicId;
     CONST char *notationName;
{
  TclExpatInfo *expat = (TclExpatInfo *) userData;
  Tcl_Obj *cmdPtr;
  int result;

  if (expat->unparsedcommand == NULL ||
      expat->status != TCL_OK) {
    return;
  }

  /*
   * Take a copy of the callback script so that arguments may be appended.
   */

  cmdPtr = Tcl_DuplicateObj(expat->unparsedcommand);
  Tcl_IncrRefCount(cmdPtr);
  Tcl_Preserve((ClientData) expat->interp);

  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)entityname, strlen(entityname)));
  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)base, strlen(base)));
  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)systemId, strlen(systemId)));
  if (publicId == NULL) {
    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL));
  } else {
    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)publicId, strlen(publicId)));
  }
  if (notationName == NULL) {
    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL));
  } else {
    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)notationName, strlen(notationName)));
  }

  /*
   * It would be desirable to be able to terminate parsing
   * if the return result is TCL_ERROR or TCL_BREAK.
   */
#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0)
  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
#else
  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION */

  Tcl_DecrRefCount(cmdPtr);
  Tcl_Release((ClientData) expat->interp);

  TclExpatHandlerResult(expat, result);

  return;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatNotationDeclHandler --
 *
 *    Called by expat for processing a notation declaration.
 *
 * Results:
 *    None.
 *
 * Side Effects:
 *    Callback script is invoked.
 *
 *----------------------------------------------------------------------------
 */

static void *
TclExpatNotationDeclHandler(userData, notationName, base, systemId, publicId)
     void *userData;
     CONST char *notationName;
     CONST char *base;
     CONST char *systemId;
     CONST char *publicId;
{
  TclExpatInfo *expat = (TclExpatInfo *) userData;
  Tcl_Obj *cmdPtr;
  int result;

  if (expat->notationcommand == NULL ||
      expat->status != TCL_OK) {
    return;
  }

  /*
   * Take a copy of the callback script so that arguments may be appended.
   */

  cmdPtr = Tcl_DuplicateObj(expat->notationcommand);
  Tcl_IncrRefCount(cmdPtr);
  Tcl_Preserve((ClientData) expat->interp);

  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)notationName, strlen(notationName)));
  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)base, strlen(base)));
  if (systemId == NULL) {
    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL));
  } else {
    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)systemId, strlen(systemId)));
  }
  if (publicId == NULL) {
    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewListObj(0, NULL));
  } else {
    Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)publicId, strlen(publicId)));
  }

  /*
   * It would be desirable to be able to terminate parsing
   * if the return result is TCL_ERROR or TCL_BREAK.
   */
#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0)
  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
#else
  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION */

  Tcl_DecrRefCount(cmdPtr);
  Tcl_Release((ClientData) expat->interp);

  TclExpatHandlerResult(expat, result);

  return;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatUnknownEncodingHandler --
 *
 *    Called by expat for processing a reference to a character in an 
 *    unknown encoding.
 *
 * Results:
 *    None.
 *
 * Side Effects:
 *    Callback script is invoked.
 *
 *----------------------------------------------------------------------------
 */

static int
TclExpatUnknownEncodingHandler(encodingHandlerData, name, info)
     void *encodingHandlerData;
     CONST char *name;
     XML_Encoding *info;
{
  TclExpatInfo *expat = (TclExpatInfo *) encodingHandlerData;
  Tcl_Obj *cmdPtr;
  int result;

  Tcl_SetResult(expat->interp, "not implemented", NULL);
  return 0;

  if (expat->unknownencodingcommand == NULL ||
      expat->status != TCL_OK) {
    return;
  }

  /*
   * Take a copy of the callback script so that arguments may be appended.
   */

  cmdPtr = Tcl_DuplicateObj(expat->unknownencodingcommand);
  Tcl_IncrRefCount(cmdPtr);
  Tcl_Preserve((ClientData) expat->interp);

  /*
   * Setup the arguments
   */

  /*
   * It would be desirable to be able to terminate parsing
   * if the return result is TCL_ERROR or TCL_BREAK.
   */
#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0)
  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
#else
  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION */

  Tcl_DecrRefCount(cmdPtr);
  Tcl_Release((ClientData) expat->interp);

  TclExpatHandlerResult(expat, result);

  return;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatExternalEntityRefHandler --
 *
 *    Called by expat for processing external entity references.
 *
 * Results:
 *    None.
 *
 * Side Effects:
 *    Callback script is invoked.
 *
 *----------------------------------------------------------------------------
 */

static void *
TclExpatExternalEntityRefHandler(parser, openEntityNames, base, systemId, publicId)
     XML_Parser parser;
     CONST char *openEntityNames;
     CONST char *base;
     CONST char *systemId;
     CONST char *publicId;
{
  TclExpatInfo *expat = (TclExpatInfo *) XML_GetUserData(parser);
  Tcl_Obj *cmdPtr;
  int result;

  if (expat->externalentitycommand == NULL ||
      expat->status != TCL_OK) {
    return;
  }

  /*
   * Take a copy of the callback script so that arguments may be appended.
   */

  cmdPtr = Tcl_DuplicateObj(expat->externalentitycommand);
  Tcl_IncrRefCount(cmdPtr);
  Tcl_Preserve((ClientData) expat->interp);

  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)openEntityNames, strlen(openEntityNames)));
  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)base, strlen(base)));
  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)systemId, strlen(systemId)));
  Tcl_ListObjAppendElement(expat->interp, cmdPtr, Tcl_NewStringObj((char *)publicId, strlen(publicId)));

  /*
   * It would be desirable to be able to terminate parsing
   * if the return result is TCL_ERROR or TCL_BREAK.
   */
#if (TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0)
  result = Tcl_GlobalEvalObj(expat->interp, cmdPtr);
#else
  result = Tcl_EvalObjEx(expat->interp, cmdPtr, TCL_EVAL_GLOBAL);
#endif /* if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION */

  Tcl_DecrRefCount(cmdPtr);
  Tcl_Release((ClientData) expat->interp);

  TclExpatHandlerResult(expat, result);

  return;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclExpatDeleteCmd --
 *
 *    Called when a expat parser is deleted.
 *
 * Results:
 *    None.
 *
 * Side Effects:
 *    Memory structures are freed.
 *
 *----------------------------------------------------------------------------
 */

static void
TclExpatDeleteCmd(clientData)
     ClientData clientData;
{
  TclExpatInfo *expat = (TclExpatInfo *) clientData;

  TclExpatFreeParser(expat);

  Tcl_DecrRefCount(expat->name);

  if (expat->elementstartcommand) {
    Tcl_DecrRefCount(expat->elementstartcommand);
  }
  if (expat->elementendcommand) {
    Tcl_DecrRefCount(expat->elementendcommand);
  }
  if (expat->datacommand) {
    Tcl_DecrRefCount(expat->datacommand);
  }
  if (expat->picommand) {
    Tcl_DecrRefCount(expat->picommand);
  }
  if (expat->externalentitycommand) {
    Tcl_DecrRefCount(expat->externalentitycommand);
  }
}

Generated by  Doxygen 1.6.0   Back to index