Ce que fait la macro du classeur Excel

Attribute VB_Name = "modExfBuild"
' ExcelifyXML - the reconstruction engine, part 2: rows grouped under their
' wrapper instances, then the element tree built row by row. Port of the rest
' of executePlan in src/lib/excel-macro/engine/execute.ts (columns and rows:
' modExfEngine; the tree: modExfTree; the output: modExfWrite).
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Compare Binary
Option Private Module

' Every refusal of the engine happens here, before any file is written.
Public Function ExfEngineBuild(ByRef p As ExfPlan) As Boolean
    Dim u As Long, n As Long, i As Long, j As Long, k As Long, t As Long, g As Long
    Dim v As String, acc As String, sig As String, levels As Long, grpCount As Long, root As Long
    Dim keyU() As Long, own() As String, levelKey() As String
    Dim groupIndex As ExfStrMap, grpKeys() As String, grpVals() As String, grpFirst() As Long, grpLast() As Long, rowNext() As Long
    Dim isSelf() As Boolean, instanceIndex As ExfStrMap, knownTypes() As String, typeList As String
    Dim typeMap As ExfStrMap, allowed() As Boolean, isTypeCol() As Boolean, typeU As Long
    Dim uniqNameId() As Long, keyOrder() As Long, keyLen() As String
    Dim newColumn() As Boolean, ignoredColumn() As Boolean
    Dim cursor As Long, wrapper As Long, rowNode As Long, leaf As Long, tagId As Long, rowType As Long
    Dim scoped As Boolean, outOfType As Boolean

    If Not ExfEngineCheckColumns() Then Exit Function
    ExfEngineNormalizeBooleans p

    ' --- Group rows by wrapper instance (wrappers.ts wrapperKeyOf), in order
    ' of first appearance. keyU: -2 = fixed value, -1 = column absent, else the
    ' unique column holding the value.
    levels = p.wrapCount
    ReDim keyU(0 To p.keyCount)
    For k = 0 To p.keyCount - 1
        If p.keyColumn(k) >= 0 Then
            keyU(k) = ExfMapGet(gUniqIndex, p.strs(p.keyColumn(k)))
        Else
            keyU(k) = -2
        End If
    Next k
    ReDim own(0 To p.keyCount)
    ReDim levelKey(0 To levels)
    ReDim grpKeys(0 To levels, 0 To gRowCount)
    ReDim grpVals(0 To p.keyCount, 0 To gRowCount)
    ReDim grpFirst(0 To gRowCount)
    ReDim grpLast(0 To gRowCount)
    ReDim rowNext(0 To gRowCount)
    ExfMapInit groupIndex, 64
    For n = 0 To gRowCount - 1
        acc = vbNullString
        For i = 0 To levels - 1
            For k = p.wrapKeyStart(i) To p.wrapKeyStart(i) + p.wrapKeyCount(i) - 1
                If keyU(k) = -2 Then
                    own(k) = p.strs(p.keyDefault(k))
                ElseIf keyU(k) >= 0 Then
                    own(k) = gVals(keyU(k), n)
                Else
                    own(k) = vbNullString
                End If
                acc = acc & ExfLenKey(own(k))
            Next k
            acc = acc & "|"
            levelKey(i) = acc
        Next i
        g = ExfMapGet(groupIndex, acc)
        If g < 0 Then
            g = grpCount
            ExfMapSet groupIndex, acc, g
            For i = 0 To levels - 1
                grpKeys(i, g) = levelKey(i)
            Next i
            For k = 0 To p.keyCount - 1
                grpVals(k, g) = own(k)
            Next k
            grpFirst(g) = n
            grpCount = g + 1
        Else
            rowNext(grpLast(g)) = n
        End If
        grpLast(g) = n
        rowNext(n) = -1
    Next n

    ' --- Lookups
    ReDim isSelf(0 To p.strCount)
    For i = 0 To p.selfCloseCount - 1
        isSelf(p.selfClosing(i)) = True
    Next i
    ExfMapInit instanceIndex, p.instCount
    For t = 0 To p.instCount - 1
        acc = p.instLevel(t) & "#" & p.strs(p.instKey(t))
        If ExfMapGet(instanceIndex, acc) < 0 Then ExfMapSet instanceIndex, acc, t
    Next t
    ReDim knownTypes(0 To p.typeCount)
    For t = 0 To p.typeCount - 1
        knownTypes(t) = p.strs(p.types(t))
        If t > 0 Then typeList = typeList & ", "
        typeList = typeList & knownTypes(t)
    Next t
    ' allowed(t, u): column u is written for rows of type t.
    ReDim allowed(0 To p.typeCount, 0 To gUniqCount)
    For t = 0 To p.typeCount - 1
        ExfMapInit typeMap, p.typeColCount(t)
        For k = p.typeColStart(t) To p.typeColStart(t) + p.typeColCount(t) - 1
            ExfMapSet typeMap, p.strs(p.typeCols(k)), 1
        Next k
        For u = 0 To gUniqCount - 1
            allowed(t, u) = ExfMapGet(typeMap, gUniqName(u)) >= 0
        Next u
    Next t
    ReDim isTypeCol(0 To gUniqCount)
    For u = 0 To gUniqCount - 1
        isTypeCol(u) = (gUniqName(u) = "_type")
    Next u
    typeU = ExfMapGet(gUniqIndex, "_type")

    ExfTreeInit p, gRowCount
    ReDim uniqNameId(0 To gUniqCount)
    For u = 0 To gUniqCount - 1
        uniqNameId(u) = -1
        If gUniqKind(u) = EXF_KIND_NEW Then uniqNameId(u) = ExfTreeNameIdOf(p, gUniqName(u))
    Next u

    ' Wrapper attributes in signature order (execute.ts attrSignature sorts the
    ' names): keyOrder lists, level by level, the KEY entries sorted by name.
    ReDim keyOrder(0 To p.keyCount)
    ReDim keyLen(0 To p.keyCount)
    For k = 0 To p.keyCount - 1
        keyLen(k) = ExfLenKey(p.strs(p.keyAttr(k)))
    Next k
    For i = 0 To levels - 1
        For j = 0 To p.wrapKeyCount(i) - 1
            k = j
            Do While k > 0
                If ExfCompareUnits(p.strs(p.keyAttr(keyOrder(p.wrapKeyStart(i) + k - 1))), _
                                   p.strs(p.keyAttr(p.wrapKeyStart(i) + j))) <= 0 Then Exit Do
                keyOrder(p.wrapKeyStart(i) + k) = keyOrder(p.wrapKeyStart(i) + k - 1)
                k = k - 1
            Loop
            keyOrder(p.wrapKeyStart(i) + k) = p.wrapKeyStart(i) + j
        Next j
    Next i

    ' --- Build
    root = ExfTreeNewNode(p.rootName, False, -1)
    ExfTreeSetRoot root
    For i = 0 To p.rootAttrCount - 1
        ExfTreeSetAttr root, p.rootAttrs(2 * i), p.strs(p.rootAttrs(2 * i + 1))
    Next i
    ExfTreeLayOut p, root, p.rootList, 0, p.rootListCount

    ReDim newColumn(0 To gUniqCount)
    ReDim ignoredColumn(0 To gUniqCount)
    For g = 0 To grpCount - 1
        cursor = root
        For i = 0 To levels - 1
            sig = vbNullString
            For j = p.wrapKeyStart(i) To p.wrapKeyStart(i) + p.wrapKeyCount(i) - 1
                sig = sig & keyLen(keyOrder(j)) & ExfLenKey(grpVals(keyOrder(j), g))
            Next j
            acc = cursor & "|" & p.strs(p.wrapName(i)) & "|" & sig
            wrapper = ExfTreeWrapperGet(acc)
            If wrapper < 0 Then
                wrapper = ExfTreeNewNode(p.wrapName(i), p.wrapSelfClosing(i) = 1, -1)
                For k = p.wrapKeyStart(i) To p.wrapKeyStart(i) + p.wrapKeyCount(i) - 1
                    ExfTreeSetAttr wrapper, p.keyAttr(k), grpVals(k, g)
                Next k
                ExfTreeAppend cursor, wrapper
                ExfTreeWrapperSet acc, wrapper
            End If
            ' First visit of this wrapper instance: its siblings, before any row.
            If Not ExfTreeFilled(wrapper) Then
                ExfTreeMarkFilled wrapper
                t = ExfMapGet(instanceIndex, i & "#" & grpKeys(i, g))
                If t >= 0 Then
                    ExfTreeLayOut p, wrapper, p.instLists, p.instListStart(t), p.instListCount(t)
                Else
                    ExfTreeLayOut p, wrapper, p.wrapLists, p.wrapListStart(i), p.wrapListCount(i)
                End If
            End If
            cursor = wrapper
        Next i

        n = grpFirst(g)
        Do While n >= 0
            tagId = p.rowTag
            rowType = -1
            If p.isMultiTag Then
                If typeU < 0 Then
                    ExfSetError "errTypeColumnMissing", "values", typeList
                    Exit Function
                End If
                v = ExfTrim(gVals(typeU, n), gIsSpace)
                For t = 0 To p.typeCount - 1
                    If knownTypes(t) = v Then
                        rowType = t
                        Exit For
                    End If
                Next t
                If rowType < 0 Then
                    ExfSetError "errTypeEmpty", "row", CStr(gSheetRow(n)), "value", v, "values", typeList
                    Exit Function
                End If
                tagId = p.types(rowType)
            End If
            rowNode = ExfTreeNewNode(tagId, isSelf(tagId), -1)
            scoped = False
            If rowType >= 0 Then scoped = (p.typeScoped(rowType) = 1)

            For u = 0 To gUniqCount - 1
                If Not isTypeCol(u) Then
                    ' (VBA evaluates both sides of And: no allowed(-1, u) when not scoped)
                    outOfType = False
                    If scoped Then outOfType = Not allowed(rowType, u)
                    If outOfType Then
                        If gUniqKind(u) = EXF_KIND_NEW Then
                            If Len(gVals(u, n)) > 0 Then ignoredColumn(u) = True
                        End If
                    ElseIf Len(gVals(u, n)) > 0 Then
                        If gUniqKind(u) = EXF_KIND_NEW Then
                            leaf = ExfTreeNewNode(uniqNameId(u), False, -1)
                            ExfTreeSetText leaf, gVals(u, n)
                            ExfTreeAppend rowNode, leaf
                            newColumn(u) = True
                        ElseIf gUniqKind(u) = EXF_KIND_COL Then
                            ExfTreeApplyColumn p, isSelf, rowNode, gUniqColumn(u), gVals(u, n)
                        End If
                    End If
                End If
            Next u
            ExfTreeAppend cursor, rowNode
            n = rowNext(n)
        Loop
    Next g

    ExfTreePruneSlots
    For u = 0 To gUniqCount - 1
        If newColumn(u) Then
            If Len(gNewColumns) > 0 Then gNewColumns = gNewColumns & ","
            gNewColumns = gNewColumns & gUniqName(u)
        End If
        If ignoredColumn(u) Then
            If Len(gIgnoredColumns) > 0 Then gIgnoredColumns = gIgnoredColumns & ","
            gIgnoredColumns = gIgnoredColumns & gUniqName(u)
        End If
    Next u
    Erase gVals        ' the tree holds its own copy: memory back before writing
    ExfEngineBuild = True
End Function

Attribute VB_Name = "modExfData"
' ExcelifyXML - reads the Data sheet: row 1 = the technical names, row 2 = your
' labels (never read), data below. Cells are read by blocks of 500 rows (32-bit
' Excel has 2 GB of memory for everything). Every cell is formatted as Text, so
' values are normally text as typed; a number, date or TRUE/FALSE pasted with
' its format is turned into text by fixed rules and reported at the end.
' Reference: sliceDataSheet in src/lib/excel-macro/engine/execute.ts.
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Compare Binary
Option Private Module

Private Const CHUNK_ROWS As Long = 500
Private Const LABEL_STYLE As String = "ExcelifyLabel"     ' prefix of the 3 label styles
Private Const LABELS_NAME As String = "ExcelifyLabels"    ' defined name of row 2

Public Type ExfSheet
    lastRow As Long
    nCols As Long
    headers() As String          ' row 1, 0 To nCols - 1
    labelsRow As Long            ' row of the labels, 0 when deleted
    firstRow As Long             ' first data row
    conversions As Long          ' cells that were not text
    convCells(0 To 4) As String  ' the first five of them
End Type

