[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