
#' @name createWorkbook
#' @title Create a new Workbook object
#' @description Create a new Workbook object
#' @param creator Creator of the workbook (your name). Defaults to login username
#' @param title Workbook properties title
#' @param subject Workbook properties subject
#' @param category Workbook properties category
#' @author Alexander Walker
#' @return Workbook object
#' @export
#' @seealso \code{\link{loadWorkbook}}
#' @seealso \code{\link{saveWorkbook}}
#' @import methods
#' @examples
#' ## Create a new workbook
#' wb <- createWorkbook()
#'
#' ## Save workbook to working directory
#' \dontrun{
#' saveWorkbook(wb, file = "createWorkbookExample.xlsx", overwrite = TRUE)
#' }
#'
#' ## Set Workbook properties
#' wb <- createWorkbook(
#'   creator = "Me",
#'   title = "title here",
#'   subject = "this & that",
#'   category = "something"
#' )
createWorkbook <- function(creator = ifelse(.Platform$OS.type == "windows", Sys.getenv("USERNAME"), Sys.getenv("USER")),
                           title = NULL,
                           subject = NULL,
                           category = NULL) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  ## check all inputs are valid
  if (length(creator) > 1) creator <- creator[[1]]
  if (length(creator) == 0) creator <- ""
  if (!"character" %in% class(creator)) creator <- ""
  
  if (length(title) > 1) title <- title[[1]]
  if (length(subject) > 1) subject <- subject[[1]]
  if (length(category) > 1) category <- category[[1]]
  
  if (!is.null(title)) {
    if (!"character" %in% class(title)) {
      stop("title must be a string")
    }
  }
  
  if (!is.null(subject)) {
    if (!"character" %in% class(subject)) {
      stop("subject must be a string")
    }
  }
  
  if (!is.null(category)) {
    if (!"character" %in% class(category)) {
      stop("category must be a string")
    }
  }
  
  invisible(Workbook$new(creator = creator, title = title, subject = subject, category = category))
}


#' @name saveWorkbook
#' @title save Workbook to file
#' @description save a Workbook object to file
#' @author Alexander Walker, Philipp Schauberger
#' @param wb A Workbook object to write to file
#' @param file A character string naming an xlsx file
#' @param overwrite If \code{TRUE}, overwrite any existing file.
#' @param returnValue  If \code{TRUE}, returns  \code{TRUE} in case of a success, else \code{FALSE}. 
#' If flag is \code{FALSE}, then no return value is returned.
#' @seealso \code{\link{createWorkbook}}
#' @seealso \code{\link{addWorksheet}}
#' @seealso \code{\link{loadWorkbook}}
#' @seealso \code{\link{writeData}}
#' @seealso \code{\link{writeDataTable}}
#' @export
#' @examples
#' ## Create a new workbook and add a worksheet
#' wb <- createWorkbook("Creator of workbook")
#' addWorksheet(wb, sheetName = "My first worksheet")
#'
#' ## Save workbook to working directory
#' \dontrun{
#' saveWorkbook(wb, file = "saveWorkbookExample.xlsx", overwrite = TRUE)
#' }
saveWorkbook <- function(wb, file, overwrite = FALSE, returnValue = FALSE) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  ## increase scipen to avoid writing in scientific
  sci_pen <- getOption("scipen")
  options("scipen" = 10000)
  on.exit(options("scipen" = sci_pen), add = TRUE)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  if (!is.logical(overwrite)) {
    overwrite <- FALSE
  }
  
  if (!is.logical(returnValue)) {
    returnValue <- FALSE
  }
  
  if (file.exists(file) & !overwrite) {
    stop("File already exists!")
  }
  
  xlsx_file <- wb$saveWorkbook()
  
  result<-tryCatch(file.copy(from = xlsx_file, to = file, overwrite = overwrite),
                   error = function(e) e, warning = function(w) w)
  
  
  
  
  ## delete temporary dir
  unlink(dirname(xlsx_file), force = TRUE, recursive = TRUE)
  if(returnValue == FALSE){
    invisible(1)
  }else{
    return(result)
  }
  
}


#' @name mergeCells
#' @title Merge cells within a worksheet
#' @description Merge cells within a worksheet
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param cols Columns to merge
#' @param rows corresponding rows to merge
#' @details As merged region must be rectangular, only min and max of cols and rows are used.
#' @author Alexander Walker
#' @seealso \code{\link{removeCellMerge}}
#' @export
#' @examples
#' ## Create a new workbook
#' wb <- createWorkbook()
#'
#' ## Add a worksheet
#' addWorksheet(wb, "Sheet 1")
#' addWorksheet(wb, "Sheet 2")
#'
#' ## Merge cells: Row 2 column C to F (3:6)
#' mergeCells(wb, "Sheet 1", cols = 2, rows = 3:6)
#'
#' ## Merge cells:Rows 10 to 20 columns A to J (1:10)
#' mergeCells(wb, 1, cols = 1:10, rows = 10:20)
#'
#' ## Intersecting merges
#' mergeCells(wb, 2, cols = 1:10, rows = 1)
#' mergeCells(wb, 2, cols = 5:10, rows = 2)
#' mergeCells(wb, 2, cols = c(1, 10), rows = 12) ## equivalent to 1:10 as only min/max are used
#' # mergeCells(wb, 2, cols = 1, rows = c(1,10)) # Throws error because intersects existing merge
#'
#' ## remove merged cells
#' removeCellMerge(wb, 2, cols = 1, rows = 1) # removes any intersecting merges
#' mergeCells(wb, 2, cols = 1, rows = 1:10) # Now this works
#'
#' ## Save workbook
#' \dontrun{
#' saveWorkbook(wb, "mergeCellsExample.xlsx", overwrite = TRUE)
#' }
mergeCells <- function(wb, sheet, cols, rows) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  if (!is.numeric(cols)) {
    cols <- convertFromExcelRef(cols)
  }
  
  wb$mergeCells(sheet, startRow = min(rows), endRow = max(rows), startCol = min(cols), endCol = max(cols))
}



#' @name int2col
#' @title Convert integer to Excel column
#' @description Converts an integer to an Excel column label.
#' @param x A numeric vector
#' @export
#' @examples
#' int2col(1:10)
int2col <- function(x) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (!is.numeric(x)) {
    stop("x must be numeric.")
  }
  
  convert_to_excel_ref(cols = x, LETTERS = LETTERS)
}


#' @name removeCellMerge
#' @title Create a new Workbook object
#' @description Unmerges any merged cells that intersect
#' with the region specified by, min(cols):max(cols) X min(rows):max(rows)
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param cols vector of column indices
#' @param rows vector of row indices
#' @author Alexander Walker
#' @export
#' @seealso \code{\link{mergeCells}}
removeCellMerge <- function(wb, sheet, cols, rows) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  cols <- convertFromExcelRef(cols)
  rows <- as.integer(rows)
  
  wb$removeCellMerge(sheet, startRow = min(rows), endRow = max(rows), startCol = min(cols), endCol = max(cols))
}


#' @name sheets
#' @title Returns names of worksheets.
#' @description DEPRECATED. Use names().
#' @param wb A workbook object
#' @return Name of worksheet(s) for a given index
#' @author Alexander Walker
#' @seealso \code{\link{names}} to rename a worksheet in a Workbook
#' @details DEPRECATED. Use \code{\link{names}}
#' @export
#' @examples
#'
#' ## Create a new workbook
#' wb <- createWorkbook()
#'
#' ## Add some worksheets
#' addWorksheet(wb, "Worksheet Name")
#' addWorksheet(wb, "This is worksheet 2")
#' addWorksheet(wb, "The third worksheet")
#'
#' ## Return names of sheets, can not be used for assignment.
#' names(wb)
#' # openXL(wb)
#'
#' names(wb) <- c("A", "B", "C")
#' names(wb)
#' # openXL(wb)
sheets <- function(wb) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  nms <- wb$sheet_names
  nms <- replaceXMLEntities(nms)
  
  return(nms)
}



