

#' @include class_definitions.R
#' @import stringi

Workbook$methods(
  initialize = function(creator = openxlsx_getOp("creator"),
                        title = NULL,
                        subject = NULL,
                        category = NULL) {
    charts <<- list()
    isChartSheet <<- logical(0)

    colWidths <<- list()
    colOutlineLevels <<- list()
    attr(colOutlineLevels, "hidden") <<- NULL
    connections <<- NULL
    Content_Types <<- genBaseContent_Type()
    core <<-
      genBaseCore(
        creator = creator,
        title = title,
        subject = subject,
        category = category
      )
    comments <<- list()
    threadComments <<- list()


    drawings <<- list()
    drawings_rels <<- list()

    embeddings <<- NULL
    externalLinks <<- NULL
    externalLinksRels <<- NULL

    headFoot <<- NULL

    media <<- list()

    persons <<- NULL

    pivotTables <<- NULL
    pivotTables.xml.rels <<- NULL
    pivotDefinitions <<- NULL
    pivotRecords <<- NULL
    pivotDefinitionsRels <<- NULL

    queryTables <<- NULL
    rowHeights <<- list()
    outlineLevels <<- list()
    attr(outlineLevels, "hidden") <<- NULL

    slicers <<- NULL
    slicerCaches <<- NULL

    sheet_names <<- character(0)
    sheetOrder <<- integer(0)

    sharedStrings <<- list()
    attr(sharedStrings, "uniqueCount") <<- 0

    styles <<- genBaseStyleSheet()
    styleObjects <<- list()


    tables <<- NULL
    tables.xml.rels <<- NULL
    theme <<- NULL


    vbaProject <<- NULL
    vml <<- list()
    vml_rels <<- list()

    workbook <<- genBaseWorkbook()
    workbook.xml.rels <<- genBaseWorkbook.xml.rels()

    worksheets <<- list()
    worksheets_rels <<- list()
    ActiveSheet <<- integer(0)
  }
)

Workbook$methods(
  addWorksheet = function(
    sheetName,
    showGridLines = openxlsx_getOp("showGridLines"),
    tabColour = openxlsx_getOp("tabColour"),
    zoom = 100,
    oddHeader = openxlsx_getOp("oddHeader"),
    oddFooter = openxlsx_getOp("oddFooter"),
    evenHeader = openxlsx_getOp("evenHeader"),
    evenFooter = openxlsx_getOp("evenFooter"),
    firstHeader = openxlsx_getOp("firstHeader"),
    firstFooter = openxlsx_getOp("firstFooter"),
    visible = TRUE,
    paperSize = openxlsx_getOp("paperSize", 9),
    orientation = openxlsx_getOp("orientation", "portrait"),
    hdpi = openxlsx_getOp("hdpi", 300),
    vdpi = openxlsx_getOp("vdpi", 300)
  ) {
    if (!missing(sheetName)) {
      if (grepl(pattern = ":", x = sheetName)) {
        stop("colon not allowed in sheet names in Excel")
      }
    }
    newSheetIndex <- length(worksheets) + 1L

    if (newSheetIndex > 1) {
      sheetId <-
        max(as.integer(regmatches(
          workbook$sheets,
          regexpr('(?<=sheetId=")[0-9]+', workbook$sheets, perl = TRUE)
        ))) + 1L
    } else {
      sheetId <- 1
      ActiveSheet <<- 1L
    }


    ## fix visible value
    visible <- tolower(visible)

    if (visible == "true") {
      visible <- "visible"
    } else if (visible == "false") {
      visible <- "hidden"
    } else if (visible == "veryhidden") {
      visible <- "veryHidden"
    }

    ##  Add sheet to workbook.xml
    workbook$sheets <<-
      c(
        workbook$sheets,
        sprintf(
          '<sheet name="%s" sheetId="%s" state="%s" r:id="rId%s"/>',
          sheetName,
          sheetId,
          visible,
          newSheetIndex
        )
      )

    ## append to worksheets list
    worksheets <<-
      append(
        worksheets,
        WorkSheet$new(
          showGridLines = showGridLines,
          tabSelected = newSheetIndex == 1,
          tabColour = tabColour,
          zoom = zoom,
          oddHeader = oddHeader,
          oddFooter = oddFooter,
          evenHeader = evenHeader,
          evenFooter = evenFooter,
          firstHeader = firstHeader,
          firstFooter = firstFooter,
          paperSize = paperSize,
          orientation = orientation,
          hdpi = hdpi,
          vdpi = vdpi
        )
      )


    ## update content_tyes
    ## add a drawing.xml for the worksheet
    Content_Types <<-
      c(
        Content_Types,
        sprintf(
          '<Override PartName="/xl/worksheets/sheet%s.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml"/>',
          newSheetIndex
        ),
        sprintf(
          '<Override PartName="/xl/drawings/drawing%s.xml" ContentType="application/vnd.openxmlformats-officedocument.drawing+xml"/>',
          newSheetIndex
        )
      )

    ## Update xl/rels
    workbook.xml.rels <<- c(
      workbook.xml.rels,
      sprintf(
        '<Relationship Id="rId0" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/worksheet" Target="worksheets/sheet%s.xml"/>',
        newSheetIndex
      )
    )


    ## create sheet.rels to simplify id assignment
    worksheets_rels[[newSheetIndex]] <<-
      genBaseSheetRels(newSheetIndex)
    drawings_rels[[newSheetIndex]] <<- list()
    drawings[[newSheetIndex]] <<- list()

    vml_rels[[newSheetIndex]] <<- list()
    vml[[newSheetIndex]] <<- list()

    isChartSheet[[newSheetIndex]] <<- FALSE
    comments[[newSheetIndex]] <<- list()
    threadComments[[newSheetIndex]] <<- list()

    rowHeights[[newSheetIndex]] <<- list()
    colWidths[[newSheetIndex]] <<- list()
    colOutlineLevels[[newSheetIndex]] <<- vector("character")
    outlineLevels[[newSheetIndex]] <<- vector("character")

    sheetOrder <<- c(sheetOrder, as.integer(newSheetIndex))
    sheet_names <<- c(sheet_names, sheetName)

    invisible(newSheetIndex)
  }
)

Workbook$methods(
  cloneWorksheet = function(sheetName, clonedSheet) {
    clonedSheet <- validateSheet(clonedSheet)
    if (!missing(sheetName)) {
      if (grepl(pattern = ":", x = sheetName)) {
        stop("colon not allowed in sheet names in Excel")
      }
    }
    newSheetIndex <- length(worksheets) + 1L
    if (newSheetIndex > 1) {
      sheetId <-
        max(as.integer(regmatches(
          workbook$sheets,
          regexpr('(?<=sheetId=")[0-9]+', workbook$sheets, perl = TRUE)
        ))) + 1L
    } else {
      sheetId <- 1
    }


    ## copy visibility from cloned sheet!
    visible <-
      regmatches(
        workbook$sheets[[clonedSheet]],
        regexpr('(?<=state=")[^"]+', workbook$sheets[[clonedSheet]], perl = TRUE)
      )

    ##  Add sheet to workbook.xml
    workbook$sheets <<-
      c(
        workbook$sheets,
        sprintf(
          '<sheet name="%s" sheetId="%s" state="%s" r:id="rId%s"/>',
          sheetName,
          sheetId,
          visible,
          newSheetIndex
        )
      )

    ## append to worksheets list
    worksheets <<-
      append(worksheets, worksheets[[clonedSheet]]$copy())


    ## update content_tyes
    ## add a drawing.xml for the worksheet
    Content_Types <<-
      c(
        Content_Types,
        sprintf(
          '<Override PartName="/xl/worksheets/sheet%s.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml"/>',
          newSheetIndex
        ),
        sprintf(
          '<Override PartName="/xl/drawings/drawing%s.xml" ContentType="application/vnd.openxmlformats-officedocument.drawing+xml"/>',
          newSheetIndex
        )
      )

    ## Update xl/rels
    workbook.xml.rels <<- c(
      workbook.xml.rels,
      sprintf(
        '<Relationship Id="rId0" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/worksheet" Target="worksheets/sheet%s.xml"/>',
        newSheetIndex
      )
    )

    ## create sheet.rels to simplify id assignment
    worksheets_rels[[newSheetIndex]] <<-
      genBaseSheetRels(newSheetIndex)
    drawings_rels[[newSheetIndex]] <<- drawings_rels[[clonedSheet]]

    # give each chart its own filename (images can re-use the same file, but charts can't)
    drawings_rels[[newSheetIndex]] <<-
      sapply(drawings_rels[[newSheetIndex]], function(rl) {
        chartfiles <-
          regmatches(
            rl,
            gregexpr("(?<=charts/)chart[0-9]+\\.xml", rl, perl = TRUE)
          )[[1]]
        for (cf in chartfiles) {
          chartid <- length(charts) + 1
          newname <- stri_join("chart", chartid, ".xml")
          fl <- charts[cf]

          # Read the chartfile and adjust all formulas to point to the new
          # sheet name instead of the clone source
          # The result is saved to a new chart xml file
          newfl <- file.path(dirname(fl), newname)
          charts[newname] <<- newfl
          chart <- readUTF8(fl)
          chart <-
            gsub(
              stri_join("(?<=')", sheet_names[[clonedSheet]], "(?='!)"),
              stri_join("'", sheetName, "'"),
              chart,
              perl = TRUE
            )
          chart <-
            gsub(
              stri_join("(?<=[^A-Za-z0-9])", sheet_names[[clonedSheet]], "(?=!)"),
              stri_join("'", sheetName, "'"),
              chart,
              perl = TRUE
            )
          writeLines(chart, newfl)
          # file.copy(fl, newfl)
          Content_Types <<-
            c(
              Content_Types,
              sprintf(
                '<Override PartName="/xl/charts/%s" ContentType="application/vnd.openxmlformats-officedocument.drawingml.chart+xml"/>',
                newname
              )
            )
          rl <- gsub(stri_join("(?<=charts/)", cf), newname, rl, perl = TRUE)
        }
        rl
      }, USE.NAMES = FALSE)
    # The IDs in the drawings array are sheet-specific, so within the new cloned sheet
    # the same IDs can be used => no need to modify drawings
    drawings[[newSheetIndex]] <<- drawings[[clonedSheet]]

    vml_rels[[newSheetIndex]] <<- vml_rels[[clonedSheet]]
    vml[[newSheetIndex]] <<- vml[[clonedSheet]]

    isChartSheet[[newSheetIndex]] <<- isChartSheet[[clonedSheet]]
    comments[[newSheetIndex]] <<- comments[[clonedSheet]]
    threadComments[[newSheetIndex]] <<- threadComments[[clonedSheet]]

    rowHeights[[newSheetIndex]] <<- rowHeights[[clonedSheet]]
    colWidths[[newSheetIndex]] <<- colWidths[[clonedSheet]]

    colOutlineLevels[[newSheetIndex]] <<- colOutlineLevels[[clonedSheet]]
    outlineLevels[[newSheetIndex]] <<- outlineLevels[[clonedSheet]]

    sheetOrder <<- c(sheetOrder, as.integer(newSheetIndex))
    sheet_names <<- c(sheet_names, sheetName)


    ############################
    ## STYLE
    ## ... objects are stored in a global list, so we need to get all styles
    ## assigned to the cloned sheet and duplicate them
    sheetStyles <- Filter(function(s) {
      s$sheet == sheet_names[[clonedSheet]]
    }, styleObjects)
    styleObjects <<- c(
      styleObjects,
      Map(function(s) {
        s$sheet <- sheetName
        s
      }, sheetStyles)
    )


    ############################
    ## TABLES
    ## ... are stored in the $tables list, with the name and sheet as attr
    ## and in the worksheets[]$tableParts list. We also need to adjust the
    ## worksheets_rels and set the content type for the new table

    tbls <- tables[attr(tables, "sheet") == clonedSheet]
    for (t in tbls) {
      # Extract table name, displayName and ID from the xml
      oldname <- regmatches(t, regexpr('(?<= name=")[^"]+', t, perl = TRUE))
      olddispname <- regmatches(t, regexpr('(?<= displayName=")[^"]+', t, perl = TRUE))
      oldid <- regmatches(t, regexpr('(?<= id=")[^"]+', t, perl = TRUE))
      ref <- regmatches(t, regexpr('(?<= ref=")[^"]+', t, perl = TRUE))

      # Find new, unused table names by appending _n, where n=1,2,...
      n <- 0
      while (stri_join(oldname, "_", n) %in% attr(tables, "tableName")) {
        n <- n + 1
      }
      newname <- stri_join(oldname, "_", n)
      newdispname <- stri_join(olddispname, "_", n)
      newid <- as.character(length(tables) + 3L)

      # Use the table definition from the cloned sheet and simply replace the names
      newt <- t
      newt <-
        gsub(
          stri_join(" name=\"", oldname, "\""),
          stri_join(" name=\"", newname, "\""),
          newt
        )
      newt <-
        gsub(
          stri_join(" displayName=\"", olddispname, "\""),
          stri_join(" displayName=\"", newdispname, "\""),
          newt
        )
      newt <-
        gsub(
          stri_join("(<table [^<]* id=\")", oldid, "\""),
          stri_join("\\1", newid, "\""),
          newt
        )

      oldtables <- tables
      tables <<- c(oldtables, newt)
      names(tables) <<- c(names(oldtables), ref)
      attr(tables, "sheet") <<-
        c(attr(oldtables, "sheet"), newSheetIndex)
      attr(tables, "tableName") <<-
        c(attr(oldtables, "tableName"), newname)

      oldparts <- worksheets[[newSheetIndex]]$tableParts
      worksheets[[newSheetIndex]]$tableParts <<-
        c(oldparts, sprintf('<tablePart r:id="rId%s"/>', newid))
      attr(worksheets[[newSheetIndex]]$tableParts, "tableName") <<-
        c(attr(oldparts, "tableName"), newname)
      names(attr(worksheets[[newSheetIndex]]$tableParts, "tableName")) <<-
        c(names(attr(oldparts, "tableName")), ref)

      Content_Types <<-
        c(
          Content_Types,
          sprintf(
            '<Override PartName="/xl/tables/table%s.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.table+xml"/>',
            newid
          )
        )
      tables.xml.rels <<- append(tables.xml.rels, "")

      worksheets_rels[[newSheetIndex]] <<-
        c(
          worksheets_rels[[newSheetIndex]],
          sprintf(
            '<Relationship Id="rId%s" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/table" Target="../tables/table%s.xml"/>',
            newid,
            newid
          )
        )
    }

    # TODO: The following items are currently NOT copied/duplicated for the cloned sheet:
    #   - Comments
    #   - Pivot tables

    invisible(newSheetIndex)
  }
)

Workbook$methods(
  addChartSheet = function(sheetName,
                           tabColour = NULL,
                           zoom = 100) {
    newSheetIndex <- length(worksheets) + 1L

    if (newSheetIndex > 1) {
      sheetId <-
        max(as.integer(regmatches(
          workbook$sheets,
          regexpr('(?<=sheetId=")[0-9]+', workbook$sheets, perl = TRUE)
        ))) + 1L
    } else {
      sheetId <- 1
    }

    ##  Add sheet to workbook.xml
    workbook$sheets <<-
      c(
        workbook$sheets,
        sprintf(
          '<sheet name="%s" sheetId="%s" r:id="rId%s"/>',
          sheetName,
          sheetId,
          newSheetIndex
        )
      )

    ## append to worksheets list
    worksheets <<-
      append(
        worksheets,
        ChartSheet$new(
          tabSelected = newSheetIndex == 1,
          tabColour = tabColour,
          zoom = zoom
        )
      )
    sheet_names <<- c(sheet_names, sheetName)

    ## update content_tyes
    Content_Types <<-
      c(
        Content_Types,
        sprintf(
          '<Override PartName="/xl/chartsheets/sheet%s.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.chartsheet+xml"/>',
          newSheetIndex
        )
      )

    ## Update xl/rels
    workbook.xml.rels <<- c(
      workbook.xml.rels,
      sprintf(
        '<Relationship Id="rId0" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/chartsheet" Target="chartsheets/sheet%s.xml"/>',
        newSheetIndex
      )
    )

    ## add a drawing.xml for the worksheet
    Content_Types <<-
      c(
        Content_Types,
        sprintf(
          '<Override PartName="/xl/drawings/drawing%s.xml" ContentType="application/vnd.openxmlformats-officedocument.drawing+xml"/>',
          newSheetIndex
        )
      )

    ## create sheet.rels to simplify id assignment
    worksheets_rels[[newSheetIndex]] <<-
      genBaseSheetRels(newSheetIndex)
    drawings_rels[[newSheetIndex]] <<- list()
    drawings[[newSheetIndex]] <<- list()

    isChartSheet[[newSheetIndex]] <<- TRUE

    rowHeights[[newSheetIndex]] <<- list()
    colWidths[[newSheetIndex]] <<- list()

    colOutlineLevels[[newSheetIndex]] <<- list()
    outlineLevels[[newSheetIndex]] <<- list()

    vml_rels[[newSheetIndex]] <<- list()
    vml[[newSheetIndex]] <<- list()

    sheetOrder <<- c(sheetOrder, newSheetIndex)

    invisible(newSheetIndex)
  }
)



