/*
 * tclxslt.c --
 *
 *  Interface to Gnome libxslt.
 *
 * Copyright (c) 2005-2009 Explain
 * http://www.explain.com.au/
 * Copyright (c) 2001-2004 Zveno Pty Ltd
 * http://www.zveno.com/
 *
 * See the file "LICENSE" for information on usage and
 * redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * $Id: tclxslt.c,v 1.30.2.2 2005/12/30 02:40:41 balls Exp $
 *
 */

#include <tclxslt/tclxslt.h>
#include <string.h>
#include <libxml/parserInternals.h>
#include <libxslt/namespaces.h>
#include <libxslt/imports.h>
#include <libxslt/security.h>
#include <libxslt/preproc.h>
#include <libxslt/variables.h>
#include <libxslt/templates.h>

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT

/*#ifdef __WIN32__
 *#     include "win/win32config.h"
#endif
*/

/*
 * Manage stylesheet objects
 */

typedef struct TclXSLT_Stylesheet {
  Tcl_Interp *interp;
  char *name;
  xsltStylesheetPtr stylesheet;
  Tcl_HashEntry *entryPtr;

  Tcl_Obj *resulturi;
  Tcl_Obj *profilechannelObj;

  Tcl_Obj *messagecommand;
} TclXSLT_Stylesheet;

/*
 * Extension management
 */

typedef struct TclXSLT_Extension {
  Tcl_Interp *interp;
  Tcl_Obj *nsuri;
  Tcl_Obj *tclns;
  xsltTransformContextPtr xformCtxt;
} TclXSLT_Extension;

typedef struct ThreadSpecificData {
  int initialised;
  Tcl_Interp *interp;
  int ssheetCntr;
  Tcl_HashTable *stylesheets;
  Tcl_HashTable *extensions;
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

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

/*
 * Forward declarations for private functions.
 */

static void TclXSLTGenericError _ANSI_ARGS_((void *ctx, const char *msg, ...));

static int TclXSLTCompileCommand _ANSI_ARGS_((ClientData dummy,
						Tcl_Interp *interp,
						int objc,
						Tcl_Obj *CONST objv[]));
static int TclXSLTInstanceCommand _ANSI_ARGS_((ClientData ssheet,
						Tcl_Interp *interp,
						int objc,
						Tcl_Obj *CONST objv[]));
static void TclXSLTDeleteStylesheet _ANSI_ARGS_((ClientData ssheet));
static int TclXSLTExtensionCommand _ANSI_ARGS_((ClientData dummy,
						Tcl_Interp *interp,
						int objc,
						Tcl_Obj *CONST objv[]));

static Tcl_Obj * GetParameters _ANSI_ARGS_((Tcl_Interp *interp,
					    xsltStylesheetPtr stylesheet));
static int TclXSLTTransform _ANSI_ARGS_((TclXSLT_Stylesheet *stylesheet,
                                         Tcl_Obj *source,
                                         int paramc,
                                         Tcl_Obj *CONST paramv[]));

static void TclXSLT_RegisterAll _ANSI_ARGS_((TclXSLT_Extension *extinfo,
						const xmlChar *nsuri));

/* static xsltExtInitFunction TclXSLTExtInit; */
static void *TclXSLTExtInit _ANSI_ARGS_((xsltTransformContextPtr ctxt,
					const xmlChar *URI));
/* static xsltExtShutdownFunction TclXSLTExtShutdown; */
static void TclXSLTExtShutdown _ANSI_ARGS_((xsltTransformContextPtr ctxt,
					    const xmlChar *URI,
					    void *userdata));
/* static xmlXPathEvalFunc TclXSLTExtFunction; */
static void TclXSLTExtFunction _ANSI_ARGS_((xmlXPathParserContextPtr xpathCtxt,
					    int nargs));
/* static xsltPreComputeFunction TclXSLTExtElementPreComp; */
static xsltElemPreCompPtr TclXSLTExtElementPreComp _ANSI_ARGS_((xsltStylesheetPtr style,
								xmlNodePtr inst,
								xsltTransformFunction function));
/* static xsltTransformFunction TclXSLTExtElementTransform; */
static void TclXSLTExtElementTransform _ANSI_ARGS_((xsltTransformContextPtr ctxt,
					            xmlNodePtr node,
					            xmlNodePtr inst,
					            xsltStylePreCompPtr comp));
/* static xsltSecurityCheck TclXSLTSecurityReadFile; */
static int TclXSLTSecurityReadFile _ANSI_ARGS_((xsltSecurityPrefsPtr sec,
						xsltTransformContextPtr ctxt,
						const char *value));
/* static xsltSecurityCheck TclXSLTSecurityWriteFile; */
static int TclXSLTSecurityWriteFile _ANSI_ARGS_((xsltSecurityPrefsPtr sec,
						 xsltTransformContextPtr ctxt,
						 const char *value));
/* static xsltSecurityCheck TclXSLTSecurityCreateDirectory; */
static int TclXSLTSecurityCreateDirectory _ANSI_ARGS_((xsltSecurityPrefsPtr sec,
						       xsltTransformContextPtr ctxt,
						       const char *value));
/* static xsltSecurityCheck TclXSLTSecurityReadNetwork; */
static int TclXSLTSecurityReadNetwork _ANSI_ARGS_((xsltSecurityPrefsPtr sec,
						   xsltTransformContextPtr ctxt,
						   const char *value));
/* static xsltSecurityCheck TclXSLTSecurityWriteNetwork; */
static int TclXSLTSecurityWriteNetwork _ANSI_ARGS_((xsltSecurityPrefsPtr sec,
						    xsltTransformContextPtr ctxt,
						    const char *value));

static Tcl_Obj * TclXSLT_ConvertXPathObjToTclObj _ANSI_ARGS_((Tcl_Interp *interp,
                                                              xmlXPathObjectPtr xpobj));
static xmlXPathObjectPtr TclXSLT_ConvertTclObjToXPathObj _ANSI_ARGS_((Tcl_Interp *interp,
                                                              Tcl_Obj *objPtr));

/* Copied from libxslt-1.1.24 transform.c */

static void
xsltApplySequenceConstructor(xsltTransformContextPtr ctxt,
			     xmlNodePtr contextNode, xmlNodePtr list,
			     xsltTemplatePtr templ);

/*
 * Error context for passing error result back to caller.
 */

typedef struct GenericError_Info {
  Tcl_Interp *interp;
  TclXSLT_Stylesheet *stylesheet;
  int code;
  Tcl_Obj *msg;
} GenericError_Info;

/*
 * Switch tables
 */

#ifndef CONST84
#define CONST84 /* Before 8.4 no 'const' required */
#endif

static CONST84 char *instanceCommandMethods[] = {
  "cget",
  "configure",
  "get",
  "transform",
  (char *) NULL
};
enum instanceCommandMethods {
  TCLXSLT_CGET,
  TCLXSLT_CONFIGURE,
  TCLXSLT_GET,
  TCLXSLT_TRANSFORM
};
static CONST84 char *instanceCommandOptions[] = {
  "-messagecommand",
  "-method",
  "-indent",
  "-resulturi",
  "-profilechannel",
  "-encoding",
  "-omitxmldeclaration",
  (char *) NULL
};
enum instanceCommandOptions {
  TCLXSLT_OPTION_MESSAGECOMMAND,
  TCLXSLT_OPTION_METHOD,
  TCLXSLT_OPTION_INDENT,
  TCLXSLT_OPTION_RESULTURI,
  TCLXSLT_OPTION_PROFILECHANNEL,
  TCLXSLT_OPTION_ENCODING,
  TCLXSLT_OPTION_OMITXMLDECLARATION
};

static CONST84 char *instanceGetMethods[] = {
  "parameters",
  (char *) NULL
};
enum instanceGetMethods {
  TCLXSLT_GET_PARAMETERS
};

static CONST84 char *extensionCommandMethods[] = {
  "add",
  "remove",
  (char *) NULL
};
enum extensionCommandMethods {
  TCLXSLT_EXT_ADD,
  TCLXSLT_EXT_REMOVE
};

/*
 * libxml2 and libxslt are mostly thread-safe,
 * but there are issues with error callbacks.
 */

TCL_DECLARE_MUTEX(libxslt)

/*
 *----------------------------------------------------------------------------
 *
 * Tclxslt_libxslt_Init --
 *
 *  Initialisation routine for loadable module
 *
 * Results:
 *  None.
 *
 * Side effects:
 *  Creates commands in the interpreter,
 *
 *----------------------------------------------------------------------------
 */

int
Tclxslt_libxslt_Init (interp)
     Tcl_Interp *interp;	/* Interpreter to initialise */
{
  ThreadSpecificData *tsdPtr;
  xsltSecurityPrefsPtr sec;

  tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
  if (!tsdPtr->initialised) {
    tsdPtr->initialised = 1;
    tsdPtr->interp = interp;
    tsdPtr->ssheetCntr = 0;
    tsdPtr->stylesheets = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(tsdPtr->stylesheets, TCL_ONE_WORD_KEYS);
    tsdPtr->extensions = (Tcl_HashTable *) Tcl_Alloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(tsdPtr->extensions, TCL_STRING_KEYS);
  } /* only need to init the library once per process */

  Tcl_CreateObjCommand(interp, "xslt::compile", TclXSLTCompileCommand, NULL, NULL);
  Tcl_CreateObjCommand(interp, "xslt::extension", TclXSLTExtensionCommand, NULL, NULL);

  Tcl_MutexLock(&libxslt);
#ifndef TCLXML_STATIC_TCLXSLT
  exsltRegisterAll();
#endif /* TCLXML_STATIC_TCLXSLT */

  /*
   * Setup security preferences
   */
  sec = xsltNewSecurityPrefs();
  if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_READ_FILE,
			   TclXSLTSecurityReadFile)) {
    Tcl_SetResult(interp, "unable to set readfile security", NULL);
    return TCL_ERROR;
  }
  if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_WRITE_FILE,
			   TclXSLTSecurityWriteFile)) {
    Tcl_SetResult(interp, "unable to set writefile security", NULL);
    return TCL_ERROR;
  }
  if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_CREATE_DIRECTORY,
			   TclXSLTSecurityCreateDirectory)) {
    Tcl_SetResult(interp, "unable to set createdirectory security", NULL);
    return TCL_ERROR;
  }
  if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_READ_NETWORK,
			   TclXSLTSecurityReadNetwork)) {
    Tcl_SetResult(interp, "unable to set readnetwork security", NULL);
    return TCL_ERROR;
  }
  if (xsltSetSecurityPrefs(sec, XSLT_SECPREF_WRITE_NETWORK,
			   TclXSLTSecurityWriteNetwork)) {
    Tcl_SetResult(interp, "unable to set writenetwork security", NULL);
    return TCL_ERROR;
  }
  /* xsltSetCtxtSecurityPrefs(sec, userCtxt); */
  xsltSetDefaultSecurityPrefs(sec);

  Tcl_MutexUnlock(&libxslt);

  Tcl_SetVar2Ex(interp, "::xslt::libxsltversion", NULL, Tcl_NewStringObj(xsltEngineVersion, -1), 0);
  Tcl_SetVar2Ex(interp, "::xslt::libexsltversion", NULL, Tcl_NewStringObj(exsltLibraryVersion, -1), 0);

  return TCL_OK;
}