#' @name addWorksheet
#' @title Add a worksheet to a workbook
#' @description Add a worksheet to a Workbook object
#' @author Alexander Walker
#' @param wb A Workbook object to attach the new worksheet
#' @param sheetName A name for the new worksheet
#' @param gridLines A logical. If \code{FALSE}, the worksheet grid lines will be hidden.
#' @param tabColour Colour of the worksheet tab. A valid colour (belonging to colours()) or a valid hex colour beginning with "#"
#' @param zoom A numeric between 10 and 400. Worksheet zoom level as a percentage.
#' @param header document header. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.
#' @param footer document footer. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.
#' @param evenHeader document header for even pages.
#' @param evenFooter document footer for even pages.
#' @param firstHeader document header for first page only.
#' @param firstFooter document footer for first page only.
#' @param visible If FALSE, sheet is hidden else visible.
#' @param paperSize An integer corresponding to a paper size. See ?pageSetup for details.
#' @param orientation One of "portrait" or "landscape"
#' @param hdpi Horizontal DPI. Can be set with options("openxlsx.dpi" = X) or options("openxlsx.hdpi" = X)
#' @param vdpi Vertical DPI. Can be set with options("openxlsx.dpi" = X) or options("openxlsx.vdpi" = X)
#' @details Headers and footers can contain special tags
#' \itemize{
#'   \item{\bold{&[Page]}}{ Page number}
#'   \item{\bold{&[Pages]}}{ Number of pages}
#'   \item{\bold{&[Date]}}{ Current date}
#'   \item{\bold{&[Time]}}{ Current time}
#'   \item{\bold{&[Path]}}{ File path}
#'   \item{\bold{&[File]}}{ File name}
#'   \item{\bold{&[Tab]}}{ Worksheet name}
#' }
#' @return XML tree
#' @export
#' @examples
#' ## Create a new workbook
#' wb <- createWorkbook("Fred")
#'
#' ## Add 3 worksheets
#' addWorksheet(wb, "Sheet 1")
#' addWorksheet(wb, "Sheet 2", gridLines = FALSE)
#' addWorksheet(wb, "Sheet 3", tabColour = "red")
#' addWorksheet(wb, "Sheet 4", gridLines = FALSE, tabColour = "#4F81BD")
#'
#' ## Headers and Footers
#' addWorksheet(wb, "Sheet 5",
#'   header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"),
#'   footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"),
#'   evenHeader = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"),
#'   evenFooter = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"),
#'   firstHeader = c("TOP", "OF FIRST", "PAGE"),
#'   firstFooter = c("BOTTOM", "OF FIRST", "PAGE")
#' )
#'
#' addWorksheet(wb, "Sheet 6",
#'   header = c("&[Date]", "ALL HEAD CENTER 2", "&[Page] / &[Pages]"),
#'   footer = c("&[Path]&[File]", NA, "&[Tab]"),
#'   firstHeader = c(NA, "Center Header of First Page", NA),
#'   firstFooter = c(NA, "Center Footer of First Page", NA)
#' )
#'
#' addWorksheet(wb, "Sheet 7",
#'   header = c("ALL HEAD LEFT 2", "ALL HEAD CENTER 2", "ALL HEAD RIGHT 2"),
#'   footer = c("ALL FOOT RIGHT 2", "ALL FOOT CENTER 2", "ALL FOOT RIGHT 2")
#' )
#'
#' addWorksheet(wb, "Sheet 8",
#'   firstHeader = c("FIRST ONLY L", NA, "FIRST ONLY R"),
#'   firstFooter = c("FIRST ONLY L", NA, "FIRST ONLY R")
#' )
#'
#' ## Need data on worksheet to see all headers and footers
#' writeData(wb, sheet = 5, 1:400)
#' writeData(wb, sheet = 6, 1:400)
#' writeData(wb, sheet = 7, 1:400)
#' writeData(wb, sheet = 8, 1:400)
#'
#' ## Save workbook
#' \dontrun{
#' saveWorkbook(wb, "addWorksheetExample.xlsx", overwrite = TRUE)
#' }
addWorksheet <- function(wb, sheetName,
                         gridLines = TRUE,
                         tabColour = NULL,
                         zoom = 100,
                         header = NULL,
                         footer = NULL,
                         evenHeader = NULL,
                         evenFooter = NULL,
                         firstHeader = NULL,
                         firstFooter = NULL,
                         visible = TRUE,
                         paperSize = getOption("openxlsx.paperSize", default = 9),
                         orientation = getOption("openxlsx.orientation", default = "portrait"),
                         vdpi = getOption("openxlsx.vdpi", default = getOption("openxlsx.dpi", default = 300)),
                         hdpi = getOption("openxlsx.hdpi", default = getOption("openxlsx.dpi", default = 300))) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  if (tolower(sheetName) %in% tolower(wb$sheet_names)) {
    stop(paste0("A worksheet by the name '", sheetName, "' already exists! Sheet names must be unique case-insensitive."))
  }
  
  if (!is.logical(gridLines) | length(gridLines) > 1) {
    stop("gridLines must be a logical of length 1.")
  }
  
  if (nchar(sheetName) > 31) {
    stop(paste0("sheetName '", sheetName, "' too long! Max length is 31 characters."))
  }
  
  if (!is.null(tabColour)) {
    tabColour <- validateColour(tabColour, "Invalid tabColour in addWorksheet.")
  }
  
  if (!is.numeric(zoom)) {
    stop("zoom must be numeric")
  }
  
  if (!is.character(sheetName)) {
    sheetName <- as.character(sheetName)
  }
  
  if (!is.null(header) & length(header) != 3) {
    stop("header must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  if (!is.null(footer) & length(footer) != 3) {
    stop("footer must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  if (!is.null(evenHeader) & length(evenHeader) != 3) {
    stop("evenHeader must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  if (!is.null(evenFooter) & length(evenFooter) != 3) {
    stop("evenFooter must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  if (!is.null(firstHeader) & length(firstHeader) != 3) {
    stop("firstHeader must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  if (!is.null(firstFooter) & length(firstFooter) != 3) {
    stop("firstFooter must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  visible <- tolower(visible[1])
  if (!visible %in% c("true", "false", "hidden", "visible", "veryhidden")) {
    stop("visible must be one of: TRUE, FALSE, 'hidden', 'visible', 'veryHidden'")
  }
  
  orientation <- tolower(orientation)
  if (!orientation %in% c("portrait", "landscape")) {
    stop("orientation must be 'portrait' or 'landscape'.")
  }
  
  vdpi <- as.integer(vdpi)
  if (is.na(vdpi)) {
    stop("vdpi must be numeric")
  }
  
  hdpi <- as.integer(hdpi)
  if (is.na(hdpi)) {
    stop("hdpi must be numeric")
  }
  
  
  
  ## Invalid XML characters
  sheetName <- replaceIllegalCharacters(sheetName)
  
  invisible(wb$addWorksheet(
    sheetName = sheetName,
    showGridLines = gridLines,
    tabColour = tabColour,
    zoom = zoom[1],
    oddHeader = headerFooterSub(header),
    oddFooter = headerFooterSub(footer),
    evenHeader = headerFooterSub(evenHeader),
    evenFooter = headerFooterSub(evenFooter),
    firstHeader = headerFooterSub(firstHeader),
    firstFooter = headerFooterSub(firstFooter),
    visible = visible,
    paperSize = paperSize,
    orientation = orientation,
    vdpi = vdpi,
    hdpi = hdpi
  ))
}

#' @name cloneWorksheet
#' @title Clone a worksheet to a workbook
#' @description Clone a worksheet to a Workbook object
#' @author Reinhold Kainhofer
#' @param wb A Workbook object to attach the new worksheet
#' @param sheetName A name for the new worksheet
#' @param clonedSheet The name of the existing worksheet to be cloned.
#' @return XML tree
#' @export
#' @examples
#' ## Create a new workbook
#' wb <- createWorkbook("Fred")
#'
#' ## Add 3 worksheets
#' addWorksheet(wb, "Sheet 1")
#' cloneWorksheet(wb, "Sheet 2", clonedSheet = "Sheet 1")
#'
#' ## Save workbook
#' \dontrun{
#' saveWorkbook(wb, "cloneWorksheetExample.xlsx", overwrite = TRUE)
#' }
cloneWorksheet <- function(wb, sheetName, clonedSheet) {
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  if (tolower(sheetName) %in% tolower(wb$sheet_names)) {
    stop("A worksheet by that name already exists! Sheet names must be unique case-insensitive.")
  }
  
  if (nchar(sheetName) > 31) {
    stop("sheetName too long! Max length is 31 characters.")
  }
  
  if (!is.character(sheetName)) {
    sheetName <- as.character(sheetName)
  }
  
  ## Invalid XML characters
  sheetName <- replaceIllegalCharacters(sheetName)
  
  invisible(wb$cloneWorksheet(sheetName = sheetName, clonedSheet = clonedSheet))
}


#' @name renameWorksheet
#' @title Rename a worksheet
#' @description Rename a worksheet
#' @author Alexander Walker
#' @param wb A Workbook object containing a worksheet
#' @param sheet The name or index of the worksheet to rename
#' @param newName The new name of the worksheet. No longer than 31 chars.
#' @details DEPRECATED. Use \code{\link{names}}
#' @export
#' @examples
#'
#' ## Create a new workbook
#' wb <- createWorkbook("CREATOR")
#'
#' ## Add 3 worksheets
#' addWorksheet(wb, "Worksheet Name")
#' addWorksheet(wb, "This is worksheet 2")
#' addWorksheet(wb, "Not the best name")
#'
#' #' ## rename all worksheets
#' names(wb) <- c("A", "B", "C")
#'
#'
#' ## Rename worksheet 1 & 3
#' renameWorksheet(wb, 1, "New name for sheet 1")
#' names(wb)[[1]] <- "New name for sheet 1"
#' names(wb)[[3]] <- "A better name"
#'
#' ## Save workbook
#' \dontrun{
#' saveWorkbook(wb, "renameWorksheetExample.xlsx", overwrite = TRUE)
#' }
renameWorksheet <- function(wb, sheet, newName) {
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  invisible(wb$setSheetName(sheet, newName))
}


#' @name convertFromExcelRef
#' @title Convert excel column name to integer index
#' @description Convert excel column name to integer index e.g. "J" to 10
#' @param col An excel column reference
#' @export
#' @examples
#' convertFromExcelRef("DOG")
#' convertFromExcelRef("COW")
#'
#' ## numbers will be removed
#' convertFromExcelRef("R22")
convertFromExcelRef <- function(col) {
  
  ## increase scipen to avoid writing in scientific
  exSciPen <- getOption("scipen")
  od <- getOption("OutDec")
  options("scipen" = 10000)
  options("OutDec" = ".")
  
  on.exit(options("scipen" = exSciPen), add = TRUE)
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  col <- toupper(col)
  charFlag <- grepl("[A-Z]", col)
  if (any(charFlag)) {
    col[charFlag] <- gsub("[0-9]", "", col[charFlag])
    d <- lapply(strsplit(col[charFlag], split = ""), function(x) match(rev(x), LETTERS))
    col[charFlag] <- unlist(lapply(1:length(d), function(i) sum(d[[i]] * (26^(0:(length(d[[i]]) - 1L))))))
  }
  
  col[!charFlag] <- as.integer(col[!charFlag])
  
  return(as.integer(col))
}



#' @name createStyle
#' @title Create a cell style
#' @description Create a new style to apply to worksheet cells
#' @author Alexander Walker
#' @seealso \code{\link{addStyle}}
#' @param fontName A name of a font. Note the font name is not validated. If fontName is NULL,
#' the workbook base font is used. (Defaults to Calibri)
#' @param fontColour Colour of text in cell.  A valid hex colour beginning with "#"
#' or one of colours(). If fontColour is NULL, the workbook base font colours is used.
#' (Defaults to black)
#' @param fontSize Font size. A numeric greater than 0.
#' If fontSize is NULL, the workbook base font size is used. (Defaults to 11)
#' @param numFmt Cell formatting
#' \itemize{
#'   \item{\bold{GENERAL}}
#'   \item{\bold{NUMBER}}
#'   \item{\bold{CURRENCY}}
#'   \item{\bold{ACCOUNTING}}
#'   \item{\bold{DATE}}
#'   \item{\bold{LONGDATE}}
#'   \item{\bold{TIME}}
#'   \item{\bold{PERCENTAGE}}
#'   \item{\bold{FRACTION}}
#'   \item{\bold{SCIENTIFIC}}
#'   \item{\bold{TEXT}}
#'   \item{\bold{COMMA}{  for comma separated thousands}}
#'   \item{For date/datetime styling a combination of d, m, y and punctuation marks}
#'   \item{For numeric rounding use "0.00" with the preferred number of decimal places}
#' }
#'
#' @param border Cell border. A vector of "top", "bottom", "left", "right" or a single string).
#' \itemize{
#'    \item{\bold{"top"}}{ Top border}
#'    \item{\bold{bottom}}{ Bottom border}
#'    \item{\bold{left}}{ Left border}
#'    \item{\bold{right}}{ Right border}
#'    \item{\bold{TopBottom} or \bold{c("top", "bottom")}}{ Top and bottom border}
#'    \item{\bold{LeftRight} or \bold{c("left", "right")}}{ Left and right border}
#'    \item{\bold{TopLeftRight} or \bold{c("top", "left", "right")}}{ Top, Left and right border}
#'    \item{\bold{TopBottomLeftRight} or \bold{c("top", "bottom", "left", "right")}}{ All borders}
#'   }
#'
#' @param borderColour Colour of cell border vector the same length as the number of sides specified in "border"
#' A valid colour (belonging to colours()) or a valid hex colour beginning with "#"
#'
#' @param borderStyle Border line style vector the same length as the number of sides specified in "border"
#' \itemize{
#'    \item{\bold{none}}{ No Border}
#'    \item{\bold{thin}}{ thin border}
#'    \item{\bold{medium}}{ medium border}
#'    \item{\bold{dashed}}{ dashed border}
#'    \item{\bold{dotted}}{ dotted border}
#'    \item{\bold{thick}}{ thick border}
#'    \item{\bold{double}}{ double line border}
#'    \item{\bold{hair}}{ Hairline border}
#'    \item{\bold{mediumDashed}}{ medium weight dashed border}
#'    \item{\bold{dashDot}}{ dash-dot border}
#'    \item{\bold{mediumDashDot}}{ medium weight dash-dot border}
#'    \item{\bold{dashDotDot}}{ dash-dot-dot border}
#'    \item{\bold{mediumDashDotDot}}{ medium weight dash-dot-dot border}
#'    \item{\bold{slantDashDot}}{ slanted dash-dot border}
#'   }
#'
#' @param bgFill Cell background fill colour.
#' A valid colour (belonging to colours()) or a valid hex colour beginning with "#".
#' --  \bold{Use for conditional formatting styles only.}
#' @param fgFill Cell foreground fill colour.
#' A valid colour (belonging to colours()) or a valid hex colour beginning with "#"
#'
#' @param halign
#' Horizontal alignment of cell contents
#' \itemize{
#'    \item{\bold{left}}{ Left horizontal align cell contents}
#'    \item{\bold{right}}{ Right horizontal align cell contents}
#'    \item{\bold{center}}{ Center horizontal align cell contents}
#'   }
#'
#' @param valign A name
#' Vertical alignment of cell contents
#' \itemize{
#'    \item{\bold{top}}{ Top vertical align cell contents}
#'    \item{\bold{center}}{ Center vertical align cell contents}
#'    \item{\bold{bottom}}{ Bottom vertical align cell contents}
#'   }
#'
#' @param textDecoration
#' Text styling.
#' \itemize{
#'    \item{\bold{bold}}{ Bold cell contents}
#'    \item{\bold{strikeout}}{ Strikeout cell contents}
#'    \item{\bold{italic}}{ Italicise cell contents}
#'    \item{\bold{underline}}{ Underline cell contents}
#'    \item{\bold{underline2}}{ Double underline cell contents}
#'   }
#'
#' @param wrapText Logical. If \code{TRUE} cell contents will wrap to fit in column.
#' @param textRotation Rotation of text in degrees. 255 for vertical text.
#' @param indent Horizontal indentation of cell contents.
#' @param hidden Whether the formula of the cell contents will be hidden (if worksheet protection is turned on)
#' @param locked Whether cell contents are locked (if worksheet protection is turned on)
#' @return A style object
#' @export
#' @examples
#' ## See package vignettes for further examples
#'
#' ## Modify default values of border colour and border line style
#' options("openxlsx.borderColour" = "#4F80BD")
#' options("openxlsx.borderStyle" = "thin")
#'
#' ## Size 18 Arial, Bold, left horz. aligned, fill colour #1A33CC, all borders,
#' style <- createStyle(
#'   fontSize = 18, fontName = "Arial",
#'   textDecoration = "bold", halign = "left", fgFill = "#1A33CC", border = "TopBottomLeftRight"
#' )
#'
#' ## Red, size 24, Bold, italic, underline, center aligned Font, bottom border
#' style <- createStyle(
#'   fontSize = 24, fontColour = rgb(1, 0, 0),
#'   textDecoration = c("bold", "italic", "underline"),
#'   halign = "center", valign = "center", border = "Bottom"
#' )
#'
#' # borderColour is recycled for each border or all colours can be supplied
#'
#' # colour is recycled 3 times for "Top", "Bottom" & "Right" sides.
#' createStyle(border = "TopBottomRight", borderColour = "red")
#'
#' # supply all colours
#' createStyle(border = "TopBottomLeft", borderColour = c("red", "yellow", "green"))
createStyle <- function(fontName = NULL,
                        fontSize = NULL,
                        fontColour = NULL,
                        numFmt = "GENERAL",
                        border = NULL,
                        borderColour = getOption("openxlsx.borderColour", "black"),
                        borderStyle = getOption("openxlsx.borderStyle", "thin"),
                        bgFill = NULL, fgFill = NULL,
                        halign = NULL, valign = NULL,
                        textDecoration = NULL, wrapText = FALSE,
                        textRotation = NULL,
                        indent = NULL,
                        locked = NULL, hidden = NULL) {
  
  ### Error checking
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  ## if num fmt is made up of dd, mm, yy
  numFmt_original <- numFmt[[1]]
  numFmt <- tolower(numFmt_original)
  validNumFmt <- c("general", "number", "currency", "accounting", "date", "longdate", "time", "percentage", "scientific", "text", "3", "4", "comma")
  
  if (numFmt == "date") {
    numFmt <- getOption("openxlsx.dateFormat", getOption("openxlsx.dateformat", "date"))
  } else if (numFmt == "longdate") {
    numFmt <- getOption("openxlsx.datetimeFormat", getOption("openxlsx.datetimeformat", getOption("openxlsx.dateTimeFormat", "longdate")))
  } else if (!numFmt %in% validNumFmt) {
    numFmt <- replaceIllegalCharacters(numFmt_original)
  }
  
  
  
  
  numFmtMapping <- list(
    list("numFmtId" = 0), # GENERAL
    list("numFmtId" = 2), # NUMBER
    list("numFmtId" = 164, formatCode = "&quot;$&quot;#,##0.00"), ## CURRENCY
    list("numFmtId" = 44), # ACCOUNTING
    list("numFmtId" = 14), # DATE
    list("numFmtId" = 166, formatCode = "yyyy/mm/dd hh:mm:ss"), # LONGDATE
    list("numFmtId" = 167), # TIME
    list("numFmtId" = 10), # PERCENTAGE
    list("numFmtId" = 11), # SCIENTIFIC
    list("numFmtId" = 49), # TEXT
    
    list("numFmtId" = 3),
    list("numFmtId" = 4),
    list("numFmtId" = 3)
  )
  
  names(numFmtMapping) <- validNumFmt
  
  ## Validate border line style
  if (!is.null(borderStyle)) {
    borderStyle <- validateBorderStyle(borderStyle)
  }
  
  if (!is.null(halign)) {
    halign <- tolower(halign[[1]])
    if (!halign %in% c("left", "right", "center")) {
      stop("Invalid halign argument!")
    }
  }
  
  if (!is.null(valign)) {
    valign <- tolower(valign[[1]])
    if (!valign %in% c("top", "bottom", "center")) {
      stop("Invalid valign argument!")
    }
  }
  
  if (!is.logical(wrapText)) {
    stop("Invalid wrapText")
  }
  
  if (!is.null(indent)) {
    if (!is.numeric(indent) & !is.integer(indent)) {
      stop("indent must be numeric")
    }
  }
  
  textDecoration <- tolower(textDecoration)
  if (!is.null(textDecoration)) {
    if (!all(textDecoration %in% c("bold", "strikeout", "italic", "underline", "underline2", ""))) {
      stop("Invalid textDecoration!")
    }
  }
  
  borderColour <- validateColour(borderColour, "Invalid border colour!")
  
  if (!is.null(fontColour)) {
    fontColour <- validateColour(fontColour, "Invalid font colour!")
  }
  
  if (!is.null(fontSize)) {
    if (fontSize < 1) stop("Font size must be greater than 0!")
  }
  
  if (!is.null(locked)) {
    if (!is.logical(locked)) stop("Cell attribute locked must be TRUE or FALSE")
  }
  if (!is.null(hidden)) {
    if (!is.logical(hidden)) stop("Cell attribute hidden must be TRUE or FALSE")
  }
  
  
  
  
  
  ######################### error checking complete #############################
  style <- Style$new()
  
  if (!is.null(fontName)) {
    style$fontName <- list("val" = fontName)
  }
  
  if (!is.null(fontSize)) {
    style$fontSize <- list("val" = fontSize)
  }
  
  if (!is.null(fontColour)) {
    style$fontColour <- list("rgb" = fontColour)
  }
  
  style$fontDecoration <- toupper(textDecoration)
  
  ## background fill
  if (is.null(bgFill)) {
    bgFillList <- NULL
  } else {
    bgFill <- validateColour(bgFill, "Invalid bgFill colour")
    style$fill <- append(style$fill, list(fillBg = list("rgb" = bgFill)))
  }
  
  ## foreground fill
  if (is.null(fgFill)) {
    fgFillList <- NULL
  } else {
    fgFill <- validateColour(fgFill, "Invalid fgFill colour")
    style$fill <- append(style$fill, list(fillFg = list(rgb = fgFill)))
  }
  
  
  ## border
  if (!is.null(border)) {
    border <- toupper(border)
    border <- paste(border, collapse = "")
    
    ## find position of each side in string
    sides <- c("LEFT", "RIGHT", "TOP", "BOTTOM")
    pos <- sapply(sides, function(x) regexpr(x, border))
    pos <- pos[order(pos, decreasing = FALSE)]
    nSides <- sum(pos > 0)
    
    borderColour <- rep(borderColour, length.out = nSides)
    borderStyle <- rep(borderStyle, length.out = nSides)
    
    pos <- pos[pos > 0]
    
    if (length(pos) == 0) {
      stop("Unknown border argument")
    }
    
    names(borderColour) <- names(pos)
    names(borderStyle) <- names(pos)
    
    if ("LEFT" %in% names(pos)) {
      style$borderLeft <- borderStyle[["LEFT"]]
      style$borderLeftColour <- list("rgb" = borderColour[["LEFT"]])
    }
    
    if ("RIGHT" %in% names(pos)) {
      style$borderRight <- borderStyle[["RIGHT"]]
      style$borderRightColour <- list("rgb" = borderColour[["RIGHT"]])
    }
    
    if ("TOP" %in% names(pos)) {
      style$borderTop <- borderStyle[["TOP"]]
      style$borderTopColour <- list("rgb" = borderColour[["TOP"]])
    }
    
    if ("BOTTOM" %in% names(pos)) {
      style$borderBottom <- borderStyle[["BOTTOM"]]
      style$borderBottomColour <- list("rgb" = borderColour[["BOTTOM"]])
    }
  }
  
  ## other fields
  if (!is.null(halign)) {
    style$halign <- halign
  }
  
  if (!is.null(valign)) {
    style$valign <- valign
  }
  
  if (!is.null(indent)) {
    style$indent <- indent
  }
  
  if (wrapText) {
    style$wrapText <- TRUE
  }
  
  if (!is.null(textRotation)) {
    if (!is.numeric(textRotation)) {
      stop("textRotation must be numeric.")
    }
    
    if (textRotation < 0 & textRotation >= -90) {
      textRotation <- (textRotation * -1) + 90
    }
    
    style$textRotation <- round(textRotation[[1]], 0)
  }
  
  if (numFmt != "general") {
    if (numFmt %in% validNumFmt) {
      style$numFmt <- numFmtMapping[[numFmt[[1]]]]
    } else {
      style$numFmt <- list("numFmtId" = 165, formatCode = numFmt) ## Custom numFmt
    }
  }
  
  
  if (!is.null(locked)) {
    style$locked <- locked
  }
  
  if (!is.null(hidden)) {
    style$hidden <- hidden
  }
  
  return(style)
}



#' @name addStyle
#' @title Add a style to a set of cells
#' @description Function adds a style to a specified set of cells.
#' @author Alexander Walker
#' @param wb A Workbook object containing a worksheet.
#' @param sheet A worksheet to apply the style to.
#' @param style A style object returned from createStyle()
#' @param rows Rows to apply style to.
#' @param cols columns to apply style to.
#' @param gridExpand If \code{TRUE}, style will be applied to all combinations of rows and cols.
#' @param stack If \code{TRUE} the new style is merged with any existing cell styles.  If FALSE, any
#' existing style is replaced by the new style.
#' @seealso \code{\link{createStyle}}
#' @seealso expand.grid
#' @export
#' @examples
#' ## See package vignette for more examples.
#'
#' ## Create a new workbook
#' wb <- createWorkbook("My name here")
#'
#' ## Add a worksheets
#' addWorksheet(wb, "Expenditure", gridLines = FALSE)
#'
#' ## write data to worksheet 1
#' writeData(wb, sheet = 1, USPersonalExpenditure, rowNames = TRUE)
#'
#' ## create and add a style to the column headers
#' headerStyle <- createStyle(
#'   fontSize = 14, fontColour = "#FFFFFF", halign = "center",
#'   fgFill = "#4F81BD", border = "TopBottom", borderColour = "#4F81BD"
#' )
#'
#' addStyle(wb, sheet = 1, headerStyle, rows = 1, cols = 1:6, gridExpand = TRUE)
#'
#' ## style for body
#' bodyStyle <- createStyle(border = "TopBottom", borderColour = "#4F81BD")
#' addStyle(wb, sheet = 1, bodyStyle, rows = 2:6, cols = 1:6, gridExpand = TRUE)
#' setColWidths(wb, 1, cols = 1, widths = 21) ## set column width for row names column
#' \dontrun{
#' saveWorkbook(wb, "addStyleExample.xlsx", overwrite = TRUE)
#' }
addStyle <- function(wb, sheet, style, rows, cols, gridExpand = FALSE, stack = FALSE) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  
  
  
  if (!is.null(style$numFmt) & length(wb$styleObjects) > 0) {
    if (style$numFmt$numFmtId == 165) {
      maxnumFmtId <- max(c(sapply(wb$styleObjects, function(i) {
        as.integer(
          max(c(i$style$numFmt$numFmtId, 0))
        )
      }), 165))
      style$numFmt$numFmtId <- maxnumFmtId + 1
    }
  }
  sheet <- wb$validateSheet(sheet)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  if (!"Style" %in% class(style)) {
    stop("style argument must be a Style object.")
  }
  
  if (!is.logical(stack)) {
    stop("stack parameter must be a logical!")
  }
  
  if (length(cols) == 0 | length(rows) == 0) {
    return(invisible(0))
  }
  
  cols <- convertFromExcelRef(cols)
  rows <- as.integer(rows)
  
  ## rows and cols need to be the same length
  if (gridExpand) {
    n <- length(cols)
    cols <- rep.int(cols, times = length(rows))
    rows <- rep(rows, each = n)
  } else if (length(rows) == 1 & length(cols) > 1) {
    rows <- rep.int(rows, times = length(cols))
  } else if (length(cols) == 1 & length(rows) > 1) {
    cols <- rep.int(cols, times = length(rows))
  } else if (length(rows) != length(cols)) {
    stop("Length of rows and cols must be equal.")
  }
  
  
  wb$addStyle(sheet = sheet, style = style, rows = rows, cols = cols, stack = stack)
}


#' @name getCellRefs
#' @title Return excel cell coordinates from (x,y) coordinates
#' @description Return excel cell coordinates from (x,y) coordinates
#' @author Philipp Schauberger, Alexander Walker
#' @param cellCoords A data.frame with two columns coordinate pairs.
#' @return Excel alphanumeric cell reference
#' @examples
#' getCellRefs(data.frame(1, 2))
#' # "B1"
#' getCellRefs(data.frame(1:3, 2:4))
#' # "B1" "C2" "D3"
#' @export
getCellRefs <- function(cellCoords) {
  if (!"data.frame" %in% class(cellCoords)) {
    stop("Provide a data.frame!")
  }
  
  
  
  if (!("numeric" %in% sapply(cellCoords[, 1], class) |
        "integer" %in% sapply(cellCoords[, 1], class))
      & ("numeric" %in% sapply(cellCoords[, 2], class) |
         "integer" %in% sapply(cellCoords[, 2], class))
      
  ) {
    stop("Provide a data.frame containing integers!")
  }
  
  
  
  
  
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  l <- convert_to_excel_ref(cols = unlist(cellCoords[, 2]), LETTERS = LETTERS)
  paste0(l, cellCoords[, 1])
}











#' @name freezePane
#' @title Freeze a worksheet pane
#' @description Freeze a worksheet pane
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param firstActiveRow Top row of active region
#' @param firstActiveCol Furthest left column of active region
#' @param firstRow If \code{TRUE}, freezes the first row (equivalent to firstActiveRow = 2)
#' @param firstCol If \code{TRUE}, freezes the first column (equivalent to firstActiveCol = 2)
#' @export
#' @examples
#' ## Create a new workbook
#' wb <- createWorkbook("Kenshin")
#'
#' ## Add some worksheets
#' addWorksheet(wb, "Sheet 1")
#' addWorksheet(wb, "Sheet 2")
#' addWorksheet(wb, "Sheet 3")
#' addWorksheet(wb, "Sheet 4")
#'
#' ## Freeze Panes
#' freezePane(wb, "Sheet 1", firstActiveRow = 5, firstActiveCol = 3)
#' freezePane(wb, "Sheet 2", firstCol = TRUE) ## shortcut to firstActiveCol = 2
#' freezePane(wb, 3, firstRow = TRUE) ## shortcut to firstActiveRow = 2
#' freezePane(wb, 4, firstActiveRow = 1, firstActiveCol = "D")
#'
#' ## Save workbook
#' \dontrun{
#' saveWorkbook(wb, "freezePaneExample.xlsx", overwrite = TRUE)
#' }
freezePane <- function(wb, sheet, firstActiveRow = NULL, firstActiveCol = NULL, firstRow = FALSE, firstCol = FALSE) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (is.null(firstActiveRow) & is.null(firstActiveCol) & !firstRow & !firstCol) {
    return(invisible(0))
  }
  
  if (!is.logical(firstRow)) {
    stop("firstRow must be TRUE/FALSE")
  }
  
  if (!is.logical(firstCol)) {
    stop("firstCol must be TRUE/FALSE")
  }
  
  
  
  
  if (firstRow & !firstCol) {
    invisible(wb$freezePanes(sheet, firstRow = firstRow))
  } else if (firstCol & !firstRow) {
    invisible(wb$freezePanes(sheet, firstCol = firstCol))
  } else if (firstRow & firstCol) {
    invisible(wb$freezePanes(sheet, firstActiveRow = 2L, firstActiveCol = 2L))
  } else { ## else both firstRow and firstCol are FALSE
    
    ## Convert to numeric if column letter given
    if (!is.null(firstActiveRow)) {
      firstActiveRow <- convertFromExcelRef(firstActiveRow)
    } else {
      firstActiveRow <- 1L
    }
    
    if (!is.null(firstActiveCol)) {
      firstActiveCol <- convertFromExcelRef(firstActiveCol)
    } else {
      firstActiveCol <- 1L
    }
    
    invisible(wb$freezePanes(sheet, firstActiveRow = firstActiveRow, firstActiveCol = firstActiveCol, firstRow = firstRow, firstCol = firstCol))
  }
}


convert2EMU <- function(d, units) {
  if (grepl("in", units)) {
    d <- d * 2.54
  }
  
  if (grepl("mm|milli", units)) {
    d <- d / 10
  }
  
  return(d * 360000)
}




#' @name insertImage
#' @title Insert an image into a worksheet
#' @description Insert an image into a worksheet
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param file An image file. Valid file types are: jpeg, png, bmp
#' @param width Width of figure.
#' @param height Height of figure.
#' @param startRow Row coordinate of upper left corner of the image
#' @param startCol Column coordinate of upper left corner of the image
#' @param units Units of width and height. Can be "in", "cm" or "px"
#' @param dpi Image resolution used for conversion between units.
#' @importFrom grDevices bmp png jpeg
#' @seealso \code{\link{insertPlot}}
#' @export
#' @examples
#' ## Create a new workbook
#' wb <- createWorkbook("Ayanami")
#'
#' ## Add some worksheets
#' addWorksheet(wb, "Sheet 1")
#' addWorksheet(wb, "Sheet 2")
#' addWorksheet(wb, "Sheet 3")
#'
#' ## Insert images
#' img <- system.file("extdata", "einstein.jpg", package = "openxlsx")
#' insertImage(wb, "Sheet 1", img, startRow = 5, startCol = 3, width = 6, height = 5)
#' insertImage(wb, 2, img, startRow = 2, startCol = 2)
#' insertImage(wb, 3, img, width = 15, height = 12, startRow = 3, startCol = "G", units = "cm")
#'
#' ## Save workbook
#' \dontrun{
#' saveWorkbook(wb, "insertImageExample.xlsx", overwrite = TRUE)
#' }
insertImage <- function(wb, sheet, file, width = 6, height = 3, startRow = 1, startCol = 1, units = "in", dpi = 300) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (!file.exists(file)) {
    stop("File does not exist.")
  }
  
  if (!grepl("\\\\|\\/", file)) {
    file <- file.path(getwd(), file, fsep = .Platform$file.sep)
  }
  
  units <- tolower(units)
  
  if (!units %in% c("cm", "in", "px")) {
    stop("Invalid units.\nunits must be one of: cm, in, px")
  }
  
  startCol <- convertFromExcelRef(startCol)
  startRow <- as.integer(startRow)
  
  ## convert to inches
  if (units == "px") {
    width <- width / dpi
    height <- height / dpi
  } else if (units == "cm") {
    width <- width / 2.54
    height <- height / 2.54
  }
  
  ## Convert to EMUs
  widthEMU <- as.integer(round(width * 914400L, 0)) # (EMUs per inch)
  heightEMU <- as.integer(round(height * 914400L, 0)) # (EMUs per inch)
  
  wb$insertImage(sheet, file = file, startRow = startRow, startCol = startCol, width = widthEMU, height = heightEMU)
}

pixels2ExcelColWidth <- function(pixels) {
  if (any(!is.numeric(pixels))) {
    stop("All elements of pixels must be numeric")
  }
  
  pixels[pixels == 0] <- 8.43
  pixels[pixels != 0] <- (pixels[pixels != 0] - 12) / 7 + 1
  
  pixels
}


#' @name setRowHeights
#' @title Set worksheet row heights
#' @description Set worksheet row heights
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param rows Indices of rows to set height
#' @param heights Heights to set rows to specified in Excel column height units.
#' @seealso \code{\link{removeRowHeights}}
#' @export
#' @examples
#' ## Create a new workbook
#' wb <- createWorkbook()
#'
#' ## Add a worksheet
#' addWorksheet(wb, "Sheet 1")
#'
#' ## set row heights
#' setRowHeights(wb, 1, rows = c(1, 4, 22, 2, 19), heights = c(24, 28, 32, 42, 33))
#'
#' ## overwrite row 1 height
#' setRowHeights(wb, 1, rows = 1, heights = 40)
#'
#' ## Save workbook
#' \dontrun{
#' saveWorkbook(wb, "setRowHeightsExample.xlsx", overwrite = TRUE)
#' }
setRowHeights <- function(wb, sheet, rows, heights) {
  sheet <- wb$validateSheet(sheet)
  
  if (length(rows) > length(heights)) {
    heights <- rep(heights, length.out = length(rows))
  }
  
  if (length(heights) > length(rows)) {
    stop("Greater number of height values than rows.")
  }
  
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  ## Remove duplicates
  heights <- heights[!duplicated(rows)]
  rows <- rows[!duplicated(rows)]
  
  
  heights <- as.character(as.numeric(heights))
  names(heights) <- rows
  
  wb$setRowHeights(sheet, rows, heights)
}

#' @name setColWidths
#' @title Set worksheet column widths
#' @description Set worksheet column widths to specific width or "auto".
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param cols Indices of cols to set width
#' @param widths widths to set cols to specified in Excel column width units or "auto" for automatic sizing. The widths argument is
#' recycled to the length of cols.
#' @param hidden Logical vector. If TRUE the column is hidden.
#' @param ignoreMergedCells Ignore any cells that have been merged with other cells in the calculation of "auto" column widths.
#' @details The global min and max column width for "auto" columns is set by (default values show):
#' \itemize{
#'   \item{options("openxlsx.minWidth" = 3)}
#'   \item{options("openxlsx.maxWidth" = 250)} ## This is the maximum width allowed in Excel
#' }
#'
#' NOTE: The calculation of column widths can be slow for large worksheets.
#'
#' NOTE: The \code{hidden} parameter may conflict with the one set in \code{groupColumns}; changing one will update the other.
#'
#' @seealso \code{\link{removeColWidths}}
#' @export
#' @examples
#' ## Create a new workbook
#' wb <- createWorkbook()
#'
#' ## Add a worksheet
#' addWorksheet(wb, "Sheet 1")
#'
#'
#' ## set col widths
#' setColWidths(wb, 1, cols = c(1, 4, 6, 7, 9), widths = c(16, 15, 12, 18, 33))
#'
#' ## auto columns
#' addWorksheet(wb, "Sheet 2")
#' writeData(wb, sheet = 2, x = iris)
#' setColWidths(wb, sheet = 2, cols = 1:5, widths = "auto")
#'
#' ## Save workbook
#' \dontrun{
#' saveWorkbook(wb, "setColWidthsExample.xlsx", overwrite = TRUE)
#' }
#'
setColWidths <- function(wb, sheet, cols, widths = 8.43, hidden = rep(FALSE, length(cols)), ignoreMergedCells = FALSE) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  sheet <- wb$validateSheet(sheet)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  widths <- tolower(widths) ## possibly "auto"
  if (ignoreMergedCells) {
    widths[widths == "auto"] <- "auto2"
  }
  
  if (length(widths) > length(cols)) {
    stop("More widths than columns supplied.")
  }
  
  if (length(hidden) > length(cols)) {
    stop("hidden argument is longer than cols.")
  }
  
  if (length(widths) < length(cols)) {
    widths <- rep(widths, length.out = length(cols))
  }
  
  if (length(hidden) < length(cols)) {
    hidden <- rep(hidden, length.out = length(cols))
  }
  
  ## Remove duplicates
  widths <- widths[!duplicated(cols)]
  hidden <- hidden[!duplicated(cols)]
  cols <- cols[!duplicated(cols)]
  cols <- convertFromExcelRef(cols)
  
  if (length(wb$colWidths[[sheet]]) > 0) {
    existing_cols <- names(wb$colWidths[[sheet]])
    existing_widths <- unname(wb$colWidths[[sheet]])
    existing_hidden <- attr(wb$colWidths[[sheet]], "hidden")
    
    ## check for existing custom widths
    flag <- existing_cols %in% cols
    if (any(flag)) {
      existing_cols <- existing_cols[!flag]
      existing_widths <- existing_widths[!flag]
      existing_hidden <- existing_hidden[!flag]
    }
    
    all_names <- c(existing_cols, cols)
    all_widths <- c(existing_widths, widths)
    all_hidden <- c(existing_hidden, as.character(as.integer(hidden)))
    
    ord <- order(as.integer(all_names))
    all_names <- all_names[ord]
    all_widths <- all_widths[ord]
    all_hidden <- all_hidden[ord]
    
    
    names(all_widths) <- all_names
    wb$colWidths[[sheet]] <- all_widths
    attr(wb$colWidths[[sheet]], "hidden") <- all_hidden
  } else {
    names(widths) <- cols
    wb$colWidths[[sheet]] <- widths
    attr(wb$colWidths[[sheet]], "hidden") <- as.character(as.integer(hidden))
  }
  
  # Check if any conflicting column outline levels
  if (length(wb$colOutlineLevels[[sheet]]) > 0) {
    existing_cols <- names(wb$colOutlineLevels[[sheet]])
    
    if (any(existing_cols %in% cols)) {
      for (i in intersect(existing_cols, cols)) {
        width_hidden <- attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") == i]
        outline_hidden <- attr(wb$colOutlineLevels[[sheet]], "hidden")[attr(wb$colOutlineLevels[[sheet]], "names") == i]
        
        if (outline_hidden != width_hidden) {
          attr(wb$colOutlineLevels[[sheet]], "hidden")[attr(wb$colOutlineLevels[[sheet]], "names") == i] <- width_hidden
        }
      }
      
      cols <- cols[!cols %in% existing_cols]
      hidden <- attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") %in% cols]
    }
  }
  
  invisible(0)
}


#' @name removeColWidths
#' @title Remove column widths from a worksheet

#' @description Remove column widths from a worksheet
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param cols Indices of columns to remove custom width (if any) from.
#' @seealso \code{\link{setColWidths}}
#' @export
#' @examples
#' ## Create a new workbook
#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx"))
#'
#' ## remove column widths in columns 1 to 20
#' removeColWidths(wb, 1, cols = 1:20)
#' \dontrun{
#' saveWorkbook(wb, "removeColWidthsExample.xlsx", overwrite = TRUE)
#' }
removeColWidths <- function(wb, sheet, cols) {
  sheet <- wb$validateSheet(sheet)
  
  if (!is.numeric(cols)) {
    cols <- convertFromExcelRef(cols)
  }
  
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  customCols <- as.integer(names(wb$colWidths[[sheet]]))
  removeInds <- which(customCols %in% cols)
  if (length(removeInds) > 0) {
    remainingCols <- customCols[-removeInds]
    if (length(remainingCols) == 0) {
      wb$colWidths[[sheet]] <- list()
    } else {
      rem_widths <- wb$colWidths[[sheet]][-removeInds]
      names(rem_widths) <- as.character(remainingCols)
      wb$colWidths[[sheet]] <- rem_widths
    }
  }
}



#' @name removeRowHeights
#' @title Remove custom row heights from a worksheet
#' @description Remove row heights from a worksheet
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param rows Indices of rows to remove custom height (if any) from.
#' @seealso \code{\link{setRowHeights}}
#' @export
#' @examples
#' ## Create a new workbook
#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx"))
#'
#' ## remove any custom row heights in rows 1 to 10
#' removeRowHeights(wb, 1, rows = 1:10)
#' \dontrun{
#' saveWorkbook(wb, "removeRowHeightsExample.xlsx", overwrite = TRUE)
#' }
removeRowHeights <- function(wb, sheet, rows) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  sheet <- wb$validateSheet(sheet)
  
  customRows <- as.integer(names(wb$rowHeights[[sheet]]))
  removeInds <- which(customRows %in% rows)
  if (length(removeInds) > 0) {
    wb$rowHeights[[sheet]] <- wb$rowHeights[[sheet]][-removeInds]
  }
}


#' @name insertPlot
#' @title Insert the current plot into a worksheet
#' @author Alexander Walker
#' @description The current plot is saved to a temporary image file using dev.copy.
#' This file is then written to the workbook using insertImage.
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param startRow Row coordinate of upper left corner of figure. xy[[2]] when xy is given.
#' @param startCol Column coordinate of upper left corner of figure. xy[[1]] when xy is given.
#' @param xy Alternate way to specify startRow and startCol.  A vector of length 2 of form (startcol, startRow)
#' @param width Width of figure. Defaults to 6in.
#' @param height Height of figure . Defaults to 4in.
#' @param fileType File type of image
#' @param units Units of width and height. Can be "in", "cm" or "px"
#' @param dpi Image resolution
#' @seealso \code{\link{insertImage}}
#' @export
#' @importFrom grDevices bmp png jpeg tiff dev.copy dev.list dev.off
#' @examples
#' \dontrun{
#' ## Create a new workbook
#' wb <- createWorkbook()
#'
#' ## Add a worksheet
#' addWorksheet(wb, "Sheet 1", gridLines = FALSE)
#'
#' ## create plot objects
#' require(ggplot2)
#' p1 <- qplot(mpg,
#'   data = mtcars, geom = "density",
#'   fill = as.factor(gear), alpha = I(.5), main = "Distribution of Gas Mileage"
#' )
#' p2 <- qplot(age, circumference,
#'   data = Orange, geom = c("point", "line"), colour = Tree
#' )
#'
#' ## Insert currently displayed plot to sheet 1, row 1, column 1
#' print(p1) # plot needs to be showing
#' insertPlot(wb, 1, width = 5, height = 3.5, fileType = "png", units = "in")
#'
#' ## Insert plot 2
#' print(p2)
#' insertPlot(wb, 1, xy = c("J", 2), width = 16, height = 10, fileType = "png", units = "cm")
#'
#' ## Save workbook
#' saveWorkbook(wb, "insertPlotExample.xlsx", overwrite = TRUE)
#' }
insertPlot <- function(wb, sheet, width = 6, height = 4, xy = NULL,
                       startRow = 1, startCol = 1, fileType = "png", units = "in", dpi = 300) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (is.null(dev.list()[[1]])) {
    warning("No plot to insert.")
    return()
  }
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  if (!is.null(xy)) {
    startCol <- xy[[1]]
    startRow <- xy[[2]]
  }
  
  fileType <- tolower(fileType)
  units <- tolower(units)
  
  if (fileType == "jpg") {
    fileType <- "jpeg"
  }
  
  if (!fileType %in% c("png", "jpeg", "tiff", "bmp")) {
    stop("Invalid file type.\nfileType must be one of: png, jpeg, tiff, bmp")
  }
  
  if (!units %in% c("cm", "in", "px")) {
    stop("Invalid units.\nunits must be one of: cm, in, px")
  }
  
  fileName <- tempfile(pattern = "figureImage", fileext = paste0(".", fileType))
  
  if (fileType == "bmp") {
    dev.copy(bmp, filename = fileName, width = width, height = height, units = units, res = dpi)
  } else if (fileType == "jpeg") {
    dev.copy(jpeg, filename = fileName, width = width, height = height, units = units, quality = 100, res = dpi)
  } else if (fileType == "png") {
    dev.copy(png, filename = fileName, width = width, height = height, units = units, res = dpi)
  } else if (fileType == "tiff") {
    dev.copy(tiff, filename = fileName, width = width, height = height, units = units, compression = "none", res = dpi)
  }
  
  ## write image
  invisible(dev.off())
  
  insertImage(wb = wb, sheet = sheet, file = fileName, width = width, height = height, startRow = startRow, startCol = startCol, units = units, dpi = dpi)
}



