gen_raw_html <- function(
  x,
  class = "tabwid",
  caption = "",
  topcaption = TRUE,
  manual_css = ""
) {
  align <- x$properties$align
  # for ubiquity and other packages that dump old flextable
  if (is.null(align)) {
    align <- "center"
  }

  fixed_layout <- x$properties$layout %in% "fixed"
  if (!fixed_layout) {
    if (x$properties$width > 0) {
      # setting width will contraint columns'widths and make word breaks
      tbl_width <- paste0("width:", formatC(x$properties$width * 100), "%;")
    } else {
      tbl_width <- ""
    }
    tabcss <- paste0("table-layout:auto;", tbl_width)
  } else {
    tabcss <- ""
  }

  codes <- html_content_strs(x)

  classname <- UUIDgenerate(n = 1, use.time = TRUE)
  classname <- gsub("(^[[:alnum:]]+)(.*)$", "cl-\\1", classname)
  tabcss <- paste0(".", classname, "{", tabcss, "}")

  if (is.null(manual_css) || "" %in% manual_css) {
    manual_css_str <- ""
  } else {
    manual_css_str <- manual_css
  }

  if (!is.null(x$properties$opts_html$scroll)) {
    freeze_first_column <- x$properties$opts_html$scroll$freeze_first_column
    if (isTRUE(freeze_first_column)) {
      freeze_first_css_th <- paste0(
        ".",
        classname,
        " thead > tr > th:first-child {position:sticky;left:0;z-index:5;}"
      )
      freeze_first_css_td <- paste0(
        ".",
        classname,
        " tbody > tr > td:first-child {position:sticky;left:0;z-index:3;}"
      )
      freeze_first_css <- paste0(
        c(freeze_first_css_th, freeze_first_css_td),
        collapse = ""
      )

      x$properties$opts_html$extra_css <- paste0(
        freeze_first_css,
        x$properties$opts_html$extra_css
      )
    }

    if (!is.null(x$properties$opts_html$scroll$height)) {
      x$properties$opts_html$extra_css <- paste0(
        ".",
        classname,
        " th {position: sticky;top: 0;z-index: 4;}.",
        classname,
        " {border-collapse: separate !important;}",
        x$properties$opts_html$extra_css
      )
    }
  }

  if (!is.null(x$properties$opts_html$extra_class)) {
    classname <- c(
      classname,
      x$properties$opts_html$extra_class
    )
    classname <- paste0(classname, collapse = " ")
  }

  html <- paste0(
    "<style>",
    tabcss,
    codes$css,
    x$properties$opts_html$extra_css,
    manual_css_str,
    "</style>",
    sprintf(
      "<table data-quarto-disable-processing='true' class='%s'>",
      classname
    ),
    caption,
    codes$html,
    "</table>"
  )

  if (is.null(align)) {
    align <- "center"
  }
  if ("left" %in% align) {
    tab_class <- paste0(class, " tabwid_left")
  } else if ("right" %in% align) {
    tab_class <- paste0(class, " tabwid_right")
  } else {
    tab_class <- class
  }

  if (!topcaption) {
    tab_class <- paste0(tab_class, " tabwid-caption-bottom")
  }

  style_div <- ""
  if (!is.null(x$properties$opts_html$scroll)) {
    style_div <- do.call(scrollbox, x$properties$opts_html$scroll)
    style_div <- paste0(" style=\"", style_div, "\"")
  }

  html <- paste0(
    "<div class=\"",
    tab_class,
    "\"",
    style_div,
    ">",
    html,
    "</div>"
  )
  html
}


scrollbox <- function(height = NULL, add_css = "", ...) {
  str <- "overflow-x:auto;width:100%;"
  if (!is.null(height)) {
    if (is.numeric(height)) {
      height <- sprintf("%.0fpx", height)
    }
    str <- paste0(str, "overflow-y:auto;height:", height, ";")
  }
  str <- paste0(str, add_css)
  str
}

