2024-09-27  Rolf Ade  <rolf@pointsman.de>

        Added the asTypedList method to the domDoc and domNode
        commands.

        Added the createFromTypedList method to the dom command.

2024-09-23  Rolf Ade  <rolf@pointsman.de>

        Updated to expat 2.6.3.

2024-09-08  Rolf Ade  <rolf@pointsman.de>

        Added the flag -keepTextStart to the expat command.

?<m>-jsonType jsonType</m>? ?<m>objVar</m>?</command>
          <desc>Creates a new 'empty' DOM document object without any
          element node. <m>objVar</m> controls the memory handling as
          explained above. If the option -jsonType is given the
          created document node will be of the given JSON type.</desc>
        </commanddef>

        <commanddef>
        <command><cmd>dom</cmd> <method>createFromTypedList</method> <m>typedList</m> ?<m>objVar</m>?</command>
          <desc><p>Creates a new DOM document from the argument <m>typedList</m>.
          The <m>objVar</m> argument controls the memory handling as
          explained above.</p>

          <p>The <m>typedList</m> argument must be a Tcl list and must
          follow the format of the output of the document command
          method <m>asTypedList</m>, see there.</p></desc>
        </commanddef>
        
        <commanddef>
          <command><cmd>dom</cmd> <method>createNodeCmd</method>
<m>?-returnNodeCmd?</m> <m>?-tagName name?</m> <m>?-jsonType jsonType?</m> <m>?-namespace URI?</m> <m>(element|comment|text|cdata|pi)Node</m> <m>commandName</m></command>
          <desc>This method creates Tcl commands, which in turn create
          tDOM nodes. Tcl commands created by this command are only
          available inside a script given to the domNode methods
          <m>appendFromScript</m> or <m>insertBeforeFromScript</m>. If

        string (with the strings null, true and false for the
        respectively JSON symbol). The value of a member of a JSON
        object may be also a Tcl dict, or a Tcl list or a string and
        the elements of a JSON array list may be a Tcl dict or a Tcl
        list or a string.</p>
        </desc>
      </commanddef>

      <commanddef>
        <command><method>asTypedList</method></command>
        <desc><p>In case the DOM tree includes JSON type information
        this method returns the JSON data as a nested Tcl list.</p>

        <p>The first element of every of this lists describes the type
        of the value. The types are: OBJECT, ARRAY, STRING, NUMBER,
        TRUE, FALSE or NULL.</p>

        <p>If the type is NUMBER or STRING, then the second (and last)
        element is the value. If the type is NULL, TRUE or FALSE the
        list does not have any other elements.</p>
        
        <p>If the type is OBJECT the second value will be a Tcl list
        of property name and value pairs, which means the second
        element could be used as dict. The value will be a Tcl list
        build by the rules of the <m>asTypedList</m> method.</p>

        <p>If the type is ARRAY the second value will be a Tcl list of
        the JSON array values, each one build by the rules of the
        <m>asTypedList</m> method.</p>
        </desc>
      </commanddef>
      
      <commanddef>
        <command><method>publicId</method> <m>?publicId?</m></command>
        <desc>Returns the public identifier of the doctype declaration of the
document, if there is one, otherwise the empty string. If there is a value
given to the method, the public identifier of the document is set to this
value.</desc>

      <commanddef>
        <command><m>@attrName</m></command>
        <desc>Returns the value of the attribute <m>attrName</m>.  Short cut
for <m>getAttribute</m>.</desc>
      </commanddef>

      <commanddef>
        <command><method>jsonType</method> <m>?(OBJECT|ARRAY|NONE)|(STRING|NUMBER|TRUE|FALSE|NULL|NONE)?</m></command>
        <desc>Only element and text nodes may have a JSON type and
        only this types of nodes support the <m>jsonType</m> method;
        the other node types return error if called with this method.
        Returns the jsonType of the node. If the optional argument is
        given, the JSON type of the node is set to the given type and
        returned. Valid type arguments for element nodes are OBJECT,
        ARRAY and NONE. Valid type arguments for text nodes are

    int  nestingDepth;
    int  maxnesting;
    char *arrItemElm;
    char *buf;
    domLength len;
} JSONParse;

#define SetResult(str) Tcl_ResetResult(interp); \
                     Tcl_SetStringObj(Tcl_GetObjResult(interp), (str), -1)
#define SetResult3(str1,str2,str3) Tcl_ResetResult(interp);     \
                     Tcl_AppendResult(interp, (str1), (str2), (str3), NULL)

#define errReturn(i,j) {jparse->state = j; return (i);}
    

/* #define DEBUG */
#ifdef DEBUG
# define DBG(x) x
#else
# define DBG(x) 
#endif

        i += clen;
    }
}

/* Parse a single JSON value which begins at json[i]. Return the index
 * of the first character past the end of the value parsed. */

static domLength jsonParseValue (
    domNode   *parent,
    char      *json,
    domLength  i,
    JSONParse *jparse
    )
{
    char c, save;

    } else if (c == '\0') {
        return 0;   /* End of input */
    } else {
        errReturn(i,JSON_SYNTAX_ERR);
    }
}