' Row 1, and where the data starts. False when a message must be shown.
Public Function ExfReadHeaders(ByVal ws As Worksheet, ByRef sh As ExfSheet) As Boolean
    Dim block As Variant, v As Variant, c As Long, hasHeader As Boolean, nameRow As Long

    sh.lastRow = ExfLastCell(ws, xlByRows)
    sh.nCols = ExfLastCell(ws, xlByColumns)
    If sh.nCols = 0 Then
        ExfSetError "errNoHeaders", "sheet", ws.Name
        Exit Function
    End If
    block = ExfBlock(ws, 1, 1, sh.nCols)
    ReDim sh.headers(0 To sh.nCols - 1)
    For c = 1 To sh.nCols
        v = block(1, c)
        If VarType(v) = vbString Then
            sh.headers(c - 1) = v
        ElseIf IsEmpty(v) Then
            sh.headers(c - 1) = vbNullString
        ElseIf IsError(v) Then
            ExfSetError "errCellError", "cell", ws.Cells(1, c).Address(False, False), "value", ExfErrorText(ws, 1, c, v)
            Exit Function
        Else
            sh.headers(c - 1) = ExfConvert(ws, 1, c, v)
        End If
        If Len(sh.headers(c - 1)) > 0 Then hasHeader = True
    Next c
    If Not hasHeader Then
        ExfSetError "errNoHeaders", "sheet", ws.Name
        Exit Function
    End If

    ' The labels row is found by its defined name (follows inserted and deleted
    ' rows) and by its style (moves with the cells when a sort takes it along).
    nameRow = ExfNamedRow(ws)
    If nameRow > 0 Then
        If ExfIsLabelsRow(ws, nameRow) Then sh.labelsRow = nameRow
    End If
    If sh.labelsRow = 0 Then
        sh.labelsRow = ExfFindLabelsRow(ws, sh.lastRow)
        ' Styles cleared but the name still in place: it is still the labels row.
        If sh.labelsRow = 0 Then sh.labelsRow = nameRow
    End If
    If sh.labelsRow <> 0 And sh.labelsRow <> 2 Then
        ExfSetError "errLabelRowMoved", "row", CStr(sh.labelsRow), "sheet", ws.Name
        Exit Function
    End If
    If sh.labelsRow = 2 Then sh.firstRow = 3 Else sh.firstRow = 2
    ExfReadHeaders = True
End Function

' Every data row, in sheet order, handed to the engine (ExfEngineAddRow).
Public Function ExfReadRows(ByVal ws As Worksheet, ByRef sh As ExfSheet) As Boolean
    Dim block As Variant, v As Variant, rowCells() As String
    Dim r1 As Long, r2 As Long, r As Long, c As Long, total As Long, chunkNo As Long

    ExfReadRows = True
    If sh.firstRow > sh.lastRow Then Exit Function
    ReDim rowCells(0 To sh.nCols - 1)
    total = sh.lastRow - sh.firstRow + 1
    For r1 = sh.firstRow To sh.lastRow Step CHUNK_ROWS
        r2 = r1 + CHUNK_ROWS - 1
        If r2 > sh.lastRow Then r2 = sh.lastRow
        block = ExfBlock(ws, r1, r2 - r1 + 1, sh.nCols)
        For r = 1 To r2 - r1 + 1
            For c = 1 To sh.nCols
                v = block(r, c)
                If VarType(v) = vbString Then
                    rowCells(c - 1) = v
                ElseIf IsEmpty(v) Then
                    rowCells(c - 1) = vbNullString
                ElseIf IsError(v) Then
                    ExfSetError "errCellError", "cell", ws.Cells(r1 + r - 1, c).Address(False, False), _
                        "value", ExfErrorText(ws, r1 + r - 1, c, v)
                    ExfReadRows = False
                    Exit Function
                Else
                    rowCells(c - 1) = ExfConvert(ws, r1 + r - 1, c, v)
                    sh.conversions = sh.conversions + 1
                    If sh.conversions <= 5 Then
                        sh.convCells(sh.conversions - 1) = ws.Cells(r1 + r - 1, c).Address(False, False)
                    End If
                End If
            Next c
            ExfEngineAddRow rowCells, r1 + r - 1
        Next r
        chunkNo = chunkNo + 1
        If chunkNo Mod 20 = 0 Then
            ExfStatus ExfFill(ExfMessageText("progressReading"), "done", CStr(r2 - sh.firstRow + 1), "total", CStr(total))
            DoEvents
        End If
    Next r1
End Function

' A cell that is not text (typed or pasted with its format), as text:
' TRUE/FALSE -> true/false; dates -> YYYY-MM-DD, with THH:MM:SS when there is a
' time; whole numbers below 10^15 -> digits only; other numbers -> invariant
' notation with a decimal point (never the regional settings of Excel).
Private Function ExfConvert(ByVal ws As Worksheet, ByVal r As Long, ByVal c As Long, ByRef v As Variant) As String
    Dim d As Variant
    If VarType(v) = vbBoolean Then
        If v Then ExfConvert = "true" Else ExfConvert = "false"
        Exit Function
    End If
    ' Value2 gives dates as numbers; Value tells them apart.
    d = ws.Cells(r, c).Value
    If VarType(d) = vbDate Then
        ExfConvert = ExfIsoDate(CDate(d))
    Else
        ExfConvert = ExfNumberText(CDbl(v))
    End If
End Function

Private Function ExfIsoDate(ByVal d As Date) As String
    Dim days As Double, dayTime As Double
    days = Int(CDbl(d))
    dayTime = CDbl(d) - days
    If dayTime = 0 Then
        ExfIsoDate = Format$(d, "yyyy\-mm\-dd")
    ElseIf days = 0 Then
        ExfIsoDate = Format$(d, "hh\:nn\:ss")
    Else
        ExfIsoDate = Format$(d, "yyyy\-mm\-dd") & "T" & Format$(d, "hh\:nn\:ss")
    End If
End Function

Private Function ExfNumberText(ByVal x As Double) As String
    Dim s As String
    If x = Fix(x) And Abs(x) < 1E+15 Then
        ExfNumberText = Format$(x, "0")
        Exit Function
    End If
    ' Str$ is invariant (decimal point) but drops the leading zero: -.5, .5
    s = Trim$(Str$(x))
    If Left$(s, 1) = "." Then
        s = "0" & s
    ElseIf Left$(s, 2) = "-." Then
        s = "-0" & Mid$(s, 2)
    End If
    ExfNumberText = s
End Function

' What the cell shows (#N/A, #VALEUR!...), else the English name of the error.
Private Function ExfErrorText(ByVal ws As Worksheet, ByVal r As Long, ByVal c As Long, ByRef v As Variant) As String
    Dim s As String, codes As Variant, errNames As Variant, i As Long
    On Error Resume Next
    s = ws.Cells(r, c).Text
    On Error GoTo 0
    If Left$(s, 1) = "#" Then
        ExfErrorText = s
        Exit Function
    End If
    codes = Array(2000, 2007, 2015, 2023, 2029, 2036, 2042, 2043, 2045, 2046, 2047, 2048, 2049, 2050)
    errNames = Array("#NULL!", "#DIV/0!", "#VALUE!", "#REF!", "#NAME?", "#NUM!", "#N/A", "#GETTING_DATA", _
        "#SPILL!", "#CONNECT!", "#BLOCKED!", "#UNKNOWN!", "#FIELD!", "#CALC!")
    For i = 0 To UBound(codes)
        If v = CVErr(codes(i)) Then
            ExfErrorText = errNames(i)
            Exit Function
        End If
    Next i
    ExfErrorText = "#?"
End Function

' Row of the defined name ExcelifyLabels on this sheet, 0 when it is missing
' or broken (#REF! once the row has been deleted).
Private Function ExfNamedRow(ByVal ws As Worksheet) As Long
    Dim rg As Range
    On Error Resume Next
    Set rg = ws.Parent.Names(LABELS_NAME).RefersToRange
    On Error GoTo 0
    If rg Is Nothing Then Exit Function
    If rg.Worksheet.CodeName <> ws.CodeName Then Exit Function
    ExfNamedRow = rg.Row
End Function

Private Function ExfIsLabelsRow(ByVal ws As Worksheet, ByVal r As Long) As Boolean
    Dim s As String
    On Error Resume Next
    s = ws.Cells(r, 1).Style.Name
    On Error GoTo 0
    ExfIsLabelsRow = (Left$(s, Len(LABEL_STYLE)) = LABEL_STYLE)
End Function

' First row whose first cell has a label style, 0 when there is none.
Private Function ExfFindLabelsRow(ByVal ws As Worksheet, ByVal lastRow As Long) As Long
    Dim r As Long
    For r = 1 To lastRow
        If ExfIsLabelsRow(ws, r) Then
            ExfFindLabelsRow = r
            Exit Function
        End If
    Next r
End Function

' Cells of a rectangle as a 1-based 2-D array, even for a single cell.
Public Function ExfBlock(ByVal ws As Worksheet, ByVal firstRow As Long, ByVal rows As Long, ByVal cols As Long) As Variant
    Dim v As Variant, one(1 To 1, 1 To 1) As Variant
    v = ws.Range(ws.Cells(firstRow, 1), ws.Cells(firstRow + rows - 1, cols)).Value2
    If IsArray(v) Then
        ExfBlock = v
    Else
        one(1, 1) = v
        ExfBlock = one
    End If
End Function

' Last used row (xlByRows) or column (xlByColumns), 0 on an empty sheet.
' LookIn:=xlFormulas also sees hidden and filtered cells, which are exported.
Public Function ExfLastCell(ByVal ws As Worksheet, ByVal order As XlSearchOrder) As Long
    Dim hit As Range
    Set hit = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, _
        SearchOrder:=order, SearchDirection:=xlPrevious)
    If hit Is Nothing Then Exit Function
    If order = xlByRows Then ExfLastCell = hit.Row Else ExfLastCell = hit.Column
End Function

' Sheets are found by their code name: the tabs may be renamed.
Public Function ExfSheetByCodeName(ByVal book As Workbook, ByVal wantedName As String) As Worksheet
    Dim ws As Worksheet
    For Each ws In book.Worksheets
        If ws.CodeName = wantedName Then
            Set ExfSheetByCodeName = ws
            Exit Function
        End If
    Next ws
End Function

Attribute VB_Name = "modExfEngine"
' ExcelifyXML - the reconstruction engine, part 1: the columns and rows of the
' Data sheet. A line-by-line port of executePlan in
' src/lib/excel-macro/engine/execute.ts, itself proven byte-identical to the
' website's online reconstruction: same tables, same order of operations,
' same output. Part 2 (modExfBuild) groups the rows and builds the element
' tree, part 3 (modExfTree) holds the tree, part 4 (modExfWrite) writes the
' XML.
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Compare Binary
Option Private Module

Public Const EXF_KIND_SKIP As Long = 0  ' _type, _order, wrapper attribute columns
Public Const EXF_KIND_COL As Long = 1   ' known column
Public Const EXF_KIND_NEW As Long = 2   ' unknown column with a valid XML name: a new element
Public Const EXF_KIND_BAD As Long = 3   ' unknown column with an invalid name

' Shared with modExfBuild. A name used twice is read from its last column,
' like the row object of the online engine's CSV.
Public gUniqCount As Long
Public gUniqName() As String
Public gUniqKind() As Long
Public gUniqColumn() As Long            ' entry of the COL table for a known column
Public gUniqIndex As ExfStrMap
Public gRowCount As Long                ' rows kept (entirely empty rows skipped)
Public gVals() As String                ' values by (unique column, row)
Public gSheetRow() As Long              ' sheet row of each kept row, for messages
Public gIsSpace() As Boolean            ' code units String.prototype.trim removes
Public gNewColumns As String            ' results, comma-separated
Public gIgnoredColumns As String

Private mCols As Long                   ' sheet columns read
Private mHeaders() As String
Private mColUniq() As Long              ' unique name of each sheet column
Private mUniqCol() As Long              ' sheet column a unique name is read from
Private mBadCols() As Long              ' sheet columns whose name is invalid
Private mBadCount As Long
Private mBadData() As Boolean           ' ... and that hold data