# to html/css  ----
#' @importFrom data.table setnames setorderv := setcolorder setDT setDF dcast
html_content_strs <- function(x) {
  cell_data_f <- information_data_cell(x)
  setDT(cell_data_f)
  par_data_f <- information_data_paragraph(x)
  setDT(par_data_f)

  txt_data <- runs_as_html(x, chunk_data = information_data_chunk(x))
  span_style_str <- attr(txt_data, "css")
  setDT(txt_data)

  cell_data <- merge(
    x = cell_data_f,
    y = par_data_f[, c(".part", ".row_id", ".col_id", "text.align")],
    by = c(".part", ".row_id", ".col_id")
  )
  par_data <- merge(
    x = par_data_f,
    y = cell_data_f[, c(
      ".part",
      ".row_id",
      ".col_id",
      "text.direction",
      "vertical.align"
    )],
    by = c(".part", ".row_id", ".col_id")
  )

  # get rid of originals that are empty
  cell_data[, c("width", "height", "hrule") := list(NULL, NULL, NULL)]
  cell_data <- merge(cell_data, fortify_width(x), by = ".col_id")
  cell_data <- merge(cell_data, fortify_height(x), by = c(".part", ".row_id"))
  cell_data <- merge(cell_data, fortify_hrule(x), by = c(".part", ".row_id"))

  span_data <- fortify_span(x)

  data_ref_pars <- distinct_paragraphs_properties(par_data)
  setDT(data_ref_pars)
  data_ref_cells <- distinct_cells_properties(cell_data)
  setDT(data_ref_cells)

  par_data <- merge(
    par_data,
    data_ref_pars,
    by = setdiff(colnames(data_ref_pars), "classname")
  )
  par_data <- par_data[,
    list(p_tag = paste0("<p class=\"", get("classname"), "\">")),
    by = c(".part", ".row_id", ".col_id")
  ]

  by_columns <- intersect(colnames(cell_data), colnames(data_ref_cells))
  cell_data <- merge(cell_data, data_ref_cells, by = by_columns)
  cell_data <- merge(
    cell_data,
    span_data,
    by = c(".part", ".row_id", ".col_id")
  )

  cell_data <- cell_data[,
    list(
      td_tag = paste0(
        ifelse(get(".part") %in% "header", "<th ", "<td "),
        paste0(
          ifelse(
            get("rowspan") > 1,
            paste0(" colspan=\"", get("rowspan"), "\""),
            ""
          ),
          ifelse(
            get("colspan") > 1,
            paste0(" rowspan=\"", get("colspan"), "\""),
            ""
          )
        ),
        "class=\"",
        get("classname"),
        "\">"
      )
    ),
    by = c(".part", ".row_id", ".col_id")
  ]

  dat <- merge(txt_data, par_data, by = c(".part", ".row_id", ".col_id"))
  dat$p_tag <- paste0(dat$p_tag, dat$span_tag, "</p>")
  dat <- merge(dat, cell_data, by = c(".part", ".row_id", ".col_id"))
  dat$td_tag <- paste0(
    dat$td_tag,
    dat$p_tag,
    ifelse(dat$.part %in% "header", "</th>", "</td>")
  )

  data_hrule <- fortify_hrule(x)
  data_hrule$tr_tag <- "<tr>"
  data_hrule$tr_tag[
    !data_hrule$hrule %in% "exact"
  ] <- "<tr style=\"overflow-wrap:break-word;\">"

  rows_data <- data_hrule[c(".part", ".row_id", "tr_tag")]

  dat <- merge(dat, span_data, by = c(".part", ".row_id", ".col_id"))
  dat$td_tag[dat$rowspan < 1 | dat$colspan < 1] <- ""

  z <- dcast(
    dat,
    .part + .row_id ~ .col_id,
    drop = TRUE,
    fill = "",
    value.var = "td_tag",
    fun.aggregate = I
  )
  z <- merge(z, rows_data, by = c(".part", ".row_id"))
  setorderv(z, c(".part", ".row_id"))
  z$tr_end <- "</tr>"

  parts <- z$.part
  header_start <- head(which(parts %in% "header"), n = 1)
  header_end <- tail(which(parts %in% "header"), n = 1)
  body_start <- head(which(parts %in% "body"), n = 1)
  body_end <- tail(which(parts %in% "body"), n = 1)
  footer_start <- head(which(parts %in% "footer"), n = 1)
  footer_end <- tail(which(parts %in% "footer"), n = 1)

  z$tpart_start <- ""
  z$tpart_end <- ""
  z$tpart_start[header_start] <- "<thead>"
  z$tpart_end[header_end] <- "</thead>"
  z$tpart_start[body_start] <- "<tbody>"
  z$tpart_end[body_end] <- "</tbody>"
  z$tpart_start[footer_start] <- "<tfoot>"
  z$tpart_end[footer_end] <- "</tfoot>"
  setcolorder(z, neworder = c("tpart_start", "tr_tag"))

  z[, c(".part", ".row_id") := NULL]

  html <- apply(as.matrix(z), 1, paste0, collapse = "")
  html <- paste0(html, collapse = "")

  par_style_str <- par_css_styles(data_ref_pars)
  cell_style_str <- cell_css_styles(
    data_ref_cells,
    add_widths = x$properties$layout %in% "fixed"
  )
  list(
    html = html,
    css = paste0(span_style_str, par_style_str, cell_style_str)
  )
}


