[rkward-cvs] SF.net SVN: rkward:[4182] trunk/rkward

[tfry at users.sourceforge.net]

Revision: 4182
          http://rkward.svn.sourceforge.net/rkward/?rev=4182&view=rev
Author:   tfry
Date:     2012-03-15 16:12:53 +0000 (Thu, 15 Mar 2012)
Log Message:
-----------
Work around annoying new restrictions in utils::assignInNamespace()

Modified Paths:
--------------
    trunk/rkward/ChangeLog
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.replace.function.R

Modified: trunk/rkward/ChangeLog
===================================================================
--- trunk/rkward/ChangeLog	2012-03-15 12:04:33 UTC (rev 4181)
+++ trunk/rkward/ChangeLog	2012-03-15 16:12:53 UTC (rev 4182)
@@ -1,3 +1,4 @@
+- Fixed: Plot history and graphical menus broken in some cases with R 2.15.0		TODO: backport? (r4182)
 - Fixed: If the rkward package was loaded in a plain R session, q() and quit() still work
 - combined all Wilcoxon/Mann-Whitney-tests in one plugin (from previously two separate plugins)			TODO: adjust test(s)
 - Added polyserial/polychoric correlations to correlation matrix plugin			TODO: adjust test(s)

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.replace.function.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.replace.function.R	2012-03-15 12:04:33 UTC (rev 4181)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/rk.replace.function.R	2012-03-15 16:12:53 UTC (rev 4182)
@@ -7,8 +7,9 @@
 #' 
 #' The original function is assigned to the environment
 #' \code{rkward::.rk.backups} with the same name as the original, and can be
-#' referred to from the replacement. WARNING: This mechansim does not support
-#' several subsequent replacments of the same function.
+#' referred to from the replacement. WARNING: This mechanism does not support
+#' several subsequent replacments of the same function, nor does it support
+#' replacement of generics.
 #' 
 #' WARNING: This function can be used to alter - and disrupt - internal
 #' functions in arbitrary ways. You better know what you are doing.
@@ -42,6 +43,30 @@
 # Function formals are copied from the original.
 # A backup of the original is stored as rkward::.rk.backups$FUNCTIONNAME
 "rk.replace.function" <- function (functionname, environment, replacement, copy.formals=TRUE) {
+	# This is a stripped down copy of utils::assignInNamespace, without the restrictions
+	# added which would prevent us from properly replacing e.g. utils::menu,
+	# but also without some of the fine points for replacing while loading a namespace,
+	# and for handling S3 methods.
+	doAssignInNamespace <- function(x, value, ns, pos = -1, envir = as.environment(pos))
+	{
+		if (missing(ns)) {
+			nm <- attr(envir, "name", exact = TRUE)
+			if(is.null(nm) || substring(nm, 1L, 8L) != "package:")
+			    stop("environment specified is not a package")
+			ns <- asNamespace(substring(nm, 9L))
+		} else ns <- asNamespace(ns)
+		if (bindingIsLocked(x, ns)) {
+			unlockBinding(x, ns)
+			assign(x, value, envir = ns, inherits = FALSE)
+			w <- options("warn")
+			on.exit(options(w))
+			options(warn = -1)
+			lockBinding(x, ns)
+		} else {
+			assign(x, value, envir = ns, inherits = FALSE)
+		}
+	}
+
 	original <- get (functionname, envir=environment, inherits=FALSE)
 
 	# create a backup
@@ -57,9 +82,9 @@
 	)
 	try (
 		if (isNamespace (environment)) {
-			assignInNamespace (functionname, replacement, ns=environment)
+			doAssignInNamespace (functionname, replacement, ns=environment)
 		} else {
-			assignInNamespace (functionname, replacement, envir=environment)
+			doAssignInNamespace (functionname, replacement, envir=environment)
 		}
 	)
 	try (

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