' Row 1 read: which columns are known, new or invalid. False on _order.
Public Function ExfEngineStart(ByRef p As ExfPlan, ByRef headers() As String, ByVal nCols As Long) As Boolean
    Dim c As Long, u As Long, k As Long, nm As String
    Dim colIndex As ExfStrMap, ancestorIndex As ExfStrMap

    ExfEngineReset
    mCols = nCols
    ReDim mHeaders(0 To nCols - 1)
    ReDim mColUniq(0 To nCols - 1)
    ReDim gUniqName(0 To nCols - 1)
    ReDim mUniqCol(0 To nCols - 1)
    ReDim mBadData(0 To nCols - 1)
    ReDim mBadCols(0 To nCols - 1)
    ExfMapInit gUniqIndex, nCols
    For c = 0 To nCols - 1
        mHeaders(c) = headers(c)
        u = ExfMapGet(gUniqIndex, headers(c))
        If u < 0 Then
            u = gUniqCount
            ExfMapSet gUniqIndex, headers(c), u
            gUniqName(u) = headers(c)
            gUniqCount = u + 1
        End If
        mUniqCol(u) = c
        mColUniq(c) = u
    Next c

    ExfMapInit colIndex, p.colCount
    For k = 0 To p.colCount - 1
        If ExfMapGet(colIndex, p.strs(p.colName(k))) < 0 Then ExfMapSet colIndex, p.strs(p.colName(k)), k
    Next k
    ExfMapInit ancestorIndex, p.ancestorCount
    For k = 0 To p.ancestorCount - 1
        ExfMapSet ancestorIndex, p.strs(p.ancestorCols(k)), k
    Next k

    ReDim gUniqKind(0 To gUniqCount - 1)
    ReDim gUniqColumn(0 To gUniqCount - 1)
    For u = 0 To gUniqCount - 1
        nm = gUniqName(u)
        ' Ecart assume: the online engine sorts rows by an _order column; in the
        ' workbook, rows are sorted in Excel and the column is refused.
        If nm = "_order" Then
            ExfSetError "errOrderColumn"
            Exit Function
        End If
        gUniqKind(u) = EXF_KIND_SKIP
        gUniqColumn(u) = -1
        If nm <> "_type" Then
            gUniqColumn(u) = ExfMapGet(colIndex, nm)
            If gUniqColumn(u) >= 0 Then
                gUniqKind(u) = EXF_KIND_COL
            ElseIf ExfMapGet(ancestorIndex, nm) < 0 Then
                If ExfIsXmlName(nm) Then gUniqKind(u) = EXF_KIND_NEW Else gUniqKind(u) = EXF_KIND_BAD
            End If
        End If
    Next u
    For c = 0 To nCols - 1
        If gUniqKind(mColUniq(c)) = EXF_KIND_BAD Then
            mBadCols(mBadCount) = c
            mBadCount = mBadCount + 1
        End If
    Next c

    ReDim gIsSpace(0 To 65535)
    For k = 0 To p.spaceCount - 1
        gIsSpace(p.spaces(k)) = True
    Next k
    ReDim gVals(0 To gUniqCount - 1, 0 To 1023)
    ReDim gSheetRow(0 To 1023)
    ExfEngineStart = True
End Function

' One sheet row, cells already turned into text. An entirely empty row is
' skipped (reconstruct.ts parseCsvRecords).
Public Sub ExfEngineAddRow(ByRef rowCells() As String, ByVal sheetRow As Long)
    Dim c As Long, u As Long, n As Long, cap As Long
    For c = 0 To mCols - 1
        If Len(rowCells(c)) > 0 Then Exit For
    Next c
    If c = mCols Then Exit Sub
    For c = 0 To mBadCount - 1
        If Len(rowCells(mBadCols(c))) > 0 Then mBadData(mBadCols(c)) = True
    Next c
    n = gRowCount
    cap = UBound(gSheetRow) + 1
    If n = cap Then
        ReDim Preserve gVals(0 To gUniqCount - 1, 0 To 2 * cap - 1)
        ReDim Preserve gSheetRow(0 To 2 * cap - 1)
    End If
    For u = 0 To gUniqCount - 1
        gVals(u, n) = rowCells(mUniqCol(u))
    Next u
    gSheetRow(n) = sheetRow
    gRowCount = n + 1
End Sub

' Ecart assume: the online engine silently drops a column whose name can't be
' an element; the macro stops, so no typed data is lost unseen.
Public Function ExfEngineCheckColumns() As Boolean
    Dim c As Long
    For c = 0 To mCols - 1
        If mBadData(c) Then
            ExfSetError "errHeaderInvalid", "column", ExfColumnLetters(c + 1), "name", mHeaders(c)
            Exit Function
        End If
    Next c
    ExfEngineCheckColumns = True
End Function

' Booleans turned TRUE/FALSE or VRAI/FAUX by a spreadsheet, in the columns that
' held only true/false in the source (plan tables BOOLCOL, BOOLTOKEN, CASE).
Public Sub ExfEngineNormalizeBooleans(ByRef p As ExfPlan)
    Dim b As Long, i As Long, n As Long, u As Long, mapped As Long, v As String
    Dim hasUpper() As Boolean, upper() As String, tokens As ExfStrMap
    ReDim hasUpper(0 To 65535)
    ReDim upper(0 To 65535)
    For i = 0 To p.caseCount - 1
        hasUpper(p.caseMap(2 * i)) = True
        upper(p.caseMap(2 * i)) = p.strs(p.caseMap(2 * i + 1))
    Next i
    ExfMapInit tokens, p.boolTokenCount
    For i = 0 To p.boolTokenCount - 1
        ExfMapSet tokens, p.strs(p.boolTokens(2 * i)), p.boolTokens(2 * i + 1)
    Next i
    For b = 0 To p.boolColCount - 1
        u = ExfMapGet(gUniqIndex, p.strs(p.boolCols(b)))
        If u >= 0 Then
            For n = 0 To gRowCount - 1
                v = gVals(u, n)
                If Len(v) > 0 Then
                    If v <> "true" And v <> "false" Then
                        mapped = ExfMapGet(tokens, ExfUpperForTokens(ExfTrim(v, gIsSpace), hasUpper, upper))
                        If mapped >= 0 Then gVals(u, n) = p.strs(mapped)
                    End If
                End If
            Next n
        End If
    Next b
End Sub

Public Function ExfEngineRowCount() As Long
    ExfEngineRowCount = gRowCount
End Function

' Columns written as new elements, comma-separated (message successNewColumns).
Public Function ExfEngineNewColumns() As String
    ExfEngineNewColumns = gNewColumns
End Function

' Columns left out because the row type doesn't use them (successIgnoredColumns).
Public Function ExfEngineIgnoredColumns() As String
    ExfEngineIgnoredColumns = gIgnoredColumns
End Function

' Frees the memory held between two runs.
Public Sub ExfEngineReset()
    mCols = 0
    gUniqCount = 0
    mBadCount = 0
    gRowCount = 0
    gNewColumns = vbNullString
    gIgnoredColumns = vbNullString
    Erase mHeaders, mColUniq, mBadCols, mBadData, mUniqCol
    Erase gUniqName, gUniqKind, gUniqColumn, gVals, gSheetRow, gIsSpace
    ExfMapInit gUniqIndex, 16
    ExfTreeReset
End Sub

Attribute VB_Name = "modExfEntry"
' ExcelifyXML - the workbook's macro: rebuilds the XML file from the Data sheet.
'
' What it does, in order:
'   1. reads the structure stored by the website in the hidden sheet _excelify;
'   2. reads the Data sheet (row 1 = technical names, row 2 = your labels,
'      never read, data below);
'   3. rebuilds the XML exactly as the website's online reconstruction does;
'   4. asks where to save it and writes that single file (UTF-8).
' Nothing else: no network, no automatic start, no other file read or changed.
' Source code and explanations: https://www.excelifyxml.com/excel-macro
'
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Compare Binary

' The "Generate XML" button (also in Alt+F8 > Macros) - the only macro this
' workbook offers: every other module is private to it.
Public Sub ExcelifyGenererXML()
    ExfRunBook ThisWorkbook, vbNullString, True
End Sub

Attribute VB_Name = "modExfMap"
' ExcelifyXML - case-sensitive map from text to number (StrMap in
' src/lib/excel-macro/engine/execute.ts). Scripting.Dictionary only exists on
' Windows and a Collection ignores case, so the macro has its own: a chained
' hash table held in plain arrays.
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Compare Binary
Option Private Module

Public Type ExfStrMap
    keys() As String
    vals() As Long
    hashes() As Long
    nxt() As Long           ' next entry in the same bucket, -1 at the end
    buckets() As Long       ' first entry of each bucket, -1 when empty
    count As Long
    mask As Long            ' number of buckets - 1 (a power of two)
End Type

' Prime below 2^20: h * 33 + 255 stays far below the 2^31 limit of a Long.
Private Const HASH_MOD As Long = 1048573

Public Sub ExfMapInit(ByRef m As ExfStrMap, Optional ByVal capacity As Long = 16)
    Dim size As Long, i As Long
    size = 16
    Do While size < capacity And size < 1048576
        size = size * 2
    Loop
    ReDim m.keys(0 To size - 1)
    ReDim m.vals(0 To size - 1)
    ReDim m.hashes(0 To size - 1)
    ReDim m.nxt(0 To size - 1)
    ReDim m.buckets(0 To size - 1)
    For i = 0 To size - 1
        m.buckets(i) = -1
    Next i
    m.count = 0
    m.mask = size - 1
End Sub

' Hash of the UTF-16 code units (read as bytes: no character is skipped).
Private Function ExfHash(ByRef key As String) As Long
    Dim b() As Byte, i As Long, h As Long
    If Len(key) = 0 Then Exit Function
    b = key
    h = 5381
    For i = 0 To UBound(b)
        h = (h * 33 + b(i)) Mod HASH_MOD
    Next i
    ExfHash = h
End Function

' Value stored for key, or -1 when absent.
Public Function ExfMapGet(ByRef m As ExfStrMap, ByRef key As String) As Long
    Dim e As Long, h As Long
    h = ExfHash(key)
    e = m.buckets(h And m.mask)
    Do While e >= 0
        If m.hashes(e) = h Then
            If m.keys(e) = key Then
                ExfMapGet = m.vals(e)
                Exit Function
            End If
        End If
        e = m.nxt(e)
    Loop
    ExfMapGet = -1
End Function

Public Sub ExfMapSet(ByRef m As ExfStrMap, ByRef key As String, ByVal aValue As Long)
    Dim e As Long, h As Long, b As Long
    h = ExfHash(key)
    e = m.buckets(h And m.mask)
    Do While e >= 0
        If m.hashes(e) = h Then
            If m.keys(e) = key Then
                m.vals(e) = aValue
                Exit Sub
            End If
        End If
        e = m.nxt(e)
    Loop
    If m.count > m.mask Then ExfMapGrow m
    e = m.count
    m.keys(e) = key
    m.vals(e) = aValue
    m.hashes(e) = h
    b = h And m.mask
    m.nxt(e) = m.buckets(b)
    m.buckets(b) = e
    m.count = e + 1
End Sub

' Twice as many buckets (and entry slots), entries re-chained.
Private Sub ExfMapGrow(ByRef m As ExfStrMap)
    Dim size As Long, i As Long, b As Long
    size = (m.mask + 1) * 2
    ReDim Preserve m.keys(0 To size - 1)
    ReDim Preserve m.vals(0 To size - 1)
    ReDim Preserve m.hashes(0 To size - 1)
    ReDim Preserve m.nxt(0 To size - 1)
    ReDim m.buckets(0 To size - 1)
    m.mask = size - 1
    For i = 0 To size - 1
        m.buckets(i) = -1
    Next i
    For i = 0 To m.count - 1
        b = m.hashes(i) And m.mask
        m.nxt(i) = m.buckets(b)
        m.buckets(b) = i
    Next i
End Sub

Attribute VB_Name = "modExfPlan"
' ExcelifyXML - reads the plan: everything needed to rebuild the XML, stored by
' the website in the hidden sheet "_excelify" as blocks of cells (numbers and
' one pool of strings, no JSON to parse). Port of readPlanSheet in
' src/lib/excel-macro/xlsx/plan-sheet.ts; the tables are described in
' src/lib/excel-macro/engine/plan.ts.
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Compare Binary
Option Private Module

Public Const EXF_PLAN_MARKER As String = "EXCELIFY"
Public Const EXF_PLAN_FORMAT As Long = 1        ' newest plan format this macro reads
Public Const EXF_MACRO_VERSION As Long = 1      ' compared with the plan's C1

' Column kinds of the COL table.
Public Const EXF_COL_TEXT As Long = 1
Public Const EXF_COL_ATTR As Long = 2
Public Const EXF_COL_NONE As Long = 3

' Every array is 0-based and always allocated (one spare slot), its length in
' the matching count. Pair tables are flat: pair i = (x(2 * i), x(2 * i + 1)).
Public Type ExfPlan
    planFormat As Long
    strs() As String            ' string pool, every other table refers to it
    strCount As Long
    indent As Long
    prologue() As Long          ' declaration line, then header comments
    prologueCount As Long
    rootName As Long
    rootAttrs() As Long         ' pairs (name, value)
    rootAttrCount As Long
    isMultiTag As Boolean
    rowTag As Long
    types() As Long             ' multi-tag rows: the known _type values
    typeScoped() As Long
    typeColStart() As Long
    typeColCount() As Long
    typeCount As Long
    typeCols() As Long
    typeColTotal As Long
    nodeName() As Long          ' element trees kept verbatim (root and wrapper siblings)
    nodeText() As Long
    nodeSelfClosing() As Long
    nodeSlot() As Long
    nodeAttrStart() As Long
    nodeAttrCount() As Long
    nodeChildStart() As Long
    nodeChildCount() As Long
    nodeCount As Long
    nodeAttrs() As Long         ' pairs (name, value)
    nodeAttrTotal As Long
    nodeChildren() As Long
    nodeChildTotal As Long
    rootList() As Long
    rootListCount As Long
    wrapName() As Long          ' the elements between the root and the rows
    wrapSelfClosing() As Long
    wrapListStart() As Long
    wrapListCount() As Long
    wrapKeyStart() As Long
    wrapKeyCount() As Long
    wrapCount As Long
    wrapLists() As Long
    wrapListTotal As Long
    keyAttr() As Long
    keyColumn() As Long
    keyDefault() As Long
    keyCount As Long
    instLevel() As Long         ' own siblings of each wrapper instance
    instKey() As Long
    instListStart() As Long
    instListCount() As Long
    instCount As Long
    instLists() As Long
    instListTotal As Long
    colName() As Long           ' how each known column reaches its element
    colKind() As Long
    colAttr() As Long
    colCdata() As Long
    colSegStart() As Long
    colSegCount() As Long
    colCount As Long
    segName() As Long
    segIndex() As Long
    segQualAttr() As Long
    segQualValue() As Long
    segCount As Long
    ancestorCols() As Long
    ancestorCount As Long
    selfClosing() As Long
    selfCloseCount As Long
    boolCols() As Long
    boolColCount As Long
    boolTokens() As Long        ' pairs (token, value)
    boolTokenCount As Long
    caseMap() As Long           ' pairs (code unit, uppercase string)
    caseCount As Long
    spaces() As Long
    spaceCount As Long
    locale As String            ' META
    sourceName As String
    outputName As String
