Automatically add citations to reference (#48)

NEWS.md

@@ -2,7 +2,8 @@
 
 ## New features
 
-* `colformat_md` supports multiple paragprahs by collapsing them with a separator given to the `.sep` argument (default: `"\n\n").
+* `colformat_md` supports multiple paragprahs by collapsing them with a separator given to the `.sep` argument (default: `"\n\n") (#43).
+* `colformat_md` can now automatically add citations to reference on R Markdown (#48).
 
 ## Bug fixes
 

R/colformat.R

@@ -54,11 +54,13 @@ colformat_md <- function(x,
     return(x)
   }
 
+  texts <- unlist(dataset[col], use.names = FALSE)
+
   # Must evaluate outside add_footnotes due to lazy evaluation of arguments
   ft <- flextable::compose(x,
                            i = seq(nrow(dataset)), j = col, part = part,
                            value = as_paragraph_md(
-                             unlist(dataset[col], use.names = FALSE),
+                             texts,
                              auto_color_link = auto_color_link,
                              .from = .from,
                              md_extensions = md_extensions,
@@ -67,7 +69,11 @@ colformat_md <- function(x,
                              .sep = .sep
                            ))
 
-  add_footnotes(ft, part, .footnote_options)
+  structure(
+    add_footnotes(ft, part, .footnote_options),
+    class = c("ftExtra", class(ft)),
+    citations = collect_citations(paste(texts, collapse = "\n\n"))
+  )
 }
 
 where <- function(...) {

R/collect-citations.R

@@ -0,0 +1,14 @@
+collect_citations <- function(x, .from = 'markdown') {
+  tf <- tempfile()
+  xfun::write_utf8(x, tf)
+  rmarkdown::pandoc_convert(
+    input = tf,
+    to = "markdown",
+    from = .from,
+    output = tf,
+    citeproc = FALSE,
+    options = lua("cite.lua"),
+    wd = getwd()
+  )
+  paste(readLines(tf), collapse = "")
+}

R/knit-print.R

@@ -0,0 +1,27 @@
+#' knit_print for extended flextable object
+#'
+#' Adds a YAML meta data block to cite materials found by `colformat_md()` in
+#' the `flextable` object.
+#'
+#' @inheritParams knitr::knit_print
+#' @param label
+#'  A key to be set in the YAML meta data block to cite materials.
+#'  This must be unique in the document.
+#'  Default value is the chunk label prepended by "ftExtra-cite-".
+#'
+#' @return The `knit_asis` class object.
+#' @noRd
+knit_print.ftExtra <- function(x,
+                               options,
+                               ...,
+                               key = paste0("ftExtra-cite-", options$label)) {
+  ft <- NextMethod("knit_print", x, options, ...)
+
+  cite <- attr(x, "citations", exact = TRUE)
+
+  if (cite == "") return(ft)
+
+  res <- sprintf('---\n%s: "%s"\n---\n\n%s', key, cite, ft)
+  attributes(res) <- attributes(ft)
+  res
+}

R/zzz.R

@@ -0,0 +1,3 @@
+.onLoad <- function(libname, pkgname) {
+  registerS3method("knit_print", "ftExtra", knit_print.ftExtra, asNamespace("knitr"))
+}

inst/lua/cite.lua

@@ -0,0 +1,12 @@
+cite = {}
+
+function Cite(elem)
+  table.insert(cite, elem)
+  table.insert(cite, pandoc.Space())
+end
+
+function Pandoc(doc)
+  table.remove(cite)
+  doc.blocks = {pandoc.Para(cite)}
+  return doc
+end