R/docx.R

In davidgohel/ReporteRs: Microsoft Word and PowerPoint Documents Generation

#' @title Create Microsoft Word document object representation
#'
#' @description
#' Create a \code{\link{docx}} object
#'
#' @param title \code{"character"} value: title of the
#' document (in the doc properties).
#' @param template \code{"character"} value, it represents
#' the filename of the docx file used as a template.
#' @param empty_template wether the content of the template should
#' be clear or not.
#' @param list.definition a list definition to specify how ordered and unordered
#' lists have to be formated. See \code{\link{list.settings}}. Default to
#' \code{getOption("ReporteRs-list-definition")}.
#' @return an object of class \code{\link{docx}}.
#' @details
#' Several methods can used to send R output into an object of class \code{\link{docx}}.
#'
#' \itemize{
#'   \item \code{\link{addTitle}} add titles
#'   \item \code{\link{addParagraph}} add text
#'   \item \code{\link{addPlot}} add plots
#'   \item \code{\link{addFlexTable}} add tables. See \code{\link{FlexTable}}
#'   \item \code{\link{addImage}} add external images
#'   \item \code{\link{addTOC}} add table of content
#'   \item \code{\link{addPageBreak}} add page break
#'   \item \code{\link{addSection}} add section (for landscape orientation)
#'   \item \code{\link{addDocument}} add an external \code{docx} file into
#' 		a \code{docx} object.
#' }
#'
#' R outputs (tables, plots, paragraphs and images) can be inserted (and not added at the end)
#' in a document if a bookmark exists in the template file.
#'
#' Once object has content, user can write the docx into a ".docx" file, see \code{\link{writeDoc}}.
#' @references Wikipedia: Office Open XML\cr\url{http://en.wikipedia.org/wiki/Office_Open_XML}
#' @note Word 2007-2013 (*.docx) file formats are the only supported files.\cr Document are manipulated in-memory ; a \code{docx}'s document is not written to the disk unless the \code{\link{writeDoc}} method has been called on the object.
#' @export
#' @examples
#' \donttest{
#' if( check_valid_java_version() ){
#' # set default font size to 10
#' options( "ReporteRs-fontsize" = 10 )
#'
#' # Create a new document
#' doc <- docx( title = "title" )
#'
#' # display available styles
#' styles( doc )
#'
#' # add title
#' doc <- addParagraph( doc, "Document title", stylename = "TitleDoc" )
#'
#' # add a paragraph
#' doc <- addParagraph( doc , "This document is generated with ReporteRs."
#'   , stylename="Citationintense")
#'
#' # add page break
#' doc <- addPageBreak( doc )
#'
#' # add a title
#' doc <- addTitle( doc, "Table of contents", level =  1 )
#'
#' ################ TOC DEMO ################
#' # add a table of content
#' doc <- addTOC( doc )
#'
#' # add page break and then tables of contents for produced plots and tables
#' doc <- addPageBreak( doc )
#' doc <- addTitle( doc, "List of graphics", level =  1 )
#' doc <- addTOC( doc, stylename = "rPlotLegend" )
#' doc <- addTitle( doc, "List of tables", level =  1 )
#' doc <- addTOC( doc, stylename = "rTableLegend" )
#'
#' # add page break
#' doc <- addPageBreak( doc )
#'
#' ################ TEXT DEMO ################
#'
#' # add a title
#' doc <- addTitle( doc, "Text demo", level =  1 )
#'
#'
#' sometext = c( "Lorem ipsum dolor sit amet, consectetur adipiscing elit."
#'   , "In sit amet ipsum tellus. Vivamus dignissim arcu sit."
#'   , "Quisque dictum tristique ligula."
#' )
#' # add simple text with 'Normal' style
#' doc <- addParagraph( doc, value = sometext, stylename="Normal" )
#' # add simple text with 'BulletList' style
#' doc <- addParagraph( doc, value = sometext, stylename="BulletList" )
#'
#' # Add "My tailor is rich" and "Cats and Dogs"
#' # format some of the pieces of text
#' pot1 = pot("My tailor", textProperties(color="red",
#' 	shading.color = "#CCCCCC" ) ) + " is " + pot("rich",
#' 		textProperties(font.weight="bold") )
#' pot2 = pot("Cats", textProperties(color="red" )) + " and " + pot("Dogs",
#' 	textProperties(color="blue" ) )
#' doc <- addParagraph(doc, set_of_paragraphs( pot1, pot2 ),
#' 	stylename = "Normal" )
#'
#' doc <- addParagraph(doc, "Silentium tractibus per minimis ne excita
#' ut temptentur generalibus quam primordiis per clades post delictis
#' iuge exitium silentium per et.",
#'   par.properties = parProperties( padding.left = 25,
#'     padding.right = 25) )
#'
#'
#' doc <- addParagraph(doc,
#'   pot("Gallus necem refert singula modum quae est quae quorum leo.",
#' 	format = textItalic( ) ),
#'   par.properties = parProperties(list.style = "blockquote") )
#'
#'
#' ordered.list.level1 = parProperties(list.style = "ordered", level = 1 )
#' ordered.list.level2 = parProperties(list.style = "ordered", level = 2 )
#'
#' doc <- addParagraph( doc, value = sometext,
#' 	par.properties = ordered.list.level1 )
#' doc <- addParagraph( doc, value = sometext,
#' 	par.properties = ordered.list.level2 )
#'
#' ################ PLOT DEMO ################
#' # load ggplot2
#' if( requireNamespace("ggplot2", quietly = TRUE) ){
#'   doc <- addTitle( doc, "Plot example", level = 1 )
#'
#'   # create a ggplot2 plot
#'   myplot = ggplot2::qplot(Sepal.Length, Petal.Length, data = iris
#'     , color = Species, size = Petal.Width, alpha = I(0.7) )
#'
#'   # Add myplot into object doc
#'   doc <- addPlot( doc = doc, fun = print, x = myplot )
#'
#'   # Add a legend below the plot
#'   doc <- addParagraph( doc, value = "my first plot",
#' 	stylename = "rPlotLegend")
#' }
#'
#' ################ FLEXTABLE DEMO ################
#'
#' doc <- addTitle( doc, "FlexTable example", level = 1 )
#'
#' # Create a FlexTable with data.frame mtcars, display rownames
#' # use different formatting properties for header and body
#' MyFTable <- FlexTable( data = mtcars, add.rownames = TRUE,
#' 	header.cell.props = cellProperties( background.color = "#00557F" ),
#' 	header.text.props = textProperties( color = "white",
#' 		font.size = 11, font.weight = "bold" ),
#' 	body.text.props = textProperties( font.size = 10 )
#' )
#' # zebra stripes - alternate colored backgrounds on table rows
#' MyFTable <- setZebraStyle( MyFTable, odd = "#E1EEf4", even = "white" )
#'
#' # applies a border grid on table
#' MyFTable <- setFlexTableBorders(MyFTable,
#' 	inner.vertical = borderProperties( color="#0070A8", style="solid" ),
#' 	inner.horizontal = borderNone(),
#' 	outer.vertical = borderProperties( color = "#006699",
#' 		style = "solid", width = 2 ),
#' 	outer.horizontal = borderProperties( color = "#006699",
#' 		style = "solid", width = 2 )
#' )
#'
#'
#' # add MyFTable into document
#' doc <- addFlexTable( doc, MyFTable )
#' doc <- addParagraph( doc, value = "my first table",
#' 	stylename = "rTableLegend")
#'
#' # write the doc
#' writeDoc( doc, file = "document_example.docx")
#' }
#' }
#' @seealso \code{\link{pptx}}
docx = function( title = "untitled", template, empty_template = FALSE, list.definition = getOption("ReporteRs-list-definition") ){

  .Deprecated(msg = "Function docx is deprecated, please use officer::read_docx() instead.")

	if( missing( template ) )
		template = file.path( system.file(package = "ReporteRs"), "templates/EMPTY_DOC.docx" )
	.reg = regexpr( paste( "(\\.(?i)(docx))$", sep = "" ), template )

	template <- file_path_as_absolute2(template)

	if( .reg < 1 )
	  stop("invalid template name, it must have extension .docx")

	if( !file.exists( template ) )
		stop(template , " can not be found.")

	lidef = do.call( list.settings, list.definition )
	# java calls
	obj = .jnew( class.docx4r.document )
	.jcall( obj, "V", "setBaseDocument", template, lidef )
	.sysenv = Sys.getenv(c("USERDOMAIN","COMPUTERNAME","USERNAME"))

	.jcall( obj, "V", "setDocPropertyTitle", title )
	.jcall( obj, "V", "setDocPropertyCreator", paste( .sysenv["USERDOMAIN"], "/", .sysenv["USERNAME"], " on computer ", .sysenv["COMPUTERNAME"], sep = "" ) )

	if( empty_template )
	  .jcall(obj, "V", "deleteContent")

	.Object = list( obj = obj
		, title = title
		, basefile = template
		, plot_first_id=1L
		)
	class( .Object ) = "docx"
	.Object$styles = styles( .Object )
	matchheaders = regexpr("^(Heading|Titre|Rubrik|Overskrift|berschrift|)[1-9]{1}$", .Object$styles )
	if( any( matchheaders > 0 ) ){
		.Object = map_title(.Object, stylenames = sort( .Object$styles[ matchheaders > 0 ] ) )
	} else .Object$header.styles = character(0)


	.Object
}


#' @details \code{dim} returns page width and height and page margins
#' of a \code{docx} object.
#' @param x a \code{docx} objet
#' @examples
#' \donttest{
#' # get docx page dimensions ------
#' doc = docx( title = "title" )
#' dim( doc )
#' }
#' @rdname docx
#' @export
dim.docx = function( x ){
  temp = .jcall(x$obj, "[I", "getSectionDimensions")
  out = list( page = c( width = temp[1], height = temp[2] ) / 1440
              , margins = c(top = temp[3], right = temp[4], bottom = temp[5], left = temp[5]) / 1440
  )
  out
}


#' @details
#' \code{print} print informations about an object of
#' class \code{docx}.
#' @param ... unused
#' @rdname docx
#' @export
print.docx = function (x, ...){
  cat("[docx object]\n")

  cat("title:", x$title, "\n")

  cat(paste( "Original document: '", x$basefile, "'\n", sep = "" ) )

  cat( "Styles:\n" )
  print( styles( x ) )

  invisible()
}