Nothing
# ehelp-utils.R
# -- M.Ponce
#################################################################################################
## Utilities file for the eHelp apckage
#
# print-method for ehelp.obj & IO routines
#################################################################################################
# Define methods associated with ehelp.obj
print <- function(ehelp.obj){
#' method associated with ehelp objects
#' @param ehelp.obj ehelp object
#' @keywords internal
UseMethod("print",ehelp.obj)
}
print.ehelp <- function(ehelp.obj,coloring=T) {
#' function associated to the ehelp object method
#' @param ehelp.obj ehelp object
#' @param coloring whether to use colors or not when displaying the help
#' @keywords internal
# header
lines <- paste0("---------------------------------------------------------------",'\n', sep='')
clrPalette <- ehelp.palette()
#print(ehelp.obj)
cat(lines)
#print(ehelp.obj$txt)
for (obj.line in seq_along(ehelp.obj$code)) {
if (coloring) {
clr <- list("","")
#print(ehelp.obj$code[obj.line])
if (ehelp.obj$code[obj.line] %in% clrPalette$codes)
# select here the color-palette: $color or $bw
clr <- clrPalette$color[ clrPalette$code == ehelp.obj$code[obj.line] ][[1]]
#print(paste0(clr,ehelp.obj$txt[obj.line]))
cat( paste0(clr[[1]], ehelp.obj$txt[obj.line], clr[[2]]) )
} else {
cat(ehelp.obj$txt[obj.line])
}
}
# footer
cat('\n',lines)
}
#################################################################################################
### OUTPUT functions to save information to files...
processOutput <- function(ehelp.obj, fnName,fnCorpus, output) {
#' function to process the type output requested
#' @param ehelp.obj ehelp object generated by the ehelp() fn
#' @param fnName name of the function
#' @param fnCorpus function definition
#' @param output type of output, valid options are "txt", "TXT", "html", "HTML", "latex", "LATEX", "markdown", "MARKDOWN"
#' @keywords internal
# valid options are "txt", "ascii", "html", "latex", "markdown"
valid.outputFmts <- c("txt", "ascii", "html", "latex", "markdown")
# add uppercases, for including the listing of the fn
# valid.outputFmts <- c(valid.outputFmts, toupper(valid.outputFmts))
ext.outputs <- c("txt","asc","html","tex","md")
# lower case options
if (output %in% tolower(valid.outputFmts)) {
# define filename for saving documentation
fileName <- paste0(fnName,"-eHelp",'.',ext.outputs[output == valid.outputFmts])
# only output documentation of the fn
write.fmt(ehelp.obj,output,filename=fileName)
# UPPER case options
} else if (output %in% toupper(valid.outputFmts)) {
# define filename for saving documentation
fileName <- paste0(fnName,"-eHelp",'.',toupper(ext.outputs[tolower(output) == valid.outputFmts]))
# output documentation of the fn
write.fmt(ehelp.obj,output,filename=fileName, leaveOpen=T)
# load proper style/format for output
fmt <- format.defns(tolower(output),filename=fileName)
# and listing...
write.Fncorpus(fnName, fnCorpus, filename=fileName,
begining=fmt$lst['begining'], ending=fmt$lst['ending']
#, EoL=as.character(fmt$eol)
, EoL=fmt$lst$eol
)
# check whether there was no type of output selected
} else if (tolower(output) != "none") {
# otherwise is a mistaken fortmat...
message("The selected output format <<",output,">> is not supported. \n",
"Valid options are: ",paste0(valid.outputFmts,sep=" "),"--and-- ",
paste0(toupper(valid.outputFmts),sep=" "),'\n')
}
}
#####################
# default "write" method associated with ehelp objects...
write.ehelp <- function(X.obj,filename){
#' function for writing ehelp output to a local text file
#' @param X.obj ehelp object
#' @param filename name of the file where to write the documentation
#' @keywords internal
lines <- paste0("-----------------------",'\n')
#X.obj <- c(lines,X.obj,lines)
utils::write.table(X.obj,file=filename,sep="", col.names=FALSE,row.names=FALSE, quote=FALSE, eol="")
write.Info(filename)
message(paste(filename,"written to",getwd()))
}
######################
write.Fncorpus <- function(fnName, fnListing, filename,
lines=paste0("/* ################################################ */"),
begining="", ending="", EoL="\r\n"){
#' Function to write into a file the listing of the fn.
#' @param fnName name of the function
#' @param fnListing listing of fn to write to file
#' @param filename name of the file where to write the documentation
#' @param lines optional argument to specify the separation lines to be used
#' @param begining an optional argument to specify the initial lines of HTML code
#' @param ending an optional argument to specify the last lines of HTML code
#' @param EoL optional argument to specify the EOL (if need, eg. for html)
#' @keywords internal
#lines <- paste0("/* ################################################ */")
header <- c(lines,paste0("/* *** FUNCTION LISTING: ",fnName," ****/"),lines)
# adding the "fn <-" which is supressed otherwise when capturing the fn
fnListing[1] <- paste0(fnName, " <- ",fnListing[1])
listing <- c(begining,header,fnListing,lines,ending)
utils::write.table(listing,file=filename,sep=EoL, col.names=FALSE,row.names=FALSE, quote=FALSE, append=TRUE, eol=EoL)
}
write.Info <- function(filename, lines=paste0("-----------------------------------------------"), pre="", post="", EoL="") {
#' function for including informaton about time and date in the generated files
#' @param filename name of the file where to write the documentation
#' @param lines optional argument to specify the separation lines to be used
#' @param post optional argument to specify post-information code to be added (if need, eg. for html)
#' @param EoL optional argument to specify the EOL (if need, eg. for html)
#' @keywords internal
# get some data from the current session
date <- format(Sys.time(), "%a %b %d %X %Y")
username <- Sys.info()["user"]
sysinfo <- Sys.info()["sysname"]
sessionInfo <- sessionInfo()["R.version"]
#lines <- paste0("-----------------------------------------------")
output <- c(pre)
output <- c(output,'\n',lines,'\n')
output <- c(output,paste0(" Generated using the eHelp package -- ",date))
output <- c(output,paste0('\n'," User: ",username," -- System: ",sysinfo))
output <- c(output,paste0(" ",sessionInfo$R.version$version.string,'\n'))
output <- c(output,post)
utils::write.table(output, file=filename,sep="", col.names=FALSE,row.names=FALSE, quote=FALSE, append=TRUE, eol=EoL)
}
#################################################################################################
#################################################################################################
write.fmt <- function(X.obj, format, filename, leaveOpen=FALSE){
#' function for writing ehelp output to a local LaTeX file
#' @param X.obj ehelp object
#' @param format type of output: txt, latex, html
#' @param filename name of the file where to write the documentation
#' @param leaveOpen boolean argument to leave the file open
#' @keywords internal
format <- tolower(format)
# capture the text to output
ehelp.txt <- X.obj$txt
# load palettes
formatting.codes <- ehelp.palette()
# load format defns
if (leaveOpen) {
fmt <- format.defns(format,filename,ending="")
} else {
fmt <- format.defns(format,filename)
}
#print(fmt)
# special consideration when the format is "ascii" => will keep ESC-codes for color
if (format == "ascii") format <- "color"
for (line in seq_along(ehelp.txt)) {
lang.Code <- list("","")
if (X.obj$code[line] %in% formatting.codes$codes)
lang.Code <- formatting.codes[[format]][ formatting.codes$codes == X.obj$code[line] ][[1]]
ehelp.txt[line] <- paste0(lang.Code[[1]], ehelp.txt[line], lang.Code[[2]], fmt$eol)
# replace special characters depending on the format
for (sp.char in fmt$sp.chars)
ehelp.txt[line] <- gsub(sp.char[[1]],sp.char[[2]],ehelp.txt[line])
}
# combine parts
ehelp.txt <- c(fmt$struct, fmt$lines,ehelp.txt) #,fmt$lines)
####
utils::write.table(ehelp.txt,file=filename,sep="", col.names=FALSE,row.names=FALSE, quote=FALSE, eol=fmt$eol)
write.Info(filename, lines=fmt$lines, pre=fmt$pre, post=fmt$post, EoL=fmt$eol)
message(paste(filename,"written to",getwd(),'\n'))
}
#################################################################################################
#################################################################################################
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.