Workbook$methods(
  saveWorkbook = function() {
    ## temp directory to save XML files prior to compressing
    tmpDir <- file.path(tempfile(pattern = "workbookTemp_"))

    if (dir.exists(tmpDir)) {
      unlink(tmpDir, recursive = TRUE, force = TRUE)
    }

    success <- dir.create(path = tmpDir, recursive = FALSE)
    if (!success) {
      stop(sprintf("Failed to create temporary directory '%s'", tmpDir))
    }

    .self$preSaveCleanUp()

    nSheets <- length(worksheets)
    nThemes <- length(theme)
    nPivots <- length(pivotDefinitions)
    nSlicers <- length(slicers)
    nComments <- sum(sapply(comments, length) > 0)
    nThreadComments <- sum(sapply(threadComments, length) > 0)
    nPersons <- length(persons)
    nVML <- sum(sapply(vml, length) > 0)

    relsDir <- file.path(tmpDir, "_rels")
    dir.create(path = relsDir, recursive = TRUE)

    docPropsDir <- file.path(tmpDir, "docProps")
    dir.create(path = docPropsDir, recursive = TRUE)

    xlDir <- file.path(tmpDir, "xl")
    dir.create(path = xlDir, recursive = TRUE)

    xlrelsDir <- file.path(tmpDir, "xl", "_rels")
    dir.create(path = xlrelsDir, recursive = TRUE)

    xlTablesDir <- file.path(tmpDir, "xl", "tables")
    dir.create(path = xlTablesDir, recursive = TRUE)

    xlTablesRelsDir <- file.path(xlTablesDir, "_rels")
    dir.create(path = xlTablesRelsDir, recursive = TRUE)

    if (length(media) > 0) {
      xlmediaDir <- file.path(tmpDir, "xl", "media")
      dir.create(path = xlmediaDir, recursive = TRUE)
    }


    ## will always have a theme
    xlthemeDir <- file.path(tmpDir, "xl", "theme")
    dir.create(path = xlthemeDir, recursive = TRUE)

    if (is.null(theme)) {
      con <- file(file.path(xlthemeDir, "theme1.xml"), open = "wb")
      writeBin(charToRaw(genBaseTheme()), con)
      close(con)
    } else {
      lapply(1:nThemes, function(i) {
        con <-
          file(file.path(xlthemeDir, stri_join("theme", i, ".xml")), open = "wb")
        writeBin(charToRaw(pxml(theme[[i]])), con)
        close(con)
      })
    }

    ## will always have drawings
    xlworksheetsDir <- file.path(tmpDir, "xl", "worksheets")
    dir.create(path = xlworksheetsDir, recursive = TRUE)

    xlworksheetsRelsDir <-
      file.path(tmpDir, "xl", "worksheets", "_rels")
    dir.create(path = xlworksheetsRelsDir, recursive = TRUE)

    xldrawingsDir <- file.path(tmpDir, "xl", "drawings")
    dir.create(path = xldrawingsDir, recursive = TRUE)

    xldrawingsRelsDir <- file.path(tmpDir, "xl", "drawings", "_rels")
    dir.create(path = xldrawingsRelsDir, recursive = TRUE)

    ## charts
    if (length(charts) > 0) {
      file.copy(
        from = dirname(charts[1]),
        to = file.path(tmpDir, "xl"),
        recursive = TRUE
      )
    }


    ## xl/comments.xml
    if (nComments > 0 | nVML > 0) {
      for (i in 1:nSheets) {
        if (length(comments[[i]]) > 0) {
          fn <- sprintf("comments%s.xml", i)

          Content_Types <<- c(
            Content_Types,
            sprintf(
              '<Override PartName="/xl/%s" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.comments+xml"/>',
              fn
            )
          )

          worksheets_rels[[i]] <<- unique(c(
            worksheets_rels[[i]],
            sprintf(
              '<Relationship Id="rIdcomment" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments" Target="../%s"/>',
              fn
            )
          ))

          writeCommentXML(
            comment_list = comments[[i]],
            file_name = file.path(tmpDir, "xl", fn)
          )
        }
      }

      .self$writeDrawingVML(xldrawingsDir)
    }

    ## Threaded Comments xl/threadedComments/threadedComment.xml
    if (nThreadComments > 0) {
      xlThreadComments <- file.path(tmpDir, "xl", "threadedComments")
      dir.create(path = xlThreadComments, recursive = TRUE)

      for (i in seq_len(nSheets)) {
        if (length(threadComments[[i]]) > 0) {
          fl <- threadComments[[i]]
          file.copy(
            from = fl,
            to = file.path(xlThreadComments, basename(fl)),
            overwrite = TRUE,
            copy.date = TRUE
          )

          worksheets_rels[[i]] <<- unique(c(
            worksheets_rels[[i]],
            sprintf(
              '<Relationship Id="rIdthread" Type="http://schemas.microsoft.com/office/2017/10/relationships/threadedComment" Target="../threadedComments/%s"/>',
              basename(fl)
            )
          ))
        }
      }
    }

    ## xl/persons/person.xml
    if (nPersons > 0) {
      personDir <- file.path(tmpDir, "xl", "persons")
      dir.create(path = personDir, recursive = TRUE)
      file.copy(
        from = persons,
        to = personDir,
        overwrite = TRUE
      )

    }


    if (length(embeddings) > 0) {
      embeddingsDir <- file.path(tmpDir, "xl", "embeddings")
      dir.create(path = embeddingsDir, recursive = TRUE)
      for (fl in embeddings) {
        file.copy(
          from = fl,
          to = embeddingsDir,
          overwrite = TRUE
        )
      }
    }


    if (nPivots > 0) {
      pivotTablesDir <- file.path(tmpDir, "xl", "pivotTables")
      dir.create(path = pivotTablesDir, recursive = TRUE)

      pivotTablesRelsDir <-
        file.path(tmpDir, "xl", "pivotTables", "_rels")
      dir.create(path = pivotTablesRelsDir, recursive = TRUE)

      pivotCacheDir <- file.path(tmpDir, "xl", "pivotCache")
      dir.create(path = pivotCacheDir, recursive = TRUE)

      pivotCacheRelsDir <-
        file.path(tmpDir, "xl", "pivotCache", "_rels")
      dir.create(path = pivotCacheRelsDir, recursive = TRUE)

      for (i in seq_along(pivotTables)) {
        file.copy(
          from = pivotTables[i],
          to = file.path(pivotTablesDir, sprintf("pivotTable%s.xml", i)),
          overwrite = TRUE,
          copy.date = TRUE
        )
      }

      for (i in seq_along(pivotDefinitions)) {
        file.copy(
          from = pivotDefinitions[i],
          to = file.path(pivotCacheDir, sprintf("pivotCacheDefinition%s.xml", i)),
          overwrite = TRUE,
          copy.date = TRUE
        )
      }

      for (i in seq_along(pivotRecords)) {
        file.copy(
          from = pivotRecords[i],
          to = file.path(pivotCacheDir, sprintf("pivotCacheRecords%s.xml", i)),
          overwrite = TRUE,
          copy.date = TRUE
        )
      }

      for (i in seq_along(pivotDefinitionsRels)) {
        file.copy(
          from = pivotDefinitionsRels[i],
          to = file.path(
            pivotCacheRelsDir,
            sprintf("pivotCacheDefinition%s.xml.rels", i)
          ),
          overwrite = TRUE,
          copy.date = TRUE
        )
      }

      for (i in seq_along(pivotTables.xml.rels)) {
        write_file(
          body = pivotTables.xml.rels[[i]],
          fl = file.path(pivotTablesRelsDir, sprintf("pivotTable%s.xml.rels", i))
        )
      }
    }

    ## slicers
    if (nSlicers > 0) {
      slicersDir <- file.path(tmpDir, "xl", "slicers")
      dir.create(path = slicersDir, recursive = TRUE)

      slicerCachesDir <- file.path(tmpDir, "xl", "slicerCaches")
      dir.create(path = slicerCachesDir, recursive = TRUE)

      for (i in seq_along(slicers)) {
        if (nchar(slicers[i]) > 0) {
          file.copy(from = slicers[i], to = file.path(slicersDir, sprintf("slicer%s.xml", i)))
        }
      }



      for (i in seq_along(slicerCaches)) {
        write_file(
          body = slicerCaches[[i]],
          fl = file.path(slicerCachesDir, sprintf("slicerCache%s.xml", i))
        )
      }
    }


    ## Write content

    ## write .rels
    write_file(
      head = '<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">\n',
      body = '<Relationship Id="rId3" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties" Target="docProps/app.xml"/><Relationship Id="rId2" Type="http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties" Target="docProps/core.xml"/><Relationship Id="rId1" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument" Target="xl/workbook.xml"/>',
      tail = "</Relationships>",
      fl = file.path(relsDir, ".rels")
    )

    app <- "<Application>Microsoft Excel</Application>"
    # further protect argument (might be extended with: <ScaleCrop>, <HeadingPairs>, <TitlesOfParts>, <LinksUpToDate>, <SharedDoc>, <HyperlinksChanged>, <AppVersion>)
    if (!is.null(workbook$apps)) app <- paste0(app, workbook$apps)

    ## write app.xml
    write_file(
      head = '<Properties xmlns="http://schemas.openxmlformats.org/officeDocument/2006/extended-properties" xmlns:vt="http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes">',
      body = app,
      tail = "</Properties>",
      fl = file.path(docPropsDir, "app.xml")
    )

    ## write core.xml
    write_file(
      head = "",
      body = pxml(core),
      tail = "",
      fl = file.path(docPropsDir, "core.xml")
    )

    ## write workbook.xml.rels
    write_file(
      head = '<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">',
      body = pxml(workbook.xml.rels),
      tail = "</Relationships>",
      fl = file.path(xlrelsDir, "workbook.xml.rels")
    )

    ## write tables
    if (length(unlist(tables, use.names = FALSE)) > 0) {
      for (i in seq_along(unlist(tables, use.names = FALSE))) {
        if (!grepl("openxlsx_deleted", attr(tables, "tableName")[i], fixed = TRUE)) {
          write_file(
            body = pxml(unlist(tables, use.names = FALSE)[[i]]),
            fl = file.path(xlTablesDir, sprintf("table%s.xml", i + 2))
          )
          if (tables.xml.rels[[i]] != "") {
            write_file(
              body = tables.xml.rels[[i]],
              fl = file.path(xlTablesRelsDir, sprintf("table%s.xml.rels", i + 2))
            )
          }
        }
      }
    }


    ## write query tables
    if (length(queryTables) > 0) {
      xlqueryTablesDir <- file.path(tmpDir, "xl", "queryTables")
      dir.create(path = xlqueryTablesDir, recursive = TRUE)

      for (i in seq_along(queryTables)) {
        write_file(
          body = queryTables[[i]],
          fl = file.path(xlqueryTablesDir, sprintf("queryTable%s.xml", i))
        )
      }
    }

    ## connections
    if (length(connections) > 0) {
      write_file(body = connections, fl = file.path(xlDir, "connections.xml"))
    }

    ## externalLinks
    if (length(externalLinks)) {
      externalLinksDir <- file.path(tmpDir, "xl", "externalLinks")
      dir.create(path = externalLinksDir, recursive = TRUE)

      for (i in seq_along(externalLinks)) {
        write_file(
          body = externalLinks[[i]],
          fl = file.path(externalLinksDir, sprintf("externalLink%s.xml", i))
        )
      }
    }

    ## externalLinks rels
    if (length(externalLinksRels)) {
      externalLinksRelsDir <-
        file.path(tmpDir, "xl", "externalLinks", "_rels")
      dir.create(path = externalLinksRelsDir, recursive = TRUE)

      for (i in seq_along(externalLinksRels)) {
        write_file(
          body = externalLinksRels[[i]],
          fl = file.path(
            externalLinksRelsDir,
            sprintf("externalLink%s.xml.rels", i)
          )
        )
      }
    }

    # printerSettings
    printDir <- file.path(tmpDir, "xl", "printerSettings")
    dir.create(path = printDir, recursive = TRUE)
    for (i in 1:nSheets) {
      writeLines(genPrinterSettings(), file.path(printDir, sprintf("printerSettings%s.bin", i)))
    }

    ## media (copy file from origin to destination)
    for (x in media) {
      file.copy(x, file.path(xlmediaDir, names(media)[which(media == x)]))
    }

    ## VBA Macro
    if (!is.null(vbaProject)) {
      file.copy(vbaProject, xlDir)
    }

    ## write worksheet, worksheet_rels, drawings, drawing_rels
    .self$writeSheetDataXML(
      xldrawingsDir,
      xldrawingsRelsDir,
      xlworksheetsDir,
      xlworksheetsRelsDir
    )

    ## write sharedStrings.xml
    ct <- Content_Types
    if (length(sharedStrings) > 0) {
      write_file(
        head = sprintf(
          '<sst xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" count="%s" uniqueCount="%s">',
          length(sharedStrings),
          attr(sharedStrings, "uniqueCount")
        ),
        body = stri_join(sharedStrings, collapse = "", sep = " "),
        tail = "</sst>",
        fl = file.path(xlDir, "sharedStrings.xml")
      )
    } else {
      ## Remove relationship to sharedStrings
      ct <- ct[!grepl("sharedStrings", ct)]
    }

    if (nComments > 0) {
      ct <-
        c(
          ct,
          '<Default Extension="vml" ContentType="application/vnd.openxmlformats-officedocument.vmlDrawing"/>'
        )
    }

    ## write [Content_type]
    write_file(
      head = '<Types xmlns="http://schemas.openxmlformats.org/package/2006/content-types">',
      body = pxml(ct),
      tail = "</Types>",
      fl = file.path(tmpDir, "[Content_Types].xml")
    )


    styleXML <- styles
    styleXML$numFmts <-
      stri_join(
        sprintf('<numFmts count="%s">', length(styles$numFmts)),
        pxml(styles$numFmts),
        "</numFmts>"
      )
    styleXML$fonts <-
      stri_join(
        sprintf('<fonts count="%s">', length(styles$fonts)),
        pxml(styles$fonts),
        "</fonts>"
      )
    styleXML$fills <-
      stri_join(
        sprintf('<fills count="%s">', length(styles$fills)),
        pxml(styles$fills),
        "</fills>"
      )
    styleXML$borders <-
      stri_join(
        sprintf('<borders count="%s">', length(styles$borders)),
        pxml(styles$borders),
        "</borders>"
      )
    styleXML$cellStyleXfs <-
      c(
        sprintf('<cellStyleXfs count="%s">', length(styles$cellStyleXfs)),
        pxml(styles$cellStyleXfs),
        "</cellStyleXfs>"
      )
    styleXML$cellXfs <-
      stri_join(
        sprintf('<cellXfs count="%s">', length(styles$cellXfs)),
        pxml(styles$cellXfs),
        "</cellXfs>"
      )
    styleXML$cellStyles <-
      stri_join(
        sprintf('<cellStyles count="%s">', length(styles$cellStyles)),
        pxml(styles$cellStyles),
        "</cellStyles>"
      )
    styleXML$dxfs <-
      ifelse(
        length(styles$dxfs) == 0,
        '<dxfs count="0"/>',
        stri_join(
          sprintf('<dxfs count="%s">', length(styles$dxfs)),
          stri_join(unlist(styles$dxfs), sep = " ", collapse = ""),
          "</dxfs>"
        )
      )
    ## write styles.xml
    write_file(
      head = '<styleSheet xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="x14ac x16r2 xr" xmlns:x14ac="http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac" xmlns:x16r2="http://schemas.microsoft.com/office/spreadsheetml/2015/02/main" xmlns:xr="http://schemas.microsoft.com/office/spreadsheetml/2014/revision">',
      body = pxml(styleXML),
      tail = "</styleSheet>",
      fl = file.path(xlDir, "styles.xml")
    )

    ## write workbook.xml
    workbookXML <- workbook
    workbookXML$sheets <-
      stri_join("<sheets>", pxml(workbookXML$sheets), "</sheets>")
    if (length(workbookXML$definedNames) > 0) {
      workbookXML$definedNames <-
        stri_join(
          "<definedNames>",
          pxml(workbookXML$definedNames),
          "</definedNames>"
        )
    }

    write_file(
      head = '<workbook xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships" xmlns:mc="http://schemas.openxmlformats.org/markup-compatibility/2006" mc:Ignorable="x15 xr xr6 xr10 xr2" xmlns:x15="http://schemas.microsoft.com/office/spreadsheetml/2010/11/main" xmlns:xr="http://schemas.microsoft.com/office/spreadsheetml/2014/revision" xmlns:xr6="http://schemas.microsoft.com/office/spreadsheetml/2016/revision6" xmlns:xr10="http://schemas.microsoft.com/office/spreadsheetml/2016/revision10" xmlns:xr2="http://schemas.microsoft.com/office/spreadsheetml/2015/revision2">',
      body = pxml(workbookXML),
      tail = "</workbook>",
      fl = file.path(xlDir, "workbook.xml")
    )
    workbook$sheets <<-
      workbook$sheets[order(sheetOrder)] ## Need to reset sheet order to allow multiple savings

    ## compress to xlsx
    wd <- getwd()
    tmpFile <-
      basename(tempfile(fileext = ifelse(is.null(vbaProject), ".xlsx", ".xlsm")))
    on.exit(expr = setwd(wd), add = TRUE)

    ## zip it
    setwd(dir = tmpDir)
    cl <-
      ifelse(
        !is.null(getOption("openxlsx.compresssionLevel")),
        getOption("openxlsx.compresssionLevel"),
        getOption("openxlsx.compresssionevel", 6)
      )
    zipr(
      zipfile = tmpFile, include_directories = FALSE,
      files = list.files(path = tmpDir, all.files = FALSE),
      recurse = TRUE,
      compression_level = cl
    )

    ## reset styles - maintain any changes to base font
    baseFont <- styles$fonts[[1]]
    styles <<-
      genBaseStyleSheet(styles$dxfs,
        tableStyles = styles$tableStyles,
        extLst = styles$extLst
      )
    styles$fonts[[1]] <<- baseFont


    return(file.path(tmpDir, tmpFile))
  }
)



