Bugfixes raised by GMTs (47-50)

Fix #47, Fix #48, Fix #49, Fix #50
brodieG · Aug 1, 2016 · 4b36bb4 · 4b36bb4
2 parents 6a59955 + 19e06ae
commit 4b36bb4
Show file tree

Hide file tree

Showing 20 changed files with 133 additions and 118 deletions.
diff --git a/R/check.R b/R/check.R
@@ -295,7 +295,9 @@ check_args <- function(
       # No recognized color alternatives, try to use HTML if we can
 
       format <- if(!term.colors %in% c(8, 256)) {
-        if(interactive) "html" else "raw"
+        if(
+          interactive && (identical(pager, "on") || is(pager, "PagerBrowser"))
+        ) "html" else "raw"
       } else if (term.colors == 8) {
         "ansi8"
       } else if (term.colors == 256) {

diff --git a/R/core.R b/R/core.R
@@ -349,6 +349,9 @@ line_diff <- function(
   # Word diffs in wrapped form is atomic; note this will potentially change
   # the length of the vectors
 
+  tar.wrap.diff <- integer(0L)
+  cur.wrap.diff <- integer(0L)
+
   if(
     is.atomic(target) && is.atomic(current) &&
     length(tar.rh <- which_atomic_cont(tar.capt.p, target)) &&
@@ -383,6 +386,13 @@ line_diff <- function(
       Map(dat.up, tar.dat, diff.word$tar.dat, MoreArgs=list(ind=tar.rh))
     cur.dat <-
       Map(dat.up, cur.dat, diff.word$cur.dat, MoreArgs=list(ind=cur.rh))
+
+    # Mark the lines that were wrapped diffed; necessary b/c tar/cur.rh are
+    # defined even if other conditions to get in this loop are not, and also
+    # because the addition of the fill lines moves everything around
+
+    tar.wrap.diff <- seq_along(tar.dat$fill)[!tar.dat$fill][tar.rh]
+    cur.wrap.diff <- seq_along(cur.dat$fill)[!cur.dat$fill][cur.rh]
   }
   # Actual line diff
 
@@ -398,23 +408,14 @@ line_diff <- function(
   # diff data for each hunk, which might be slow
 
   if(etc@word.diff) {
-    # Word diffs on hunks; check first which lines already have diffs and
-    # identify the diff hunks that don't contain any of those lines
+    # Word diffs on hunks, excluding all values that have already been wrap
+    # diffed as in tar.rh and cur.rh
 
-    tar.l.w.d <- which(vapply(tar.dat$word.ind, "[", integer(1L), 1L) != -1L)
-    cur.l.w.d <- which(vapply(cur.dat$word.ind, "[", integer(1L), 1L) != -1L)
-    all.l.w.d <- c(tar.l.w.d, -cur.l.w.d)
-
-    hunks.w.o.w.diff <- vapply(
-      hunks.flat,
-      function(y) !y$context && !any(unlist(y[c("A", "B")]) %in% all.l.w.d),
-      logical(1L)
-    )
-    for(i in which(hunks.w.o.w.diff)) {
-      h.a <- hunks.flat[[i]]
+    for(h.a in hunks.flat) {
+      if(h.a$context) next
       h.a.ind <- c(h.a$A, h.a$B)
-      h.a.tar.ind <- h.a.ind[h.a.ind > 0]
-      h.a.cur.ind <- abs(h.a.ind[h.a.ind < 0])
+      h.a.tar.ind <- setdiff(h.a.ind[h.a.ind > 0], tar.wrap.diff)
+      h.a.cur.ind <- setdiff(abs(h.a.ind[h.a.ind < 0]), cur.wrap.diff)
       h.a.w.d <- diff_word2(
         tar.dat, cur.dat, h.a.tar.ind, h.a.cur.ind, diff.mode="hunk", warn=warn,
         etc=etc

diff --git a/R/pager.R b/R/pager.R
@@ -169,7 +169,7 @@ setMethod("initialize", "PagerSystemLess",
 #' @return \code{fun}, wrapped in a function that does the blocking
 
 make_blocking <- function(
-  fun, msg="Press any key to continue...", invisible.res=TRUE
+  fun, msg="Press ENTER to continue...", invisible.res=TRUE
 ) {
   if(!is.function(fun)) stop("Argument `fun` must be a function")
   if(!is.chr.1L(msg)) stop("Argument `msg` must be character(1L) and not NA")

diff --git a/R/styles.R b/R/styles.R
@@ -303,14 +303,18 @@ StyleText <- setClass(
 #'
 #' Should you want to capture the HTML output for use elsewhere, you can do
 #' so by using \code{as.character} on the return value of the \code{diff*}
-#' methods.  If you want the raw HTML without any of the headers and links to
-#' css use \code{html.ouput="diff.only"} when you instantiate the \code{Style}
-#' object (see examples), or disable the \code{\link{Pager}}.  Another option
-#' is \code{html.output="diff.w.style"} which will add a \code{<style></style>}
-#' tag pair with all the CSS styles crammed therein.  This last option results
-#' in illegal HTML with a \code{<style>} block insite the \code{<body>} block,
-#' but appears to work and is useful if you want to embed HTML someplace but do
-#' not have access to the headers.
+#' methods.  If you want the raw HTML without any of the headers and
+#' css in \code{<style>} tags use \code{html.ouput="diff.only"} when you
+#' instantiate the \code{Style} object (see examples), or disable the
+#' \code{\link{Pager}}.  Another option is \code{html.output="diff.w.style"}
+#' which will add \code{<style>} tags with the CSS, but without wrapping those
+#' in \code{<head>} tags. This last option results in illegal HTML with a
+#' \code{<style>} block inside the \code{<body>} block, but appears to work and
+#' is useful if you want to embed HTML someplace but do not have access to the
+#' headers.
+#'
+#' For compatibility with RStudio server sessions the styles are always included
+#' directly within \code{style} tags rather than in an external style sheet.
 #'
 #' Unlike with ANSI styles, you should not modify the styling functions in the
 #' \code{@funs} slot of the \code{Style} object.  Instead, provide your own
@@ -324,7 +328,7 @@ StyleText <- setClass(
 #'     and pass that object as the value for the \code{style} parameter for the
 #'     \code{diff*} methods (see example)
 #'   \item as above, but asign the object to the active \code{PaletteOfStyles}
-#'   \item  set the \dQuote{diffobj.css} option
+#'   \item  set the \dQuote{diffobj.html.css} option
 #' }
 #'
 #' If you define your own custom \code{StyleHtml} object you may want to modify
@@ -644,7 +648,9 @@ StyleHtml <- setClass(
 )
 #' Return Location of Default CSS File
 #'
-#' Used as the value for \code{getOption("diffobj.css")}.
+#' Used as the value for \code{getOption("diffobj.html.css")}.  Note that the
+#' contents of this file rather than the file address are used when
+#' constructing HTML output.
 #'
 #' @export
 #' @return path to the default CSS file
@@ -682,13 +688,14 @@ setMethod("initialize", "StyleHtml",
       if(html.output == "auto") {
         html.output <- if(is(pager, "PagerBrowser")) "page" else "diff.only"
       }
-      if(html.output == "diff.w.style") {
+      if(html.output %in% c("diff.w.style", "page")) {
         css.txt <- try(paste0(readLines(css), collapse="\n"))
         if(inherits(css.txt, "try-error")) stop("Cannot read css file ", css)
         css <- sprintf("<style type='text/css'>%s</style>", css.txt)
+      }
+      if(html.output == "diff.w.style") {
         tpl <- "%s%s"
       } else if (html.output == "page") {
-        css <- sprintf("<link rel='stylesheet' type='text/css' href='%s'>", css)
         tpl <- "<!DOCTYPE html><html><head>%s</head><body>%s</body><html>"
       } else if (html.output == "diff.only") {
         css <- ""

diff --git a/R/trim.R b/R/trim.R
@@ -293,7 +293,7 @@ strip_list_rh <- function(x, obj) {
   # Split output into each list component
 
   list.h <- detect_list_guides(x)
-  dat <- split_by_guides(x, list.h, drop=FALSE)
+  dat <- split_by_guides(x, list.h, drop.leading=FALSE)
   elements <- flatten_list(obj)
 
   # Special case where first element in list is deeper than one value, which

diff --git a/man/Style.Rd b/man/Style.Rd
diff --git a/man/diffChr.Rd b/man/diffChr.Rd
diff --git a/man/diffCsv.Rd b/man/diffCsv.Rd
diff --git a/man/diffDeparse.Rd b/man/diffDeparse.Rd
diff --git a/man/diffFile.Rd b/man/diffFile.Rd
diff --git a/man/diffPrint.Rd b/man/diffPrint.Rd
diff --git a/man/diffStr.Rd b/man/diffStr.Rd
diff --git a/man/diffobj_css.Rd b/man/diffobj_css.Rd
diff --git a/man/make_blocking.Rd b/man/make_blocking.Rd
diff --git a/tests/run.R b/tests/run.R
@@ -3,15 +3,15 @@
 library(testthat)
 library(diffobj)
 
-local({
+local({                                         # so we can use `on.exit`
   old.opts <- diffobj_set_def_opts()
   options(diffobj.style=StyleAnsi8NeutralYb())  # force ANSI colors
   options(diffobj.pager="off")                  # run tests without pager
   options(width=80L)
   on.exit(options(old.opts))
   test_dir(
     "testthat",
-    filter=paste0(
+    filter=paste0(                              # so we can run subset of files
       c(
         "atomic",
         "banner",

diff --git a/tests/testthat/helper/diffPrint/3200.rds b/tests/testthat/helper/diffPrint/3200.rds
diff --git a/tests/testthat/helper/html/300.rds b/tests/testthat/helper/html/300.rds