R/ehelp-utils.R

In ehelp: Enhanced Help to Enable "Docstring"-Comments in Users Functions

# 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'))
}



#################################################################################################
#################################################################################################