# html chunks ----
htmlize <- function(x) {
  x <- htmlEscape(x)
  x <- gsub("\t", "&emsp;", x)
  x
}

#' @importFrom officer image_to_base64 plot_in_png
img_as_html <- function(img_data, width, height, alt = "") {
  img_data <- str_raster <- mapply(
    function(img_raster, width, height) {
      if (inherits(img_raster, "raster")) {
        img_raster <- plot_in_png(
          code = {
            op <- par(mar = rep(0, 4))
            plot(img_raster, interpolate = FALSE, asp = NA)
            par(op)
          },
          width = width,
          height = height,
          res = 300,
          units = "in",
          path = tempfile(fileext = ".png")
        )
      }
      img_raster
    },
    img_data,
    width,
    height,
    SIMPLIFY = TRUE,
    USE.NAMES = FALSE
  )
  base64_strings <- image_to_base64(img_data)
  alt <- ifelse(is.na(alt), "", alt)
  sprintf(
    "<img style=\"vertical-align:baseline;width:%.0fpx;height:%.0fpx;\" src=\"%s\" alt=\"%s\" />",
    width * 72,
    height * 72,
    base64_strings,
    htmlEscape(alt)
  )
}

# css ----

css_pt <- function(x, digits = 1) {
  x <- ifelse(
    is.na(x),
    "inherit",
    ifelse(x < 0.001, "0", paste0(format_double(x, digits = digits), "pt"))
  )
  x
}
css_no_unit <- function(x, digits = 0) {
  x <- ifelse(
    is.na(x),
    "inherit",
    ifelse(x < 0.001, "0", format_double(x, digits = digits))
  )
  x
}

border_css <- function(color, width, style, side) {
  style[!style %in% c("dotted", "dashed", "solid")] <- "solid"
  x <- sprintf(
    "border-%s: %s %s %s;",
    side,
    css_pt(width, 2),
    style,
    colcodecss(color)
  )
  x
}


css_align <- function(text.direction, align) {
  textdir <- rep("", length(text.direction))
  textdir[
    text.direction %in% "btlr"
  ] <- "writing-mode: vertical-rl;transform: rotate(180deg);-ms-writing-mode:bt-lr;-webkit-writing-mode:vertical-rl;"
  textdir[
    text.direction %in% "tbrl"
  ] <- "writing-mode: vertical-rl;-ms-writing-mode:tb-rl;-webkit-writing-mode:vertical-rl;"

  textalign <- sprintf("text-align:%s;", align)

  textalign_margins <- rep("", length(text.direction))
  textalign_margins[
    text.direction %in% "tbrl" & align %in% "center"
  ] <- "margin-left:auto;margin-right:auto;"
  textalign_margins[
    text.direction %in% "tbrl" & align %in% "left"
  ] <- "margin-right:auto;"
  textalign_margins[
    text.direction %in% "tbrl" & align %in% "right"
  ] <- "margin-left:auto;"

  textalign_margins[
    text.direction %in% "btlr" & align %in% "center"
  ] <- "margin-left:auto;margin-right:auto;"
  textalign_margins[
    text.direction %in% "btlr" & align %in% "left"
  ] <- "margin-right:auto;"
  textalign_margins[
    text.direction %in% "btlr" & align %in% "right"
  ] <- "margin-left:auto;"

  paste0(textalign, textalign_margins, textdir)
}

par_css_styles <- function(x) {
  shading <- rep("background-color:transparent;", nrow(x))
  has_shading <- colalpha(x$shading.color) > 0
  shading[has_shading] <- sprintf(
    "background-color:%s;",
    colcodecss(x$shading.color[has_shading])
  )

  textalign <- css_align(x$text.direction, x$text.align)

  bb <- border_css(
    color = x$border.color.bottom,
    width = x$border.width.bottom,
    style = x$border.style.bottom,
    side = "bottom"
  )
  bt <- border_css(
    color = x$border.color.top,
    width = x$border.width.top,
    style = x$border.style.top,
    side = "top"
  )
  bl <- border_css(
    color = x$border.color.left,
    width = x$border.width.left,
    style = x$border.style.left,
    side = "left"
  )
  br <- border_css(
    color = x$border.color.right,
    width = x$border.width.right,
    style = x$border.style.right,
    side = "right"
  )

  padding.bottom <- sprintf("padding-bottom:%s;", css_pt(x$padding.bottom))
  padding.top <- sprintf("padding-top:%s;", css_pt(x$padding.top))
  padding.left <- sprintf("padding-left:%s;", css_pt(x$padding.left))
  padding.right <- sprintf("padding-right:%s;", css_pt(x$padding.right))

  line_spacing <- sprintf("line-height: %s;", css_no_unit(x$line_spacing, 2))

  # first-line/hanging indents: CSS `text-indent` only moves the first
  # line, so hanging is a negative value relative to `padding-left`
  # (hanging wins over first_line, as in officer's `fp_par()`).
  text_indent <- rep("", nrow(x))
  has_first <- !is.na(x$first_line) & x$first_line > 0
  text_indent[has_first] <- sprintf(
    "text-indent:%s;",
    css_pt(x$first_line[has_first])
  )
  has_hanging <- !is.na(x$hanging) & x$hanging > 0
  text_indent[has_hanging] <- sprintf(
    "text-indent:-%s;",
    css_pt(x$hanging[has_hanging])
  )

  style_column <- paste0(
    "margin:0;",
    textalign,
    bb,
    bt,
    bl,
    br,
    padding.bottom,
    padding.top,
    padding.left,
    padding.right,
    line_spacing,
    text_indent,
    shading
  )
  paste0(".", x$classname, "{", style_column, "}", collapse = "")
}

