[rkward-cvs] [rkward] packages/rkwarddev: new function rk.JS.header() to generate header code

[m.eik michalke]

Git commit 07f8662021eaada58b49b55e43efbea4e92d7f3a by m.eik michalke.
Committed on 01/12/2014 at 15:40.
Pushed by meikm into branch 'master'.

new function rk.JS.header() to generate header code

M  +2    -1    packages/rkwarddev/ChangeLog
M  +2    -1    packages/rkwarddev/R/i18n.R
M  +16   -0    packages/rkwarddev/R/rk-internal.R
A  +84   -0    packages/rkwarddev/R/rk.JS.header.R

http://commits.kde.org/rkward/07f8662021eaada58b49b55e43efbea4e92d7f3a

diff --git a/packages/rkwarddev/ChangeLog b/packages/rkwarddev/ChangeLog
index 1f8e19b..73f91a3 100644
--- a/packages/rkwarddev/ChangeLog
+++ b/packages/rkwarddev/ChangeLog
@@ -1,6 +1,6 @@
 ChangeLog for package rkwarddev
 
-changes in version 0.06-6 (2014-11-30)
+changes in version 0.06-6 (2014-12-01)
 fixed:
   - rk.XML.optionset() does now allow to re-use objects defined in the same
     function call (i.e., refer to optioncolumns in the logic section)
@@ -19,6 +19,7 @@ added:
   - new attribute "i18n" added to several XML functions; it takes a list with the named arguments
     "comment" or "context" to either produce an i18n comment node or an "i18n_context" attribute
   - new function rk.i18n.comment() to give context for translators
+  - new function rk.JS.header() to easily generate JavaScript header code fit for i18n
 changed:
   - function i18n() was changed to be used in JavaScript generation only; this breaks code
     using the function introduced with 0.06-4, but that was to be shortlived from the start...
diff --git a/packages/rkwarddev/R/i18n.R b/packages/rkwarddev/R/i18n.R
index cde2814..ab76e3f 100644
--- a/packages/rkwarddev/R/i18n.R
+++ b/packages/rkwarddev/R/i18n.R
@@ -1,4 +1,4 @@
-# Copyright 2010-2014 Meik Michalke <meik.michalke at hhu.de>
+# Copyright 2014 Meik Michalke <meik.michalke at hhu.de>
 #
 # This file is part of the R package rkwarddev.
 #
@@ -30,6 +30,7 @@
 #' @param plural Character string for plural form of \code{msgid}, must at least include one
 #'    placeholder, and the first one has to represent an integer value in the dialog.
 #' @param newline Character string, can be set to e.g. \code{"\n"} to force a newline after the call.
+#' @return An object of class \code{rk.JS.i18n}.
 #' @export
 #' @examples
 #' i18n("Select data")
diff --git a/packages/rkwarddev/R/rk-internal.R b/packages/rkwarddev/R/rk-internal.R
index 5afbcff..c409dea 100644
--- a/packages/rkwarddev/R/rk-internal.R
+++ b/packages/rkwarddev/R/rk-internal.R
@@ -1409,3 +1409,19 @@ check.i18n <- function(i18n=NULL, attrs=list(), node=NULL, comment=FALSE){
   }
   return(result)
 } ## end function check.i18n()
+
+
+## function force.i18n
+# ensures that obj is encapsulated in i18n() in the output
+force.i18n <- function(obj){
+  stopifnot(length(obj) == 1)
+  if(inherits(obj, "rk.JS.i18n")){
+    result <- slot(obj, "value")
+  } else if(is.character(obj)){
+    result <- paste0("i18n(\"", obj, "\")")
+  } else {
+    stop(simpleError(paste0("force.i18n: don't know how to deal with an object of class ", class(obj), "!")))
+  }
+  return(result)
+} ## end function force.i18n
+
diff --git a/packages/rkwarddev/R/rk.JS.header.R b/packages/rkwarddev/R/rk.JS.header.R
new file mode 100644
index 0000000..eea5c80
--- /dev/null
+++ b/packages/rkwarddev/R/rk.JS.header.R
@@ -0,0 +1,84 @@
+# Copyright 2014 Meik Michalke <meik.michalke at hhu.de>
+#
+# This file is part of the R package rkwarddev.
+#
+# rkwarddev is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# rkwarddev is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with rkwarddev.  If not, see <http://www.gnu.org/licenses/>.
+
+#' Generate JavaScript header object
+#'
+#' @param title Either a character string or object of class \code{rk.JS.i18n}. Will become the header title,
+#'    nested in an i18n() call.
+#' @param ... An optional number of additional info to add to the header. each entry must be named \code{add}
+#'    or \code{addFromUI} -- note that you can use multiple entries with the same name here. Entries named
+#'    \code{add} must be vectors of legth 2, the first being the caption (character), the second its value (either
+#'    character or a XiMpLe node from the dialog). Entries named \code{addFromUI} must have exactly one value
+#'    specifying the GUI element to query (either character or a XiMpLe node from the dialog).
+#' @param level Integer, if not \code{NULL} will be added as the header level.
+#' @param guess.getter Locigal, if \code{TRUE} try to get a good default getter function for JavaScript
+#'    variable values.
+#' @return A character string.
+#' @export
+#' @examples
+#' my.cbox <- rk.XML.cbox("This is a test")
+#' rk.JS.header("Test results", addFromUI=my.cbox)
+
+rk.JS.header <- function(title, ..., level=NULL, guess.getter=FALSE){
+  addToHeaderChar <- addLevel <- NULL
+  addToHeader <- list(...)
+  headerNames <- names(addToHeader)
+  
+  if(!all(headerNames %in% c("add", "addFromUI"))){
+    stop(simpleError("rk.JS.header: currently only \"add\" and \"addFromUI\" are supported!"))
+  } else {}
+  
+  if(length(addToHeader) > 0){
+    addToHeaderChar <- paste(sapply(1:length(addToHeader), function(this.add){
+        functionName <- headerNames[[this.add]]
+        content <- addToHeader[[this.add]]
+        if(identical(functionName, "addFromUI")){
+          stopifnot(length(content) == 1)
+          content <- paste0("\"", id(content, js=FALSE), "\"")
+        } else if(identical(functionName, "add")){
+          stopifnot(length(content) == 2)
+          if(is.character(content[[2]])){
+            value <- paste0("\"", content[[2]], "\"")
+          } else if(is.XiMpLe.node(content[[2]])){
+            JS.var.value <- rk.JS.vars(content[[2]], guess.getter=guess.getter)
+            value <- paste0(slot(JS.var.value, "getter"), "(\"", id(content[[2]], js=FALSE), "\")")
+          } else {
+            stop(simpleError("rk.JS.header: you can only provide character values or XiMpLe nodes!"))
+          }
+          content <- paste0(force.i18n(content[[1]]), ", ", value)
+        } else {}
+        paste0(functionName, "(", content, ")")
+      }),
+      sep="", collapse="."
+    )
+    addToHeaderChar <- paste0(".", addToHeaderChar)
+  } else {}
+
+  if(!is.null(level)){
+    addToHeaderChar <- paste0(addToHeaderChar, ".level(", level, ")")
+  } else {} 
+
+  result <- paste0(
+    "new Header(",
+    force.i18n(title),
+    ")",
+    addToHeaderChar,
+    ".print();\n"
+  )
+
+  return(result)
+}