R/patchLog.R

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

# Patch a latex log file.  This borrows from logParser.js from TeXWorks,
# which had this author information and a GPL license.

#// TeXworksScript
#// Title: Errors, warnings, badboxes
#// Description: Looks for errors, warnings or badboxes in the LaTeX terminal output
#// Author: Jonathan Kew, Stefan Löffler, Antonio Macrì, Henrik Skov Midtiby
#// Version: 0.8.2
#// Date: 2012-03-26

patchLog <- function(f, newname=f, concords = NULL, max_print_line = 79, Cstyle = FALSE) {

    force(newname)
    lines <- readLines(f)
    
    # These patterns recognize all errors generated with \errmessage,
    # that is, starting with "!" and containing "l.\d+".
    # The macro \GenericError uses \errmessage internally.
    # Macros \@latex@error and \(Class|Package)Error use \GenericError.
    
    fileregexp <- '(?:"((?:\\./|/|\\.\\\\|[a-zA-Z]:\\\\|[a-zA-Z]:/|\\\\\\\\)(?:[^"]|$)+)"|((?:\\./|/|\\.\\\\|[a-zA-Z]:\\\\|[a-zA-Z]:/|\\\\\\\\)[^ ()$]+))'
    errormsg <- regexpr("^!\\s+", lines)
    errormsgC <- regexpr(paste0("^", fileregexp, ":(\\d+):\\s"), lines, perl = TRUE)
    if (is.na(Cstyle)) 
    	Cstyle <- (sum(errormsgC != -1) > sum(errormsg != -1)) 

    if (Cstyle) {
    	errormsg <- errormsgC
    	errorline <- errormsgC
    	errormsgbegin <- regexpr(paste0("^", fileregexp, ":(\\d+):\\s.*begin.*on input line (\\d+)"), lines, perl = TRUE)
    } else {
        # We capture extra text in errorline and errormsgbegin so that C style and default
        # style end up with the line number in the same location.  
        errorline <- regexpr("()l(\\.)(\\d+)", lines, perl = TRUE)
        errormsgbegin <- regexpr("^(!\\s).*(begin).*(on input line) (\\d+)", lines, perl = TRUE)
    }
    # We don't actually patch Warning messages, but here's the regex from
    # logParser.js to do so if we ever want to:
    # warnings <- regexpr("^(?:Class|Package|LaTeX) ([^\\\\s]+) Warning: .+\\n(?:\\\\(\\\\1\\\\)\\\\s.+\\n)*(?:.*\\\\.\\n)?", 
    #		      lines, perl = TRUE)
    badbox <- regexpr("^(?:Under|Over)full \\\\[hv]box\\s*\\([^)]+\\) in paragraph at lines (\\d+)--(\\d+)$",
                      lines, perl = TRUE)
    
    filestart <- gregexpr(paste0('\\(', fileregexp), lines, perl = TRUE)
    lineswithfile <- which(sapply(filestart, function(x) length(x) > 1 || x != -1))
    filestartline <- rep.int(lineswithfile, sapply(filestart[lineswithfile], length))
    filestartcol <- unlist(lapply(filestart[lineswithfile], function(x) attr(x, "capture.start")[,2]))
    filenamelen <- unlist(lapply(filestart[lineswithfile], function(x) attr(x, "capture.length")[,2]))
    filename <- substr(lines[filestartline], filestartcol, filestartcol + filenamelen - 1)

    realnames <- unique(filename)
    realnames <- realnames[file.exists(realnames)]
    
    keep <- filename %in% realnames
    filestartline <- filestartline[keep]
    filestartcol <- filestartcol[keep]
    filenamelen <- filenamelen[keep]
    filename <- myNormalizePath(filename[keep])

    openparen <- gregexpr("(", lines, fixed = TRUE)
    closeparen <- gregexpr(")", lines, fixed = TRUE)

    # Need to ignore the text in badbox warnings which may contain parens
    errortext <- which(badbox != -1) + 1
    lastline <- errortext
    repeat {
	continued <- nchar(lines[lastline], type="bytes") >= 79	
	lastline <- setdiff(lastline[continued] + 1, errortext)
	if (!length(lastline)) break
	errortext <- union(errortext, lastline)
    }
    # similarly, text may show up in errorlines
    errortext <- union(errortext, which(errorline != -1))

    openparen[errortext] <- list(-1)
    closeparen[errortext] <- list(-1)

    lineswithopen <- which(sapply(openparen, function(x) length(x) > 1 || x != -1))
    lineswithclose <- which(sapply(closeparen, function(x) length(x) > 1 || x != -1))

    openlines <- rep.int(lineswithopen, sapply(openparen[lineswithopen], length))
    closelines <- rep.int(lineswithclose, sapply(closeparen[lineswithclose], length))

    opencols <- do.call(c, openparen[lineswithopen])
    closecols <- do.call(c, closeparen[lineswithclose])

    parenlocs <- rbind( cbind(openlines, opencols, 1), cbind(closelines, closecols, -1) )
    o <- order(parenlocs[,1], parenlocs[,2])
    parenlocs <- parenlocs[o,]
    parenlines <- parenlocs[,1]
    parencols <- parenlocs[,2]

    #parendepth is the parenthesis depth just after that character
    parendepth <- cumsum(parenlocs[,3])

    fileineffect <- character(length(lines))
    inds <- seq_along(parendepth)

    for (i in seq_along(filename)) {
	j <- which(parenlines == filestartline[i] & parencols + 1 == filestartcol[i])
	depth <- parendepth[j]
	popped <- which(inds > j & parendepth == depth - 1)

	fileendline <- if (length(popped)) parenlines[min(popped)] else length(lines)
	fileineffect[filestartline[i]:fileendline] <- filename[i]
    }
    
    if (!length(concords)) { # The run failed, so get them from the source
        concordance <- grepl("-concordance.tex$", filename)
        if (any(concordance))
    	    concords <- readConcords( unique(filename[concordance]) )
    }
    
    if (length(concords)) {
	# Now start patching.  Need to patch last thing on a line first.
	
	names(concords) <- myNormalizePath(names(concords), mustWork = FALSE)
	patchable <- fileineffect %in% names(concords)

	# First, the badbox lines
	dofix <- which(patchable & (badbox != -1))
	if (length(dofix)) {
	    firststart <- attr(badbox, "capture.start")[dofix,1]
	    firststop <- firststart + attr(badbox, "capture.length")[dofix,1] - 1
	    secondstart <- attr(badbox, "capture.start")[dofix, 2]
	    secondstop  <- secondstart + attr(badbox, "capture.length")[dofix, 2] - 1
	    first <- as.numeric(substr(lines[dofix], firststart, firststop))
	    second <- as.numeric(substr(lines[dofix], secondstart, secondstop))
	    for (f in unique(fileineffect[dofix])) {
		thisfile <- fileineffect[dofix] == f
		first[thisfile] <- concords[[f]]$concord[first[thisfile]]
		second[thisfile] <- concords[[f]]$concord[second[thisfile]]
	    }
	    mysubstr(lines[dofix], secondstart, secondstop) <- as.character(second)
	    mysubstr(lines[dofix], firststart, firststop) <- as.character(first)
	}

	# Now, the error messages talking about missing \end
	dofix <- which(patchable & (errormsgbegin != -1))
	if (length(dofix)) {
	    start <- attr(errormsgbegin, "capture.start")[dofix, 4]
	    stop <- start + attr(errormsgbegin, "capture.length")[dofix, 4] - 1
	    num <- as.numeric(substr(lines[dofix], start, stop))
	    for (f in unique(fileineffect[dofix])) {
		thisfile <- fileineffect[dofix] == f
		num[thisfile] <- concords[[f]]$concord[num[thisfile]]
	    }
	    mysubstr(lines[dofix], start, stop) <- as.character(num)
	}

	# Now, the other error lines
	dofix <- which(patchable & (errorline != -1))
	if (length(dofix)) {
	    start <- attr(errorline, "capture.start")[dofix, 3]
	    stop <- start + attr(errorline, "capture.length")[dofix, 3] - 1
	    num <- as.numeric(substr(lines[dofix], start, stop))
	    for (f in unique(fileineffect[dofix])) {
		thisfile <- fileineffect[dofix] == f
		num[thisfile] <- concords[[f]]$concord[num[thisfile]]
	    }
	    mysubstr(lines[dofix], start, stop) <- as.character(num)
	    if (Cstyle) {
	        cap <- ifelse(attr(errorline, "capture.length")[dofix, 1] > 0, 1, 2)
	    	start <- attr(errorline, "capture.start")[cbind(dofix, cap)]
	    	stop <- start + attr(errorline, "capture.length")[cbind(dofix, cap)] - 1
	    	f <- myNormalizePath(substr(lines[dofix], start, stop))
	        mysubstr(lines[dofix], start, stop) <- 
	            sapply(concords[f], function(x) x$newsrc)
	    }
	}

	# And finally, the filenames
	dofix <- filename %in% names(concords)
	if (any(dofix)) {
	    start <- filestartcol[dofix]
	    stop <- start + filenamelen[dofix] - 1
	    withPath <- function(s) {
		okay <- grepl("[/\\]", s)
		s[!okay] <- paste0("./", s[!okay])
	    }
	    mysubstr(lines[filestartline[dofix]], start, stop) <- sapply(concords[filename[dofix]], 
	                                      function(x) withPath(x$newsrc))
	}
    }
    writeLines(lines, newname)
    invisible(concords)
}

`mysubstr<-` <- function(x, start, stop, value) 
    paste0(substr(x, 1, start-1), value, substr(x, stop+1, nchar(x)))
    
myNormalizePath <- function(f, mustWork = NA) {
    filename <- normalizePath(f, mustWork = mustWork)
    if (.Platform$OS.type == "windows") {
    	upperdrive <- grepl("^[[:upper:]]:", filename)
    	substr(filename[upperdrive], 1,1) <- tolower(substr(filename[upperdrive], 1,1))
    }
    filename
}

readConcords <- function(files) {
    concords <- character(length(files))
    for (i in seq_along(files)) {
    	lines <- readLines(files[i])
    	if (grepl("\\Sconcordance{", lines[1], fixed=TRUE)) {
    	    lines[1] <- sub("\\Sconcordance{", "", lines[1], fixed = TRUE)
    	    lines[length(lines)] <- sub("}$", "", lines[length(lines)])
    	    lines <- sub("%$", "", lines)
    	    concords[i] <- paste(lines, collapse="")
    	}
    }
    parseConcords(concords)
}