/* Helper function which checks if a given string is a JSON number. */
int
isJSONNumber (
    char *num,
    domLength numlen
    )
{
    domLength i;
    int seenDP, seenE;
    unsigned char c;
    
    if (numlen == 0) return 0;
    seenDP = 0;
    seenE = 0;
    i = 0;
    c = num[0];
    if (!(c == '-' || (c>='0' && c<='9'))) return 0;
    if (c<='0') {
        i = (c == '-' ? i+1 : i);
        if (i+1 < numlen) {
            if (num[i] == '0' && num[i+1] >= '0' && num[i+1] <= '9') {
                return 0;
            }
        }
    }
    i = 1;
    for (; i < numlen; i++) {
        c = num[i];
        if (c >= '0' && c <= '9') continue;
        if (c == '.') {
            if (num[i-1] == '-') return 0;
            if (seenDP) return 0;
            seenDP = 1;
            continue;
        }
        if (c == 'e' || c == 'E') {
            if (num[i-1] < '0') return 0;
            if (seenE) return 0;
            seenDP = seenE = 1;
            c = num[i+1];
            if (c == '+' || c == '-') {
                i++;
                c = num[i+1];
            }
            if (c < '0' || c > '9') return 0;
            continue;
        }
        break;
    }
    /* Catches a plain '-' without following digits */
    if (num[i-1] < '0') return 0;
    /* Catches trailing chars */
    if (i < numlen) return 0;
    return 1;
}

static inline int
getJSONTypeFromList (
    Tcl_Interp *interp,
    Tcl_Obj *list,
    Tcl_Obj **typeValue
    )
{
    Tcl_Obj *symbol;
    char *s;
    domLength slen, llen;
    
    if (Tcl_ListObjIndex (interp, list, 0, &symbol) != TCL_OK) {
        return -1;
    }
    if (!symbol) {
        /* Empty lists are not allowed. */
        SetResult ("Empty list.");
        return -1;
    }
    Tcl_ListObjLength (interp, list, &llen);
    if (llen > 2) {
        SetResult ("Too much list elements.");
        return -1;
    }
    Tcl_ListObjIndex (interp, list, 1, typeValue);
    s = Tcl_GetStringFromObj (symbol, &slen);
    if (strcmp (s, "STRING") == 0) {
        if (*typeValue == NULL) {
            SetResult ("Missing value for STRING.");
            return -1;
        }
        return JSON_STRING;
    } else if (strcmp (s, "OBJECT") == 0) {
        if (*typeValue == NULL) {
            SetResult ("Missing value for OBJECT.");
            return -1;
        }
        return JSON_OBJECT;
    } else if (strcmp (s, "NUMBER") == 0) {
        if (*typeValue == NULL) {
            SetResult ("Missing value for NUMBER.");
            return -1;
        }
        s = Tcl_GetStringFromObj (*typeValue, &slen);
        if (!isJSONNumber (s, slen)) {
            SetResult ("Not a valid NUMBER value.");
            return -1;
        }
        return JSON_NUMBER;
    } else if (strcmp (s, "ARRAY") == 0) {
        if (*typeValue == NULL) {
            SetResult ("Missing value for ARRAY.");
            return -1;
        }
        return JSON_ARRAY;
    } else if (strcmp (s, "TRUE") == 0) {
        if (*typeValue != NULL) {
            SetResult ("No value expected for TRUE.");
            return -1;
        }
        return JSON_TRUE;
    } else if (strcmp (s, "FALSE") == 0) {
        if (*typeValue != NULL) {
            SetResult ("No value expected for FALSE.");
            return -1;
        }
        return JSON_FALSE;
    } else if (strcmp (s, "NULL") == 0) {
        if (*typeValue != NULL) {
            SetResult ("No value expected for NULL.");
            return -1;
        }
        return JSON_NULL;
    } else {
        SetResult3 ("Unkown symbol \"", s, "\".");
        return -1;
    }            
}

static void objectErrMsg (
    Tcl_Interp *interp,
    domNode *node
    ) 
{
    Tcl_Obj *msg;

    msg = Tcl_GetObjResult (interp);
    Tcl_IncrRefCount (msg);
    Tcl_ResetResult (interp);
    Tcl_AppendResult (interp, "object property \"", node->nodeName,
                      "\": ", Tcl_GetString (msg), (char *)NULL);
    Tcl_DecrRefCount (msg);
}

static void arrayErrMsg (
    Tcl_Interp *interp,
    domLength i
    ) 
{
    Tcl_Obj *msg;
    char buf[20];

    msg = Tcl_GetObjResult (interp);
    Tcl_IncrRefCount (msg);
    Tcl_ResetResult (interp);
    sprintf (buf, domLengthConversion, i + 1);
    Tcl_AppendResult (interp, "array element ", buf, ": ",
                      Tcl_GetString (msg), (char *) NULL);
    Tcl_DecrRefCount (msg);
}

