R/html_document2_ja.R

In Gedevan-Aleksizde/rmdja: R Markdown Formats for Japanese

#' bookdown::html_document2 wrapper for Japanese
#'  
#' @inheritParams bookdown::gitbook
#' @param dev: character. デフォルト: `png` しかし将来 `ragg_png` にするかもしれない.
#' @param code_rownumber: logical. デフォルト: TRUE. 行番号を表示するかどうか
#' @export
html_document2_ja <- function(
  fig_caption = TRUE,
  fig_align = "center",
  fig_width = 7,
  fig_height = 5,
  fig_retina = 2,
  table_css = TRUE,
  toc_depth = 3,
  number_sections = TRUE,
  self_contained = FALSE,
  code_folding = c("none", "show", "hide"),
  code_download = FALSE,
  code_rownumber = TRUE,
  highlight = "default",
  dev = 'png',
  dev.args = list(res = 200),
  df_print = "default",
  mathjax = "default",
  template = "default",
  extra_dependencies = NULL,
  css = NULL,
  includes = NULL,
  keep_md = FALSE,
  lib_dir = 'libs',
  md_extensions = NULL,
  pandoc_args = NULL,
  ...){
  
  code_folding <- code_folding[1]
  match.arg(code_folding, c("none", "show", "hide"))

  opts_chunk_default <- list()
  if(code_rownumber) {
    opts_chunk_default <- c(opts_chunk_default, list(attr.source = c(".numberLines .lineAnchors")))
  }
  if(!missing(fig_align) || !is.null(fig_align)){
    opts_chunk_default <- c(opts_chunk_default, list(fig.align = fig_align))
  }
  opts_chunk_default <- c(opts_chunk_default, list(tidy = T, tidy.opts = list(indent = getOption("formatR.indent", 2), width = 60)))

  preproc_css <- function(metadata, input_file, runtime, knit_meta, files_dir, output_dir){
    args_extra <- c()
    img_list <- list(d = "styles/img", f = ICON_FILES())
    css_list <- list(d = "styles/css", f = CSS_FILES())
    for(x in list(img_list, css_list)){
      dir_copy_to <- file.path(files_dir, x$d)
      if(!file.exists(dir_copy_to)) dir.create(dir_copy_to, recursive = T)
      file.copy(system.file(file.path("resources", x$d, x$f), package = "rmdja"),
                dir_copy_to)
      for(css_file in file.path(dir_copy_to, subset(x$f, subset = substr(x$f, nchar(x$f) - 3, nchar(x$f)) == ".css"))){
        args_extra <- c(args_extra, c("--css", css_file))
        }
    }
    if(is.null(metadata[["biblio-title"]])) args_extra <- c(args_extra, "-Mbiblio-title=参考文献")
    return(args_extra)
  }

  args <- list(
    fig_caption = fig_caption,
    number_sections = number_sections,
    self_contained = self_contained,
    lib_dir = lib_dir,
    pandoc_args = pandoc_args,
    toc_depth = toc_depth,
    fig_align = fig_align,
    fig_width = fig_width,
    fig_height = fig_height,
    fig_retina = fig_retina,
    code_folding = code_folding,
    code_download = code_download,
    highlight = highlight,
    dev = dev,
    dev.args = dev.args,
    df_print = df_print,
    mathjax = mathjax,
    extra_dependencies = extra_dependencies,
    css = css,
    includes = includes,
    keep_md = keep_md,
    md_extensions = md_extensions,
    template = template,
    ...
  )
  out <- rmarkdown::output_format(
    knitr = rmarkdown::knitr_options(
      opts_chunk = opts_chunk_default,
      opts_hooks = list(echo = hook_display_block),
      opts_knit = list(global.par = T)
    ),
    pandoc = NULL,
    keep_md = keep_md,
    pre_processor = preproc_css,
    base_format = do.call(bookdown::html_document2, args)
  )
  # TODO refactoring
  preproc_base <- out$pre_processor
  out$pre_processor <- function(metadata, input_file, runtime, knit_meta, files_dir, output_dir){
    a1 <- preproc_css(metadata, input_file, runtime, knit_meta, files_dir, output_dir)
    a2 <- preproc_base(metadata, input_file, runtime, knit_meta, files_dir, output_dir)
    return(c(a1, a2))
  }
  out$knitr$opts_hooks <- list(echo = hook_display_block)
  if(code_rownumber) out$knitr$opts_chunk <- merge_lists(out$knitr$opts_chunk, opts_chunk_default)
  return(out)
}