1# Copyright (C) 2021 Brodie Gaslam 2# 3# This file is part of "diffobj - Diffs for R Objects" 4# 5# This program is free software: you can redistribute it and/or modify 6# it under the terms of the GNU General Public License as published by 7# the Free Software Foundation, either version 2 of the License, or 8# (at your option) any later version. 9# 10# This program is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13# GNU General Public License for more details. 14# 15# Go to <https://www.r-project.org/Licenses/GPL-2> for a copy of the license. 16 17#' Objects for Specifying Pager Settings 18#' 19#' Initializers for pager configuration objects that modify pager behavior. 20#' These objects can be used as the \code{pager} argument to the 21#' \code{\link[=diffPrint]{diff*}} methods, or as the \code{pager} slot for 22#' \code{\link{Style}} objects. In this documentation we use the \dQuote{pager} 23#' term loosely and intend it to refer to any device other than the terminal 24#' that can be used to render output. 25#' 26#' @section Default Output Behavior: 27#' 28#' \code{\link[=diffPrint]{diff*}} methods use \dQuote{pagers} to help 29#' manage large outputs and also to provide an alternative colored diff when the 30#' terminal does not support them directly. 31#' 32#' For OS X and *nix systems where \code{less} is the pager and the 33#' terminal supports ANSI escape sequences, output is colored with ANSI escape 34#' sequences. If the output exceeds one screen height in size (as estimated by 35#' \code{\link{console_lines}}) it is sent to the pager. 36#' 37#' If the terminal does not support ANSI escape sequences, or if the system 38#' pager is not \code{less} as detected by \code{\link{pager_is_less}}, then the 39#' output is rendered in HTML and sent to the IDE viewer 40#' (\code{getOption("viewer")}) if defined, or to the browser with 41#' \code{\link{browseURL}} if not. This behavior may seem sub-optimal for 42#' systems that have ANSI aware terminals and ANSI aware pagers other than 43#' \code{less}, but these should be rare and it is possible to configure 44#' \code{diffobj} to produce the correct output for them (see examples). 45#' 46#' @section Pagers and Styles: 47#' 48#' There is a close relationship between pagers and \code{\link{Style}}. The 49#' \code{Style} objects control whether the output is raw text, formatted 50#' with ANSI escape sequences, or marked up with HTML. In order for these 51#' different types of outputs to render properly, they need to be sent to the 52#' right device. For this reason \code{\link{Style}} objects come with a 53#' \code{Pager} configuration object pre-assigned so the output can render 54#' correctly. The exact \code{Pager} configuration object depends on the 55#' \code{\link{Style}} as well as the system configuration. 56#' 57#' In any call to the \code{\link[=diffPrint]{diff*}} methods you can always 58#' specify both the \code{\link{Style}} and \code{Pager} configuration object 59#' directly for full control of output formatting and rendering. We have tried 60#' to set-up sensible defaults for most likely use cases, but given the complex 61#' interactions involved it is possible you may need to configure things 62#' explicitly. Should you need to define explicit configurations you can save 63#' them as option values with 64#' \code{options(diffobj.pager=..., diffobj.style=...)} so that you do not need 65#' to specify them each time you use \code{diffobj}. 66#' 67#' @section Pager Configuration Objects: 68#' 69#' The \code{Pager} configuration objects allow you to specify what device to 70#' use as the pager and under what circumstances the pager should be used. 71#' Several pre-defined pager configuration objects are available via 72#' constructor functions: 73#' \itemize{ 74#' \item \code{Pager}: Generic pager just outputs directly to terminal; not 75#' useful unless the default parameters are modified. 76#' \item \code{PagerOff}: Turn off pager 77#' \item \code{PagerSystem}: Use the system pager as invoked by 78#' \code{\link{file.show}} 79#' \item \code{PagerSystemLess}: Like \code{PagerSystem}, but provides 80#' additional configuration options if the system pager is \code{less}. 81#' Note this object does not change the system pager; it only allows you to 82#' configure it via the \code{$LESS} environment variable which will have 83#' no effect unless the system pager is set to be \code{less}. 84#' \item \code{PagerBrowser}: Use \code{getOption("viewer")} if defined, or 85#' \code{\link{browseURL}} if not 86#' } 87#' The default configuration for \code{PagerSystem} and \code{PagerSystemLess} 88#' leads to output being sent to the pager if it exceeds the estimated window 89#' size, whereas \code{PagerBrowser} always sends output to the pager. This 90#' behavior can be configured via the \code{threshold} parameter. 91#' 92#' \code{PagerSystemLess}'s primary role is to correctly configure the 93#' \code{$LESS} system variable so that \code{less} renders the ANSI escape 94#' sequences as intended. On OS X \code{more} is a faux-alias to \code{less}, 95#' except it does not appear to read the \code{$LESS} system variable. 96#' Should you configure your system pager to be the \code{more} version of 97#' \code{less}, \code{\link{pager_is_less}} will be tricked into thinking you 98#' are using a \dQuote{normal} version of \code{less} and you will likely end up 99#' seeing gibberish in the pager. If this is your use case you will need to 100#' set-up a custom pager configuration object that sets the correct system 101#' variables. 102#' 103#' @section Custom Pager Configurations: 104#' 105#' In most cases the simplest way to generate new pager configurations is to use 106#' a list specification in the \code{\link[=diffPrint]{diff*}} call. 107#' Alternatively you can start with an existing \code{Pager} object and change 108#' the defaults. Both these cases are covered in the examples. 109#' 110#' You can change what system pager is used by \code{PagerSystem} by changing it 111#' with \code{options(pager=...)} or by changing the \code{$PAGER} environment 112#' variable. You can also explicitly set a function to act as the pager when 113#' you instantiate the \code{Pager} configuration object (see examples). 114#' 115#' If you wish to define your own pager object you should do so by extending the 116#' any of the \code{Pager} classes. If the function you use to handle the 117#' actual paging is non-blocking (i.e. allows R code evaluation to continue 118#' after it is spawned, you should set the \code{make.blocking} parameter to 119#' TRUE to pause execution prior to deleting the temporary file that contains 120#' the diff. 121#' 122#' @param pager a function that accepts at least one parameter and does not 123#' require a parameter other than the first parameter. This function will be 124#' called with a file path passed as the first argument. The referenced file 125#' will contain the text of the diff. By default this is a temporary file that 126#' will be deleted as soon as the pager function completes evaluation. 127#' \code{PagerSystem} and \code{PagerSystemLess} use \code{\link{file.show}} 128#' by default, and \code{PagerBrowser} uses 129#' \code{\link{view_or_browse}} for HTML output. For asynchronous pagers such 130#' as \code{view_or_browse} it is important to make the pager function 131#' blocking by setting the \code{make.blocking} parameter to TRUE, or to 132#' specify a pager file path explicitly with \code{file.path}. 133#' @param file.ext character(1L) an extension to append to file path passed to 134#' \code{pager}, \emph{without} the period. For example, \code{PagerBrowser} 135#' uses \dQuote{html} to cause \code{\link{browseURL}} to launch the web 136#' browser. This parameter will be overridden if \code{file.path} is used. 137#' @param threshold integer(1L) number of lines of output that triggers the use 138#' of the pager; negative values lead to using 139#' \code{\link{console_lines} + 1}, and zero leads to always using the pager 140#' irrespective of how many lines the output has. 141#' @param ansi TRUE or FALSE, whether the pager supports ANSI CSI SGR sequences. 142#' @param flags character(1L), only for \code{PagerSystemLess}, what flags to 143#' set with the \code{LESS} system environment variable. By default the 144#' \dQuote{R} flag is set to ensure ANSI escape sequences are interpreted if 145#' it appears your terminal supports ANSI escape sequences. If you want to 146#' leave the output on the screen after you exit the pager you can use 147#' \dQuote{RX}. You should only provide the flag letters (e.g. \dQuote{"RX"}, 148#' not \code{"-RX"}). The system variable is only modified for the duration 149#' of the evaluation and is reset / unset afterwards. \emph{Note:} you must 150#' specify this slot via the constructor as in the example. If you set the 151#' slot directly it will not have any effect. 152#' @param file.path character(1L), if not NA the diff will be written to this 153#' location, ignoring the value of \code{file.ext}. If NA_character_ 154#' (default), a temporary file is used and removed after the pager function 155#' completes evaluation. If not NA, the file is preserved. Beware that the 156#' file will be overwritten if it already exists. 157#' @param make.blocking TRUE, FALSE, or NA. Whether to wrap \code{pager} with 158#' \code{\link{make_blocking}} prior to calling it. This suspends R code 159#' execution until there is user input so that temporary diff files are not 160#' deleted before the pager has a chance to read them. This typically 161#' defaults to FALSE, except for \code{PagerBrowser} where it defaults to NA, 162#' which resolves to \code{is.na(file.path)} (i.e. it is TRUE if the diff is 163#' being written to a temporary file, and FALSE otherwise). 164#' @param ... additional arguments to pass on to \code{new} that are passed on 165#' to parent classes. 166#' 167#' @aliases PagerOff, PagerSystem, PagerSystemLess, PagerBrowser 168#' @importFrom utils browseURL 169#' @include options.R 170#' @rdname Pager 171#' @name Pager 172#' @seealso \code{\link{Style}}, \code{\link{pager_is_less}} 173#' @examples 174#' ## We `dontrun` these examples as they involve pagers that should only be run 175#' ## in interactive mode 176#' \dontrun{ 177#' ## Specify Pager parameters via list; this lets the `diff*` functions pick 178#' ## their preferred pager based on format and other output parameters, but 179#' ## allows you to modify the pager behavior. 180#' 181#' f <- tempfile() 182#' diffChr(1:200, 180:300, format='html', pager=list(file.path=f)) 183#' head(readLines(f)) # html output 184#' unlink(f) 185#' 186#' ## Assuming system pager is `less` and terminal supports ANSI ESC sequences 187#' ## Equivalent to running `less -RFX` 188#' 189#' diffChr(1:200, 180:300, pager=PagerSystemLess(flags="RFX")) 190#' 191#' ## If the auto-selected pager would be the system pager, we could 192#' ## equivalently use: 193#' 194#' diffChr(1:200, 180:300, pager=list(flags="RFX")) 195#' 196#' ## System pager is not less, but it supports ANSI escape sequences 197#' 198#' diffChr(1:200, 180:300, pager=PagerSystem(ansi=TRUE)) 199#' 200#' ## Use a custom pager, in this case we make up a trivial one and configure it 201#' ## always page (`threshold=0L`) 202#' 203#' page.fun <- function(x) cat(paste0("| ", readLines(x)), sep="\n") 204#' page.conf <- PagerSystem(pager=page.fun, threshold=0L) 205#' diffChr(1:200, 180:300, pager=page.conf, disp.width=getOption("width") - 2) 206#' 207#' ## Set-up the custom pager as the default pager 208#' 209#' options(diffobj.pager=page.conf) 210#' diffChr(1:200, 180:300) 211#' 212#' ## A blocking pager (this is effectively very similar to what `PagerBrowser` 213#' ## does); need to block b/c otherwise temp file with diff could be deleted 214#' ## before the device has a chance to read it since `browseURL` is not 215#' ## blocking itself. On OS X we need to specify the extension so the correct 216#' ## program opens it (in this case `TextEdit`): 217#' 218#' page.conf <- Pager(pager=browseURL, file.ext="txt", make.blocking=TRUE) 219#' diffChr(1:200, 180:300, pager=page.conf, format='raw') 220#' 221#' ## An alternative to a blocking pager is to disable the 222#' ## auto-file deletion; here we also specify a file location 223#' ## explicitly so we can recover the diff text. 224#' 225#' f <- paste0(tempfile(), ".html") # must specify .html 226#' diffChr(1:5, 2:6, format='html', pager=list(file.path=f)) 227#' tail(readLines(f)) 228#' unlink(f) 229#' } 230 231setClass( 232 "Pager", 233 slots=c( 234 pager="function", file.ext="character", threshold="numeric", 235 ansi="logical", file.path="character", make.blocking="logical" 236 ), 237 prototype=list( 238 pager=function(x) writeLines(readLines(x)), file.ext="", threshold=0L, 239 ansi=FALSE, file.path=NA_character_, make.blocking=FALSE 240 ), 241 validity=function(object) { 242 if(!is.chr.1L(object@file.ext)) return("Invalid `file.ext` slot") 243 if(!is.int.1L(object@threshold)) return("Invalid `threshold` slot") 244 if(!is.TF(object@ansi)) return("Invalid `ansi` slot") 245 if(!is.logical(object@make.blocking) || length(object@make.blocking) != 1L) 246 return("Invalid `make.blocking` slot") 247 if(!is.character(object@file.path) || length(object@file.path) != 1L) 248 return("Invalid `file.path` slot") 249 250 TRUE 251 } 252) 253setMethod("initialize", "Pager", 254 function(.Object, ...) { 255 dots <- list(...) 256 if("file.path" %in% names(dots)) { 257 file.path <- dots[['file.path']] 258 if(length(file.path) != 1L) 259 stop("Argument `file.path` must be length 1.") 260 if(is.na(file.path)) file.path <- NA_character_ 261 if(!is.character(file.path)) 262 stop("Argument `file.path` must be character.") 263 dots[['file.path']] <- file.path 264 } 265 do.call(callNextMethod, c(list(.Object), dots)) 266 } 267) 268 269#' @export 270#' @rdname Pager 271 272Pager <- function( 273 pager=function(x) writeLines(readLines(x)), file.ext="", threshold=0L, 274 ansi=FALSE, file.path=NA_character_, make.blocking=FALSE 275) { 276 new( 277 'Pager', pager=pager, file.ext=file.ext, threshold=threshold, 278 file.path=file.path, make.blocking=make.blocking 279) } 280#' @export 281#' @rdname Pager 282 283setClass("PagerOff", contains="Pager") 284 285#' @export 286#' @rdname Pager 287 288PagerOff <- function(...) new("PagerOff", ...) 289 290#' @export 291#' @rdname Pager 292 293setClass( 294 "PagerSystem", contains="Pager", 295 prototype=list(pager=file.show, threshold=-1L, file.ext="") 296) 297#' @export 298#' @rdname Pager 299 300PagerSystem <- function(pager=file.show, threshold=-1L, file.ext="", ...) 301 new("PagerSystem", pager=pager, threshold=threshold, ...) 302 303#' @export 304#' @rdname Pager 305 306setClass( 307 "PagerSystemLess", contains="PagerSystem", slots=c("flags"), 308 prototype=list(flags="R") 309) 310#' @export 311#' @rdname Pager 312 313PagerSystemLess <- function( 314 pager=file.show, threshold=-1L, flags="R", file.ext="", ansi=TRUE, ... 315) 316 new( 317 "PagerSystemLess", pager=pager, threshold=threshold, flags=flags, 318 ansi=ansi, file.ext=file.ext, ... 319 ) 320 321# Must use initialize so that the pager function can access the flags slot 322 323setMethod("initialize", "PagerSystemLess", 324 function(.Object, ...) { 325 dots <- list(...) 326 flags <- if("flags" %in% names(dots)) { 327 if(!is.chr.1L(dots[['flags']])) 328 stop("Argument `flags` must be character(1L) and not NA") 329 dots[['flags']] 330 } else "" 331 pager.old <- dots[['pager']] 332 pager <- function(x) { 333 old.less <- set_less_var(flags) 334 on.exit(reset_less_var(old.less), add=TRUE) 335 pager.old(x) 336 } 337 dots[['flags']] <- flags 338 dots[['pager']] <- pager 339 do.call(callNextMethod, c(list(.Object), dots)) 340} ) 341#' Create a Blocking Version of a Function 342#' 343#' Wraps \code{fun} in a function that runs \code{fun} and then issues a 344#' \code{readline} prompt to prevent further R code evaluation until user 345#' presses a key. 346#' 347#' @export 348#' @param fun a function 349#' @param msg character(1L) a message to use as the \code{readline} prompt 350#' @param invisible.res whether to return the result of \code{fun} invisibly 351#' @return \code{fun}, wrapped in a function that does the blocking. 352#' @examples 353#' make_blocking(sum, invisible.res=FALSE)(1:10) 354 355make_blocking <- function( 356 fun, msg="Press ENTER to continue...", invisible.res=TRUE 357) { 358 if(!is.function(fun)) stop("Argument `fun` must be a function") 359 if(!is.chr.1L(msg)) stop("Argument `msg` must be character(1L) and not NA") 360 if(!is.TF(invisible.res)) 361 stop("Argument `invisible.res` must be TRUE or FALSE") 362 res <- function(...) { 363 res <- fun(...) 364 readline(msg) 365 if(invisible.res) invisible(res) else res 366 } 367 res 368} 369#' Invoke IDE Viewer If Available, browseURL If Not 370#' 371#' Use \code{getOption("viewer")} to view HTML output if it is available as 372#' per \href{https://support.rstudio.com/hc/en-us/articles/202133558-Extending-RStudio-with-the-Viewer-Pane}{RStudio}. Fallback to \code{\link{browseURL}} 373#' if not available. 374#' 375#' @export 376#' @param url character(1L) a location containing a file to display 377#' @return the return vaue of \code{getOption("viewer")} if it is a function, or 378#' of \code{\link{browseURL}} if the viewer is not available 379 380view_or_browse <- function(url) { 381 viewer <- getOption("viewer") 382 view.success <- FALSE 383 if(is.function(viewer)) { 384 view.try <- try(res <- viewer(url), silent=TRUE) 385 if(inherits(view.try, "try-error")) { 386 warning( 387 "IDE viewer failed with error ", 388 conditionMessage(attr(view.try, "condition")), 389 "; falling back to `browseURL`" 390 ) 391 } else view.success <- TRUE 392 } 393 if(!view.success) { 394 res <- utils::browseURL(url) 395 } 396 res 397} 398setClass( 399 "PagerBrowser", contains="Pager", 400 prototype=list(threshold=0L, file.ext='html', make.blocking=NA) 401) 402 403#' @export 404#' @rdname Pager 405 406PagerBrowser <- function( 407 pager=view_or_browse, threshold=0L, file.ext="html", make.blocking=NA, ... 408) 409 new( 410 "PagerBrowser", pager=pager, threshold=threshold, file.ext=file.ext, 411 make.blocking=make.blocking, ... 412 ) 413 414# Helper function to determine whether pager will be used or not 415 416use_pager <- function(pager, len) { 417 if(!is(pager, "Pager")) 418 stop("Logic Error: expecting `Pager` arg; contact maintainer.") # nocov 419 if(!is(pager, "PagerOff")) { 420 threshold <- if(pager@threshold < 0L) { 421 console_lines() 422 } else pager@threshold 423 !threshold || len > threshold 424 } else FALSE 425} 426#' Check Whether System Has less as Pager 427#' 428#' If \code{getOption(pager)} is set to the default value, checks whether 429#' \code{Sys.getenv("PAGER")} appears to be \code{less} by trying to run the 430#' pager with the \dQuote{version} and parsing the output. If 431#' \code{getOption(pager)} is not the default value, then checks whether it 432#' points to the \code{less} program by the same mechanism. 433#' 434#' Some systems may have \code{less} pagers installed that do not respond to the 435#' \code{$LESS} environment variable. For example, \code{more} on at least some 436#' versions of OS X is \code{less}, but does not actually respond to 437#' \code{$LESS}. If such as pager is the system pager you will likely end up 438#' seeing gibberish in the pager. If this is your use case you will need to 439#' set-up a custom pager configuration object that sets the correct system 440#' variables (see \code{\link{Pager}}). 441#' 442#' @seealso \code{\link{Pager}} 443#' @return TRUE or FALSE 444#' @export 445#' @examples 446#' pager_is_less() 447 448pager_is_less <- function() { 449 pager.opt <- getOption("pager") 450 if(pager_opt_default(pager.opt)) { 451 file_is_less(Sys.getenv("PAGER")) 452 } else if (is.character(pager.opt)) { 453 file_is_less(head(pager.opt, 1L)) 454 } else FALSE 455} 456pager_opt_default <- function(x=getOption("pager")) { 457 is.character(x) && !is.na(x[1L]) && 458 normalizePath(x[1L], mustWork=FALSE) == 459 normalizePath(file.path(R.home(), "bin", "pager"), mustWork=FALSE) 460} 461## Helper Function to Check if a File is Likely to be less Pager 462 463file_is_less <- function(x) { 464 if(is.chr.1L(x) && file_test("-x", x)) { 465 res <- tryCatch( 466 system2(x, "--version", stdout=TRUE, stderr=TRUE), 467 warning=function(e) NULL, 468 error=function(e) NULL 469 ) 470 length(res) && grepl("^less \\d+", res[1L]) 471 } else FALSE 472} 473 474