static int
TypedList2DOMWorker (
    Tcl_Interp *interp,
    domNode *parent,
    Tcl_Obj *value
    )
{
    Tcl_Obj *property, *pvalue, *pdetail, *aelm, *adetail;
    domLength llen, i, strl;
    domNode *pnode, *container;
    domTextNode *textNode;
    char *str;
    int jsonType;
    
    switch (parent->info) {
    case JSON_OBJECT:
        if (Tcl_ListObjLength (interp, value, &llen) != TCL_OK) {
            return TCL_ERROR;
        }
        if (llen % 2 != 0) {
            SetResult ("An OBJECT value must be a Tcl list with an even "
                       "number of elements.");
            return TCL_ERROR;
        }
        for (i = 0; i < llen; i += 2) {
            /* Since we loop over all elements every element is
             * present and there is no need to check property or
             * pvalue for NULL. */
            Tcl_ListObjIndex (interp, value, i, &property);
            Tcl_ListObjIndex (interp, value, i+1, &pvalue);
            pnode = domAppendNewElementNode (parent, Tcl_GetString (property),
                                             NULL);
            jsonType = getJSONTypeFromList (interp, pvalue, &pdetail);
            if (jsonType < 0) {
                objectErrMsg (interp, pnode);
                return TCL_ERROR;
            }
            if (jsonType < 3) {
                /* JSON_OBJECT or JSON_ARRAY */
                pnode->info = jsonType;
                if (TypedList2DOMWorker (interp, pnode, pdetail) != TCL_OK) {
                    objectErrMsg (interp, pnode);
                    return TCL_ERROR;
                }
            } else {
                /* The other json types are represented by a text node.*/
                switch (jsonType) {
                case JSON_NUMBER:
                case JSON_STRING:
                    str = Tcl_GetStringFromObj (pdetail, &strl);
                    break;
                default:
                    str = "";
                    strl = 0;
                    break;
                }
                textNode = domNewTextNode (parent->ownerDocument,
                                           str, strl, TEXT_NODE);
                textNode->info = jsonType;
                domAppendChild (pnode, (domNode *) textNode);
            }
        }
        break;
    case JSON_ARRAY:
        if (Tcl_ListObjLength (interp, value, &llen) != TCL_OK) {
            return TCL_ERROR;
        }
        for (i = 0; i < llen; i++) {
            Tcl_ListObjIndex (interp, value, i, &aelm);
            jsonType = getJSONTypeFromList (interp, aelm, &adetail);
            if (jsonType < 0) {
                arrayErrMsg (interp, i);
                return TCL_ERROR;
            }
            switch (jsonType) {
            case JSON_OBJECT:
                container = domAppendNewElementNode (parent,
                                                     JSON_OBJECT_CONTAINER,
                                                     NULL);
                container->info = JSON_OBJECT;                
                if (TypedList2DOMWorker (interp, container, adetail) != TCL_OK) {
                    arrayErrMsg (interp, i);
                    return TCL_ERROR;
                }
                break;
            case JSON_ARRAY:
                container = domAppendNewElementNode (parent,
                                                     JSON_ARRAY_CONTAINER,
                                                     NULL);
                container->info = JSON_ARRAY;                
                if (TypedList2DOMWorker (interp, container, adetail) != TCL_OK) {
                    arrayErrMsg (interp, i);
                    return TCL_ERROR;
                }
                break;
            default:
                /* The other json types are represented by a text node.*/
                switch (jsonType) {
                case JSON_NUMBER:
                case JSON_STRING:
                    str = Tcl_GetStringFromObj (adetail, &strl);
                    break;
                default:
                    str = "";
                    strl = 0;
                    break;
                }
                textNode = domNewTextNode (parent->ownerDocument,
                                           str, strl, TEXT_NODE);
                textNode->info = jsonType;
                domAppendChild (parent, (domNode *) textNode);
                break;
            }
        }
        break;
    default:
        /* Every "text node" JSON values are either done directly by
         * TypedList2DOM() or inline in the OBJECT and ARRAY cases in
         * this function. */
        SetResult ("Internal error. Please report.");
        return TCL_ERROR;
    }
    return TCL_OK;
}
    
domDocument *
TypedList2DOM (
    Tcl_Interp *interp,
    Tcl_Obj *typedList
    )
{
    domDocument *doc;
    domNode *rootNode;
    domTextNode *textNode;
    Tcl_Obj *value, *msg;
    char *str;
    domLength strl;
    int jsonType;

    jsonType = getJSONTypeFromList (interp, typedList, &value);
    if (jsonType < 0) {
        msg = Tcl_GetObjResult (interp);
        Tcl_IncrRefCount (msg);
        Tcl_ResetResult (interp);
        Tcl_AppendResult (interp, "Invalid typed list format: ",
                          Tcl_GetString (msg), (char *) NULL);
        Tcl_DecrRefCount (msg);
        return NULL;
    }
    doc  = domCreateDoc (NULL, 0);
    rootNode = doc->rootNode;
    if (jsonType < 3) {
        /* JSON_OBJECT or JSON_ARRAY */
        rootNode->info = jsonType;
        if (TypedList2DOMWorker (interp, rootNode, value) != TCL_OK) {
            msg = Tcl_GetObjResult (interp);
            Tcl_IncrRefCount (msg);
            domFreeDocument(doc, NULL, interp);
            Tcl_ResetResult (interp);
            Tcl_AppendResult (interp, "Invalid typed list format: ",
                              Tcl_GetString (msg), (char *) NULL);
            Tcl_DecrRefCount (msg);
            return NULL;
        }
    } else {
        /* The other json types are represented by a text node.*/
        if (jsonType > 5) {
            /* JSON_STRING or JSON_NUMBER */
            str = Tcl_GetStringFromObj (value, &strl);
        } else {
            str = "";
            strl = 0;
        }
        textNode = domNewTextNode (doc, str, strl, TEXT_NODE);
        textNode->info = jsonType;
        domAppendChild (rootNode, (domNode *) textNode);
    }
    return doc;
}

domDocument *
JSON_Parse (
    char *json,    /* Complete text of the json string being parsed */
    char *documentElement, /* name of the root element, may be NULL */
    int   maxnesting,
    char **errStr,

    char *json,    /* Complete text of the json string being parsed */
    char *documentElement, /* name of the root element, may be NULL */
    int   maxnesting,
    char **errStr,
    domLength *byteIndex
    );

domDocument *
TypedList2DOM (
    Tcl_Interp *interp,
    Tcl_Obj *typedList
    );

