[rkward-cvs] SF.net SVN: rkward:[4141] trunk/rkward/rkward/rbackend/rpackages/rkward/R

Sat Jan 7 21:45:43 UTC 2012

Revision: 4141
          http://rkward.svn.sourceforge.net/rkward/?rev=4141&view=rev
Author:   m-eik
Date:     2012-01-07 21:45:42 +0000 (Sat, 07 Jan 2012)
Log Message:
-----------
this commit adds a dynamic menu to the HTML output file. it's still quite simple, but it does work. by default, rk.header() will add h1 headers to the menu, this can be changed by changing "menu=NULL" to either TRUE or FALSE.
i'm thinking of adding support for hiding the menu (only a "show menu" link should appear), and then to give it a fixed position, e.g. in the upper right corner, so it's always available.

Modified Paths:
--------------
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.print-functions.R

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R
===================================================================

--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R	2012-01-04 22:09:25 UTC (rev 4140)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.filename-functions.R	2012-01-07 21:45:42 UTC (rev 4141)
@@ -69,9 +69,30 @@
 
 	if (!file.exists (x)) {
 		.rk.cat.output (paste ("<?xml version=\"1.0\" encoding=\"", .Call ("rk.locale.name"), "\"?>\n", sep=""))
-		.rk.cat.output (paste ("<html><head>\n<title>RKWard Output</title>\n", .rk.do.plain.call ("getCSSlink"), "</head>\n<body>\n", sep=""))
+		.rk.cat.output (paste ("<html><head>\n<title>RKWard Output</title>\n", .rk.do.plain.call ("getCSSlink"), sep=""))
+		# the next part defines a JavaScript function to add individual results to a global menu in the document
+		.rk.cat.output (paste ("\t<script type=\"text/javascript\">
+		function addToMenu(id){
+			var fullHeader = document.getElementById(id);
+			var resultsMenu = document.getElementById('RKWardResultsMenu');
+			var headerName = fullHeader.getAttribute('name');
+			var headerText = fullHeader.firstChild.data;
+			// create new anchor for menu
+			var newAnchor = document.createElement('a');
+			var newLine = document.createElement('br');
+			var anchorRef = document.createAttribute('href');
+			var anchorText = document.createTextNode(headerText);
+			anchorRef.nodeValue = '#' + headerName;
+			newAnchor.setAttributeNode(anchorRef);
+			newAnchor.appendChild(anchorText);
+			resultsMenu.appendChild(newAnchor);
+			resultsMenu.appendChild(newLine);
+		}\n\t</script>\n", sep=""))
+		.rk.cat.output (paste ("</head>\n<body>\n", sep=""))
 		# This initial output mostly to indicate the output is really there, just empty for now
 		.rk.cat.output (paste ("<pre>RKWard output initialized on", date (), "</pre>\n"))
+		# an empty <div> where the menu gets added to dynamically
+		.rk.cat.output (paste ("<div id=\"RKWardResultsMenu\"><!-- the menu goes here --></div>", sep=""))
 	}
 
 	# needs to come after initialization, so initialization alone does not trigger an update during startup

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.print-functions.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.print-functions.R	2012-01-04 22:09:25 UTC (rev 4140)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.print-functions.R	2012-01-07 21:45:42 UTC (rev 4141)
@@ -38,6 +38,9 @@
 #'   the header with \code{<h2></h>} tag.
 #' @param parameters a list, preferably named, giving a list of "parameters" to
 #'   be printed to the output
+#' @param menu If \code{NULL}, the default, \code{rk.header()} will automatically
+#'   add h1 headers to the menu. \code{TRUE} will always add the header, and
+#'   \code{FALSE} will suppress it.
 #' @param titles a character vector, giving the column headers for a html
 #'   table.
 #' @param print.rownames controls printing of rownames. TRUE to force printing,
@@ -96,11 +99,21 @@
 	.rk.cat.output (.rk.do.plain.call ("highlightRCode", as.character (code)))
 }
 
-"rk.header" <- function (title, parameters=list (), level=1) {
+"rk.header" <- function (title, parameters=list (), level=1, menu=NULL) {
 	sink (rk.get.output.html.file(), append=TRUE)
 	on.exit (sink ())
 
-	cat ("<h", level, ">", title, "</h", level, ">\n", sep="")
+	# give header a name to be able to set anchors
+	# it's just a time string down to the fraction of a second: yyyymmddHHMMSS.ssssss
+	header.id <- format(Sys.time(), "%Y%m%d%H%M%OS6")
+	# add 'id' and 'name' attributes to the header
+	cat ("<h", level, "><a  id=\"", header.id,"\" name=\"", header.id,"n\">", title, "</a></h", level, ">\n", sep="")
+	# if 'menu' is true, also add a javascript function call to add this header to the results menu
+	# the function addToMenu() will be defined in the document head
+	# see rk.set.output.html.file() in rk.filename-functions.R
+	if (isTRUE(menu) || (is.null(menu) && level == 1)){
+		cat("<script>\n\t<!--\n\t\taddToMenu('", header.id,"');\n\t-->\n</script>\n", sep="")
+	}
 	if (length (parameters)) {
 		# legacy handling: parameter=value used to be passed as parameter, value
 		if (is.null (names (parameters))) {

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.