#' @name replaceStyle
#' @title Replace an existing cell style
#' @description Replace an existing cell style
#' @author Alexander Walker
#' @param wb A workbook object
#' @param index Index of style object to replace
#' @param newStyle A style to replace the existing style as position index
#' @description Replace a style object
#' @export
#' @seealso \code{\link{getStyles}}
#' @examples
#'
#' ## load a workbook
#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx"))
#'
#' ## create a new style and replace style 2
#'
#' newStyle <- createStyle(fgFill = "#00FF00")
#'
#' ## replace style 2
#' getStyles(wb)[1:3] ## prints styles
#' replaceStyle(wb, 2, newStyle = newStyle)
#'
#' ## Save workbook
#' \dontrun{
#' saveWorkbook(wb, "replaceStyleExample.xlsx", overwrite = TRUE)
#' }
replaceStyle <- function(wb, index, newStyle) {
  nStyles <- length(wb$styleObjects)
  
  if (nStyles == 0) {
    stop("Workbook has no existing styles.")
  }
  
  if (index > nStyles) {
    stop(sprintf("Invalid index. Workbook only has %s styles.", nStyles))
  }
  
  if (!all("Style" %in% class(newStyle))) {
    stop("Invalid style object.")
  }
  
  wb$styleObjects[[index]]$style <- newStyle
}


#' @name getStyles
#' @title Returns a list of all styles in the workbook
#' @description Returns list of style objects in the workbook
#' @param wb A workbook object
#' @export
#' @seealso \code{\link{replaceStyle}}
#' @examples
#' ## load a workbook
#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx"))
#' getStyles(wb)[1:3]
getStyles <- function(wb) {
  nStyles <- length(wb$styleObjects)
  
  if (nStyles == 0) {
    stop("Workbook has no existing styles.")
  }
  
  styles <- lapply(wb$styleObjects, "[[", "style")
  
  return(styles)
}



