# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  printToPDF.r                                                                           #
  #           Last Updated Funclist  :  19 Feb 2015,  1:05 PM (Thursday)                                                       #
  #                                                                                                                            #
  #           Author Name            :  Rick Saporta                                                                           #
  #           Author Email           :  RickSaporta@gmail.com                                                                  #
  #           Author URL             :  www.github.com/rsaporta                                                                #
  #                                                                                                                            #
  #           Packages Called        :  extrafont, gridExtra                                                                   #
  #           Packages Used via NS   :  NA                                                                                     #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   printToPDF         ( Plots.list                                                                                          #
  #                        , f.name, f.dir=ifelse(exists("plotsDir"), plotsDir, "~/Desktop"), height.per.plot=4.2              #
  #                        , width.per.plot=8, ncol=NULL, nrow=NULL, ext=".pdf", open.when.done=TRUE, main=NULL                #
  #                        , sub=NULL, timestamp.plotfile=getOption("timestamp.plotfile"), legend.plot=NULL                    #
  #                        , legend.position="bottom", footer=NULL, showWarnings.sub=TRUE, ..., fouts=c()                      #
  #                        , paginate=FALSE, family="Arial"                                                                    #
  #                        , pdfFunc=c("cairo_pdf", "pdf"), math_fonts=identical(pdfFunc, "cairo_pdf"), verbose=TRUE )         #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #

