### R code from vignette source 'switches-by-context.Rnw' ################################################### ### code chunk number 1: switches-by-context.Rnw:51-260 ################################################### ## Function: getSwitches: download whichever switches file is present ## Args: ## urls: vector of the possible (base)names of the switches file ## Value: list of two elements: ## 1. name of downloaded file or "none" if download failed ## 2. vector of the contents of the downloaded file getSwitches <- function (urls) { ## we'll return the first one that does not fail for (i in 1:length(urls)) { switches <- tryCatch(readLines(ucon <- url(urls[i]), warn=FALSE), warning=function(w) FALSE, error=function(e) FALSE) close(ucon) if (is.logical(switches)) { if (i == length(urls)) { message("Switches document could not be downloaded.") swname <- "none" switches <- "" } next } else { message("Downloading ", urls[i]) swname <- basename(urls[i]) break } } return(list(swname, switches)) } ## Function: php2txt: download and create a text file with HTML markup converted to LaTeX ## Args: ## out: character, optional. file name for converted switch.html. Default is ## switch.data.mod-date ## Value: only side-effects: ## 1. create switches.data.last-mod-date containing html converted to LaTeX ## 2. create switches.last.update.RDS containing dates of downloaded pages, ## most recent first. php2txt <- function(out) { ## download, or read from local copy if already downloaded today phpfiles <- c("switches.html", "switches.php.html", "switches.php") ## download but avoid downloading multiple times on the same day if (file.exists(phpfiles[1]) && as.Date(file.mtime(phpfiles[1])) == Sys.Date() ) { message("note: reading local switches.html") sw.1 <- list("switches.html", readLines("switches.html")) } else { sw.1 <- getSwitches(paste0("https://reduce-algebra.sourceforge.io/", phpfiles)) if (sw.1[[1]] == "none") stop("Cannot create switches-by-context.tex. Stopping.") writeLines(sw.1[[2]], phpfiles[1]) } ## input has invalid utf8 chars x201C (“), x201D (”), x2019 (’) and x2013 (–) on ## various records. Neither Sweave nor texi2dvi like this. So preamble includes ## [utf8]{inputenc} and the SweaveUTF8 command sw.1[[2]] <- gsub('[“”]', '"', sw.1[[2]]) sw.1[[2]] <- gsub('’', "'", sw.1[[2]]) sw.1[[2]] <- gsub("–", "-", sw.1[[2]]) ## check whether the page has been updated since last fetch if (file.exists("switches.last.update.RDS")) { switches.last.update <- readRDS("switches.last.update.RDS") } else { switches.last.update <- as.Date("1970-01-01") } if (length(plm.idx <- grep("Page last modified on", sw.1[[2]])) == 0) { stop("Could not find \"Page last modified on\".") } else { page.mod.date <- as.Date(gsub("(^ *|st|nd|rd|th|\\.)", "", sw.1[[2]][plm.idx+1]), "%A %e %B %Y") if (page.mod.date <= switches.last.update[1]) { message( paste0("note: nothing to do https://reduce-algebra.sourceforge.io/", sw.1[[1]], "\n not updated since last download.")) q("no") } else { pmd.sfx <- as.character(page.mod.date) if (missing(out)) out <- paste0("switches.data.", pmd.sfx) } } ## find the start/end of the two tables (tbody) and extract them sw.idx <- which(grepl(" translation "&radic[^.]+.", "$\\\\sqrt{x^2}$ to $|x|$.", "→", "$\\\\rightarrow$", "", "$", "", "{\\\\it ", "", "}", "_", "\\\\_", ## must be after _ -> \_ but before "ξ([^<]+)", "$\\\\xi_\\1$", "([^<]+)", "$^\\1$", "([^<]+)", "$_\\1$", "]*>", "", "–", "", "([^$])ξ", "\\1$\\\\xi$", "<", "", ">", "", """, "\042", " ", " " ) sw.from <- h2l[seq(1, length(h2l), 2)] sw.to <- h2l[seq(2, length(h2l), 2)] for (i in 1:length(sw.from)) sw.doc <- gsub(sw.from[i], sw.to[i], sw.doc) ## create data frame for sw.doc. This assumes that each table row consists of 6 lines of ## text: tr, 4x th/td and /tr sw.doc.len <- length(sw.doc) sw.doc.df <- data.frame( switch=gsub("( +|)", "", sw.doc[seq(2, sw.doc.len, 6)]), state=gsub("( +|)", "", sw.doc[seq(3, sw.doc.len, 6)]), context=gsub("( +|)", "", sw.doc[seq(4, sw.doc.len, 6)]), description=paste0(gsub("( +|)", "", sw.doc[seq(5, sw.doc.len, 6)]), " \\\\") ) write.table(sw.doc.df, out, quote=FALSE, sep="\t", row.names=FALSE) message(paste("note: wrote converted ", phpfiles[1], " to ", out)) ## save this modification date (stack) switches.last.update <- c(page.mod.date, switches.last.update) saveRDS(switches.last.update, "switches.last.update.RDS") return(pmd.sfx) } ## Function: txt2tex: return formatted LaTeX for a context type ## Args: ## date.idx: integer, required. index of desired update date. Default: 1, most recent ## date.suffix: logical, required. Use modification date as file suffix. Default: TRUE ## type: char, general or package. Default: general ## longtable: logical, required. Use longtable or table/tabular. Default: FALSE ## fsize: logical, wrap each column in \Lsmc{}. \Lsmc is defined in the Rnw file ## Value: only side-effects: create switches.last-mod-date.tex|pdf txt2tex <- function(date.idx=1, date.suffix=TRUE, type="general", longtable=FALSE, fsize=FALSE) { pmd.date <- readRDS("switches.last.update.RDS")[date.idx] pmd.sfx <- paste0(".", pmd.date) idata <- paste0("switches.data", if (date.suffix) pmd.sfx else "") ## Read the data switches <- read.table(idata, header = TRUE, sep = "\t", quote="", colClasses = c('character','character','character','character')) if (fsize) { for (var in c('switch','state','description')) { switches[,var] <- paste0("\\Lsmc{", switches[,var], "}") } } isGeneral <- grepl("([A-Z][a-z]+|\\*)", switches$context) if (tolower(type) == "general") {swtype <- switches[which(isGeneral),] } else {swtype <- switches[which(!isGeneral),] } sw.by.c <- swtype[order(swtype$context), c('context','switch','state','description')] ## in order to have * (global) as first table, this must be done no earlier than here if (any(c.global <- grepl("^\\*$", sw.by.c$context))) { sw.by.c$context[which(c.global)] <- "Global" } ## debugging ## return(sw.by.c) ## end debugging ## by context contexts <- unique(sw.by.c$context) ## for default size >10pt some contexts need longtable so define separate begin/end ## for longtable and table. Order of caption differs too. By using ## caption[]{continued} in the endhead, duplicated entries in LoT are avoided when a ## table spans pages. tab.head <- "\\bfseries{Switch} & \\bfseries{Default} & \\bfseries{Effect} \\\\" hline <- "\\hline" topline <- hline #"\\toprule" botline <- hline #"\\bottomrule" txt.c <- vector("character") for (context in contexts) { this.context <- sw.by.c[sw.by.c$context == context,c('switch','state','description')] ## to get hyphenation working in the switch column ## if (any(nchar(this.context$switch) > 15)) { ## this.context$switch <- paste0("\\hspace{0pt}", this.context$switch) ## } this.context$switch <- ifelse(nchar(this.context$switch) > 18, sub("\\_", "\\_\\\\\\\\", this.context$switch), this.context$switch) txt.c <- c(txt.c, if (longtable) { c("\n\\begin{longtable}[c]{p{4cm}lp{10cm}}", paste0("\\caption{", context, "}\\\\"), ## needs newline in longtable tab.head, topline, "\\endfirsthead", "\\caption[]{(continued)}\\\\", tab.head, topline, "\\endhead" ) } else { c("\n\\begin{table}[hp]", "\\begin{center}", paste0("\\caption{", context, "}"), "\\begin{tabular}{p{4cm}lp{10cm}}", tab.head, topline ) }, apply(this.context, 1, paste, collapse = " & "), botline, if (longtable) { "\\end{longtable}\n" } else { c("\\end{tabular}", "\\end{center}", "\\end{table}\n") } ) } return(txt.c) } pmd.date <- php2txt() ################################################### ### code chunk number 2: update ################################################### writeLines(swgen <- txt2tex(date.idx=1, date.suffix=TRUE, type="general", longtable=FALSE)) ################################################### ### code chunk number 3: update ################################################### writeLines(swpkg <- txt2tex(date.idx=1, date.suffix=TRUE, type="package", longtable=FALSE))