#' @name removeWorksheet
#' @title Remove a worksheet from a workbook
#' @description Remove a worksheet from a Workbook object
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @description Remove a worksheet from a workbook
#' @export
#' @examples
#' ## load a workbook
#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx"))
#'
#' ## Remove sheet 2
#' removeWorksheet(wb, 2)
#'
#' ## save the modified workbook
#' \dontrun{
#' saveWorkbook(wb, "removeWorksheetExample.xlsx", overwrite = TRUE)
#' }
removeWorksheet <- function(wb, sheet) {
  if (class(wb) != "Workbook") {
    stop("wb must be a Workbook object!")
  }
  
  if (length(sheet) != 1) {
    stop("sheet must have length 1.")
  }
  
  wb$deleteWorksheet(sheet)
  
  invisible(0)
}


#' @name deleteData
#' @title Delete cell data
#' @description Delete contents and styling from a cell.
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param rows Rows to delete data from.
#' @param cols columns to delete data from.
#' @param gridExpand If \code{TRUE}, all data in rectangle min(rows):max(rows) X min(cols):max(cols)
#' will be removed.
#' @export
#' @examples
#' ## write some data
#' wb <- createWorkbook()
#' addWorksheet(wb, "Worksheet 1")
#' x <- data.frame(matrix(runif(200), ncol = 10))
#' writeData(wb, sheet = 1, x = x, startCol = 2, startRow = 3, colNames = FALSE)
#'
#' ## delete some data
#' deleteData(wb, sheet = 1, cols = 3:5, rows = 5:7, gridExpand = TRUE)
#' deleteData(wb, sheet = 1, cols = 7:9, rows = 5:7, gridExpand = TRUE)
#' deleteData(wb, sheet = 1, cols = LETTERS, rows = 18, gridExpand = TRUE)
#' \dontrun{
#' saveWorkbook(wb, "deleteDataExample.xlsx", overwrite = TRUE)
#' }
deleteData <- function(wb, sheet, cols, rows, gridExpand = FALSE) {
  sheet <- wb$validateSheet(sheet)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  
  wb$worksheets[[sheet]]$sheet_data$delete(rows_in = rows, cols_in = cols, grid_expand = gridExpand)
  
  
  invisible(0)
}


#' @name modifyBaseFont
#' @title Modify the default font
#' @description Modify the default font for this workbook
#' @author Alexander Walker
#' @param wb A workbook object
#' @param fontSize font size
#' @param fontColour font colour
#' @param fontName Name of a font
#' @details The font name is not validated in anyway.  Excel replaces unknown font names
#' with Arial. Base font is black, size 11, Calibri.
#' @export
#' @examples
#' ## create a workbook
#' wb <- createWorkbook()
#' addWorksheet(wb, "S1")
#' ## modify base font to size 10 Arial Narrow in red
#' modifyBaseFont(wb, fontSize = 10, fontColour = "#FF0000", fontName = "Arial Narrow")
#'
#' writeData(wb, "S1", iris)
#' writeDataTable(wb, "S1", x = iris, startCol = 10) ## font colour does not affect tables
#' \dontrun{
#' saveWorkbook(wb, "modifyBaseFontExample.xlsx", overwrite = TRUE)
#' }
modifyBaseFont <- function(wb, fontSize = 11, fontColour = "black", fontName = "Calibri") {
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (fontSize < 0) stop("Invalid fontSize")
  fontColour <- validateColour(fontColour)
  
  wb$styles$fonts[[1]] <- sprintf('<font><sz val="%s"/><color rgb="%s"/><name val="%s"/></font>', fontSize, fontColour, fontName)
}


#' @name getBaseFont
#' @title Return the workbook default font
#' @description Return the workbook default font
#' @author Alexander Walker
#' @param wb A workbook object
#' @description Returns the base font used in the workbook.
#' @export
#' @examples
#' ## create a workbook
#' wb <- createWorkbook()
#' getBaseFont(wb)
#'
#' ## modify base font to size 10 Arial Narrow in red
#' modifyBaseFont(wb, fontSize = 10, fontColour = "#FF0000", fontName = "Arial Narrow")
#'
#' getBaseFont(wb)
getBaseFont <- function(wb) {
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  wb$getBaseFont()
}


