<desc><p>Return the current configuration value option for the
parser.</p> 
          <p>If the -handlerset option is used, the configuration for the
named handler set is returned.</p>
          </desc>
        </commanddef>

        <commanddef>
          <command><cmd>parser</cmd> <method>currentmarkup</method></command>

          <desc><p>Returns the current markup as found in the XML, if
          called from within one of its markup event handler script
          (-elementstartcommand, -elementendcommand, -commentcommand
          and -processinginstructioncommand). Otherwise it return the
          empty string.</p></desc>
        </commanddef>

        <commanddef>
          <command><cmd>parser</cmd> <method>free</method></command>

          <desc><p>Deletes the parser and the parser command. A parser cannot
be freed from within one of its handler callbacks (neither directly nor
indirectly) and will raise a tcl error in this case.</p></desc>
        </commanddef>

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

    XML_SetElementHandler(expat->parser,
                          TclGenExpatElementStartHandler,
                          TclGenExpatElementEndHandler);
    XML_SetNamespaceDeclHandler(expat->parser,
                                TclGenExpatStartNamespaceDeclHandler,
                                TclGenExpatEndNamespaceDeclHandler);
    XML_SetCharacterDataHandler(expat->parser,
                                TclGenExpatCharacterDataHandler);
    XML_SetProcessingInstructionHandler(expat->parser,
                                        TclGenExpatProcessingInstructionHandler);
    XML_SetDefaultHandlerExpand(expat->parser, TclGenExpatDefaultHandler);


    XML_SetNotationDeclHandler(expat->parser,
                               TclGenExpatNotationDeclHandler);
    XML_SetExternalEntityRefHandler(expat->parser,
                                    TclGenExpatExternalEntityRefHandler);
    XML_SetUnknownEncodingHandler(expat->parser,
                                  TclGenExpatUnknownEncodingHandler,
                                  (void *) expat);


    XML_SetCommentHandler(expat->parser, TclGenExpatCommentHandler);

    XML_SetNotStandaloneHandler(expat->parser, 
                                TclGenExpatNotStandaloneHandler);
    XML_SetCdataSectionHandler(expat->parser, 
                               TclGenExpatStartCdataSectionHandler,
                               TclGenExpatEndCdataSectionHandler);

    XML_SetElementDeclHandler(expat->parser, TclGenExpatElementDeclHandler);

    XML_SetAttlistDeclHandler(expat->parser, TclGenExpatAttlistDeclHandler);

    XML_SetDoctypeDeclHandler(expat->parser,
                              TclGenExpatStartDoctypeDeclHandler,
                              TclGenExpatEndDoctypeDeclHandler);

    XML_SetXmlDeclHandler (expat->parser, TclGenExpatXmlDeclHandler);

    XML_SetEntityDeclHandler (expat->parser,
                              TclGenExpatEntityDeclHandler);
    if (expat->noexpand) {

        XML_SetDefaultHandler(expat->parser,
                              TclGenExpatDefaultHandler);
    } else {

        XML_SetDefaultHandlerExpand(expat->parser,
                                    TclGenExpatDefaultHandler);
    }
    
    XML_SetUserData(expat->parser, (void *) expat);
    
    return TCL_OK;
}

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

/*
 *----------------------------------------------------------------------------
 *
 * CurrentmarkupCommand --
 *
 *	Set as defaultHandler prior to XML_Currentmarkup() call.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores the markup context in expapt->currentmarkup.
 *
 *----------------------------------------------------------------------------
 */
