1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
# Copyright (C) 2021 Brodie Gaslam
#
# This file is part of "diffobj - Diffs for R Objects"
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# Go to <https://www.r-project.org/Licenses/GPL-2> for a copy of the license.
#' @include styles.R
NULL
#' Attempt to Compute Console Height in Text Lines
#'
#' Returns the value of the \code{LINES} system variable if it is reasonable,
#' 48 otherwise.
#'
#' @export
#' @return integer(1L)
#' @examples
#' console_lines()
console_lines <- function() {
LINES <- as.integer(Sys.getenv("LINES"))
if(length(LINES) == 1L && !is.na(LINES) && LINES > 0L) LINES else 48L
}
#' Configure Automatic Context Calculation
#'
#' Helper functions to help define parameters for selecting an appropriate
#' \code{context} value.
#'
#' @export
#' @param min integer(1L), positive, set to zero to allow any context
#' @param max integer(1L), set to negative to allow any context
#' @return S4 object containing configuration parameters, for use as the
#' \code{context} or parameter value in \code{\link[=diffPrint]{diff*}}
#' methods
#' @examples
#' ## `pager="off"` for CRAN compliance; you may omit in normal use
#' diffChr(letters, letters[-13], context=auto_context(0, 3), pager="off")
#' diffChr(letters, letters[-13], context=auto_context(0, 10), pager="off")
#' diffChr(
#' letters, letters[-13], context=auto_context(0, 10), line.limit=3L,
#' pager="off"
#' )
auto_context <- function(
min=getOption("diffobj.context.auto.min"),
max=getOption("diffobj.context.auto.max")
){
if(!is.int.1L(min) || min < 0L)
stop("Argument `min` must be integer(1L) and greater than zero")
if(!is.int.1L(max))
stop("Argument `max` must be integer(1L) and not NA")
new("AutoContext", min=as.integer(min), max=as.integer(max))
}
# Changes the LESS system variable to make it compatible with ANSI escape
# sequences
#
# flags is supposed to be character(1L) in form "XVF" or some such
#
# Returns the previous value of the variable, NA if it was not set
#
# Assumes `Sys.getenv('VAR')` always returns a length 1 character vector, even
# though strictly this is not documented (used to handle other case but this
# assumption simplifies testing now that we can't mock Sys.getenv anymore).
set_less_var <- function(flags) {
LESS <- Sys.getenv("LESS", unset=NA) # NA return is NA_character_
LESS.new <- NA
if(is.character(LESS) && length(LESS) == 1L) {
if(isTRUE(grepl("^\\s*$", LESS)) || is.na(LESS) || !nzchar(LESS)) {
LESS.new <- sprintf("-%s", flags)
} else if(
isTRUE(grepl("^\\s*-[[:alpha:]]+(\\s+-[[:alpha:]])*\\s*$", LESS))
) {
LESS.new <- sub(
"\\s*\\K(-[[:alpha:]]+)\\b$", sprintf("\\1%s", flags), LESS, perl=TRUE
) } }
if(!is.na(LESS.new)) Sys.setenv(LESS=LESS.new)
LESS
}
reset_less_var <- function(LESS.old) {
if(is.na(LESS.old)) {
Sys.unsetenv("LESS")
} else Sys.setenv(LESS=LESS.old)
}
|