#' @name setHeaderFooter
#' @title Set document headers and footers
#' @description Set document headers and footers
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param header document header. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.
#' @param footer document footer. Character vector of length 3 corresponding to positions left, center, right. Use NA to skip a position.
#' @param evenHeader document header for even pages.
#' @param evenFooter document footer for even pages.
#' @param firstHeader document header for first page only.
#' @param firstFooter document footer for first page only.
#' @details Headers and footers can contain special tags
#' \itemize{
#'   \item{\bold{&[Page]}}{ Page number}
#'   \item{\bold{&[Pages]}}{ Number of pages}
#'   \item{\bold{&[Date]}}{ Current date}
#'   \item{\bold{&[Time]}}{ Current time}
#'   \item{\bold{&[Path]}}{ File path}
#'   \item{\bold{&[File]}}{ File name}
#'   \item{\bold{&[Tab]}}{ Worksheet name}
#' }
#' @export
#' @seealso \code{\link{addWorksheet}} to set headers and footers when adding a worksheet
#' @examples
#' wb <- createWorkbook()
#'
#' addWorksheet(wb, "S1")
#' addWorksheet(wb, "S2")
#' addWorksheet(wb, "S3")
#' addWorksheet(wb, "S4")
#'
#' writeData(wb, 1, 1:400)
#' writeData(wb, 2, 1:400)
#' writeData(wb, 3, 3:400)
#' writeData(wb, 4, 3:400)
#'
#' setHeaderFooter(wb,
#'   sheet = "S1",
#'   header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"),
#'   footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"),
#'   evenHeader = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"),
#'   evenFooter = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"),
#'   firstHeader = c("TOP", "OF FIRST", "PAGE"),
#'   firstFooter = c("BOTTOM", "OF FIRST", "PAGE")
#' )
#'
#' setHeaderFooter(wb,
#'   sheet = 2,
#'   header = c("&[Date]", "ALL HEAD CENTER 2", "&[Page] / &[Pages]"),
#'   footer = c("&[Path]&[File]", NA, "&[Tab]"),
#'   firstHeader = c(NA, "Center Header of First Page", NA),
#'   firstFooter = c(NA, "Center Footer of First Page", NA)
#' )
#'
#' setHeaderFooter(wb,
#'   sheet = 3,
#'   header = c("ALL HEAD LEFT 2", "ALL HEAD CENTER 2", "ALL HEAD RIGHT 2"),
#'   footer = c("ALL FOOT RIGHT 2", "ALL FOOT CENTER 2", "ALL FOOT RIGHT 2")
#' )
#'
#' setHeaderFooter(wb,
#'   sheet = 4,
#'   firstHeader = c("FIRST ONLY L", NA, "FIRST ONLY R"),
#'   firstFooter = c("FIRST ONLY L", NA, "FIRST ONLY R")
#' )
#' \dontrun{
#' saveWorkbook(wb, "setHeaderFooterExample.xlsx", overwrite = TRUE)
#' }
setHeaderFooter <- function(wb, sheet,
                            header = NULL,
                            footer = NULL,
                            evenHeader = NULL,
                            evenFooter = NULL,
                            firstHeader = NULL,
                            firstFooter = NULL) {
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  sheet <- wb$validateSheet(sheet)
  
  if (!is.null(header) & length(header) != 3) {
    stop("header must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  if (!is.null(footer) & length(footer) != 3) {
    stop("footer must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  if (!is.null(evenHeader) & length(evenHeader) != 3) {
    stop("evenHeader must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  if (!is.null(evenFooter) & length(evenFooter) != 3) {
    stop("evenFooter must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  if (!is.null(firstHeader) & length(firstHeader) != 3) {
    stop("firstHeader must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  if (!is.null(firstFooter) & length(firstFooter) != 3) {
    stop("firstFooter must have length 3 where elements correspond to positions: left, center, right.")
  }
  
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  oddHeader <- headerFooterSub(header)
  oddFooter <- headerFooterSub(footer)
  evenHeader <- headerFooterSub(evenHeader)
  evenFooter <- headerFooterSub(evenFooter)
  firstHeader <- headerFooterSub(firstHeader)
  firstFooter <- headerFooterSub(firstFooter)
  
  naToNULLList <- function(x) {
    lapply(x, function(x) {
      if (is.na(x)) {
        return(NULL)
      }
      x
    })
  }
  
  hf <- list(
    oddHeader = naToNULLList(oddHeader),
    oddFooter = naToNULLList(oddFooter),
    evenHeader = naToNULLList(evenHeader),
    evenFooter = naToNULLList(evenFooter),
    firstHeader = naToNULLList(firstHeader),
    firstFooter = naToNULLList(firstFooter)
  )
  
  if (all(sapply(hf, length) == 0)) {
    hf <- NULL
  }
  
  
  wb$worksheets[[sheet]]$headerFooter <- hf
}




#' @name pageSetup
#' @title Set page margins, orientation and print scaling
#' @description Set page margins, orientation and print scaling
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param orientation Page orientation. One of "portrait" or "landscape"
#' @param scale Print scaling. Numeric value between 10 and 400
#' @param left left page margin in inches
#' @param right right page margin in inches
#' @param top top page margin in inches
#' @param bottom bottom page margin in inches
#' @param header header margin in inches
#' @param footer footer margin in inches
#' @param fitToWidth If \code{TRUE}, worksheet is scaled to fit to page width on printing.
#' @param fitToHeight If \code{TRUE}, worksheet is scaled to fit to page height on printing.
#' @param paperSize See details. Default value is 9 (A4 paper).
#' @param printTitleRows Rows to repeat at top of page when printing. Integer vector.
#' @param printTitleCols Columns to repeat at left when printing. Integer vector.
#' @export
#' @details
#' paperSize is an integer corresponding to:
#' \itemize{
#' \item{\bold{1}}{ Letter paper (8.5 in. by 11 in.)}
#' \item{\bold{2}}{ Letter small paper (8.5 in. by 11 in.)}
#' \item{\bold{3}}{ Tabloid paper (11 in. by 17 in.)}
#' \item{\bold{4}}{ Ledger paper (17 in. by 11 in.)}
#' \item{\bold{5}}{ Legal paper (8.5 in. by 14 in.)}
#' \item{\bold{6}}{ Statement paper (5.5 in. by 8.5 in.)}
#' \item{\bold{7}}{ Executive paper (7.25 in. by 10.5 in.)}
#' \item{\bold{8}}{ A3 paper (297 mm by 420 mm)}
#' \item{\bold{9}}{ A4 paper (210 mm by 297 mm)}
#' \item{\bold{10}}{ A4 small paper (210 mm by 297 mm)}
#' \item{\bold{11}}{ A5 paper (148 mm by 210 mm)}
#' \item{\bold{12}}{ B4 paper (250 mm by 353 mm)}
#' \item{\bold{13}}{ B5 paper (176 mm by 250 mm)}
#' \item{\bold{14}}{ Folio paper (8.5 in. by 13 in.)}
#' \item{\bold{15}}{ Quarto paper (215 mm by 275 mm)}
#' \item{\bold{16}}{ Standard paper (10 in. by 14 in.)}
#' \item{\bold{17}}{ Standard paper (11 in. by 17 in.)}
#' \item{\bold{18}}{ Note paper (8.5 in. by 11 in.)}
#' \item{\bold{19}}{ #9 envelope (3.875 in. by 8.875 in.)}
#' \item{\bold{20}}{ #10 envelope (4.125 in. by 9.5 in.)}
#' \item{\bold{21}}{ #11 envelope (4.5 in. by 10.375 in.)}
#' \item{\bold{22}}{ #12 envelope (4.75 in. by 11 in.)}
#' \item{\bold{23}}{ #14 envelope (5 in. by 11.5 in.)}
#' \item{\bold{24}}{ C paper (17 in. by 22 in.)}
#' \item{\bold{25}}{ D paper (22 in. by 34 in.)}
#' \item{\bold{26}}{ E paper (34 in. by 44 in.)}
#' \item{\bold{27}}{ DL envelope (110 mm by 220 mm)}
#' \item{\bold{28}}{ C5 envelope (162 mm by 229 mm)}
#' \item{\bold{29}}{ C3 envelope (324 mm by 458 mm)}
#' \item{\bold{30}}{ C4 envelope (229 mm by 324 mm)}
#' \item{\bold{31}}{ C6 envelope (114 mm by 162 mm)}
#' \item{\bold{32}}{ C65 envelope (114 mm by 229 mm)}
#' \item{\bold{33}}{ B4 envelope (250 mm by 353 mm)}
#' \item{\bold{34}}{ B5 envelope (176 mm by 250 mm)}
#' \item{\bold{35}}{ B6 envelope (176 mm by 125 mm)}
#' \item{\bold{36}}{ Italy envelope (110 mm by 230 mm)}
#' \item{\bold{37}}{ Monarch envelope (3.875 in. by 7.5 in.).}
#' \item{\bold{38}}{ 6 3/4 envelope (3.625 in. by 6.5 in.)}
#' \item{\bold{39}}{ US standard fanfold (14.875 in. by 11 in.)}
#' \item{\bold{40}}{ German standard fanfold (8.5 in. by 12 in.)}
#' \item{\bold{41}}{ German legal fanfold (8.5 in. by 13 in.)}
#' \item{\bold{42}}{ ISO B4 (250 mm by 353 mm)}
#' \item{\bold{43}}{ Japanese double postcard (200 mm by 148 mm)}
#' \item{\bold{44}}{ Standard paper (9 in. by 11 in.)}
#' \item{\bold{45}}{ Standard paper (10 in. by 11 in.)}
#' \item{\bold{46}}{ Standard paper (15 in. by 11 in.)}
#' \item{\bold{47}}{ Invite envelope (220 mm by 220 mm)}
#' \item{\bold{50}}{ Letter extra paper (9.275 in. by 12 in.)}
#' \item{\bold{51}}{ Legal extra paper (9.275 in. by 15 in.)}
#' \item{\bold{52}}{ Tabloid extra paper (11.69 in. by 18 in.)}
#' \item{\bold{53}}{ A4 extra paper (236 mm by 322 mm)}
#' \item{\bold{54}}{ Letter transverse paper (8.275 in. by 11 in.)}
#' \item{\bold{55}}{ A4 transverse paper (210 mm by 297 mm)}
#' \item{\bold{56}}{ Letter extra transverse paper (9.275 in. by 12 in.)}
#' \item{\bold{57}}{ SuperA/SuperA/A4 paper (227 mm by 356 mm)}
#' \item{\bold{58}}{ SuperB/SuperB/A3 paper (305 mm by 487 mm)}
#' \item{\bold{59}}{ Letter plus paper (8.5 in. by 12.69 in.)}
#' \item{\bold{60}}{ A4 plus paper (210 mm by 330 mm)}
#' \item{\bold{61}}{ A5 transverse paper (148 mm by 210 mm)}
#' \item{\bold{62}}{ JIS B5 transverse paper (182 mm by 257 mm)}
#' \item{\bold{63}}{ A3 extra paper (322 mm by 445 mm)}
#' \item{\bold{64}}{ A5 extra paper (174 mm by 235 mm)}
#' \item{\bold{65}}{ ISO B5 extra paper (201 mm by 276 mm)}
#' \item{\bold{66}}{ A2 paper (420 mm by 594 mm)}
#' \item{\bold{67}}{ A3 transverse paper (297 mm by 420 mm)}
#' \item{\bold{68}}{ A3 extra transverse paper (322 mm by 445 mm)}
#' }
#' @examples
#' wb <- createWorkbook()
#' addWorksheet(wb, "S1")
#' addWorksheet(wb, "S2")
#' writeDataTable(wb, 1, x = iris[1:30, ])
#' writeDataTable(wb, 2, x = iris[1:30, ], xy = c("C", 5))
#'
#' ## landscape page scaled to 50%
#' pageSetup(wb, sheet = 1, orientation = "landscape", scale = 50)
#'
#' ## portrait page scales to 300% with 0.5in left and right margins
#' pageSetup(wb, sheet = 2, orientation = "portrait", scale = 300, left = 0.5, right = 0.5)
#'
#'
#' ## print titles
#' addWorksheet(wb, "print_title_rows")
#' addWorksheet(wb, "print_title_cols")
#'
#' writeData(wb, "print_title_rows", rbind(iris, iris, iris, iris))
#' writeData(wb, "print_title_cols", x = rbind(mtcars, mtcars, mtcars), rowNames = TRUE)
#'
#' pageSetup(wb, sheet = "print_title_rows", printTitleRows = 1) ## first row
#' pageSetup(wb, sheet = "print_title_cols", printTitleCols = 1, printTitleRows = 1)
#' \dontrun{
#' saveWorkbook(wb, "pageSetupExample.xlsx", overwrite = TRUE)
#' }
pageSetup <- function(wb, sheet, orientation = NULL, scale = 100,
                      left = 0.7, right = 0.7, top = 0.75, bottom = 0.75,
                      header = 0.3, footer = 0.3,
                      fitToWidth = FALSE, fitToHeight = FALSE, paperSize = NULL,
                      printTitleRows = NULL, printTitleCols = NULL) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  sheet <- wb$validateSheet(sheet)
  xml <- wb$worksheets[[sheet]]$pageSetup
  
  if (!is.null(orientation)) {
    orientation <- tolower(orientation)
    if (!orientation %in% c("portrait", "landscape")) stop("Invalid page orientation.")
  } else {
    orientation <- ifelse(grepl("landscape", xml), "landscape", "portrait") ## get existing
  }
  
  if (scale < 10 | scale > 400) {
    stop("Scale must be between 10 and 400.")
  }
  
  if (!is.null(paperSize)) {
    paperSizes <- 1:68
    paperSizes <- paperSizes[!paperSizes %in% 48:49]
    if (!paperSize %in% paperSizes) {
      stop("paperSize must be an integer in range [1, 68]. See ?pageSetup details.")
    }
    paperSize <- as.integer(paperSize)
  } else {
    paperSize <- regmatches(xml, regexpr('(?<=paperSize=")[0-9]+', xml, perl = TRUE)) ## get existing
  }
  
  
  ##############################
  ## Keep defaults on orientation, hdpi, vdpi, paperSize
  hdpi <- regmatches(xml, regexpr('(?<=horizontalDpi=")[0-9]+', xml, perl = TRUE))
  vdpi <- regmatches(xml, regexpr('(?<=verticalDpi=")[0-9]+', xml, perl = TRUE))
  
  
  ##############################
  ## Update
  wb$worksheets[[sheet]]$pageSetup <- sprintf(
    '<pageSetup paperSize="%s" orientation="%s" scale = "%s" fitToWidth="%s" fitToHeight="%s" horizontalDpi="%s" verticalDpi="%s" r:id="rId2"/>',
    paperSize, orientation, scale, as.integer(fitToWidth), as.integer(fitToHeight), hdpi, vdpi
  )
  
  if (fitToHeight | fitToWidth) {
    wb$worksheets[[sheet]]$sheetPr <- unique(c(wb$worksheets[[sheet]]$sheetPr, '<pageSetUpPr fitToPage="1"/>'))
  }
  
  wb$worksheets[[sheet]]$pageMargins <-
    sprintf('<pageMargins left="%s" right="%s" top="%s" bottom="%s" header="%s" footer="%s"/>', left, right, top, bottom, header, footer)
  
  ## print Titles
  if (!is.null(printTitleRows) & is.null(printTitleCols)) {
    if (!is.numeric(printTitleRows)) {
      stop("printTitleRows must be numeric.")
    }
    
    wb$createNamedRegion(
      ref1 = paste0("$", min(printTitleRows)),
      ref2 = paste0("$", max(printTitleRows)),
      name = "_xlnm.Print_Titles",
      sheet = names(wb)[[sheet]],
      localSheetId = sheet - 1L
    )
  } else if (!is.null(printTitleCols) & is.null(printTitleRows)) {
    if (!is.numeric(printTitleCols)) {
      stop("printTitleCols must be numeric.")
    }
    
    cols <- convert_to_excel_ref(cols = range(printTitleCols), LETTERS = LETTERS)
    wb$createNamedRegion(
      ref1 = paste0("$", cols[1]),
      ref2 = paste0("$", cols[2]),
      name = "_xlnm.Print_Titles",
      sheet = names(wb)[[sheet]],
      localSheetId = sheet - 1L
    )
  } else if (!is.null(printTitleCols) & !is.null(printTitleRows)) {
    if (!is.numeric(printTitleRows)) {
      stop("printTitleRows must be numeric.")
    }
    
    if (!is.numeric(printTitleCols)) {
      stop("printTitleCols must be numeric.")
    }
    
    
    cols <- convert_to_excel_ref(cols = range(printTitleCols), LETTERS = LETTERS)
    rows <- range(printTitleRows)
    
    cols <- paste(paste0("$", cols[1]), paste0("$", cols[2]), sep = ":")
    rows <- paste(paste0("$", rows[1]), paste0("$", rows[2]), sep = ":")
    localSheetId <- sheet - 1L
    sheet <- names(wb)[[sheet]]
    
    wb$workbook$definedNames <- c(
      wb$workbook$definedNames,
      sprintf('<definedName name="_xlnm.Print_Titles" localSheetId="%s">\'%s\'!%s,\'%s\'!%s</definedName>', localSheetId, sheet, cols, sheet, rows)
    )
  }
}


#' @name protectWorksheet
#' @title Protect a worksheet from modifications
#' @description Protect or unprotect a worksheet from modifications by the user in the graphical user interface. Replaces an existing protection.
#' @author Reinhold Kainhofer
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param protect Whether to protect or unprotect the sheet (default=TRUE)
#' @param password (optional) password required to unprotect the worksheet
#' @param lockSelectingLockedCells Whether selecting locked cells is locked
#' @param lockSelectingUnlockedCells Whether selecting unlocked cells is locked
#' @param lockFormattingCells Whether formatting cells is locked
#' @param lockFormattingColumns Whether formatting columns is locked
#' @param lockFormattingRows Whether formatting rows is locked
#' @param lockInsertingColumns Whether inserting columns is locked
#' @param lockInsertingRows Whether inserting rows is locked
#' @param lockInsertingHyperlinks Whether inserting hyperlinks is locked
#' @param lockDeletingColumns Whether deleting columns is locked
#' @param lockDeletingRows Whether deleting rows is locked
#' @param lockSorting Whether sorting is locked
#' @param lockAutoFilter Whether auto-filter is locked
#' @param lockPivotTables Whether pivot tables are locked
#' @param lockObjects Whether objects are locked
#' @param lockScenarios Whether scenarios are locked
#' @export
#' @examples
#' wb <- createWorkbook()
#' addWorksheet(wb, "S1")
#' writeDataTable(wb, 1, x = iris[1:30, ])
#' # Formatting cells / columns is allowed , but inserting / deleting columns is protected:
#' protectWorksheet(wb, "S1",
#'   protect = TRUE,
#'   lockFormattingCells = FALSE, lockFormattingColumns = FALSE,
#'   lockInsertingColumns = TRUE, lockDeletingColumns = TRUE
#' )
#'
#' # Remove the protection
#' protectWorksheet(wb, "S1", protect = FALSE)
#' \dontrun{
#' saveWorkbook(wb, "pageSetupExample.xlsx", overwrite = TRUE)
#' }
protectWorksheet <- function(wb, sheet, protect = TRUE, password = NULL,
                             lockSelectingLockedCells = NULL, lockSelectingUnlockedCells = NULL,
                             lockFormattingCells = NULL, lockFormattingColumns = NULL, lockFormattingRows = NULL,
                             lockInsertingColumns = NULL, lockInsertingRows = NULL, lockInsertingHyperlinks = NULL,
                             lockDeletingColumns = NULL, lockDeletingRows = NULL,
                             lockSorting = NULL, lockAutoFilter = NULL, lockPivotTables = NULL,
                             lockObjects = NULL, lockScenarios = NULL) {
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  sheet <- wb$validateSheet(sheet)
  xml <- wb$worksheets[[sheet]]$sheetProtection
  
  props <- c()
  
  if (!missing(password) && !is.null(password)) {
    props["password"] <- hashPassword(password)
  }
  
  if (!missing(lockSelectingLockedCells) && !is.null(lockSelectingLockedCells)) {
    props["selectLockedCells"] <- toString(as.numeric(lockSelectingLockedCells))
  }
  if (!missing(lockSelectingUnlockedCells) && !is.null(lockSelectingUnlockedCells)) {
    props["selectUnlockedCells"] <- toString(as.numeric(lockSelectingUnlockedCells))
  }
  if (!missing(lockFormattingCells) && !is.null(lockFormattingCells)) {
    props["formatCells"] <- toString(as.numeric(lockFormattingCells))
  }
  if (!missing(lockFormattingColumns) && !is.null(lockFormattingColumns)) {
    props["formatColumns"] <- toString(as.numeric(lockFormattingColumns))
  }
  if (!missing(lockFormattingRows) && !is.null(lockFormattingRows)) {
    props["formatRows"] <- toString(as.numeric(lockFormattingRows))
  }
  if (!missing(lockInsertingColumns) && !is.null(lockInsertingColumns)) {
    props["insertColumns"] <- toString(as.numeric(lockInsertingColumns))
  }
  if (!missing(lockInsertingRows) && !is.null(lockInsertingRows)) {
    props["insertRows"] <- toString(as.numeric(lockInsertingRows))
  }
  if (!missing(lockInsertingHyperlinks) && !is.null(lockInsertingHyperlinks)) {
    props["insertHyperlinks"] <- toString(as.numeric(lockInsertingHyperlinks))
  }
  if (!missing(lockDeletingColumns) && !is.null(lockDeletingColumns)) {
    props["deleteColumns"] <- toString(as.numeric(lockDeletingColumns))
  }
  if (!missing(lockDeletingRows) && !is.null(lockDeletingRows)) {
    props["deleteRows"] <- toString(as.numeric(lockDeletingRows))
  }
  if (!missing(lockSorting) && !is.null(lockSorting)) {
    props["sort"] <- toString(as.numeric(lockSorting))
  }
  if (!missing(lockAutoFilter) && !is.null(lockAutoFilter)) {
    props["autoFilter"] <- toString(as.numeric(lockAutoFilter))
  }
  if (!missing(lockPivotTables) && !is.null(lockPivotTables)) {
    props["pivotTables"] <- toString(as.numeric(lockPivotTables))
  }
  if (!missing(lockObjects) && !is.null(lockObjects)) {
    props["objects"] <- toString(as.numeric(lockObjects))
  }
  if (!missing(lockScenarios) && !is.null(lockScenarios)) {
    props["scenarios"] <- toString(as.numeric(lockScenarios))
  }
  
  if (protect) {
    props["sheet"] <- "1"
    wb$worksheets[[sheet]]$sheetProtection <- sprintf("<sheetProtection %s/>", paste(names(props), '="', props, '"', collapse = " ", sep = ""))
  } else {
    wb$worksheets[[sheet]]$sheetProtection <- ""
  }
}



#' @name protectWorkbook
#' @title Protect a workbook from modifications
#' @description Protect or unprotect a workbook from modifications by the user in the graphical user interface. Replaces an existing protection.
#' @author Reinhold Kainhofer
#' @param wb A workbook object
#' @param protect Whether to protect or unprotect the sheet (default=TRUE)
#' @param password (optional) password required to unprotect the workbook
#' @param lockStructure Whether the workbook structure should be locked
#' @param lockWindows Whether the window position of the spreadsheet should be locked
#' @export
#' @examples
#' wb <- createWorkbook()
#' addWorksheet(wb, "S1")
#' protectWorkbook(wb, protect = TRUE, password = "Password", lockStructure = TRUE)
#' \dontrun{
#' saveWorkbook(wb, "WorkBook_Protection.xlsx", overwrite = TRUE)
#' }
#' # Remove the protection
#' protectWorkbook(wb, protect = FALSE)
#' \dontrun{
#' saveWorkbook(wb, "WorkBook_Protection_unprotected.xlsx", overwrite = TRUE)
#' }
protectWorkbook <- function(wb, protect = TRUE, password = NULL, lockStructure = FALSE, lockWindows = FALSE) {
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  invisible(wb$protectWorkbook(protect = protect, password = password, lockStructure = lockStructure, lockWindows = lockWindows))
}





#' @name showGridLines
#' @title Set worksheet gridlines to show or hide.
#' @description Set worksheet gridlines to show or hide.
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param showGridLines A logical. If \code{FALSE}, grid lines are hidden.
#' @export
#' @examples
#' wb <- loadWorkbook(file = system.file("extdata", "loadExample.xlsx", package = "openxlsx"))
#' names(wb) ## list worksheets in workbook
#' showGridLines(wb, 1, showGridLines = FALSE)
#' showGridLines(wb, "testing", showGridLines = FALSE)
#' \dontrun{
#' saveWorkbook(wb, "showGridLinesExample.xlsx", overwrite = TRUE)
#' }
showGridLines <- function(wb, sheet, showGridLines = FALSE) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  sheet <- wb$validateSheet(sheet)
  
  if (!is.logical(showGridLines)) stop("showGridLines must be a logical")
  
  
  sv <- wb$worksheets[[sheet]]$sheetViews
  showGridLines <- as.integer(showGridLines)
  ## If attribute exists gsub
  if (grepl("showGridLines", sv)) {
    sv <- gsub('showGridLines=".?[^"]', sprintf('showGridLines="%s', showGridLines), sv, perl = TRUE)
  } else {
    sv <- gsub("<sheetView ", sprintf('<sheetView showGridLines="%s" ', showGridLines), sv)
  }
  
  wb$worksheets[[sheet]]$sheetViews <- sv
}





#' @name worksheetOrder
#' @title Order of worksheets in xlsx file
#' @description Get/set order of worksheets in a Workbook object
#' @details This function does not reorder the worksheets within the workbook object, it simply
#' shuffles the order when writing to file.
#' @export
#' @examples
#' ## setup a workbook with 3 worksheets
#' wb <- createWorkbook()
#' addWorksheet(wb = wb, sheetName = "Sheet 1", gridLines = FALSE)
#' writeDataTable(wb = wb, sheet = 1, x = iris)
#'
#' addWorksheet(wb = wb, sheetName = "mtcars (Sheet 2)", gridLines = FALSE)
#' writeData(wb = wb, sheet = 2, x = mtcars)
#'
#' addWorksheet(wb = wb, sheetName = "Sheet 3", gridLines = FALSE)
#' writeData(wb = wb, sheet = 3, x = Formaldehyde)
#'
#' worksheetOrder(wb)
#' names(wb)
#' worksheetOrder(wb) <- c(1, 3, 2) # switch position of sheets 2 & 3
#' writeData(wb, 2, 'This is still the "mtcars" worksheet', startCol = 15)
#' worksheetOrder(wb)
#' names(wb) ## ordering within workbook is not changed
#' \dontrun{
#' saveWorkbook(wb, "worksheetOrderExample.xlsx", overwrite = TRUE)
#' }
#' worksheetOrder(wb) <- c(3, 2, 1)
#' \dontrun{
#' saveWorkbook(wb, "worksheetOrderExample2.xlsx", overwrite = TRUE)
#' }
worksheetOrder <- function(wb) {
  if (!"Workbook" %in% class(wb)) {
    stop("Argument must be a Workbook.")
  }
  
  wb$sheetOrder
}

#' @rdname worksheetOrder
#' @param wb A workbook object
#' @param value Vector specifying order to write worksheets to file
#' @export
`worksheetOrder<-` <- function(wb, value) {
  if (!"Workbook" %in% class(wb)) {
    stop("Argument must be a Workbook.")
  }
  
  if (any(value != as.integer(value))) {
    stop("values must be integers")
  }
  
  value <- as.integer(value)
  
  value <- unique(value)
  if (length(value) != length(wb$worksheets)) {
    stop(sprintf("Worksheet order must be same length as number of worksheets [%s]", length(wb$worksheets)))
  }
  
  if (any(value > length(wb$worksheets))) {
    stop("Elements of order are greater than the number of worksheets")
  }
  
  wb$sheetOrder <- value
  
  invisible(wb)
}




#' @name convertToDate
#' @title Convert from excel date number to R Date type
#' @description Convert from excel date number to R Date type
#' @param x A vector of integers
#' @param origin date. Default value is for Windows Excel 2010
#' @param ... additional parameters passed to as.Date()
#' @details Excel stores dates as number of days from some origin day
#' @seealso \code{\link{writeData}}
#' @export
#' @examples
#' ## 2014 April 21st to 25th
#' convertToDate(c(41750, 41751, 41752, 41753, 41754, NA))
#' convertToDate(c(41750.2, 41751.99, NA, 41753))
convertToDate <- function(x, origin = "1900-01-01", ...) {
  x <- as.numeric(x)
  notNa <- !is.na(x)
  if (origin == "1900-01-01") {
    x[notNa] <- x[notNa] - 2
  }
  
  return(as.Date(x, origin = origin, ...))
}


#' @name convertToDateTime
#' @title Convert from excel time number to R POSIXct type.
#' @description Convert from excel time number to R POSIXct type.
#' @param x A numeric vector
#' @param origin date. Default value is for Windows Excel 2010
#' @param ... Additional parameters passed to as.POSIXct
#' @details Excel stores dates as number of days from some origin date
#' @export
#' @examples
#' ## 2014-07-01, 2014-06-30, 2014-06-29
#' x <- c(41821.8127314815, 41820.8127314815, NA, 41819, NaN)
#' convertToDateTime(x)
#' convertToDateTime(x, tx = "Australia/Perth")
convertToDateTime <- function(x, origin = "1900-01-01", ...) {
  sci_pen <- getOption("scipen")
  options("scipen" = 10000)
  on.exit(options("scipen" = sci_pen), add = TRUE)
  
  x <- as.numeric(x)
  date <- convertToDate(x, origin)
  
  x <- x * 86400
  rem <- x %% 86400
  
  hours <- as.integer(floor(rem / 3600))
  minutes_fraction <- rem %% 3600
  minutes_whole <- as.integer(floor(minutes_fraction / 60))
  secs <- minutes_fraction %% 60
  
  y <- sprintf("%02d:%02d:%06.3f", hours, minutes_whole, secs)
  notNA <- !is.na(x)
  date_time <- rep(NA, length(x))
  date_time[notNA] <- as.POSIXct(paste(date[notNA], y[notNA]), ...)
  
  date_time <- .POSIXct(date_time)
  
  return(date_time)
}



#' @name names
#' @title get or set worksheet names
#' @description get or set worksheet names
#' @aliases names.Workbook
#' @export
#' @method names Workbook
#' @param x A \code{Workbook} object
#' @examples
#'
#' wb <- createWorkbook()
#' addWorksheet(wb, "S1")
#' addWorksheet(wb, "S2")
#' addWorksheet(wb, "S3")
#'
#' names(wb)
#' names(wb)[[2]] <- "S2a"
#' names(wb)
#' names(wb) <- paste("Sheet", 1:3)
names.Workbook <- function(x) {
  nms <- x$sheet_names
  nms <- replaceXMLEntities(nms)
}

#' @rdname names
#' @param value a character vector the same length as wb
#' @export
`names<-.Workbook` <- function(x, value) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (any(duplicated(tolower(value)))) {
    stop("Worksheet names must be unique.")
  }
  
  existing_sheets <- x$sheet_names
  inds <- which(value != existing_sheets)
  
  if (length(inds) == 0) {
    return(invisible(x))
  }
  
  if (length(value) != length(x$worksheets)) {
    stop(sprintf("names vector must have length equal to number of worksheets in Workbook [%s]", length(existing_sheets)))
  }
  
  if (any(nchar(value) > 31)) {
    warning("Worksheet names must less than 32 characters. Truncating names...")
    value[nchar(value) > 31] <- sapply(value[nchar(value) > 31], substr, start = 1, stop = 31)
  }
  
  for (i in inds) {
    invisible(x$setSheetName(i, value[[i]]))
  }
  
  invisible(x)
}



#' @name createNamedRegion
#' @title Create a named region.
#' @description Create a named region
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param rows Numeric vector specifying rows to include in region
#' @param cols Numeric vector specifying columns to include in region
#' @param name Name for region. A character vector of length 1. Note region names musts be case-insensitive unique.
#' @details Region is given by: min(cols):max(cols) X min(rows):max(rows)
#' @export
#' @seealso \code{\link{getNamedRegions}}
#' @examples
#' ## create named regions
#' wb <- createWorkbook()
#' addWorksheet(wb, "Sheet 1")
#'
#' ## specify region
#' writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1)
#' createNamedRegion(
#'   wb = wb,
#'   sheet = 1,
#'   name = "iris",
#'   rows = 1:(nrow(iris) + 1),
#'   cols = 1:ncol(iris)
#' )
#'
#'
#' ## using writeData 'name' argument
#' writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10)
#'
#' out_file <- tempfile(fileext = ".xlsx")
#' \dontrun{
#' saveWorkbook(wb, out_file, overwrite = TRUE)
#'
#' ## see named regions
#' getNamedRegions(wb) ## From Workbook object
#' getNamedRegions(out_file) ## From xlsx file
#'
#' ## read named regions
#' df <- read.xlsx(wb, namedRegion = "iris")
#' head(df)
#'
#' df <- read.xlsx(out_file, namedRegion = "iris2")
#' head(df)
#' }
createNamedRegion <- function(wb, sheet, cols, rows, name) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  sheet <- wb$validateSheet(sheet)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  if (!is.numeric(rows)) {
    stop("rows argument must be a numeric/integer vector")
  }
  
  if (!is.numeric(cols)) {
    stop("cols argument must be a numeric/integer vector")
  }
  
  ## check name doesn't already exist
  ## named region
  
  ex_names <- regmatches(wb$workbook$definedNames, regexpr('(?<=name=")[^"]+', wb$workbook$definedNames, perl = TRUE))
  ex_names <- tolower(replaceXMLEntities(ex_names))
  
  if (tolower(name) %in% ex_names) {
    stop(sprintf("Named region with name '%s' already exists!", name))
  } else if (grepl("[^A-Z0-9_\\.]", name[1], ignore.case = TRUE)) {
    stop("Invalid characters in name")
  } else if (grepl("^[A-Z]{1,3}[0-9]+$", name)) {
    stop("name cannot look like a cell reference.")
  }
  
  
  cols <- round(cols)
  rows <- round(rows)
  
  startCol <- min(cols)
  endCol <- max(cols)
  
  startRow <- min(rows)
  endRow <- max(rows)
  
  ref1 <- paste0("$", convert_to_excel_ref(cols = startCol, LETTERS = LETTERS), "$", startRow)
  ref2 <- paste0("$", convert_to_excel_ref(cols = endCol, LETTERS = LETTERS), "$", endRow)
  
  invisible(
    wb$createNamedRegion(ref1 = ref1, ref2 = ref2, name = name, sheet = wb$sheet_names[sheet])
  )
}







#' @name getNamedRegions
#' @title Get named regions
#' @description Return a vector of named regions in a xlsx file or
#' Workbook object
#' @param x An xlsx file or Workbook object
#' @export
#' @seealso \code{\link{createNamedRegion}}
#' @examples
#' ## create named regions
#' wb <- createWorkbook()
#' addWorksheet(wb, "Sheet 1")
#'
#' ## specify region
#' writeData(wb, sheet = 1, x = iris, startCol = 1, startRow = 1)
#' createNamedRegion(
#'   wb = wb,
#'   sheet = 1,
#'   name = "iris",
#'   rows = 1:(nrow(iris) + 1),
#'   cols = 1:ncol(iris)
#' )
#'
#'
#' ## using writeData 'name' argument to create a named region
#' writeData(wb, sheet = 1, x = iris, name = "iris2", startCol = 10)
#' \dontrun{
#' out_file <- tempfile(fileext = ".xlsx")
#' saveWorkbook(wb, out_file, overwrite = TRUE)
#'
#' ## see named regions
#' getNamedRegions(wb) ## From Workbook object
#' getNamedRegions(out_file) ## From xlsx file
#'
#' ## read named regions
#' df <- read.xlsx(wb, namedRegion = "iris")
#' head(df)
#'
#' df <- read.xlsx(out_file, namedRegion = "iris2")
#' head(df)
#' }
getNamedRegions <- function(x) {
  UseMethod("getNamedRegions", x)
}

#' @export
getNamedRegions.default <- function(x) {
  if (!file.exists(x)) {
    stop(sprintf("File '%s' does not exist.", x))
  }
  
  xmlDir <- file.path(tempdir(), "named_regions_tmp")
  xmlFiles <- unzip(x, exdir = xmlDir)
  
  workbook <- xmlFiles[grepl("workbook.xml$", xmlFiles, perl = TRUE)]
  workbook <- unlist(readLines(workbook, warn = FALSE, encoding = "UTF-8"))
  
  dn <- getChildlessNode(xml = removeHeadTag(workbook), tag = "<definedName ")
  if (length(dn) == 0) {
    return(NULL)
  }
  
  dn_names <- get_named_regions_from_string(dn = dn)
  
  unlink(xmlDir, recursive = TRUE, force = TRUE)
  
  return(dn_names)
}


#' @export
getNamedRegions.Workbook <- function(x) {
  dn <- x$workbook$definedNames
  if (length(dn) == 0) {
    return(NULL)
  }
  
  dn_names <- get_named_regions_from_string(dn = dn)
  
  return(dn_names)
}






#' @name addFilter
#' @title Add column filters
#' @description Add excel column filters to a worksheet
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param cols columns to add filter to.
#' @param rows A row number.
#' @seealso \code{\link{writeData}}
#' @details adds filters to worksheet columns, same as filter parameters in writeData.
#' writeDataTable automatically adds filters to first row of a table.
#' NOTE Can only have a single filter per worksheet unless using tables.
#' @export
#' @seealso \code{\link{addFilter}}
#' @examples
#' wb <- createWorkbook()
#' addWorksheet(wb, "Sheet 1")
#' addWorksheet(wb, "Sheet 2")
#' addWorksheet(wb, "Sheet 3")
#'
#' writeData(wb, 1, iris)
#' addFilter(wb, 1, row = 1, cols = 1:ncol(iris))
#'
#' ## Equivalently
#' writeData(wb, 2, x = iris, withFilter = TRUE)
#'
#' ## Similarly
#' writeDataTable(wb, 3, iris)
#' \dontrun{
#' saveWorkbook(wb, file = "addFilterExample.xlsx", overwrite = TRUE)
#' }
addFilter <- function(wb, sheet, rows, cols) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  sheet <- wb$validateSheet(sheet)
  
  if (length(rows) != 1) {
    stop("row must be a numeric of length 1.")
  }
  
  if (!is.numeric(cols)) {
    cols <- convertFromExcelRef(cols)
  }
  
  wb$worksheets[[sheet]]$autoFilter <- sprintf('<autoFilter ref="%s"/>', paste(getCellRefs(data.frame("x" = c(rows, rows), "y" = c(min(cols), max(cols)))), collapse = ":"))
  
  invisible(wb)
}