static void
CurrentmarkupCommand(userData, s, len)
     void *userData;
     CONST char *s;
     int len;
{
    TclGenExpatInfo *expat = (TclGenExpatInfo *) userData;

    if (expat->status != TCL_OK) {
        return;
    }
  
    if (expat->cdata) {
        /* TclGenExpatCharacterDataHandler() was called and
         * initialized expat->cdata, but expat->cdata isn't reset by
         * TclExpatDispatchPCDATA(), so we're called from
         * -characterdatacommand and return the empty string by
         * definition. */
        expat->currentmarkup = NULL;
        expat->currentmarkuplen = 0;
        return;
    }
    expat->currentmarkup = s;
    expat->currentmarkuplen = len;
    return;
}



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

     Tcl_Obj *CONST objv[];
{
  TclGenExpatInfo *expat = (TclGenExpatInfo *) clientData;
  char *data;
  int len = 0, optionIndex, result = TCL_OK;

  static CONST84 char *options[] = {
      "configure", "cget", "currentmarkup", "free", "get",
      "parse", "parsechannel", "parsefile", "reset", NULL
  };
  enum options {
      EXPAT_CONFIGURE, EXPAT_CGET, EXPAT_CURRENTMARKUP, EXPAT_FREE, EXPAT_GET,
      EXPAT_PARSE, EXPAT_PARSECHANNEL, EXPAT_PARSEFILE, EXPAT_RESET
  };


  if (objc < 2) {
      Tcl_SetResult (interp, 
                     "wrong # args: should be \"parserCmd method ?arg ...?\"",

        break;

    case EXPAT_CGET:

        CheckArgs (3,5,2, "?-handlerset handlersetname? switch");
        result = TclExpatCget(interp, expat, objc - 2, objv + 2);
        break;

    case EXPAT_CURRENTMARKUP:

        CheckArgs (2,2,1, "");
        if (expat->parsingState < 2) {
            Tcl_ResetResult(expat->interp);
            break;
        }
        
        XML_SetDefaultHandlerExpand(expat->parser,
                                    CurrentmarkupCommand);
        XML_DefaultCurrent(expat->parser);
        if (expat->currentmarkuplen) {
            Tcl_SetObjResult(expat->interp, 
                             Tcl_NewStringObj(expat->currentmarkup,
                                              expat->currentmarkuplen));
        } else {
            Tcl_ResetResult(expat->interp);
        }
        expat->currentmarkup = NULL;
        expat->currentmarkuplen = 0;
        if (expat->noexpand) {
            XML_SetDefaultHandler(expat->parser,
                                  TclGenExpatDefaultHandler);
        } else {
            XML_SetDefaultHandlerExpand(expat->parser,
                                        TclGenExpatDefaultHandler);
        }
        result = TCL_OK;
        break;

    case EXPAT_FREE:

        CheckArgs (2,2,1,"");

        if (expat->parsingState > 1) {
            Tcl_SetResult (interp, "parser freeing not allowed from within "

	Tcl_IncrRefCount(activeTclHandlerSet->elementstartcommand);
        rc = Tcl_GetCommandInfo(interp, Tcl_GetString(objPtr[1]), &cmdInfo);
        if (rc && cmdInfo.isNativeObjectProc) {
            activeTclHandlerSet->elementstartObjProc = cmdInfo.objProc;
            activeTclHandlerSet->elementstartclientData 
                = cmdInfo.objClientData;
        } else {

            activeTclHandlerSet->elementstartObjProc = NULL;
        }
	break;

      case EXPAT_ELEMENTENDCMD:		/* -elementendcommand */

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

	activeTclHandlerSet->elementendcommand = objPtr[1];
	Tcl_IncrRefCount(activeTclHandlerSet->elementendcommand);
        rc = Tcl_GetCommandInfo(interp, Tcl_GetString(objPtr[1]), &cmdInfo);
        if (rc && cmdInfo.isNativeObjectProc) {
            activeTclHandlerSet->elementendObjProc = cmdInfo.objProc;
            activeTclHandlerSet->elementendclientData = cmdInfo.objClientData;
        } else {

            activeTclHandlerSet->elementendObjProc = NULL;
        }
	break;

      case EXPAT_STARTNAMESPACEDECLCMD:	/* -startnamespacedeclcommand */

        CheckDefaultTclHandlerSet;

	activeTclHandlerSet->datacommand = objPtr[1];
	Tcl_IncrRefCount(activeTclHandlerSet->datacommand);
        rc = Tcl_GetCommandInfo (interp, Tcl_GetString(objPtr[1]), &cmdInfo);
        if (rc && cmdInfo.isNativeObjectProc) {
            activeTclHandlerSet->datacommandObjProc = cmdInfo.objProc;
            activeTclHandlerSet->datacommandclientData = cmdInfo.objClientData;
        } else {

            activeTclHandlerSet->datacommandObjProc = NULL;
        }
	break;

      case EXPAT_PICMD:			/* -processinginstructioncommand */

        CheckDefaultTclHandlerSet;

        break;

    case EXPAT_NOEXPAND:
        if (Tcl_GetBooleanFromObj (interp, objv[1], &bool) != TCL_OK) {
            return TCL_ERROR;
        }
        if (bool) {

            XML_SetDefaultHandler( expat->parser,
                                   TclGenExpatDefaultHandler);

        } else {

            XML_SetDefaultHandlerExpand( expat->parser,
                                         TclGenExpatDefaultHandler);
        }
        expat->noexpand = bool;
        break;

    }

    objPtr += 2;

              activeCHandlerSet->datacommand (activeCHandlerSet->userData,
                                              s, len);
          }
      }
      activeCHandlerSet = activeCHandlerSet->nextHandlerSet;
  }
  Tcl_DecrRefCount (expat->cdata);
  expat->cdata = NULL;
  return;
}