Workbook$methods(
  updateSharedStrings = function(uNewStr) {
    ## Function will return named list of references to new strings
    uStr <- uNewStr[which(!uNewStr %in% sharedStrings)]
    uCount <- attr(sharedStrings, "uniqueCount")
    sharedStrings <<- append(sharedStrings, uStr)

    attr(sharedStrings, "uniqueCount") <<- uCount + length(uStr)
  }
)

Workbook$methods(
  validateSheet = function(sheetName) {
    if (!is.numeric(sheetName)) {
      if (is.null(sheet_names)) {
        stop("Workbook does not contain any worksheets.", call. = FALSE)
      }
    }

    if (is.numeric(sheetName)) {
      if (sheetName > length(sheet_names)) {
        stop("This Workbook only has ", length(sheet_names),
          " sheets, ", sheetName, " is not valid",
          call. = FALSE
        )
      }
      return(sheetName)
    } else if (!sheetName %in% replaceXMLEntities(sheet_names)) {
      stop(sprintf("Sheet '%s' does not exist.", replaceXMLEntities(sheetName)),
        call. = FALSE)
    }

    which(replaceXMLEntities(sheet_names) == sheetName)
  }
)


Workbook$methods(
  getSheetName = function(sheetIndex) {
    if (any(length(sheet_names) < sheetIndex)) {
      stop(sprintf("Workbook only contains %s sheet(s).", length(sheet_names)))
    }

    sheet_names[sheetIndex]
  }
)

Workbook$methods(
  buildTable = function(sheet,
                        colNames,
                        ref,
                        showColNames,
                        tableStyle,
                        tableName,
                        withFilter,
                        totalsRowCount = 0,
                        showFirstColumn = 0,
                        showLastColumn = 0,
                        showRowStripes = 1,
                        showColumnStripes = 0) {
    ## id will start at 3 and drawing will always be 1, printer Settings at 2 (printer settings has been removed)
    id <- as.character(length(tables) + 3L)
    sheet <- validateSheet(sheet)

    ## build table XML and save to tables field
    table <-
      sprintf(
        '<table xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" id="%s" name="%s" displayName="%s" ref="%s" totalsRowCount="%s"',
        id,
        tableName,
        tableName,
        ref,
        as.integer(totalsRowCount)
      )
    # because tableName might be native encoded non-ASCII strings, we need to ensure
    # it's UTF-8 encoded
    table <- enc2utf8(table)

    nms <- names(tables)
    tSheets <- attr(tables, "sheet")
    tNames <- attr(tables, "tableName")

    tableStyleXML <-
      sprintf(
        '<tableStyleInfo name="%s" showFirstColumn="%s" showLastColumn="%s" showRowStripes="%s" showColumnStripes="%s"/>',
        tableStyle,
        as.integer(showFirstColumn),
        as.integer(showLastColumn),
        as.integer(showRowStripes),
        as.integer(showColumnStripes)
      )


    tables <<-
      c(
        tables,
        build_table_xml(
          table = table,
          tableStyleXML = tableStyleXML,
          ref = ref,
          colNames = gsub("\n|\r", "_x000a_", colNames),
          showColNames = showColNames,
          withFilter = withFilter
        )
      )
    names(tables) <<- c(nms, ref)
    attr(tables, "sheet") <<- c(tSheets, sheet)
    attr(tables, "tableName") <<- c(tNames, tableName)

    worksheets[[sheet]]$tableParts <<-
      append(
        worksheets[[sheet]]$tableParts,
        sprintf('<tablePart r:id="rId%s"/>', id)
      )
    attr(worksheets[[sheet]]$tableParts, "tableName") <<-
      c(tNames[tSheets == sheet &
        !grepl("openxlsx_deleted", tNames, fixed = TRUE)], tableName)



    ## update Content_Types
    Content_Types <<-
      c(
        Content_Types,
        sprintf(
          '<Override PartName="/xl/tables/table%s.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.table+xml"/>',
          id
        )
      )

    ## create a table.xml.rels
    tables.xml.rels <<- append(tables.xml.rels, "")

    ## update worksheets_rels
    worksheets_rels[[sheet]] <<- c(
      worksheets_rels[[sheet]],
      sprintf(
        '<Relationship Id="rId%s" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/table" Target="../tables/table%s.xml"/>',
        id,
        id
      )
    )
  }
)









Workbook$methods(
  writeDrawingVML = function(dir) {
    for (i in seq_along(comments)) {
      id <- 1025

      cd <- unlist(lapply(comments[[i]], "[[", "clientData"))
      nComments <- length(cd)

      ## write head
      if (nComments > 0 | length(vml[[i]]) > 0) {
        write(
          x = stri_join(
            '<xml xmlns:v="urn:schemas-microsoft-com:vml"
                    xmlns:o="urn:schemas-microsoft-com:office:office"
                    xmlns:x="urn:schemas-microsoft-com:office:excel">
                    <o:shapelayout v:ext="edit">
                    <o:idmap v:ext="edit" data="1"/>
                    </o:shapelayout>
                    <v:shapetype id="_x0000_t202" coordsize="21600,21600" o:spt="202"
                    path="m,l,21600r21600,l21600,xe">
                    <v:stroke joinstyle="miter"/>
                    <v:path gradientshapeok="t" o:connecttype="rect"/>
                    </v:shapetype>'
          ),
          file = file.path(dir, sprintf("vmlDrawing%s.vml", i)),
          sep = " "
        )
      }

      if (nComments > 0) {
        for (j in 1:nComments) {
          id <- id + 1L
          write(
            x = genBaseShapeVML(cd[j], id),
            file = file.path(dir, sprintf("vmlDrawing%s.vml", i)),
            append = TRUE
          )
        }
      }

      if (length(vml[[i]]) > 0) {
        write(
          x = vml[[i]],
          file = file.path(dir, sprintf("vmlDrawing%s.vml", i)),
          append = TRUE
        )
      }

      if (nComments > 0 | length(vml[[i]]) > 0) {
        write(
          x = "</xml>",
          file = file.path(dir, sprintf("vmlDrawing%s.vml", i)),
          append = TRUE
        )
        worksheets[[i]]$legacyDrawing <<-
          '<legacyDrawing r:id="rIdvml"/>'
      }
    }
  }
)



Workbook$methods(
  updateStyles = function(style) {
    ## Updates styles.xml
    xfNode <- list(
      numFmtId = 0,
      fontId = 0,
      fillId = 0,
      borderId = 0,
      xfId = 0
    )


    alignmentFlag <- FALSE

    ## Font
    if (!is.null(style$fontName) |
      !is.null(style$fontSize) |
      !is.null(style$fontColour) |
      !is.null(style$fontDecoration) |
      !is.null(style$fontFamily) |
      !is.null(style$fontScheme)) {
      fontNode <- .self$createFontNode(style)
      fontId <- which(styles$fonts == fontNode) - 1L

      if (length(fontId) == 0) {
        fontId <- length(styles$fonts)
        styles$fonts <<- append(styles[["fonts"]], fontNode)
      }

      xfNode$fontId <- fontId
      xfNode <- append(xfNode, list("applyFont" = "1"))
    }


    ## numFmt
    if (!is.null(style$numFmt)) {
      if (as.integer(style$numFmt$numFmtId) > 0) {
        numFmtId <- style$numFmt$numFmtId
        if (as.integer(numFmtId) > 163L) {
          tmp <- style$numFmt$formatCode

          styles$numFmts <<- unique(c(
            styles$numFmts,
            sprintf(
              '<numFmt numFmtId="%s" formatCode="%s"/>',
              numFmtId,
              tmp
            )
          ))
        }

        xfNode$numFmtId <- numFmtId
        xfNode <- append(xfNode, list("applyNumberFormat" = "1"))
      }
    }

    ## Fill
    if (!is.null(style$fill)) {
      fillNode <- .self$createFillNode(style)
      if (!is.null(fillNode)) {
        fillId <- which(styles$fills == fillNode) - 1L

        if (length(fillId) == 0) {
          fillId <- length(styles$fills)
          styles$fills <<- c(styles$fills, fillNode)
        }
        xfNode$fillId <- fillId
        xfNode <- append(xfNode, list("applyFill" = "1"))
      }
    }

    ## Border
    if (any(!is.null(
      c(
        style$borderLeft,
        style$borderRight,
        style$borderTop,
        style$borderBottom,
        style$borderDiagonal
      )
    ))) {
      borderNode <- .self$createBorderNode(style)
      borderId <- which(styles$borders == borderNode) - 1L

      if (length(borderId) == 0) {
        borderId <- length(styles$borders)
        styles$borders <<- c(styles$borders, borderNode)
      }

      xfNode$borderId <- borderId
      xfNode <- append(xfNode, list("applyBorder" = "1"))
    }


    # if(!is.null(style$xfId))
    # xfNode$xfId <- style$xfId

    childNodes <- ""

    ## Alignment
    if (!is.null(style$halign) |
      !is.null(style$valign) |
      !is.null(style$wrapText) |
      !is.null(style$textRotation) | !is.null(style$indent)) {
      attrs <- list()
      alignNode <- "<alignment"

      if (!is.null(style$textRotation)) {
        alignNode <-
          stri_join(alignNode,
            sprintf('textRotation="%s"', style$textRotation),
            sep = " "
          )
      }

      if (!is.null(style$halign)) {
        alignNode <-
          stri_join(alignNode, sprintf('horizontal="%s"', style$halign), sep = " ")
      }

      if (!is.null(style$valign)) {
        alignNode <-
          stri_join(alignNode, sprintf('vertical="%s"', style$valign), sep = " ")
      }

      if (!is.null(style$indent)) {
        alignNode <-
          stri_join(alignNode, sprintf('indent="%s"', style$indent), sep = " ")
      }

      if (!is.null(style$wrapText)) {
        if (style$wrapText) {
          alignNode <- stri_join(alignNode, 'wrapText="1"', sep = " ")
        }
      }


      alignNode <- stri_join(alignNode, "/>")

      alignmentFlag <- TRUE
      xfNode <- append(xfNode, list("applyAlignment" = "1"))

      childNodes <- stri_join(childNodes, alignNode)
    }

    if (!is.null(style$hidden) | !is.null(style$locked)) {
      xfNode <- append(xfNode, list("applyProtection" = "1"))
      protectionNode <- "<protection"

      if (!is.null(style$hidden)) {
        protectionNode <-
          stri_join(protectionNode, sprintf('hidden="%s"', as.numeric(style$hidden)), sep = " ")
      }
      if (!is.null(style$locked)) {
        protectionNode <-
          stri_join(protectionNode, sprintf('locked="%s"', as.numeric(style$locked)), sep = " ")
      }

      protectionNode <- stri_join(protectionNode, "/>")
      childNodes <- stri_join(childNodes, protectionNode)
    }

    if (length(childNodes) > 0) {
      xfNode <-
        stri_join(
          "<xf ",
          stri_join(
            stri_join(names(xfNode), '="', xfNode, '"'),
            sep = " ",
            collapse = " "
          ),
          ">",
          childNodes,
          "</xf>"
        )
    } else {
      xfNode <-
        stri_join("<xf ", stri_join(
          stri_join(names(xfNode), '="', xfNode, '"'),
          sep = " ",
          collapse = " "
        ), "/>")
    }

    styleId <- which(styles$cellXfs == xfNode) - 1L
    if (length(styleId) == 0) {
      styleId <- length(styles$cellXfs)
      styles$cellXfs <<- c(styles$cellXfs, xfNode)
    }


    return(as.integer(styleId))
  }
)





Workbook$methods(
  updateCellStyles = function() {
    flag <- TRUE
    for (style in cellStyleObjects) {
      ## Updates styles.xml
      xfNode <- list(
        numFmtId = 0,
        fontId = 0,
        fillId = 0,
        borderId = 0
      )


      alignmentFlag <- FALSE

      ## Font
      if (!is.null(style$fontName) |
        !is.null(style$fontSize) |
        !is.null(style$fontColour) |
        !is.null(style$fontDecoration) |
        !is.null(style$fontFamily) |
        !is.null(style$fontScheme)) {
        fontNode <- .self$createFontNode(style)
        fontId <- which(styles$font == fontNode) - 1L

        if (length(fontId) == 0) {
          fontId <- length(styles$fonts)
          styles$fonts <<- append(styles[["fonts"]], fontNode)
        }

        xfNode$fontId <- fontId
        xfNode <- append(xfNode, list("applyFont" = "1"))
      }


      ## numFmt
      if (!is.null(style$numFmt)) {
        if (as.integer(style$numFmt$numFmtId) > 0) {
          numFmtId <- style$numFmt$numFmtId
          if (as.integer(numFmtId) > 163L) {
            tmp <- style$numFmt$formatCode

            styles$numFmts <<- unique(c(
              styles$numFmts,
              sprintf(
                '<numFmt numFmtId="%s" formatCode="%s"/>',
                numFmtId,
                tmp
              )
            ))
          }

          xfNode$numFmtId <- numFmtId
          xfNode <- append(xfNode, list("applyNumberFormat" = "1"))
        }
      }

      ## Fill
      if (!is.null(style$fill)) {
        fillNode <- .self$createFillNode(style)
        if (!is.null(fillNode)) {
          fillId <- which(styles$fills == fillNode) - 1L

          if (length(fillId) == 0) {
            fillId <- length(styles$fills)
            styles$fills <<- c(styles$fills, fillNode)
          }
          xfNode$fillId <- fillId
          xfNode <- append(xfNode, list("applyFill" = "1"))
        }
      }

      ## Border
      if (any(!is.null(
        c(
          style$borderLeft,
          style$borderRight,
          style$borderTop,
          style$borderBottom,
          style$borderDiagonal
        )
      ))) {
        borderNode <- .self$createBorderNode(style)
        borderId <- which(styles$borders == borderNode) - 1L

        if (length(borderId) == 0) {
          borderId <- length(styles$borders)
          styles$borders <<- c(styles$borders, borderNode)
        }

        xfNode$borderId <- borderId
        xfNode <- append(xfNode, list("applyBorder" = "1"))
      }

      xfNode <-
        stri_join("<xf ", stri_join(
          stri_join(names(xfNode), '="', xfNode, '"'),
          sep = " ",
          collapse = " "
        ), "/>")

      if (flag) {
        styles$cellStyleXfs <<- xfNode
        flag <- FALSE
      } else {
        styles$cellStyleXfs <<- c(styles$cellStyleXfs, xfNode)
      }
    }
  }
)








Workbook$methods(
  getBaseFont = function() {
    baseFont <- styles$fonts[[1]]

    sz <- getAttrs(baseFont, "sz")
    colour <- getAttrs(baseFont, "color")
    name <- getAttrs(baseFont, "name")

    if (length(sz[[1]]) == 0) {
      sz <- list("val" = "10")
    }

    if (length(colour[[1]]) == 0) {
      colour <- list("rgb" = "#000000")
    }

    if (length(name[[1]]) == 0) {
      name <- list("val" = "Calibri")
    }

    list(
      "size" = sz,
      "colour" = colour,
      "name" = name
    )
  }
)