#' @name removeFilter
#' @title Remove a worksheet filter
#' @description Removes filters from addFilter() and writeData()
#' @param wb A workbook object
#' @param sheet A vector of names or indices of worksheets
#' @export
#' @examples
#' wb <- createWorkbook()
#' addWorksheet(wb, "Sheet 1")
#' addWorksheet(wb, "Sheet 2")
#' addWorksheet(wb, "Sheet 3")
#'
#' writeData(wb, 1, iris)
#' addFilter(wb, 1, row = 1, cols = 1:ncol(iris))
#'
#' ## Equivalently
#' writeData(wb, 2, x = iris, withFilter = TRUE)
#'
#' ## Similarly
#' writeDataTable(wb, 3, iris)
#'
#' ## remove filters
#' removeFilter(wb, 1:2) ## remove filters
#' removeFilter(wb, 3) ## Does not affect tables!
#' \dontrun{
#' saveWorkbook(wb, file = "removeFilterExample.xlsx", overwrite = TRUE)
#' }
removeFilter <- function(wb, sheet) {
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  for (s in sheet) {
    s <- wb$validateSheet(s)
    wb$worksheets[[s]]$autoFilter <- character(0)
  }
  
  invisible(wb)
}











#' @name setHeader
#' @title Set header for all worksheets
#' @description DEPRECATED
#' @author Alexander Walker
#' @param wb A workbook object
#' @param text header text. A character vector of length 1.
#' @param position Position of text in header. One of "left", "center" or "right"
#' @export
#' @examples
#' \dontrun{
#' wb <- createWorkbook("Edgar Anderson")
#' addWorksheet(wb, "S1")
#' writeDataTable(wb, "S1", x = iris[1:30, ], xy = c("C", 5))
#'
#' ## set all headers
#' setHeader(wb, "This is a header", position = "center")
#' setHeader(wb, "To the left", position = "left")
#' setHeader(wb, "On the right", position = "right")
#'
#' ## set all footers
#' setFooter(wb, "Center Footer Here", position = "center")
#' setFooter(wb, "Bottom left", position = "left")
#' setFooter(wb, Sys.Date(), position = "right")
#'
#' saveWorkbook(wb, "headerHeaderExample.xlsx", overwrite = TRUE)
#' }
setHeader <- function(wb, text, position = "center") {
  warning("This function is deprecated. Use function 'setHeaderFooter()'")
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  position <- tolower(position)
  if (!position %in% c("left", "center", "right")) {
    stop("Invalid position.")
  }
  
  if (length(text) != 1) {
    stop("Text argument must be a character vector of length 1")
  }
  
  sheet <- wb$validateSheet(1)
  wb$headFoot$text[wb$headFoot$pos == position & wb$headFoot$head == "head"] <- as.character(text)
}


#' @name setFooter
#' @title Set footer for all worksheets
#' @description DEPRECATED
#' @author Alexander Walker
#' @param wb A workbook object
#' @param text footer text. A character vector of length 1.
#' @param position Position of text in footer. One of "left", "center" or "right"
#' @export
#' @examples
#' \dontrun{
#' wb <- createWorkbook("Edgar Anderson")
#' addWorksheet(wb, "S1")
#' writeDataTable(wb, "S1", x = iris[1:30, ], xy = c("C", 5))
#'
#' ## set all headers
#' setHeader(wb, "This is a header", position = "center")
#' setHeader(wb, "To the left", position = "left")
#' setHeader(wb, "On the right", position = "right")
#'
#' ## set all footers
#' setFooter(wb, "Center Footer Here", position = "center")
#' setFooter(wb, "Bottom left", position = "left")
#' setFooter(wb, Sys.Date(), position = "right")
#'
#' saveWorkbook(wb, "headerFooterExample.xlsx", overwrite = TRUE)
#' }
setFooter <- function(wb, text, position = "center") {
  warning("This function is deprecated. Use function 'setHeaderFooter()'")
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  position <- tolower(position)
  if (!position %in% c("left", "center", "right")) {
    stop("Invalid position.")
  }
  
  if (length(text) != 1) {
    stop("Text argument must be a character vector of length 1")
  }
  
  sheet <- wb$validateSheet(1)
  wb$headFoot$text[wb$headFoot$pos == position & wb$headFoot$head == "foot"] <- as.character(text)
}











#' @name dataValidation
#' @title Add data validation to cells
#' @description Add Excel data validation to cells
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param cols Contiguous columns to apply conditional formatting to
#' @param rows Contiguous rows to apply conditional formatting to
#' @param type One of 'whole', 'decimal', 'date', 'time', 'textLength', 'list' (see examples)
#' @param operator One of 'between', 'notBetween', 'equal',
#'  'notEqual', 'greaterThan', 'lessThan', 'greaterThanOrEqual', 'lessThanOrEqual'
#' @param value a vector of length 1 or 2 depending on operator (see examples)
#' @param allowBlank logical
#' @param showInputMsg logical
#' @param showErrorMsg logical
#' @export
#' @examples
#' wb <- createWorkbook()
#' addWorksheet(wb, "Sheet 1")
#' addWorksheet(wb, "Sheet 2")
#'
#' writeDataTable(wb, 1, x = iris[1:30, ])
#'
#' dataValidation(wb, 1,
#'   col = 1:3, rows = 2:31, type = "whole",
#'   operator = "between", value = c(1, 9)
#' )
#'
#' dataValidation(wb, 1,
#'   col = 5, rows = 2:31, type = "textLength",
#'   operator = "between", value = c(4, 6)
#' )
#'
#'
#' ## Date and Time cell validation
#' df <- data.frame(
#'   "d" = as.Date("2016-01-01") + -5:5,
#'   "t" = as.POSIXct("2016-01-01") + -5:5 * 10000
#' )
#'
#' writeData(wb, 2, x = df)
#' dataValidation(wb, 2,
#'   col = 1, rows = 2:12, type = "date",
#'   operator = "greaterThanOrEqual", value = as.Date("2016-01-01")
#' )
#'
#' dataValidation(wb, 2,
#'   col = 2, rows = 2:12, type = "time",
#'   operator = "between", value = df$t[c(4, 8)]
#' )
#' \dontrun{
#' saveWorkbook(wb, "dataValidationExample.xlsx", overwrite = TRUE)
#' }
#'
#'
#' ######################################################################
#' ## If type == 'list'
#' # operator argument is ignored.
#'
#' wb <- createWorkbook()
#' addWorksheet(wb, "Sheet 1")
#' addWorksheet(wb, "Sheet 2")
#'
#' writeDataTable(wb, sheet = 1, x = iris[1:30, ])
#' writeData(wb, sheet = 2, x = sample(iris$Sepal.Length, 10))
#'
#' dataValidation(wb, 1, col = 1, rows = 2:31, type = "list", value = "'Sheet 2'!$A$1:$A$10")
#'
#' # openXL(wb)
dataValidation <- function(wb, sheet, cols, rows, type, operator, value, allowBlank = TRUE, showInputMsg = TRUE, showErrorMsg = TRUE) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  ## rows and cols
  if (!is.numeric(cols)) {
    cols <- convertFromExcelRef(cols)
  }
  rows <- as.integer(rows)
  
  ## check length of value
  if (length(value) > 2) {
    stop("value argument must be length < 2")
  }
  
  valid_types <- c(
    "whole",
    "decimal",
    "date",
    "time", ## need to conv
    "textLength",
    "list"
  )
  
  if (!tolower(type) %in% tolower(valid_types)) {
    stop("Invalid 'type' argument!")
  }
  
  
  ## operator == 'between' we leave out
  valid_operators <- c(
    "between",
    "notBetween",
    "equal",
    "notEqual",
    "greaterThan",
    "lessThan",
    "greaterThanOrEqual",
    "lessThanOrEqual"
  )
  
  if (tolower(type) != "list") {
    if (!tolower(operator) %in% tolower(valid_operators)) {
      stop("Invalid 'operator' argument!")
    }
    
    operator <- valid_operators[tolower(valid_operators) %in% tolower(operator)][1]
  } else {
    operator <- "between" ## ignored
  }
  
  if (!is.logical(allowBlank)) {
    stop("Argument 'allowBlank' musts be logical!")
  }
  
  if (!is.logical(showInputMsg)) {
    stop("Argument 'showInputMsg' musts be logical!")
  }
  
  if (!is.logical(showErrorMsg)) {
    stop("Argument 'showErrorMsg' musts be logical!")
  }
  
  ## All inputs validated
  
  type <- valid_types[tolower(valid_types) %in% tolower(type)][1]
  
  ## check input combinations
  if (type == "date" & !"Date" %in% class(value)) {
    stop("If type == 'date' value argument must be a Date vector.")
  }
  
  if (type == "time" & !any(tolower(class(value)) %in% c("posixct", "posixt"))) {
    stop("If type == 'date' value argument must be a POSIXct or POSIXlt vector.")
  }
  
  
  value <- head(value, 2)
  allowBlank <- as.integer(allowBlank[1])
  showInputMsg <- as.integer(showInputMsg[1])
  showErrorMsg <- as.integer(showErrorMsg[1])
  
  if (type == "list") {
    invisible(wb$dataValidation_list(
      sheet = sheet,
      startRow = min(rows),
      endRow = max(rows),
      startCol = min(cols),
      endCol = max(cols),
      value = value,
      allowBlank = allowBlank,
      showInputMsg = showInputMsg,
      showErrorMsg = showErrorMsg
    ))
  } else {
    invisible(wb$dataValidation(
      sheet = sheet,
      startRow = min(rows),
      endRow = max(rows),
      startCol = min(cols),
      endCol = max(cols),
      type = type,
      operator = operator,
      value = value,
      allowBlank = allowBlank,
      showInputMsg = showInputMsg,
      showErrorMsg = showErrorMsg
    ))
  }
  
  
  
  invisible(0)
}








#' @name getDateOrigin
#' @title Get the date origin an xlsx file is using
#' @description Return the date origin used internally by an xlsx or xlsm file
#' @author Alexander Walker
#' @param xlsxFile An xlsx or xlsm file.
#' @details Excel stores dates as the number of days from either 1904-01-01 or 1900-01-01. This function
#' checks the date origin being used in an Excel file and returns is so it can be used in \code{\link{convertToDate}}
#' @return One of "1900-01-01" or "1904-01-01".
#' @seealso \code{\link{convertToDate}}
#' @examples
#'
#' ## create a file with some dates
#' \dontrun{
#' write.xlsx(as.Date("2015-01-10") - (0:4), file = "getDateOriginExample.xlsx")
#' m <- read.xlsx("getDateOriginExample.xlsx")
#'
#' ## convert to dates
#' do <- getDateOrigin(system.file("extdata", "readTest.xlsx", package = "openxlsx"))
#' convertToDate(m[[1]], do)
#' }
#' @export
getDateOrigin <- function(xlsxFile) {
  xlsxFile <- getFile(xlsxFile)
  if (!file.exists(xlsxFile)) {
    stop("File does not exist.")
  }
  
  if (grepl("\\.xls$|\\.xlm$", xlsxFile)) {
    stop("openxlsx can not read .xls or .xlm files!")
  }
  
  ## create temp dir and unzip
  xmlDir <- file.path(tempdir(), "_excelXMLRead")
  xmlFiles <- unzip(xlsxFile, exdir = xmlDir)
  
  on.exit(unlink(xmlDir, recursive = TRUE), add = TRUE)
  
  workbook <- xmlFiles[grepl("workbook.xml$", xmlFiles, perl = TRUE)]
  workbook <- paste(unlist(readLines(workbook, warn = FALSE)), collapse = "")
  
  if (grepl('date1904="1"|date1904="true"', workbook, ignore.case = TRUE)) {
    origin <- "1904-01-01"
  } else {
    origin <- "1900-01-01"
  }
  
  return(origin)
}








#' @name getSheetNames
#' @title Get names of worksheets
#' @description Returns the worksheet names within an xlsx file
#' @author Alexander Walker
#' @param file An xlsx or xlsm file.
#' @return Character vector of worksheet names.
#' @examples
#' getSheetNames(system.file("extdata", "readTest.xlsx", package = "openxlsx"))
#' @export
getSheetNames <- function(file) {
  if (!file.exists(file)) {
    stop("file does not exist.")
  }
  
  if (grepl("\\.xls$|\\.xlm$", file)) {
    stop("openxlsx can not read .xls or .xlm files!")
  }
  
  ## create temp dir and unzip
  xmlDir <- file.path(tempdir(), "_excelXMLRead")
  xmlFiles <- unzip(file, exdir = xmlDir)
  
  on.exit(unlink(xmlDir, recursive = TRUE), add = TRUE)
  
  workbook <- xmlFiles[grepl("workbook.xml$", xmlFiles, perl = TRUE)]
  workbook <- readLines(workbook, warn = FALSE, encoding = "UTF-8")
  workbook <- removeHeadTag(workbook)
  sheets <- unlist(regmatches(workbook, gregexpr("(?<=<sheets>).*(?=</sheets>)", workbook, perl = TRUE)))
  sheets <- unlist(regmatches(sheets, gregexpr("<sheet[^>]*>", sheets, perl = TRUE)))
  
  ## Some veryHidden sheets do not have a sheet content and their rId is empty.
  ## Such sheets need to be filtered out because otherwise their sheet names
  ## occur in the list of all sheet names, leading to a wrong association
  ## of sheet names with sheet indeces.
  sheets <- grep('r:id="[[:blank:]]*"', sheets, invert = TRUE, value = TRUE)
  
  sheetNames <- unlist(regmatches(sheets, gregexpr('(?<=name=")[^"]+', sheets, perl = TRUE)))
  sheetNames <- replaceXMLEntities(sheetNames)
  
  return(sheetNames)
}




#' @name sheetVisibility
#' @title Get/set worksheet visible state
#' @description Get and set worksheet visible state
#' @param wb A workbook object
#' @return Character vector of worksheet names.
#' @return  Vector of "hidden", "visible", "veryHidden"
#' @examples
#'
#' wb <- createWorkbook()
#' addWorksheet(wb, sheetName = "S1", visible = FALSE)
#' addWorksheet(wb, sheetName = "S2", visible = TRUE)
#' addWorksheet(wb, sheetName = "S3", visible = FALSE)
#'
#' sheetVisibility(wb)
#' sheetVisibility(wb)[1] <- TRUE ## show sheet 1
#' sheetVisibility(wb)[2] <- FALSE ## hide sheet 2
#' sheetVisibility(wb)[3] <- "hidden" ## hide sheet 3
#' sheetVisibility(wb)[3] <- "veryHidden" ## hide sheet 3 from UI
#' @export
sheetVisibility <- function(wb) {
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  state <- rep("visible", length(wb$workbook$sheets))
  state[grepl("hidden", wb$workbook$sheets)] <- "hidden"
  state[grepl("veryHidden", wb$workbook$sheets, ignore.case = TRUE)] <- "veryHidden"
  
  
  return(state)
}

