#' @rdname comment
#' @export
block_comment <- function(
description = "",
empty_lines_first = 1,
empty_lines_last = empty_lines_first,
allign = "center",
token = "#",
html = FALSE,
clipboard = TRUE,
verbose = TRUE,
...
) {
## Specify width
width <- comment_width(...)
# Translate the allign argument to the side argument for str_pad
# The names would be confusing without this recoding
side <- switch(allign, "right" = "left", "left" = "right", "center" = "both")
## Create the empty lines to add first and last
elf <- paste(rep(empty_line(width, token = token), empty_lines_first), collapse = "\n")
ell <- paste(rep(empty_line(width, token = token), empty_lines_last), collapse = "\n")
msg <- paste(
full_line(width, token = token),
elf,
## Conditions used to specify if the text should be on just one alligned line or split
## onto several lines.
if (str_length(description) <= width - 4){
paste(token, str_pad(description, width - 4, side = side), token)
} else{
x <- strwrap(description, width = width - 2, prefix = token, indent = 1, exdent = 1)
paste(str_pad(x, width - 2, side = "right"), token)
},
ell,
full_line(width, token = token),
sep = "\n"
)
out(msg, html, clipboard, verbose)
}
#' @rdname comment
#' @export
comment_line <- function(..., clipboard = TRUE, verbose = TRUE, token = "#", html = FALSE){
out(full_line(comment_width(...), token = token), html, clipboard, verbose)
}
################################################################################
# #
# Exported helper function #
# #
################################################################################
#' Function to specify the width of the comment
#'
#' Helper function to the commet family of functions. Can take both numerical values as the width
#' in characters or a prespecified standard through a character string.
#'
#' The width is specified in order to fit the comment on a printed page or in a script file showed in RStudio
#' (hence the -5 in \code{getOption("width") - 5} to adjust for the line numbering in the script file compared to the console.
#' It is also possible to use a global option \code{comment_width}. This is not a standard option and has to be manually
#' specified (for example in a .Rprofile-file).
#'
#' @param width is the prefered width. Could be numeric (number of characters), a paper size
#' (currently \code{"a4portrait"}, \code{"a4landscape"}, \code{"a3portrait"} or \code{"a3landscape"}),
#' \code{"script_width"} (= \code{getOption("width") - 5}) or \code{"option"} (to get data from global option \code{"comment_width"}).
#' Default is \code{"option"} but if a global option does not exist, "a4portrait".
#' @param a4portrait_width specifies the number of characters that can be printed on a single line on a a4 paper
#' in portrait orientation. This value is usually 80 (or in the range from 60 to 75). Here a lower value is set by default
#' due to experimentation on the authors own computer. Please contact the author if this value seems strange.
#' Note however that it is usully more sufficient to use a global option for the \code{width} parameter than to
#' manually change this value (whih is however possible for increased flexibility). This value depends on margins and font size
#' when printing.
#'
#' @return An integer specifiing the text width (in number of characters) to be used in a comment.
#' @export
#' @examples
#' comment_width()
#' comment_width(42)
#' comment_width("a4portrait")
#'
#'\dontrun{
#' # We can set a global option for the comment_width
#' options(comment_width = 80)
#' header_comment("Test", "A small test")
#' }
#'
comment_width <- function(width = "option", a4portrait_width = 80){
# Check that width is a valid argument
valid_width_arguments <- c("option", "script_width", "a4portrait", "a4landscape", "a3portrait", "a3landscape")
if ( !(is.numeric(width) | width %in% valid_width_arguments)){
stop("Invalid width argument! See ?comment_width for help!")
}
# Use global option if possible, otherwise use a4portrait as default
if (width == "option" & !is.null(getOption("comment_width"))){
width <- getOption("comment_width")
} else if (width == "option" & is.null(getOption("comment_width"))){
width <- "a4portrait"
}
# a4portrait is usually recommended to 80 but 53 was the value found when experimenting
a4portrait <- a4portrait_width
golden_ratio <- 8 / 5
# If width_text is numeric, it should be translated into a numeric value.
# If it is not a character, it is preserved and returned unchanged
text2num <- function(width_text){
if (is.character(width_text)){
switch(width_text,
"script_width" = getOption("width") - 5,
"a4portrait" = a4portrait,
"a4landscape" = a4portrait * golden_ratio,
"a3portrait" = a4portrait * golden_ratio,
"a3landscape" = 2 * a4portrait)
} else{
width_text
}
}
if (width %in% valid_width_arguments){
width <- text2num(width)
}
min(width, text2num("script_width"))
}
################################################################################
# #
# General help page #
# #
################################################################################
#' Create nicely formated comments
#'
#' Functions to automate creation of nicely formated comments. Comments are printed to the console and can thereafter be copied to script files.
#'
#' The header_comment function uses global options for name, contact and textwidth as default. Width is a standard option in R
#' but name and contact are not. It might be
#' a good idea to define those as global options in a .Rprofile-script (use Google if you do not know the concept!).
#' Dates for creation and last update are both set to the same date.
#' The update date has to be manually updated in the script
#' (the output of the functuion is just a template to start with; it should not be nececasy to run the
#' function each time a script is updated.)
#'
#' @section Functions:
#' There are 4 functions to help with script comments
#'
#' \itemize{
#' \item header_comment: a header introduction to be included at the top of the script
#' \item block_comment: a block comment to make a title for a new section in the script
#' \item line_comment: a one line comment surrounded by hashtags
#' \item comment_line: a line of hashtags (no text)
#' }
#'
#' @param title a short and descriptive title.
#' @param description additional information about the script. Could be a single line or a full paragraph. Empty character string as default.
#' @param author name of the script author(s). From getOption("name") as default.
#' @param contact How to contact the author of the script. From getOption("contact") as default.
#' @param client Name (and possible contact information) to the client for who the script was written. Sets author as default (assuming you wrote the script for yourself).
#' @param date_created A character string defining the date when the script was created. Todays date as default. The date is specified as a string and does not need to be exact.
#' For example "Many years ago" would be accepted if you want to add a heading to an old script.
#' @param date_updated A character string defining the date when the script was last updated. Same as date_created by default.
#' @param source is the path to where the script was originaly stored . This information might be good if the document is printed, forgotten and found. Current directory as default.
#' @param tab "tabulation length" to add space betwen left column titles and right column text.
#' @param empty_lines_first number of empty lines to be added before the text in a block comment. 1 by default.
#' @param empty_lines_last number of empty lines to be added after the text in a block comment. Same as \code{empty_lines_first} by default.
#' @param allign specify text allignment. "center" as default with other options "left" and "right". If the text is too long to be fit on one line, it is split to a left aligned paragraph (\code{allign} being ignored).
#' @param token a character string specifying the comment character to be used. Default is \code{"#"}, which should be used in R scripts.
#' @param html Should the comment be used in a HTML- or R Markdown-document (FALSE by default). If so, the comment starts
#' with "<!--" and ends with "-->".
#' \code{token = "\%"} could be used to create comments for LaTeX and \code{token = "*"} for Stata etcetera. The length of the character string is not restricted but should normally
#' be just one character. If a longer character string is used, the width of the comment would be multiplied by the number of characters.
#' This might result in a quite messy output.
#' @param clipboard Should the output be copied to clipboard? (\code{TRUE} by default). Corrently only supported on Mac.
#' @param verbose Should the comment be printed to the console? (\code{TRUE} by default). This could be used if \code{clipboard = TRUE} and run on a Mac.
#' @param ... arguments passed to \link{comment_width} to specify the width of the comment.
#' @return There is no object returned from the function call. There is just a printed message to the console that could be copied to the beginning of a script).
#' @examples
#' \dontrun{
#'
#' # If global options specifies "author" and "contact", these do not need to be specified every time:
#' header_comment("Test", "This is a little test")
#'
#' header_comment("Test", "This is just a test!", width = "script_width")
#'
#' header_comment("Smaller block", "This is a smaller test block!", width = 55, tab = 17)
#'
#' header_comment("Smaller block", "This is a small test block but with a longer extra description
#' that has to be split from a single line into a full paragraph.", width = 55, tab = 17)
#' }
#'
#' header_comment("Nice script", "This is a very nice script that is well documented",
#' author = "Jane Doe",
#' contact = "jane@@doe.se",
#' client = "John Doe",
#' date_created = "2014-07-03",
#' width = "a4landscape")
#'
#' block_comment("A title for a new section in the script")
#' block_comment("A shorter box", width = 50)
#' block_comment("A compact title", empty_lines_first = 0, allign = "left")
#' \dontrun{
#' block_comment("A longer descriptive text that has to be
#' separated into several lines in order to fit.
#' Then it is no longer alligned to 'center' even if so specified!", allign = "center")
#' }
#' line_comment("A comment in the middle of a line")
#' line_comment("A comment in the middle of a shorter line", 50)
#'
#' comment_line()
#' comment_line(42)
#' @name comment
#' @import stringr
NULL
#' @name commentr
#' @rdname comment
NULL
#' @rdname comment
#' @export
header_comment <- function(
title,
description = "",
author = getOption("name"),
contact = getOption("contact"),
client = author,
date_created= format(Sys.time(), "%Y-%m-%d"),
date_updated= date_created,
source = getwd(),
tab = 17,
token = "#",
html = FALSE,
clipboard = TRUE,
verbose = TRUE,
...
){
## Felmeddelande om det saknas author och/eller contact
if (is.null(author) | is.null(contact)){
stop("Author and/or contact not specified!")
}
## Width of the comment
width <- comment_width(...)
## Skapa textrad med titel och innehåll
text_line <- function(which_text, text) {
pre <- str_pad(paste0(token, " ", which_text, ":"), tab, side = "right")
text <- paste0(pre, text)
paste0(stringr::str_pad(text, width - 1, side = "right"), token)
}
## Skapa textstycke utan titel
text_paragraph <- function(text){
x <- strwrap(text, width = width - 2, indent = tab - 1, exdent = tab - 1, prefix = token)
paste(stringr::str_pad(x, width - 2, side = "right"), token, collapse = "\n")
}
## Bryt upp en lång text till stycke om nödvändigt, annars inte
text_cond_paragraph <- function(which_text, text){
if (stringr::str_length(text) < width - tab){
text_line(which_text, text)
} else{
paste(
text_line(which_text, ""),
text_paragraph(text),
sep = "\n"
)
}
}
msg <- paste(
full_line(width, token = token),
empty_line(width, token = token),
text_line("Purpose", title),
empty_line(width, token = token),
text_line("Author", author),
text_line("Contact", contact),
text_line("Client", client),
empty_line(width, token = token),
text_line("Code created", date_created),
text_line("Last updated", date_updated),
text_line("Source", source),
empty_line(width, token = token),
text_cond_paragraph("Comment", description), # writeLines anropat via text_cond_paragraph
empty_line(width, token = token),
full_line(width, token = token),
sep = "\n"
)
## Handle the output
out(msg, html, clipboard, verbose)
}
################################################################################
# #
# Helper functions #
# #
################################################################################
#' Helper function to create string with repeated hashtags
#' @param ... arguments passed to \code{comment_width}
#' @param token a character specifying the comment symbol. "#" by default.
#' @keywords internal
full_line <- function(..., token = "#"){
paste0(rep_len(token, comment_width(...)), collapse = "")
}
#' Helper function to create string with hashtags and spaces
#' @param ... arguments passed to \code{comment_width}
#' @param token a character specifying the comment symbol. "#" by default.
#' @keywords internal
empty_line <- function(..., token = "#"){
paste0(token, str_pad(" ", comment_width(...) - 2, side = "both"), pad = token, collapse = "")
}
#' Comment start for R Markdown/HTML
#' @param html should the comment be used in HTML (FASLE by default)
#' @keywords internal
comment_start <- function(html = FALSE){
paste0("\n", if (html) "<!--")
}
#' Comment end for R Markdown/HTML
#' @param html should the comment be used in HTML (FASLE by default)
#' @keywords internal
comment_end <- function(html = FALSE){
paste0(if (html) "-->", "\n")
}
#' Handle output of the comment
#' @param msg the comment to return
#' @param clipboard,verbose,html See \code{\link{commentr}}
#' @keywords internal
out <- function(msg, html, clipboard = TRUE, verbose = TRUE){
mac <- Sys.info()[['sysname']] == "Darwin"
msg <- paste(
comment_start(html),
msg,
comment_end(html),
sep = "\n"
)
## if on Mac OSX and flagged to true, then copy to clipboard
if(clipboard && mac) {
con <- pipe("pbcopy", "w")
writeLines(msg, con)
close(con)
message("The comment has been copied to clipboard and can be pasted into a script file!")
}
if (verbose){
writeLines(msg)
}
}
#' @rdname comment
#' @export
line_comment <- function(title, ..., clipboard = TRUE, verbose = TRUE, token = "#", html = FALSE){
msg <- paste(
str_pad(paste0(" ", title, " "), comment_width(...), side = "both", pad = token),
sep = "\n"
)
out(msg, html, clipboard, verbose)
}