initial typst support

.Rbuildignore

@@ -7,3 +7,4 @@
 ^pkgdown$
 ^\.github$
 ^LICENSE\.md$
+^.devcontainer$

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: emphatic
 Type: Package
 Title: Highlight R Output using Colouring
-Version: 0.1.6.9004
+Version: 0.1.6.9005
 Author: mikefc
 Maintainer: mikefc <[email protected]>
 Description: User-defined colouring of data.frames and other R output. 

NAMESPACE

@@ -6,6 +6,7 @@ export(as_emphatic)
 export(as_html)
 export(as_latex)
 export(as_svg)
+export(as_typst)
 export(hl)
 export(hl_adjust)
 export(hl_diff)

NEWS.md

@@ -1,5 +1,5 @@
 
-# emphatic 0.1.6.9004  2024-04-30
+# emphatic 0.1.6.9005  2024-05-01
 
 * Removed `hl_mat()` and associated vignettes.
     * function is not exported for now as the selection process is too 
@@ -10,6 +10,7 @@
 * Added latex output so Quarto/Rmd will show emphatic objects when 
   rendered to PDF
 * Remove `scale_mode` argument to `hl()`
+* Support for output to `typst` in quarto docs
 
 # emphatic 0.1.6  2024-04-27
 

R/core-typst.R

@@ -0,0 +1,72 @@
+
+
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#' Convert a vector of colours to opening latex code for background colour
+#'
+#' @param colours Chcaracter vector of R colours
+#'
+#' @return Character vector of latex opening span tags
+#'
+#' @noRd
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+col2fill_typst <- function(colours) {
+  no_colour <- is.na(colours) | colours == ''
+  colours[no_colour] <- NA
+  colours <- col2hex(colours)
+
+  ifelse(
+    no_colour,
+    '#[',  # do nothing
+    paste0('#highlight(fill: rgb("', colours, '"))[')
+  )
+
+}
+
+
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#' Convert a vector of colours to opening latex code for text colour
+#'
+#' @param colours Chcaracter vector of R colours
+#'
+#' @return Character vector of latex opening span tags
+#'
+#' @noRd
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+col2text_typst <- function(colours) {
+  no_colour <- is.na(colours) | colours == ''
+  colours[no_colour] <- NA
+  colours <- col2hex(colours)
+
+  ifelse(
+    no_colour,
+    paste0('#['),
+    paste0('#text(fill: rgb("', colours, '"))[')
+  )
+
+}
+
+reset_typst         <- "]]"
+underline_on_typst  <- "#underline["
+underline_off_typst <- "]"
+
+#  #highlight(fill: rgb("aaaaaa"))[
+#    #text(font: "Courier New", fill: rgb("#0000ff"))[
+#      Hello\u{00a0}\u{00a0}\u{00a0}\u{00a0}there \
+#    ]
+#  ]
+
+
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# Escape HTML by replacing special characters
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+escape_typst <- function(x) {
+  x <- enc2utf8(x)
+  x <- gsub(" ", "\\\\u{00a0}", x, useBytes = TRUE)
+  x <- gsub("<"  , "\\\\<", x, useBytes = TRUE)
+  x <- gsub("\n"  , "\\\\\n", x, useBytes = TRUE)
+  Encoding(x) <- 'UTF-8'
+  x
+}

R/core.R

@@ -154,11 +154,13 @@ as.character.emphatic <- function(x, ..., mode = 'ansi') {
       return (paste(strs, collapse = "<br/>"))
     } else if (mode == 'latex') {
       return (paste(strs, collapse = "\\\\\n"))
+    } else if (mode == 'typst') {
+      return (paste(strs, collapse = "\\\n"))
     }
   }
 
 