int
isJSONNumber (
    char *num,
    domLength numlen
    );

            /* No content at all. This could be an empty string,
             * an empty object or an empty array. We default to
             * empty string. */
            writeChars(jstring, channel, "\"\"",2);
            return;
        case JSON_START:
        case JSON_ARRAY:
            /* The children we are serializing are the value of an
             * array element. The node is a container for either a
             * (nested, in case of JSON_ARRAY) array or an object. */
            /* Look, if the name of the container gives a hint.*/
            if (strcmp (node->nodeName, JSON_ARRAY_CONTAINER)==0) {
                effectivParentType = JSON_ARRAY;
                break;
            }
            /* If we here, heuristics didn't helped. We have to

    int          indent,
    int          outputFlags,
    int          level,
    int          inside
    )
{
    domTextNode *textNode;



    
    switch (node->nodeType) {
    case TEXT_NODE:
        if (inside == JSON_OBJECT) {
            /* We're inside a JSON object. A text node can not be
             * meaningful interpreted as member of an object. Ignore
             * the node */
            return;
        }
        textNode = (domTextNode *) node;
        switch (node->info) {
        case JSON_NUMBER:
            /* Check, if the text value is a JSON number and fall back
             * to string token, if not. This is to ensure, the
             * serialization is always a valid JSON string. */




            if (isJSONNumber (textNode->nodeValue, textNode->valueLength)) {






































                writeChars(jstring, channel, textNode->nodeValue,
                           textNode->valueLength);
            } else {

                tcldom_AppendEscapedJSON (jstring, channel,
                                          textNode->nodeValue,
                                          textNode->valueLength);
            }
            break;
        case JSON_NULL:
            writeChars(jstring, channel, "null",4);
            break;
        case JSON_TRUE:
            writeChars(jstring, channel, "true",4);
            break;

                                      textnode->valueLength);
    } else {
        resultObj = Tcl_NewObj ();
    }
    Tcl_SetObjResult (interp, resultObj);
    return TCL_OK;
}

typedef struct 
{
    Tcl_Obj  *object;
    Tcl_Obj  *array;
    Tcl_Obj  *null;
    Tcl_Obj  *true;
    Tcl_Obj  *false;
    Tcl_Obj  *number;
    Tcl_Obj  *string;
} asTypedListTypes;


/*----------------------------------------------------------------------------
|   tcldom_treeAsTypedList
|
\---------------------------------------------------------------------------*/
static Tcl_Obj*
tcldom_treeAsTypedListWorker (
    domNode    *node,          /* Must be ELEMENT_NODE or TEXT_NODE */
    const asTypedListTypes *c  /* c for string constants */
    )
{
    Tcl_Obj *listObj, *resultObj = Tcl_NewListObj (0, NULL);
    domNode *child, *childchild;
    domTextNode *textNode;

    if (node->nodeType == ELEMENT_NODE) {
        switch (node->info) {
        case JSON_ARRAY:
            listObj = Tcl_NewListObj (0, NULL);
            child = node->firstChild;
            while (child) {
                if (child->nodeType == ELEMENT_NODE
                    || child->nodeType == TEXT_NODE) {
                    Tcl_ListObjAppendElement (
                        NULL, listObj, tcldom_treeAsTypedListWorker (child, c)
                        );
                }
                child = child->nextSibling;
            }
            Tcl_ListObjAppendElement(NULL, resultObj, c->array);
            Tcl_ListObjAppendElement(NULL, resultObj, listObj);
            break;
        case JSON_OBJECT:
            listObj = Tcl_NewListObj (0, NULL);
            child = node->firstChild;
            while (child) {
                Tcl_ListObjAppendElement(NULL, listObj,
                                         Tcl_NewStringObj(child->nodeName, -1));
                if (child->nodeType == ELEMENT_NODE) {
                    if (child->info == 0) {
                        childchild = child->firstChild;
                        while (childchild) {
                            if (childchild->nodeType == TEXT_NODE) {
                                Tcl_ListObjAppendElement(
                                    NULL, listObj,
                                    tcldom_treeAsTypedListWorker (
                                        childchild, c));
                                break;
                            }
                            childchild = childchild->nextSibling;
                        }
                    } else {
                        Tcl_ListObjAppendElement(NULL, listObj,
                                                 tcldom_treeAsTypedListWorker (
                                                     child, c));
                    }
                }
                child = child->nextSibling;
            }
            Tcl_ListObjAppendElement(NULL, resultObj, c->object);
            Tcl_ListObjAppendElement(NULL, resultObj, listObj);
            break;
        }
    } else {
        /* Text node */
        switch (node->info) {
        case JSON_NULL:
            Tcl_ListObjAppendElement (NULL, resultObj, c->null);
            break;
        case JSON_TRUE:
            Tcl_ListObjAppendElement (NULL, resultObj, c->true);
            break;
        case JSON_FALSE:
            Tcl_ListObjAppendElement (NULL, resultObj, c->false);
            break;
        case JSON_NUMBER:
            textNode = (domTextNode *)node;
            if (isJSONNumber (textNode->nodeValue, textNode->valueLength)) {
                Tcl_ListObjAppendElement(NULL, resultObj, c->number);
                Tcl_ListObjAppendElement(
                    NULL, resultObj, Tcl_NewStringObj(textNode->nodeValue,
                                                      textNode->valueLength));
                break;
            }
            /* fall through */
        case JSON_STRING:
        default:
            textNode = (domTextNode *)node;
            Tcl_ListObjAppendElement(NULL, resultObj, c->string);
            Tcl_ListObjAppendElement(
                NULL, resultObj, Tcl_NewStringObj(textNode->nodeValue,
                                                  textNode->valueLength));
            break;
        }
    }
    return resultObj;
}

