[Breaking Changes] attribute-based node protection

DESCRIPTION

@@ -50,10 +50,11 @@ Suggests:
     rmarkdown,
     covr,
     testthat (>= 3.0.0),
+    brio,
     withr
 Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 VignetteBuilder: knitr

NAMESPACE

@@ -1,12 +1,20 @@
 # Generated by roxygen2: do not edit by hand
 
+export(add_protected_ranges)
 export(find_between)
+export(get_protected_nodes)
+export(get_protected_ranges)
+export(is_protected)
+export(join_split_nodes)
 export(md_ns)
 export(protect_curly)
 export(protect_math)
+export(remove_protected_ranges)
+export(split_protected_nodes)
 export(stylesheet)
 export(to_md)
 export(to_xml)
+export(xpath_protected)
 export(yarn)
 importFrom(R6,R6Class)
 importFrom(magrittr,"%>%")

NEWS.md

@@ -1,3 +1,31 @@
+# tinkr 1.0.0 
+
+## BREAKING CHANGES
+
+Node protection will no longer fragment text nodes into groups of 'asis' and
+regular text nodes. Instead, two attributes `protect.start` and `protect.end`
+are added that record the ranges of the protected characters. If you have been
+relying on using `@asis` nodes to manipulate your documents, your code will
+break. We are instead exporting helper functions to handle this.
+
+ - `protect_math()`, `protect_curly()`, and `protect_unescaped()` now modify
+   the document in place.
+
+## NEW FUNCTIONS
+
+ - `add_protected_ranges()` adds and updates protected ranges for a given text
+   node
+ - `is_protected()` an indicator if a node has protection or not
+ - `get_protected_ranges()` returns a list of integer vectors that indicate the
+   protected ranges
+ - `remove_protected_ranges()` removes the `protect.start` and `protect.end`
+   attributes from a node
+
+## BUG FIX
+
+ - `protect_math()` no longer failes if `protect_curly()` was run before it
+   (reported: @maelle, #105; fixed: @zkamvar)
+
 # tinkr 0.2.0.9000
 
 ## BUG FIX

R/asis-nodes.R

@@ -17,7 +17,7 @@
 #' txt <- textConnection(tinkr::to_md(m))
 #' cat(tail(readLines(txt)), sep = "\n") # broken math
 #' close(txt)
-#' m$body <- protect_math(m$body)
+#' protect_math(m$body)
 #' txt <- textConnection(tinkr::to_md(m))
 #' cat(tail(readLines(txt)), sep = "\n") # fixed math
 #' close(txt)
@@ -32,6 +32,10 @@ set_asis <- function(nodes) {
   xml2::xml_set_attr(nodes[xml2::xml_name(nodes) != "softbreak"], "asis", "true")
 }
 
+is_asis <- function(node) {
+  xml2::xml_has_attr(node, "asis")
+}
+
 # INLINE MATH ------------------------------------------------------------------
 
 # finding inline math consists of searching for $ and excluding $$
@@ -104,7 +108,6 @@ find_broken_math <- function(math) {
 #' cat(tinkr::to_md(list(body = protxt, yaml = "")), sep = "\n")
 #' }
 protect_inline_math <- function(body, ns) {
-  body  <- copy_xml(body)
   math  <- find_inline_math(body, ns)
   if (length(math) == 0) {
     return(body)
@@ -120,16 +123,12 @@ protect_inline_math <- function(body, ns) {
   bmath   <- math[!bespoke]
 
   # protect math that is strictly inline
-  if (length(imath)) {
-    new_nodes <- purrr::map(imath, fix_fully_inline)
-    # since we split up the nodes, we have to do this node by node
-    for (i in seq(new_nodes)) {
-      add_node_siblings(imath[[i]], new_nodes[[i]], remove = TRUE)
-    }
+  if (length(imath) > 0L) {
+    purrr::walk(imath, label_fully_inline)
   }
 
   # protect math that is broken across lines or markdown elements
-  if (length(bmath)) {
+  if (length(bmath) > 0L) {
     if (any(broke$ambiguous)) {
       # ambiguous math may be due to inline r code that produces an answer:
       # $R^2 = `r runif(1)`$
@@ -155,7 +154,7 @@ protect_inline_math <- function(body, ns) {
       fix_partial_inline(i, body, ns)
     }
   }
-  copy_xml(body)
+  body
 }
 
 # Partial inline math are math elements that are not entirely embedded in a
@@ -171,78 +170,69 @@ fix_partial_inline <- function(tag, body, ns) {
   # find everything between the tagged pair
   math_lines <- find_between_inlines(body, ns, tag)
   # make sure everything between the tagged pair is labeled as 'asis'
+  # this is explicitly for symbols like `_`, which denote subscripts in LaTeX,
+  # but make _emph_ text in markdown.
   filling <- math_lines[is.na(xml2::xml_attr(math_lines, "latex-pair"))]
   set_asis(filling)
   filling <- xml2::xml_find_all(filling, ".//node()")
   set_asis(filling)
-  # paste the lines together and create new nodes
-  n <- length(math_lines)
-  char <- as.character(math_lines)
-  char[[1]] <- sub("[$]", "$</text><text asis='true'>", char[[1]])
-  char[[n]] <- sub("[<]text ", "<text asis='true' ", char[[n]])
-  nodes <- paste(char, collapse = "")
-  nodes <- make_text_nodes(nodes)
-  # add the new nodes to the bottom of the existing math lines
-  last_line <- math_lines[n]
-  to_remove <- math_lines[-n]
-  add_node_siblings(last_line, nodes, remove = TRUE)
-  # remove the duplicate lines
-  xml2::xml_remove(to_remove)
+  purrr::walk(math_lines, label_partial_inline)
 }
 
-fix_fully_inline <- function(math) {
-  char <- as.character(math)
-  # Find inline math that is complete and wrap it in text with asis
-  # <text>this is $\LaTeX$ text</text>
-  #   becomes
-  # <text>this is </text><text asis='true'>$\LaTeX$</text><text> text</text>
-  char <- gsub(
-    pattern = inline_dollars_regex("full"),
-    replacement = "</text><text asis='true'>\\1</text><text>",
-    x = char,
+label_partial_inline <- function(math) {
+  char <- xml2::xml_text(math)
+  # find lines that begin with `$` but do not have an end.
+  start <- gregexpr(inline_dollars_regex("start"),
+    char,
+    perl = TRUE
+  )
+  # find lines that end with `$` but do not have a beginning.
+  stop <- gregexpr(inline_dollars_regex("stop"),
+    char,
     perl = TRUE
   )
-  make_text_nodes(char)
+  has_start <- start[[1]][1] > 0
+  has_end <- stop[[1]][1] > 0
+  if (has_start) {
+    # if the line contains the beginning of an inline math fragment,
+    # we start at the match and end at the end of the string
+    begin <- start[[1]]
+    end <- nchar(char)
+  } else if (has_end) {
+    # if the line contains the end of an inline math fragment,
+    # we start at the beginning of the string and end at the end of the match
+    begin <- 1
+    end <- stop[[1]] + attr(stop[[1]], "match.len") - 1L
+  } else {
+    # otherwise, the entire range should be protected.
+    begin <- 1
+    end <- nchar(char)
+  }
+  # if any of the nodes have been set as curly, unset
+  xml2::xml_set_attr(math, "curly", NULL)
+  xml2::xml_set_attr(math, "curly-id", NULL)
+  add_protected_ranges(math, begin, end)
 }
 
-#' Transform a character vector of XML into text nodes
-#'
-#' This is useful in the case where we want to modify some text content to
-#' split it and label a portion of it 'asis' to protect it from commonmark's
-#' escape processing.
-#'
-#' `fix_fully_inline()` uses `make_text_nodes()` to modify a single text node
-#' into several text nodes. It first takes a string of a single text node like
-#' below...
-#'
-#' ```html
-#' <text>this is $\LaTeX$ text</text>
-#' ```
-#'
-#' ...and splits it into three text nodes, surrounding the LaTeX math with text
-#' tags that have the 'asis' attribute.
-#'
-#' ```html
-#' <text>this is </text><text asis='true'>$\LaTeX$</text><text> text</text>
-#' ```
-#'
-#' The `make_text_nodes()` function takes the above text string and converts it
-#' into nodes so that the original text node can be replaced.
-#'
-#' @param a character vector of modified text nodes
-#' @return a nodeset with no associated namespace
-#' @noRd
-make_text_nodes <- function(txt) {
-  # We are hijacking commonmark here to produce an XML markdown document with
-  # a single element: {paste(txt, collapse = ''). This gets passed to glue where
-  # it is expanded into nodes that we can read in via {xml2}, strip the
-  # namespace, and extract all nodes below
-  doc <- glue::glue(commonmark::markdown_xml("{paste(txt, collapse = '')}"))
-  nodes <- xml2::xml_ns_strip(xml2::read_xml(doc))
-  xml2::xml_find_all(nodes, ".//paragraph/text/*")
+label_fully_inline <- function(math) {
+  char <- xml2::xml_text(math)
+  # Find the locations of inline math that is complete
+  locations <- gregexpr(pattern = inline_dollars_regex("full"),
+    char,
+    perl = TRUE
+  )
+  # add the ranges to the attributes
+  # <text>this is $\LaTeX$ text</text>
+  #   becomes
+  # <text protect.start='9' protect.end='16'>this is $\LaTeX$ text</text>
+  start <- locations[[1]]
+  end <- start + attr(locations[[1]], "match.len") - 1L
+  # if any of the nodes have been set as curly, unset
+  xml2::xml_set_attr(math, "curly", NULL)
+  xml2::xml_set_attr(math, "curly-id", NULL)
+  add_protected_ranges(math, start, end)
 }
 
-
 # BLOCK MATH ------------------------------------------------------------------
 
 find_block_math <- function(body, ns) {
@@ -258,6 +248,9 @@ protect_block_math <- function(body, ns) {
   bm <- find_block_math(body, ns)
   # get all of the internal nodes
   bm <- xml2::xml_find_all(bm, ".//descendant-or-self::md:*", ns = ns)
+  # if any of the nodes have been set as curly, unset
+  xml2::xml_set_attr(bm, "curly", NULL)
+  xml2::xml_set_attr(bm, "curly-id", NULL)
   set_asis(bm)
 }
 
@@ -373,11 +366,10 @@ protect_unescaped <- function(body, txt, ns = md_ns()) {
     warning(msg, call. = FALSE)
     return(body)
   }
-  body <- copy_xml(body)
-  XPATH <- ".//md:text[not(@asis)][contains(text(), '[') or contains(text(), ']')]"
+  XPATH <- ".//md:text[contains(text(), '[') or contains(text(), ']')]"
   snodes <- xml2::xml_find_all(body, XPATH, ns = ns)
   fix_unescaped_squares(snodes, txt)
-  copy_xml(body)
+  return(body)
 }
 
 #' Find the escaped square braces in text vector
@@ -386,7 +378,7 @@ protect_unescaped <- function(body, txt, ns = md_ns()) {
 #' @return the same output as [base::gregexpr()]: a list the same length as
 #' `txt` with integer vectors indicating the character positions of the matches
 #' with attributes:
-#'   1. match.length the length of the match (will be '2')
+#'   1. match.len the length of the match (will be '2')
 #' @noRd
 find_escaped_squares <- function(txt) {
   gregexpr("(\\\\\\])|(\\\\\\[)", txt, useBytes = FALSE)
@@ -407,9 +399,8 @@ find_escaped_squares <- function(txt) {
 #' not represented as markup, we use their `sourcepos` attributes to determine
 #' the lines and columns of the `txt` where _escaped_ square braces are.
 #'
-#' Knowing this, we can process each node by its line number and wrap all
-#' unescpaed square braces in text nodes with the `@asis` attribute, which is
-#' performed with the [fix_unescaped()] function.
+#' Knowing this, we can add protection attributes to the positions that should
+#' not be escaped.
 #'
 #' @return nothing, invisibly. This function is called for its side-effect.
 #' @noRd
@@ -438,7 +429,7 @@ fix_unescaped_squares <- function(nodes, txt) {
       }
     }
   }
-  invisible()
+  return(invisible())
 }
 
 
@@ -456,17 +447,17 @@ fix_unescaped_squares <- function(nodes, txt) {
 #' will produce a text node like this:
 #'
 #' ```html
-#' <text sourcepos='1:1-1:43'>this is [unescaped] and this is [escaped]</text>
+#' <text sourcepos='1:1-1:43'>
+#' this is [unescaped] and this is [escaped]
+#' </text>
 #' ```
 #'
 #' This function will replace the text node with this:
 #'
 #' ```html
-#' <text sourcepos='1:1-1:43'>this is </text>
-#' <text asis='true'>[</text>
-#' <text>unescaped</text>
-#' <text asis='true'>]</text>
-#' <text> and this is [escaped]</text>
+#' <text sourcepos='1:1-1:43' protect.start='9 19' protect.end='9 19'>
+#' this is [unescaped] and this is [escaped]
+#' </text>
 #' ```
 #'
 #' This will ensure that the unescaped markdown remains unescaped.
@@ -479,35 +470,37 @@ fix_unescaped_squares <- function(nodes, txt) {
 #'   list items will have an offset of 4L because they are preceeded by ` - `.
 #'   Defaults to `1L`, indicating that this text node starts as a paragraph
 #'   whose parent is the root of the document.
-#' @return new XML nodes, invisibly
+#' @return modified XML nodes, invisibly
 #' @noRd
 fix_unescaped <- function(node, escaped = integer(0), offset = 1L) {
 
   txt <- as.character(node)
-  if (length(escaped) == 0) {
-    # If we have no escaped characters, then we can do a broad substitution
-    unescaped <- TRUE
-  } else {
-    # Converted to text, the node becomes <text ...>Actual text</text> Because
-    # the position is based on the actual text, we need to find the start of
-    # the actual text in the node text
-    text_start <- gregexpr("[>]", txt)[[1]][[1]] + 1L
+  if (length(escaped) > 0) {
     # Because the escaped characters were stripped off, we have to account for
     # a rolling count of the number of escapes
     missing_chars <- seq_along(escaped) - 1L
-    # If the source starts with markup, we have to take into account the offset
-    # position. This will set the escaped to start at the end of the XML markup
-    unescaped <- -(escaped + text_start - offset - missing_chars)
+    # If the source starts with markup (e.g. a list item), we have to take into
+    # account the offset position. This will set the escaped to start at the
+    # end of the XML markup
+    escaped <- escaped - missing_chars - offset + 1L
   }
-  # Here we split the character and exclude the escaped braces, protecting
-  # the unescaped braces.
-  chars <- strsplit(txt, "")[[1]]
-  chars[unescaped] <- sub(
+  return(label_unescaped(node, except = escaped))
+}
+
+
+label_unescaped <- function(node, except = integer(0)) {
+  char <- xml2::xml_text(node)
+  # Find the locations of inline chars that is complete
+  locations <- gregexpr(
     pattern = "(\\[|\\])",
-    replacement = "</text><text asis='true'>\\1</text><text>",
-    x = chars[unescaped]
+    char,
+    perl = TRUE
   )
-  new_nodes <- make_text_nodes(paste(chars, collapse = ""))
-  add_node_siblings(node, new_nodes, remove = TRUE)
+  # add the ranges to the attributes
+  # <text>this is $\LaTeX$ text</text>
+  #   becomes
+  # <text protect.start='9' protect.end='16'>this is $\LaTeX$ text</text>
+  pos <- locations[[1]]
+  pos <- pos[!pos %in% except]
+  return(add_protected_ranges(node, pos, pos))
 }
-