-  stopifnot(mode %in% c('ansi', 'html', 'latex'))
+  stopifnot(mode %in% c('ansi', 'html', 'latex', 'typst'))
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # Remove the 'emphatic' class here, so that if any subsequent operations
@@ -292,10 +294,11 @@ as_character_inner <- function(m,
   stopifnot(is.character(m))
   stopifnot((is_atomic(m) && length(m) == length(text)) || identical(dim(m), dim(text)))
   stopifnot((is_atomic(m) && length(m) == length(fill)) || identical(dim(m), dim(fill)))
-  stopifnot(mode %in% c('ansi', 'html', 'latex'))
+  stopifnot(mode %in% c('ansi', 'html', 'latex', 'typst'))
 
   collapser <- "\n"
   if (mode == 'latex') collapser <- '\\\\\n'
+  if (mode == 'typst') collapser <- '\\\n'
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # Automatic contrasting text for foreground?
@@ -323,6 +326,8 @@ as_character_inner <- function(m,
     end <- matrix(reset_html , nrow = nrow(m), ncol = ncol(m))
   } else if (mode == 'latex') {
     end <- matrix(reset_latex, nrow = nrow(m), ncol = ncol(m))
+  } else if (mode == 'typst') {
+    end <- matrix(reset_typst, nrow = nrow(m), ncol = ncol(m))
   }
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -342,6 +347,9 @@ as_character_inner <- function(m,
   } else if (mode == 'latex') {
     text[] <- col2text_latex(text)
     fill[] <- col2fill_latex(fill)
+  } else if (mode == 'typst') {
+    text[] <- col2text_typst(text)
+    fill[] <- col2fill_typst(fill)
   }
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -368,7 +376,6 @@ as_character_inner <- function(m,
   if (has_col_names) {
     for (i in seq_along(col_widths)) {
       width <- col_widths[i]
-      # if (mode == 'latex') width <- width - 1
       fmt   <- sprintf(" %%%is", width)
       m[,i] <- sprintf(fmt, m[,i])
       fmt   <- sprintf("%%%is", width)
@@ -387,6 +394,10 @@ as_character_inner <- function(m,
     att <- attributes(m)
     m <- escape_latex(m)
     attributes(m) <- att
+  } else if (mode == 'typst') {
+    att <- attributes(m)
+    m <- escape_typst(m)
+    attributes(m) <- att
   }
 
   ansi_mat <- paste0(text, fill, m, end)
@@ -468,12 +479,16 @@ as_character_inner <- function(m,
         this_rownames <- escape_html(this_rownames)
       } else if (mode == 'latex') {
         this_rownames <- escape_latex(this_rownames)
+      } else if (mode == 'typst') {
+        this_rownames <- escape_typst(this_rownames)
       }
       ansi_mat      <- cbind(this_rownames, ansi_mat)
       col_names     <- c(sprintf(fmt, ''), col_names)
     } else {
       if (mode == 'latex') {
         rownames(m) <- escape_latex(rownames(m))
+      } else if (mode == 'typst') {
+        rownames(m) <- escape_typst(rownames(m))
       }
       col_names <- c('', col_names)
     }
@@ -493,6 +508,9 @@ as_character_inner <- function(m,
         } else if (mode == 'latex') {
           header <- escape_latex(header)
           header <- paste0(underline_on_latex, header, underline_off_latex)
+        } else if (mode == 'typst') {
+          header <- escape_typst(header)
+          header <- paste0(underline_on_typst, header, underline_off_typst)
         }
     }
 

R/knitr.R

@@ -57,6 +57,38 @@ as_latex <- function(x, ...) {
 }
 
 
+
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+#' Render an emphatic object to typst
+#'
+#' @param x emphatic object
+#' @param ... other arguments passed to \code{as.character.emphatic}
+#' @param font name of font. Default: 'Courier New'
+#' @param font_size font size in points. default: 10
+#'
+#' @export
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+as_typst <- function(x, ..., font = 'Courier New', font_size = 10) {
+
+  res <- as.character(x, ..., mode = 'typst')
+
+  res <- paste(
+    "\n```{=typst}\n",
+    "#[",
+    paste0('#set text(font: "', font, '", size: ', font_size, 'pt)'),
+    res,
+    "]",
+    "\n```\n",
+    sep = "\n"
+  )
+
+  class(res) <- unique(c('knit_asis', class(res)))
+  attr(res, 'knit_cacheable') <- NA
+  res
+}
+
+
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 #' Automatically output emphatic objects to HTML knitted documents.
 #'
@@ -68,6 +100,8 @@ knit_print.emphatic <- function(x, style = NULL, ...) {
 
   if (requireNamespace('knitr', quietly = TRUE) && knitr::is_latex_output()) {
     as_latex(x, ...)
+  } else if (requireNamespace('knitr', quietly = TRUE) && knitr::pandoc_to() == 'typst') {
+    as_typst(x, ...)
   } else {
     as_html(x, style = style, ...)
   }

README.Rmd

@@ -80,7 +80,7 @@ image_read("man/figures/logo.png")
 You can install from [GitHub](https://github.com/coolbutuseless/emphatic) with:
 
 ``` r
-# install.package('remotes')
+# install.packages('remotes')
 remotes::install_github('coolbutuseless/emphatic', ref = 'main')
 ```
 

README.md

@@ -31,7 +31,7 @@ You can install from
 [GitHub](https://github.com/coolbutuseless/emphatic) with:
 
 ``` r
-# install.package('remotes')
+# install.packages('remotes')
 remotes::install_github('coolbutuseless/emphatic', ref = 'main')
 ```