/*
 *----------------------------------------------------------------------------
 *

    int parsingState;           /* 0 == freshly (re-)initialized
                                   1 == initParserProcs called
                                   2 == parsing an input chunk */
    XML_Char nsSeparator;       
    int paramentityparsing;     
    int noexpand;
    int useForeignDTD;
    CONST char *currentmarkup;  /* Used to transfer data for method */
    int currentmarkuplen;       /* currentmarkup */
 
    TclHandlerSet *firstTclHandlerSet;
    CHandlerSet *firstCHandlerSet;
} TclGenExpatInfo;

/*--------------------------------------------------------------------------
|   Function prototypes
|

#    parser-5.*: parse input from channel
#    parser-6.*: reuse parser 
#    parser-7.*: parser reset
#    parser-8.*: parser free
#    parser-9.*: parser parse
#    parser-10.*: return code 'return' from callback
#    parser-11.*: parser input from filename
#    parser-12.*: parser currentmarkup
#
# Copyright (c) 1999-2000 Zveno Pty Ltd.
# Copyright (c) 2002-2015 Rolf Ade
#
# $Id$

source [file join [file dir [info script]] loadtdom.tcl]

proc parray arrayName {
    upvar #0 $arrayName arr

proc elementstart {args} {
    global parser

    $parser parse {<root>foo bar</root>}
}

test parser-9.1 {try to use the parser from within one of its callbacks} {
    set parser [expat -elementstartcommand elementstart]
    set result [catch {$parser parse <root>foo</root>} errMsg]
    lappend result $errMsg
    $parser free
    set result
} {1 {Parser already in use.}}

proc calledFromElementstart {args} {
    global parser

    $parser parse {<root>foo bar</root>}
}

proc elementstart {args} {
    calledFromElementstart
}

test parser-9.2 {try to use the parser from within one of its callbacks} {
    set parser [expat -elementstartcommand elementstart]
    set result [catch {$parser parse <root>foo</root>} errMsg]
    lappend result $errMsg
    $parser free
    set result
} {1 {Parser already in use.}}

    set parser [::xml::parser parser-11.1 -elementstartcommand Count]
    set file [file join [pwd] [file dir [info script]] data/books.xml]
    $parser parsefile $file
    set ::count
} {42}


proc elementstart-12.1 {parser args} {
    global result
    append result [$parser currentmarkup]
}

proc elementend-12.1 {parser args} {
    global result
    append result [$parser currentmarkup]
}

test parser-12.1 {currentmarkup method} {
    catch {unset result}
    set result ""
    set p [expat parser-12.1 -noexpand]
    $p configure \
        -elementstartcommand [list elementstart-12.1 $p] \
        -elementendcommand [list elementend-12.1 $p]
    $p parse {<root rootatt="rootatt">text<a
        a_att1="a_att1"
        a_att2 = "a_att2"/><b>more text</b></root>}
    $p free
    set result
} {<root rootatt="rootatt"><a
        a_att1="a_att1"
        a_att2 = "a_att2"/><b></b></root>}

proc characterdata-12.2 {parser data} {
    global result
    append result [$parser currentmarkup]
}
test parser-12.2 {currentmarkup method} {
    catch {unset result}
    set result ""
    set p [expat parser-12.2]
    $p configure \
        -characterdatacommand [list characterdata-12.2 $p] 
    $p parse {<root rootatt="rootatt">text<a
        a_att1="a_att1"
        a_att2 = "a_att2"/><b>more text</b></root>}
    $p free
    set result
} {}

test parser-12.3 {currentmarkup method} {
    set p [expat parser-12.3]
    set result [$p currentmarkup]
    $p free
    set result
} {}

proc elementstart-12.4 {parser handlerset args} {
    global result
    append result "$handlerset: [$parser currentmarkup]\n"
}
proc elementend-12.4 {parser handlerset args} {
    global result
    append result "$handlerset: [$parser currentmarkup]\n"
}
test parser-12.4 {currentmarkup method - multiple handler set} {
    catch {unset result}
    set result ""
    set p [expat parser-12.4]
    $p configure \
        -elementstartcommand [list elementstart-12.4 $p default] \
        -elementendcommand [list elementend-12.4 $p default] \
        -handlerset "additional" \
        -elementstartcommand [list elementstart-12.4 $p "additional"] \
        -elementendcommand [list elementend-12.4 $p "additional"]
    $p parse {<root rootatt="rootatt">text<a
        a_att1="a_att1"
        a_att2 = "a_att2"/><b>more text</b></root>}
    $p free
    set result
} {default: <root rootatt="rootatt">
additional: <root rootatt="rootatt">
default: <a
        a_att1="a_att1"
        a_att2 = "a_att2"/>
additional: <a
        a_att1="a_att1"
        a_att2 = "a_att2"/>
default: 
additional: 
default: <b>
additional: <b>
default: </b>
additional: </b>
default: </root>
additional: </root>
}

proc elementstart-12.5 {parser args} {
    global result
    append result "[$parser currentmarkup]"
}
test parser-12.5 {currentmarkup method - empty element shortcut -elementstartcommand} {
    catch {unset result}
    set result ""
    set p [expat parser-12.5]
    $p configure \
        -elementstartcommand [list elementstart-12.5 $p] 
    $p parse {<root><elem/></root>}
    $p free
    set result
} {<root><elem/>}

proc elementend-12.6 {parser args} {
    global result
    if {[$parser currentmarkup] eq ""} {
        append result "<elementend called, but currentmarkup return empty string>"
    }
    append result "[$parser currentmarkup]"
}
test parser-12.6 {currentmarkup method - empty element shortcut -elementendcommand} {
    catch {unset result}
    set result ""
    set p [expat parser-12.6]
    $p configure \
        -elementendcommand [list elementend-12.6 $p] 
    $p parse {<root><elem/></root>}
    $p free
    set result
} {<elementend called, but currentmarkup return empty string></root>}
    
foreach parser [info commands xmlparser*] {
    $parser free
}
foreach parser [info commands parser-*] {
    $parser free
}

proc elementdeclcommand-12.7 {parser args} {
    global result
    append result "elementdeclcommand: [$parser currentmarkup]"
}

proc entitydeclcommand-12.7 {parser args} {
    global result
    append result "entitydeclcommand: [$parser currentmarkup]"
}

test parser-12.7 {currentmarkup method - not for doctype markup handler} {
    catch {unset result}
    set result ""
    set p [expat parser-12.7]
    $p configure \
        -elementdeclcommand [list elementdeclcommand-12.7 $p] \
        -entitydeclcommand [list entitydeclcommand-12.7 $p]
    $p parse {<!DOCTYPE test [
<!ELEMENT test (#PCDATA) >
<!ENTITY % xx '&#37;zz;'>
<!ENTITY % zz '&#60;!ENTITY tricky "error-prone" >' >
%xx;
]>
<test>This sample shows a &tricky; method.</test>}
    $p free
    set result
} {elementdeclcommand: entitydeclcommand: entitydeclcommand: }

proc pi-12.8 {parser args} {
    global result
    append result "pi: [$parser currentmarkup]"
}
test parser-12.8 {currentmarkup method - processing instruction} {
    catch {unset result}
    set result ""
    set p [expat parser-12.8]
    $p configure \
        -processinginstructioncommand [list pi-12.8 $p]
    $p parse {<doc><?xml-stylesheet type="text/xsl" href="style.xsl"?></doc>}
    $p free
    set result
} {pi: <?xml-stylesheet type="text/xsl" href="style.xsl"?>}

proc comment-12.9 {parser args} {
    global result
    append result "comment: [$parser currentmarkup]"
}
test parser-12.9 {currentmarkup method - comment} {
    catch {unset result}
    set result ""
    set p [expat parser-12.9]
    $p configure \
        -commentcommand [list comment-12.9 $p]
    $p parse {<doc><!-- A comment --></doc>}
    $p free
    set result
} {comment: <!-- A comment -->}


# cleanup
::tcltest::cleanupTests
return

proc PI {target data args} {
    lappend ::result $target $data
}

test pi-1.1 {PI} {
    set ::result {}


    set parser [xml::parser pi-1.1 \
	-processinginstructioncommand PI]
    $parser parse {<?xml version="1.0"?>
<!DOCTYPE Test>
<Test><?Test This is a processing instruction?></Test>
}
    $parser free
    set ::result
} {Test {This is a processing instruction}}

test pi-1.2 {PI: missing trailing ?} {
    set ::result {}


    set parser [xml::parser pi-1.2 \
	-processinginstructioncommand PI]
    set returncode [catch {$parser parse {<?xml version="1.0"?>
<!DOCTYPE Test>
<Test><?Test This is a syntax error></Test>
}} msg]
    $parser free
    list $returncode [regexp {error "unclosed token" at.+} $msg]
} {1 1}

test pi-2.1 {PI with special characters} {
    set ::result {}


    set parser [xml::parser pi-2.1 \
	-processinginstructioncommand PI]
    $parser parse {<?xml version="1.0"?>
<!DOCTYPE Test>
<Test><?Test [if !VMLRender]?></Test>
}
    $parser free
    set ::result
} {Test {[if !VMLRender]}}





# cleanup
::tcltest::cleanupTests
return