cell_css_styles <- function(x, add_widths = TRUE) {
  background.color <- ifelse(
    colalpha(x$background.color) > 0,
    sprintf("background-color:%s;", colcodecss(x$background.color)),
    "background-color:transparent;"
  )
  width <- rep("", nrow(x))
  if (add_widths) {
    width[!is.na(x$width)] <- sprintf(
      "width:%sin;",
      css_no_unit(x$width[!is.na(x$width)], digits = 3)
    )
  }

  height <- rep("", nrow(x))
  hsel <- !is.na(x$height) & x$hrule %in% c("exact", "atleast")
  height[hsel] <- sprintf(
    "height:%sin;",
    css_no_unit(x$height[hsel], digits = 3)
  )

  vertical.align <- rep("vertical-align: middle;", nrow(x))
  vertical.align[x$vertical.align %in% "top"] <- "vertical-align: top;"
  vertical.align[x$vertical.align %in% "bottom"] <- "vertical-align: bottom;"

  bb <- border_css(
    color = x$border.color.bottom,
    width = x$border.width.bottom,
    style = x$border.style.bottom,
    side = "bottom"
  )
  bt <- border_css(
    color = x$border.color.top,
    width = x$border.width.top,
    style = x$border.style.top,
    side = "top"
  )
  bl <- border_css(
    color = x$border.color.left,
    width = x$border.width.left,
    style = x$border.style.left,
    side = "left"
  )
  br <- border_css(
    color = x$border.color.right,
    width = x$border.width.right,
    style = x$border.style.right,
    side = "right"
  )

  margin.bottom <- sprintf("margin-bottom:%s;", css_pt(x$margin.bottom))
  margin.top <- sprintf("margin-top:%s;", css_pt(x$margin.top))
  margin.left <- sprintf("margin-left:%s;", css_pt(x$margin.left))
  margin.right <- sprintf("margin-right:%s;", css_pt(x$margin.right))

  style_column <- paste0(
    width,
    height,
    background.color,
    vertical.align,
    bb,
    bt,
    bl,
    br,
    margin.bottom,
    margin.top,
    margin.left,
    margin.right
  )
  paste0(".", x$classname, "{", style_column, "}", collapse = "")
}

# htmlDependency ----
#' @importFrom htmltools htmlDependency
#' @export
#' @title htmlDependency for flextable objects
#' @description When using loops in an R Markdown for HTML document, the
#' htmlDependency object for flextable must also be added at least once.
#' @examples
#' if (require("htmltools")) {
#'   div(flextable_html_dependency())
#' }
#' @keywords internal
flextable_html_dependency <- function() {
  htmlDependency(
    "tabwid",
    "1.1.3",
    src = system.file(package = "flextable", "web_1.1.3"),
    stylesheet = "tabwid.css",
    script = "tabwid.js"
  )
}

# URL of the KaTeX stylesheet that `equatags`/`katex` emits when rendering
# equations to HTML. Extracted from the actual output so the version always
# matches the markup (no hard-coded version, no version skew). The extraction
# spins up a V8 rendering, so the result is cached for the session in
# `flextable_global`; it only depends on the installed katex version, which
# cannot change in a loaded session. Failures (no equatags, no match) are not
# cached so a later call can recover.
katex_css_href <- function() {
  if (!is.null(flextable_global$katex_css_href)) {
    return(flextable_global$katex_css_href)
  }
  if (!requireNamespace("equatags", quietly = TRUE)) {
    return(NULL)
  }
  transform_mathjax <- getFromNamespace("transform_mathjax", "equatags")
  html <- transform_mathjax("1", to = "html")
  href <- regmatches(
    html,
    regexpr("https://[^\"']+katex[^\"']+\\.css", html)
  )
  if (length(href) < 1) {
    return(NULL)
  }
  flextable_global$katex_css_href <- href[1]
  href[1]
}