/*
 * XSLT is not safe due to the document(), xsl:include and xsl:import functions/elements.
 * However, libxslt checks whether access is permitted to external resources.
 *
 * NOTE: need to make sure decision to allow access to resources is made by a trusted interpreter, not the untrusted slave.  Even better, use a mechanism similar to TclXML/libxml2 to access external resources.
 */

int
Tclxslt_libxslt_SafeInit (interp)
     Tcl_Interp *interp;	/* Interpreter to initialise */
{
  return Tclxslt_libxslt_Init(interp);
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTCompileCommand --
 *
 *  Class creation command for xslt stylesheet objects.
 *
 * Results:
 *  Compiles the XSLT stylesheet.
 *  Creates a Tcl command associated with that stylesheet.
 *
 * Side effects:
 *  Memory allocated, stylesheet is compiled.
 *
 *----------------------------------------------------------------------------
 */

static int
TclXSLTCompileCommand(dummy, interp, objc, objv)
     ClientData dummy;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
{
  ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
  TclXSLT_Stylesheet *info;
  xmlDocPtr origDoc, doc;
  xsltStylesheetPtr ssheetPtr = NULL;
  void *oldxsltErrorCtx, *oldxmlErrorCtx;
  xmlGenericErrorFunc old_xsltGenericError, old_xmlGenericError;
  GenericError_Info *errorInfoPtr;
  Tcl_Obj *errObjPtr = NULL;
  int new;

  if (objc != 2) {
    Tcl_WrongNumArgs(interp, 1, objv, "stylesheet-doc");
    return TCL_ERROR;
  }

  if (TclXML_libxml2_GetDocFromObj(interp, objv[1], &origDoc) != TCL_OK) {
    return TCL_ERROR;
  }

  Tcl_MutexLock(&libxslt);
  doc = xmlCopyDoc(origDoc, 1);
  /*
   * xmlCopyDoc doesn't copy some of the fields.
   */
  if (origDoc->URL) {
    doc->URL = (const xmlChar *) xmlMalloc(strlen((char *) origDoc->URL) + 1);
    strcpy((char *) doc->URL, (char *) origDoc->URL);
  }

  /*
   * Prepare for compiling stylesheet
   */

  TclXML_libxml2_ResetError(interp);

  errorInfoPtr = (GenericError_Info *) Tcl_Alloc(sizeof(GenericError_Info));
  errorInfoPtr->interp = interp;
  errorInfoPtr->stylesheet = NULL;
  errorInfoPtr->code = TCL_OK;
  errorInfoPtr->msg = NULL;
  xmlSetGenericErrorFunc((void *) errorInfoPtr,
			 TclXSLTGenericError);

  /*
   * Save the previous error context so that it can
   * be restored upon completion of the operation.
   */
  old_xsltGenericError = xsltGenericError;
  oldxsltErrorCtx = xsltGenericErrorContext;
  old_xmlGenericError = xmlGenericError;
  oldxmlErrorCtx = xmlGenericErrorContext;

  xmlSetGenericErrorFunc((void *) errorInfoPtr,
			 TclXSLTGenericError);
  xsltSetGenericErrorFunc((void *) errorInfoPtr, TclXSLTGenericError);

  /*
   * Compile stylesheet
   */

  ssheetPtr = xsltParseStylesheetDoc(doc);

  xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError);
  xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError);

  Tcl_MutexUnlock(&libxslt);

  errObjPtr = TclXML_libxml2_GetErrorObj(interp);

  if (ssheetPtr == NULL) {
    Tcl_SetResult(interp, "error compiling stylesheet", NULL);
    goto error;
  }

  if (ssheetPtr->errors > 0) {
    Tcl_SetResult(interp, "error compiling XSLT stylesheet", NULL);
    goto error;
  }

  if (errorInfoPtr->code != TCL_OK) {
    goto error;
  }

  /* TODO: notify app of any warnings */

  info = (TclXSLT_Stylesheet *) Tcl_Alloc(sizeof(TclXSLT_Stylesheet));
  info->interp = interp;
  info->name = Tcl_Alloc(20);
  sprintf(info->name, "style%d", tsdPtr->ssheetCntr++);
  info->stylesheet = ssheetPtr;
  info->messagecommand = NULL;
  info->resulturi = NULL;
  info->profilechannelObj = NULL;

  /*
   * Create reverse mapping of stylesheet to name of stylesheet command.
   */
  info->entryPtr = Tcl_CreateHashEntry(tsdPtr->stylesheets, (ClientData) ssheetPtr, &new);
  /* sanity check: new == 1 */
  Tcl_SetHashValue(info->entryPtr, (ClientData) info->name);

  Tcl_CreateObjCommand(interp, info->name, TclXSLTInstanceCommand, (ClientData) info, TclXSLTDeleteStylesheet);

  Tcl_SetObjResult(interp, Tcl_NewStringObj(info->name, -1));

  return TCL_OK;

error:

  if (errObjPtr) {
    Tcl_SetObjResult(interp, errObjPtr);
  } else if (errorInfoPtr->msg) {
    Tcl_SetObjResult(interp, errorInfoPtr->msg);
    Tcl_DecrRefCount(errorInfoPtr->msg);
  }
  Tcl_Free((char *) errorInfoPtr);

  Tcl_MutexLock(&libxslt);
  if (ssheetPtr) {
    xsltFreeStylesheet(ssheetPtr);
  } else {
    xmlFreeDoc(doc);
  }
  Tcl_MutexUnlock(&libxslt);
  
  return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTDeleteStylesheet --
 *
 *  Class destruction command for xslt stylesheet objects.
 *
 * Results:
 *  Frees memory associated with a stylesheet.
 *
 * Side effects:
 *  Memory deallocated.
 *
 *----------------------------------------------------------------------------
 */

static void
TclXSLTDeleteStylesheet(clientData)
     ClientData clientData;
{
  TclXSLT_Stylesheet *ssheet = (TclXSLT_Stylesheet *) clientData;

  Tcl_DeleteHashEntry(ssheet->entryPtr);
  
  Tcl_Free(ssheet->name);
  if (ssheet->messagecommand) {
    Tcl_DecrRefCount(ssheet->messagecommand);
  }
  if (ssheet->resulturi) {
    Tcl_DecrRefCount(ssheet->resulturi);
  }
  if (ssheet->profilechannelObj) {
    Tcl_DecrRefCount(ssheet->profilechannelObj);
  }
  Tcl_MutexLock(&libxslt);
  xsltFreeStylesheet(ssheet->stylesheet); /* Also frees document */
  Tcl_MutexUnlock(&libxslt);
  Tcl_Free((char *) ssheet);
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTInstanceCommand --
 *
 *  Handles the stylesheet object command.
 *
 * Results:
 *  Depends on method.
 *
 * Side effects:
 *  Depends on method.
 *
 *----------------------------------------------------------------------------
 */

static int
TclXSLTInstanceCommand(clientData, interp, objc, objv)
     ClientData clientData;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
{
  TclXSLT_Stylesheet *ssheet = (TclXSLT_Stylesheet *) clientData;
  int method, option, indent = 0, theOmitXMLDeclaration = 0;
  const xmlChar *theMethod, *theEncoding;

  if (objc < 3) {
    Tcl_WrongNumArgs(interp, 1, objv, "method ?args ...?");
    return TCL_ERROR;
  }

  if (Tcl_GetIndexFromObj(interp, objv[1], instanceCommandMethods, 
			    "method", 0, &method) != TCL_OK) {
    return TCL_ERROR;
  }

  switch ((enum instanceCommandMethods) method) {
  case TCLXSLT_CGET:

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

    if (Tcl_GetIndexFromObj(interp, objv[2], instanceCommandOptions, 
			    "option", 0, &option) != TCL_OK) {
      return TCL_ERROR;
    }

    switch ((enum instanceCommandOptions) option) {

    case TCLXSLT_OPTION_METHOD:
      XSLT_GET_IMPORT_PTR(theMethod, ssheet->stylesheet, method);
      if (theMethod != NULL) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) theMethod, -1));
      } /* theMethod == NULL means XML method; result should be empty.
	   EXCEPTION: if the result document is of type XML_HTML_DOCUMENT_NODE
	   then the method should be "html".
	 */
      break;

    case TCLXSLT_OPTION_ENCODING:
      XSLT_GET_IMPORT_PTR(theEncoding, ssheet->stylesheet, encoding);
      if (theEncoding != NULL) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj((CONST char *) theEncoding, -1));
      } /* theEncoding == NULL means default (UTF-8) encoding; result should be empty.
	 */
      break;

    case TCLXSLT_OPTION_OMITXMLDECLARATION:
      XSLT_GET_IMPORT_INT(theOmitXMLDeclaration, ssheet->stylesheet, omitXmlDeclaration);
      Tcl_SetObjResult(interp, Tcl_NewBooleanObj(theOmitXMLDeclaration == 1));
      break;

    case TCLXSLT_OPTION_INDENT:
      XSLT_GET_IMPORT_INT(indent, ssheet->stylesheet, indent);
      Tcl_SetObjResult(interp, Tcl_NewBooleanObj(indent));
      break;

    case TCLXSLT_OPTION_MESSAGECOMMAND:
      if (ssheet->messagecommand != NULL) {
        Tcl_SetObjResult(interp, ssheet->messagecommand);
      }
      break;

    case TCLXSLT_OPTION_RESULTURI:
      if (ssheet->resulturi != NULL) {
        Tcl_SetObjResult(interp, ssheet->resulturi);
      }
      break;

    case TCLXSLT_OPTION_PROFILECHANNEL:
      if (ssheet->profilechannelObj != NULL) {
        Tcl_SetObjResult(interp, ssheet->profilechannelObj);
      }
      break;

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

    break;

  case TCLXSLT_CONFIGURE:
    
    if (objc != 4) {
      Tcl_WrongNumArgs(interp, 2, objv, "option value");
      return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[2], instanceCommandOptions, 
			    "option", 0, &option) != TCL_OK) {
      return TCL_ERROR;
    }

    switch ((enum instanceCommandOptions) option) {

    case TCLXSLT_OPTION_METHOD:
    case TCLXSLT_OPTION_INDENT:
    case TCLXSLT_OPTION_ENCODING:
    case TCLXSLT_OPTION_OMITXMLDECLARATION:
      Tcl_SetResult(interp, "read-only option", NULL);
      return TCL_ERROR;
      break;

    case TCLXSLT_OPTION_MESSAGECOMMAND:
      if (ssheet->messagecommand != NULL) {
        Tcl_DecrRefCount(ssheet->messagecommand);
      }
      ssheet->messagecommand = objv[3];
      Tcl_IncrRefCount(ssheet->messagecommand);
      break;

    case TCLXSLT_OPTION_RESULTURI:
      if (ssheet->resulturi != NULL) {
        Tcl_DecrRefCount(ssheet->resulturi);
      }
      ssheet->resulturi = objv[3];
      Tcl_IncrRefCount(ssheet->resulturi);
      break;

    case TCLXSLT_OPTION_PROFILECHANNEL:
      if (ssheet->profilechannelObj != NULL) {
        Tcl_DecrRefCount(ssheet->profilechannelObj);
      }
#ifdef __WIN32__
      Tcl_SetResult(interp, "profiling not available", NULL);
      return TCL_ERROR;
#else
      ssheet->profilechannelObj = objv[3];
      Tcl_IncrRefCount(ssheet->profilechannelObj);
#endif
      break;

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

    break;

  case TCLXSLT_GET:
    if (objc != 3) {
      Tcl_WrongNumArgs(interp, 2, objv, "name");
      return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[2], instanceGetMethods,
			    "name", 0, &option) != TCL_OK) {
      return TCL_ERROR;
    }

    switch ((enum instanceGetMethods) option) {
    case TCLXSLT_GET_PARAMETERS:

      Tcl_SetObjResult(interp, GetParameters(interp, ssheet->stylesheet));
      break;

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

    break;

  case TCLXSLT_TRANSFORM:
    if (objc < 3) {
      Tcl_WrongNumArgs(interp, 2, objv, "source ?param value...?");
      return TCL_ERROR;
    }

    return TclXSLTTransform(ssheet, objv[2], objc - 3, &objv[3]);

    break;

  default:
    Tcl_SetResult(interp, "unknown method", NULL);
    return TCL_OK;
  }

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTTransform --
 *
 *  Performs an XSL transformation.
 *
 * Results:
 *  Result document created.
 *
 * Side effects:
 *  Memory allocated for result document.
 *
 *----------------------------------------------------------------------------
 */