Workbook$methods(
  createFontNode = function(style) {
    baseFont <- .self$getBaseFont()

    fontNode <- "<font>"

    ## size
    if (is.null(style$fontSize[[1]])) {
      fontNode <-
        stri_join(fontNode, sprintf('<sz %s="%s"/>', names(baseFont$size), baseFont$size))
    } else {
      fontNode <-
        stri_join(fontNode, sprintf('<sz %s="%s"/>', names(style$fontSize), style$fontSize))
    }

    ## colour
    if (is.null(style$fontColour[[1]])) {
      fontNode <-
        stri_join(
          fontNode,
          sprintf(
            '<color %s="%s"/>',
            names(baseFont$colour),
            baseFont$colour
          )
        )
    } else {
      if (length(style$fontColour) > 1) {
        fontNode <- stri_join(fontNode, sprintf(
          "<color %s/>",
          stri_join(
            sapply(seq_along(style$fontColour), function(i) {
              sprintf('%s="%s"', names(style$fontColour)[i], style$fontColour[i])
            }),
            sep = " ",
            collapse = " "
          )
        ))
      } else {
        fontNode <-
          stri_join(
            fontNode,
            sprintf(
              '<color %s="%s"/>',
              names(style$fontColour),
              style$fontColour
            )
          )
      }
    }


    ## name
    if (is.null(style$fontName[[1]])) {
      fontNode <-
        stri_join(
          fontNode,
          sprintf('<name %s="%s"/>', names(baseFont$name), baseFont$name)
        )
    } else {
      fontNode <-
        stri_join(
          fontNode,
          sprintf('<name %s="%s"/>', names(style$fontName), style$fontName)
        )
    }

    ### Create new font and return Id
    if (!is.null(style$fontFamily)) {
      fontNode <-
        stri_join(fontNode, sprintf('<family val = "%s"/>', style$fontFamily))
    }

    if (!is.null(style$fontScheme)) {
      fontNode <-
        stri_join(fontNode, sprintf('<scheme val = "%s"/>', style$fontScheme))
    }

    if ("BOLD" %in% style$fontDecoration) {
      fontNode <- stri_join(fontNode, "<b/>")
    }

    if ("ITALIC" %in% style$fontDecoration) {
      fontNode <- stri_join(fontNode, "<i/>")
    }

    if ("UNDERLINE" %in% style$fontDecoration) {
      fontNode <- stri_join(fontNode, '<u val="single"/>')
    }

    if ("UNDERLINE2" %in% style$fontDecoration) {
      fontNode <- stri_join(fontNode, '<u val="double"/>')
    }

    if ("ACCOUNTING" %in% style$fontDecoration) {
      fontNode <- stri_join(fontNode, '<u val="singleAccounting"/>')
    }

    if ("ACCOUNTING2" %in% style$fontDecoration) {
      fontNode <- stri_join(fontNode, '<u val="doubleAccounting"/>')
    }

    if ("STRIKEOUT" %in% style$fontDecoration) {
      fontNode <- stri_join(fontNode, "<strike/>")
    }

    stri_join(fontNode, "</font>")
  }
)


Workbook$methods(
  createBorderNode = function(style) {
    borderNode <- "<border"

    if (style$borderDiagonalUp) {
      borderNode <- stri_join(borderNode, 'diagonalUp="1"', sep = " ")
    }

    if (style$borderDiagonalDown) {
      borderNode <-
        stri_join(borderNode, 'diagonalDown="1"', sep = " ")
    }

    borderNode <- stri_join(borderNode, ">")

    if (!is.null(style$borderLeft)) {
      borderNode <-
        stri_join(
          borderNode,
          sprintf('<left style="%s">', style$borderLeft),
          sprintf(
            '<color %s="%s"/>',
            names(style$borderLeftColour),
            style$borderLeftColour
          ),
          "</left>"
        )
    }

    if (!is.null(style$borderRight)) {
      borderNode <-
        stri_join(
          borderNode,
          sprintf('<right style="%s">', style$borderRight),
          sprintf(
            '<color %s="%s"/>',
            names(style$borderRightColour),
            style$borderRightColour
          ),
          "</right>"
        )
    }

    if (!is.null(style$borderTop)) {
      borderNode <-
        stri_join(
          borderNode,
          sprintf('<top style="%s">', style$borderTop),
          sprintf(
            '<color %s="%s"/>',
            names(style$borderTopColour),
            style$borderTopColour
          ),
          "</top>"
        )
    }

    if (!is.null(style$borderBottom)) {
      borderNode <-
        stri_join(
          borderNode,
          sprintf('<bottom style="%s">', style$borderBottom),
          sprintf(
            '<color %s="%s"/>',
            names(style$borderBottomColour),
            style$borderBottomColour
          ),
          "</bottom>"
        )
    }

    if (!is.null(style$borderDiagonal)) {
      borderNode <-
        stri_join(
          borderNode,
          sprintf('<diagonal style="%s">', style$borderDiagonal),
          sprintf(
            '<color %s="%s"/>',
            names(style$borderDiagonalColour),
            style$borderDiagonalColour
          ),
          "</diagonal>"
        )
    }

    stri_join(borderNode, "</border>")
  }
)


Workbook$methods(
  createFillNode = function(style, patternType = "solid") {
    fill <- style$fill

    ## gradientFill
    if (any(grepl("gradientFill", fill))) {
      fillNode <- fill # stri_join("<fill>", fill, "</fill>")
    } else if (!is.null(fill$fillFg) | !is.null(fill$fillBg)) {
      fillNode <-
        stri_join(
          "<fill>",
          sprintf('<patternFill patternType="%s">', patternType)
        )

      if (!is.null(fill$fillFg)) {
        fillNode <-
          stri_join(fillNode, sprintf(
            "<fgColor %s/>",
            stri_join(
              stri_join(names(fill$fillFg), '="', fill$fillFg, '"'),
              sep = " ",
              collapse = " "
            )
          ))
      }

      if (!is.null(fill$fillBg)) {
        fillNode <-
          stri_join(fillNode, sprintf(
            "<bgColor %s/>",
            stri_join(
              stri_join(names(fill$fillBg), '="', fill$fillBg, '"'),
              sep = " ",
              collapse = " "
            )
          ))
      }

      fillNode <- stri_join(fillNode, "</patternFill></fill>")
    } else {
      return(NULL)
    }

    return(fillNode)
  }
)







Workbook$methods(
  setSheetName = function(sheet, newSheetName) {
    if (newSheetName %in% sheet_names) {
      stop(sprintf("Sheet %s already exists!", newSheetName))
    }

    sheet <- validateSheet(sheet)

    oldName <- sheet_names[[sheet]]
    sheet_names[[sheet]] <<- newSheetName

    ## Rename in workbook
    sheetId <-
      regmatches(
        workbook$sheets[[sheet]],
        regexpr('(?<=sheetId=")[0-9]+', workbook$sheets[[sheet]], perl = TRUE)
      )
    rId <-
      regmatches(
        workbook$sheets[[sheet]],
        regexpr('(?<= r:id="rId)[0-9]+', workbook$sheets[[sheet]], perl = TRUE)
      )
    workbook$sheets[[sheet]] <<-
      sprintf(
        '<sheet name="%s" sheetId="%s" r:id="rId%s"/>',
        newSheetName,
        sheetId,
        rId
      )

    ## rename styleObjects sheet component
    if (length(styleObjects) > 0) {
      styleObjects <<- lapply(styleObjects, function(x) {
        if (x$sheet == oldName) {
          x$sheet <- newSheetName
        }

        return(x)
      })
    }

    ## rename defined names
    if (length(workbook$definedNames) > 0) {
      belongTo <- getDefinedNamesSheet(workbook$definedNames)
      toChange <- belongTo == oldName
      if (any(toChange)) {
        newSheetName <- sprintf("'%s'", newSheetName)
        tmp <-
          gsub(oldName, newSheetName, workbook$definedName[toChange], fixed = TRUE)
        tmp <- gsub("'+", "'", tmp)
        workbook$definedNames[toChange] <<- tmp
      }
    }
  }
)


Workbook$methods(
  writeSheetDataXML = function(xldrawingsDir,
                               xldrawingsRelsDir,
                               xlworksheetsDir,
                               xlworksheetsRelsDir) {
    ## write worksheets
    # nSheets <- length(worksheets)

    for (i in seq_along(worksheets)) {
      ## Write drawing i (will always exist) skip those that are empty
      if (any(drawings[[i]] != "")) {
        write_file(
          head = '<xdr:wsDr xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing" xmlns:a="http://schemas.openxmlformats.org/drawingml/2006/main" xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships">',
          body = pxml(drawings[[i]]),
          tail = "</xdr:wsDr>",
          fl = file.path(xldrawingsDir, stri_join("drawing", i, ".xml"))
        )

        write_file(
          head = '<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">',
          body = pxml(drawings_rels[[i]]),
          tail = "</Relationships>",
          fl = file.path(xldrawingsRelsDir, stri_join("drawing", i, ".xml.rels"))
        )
      } else {
        worksheets[[i]]$drawing <<- character(0)
      }

      ## vml drawing
      if (length(vml_rels[[i]]) > 0) {
        file.copy(
          from = vml_rels[[i]],
          to = file.path(
            xldrawingsRelsDir,
            stri_join("vmlDrawing", i, ".vml.rels")
          )
        )
      }

      # outlineLevelRow in SheetformatPr
      if ((length(outlineLevels[[i]]) > 0) && (!grepl("outlineLevelRow", worksheets[[i]]$sheetFormatPr))) {
        worksheets[[i]]$sheetFormatPr <<- gsub("/>", ' outlineLevelRow="1"/>', worksheets[[i]]$sheetFormatPr)
      }

      if (isChartSheet[i]) {
        chartSheetDir <- file.path(dirname(xlworksheetsDir), "chartsheets")
        chartSheetRelsDir <-
          file.path(dirname(xlworksheetsDir), "chartsheets", "_rels")

        if (!file.exists(chartSheetDir)) {
          dir.create(chartSheetDir, recursive = TRUE)
          dir.create(chartSheetRelsDir, recursive = TRUE)
        }

        write_file(
          body = worksheets[[i]]$get_prior_sheet_data(),
          fl = file.path(chartSheetDir, stri_join("sheet", i, ".xml"))
        )

        write_file(
          head = '<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">',
          body = pxml(worksheets_rels[[i]]),
          tail = "</Relationships>",
          fl = file.path(chartSheetRelsDir, sprintf("sheet%s.xml.rels", i))
        )
      } else {
        ## Write worksheets
        ws <- worksheets[[i]]
        hasHL <-
          ifelse(length(worksheets[[i]]$hyperlinks) > 0, TRUE, FALSE)

        ## reorder sheet data
        worksheets[[i]]$order_sheetdata()

        prior <- ws$get_prior_sheet_data()
        post <- ws$get_post_sheet_data()

        worksheets[[i]]$sheet_data$style_id <<-
          as.character(worksheets[[i]]$sheet_data$style_id)

        if ((length(rowHeights[[i]]) == 0) & (length(outlineLevels[[i]]) == 0)) {
          write_worksheet_xml(
            prior = prior,
            post = post,
            sheet_data = ws$sheet_data,
            R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i))
          )
        } else if ((length(rowHeights[[i]]) == 0) & (length(outlineLevels[[i]]) > 0)) {
          write_worksheet_xml_2(
            prior = prior,
            post = post,
            sheet_data = ws$sheet_data,
            row_heights_ = NULL,
            outline_levels_ = unlist(outlineLevels[[i]]),
            R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i))
          )
        } else if ((length(rowHeights[[i]]) > 0) & (length(outlineLevels[[i]]) == 0)) {
          write_worksheet_xml_2(
            prior = prior,
            post = post,
            sheet_data = ws$sheet_data,
            row_heights_ = unlist(rowHeights[[i]]),
            outline_levels_ = NULL,
            R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i))
          )
        } else {
          ## row heights will always be in order and all row heights are given rows in preSaveCleanup
          write_worksheet_xml_2(
            prior = prior,
            post = post,
            sheet_data = ws$sheet_data,
            row_heights_ = unlist(rowHeights[[i]]),
            outline_levels_ = unlist(outlineLevels[[i]]),
            R_fileName = file.path(xlworksheetsDir, sprintf("sheet%s.xml", i))
          )
        }

        worksheets[[i]]$sheet_data$style_id <<- integer(0)


        ## write worksheet rels
        if (length(worksheets_rels[[i]]) > 0) {
          ws_rels <- worksheets_rels[[i]]
          if (hasHL) {
            h_inds <- stri_join(seq_along(worksheets[[i]]$hyperlinks), "h")
            ws_rels <-
              c(ws_rels, unlist(
                lapply(seq_along(h_inds), function(j) {
                  worksheets[[i]]$hyperlinks[[j]]$to_target_xml(h_inds[j])
                })
              ))
          }

          ## Check if any tables were deleted - remove these from rels
          if (length(tables) > 0) {
            table_inds <- grep("tables/table[0-9].xml", ws_rels)

            if (length(table_inds) > 0) {
              ids <-
                regmatches(
                  ws_rels[table_inds],
                  regexpr(
                    '(?<=Relationship Id=")[0-9A-Za-z]+',
                    ws_rels[table_inds],
                    perl = TRUE
                  )
                )
              inds <-
                as.integer(gsub("[^0-9]", "", ids, perl = TRUE)) - 2L
              table_nms <- attr(tables, "tableName")[inds]
              is_deleted <-
                grepl("openxlsx_deleted", table_nms, fixed = TRUE)
              if (any(is_deleted)) {
                ws_rels <- ws_rels[-table_inds[is_deleted]]
              }
            }
          }



          write_file(
            head = '<Relationships xmlns="http://schemas.openxmlformats.org/package/2006/relationships">',
            body = pxml(ws_rels),
            tail = "</Relationships>",
            fl = file.path(xlworksheetsRelsDir, sprintf("sheet%s.xml.rels", i))
          )
        }
      } ## end of isChartSheet[i]
    } ## end of loop through 1:nSheets

    invisible(0)
  }
)





Workbook$methods(
  setRowHeights = function(sheet, rows, heights) {
    sheet <- validateSheet(sheet)

    ## remove any conflicting heights
    flag <- names(rowHeights[[sheet]]) %in% rows
    if (any(flag)) {
      rowHeights[[sheet]] <<- rowHeights[[sheet]][!flag]
    }

    nms <- c(names(rowHeights[[sheet]]), rows)
    allRowHeights <- unlist(c(rowHeights[[sheet]], heights))
    names(allRowHeights) <- nms

    allRowHeights <-
      allRowHeights[order(as.integer(names(allRowHeights)))]

    rowHeights[[sheet]] <<- allRowHeights
  }
)

Workbook$methods(
  groupColumns = function(sheet) {
    sheet <- validateSheet(sheet)

    hidden <- attr(colOutlineLevels[[sheet]], "hidden", exact = TRUE)
    cols <- names(colOutlineLevels[[sheet]])
    max_outline <- max(colOutlineLevels[[sheet]])
    
    outline_attr <- paste0(' outlineLevelCol="', max_outline, '"')
    if (!grepl("outlineLevelCol", worksheets[[sheet]]$sheetFormatPr)) {
      worksheets[[sheet]]$sheetFormatPr <<- sub("/>", paste0(outline_attr, "/>"), worksheets[[sheet]]$sheetFormatPr)
    } else {
      worksheets[[sheet]]$sheetFormatPr <<- sub(' outlineLevelCol="[0-9]+"', outline_attr, worksheets[[sheet]]$sheetFormatPr)
    }

    # Check if column is already created (by `setColWidths()` or on import)
    # Note that columns are initiated by `setColWidths` first (see: order of execution in `preSaveCleanUp()`)
    if (any(cols %in% names(worksheets[[sheet]]$cols))) {

      for (i in intersect(cols, names(worksheets[[sheet]]$cols))) {
        outline_hidden <- attr(colOutlineLevels[[sheet]], "hidden")[attr(colOutlineLevels[[sheet]], "names") == i]
        outline_level <- colOutlineLevels[[sheet]][[i]]

        if (grepl("outlineLevel", worksheets[[sheet]]$cols[[i]], perl = TRUE)) {
          worksheets[[sheet]]$cols[[i]] <<- sub("((?<=hidden=\")(\\w+)\")", paste0(outline_hidden, "\""), worksheets[[sheet]]$cols[[i]], perl = TRUE)
        } else {
          worksheets[[sheet]]$cols[[i]] <<- sub("((?<=hidden=\")(\\w+)\")", paste0(outline_hidden, "\" outlineLevel=\"", outline_level, "\""), worksheets[[sheet]]$cols[[i]], perl = TRUE)
        }
      }

      cols <- cols[!cols %in% names(worksheets[[sheet]]$cols)]
      hidden <- attr(colOutlineLevels[[sheet]], "hidden")[attr(colOutlineLevels[[sheet]], "names") %in% cols]
    }

    if (length(cols) > 0) {
      colNodes <- sprintf('<col min="%s" max="%s" outlineLevel="%s" hidden="%s"/>', cols, cols, colOutlineLevels[[sheet]][cols], hidden)
      names(colNodes) <- cols
      colNodes = append(worksheets[[sheet]]$cols, colNodes)
      # Order by column name (=index)
      worksheets[[sheet]]$cols <<- colNodes[order(names(colNodes))]
    }
  }
)