End Type

' Table of contents of the plan sheet.
Private mSecName() As String
Private mSecFirst() As Long
Private mSecRows() As Long
Private mSecWidth() As Long
Private mSecTotal As Long

' Reads the plan into p; False when the message set by ExfSetError must be
' shown (errPlanMissing, errPlanTooNew). The macro messages (MSG section) are
' loaded first, so that even a refusal is shown in the workbook's language.
Public Function ExfReadPlan(ByVal ws As Worksheet, ByRef p As ExfPlan) As Boolean
    Dim head As Variant, toc As Variant, block As Variant, i As Long, n As Long

    head = ExfBlock(ws, 1, 1, 4)
    If VarType(head(1, 1)) <> vbString Then GoTo Missing
    If head(1, 1) <> EXF_PLAN_MARKER Then GoTo Missing
    If Not ExfIsNumber(head(1, 2)) Or Not ExfIsNumber(head(1, 3)) Or Not ExfIsNumber(head(1, 4)) Then GoTo Missing
    mSecTotal = CLng(head(1, 4))
    If mSecTotal < 1 Then GoTo Missing

    toc = ExfBlock(ws, 2, mSecTotal, 4)
    ReDim mSecName(0 To mSecTotal - 1)
    ReDim mSecFirst(0 To mSecTotal - 1)
    ReDim mSecRows(0 To mSecTotal - 1)
    ReDim mSecWidth(0 To mSecTotal - 1)
    For i = 1 To mSecTotal
        mSecName(i - 1) = ExfCellString(toc(i, 1))
        mSecFirst(i - 1) = ExfCellLong(toc(i, 2))
        mSecRows(i - 1) = ExfCellLong(toc(i, 3))
        mSecWidth(i - 1) = ExfCellLong(toc(i, 4))
    Next i

    n = ExfSection(ws, "MSG", block)
    For i = 1 To n
        ExfMessageAdd ExfCellString(block(i, 1)), ExfCellString(block(i, 2))
    Next i

    If CDbl(head(1, 2)) > EXF_PLAN_FORMAT Or CDbl(head(1, 3)) > EXF_MACRO_VERSION Then
        ExfSetError "errPlanTooNew", "needed", ExfCellString(head(1, 3))
        Exit Function
    End If
    p.planFormat = CLng(head(1, 2))

    ' Strings: A = number of chunks, B... = the chunks (Excel cells hold at
    ' most 32,767 characters).
    n = ExfSection(ws, "STR", block)
    ReDim p.strs(0 To n)
    For i = 1 To n
        p.strs(i - 1) = ExfJoinChunks(block, i)
    Next i
    p.strCount = n
    If n = 0 Then GoTo Missing

    n = ExfSection(ws, "META", block)
    For i = 1 To n
        Select Case ExfCellString(block(i, 1))
            Case "rootName": p.rootName = ExfCellLong(block(i, 2))
            Case "rowTag": p.rowTag = ExfCellLong(block(i, 2))
            Case "multiTag": p.isMultiTag = (ExfCellLong(block(i, 2)) = 1)
            Case "indent": p.indent = ExfCellLong(block(i, 2))
            Case "locale": p.locale = ExfCellString(block(i, 2))
            Case "source": p.sourceName = ExfCellString(block(i, 2))
            Case "output": p.outputName = ExfCellString(block(i, 2))
        End Select
    Next i

    n = ExfSection(ws, "PROLOGUE", block)
    p.prologueCount = ExfColumn(block, n, 1, p.prologue)

    n = ExfSection(ws, "ROOTATTR", block)
    p.rootAttrCount = ExfPairs(block, n, p.rootAttrs)

    n = ExfSection(ws, "ROOTLIST", block)
    p.rootListCount = ExfColumn(block, n, 1, p.rootList)

    n = ExfSection(ws, "TYPE", block)
    p.typeCount = ExfColumn(block, n, 1, p.types)
    ExfColumn block, n, 2, p.typeScoped
    ExfColumn block, n, 3, p.typeColStart
    ExfColumn block, n, 4, p.typeColCount

    n = ExfSection(ws, "TYPECOL", block)
    p.typeColTotal = ExfColumn(block, n, 1, p.typeCols)

    n = ExfSection(ws, "NODE", block)
    p.nodeCount = ExfColumn(block, n, 1, p.nodeName)
    ExfColumn block, n, 2, p.nodeText
    ExfColumn block, n, 3, p.nodeSelfClosing
    ExfColumn block, n, 4, p.nodeSlot
    ExfColumn block, n, 5, p.nodeAttrStart
    ExfColumn block, n, 6, p.nodeAttrCount
    ExfColumn block, n, 7, p.nodeChildStart
    ExfColumn block, n, 8, p.nodeChildCount

    n = ExfSection(ws, "NODEATTR", block)
    p.nodeAttrTotal = ExfPairs(block, n, p.nodeAttrs)

    n = ExfSection(ws, "NODECHILD", block)
    p.nodeChildTotal = ExfColumn(block, n, 1, p.nodeChildren)

    n = ExfSection(ws, "WRAP", block)
    p.wrapCount = ExfColumn(block, n, 1, p.wrapName)
    ExfColumn block, n, 2, p.wrapSelfClosing
    ExfColumn block, n, 3, p.wrapListStart
    ExfColumn block, n, 4, p.wrapListCount
    ExfColumn block, n, 5, p.wrapKeyStart
    ExfColumn block, n, 6, p.wrapKeyCount

    n = ExfSection(ws, "WRAPLIST", block)
    p.wrapListTotal = ExfColumn(block, n, 1, p.wrapLists)

    n = ExfSection(ws, "KEY", block)
    p.keyCount = ExfColumn(block, n, 1, p.keyAttr)
    ExfColumn block, n, 2, p.keyColumn
    ExfColumn block, n, 3, p.keyDefault

    n = ExfSection(ws, "INST", block)
    p.instCount = ExfColumn(block, n, 1, p.instLevel)
    ExfColumn block, n, 2, p.instKey
    ExfColumn block, n, 3, p.instListStart
    ExfColumn block, n, 4, p.instListCount

    n = ExfSection(ws, "INSTLIST", block)
    p.instListTotal = ExfColumn(block, n, 1, p.instLists)

    n = ExfSection(ws, "COL", block)
    p.colCount = ExfColumn(block, n, 1, p.colName)
    ExfColumn block, n, 2, p.colKind
    ExfColumn block, n, 3, p.colAttr
    ExfColumn block, n, 4, p.colCdata
    ExfColumn block, n, 5, p.colSegStart
    ExfColumn block, n, 6, p.colSegCount

    n = ExfSection(ws, "SEG", block)
    p.segCount = ExfColumn(block, n, 1, p.segName)
    ExfColumn block, n, 2, p.segIndex
    ExfColumn block, n, 3, p.segQualAttr
    ExfColumn block, n, 4, p.segQualValue

    n = ExfSection(ws, "ANCESTOR", block)
    p.ancestorCount = ExfColumn(block, n, 1, p.ancestorCols)

    n = ExfSection(ws, "SELFCLOSE", block)
    p.selfCloseCount = ExfColumn(block, n, 1, p.selfClosing)

    n = ExfSection(ws, "BOOLCOL", block)
    p.boolColCount = ExfColumn(block, n, 1, p.boolCols)

    n = ExfSection(ws, "BOOLTOKEN", block)
    p.boolTokenCount = ExfPairs(block, n, p.boolTokens)

    n = ExfSection(ws, "CASE", block)
    p.caseCount = ExfPairs(block, n, p.caseMap)

    n = ExfSection(ws, "SPACE", block)
    p.spaceCount = ExfColumn(block, n, 1, p.spaces)

    ExfReadPlan = True
    Exit Function

Missing:
    ExfSetError "errPlanMissing"
End Function

' Rows of a section as a 1-based block (Empty when the section is empty or
' absent); returns its number of rows.
Private Function ExfSection(ByVal ws As Worksheet, ByVal secName As String, ByRef block As Variant) As Long
    Dim i As Long
    block = Empty
    For i = 0 To mSecTotal - 1
        If mSecName(i) = secName Then
            If mSecRows(i) > 0 And mSecWidth(i) > 0 And mSecFirst(i) > 0 Then
                block = ExfBlock(ws, mSecFirst(i), mSecRows(i), mSecWidth(i))
                ExfSection = mSecRows(i)
            End If
            Exit Function
        End If
    Next i
End Function

' Column col of a block into arr (0-based, one spare slot); returns n.
Private Function ExfColumn(ByRef block As Variant, ByVal n As Long, ByVal col As Long, ByRef arr() As Long) As Long
    Dim r As Long
    ReDim arr(0 To n)
    For r = 1 To n
        arr(r - 1) = ExfCellLong(block(r, col))
    Next r
    ExfColumn = n
End Function

' Two-column block into a flat pair list (0-based, one spare slot); returns n.
Private Function ExfPairs(ByRef block As Variant, ByVal n As Long, ByRef arr() As Long) As Long
    Dim r As Long
    ReDim arr(0 To 2 * n)
    For r = 1 To n
        arr(2 * r - 2) = ExfCellLong(block(r, 1))
        arr(2 * r - 1) = ExfCellLong(block(r, 2))
    Next r
    ExfPairs = n
End Function

' STR row r: its chunks joined back.
Private Function ExfJoinChunks(ByRef block As Variant, ByVal r As Long) As String
    Dim k As Long, j As Long, parts() As String
    k = ExfCellLong(block(r, 1))
    If k <= 1 Then
        If k = 1 Then ExfJoinChunks = ExfCellString(block(r, 2))
        Exit Function
    End If
    ReDim parts(0 To k - 1)
    For j = 1 To k
        parts(j - 1) = ExfCellString(block(r, 1 + j))
    Next j
    ExfJoinChunks = Join(parts, vbNullString)
End Function

Public Function ExfCellString(ByRef v As Variant) As String
    If VarType(v) = vbString Then
        ExfCellString = v
    ElseIf IsEmpty(v) Or IsError(v) Then
        ExfCellString = vbNullString
    Else
        ExfCellString = CStr(v)
    End If
End Function

Private Function ExfCellLong(ByRef v As Variant) As Long
    If ExfIsNumber(v) Then ExfCellLong = CLng(v)
End Function

Private Function ExfIsNumber(ByRef v As Variant) As Boolean
    Select Case VarType(v)
        Case vbDouble, vbLong, vbInteger, vbSingle, vbCurrency, vbDecimal, vbByte
            ExfIsNumber = True
    End Select
End Function

Attribute VB_Name = "modExfRun"
' ExcelifyXML - one run of the macro on a workbook: plan, Data sheet, engine,
' save dialog, file, message. Called by the button (modExfEntry) on the
' workbook that holds this code.
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Compare Binary
Option Private Module

