diff htmlhlp.R @ 0:e66bb061af06 draft

planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit 3529b25417f8e1a5836474c9adec4b696d35099d-dirty
author prog
date Tue, 12 Jul 2016 12:02:37 -0400
parents
children 20d69a062da3
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/htmlhlp.R	Tue Jul 12 12:02:37 2016 -0400
@@ -0,0 +1,111 @@
+if ( ! exists('HtmlWriter')) { # Do not load again if already loaded
+
+	library(methods)
+
+	#####################
+	# CLASS DECLARATION #
+	#####################
+	
+	HtmlWriter <- setRefClass("HtmlWriter", fields = list(.file = "character", .auto.indent = "numeric"))
+	
+	
+	###############
+	# CONSTRUCTOR #
+	###############
+	
+	HtmlWriter$methods( initialize = function(file = NA_character_, auto.indent = TRUE, ...) {
+
+		.file <<- file
+		.auto.indent <<- if (auto.indent) 0 else NA_integer_
+
+		# Create empty file
+		cat('', file = .self$.file, append = FALSE)
+
+		callSuper(...) # calls super-class initializer with remaining parameters
+	})
+
+	#########
+	# WRITE #
+	#########
+
+	HtmlWriter$methods( write = function(text, indent = NA_integer_, newline = TRUE, escape = FALSE) {
+
+		# Compute indentation
+		if (is.na(indent))
+			indent <- if (is.na(.self$.auto.indent)) 0 else .self$.auto.indent
+
+		cat(rep("\t", indent), text, if (newline) "\n" else "", sep = '', file = .self$.file, append = TRUE)
+	})
+
+	#############
+	# WRITE TAG #
+	#############
+
+	HtmlWriter$methods( writeTag = function(tag, text = NA_character_, indent = NA_integer_, newline = TRUE) {
+
+		if (is.na(text))
+			.self$write(paste0("<", tag, "/>"), indent = indent, newline = newline, escape = FALSE)
+		else {
+			.self$writeBegTag(tag, indent = indent, newline = FALSE)
+			.self$write(text, escape = TRUE , indent = 0, newline = FALSE)
+			.self$writeEndTag(tag, indent = 0, newline = newline)
+		}
+	})
+
+	###################
+	# WRITE BEGIN TAG #
+	###################
+
+	HtmlWriter$methods( writeBegTag = function(tag, indent = NA_integer_, newline = TRUE) {
+
+		# Write opening tag
+		.self$write(paste0("<", tag, ">"), indent = indent, newline = newline, escape = FALSE)
+
+		# Increment auto-indent
+		if ( ! is.na(.self$.auto.indent))
+			.auto.indent <<- .self$.auto.indent + 1
+	})
+
+	#################
+	# WRITE END TAG #
+	#################
+
+	HtmlWriter$methods( writeEndTag = function(tag, indent = NA_integer_, newline = TRUE) {
+
+		# Decrement auto-indent
+		if ( ! is.na(.self$.auto.indent))
+			.auto.indent <<- .self$.auto.indent - 1
+
+		# Write closing tag
+		.self$write(paste0("</", tag, ">"), indent = indent, newline = newline, escape = FALSE)
+	})
+
+	###############
+	# WRITE TABLE #
+	###############
+
+	HtmlWriter$methods( writeTable = function(x, indent = NA_integer_, newline = TRUE) {
+
+		.self$writeBegTag('table', indent = indent, newline = newline)
+
+		# Write table header
+		if ( ! is.null(colnames(x))) {
+			.self$writeBegTag('tr', indent = indent + 1, newline = newline)
+			for (field in colnames(x))
+				.self$writeTag('th', field, indent = indent + 2, newline = newline)
+			.self$writeEndTag('tr', indent = indent + 1, newline = newline)
+		}
+
+		# Write values
+		if (nrow(x) > 0 && ncol(x) > 0)
+			for (i in 1:nrow(x)) {
+				.self$writeBegTag('tr', indent = indent + 1, newline = newline)
+				for (j in 1:ncol(x))
+					.self$writeTag('td', x[i, j], indent = indent + 2, newline = newline)
+				.self$writeEndTag('tr', indent = indent + 1, newline = newline)
+			}
+		.self$writeEndTag('table', indent = indent, newline = newline)
+	})
+
+
+} # end of load safe guard