static int
TclXSLTTransform(stylesheet, source, paramc, paramv)
    TclXSLT_Stylesheet *stylesheet;
    Tcl_Obj *source;
    int paramc;
    Tcl_Obj *CONST paramv[];
{
  xmlDocPtr doc, result;
  char **params = NULL;
  int nbparams = 0, i;
  GenericError_Info *errorInfoPtr;
  void *oldxsltErrorCtx, *oldxmlErrorCtx;
  xmlGenericErrorFunc old_xsltGenericError, old_xmlGenericError;
  Tcl_Obj *resultObjPtr, *errObjPtr = NULL;
  char *resulturi = NULL;
  FILE *profile = NULL;
  xsltTransformContextPtr userCtxt = NULL;

  errorInfoPtr = (GenericError_Info *) Tcl_Alloc(sizeof(GenericError_Info));
  errorInfoPtr->interp = stylesheet->interp;
  errorInfoPtr->stylesheet = stylesheet;
  errorInfoPtr->code = TCL_OK;
  errorInfoPtr->msg = NULL;

  if (TclXML_libxml2_GetDocFromObj(stylesheet->interp, source, &doc) != TCL_OK) {
    goto error;
  }

  TclXML_libxml2_ResetError(stylesheet->interp);

  params = (char **) Tcl_Alloc(sizeof(char **) * (paramc + 1));
  for (i = 0; i < paramc; i++) {
    params[nbparams++] = Tcl_GetStringFromObj(paramv[i++], NULL);
    params[nbparams++] = Tcl_GetStringFromObj(paramv[i], NULL);
  }
  params[nbparams] = NULL;

  if (stylesheet->resulturi) {
    resulturi = Tcl_GetStringFromObj(stylesheet->resulturi, NULL);
  }
#ifdef __WIN32__
  /* Tcl_GetOpenFile not available on Windows */
#else
  if (stylesheet->profilechannelObj) {
    if (Tcl_GetOpenFile(stylesheet->interp,
			Tcl_GetStringFromObj(stylesheet->profilechannelObj, NULL),
			1, 1,
			(ClientData *) &profile) != TCL_OK) {
      goto error;
    }
  }
#endif

  /*
   * Perform the transformation
   */

  Tcl_MutexLock(&libxslt);

  /*
   * Save the previous error context so that it can
   * be restored upon completion of the transformation.
   * This is necessary because transformations may occur
   * recursively (usually due to extensions).
   */
  old_xsltGenericError = xsltGenericError;
  oldxsltErrorCtx = xsltGenericErrorContext;
  old_xmlGenericError = xmlGenericError;
  oldxmlErrorCtx = xmlGenericErrorContext;

  xmlSetGenericErrorFunc((void *) errorInfoPtr,
			 TclXSLTGenericError);
  xsltSetGenericErrorFunc((void *) errorInfoPtr, TclXSLTGenericError);

  userCtxt = xsltNewTransformContext(stylesheet->stylesheet, doc);
  if (userCtxt == NULL) {
    xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError);
    xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError);

    Tcl_MutexUnlock(&libxslt);
    Tcl_SetResult(stylesheet->interp, "unable to create transformation context", NULL);
    goto error;
  }

  result = xsltApplyStylesheetUser(stylesheet->stylesheet,
				   doc,
				   (const char **)params,
				   resulturi,
				   profile,
				   userCtxt);

  xsltFreeTransformContext(userCtxt);

  xmlSetGenericErrorFunc((void *) oldxmlErrorCtx, old_xmlGenericError);
  xsltSetGenericErrorFunc((void *) oldxsltErrorCtx, old_xsltGenericError);

  Tcl_MutexUnlock(&libxslt);

  errObjPtr = TclXML_libxml2_GetErrorObj(stylesheet->interp);

  if (result == NULL) {
    Tcl_Obj *resultPtr = Tcl_NewStringObj("no result document: ", -1);

    if (errObjPtr) {
      Tcl_AppendObjToObj(resultPtr, errObjPtr);
      Tcl_SetObjResult(stylesheet->interp, resultPtr);
      goto error;
    } else {
      if (errorInfoPtr->msg) {
	Tcl_AppendObjToObj(resultPtr, errorInfoPtr->msg);
      }

      Tcl_SetObjResult(stylesheet->interp, resultPtr);
      goto error;
    }
  }

  if ((errObjPtr || (errorInfoPtr->code != TCL_OK && errorInfoPtr->msg)) && stylesheet->messagecommand) {

    /* We have produced a result, but there may possibly
     * have been errors.  Trouble is, there might also
     * have been some completely innocent messages.
     * -messageCommand is the only way to find out about these.
     */

    Tcl_Obj *cmdPtr = Tcl_DuplicateObj(stylesheet->messagecommand);
    if (errObjPtr) {
      if (Tcl_ListObjAppendElement(stylesheet->interp, cmdPtr, errObjPtr) != TCL_OK) {
	goto error;
      }
    } else {
      if (Tcl_ListObjAppendElement(stylesheet->interp, cmdPtr, errorInfoPtr->msg) != TCL_OK) {
	goto error;
      }
    }
    if (Tcl_GlobalEvalObj(stylesheet->interp, cmdPtr) != TCL_OK) {
      Tcl_Obj *resultPtr = Tcl_NewStringObj("message command failed: ", -1);

      Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(stylesheet->interp));
      Tcl_SetObjResult(stylesheet->interp, resultPtr);
      goto error;
    }

  }

  resultObjPtr = TclDOM_libxml2_CreateObjFromDoc(stylesheet->interp, result);
  Tcl_SetObjResult(stylesheet->interp, resultObjPtr);

  if (errorInfoPtr->msg) {
    Tcl_DecrRefCount(errorInfoPtr->msg);
  }
  Tcl_Free((char *) errorInfoPtr);
  Tcl_Free((char *) params);

  return TCL_OK;

 error:

  if (errorInfoPtr->msg) {
    Tcl_DecrRefCount(errorInfoPtr->msg);
  }
  if (params) {
    Tcl_Free((char *) params);
  }
  Tcl_Free((char *) errorInfoPtr);

  return TCL_ERROR;
}

void
ListObjAppendUniqueList(interp, tablePtr, listPtr, newElementsPtr)
     Tcl_Interp *interp;
     Tcl_HashTable *tablePtr;
     Tcl_Obj *listPtr;
     Tcl_Obj *newElementsPtr;
{
  int len, idx;
  Tcl_Obj *elementPtr, *keyPtr, *namePtr, *nameURIPtr;
  Tcl_HashEntry *entryPtr;

  Tcl_ListObjLength(interp, newElementsPtr, &len);
  for (idx = 0; idx < len; idx++) {
	Tcl_ListObjIndex(interp, newElementsPtr, idx, &elementPtr);
	Tcl_ListObjIndex(interp, elementPtr, 0, &namePtr);
	Tcl_ListObjIndex(interp, elementPtr, 1, &nameURIPtr);

	keyPtr = Tcl_NewObj();
	Tcl_AppendStringsToObj(keyPtr,
						   Tcl_GetStringFromObj(nameURIPtr, NULL), 
						   "^", 
						   Tcl_GetStringFromObj(namePtr, NULL),
						   NULL);
	entryPtr = Tcl_FindHashEntry(tablePtr, (CONST char *) keyPtr);
	if (entryPtr == NULL) {
	  Tcl_ListObjAppendElement(interp, listPtr, elementPtr);
	}
	Tcl_DecrRefCount(keyPtr);
  }
}

/*
 *----------------------------------------------------------------------------
 *
 * GetParameters --
 *
 *  Retrieves the parameters for a stylesheet.
 *
 * Results:
 *  Returns a Tcl list object.
 *
 * Side effects:
 *  None.
 *
 *----------------------------------------------------------------------------
 */