' Returns a report: "OK<TAB>rows<TAB>bytes<TAB>conversions<TAB>cells<TAB>new
' columns<TAB>ignored columns<TAB>milliseconds", or "ERR<TAB>key<TAB>name=value...".
' Not interactive (the test benches only, from inside the project): no dialog
' and no message, writes outPath.
Public Function ExfRunBook(ByVal book As Workbook, ByVal outPath As String, ByVal interactive As Boolean) As String
    Dim p As ExfPlan, sh As ExfSheet, wsPlan As Worksheet, wsData As Worksheet
    Dim target As String, extensionFixed As Boolean, fileNo As Integer, bytes As Double
    Dim t0 As Double, cancelKey As Long, report As String, msg As String, warn As Boolean, inPlace As Boolean

    On Error GoTo Failed
    t0 = Timer
    cancelKey = Application.EnableCancelKey
    Application.EnableCancelKey = xlErrorHandler     ' Esc stops cleanly
    ExfClearError
    ExfMessagesClear

    ' 1. The plan
    Set wsPlan = ExfSheetByCodeName(book, "shPlan")
    If wsPlan Is Nothing Then
        ExfSetError "errPlanMissing"
        GoTo Finish
    End If
    If Not ExfReadPlan(wsPlan, p) Then GoTo Finish

    ' 2. The Data sheet
    Set wsData = ExfSheetByCodeName(book, "shData")
    If wsData Is Nothing Then
        ExfSetError "errDataSheetMissing"
        GoTo Finish
    End If
    If Not ExfReadHeaders(wsData, sh) Then GoTo Finish
    If Not ExfEngineStart(p, sh.headers, sh.nCols) Then GoTo Finish
    If interactive Then
        If wsData.FilterMode Then
            If MsgBox(ExfFill(ExfMessageText("filterNotice"), "sheet", wsData.Name), _
                      vbOKCancel + vbQuestion, ExfMessageText("title")) <> vbOK Then GoTo Finish
        End If
    End If
    ExfStatus ExfFill(ExfMessageText("progressReading"), "done", "0", "total", CStr(sh.lastRow - sh.firstRow + 1))
    If Not ExfReadRows(wsData, sh) Then GoTo Finish

    ' 3. The XML, built in memory (every refusal happens here, before any file)
    If Not ExfEngineBuild(p) Then GoTo Finish

    ' 4. Where to write
    If interactive Then
        target = ExfAskSavePath(book.Path, p.outputName, extensionFixed)
        If Len(target) = 0 Then GoTo Finish         ' cancelled
    Else
        ' A new .xml file only: never another kind, never over an existing file.
        target = outPath
        If LCase$(Right$(target, 4)) <> ".xml" Or ExfFileExists(target) Then
            ExfSetError "errWrite", "path", target
            GoTo Finish
        End If
    End If
    If ExfIsCloudPath(target) Then
        ExfSetError "errCloudPath", "path", target
        GoTo Finish
    End If
    If Not ExfPathEncodable(target) Then
        ExfSetError "errPathCharacters", "path", target
        GoTo Finish
    End If
    If interactive Then
        ' Windows: this dialog doesn't warn about an existing file. Mac: the
        ' dialog itself asked, for the very name it returned.
        If ExfOverwriteNeedsConfirm(target, extensionFixed) Then
            If MsgBox(ExfFill(ExfMessageText("confirmOverwrite"), "name", ExfFileName(target)), _
                      vbYesNo + vbQuestion + vbDefaultButton2, ExfMessageText("title")) <> vbYes Then GoTo Finish
        End If
    End If

    ' Mac, file chosen in the save dialog: the only file Excel may write, so it
    ' is written in place. Elsewhere (Windows, test benches): next to it, then
    ' renamed over it.
#If Mac Then
    inPlace = interactive
#End If
    ExfStatus ExfMessageText("progressWriting")
    fileNo = ExfOpenOutput(target, inPlace)
    If fileNo = 0 Then GoTo Finish
    bytes = ExfWriteXml(p, fileNo)
    If inPlace Then
        Close #fileNo
    ElseIf Not ExfCommitOutput(fileNo, target) Then
        fileNo = 0
        GoTo Finish
    End If
    fileNo = 0

    report = "OK" & vbTab & ExfEngineRowCount() & vbTab & bytes & vbTab & sh.conversions & vbTab & _
        ExfJoinCells(sh, ",") & vbTab & ExfEngineNewColumns() & vbTab & ExfEngineIgnoredColumns() & vbTab & _
        Round((Timer - t0) * 1000)
    If interactive Then
        ExfStatusClear
        msg = ExfFill(ExfMessageText("success"), "rows", CStr(ExfEngineRowCount()), "path", target)
        If sh.conversions > 0 Then
            msg = msg & vbLf & vbLf & ExfFill(ExfMessageText("successConversions"), _
                "count", CStr(sh.conversions), "cells", ExfJoinCells(sh, ", "))
            warn = True
        End If
        If Len(ExfEngineNewColumns()) > 0 Then
            msg = msg & vbLf & vbLf & ExfFill(ExfMessageText("successNewColumns"), "columns", ExfShortList(ExfEngineNewColumns()))
            warn = True
        End If
        If Len(ExfEngineIgnoredColumns()) > 0 Then
            msg = msg & vbLf & vbLf & ExfFill(ExfMessageText("successIgnoredColumns"), "columns", ExfShortList(ExfEngineIgnoredColumns()))
            warn = True
        End If
        If warn Then
            MsgBox msg, vbExclamation, ExfMessageText("title")
        Else
            MsgBox msg, vbInformation, ExfMessageText("title")
        End If
    End If

Finish:
    On Error Resume Next
    If fileNo <> 0 Then ExfAbandonOutput fileNo, target, inPlace
    ExfEngineReset
    ExfStatusClear
    Application.EnableCancelKey = cancelKey
    If Len(ExfErrorKey()) > 0 Then
        report = ExfErrorReport()
        If interactive Then MsgBox ExfErrorMessage(), vbExclamation, ExfMessageText("title")
    ElseIf Len(report) = 0 Then
        report = "CANCELLED"
    End If
    ExfRunBook = report
    Exit Function

Failed:
    If Err.Number = 18 Then                   ' Esc: stopped by the user, nothing to say
        report = "CANCELLED"
    Else
        ExfSetError "errUnexpected", "code", CStr(Err.Number), "description", Err.Description
    End If
    Resume Finish
End Function

' Normally the file is written next to its final place, then renamed over it:
' an existing file is only replaced once the new one is complete. In place on
' Mac for the file chosen in the save dialog, the only one the sandbox lets
' Excel write there (see ExfAskSavePath).
Private Function ExfOpenOutput(ByVal target As String, ByVal inPlace As Boolean) As Integer
    On Error GoTo Denied
    If inPlace Then
        ExfOpenOutput = ExfWriterOpenInPlace(target)
    Else
        ExfOpenOutput = ExfWriterOpen(target)
    End If
    Exit Function
Denied:
#If Mac Then
    ExfSetError "errMacAccess", "path", target
#Else
    ExfSetError "errWrite", "path", target
#End If
End Function

Private Function ExfCommitOutput(ByVal fileNo As Integer, ByVal target As String) As Boolean
    On Error GoTo Denied
    ExfWriterCommit fileNo, target
    ExfCommitOutput = True
    Exit Function
Denied:
    ' The complete temporary file (target & ".tmp") is left in place.
    ExfSetError "errWrite", "path", target
    ExfCloseQuietly fileNo
End Function

' A run stopped while writing leaves no half-written file behind.
Private Sub ExfAbandonOutput(ByVal fileNo As Integer, ByVal target As String, ByVal inPlace As Boolean)
    On Error Resume Next
    Close #fileNo
    If inPlace Then
        Kill target
    Else
        Kill target & ".tmp"
    End If
End Sub

Private Sub ExfCloseQuietly(ByVal fileNo As Integer)
    On Error Resume Next
    Close #fileNo
End Sub

Private Function ExfOverwriteNeedsConfirm(ByVal target As String, ByVal extensionFixed As Boolean) As Boolean
#If Mac Then
    Exit Function
#End If
    ExfOverwriteNeedsConfirm = ExfFileExists(target)
End Function

' The first converted cells (at most five), e.g. "B7, C12".
Private Function ExfJoinCells(ByRef sh As ExfSheet, ByVal separator As String) As String
    Dim i As Long, s As String
    For i = 0 To 4
        If Len(sh.convCells(i)) > 0 Then
            If Len(s) > 0 Then s = s & separator
            s = s & sh.convCells(i)
        End If
    Next i
    ExfJoinCells = s
End Function

' A comma-separated list shortened for a message box (about 1,000 characters).
Private Function ExfShortList(ByVal list As String) As String
    Dim items() As String, i As Long, s As String
    items = Split(list, ",")
    For i = 0 To UBound(items)
        If i = 8 Then
            s = s & ", " & ChrW(8230)
            Exit For
        End If
        If i > 0 Then s = s & ", "
        If Len(items(i)) > 60 Then s = s & Left$(items(i), 60) & ChrW(8230) Else s = s & items(i)
    Next i
    ExfShortList = s
End Function

Attribute VB_Name = "modExfTree"
' ExcelifyXML - the reconstruction engine, part 3: the element tree, where
' each row's values find their element. Port of class Tree, layOut and
' applyColumn in src/lib/excel-macro/engine/execute.ts. Element and attribute names are held
' as numbers (their place in the plan's string pool), which compares faster
' than text in VBA; two names are equal exactly when their numbers are.
' The engine is split in four modules: modExfEngine, modExfBuild, this one,
' modExfWrite.
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Compare Binary
Option Private Module

' The tree (execute.ts class Tree): one entry per element, attributes chained.
' Public: read by modExfWrite, which writes it out.
Private mNodeCount As Long
Public nNameId() As Long
Public nText() As String
Public nCdata() As Boolean
Public nSelf() As Boolean
Public nStatic() As Long               ' plan node emitted as is, else -1
Public nFirst() As Long
Private nLast() As Long
Public nNext() As Long
Public nAttrFirst() As Long
Private nAttrLast() As Long
Public nRemoved() As Boolean
Private nFilled() As Boolean
Private mAttrCount As Long
Public aKeyId() As Long
Public aVal() As String
Public aNext() As Long
Private mRoot As Long
Private mWrapperIndex As ExfStrMap      ' wrappers and slots by parent, name and attributes
Private mSlots() As Long
Private mSlotCount As Long
Private mStrIndex As ExfStrMap          ' the plan's strings, for the names of new columns
Private mExtraNames() As String         ' names of new columns absent from the string pool
Private mExtraCount As Long

' ============================================================================
' Tree primitives
' ============================================================================

Public Sub ExfTreeInit(ByRef p As ExfPlan, ByVal rows As Long)
    Dim cap As Long, i As Long
    cap = 1024
    Do While cap < rows * 4 And cap < 4194304
        cap = cap * 2
    Loop
    mNodeCount = 0
    ReDim nNameId(0 To cap - 1)
    ReDim nText(0 To cap - 1)
    ReDim nCdata(0 To cap - 1)
    ReDim nSelf(0 To cap - 1)
    ReDim nStatic(0 To cap - 1)
    ReDim nFirst(0 To cap - 1)
    ReDim nLast(0 To cap - 1)
    ReDim nNext(0 To cap - 1)
    ReDim nAttrFirst(0 To cap - 1)
    ReDim nAttrLast(0 To cap - 1)
    ReDim nRemoved(0 To cap - 1)
    ReDim nFilled(0 To cap - 1)
    mAttrCount = 0
    ReDim aKeyId(0 To 1023)
    ReDim aVal(0 To 1023)
    ReDim aNext(0 To 1023)
    mSlotCount = 0
    ReDim mSlots(0 To 15)
    ExfMapInit mWrapperIndex, 64
    ExfMapInit mStrIndex, p.strCount
    For i = 0 To p.strCount - 1
        ExfMapSet mStrIndex, p.strs(i), i
    Next i
    mExtraCount = 0
    ReDim mExtraNames(0 To 15)
    mRoot = 0
End Sub

Private Sub ExfGrowNodes()
    Dim cap As Long
    cap = 2 * (UBound(nNameId) + 1)
    ReDim Preserve nNameId(0 To cap - 1)
    ReDim Preserve nText(0 To cap - 1)
    ReDim Preserve nCdata(0 To cap - 1)
    ReDim Preserve nSelf(0 To cap - 1)
    ReDim Preserve nStatic(0 To cap - 1)
    ReDim Preserve nFirst(0 To cap - 1)
    ReDim Preserve nLast(0 To cap - 1)
    ReDim Preserve nNext(0 To cap - 1)
    ReDim Preserve nAttrFirst(0 To cap - 1)
    ReDim Preserve nAttrLast(0 To cap - 1)
    ReDim Preserve nRemoved(0 To cap - 1)
    ReDim Preserve nFilled(0 To cap - 1)
End Sub

' = Tree.newNode
Public Function ExfTreeNewNode(ByVal nameId As Long, ByVal selfClosing As Boolean, ByVal staticId As Long) As Long
    Dim id As Long
    id = mNodeCount
    If id > UBound(nNameId) Then ExfGrowNodes
    nNameId(id) = nameId
    nSelf(id) = selfClosing
    nStatic(id) = staticId
    nFirst(id) = -1
    nLast(id) = -1
    nNext(id) = -1
    nAttrFirst(id) = -1
    nAttrLast(id) = -1
    mNodeCount = id + 1
    ExfTreeNewNode = id
End Function

' = Tree.append
Public Sub ExfTreeAppend(ByVal parentNode As Long, ByVal child As Long)
    If nLast(parentNode) < 0 Then
        nFirst(parentNode) = child
    Else
        nNext(nLast(parentNode)) = child
    End If
    nLast(parentNode) = child
End Sub