#' @rdname sheetVisibility
#' @param value a logical/character vector the same length as sheetVisibility(wb)
#' @export
`sheetVisibility<-` <- function(wb, value) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  value <- tolower(as.character(value))
  if (!any(value %in% c("true", "visible"))) {
    stop("A workbook must have atleast 1 visible worksheet.")
  }
  
  value[value %in% "true"] <- "visible"
  value[value %in% "false"] <- "hidden"
  value[value %in% "veryhidden"] <- "veryHidden"
  
  
  exState0 <- regmatches(wb$workbook$sheets, regexpr('(?<=state=")[^"]+', wb$workbook$sheets, perl = TRUE))
  exState <- tolower(exState0)
  exState[exState %in% "true"] <- "visible"
  exState[exState %in% "hidden"] <- "hidden"
  exState[exState %in% "false"] <- "hidden"
  exState[exState %in% "veryhidden"] <- "veryHidden"
  
  if (length(value) != length(wb$workbook$sheets)) {
    stop(sprintf("value vector must have length equal to number of worksheets in Workbook [%s]", length(exState)))
  }
  
  inds <- which(value != exState)
  if (length(inds) == 0) {
    return(invisible(wb))
  }
  
  for (i in 1:length(wb$worksheets)) {
    wb$workbook$sheets[i] <- gsub(exState0[i], value[i], wb$workbook$sheets[i], fixed = TRUE)
  }
  
  invisible(wb)
}





#' @name pageBreak
#' @title add a page break to a worksheet
#' @description insert page breaks into a worksheet
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param i row or column number to insert page break.
#' @param type One of "row" or "column" for a row break or column break.
#' @export
#' @seealso \code{\link{addWorksheet}}
#' @examples
#' wb <- createWorkbook()
#' addWorksheet(wb, "Sheet 1")
#' writeData(wb, sheet = 1, x = iris)
#'
#' pageBreak(wb, sheet = 1, i = 10, type = "row")
#' pageBreak(wb, sheet = 1, i = 20, type = "row")
#' pageBreak(wb, sheet = 1, i = 2, type = "column")
#' \dontrun{
#' saveWorkbook(wb, "pageBreakExample.xlsx", TRUE)
#' }
#' ## In Excel: View tab -> Page Break Preview
pageBreak <- function(wb, sheet, i, type = "row") {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  sheet <- wb$validateSheet(sheet)
  
  type <- tolower(type)[1]
  if (!type %in% c("row", "column")) {
    stop("'type' argument must be 'row' or 'column'.")
  }
  
  if (!is.numeric(i)) {
    stop("'i' must be numeric.")
  }
  i <- round(i)
  
  if (type == "row") {
    wb$worksheets[[sheet]]$rowBreaks <- c(
      wb$worksheets[[sheet]]$rowBreaks,
      sprintf('<brk id="%s" max="16383" man="1"/>', i)
    )
  } else if (type == "column") {
    wb$worksheets[[sheet]]$colBreaks <- c(
      wb$worksheets[[sheet]]$colBreaks,
      sprintf('<brk id="%s" max="1048575" man="1"/>', i)
    )
  }
  
  
  # wb$worksheets[[sheet]]$autoFilter <- sprintf('<autoFilter ref="%s"/>', paste(getCellRefs(data.frame("x" = c(rows, rows), "y" = c(min(cols), max(cols)))), collapse = ":"))
  
  invisible(wb)
}


















#' @name conditionalFormat
#' @title Add conditional formatting to cells
#' @description DEPRECATED! USE \code{\link{conditionalFormatting}}
#' @author Alexander Walker
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param cols Columns to apply conditional formatting to
#' @param rows Rows to apply conditional formatting to
#' @param rule The condition under which to apply the formatting or a vector of colours. See examples.
#' @param style A style to apply to those cells that satisfy the rule. A Style object returned from createStyle()
#' @details DEPRECATED! USE \code{\link{conditionalFormatting}}
#'
#' Valid operators are "<", "<=", ">", ">=", "==", "!=". See Examples.
#' Default style given by: createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
#' @param type Either 'expression', 'colorscale' or 'databar'. If 'expression' the formatting is determined
#' by a formula.  If colorScale cells are coloured based on cell value. See examples.
#' @seealso \code{\link{createStyle}}
#' @export
conditionalFormat <- function(wb, sheet, cols, rows, rule = NULL, style = NULL, type = "expression") {
  warning("conditionalFormat() has been deprecated. Use conditionalFormatting().")
  ## Rule always applies to top left of sqref, $ determine which cells the rule depends on
  ## Rule for "databar" and colourscale are colours of length 2/3 or 1 respectively.
  
  type <- tolower(type)
  if (tolower(type) %in% c("colorscale", "colourscale")) {
    type <- "colorScale"
  } else if (type == "databar") {
    type <- "dataBar"
  } else if (type != "expression") {
    stop("Invalid type argument.  Type must be 'expression', 'colourScale' or 'databar'")
  }
  
  ## rows and cols
  if (!is.numeric(cols)) {
    cols <- convertFromExcelRef(cols)
  }
  rows <- as.integer(rows)
  
  ## check valid rule
  if (type == "colorScale") {
    if (!length(rule) %in% 2:3) {
      stop("rule must be a vector containing 2 or 3 colours if type is 'colorScale'")
    }
    
    rule <- validateColour(rule, errorMsg = "Invalid colour specified in rule.")
    dxfId <- NULL
  } else if (type == "dataBar") {
    
    ## If rule is NULL use default colour
    if (is.null(rule)) {
      rule <- "FF638EC6"
    } else {
      rule <- validateColour(rule, errorMsg = "Invalid colour specified in rule.")
    }
    
    dxfId <- NULL
  } else { ## else type == "expression"
    
    rule <- toupper(gsub(" ", "", rule))
    rule <- replaceIllegalCharacters(rule)
    rule <- gsub("!=", "&lt;&gt;", rule)
    rule <- gsub("==", "=", rule)
    
    if (!grepl("[A-Z]", substr(rule, 1, 2))) {
      
      ## formula looks like "operatorX" , attach top left cell to rule
      rule <- paste0(getCellRefs(data.frame("x" = min(rows), "y" = min(cols))), rule)
    } ## else, there is a letter in the formula and apply as is
    
    if (is.null(style)) {
      style <- createStyle(fontColour = "#9C0006", bgFill = "#FFC7CE")
    }
    
    invisible(dxfId <- wb$addDXFS(style))
  }
  
  
  invisible(wb$conditionalFormatCell(sheet,
                                     startRow = min(rows),
                                     endRow = max(rows),
                                     startCol = min(cols),
                                     endCol = max(cols),
                                     dxfId,
                                     formula = rule,
                                     type = type
  ))
  
  invisible(0)
}