Workbook$methods(
  groupRows = function(sheet, rows, hidden = 0, levels = -1) {
    # Validation, input data cleanup / preparation
    sheet <- validateSheet(sheet)
    hidden = rep(hidden, length.out = length(rows))
    levels = rep(levels, length.out = length(rows))
    
    # browser()
    
    # disassemble outlineLevels (extract rows, levels and hidden components)
    existing_rows <- names(outlineLevels[[sheet]])
    existing_levels <- outlineLevels[[sheet]]
    attributes(existing_levels) <- NULL
    existing_hidden <-  attr(outlineLevels[[sheet]], "hidden")

    # 1. existing entries: 
    #       - if levels==-1 => set outlineLevel to max of existing level + 1
    #       - Otherwise, set outlineLevel to given levels
    #       - update hidden flag correspondingly
    # 2. New entries
    #       - Append new entries to the end (hidden and levels vector), potentially out-of-order
    # 3. Reorder all entries to be in the correct order
    
    flag <- existing_rows %in% rows

    # Find indices of rows that already exist
    existing_outline_indices = which(flag)
    existing_outline = existing_rows[existing_outline_indices]
    existing_rows_indices = match(existing_outline, rows)
    
    # Auto-detect new level if required
    new_level <- "1"
    if (any(flag)) {
      new_level <- as.character(max(as.numeric(existing_levels[flag])) + 1)
    }
    levels[levels < 0] = as.character(new_level)
    
    if (any(flag)) {
      # Assign the given values to existing row definitions (indices were extracted above)
      existing_hidden[existing_outline_indices] <- hidden[existing_rows_indices]
      existing_levels[existing_outline_indices] <- levels[existing_rows_indices]
      
      # Append all remaining new entries:
      all_names <- c(existing_rows, rows[-existing_rows_indices])
      all_levels <- c(existing_levels, levels[-existing_rows_indices])
      all_hidden <- c(existing_hidden, hidden[-existing_rows_indices])
    } else {
      # only new rows were added, no existing modified
      all_names = c(existing_rows, rows)
      all_levels = c(existing_levels, levels)
      all_hidden = c(existing_hidden, hidden)
    }
    
    # re-order and then re-assamble the outlineLevels object (vector with proper attributes)
    ord <- order(as.numeric(all_names))
    all_levels <- as.character(all_levels[ord])
    names(all_levels) <- all_names[ord]
    attr(all_levels, "hidden") <- as.character(as.integer(all_hidden[ord]))
    
    outlineLevels[[sheet]] <<- all_levels
    

    # Finally, update the sheetFormatPr XML element with the maximum outline level
    max_outline = max(as.numeric(outlineLevels[[sheet]]))
    outline_attr <- paste0(' outlineLevelRow="', max_outline, '"')
    if (!grepl("outlineLevelRow", worksheets[[sheet]]$sheetFormatPr)) {
      worksheets[[sheet]]$sheetFormatPr <<- sub("/>", paste0(outline_attr, "/>"), worksheets[[sheet]]$sheetFormatPr)
    } else {
      worksheets[[sheet]]$sheetFormatPr <<- sub(' outlineLevelRow="[0-9]+"', outline_attr, worksheets[[sheet]]$sheetFormatPr)
    }
  }
)



Workbook$methods(
  deleteWorksheet = function(sheet) {
    # To delete a worksheet
    # Remove colwidths element
    # Remove drawing partname from Content_Types (drawing(sheet).xml)
    # Remove highest sheet from Content_Types
    # Remove drawings element
    # Remove drawings_rels element

    # Remove vml element
    # Remove vml_rels element

    # Remove rowHeights element
    # Remove styleObjects on sheet
    # Remove last sheet element from workbook
    # Remove last sheet element from workbook.xml.rels
    # Remove element from worksheets
    # Remove element from worksheets_rels
    # Remove hyperlinks
    # Reduce calcChain i attributes & remove calcs on sheet
    # Remove sheet from sheetOrder
    # Remove queryTable references from workbook$definedNames to worksheet
    # remove tables

    sheet <- validateSheet(sheet)
    sheetNames <- sheet_names
    nSheets <- length(unlist(sheetNames, use.names = FALSE))
    sheetName <- sheetNames[[sheet]]

    colWidths[[sheet]] <<- NULL
    sheet_names <<- sheet_names[-sheet]

    ## remove last drawings(sheet).xml from Content_Types
    Content_Types <<-
      Content_Types[!grepl(sprintf("drawing%s.xml", nSheets), Content_Types)]

    ## remove highest sheet
    Content_Types <<-
      Content_Types[!grepl(sprintf("sheet%s.xml", nSheets), Content_Types)]

    drawings[[sheet]] <<- NULL
    drawings_rels[[sheet]] <<- NULL

    vml[[sheet]] <<- NULL
    vml_rels[[sheet]] <<- NULL

    rowHeights[[sheet]] <<- NULL
    colOutlineLevels[[sheet]] <<- NULL
    outlineLevels[[sheet]] <<- NULL
    comments[[sheet]] <<- NULL
    threadComments[[sheet]] <<- NULL
    isChartSheet <<- isChartSheet[-sheet]

    ## sheetOrder
    toRemove <- which(sheetOrder == sheet)
    sheetOrder[sheetOrder > sheet] <<-
      sheetOrder[sheetOrder > sheet] - 1L
    sheetOrder <<- sheetOrder[-toRemove]


    ## remove styleObjects
    if (length(styleObjects) > 0) {
      styleObjects <<-
        styleObjects[unlist(lapply(styleObjects, "[[", "sheet"), use.names = FALSE) != sheetName]
    }

    ## Need to remove reference from workbook.xml.rels to pivotCache
    removeRels <- grep("pivotTables", worksheets_rels[[sheet]], value = TRUE)
    if (length(removeRels) > 0) {
      ## sheet rels links to a pivotTable file, the corresponding pivotTable_rels file links to the cacheDefn which is listing in workbook.xml.rels
      ## remove reference to this file from the workbook.xml.rels
      fileNo <-
        as.integer(unlist(regmatches(
          removeRels,
          gregexpr("(?<=pivotTable)[0-9]+(?=\\.xml)", removeRels, perl = TRUE)
        )))
      toRemove <-
        stri_join(
          sprintf("(pivotCacheDefinition%s\\.xml)", fileNo),
          sep = " ",
          collapse = "|"
        )

      fileNo <- grep(toRemove, pivotTables.xml.rels)
      toRemove <-
        stri_join(
          sprintf("(pivotCacheDefinition%s\\.xml)", fileNo),
          sep = " ",
          collapse = "|"
        )

      ## remove reference to file from workbook.xml.res
      workbook.xml.rels <<-
        workbook.xml.rels[!grepl(toRemove, workbook.xml.rels)]
    }

    ## As above for slicers
    ## Need to remove reference from workbook.xml.rels to pivotCache
    removeRels <- grepl("slicers", worksheets_rels[[sheet]])
    if (any(removeRels)) {
      workbook.xml.rels <<-
        workbook.xml.rels[!grepl(sprintf("(slicerCache%s\\.xml)", sheet), workbook.xml.rels)]
    }

    ## wont't remove tables and then won't need to reassign table r:id's but will rename them!
    worksheets[[sheet]] <<- NULL
    worksheets_rels[[sheet]] <<- NULL

    if (length(tables) > 0) {
      tableSheets <- attr(tables, "sheet")
      tableNames <- attr(tables, "tableName")

      inds <-
        tableSheets %in% sheet &
          !grepl("openxlsx_deleted", attr(tables, "tableName"), fixed = TRUE)
      tableSheets[tableSheets > sheet] <-
        tableSheets[tableSheets > sheet] - 1L

      ## Need to flag a table as deleted
      if (any(inds)) {
        tableSheets[inds] <- 0
        tableNames[inds] <-
          stri_join(tableNames[inds], "_openxlsx_deleted")
      }
      attr(tables, "tableName") <<- tableNames
      attr(tables, "sheet") <<- tableSheets
    }


    ## drawing will always be the first relationship and printerSettings second
    if (nSheets > 1) {
      for (i in 1:(nSheets - 1L)) {
        worksheets_rels[[i]][1:3] <<- genBaseSheetRels(i)
      }
    } else {
      worksheets_rels <<- list()
    }


    ## remove sheet
    sn <-
      unlist(lapply(workbook$sheets, function(x) {
        regmatches(
          x, regexpr('(?<= name=")[^"]+', x, perl = TRUE)
        )
      }))
    workbook$sheets <<- workbook$sheets[!sn %in% sheetName]

    ## Reset rIds
    if (nSheets > 1) {
      for (i in (sheet + 1L):nSheets) {
        workbook$sheets <<-
          gsub(stri_join("rId", i),
            stri_join("rId", i - 1L),
            workbook$sheets,
            fixed = TRUE
          )
      }
    } else {
      workbook$sheets <<- NULL
    }

    ## Can remove highest sheet
    workbook.xml.rels <<-
      workbook.xml.rels[!grepl(sprintf("sheet%s.xml", nSheets), workbook.xml.rels)]

    ## definedNames
    if (length(workbook$definedNames) > 0) {
      belongTo <- getDefinedNamesSheet(workbook$definedNames)
      workbook$definedNames <<-
        workbook$definedNames[!belongTo %in% sheetName]
    }

    invisible(1)
  }
)


Workbook$methods(
  addDXFS = function(style) {
    dxf <- "<dxf>"
    dxf <- stri_join(dxf, createFontNode(style))
    fillNode <- NULL

    if (!is.null(style$fill$fillFg) | !is.null(style$fill$fillBg)) {
      dxf <- stri_join(dxf, createFillNode(style))
    }

    if (any(!is.null(
      c(
        style$borderLeft,
        style$borderRight,
        style$borderTop,
        style$borderBottom,
        style$borderDiagonal
      )
    ))) {
      dxf <- stri_join(dxf, createBorderNode(style))
    }

    dxf <- stri_join(dxf, "</dxf>", sep = " ")
    if (dxf %in% styles$dxfs) {
      return(which(styles$dxfs == dxf) - 1L)
    }

    dxfId <- length(styles$dxfs)
    styles$dxfs <<- c(styles$dxfs, dxf)

    return(dxfId)
  }
)



Workbook$methods(
  dataValidation = function(sheet,
                            startRow,
                            endRow,
                            startCol,
                            endCol,
                            type,
                            operator,
                            value,
                            allowBlank,
                            showInputMsg,
                            showErrorMsg) {
    sheet <- validateSheet(sheet)
    sqref <-
      stri_join(getCellRefs(data.frame(
        "x" = c(startRow, endRow),
        "y" = c(startCol, endCol)
      )),
      sep = " ",
      collapse = ":"
      )

    header <-
      sprintf(
        '<dataValidation type="%s" operator="%s" allowBlank="%s" showInputMessage="%s" showErrorMessage="%s" sqref="%s">',
        type,
        operator,
        allowBlank,
        showInputMsg,
        showErrorMsg,
        sqref
      )


    if (type == "date") {
      origin <- 25569L
      if (grepl(
        'date1904="1"|date1904="true"',
        stri_join(unlist(workbook), sep = " ", collapse = ""),
        ignore.case = TRUE
      )) {
        origin <- 24107L
      }

      value <- as.integer(value) + origin
    }

    if (type == "time") {
      origin <- 25569L
      if (grepl(
        'date1904="1"|date1904="true"',
        stri_join(unlist(workbook), sep = " ", collapse = ""),
        ignore.case = TRUE
      )) {
        origin <- 24107L
      }

      t <- format(value[1], "%z")
      offSet <-
        suppressWarnings(ifelse(substr(t, 1, 1) == "+", 1L, -1L) * (as.integer(substr(t, 2, 3)) + as.integer(substr(t, 4, 5)) / 60) / 24)
      if (is.na(offSet)) {
        offSet[i] <- 0
      }

      value <- as.numeric(as.POSIXct(value)) / 86400 + origin + offSet
    }

    form <-
      sapply(seq_along(value), function(i) {
        sprintf("<formula%s>%s</formula%s>", i, value[i], i)
      })
    worksheets[[sheet]]$dataValidations <<-
      c(
        worksheets[[sheet]]$dataValidations,
        stri_join(header, stri_join(form, collapse = ""), "</dataValidation>")
      )

    invisible(0)
  }
)



Workbook$methods(
  dataValidation_list = function(sheet,
                                 startRow,
                                 endRow,
                                 startCol,
                                 endCol,
                                 value,
                                 allowBlank,
                                 showInputMsg,
                                 showErrorMsg) {
    sheet <- validateSheet(sheet)
    sqref <-
      stri_join(getCellRefs(data.frame(
        "x" = c(startRow, endRow),
        "y" = c(startCol, endCol)
      )),
      sep = " ",
      collapse = ":"
      )
    data_val <-
      sprintf(
        '<x14:dataValidation type="list" allowBlank="%s" showInputMessage="%s" showErrorMessage="%s">',
        allowBlank,
        showInputMsg,
        showErrorMsg
      )

    formula <-
      sprintf("<x14:formula1><xm:f>%s</xm:f></x14:formula1>", value)
    sqref <- sprintf("<xm:sqref>%s</xm:sqref>", sqref)

    xmlData <-
      stri_join(data_val, formula, sqref, "</x14:dataValidation>")

    worksheets[[sheet]]$dataValidationsLst <<-
      c(worksheets[[sheet]]$dataValidationsLst, xmlData)

    invisible(0)
  }
)