# `data-external="1"` keeps pandoc --self-contained/--embed-resources from
# downloading and inlining the stylesheet: inlining would break its relative
# `url(fonts/...)` references and require internet at render time.
katex_css_link <- function() {
  href <- katex_css_href()
  if (is.null(href)) {
    return(NULL)
  }
  sprintf(
    "<link rel=\"stylesheet\" href=\"%s\" data-external=\"1\">",
    href
  )
}

# flextable renders HTML tables inside a shadow DOM (see web_1.1.3/tabwid.js),
# which moves the table and the KaTeX stylesheet injected in cells into a
# shadow root. `@font-face` rules declared inside a shadow root are not
# registered by the browser, so the KaTeX math fonts (KaTeX_SansSerif,
# KaTeX_Typewriter, KaTeX_Fraktur, KaTeX_AMS) never load and the corresponding
# variants (`\mathsf`, `\mathtt`, `\mathfrak`, `\mathbb`) silently fall back to
# the default font (issue #622). Adding the same stylesheet as a document-level
# dependency registers the fonts in the light DOM, where they become usable by
# the shadow DOM content too.
katex_html_dependency <- function() {
  link <- katex_css_link()
  if (is.null(link)) {
    return(NULL)
  }
  version <- sub(".*katex@([0-9.]+).*", "\\1", link)
  if (!grepl("^[0-9.]+$", version)) {
    version <- "0.0.0"
  }
  # The stylesheet is served from a CDN; remote `href` dependencies are not
  # supported by the knitr meta path ("not disk-based"), so emit the link tag
  # via `head` while pointing `src` at an existing on-disk directory and
  # copying nothing (`all_files = FALSE`).
  htmlDependency(
    name = "katex",
    version = version,
    src = system.file(package = "flextable", "web_1.1.3"),
    all_files = FALSE,
    head = link
  )
}

html_dependencies_list <- function(x) {
  list_deps <- list(flextable_html_dependency())
  list_deps <- append(
    list_deps,
    lapply(avail_gfonts(x), gdtools::gfontHtmlDependency)
  )
  if (has_equation(x)) {
    katex_dep <- katex_html_dependency()
    if (!is.null(katex_dep)) {
      list_deps <- append(list_deps, list(katex_dep))
    }
  }
  list_deps
}

#' @importFrom gdtools installed_gfonts
avail_gfonts <- function(x) {
  z <- character()
  if (nrow_part(x, part = "body") > 0) {
    z <- append(z, unique(as.vector(x$body$styles$text$font.family$data)))
  }
  if (nrow_part(x, part = "footer") > 0) {
    z <- append(z, unique(as.vector(x$footer$styles$text$font.family$data)))
  }
  if (nrow_part(x, part = "header") > 0) {
    z <- append(z, unique(as.vector(x$header$styles$text$font.family$data)))
  }
  families <- unique(as.character(z))
  intersect(families, installed_gfonts())
}

#' @importFrom rmarkdown html_document render pandoc_available
render_htmltag <- function(x, path, title, lang = "en") {
  sucess <- FALSE
  rmd_file <- tmp_rmd(title = paste0(title, collapse = "\n"), lang = lang)
  html_file <- gsub("\\.Rmd$", ".html", rmd_file)
  tryCatch(
    {
      render(
        rmd_file,
        output_format = html_document(
          self_contained = TRUE,
          theme = NULL,
          mathjax = NULL
        ),
        # output_file = basename(path),
        envir = new.env(),
        quiet = TRUE,
        params = list(x = x)
      )
      sucess <- file.copy(html_file, path, overwrite = TRUE)
    },
    warning = function(e) {},
    error = function(e) {}
  )
  sucess
}

tmp_rmd <- function(title, lang = "en") {
  stopifnot(pandoc_available())
  file <- tempfile(fileext = ".Rmd")
  writeLines(
    c(
      "---",
      sprintf("title: \"%s\"", title),
      sprintf("lang: %s", lang),
      "params:",
      "  x: ''",
      "---",
      "```{r include=FALSE}",
      "library(knitr)",
      "opts_chunk$set(echo = FALSE)",
      "```",
      "",
      "```{r}",
      "params$x",
      "```"
    ),
    file,
    useBytes = TRUE
  )
  file
}
