comparison 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
comparison
equal deleted inserted replaced
-1:000000000000 0:e66bb061af06
1 if ( ! exists('HtmlWriter')) { # Do not load again if already loaded
2
3 library(methods)
4
5 #####################
6 # CLASS DECLARATION #
7 #####################
8
9 HtmlWriter <- setRefClass("HtmlWriter", fields = list(.file = "character", .auto.indent = "numeric"))
10
11
12 ###############
13 # CONSTRUCTOR #
14 ###############
15
16 HtmlWriter$methods( initialize = function(file = NA_character_, auto.indent = TRUE, ...) {
17
18 .file <<- file
19 .auto.indent <<- if (auto.indent) 0 else NA_integer_
20
21 # Create empty file
22 cat('', file = .self$.file, append = FALSE)
23
24 callSuper(...) # calls super-class initializer with remaining parameters
25 })
26
27 #########
28 # WRITE #
29 #########
30
31 HtmlWriter$methods( write = function(text, indent = NA_integer_, newline = TRUE, escape = FALSE) {
32
33 # Compute indentation
34 if (is.na(indent))
35 indent <- if (is.na(.self$.auto.indent)) 0 else .self$.auto.indent
36
37 cat(rep("\t", indent), text, if (newline) "\n" else "", sep = '', file = .self$.file, append = TRUE)
38 })
39
40 #############
41 # WRITE TAG #
42 #############
43
44 HtmlWriter$methods( writeTag = function(tag, text = NA_character_, indent = NA_integer_, newline = TRUE) {
45
46 if (is.na(text))
47 .self$write(paste0("<", tag, "/>"), indent = indent, newline = newline, escape = FALSE)
48 else {
49 .self$writeBegTag(tag, indent = indent, newline = FALSE)
50 .self$write(text, escape = TRUE , indent = 0, newline = FALSE)
51 .self$writeEndTag(tag, indent = 0, newline = newline)
52 }
53 })
54
55 ###################
56 # WRITE BEGIN TAG #
57 ###################
58
59 HtmlWriter$methods( writeBegTag = function(tag, indent = NA_integer_, newline = TRUE) {
60
61 # Write opening tag
62 .self$write(paste0("<", tag, ">"), indent = indent, newline = newline, escape = FALSE)
63
64 # Increment auto-indent
65 if ( ! is.na(.self$.auto.indent))
66 .auto.indent <<- .self$.auto.indent + 1
67 })
68
69 #################
70 # WRITE END TAG #
71 #################
72
73 HtmlWriter$methods( writeEndTag = function(tag, indent = NA_integer_, newline = TRUE) {
74
75 # Decrement auto-indent
76 if ( ! is.na(.self$.auto.indent))
77 .auto.indent <<- .self$.auto.indent - 1
78
79 # Write closing tag
80 .self$write(paste0("</", tag, ">"), indent = indent, newline = newline, escape = FALSE)
81 })
82
83 ###############
84 # WRITE TABLE #
85 ###############
86
87 HtmlWriter$methods( writeTable = function(x, indent = NA_integer_, newline = TRUE) {
88
89 .self$writeBegTag('table', indent = indent, newline = newline)
90
91 # Write table header
92 if ( ! is.null(colnames(x))) {
93 .self$writeBegTag('tr', indent = indent + 1, newline = newline)
94 for (field in colnames(x))
95 .self$writeTag('th', field, indent = indent + 2, newline = newline)
96 .self$writeEndTag('tr', indent = indent + 1, newline = newline)
97 }
98
99 # Write values
100 if (nrow(x) > 0 && ncol(x) > 0)
101 for (i in 1:nrow(x)) {
102 .self$writeBegTag('tr', indent = indent + 1, newline = newline)
103 for (j in 1:ncol(x))
104 .self$writeTag('td', x[i, j], indent = indent + 2, newline = newline)
105 .self$writeEndTag('tr', indent = indent + 1, newline = newline)
106 }
107 .self$writeEndTag('table', indent = indent, newline = newline)
108 })
109
110
111 } # end of load safe guard