Workbook$methods(
  conditionalFormatting = function(sheet,
                                   startRow,
                                   endRow,
                                   startCol,
                                   endCol,
                                   dxfId,
                                   formula,
                                   type,
                                   values,
                                   params) {
    sheet <- validateSheet(sheet)
    sqref <-
      stri_join(getCellRefs(data.frame(
        "x" = c(startRow, endRow),
        "y" = c(startCol, endCol)
      )), collapse = ":")



    ## Increment priority of conditional formatting rule
    if (length(worksheets[[sheet]]$conditionalFormatting) > 0) {
      for (i in rev(seq_along(worksheets[[sheet]]$conditionalFormatting))) {
        priority <-
          regmatches(
            worksheets[[sheet]]$conditionalFormatting[[i]],
            regexpr(
              '(?<=priority=")[0-9]+',
              worksheets[[sheet]]$conditionalFormatting[[i]],
              perl = TRUE
            )
          )
        priority_new <- as.integer(priority) + 1L

        priority_pattern <- sprintf('priority="%s"', priority)
        priority_new <- sprintf('priority="%s"', priority_new)

        ## now replace
        worksheets[[sheet]]$conditionalFormatting[[i]] <<-
          gsub(priority_pattern,
               priority_new,
               worksheets[[sheet]]$conditionalFormatting[[i]],
               fixed = TRUE
          )
      }
    }

    nms <- c(names(worksheets[[sheet]]$conditionalFormatting), sqref)

    if (type == "colorScale") {
      ## formula contains the colours
      ## values contains numerics or is NULL
      ## dxfId is ignored

      if (is.null(values)) {
        if (length(formula) == 2L) {
          cfRule <-
            sprintf(
              '<cfRule type="colorScale" priority="1"><colorScale>
                             <cfvo type="min"/><cfvo type="max"/>
                             <color rgb="%s"/><color rgb="%s"/>
                           </colorScale></cfRule>',
              formula[[1]],
              formula[[2]]
            )
        } else {
          cfRule <-
            sprintf(
              '<cfRule type="colorScale" priority="1"><colorScale>
                             <cfvo type="min"/><cfvo type="percentile" val="50"/><cfvo type="max"/>
                             <color rgb="%s"/><color rgb="%s"/><color rgb="%s"/>
                           </colorScale></cfRule>',
              formula[[1]],
              formula[[2]],
              formula[[3]]
            )
        }
      } else {
        if (length(formula) == 2L) {
          cfRule <-
            sprintf(
              '<cfRule type="colorScale" priority="1"><colorScale>
                            <cfvo type="num" val="%s"/><cfvo type="num" val="%s"/>
                            <color rgb="%s"/><color rgb="%s"/>
                           </colorScale></cfRule>',
              values[[1]],
              values[[2]],
              formula[[1]],
              formula[[2]]
            )
        } else {
          cfRule <-
            sprintf(
              '<cfRule type="colorScale" priority="1"><colorScale>
                            <cfvo type="num" val="%s"/><cfvo type="num" val="%s"/><cfvo type="num" val="%s"/>
                            <color rgb="%s"/><color rgb="%s"/><color rgb="%s"/>
                           </colorScale></cfRule>',
              values[[1]],
              values[[2]],
              values[[3]],
              formula[[1]],
              formula[[2]],
              formula[[3]]
            )
        }
      }
    } else if (type == "dataBar") {
      # forumula is a vector of colours of length 1 or 2
      # values is NULL or a numeric vector of equal length as formula

      if (length(formula) == 2L) {
        negColour <- formula[[1]]
        posColour <- formula[[2]]
      } else {
        posColour <- formula
        negColour <- "FFFF0000"
      }

      guid <-
        stri_join(
          "F7189283-14F7-4DE0-9601-54DE9DB",
          40000L + length(worksheets[[sheet]]$extLst)
        )

      showValue <- 1
      if ("showValue" %in% names(params)) {
        showValue <- as.integer(params$showValue)
      }

      gradient <- 1
      if ("gradient" %in% names(params)) {
        gradient <- as.integer(params$gradient)
      }

      border <- 1
      if ("border" %in% names(params)) {
        border <- as.integer(params$border)
      }

      if (is.null(values)) {
        cfRule <-
          sprintf(
            '<cfRule type="dataBar" priority="1"><dataBar showValue="%s">
                          <cfvo type="min"/><cfvo type="max"/>
                          <color rgb="%s"/>
                          </dataBar>
                          <extLst><ext uri="{B025F937-C7B1-47D3-B67F-A62EFF666E3E}" xmlns:x14="http://schemas.microsoft.com/office/spreadsheetml/2009/9/main"><x14:id>{%s}</x14:id></ext>
                        </extLst></cfRule>',
            showValue,
            posColour,
            guid
          )
      } else {
        cfRule <-
          sprintf(
            '<cfRule type="dataBar" priority="1"><dataBar showValue="%s">
                            <cfvo type="num" val="%s"/><cfvo type="num" val="%s"/>
                            <color rgb="%s"/>
                            </dataBar>
                            <extLst><ext uri="{B025F937-C7B1-47D3-B67F-A62EFF666E3E}" xmlns:x14="http://schemas.microsoft.com/office/spreadsheetml/2009/9/main">
                            <x14:id>{%s}</x14:id></ext></extLst></cfRule>',
            showValue,
            values[[1]],
            values[[2]],
            posColour,
            guid
          )
      }

      worksheets[[sheet]]$extLst <<-
        c(
          worksheets[[sheet]]$extLst,
          gen_databar_extlst(
            guid = guid,
            sqref = sqref,
            posColour = posColour,
            negColour = negColour,
            values = values,
            border = border,
            gradient = gradient
          )
        )
    } else if (type == "expression") {
      cfRule <-
        sprintf(
          '<cfRule type="expression" dxfId="%s" priority="1"><formula>%s</formula></cfRule>',
          dxfId,
          formula
        )
    } else if (type == "duplicatedValues") {
      cfRule <-
        sprintf(
          '<cfRule type="duplicateValues" dxfId="%s" priority="1"/>',
          dxfId
        )
    } else if (type == "containsText") {
      cfRule <-
        sprintf(
          '<cfRule type="containsText" dxfId="%s" priority="1" operator="containsText" text="%s">
                        	<formula>NOT(ISERROR(SEARCH("%s", %s)))</formula>
                       </cfRule>',
          dxfId,
          values,
          values,
          unlist(strsplit(sqref, split = ":"))[[1]]
        )
    } else if (type == "notContainsText") {
      cfRule <-
        sprintf(
          '<cfRule type="notContainsText" dxfId="%s" priority="1" operator="notContains" text="%s">
                        	<formula>ISERROR(SEARCH("%s", %s))</formula>
                       </cfRule>',
          dxfId,
          values,
          values,
          unlist(strsplit(sqref, split = ":"))[[1]]
        )
    } else if (type == "beginsWith") {
      cfRule <-
        sprintf(
          '<cfRule type="beginsWith" dxfId="%s" priority="1" operator="beginsWith" text="%s">
                        	<formula>LEFT(%s,LEN("%s"))="%s"</formula>
                       </cfRule>',
          dxfId,
          values,

          unlist(strsplit(sqref, split = ":"))[[1]],
          values,
          values
        )
    } else if (type == "endsWith") {
      cfRule <-
        sprintf(
          '<cfRule type="endsWith" dxfId="%s" priority="1" operator="endsWith" text="%s">
                        	<formula>RIGHT(%s,LEN("%s"))="%s"</formula>
                       </cfRule>',
          dxfId,
          values,

          unlist(strsplit(sqref, split = ":"))[[1]],
          values,
          values
        )
    } else if (type == "between") {
      cfRule <-
        sprintf(
          '<cfRule type="cellIs" dxfId="%s" priority="1" operator="between"><formula>%s</formula><formula>%s</formula></cfRule>',
          dxfId,
          formula[1],
          formula[2]
        )
    } else if (type == "topN") {
      cfRule <-
        sprintf(
          '<cfRule type="top10" dxfId="%s" priority="1" rank="%s" percent="%s"></cfRule>',
          dxfId,
          values[1],
          values[2]
        )
    } else if (type == "bottomN") {
      cfRule <-
        sprintf(
          '<cfRule type="top10" dxfId="%s" priority="1" rank="%s" percent="%s" bottom="1"></cfRule>',
          dxfId,
          values[1],
          values[2]
        )
    } else if (type == "containsBlanks") {
      cfRule <-
        sprintf(
          '<cfRule type="containsBlanks" dxfId="%s" priority="1">
                        	<formula>LEN(TRIM(%s))=0</formula>
                       </cfRule>',
          dxfId,
          unlist(strsplit(sqref, split = ":"))[[1]]
        )
    } else if (type == "notContainsBlanks") {
      cfRule <-
        sprintf(
          '<cfRule type="notContainsBlanks" dxfId="%s" priority="1">
                        	<formula>LEN(TRIM(%s))&gt;0</formula>
                       </cfRule>',
          dxfId,
          unlist(strsplit(sqref, split = ":"))[[1]]
        )
    }

    worksheets[[sheet]]$conditionalFormatting <<-
      append(worksheets[[sheet]]$conditionalFormatting, cfRule)

    names(worksheets[[sheet]]$conditionalFormatting) <<- nms

    invisible(0)
  }
)




Workbook$methods(
  mergeCells = function(sheet, startRow, endRow, startCol, endCol) {
    sheet <- validateSheet(sheetName = sheet)

    sqref <-
      getCellRefs(data.frame(
        "x" = c(startRow, endRow),
        "y" = c(startCol, endCol)
      ))
    exMerges <-
      regmatches(
        worksheets[[sheet]]$mergeCells,
        regexpr("[A-Z0-9]+:[A-Z0-9]+", worksheets[[sheet]]$mergeCells)
      )

    if (!is.null(exMerges)) {
      comps <-
        lapply(exMerges, function(rectCoords) {
          unlist(strsplit(rectCoords, split = ":"))
        })
      exMergedCells <- build_cell_merges(comps = comps)
      newMerge <- unlist(build_cell_merges(comps = list(sqref)))

      ## Error if merge intersects
      mergeIntersections <-
        sapply(exMergedCells, function(x) {
          any(x %in% newMerge)
        })
      if (any(mergeIntersections)) {
        stop(
          sprintf(
            "Merge intersects with existing merged cells: \n\t\t%s.\nRemove existing merge first.",
            stri_join(exMerges[mergeIntersections], collapse = "\n\t\t")
          )
        )
      }
    }

    worksheets[[sheet]]$mergeCells <<-
      c(
        worksheets[[sheet]]$mergeCells,
        sprintf(
          '<mergeCell ref="%s"/>',
          stri_join(sqref,
            collapse = ":", sep =
              " "
          )
        )
      )
  }
)



Workbook$methods(
  removeCellMerge = function(sheet, startRow, endRow, startCol, endCol) {
    sheet <- validateSheet(sheet)

    sqref <-
      getCellRefs(data.frame(
        "x" = c(startRow, endRow),
        "y" = c(startCol, endCol)
      ))
    exMerges <-
      regmatches(
        worksheets[[sheet]]$mergeCells,
        regexpr("[A-Z0-9]+:[A-Z0-9]+", worksheets[[sheet]]$mergeCells)
      )

    if (!is.null(exMerges)) {
      comps <-
        lapply(exMerges, function(x) {
          unlist(strsplit(x, split = ":"))
        })
      exMergedCells <- build_cell_merges(comps = comps)
      newMerge <- unlist(build_cell_merges(comps = list(sqref)))

      ## Error if merge intersects
      mergeIntersections <-
        sapply(exMergedCells, function(x) {
          any(x %in% newMerge)
        })
    }

    ## Remove intersection
    worksheets[[sheet]]$mergeCells <<-
      worksheets[[sheet]]$mergeCells[!mergeIntersections]
  }
)





Workbook$methods(
  freezePanes = function(sheet,
                         firstActiveRow = NULL,
                         firstActiveCol = NULL,
                         firstRow = FALSE,
                         firstCol = FALSE) {
    sheet <- validateSheet(sheet)
    paneNode <- NULL

    if (firstRow) {
      paneNode <-
        '<pane ySplit="1" topLeftCell="A2" activePane="bottomLeft" state="frozen"/>'
    } else if (firstCol) {
      paneNode <-
        '<pane xSplit="1" topLeftCell="B1" activePane="topRight" state="frozen"/>'
    }


    if (is.null(paneNode)) {
      if (firstActiveRow == 1 & firstActiveCol == 1) {
        ## nothing to do
        return(NULL)
      }

      if (firstActiveRow > 1 & firstActiveCol == 1) {
        attrs <- sprintf('ySplit="%s"', firstActiveRow - 1L)
        activePane <- "bottomLeft"
      }

      if (firstActiveRow == 1 & firstActiveCol > 1) {
        attrs <- sprintf('xSplit="%s"', firstActiveCol - 1L)
        activePane <- "topRight"
      }

      if (firstActiveRow > 1 & firstActiveCol > 1) {
        attrs <-
          sprintf(
            'ySplit="%s" xSplit="%s"',
            firstActiveRow - 1L,
            firstActiveCol - 1L
          )
        activePane <- "bottomRight"
      }

      topLeftCell <-
        getCellRefs(data.frame(firstActiveRow, firstActiveCol))

      paneNode <-
        sprintf(
          '<pane %s topLeftCell="%s" activePane="%s" state="frozen"/><selection pane="%s"/>',
          stri_join(attrs, collapse = " ", sep = " "),
          topLeftCell,
          activePane,
          activePane
        )
    }

    worksheets[[sheet]]$freezePane <<- paneNode
  }
)



Workbook$methods(
  insertImage = function(sheet,
                         file,
                         startRow,
                         startCol,
                         width,
                         height,
                         rowOffset = 0,
                         colOffset = 0,
                         address) {
    ## within the sheet the drawing node's Id refernce an id in the sheetRels
    ## sheet rels reference the drawingi.xml file
    ## drawingi.xml reference drawingRels
    ## drawing rels reference an image in the media folder
    ## worksheetRels(sheet(i)) references drawings(j)

    sheet <- validateSheet(sheet)

    imageType <- regmatches(file, gregexpr("\\.[a-zA-Z]*$", file))
    imageType <- gsub("^\\.", "", imageType)

    imageNo <- length((drawings[[sheet]])) + 1L
    imageRelNo <- length((drawings_rels[[sheet]])) + 1L
    linkRelNo <- length((drawings_rels[[sheet]])) + 2L
    mediaNo <- length(media) + 1L

    startCol <- convertFromExcelRef(startCol)

    ## update Content_Types
    if (!any(grepl(stri_join("image/", imageType), Content_Types))) {
      Content_Types <<-
        unique(c(
          sprintf(
            '<Default Extension="%s" ContentType="image/%s"/>',
            imageType,
            imageType
          ),
          Content_Types
        ))
    }

    ## drawings rels (Reference from drawings.xml to image file in media folder)
    drawings_rels[[sheet]] <<- c(
      drawings_rels[[sheet]],
      sprintf(
        '<Relationship Id="rId%s" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/image" Target="../media/image%s.%s"/>',
        imageRelNo,
        mediaNo,
        imageType
      ), 
      if (!missing(address)) {
        sprintf(
          '<Relationship Id="rId%s" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink" Target="%s" TargetMode="External"/>',
          linkRelNo,
          address
        )
      }
    )

    ## write file path to media slot to copy across on save
    tmp <- file
    names(tmp) <- stri_join("image", mediaNo, ".", imageType)
    media <<- append(media, tmp)

    ## create drawing.xml
    anchor <-
      '<xdr:oneCellAnchor xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing">'

    from <- sprintf(
      '<xdr:from xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing">
    <xdr:col xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing">%s</xdr:col>
    <xdr:colOff xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing">%s</xdr:colOff>
    <xdr:row xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing">%s</xdr:row>
    <xdr:rowOff xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing">%s</xdr:rowOff>
  </xdr:from>',
      startCol - 1L,
      colOffset,
      startRow - 1L,
      rowOffset
    )

    drawingsXML <- stri_join(
      anchor,
      from,
      sprintf(
        '<xdr:ext xmlns:xdr="http://schemas.openxmlformats.org/drawingml/2006/spreadsheetDrawing" cx="%s" cy="%s"/>',
        width,
        height
      ),
      genBasePic(
        imageNo, 
        imageRelNo, 
        ifelse(
          missing(address),
          "/",
          sprintf(
            '>
              <a:hlinkClick xmlns:r="http://schemas.openxmlformats.org/officeDocument/2006/relationships" r:id="rId%s"/>
            </xdr:cNvPr',
            linkRelNo
          )
        )
      ),
      "<xdr:clientData/>",
      "</xdr:oneCellAnchor>"
    )


    ## append to workbook drawing
    drawings[[sheet]] <<- c(drawings[[sheet]], drawingsXML)
  }
)



