1#' RKWard file names 2#' 3#' In RKWard the output is saved as a html file which is located at "~/.rkward" 4#' by default. (\bold{TODO}: make this platform free). The name of this html 5#' file can be retrieved and set using \code{rk.get.output.html.file} and 6#' \code{rk.set.output.html.file}. \code{rk.flush.output.html.file} will delete 7#' the current (or specified) html file, and re-initialize it. 8#' 9#' \code{rk.get.tempfile.name} returns a non-existing filename inside the 10#' directory of the output file. It is mainly used by \link{rk.graph.on} to 11#' create filenames suitable for storing images in the output. The filenames of 12#' the temporary files are of the form 13#' "\code{prefix}\emph{xyz}.\code{extension}". \code{rk.get.tempfile.name} is 14#' somewhat misnamed. For truly temporary files, \link{tempfile} is generally 15#' more suitable. 16#' 17#' \code{rk.get.workspace.url} returns the url of workspace file which has been 18#' loaded in RKWard, or NULL, if no workspace has been loaded. NOTE: This value 19#' is note affected by running \code{load} in R, only by loading R workspaces 20#' via the RKWard GUI. 21#' 22#' @aliases rk.get.tempfile.name rk.get.workspace.url rk.get.output.html.file 23#' rk.set.output.html.file 24#' @param prefix a string, used as a filename prefix when saving images to the 25#' output file 26#' @param extension a string, used as a filename extension when saving images 27#' to the output file 28#' @param x a string, giving the filename of the of the output file 29#' @param additional.header.contents NULL or an additional string to add to the HTML header section. 30#' This could be scripts or additional CSS definitions, for example. Note that 31#' \emph{nothing} will be added to the header, if the file already exists. 32#' @param style Currently either "regular" or "preview". The latter omits table of contents and date. 33#' @param css Local file name of CSS file to use, or NULL for no CSS file. The CSS file will be 34#' placed next to x, with file name extension ".css". Only effective when initializing a 35#' (non-existing) output file. 36#' @param silent Set to true to avoid the output window being raised in the frontend. 37#' @param flush.images. If true, any images used in the output file will be deleted as well. 38#' @param ask Logical: Whether to ask before flushing the output file. 39#' @param ... Further parameters passed to rk.set.output.html.file() 40#' @return \code{rk.get.tempfile.name}, \code{rk.get.output.html.file}, and 41#' \code{rk.get.workspace.url} return a string while 42#' \code{rk.set.output.html.file} returns the \bold{previous} output html file. 43#' @author Thomas Friedrichsmeier \email{rkward-devel@@kde.org} 44#' @seealso \url{rkward://page/rkward_output}, \link{tempfile}, \link{file}, 45#' \link{rk.print} 46#' @keywords utilities IO 47#' @rdname rk.get.tempfile.name 48#' @examples 49#' 50#' testfile.name <- rk.get.tempfile.name(prefix="test", extension=".txt") 51#' testfile <- file(testfile.name) 52#' cat("This is a test\n", file=testfile) 53#' close(testfile) 54#' unlink(testfile.name) 55#' 56#' outfile <- rk.get.output.html.file() 57#' 58#' ## Not run 59#' rk.set.output.html.file("~/.rkward/another_file.html") 60#' rk.header("Output on a different output file") 61#' rk.show.html(rk.get.output.html.file()) 62#' rk.flush.output() 63#' rk.set.output.html.file(outfile) 64#' 65#' @export 66"rk.get.tempfile.name" <- function (prefix="image", extension=".jpg") { 67 return (.rk.do.plain.call ("get.tempfile.name", c (prefix, extension))) 68} 69 70#' @export 71#' @rdname rk.get.tempfile.name 72"rk.get.workspace.url" <- function () { 73 res <- .rk.do.plain.call ("getWorkspaceUrl") 74 if (length (res)) res 75 else NULL 76} 77 78#' @export 79#' @rdname rk.get.tempfile.name 80"rk.get.output.html.file" <- function () { 81 return (.rk.variables$.rk.output.html.file) 82} 83 84#' @export 85#' @rdname rk.get.tempfile.name 86"rk.set.output.html.file" <- function (x, additional.header.contents = getOption ("rk.html.header.additions"), style=c ("regular", "preview"), css = getOption ("rk.output.css.file"), silent=FALSE) { 87 stopifnot (is.character (x)) 88 style <- match.arg (style) 89 oldfile <- rk.get.output.html.file () 90 assign (".rk.output.html.file", x, .rk.variables) 91 92 if (!file.exists (x)) { 93 .rk.cat.output (paste ("<?xml version=\"1.0\" encoding=\"", .Call ("rk.locale.name", PACKAGE="(embedding)"), "\"?>\n", sep="")) 94 .rk.cat.output ("<html><head>\n<title>RKWard Output</title>\n") 95 if (!is.null (css)) { 96 cssfilename <- paste (sub ("\\.[^.]*$", "", basename (x)), ".css", sep="") 97 .rk.cat.output (paste ("<link rel=\"StyleSheet\" type=\"text/css\" href=\"", cssfilename, "\"/>\n", sep="")) 98 cssfile <- file.path (dirname (x), cssfilename) 99 if (!file.copy (css, cssfile, overwrite=TRUE)) { 100 warning ("Failed to copy CSS file ", css, " to ", cssfile) 101 } 102 } 103 # the next part defines a JavaScript function to add individual results to a global table of contents menu in the document 104 if (style != "preview") { 105 .rk.cat.output (paste ("\t<script type=\"text/javascript\"> 106 <!-- 107 function addToTOC(id, level){ 108 var fullHeader = document.getElementById(id); 109 var resultsTOC = document.getElementById('RKWardResultsTOCShown'); 110 var headerName = fullHeader.getAttribute('name'); 111 var headerText = fullHeader.firstChild.data; 112 var headerTitle = fullHeader.getAttribute('title'); 113 var newDiv = document.createElement('div'); 114 // create new anchor for TOC 115 var newAnchor = '<a href=\"#' + headerName + '\" title=\"' + headerTitle + '\"'; 116 // indent anchor depending on header level 117 if(level > 1){ 118 newDiv.style.textIndent = level-1 + 'em'; 119 newDiv.className = 'level' + level; 120 newAnchor = '• ' + newAnchor + '>' + headerText + '</a>'; 121 } else { 122 newAnchor = newAnchor + '>' + headerText + '</a>'; 123 } 124 newDiv.innerHTML = newAnchor; 125 resultsTOC.appendChild(newDiv); 126 } 127 function switchVisible(show, hide) { 128 document.getElementById(show).style.display = 'inline'; 129 document.getElementById(hide).style.display = 'none'; 130 } 131 function showMLevel(nodes){ 132 for(var i=0; i < nodes.length; i++) { 133 nodes[i].style.display = 'block'; 134 } 135 } 136 function hideMLevel(nodes){ 137 for(var i=0; i < nodes.length; i++) { 138 nodes[i].style.display = 'none'; 139 } 140 } 141 function maxLevel(level){ 142 if(level > 5){ 143 return false; 144 } 145 for(var i=1; i < 6; i++) { 146 if(i <= level){ 147 showMLevel(document.getElementsByClassName('level' + i)); 148 } else { 149 hideMLevel(document.getElementsByClassName('level' + i)); 150 } 151 } 152 } 153 // -->\n\t</script>\n", sep="")) 154 # positioning of the TOC is done by CSS, default state is hidden 155 # see $SRC/rkward/pages/rkward_output.css 156 } 157 158 if (!is.null (additional.header.contents)) .rk.cat.output (as.character (additional.header.contents)) 159 .rk.cat.output ("</head>\n<body>\n") 160 if (style != "preview") { 161 # This initial output mostly to indicate the output is really there, just empty for now 162 .rk.cat.output (paste ("<a name=\"top\"></a>\n<pre>RKWard output initialized on", .rk.date (), "</pre>\n")) 163 # an empty <div> where the TOC menu gets added to dynamically, and a second one to toggle show/hide 164 .rk.cat.output (paste ( 165 "<div id=\"RKWardResultsTOCShown\" class=\"RKTOC\">\n", 166 "\t<a onclick=\"javascript:switchVisible('RKWardResultsTOCHidden','RKWardResultsTOCShown'); return false;\" href=\"\" class=\"toggleTOC\">Hide TOC</a>\n", 167 "\t<span class=\"right\"><a href=\"#top\" class=\"toggleTOC\">Go to top</a></span>\n<br />", 168 "\t\t<span class=\"center\">\n\t\t\t<a onclick=\"javascript:maxLevel('1'); return false;\" href=\"\" title=\"TOC level 1\">1</a> •\n", 169 "\t\t\t<a onclick=\"javascript:maxLevel('2'); return false;\" href=\"\" title=\"TOC level 2\">2</a> •\n", 170 "\t\t\t<a onclick=\"javascript:maxLevel('3'); return false;\" href=\"\" title=\"TOC level 3\">3</a> •\n", 171 "\t\t\t<a onclick=\"javascript:maxLevel('4'); return false;\" href=\"\" title=\"TOC level 4\">4</a>\n\t\t</span>\n", 172 "\t<!-- the TOC menu goes here -->\n</div>\n", 173 "<div id=\"RKWardResultsTOCHidden\" class=\"RKTOC RKTOChidden\">\n", 174 "\t<a onclick=\"javascript:switchVisible('RKWardResultsTOCShown','RKWardResultsTOCHidden'); return false;\" href=\"\" class=\"toggleTOC\">Show TOC</a>\n", 175 "\t<span class=\"right\"><a href=\"#top\" class=\"toggleTOC\">Go to top</a></span>\n", 176 "</div>\n", sep="")) 177 } 178 } 179 180 # needs to come after initialization, so initialization alone does not trigger an update during startup 181 .rk.do.plain.call ("set.output.file", c (x, if (isTRUE (silent)) "SILENT" else NULL), synchronous=FALSE) 182 invisible (oldfile) 183} 184 185# Internal helper function to extract file names of images used in html files. 186# Almost definitely, this could be simplified, but I'll leave that as an exercise to the reader ;-) 187# Note that this uses heuristics, rather than real parsing 188".rk.get.images.in.html.file" <- function (file) { 189 lines <- readLines (file) 190 lines <- grep ("<(img|object)", lines, ignore.case=TRUE, value=TRUE) 191 files <- character (0) 192 for (line in lines) { 193 slines <- strsplit (line, "<")[[1]] 194 for (sline in slines) { 195 sline <- toupper (sline) 196 if (substring (sline, 0, 3) == "IMG") { 197 parts <- strsplit (sline, "SRC")[[1]] 198 if (length (parts) < 2) next 199 parts <- strsplit (parts[2], "\"")[[1]] 200 if (length (parts) < 2) next 201 files <- c (files, parts[2]) 202 } else if (substring (sline, 0, 6) == "OBJECT") { 203 parts <- strsplit (sline, "DATA")[[1]] 204 if (length (parts) < 2) next 205 parts <- strsplit (parts[2], "\"")[[1]] 206 if (length (parts) < 2) next 207 files <- c (files, parts[2]) 208 } 209 } 210 } 211 files 212} 213 214#' @export 215#' @rdname rk.get.tempfile.name 216"rk.flush.output" <- function (x=rk.get.output.html.file (), flush.images=TRUE, ask=TRUE, ...) { 217 images <- character (0) 218 if (flush.images) images <- .rk.get.images.in.html.file (x) 219 220 desc <- x 221 if (length (images)) { 222 desc <- paste (x, ", along with ", length (images), " image files", sep="") 223 } 224 225 if (isTRUE (ask)) { 226 if (!rk.show.question (paste ("Do you really want to flush the output file (", desc, ")?\nIt will not be possible to restore it.", sep=""))) stop ("Aborted by user") 227 } 228 229 unlink (x) 230 try ( 231 for (image in images) { 232 unlink (image) 233 } 234 ) 235 236 rk.set.output.html.file (x, ...) 237} 238