static Tcl_Obj *
GetParameters(interp, stylesheet)
     Tcl_Interp *interp;
     xsltStylesheetPtr stylesheet;
{
  Tcl_Obj *resultPtr, *objPtr, *keyPtr;
  xsltStackElemPtr varPtr;
  Tcl_HashTable entries;  /* to keep track of parameter qnames */
  int new;

  if (stylesheet == NULL) {
    return NULL;
  }

  resultPtr = Tcl_NewListObj(0, NULL);
  Tcl_InitObjHashTable(&entries);

  for (varPtr = stylesheet->variables; varPtr; varPtr = varPtr->next) {
    Tcl_Obj *listPtr;

    if (strcmp((char *) varPtr->comp->inst->name, "param") == 0) {
      listPtr = Tcl_NewListObj(0, NULL);
      Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->name, -1));
      Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->nameURI, -1));
      Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj((CONST char *) varPtr->select, -1));

      Tcl_ListObjAppendElement(interp, resultPtr, listPtr);

	  keyPtr = Tcl_NewStringObj((CONST char *) varPtr->nameURI, -1);
	  Tcl_AppendStringsToObj(keyPtr, "^", varPtr->name, NULL);
	  Tcl_CreateHashEntry(&entries, (CONST char *) keyPtr, &new);
    }
  }

  objPtr = GetParameters(interp, stylesheet->next);
  if (objPtr) {
    ListObjAppendUniqueList(interp, &entries, resultPtr, objPtr);
  }
  objPtr = GetParameters(interp, stylesheet->imports);
  if (objPtr) {
    ListObjAppendUniqueList(interp, &entries, resultPtr, objPtr);
  }

  Tcl_DeleteHashTable(&entries);

  return resultPtr;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTGenericError --
 *
 *  Handler for stylesheet errors.
 *
 *  NB. Cannot distinguish between errors and use of xsl:message element.
 *
 * Results:
 *  Stores error message.
 *
 * Side effects:
 *  Transform will return error condition.
 *
 *----------------------------------------------------------------------------
 */