' = Tree.setAttr: an existing attribute keeps its place, as in a JavaScript object.
Public Sub ExfTreeSetAttr(ByVal node As Long, ByVal keyId As Long, ByRef aValue As String)
    Dim a As Long, cap As Long
    a = nAttrFirst(node)
    Do While a >= 0
        If aKeyId(a) = keyId Then
            aVal(a) = aValue
            Exit Sub
        End If
        a = aNext(a)
    Loop
    a = mAttrCount
    If a > UBound(aKeyId) Then
        cap = 2 * (UBound(aKeyId) + 1)
        ReDim Preserve aKeyId(0 To cap - 1)
        ReDim Preserve aVal(0 To cap - 1)
        ReDim Preserve aNext(0 To cap - 1)
    End If
    aKeyId(a) = keyId
    aVal(a) = aValue
    aNext(a) = -1
    If nAttrLast(node) < 0 Then
        nAttrFirst(node) = a
    Else
        aNext(nAttrLast(node)) = a
    End If
    nAttrLast(node) = a
    mAttrCount = a + 1
End Sub

' = Tree.getAttr: False when absent.
Private Function ExfGetAttr(ByVal node As Long, ByVal keyId As Long, ByRef aValue As String) As Boolean
    Dim a As Long
    a = nAttrFirst(node)
    Do While a >= 0
        If aKeyId(a) = keyId Then
            aValue = aVal(a)
            ExfGetAttr = True
            Exit Function
        End If
        a = aNext(a)
    Loop
End Function

Public Sub ExfTreeSetText(ByVal node As Long, ByRef aValue As String)
    nText(node) = aValue
End Sub

Public Sub ExfTreeSetRoot(ByVal node As Long)
    mRoot = node
End Sub

' First visit of a wrapper instance (its siblings are laid out once).
Public Function ExfTreeFilled(ByVal node As Long) As Boolean
    ExfTreeFilled = nFilled(node)
End Function

Public Sub ExfTreeMarkFilled(ByVal node As Long)
    nFilled(node) = True
End Sub

' Wrapper elements (and slots) by "parent|name|attribute signature", -1 when absent.
Public Function ExfTreeWrapperGet(ByRef key As String) As Long
    ExfTreeWrapperGet = ExfMapGet(mWrapperIndex, key)
End Function

Public Sub ExfTreeWrapperSet(ByRef key As String, ByVal node As Long)
    ExfMapSet mWrapperIndex, key, node
End Sub

' Name of a new column as a number: its place in the string pool when the pool
' has it (the same name as a path segment is the same element), else a number
' past the pool.
Public Function ExfTreeNameIdOf(ByRef p As ExfPlan, ByRef nm As String) As Long
    Dim id As Long
    id = ExfMapGet(mStrIndex, nm)
    If id < 0 Then
        If mExtraCount > UBound(mExtraNames) Then ReDim Preserve mExtraNames(0 To 2 * mExtraCount)
        mExtraNames(mExtraCount) = nm
        id = p.strCount + mExtraCount
        mExtraCount = mExtraCount + 1
    End If
    ExfTreeNameIdOf = id
End Function

Public Function ExfTreeNameText(ByRef p As ExfPlan, ByVal nameId As Long) As String
    If nameId < p.strCount Then
        ExfTreeNameText = p.strs(nameId)
    Else
        ExfTreeNameText = mExtraNames(nameId - p.strCount)
    End If
End Function

Public Function ExfTreeRoot() As Long
    ExfTreeRoot = mRoot
End Function

' A slot no row reached is left out.
Public Sub ExfTreePruneSlots()
    Dim i As Long
    For i = 0 To mSlotCount - 1
        If Not nFilled(mSlots(i)) Then nRemoved(mSlots(i)) = True
    Next i
End Sub

' ============================================================================
' Layout and columns
' ============================================================================

' = execute.ts layOut: kept siblings (emitted from the plan as they are), and
' slots re-created empty, where the rows' container sits among them.
Public Sub ExfTreeLayOut(ByRef p As ExfPlan, ByVal parentNode As Long, ByRef list() As Long, ByVal start As Long, ByVal count As Long)
    Dim j As Long, id As Long, el As Long, a As Long, na As Long, first As Long
    Dim keys() As String, vals() As String
    For j = start To start + count - 1
        id = list(j)
        If p.nodeSlot(id) = 1 Then
            el = ExfTreeNewNode(p.nodeName(id), False, -1)
            na = p.nodeAttrCount(id)
            first = p.nodeAttrStart(id)
            If na > 0 Then
                ReDim keys(0 To na - 1)
                ReDim vals(0 To na - 1)
            End If
            For a = first To first + na - 1
                keys(a - first) = p.strs(p.nodeAttrs(2 * a))
                vals(a - first) = p.strs(p.nodeAttrs(2 * a + 1))
                ExfTreeSetAttr el, p.nodeAttrs(2 * a), p.strs(p.nodeAttrs(2 * a + 1))
            Next a
            ExfTreeAppend parentNode, el
            ExfAddSlotKey parentNode & "|" & p.strs(p.nodeName(id)) & "|" & ExfAttrSig(keys, vals, na), el
        Else
            ExfTreeAppend parentNode, ExfTreeNewNode(p.nodeName(id), False, id)
        End If
    Next j
End Sub

Private Sub ExfAddSlotKey(ByVal key As String, ByVal el As Long)
    If ExfMapGet(mWrapperIndex, key) < 0 Then ExfMapSet mWrapperIndex, key, el
    If mSlotCount > UBound(mSlots) Then ReDim Preserve mSlots(0 To 2 * mSlotCount)
    mSlots(mSlotCount) = el
    mSlotCount = mSlotCount + 1
End Sub

' = execute.ts applyColumn (reconstruct.ts applyDescriptor + descendPath).
Public Sub ExfTreeApplyColumn(ByRef p As ExfPlan, ByRef isSelf() As Boolean, ByVal rowNode As Long, ByVal colId As Long, ByRef aValue As String)
    Dim kind As Long, cur As Long, s As Long, nameId As Long, idx As Long, cnt As Long
    Dim found As Long, c As Long, fresh As Long, attrId As Long, want As String, got As String

    kind = p.colKind(colId)
    If kind = EXF_COL_NONE Then Exit Sub
    cur = rowNode
    For s = p.colSegStart(colId) To p.colSegStart(colId) + p.colSegCount(colId) - 1
        nameId = p.segName(s)
        If p.segIndex(s) >= 0 Then
            ' Positional: materialize the same-name children up to the index.
            idx = p.segIndex(s)
            cnt = 0
            found = -1
            c = nFirst(cur)
            Do While c >= 0
                If nNameId(c) = nameId Then
                    If cnt = idx Then found = c
                    cnt = cnt + 1
                End If
                c = nNext(c)
            Loop
            Do While found < 0
                fresh = ExfTreeNewNode(nameId, isSelf(nameId), -1)
                ExfTreeAppend cur, fresh
                If cnt = idx Then found = fresh
                cnt = cnt + 1
            Loop
        ElseIf p.segQualAttr(s) >= 0 Then
            attrId = p.segQualAttr(s)
            want = p.strs(p.segQualValue(s))
            found = -1
            c = nFirst(cur)
            Do While c >= 0
                If nNameId(c) = nameId Then
                    If ExfGetAttr(c, attrId, got) Then
                        If got = want Then
                            found = c
                            Exit Do
                        End If
                    End If
                End If
                c = nNext(c)
            Loop
            If found < 0 Then
                found = ExfTreeNewNode(nameId, isSelf(nameId), -1)
                ExfTreeSetAttr found, attrId, want
                ExfTreeAppend cur, found
            End If
        Else
            found = -1
            c = nFirst(cur)
            Do While c >= 0
                If nNameId(c) = nameId Then
                    found = c
                    Exit Do
                End If
                c = nNext(c)
            Loop
            If found < 0 Then
                found = ExfTreeNewNode(nameId, isSelf(nameId), -1)
                ExfTreeAppend cur, found
            End If
        End If
        cur = found
    Next s
    If kind = EXF_COL_TEXT Then
        nText(cur) = aValue
        If p.colCdata(colId) = 1 Then nCdata(cur) = True
    ElseIf kind = EXF_COL_ATTR Then
        ExfTreeSetAttr cur, p.colAttr(colId), aValue
    End If
End Sub

' Frees the tree's memory.
Public Sub ExfTreeReset()
    mNodeCount = 0
    mAttrCount = 0
    mSlotCount = 0
    mExtraCount = 0
    Erase nNameId, nText, nCdata, nSelf, nStatic, nFirst, nLast, nNext, nAttrFirst, nAttrLast, nRemoved, nFilled
    Erase aKeyId, aVal, aNext, mSlots, mExtraNames
    ExfMapInit mWrapperIndex, 16
    ExfMapInit mStrIndex, 16
End Sub

Attribute VB_Name = "modExfUi"
' ExcelifyXML - what the user sees: messages (in the workbook's language, read
' from the plan: this file holds no French or English text), the save dialog,
' the status bar.
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Compare Binary
Option Private Module

Private mMsgIndex As ExfStrMap
Private mMsgText() As String
Private mMsgCount As Long
Private mMsgReady As Boolean

Private mErrKey As String
Private mErrArgs() As String        ' placeholder name, value, name, value...
Private mErrArgCount As Long

' ----------------------------------------------------------------------------
' Messages
' ----------------------------------------------------------------------------

Public Sub ExfMessagesClear()
    ExfMapInit mMsgIndex, 64
    ReDim mMsgText(0 To 63)
    mMsgCount = 0
    mMsgReady = True
End Sub

Public Sub ExfMessageAdd(ByVal key As String, ByVal txt As String)
    Dim i As Long
    If Not mMsgReady Then ExfMessagesClear
    i = ExfMapGet(mMsgIndex, key)
    If i < 0 Then
        i = mMsgCount
        If i > UBound(mMsgText) Then ReDim Preserve mMsgText(0 To 2 * i)
        ExfMapSet mMsgIndex, key, i
        mMsgCount = i + 1
    End If
    mMsgText(i) = txt
End Sub

' The message in the workbook's language, or a short built-in text when the
' plan (and so every message) is missing.
Public Function ExfMessageText(ByVal key As String) As String
    Dim i As Long
    i = -1
    If mMsgReady Then i = ExfMapGet(mMsgIndex, key)
    If i >= 0 Then
        ExfMessageText = mMsgText(i)
    Else
        ExfMessageText = ExfFallbackText(key)
    End If
End Function

' Built-in texts, English then French (accents written as character codes:
' this file stays ASCII).
Private Function ExfFallbackText(ByVal key As String) As String
    Select Case key
        Case "title", "saveDialogTitle"
            ExfFallbackText = "ExcelifyXML"
        Case "fileFilterLabel"
            ExfFallbackText = "XML"
        Case "errPlanMissing"
            ExfFallbackText = "This workbook's structure information is missing or damaged. " & _
                "Start again from the downloaded workbook." & vbLf & vbLf & _
                "Les informations de structure de ce classeur sont manquantes ou ab" & ChrW(238) & "m" & ChrW(233) & "es. " & _
                "Repartez du classeur t" & ChrW(233) & "l" & ChrW(233) & "charg" & ChrW(233) & "."
        Case "errPlanTooNew"
            ExfFallbackText = "This workbook needs a newer version of the macro ({needed}). " & _
                "Generate a new workbook on excelifyxml.com." & vbLf & vbLf & _
                "Ce classeur demande une version plus r" & ChrW(233) & "cente de la macro ({needed}). " & _
                "G" & ChrW(233) & "n" & ChrW(233) & "rez un nouveau classeur sur excelifyxml.com."
        Case "errUnexpected"
            ExfFallbackText = "ExcelifyXML: {code} - {description}"
        Case Else
            ExfFallbackText = "ExcelifyXML: " & key
    End Select
End Function

' Replaces each {name} whose name is given (pairs name, value), in a single
' pass like fillText in workbook-texts.ts: an inserted value is never read
' again, an unknown placeholder is left as is.
Public Function ExfFill(ByVal template As String, ParamArray args() As Variant) As String
    Dim pairs() As String, n As Long, i As Long
    n = UBound(args) + 1
    If n > 0 Then
        ReDim pairs(0 To n - 1)
        For i = 0 To n - 1
            pairs(i) = CStr(args(i))
        Next i
    End If
    ExfFill = ExfFillPairs(template, pairs, n)
End Function

Private Function ExfFillPairs(ByVal template As String, ByRef pairs() As String, ByVal n As Long) As String
    Dim out As String, pos As Long, openAt As Long, closeAt As Long, nm As String, a As Long, found As Long
    pos = 1
    Do
        openAt = InStr(pos, template, "{", vbBinaryCompare)
        If openAt = 0 Then Exit Do
        closeAt = InStr(openAt + 1, template, "}", vbBinaryCompare)
        If closeAt = 0 Then Exit Do
        nm = Mid$(template, openAt + 1, closeAt - openAt - 1)
        found = -1
        If ExfIsWord(nm) Then
            For a = 0 To n - 2 Step 2
                If pairs(a) = nm Then
                    found = a + 1
                    Exit For
                End If
            Next a
        End If
        If found >= 0 Then
            out = out & Mid$(template, pos, openAt - pos) & pairs(found)
            pos = closeAt + 1
        Else
            out = out & Mid$(template, pos, openAt - pos + 1)
            pos = openAt + 1
        End If
    Loop
    ExfFillPairs = out & Mid$(template, pos)