static void
tcldom_treeAsTypedList (
    Tcl_Interp *interp,
    domNode    *node
    )
{
    asTypedListTypes c;
    
    if (node->nodeType != ELEMENT_NODE && node->nodeType != TEXT_NODE) {
        Tcl_ResetResult (interp);
        return;
    }

    c.object = Tcl_NewStringObj ("OBJECT", 6);
    c.array = Tcl_NewStringObj ("ARRAY", 5);
    c.null = Tcl_NewStringObj ("NULL", 4);
    c.true = Tcl_NewStringObj ("TRUE", 4);
    c.false = Tcl_NewStringObj ("FALSE", 5);
    c.number = Tcl_NewStringObj ("NUMBER", 6);
    c.string = Tcl_NewStringObj ("STRING", 6);

    Tcl_IncrRefCount (c.object);
    Tcl_IncrRefCount (c.array);
    Tcl_IncrRefCount (c.null);
    Tcl_IncrRefCount (c.true);
    Tcl_IncrRefCount (c.false);
    Tcl_IncrRefCount (c.number);
    Tcl_IncrRefCount (c.string);

    if (node->nodeType == ELEMENT_NODE
        && node->info == 0
        && node->firstChild->nodeType == TEXT_NODE) {
        /* Either a value only json document or a OBJECT propertiy
         * element node.*/ 
        node = node->firstChild;
    }
    
    Tcl_SetObjResult (interp, 
                      tcldom_treeAsTypedListWorker (node, &c));

    Tcl_DecrRefCount (c.object);
    Tcl_DecrRefCount (c.array);
    Tcl_DecrRefCount (c.null);
    Tcl_DecrRefCount (c.true);
    Tcl_DecrRefCount (c.false);
    Tcl_DecrRefCount (c.number);
    Tcl_DecrRefCount (c.string);
}