static void
TclXSLTGenericError (void *ctx, const char *msg, ...)
{
  va_list args;
  char buf[2048];
  int len;
  GenericError_Info *errorInfoPtr = (GenericError_Info *) ctx;

  if (ctx < (void *) 0x1000) {
    fprintf(stderr, "TclXSLT: bad context\n");
    va_start(args,msg);
    vfprintf(stderr, msg, args);
    va_end(args);
    return;
  }

  va_start(args,msg);
  len = vsnprintf(buf, 2047, msg, args);
  va_end(args);

  if (!errorInfoPtr->interp) {
    return;
  }

  if (errorInfoPtr->stylesheet && errorInfoPtr->stylesheet->messagecommand) {

    Tcl_Obj *cmdPtr = Tcl_DuplicateObj(errorInfoPtr->stylesheet->messagecommand);
    if (Tcl_ListObjAppendElement(errorInfoPtr->interp, cmdPtr, Tcl_NewStringObj(buf, len)) != TCL_OK) {
      Tcl_BackgroundError(errorInfoPtr->interp);
      return;
    }
    if (Tcl_GlobalEvalObj(errorInfoPtr->interp, cmdPtr) != TCL_OK) {
      Tcl_BackgroundError(errorInfoPtr->interp);
      return;
    }

  } else {

    if (!errorInfoPtr->msg) {
      errorInfoPtr->msg = Tcl_NewObj();
      Tcl_IncrRefCount(errorInfoPtr->msg);
    }

    errorInfoPtr->code = TCL_ERROR;

    Tcl_AppendToObj(errorInfoPtr->msg, buf, len);

  }
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTExtensionCommand --
 *
 *  Command for xslt::extension command.
 *
 * Results:
 *  Depends on method.
 *
 * Side effects:
 *  Depends on method
 *
 *----------------------------------------------------------------------------
 */

static int
TclXSLTExtensionCommand(dummy, interp, objc, objv)
     ClientData dummy;
     Tcl_Interp *interp;
     int objc;
     Tcl_Obj *CONST objv[];
{
  ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
  int method, new;
  TclXSLT_Extension *extinfo;
  Tcl_HashEntry *entry;

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

  if (Tcl_GetIndexFromObj(interp, objv[1], extensionCommandMethods,
			  "method", 0, &method) != TCL_OK) {
    return TCL_ERROR;
  }

  switch ((enum extensionCommandMethods) method) {

  case TCLXSLT_EXT_ADD:
    if (objc != 4) {
      Tcl_WrongNumArgs(interp, 2, objv, "nsuri tcl-namespace");
      return TCL_ERROR;
    }

    Tcl_MutexLock(&libxslt);

    if (xsltRegisterExtModule((const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL),
			      TclXSLTExtInit,
			      TclXSLTExtShutdown)) {
      Tcl_MutexUnlock(&libxslt);
      Tcl_SetResult(interp, "cannot register extension module", NULL);
    }

    Tcl_MutexUnlock(&libxslt);

    extinfo = (TclXSLT_Extension *) Tcl_Alloc(sizeof(TclXSLT_Extension));
    extinfo->interp = interp;
    extinfo->nsuri = objv[2];
    Tcl_IncrRefCount(objv[2]);
    extinfo->tclns = objv[3];
    Tcl_IncrRefCount(objv[3]);

    extinfo->xformCtxt = NULL;

    entry = Tcl_CreateHashEntry(tsdPtr->extensions, Tcl_GetStringFromObj(objv[2], NULL), &new);

    if (!new) {
      Tcl_SetResult(interp, "extension already exists", NULL);
      Tcl_Free((char *) extinfo);
      return TCL_ERROR;
    }

    Tcl_SetHashValue(entry, extinfo);

    TclXSLT_RegisterAll(extinfo, (const xmlChar *) Tcl_GetStringFromObj(objv[2], NULL));

    Tcl_ResetResult(interp);

    break;

  case TCLXSLT_EXT_REMOVE:
    if (objc != 3) {
      Tcl_WrongNumArgs(interp, 2, objv, "nsuri");
      return TCL_ERROR;
    }

    /*
     * TODO: Remove previously registered elements and functions.
    */

    entry = Tcl_FindHashEntry(tsdPtr->extensions, Tcl_GetStringFromObj(objv[2], NULL));
    if (entry == NULL) {
      Tcl_SetResult(interp, "unknown XML Namespace URI", NULL);
      return TCL_ERROR;
    }

    extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry);
    Tcl_DecrRefCount(extinfo->nsuri);
    Tcl_DecrRefCount(extinfo->tclns);
    Tcl_Free((char *) extinfo);

    Tcl_DeleteHashEntry(entry);

    break;

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

  return TCL_OK;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTExtInit --
 *
 *  Load extensions into a transformation context.
 *
 * Results:
 *  Returns pointer to extension data.
 *  Elements and functions are pre-registered.
 *
 * Side effects:
 *  None.
 *
 *----------------------------------------------------------------------------
 */

static void *
TclXSLTExtInit(ctxt, URI)
     xsltTransformContextPtr ctxt;
     const xmlChar *URI;
{
  ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
  Tcl_HashEntry *entry;
  TclXSLT_Extension *extinfo;

  entry = Tcl_FindHashEntry(tsdPtr->extensions, (CONST char *) URI);
  if (entry == NULL) {
    /* Extension module was removed */
    return NULL;
  }

  extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry);
  extinfo->xformCtxt = ctxt;

  return (void *) extinfo;
}

void
TclXSLT_RegisterAll(extinfo, nsuri)
    TclXSLT_Extension *extinfo;
    const xmlChar *nsuri;
{
  Tcl_Obj *cmdPtr, *objPtr;
  Tcl_Obj **reg;
  int ret, i, len;

  /*
   * Q: How to distinguish between extension elements and functions?
   * A: Use the formal parameters.  If the command can accept
   * a variable argument list, then it is registered as a function.
   * Otherwise it will be registered as an extension (and expected
   * to accept certain arguments).
   */

  cmdPtr = Tcl_NewStringObj("::xslt::getprocs ", -1);
  Tcl_IncrRefCount(cmdPtr);
  Tcl_AppendObjToObj(cmdPtr, extinfo->tclns);
  ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
  objPtr = Tcl_GetObjResult(extinfo->interp);
  Tcl_IncrRefCount(objPtr);
  Tcl_DecrRefCount(cmdPtr);

  if (ret != TCL_OK || objPtr == NULL) {
    /*
     * Something went wrong, therefore nothing to register.
     */
    return;
  }

  ret = Tcl_ListObjGetElements(extinfo->interp, objPtr, &len, &reg);
  if (ret != TCL_OK || len != 2) {
    /*
     * Something went wrong, therefore nothing to register.
     */
    return;
  }

  /*
   * reg[0] contains extension elements
   * reg[1] contains extension functions
   */

  Tcl_MutexLock(&libxslt);

  /*
   * First register the extension elements.
   */

  ret = Tcl_ListObjLength(extinfo->interp, reg[0], &len);
  if (ret == TCL_OK && len > 0) {
    for (i = 0; i < len; i++) {

      if (Tcl_ListObjIndex(extinfo->interp, reg[0], i, &objPtr) != TCL_OK) {
        continue;
      }

      xsltRegisterExtModuleElement((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL),
                             nsuri,
                             (xsltPreComputeFunction) TclXSLTExtElementPreComp,
                             (xsltTransformFunction) TclXSLTExtElementTransform);
    }
  }

  /*
   * Now register the extension functions.
   */

  ret = Tcl_ListObjLength(extinfo->interp, reg[1], &len);
  if (ret != TCL_OK || len == 0) {
    Tcl_MutexUnlock(&libxslt);
    return;
  }

  for (i = 0; i < len; i++) {

    if (Tcl_ListObjIndex(extinfo->interp, reg[1], i, &objPtr) != TCL_OK) {
      continue;
    }

    xsltRegisterExtModuleFunction((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL),
    	nsuri,
    	TclXSLTExtFunction);
  }

  Tcl_MutexUnlock(&libxslt);

  Tcl_DecrRefCount(objPtr);

  return;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTExtElementPreComp --
 *
 *  Compilation step for extension element.
 *
 * Results:
 *  Not currently used.
 *
 * Side effects:
 *  None.
 *
 *----------------------------------------------------------------------------
 */

static xsltElemPreCompPtr
TclXSLTExtElementPreComp(style, inst, function)
    xsltStylesheetPtr style;
    xmlNodePtr inst;
    xsltTransformFunction function;
{
  return NULL;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTExtElementTransform --
 *
 *  Implements extension element.
 *
 * Results:
 *  Returns string returned by Tcl command evaluation.
 *
 * Side effects:
 *  Depends on Tcl command evaluated.
 *
 *----------------------------------------------------------------------------
 */

/*
 * xsltAddTextString --
 * Copied from libxslt-1.1.24 transform.c
 * (without the debugging code)
 */

static xmlNodePtr
xsltAddTextString(xsltTransformContextPtr ctxt, xmlNodePtr target,
		  const xmlChar *string, int len) {
    if ((len <= 0) || (string == NULL) || (target == NULL))
        return(target);

    if (ctxt->lasttext == target->content) {

	if (ctxt->lasttuse + len >= ctxt->lasttsize) {
	    xmlChar *newbuf;
	    int size;

	    size = ctxt->lasttsize + len + 100;
	    size *= 2;
	    newbuf = (xmlChar *) xmlRealloc(target->content,size);
	    if (newbuf == NULL) {
		xsltTransformError(ctxt, NULL, target,
		 "xsltCopyText: text allocation failed\n");
		return(NULL);
	    }
	    ctxt->lasttsize = size;
	    ctxt->lasttext = newbuf;
	    target->content = newbuf;
	}
	memcpy(&(target->content[ctxt->lasttuse]), string, len);
	ctxt->lasttuse += len;
	target->content[ctxt->lasttuse] = 0;
    } else {
	xmlNodeAddContent(target, string);
	ctxt->lasttext = target->content;
	len = xmlStrlen(target->content);
	ctxt->lasttsize = len;
	ctxt->lasttuse = len;
    }
    return(target);
}

/*
 * xsltCopyNamespaceListInternal --
 * Copied from libxslt-1.1.24 transform.c
 * (without the debugging code)
 */

static xmlNsPtr
xsltCopyNamespaceListInternal(xmlNodePtr elem, xmlNsPtr ns) {
    xmlNsPtr ret = NULL;
    xmlNsPtr p = NULL, q, luNs;

    if (ns == NULL)
	return(NULL);
    if ((elem != NULL) && (elem->type != XML_ELEMENT_NODE))
	elem = NULL;

    do {
	if (ns->type != XML_NAMESPACE_DECL)
	    break;
	if (elem != NULL) {	    
	    if ((elem->ns != NULL) &&
		xmlStrEqual(elem->ns->prefix, ns->prefix) &&
		xmlStrEqual(elem->ns->href, ns->href))
	    {
		ns = ns->next;
		continue;
	    }
	    luNs = xmlSearchNs(elem->doc, elem, ns->prefix);
	    if ((luNs != NULL) && (xmlStrEqual(luNs->href, ns->href)))
	    {
		ns = ns->next;
		continue;
	    }
	}	    	
	q = xmlNewNs(elem, ns->href, ns->prefix);
	if (p == NULL) {
	    ret = p = q;
	} else if (q != NULL) {
	    p->next = q;
	    p = q;
	}
	ns = ns->next;	
    } while (ns != NULL);
    return(ret);
}

/*
 * xsltCopyText --
 * Copied from libxslt-1.1.24 transform.c
 * (without the debugging code)
 */

static xmlNodePtr
xsltCopyText(xsltTransformContextPtr ctxt, xmlNodePtr target,
	     xmlNodePtr cur, int interned)
{
    xmlNodePtr copy;

    if ((cur->type != XML_TEXT_NODE) &&
	(cur->type != XML_CDATA_SECTION_NODE))
	return(NULL);
    if (cur->content == NULL) 
	return(NULL);

    if ((target == NULL) || (target->children == NULL)) {
	ctxt->lasttext = NULL;
    }

    if ((ctxt->style->cdataSection != NULL) &&
	(ctxt->type == XSLT_OUTPUT_XML) &&	
	(target != NULL) &&
	(target->type == XML_ELEMENT_NODE) &&
	(((target->ns == NULL) && 
	  (xmlHashLookup2(ctxt->style->cdataSection,
		          target->name, NULL) != NULL)) ||
	 ((target->ns != NULL) &&
	  (xmlHashLookup2(ctxt->style->cdataSection,
	                  target->name, target->ns->href) != NULL))))
    {
	if ((target->last != NULL) &&
	     (target->last->type == XML_CDATA_SECTION_NODE))
	{
	    copy = xsltAddTextString(ctxt, target->last, cur->content,
		xmlStrlen(cur->content));
	    goto exit;
	} else {
	    unsigned int len;

	    len = xmlStrlen(cur->content);	    
	    copy = xmlNewCDataBlock(ctxt->output, cur->content, len);
	    if (copy == NULL)
		goto exit;
	    ctxt->lasttext = copy->content;
	    ctxt->lasttsize = len;
	    ctxt->lasttuse = len;
	}
    } else if ((target != NULL) &&
	(target->last != NULL) &&
	(((target->last->type == XML_TEXT_NODE) &&
	(target->last->name == cur->name)) ||
	(((target->last->type == XML_CDATA_SECTION_NODE) &&
	(cur->name == xmlStringTextNoenc)))))
    {
	copy = xsltAddTextString(ctxt, target->last, cur->content,
	    xmlStrlen(cur->content));
	goto exit;
    } else if ((interned) && (target != NULL) &&
	(target->doc != NULL) &&
	(target->doc->dict == ctxt->dict))
    {        
        copy = xmlNewTextLen(NULL, 0);
	if (copy == NULL)
	    goto exit;	
	if (cur->name == xmlStringTextNoenc)
	    copy->name = xmlStringTextNoenc;
	
	if (xmlDictOwns(ctxt->dict, cur->content))
	    copy->content = cur->content;
	else {
	    if ((copy->content = xmlStrdup(cur->content)) == NULL)
		return NULL;
	}
    } else {
        unsigned int len;

	len = xmlStrlen(cur->content);
	copy = xmlNewTextLen(cur->content, len);
	if (copy == NULL)
	    goto exit;
	if (cur->name == xmlStringTextNoenc)
	    copy->name = xmlStringTextNoenc;
	ctxt->lasttext = copy->content;
	ctxt->lasttsize = len;
	ctxt->lasttuse = len;
    }
    if (copy != NULL) {
	if (target != NULL) {
	    copy->doc = target->doc;
	    xmlAddChild(target, copy);
	}
    } else {
	xsltTransformError(ctxt, NULL, target,
			 "xsltCopyText: text copy failed\n");
    }

exit:
    if ((copy == NULL) || (copy->content == NULL)) {
	xsltTransformError(ctxt, NULL, target,
	    "Internal error in xsltCopyText(): "
	    "Failed to copy the string.\n");
	ctxt->state = XSLT_STATE_STOPPED;
    }
    return(copy);
}

/*
 * xsltShallowCopyElem --
 * Copied from libxslt-1.1.24 transform.c
 * (without the debugging code)
 */

static xmlNodePtr
xsltShallowCopyElem(xsltTransformContextPtr ctxt, xmlNodePtr node,
		    xmlNodePtr insert, int isLRE)
{
    xmlNodePtr copy;

    if ((node->type == XML_DTD_NODE) || (insert == NULL))
	return(NULL);
    if ((node->type == XML_TEXT_NODE) ||
	(node->type == XML_CDATA_SECTION_NODE))
	return(xsltCopyText(ctxt, insert, node, 0));

    copy = xmlDocCopyNode(node, insert->doc, 0);
    if (copy != NULL) {
	copy->doc = ctxt->output;
	xmlAddChild(insert, copy);

	if (node->type == XML_ELEMENT_NODE) {
	    if (node->nsDef != NULL) {
		if (isLRE)
		    xsltCopyNamespaceList(ctxt, copy, node->nsDef);
		else
		    xsltCopyNamespaceListInternal(copy, node->nsDef);
	    }

	    if (node->ns != NULL) {
		if (isLRE) {
		    copy->ns = xsltGetNamespace(ctxt, node, node->ns, copy);
		} else {
		    copy->ns = xsltGetSpecialNamespace(ctxt,
			node, node->ns->href, node->ns->prefix, copy);
		    
		}
	    } else if ((insert->type == XML_ELEMENT_NODE) &&
		       (insert->ns != NULL))
	    {
		xsltGetSpecialNamespace(ctxt, node, NULL, NULL, copy);
	    }
	}
    } else {
	xsltTransformError(ctxt, NULL, node,
		"xsltShallowCopyElem: copy %s failed\n", node->name);
    }
    return(copy);
}

/*
 * xsltApplyFallbacks --
 * Copied from libxslt-1.1.24 transform.c
 * (without the debugging code)
 */

static int
xsltApplyFallbacks(xsltTransformContextPtr ctxt, xmlNodePtr node,
	           xmlNodePtr inst) {

    xmlNodePtr child;
    int ret = 0;
    
    if ((ctxt == NULL) || (node == NULL) || (inst == NULL) ||
	(inst->children == NULL))
	return(0);

    child = inst->children;
    while (child != NULL) {
        if ((IS_XSLT_ELEM(child)) &&
            (xmlStrEqual(child->name, BAD_CAST "fallback"))) {
	    ret++;
	    xsltApplySequenceConstructor(ctxt, node, child->children,
		NULL);
	}
	child = child->next;
    }
    return(ret);
}

/*
 * xsltReleaseLocalRVTs --
 * Copied from libxslt-1.1.24 transform.c
 * (without the debugging code)
 */

static void
xsltReleaseLocalRVTs(xsltTransformContextPtr ctxt, xmlDocPtr base)
{
    xmlDocPtr cur = ctxt->localRVT, tmp;
    
    while ((cur != NULL) && (cur != base)) {
	if (cur->psvi == (void *) ((long) 1)) {
	    cur = (xmlDocPtr) cur->next;
	} else {
	    tmp = cur;
	    cur = (xmlDocPtr) cur->next;

	    if (tmp == ctxt->localRVT)
		ctxt->localRVT = cur;

	    if (tmp == ctxt->localRVTBase)
		ctxt->localRVTBase = cur;

	    if (tmp->prev)
		tmp->prev->next = (xmlNodePtr) cur;
	    if (cur)
		cur->prev = tmp->prev;
	    xsltReleaseRVT(ctxt, tmp);
	}
    }
}

/*
 * xsltApplySequenceConstructor --
 * Copied from libxslt-1.1.24 transform.c
 * (without the debugging code)
 */

static void
xsltApplySequenceConstructor(xsltTransformContextPtr ctxt,
			     xmlNodePtr contextNode, xmlNodePtr list,
			     xsltTemplatePtr templ)
{
    xmlNodePtr oldInsert, oldInst, oldCurInst, oldContextNode;
    xmlNodePtr cur, insert, copy = NULL;
    int level = 0, oldVarsNr;
    xmlDocPtr oldLocalFragmentTop, oldLocalFragmentBase;
#ifdef XSLT_REFACTORED
    xsltStylePreCompPtr info;
#endif

    if (ctxt == NULL)
	return;
    if (list == NULL)
        return;
    CHECK_STOPPED;


    oldLocalFragmentTop = ctxt->localRVT;
    oldInsert = insert = ctxt->insert;
    oldInst = oldCurInst = ctxt->inst;
    oldContextNode = ctxt->node;

    oldVarsNr = ctxt->varsNr;

    cur = list;
    while (cur != NULL) {
        ctxt->inst = cur;

        if (insert == NULL) {
	  goto error;
	}
#ifdef XSLT_REFACTORED
	if (cur->type == XML_ELEMENT_NODE) {
	    info = (xsltStylePreCompPtr) cur->psvi;
	    if (info == NULL) {
		if (IS_XSLT_ELEM_FAST(cur) && IS_XSLT_NAME(cur, "message")) {
		    xsltMessage(ctxt, contextNode, cur);
		    goto skip_children;
		}		    		 
		/*
		* Something really went wrong:
		*/
		xsltTransformError(ctxt, NULL, cur,
		    "Internal error in xsltApplySequenceConstructor(): "
		    "The element '%s' in the stylesheet has no compiled "
		    "representation.\n",
		    cur->name);
                goto skip_children;
            }

	    if (info->type == XSLT_FUNC_LITERAL_RESULT_ELEMENT) {
		xsltStyleItemLRElementInfoPtr lrInfo =
		    (xsltStyleItemLRElementInfoPtr) info;
		copy = xmlDocCopyNode(cur, insert->doc, 0);
		if (copy == NULL) {
		    xsltTransformError(ctxt, NULL, cur,
			"Internal error in xsltApplySequenceConstructor(): "
			"Failed to copy literal result element '%s'.\n",
			cur->name);
		    goto error;
		} else {
		    copy->doc = ctxt->output;
		    xmlAddChild(insert, copy);
		    if (lrInfo->effectiveNs != NULL) {
			xsltEffectiveNsPtr effNs = lrInfo->effectiveNs;
			xmlNsPtr ns, lastns = NULL;

			while (effNs != NULL) {
			    ns = xmlSearchNs(copy->doc, copy, effNs->prefix);
			    if ((ns != NULL) &&
				(xmlStrEqual(ns->href, effNs->nsName)))
			    {
				effNs = effNs->next;
				continue;			    
			    }
			    ns = xmlNewNs(copy, effNs->nsName, effNs->prefix);
			    if (ns == NULL) {
				xsltTransformError(ctxt, NULL, cur,
				    "Internal error in "
				    "xsltApplySequenceConstructor(): "
				    "Failed to copy a namespace "
				    "declaration.\n");
				goto error;
			    }
								
			    if (lastns == NULL)
				copy->nsDef = ns;
			    else
				lastns->next =ns;
			    lastns = ns;

			    effNs = effNs->next;
			}
			
		    }
		    if (cur->ns != NULL) {
			copy->ns = xsltGetSpecialNamespace(ctxt, cur,
			    cur->ns->href, cur->ns->prefix, copy);			    
		    } else {
			if (copy->nsDef ||
			    ((insert != NULL) &&
			     (insert->type == XML_ELEMENT_NODE) &&
			     (insert->ns != NULL)))
			{
			    xsltGetSpecialNamespace(ctxt, cur,
				NULL, NULL, copy);
			}
		    }
		}
		if (cur->properties != NULL) {
		    xsltAttrListTemplateProcess(ctxt, copy, cur->properties);
		}
	    } else if (IS_XSLT_ELEM_FAST(cur)) {
		if (info->type == XSLT_FUNC_UNKOWN_FORWARDS_COMPAT) {
		    ctxt->insert = insert;
		    if (!xsltApplyFallbacks(ctxt, contextNode, cur)) {
			xsltTransformError(ctxt, NULL, cur,
			    "The is no fallback behaviour defined for "
			    "the unknown XSLT element '%s'.\n",
			    cur->name);
		    }			
		    ctxt->insert = oldInsert;
		} else if (info->func != NULL) {
		    ctxt->insert = insert;

		    info->func(ctxt, contextNode, cur,
			(xsltElemPreCompPtr) info);

		    if (oldLocalFragmentTop != ctxt->localRVT)
			xsltReleaseLocalRVTs(ctxt, oldLocalFragmentTop);

		    ctxt->insert = oldInsert;
		} else if (info->type == XSLT_FUNC_VARIABLE) {		
		    xsltStackElemPtr tmpvar = ctxt->vars;
		
		    xsltParseStylesheetVariable(ctxt, cur);
		    
		    if (tmpvar != ctxt->vars) {
			ctxt->vars->level = level;
		    }
		} else if (info->type == XSLT_FUNC_MESSAGE) {
		    xsltMessage(ctxt, contextNode, cur);
		} else {
		    xsltTransformError(ctxt, NULL, cur,
			"Unexpected XSLT element '%s'.\n", cur->name);		    	
		}
		goto skip_children;

	    } else {
		xsltTransformFunction func;
		if (cur->psvi == xsltExtMarker) {
		    func = (xsltTransformFunction)
			xsltExtElementLookup(ctxt, cur->name, cur->ns->href);
		} else
		    func = ((xsltElemPreCompPtr) cur->psvi)->func;
		
		if (func == NULL) {
		    ctxt->insert = insert;
		    if (!xsltApplyFallbacks(ctxt, contextNode, cur)) {
			xsltTransformError(ctxt, NULL, cur,
			    "Unknown extension instruction '{%s}%s'.\n",
			    cur->ns->href, cur->name);
		    }			
		    ctxt->insert = oldInsert;		    
		} else {
		    ctxt->insert = insert;
		    oldLocalFragmentBase = ctxt->localRVTBase;
		    ctxt->localRVTBase = NULL;

		    func(ctxt, contextNode, cur, cur->psvi);

		    ctxt->localRVTBase = oldLocalFragmentBase;
		    if (oldLocalFragmentTop != ctxt->localRVT)
			xsltReleaseLocalRVTs(ctxt, oldLocalFragmentTop);

		    ctxt->insert = oldInsert;
		}
		goto skip_children;
	    }

	} else if (XSLT_IS_TEXT_NODE(cur)) {
            if (xsltCopyText(ctxt, insert, cur, ctxt->internalized) == NULL)
		goto error;	    
	}

#else /* XSLT_REFACTORED */

        if (IS_XSLT_ELEM(cur)) {
            xsltStylePreCompPtr info = (xsltStylePreCompPtr) cur->psvi;

            if (info == NULL) {
                if (IS_XSLT_NAME(cur, "message")) {
                    xsltMessage(ctxt, contextNode, cur);
                } else {		    
                    ctxt->insert = insert;
                    if (!xsltApplyFallbacks(ctxt, contextNode, cur)) {
                        xsltGenericError(xsltGenericErrorContext,
			    "xsltApplySequenceConstructor: %s was not compiled\n",
			    cur->name);
                    }
                    ctxt->insert = oldInsert;
                }
                goto skip_children;
            }	    

            if (info->func != NULL) {
		oldCurInst = ctxt->inst;
		ctxt->inst = cur;
                ctxt->insert = insert;
		oldLocalFragmentBase = ctxt->localRVTBase;
		ctxt->localRVTBase = NULL;

                info->func(ctxt, contextNode, cur, (xsltElemPreCompPtr) info);

		ctxt->localRVTBase = oldLocalFragmentBase;
		if (oldLocalFragmentTop != ctxt->localRVT)
		    xsltReleaseLocalRVTs(ctxt, oldLocalFragmentTop);

                ctxt->insert = oldInsert;
		ctxt->inst = oldCurInst;
                goto skip_children;
            }

            if (IS_XSLT_NAME(cur, "variable")) {
		xsltStackElemPtr tmpvar = ctxt->vars;
		
		oldCurInst = ctxt->inst;
		ctxt->inst = cur;

		xsltParseStylesheetVariable(ctxt, cur);

		ctxt->inst = oldCurInst;
		
		if (tmpvar != ctxt->vars) {
		    ctxt->vars->level = level;
		}
            } else if (IS_XSLT_NAME(cur, "message")) {
                xsltMessage(ctxt, contextNode, cur);
            } else {
		xsltTransformError(ctxt, NULL, cur,
		    "Unexpected XSLT element '%s'.\n", cur->name);
            }
            goto skip_children;
        } else if ((cur->type == XML_TEXT_NODE) ||
                   (cur->type == XML_CDATA_SECTION_NODE)) {

            if (xsltCopyText(ctxt, insert, cur, ctxt->internalized) == NULL)
		goto error;
        } else if ((cur->type == XML_ELEMENT_NODE) &&
                   (cur->ns != NULL) && (cur->psvi != NULL)) {
            xsltTransformFunction function;

	    oldCurInst = ctxt->inst;
	    ctxt->inst = cur;
            if (cur->psvi == xsltExtMarker)
                function = (xsltTransformFunction)
                    xsltExtElementLookup(ctxt, cur->name, cur->ns->href);
            else
                function = ((xsltElemPreCompPtr) cur->psvi)->func;

            if (function == NULL) {
                xmlNodePtr child;
                int found = 0;

                child = cur->children;
                while (child != NULL) {
                    if ((IS_XSLT_ELEM(child)) &&
                        (IS_XSLT_NAME(child, "fallback")))
		    {
                        found = 1;
                        xsltApplySequenceConstructor(ctxt, contextNode,
			    child->children, NULL);
                    }
                    child = child->next;
                }

                if (!found) {
                    xsltTransformError(ctxt, NULL, cur,
			"xsltApplySequenceConstructor: failed to find extension %s\n",
			cur->name);
                }
            } else {

                ctxt->insert = insert;
		oldLocalFragmentBase = ctxt->localRVTBase;
		ctxt->localRVTBase = NULL;

                function(ctxt, contextNode, cur, cur->psvi);
		if (oldLocalFragmentTop != ctxt->localRVT)
		    xsltReleaseLocalRVTs(ctxt, oldLocalFragmentTop);

		ctxt->localRVTBase = oldLocalFragmentBase;
                ctxt->insert = oldInsert;

            }
	    ctxt->inst = oldCurInst;
            goto skip_children;
        } else if (cur->type == XML_ELEMENT_NODE) {
	    oldCurInst = ctxt->inst;
	    ctxt->inst = cur;

            if ((copy = xsltShallowCopyElem(ctxt, cur, insert, 1)) == NULL)
		goto error;            
            if ((templ != NULL) && (oldInsert == insert) &&
                (ctxt->templ != NULL) && (ctxt->templ->inheritedNs != NULL)) {
                int i;
                xmlNsPtr ns, ret;

                for (i = 0; i < ctxt->templ->inheritedNsNr; i++) {
		    const xmlChar *URI = NULL;
		    xsltStylesheetPtr style;
                    ns = ctxt->templ->inheritedNs[i];		    
		    
		    style = ctxt->style;
		    while (style != NULL) {
			if (style->nsAliases != NULL)
			    URI = (const xmlChar *) 
				xmlHashLookup(style->nsAliases, ns->href);
			if (URI != NULL)
			    break;
			
			style = xsltNextImport(style);
		    }
		    if (URI == UNDEFINED_DEFAULT_NS)
			continue;
		    if (URI == NULL)
			URI = ns->href;
		    ret = xmlSearchNs(copy->doc, copy, ns->prefix);
		    if ((ret == NULL) || (!xmlStrEqual(ret->href, URI)))
		    {
			xmlNewNs(copy, URI, ns->prefix);
		    }
                }
		if (copy->ns != NULL) {
		    copy->ns = xsltGetNamespace(ctxt, cur, copy->ns, copy);
		}
            }
            if (cur->properties != NULL) {
                xsltAttrListTemplateProcess(ctxt, copy, cur->properties);
            }
	    ctxt->inst = oldCurInst;
        }
#endif /* else of XSLT_REFACTORED */

        if (cur->children != NULL) {
            if (cur->children->type != XML_ENTITY_DECL) {
                cur = cur->children;
		level++;
                if (copy != NULL)
                    insert = copy;
                continue;
            }
        }

skip_children:
	if (ctxt->state == XSLT_STATE_STOPPED)
	    break;
        if (cur->next != NULL) {
            cur = cur->next;
            continue;
        }

        do {
            cur = cur->parent;
	    level--;
	    if ((ctxt->varsNr > oldVarsNr) && (ctxt->vars->level > level)) {
		xsltLocalVariablePop(ctxt, oldVarsNr, level);		
	    }

            insert = insert->parent;
            if (cur == NULL)
                break;
            if (cur == list->parent) {
                cur = NULL;
                break;
            }
            if (cur->next != NULL) {
                cur = cur->next;
                break;
            }
        } while (cur != NULL);
    }

error:
    if (ctxt->varsNr > oldVarsNr)
	xsltLocalVariablePop(ctxt, oldVarsNr, -1);     

    ctxt->node = oldContextNode;
    ctxt->inst = oldInst;
    ctxt->insert = oldInsert;
}

static void 
TclXSLTExtElementTransform(ctxt, node, inst, comp)
    xsltTransformContextPtr ctxt; /* unused */
    xmlNodePtr node;
    xmlNodePtr inst;
    xsltStylePreCompPtr comp; /* unused */
{
  ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
  TclXSLT_Extension *extinfo;
  Tcl_HashEntry *entry;
  Tcl_Obj *cmdPtr, *objPtr, *avtObjPtr, *elemObj;
  xsltStylesheetPtr style = NULL;
  xmlDocPtr oldOutput, res = NULL;
  xmlNodePtr oldInsert;
  xsltOutputType oldType;
  xmlAttrPtr attr;
  int ret;

  if (inst == NULL) {
    return;
  }

  entry = Tcl_FindHashEntry(tsdPtr->extensions, (CONST char *) inst->ns->href);
  if (entry == NULL) {
    /*
     * Cannot find extension module.
     * Must have been removed.
     */
    return;
  }

  extinfo = (TclXSLT_Extension *) Tcl_GetHashValue(entry);

  /*
   * Evaluate every attribute as an AVT.
   * Pass these values on to the callback as a list.
   * Each list element is (name, ns, value)
   */

  avtObjPtr = Tcl_NewListObj(0, NULL);
  for (attr = inst->properties; attr != NULL; attr = attr->next) {
    elemObj = Tcl_NewListObj(0, NULL);
    if (Tcl_ListObjAppendElement(extinfo->interp, elemObj, Tcl_NewStringObj((CONST char *) attr->name, -1))) {
      goto error;
    }
    if (attr->ns != NULL) {
      if (Tcl_ListObjAppendElement(extinfo->interp, elemObj, Tcl_NewStringObj((CONST char *) attr->ns->href, -1))) {
	goto error;
      }
    } else {
      if (Tcl_ListObjAppendElement(extinfo->interp, elemObj, Tcl_NewObj())) {
	goto error;
      }
    }
    if (Tcl_ListObjAppendElement(extinfo->interp, elemObj, Tcl_NewStringObj((char *) xsltEvalAttrValueTemplate(ctxt, inst, attr->name, NULL), -1))) {
      goto error;
    }

    if (Tcl_ListObjAppendElement(extinfo->interp, avtObjPtr, elemObj)) {
      goto error;
    }
  }

  /*
   * Evaluate the element content.
   */

  oldOutput = ctxt->output;
  oldInsert = ctxt->insert;
  oldType = ctxt->type;

  style = xsltNewStylesheet();
  if (style == NULL) {
    xsltTransformError(ctxt, NULL, inst,
		       "TclXSLT: out of memory\n");
    goto error;
  }
  res = xmlNewDoc(style->version);
  res->charset = XML_CHAR_ENCODING_UTF8;
  ctxt->output = res;
  ctxt->insert = (xmlNodePtr) res;

  xsltApplySequenceConstructor(ctxt, node, inst->children, NULL);

  /*
   * Start constructing the script by first defining the command.
   */

  cmdPtr = Tcl_DuplicateObj(extinfo->tclns);
  Tcl_AppendStringsToObj(cmdPtr, "::", inst->name, NULL);

  if (res != NULL) {
    objPtr = TclDOM_libxml2_CreateObjFromDoc(extinfo->interp, res);
    if (objPtr == NULL) {
      Tcl_DecrRefCount(cmdPtr);
      Tcl_BackgroundError(extinfo->interp);
      goto error;
    }
    if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, objPtr) != TCL_OK) {
      Tcl_DecrRefCount(cmdPtr);
      Tcl_BackgroundError(extinfo->interp);
      goto error;
    }
  } else {
    if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, Tcl_NewObj()) != TCL_OK) {
      Tcl_DecrRefCount(cmdPtr);
      Tcl_BackgroundError(extinfo->interp);
      goto error;
    }
  }

  if (node != NULL) {
    objPtr = TclDOM_libxml2_CreateObjFromNode(extinfo->interp, node);
    if (objPtr == NULL) {
      Tcl_DecrRefCount(cmdPtr);
      Tcl_BackgroundError(extinfo->interp);
      goto error;
    }
    if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, objPtr) != TCL_OK) {
      Tcl_DecrRefCount(cmdPtr);
      Tcl_BackgroundError(extinfo->interp);
      goto error;
    }
  } else {
    if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, Tcl_NewObj()) != TCL_OK) {
      Tcl_DecrRefCount(cmdPtr);
      Tcl_BackgroundError(extinfo->interp);
      goto error;
    }
  }

  if (inst != NULL) {
    objPtr = TclDOM_libxml2_CreateObjFromNode(extinfo->interp, inst);
    if (objPtr == NULL) {
      Tcl_DecrRefCount(cmdPtr);
      Tcl_BackgroundError(extinfo->interp);
      goto error;
    }
    if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, objPtr) != TCL_OK) {
      Tcl_DecrRefCount(cmdPtr);
      Tcl_BackgroundError(extinfo->interp);
      goto error;
    }
  } else {
    if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, Tcl_NewObj()) != TCL_OK) {
      Tcl_DecrRefCount(cmdPtr);
      Tcl_BackgroundError(extinfo->interp);
      goto error;
    }
  }

  if (Tcl_ListObjAppendElement(extinfo->interp, cmdPtr, avtObjPtr) != TCL_OK) {
    Tcl_DecrRefCount(cmdPtr);
    Tcl_BackgroundError(extinfo->interp);
    goto error;
  }

  /*
   * Converting the stylesheet node to a TclDOM node may clobber the
   * _private pointer.  It would be nice to find the equivalent node
   * in the original DOM tree, but it may not even exist anymore :-(
   *
   * TODO: make extension elements more effective, and allow
   * pre-computation.
   */

  /*
   * Now evaluate the complete command.
   */
  ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
  if (ret != TCL_OK) {
    xsltTransformError(ctxt, NULL, NULL, "TclXSLT extension failed: \"%s\"", Tcl_GetStringFromObj(Tcl_GetObjResult(extinfo->interp), NULL));
    Tcl_BackgroundError(extinfo->interp);
  }

  /*
   * TODO:
   * If the script evaluation is successful, then the return
   * result is either a DOM node to be inserted into the result tree
   * or a string to be added as a text node.
   */

  error:
    ctxt->output = oldOutput;
    ctxt->insert = oldInsert;
    ctxt->type = oldType;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTExtFunction --
 *
 *  Handles evaluation of an extension function.
 *
 * Results:
 *  Returns string returned by Tcl command evaluation.
 *
 * Side effects:
 *  Depends on Tcl command evaluated.
 *
 *----------------------------------------------------------------------------
 */