End Function

' Placeholder names: letters, digits and underscores (\w in JavaScript).
Private Function ExfIsWord(ByRef s As String) As Boolean
    Dim i As Long, c As Long
    If Len(s) = 0 Then Exit Function
    For i = 1 To Len(s)
        c = ExfUnit(s, i)
        If Not ((c >= 48 And c <= 57) Or (c >= 65 And c <= 90) Or (c >= 97 And c <= 122) Or c = 95) Then Exit Function
    Next i
    ExfIsWord = True
End Function

' ----------------------------------------------------------------------------
' The message to show when the macro stops
' ----------------------------------------------------------------------------

Public Sub ExfSetError(ByVal key As String, ParamArray args() As Variant)
    Dim i As Long
    mErrKey = key
    mErrArgCount = UBound(args) + 1
    If mErrArgCount > 0 Then
        ReDim mErrArgs(0 To mErrArgCount - 1)
        For i = 0 To mErrArgCount - 1
            mErrArgs(i) = CStr(args(i))
        Next i
    End If
End Sub

Public Sub ExfClearError()
    mErrKey = vbNullString
    mErrArgCount = 0
End Sub

Public Function ExfErrorKey() As String
    ExfErrorKey = mErrKey
End Function

Public Function ExfErrorMessage() As String
    ExfErrorMessage = ExfFillPairs(ExfMessageText(mErrKey), mErrArgs, mErrArgCount)
End Function

' For the test benches: "ERR<TAB>key<TAB>name=value<TAB>..."
Public Function ExfErrorReport() As String
    Dim s As String, a As Long
    s = "ERR" & vbTab & mErrKey
    For a = 0 To mErrArgCount - 2 Step 2
        s = s & vbTab & mErrArgs(a) & "=" & mErrArgs(a + 1)
    Next a
    ExfErrorReport = s
End Function

' ----------------------------------------------------------------------------
' Where to write
' ----------------------------------------------------------------------------

' Save dialog, proposing "<source>-modifie.xml". Returns "" when cancelled.
' Mac: Excel may only write the very file chosen in this dialog (sandbox), and
' the dialog offers Excel's formats (.xlsx by default, no filter possible): the
' dialog is shown again until the user picks an XML format, so that the name
' it returns ends in .xml. Windows: an XML filter; extensionFixed tells whether
' the typed name had to be corrected to end in .xml.
Public Function ExfAskSavePath(ByVal folder As String, ByVal suggested As String, ByRef extensionFixed As Boolean) As String
    Dim p As Variant
#If Mac Then
    Do
        p = Application.GetSaveAsFilename(InitialFileName:=suggested)
        If VarType(p) = vbBoolean Then Exit Function
        If LCase$(Right$(CStr(p), 4)) = ".xml" Then Exit Do
        If MsgBox(ExfMessageText("macChooseXml"), vbOKCancel + vbInformation, ExfMessageText("title")) <> vbOK Then Exit Function
    Loop
    ExfAskSavePath = CStr(p)
#Else
    If Len(folder) > 0 And Not ExfIsCloudPath(folder) Then suggested = folder & Application.PathSeparator & suggested
    p = Application.GetSaveAsFilename(InitialFileName:=suggested, _
        FileFilter:=ExfMessageText("fileFilterLabel") & " (*.xml),*.xml", Title:=ExfMessageText("saveDialogTitle"))
    If VarType(p) = vbBoolean Then Exit Function
    ExfAskSavePath = ExfXmlPath(CStr(p), extensionFixed)
#End If
End Function

Public Function ExfXmlPath(ByVal filePath As String, ByRef extensionFixed As Boolean) As String
    If LCase$(Right$(filePath, 5)) = ".xlsx" Then
        filePath = Left$(filePath, Len(filePath) - 5)
        extensionFixed = True
    End If
    If LCase$(Right$(filePath, 4)) <> ".xml" Then
        filePath = filePath & ".xml"
        extensionFixed = True
    End If
    ExfXmlPath = filePath
End Function

Public Function ExfIsCloudPath(ByVal filePath As String) As Boolean
    Dim s As String
    s = LCase$(Left$(filePath, 8))
    ExfIsCloudPath = (Left$(s, 7) = "http://" Or s = "https://")
End Function

' Windows: file names go through the ANSI code page in VBA; a character it
' can't hold (emoji, other alphabets) would silently become "?".
Public Function ExfPathEncodable(ByVal filePath As String) As Boolean
#If Mac Then
    ExfPathEncodable = True
#Else
    ExfPathEncodable = (StrConv(StrConv(filePath, vbFromUnicode), vbUnicode) = filePath)
#End If
End Function

Public Function ExfFileExists(ByVal filePath As String) As Boolean
    On Error Resume Next
    ExfFileExists = Len(Dir$(filePath)) > 0
End Function

Public Function ExfFileName(ByVal filePath As String) As String
    Dim i As Long
    i = InStrRev(filePath, Application.PathSeparator)
    If i = 0 Then i = InStrRev(filePath, "/")
    ExfFileName = Mid$(filePath, i + 1)
End Function

' ----------------------------------------------------------------------------
' Status bar
' ----------------------------------------------------------------------------

Public Sub ExfStatus(ByVal msg As String)
    On Error Resume Next
    Application.StatusBar = msg
End Sub

Public Sub ExfStatusClear()
    On Error Resume Next
    Application.StatusBar = False
End Sub

Attribute VB_Name = "modExfUtf8"
' ExcelifyXML - UTF-8 encoding and file output in native VBA (Windows + Mac).
' No COM object, no Declare, no network: nothing that an antivirus heuristic or
' the Mac sandbox objects to.
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Private Module

' Encode a string (UTF-16 inside VBA) as UTF-8 bytes. A surrogate pair becomes
' a 4-byte sequence and a lone surrogate becomes U+FFFD (EF BF BD), exactly like
' the TextEncoder used by the website, so both outputs are byte-identical.
Public Function ExfUtf8(ByRef s As String) As Byte()
    Dim src() As Byte, out() As Byte
    Dim n As Long, i As Long, j As Long
    Dim c As Long, c2 As Long, cp As Long

    If Len(s) = 0 Then
        ExfUtf8 = out
        Exit Function
    End If
    src = s                                 ' UTF-16LE code units, 2 bytes each
    n = (UBound(src) + 1) \ 2
    ReDim out(0 To n * 3 - 1)               ' worst case: 3 bytes per code unit

    Do While i < n
        c = src(2 * i) Or (CLng(src(2 * i + 1)) * &H100&)
        If c < &H80& Then
            out(j) = c
            j = j + 1
        ElseIf c < &H800& Then
            out(j) = &HC0& Or (c \ &H40&)
            out(j + 1) = &H80& Or (c And &H3F&)
            j = j + 2
        ElseIf c >= &HD800& And c <= &HDFFF& Then
            c2 = -1
            If c <= &HDBFF& And i + 1 < n Then c2 = src(2 * i + 2) Or (CLng(src(2 * i + 3)) * &H100&)
            If c2 >= &HDC00& And c2 <= &HDFFF& Then
                cp = &H10000 + (c - &HD800&) * &H400& + (c2 - &HDC00&)
                out(j) = &HF0& Or (cp \ &H40000)
                out(j + 1) = &H80& Or ((cp \ &H1000&) And &H3F&)
                out(j + 2) = &H80& Or ((cp \ &H40&) And &H3F&)
                out(j + 3) = &H80& Or (cp And &H3F&)
                j = j + 4
                i = i + 1                   ' the low surrogate is consumed
            Else
                out(j) = &HEF&              ' lone surrogate -> U+FFFD
                out(j + 1) = &HBF&
                out(j + 2) = &HBD&
                j = j + 3
            End If
        Else
            out(j) = &HE0& Or (c \ &H1000&)
            out(j + 1) = &H80& Or ((c \ &H40&) And &H3F&)
            out(j + 2) = &H80& Or (c And &H3F&)
            j = j + 3
        End If
        i = i + 1
    Loop

    ReDim Preserve out(0 To j - 1)
    ExfUtf8 = out
End Function

' Number of bytes in an array that may be unallocated (empty string case).
Public Function ExfByteCount(ByRef data() As Byte) As Long
    On Error GoTo NoData
    ExfByteCount = UBound(data) - LBound(data) + 1
    Exit Function
NoData:
    ExfByteCount = 0
End Function

' Open a temporary file next to the target, for sequential binary writes.
' "Open ... For Binary" does not truncate an existing file, hence the temporary
' file that ExfWriterCommit renames over the target at the end.
Public Function ExfWriterOpen(ByVal targetPath As String) As Integer
    Dim f As Integer
    On Error Resume Next
    Kill targetPath & ".tmp"
    On Error GoTo 0
    f = FreeFile
    Open targetPath & ".tmp" For Binary Access Write As #f
    ExfWriterOpen = f
End Function

' Mac: Excel may only write the file chosen in the save dialog - not a
' temporary file next to it - so that file is written in place: emptied first
' (Open ... For Output), then filled.
Public Function ExfWriterOpenInPlace(ByVal targetPath As String) As Integer
    Dim f As Integer
    f = FreeFile
    Open targetPath For Output As #f
    Close #f
    f = FreeFile
    Open targetPath For Binary Access Write As #f
    ExfWriterOpenInPlace = f
End Function

Public Sub ExfWriterPut(ByVal f As Integer, ByRef data() As Byte)
    If ExfByteCount(data) > 0 Then Put #f, , data
End Sub

Public Sub ExfWriterCommit(ByVal f As Integer, ByVal targetPath As String)
    Close #f
    If Len(Dir$(targetPath)) > 0 Then Kill targetPath
    Name targetPath & ".tmp" As targetPath
End Sub

Attribute VB_Name = "modExfWrite"
' ExcelifyXML - the reconstruction engine, part 4: writes the element tree
' (modExfTree) as XML. Port of emit in src/lib/excel-macro/engine/execute.ts
' (reconstruct.ts emitElement): UTF-8 without BOM, one line per element,
' same indentation, escaping and CDATA sections as the website.
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Compare Binary
Option Private Module

Private Const BUF_SIZE As Long = 1048576   ' characters encoded and written at a time

Private mBuf As String
Private mBufPos As Long
Private mOutFile As Integer
Private mOutBytes As Double