printToPDF <- function(Plots.list, f.name, f.dir=ifelse(exists("plotsDir"), plotsDir, "~/Desktop")
                      , height.per.plot=4.2, width.per.plot=8, ncol=NULL, nrow=NULL, ext=".pdf"
                      , open.when.done=TRUE, main=NULL, sub=NULL, timestamp.plotfile=getOption("timestamp.plotfile")
                      , legend.plot=NULL
                      , legend.position="bottom"
                      , footer=NULL
                      , showWarnings.sub = TRUE
                      , ...
                      , fouts=c()
                      , paginate=FALSE
                      , family="Arial"
                      , pdfFunc=c("cairo_pdf", "pdf")
                      , math_fonts=identical(pdfFunc, "cairo_pdf")
                      , verbose=TRUE
                      ) {

## Plots a list of plots to a PDF
## Returns the filename
## ... : arguments passed through to grid.arrange
## 
## fouts : useful to keep a running talley of files

  lib(ggplot, quiet=TRUE)
  require(gridExtra)
  require(extrafont)

  if(any(wh.zero <- 0 == sapply(Plots.list, length))) {
    stop("Some plots are empty which will crash arrangeGrob;  HINT: use removeNullsFromList() ", call.=FALSE)
  }


  ## DETERMINE PDF FUNCTION
  ## --------------------------------------------- ##
  # cairo_pdf does not play nicely with legend.plot
  if (missing(pdfFunc) && !is.null(legend.plot))
    pdfFunc <- pdf
  else {
    pdfFunc <- match.arg(pdfFunc)
    if (pdfFunc == "cairo_pdf")
      lib(Cairo, quietly=TRUE)
    pdfFunc <- match.fun(pdfFunc)    
  }


  if (!is.null(legend.plot) && identical(pdfFunc, cairo_pdf)) {
    warning ("cairo_pdf does not play nicely with legend.plot\nusing standard pdf() instead")
    pdfFunc <- pdf
  }
  ## --------------------------------------------- ##

  ## Reminder to user to setScience / setProject
  if (missing(f.dir) && !exists("plotsDir")) {
    warning("plotsDir does not exist, will be saving to '", f.dir, "'\n  HINT: Did you forget to run setScience() or  setProject() ?")
  }

  ## If f.name is missing, try to extract it, otherwise fail
  if (missing(f.name)) {
    nm.P <- capture.output(substitute(Plots.list))
    pat.p <- "^P(lots?)?\\."
    if (grepl(pat.p, nm.P, ignore.case=TRUE))
      f.name <- gsub(pat.p, "", nm.P, ignore.case=TRUE)
    else 
      stop ("f.name cannot be missing, unless 'Plots.list' argument starts with P.(name) or Plots.(name)")
  }

  if (isTRUE(timestamp.plotfile))
    f.name <- timeStamp(f.name)

  if (inherits(Plots.list, "gg"))
    Plots.list <- list(Plots.list)

  len <- length(Plots.list)

  if (!len)
    stop("Plots.list has no length or is empty.\nHINT: Check your iterator")

  ## Calculate the number of cols and rows
  if (is.null(ncol)) {
    if (is.null(nrow))
      ncol <- 1
    else 
      ncol <- ceiling(len / nrow)
  }
  if (is.null(nrow))
    nrow <- ceiling(len / ncol)

  ## Optional debugging
  browser(expr=inDebugMode("pdf"))

  ## Calculate height
  height <- height.per.plot * ifelse(paginate, 1, nrow)
  width  <- width.per.plot  * ifelse(paginate, 1, ncol)

  ## Pdf & file info
  {
  if (is.character(main))
    title <- main
  else if ("label" %in% names(main) && is.character(main$label))
    title <- main$label
  else 
    title <- NULL
  }

  ## File name for output
  ## Remove the extension from f.name if accidentally put
  if (grepl(paste0(".", removeText("^\\.", ext), "$"), f.name)) {
    warning("Reminder:  You do not need to add the ext to f.name -- we add it for you", call.=FALSE)
    f.name %<>% removeText(paste0(".", removeText("^\\.", ext), "$"), .)
  }
  f.out <- as.path(f.dir, f.name, ext=ext)
  ## Create (sub)directory  if necessaru
  dir.create(dirname(f.out), recursive=TRUE, showWarnings=FALSE)

  ## footer INFO 
  ## If footer not given and the f.out is in 'orch'  OR  the footer is some variant of "orchard", use the orchard footer
  if ((missing(footer) && is.null(footer) &&  grepl("/orch/", f.out)) ||
     ( isTRUE(footer) ||  (is.character(footer) && nchar(footer) <= 15 && substr(tolower(footer), 1, 4) == "orch" ) ))
    footer <- orchardFootNote()


  verboseMsg(verbose, "Creating ", f.out, "\n", simple=TRUE)
  ## Open the pdf for output  
  if (identical(pdfFunc, pdf)) ## title does not work with cairo_pdf
    # pdfFunc(f.out, height=height, width=width, title=title, family=family)
    pdfFunc(f.out, height=height, width=width, title=title)
  else 
    pdfFunc(f.out, height=height, width=width, onefile=TRUE, family=family)

  ## Give main a line break at the top
  if (is.character(main) && !grepl("^\\s*\\n", main))
    main <- paste0("\n", main)

  browser(expr=inDebugMode("printToPDF", "pdf", "PDF"), text="in printToPDF() after having called pdfFunc but before printing graphs")

  ####   EXECUTE  ####
  ## Make sure other arguments are list
  if (is.null(names(Plots.list)))
    Plots.list <- setNames(Plots.list, nm=sprintf("Plot %i", seq(Plots.list)))

  ## sub will be pasted to bottom of main
  ## TODO 2016-Feb: Consider using subtext()
  if (!is.null(sub)) {
    if(showWarnings.sub)
      message("NEW BEHAVIOR:  'sub' will now be pasted onto 'main'.\n                Use 'footer' for the former behavoir of sub")
    # main <- subtext(main, subtext=sub, body.subtext="plain", line3=NULL)
    main <- paste(main, sub, sep="\n", collapse="\n")
  }

# orig   caught <- try(
# orig     if (paginate) {
# orig       for (nm in names(Plots.list)) {
# orig         verboseMsg(verbose, "printing ", nm, "\n", simple=TRUE)
# orig         print(Plots.list[[nm]])
# orig       }
# orig     } else 
# orig       do.call(grid.arrange, c(Plots.list, ncol=list(ncol), nrow=list(nrow), main=list(main), sub=list(footer), list(...)))
# orig   )

  caught <- try(
    if (paginate) {
      for (nm in names(Plots.list)) {
        verboseMsg(verbose, "printing ", nm, "\n", simple=TRUE)
        plot(Plots.list[[nm]])
      }
    } else {
        ## if legend.plot is set to TRUE instead of a grob, extract the legend from the first plot and remoe all legends
        if (isTRUE(legend.plot))
          legend.plot <- gg_extract_legend(Plots.list[[1]], position=legend.position)
        if (!is.null(legend.plot)) {
            Plots.list <- lapply(Plots.list, function(x) x + nolegend()) ## remove legends, one by one
            output <- do.call(arrangeGrob, c(Plots.list, ncol=list(ncol), nrow=list(nrow), top=list(main), bottom=list(footer), list(...)))
            gg_add_legend(output, legend=legend.plot, position=legend.position)
        } else {
           do.call(grid.arrange, c(Plots.list, ncol=list(ncol), nrow=list(nrow), top=list(textGrob(main)), bottom=list(footer), list(...)))
           # arrangeGrob(grobs=Plots.list, ncol=ncol, nrow=nrow, top=main, bottom=footer, ...)
        }
    }
  )

  ## Close PDF
  dev.off()

  if (math_fonts)
    try(embed_fonts(f.out))


  ## IF interactive, open the file
  if (open.when.done && exists(".o") && !isErr(caught))
    .o(f.out)

  ## append to running tally
  f.out <- c(fouts, f.out)
  
  ## Return the file name
  return(f.out)
}