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

m-eik at users.sourceforge.net m-eik at users.sourceforge.net
Thu Mar 15 11:37:15 UTC 2012


Revision: 4179
          http://rkward.svn.sourceforge.net/rkward/?rev=4179&view=rev
Author:   m-eik
Date:     2012-03-15 11:37:14 +0000 (Thu, 15 Mar 2012)
Log Message:
-----------
added .onAttach() check and moved some override functions from internal.R to new source file base_overrides.R

Modified Paths:
--------------
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_debugger.R
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.utility-functions.R

Added Paths:
-----------
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/base_overrides.R

Added: trunk/rkward/rkward/rbackend/rpackages/rkward/R/base_overrides.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/base_overrides.R	                        (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/base_overrides.R	2012-03-15 11:37:14 UTC (rev 4179)
@@ -0,0 +1,73 @@
+
+# override makeActiveBinding: If active bindings are created in globalenv (), watch them properly
+.rk.makeActiveBinding.default <- base::makeActiveBinding
+#' @export
+"makeActiveBinding" <- function (sym, fun, env, ...) {
+	if (identical (env, globalenv ())) {
+		.rk.makeActiveBinding.default (sym, fun, .rk.watched.symbols, ...)
+		f <- .rk.make.watch.f (sym)
+		.rk.makeActiveBinding.default (sym, f, globalenv (), ...)
+	} else {
+		.rk.makeActiveBinding.default (sym, fun, env, ...)
+	}
+}
+
+
+#' @export
+"require" <- function (package, quietly = FALSE, character.only = FALSE, ...)
+{
+	if (!character.only) {
+		package <- as.character(substitute(package))
+	}
+	if (!base::require(as.character(package), quietly = quietly, character.only = TRUE, ...)) {
+		.rk.do.call("require", as.character(package))
+		invisible(base::require(as.character(package), quietly = TRUE, character.only = TRUE, ...))
+	} else {
+		invisible(TRUE)
+	}
+}
+
+
+# overriding q, to ask via GUI instead. Arguments are not interpreted.
+#' @export
+"q" <- function (save = "default", status = 0, runLast = TRUE, ...) {
+	# test if this is running in RKWard, otherwise pass through to the actual q()
+	if (isTRUE(.rk.inside.rkward.session())){
+		res <- .rk.do.plain.call ("quit")
+		if (length (res) && (res == "FALSE")) stop ("Quitting was cancelled")
+	} else {
+		base:::q(save = save, status = status, runLast = runLast)
+	}
+}
+
+
+#' @export
+"quit" <- function (save = "default", status = 0, runLast = TRUE, ...) {
+	q (save, status, runLast, ...)
+}
+
+
+#' @export
+"Sys.setlocale" <- function (category = "LC_ALL", locale = "", ...) {
+	if (category == "LC_ALL" || category == "LC_CTYPE" || category == "LANG") {
+		allow <- .rk.do.plain.call ("preLocaleChange", NULL)
+		if (length (allow) && (allow == "FALSE")) stop ("Changing the locale was cancelled by user")
+
+		ret <- base::Sys.setlocale (category, locale, ...)
+
+		.Call ("rk.update.locale")
+		ret
+	} else {
+		base::Sys.setlocale (category, locale, ...)
+	}
+}
+
+
+#' @export
+"setwd" <- function () {
+	ret <- eval (body (base::setwd))
+	.rk.do.plain.call ("wdChange", base::getwd (), synchronous=FALSE)
+	invisible (ret)
+}
+formals (setwd) <- formals (base::setwd)
+

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R	2012-03-14 23:11:26 UTC (rev 4178)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R	2012-03-15 11:37:14 UTC (rev 4179)
@@ -1,3 +1,18 @@
+# check the context in which this package is loaded
+.onAttach <- function(...) {
+	.rk.inside.rkward.session(warn = TRUE)
+}
+
+# this function shall test if the rkward package was loaded in a running RKWard session
+.rk.inside.rkward.session <- function(warn = FALSE){
+	inside.rkward <- is.loaded("rk.do.generic.request")
+	if(isTRUE(warn) & !isTRUE(inside.rkward)){
+		warning("You've loaded the package 'rkward', but RKWard doesn't appear to be running. If this causes trouble, try detach(\"package:rkward\").",
+		call. = FALSE)
+	}
+	return(inside.rkward)
+}
+
 ".rk.get.meta" <- function (x) {
 	y <- attr (x, ".rk.meta");
 	c (names (y), as.character (y))
@@ -152,44 +167,6 @@
 	return (x)
 }
 
-"require" <- function (package, quietly = FALSE, character.only = FALSE, ...)
-{
-	if (!character.only) {
-		package <- as.character(substitute(package))
-	}
-	if (!base::require(as.character(package), quietly = quietly, character.only = TRUE, ...)) {
-		.rk.do.call("require", as.character(package))
-		invisible(base::require(as.character(package), quietly = TRUE, character.only = TRUE, ...))
-	} else {
-		invisible(TRUE)
-	}
-}
-
-# this function shall test if the rkward package was loaded in a running RKWard session
-.rk.inside.rkward.session <- function(warn = FALSE){
-	inside.rkward <- is.loaded("rk.do.generic.request")
-	if(isTRUE(warn) & !isTRUE(inside.rkward)){
-		warning("You've loaded the package 'rkward', but RKWard doesn't appear to be running. If this causes trouble, try detach(\"package:rkward\").",
-		call. = FALSE)
-	}
-	return(inside.rkward)
-}
-
-# overriding q, to ask via GUI instead. Arguments are not interpreted.
-"q" <- function (save = "default", status = 0, runLast = TRUE, ...) {
-	# test if this is running in RKWard, otherwise pass through to the actual q()
-	if (isTRUE(.rk.inside.rkward.session())){
-		res <- .rk.do.plain.call ("quit")
-		if (length (res) && (res == "FALSE")) stop ("Quitting was cancelled")
-	} else {
-		base:::q(save = save, status = status, runLast = runLast)
-	}
-}
-
-"quit" <- function (save = "default", status = 0, runLast = TRUE, ...) {
-	q (save, status, runLast, ...)
-}
-
 #".rk.init.handlers" <- function () {
 #	options (warning.expression = expression ())
 #	.Internal (.addCondHands (c ("message", "warning", "error"), list (function (m) { .Call ("rk.do.condition", c ("m", conditionMessage (m))) }, function (w) { .Call ("rk.do.condition", c ("w", conditionMessage (w))) }, function (e) { .Call ("rk.do.condition", c ("e", conditionMessage (e))) }), globalenv (), NULL, TRUE))
@@ -198,18 +175,6 @@
 # these functions can be used to track assignments to R objects. The main interfaces are .rk.watch.symbol (k) and .rk.unwatch.symbol (k). This works by copying the symbol to a backup environment, removing it, and replacing it by an active binding to the backup location
 ".rk.watched.symbols" <- new.env ()
 
-# override makeActiveBinding: If active bindings are created in globalenv (), watch them properly
-.rk.makeActiveBinding.default <- base::makeActiveBinding
-"makeActiveBinding" <- function (sym, fun, env, ...) {
-	if (identical (env, globalenv ())) {
-		.rk.makeActiveBinding.default (sym, fun, .rk.watched.symbols, ...)
-		f <- .rk.make.watch.f (sym)
-		.rk.makeActiveBinding.default (sym, f, globalenv (), ...)
-	} else {
-		.rk.makeActiveBinding.default (sym, fun, env, ...)
-	}
-}
-
 ".rk.make.watch.f" <- function (k) {
 	# we need to make sure, the functions we use are *not* looked up as symbols in .GlobalEnv.
 	# else, for instance, if the user names a symbol "missing", and we try to resolve it in the
@@ -345,27 +310,6 @@
 	ret
 }
 
-"Sys.setlocale" <- function (category = "LC_ALL", locale = "", ...) {
-	if (category == "LC_ALL" || category == "LC_CTYPE" || category == "LANG") {
-		allow <- .rk.do.plain.call ("preLocaleChange", NULL)
-		if (length (allow) && (allow == "FALSE")) stop ("Changing the locale was cancelled by user")
-
-		ret <- base::Sys.setlocale (category, locale, ...)
-
-		.Call ("rk.update.locale")
-		ret
-	} else {
-		base::Sys.setlocale (category, locale, ...)
-	}
-}
-
-"setwd" <- function () {
-	ret <- eval (body (base::setwd))
-	.rk.do.plain.call ("wdChange", base::getwd (), synchronous=FALSE)
-	invisible (ret)
-}
-formals (setwd) <- formals (base::setwd)
-
 # hidden, as this is not portable to different output formats
 ".rk.cat.output" <- function (x) {
 	cat (x, file = rk.get.output.html.file(), append = TRUE)
@@ -379,24 +323,6 @@
 	.rk.cat.output ("<hr>\n");
 }
 
-# Start recording commands that are submitted from rkward to R.
-# filename: filename to write to (file will be truncated!).
-# include.all: By default, some types of command are filtered (internal synchronisation commands, and run again links). Should these be included?
-# To stop recording, supply NULL or "" as filename
-# Currently used for the purpose of automated testing, only. Perhaps in the future
-# this or a similar mechanism could also be added as a user feature.
-"rk.record.commands" <- function (filename, include.all = FALSE) {
-	if (is.null (filename)) filename = ""
-
-	res <- .rk.do.plain.call ("recordCommands", c(as.character (filename), if (include.all) "include.all" else "normal"))
-
-	if (!length (res)) invisible (TRUE)
-	else {
-		warning (res)
-		invisible (FALSE)
-	}
-}
-
 # General purpose storage environment (which will hopefully never get locked by R)
 ".rk.variables" <- new.env ()
 .rk.variables$.rk.active.device <- 1

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_debugger.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_debugger.R	2012-03-14 23:11:26 UTC (rev 4178)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal_debugger.R	2012-03-15 11:37:14 UTC (rev 4179)
@@ -22,6 +22,7 @@
 
 # get relative source location
 # NOTE: this requires R >= 2.13.0
+#' @export
 rk.relative.src.line <- function (inner, outer) {
 	if (!inherits (inner, "srcref")) inner <- getSrcref (inner)
 	if (!inherits (outer, "srcref")) outer <- getSrcref (outer)

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.utility-functions.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.utility-functions.R	2012-03-14 23:11:26 UTC (rev 4178)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.utility-functions.R	2012-03-15 11:37:14 UTC (rev 4179)
@@ -38,6 +38,7 @@
 #' 
 # renames a named object in a data.frame/list without changing it's position
 # TODO: create a generic function instead, that can handle all kinds of renames
+#' @export
 "rk.rename.in.container" <- function (x, old_name, new_name, envir=parent.frame()) {
 	temp <- (names (x) == old_name)
 	i = 1;
@@ -51,6 +52,7 @@
 	error ("Could not find column with given name")
 }
 
+#' @export
 "rk.make.repos.string" <- function () {
 	x <- getOption ("repos")
 	len <- length (x)
@@ -73,6 +75,7 @@
 }
 
 # a wrapper around chooseCRANmirror() without changing options ("repos"), permanently
+#' @export
 "rk.select.CRAN.mirror" <- function () {
 	old_repos <- getOption("repos")
 	on.exit (options (repos=old_repos))
@@ -110,6 +113,7 @@
 #' ## NOT RUN
 #' rk.old.packages()
 #' 
+#' @export
 "rk.old.packages" <- function (lib.loc = NULL, repos = getOption("repos"), contriburl = contrib.url(repos, type), instPkgs = installed.packages(lib.loc = lib.loc),
                              method, available = NULL, checkBuilt = FALSE, type = getOption("pkgType")) {
 	if (is.null (lib.loc)) lib.loc <- .libPaths ()
@@ -129,3 +133,23 @@
 	}
 	old
 }
+
+
+# Start recording commands that are submitted from rkward to R.
+# filename: filename to write to (file will be truncated!).
+# include.all: By default, some types of command are filtered (internal synchronisation commands, and run again links). Should these be included?
+# To stop recording, supply NULL or "" as filename
+# Currently used for the purpose of automated testing, only. Perhaps in the future
+# this or a similar mechanism could also be added as a user feature.
+#' @export
+"rk.record.commands" <- function (filename, include.all = FALSE) {
+	if (is.null (filename)) filename = ""
+
+	res <- .rk.do.plain.call ("recordCommands", c(as.character (filename), if (include.all) "include.all" else "normal"))
+
+	if (!length (res)) invisible (TRUE)
+	else {
+		warning (res)
+		invisible (FALSE)
+	}
+}

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





More information about the rkward-tracker mailing list