' Writes the XML to an open file (modExfUtf8), UTF-8 without BOM, one line per
' element, "\n" after each line. Returns the number of bytes written.
Public Function ExfWriteXml(ByRef p As ExfPlan, ByVal fileNo As Integer) As Double
    Dim unitText As String, pads() As String, padCount As Long
    Dim stNode() As Long, stStatic() As Boolean, stDepth() As Long, stClose() As Boolean, sp As Long
    Dim kids() As Long, kidCount As Long
    Dim id As Long, node As Long, isStatic As Boolean, depth As Long, closing As Boolean
    Dim nm As String, txt As String, selfClosing As Boolean, cdata As Boolean
    Dim a As Long, c As Long, i As Long

    mOutFile = fileNo
    mOutBytes = 0
    mBuf = Space$(BUF_SIZE)
    mBufPos = 1
    For i = 0 To p.prologueCount - 1
        ExfOut p.strs(p.prologue(i))
        ExfOut vbLf
    Next i

    unitText = p.strs(p.indent)
    ReDim pads(0 To 63)
    padCount = 1
    ReDim kids(0 To 63)
    ReDim stNode(0 To 1023)
    ReDim stStatic(0 To 1023)
    ReDim stDepth(0 To 1023)
    ReDim stClose(0 To 1023)
    stNode(0) = ExfTreeRoot()
    sp = 1

    Do While sp > 0
        sp = sp - 1
        id = stNode(sp)
        isStatic = stStatic(sp)
        depth = stDepth(sp)
        closing = stClose(sp)

        ' A tree node referring to a kept element is emitted from the plan.
        node = id
        If Not isStatic Then
            If nStatic(id) >= 0 Then
                node = nStatic(id)
                isStatic = True
            End If
        End If
        If isStatic Then nm = p.strs(p.nodeName(node)) Else nm = ExfTreeNameText(p, nNameId(node))

        Do While padCount <= depth
            If padCount > UBound(pads) Then ReDim Preserve pads(0 To 2 * padCount)
            pads(padCount) = pads(padCount - 1) & unitText
            padCount = padCount + 1
        Loop

        If closing Then
            ExfOut pads(depth)
            ExfOut "</"
            ExfOut nm
            ExfOut ">" & vbLf
        Else
            ExfOut pads(depth)
            ExfOut "<"
            ExfOut nm
            kidCount = 0
            If isStatic Then
                For a = p.nodeAttrStart(node) To p.nodeAttrStart(node) + p.nodeAttrCount(node) - 1
                    ExfOut " "
                    ExfOut p.strs(p.nodeAttrs(2 * a))
                    ExfOut "="""
                    ExfOut ExfEncodeAttr(p.strs(p.nodeAttrs(2 * a + 1)))
                    ExfOut """"
                Next a
                For c = p.nodeChildStart(node) To p.nodeChildStart(node) + p.nodeChildCount(node) - 1
                    If kidCount > UBound(kids) Then ReDim Preserve kids(0 To 2 * kidCount)
                    kids(kidCount) = p.nodeChildren(c)
                    kidCount = kidCount + 1
                Next c
                txt = p.strs(p.nodeText(node))
                selfClosing = (p.nodeSelfClosing(node) = 1)
                cdata = False
            Else
                a = nAttrFirst(node)
                Do While a >= 0
                    ExfOut " "
                    ExfOut p.strs(aKeyId(a))
                    ExfOut "="""
                    ExfOut ExfEncodeAttr(aVal(a))
                    ExfOut """"
                    a = aNext(a)
                Loop
                c = nFirst(node)
                Do While c >= 0
                    If Not nRemoved(c) Then
                        If kidCount > UBound(kids) Then ReDim Preserve kids(0 To 2 * kidCount)
                        kids(kidCount) = c
                        kidCount = kidCount + 1
                    End If
                    c = nNext(c)
                Loop
                txt = nText(node)
                selfClosing = nSelf(node)
                cdata = nCdata(node)
            End If

            If kidCount = 0 Then
                If Len(txt) = 0 Then
                    If selfClosing Then
                        ExfOut "/>" & vbLf
                    Else
                        ExfOut "></"
                        ExfOut nm
                        ExfOut ">" & vbLf
                    End If
                Else
                    ExfOut ">"
                    If ExfWantsCdata(txt, cdata) Then ExfOut ExfCdata(txt) Else ExfOut ExfEncodeText(txt)
                    ExfOut "</"
                    ExfOut nm
                    ExfOut ">" & vbLf
                End If
            Else
                ExfOut ">" & vbLf
                If sp + kidCount + 1 > UBound(stNode) Then
                    ReDim Preserve stNode(0 To 2 * (sp + kidCount + 1))
                    ReDim Preserve stStatic(0 To 2 * (sp + kidCount + 1))
                    ReDim Preserve stDepth(0 To 2 * (sp + kidCount + 1))
                    ReDim Preserve stClose(0 To 2 * (sp + kidCount + 1))
                End If
                stNode(sp) = node
                stStatic(sp) = isStatic
                stDepth(sp) = depth
                stClose(sp) = True
                sp = sp + 1
                For c = kidCount - 1 To 0 Step -1
                    stNode(sp) = kids(c)
                    stStatic(sp) = isStatic
                    stDepth(sp) = depth + 1
                    stClose(sp) = False
                    sp = sp + 1
                Next c
            End If
        End If
    Loop

    ExfFlushOut
    mBuf = vbNullString
    ExfWriteXml = mOutBytes
End Function

' Appends to the output buffer (Mid$ writes in place: no new string per piece).
' A piece is never cut, so a surrogate pair never straddles two writes.
Private Sub ExfOut(ByRef s As String)
    Dim n As Long
    n = Len(s)
    If n = 0 Then Exit Sub
    If mBufPos + n - 1 > BUF_SIZE Then
        ExfFlushOut
        If n > BUF_SIZE Then
            ExfWriteChunk s
            Exit Sub
        End If
    End If
    Mid$(mBuf, mBufPos, n) = s
    mBufPos = mBufPos + n
End Sub

Private Sub ExfFlushOut()
    If mBufPos > 1 Then ExfWriteChunk Left$(mBuf, mBufPos - 1)
    mBufPos = 1
End Sub

Private Sub ExfWriteChunk(ByRef s As String)
    Dim bytes() As Byte
    bytes = ExfUtf8(s)
    ExfWriterPut mOutFile, bytes
    mOutBytes = mOutBytes + ExfByteCount(bytes)
End Sub

Attribute VB_Name = "modExfXml"
' ExcelifyXML - text rules of the XML output, character by character: XML
' names, escaping, CDATA sections, trimming. Port of
' src/lib/excel-macro/engine/text.ts, where each function is proven equal to
' the website's online reconstruction over all of Unicode.
' (c) To The Rock SASU - licensed for use with ExcelifyXML workbooks only.
' This file must stay 7-bit ASCII: the VBA editor imports modules as ANSI.
Option Explicit
Option Compare Binary
Option Private Module

' UTF-16 code unit at position i (1-based), 0 to 65535 (AscW is signed).
Public Function ExfUnit(ByRef s As String, ByVal i As Long) As Long
    ExfUnit = AscW(Mid$(s, i, 1)) And &HFFFF&
End Function

' XML 1.0 name start characters (text.ts NAME_START, code units).
Private Function ExfIsNameStart(ByVal c As Long) As Boolean
    Select Case c
        Case &H41& To &H5A&, &H5F&, &H61& To &H7A&, &HC0& To &HD6&, &HD8& To &HF6&, _
             &HF8& To &H2FF&, &H370& To &H37D&, &H37F& To &H1FFF&, &H200C& To &H200D&, _
             &H2070& To &H218F&, &H2C00& To &H2FEF&, &H3001& To &HD7FF&, &HF900& To &HFDCF&, _
             &HFDF0& To &HFFFD&
            ExfIsNameStart = True
    End Select
End Function

' Characters also allowed after the first one (text.ts NAME_MORE).
Private Function ExfIsNameMore(ByVal c As Long) As Boolean
    Select Case c
        Case &H2D&, &H2E&, &H30& To &H3A&, &HB7&, &H300& To &H36F&, &H203F& To &H2040&
            ExfIsNameMore = True
    End Select
End Function

' = text.ts isXmlName: astral characters U+10000-U+EFFFF allowed as surrogate
' pairs, lone surrogates refused.
Public Function ExfIsXmlName(ByRef nm As String) As Boolean
    Dim i As Long, n As Long, c As Long, lo As Long, ok As Boolean, first As Boolean
    n = Len(nm)
    If n = 0 Then Exit Function
    i = 1
    first = True
    Do While i <= n
        c = ExfUnit(nm, i)
        If c >= &HD800& And c <= &HDBFF& Then
            lo = 0
            If i + 1 <= n Then lo = ExfUnit(nm, i + 1)
            If lo < &HDC00& Or lo > &HDFFF& Then Exit Function
            ok = (c <= &HDB7F&)
            i = i + 2
        ElseIf c >= &HDC00& And c <= &HDFFF& Then
            Exit Function
        Else
            ok = ExfIsNameStart(c)
            If Not ok And Not first Then ok = ExfIsNameMore(c)
            i = i + 1
        End If
        If Not ok Then Exit Function
        first = False
    Loop
    ExfIsXmlName = True
End Function

' = text.ts trimWith: String.prototype.trim, isSpace() listing the code units
' it removes (plan table SPACE).
Public Function ExfTrim(ByRef aValue As String, ByRef isSpace() As Boolean) As String
    Dim s As Long, e As Long
    s = 1
    e = Len(aValue)
    Do While s <= e
        If Not isSpace(ExfUnit(aValue, s)) Then Exit Do
        s = s + 1
    Loop
    Do While e >= s
        If Not isSpace(ExfUnit(aValue, e)) Then Exit Do
        e = e - 1
    Loop
    ExfTrim = Mid$(aValue, s, e - s + 1)
End Function

' = text.ts upperWith: toUpperCase restricted to the code units that can be
' part of a boolean token (plan table CASE); every other one is kept.
Public Function ExfUpperForTokens(ByRef aValue As String, ByRef hasUpper() As Boolean, ByRef upper() As String) As String
    Dim i As Long, n As Long, c As Long, parts() As String
    n = Len(aValue)
    If n = 0 Then Exit Function
    ReDim parts(0 To n - 1)
    For i = 1 To n
        c = ExfUnit(aValue, i)
        If hasUpper(c) Then
            parts(i - 1) = upper(c)
        Else
            parts(i - 1) = Mid$(aValue, i, 1)
        End If
    Next i
    ExfUpperForTokens = Join(parts, vbNullString)
End Function

' = text.ts encodeText (parser.ts encodeXmlText). Replacing "&" first, then the
' others, gives the same result as the website's character-by-character loop.
Public Function ExfEncodeText(ByRef s As String) As String
    If InStr(1, s, "&", vbBinaryCompare) = 0 And InStr(1, s, "<", vbBinaryCompare) = 0 And _
       InStr(1, s, ">", vbBinaryCompare) = 0 And InStr(1, s, vbCr, vbBinaryCompare) = 0 Then
        ExfEncodeText = s
        Exit Function
    End If
    ExfEncodeText = Replace(Replace(Replace(Replace(s, "&", "&amp;"), "<", "&lt;"), ">", "&gt;"), vbCr, "&#13;")
End Function

' = text.ts encodeAttr (parser.ts encodeXmlAttr).
Public Function ExfEncodeAttr(ByRef s As String) As String
    If InStr(1, s, "&", vbBinaryCompare) = 0 And InStr(1, s, "<", vbBinaryCompare) = 0 And _
       InStr(1, s, """", vbBinaryCompare) = 0 And InStr(1, s, vbTab, vbBinaryCompare) = 0 And _
       InStr(1, s, vbLf, vbBinaryCompare) = 0 And InStr(1, s, vbCr, vbBinaryCompare) = 0 Then
        ExfEncodeAttr = s
        Exit Function
    End If
    ExfEncodeAttr = Replace(Replace(Replace(Replace(Replace(Replace(s, "&", "&amp;"), "<", "&lt;"), _
        """", "&quot;"), vbTab, "&#9;"), vbLf, "&#10;"), vbCr, "&#13;")
End Function

' = text.ts wantsCdata (parser.ts shouldUseCdata): CDATA in the source, or at
' least two angle brackets.
Public Function ExfWantsCdata(ByRef s As String, ByVal wasCdata As Boolean) As Boolean
    Dim lt As Long, gt As Long
    If wasCdata Then
        ExfWantsCdata = True
        Exit Function
    End If
    lt = InStr(1, s, "<", vbBinaryCompare)
    gt = InStr(1, s, ">", vbBinaryCompare)
    If lt = 0 And gt = 0 Then Exit Function
    If lt > 0 And gt > 0 Then
        ExfWantsCdata = True
    ElseIf lt > 0 Then
        ExfWantsCdata = InStr(lt + 1, s, "<", vbBinaryCompare) > 0
    Else
        ExfWantsCdata = InStr(gt + 1, s, ">", vbBinaryCompare) > 0
    End If
End Function

' = text.ts cdataSection: a literal "]]>" is split across two sections, and a
' CR goes between two sections as &#13; (inside, XML readers would read a line
' break). "]]>" holds no CR, so replacing it first matches the website's loop.
Public Function ExfCdata(ByRef s As String) As String
    ExfCdata = "<![CDATA[" & Replace(Replace(s, "]]>", "]]]]><![CDATA[>"), vbCr, "]]>&#13;<![CDATA[") & "]]>"
End Function

' = text.ts lenKey: unambiguous key part "<length>:<value>".
Public Function ExfLenKey(ByRef aValue As String) As String
    ExfLenKey = Len(aValue) & ":" & aValue
End Function

' Order of two strings by UTF-16 code units, like JavaScript's < and >:
' -1, 0 or 1.
Public Function ExfCompareUnits(ByRef a As String, ByRef b As String) As Long
    Dim i As Long, n As Long, ca As Long, cb As Long
    n = Len(a)
    If Len(b) < n Then n = Len(b)
    For i = 1 To n
        ca = ExfUnit(a, i)
        cb = ExfUnit(b, i)
        If ca <> cb Then
            If ca < cb Then ExfCompareUnits = -1 Else ExfCompareUnits = 1
            Exit Function
        End If
    Next i
    If Len(a) < Len(b) Then
        ExfCompareUnits = -1
    ElseIf Len(a) > Len(b) Then
        ExfCompareUnits = 1
    End If
End Function

' = execute.ts attrSignature: same attributes <=> same signature, whatever
' their order (keys sorted by code units, like Array.prototype.sort).
Public Function ExfAttrSig(ByRef keys() As String, ByRef vals() As String, ByVal n As Long) As String
    Dim order() As Long, parts() As String, i As Long, j As Long
    If n = 0 Then Exit Function
    ReDim order(0 To n - 1)
    For i = 0 To n - 1
        j = i
        Do While j > 0
            If ExfCompareUnits(keys(order(j - 1)), keys(i)) <= 0 Then Exit Do
            order(j) = order(j - 1)
            j = j - 1
        Loop
        order(j) = i
    Next i
    ReDim parts(0 To 2 * n - 1)
    For i = 0 To n - 1
        parts(2 * i) = ExfLenKey(keys(order(i)))
        parts(2 * i + 1) = ExfLenKey(vals(order(i)))
    Next i
    ExfAttrSig = Join(parts, vbNullString)
End Function

' Excel column letters of a 1-based column number (28 -> AB).
Public Function ExfColumnLetters(ByVal n As Long) As String
    Dim s As String
    Do While n > 0
        s = Chr$(65 + (n - 1) Mod 26) & s
        n = (n - 1) \ 26
    Loop
    ExfColumnLetters = s
End Function