1## Copyright (C) 2021 Brodie Gaslam 2## 3## This file is part of "fansi - ANSI Control Sequence Aware String Functions" 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#' ANSI Control Sequence Aware Version of strtrim 18#' 19#' One difference with [base::strtrim] is that all C0 control characters such as 20#' newlines, carriage returns, etc., are treated as zero width. 21#' 22#' `strtrim2_ctl` adds the option of converting tabs to spaces before trimming. 23#' This is the only difference between `strtrim_ctl` and `strtrim2_ctl`. 24#' 25#' @note Non-ASCII strings are converted to and returned in UTF-8 encoding. 26#' Width calculations will not work correctly with R < 3.2.2. 27#' @export 28#' @inheritSection substr_ctl _ctl vs. _sgr 29#' @seealso [fansi] for details on how _Control Sequences_ are 30#' interpreted, particularly if you are getting unexpected results. 31#' [strwrap_ctl] is used internally by this function. 32#' @inheritParams base::strtrim 33#' @inheritParams strwrap_ctl 34#' @examples 35#' strtrim_ctl("\033[42mHello world\033[m", 6) 36 37strtrim_ctl <- function(x, width, warn=getOption('fansi.warn'), ctl='all'){ 38 if(!is.character(x)) x <- as.character(x) 39 40 if(!is.numeric(width) || length(width) != 1L || is.na(width) || width < 0) 41 stop("Argument `width` must be a positive scalar numeric.") 42 43 if(!is.logical(warn)) warn <- as.logical(warn) 44 if(length(warn) != 1L || is.na(warn)) 45 stop("Argument `warn` must be TRUE or FALSE.") 46 47 if(!is.character(ctl)) 48 stop("Argument `ctl` must be character.") 49 ctl.int <- integer() 50 if(length(ctl)) { 51 # duplicate values in `ctl` are okay, so save a call to `unique` here 52 if(anyNA(ctl.int <- match(ctl, VALID.CTL))) 53 stop( 54 "Argument `ctl` may contain only values in `", 55 deparse(VALID.CTL), "`" 56 ) 57 } 58 # can assume all term cap available for these purposes 59 60 term.cap.int <- seq_along(VALID.TERM.CAP) 61 width <- as.integer(width) 62 63 # a bit inefficient to rely on strwrap, but oh well 64 65 res <- .Call( 66 FANSI_strwrap_csi, 67 enc2utf8(x), width, 68 0L, 0L, # indent, exdent 69 "", "", # prefix, initial 70 TRUE, "", # wrap always 71 FALSE, # strip spaces 72 FALSE, 8L, 73 warn, term.cap.int, 74 TRUE, # first only 75 ctl.int 76 ) 77 res 78} 79#' @export 80#' @rdname strtrim_ctl 81 82strtrim2_ctl <- function( 83 x, width, warn=getOption('fansi.warn'), 84 tabs.as.spaces=getOption('fansi.tabs.as.spaces'), 85 tab.stops=getOption('fansi.tab.stops'), 86 ctl='all' 87) { 88 if(!is.character(x)) x <- as.character(x) 89 90 if(!is.numeric(width) || length(width) != 1L || is.na(width) || width < 0) 91 stop("Argument `width` must be a positive scalar numeric.") 92 93 if(!is.logical(warn)) warn <- as.logical(warn) 94 if(length(warn) != 1L || is.na(warn)) 95 stop("Argument `warn` must be TRUE or FALSE.") 96 97 if(!is.logical(tabs.as.spaces)) tabs.as.spaces <- as.logical(tabs.as.spaces) 98 if(length(tabs.as.spaces) != 1L || is.na(tabs.as.spaces)) 99 stop("Argument `tabs.as.spaces` must be TRUE or FALSE.") 100 101 if(!is.numeric(tab.stops) || !length(tab.stops) || any(tab.stops < 1)) 102 stop("Argument `tab.stops` must be numeric and strictly positive") 103 104 if(!is.character(ctl)) 105 stop("Argument `ctl` must be character.") 106 ctl.int <- integer() 107 if(length(ctl)) { 108 # duplicate values in `ctl` are okay, so save a call to `unique` here 109 if(anyNA(ctl.int <- match(ctl, VALID.CTL))) 110 stop( 111 "Argument `ctl` may contain only values in `", 112 deparse(VALID.CTL), "`" 113 ) 114 } 115 # can assume all term cap available for these purposes 116 117 term.cap.int <- seq_along(VALID.TERM.CAP) 118 width <- as.integer(width) 119 tab.stops <- as.integer(tab.stops) 120 121 # a bit inefficient to rely on strwrap, but oh well 122 123 res <- .Call( 124 FANSI_strwrap_csi, 125 enc2utf8(x), width, 126 0L, 0L, # indent, exdent 127 "", "", # prefix, initial 128 TRUE, "", # wrap always 129 FALSE, # strip spaces 130 tabs.as.spaces, tab.stops, 131 warn, term.cap.int, 132 TRUE, # first only 133 ctl.int 134 ) 135 res 136} 137#' @export 138#' @rdname strtrim_ctl 139 140strtrim_sgr <- function(x, width, warn=getOption('fansi.warn')) 141 strtrim_ctl(x=x, width=width, warn=warn, ctl='sgr') 142 143#' @export 144#' @rdname strtrim_ctl 145 146strtrim2_sgr <- function(x, width, warn=getOption('fansi.warn'), 147 tabs.as.spaces=getOption('fansi.tabs.as.spaces'), 148 tab.stops=getOption('fansi.tab.stops') 149) 150 strtrim2_ctl( 151 x=x, width=width, warn=warn, tabs.as.spaces=tabs.as.spaces, 152 tab.stops=tab.stops, ctl='sgr' 153 ) 154