Workbook$methods(
  preSaveCleanUp = function() {
    ## Steps
    # Order workbook.xml.rels:
    #   sheets -> style -> theme -> sharedStrings -> persons -> tables -> calcChain
    # Assign workbook.xml.rels children rIds, seq_along(workbook.xml.rels)
    # Assign workbook$sheets rIds 1:nSheets
    #
    ## drawings will always be r:id1 on worksheet
    ## tables will always have r:id equal to table xml file number tables/table(i).xml

    ## Every worksheet has a drawingXML as r:id 1
    ## Every worksheet has a printerSettings as r:id 2
    ## Tables from r:id 3 to nTables+3 - 1
    ## HyperLinks from nTables+3 to nTables+3+nHyperLinks-1
    ## vmlDrawing to have rId

    sheetRIds <-
      as.integer(unlist(regmatches(
        workbook$sheets,
        gregexpr('(?<=r:id="rId)[0-9]+', workbook$sheets, perl = TRUE)
      )))

    nSheets <- length(sheetRIds)
    nExtRefs <- length(externalLinks)
    nPivots <- length(pivotDefinitions)

    ## add a worksheet if none added
    if (nSheets == 0) {
      warning("Workbook does not contain any worksheets. A worksheet will be added.",
        call. = FALSE
      )
      .self$addWorksheet("Sheet 1")
      nSheets <- 1L
    }

    ## get index of each child element for ordering
    sheetInds <- grep("(worksheets|chartsheets)/sheet[0-9]+\\.xml", workbook.xml.rels)
    stylesInd <- grep("styles\\.xml", workbook.xml.rels)
    themeInd <- grep("theme/theme[0-9]+.xml", workbook.xml.rels)
    connectionsInd <- grep("connections.xml", workbook.xml.rels)
    extRefInds <- grep("externalLinks/externalLink[0-9]+.xml", workbook.xml.rels)
    sharedStringsInd <- grep("sharedStrings.xml", workbook.xml.rels)
    tableInds <- grep("table[0-9]+.xml", workbook.xml.rels)
    personInds <- grep("person.xml", workbook.xml.rels)


    ## Reordering of workbook.xml.rels
    ## don't want to re-assign rIds for pivot tables or slicer caches
    pivotNode <- grep("pivotCache/pivotCacheDefinition[0-9].xml", workbook.xml.rels, value = TRUE)
    slicerNode <- grep("slicerCache[0-9]+.xml", workbook.xml.rels, value = TRUE)

    ## Reorder children of workbook.xml.rels
    workbook.xml.rels <<-
      workbook.xml.rels[c(
        sheetInds,
        extRefInds,
        themeInd,
        connectionsInd,
        stylesInd,
        sharedStringsInd,
        tableInds,
        personInds
      )]

    ## Re assign rIds to children of workbook.xml.rels
    workbook.xml.rels <<-
      unlist(lapply(seq_along(workbook.xml.rels), function(i) {
        gsub('(?<=Relationship Id="rId)[0-9]+',
          i,
          workbook.xml.rels[[i]],
          perl = TRUE
        )
      }))

    workbook.xml.rels <<- c(workbook.xml.rels, pivotNode, slicerNode)



    if (!is.null(vbaProject)) {
      workbook.xml.rels <<-
        c(
          workbook.xml.rels,
          sprintf(
            '<Relationship Id="rId%s" Type="http://schemas.microsoft.com/office/2006/relationships/vbaProject" Target="vbaProject.bin"/>',
            1L + length(workbook.xml.rels)
          )
        )
    }

    ## Reassign rId to workbook sheet elements, (order sheets by sheetId first)
    workbook$sheets <<-
      unlist(lapply(seq_along(workbook$sheets), function(i) {
        gsub('(?<= r:id="rId)[0-9]+', i, workbook$sheets[[i]], perl = TRUE)
      }))

    ## re-order worksheets if need to
    if (any(sheetOrder != seq_len(nSheets))) {
      workbook$sheets <<- workbook$sheets[sheetOrder]
    }

    ## preserve window size and position on save:
    bookViews <-workbook$bookViews
    xWindow <- getAttrs(bookViews, "xWindow")$xWindow
    yWindow <- getAttrs(bookViews, "yWindow")$yWindow
    windowWidth <- getAttrs(bookViews, "windowWidth")$windowWidth
    windowHeight <- getAttrs(bookViews, "windowHeight")$windowHeight


    ## re-assign tabSelected
    state <- rep.int("visible", nSheets)
    state[grepl("hidden", workbook$sheets)] <- "hidden"
    visible_sheet_index <- which(state %in% "visible")[[1]]
    visible_sheets <- which(state %in% "visible")
    workbook$bookViews <<-
      sprintf(
        '<bookViews><workbookView xWindow="%s" yWindow="%s" windowWidth="%s" windowHeight="%s" firstSheet="%s" activeTab="%s"/></bookViews>',
        xWindow, yWindow, windowWidth, windowHeight,
        visible_sheet_index - 1L,
        ActiveSheet - 1L
      )

    for(i in seq_len(nSheets)) {
      worksheets[[i]]$sheetViews <<-
        sub(
          ' tabSelected="(1|true|false|0)"',
          ifelse(
            sheetOrder[ActiveSheet] == i,
            ' tabSelected="true"',
            ' tabSelected="false"'
          ),
          worksheets[[i]]$sheetViews,
          ignore.case = TRUE
        )
    }
    # worksheets[[visible_sheet_index]]$sheetViews

    # worksheets[[visible_sheet_index]]$sheetViews <<-
    #   sub(
    #     '( tabSelected="0")|( tabSelected="false")',
    #     ' tabSelected="1"',
    #     worksheets[[visible_sheet_index]]$sheetViews,
    #     ignore.case = TRUE
    #   )
    # if (nSheets > 1) {
    #   for (i in (1:nSheets)[!(1:nSheets) %in% visible_sheet_index]) {
    #     worksheets[[i]]$sheetViews <<-
    #       sub(
    #         ' tabSelected="(1|true|false|0)"',
    #         ' tabSelected="false"',
    #         worksheets[[i]]$sheetViews,
    #         ignore.case = TRUE
    #       )
    #   }
    # }





    if (length(workbook$definedNames) > 0) {
      sheetNames <- sheet_names[sheetOrder]

      belongTo <- getDefinedNamesSheet(workbook$definedNames)

      ## sheetNames is in re-ordered order (order it will be displayed)
      newId <- match(belongTo, sheetNames) - 1L
      oldId <-
        as.numeric(regmatches(
          workbook$definedNames,
          regexpr(
            '(?<= localSheetId=")[0-9]+',
            workbook$definedNames,
            perl = TRUE
          )
        ))

      for (i in seq_along(workbook$definedNames)) {
        if (!is.na(newId[i])) {
          workbook$definedNames[[i]] <<-
            gsub(
              sprintf('localSheetId=\"%s\"', oldId[i]),
              sprintf('localSheetId=\"%s\"', newId[i]),
              workbook$definedNames[[i]],
              fixed = TRUE
            )
        }
      }
    }




    ## update workbook r:id to match reordered workbook.xml.rels externalLink element
    if (length(extRefInds) > 0) {
      newInds <- as.integer(seq_along(extRefInds) + length(sheetInds))
      workbook$externalReferences <<-
        stri_join(
          "<externalReferences>",
          stri_join(
            sprintf('<externalReference r:id=\"rId%s\"/>', newInds),
            collapse = ""
          ),
          "</externalReferences>"
        )
    }

    ## styles
    numFmtIds <- 50000L
    for (i in which(!isChartSheet)) {
      worksheets[[i]]$sheet_data$style_id <<-
        rep.int(x = as.integer(NA), times = worksheets[[i]]$sheet_data$n_elements)
    }


    prev_sheet <- 0L
    for (x in styleObjects) {
      if (length(x$rows) > 0 & length(x$cols) > 0) {
        this.sty <- x$style$copy()

        if (!is.null(this.sty$numFmt)) {
          if (this.sty$numFmt$numFmtId == 9999) {
            this.sty$numFmt$numFmtId <- numFmtIds
            numFmtIds <- numFmtIds + 1L
          }
        }


        ## convert sheet name to index
        sheet <- which(sheet_names == x$sheet)
        sId <-
          .self$updateStyles(this.sty) ## this creates the XML for styles.XML

        cells_to_style <- pair_rc(x$rows, x$cols)
        
        # Avoid recreating this if we're looking at the same sheet over and over
        if (sheet != prev_sheet) {
          existing_cells <- pair_rc(worksheets[[sheet]]$sheet_data$rows,
                                    worksheets[[sheet]]$sheet_data$cols)  
        }

        ## In here we create any style_ids that don't yet exist in sheet_data
        worksheets[[sheet]]$sheet_data$style_id[existing_cells %in% cells_to_style] <<-
          sId


        new_cells_to_append <-
          which(!cells_to_style %in% existing_cells)
        if (length(new_cells_to_append) > 0) {
          worksheets[[sheet]]$sheet_data$style_id <<-
            c(
              worksheets[[sheet]]$sheet_data$style_id,
              rep.int(x = sId, times = length(new_cells_to_append))
            )

          worksheets[[sheet]]$sheet_data$rows <<-
            c(worksheets[[sheet]]$sheet_data$rows, x$rows[new_cells_to_append])
          worksheets[[sheet]]$sheet_data$cols <<-
            c(worksheets[[sheet]]$sheet_data$cols, x$cols[new_cells_to_append])
          worksheets[[sheet]]$sheet_data$t <<-
            c(worksheets[[sheet]]$sheet_data$t, rep(as.integer(NA), length(new_cells_to_append)))
          worksheets[[sheet]]$sheet_data$v <<-
            c(
              worksheets[[sheet]]$sheet_data$v,
              rep(as.character(NA), length(new_cells_to_append))
            )
          worksheets[[sheet]]$sheet_data$f <<-
            c(
              worksheets[[sheet]]$sheet_data$f,
              rep(as.character(NA), length(new_cells_to_append))
            )
          worksheets[[sheet]]$sheet_data$data_count <<-
            worksheets[[sheet]]$sheet_data$data_count + 1L

          worksheets[[sheet]]$sheet_data$n_elements <<-
            as.integer(length(worksheets[[sheet]]$sheet_data$rows))
        }
      }
    }


    ## Make sure all rowHeights have rows, if not append them!
    for (i in seq_along(worksheets)) {
      if (length(rowHeights[[i]]) > 0) {
        rh <- as.integer(names(rowHeights[[i]]))
        missing_rows <- rh[!rh %in% worksheets[[i]]$sheet_data$rows]
        n <- length(missing_rows)

        if (n > 0) {
          worksheets[[i]]$sheet_data$style_id <<-
            c(
              worksheets[[i]]$sheet_data$style_id,
              rep.int(as.integer(NA), times = n)
            )

          worksheets[[i]]$sheet_data$rows <<-
            c(worksheets[[i]]$sheet_data$rows, missing_rows)
          worksheets[[i]]$sheet_data$cols <<-
            c(
              worksheets[[i]]$sheet_data$cols,
              rep.int(as.integer(NA), times = n)
            )

          worksheets[[i]]$sheet_data$t <<-
            c(worksheets[[i]]$sheet_data$t, rep(as.integer(NA), times = n))
          worksheets[[i]]$sheet_data$v <<-
            c(
              worksheets[[i]]$sheet_data$v,
              rep(as.character(NA), times = n)
            )
          worksheets[[i]]$sheet_data$f <<-
            c(
              worksheets[[i]]$sheet_data$f,
              rep(as.character(NA), times = n)
            )
          worksheets[[i]]$sheet_data$data_count <<-
            worksheets[[i]]$sheet_data$data_count + 1L

          worksheets[[i]]$sheet_data$n_elements <<-
            as.integer(length(worksheets[[i]]$sheet_data$rows))
        }
      }

      ## write colwidth and coloutline XML
      if (length(colWidths[[i]]) > 0) {
        invisible(.self$setColWidths(i))
      }

      if (length(colOutlineLevels[[i]]) > 0) {
        invisible(.self$groupColumns(i))
      }


      if(ActiveSheet==i) {
        worksheets[[sheetOrder[i]]]$sheetViews <<-
          stri_replace_all_regex(
            worksheets[[sheetOrder[i]]]$sheetViews,
            "tabSelected=\"(1|true|false|0)\"",
            paste0("tabSelected=\"true\"")
          )
      } else {
        worksheets[[sheetOrder[i]]]$sheetViews <<-
          stri_replace_all_regex(
            worksheets[[sheetOrder[i]]]$sheetViews,
            "tabSelected=\"(1|true|false|0)\"",
            paste0("tabSelected=\"false\"")
          )
      }
    }
  }
)



Workbook$methods(
  addStyle = function(sheet, style, rows, cols, stack) {
    sheet <- sheet_names[[sheet]]

    if (length(styleObjects) == 0) {
      styleObjects <<- list(list(
        style = style,
        sheet = sheet,
        rows = rows,
        cols = cols
      ))
    } else if (stack) {
      nStyles <- length(styleObjects)

      ## ********** Assume all styleObjects cells have one a single worksheet **********
      ## Loop through existing styleObjects
      newInds <- seq_along(rows)
      keepStyle <- rep(TRUE, nStyles)
      for (i in 1:nStyles) {
        if (sheet == styleObjects[[i]]$sheet) {
          ## Now check rows and cols intersect
          ## toRemove are the elements that the new style doesn't apply to, we remove these from the style object as it
          ## is copied, merged with the new style and given the new data points

          ex_row_cols  <- pair_rc(styleObjects[[i]]$rows, 
                                  styleObjects[[i]]$cols)
          new_row_cols <- pair_rc(rows, cols)


          ## mergeInds are the intersection of the two styles that will need to merge
          mergeInds <- which(new_row_cols %in% ex_row_cols)

          ## newInds are inds that don't exist in the current - this cumulates until the end to see if any are new
          newInds <- newInds[!newInds %in% mergeInds]


          ## If the new style does not merge
          if (length(mergeInds) > 0) {
            to_remove_from_this_style_object <-
              which(ex_row_cols %in% new_row_cols)

            ## the new style intersects with this styleObjects[[i]], we need to remove the intersecting rows and
            ## columns from styleObjects[[i]]
            if (length(to_remove_from_this_style_object) > 0) {
              ## remove these from style object
              styleObjects[[i]]$rows <<-
                styleObjects[[i]]$rows[-to_remove_from_this_style_object]
              styleObjects[[i]]$cols <<-
                styleObjects[[i]]$cols[-to_remove_from_this_style_object]

              if (length(styleObjects[[i]]$rows) == 0 |
                length(styleObjects[[i]]$cols) == 0) {
                keepStyle[i] <-
                  FALSE
              } ## this style applies to no rows or columns anymore
            }

            ## append style object for intersecting cells

            ## we are appending a new style
            keepStyle <-
              c(keepStyle, TRUE) ## keepStyle is used to remove styles that apply to 0 rows OR 0 columns

            ## Merge Style and append to styleObjects
            styleObjects <<-
              append(styleObjects, list(
                list(
                  style = mergeStyle(styleObjects[[i]]$style, newStyle = style),
                  sheet = sheet,
                  rows = rows[mergeInds],
                  cols = cols[mergeInds]
                )
              ))
          }
        } ## if sheet == styleObjects[[i]]$sheet
      } ## End of loop through styles

      ## remove any styles that no longer have any affect
      if (!all(keepStyle)) {
        styleObjects <<- styleObjects[keepStyle]
      }

      ## append style object for non-intersecting cells
      if (length(newInds) > 0) {
        styleObjects <<- append(styleObjects, list(list(
          style = style,
          sheet = sheet,
          rows = rows[newInds],
          cols = cols[newInds]
        )))
      }
    } else {
      ## else we are not stacking

      styleObjects <<- append(styleObjects, list(list(
        style = style,
        sheet = sheet,
        rows = rows,
        cols = cols
      )))
    } ## End if(length(styleObjects) > 0) else if(stack) {}
  }
)



Workbook$methods(
  createNamedRegion = function(ref1, ref2, name, sheet, localSheetId = NULL) {
    name <- replaceIllegalCharacters(name)

    if (is.null(localSheetId)) {
      workbook$definedNames <<- c(
        workbook$definedNames,
        sprintf(
          '<definedName name="%s">\'%s\'!%s:%s</definedName>',
          name,
          sheet,
          ref1,
          ref2
        )
      )
    } else {
      workbook$definedNames <<- c(
        workbook$definedNames,
        sprintf(
          '<definedName name="%s" localSheetId="%s">\'%s\'!%s:%s</definedName>',
          name,
          localSheetId,
          sheet,
          ref1,
          ref2
        )
      )
    }
  }
)


Workbook$methods(
  validate_table_name = function(tableName) {
    tableName <-
      tolower(tableName) ## Excel forces named regions to lowercase

    if (nchar(tableName) > 255) {
      stop("tableName must be less than 255 characters.")
    }

    if (grepl("$", tableName, fixed = TRUE)) {
      stop("'$' character cannot exist in a tableName")
    }

    if (grepl(" ", tableName, fixed = TRUE)) {
      stop("spaces cannot exist in a table name")
    }

    # if(!grepl("^[A-Za-z_]", tableName, perl = TRUE))
    #   stop("tableName must begin with a letter or an underscore")

    if (grepl("R[0-9]+C[0-9]+",
      tableName,
      perl = TRUE,
      ignore.case = TRUE
    )) {
      stop("tableName cannot be the same as a cell reference, such as R1C1")
    }

    if (grepl("^[A-Z]{1,3}[0-9]+$", tableName, ignore.case = TRUE)) {
      stop("tableName cannot be the same as a cell reference")
    }

    if (tableName %in% attr(tables, "tableName")) {
      stop(sprintf("Table with name '%s' already exists!", tableName))
    }

    return(tableName)
  }
)


Workbook$methods(
  check_overwrite_tables = function(sheet,
                                    new_rows,
                                    new_cols,
                                    error_msg = "Cannot overwrite existing table with another table.",
                                    check_table_header_only = FALSE) {
    ## check not overwriting another table
    if (length(tables) > 0) {
      tableSheets <- attr(tables, "sheet")
      sheetNo <- validateSheet(sheet)

      to_check <-
        which(tableSheets %in% sheetNo &
          !grepl("openxlsx_deleted", attr(tables, "tableName"), fixed = TRUE))

      if (length(to_check) > 0) {
        ## only look at tables on this sheet

        exTable <- tables[to_check]

        rows <-
          lapply(names(exTable), function(rectCoords) {
            as.numeric(unlist(regmatches(
              rectCoords, gregexpr("[0-9]+", rectCoords)
            )))
          })
        cols <-
          lapply(names(exTable), function(rectCoords) {
            convertFromExcelRef(unlist(regmatches(
              rectCoords, gregexpr("[A-Z]+", rectCoords)
            )))
          })

        if (check_table_header_only) {
          rows <- lapply(rows, function(x) {
            c(x[1], x[1])
          })
        }


        ## loop through existing tables checking if any over lap with new table
        for (i in seq_along(exTable)) {
          existing_cols <- cols[[i]]
          existing_rows <- rows[[i]]

          if ((min(new_cols) <= max(existing_cols)) &
            (max(new_cols) >= min(existing_cols)) &
            (min(new_rows) <= max(existing_rows)) &
            (max(new_rows) >= min(existing_rows))) {
            stop(error_msg)
          }
        }
      } ## end if(sheet %in% tableSheets)
    } ## end (length(tables) > 0)

    invisible(0)
  }
)




Workbook$methods(
  show = function() {
    exSheets <- sheet_names
    nSheets <- length(exSheets)
    nImages <- length(media)
    nCharts <- length(charts)
    nStyles <- length(styleObjects)
    aSheet <- ActiveSheet
    exSheets <- replaceXMLEntities(exSheets)
    showText <- "A Workbook object.\n"

    if (length(aSheet) == 0) {
      aSheet <- 1
    }

    ## worksheets
    if (nSheets > 0) {
      showText <- c(showText, "\nWorksheets:\n")

      sheetTxt <- lapply(1:nSheets, function(i) {
        tmpTxt <- sprintf('Sheet %s: "%s"\n', i, exSheets[[i]])

        if (length(rowHeights[[i]]) > 0) {
          tmpTxt <-
            append(
              tmpTxt,
              c(
                "\n\tCustom row heights (row: height)\n\t",
                stri_join(
                  sprintf("%s: %s", names(rowHeights[[i]]), round(as.numeric(
                    rowHeights[[i]]
                  ), 2)),
                  collapse = ", ",
                  sep = " "
                )
              )
            )
        }

        if (length(outlineLevels[[i]]) > 0) {
          tmpTxt <-
            append(
              tmpTxt,
              c(
                "\n\tGrouped rows:\n\t",
                stri_join(
                  sprintf("%s", names(outlineLevels[[i]])),
                  collapse = ", ",
                  sep = " "
                )
              )
            )
        }

        if (length(colOutlineLevels[[i]]) > 0) {
          tmpTxt <-
            append(
              tmpTxt,
              c(
                "\n\tGrouped columns:\n\t",
                stri_join(
                  sprintf("%s", names(colOutlineLevels[[i]])),
                  collapse = ", ",
                  sep = " "
                )
              )
            )
        }

        if (length(colWidths[[i]]) > 0) {
          cols <- names(colWidths[[i]])
          widths <- unname(colWidths[[i]])

          widths[widths != "auto"] <-
            as.numeric(widths[widths != "auto"])
          tmpTxt <-
            append(
              tmpTxt,
              c(
                "\n\tCustom column widths (column: width)\n\t ",
                stri_join(
                  sprintf("%s: %s", cols, substr(widths, 1, 5)),
                  sep = " ",
                  collapse = ", "
                )
              )
            )
          tmpTxt <- c(tmpTxt, "\n")
        }
        c(tmpTxt, "\n\n")
      })

      showText <- c(showText, sheetTxt, "\n")
    } else {
      showText <-
        c(showText, "\nWorksheets:\n", "No worksheets attached\n")
    }

    ## images
    if (nImages > 0) {
      showText <-
        c(
          showText,
          "\nImages:\n",
          sprintf('Image %s: "%s"\n', 1:nImages, media)
        )
    }

    if (nCharts > 0) {
      showText <-
        c(
          showText,
          "\nCharts:\n",
          sprintf('Chart %s: "%s"\n', 1:nCharts, charts)
        )
    }

    if (nSheets > 0) {
      showText <-
        c(showText, sprintf(
          "Worksheet write order: %s\n",
          stri_join(sheetOrder, sep = " ", collapse = ", ")
        ))
    }



    if (aSheet >= 1 & nSheets > 0) {
      showText <-
        c(
          showText,
          sprintf(
            'Active Sheet %s: "%s" \n\tPosition: %s\n',
            sheetOrder[aSheet],
            exSheets[[sheetOrder[aSheet]]],
            aSheet
          )
        )
    }

    cat(unlist(showText))
    cat("\n")
  }
)