static void 
TclXSLTExtFunction(xpathCtxt, nargs)
     xmlXPathParserContextPtr xpathCtxt;
     int nargs;
{
  xsltTransformContextPtr xformCtxt;
  TclXSLT_Extension *extinfo;
  Tcl_Obj *cmdPtr, *resultPtr;
  xmlXPathObjectPtr obj;
  int ret;

  Tcl_MutexLock(&libxslt);

  xformCtxt = xsltXPathGetTransformContext(xpathCtxt);

  /*
   * In order to find the instance data we need the
   * XML Namespace URI of this function.
   */

  extinfo = (TclXSLT_Extension *) xsltGetExtData(xformCtxt,
						 xpathCtxt->context->functionURI);

  /*
   * Start constructing the script by first defining the command.
   */

  cmdPtr = Tcl_DuplicateObj(extinfo->tclns);
  Tcl_IncrRefCount(cmdPtr);
  Tcl_AppendStringsToObj(cmdPtr, "::", xpathCtxt->context->function, NULL);

  /*
   * Each argument on the stack is converted to a Tcl_Obj
   * of an appropriate type and passed as an argument to the Tcl command.
   */

  while (nargs) {
    Tcl_Obj *objv[2];

    obj = (xmlXPathObjectPtr) valuePop(xpathCtxt);
    if (obj == NULL) {
      xmlXPathSetError(xpathCtxt, XPATH_INVALID_OPERAND);
      Tcl_DecrRefCount(cmdPtr);
      Tcl_MutexUnlock(&libxslt);
      return;
    }

    objv[0] = TclXSLT_ConvertXPathObjToTclObj(extinfo->interp, obj);
    objv[1] = NULL;
    if (Tcl_ListObjReplace(extinfo->interp, cmdPtr, 1, 0, 1, objv) != TCL_OK) {
      Tcl_BackgroundError(extinfo->interp);
      Tcl_DecrRefCount(objv[0]);
      Tcl_DecrRefCount(cmdPtr);
      Tcl_MutexUnlock(&libxslt);
      return;
    }

    /* When should this XPath object be freed?
     * Immediately before returning from the function call?
     * What if the application retains a pointer to it?
     * If the application destroys the contents, then memory
     * will leak because the XPath object is not freed.
     *
     * TODO: take a copy of the object's content and pass that
     * to the application callback.  That would allow this object
     * to be freed and allow the application to manage the copy.
     
     xmlXPathFreeObject(obj);
     */

    nargs--;
  }

  ret = Tcl_EvalObjEx(extinfo->interp, cmdPtr, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
  resultPtr = Tcl_GetObjResult(extinfo->interp);
  Tcl_DecrRefCount(cmdPtr);
  Tcl_IncrRefCount(resultPtr);

  if (ret == TCL_OK) {
    obj = TclXSLT_ConvertTclObjToXPathObj(extinfo->interp, resultPtr);
    valuePush(xpathCtxt, obj);
  } else {
    xmlGenericError(xmlGenericErrorContext,
		    Tcl_GetStringFromObj(resultPtr, NULL));
    /* Need to define a new error code - this is the closest in meaning */
    xpathCtxt->error = XPATH_UNKNOWN_FUNC_ERROR;
  }

  Tcl_MutexUnlock(&libxslt);

  Tcl_DecrRefCount(resultPtr);

}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLT_ConvertTclObjToXPathObj --
 *
 *  Convert a Tcl Object to an XPath object.
 *  Data type is preserved, with nodesets being
 *  mapped from a list of nodes.
 *
 * NB. Mutex is assumed to be locked when invoking this routine.
 *
 * Results:
 *  XPath Object.
 *
 * Side effects:
 *  None.
 *
 *----------------------------------------------------------------------------
 */

static xmlXPathObjectPtr
TclXSLT_ConvertTclObjToXPathObj(interp, objPtr)
     Tcl_Interp *interp;
     Tcl_Obj *objPtr;
{
  xmlNodePtr nodePtr;
  xmlDocPtr docPtr;

  if (TclDOM_libxml2_GetNodeFromObj(interp, objPtr, &nodePtr) == TCL_OK) {
    return xmlXPathNewNodeSet(nodePtr);
  }
  
   if (TclXML_libxml2_GetDocFromObj(interp, objPtr, &docPtr) == TCL_OK) {
    return xmlXPathNewNodeSet((xmlNodePtr) docPtr);

  }
  
  if (objPtr->typePtr == Tcl_GetObjType("int") ||
      objPtr->typePtr == Tcl_GetObjType("double")) {
    double number;

    if (Tcl_GetDoubleFromObj(interp, objPtr, &number) == TCL_OK) {
      return xmlXPathNewFloat(number);
    } else {
      return NULL;
    }
  } else if (objPtr->typePtr == Tcl_GetObjType("boolean")) {
    int boolean;

    if (Tcl_GetBooleanFromObj(interp, objPtr, &boolean) == TCL_OK) {
      return xmlXPathNewBoolean(boolean);
    } else {
      return NULL;
    }
  } else if (objPtr->typePtr == Tcl_GetObjType("list")) {
    /*
     * If each of the elements can be converted to a node,
     * then return a nodeset.
     */

    int i, len;
    Tcl_Obj **listPtr;
    xmlNodeSetPtr nset;

    Tcl_ListObjGetElements(interp, objPtr, &len, &listPtr);
    if (len == 0) {
      return xmlXPathNewNodeSet(NULL);
    }

    /*
     * First pass: check that the elements are all nodes.
     */
    for (i = 0; i < len; i++) {
      if (TclXML_libxml2_GetDocFromObj(interp, listPtr[i], &docPtr) == TCL_OK) {
        continue;
      }
      if (TclDOM_libxml2_GetNodeFromObj(interp, listPtr[i], &nodePtr) != TCL_OK) {
        return xmlXPathNewString((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL));
      }
    }
    /*
     * Now go ahead and create the nodeset (we already did the hard
     * work to create internal reps in pass 1).
     */
    if (TclXML_libxml2_GetDocFromObj(interp, listPtr[0], &docPtr) == TCL_OK) {
      nset = xmlXPathNodeSetCreate((xmlNodePtr) docPtr);
    } else {
      TclDOM_libxml2_GetNodeFromObj(interp, listPtr[0], &nodePtr);
      nset = xmlXPathNodeSetCreate(nodePtr);
    }
    for (i = 1; i < len; i++) {
      if (TclXML_libxml2_GetDocFromObj(interp, listPtr[i], &docPtr) == TCL_OK) {
        xmlXPathNodeSetAdd(nset, (xmlNodePtr) docPtr);
      } else {
        TclDOM_libxml2_GetNodeFromObj(interp, listPtr[i], &nodePtr);
        xmlXPathNodeSetAdd(nset, nodePtr);
      }
    }
    return xmlXPathWrapNodeSet(nset);

  } else {
    return xmlXPathNewString((const xmlChar *) Tcl_GetStringFromObj(objPtr, NULL));
  }
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLT_ConvertXPathObjToTclObj --
 *
 *  Convert an XPath object to a Tcl Object.
 *  Data type is preserved, with nodesets being
 *  mapped to a list of nodes.
 *
 * Results:
 *  Tcl Object.
 *
 * Side effects:
 *  None.
 *
 *----------------------------------------------------------------------------
 */

static Tcl_Obj *
TclXSLT_ConvertXPathObjToTclObj(interp, xpobj)
     Tcl_Interp *interp;
     xmlXPathObjectPtr xpobj;
{
  Tcl_Obj *objPtr;
  int i;

  switch (xpobj->type) {
    case XPATH_XSLT_TREE:
    case XPATH_NODESET:

      objPtr = Tcl_NewListObj(0, NULL);
      if (xpobj->nodesetval) {
	for (i = 0; i < xpobj->nodesetval->nodeNr; i++) {
	  Tcl_Obj *nodeObjPtr = NULL;
	  if (xpobj->nodesetval->nodeTab[i] &&
	      xpobj->nodesetval->nodeTab[i]->type == XML_DOCUMENT_NODE) {
	    nodeObjPtr = TclXML_libxml2_CreateObjFromDoc((xmlDocPtr) xpobj->nodesetval->nodeTab[i]);
	  } else if (xpobj->nodesetval->nodeTab[i]) {
	    nodeObjPtr = TclDOM_libxml2_CreateObjFromNode(interp, xpobj->nodesetval->nodeTab[i]);
	  }
	  Tcl_ListObjAppendElement(interp, objPtr, nodeObjPtr);
	}
      }

      break;

    case XPATH_BOOLEAN:
      objPtr = Tcl_NewBooleanObj(xpobj->boolval);
      break;
      
    case XPATH_NUMBER:
      objPtr = Tcl_NewDoubleObj(xpobj->floatval);
      break;

    case XPATH_STRING:
    case XPATH_UNDEFINED:
    case XPATH_POINT:
    case XPATH_RANGE:
    case XPATH_LOCATIONSET:
    case XPATH_USERS:
    default:
      objPtr = Tcl_NewStringObj((CONST char *) xmlXPathCastToString(xpobj), -1);

      break;
  }

  return objPtr;
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTExtShutdown --
 *
 *  Clean up.
 *
 * Results:
 *  None.
 *
 * Side effects:
 *  None.
 *
 *----------------------------------------------------------------------------
 */

static void
TclXSLTExtShutdown(ctxt, URI, userdata)
     xsltTransformContextPtr ctxt;
     const xmlChar *URI;
     void *userdata;
{
  /* Nothing to do */
}

/*
 *----------------------------------------------------------------------------
 *
 * TclXSLTSecurity --
 * TclXSLTSecurityReadFile --
 * TclXSLTSecurityWriteFile --
 * TclXSLTSecurityCreateDirectory --
 * TclXSLTSecurityReadNetwork --
 * TclXSLTSecurityWriteNetwork --
 *
 *  Check if external operations are permitted.
 *
 * Results:
 *  Returns boolean value.
 *
 * Side effects:
 *  Depends on callback.
 *
 *----------------------------------------------------------------------------
 */

static int
TclXSLTSecurity(name, method, value)
     Tcl_Obj *name;
     const char *method;
     const char *value;
{
  ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
  Tcl_Interp *master;
  Tcl_Obj *cmdPtr, *pathPtr;
  int result, permitted;

  if (Tcl_IsSafe(tsdPtr->interp)) {

    /*
     * Invoke hidden command
     */

    master = Tcl_GetMaster(tsdPtr->interp);

    if (!Tcl_IsSafe(master)) {
      return 0;
    }

    if (Tcl_GetInterpPath(master, tsdPtr->interp) != TCL_OK) {
      return 0;
    }
    pathPtr = Tcl_GetObjResult(master);

    cmdPtr = Tcl_NewListObj(0, NULL);
    Tcl_IncrRefCount(cmdPtr);
    Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("interp", -1));
    Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("invokehidden", -1));
    Tcl_ListObjAppendElement(master, cmdPtr, pathPtr);
    Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("-global", -1));
    Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj("::xslt::security", -1));
    Tcl_ListObjAppendElement(master, cmdPtr, name);
    Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj(method, -1));
    Tcl_ListObjAppendElement(master, cmdPtr, Tcl_NewStringObj(value, -1));

    result = Tcl_EvalObjEx(master, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);

    Tcl_DecrRefCount(cmdPtr);
  } else {

    /*
     * Invoke command normally
     */

    cmdPtr = Tcl_NewListObj(0, NULL);
    Tcl_IncrRefCount(cmdPtr);
    Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj("::xslt::security", -1));
    Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, name);
    Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj(method, -1));
    Tcl_ListObjAppendElement(tsdPtr->interp, cmdPtr, Tcl_NewStringObj(value, -1));

    result = Tcl_EvalObjEx(tsdPtr->interp, cmdPtr, TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);

    Tcl_DecrRefCount(cmdPtr);
  }

  if (result == TCL_OK) {
    if (Tcl_GetBooleanFromObj(tsdPtr->interp, Tcl_GetObjResult(tsdPtr->interp), &permitted) == TCL_OK) {
      return permitted;
    } else if (Tcl_IsSafe(tsdPtr->interp)) {
      return 0;
    } else {
      return 1;
    }
  } else if (Tcl_IsSafe(tsdPtr->interp)) {
    return 0;
  } else {
    return 1;
  }
}
static Tcl_Obj *
TclXSLTSecurityGetName(ctxt)
     xsltTransformContextPtr ctxt;
{
  ThreadSpecificData *tsdPtr = (ThreadSpecificData *) Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));
  Tcl_HashEntry *entryPtr;

  if (ctxt) {
    entryPtr = Tcl_FindHashEntry(tsdPtr->stylesheets, (ClientData) ctxt->style);
    if (entryPtr) {
      return Tcl_NewStringObj((char *) Tcl_GetHashValue(entryPtr), -1);
    } else {
      return Tcl_NewObj();
    }
  } else {
    return Tcl_NewObj();
  }
}
static int
TclXSLTSecurityReadFile(sec, ctxt, value)
     xsltSecurityPrefsPtr sec;
     xsltTransformContextPtr ctxt;
     const char *value;
{
  return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "readfile", value);
}
static int
TclXSLTSecurityWriteFile(sec, ctxt, value)
     xsltSecurityPrefsPtr sec;
     xsltTransformContextPtr ctxt;
     const char *value;
{
  return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "writefile", value);
}
static int
TclXSLTSecurityCreateDirectory(sec, ctxt, value)
     xsltSecurityPrefsPtr sec;
     xsltTransformContextPtr ctxt;
     const char *value;
{
  return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "createdirectory", value);
}
static int
TclXSLTSecurityReadNetwork(sec, ctxt, value)
     xsltSecurityPrefsPtr sec;
     xsltTransformContextPtr ctxt;
     const char *value;
{
  return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "readnetwork", value);
}
static int
TclXSLTSecurityWriteNetwork(sec, ctxt, value)
     xsltSecurityPrefsPtr sec;
     xsltTransformContextPtr ctxt;
     const char *value;
{
  return TclXSLTSecurity(TclXSLTSecurityGetName(ctxt), "writenetwork", value);
}
