From 24eb77216700cf8b2f2bde3abad84c1f83f9e32a Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Mon, 9 Jan 2023 06:22:04 +0100
Subject: Prebuilt PDF vignettes, summary_listing

---
 R/summary_listing.R | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 59 insertions(+)
 create mode 100644 R/summary_listing.R

(limited to 'R/summary_listing.R')

diff --git a/R/summary_listing.R b/R/summary_listing.R
new file mode 100644
index 00000000..38b52240
--- /dev/null
+++ b/R/summary_listing.R
@@ -0,0 +1,59 @@
+#' Display the output of a summary function according to the output format
+#'
+#' This function is intended for use in a R markdown code chunk with the chunk
+#' option `results = "asis"`.
+#'
+#' @param object The object for which the summary is to be listed
+#' @param caption An optional caption
+#' @param label An optional label, ignored in html output
+#' @param clearpage Should a new page be started after the listing? Ignored in html output
+#' @export
+summary_listing <- function(object, caption = NULL, label = NULL,
+  clearpage = TRUE) {
+  if (knitr::is_latex_output()) {
+    tex_listing(object = object, caption = caption, label = label,
+      clearpage = clearpage)
+  }
+  if (knitr::is_html_output()) {
+    html_listing(object = object, caption = caption)
+  }
+}
+
+#' @rdname summary_listing
+#' @export
+tex_listing <- function(object, caption = NULL, label = NULL,
+  clearpage = TRUE) {
+  cat("\n")
+  cat("\\begin{listing}", "\n")
+  if (!is.null(caption)) {
+    cat("\\caption{", caption, "}", "\n", sep = "")
+  }
+  if (!is.null(label)) {
+    cat("\\caption{", label, "}", "\n", sep = "")
+  }
+  cat("\\begin{snugshade}", "\n")
+  cat("\\scriptsize", "\n")
+  cat("\\begin{verbatim}", "\n")
+  cat(capture.output(suppressWarnings(summary(object))), sep = "\n")
+  cat("\n")
+  cat("\\end{verbatim}", "\n")
+  cat("\\end{snugshade}", "\n")
+  cat("\\end{listing}", "\n")
+  if (clearpage) {
+    cat("\\clearpage", "\n")
+  }
+}
+
+#' @rdname summary_listing
+#' @export
+html_listing <- function(object, caption = NULL) {
+  cat("\n")
+  if (!is.null(caption)) {
+    cat("<caption>", caption, "</caption>", "\n", sep = "")
+  }
+  cat("<pre><code>\n")
+  cat(capture.output(suppressWarnings(summary(object))), sep = "\n")
+  cat("\n")
+  cat("</pre></code>\n")
+}
+
-- 
cgit v1.2.1