# Copyright 2010-2014 Meik Michalke <meik.michalke@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/>.
#' Write a pluginmap file for RKWard
#'
#' @param name Character string, name of the plugin.
#' @param about An object of class \code{XiMpLe.node} to be pasted as the \code{<about>} section,
#' See \code{link[XiMpLe:rk.XML.about]{rk.XML.about}} for details. Skipped if \code{NULL}.
#' @param components Either an object of class \code{XiMpLe.node} to be pasted as the \code{<components>} section (see
#' \code{\link[rkwarddev:rk.XML.components]{rk.XML.components}} for details). Or a character vector with at least
#' one plugin component file name, relative path from the pluginmap file and ending with ".xml". Can be set to \code{NULL} if
#' \code{require} is used accordingly.
#' @param hierarchy Either an object of class \code{XiMpLe.node} to be pasted as the \code{<hierarchy>} section (see
#' \code{\link[rkwarddev:rk.XML.hierarchy]{rk.XML.hierarchy}} for details). Or a character vector with instructions
#' where to place the plugin in the menu hierarchy, one list or string for each included component. Valid single values are
#' \code{"file"}, \code{"edit"}, \code{"view"}, \code{"workspace"}, \code{"run"}, \code{"data"},
#' \code{"analysis"}, \code{"plots"}, \code{"distributions"}, \code{"windows"}, \code{"settings"} and \code{"help"},
#' anything else will place it in a "test" menu. If \code{hierarchy} is a list, each entry represents the label of a menu level.
#' Can be set to \code{NULL} if \code{require} is used accordingly.
#' @param require Either a (list of) objects of class \code{XiMpLe.node} to be pasted as a \code{<require>} section (see
#' \code{\link[rkwarddev:rk.XML.require]{rk.XML.require}} for details). Or a character vector with at least
#' one .pluginmap filename to be included in this one.
#' @param x11.context An object of class \code{XiMpLe.node} to be pasted as a \code{<context id="x11">} section, see
#' \code{\link[rkwarddev:rk.XML.context]{rk.XML.context}} for details.
#' @param import.context An object of class \code{XiMpLe.node} to be pasted as the \code{<context id="import">} section, see
#' \code{\link[rkwarddev:rk.XML.context]{rk.XML.context}} for details.
#' @param clean.name Logical, if \code{TRUE}, all non-alphanumeric characters except the underscore (\code{"_"}) will be removed from \code{name}.
#' @param hints Logical, if \code{TRUE} and you leave out optional entries (like \code{about=NULL}), dummy sections will be added as comments.
#' @param gen.info Logical, if \code{TRUE} a comment note will be written into the document,
#' that it was generated by \code{rkwarddev} and changes should be done to the script.
#' You can also provide a character string naming the very rkwarddev script file that generates this pluginmap,
#' which will then also be added to the comment.
#' @param dependencies An object of class \code{XiMpLe.node} to be pasted as the \code{<dependencies>} section,
#' See \code{\link[rkwarddev:rk.XML.dependencies]{rk.XML.dependencies}} for details. Skipped if \code{NULL}.
#' @param namespace Character string, the namespace attribute of the \code{<document>} node, defaults to the plugin name (which you probably shouldn't touch...).
#' RKWard's internal plugins should use the namespace \code{rkward}. This is taken care of by \code{\link[rkwarddev:rk.plugin.skeleton]{rk.plugin.skeleton}}
#' if you set \code{internal=TRUE}.
#' @param priority Character string, the priority attribute of the \code{<document>} node. Must be either "hidden", "low", "medium", or "high",
#' defaults to "medium".
#' @param id.name Character string, a unique ID for this plugin element. If \code{"auto"}, an ID will be generated automatically from \code{name}.
#' @param require.defaults Logical, if \code{TRUE}, \code{<require map="rkward::menu" />} and \code{<require map="rkward::embedded" />} will be added
#' by default, which ensures that the menu structure and embeddable plugins are loaded. It shouldn't hurt to set this.
#' @seealso \href{help:rkwardplugins}{Introduction to Writing Plugins for RKWard}
#' @return An object of class \code{XiMpLe.node}.
#' @export
rk.XML.pluginmap <- function(name, about=NULL, components, hierarchy="test",
require=NULL, x11.context=NULL, import.context=NULL, clean.name=TRUE, hints=FALSE, gen.info=TRUE,
dependencies=NULL, namespace=name, priority="medium", id.name="auto", require.defaults=TRUE){
name.orig <- name
if(isTRUE(clean.name)){
# to besure, remove all non-character symbols from name
name <- clean.name(name)
} else {}
# one of components or require *must* be used
if(is.null(components) && is.null(require)){
stop(simpleError("'components' or 'require' must be specified!"))
} else {}
# .pluginmap has these children in <document>:
# - dependencies (optional)
# - about (optional)
# - require (optional, multiple)
# - components (once)
# - component
# - attribute
# - hierarchy (once)
# - menu
# - entry
# - context (optional, "x11")
# - menu
# - entry
# - context (optional, "import")
# - menu
# - entry
all.children <- list()
if(isTRUE(gen.info)){
all.children[[length(all.children)+1]] <- generator.info()
} else if(is.character(gen.info)){
all.children[[length(all.children)+1]] <- generator.info(script=gen.info)
} else {}
# check about and dependencies
# result is a named list with "about" and "dependencies"
about.dep.list <- dependenciesCompatWrapper(dependencies=dependencies, about=about, hints=hints)
dependencies <- about.dep.list[["dependencies"]]
about <- about.dep.list[["about"]]
## dependencies section
if(!is.null(dependencies)){
all.children[[length(all.children)+1]] <- dependencies
} else {}
## about section
if(!is.null(about)){
all.children[[length(all.children)+1]] <- about
} else {}
## require section
if(isTRUE(require.defaults)){
if(is.null(require)){
} else {
}
} else {}
if(!is.null(require)){
# check if this is *really* require nodes
for(this.child in child.list(require)){
if(is.XiMpLe.node(this.child)){
valid.parent("require", node=this.child, see="rk.XML.require")
all.children[[length(all.children)+1]] <- this.child
} else {
if(grepl(".pluginmap", this.child)){
all.children[[length(all.children)+1]] <- rk.XML.require(file=this.child)
} else {
stop(simpleError("Only .pluginmap files are valid for require nodes!"))
}
}
}
} else {
if(!isTRUE(require.defaults) & isTRUE(hints)){
require.XML <- XMLNode("!--", rk.XML.require("path/file.pluginmap"))
all.children[[length(all.children)+1]] <- require.XML
} else {}
}
# check defaults
if(isTRUE(require.defaults)){
all.children[[length(all.children)+1]] <- rk.XML.require(map="rkward::menu")
all.children[[length(all.children)+1]] <- rk.XML.require(map="rkward::embedded")
} else {}
## components section
if(!is.null(components)){
if(is.XiMpLe.node(components)){
# check if this is *really* a components section, otherwise quit and go dancing
valid.parent("components", node=components, see="rk.XML.components")
all.children[[length(all.children)+1]] <- components
# get the IDs for hierarchy section
component.IDs <- sapply(slot(components, "children"), function(this.comp){
slot(this.comp, "attributes")$id
})
} else {
components.XML.list <- list()
num.compos <- length(components)
compo.names <- names(components)
for (this.comp.num in 1:num.compos){
this.comp <- components[this.comp.num]
if(num.compos > 1) {
# let's see if we have entry names
if(length(compo.names) == length(components)){
xml.basename <- compo.names[this.comp.num]
} else {
# remove any directory names and .EXT endings
xml.basename <- gsub("(.*/)?([[:alnum:]_]*).+(.*)?", "\\2", this.comp, perl=TRUE)
}
} else {
xml.basename <- name.orig
}
names(this.comp) <- NULL
components.XML.list[[length(components.XML.list) + 1]] <- rk.XML.component(
label=xml.basename,
file=this.comp,
# if this ID get's a change, also change it in rk.plugin.skeleton(show=TRUE)!
id.name=auto.ids(paste0(name, xml.basename), prefix=ID.prefix("component"), chars=25))
}
components.XML <- rk.XML.components(components.XML.list)
all.children[[length(all.children)+1]] <- components.XML
# get the IDs for hierarchy section
component.IDs <- sapply(slot(components.XML, "children"), function(this.comp){
slot(this.comp, "attributes")$id
})
}
} else {}
## hierachy section
if(is.XiMpLe.node(hierarchy)){
# check if this is *really* a hierarchy section, otherwise quit and go dancing
valid.parent("hierarchy", node=hierarchy, see="rk.XML.hierarchy")
all.children[[length(all.children)+1]] <- hierarchy
} else {
# if require loads another pluginmap, we might not need a hierarchy at all
if(is.null(hierarchy)){
if(is.null(require)){
stop(simpleError("if 'hierarchy' is NULL, 'require' must be specified!"))
} else {}
} else {
# correct for cases with one component and a list
if(length(component.IDs) == 1 & is.list(hierarchy)){
if(!is.list(hierarchy[[1]]))
hierarchy <- list(hierarchy)
} else {}
# check if the numbers fit
if(length(hierarchy) != length(component.IDs)){
stop(simpleError("Length of 'hierarchy' and number of components must be the same!"))
} else {}
# predefined menu points
main.menu <- c(file="File", edit="Edit", view="View", workspace="Workspace", run="Run",
data="Data", analysis="Analysis", plots="Plots", distributions="Distributions",
windows="Windows", settings="Settings", help="Help")
hier.comp.XML <- sapply(1:length(hierarchy), function(this.dial){
this.comp <- component.IDs[this.dial]
if(is.list(hierarchy)){
this.hier <- hierarchy[[this.dial]]
} else {
this.hier <- hierarchy[this.dial]
}
# hierachy can either be a list with menu paths, or predefined
if(is.list(this.hier)){
# check if we need to generate a hierarchy tree
if(length(this.hier) > 1){
new.hierarchy <- this.hier[2:length(this.hier)]
new.hierarchy[[length(new.hierarchy) + 1]] <- this.comp
} else {
new.hierarchy <- rk.XML.entry(this.comp)
}
if(this.hier[[1]] %in% names(main.menu)){
id.names <- sapply(this.hier, function(hier.id){
return(clean.name(hier.id))
})
hier.XML <- rk.XML.menu(
label=unlist(main.menu[[this.hier[[1]]]]),
new.hierarchy,
id.name=id.names)
} else {
hier.XML <- rk.XML.menu(
label=this.hier[[1]],
new.hierarchy)
}
} else {
entry.XML <- rk.XML.menu(
label=name.orig,
rk.XML.entry(component=this.comp),
id.name=auto.ids(paste0(name, this.comp), prefix=ID.prefix("menu"), chars=12))
if(this.hier %in% names(main.menu)){
hier.XML <- rk.XML.menu(
label=main.menu[[this.hier]],
entry.XML,
id.name=this.hier)
} else {
hier.XML <- rk.XML.menu(
label="Test",
entry.XML,
id.name="test")
}
}
return(hier.XML)
})
all.children[[length(all.children)+1]] <- rk.XML.hierarchy(hier.comp.XML)
}
}
## context sections
if(!is.null(x11.context)){
# check if this is *really* a context node for x11
if(is.XiMpLe.node(x11.context)){
node.name <- slot(x11.context, "name")
ctxt.name <- slot(x11.context, "attributes")$id
} else {
node.name <- ctxt.name <- "buhahahahaa"
}
if(!identical(node.name, "context") | !identical(ctxt.name, "x11")){
stop(simpleError("I don't know what this is, but 'x11.context' is not a context node for x11!"))
} else {
all.children[[length(all.children)+1]] <- x11.context
}
} else {
if(isTRUE(hints)){
context.x11.XML <- XMLNode("!--", rk.XML.context(id="x11"))
all.children[[length(all.children)+1]] <- context.x11.XML
} else {}
}
# import
if(!is.null(import.context)){
# check if this is *really* a context node for import
if(is.XiMpLe.node(import.context)){
node.name <- slot(import.context, "name")
ctxt.name <- slot(import.context, "attributes")$id
} else {
node.name <- ctxt.name <- "buhahahahaa"
}
if(!identical(node.name, "context") | !identical(ctxt.name, "import")){
stop(simpleError("I don't know what this is, but 'import.context' is not a context node for import!"))
} else {
all.children[[length(all.children)+1]] <- import.context
}
} else {
if(isTRUE(hints)){
context.import.XML <- XMLNode("!--", rk.XML.context(id="import"))
all.children[[length(all.children)+1]] <- context.import.XML
} else {}
}
if(identical(id.name, "auto") | is.null(id.name)){
# clean the ID of dots and append "_rkward"
doc.ID.name <- paste0(gsub("[.]*", "", name), "_rkward")
} else {
doc.ID.name <- id.name
}
# check for empty "namespace" value
if(is.null(namespace)){
namespace <- "rkward"
} else {}
# check for valid values of "priority"
if(!priority %in% c("hidden", "low", "medium", "high")){
stop(simpleError("'priority' must be one of 'hidden', 'low', 'medium' or 'high'!"))
} else {}
all.attrs <- list(base_prefix="", namespace=namespace, id=doc.ID.name, po_id=doc.ID.name, priority=priority)
top.doc <- XMLNode("document", attrs=all.attrs, .children=all.children)
pluginmap <- XMLTree(
dtd=list(doctype="rkpluginmap"),
.children=child.list(top.doc)
)
return(pluginmap)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.