/*----------------------------------------------------------------------------
|   findBaseURI
|
\---------------------------------------------------------------------------*/
const char *findBaseURI (
    domNode *node

        "target",          "data",           "selectNodes",     "namespaceURI",
        "getAttributeNS",  "setAttributeNS", "hasAttributeNS",  "removeAttributeNS",
        "asHTML",          "prefix",         "getBaseURI",      "appendFromScript",
        "xslt",            "toXPath",        "delete",          "getElementById",
        "getElementsByTagName",              "getElementsByTagNameNS",
        "disableOutputEscaping",             "precedes",         "asText",
        "insertBeforeFromScript",            "normalize",        "baseURI",
        "asJSON",          "asTclValue",     "asTypedList",      "jsonType",
        "attributeNames",  "asCanonicalXML", "getByteIndex",
#ifdef TCL_THREADS
        "readlock",        "writelock",
#endif
        NULL
    };
    enum nodeMethod {
        m_firstChild,      m_nextSibling,    m_getAttribute,    m_nodeName,

        m_target,          m_data,           m_selectNodes,     m_namespaceURI,
        m_getAttributeNS,  m_setAttributeNS, m_hasAttributeNS,  m_removeAttributeNS,
        m_asHTML,          m_prefix,         m_getBaseURI,      m_appendFromScript,
        m_xslt,            m_toXPath,        m_delete,          m_getElementById,
        m_getElementsByTagName,              m_getElementsByTagNameNS,
        m_disableOutputEscaping,             m_precedes,        m_asText,
        m_insertBeforeFromScript,            m_normalize,       m_baseURI,
        m_asJSON,          m_asTclValue,     m_asTypedList,     m_jsonType,
        m_attributeNames,  m_asCanonicalXML, m_getByteIndex
#ifdef TCL_THREADS
        ,m_readlock,       m_writelock
#endif
    };

    node = (domNode*) clientData;
    if (TcldomDATA(domCreateCmdMode) == DOM_CREATECMDMODE_AUTO) {

        case m_asTclValue:
            CheckArgs(2,3,2,"?typeVar?");
            if (tcldom_treeAsTclValue (interp, node, (objc == 3) ? objv[2] : NULL)
                != TCL_OK) {
                return TCL_ERROR;
            }
            break;

        case m_asTypedList:
            CheckArgs(2,2,2,"");
            tcldom_treeAsTypedList (interp, node);
            break;

        case m_getAttribute:
            CheckArgs(3,4,2,"attrName ?defaultValue?");
            if (node->nodeType != ELEMENT_NODE) {
                SetResult("NOT_AN_ELEMENT : there are no attributes");
                return TCL_ERROR;
            }
            attr_name = Tcl_GetString(objv[2]);

        /* The following methods will be dispatched to tcldom_NodeObjCmd */
        "getElementById",  "firstChild",                 "lastChild",
        "appendChild",     "removeChild",                "hasChildNodes",
        "childNodes",      "ownerDocument",              "insertBefore",
        "replaceChild",    "appendFromList",             "appendXML",
        "selectNodes",     "baseURI",                    "appendFromScript",
        "insertBeforeFromScript",                        "asJSON",
        "jsonType",        "asTclValue",                 "asTypedList",
#ifdef TCL_THREADS
        "readlock",        "writelock",                  "renumber",
#endif
        NULL
    };
    enum docMethod {
        m_documentElement,  m_getElementsByTagName,       m_delete,

        /* The following methods will be dispatched to tcldom_NodeObjCmd */
        m_getElementById,   m_firstChild,                 m_lastChild,
        m_appendChild,      m_removeChild,                m_hasChildNodes,
        m_childNodes,       m_ownerDocument,              m_insertBefore,
        m_replaceChild,     m_appendFromList,             m_appendXML,
        m_selectNodes,      m_baseURI,                    m_appendFromScript,
        m_insertBeforeFromScript,                         m_asJSON,
        m_jsonType,         m_asTclValue,                 m_asTypedList
#ifdef TCL_THREADS
       ,m_readlock,         m_writelock,                  m_renumber
#endif
    };

    dinfo = (domDeleteInfo*)clientData;
    if (TcldomDATA(domCreateCmdMode) == DOM_CREATECMDMODE_AUTO) {

        case m_hasChildNodes:
        case m_childNodes:
        case m_ownerDocument:
        case m_selectNodes:
        case m_baseURI:
        case m_asJSON:
        case m_asTclValue:
        case m_asTypedList:
        case m_jsonType:
        case m_getElementById:
            /* We dispatch the method call to tcldom_NodeObjCmd */
            if (TcldomDATA(domCreateCmdMode) == DOM_CREATECMDMODE_AUTO) {
                if (dinfo == NULL) {
                    /* tcldom_DocObjCmd was called with a doc token.
                       Since the domCreateCmdMode is 'automatic'

    }
    if (objc > 2) {
        if (Tcl_GetIndexFromObj(interp, objv[1], options, "option",
                                0, &index) != TCL_OK) {
            return TCL_ERROR;
        }
        Tcl_ResetResult(interp);
        if (Tcl_GetIndexFromObj(interp, objv[2], jsonTypes, "jsonType",
                                0, &jsonType) != TCL_OK) {
            return TCL_ERROR;
        }
        if (objc == 4) {
            newObjName = objv[3];
        }
    }

        }
        doc = domCreateDocument (NULL, Tcl_GetString(objv[2]));
    } else {
        doc = domCreateDocument (uri, Tcl_GetString(objv[2]));
    }
    return tcldom_returnDocumentObj (interp, doc, newObjName, 1, 0);
}

/*----------------------------------------------------------------------------
|   tcldom_createFromTypedList
|
\---------------------------------------------------------------------------*/
static
int tcldom_createFromTypedList (
    ClientData  UNUSED(clientData),
    Tcl_Interp *interp,
    int         objc,
    Tcl_Obj    * const objv[]
)
{
    domDocument *doc;
    Tcl_Obj     *newObjName = NULL;

    CheckArgs(2,3,1,"typedList ?newObjVar?");

    if (objc == 3) {
        newObjName = objv[2];
    }

    doc = TypedList2DOM (interp, objv[1]);
    if (doc == NULL) {
        return TCL_ERROR;
    }
    return tcldom_returnDocumentObj(interp, doc, newObjName, 1, 0);
}

/* Helper function to build up the error string message in a central
 * place. Caller must provide byteIndex; line is expected to be > 0 if
 * line/column information is given. */
void tcldom_reportErrorLocation (
    Tcl_Interp *interp,
    int before,

    domLength     repllen;
    Tcl_CmdInfo   cmdInfo;
    Tcl_Obj     * mobjv[MAX_REWRITE_ARGS], *newObj, *storedErrMsg;
    Tcl_DString   cleardString;

    static const char *domMethods[] = {
        "createDocument",  "createDocumentNS",   "createNodeCmd",
        "createFromTypedList", "parse",          "setStoreLineColumn",
        "isCharData",      "isName",             "isPIName",
        "isQName",         "isComment",          "isCDATA",
        "isPIValue",       "isNCName",           "createDocumentNode",
        "setNameCheck",    "setTextCheck",       "setObjectCommands",
        "featureinfo",     "isBMPCharData",      "clearString",
        "isHTML5CustomName",
#ifdef TCL_THREADS
        "attachDocument",  "detachDocument",
#endif
        NULL
    };
    enum domMethod {
        m_createDocument,    m_createDocumentNS,   m_createNodeCmd,
        m_createFromTypedList, m_parse,            m_setStoreLineColumn,
        m_isCharData,        m_isName,             m_isPIName,
        m_isQName,           m_isComment,          m_isCDATA,
        m_isPIValue,         m_isNCName,           m_createDocumentNode,
        m_setNameCheck,      m_setTextCheck,       m_setObjectCommands,
        m_featureinfo,       m_isBMPCharData,      m_clearString,
        m_isHTML5CustomName
#ifdef TCL_THREADS

        case m_createDocumentNS:
            return tcldom_createDocumentNS(clientData, interp, --objc, objv+1);

        case m_createDocumentNode:
            return tcldom_createDocumentNode (clientData, interp, --objc,
                                              objv+1);
        case m_createFromTypedList:
            return tcldom_createFromTypedList (clientData, interp, --objc,
                                               objv+1);
        case m_createNodeCmd:
            return nodecmd_createNodeCmd(interp, --objc, objv+1,
                                         !TcldomDATA(dontCheckName),
                                         !TcldomDATA(dontCheckCharData));
        case m_parse:
            return tcldom_parse(clientData, interp, --objc, objv+1);

#    json-4.*: Unicode
#    json-5.*: Max nesting
#    json-6.*: asJSON
#    json-7.*: jsonType
#    json-8.*: appendFromScript
#    json-9.*: cloneNode
#    json-10.*: asTclValue
#    json-11.*: asTypedList
#    json-12.*: createFromTypedList
# Copyright (c) 2017 Rolf Ade.

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

testConstraint needExpand 1
if {$tcl_version < 8.5} {
    testConstraint needExpand 0
}
# See below the comment in proc dom for explanation
if {[info commands _dom] eq ""} {
    testConstraint nonetest 1
} else {
    testConstraint nonetest 0
}
namespace eval nodeCmds {
    dom createNodeCmd elementNode e1
    dom createNodeCmd -jsonType ARRAY elementNode jae1
    dom createNodeCmd elementNode e2
    dom createNodeCmd commentNode c
    dom createNodeCmd textNode    t
    dom createNodeCmd -jsonType TRUE textNode true

test json-1.8 {Parse JSON - true, false, null} {
    set doc [dom parse -json -jsonroot "JSONObject" {{"a":true,"b":false,"c":null,"d":"true","e":""}}]
    set result [$doc asXML -indent none]
    $doc delete
    set result
} {<JSONObject><a>true</a><b>false</b><c>null</c><d>true</d><e></e></JSONObject>}

test json-1.9 {JSON syntax error} {nonetest} {
    set result [catch {dom parse -json {{"a" "a value"}}} errMsg]
    list $result $errMsg
} {1 {error "JSON syntax error" at position 5
"{"a" " <--Error-- a value"}"}}

test json-1.10 {JSON syntax error} {nonetest} {
    set result [catch {dom parse -json {{"a":00.23}}} errMsg]
    list $result $errMsg
} {1 {error "JSON syntax error" at position 6
"{"a":00 <--Error-- .23}"}}

test json-1.11 {JSON syntax error} {nonetest} {
    set result [catch {dom parse -json {{"a":-00.23}}} errMsg]
    list $result $errMsg
} {1 {error "JSON syntax error" at position 7
"{"a":-00 <--Error-- .23}"}}

test json-1.12 {JSON syntax error} {nonetest} {
    set result [catch {dom parse -json {{"a":.23}}} errMsg]
    list $result $errMsg
} {1 {error "JSON syntax error" at position 5
"{"a":. <--Error-- 23}"}}

test json-1.13 {JSON syntax error} {nonetest} {
    set result [catch {dom parse -json {{"a":-.23}}} errMsg]
    list $result $errMsg
} {1 {error "JSON syntax error" at position 6
"{"a":-. <--Error-- 23}"}}

test json-1.14 {JSON syntax error} {nonetest} {
    set result [catch {dom parse -json {{"a":-}}} errMsg]
    list $result $errMsg
} {1 {error "JSON syntax error" at position 5
"{"a":- <--Error-- }"}}

test json-1.15 {Parse JSON - nested object} {
    set doc [dom parse -json {["a",["aa","bb"],"b"]}]
    set result [$doc asXML -indent none]
    $doc delete
    set result
} "a<arraycontainer>aabb</arraycontainer>b"

set notJsons {
    {{null}}
    {{1.23}}
    {{"string"}}
    {{"e":}}
}
test json-1.16 {Invalid input} {nonetest} {
    set result ""
    set ind 0
    foreach notJson $notJsons {
        if {![catch {dom parse -json $notJson docNode} errMsg]} {
            lappend result $errMsg
        }
    }
    set result
} ""

test json-1.17 {Literal binary 0 (NUL, '\0') is not allowed in input} {nonetest} {
    catch {dom parse -json "\"a\u0000\""}
} 1

test json-1.18 {Escaped binary 0 (NUL, '\0') is OK} {
    dom parse -json "\"a\\u0000\"" doc
    set result [$doc asJSON]
    $doc delete
    set result
} "\"a\\u0000\""

test json-1.19 {Invalid input - incomplete \u escape} {nonetest} {
    set result 1
    foreach jsonstr {
        "ab\u00"
        "ab\ua"
        "ab\u12"
        "ab\u123"
        "ab\u123g"

test json-3.4.1 {unescaping} {
    set doc [dom parse -jsonroot json -json {["\\a","\u0071"]}]
    set result [$doc asXML -indent none]
    $doc delete
    set result
} {<json>\aq</json>}

test json-3.5 {unescaping} {nonetest} {
    set result [catch {dom parse -json {{"this":"a\lb"}}} errMsg]
    list $result $errMsg
} {1 {error "JSON syntax error" at position 11
"{"this":"a\l <--Error-- b"}"}}

test json-3.6 {unescaping} {
    set doc [dom parse -json {{"this":"a\nbc"}}]

			4,
			"abc"
		]
	},
	"b": "bvalue"
}}

if {[info commands _dom] eq ""} {

test json-7.1 {jsonType} {
    set doc [dom parse {<j>foo</j>}]
    set root [$doc documentElement]
    set result [list]
    lappend result [$root asJSON]
    lappend result [$root jsonType]
    $root jsonType ARRAY

        nodeCmds::true
        nodeCmds::false
    }
    set result [$doc asJSON]
    $doc delete
    set result
} {[null,true,false]}
}

test json-9.1 {cloneNode -deep} {
    dom parse -json {[["a",1,"b",{"foo":"bar","baz":"boo"},null],"",null]} doc
    dom createDocument some other
    $other documentElement root
    $root appendChild [[$doc firstChild] cloneNode -deep]
    set result [[$root firstChild] asJSON]

    }}
    set doc [dom parse -json -jsonroot myjson $json]
    set myjson [$doc documentElement]
    set dict [$myjson asTclValue resulttype]
    $doc delete
    list $dict $resulttype
} {{Titel Wirtschaftsinformatik Keywords {Introduction Basics} Year 2022} dict}

test json-11.1 {asTypedList} {
    set json {{
        "Titel": "Wirtschaftsinformatik",
        "Keywords": ["Introduction","Basics"],
        "Year": 2022
    }}
    set doc [dom parse -json $json]
    set result [$doc asTypedList]
    $doc delete
    set result
} {OBJECT {Titel {STRING Wirtschaftsinformatik} Keywords {ARRAY {{STRING Introduction} {STRING Basics}}} Year {NUMBER 2022}}}

test json-11.2 {asTypedList} {
    set json {{
        "stringproperty": "abc",
        "objectproperty": {"one": 1, "two": "two"},
        "array": ["foo", -2.23, null, true, false, {"one": 1, "two": "two"}, [2,16,24]],
        "number": 2022,
        "null": null,
        "true": true,
        "false": false
    }}
    set doc [dom parse -json $json]
    set result [$doc asTypedList]
    $doc delete
    set result
} {OBJECT {stringproperty {STRING abc} objectproperty {OBJECT {one {NUMBER 1} two {STRING two}}} array {ARRAY {{STRING foo} {NUMBER -2.23} NULL TRUE FALSE {OBJECT {one {NUMBER 1} two {STRING two}}} {ARRAY {{NUMBER 2} {NUMBER 16} {NUMBER 24}}}}} number {NUMBER 2022} null NULL true TRUE false FALSE}}

test json-11.3 {asTypedList} {
    set json {{
        "one two": "abc",
        "one\u007btwo": "abc",
        " one two ": "edf"
    }}
    set doc [dom parse -json $json]
    set result [$doc asTypedList]
    $doc delete
    set result
} {OBJECT {{one two} {STRING abc} one\{two {STRING abc} { one two } {STRING edf}}}

test json-11.4 {asTypedList} {
    set result ""
    foreach json {
        {"string foo"}
        null
        true
        false
        -1.23
    } {
        set doc [dom parse -json $json]
        lappend result [$doc asTypedList]
        $doc delete
    }
    set result
} {{STRING {string foo}} NULL TRUE FALSE {NUMBER -1.23}}

test json-11.5 {asTypedList} {
    set result ""
    set json {{
        "Keywords": ["Introduction","Basics"],
        "Data": {"one": "two", "three": true},
        "Titel": "Wirtschaftsinformatik"
    }}
    set doc [dom parse -json $json]
    set node [$doc firstChild]
    while {$node ne ""} {
        lappend result [$node asTypedList]
        set node [$node nextSibling]
    }
    $doc delete
    set result
} {{ARRAY {{STRING Introduction} {STRING Basics}}} {OBJECT {one {STRING two} three TRUE}} {STRING Wirtschaftsinformatik}}

if {[info commands _dom] eq ""} {

test json-12.1 {createFromTypedList} {
    set doc [dom createFromTypedList {OBJECT {Titel {STRING Wirtschaftsinformatik} Keywords {ARRAY {{STRING Introduction} {STRING Basics}}} Year {NUMBER 2022}}}]
    set result [$doc asJSON]
    $doc delete
    set result
} {{"Titel":"Wirtschaftsinformatik","Keywords":["Introduction","Basics"],"Year":2022}}

test json-12.2 {createFromTypedList} {
    set typedList {OBJECT {Titel {STRING Wirtschaftsinformatik} Keywords {ARRAY {{STRING Introduction} {STRING Basics}}} Year {NUMBER 2022}}}
    set doc [dom createFromTypedList $typedList]
    set result [$doc asTypedList]
    $doc delete
    expr {$typedList eq $result}
} 1

proc createFromTypedList {list} {
    dom createFromTypedList $list doc
    if {$list eq [$doc asTypedList]} {
        return ""
    }
    error "Invalid turnaround."
}
test json-12.3 {createFromTypedList} {
    createFromTypedList {OBJECT {Titel {STRING Wirtschaftsinformatik} Keywords {ARRAY {{STRING Introduction} {STRING Basics}}} Year {NUMBER 2022}}}
} {}

test json-12.4 {createFromTypedList} {
    set result ""
    foreach json {
        {STRING foo}
        NULL
        TRUE
        FALSE
        {NUMBER -1.23}
    } {
        set doc [dom createFromTypedList $json]
        set this [$doc asTypedList]
        if {$json ne $this} {
            lappend result "json $json this $this"
        } else {
            lappend result 1
        }
        $doc delete
    }
    set result
} {1 1 1 1 1}

test json-12.5 {createFromTypedList} {
    set result ""
    foreach wrong {
        NUL
        ""
        {one two}
        {STRING two three}
    } {
        catch {dom createFromTypedList $wrong} errMsg
        lappend result $errMsg
    }
    set result
} {{Invalid typed list format: Unkown symbol "NUL".} {Invalid typed list format: Empty list.} {Invalid typed list format: Unkown symbol "one".} {Invalid typed list format: Too much list elements.}}

test json-12.6 {createFromTypedList} {
    catch {dom createFromTypedList {OBJECT {one {STRING two} two {}}}} errMsg
    set errMsg
} {Invalid typed list format: object property "two": Empty list.}

test json-12.7 {createFromTypedList} {
    catch {dom createFromTypedList {OBJECT {one {STRING two} two {ARRAY {{NUMBER 1} {NULL foo}}}}}} errMsg
    set errMsg
} {Invalid typed list format: object property "two": array element 2: No value expected for NULL.}

}

if {[info commands _dom] eq ""} {
    rename dom _dom
    proc dom {args} {
        if {[lindex $args 0] != "parse" || [lsearch -exact $args "-json"] < 0} {
            return [uplevel 1 [linsert $args 0 _dom]]
        }
        set haveData 0
        set uplevelVar ""
        for {set x 1} {$x < [llength $args]} {incr x} {
            switch -- [lindex $args $x] {
                "-jsonroot" -
                "-jsonmaxnesting" -
                "-channel" -
                "-baseurl" -
                "-externalentitycommand" {
                    incr x
                }
                "-json" -
                "--" -
                "-keepEmpties" -
                "-keepCDATA" {
                    # do nothing, the options are flags
                }
                default {
                    if {$haveData} {
                        set uplevelVar [lindex $args $x]
                    } else {
                        set data [lindex $args $x]
                        set haveData 1
                    }
                }                
            }
        }
        if {[catch {
            _dom parse -json $data doc
        } errMsg]} {
            # Some tests check if invalid json data is detected. Since
            # we need valid json data for what is tested here that
            # tests should be marked with constraint nonetest. To
            # raise error here does not help much because if the test
            # data is expected to be invalid the command will be
            # [catch]ed. Therefore the puts to catch attention.
            puts  "Unexpeced invalid json data '$data'"
        }
        set njson [$doc asJSON]
        set typedList [$doc asTypedList]
        _dom createFromTypedList $typedList docFromTyped
        if {$njson ne [$docFromTyped asJSON]} {
            error "Normalized json '$data' differs from normalized json created with createFromTypedList"
        }
        return [uplevel 1 [linsert $args 0 _dom]]
    }
    source [file join [file dir [info script]] domjson.test]
    rename dom {}
    rename _dom dom
}