#' @name all.equal
#' @aliases all.equal.Workbook
#' @title Check equality of workbooks
#' @description Check equality of workbooks
#' @method all.equal Workbook
#' @param target A \code{Workbook} object
#' @param current A \code{Workbook} object
#' @param ... ignored
all.equal.Workbook <- function(target, current, ...) {
  
  
  # print("Comparing workbooks...")
  #   ".rels",
  #   "app",
  #   "charts",
  #   "colWidths",
  #   "Content_Types",
  #   "core",
  #   "drawings",
  #   "drawings_rels",
  #   "media",
  #   "rowHeights",
  #   "workbook",
  #   "workbook.xml.rels",
  #   "worksheets",
  #   "sheetOrder"
  #   "sharedStrings",
  #   "tables",
  #   "tables.xml.rels",
  #   "theme"
  
  
  ## TODO
  # sheet_data
  
  x <- target
  y <- current
  
  
  
  
  nSheets <- length(names(x))
  failures <- NULL
  
  flag <- all(names(x$charts) %in% names(y$charts)) & all(names(y$charts) %in% names(x$charts))
  if (!flag) {
    message("charts not equal")
    failures <- c(failures, "wb$charts")
  }
  
  flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(x$colWidths[[i]], y$colWidths[[i]]))))
  if (!flag) {
    message("colWidths not equal")
    failures <- c(failures, "wb$colWidths")
  }
  
  flag <- all(x$Content_Types %in% y$Content_Types) & all(y$Content_Types %in% x$Content_Types)
  if (!flag) {
    message("Content_Types not equal")
    failures <- c(failures, "wb$Content_Types")
  }
  
  flag <- all(unlist(x$core) == unlist(y$core))
  if (!flag) {
    message("core not equal")
    failures <- c(failures, "wb$core")
  }
  
  
  flag <- all(unlist(x$drawings) %in% unlist(y$drawings)) & all(unlist(y$drawings) %in% unlist(x$drawings))
  if (!flag) {
    message("drawings not equal")
    failures <- c(failures, "wb$drawings")
  }
  
  flag <- all(unlist(x$drawings_rels) %in% unlist(y$drawings_rels)) & all(unlist(y$drawings_rels) %in% unlist(x$drawings_rels))
  if (!flag) {
    message("drawings_rels not equal")
    failures <- c(failures, "wb$drawings_rels")
  }
  
  flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(x$drawings_rels[[i]], y$drawings_rels[[i]]))))
  if (!flag) {
    message("drawings_rels not equal")
    failures <- c(failures, "wb$drawings_rels")
  }
  
  
  
  
  flag <- all(names(x$media) %in% names(y$media) & names(y$media) %in% names(x$media))
  if (!flag) {
    message("media not equal")
    failures <- c(failures, "wb$media")
  }
  
  flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(x$rowHeights[[i]], y$rowHeights[[i]]))))
  if (!flag) {
    message("rowHeights not equal")
    failures <- c(failures, "wb$rowHeights")
  }
  
  flag <- all(sapply(1:nSheets, function(i) isTRUE(all.equal(names(x$rowHeights[[i]]), names(y$rowHeights[[i]])))))
  if (!flag) {
    message("rowHeights not equal")
    failures <- c(failures, "wb$rowHeights")
  }
  
  flag <- all(x$sharedStrings %in% y$sharedStrings) & all(y$sharedStrings %in% x$sharedStrings) & (length(x$sharedStrings) == length(y$sharedStrings))
  if (!flag) {
    message("sharedStrings not equal")
    failures <- c(failures, "wb$sharedStrings")
  }
  
  
  
  # flag <- sapply(1:nSheets, function(i) isTRUE(all.equal(x$worksheets[[i]]$sheet_data, y$worksheets[[i]]$sheet_data)))
  # if(!all(flag)){
  #
  #   tmp_x <- x$sheet_data[[which(!flag)[[1]]]]
  #   tmp_y <- y$sheet_data[[which(!flag)[[1]]]]
  #
  #   tmp_x_e <- sapply(tmp_x, "[[", "r")
  #   tmp_y_e <- sapply(tmp_y, "[[", "r")
  #   flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "")
  #   if(any(flag)){
  #     message(sprintf("sheet_data %s not equal", which(!flag)[[1]]))
  #     message(sprintf("r elements: %s", paste(which(flag), collapse = ", ")))
  #     return(FALSE)
  #   }
  #
  #   tmp_x_e <- sapply(tmp_x, "[[", "t")
  #   tmp_y_e <- sapply(tmp_y, "[[", "t")
  #   flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "")
  #   if(any(flag)){
  #     message(sprintf("sheet_data %s not equal", which(!flag)[[1]]))
  #     message(sprintf("t elements: %s", paste(which(isTRUE(flag)), collapse = ", ")))
  #     return(FALSE)
  #   }
  #
  #
  #   tmp_x_e <- sapply(tmp_x, "[[", "v")
  #   tmp_y_e <- sapply(tmp_y, "[[", "v")
  #   flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "")
  #   if(any(flag)){
  #     message(sprintf("sheet_data %s not equal", which(!flag)[[1]]))
  #     message(sprintf("v elements: %s", paste(which(flag), collapse = ", ")))
  #     return(FALSE)
  #   }
  #
  #   tmp_x_e <- sapply(tmp_x, "[[", "f")
  #   tmp_y_e <- sapply(tmp_y, "[[", "f")
  #   flag <- paste0(tmp_x_e, "") != paste0(tmp_x_e, "")
  #   if(any(flag)){
  #     message(sprintf("sheet_data %s not equal", which(!flag)[[1]]))
  #     message(sprintf("f elements: %s", paste(which(flag), collapse = ", ")))
  #     return(FALSE)
  #   }
  # }
  
  
  flag <- all(names(x$styles) %in% names(y$styles)) & all(names(y$styles) %in% names(x$styles))
  if (!flag) {
    message("names styles not equal")
    failures <- c(failures, "names of styles not equal")
  }
  
  flag <- all(unlist(x$styles) %in% unlist(y$styles)) & all(unlist(y$styles) %in% unlist(x$styles))
  if (!flag) {
    message("styles not equal")
    failures <- c(failures, "styles not equal")
  }
  
  
  flag <- length(x$styleObjects) == length(y$styleObjects)
  if (!flag) {
    message("styleObjects lengths not equal")
    failures <- c(failures, "styleObjects lengths not equal")
  }
  
  
  nStyles <- length(x$styleObjects)
  if (nStyles > 0) {
    for (i in 1:nStyles) {
      sx <- x$styleObjects[[i]]
      sy <- y$styleObjects[[i]]
      
      flag <- isTRUE(all.equal(sx$sheet, sy$sheet))
      if (!flag) {
        message(sprintf("styleObjects '%s' sheet name not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' sheet name not equal", i))
      }
      
      
      flag <- isTRUE(all.equal(sx$rows, sy$rows))
      if (!flag) {
        message(sprintf("styleObjects '%s' rows not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' rows not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$cols, sy$cols))
      if (!flag) {
        message(sprintf("styleObjects '%s' cols not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' cols not equal", i))
      }
      
      ## check style class equality
      flag <- isTRUE(all.equal(sx$style$fontName, sy$style$fontName))
      if (!flag) {
        message(sprintf("styleObjects '%s' fontName not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' fontName not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$fontColour, sy$style$fontColour))
      if (!flag) {
        message(sprintf("styleObjects '%s' fontColour not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' fontColour not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$fontSize, sy$style$fontSize))
      if (!flag) {
        message(sprintf("styleObjects '%s' fontSize not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' fontSize not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$fontFamily, sy$style$fontFamily))
      if (!flag) {
        message(sprintf("styleObjects '%s' fontFamily not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' fontFamily not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$fontDecoration, sy$style$fontDecoration))
      if (!flag) {
        message(sprintf("styleObjects '%s' fontDecoration not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' fontDecoration not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$borderTop, sy$style$borderTop))
      if (!flag) {
        message(sprintf("styleObjects '%s' borderTop not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' borderTop not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$borderLeft, sy$style$borderLeft))
      if (!flag) {
        message(sprintf("styleObjects '%s' borderLeft not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' borderLeft not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$borderRight, sy$style$borderRight))
      if (!flag) {
        message(sprintf("styleObjects '%s' borderRight not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' borderRight not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$borderBottom, sy$style$borderBottom))
      if (!flag) {
        message(sprintf("styleObjects '%s' borderBottom not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' borderBottom not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$borderTopColour, sy$style$borderTopColour))
      if (!flag) {
        message(sprintf("styleObjects '%s' borderTopColour not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' borderTopColour not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$borderLeftColour, sy$style$borderLeftColour))
      if (!flag) {
        message(sprintf("styleObjects '%s' borderLeftColour not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' borderLeftColour not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$borderRightColour, sy$style$borderRightColour))
      if (!flag) {
        message(sprintf("styleObjects '%s' borderRightColour not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' borderRightColour not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$borderBottomColour, sy$style$borderBottomColour))
      if (!flag) {
        message(sprintf("styleObjects '%s' borderBottomColour not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' borderBottomColour not equal", i))
      }
      
      
      flag <- isTRUE(all.equal(sx$style$halign, sy$style$halign))
      if (!flag) {
        message(sprintf("styleObjects '%s' halign not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' halign not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$valign, sy$style$valign))
      if (!flag) {
        message(sprintf("styleObjects '%s' valign not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' valign not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$indent, sy$style$indent))
      if (!flag) {
        message(sprintf("styleObjects '%s' indent not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' indent not equal", i))
      }
      
      
      flag <- isTRUE(all.equal(sx$style$textRotation, sy$style$textRotation))
      if (!flag) {
        message(sprintf("styleObjects '%s' textRotation not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' textRotation not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$numFmt, sy$style$numFmt))
      if (!flag) {
        message(sprintf("styleObjects '%s' numFmt not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' numFmt not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$fill, sy$style$fill))
      if (!flag) {
        message(sprintf("styleObjects '%s' fill not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' fill not equal", i))
      }
      
      flag <- isTRUE(all.equal(sx$style$wrapText, sy$style$wrapText))
      if (!flag) {
        message(sprintf("styleObjects '%s' wrapText not equal", i))
        failures <- c(failures, sprintf("styleObjects '%s' wrapText not equal", i))
      }
    }
  }
  
  
  flag <- all(x$sheet_names %in% y$sheet_names) & all(y$sheet_names %in% x$sheet_names)
  if (!flag) {
    message("names workbook not equal")
    failures <- c(failures, "names workbook not equal")
  }
  
  flag <- all(unlist(x$workbook) %in% unlist(y$workbook)) & all(unlist(y$workbook) %in% unlist(x$workbook))
  if (!flag) {
    message("workbook not equal")
    failures <- c(failures, "wb$workbook")
  }
  
  flag <- all(unlist(x$workbook.xml.rels) %in% unlist(y$workbook.xml.rels)) & all(unlist(y$workbook.xml.rels) %in% unlist(x$workbook.xml.rels))
  if (!flag) {
    message("workbook.xml.rels not equal")
    failures <- c(failures, "wb$workbook.xml.rels")
  }
  
  
  for (i in 1:nSheets) {
    ws_x <- x$worksheets[[i]]
    ws_y <- y$worksheets[[i]]
    
    flag <- all(names(ws_x) %in% names(ws_y)) & all(names(ws_y) %in% names(ws_x))
    if (!flag) {
      message(sprintf("names of worksheet elements for sheet %s not equal", i))
      failures <- c(failures, sprintf("names of worksheet elements for sheet %s not equal", i))
    }
    
    nms <- c(
      "sheetPr", "dataValidations", "sheetViews", "cols", "pageMargins",
      "extLst", "conditionalFormatting", "oleObjects",
      "colBreaks", "dimension", "drawing", "sheetFormatPr", "tableParts",
      "mergeCells", "hyperlinks", "headerFooter", "autoFilter",
      "rowBreaks", "pageSetup", "freezePane", "legacyDrawingHF", "legacyDrawing"
    )
    
    for (j in nms) {
      flag <- isTRUE(all.equal(gsub(" |\t", "", ws_x[[j]]), gsub(" |\t", "", ws_y[[j]])))
      if (!flag) {
        message(sprintf("worksheet '%s', element '%s' not equal", i, j))
        failures <- c(failures, sprintf("worksheet '%s', element '%s' not equal", i, j))
      }
    }
  }
  
  
  flag <- all(unlist(x$sheetOrder) %in% unlist(y$sheetOrder)) & all(unlist(y$sheetOrder) %in% unlist(x$sheetOrder))
  if (!flag) {
    message("sheetOrder not equal")
    failures <- c(failures, "sheetOrder not equal")
  }
  
  
  flag <- length(x$tables) == length(y$tables)
  if (!flag) {
    message("length of tables not equal")
    failures <- c(failures, "length of tables not equal")
  }
  
  flag <- all(names(x$tables) == names(y$tables))
  if (!flag) {
    message("names of tables not equal")
    failures <- c(failures, "names of tables not equal")
  }
  
  flag <- all(unlist(x$tables) == unlist(y$tables))
  if (!flag) {
    message("tables not equal")
    failures <- c(failures, "tables not equal")
  }
  
  
  flag <- isTRUE(all.equal(x$tables.xml.rels, y$tables.xml.rels))
  if (!flag) {
    message("tables.xml.rels not equal")
    failures <- c(failures, "tables.xml.rels not equal")
  }
  
  flag <- x$theme == y$theme
  if (!flag) {
    message("theme not equal")
    failures <- c(failures, "theme not equal")
  }
  
  if (!is.null(failures)) {
    return(FALSE)
  }
  
  
  #   "connections",
  #   "externalLinks",
  #   "externalLinksRels",
  #   "headFoot",
  #   "pivotTables",
  #   "pivotTables.xml.rels",
  #   "pivotDefinitions",
  #   "pivotRecords",
  #   "pivotDefinitionsRels",
  #   "queryTables",
  #   "slicers",
  #   "slicerCaches",
  #   "vbaProject",
  
  
  return(TRUE)
}



#' @name sheetVisible
#' @title Get worksheet visible state.
#' @description DEPRECATED - Use function 'sheetVisibility()
#' @author Alexander Walker
#' @param wb A workbook object
#' @return Character vector of worksheet names.
#' @return  TRUE if sheet is visible, FALSE if sheet is hidden
#' @examples
#'
#' wb <- createWorkbook()
#' addWorksheet(wb, sheetName = "S1", visible = FALSE)
#' addWorksheet(wb, sheetName = "S2", visible = TRUE)
#' addWorksheet(wb, sheetName = "S3", visible = FALSE)
#'
#' sheetVisible(wb)
#' sheetVisible(wb)[1] <- TRUE ## show sheet 1
#' sheetVisible(wb)[2] <- FALSE ## hide sheet 2
#' @export
sheetVisible <- function(wb) {
  warning("This function is deprecated. Use function 'sheetVisibility()'")
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  state <- rep(TRUE, length(wb$workbook$sheets))
  state[grepl("hidden", wb$workbook$sheets)] <- FALSE
  
  return(state)
}

#' @rdname sheetVisible
#' @param value a logical vector the same length as sheetVisible(wb)
#' @export
`sheetVisible<-` <- function(wb, value) {
  warning("This function is deprecated. Use function 'sheetVisibility()'")
  
  if (!is.logical(value)) {
    stop("value must be a logical vector.")
  }
  
  if (!any(value)) {
    stop("A workbook must have atleast 1 visible worksheet.")
  }
  
  value <- as.character(value)
  value[value %in% "TRUE"] <- "visible"
  value[value %in% "FALSE"] <- "hidden"
  
  exState <- rep("visible", length(wb$workbook$sheets))
  exState[grepl("hidden", wb$workbook$sheets)] <- "hidden"
  
  if (length(value) != length(wb$workbook$sheets)) {
    stop(sprintf("value vector must have length equal to number of worksheets in Workbook [%s]", length(exState)))
  }
  
  inds <- which(value != exState)
  if (length(inds) == 0) {
    return(invisible(wb))
  }
  
  for (i in inds) {
    wb$workbook$sheets[i] <- gsub(exState[i], value[i], wb$workbook$sheets[i])
  }
  
  invisible(wb)
}



#' @name copyWorkbook
#' @title Copy a Workbook object.
#' @description Just a wrapper of wb$copy()
#' @param wb A workbook object
#' @return Workbook
#' @examples
#'
#' wb <- createWorkbook()
#' wb2 <- wb ## does not create a copy
#' wb3 <- copyWorkbook(wb) ## wrapper for wb$copy()
#'
#' addWorksheet(wb, "Sheet1") ## adds worksheet to both wb and wb2 but not wb3
#'
#' names(wb)
#' names(wb2)
#' names(wb3)
#' @export
copyWorkbook <- function(wb) {
  if (!inherits(wb, "Workbook")) {
    stop("argument must be a Workbook.")
  }
  
  return(wb$copy())
}





#' @name getTables
#' @title List Excel tables in a workbook
#' @description List Excel tables in a workbook
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @return character vector of table names on the specified sheet
#' @examples
#'
#' wb <- createWorkbook()
#' addWorksheet(wb, sheetName = "Sheet 1")
#' writeDataTable(wb, sheet = "Sheet 1", x = iris)
#' writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10)
#'
#' getTables(wb, sheet = "Sheet 1")
#' @export
getTables <- function(wb, sheet) {
  if (!inherits(wb, "Workbook")) {
    stop("argument must be a Workbook.")
  }
  
  if (length(sheet) != 1) {
    stop("sheet argument must be length 1")
  }
  
  if (length(wb$tables) == 0) {
    return(character(0))
  }
  
  sheet <- wb$validateSheet(sheetName = sheet)
  
  table_sheets <- attr(wb$tables, "sheet")
  tables <- attr(wb$tables, "tableName")
  refs <- names(wb$tables)
  
  refs <- refs[table_sheets == sheet & !grepl("openxlsx_deleted", tables, fixed = TRUE)]
  tables <- tables[table_sheets == sheet & !grepl("openxlsx_deleted", tables, fixed = TRUE)]
  
  if (length(tables) > 0) {
    attr(tables, "refs") <- refs
  }
  
  return(tables)
}





#' @name removeTable
#' @title Remove an Excel table in a workbook
#' @description List Excel tables in a workbook
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param table Name of table to remove. See \code{\link{getTables}}
#' @return character vector of table names on the specified sheet
#' @examples
#'
#' wb <- createWorkbook()
#' addWorksheet(wb, sheetName = "Sheet 1")
#' addWorksheet(wb, sheetName = "Sheet 2")
#' writeDataTable(wb, sheet = "Sheet 1", x = iris, tableName = "iris")
#' writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10)
#'
#'
#' removeWorksheet(wb, sheet = 1) ## delete worksheet removes table objects
#'
#' writeDataTable(wb, sheet = 1, x = iris, tableName = "iris")
#' writeDataTable(wb, sheet = 1, x = mtcars, tableName = "mtcars", startCol = 10)
#'
#' ## removeTable() deletes table object and all data
#' getTables(wb, sheet = 1)
#' removeTable(wb = wb, sheet = 1, table = "iris")
#' writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1)
#'
#' getTables(wb, sheet = 1)
#' removeTable(wb = wb, sheet = 1, table = "iris")
#' writeDataTable(wb, sheet = 1, x = iris, tableName = "iris", startCol = 1)
#' \dontrun{
#' saveWorkbook(wb = wb, file = "removeTableExample.xlsx", overwrite = TRUE)
#' }
#'
#' @export
removeTable <- function(wb, sheet, table) {
  if (!inherits(wb, "Workbook")) {
    stop("argument must be a Workbook.")
  }
  
  if (length(sheet) != 1) {
    stop("sheet argument must be length 1")
  }
  
  if (length(table) != 1) {
    stop("table argument must be length 1")
  }
  
  ## delete table object and all data in it
  sheet <- wb$validateSheet(sheetName = sheet)
  
  if (!table %in% attr(wb$tables, "tableName")) {
    stop(sprintf("table '%s' does not exist.", table), call. = FALSE)
  }
  
  ## get existing tables
  table_sheets <- attr(wb$tables, "sheet")
  table_names <- attr(wb$tables, "tableName")
  refs <- names(wb$tables)
  
  ## delete table object (by flagging as deleted)
  inds <- which(table_sheets %in% sheet & table_names %in% table)
  table_name_original <- table_names[inds]
  
  table_names[inds] <- paste0(table_name_original, "_openxlsx_deleted")
  attr(wb$tables, "tableName") <- table_names
  
  ## delete reference from worksheet to table
  worksheet_table_names <- attr(wb$worksheets[[sheet]]$tableParts, "tableName")
  to_remove <- which(worksheet_table_names == table_name_original)
  
  wb$worksheets[[sheet]]$tableParts <- wb$worksheets[[sheet]]$tableParts[-to_remove]
  attr(wb$worksheets[[sheet]]$tableParts, "tableName") <- worksheet_table_names[-to_remove]
  
  
  ## Now delete data from the worksheet
  refs <- strsplit(refs[[inds]], split = ":")[[1]]
  rows <- as.integer(gsub("[A-Z]", "", refs))
  rows <- seq(from = rows[1], to = rows[2], by = 1)
  
  cols <- convertFromExcelRef(refs)
  cols <- seq(from = cols[1], to = cols[2], by = 1)
  
  ## now delete data
  deleteData(wb = wb, sheet = sheet, rows = rows, cols = cols, gridExpand = TRUE)
  
  invisible(0)
}

#' @name groupColumns
#' @title Group columns
#' @description Group a selection of columns
#' @author Joshua Sturm
#' @param wb A workbook object.
#' @param sheet A name or index of a worksheet.
#' @param cols Indices of cols to group.
#' @param hidden Logical vector. If TRUE the grouped columns are hidden. Defaults to FALSE.
#' @details Group columns together, with the option to hide them.
#'
#' NOTE: \code{\link{setColWidths}} has a conflicting \code{hidden} parameter; changing one will update the other.
#' @seealso \code{\link{ungroupColumns}} to ungroup columns. \code{\link{groupRows}} for grouping rows.
#' @export
#'
groupColumns <- function(wb, sheet, cols, hidden = FALSE) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  sheet <- wb$validateSheet(sheet)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  if (any(cols) < 1L) {
    stop("Invalid columns selected (<= 0).")
  }
  
  if (!is.logical(hidden)) {
    stop("Hidden should be a logical value (TRUE/FALSE).")
  }
  
  if (length(hidden) > length(cols)) {
    stop("Hidden argument is of greater length than number of cols.")
  }
  
  levels <- rep("1", length(cols))
  hidden <- rep(hidden, length.out = length(cols))

  hidden <- hidden[!duplicated(cols)]
  levels <- levels[!duplicated(cols)]
  cols <- cols[!duplicated(cols)]
  cols <- convertFromExcelRef(cols)
  
  if (length(wb$colWidths[[sheet]]) > 0) {
    existing_cols <- names(wb$colWidths[[sheet]])
    existing_hidden <- attr(wb$colWidths[[sheet]], "hidden", exact = TRUE)
    
    if (any(existing_cols %in% cols)) {
      for (i in intersect(existing_cols, cols)) {
        width_hidden <- attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") == i]
        outline_hidden <- as.character(as.integer(hidden))[cols == i]

        if (width_hidden != outline_hidden) {
          attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") == i] <- outline_hidden
        }
      }
      
      # cols <- cols[!cols %in% existing_cols]
      # hidden <- attr(wb$colOutlineLevels[[sheet]], "hidden")[attr(wb$colOutlineLevels[[sheet]], "name") %in% cols]
      
      # wb$colOutlineLevels[[sheet]] <- cols
      # attr(wb$colOutlineLevels[[sheet]], "hidden") <- as.character(as.integer(hidden))
    }
  }
  
  if (length(wb$colOutlineLevels[[sheet]]) > 0) {
    existing_cols <- names(wb$colOutlineLevels[[sheet]])
    existing_levels <- unname(wb$colOutlineLevels[[sheet]])
    existing_hidden <- attr(wb$colOutlineLevels[[sheet]], "hidden")
    
    # check if column is already grouped
    flag <- existing_cols %in% cols
    if (any(flag)) {
      existing_cols <- existing_cols[!flag]
      existing_levels <- existing_levels[!flag]
      existing_hidden <- existing_hidden[!flag]
    }
    
    all_names <- c(existing_cols, cols)
    all_levels <- c(existing_levels, levels)
    all_hidden <- c(existing_hidden, as.character(as.integer(hidden)))
    
    ord <- order(as.integer(all_names))
    all_names <- all_names[ord]
    all_levels <- all_levels[ord]
    all_hidden <- all_hidden[ord]
    
    
    names(all_levels) <- all_names
    wb$colOutlineLevels[[sheet]] <- all_levels
    levels <- all_levels
    attr(wb$colOutlineLevels[[sheet]], "hidden") <- as.character(as.integer(all_hidden))
    hidden <- all_hidden
  } else {
    names(levels) <- cols
    wb$colOutlineLevels[[sheet]] <- levels
    attr(wb$colOutlineLevels[[sheet]], "hidden") <- as.character(as.integer(hidden))
  }
  
  invisible(0)
}

#' @name ungroupColumns
#' @title Ungroup Columns
#' @description Ungroup a selection of columns
#' @author Joshua Sturm
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param cols Indices of columns to ungroup
#' @details If column was previously hidden, it will now be shown
#' @seealso \code{\link{ungroupRows}} To ungroup rows
#' @export

ungroupColumns <- function(wb, sheet, cols) {
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  sheet <- wb$validateSheet(sheet)
  
  if (!is.numeric(cols)) {
    cols <- convertFromExcelRef(cols)
  }
  
  if (any(cols) < 1L) {
    stop("Invalid columns selected (<= 0).")
  }
  
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  customCols <- as.integer(names(wb$colOutlineLevels[[sheet]]))
  removeInds <- which(customCols %in% cols)
  
  # Check if any selected columns are already grouped
  if (length(removeInds) > 0) {
    remainingCols <- customCols[-removeInds]
    if (length(remainingCols) == 0) {
      wb$colOutlineLevels[[sheet]] <- list()
      wb$worksheets[[sheet]]$sheetFormatPr <- sub(' outlineLevelCol="1"', "", wb$worksheets[[sheet]]$sheetFormatPr)
    } else {
      rem_widths <- wb$colOutlineLevels[[sheet]][-removeInds]
      names(rem_widths) <- as.character(remainingCols)
      wb$colOutlineLevels[[sheet]] <- rem_widths
    }
  }
  
  if (length(wb$colWidths[[sheet]]) > 0) {
    if (any(cols %in% names(wb$colWidths[[sheet]]))) {
      attr(wb$colWidths[[sheet]], "hidden")[attr(wb$colWidths[[sheet]], "names") %in% cols] <- "0"
    }
  }
}

#' @name groupRows
#' @title Group Rows
#' @description Group a selection of rows
#' @author Joshua Sturm
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param rows Indices of rows to group
#' @param hidden Logical vector. If TRUE the grouped columns are hidden. Defaults to FALSE
#' @seealso \code{\link{ungroupRows}} to ungroup rows. \code{\link{groupColumns}} for grouping columns.
#' @export

groupRows <- function(wb, sheet, rows, hidden = FALSE) {
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  sheet <- wb$validateSheet(sheet)
  
  if (length(hidden) > length(rows)) {
    stop("Hidden argument is of greater length than number of rows.")
  }
  
  if (!is.logical(hidden)) {
    stop("Hidden should be a logical value (TRUE/FALSE).")
  }
  
  if (any(rows) < 1L) {
    stop("Invalid rows entered (<= 0).")
  }
  
  hidden <- rep(as.character(as.integer(hidden)), length.out = length(rows))
  
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  levels <- rep("1", length(rows))
  
  # Remove duplicates
  hidden <- hidden[!duplicated(rows)]
  levels <- levels[!duplicated(rows)]
  rows <- rows[!duplicated(rows)]
  
  names(levels) <- rows
  
  wb$groupRows(sheet = sheet, rows = rows, hidden = hidden, levels = levels)
}

#' @name ungroupRows
#' @title Ungroup Rows
#' @description Ungroup a selection of rows
#' @author Joshua Sturm
#' @param wb A workbook object
#' @param sheet A name or index of a worksheet
#' @param rows Indices of rows to ungroup
#' @details If row was previously hidden, it will now be shown
#' @seealso \code{\link{ungroupColumns}}
#' @export

ungroupRows <- function(wb, sheet, rows) {
  od <- getOption("OutDec")
  options("OutDec" = ".")
  on.exit(expr = options("OutDec" = od), add = TRUE)
  
  if (!"Workbook" %in% class(wb)) {
    stop("First argument must be a Workbook.")
  }
  
  sheet <- wb$validateSheet(sheet)
  
  if (any(rows) < 1L) {
    stop("Invalid rows entered (<= 0).")
  }
  
  customRows <- as.integer(names(wb$outlineLevels[[sheet]]))
  removeInds <- which(customRows %in% rows)
  if (length(removeInds) > 0) {
    wb$outlineLevels[[sheet]] <- wb$outlineLevels[[sheet]][-removeInds]
  }
  
  if (length(wb$outlineLevels[[sheet]]) == 0) {
    wb$worksheets[[sheet]]$sheetFormatPr <- sub(' outlineLevelRow="1"', "", wb$worksheets[[sheet]]$sheetFormatPr)
  }
}




#' @name addCreator
#' @title Add another author to the meta data of the file.
#' @author Philipp Schauberger
#' @description Just a wrapper of wb$addCreator()
#' @param wb A workbook object
#' @param Creator A string object with the name of the creator
#' @examples
#'
#' wb <- createWorkbook()
#' addCreator(wb, "test")
#' @export
addCreator <- function(wb, Creator) {
  if (!inherits(wb, "Workbook")) {
    stop("argument must be a Workbook.")
  }
  
  invisible(wb$addCreator(Creator))
}

#' @name setLastModifiedBy
#' @title Add another author to the meta data of the file.
#' @author Philipp Schauberger
#' @description Just a wrapper of wb$changeLastModifiedBy()
#' @param wb A workbook object
#' @param LastModifiedBy A string object with the name of the LastModifiedBy-User
#' @examples
#'
#' wb <- createWorkbook()
#' setLastModifiedBy(wb, "test")
#' @export
setLastModifiedBy <- function(wb, LastModifiedBy) {
  if (!inherits(wb, "Workbook")) {
    stop("argument must be a Workbook.")
  }
  
  invisible(wb$changeLastModifiedBy(LastModifiedBy))
}



#' @name getCreators
#' @title Add another author to the meta data of the file.
#' @description Just a wrapper of wb$getCreators()
#' Get the names of the
#' @param wb A workbook object
#' @author Philipp Schauberger
#' @return vector of creators
#' @examples
#'
#' wb <- createWorkbook()
#' getCreators(wb)
#' @export
getCreators <- function(wb) {
  if (!inherits(wb, "Workbook")) {
    stop("argument must be a Workbook.")
  }
  
  return(wb$getCreators())
}
