# ------------------------------------------------------------------------------------------------------------------------- # # ----------------------------------------------------------------------------------------------------------------------- # # # # File Name : boxit and mkdash.r # # Last Updated Funclist : 19 Feb 2015, 12:52 PM (Thursday) # # # # Author Name : Rick Saporta # # Author Email : RickSaporta@gmail.com # # Author URL : www.github.com/rsaporta # # # # Packages Called : NA # # Packages Used via NS : utils # # # # ----------------------------------------------------------------------------------------------------------------------- # # # # getHairSpace ( ) # # topAndBottom ( vec, n=1 ) # # mr ( x=clipPaste(), mindent=9, minWidth=60, align="left", top=TRUE, match=FALSE, ... ) # # mkdsh ( x=clipPaste(), space=TRUE, pound="#", dash="-", leftSpace=TRUE, toptoo=FALSE # # , includeInput=TRUE, dontCollapse=FALSE, dontCopy=FALSE, dontTrim=FALSE ) # # hariSpaceWrap ( string, .hs=getHairSpace() ) # # printBox ( x, width=68, dash="~", sides="#", crop=FALSE, topspace=0, bottomspace=0, tabs=1, header="" ) # # padTo ( string, to=mnchar(string) # # , align=c("right", "left"), splitOn=if (length(string) == 1) "\n" else NULL # # , dontPadOutterLineBreaks=identical(splitOn, "\n") ) # # boxit ( string, min_width=80, tab.replace=4, .hs=getHairSpace() # # , align=c("center", "left", "right"), pad=0, sep=C, C=" " ) # # msgBox ( ..., sep="", col="\n", collapse=col, shiftLeft=0, prelines=1, pad=10, dash="-", pound="" # # , silent=FALSE ) # # mkdsh ( msg, ... ) # # mds ( includeInput=TRUE, x=clipPaste() ) # # mkdshr ( x=clipPaste(), space=TRUE, pound="#", dash="-", leftSpace=TRUE, includeInput=TRUE, top=TRUE # # , minWidth=20, align=NA, mindent=4, dontSmoothPreSpace=FALSE, fancy=FALSE, match=FALSE ) # # # # # # # # ----------------------------------------------------------------------------------------------------------------------- # # ------------------------------------------------------------------------------------------------------------------------- # # boxit and mkdash.r ## boxit is the newer function, msgBox is the older one ## hairspace getHairSpace <- function() { ## This looks like a regular space on screen, but it is ## a "HAIR SPACE", U+200A return(" ") } .hs <- getHairSpace() hariSpaceWrap <- function(...) { ## i had typed it wrong -- never noticed warning("typo in code - look at the 'i' -- correct function is hairSpaceWrap") hairSpaceWrap(...) } hairSpaceWrap <- function(string, .hs = getHairSpace()) paste0(.hs, string, .hs) # ------------- # printBox <- function(x, width=68, dash="~", sides="#", crop=FALSE, topspace=0, bottomspace=0, tabs=1, header="") { splat <- splitToWidth(x, width) ncs <- nchar(splat) # Add header if given if (!is.na(header) && nchar(header)) splat <- c(Header, splat) # should the total width be based on the width param or # instead cropped down to the longest line mx <- ifelse(crop, max(ncs), width-2) # add spacer lines ## TODO: splat <- c(rep("", topspace), splat, rep("", bottomspace)) # Add tabs. Converting numerics to string of spaces. if(is.numeric(tabs)) tabs <- pasteC(rep(" ", tabs)) splat <- paste0(tabs, splat) # create line of dashes & add to splat dashes <- pasteC(rep(dash, mx)) splat <- c(dashes, splat, dashes) # align text, padding with whitespaces padded <- alignText(splat, halign="left", tabs=tabs) final <- paste(sides, unlist(strsplit(padded, "\n")), sides, collapse="\n") cat(final) } # ------------- # padTo <- function(string, to=mnchar(string), align=c("right", "left"), splitOn=if (length(string) == 1) "\n" else NULL, dontPadOutterLineBreaks=identical(splitOn, "\n")) { align <- match.arg(align) if (isTRUE(dontPadOutterLineBreaks)) { starter <- removeNA(extract_gregexpr("^\\n+", string, simplify=TRUE, multi.matches="first")) ender <- removeNA(extract_gregexpr("\\n+$", string, simplify=TRUE, multi.matches="first")) string <- gsub("^\\n+|\\n+$", "", string) } if (!is.null(splitOn)) string.mod <- unlist(strsplit(string, splitOn)) else string.mod <- string spacesToAdd <- pmax(to - nchar(string.mod), 0) padding <- pasteR(" ", n=spacesToAdd) ## check for starting or ending linebreaks ret <- { if (align == "right") paste0(string.mod, padding) else paste0(padding, string.mod) } ## Put the ending line breaks back if (isTRUE(dontPadOutterLineBreaks)) { blanks <- rep("", length(ret)) starter <- head(c(starter, blanks), length(ret)) ender <- tail(c(blanks, ender), length(ret)) ret <- paste0(starter, ret, ender) } return(ret) } boxit <- function(string, min_width=80, tab.replace=4, .hs=getHairSpace(), align=c("center", "left", "right"), pad=0, sep=C, C=" ") { ## Wraps a box around a message ## Set tab.replace to FALSE, 0 (or anything non-numeric) to NOT replace tab ## C and sep are synoyms. The 'C' comes from pasteC syntax align <- match.arg(align) out <- capture.output(cat(string, sep=sep)) if (is.numeric(tab.replace) && tab.replace > 0) out <- gsub("\\t", pasteR(" ", tab.replace), out) ## Check if a line has a hairspace, if so, treat different has.hs.r <- grepl(paste0(.hs, "$"), out) has.hs.l <- grepl(paste0("^", .hs), out) out <- gsub(.hs, "", out) ## pad according to hs ## TODO ## mn <- max(mnchar(out), min_width-6) nc <- nchar(out) spaces_needed <- mn - nchar(out) + pad if (align == "center") { l.space <- ceiling(spaces_needed / 2) r.space <- spaces_needed - l.space } else if (align == "left") { l.space <- pad r.space <- spaces_needed - pad } else if (align == "right") { l.space <- spaces_needed - pad r.space <- pad } out.padded <- paste0(pasteR(" ", l.space), out, pasteR(" ", r.space)) out.padded.full <- sprintf("| %s |", out.padded) hr <- pasteR("-", nchar(out.padded.full)[[1]] - 2) hr.full <- paste0("+", hr, "+") pasteC(c(hr.full, out.padded.full, hr.full), C="\n") } msgBox <- function(..., sep="", col="\n", collapse=col, shiftLeft=0, prelines=1 , pad=10, dash="-", pound="", silent=FALSE) { # In case 'mkdsh' is not available. This is specific for RProfile if (!exists("mkdsh")) mkdsh <- function(msg, ...) return(msg) msg <- paste(c(...), sep=sep, collapse=collapse) msg <- center(msg, pad=pad, trim.first=FALSE) msg <- mkdsh(msg, dash=dash, pound=pound, leftSpace=FALSE, toptoo=TRUE , dontCopy=TRUE, dontCollapse=TRUE, dontTrim=TRUE) lft <- pasteR(" ", shiftLeft) msg <- paste0(lft, unlist(strsplit(msg,"\n")) ) # , collapse="\n" # I removed the `collapse="\n"` for `fresh()` # If this broke something, put it back then fix fresh if (!silent) { cls(prelines) cat(msg, sep="\n") } return(invisible(msg)) } ## ------------------------------------------------------------------------- ## mds <- function(includeInput=TRUE, x=clipPaste()) { mkdsh(x=x, includeInput = !isFALSE(includeInput) ) } mkdshr <- function(x=clipPaste(), space=TRUE, pound="#", dash="-", leftSpace=TRUE, includeInput=TRUE , top=TRUE, minWidth=20, align=NA, mindent=4, dontSmoothPreSpace=FALSE , fancy=FALSE, match=FALSE) { ## This function takes a header that contains space to its left and adds equal space to the right. ## TODO: Match does not work, and it will not work unless I strip any closing pounds. ## this is the output of spacecnt if(exists("spacecntoutputvalues")) { mindent <- spacecntoutputvalues[["mindent"]] minWidth <- spacecntoutputvalues[["minWidth"]] # this is a temp workaround until i properly account for pound spaces if (spacecntoutputvalues[["totalLength"]] - spacecntoutputvalues[["minWidth"]] == 4) minWidth <- minWidth + 2 suppressWarnings(rm(spacecntoutputvalues, envir=.GlobalEnv)) if (missing(top)) top <- FALSE } ## TODO: double check minWidth & mindent ## Currently, mindent is one too many, thus subtracting one mindent <- max(0, mindent-1) mc <- match.call() # for shorthands, we're interested in evaluating what was typed at the console. # if the call came in through a wrapper, we want to evaluate that if (as.character(sys.call(1)[[1]]) == "mr") mc <- match.call(call=sys.call(1)) # if there was at least one argument, then we will evaluate it mc2 <- if (length(mc) > 1) mc[[2]] else NULL ## Shorthands, allow for the first argument to be `align` or `top` if (is.numeric(mc2)) { minWidth <- mc2 x <- clipPaste() } else if(!is.null(mc2) && !is.logical(mc2)) { mc2 <- paste(as.character(mc2), collapse="") m <- substr(tolower(mc2), 1, 1) if (m %in% c("l", "c", "r", "n") && length(mc2) < 8) { # "n" for "no align" align <- m x <- clipPaste() } else if (tolower(mc2)=="match") { match=TRUE x <- clipPaste() } else if (tolower(mc2)=="top") { x <- clipPaste() top <- TRUE } else if (tolower(mc2)=="x") { x <- clipPaste() } } ## this allows to quickly set the other params in the function call if (x[[1]]=="x") x <- clipPaste() # for debugging, hold on to the original orig <- x # Collapse if multiple lines if (length(x) > 1) { x <- paste(x, collapse="\n") } ## remove any trailing line-break (normally from copy+pasting one extra line break) x <- gsub("\\n$", "", x) ## TODO: Had this in here for some reason. Cannot remember why. Taking it out for now. # x <- gsub("\\\\n*", "", x) # I dont remember why these are here, other than there was a use case that called for it. # Split up the lines x <- strsplit(x, "\n")[[1]] # remove any trailing spaces x <- sub("\\s*$", "", x) # any blank lines will get a starting pound, if all others have starting pounds blankLines <- which(x=="") if (match) { # identify the longest line with a closing pound minWidth <- max(nchar( grep(paste0(pound, "$"), x, value=TRUE) )) } # Bank & Strip any pre-white spaces wherePreSpace <- regexpr("^\\s*", x) ## Find it preSpace <- substr(x, wherePreSpace, attr(wherePreSpace, "match.length")) ## Bank it x <- substr(x, attr(wherePreSpace, "match.length")+1, nchar(x)) ## Strip it # Bank & Strip any opening pounds prePound <- regexpr(pattern=paste0(pound, "+(%|\\*)*"), x) ## Find it leftPound <- substr(x, prePound, attr(prePound, "match.length")) ## Bank it x <- substr(x, attr(prePound, "match.length")+1, nchar(x)) ## Strip it # Bank & Strip the main space whereSpace <- regexpr(pattern="^\\s+", x) ## Find it LSpace <- substr(x, whereSpace, attr(whereSpace, "match.length")) ## Bank it x <- substr(x, attr(whereSpace, "match.length")+1, nchar(x)) ## Strip it ## add Pound to any blank lines leftPound[blankLines] <- names(which.max(table(leftPound))) # add top & bottom blank lines, if needed if (top) { x <- c("", x, "") topAndBottom <- function(vec, n=1) return(c(head(vec, n), vec, tail(vec, n))) leftPound <- topAndBottom(leftPound) LSpace <- topAndBottom(LSpace) } # for aligning left or right, extra spaces will be needed for pounds of differring widths poundPadding.count <- max(nchar(leftPound)) - nchar(leftPound) # total width of each line, minus any leftspace widths <- nchar(x) + 2 * (nchar(LSpace) + nchar(leftPound) + poundPadding.count) # padding left and right # the minimum width for all lines is the max amongst the requested width & all the widths minWidth <- ifelse(match, minWidth, max(widths, minWidth)) # if we are matching, then we stick to the minwidth ##$ TODO: CHECK FOR LONG LINES --- # Is the longestLine the longest padded pound ##$ TODO: CHECK FOR LONG LINES --- # long lines are any where they are within the poundPadding of the longest pound ##$ TODO: CHECK FOR LONG LINES --- widths - 2* nchar(leftPound) ##$ TODO: CHECK FOR LONG LINES --- longestLine <- intersect(which(nchar(x) == max(nchar(x))), which(nchar(leftPound) == max(nchar(leftPound)))) # how many spaces does each line need (note that the poundPadding gets compensated for here and in the switch statement) spacesNeeded <- minWidth - (nchar(x) + 2 * nchar(leftPound) ) + max(poundPadding.count) # why 2*padding? In case the longest line also has the most ## TODO: look at this part in the next line: `min(spacesNeeded - poundPadding.count)` Is that supposed to be minus? If so, why the `min`? # pad the spaces need with minimum of indent spacesNeeded <- spacesNeeded + max(0, (2*mindent) - min(spacesNeeded - poundPadding.count)) # if centering, divide spaces in half, otherwise just cound how many spaces on left, so that we know how many remain for right # if left align, use the smallest space for which there is text (ie nchar(x) > 0) # Left & Right aligns need to be adjusted for differing lengths of pounds. (Center is not neccssary) ncls <- nchar(LSpace) ncls.min <- ifelse(any(ncls > 0), min(ncls[ncls > 0]), 0) # find the smallest ncls above zero, if it exists. minSpace <- max(mindent, ncls.min) # check if any "should be" indented (6 Spaces more than the smallest non-zero space) extraIndent <- minSpace * as.integer(ncls > ncls.min+6) # calculate the number of spaces need on the LEFT and on the RIGHT LSpace.count <- switch(substr(tolower(align), 1, 1), l = {rep( minSpace, length(spacesNeeded)) + poundPadding.count + extraIndent}, r = {spacesNeeded - (minSpace + poundPadding.count + extraIndent)}, c = {spacesNeeded / 2}, ncls ) LSpace.count <- floor(LSpace.count) RSpace.count <- spacesNeeded - LSpace.count # Create the spaces for each side LEFT <- sapply(LSpace.count, pasteR, x=" ") RIGHT <- sapply(RSpace.count, pasteR, x=" ") # add the pounds back in LEFT <- paste0(leftPound, LEFT) RIGHT <- paste0(RIGHT, revString(leftPound)) # construct into single lines x <- paste(LEFT, x, RIGHT) ## Now all that is missing is the top and bototm dashes ## and the preSpace on the left if (top) { # if the leftPound are all the same length and all longer than length of pound, add a nice extra space nclp <- nchar(leftPound) addspace <- (fancy || (length(x) > 8 && all(nclp > length(pound)) && mean(nclp)==nclp[[1]])) # if we're not adding a space, the pound to use should be as long as the shortest pound already present if(!addspace) pound <- pasteR(pound, max(1, min(nclp)) ) # use a slighlty shorter x, if we're adding space x.use <- ifelse (addspace, substr(x, 2, nchar(x)-1)[[1]], x[[1]]) # create top & bottom bar from `mkdsh()` bar <- mkdsh(x.use, space=space, pound=pound, dash=dash, leftSpace=leftSpace, includeInput=FALSE ) # add in the space bar <- ifelse(addspace, paste0(" ", bar, " "), bar) # add the bars into x x <- c(bar, x, bar) } # smooth preSpace if (!dontSmoothPreSpace) preSpace[] <- preSpace[which.max(nchar(preSpace))] # add back any spaces in place before the `pound` x <- paste0(preSpace, x) # collapse into a single string x <- paste(x, collapse="\n") clipCopy(x, sep="\n") return(invisible(x)) } mr <- function(x=clipPaste(), mindent=9, minWidth=60, align="left", top=TRUE, match=FALSE, ...) mkdshr(..., top=top, mindent=mindent, minWidth=ifelse(match, 1, minWidth), align=align, match=match) mkdsh <- function(x=clipPaste(), space=TRUE, pound="#", dash="-", leftSpace=TRUE, toptoo=FALSE , includeInput=TRUE, dontCollapse=FALSE, dontCopy=FALSE, dontTrim=FALSE) { # pound: turn off by making it FALSE or making it "" # dontCollapse, dontCopy : useuful for programmatic modes. ## this allows to quickly set the other params in the function call if (x[[1]]=="x") x <- clipPaste() ## TODO: Are you sure you want to collapse? # Collapse if multiple lines if (length(x) > 1) { x <- paste(x, collapse="\n") } ## Allow for a line of all whitespace. Thus, all the whitespace trimming is inside an if clause if (!dontTrim && !identical(strsplit(x, "\\s*"), list(""))) { x <- gsub("\\n$", "", x) leftSpaces <- 0 if(leftSpace) # TODO: turn this into regex with whitespace. Save the whole white space as a substring. Dont count it. leftSpaces <- min(which(strsplit(x, " ", fixed=TRUE)[[1]]!="")) - 1 original <- x x <- gsub("(^\\s*|\\s*$)", "", x) } else { leftSpace <- 0 original <- x } x <- sapply(strsplit(x, "\\n"), utils::tail, 1) nc <- nchar(x) if (space) nc <- nc -2 if (!isFALSE(pound) && nchar(pound)) nc <- nc - 2*nchar(pound) dashes <- pasteR(dash, nc) if (space) dashes <- paste0(" ", dashes, " ") if (!isFALSE(pound) && nchar(pound)) dashes <- paste0(pound, dashes, pound) if (leftSpace) dashes <- paste0(pasteR(" ", leftSpaces), dashes) # # output to console # cat("\n\n", original,"\n", dashes, "\n\n", sep="") ## No need to output if using clipCopy # combine with original if (includeInput) dashes <- c(original, dashes) ## add dashes bar to the top if (toptoo) dashes <- c(utils::tail(dashes, 1), dashes) # Collapse into a single string if (!dontCollapse) dashes <- paste(dashes, collapse="\n") # copy to clipboard if(!dontCopy) clipCopy(dashes, sep="\n") # return invisibly return(invisible(dashes)) }