R/texi2dvi.R

In patchDVI: Package to Patch '.dvi' or '.synctex' Files

# This is extracted from the file in the original copyright notice below,
# and modified for patchDVI.

#  File src/library/tools/R/utils.R
#  Part of the R package, http://www.R-project.org
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  A copy of the GNU General Public License is available at
#  http://www.r-project.org/Licenses/


## x without y, as in the examples of ?match.
`%w/o%` <-
  function(x, y)
    x[!x %in% y]

Rtexinputs <- function() {
  if (getRversion() < "2.12.0")
    file.path(R.home("share"), "texmf")
  else
    file.path(R.home("share"), "texmf", "tex", "latex")
}

texi2dvi <-
  function(file, pdf = FALSE, clean = FALSE, quiet = FALSE,
           texi2dvi = getOption("texi2dvi"),
           texinputs = NULL, index = TRUE,
           links = NULL )
  {
    ## Run texi2dvi on a latex file, or emulate it.

    if(is.null(texi2dvi) || !nzchar(texi2dvi))
      texi2dvi <- Sys.which("texi2dvi")

    envSep <- .Platform$path.sep
    texinputs0 <- texinputs

    Rtexmf <- file.path(R.home("share"), "texmf")

    ## "" forces use of default paths.
    texinputs <- paste(c(texinputs0, Rtexinputs(), ""),
                       collapse = envSep)
    ## not clear if this is needed, but works
    if(.Platform$OS.type == "windows")
      texinputs <- gsub("\\", "/", texinputs, fixed = TRUE)
    if (getRversion() < "2.12.0")
      Rbstinputs <- Rtexmf
    else
      Rbstinputs <- file.path(Rtexmf, "bibtex", "bst")
    bstinputs <- paste(c(texinputs0, Rbstinputs, ""),
                       collapse = envSep)

    otexinputs <- Sys.getenv("TEXINPUTS", unset = NA)
    if(is.na(otexinputs)) {
      on.exit(Sys.unsetenv("TEXINPUTS"))
      otexinputs <- "."
    } else on.exit(Sys.setenv(TEXINPUTS = otexinputs))
    Sys.setenv(TEXINPUTS = paste(otexinputs, texinputs, "", sep = envSep))
    bibinputs <- Sys.getenv("BIBINPUTS", unset = NA)
    if(is.na(bibinputs)) {
      on.exit(Sys.unsetenv("BIBINPUTS"), add = TRUE)
      bibinputs <- "."
    } else on.exit(Sys.setenv(BIBINPUTS = bibinputs, add = TRUE))
    Sys.setenv(BIBINPUTS = paste(bibinputs, texinputs, sep = envSep))
    obstinputs <- Sys.getenv("BSTINPUTS", unset = NA)
    if(is.na(obstinputs)) {
      on.exit(Sys.unsetenv("BSTINPUTS"), add = TRUE)
      obstinputs <- "."
    } else on.exit(Sys.setenv(BSTINPUTS = obstinputs), add = TRUE)
    Sys.setenv(BSTINPUTS = paste(obstinputs, bstinputs, sep = envSep))

    if(index && nzchar(texi2dvi) && .Platform$OS.type == "windows") { # MiKTeX on Windows
      extra <- ""
      if (is.null(links))
        opt_links <- if(pdf) "--tex-option=-synctex=-1" else "--tex-option=--src-specials"
      else
        opt_links <- links
      ext <- if(pdf) "pdf" else "dvi"
      opt_pdf <- if(pdf) "--pdf" else ""
      file.create(".timestamp")
      opt_quiet <- if(quiet) "--quiet" else ""

      ## look for MiKTeX (which this almost certainly is)
      ## and set the path to R's style files.
      ## -I works in MiKTeX >= 2.4, at least
      ## http://docs.miktex.org/manual/texify.html
      cmd <- paste(shQuote(texi2dvi), "--version")
      if (!quiet) message(cmd, "\n")
      ver <- system(cmd, intern = TRUE)
      if(length(grep("MiKTeX", ver[1L]))) {
        ## AFAICS need separate -I for each element of texinputs.
        texinputs <- c(texinputs0,
                       Rtexinputs(),
                       if (getRversion() < "2.12.0") NULL else Rbstinputs)
        paths <- paste ("-I", shQuote(texinputs))
        extra <- paste(extra, paste(paths, collapse = " "))
      }
      ## this only gives a failure in some cases, e.g. not for bibtex errors.
      cmd <- paste(shQuote(texi2dvi), opt_quiet, opt_pdf, opt_links,
                   shQuote(file), extra)
      if (!quiet) message(cmd, "\n")
      consoleLog <- system(cmd, intern=TRUE, ignore.stderr=TRUE)
      if(clean) {
        out_file <- paste(tools::file_path_sans_ext(file), ext, sep = ".")
        files <- list.files(all.files = TRUE) %w/o% c(".", "..",
                                                      out_file)
        file.remove(files[file_test("-nt", files, ".timestamp")])
      }
      file.remove(".timestamp")
    } else {
      ## Do not have Synctex-compatible texi2dvi or don't want to index
      ## Needed everywhere except for MiKTeX

      ## If it is called with MiKTeX then TEXINPUTS etc will be ignored.

      if (is.null(links))
        opt_links <- if(pdf) "--synctex=-1" else "--src-specials"
      else
        opt_links <- links
      texfile <- shQuote(file)
      base <- tools::file_path_sans_ext(file)
      idxfile <- paste(base, ".idx", sep="")
      latex <- if(pdf) Sys.getenv("PDFLATEX", "pdflatex")
      else  Sys.getenv("LATEX", "latex")
      bibtex <- Sys.getenv("BIBTEX", "bibtex")
      makeindex <- Sys.getenv("MAKEINDEX", "makeindex")
      cmd <- paste(shQuote(latex), "-interaction=nonstopmode", opt_links, texfile)
      if (!quiet) message(cmd, "\n")
      consoleLog <- system(cmd, intern = TRUE)
      status <- attr(consoleLog, "status")
      if(!is.null(status) && status)
        warning(gettextf("unable to run '%s' on '%s'", latex, file),
                domain = NA)
      nmiss <- length(grep("^LaTeX Warning:.*Citation.*undefined",
                           readLines(paste(base, ".log", sep = ""))))
      for(iter in 1L:10L) { ## safety check
        ## This might fail as the citations have been included in the Rnw
        if(nmiss) system(paste(shQuote(bibtex), shQuote(base)))
        nmiss_prev <- nmiss
        if(index && file.exists(idxfile)) {
          cmd <- paste(shQuote(makeindex), shQuote(idxfile))
          if (!quiet) message(cmd, "\n")
          if(system(cmd))
            stop(gettextf("unable to run '%s' on '%s'",
                          makeindex, idxfile),
                 domain = NA)
        }
        cmd <- paste(shQuote(latex), "-interaction=nonstopmode", opt_links, texfile)
        if (!quiet) message(cmd, "\n")
        consoleLog <- system(cmd, intern = TRUE)
        status <- attr(consoleLog, "status")
        if(!is.null(status) && status)
          warning(gettextf("unable to run %s on '%s'", latex, file), domain = NA)
        Log <- readLines(paste(base, ".log", sep = ""))
        nmiss <- length(grep("^LaTeX Warning:.*Citation.*undefined", Log))
        if(nmiss == nmiss_prev &&
           !length(grep("Rerun to get", Log)) ) break
      }
    }
    invisible(consoleLog)
  }