## TO BE DEPRECATED
Workbook$methods(
  conditionalFormatCell = function(sheet,
                                   startRow,
                                   endRow,
                                   startCol,
                                   endCol,
                                   dxfId,
                                   formula,
                                   type) {
    sheet <- validateSheet(sheet)
    sqref <-
      stri_join(getCellRefs(data.frame(
        "x" = c(startRow, endRow),
        "y" = c(startCol, endCol)
      )), collapse = ":")

    ## Increment priority of conditional formatting rule
    if (length((worksheets[[sheet]]$conditionalFormatting)) > 0) {
      for (i in rev(seq_along(worksheets[[sheet]]$conditionalFormatting))) {
        worksheets[[sheet]]$conditionalFormatting[[i]] <<-
          gsub('(?<=priority=")[0-9]+',
            i + 1L,
            worksheets[[sheet]]$conditionalFormatting[[i]],
            perl = TRUE
          )
      }
    }

    nms <- c(names(worksheets[[sheet]]$conditionalFormatting), sqref)

    if (type == "expression") {
      cfRule <-
        sprintf(
          '<cfRule type="expression" dxfId="%s" priority="1"><formula>%s</formula></cfRule>',
          dxfId,
          formula
        )
    } else if (type == "dataBar") {
      if (length(formula) == 2) {
        negColour <- formula[[1]]
        posColour <- formula[[2]]
      } else {
        posColour <- formula
        negColour <- "FFFF0000"
      }

      guid <-
        stri_join(
          "F7189283-14F7-4DE0-9601-54DE9DB",
          40000L + length(worksheets[[sheet]]$extLst)
        )
      cfRule <-
        sprintf(
          '<cfRule type="dataBar" priority="1"><dataBar><cfvo type="min"/><cfvo type="max"/><color rgb="%s"/></dataBar><extLst><ext uri="{B025F937-C7B1-47D3-B67F-A62EFF666E3E}" xmlns:x14="http://schemas.microsoft.com/office/spreadsheetml/2009/9/main"><x14:id>{%s}</x14:id></ext></extLst></cfRule>',
          posColour,
          guid
        )
    } else if (length(formula) == 2L) {
      cfRule <-
        sprintf(
          '<cfRule type="colorScale" priority="1"><colorScale><cfvo type="min"/><cfvo type="max"/><color rgb="%s"/><color rgb="%s"/></colorScale></cfRule>',
          formula[[1]],
          formula[[2]]
        )
    } else {
      cfRule <-
        sprintf(
          '<cfRule type="colorScale" priority="1"><colorScale><cfvo type="min"/><cfvo type="percentile" val="50"/><cfvo type="max"/><color rgb="%s"/><color rgb="%s"/><color rgb="%s"/></colorScale></cfRule>',
          formula[[1]],
          formula[[2]],
          formula[[3]]
        )
    }

    worksheets[[sheet]]$conditionalFormatting <<-
      append(worksheets[[sheet]]$conditionalFormatting, cfRule)

    names(worksheets[[sheet]]$conditionalFormatting) <<- nms

    invisible(0)
  }
)






Workbook$methods(
  loadStyles = function(stylesXML) {
    ## Build style objects from the styles XML
    stylesTxt <- readUTF8(stylesXML)
    stylesTxt <- removeHeadTag(stylesTxt)

    ## Indexed colours
    vals <- getNodes(xml = stylesTxt, tagIn = "<indexedColors>")
    if (length(vals) > 0) {
      styles$indexedColors <<-
        stri_join("<colors>", vals, "</colors>")
    }

    ## dxf (don't need these, I don't think)
    dxf <- getNodes(xml = stylesTxt, tagIn = "<dxfs")
    if (length(dxf) > 0) {
      dxf <- getNodes(xml = dxf[[1]], tagIn = "<dxf>")
      if (length(dxf) > 0) {
        styles$dxfs <<- dxf
      }
    }

    tableStyles <- getChildlessNode(stylesTxt, tag = "tableStyles")
    if (length(tableStyles) > 0) {
      styles$tableStyles <<- tableStyles
    }

    extLst <- getChildlessNode(stylesTxt, tag = "extLst")
    if (length(extLst) > 0) {
      styles$extLst <<- extLst
    }


    ## Number formats
    numFmts <- getChildlessNode(xml = stylesTxt, tag = "numFmt")
    numFmtFlag <- FALSE
    if (length(numFmts) > 0) {
      numFmtsIds <-
        sapply(numFmts, getAttr, tag = 'numFmtId="', USE.NAMES = FALSE)
      formatCodes <-
        sapply(numFmts, getAttr, tag = 'formatCode="', USE.NAMES = FALSE)
      numFmts <-
        lapply(seq_along(numFmts), function(i) {
          list("numFmtId" = numFmtsIds[[i]], "formatCode" = formatCodes[[i]])
        })
      numFmtFlag <- TRUE
    }

    ## fonts will maintain, sz, color, name, family scheme
    if (grepl("<font/>", stylesTxt, fixed = TRUE)) {
      ## empty font node
      fonts <- getNodes(xml = stylesTxt, tagIn = "<fonts")
      fonts <- strsplit(fonts, split = "<font/>", fixed = TRUE)[[1]]
      fonts <-
        unlist(lapply(fonts, function(xml) {
          c(getNodes(xml, tagIn = "<font>"), "")
        }))
    } else {
      fonts <- getNodes(xml = stylesTxt, tagIn = "<font>")
    }
    styles$fonts[[1]] <<- fonts[[1]]
    fonts <- buildFontList(fonts)


    fills <- getNodes(xml = stylesTxt, tagIn = "<fill>")
    fills <- buildFillList(fills)

    borders <- getOpenClosedNode(stylesTxt, "<borders ", "</borders>")
    borders <-
      substr(
        borders,
        start =  regexpr("<border>", borders)[1],
        stop = regexpr("</borders>", borders) - 1L
      )
    borders <- getNodes(xml = borders, tagIn = "<border")
    borders <- sapply(borders, buildBorder, USE.NAMES = FALSE)


    ## ------------------------------ build styleObjects ------------------------------ ##

    cellXfs <- getNodes(xml = stylesTxt, tagIn = "<cellXfs")

    xf <- getChildlessNode(xml = cellXfs, tag = "xf")
    xfAttrs <- regmatches(xf, gregexpr('[a-zA-Z]+=".*?"', xf))
    xfNames <-
      lapply(xfAttrs, function(xfAttrs) {
        regmatches(
          xfAttrs,
          regexpr('[a-zA-Z]+(?=\\=".*?")', xfAttrs, perl = TRUE)
        )
      })
    xfVals <-
      lapply(xfAttrs, function(xfAttrs) {
        regmatches(xfAttrs, regexpr('(?<=").*?(?=")', xfAttrs, perl = TRUE))
      })

    for (i in seq_along(xf)) {
      names(xfVals[[i]]) <- xfNames[[i]]
    }

    styleObjects_tmp <- list()
    flag <- FALSE
    for (s in xfVals) {
      style <- createStyle()
      if (any(s != "0")) {
        if ("fontId" %in% names(s)) {
          if (s[["fontId"]] != "0") {
            thisFont <- fonts[[(as.integer(s[["fontId"]]) + 1)]]

            if ("sz" %in% names(thisFont)) {
              style$fontSize <- thisFont$sz
            }

            if ("name" %in% names(thisFont)) {
              style$fontName <- thisFont$name
            }

            if ("family" %in% names(thisFont)) {
              style$fontFamily <- thisFont$family
            }

            if ("color" %in% names(thisFont)) {
              style$fontColour <- thisFont$color
            }

            if ("scheme" %in% names(thisFont)) {
              style$fontScheme <- thisFont$scheme
            }

            flags <-
              c("bold", "italic", "underline", "strikeout") %in% names(thisFont)
            if (any(flags)) {
              style$fontDecoration <- NULL
              if (flags[[1]]) {
                style$fontDecoration <-
                  append(style$fontDecoration, "BOLD")
              }

              if (flags[[2]]) {
                style$fontDecoration <-
                  append(style$fontDecoration, "ITALIC")
              }

              if (flags[[3]]) {
                style$fontDecoration <-
                  append(style$fontDecoration, "UNDERLINE")
              }

              if (flags[[4]]) {
                style$fontDecoration <-
                  append(style$fontDecoration, "STRIKEOUT")
              }
            }
          }
        }

        if ("numFmtId" %in% names(s)) {
          if (s[["numFmtId"]] != "0") {
            if (as.integer(s[["numFmtId"]]) < 164) {
              style$numFmt <- list(numFmtId = s[["numFmtId"]])
            } else if (numFmtFlag) {
              style$numFmt <- numFmts[[which(s[["numFmtId"]] == numFmtsIds)[1]]]
            }
          }
        }

        ## Border
        if ("borderId" %in% names(s)) {
          if (s[["borderId"]] != "0") {
            # & "applyBorder" %in% names(s)){

            border_ind <- as.integer(s[["borderId"]]) + 1L
            if (border_ind <= length(borders)) {
              thisBorder <- borders[[border_ind]]

              if ("borderLeft" %in% names(thisBorder)) {
                style$borderLeft <- thisBorder$borderLeft
                style$borderLeftColour <- thisBorder$borderLeftColour
              }

              if ("borderRight" %in% names(thisBorder)) {
                style$borderRight <- thisBorder$borderRight
                style$borderRightColour <-
                  thisBorder$borderRightColour
              }

              if ("borderTop" %in% names(thisBorder)) {
                style$borderTop <- thisBorder$borderTop
                style$borderTopColour <- thisBorder$borderTopColour
              }

              if ("borderBottom" %in% names(thisBorder)) {
                style$borderBottom <- thisBorder$borderBottom
                style$borderBottomColour <-
                  thisBorder$borderBottomColour
              }

              if ("borderDiagonal" %in% names(thisBorder)) {
                style$borderDiagonal <- thisBorder$borderDiagonal
                style$borderDiagonalColour <-
                  thisBorder$borderDiagonalColour
              }

              if ("borderDiagonalUp" %in% names(thisBorder)) {
                style$borderDiagonalUp <-
                  thisBorder$borderDiagonalUp
              }

              if ("borderDiagonalDown" %in% names(thisBorder)) {
                style$borderDiagonalDown <-
                  thisBorder$borderDiagonalDown
              }
            }
          }
        }

        ## alignment
        # applyAlignment <- "applyAlignment" %in% names(s)
        if ("horizontal" %in% names(s)) {
          # & applyAlignment)
          style$halign <- s[["horizontal"]]
        }

        if ("vertical" %in% names(s)) {
          style$valign <- s[["vertical"]]
        }

        if ("indent" %in% names(s)) {
          style$indent <- s[["indent"]]
        }

        if ("textRotation" %in% names(s)) {
          style$textRotation <- s[["textRotation"]]
        }

        ## wrap text
        if ("wrapText" %in% names(s)) {
          if (s[["wrapText"]] %in% c("1", "true")) {
            style$wrapText <- TRUE
          }
        }

        if ("fillId" %in% names(s)) {
          if (s[["fillId"]] != "0") {
            fillId <- as.integer(s[["fillId"]]) + 1L

            if ("fgColor" %in% names(fills[[fillId]])) {
              tmpFg <- fills[[fillId]]$fgColor
              tmpBg <- fills[[fillId]]$bgColor

              if (!is.null(tmpFg)) {
                style$fill$fillFg <- tmpFg
              }

              if (!is.null(tmpFg)) {
                style$fill$fillBg <- tmpBg
              }
            } else {
              style$fill <- fills[[fillId]]
            }
          }
        }


        if ("xfId" %in% names(s)) {
          if (s[["xfId"]] != "0") {
            style$xfId <- s[["xfId"]]
          }
        }
      } ## end if !all(s == "0")

      # Cell protection settings can be "0", so we cannot just skip all zeroes
      if ("locked" %in% names(s)) {
        style$locked <- (s[["locked"]] == "1")
      }

      if ("hidden" %in% names(s)) {
        style$hidden <- (s[["hidden"]] == "1")
      }

      ## we need to skip the first one as this is used as the base style
      if (flag) {
        styleObjects_tmp <- append(styleObjects_tmp, list(style))
      }

      flag <- TRUE
    } ## end of for loop through styles s in ...


    ## ------------------------------ build styleObjects Complete ------------------------------ ##


    return(styleObjects_tmp)
  }
)

Workbook$methods(
  protectWorkbook = function(protect = TRUE,
                             lockStructure = FALSE,
                             lockWindows = FALSE,
                             password = NULL,
                             type = NULL) {
    attr <- c()
    if (!is.null(password)) {
      attr["workbookPassword"] <- hashPassword(password)
    }
    if (!missing(lockStructure) && !is.null(lockStructure)) {
      attr["lockStructure"] <- toString(as.numeric(lockStructure))
    }
    if (!missing(lockWindows) && !is.null(lockWindows)) {
      attr["lockWindows"] <- toString(as.numeric(lockWindows))
    }
    # TODO: Shall we parse the existing protection settings and preserve all unchanged attributes?
    if (protect) {
      workbook$workbookProtection <<-
        sprintf(
          "<workbookProtection %s/>",
          stri_join(
            names(attr),
            '="',
            attr,
            '"',
            collapse = " ",
            sep = ""
          )
        )
      if (!is.null(type) | !is.null(password))
        workbook$apps <<- sprintf("<DocSecurity>%i</DocSecurity>", type)
    } else {
      workbook$workbookProtection <<- ""
    }
  }
)







Workbook$methods(
  addCreator = function(Creator = NULL) {
    if (!is.null(Creator)) {
      current_creator <-
        stri_match(core, regex = "<dc:creator>(.*?)</dc:creator>")[1, 2]
      core <<-
        stri_replace_all_fixed(
          core,
          pattern = current_creator,
          replacement = stri_c(current_creator, Creator, sep = ";")
        )
    }
  }
)





Workbook$methods(
  getCreators = function() {
    current_creator <-
      stri_match(core, regex = "<dc:creator>(.*?)</dc:creator>")[1, 2]

    current_creator_vec <- as.character(stri_split_fixed(
      str = current_creator,
      pattern = ";",
      simplify = TRUE
    ))

    return(current_creator_vec)
  }
)



Workbook$methods(
  changeLastModifiedBy = function(LastModifiedBy = NULL) {
    if (!is.null(LastModifiedBy)) {
      current_LastModifiedBy <-
        stri_match(core, regex = "<cp:lastModifiedBy>(.*?)</cp:lastModifiedBy>")[1, 2]
      core <<-
        stri_replace_all_fixed(
          core,
          pattern = current_LastModifiedBy,
          replacement = LastModifiedBy
        )
    }
  }
)



Workbook$methods(
  setactiveSheet = function(activeSheet = NULL) {
    if (is.character(activeSheet)) {
      if (activeSheet %in% sheet_names) {
        ActiveSheet <<- which(sheet_names[sheetOrder] == activeSheet)
      } else {
        stop(paste(activeSheet, "doesn't exist as sheet name."))
      }
    }

    if (is.integer(activeSheet)|is.numeric(activeSheet)) {
      if (activeSheet %in% seq_along(sheet_names)) {
        ActiveSheet <<- which(sheetOrder==activeSheet)
      }else {
        stop(paste(activeSheet, "doesn't exist as sheet index."))
      }
    }

    for(i in seq_along(sheet_names)){
      worksheets[[i]]$sheetViews <<- stri_replace_all_regex(worksheets[[i]]$sheetViews,
                           "tabSelected=\"(1|true|false|0)\"",
                           paste0("tabSelected=\"",
                                  ifelse(sheetOrder[ActiveSheet]  == i,"true","false")
                                  ,"\""))


    }



  }
)
