Preparing for v0.1.3

Fix #51, Fix #53, Fix #54, Fix #55, Fix #56

.Rbuildignore

@@ -5,3 +5,4 @@
 ^\.travis\.yml$
 ^scratch\.R$
 \.Rdata
+covr\.R

.travis.yml

@@ -7,6 +7,7 @@ branches:
     - master
     - development
     - rc
+    - misc
 
 after_success:
-  - Rscript -e 'covr::codecov()'
+  - Rscript covr.R

DESCRIPTION

@@ -1,9 +1,9 @@
 Package: diffobj
 Type: Package
 Title: Compare R Objects with a Diff
-Description:  Colorized diffs to quickly identify _and understand_ differences
+Description: Colorized diffs to quickly identify _and understand_ differences
     between R objects.  See `vignette("diffobj")` for details.
-Version: 0.1.2
+Version: 0.1.3
 Date: 2016-07-31
 Authors@R: c(
     person(
@@ -28,6 +28,7 @@ Collate:
     'capt.R'
     'check.R'
     'pager.R'
+    'finalizer.R'
     'misc.R'
     'html.R'
     'styles.R'

NAMESPACE

@@ -33,8 +33,10 @@ export(diffObj)
 export(diffPrint)
 export(diffStr)
 export(diffobj_css)
+export(diffobj_js)
 export(diffobj_set_def_opts)
 export(div_f)
+export(finalizeHtml)
 export(gdo)
 export(guidesChr)
 export(guidesDeparse)
@@ -43,6 +45,7 @@ export(guidesPrint)
 export(guidesStr)
 export(has_Rdiff)
 export(make_blocking)
+export(nchar_html)
 export(pager_is_less)
 export(ses)
 export(span_f)
@@ -52,6 +55,7 @@ export(trimDeparse)
 export(trimFile)
 export(trimPrint)
 export(trimStr)
+export(view_or_browse)
 exportClasses(AlignThreshold)
 exportClasses(PagerOff)
 exportClasses(PagerSystem)
@@ -70,6 +74,8 @@ exportClasses(StyleHtml)
 exportClasses(StyleHtmlLightRgb)
 exportClasses(StyleHtmlLightYb)
 exportClasses(StyleRaw)
+exportClasses(StyleSummary)
+exportClasses(StyleSummaryHtml)
 exportClasses(StyleText)
 exportMethods("[")
 exportMethods(diffObj)

NEWS.md

@@ -1,19 +1,33 @@
-## diffobj 0.1.2
+# diffobj
 
-Bugfixes:
+## v0.1.3
+
+* [#51](https://github.com/brodieG/diffobj/issues/51) use RStudio viewport to display HTML diffs when running in RStudio, as per [Noam Ross](https://twitter.com/noamross/status/760115813559009280)
+* [#54](https://github.com/brodieG/diffobj/issues/54), [#55](https://github.com/brodieG/diffobj/issues/55), scale HTML output to viewport width (see `?Style`)
+* [#53](https://github.com/brodieG/diffobj/issues/53), default term colors computed on run instead of on package load
+* [#56](https://github.com/brodieG/diffobj/issues/56), disable wrap for HTML output
+* HTML output now captured with default width 80 since there is no explicit relationship between HTML viewport width and `getOption("width")`
+* Fix subtle rendering and formatting application flaws
+* Switch Travis shields to SVG per [Gábor Csárdi](https://github.com/gaborcsardi/diffobj/commit/710251f2cd663bfdadcab9aea6a37f9eb4a87599)
+* Improve in-hunk alignment of partially matching lines
+* Compile with `-pedantic`, fix related warnings [Arun](http://stackoverflow.com/users/559784/arun)
+* Improved coverage and more robust testing
+* Several internal structure changes to accomodate improvements
+
+## v0.1.2
 
 * [#46](https://github.com/brodieG/diffobj/issues/46): Guide and Trim Problems with Lists
-* [#47](https://github.com/brodieG/diffobj/issues/47): Output Format in non-ANSI Terminals Without Browser
-* [#48](https://github.com/brodieG/diffobj/issues/48): `make_blocking` Default prompt Confusing
+* [#47](https://github.com/brodieG/diffobj/issues/47): Output Format in non-ANSI Terminals Without Browser (reported by [Frank](https://github.com/brodieG/diffobj/issues/47))
+* [#48](https://github.com/brodieG/diffobj/issues/48): `make_blocking` Default prompt Confusing (reported by [Frank](https://github.com/brodieG/diffobj/issues/47))
 * [#49](https://github.com/brodieG/diffobj/issues/49): In-Hunk Word Diffs Issues when Unwrap-diffing Atomics
-* [#50](https://github.com/brodieG/diffobj/issues/50): CSS Lost in Rstudio Server Sessions
+* [#50](https://github.com/brodieG/diffobj/issues/50): CSS Lost in Rstudio Server Sessions (reported by [Steven Beaupré](https://chat.stackoverflow.com/users/4064778/steven-beaupre))
 
-## diffobj 0.1.1
+## v0.1.1
 
 * Turn off unwrapping for _named_ atomic vectors (see [#43](https://github.com/brodieG/diffobj/issues/43))
 * [#44](https://github.com/brodieG/diffobj/issues/44): Proper handling of NULL objects in `diffStr`
 * [#41](https://github.com/brodieG/diffobj/issues/41): Compilation Issues in Winbuilder
 
-## diffobj 0.1.0
+## v0.1.0
 
 * Initial Release

R/capt.R

@@ -21,11 +21,12 @@
 capture <- function(x, etc, err) {
   capt.width <- etc@text.width
   if(capt.width) {
-    opt.set <- try(width.old <- options(width=capt.width))
+    opt.set <- try(width.old <- options(width=capt.width), silent=TRUE)
     if(inherits(opt.set, "try-error")) {
       warning(
-        "Unable to set desired width ", capt.width, ", proceeding with ",
-        "existing setting."
+        "Unable to set desired width ", capt.width, ", (",
+        conditionMessage(attr(opt.set, "condition")), ");",
+        "proceeding with existing setting."
       )
     } else on.exit(options(width.old))
   }
@@ -349,7 +350,7 @@ capt_csv <- function(target, current, etc, err, extra){
 
 set_mode <- function(etc, tar.capt, cur.capt) {
   stopifnot(is(etc, "Settings"), is.character(tar.capt), is.character(cur.capt))
-  nc_fun <- if(is(etc@style, "StyleAnsi")) crayon_nchar else nchar
+  nc_fun <- etc@style@nchar.fun
   if(etc@mode == "auto") {
     if(
       any(nc_fun(cur.capt) > etc@text.width.half) ||

R/check.R

@@ -92,7 +92,8 @@ is.one.arg.fun <- function(x) {
     nm.forms <- vapply(formals(x), is.name, logical(1L))
     forms.chr <- character(length(nm.forms))
     forms.chr[nm.forms] <- as.character(formals(x)[nm.forms])
-    if(any(tail(!nzchar(forms.chr) & nm.forms, -1L)))
+    forms.names <- names(formals(x))
+    if(any(tail(!nzchar(forms.chr) & nm.forms & forms.names != "...", -1L)))
       "cannot have any non-optional arguments other than first one" else TRUE
   }
 }
@@ -125,6 +126,7 @@ check_args <- function(
   extra, interactive, term.colors
 ) {
   err <- make_err_fun(call)
+  warn <- make_warn_fun(call)
 
   # Check extra
 
@@ -207,6 +209,7 @@ check_args <- function(
 
   # int 1L vars
 
+  if(is.null(term.colors)) term.colors <- crayon::num_colors()
   msg.base <- "Argument `%s` must be integer(1L) and not NA."
   int.1L.vars <- c("max.diffs", "term.colors")
   for(x in int.1L.vars) {
@@ -239,11 +242,16 @@ check_args <- function(
   }
   # style
 
-  if(!is(style, "Style") && !string_in(style, "auto"))
-    err("Argument `style` must be \"auto\" or a `Style` object.")
+  valid_object(style, "style", err)
+  if(
+    !is(style, "Style") && !string_in(style, "auto") &&
+    !(is.list(style) && !is.object(style))
+  )
+    err("Argument `style` must be \"auto\",  a `Style` object, or a list.")
 
   # pager
 
+  valid_object(pager, "pager", err)
   valid.pagers <- c("auto", "off", "on")
   if(!is(pager, "Pager") && !string_in(pager, valid.pagers))
     err(
@@ -280,7 +288,17 @@ check_args <- function(
   }
   # format; decide what format to use
 
-  if(!is(style, "Style") && string_in(style, "auto")) {
+  if(
+    !is(style, "Style") &&
+    (
+      string_in(style, "auto") || (is.list(style) && !is.object(style))
+    )
+  ) {
+    if(is.list(style)) {
+      style.args <- style
+      style <- "auto"
+    } else style.args <- list()
+
     if(!is.chr.1L(format))
       err("Argument `format` must be character(1L) and not NA")
     valid.formats <- c("auto", dimnames(palette.of.styles@data)$format)
@@ -307,7 +325,24 @@ check_args <- function(
     style <- palette.of.styles[[
       format, get_pal_par(format, brightness), get_pal_par(format, color.mode)
     ]]
-    if(is(style, "classRepresentation")) style <- new(style)
+    if(is(style, "classRepresentation")) {
+      style <- try(do.call("new", c(list(style), style.args)))
+      if(inherits(style, "try-error"))
+        err("Unable to instantiate `Style` object; see prior errors.")
+    } else {
+      if(length(style.args)) {
+        warn(
+          "Extra `style` arguments cannot be applied because selected object ",
+          "`palette.of.styles` is a `Style` instance rather than a `Style` ",
+          "\"classRepresentation\".  See documentation for the `style` ",
+          "parameter for details."
+      ) }
+      valid_object(
+        style, "palette.of.styles", err,
+        paste0(
+          "Argument `%s` is an invalid `%s` because it contains and invalid ",
+          "`Style` object:"
+    ) ) }
   } else if(!is(style, "Style"))
     stop("Logic Error: unexpected style state; contact maintainer.")
 

R/core.R

@@ -262,6 +262,29 @@ char_diff <- function(x, y, context=-1L, etc, diff.mode, warn) {
 
   list(hunks=hunks, hit.diffs.max=hit.diffs.max)
 }
+# Compute the character representation of a hunk header
+
+make_hh <- function(h.g, mode, tar.dat, cur.dat, ranges.orig) {
+  h.ids <- vapply(h.g, "[[", integer(1L), "id")
+  h.head <- vapply(h.g, "[[", logical(1L), "guide")
+
+  # exclude header hunks from contributing to range, and adjust ranges for
+  # possible fill lines added to the data
+
+  h.ids.nh <- h.ids[!h.head]
+  tar.rng <- find_rng(h.ids.nh, ranges.orig[1:2, , drop=FALSE])
+  tar.rng.f <- cumsum(!tar.dat$fill)[tar.rng]
+  cur.rng <- find_rng(h.ids.nh, ranges.orig[3:4, , drop=FALSE])
+  cur.rng.f <- cumsum(!cur.dat$fill)[cur.rng]
+
+  hh.a <- paste0(rng_as_chr(tar.rng.f))
+  hh.b <- paste0(rng_as_chr(cur.rng.f))
+
+  if(mode == "sidebyside") sprintf("@@ %s @@", c(hh.a, hh.b)) else {
+    sprintf("@@ %s / %s @@", hh.a, hh.b)
+  }
+}
+
 # Variation on `char_diff` used for the overall diff where we don't need
 # to worry about overhead from creating the `Diff` object
 
@@ -358,8 +381,11 @@ line_diff <- function(
     length(cur.rh <- which_atomic_cont(cur.capt.p, current)) &&
     etc@unwrap.atomic && etc@word.diff
   ) {
-    if(!all(diff(tar.rh) == 1L) || !all(diff(cur.rh)) == 1L)
+    if(!all(diff(tar.rh) == 1L) || !all(diff(cur.rh)) == 1L){
+      # nocov start
       stop("Logic Error, row headers must be sequential; contact maintainer.")
+      # nocov end
+    }
 
     # Only do this for the portion of the data that actually matches up with
     # the atomic row headers (NOTE: need to check what happens with named
@@ -440,11 +466,65 @@ line_diff <- function(
 
   # Instantiate result
 
-  hunk.grps <- group_hunks(
+  hunk.grps.raw <- group_hunks(
     hunks.flat, etc=etc, tar.capt=tar.dat$raw, cur.capt=cur.dat$raw
   )
+  # Recompute line limit accounting for banner len
+
+  gutter.dat <- etc@gutter
+  banner.len <- banner_len(etc@mode)
+  max.w <- etc@text.width
+
+  line.limit <- etc@line.limit
+  line.limit.a <- if(line.limit[[1L]] >= 0L)
+    pmax(integer(2L), line.limit - banner.len) else line.limit
+  etc@line.limit <- line.limit.a
+
+  # Trim hunks to the extented needed to make sure we fit in lines
+
+  hunk.grps <- trim_hunks(hunk.grps.raw, etc, tar.dat$raw, cur.dat$raw)
+  hunks.flat <- unlist(hunk.grps, recursive=FALSE)
+
+  # Compact to width of widest element, so retrieve all char values; also
+  # need to generate all the hunk headers b/c we need to use them in width
+  # computation as well; under no circumstances are hunk headers allowed to
+  # wrap as they are always assumed to take one line.
+  #
+  # Note: this used to be done after trimming / subbing, which is technically
+  # better since we might have trimmed away long rows, but we need to do it
+  # here so that we can can record the new text width in the outgoing object;
+  # also, logic a bit circuitous b/c this was originally done elsewhere; might
+  # be faster to use tar.dat and cur.dat directly
+
+  chr.ind <- unlist(lapply(hunks.flat, "[", c("A", "B")))
+  chr.dat <- get_dat_raw(chr.ind, tar.dat$raw, cur.dat$raw)
+  chr.size <- integer(length(chr.dat))
+
+  ranges <- vapply(
+    hunks.flat, function(h.a) c(h.a$tar.rng.trim, h.a$cur.rng.trim),
+    integer(4L)
+  )
+  ranges.orig <- vapply(
+    hunks.flat, function(h.a) c(h.a$tar.rng.sub, h.a$cur.rng.sub), integer(4L)
+  )
+  hunk.heads <-
+    lapply(hunk.grps, make_hh, etc@mode, tar.dat, cur.dat, ranges.orig)
+  h.h.chars <- nchar(chr_trim(unlist(hunk.heads), etc@line.width))
+
+  chr.size <- etc@style@nchar.fun(chr.dat)
+  max.col.w <- max(
+    max(0L, chr.size, .min.width + gutter.dat@width), h.h.chars
+  )
+  max.w <- if(max.col.w < max.w) max.col.w else max.w
+
+  # future calculations should assume narrower display
+
+  etc@text.width <- max.w
+  etc@line.width <- max.w + gutter.dat@width
+
   new(
     "Diff", diffs=hunk.grps, target=target, current=current,
-    hit.diffs.max=!warn, tar.dat=tar.dat, cur.dat=cur.dat, etc=etc
+    hit.diffs.max=!warn, tar.dat=tar.dat, cur.dat=cur.dat, etc=etc,
+    hunk.heads=hunk.heads
   )
 }