[Sciviews-commits] r127 - pkg/svWidgets/R

[noreply at r-forge.r-project.org]

Author: romain
Date: 2009-05-05 09:31:34 +0200 (Tue, 05 May 2009)
New Revision: 127

Modified:
   pkg/svWidgets/R/tkMenu.R
   pkg/svWidgets/R/tkTool.R
Log:
added tool button action and menu action to command history

Modified: pkg/svWidgets/R/tkMenu.R
===================================================================
--- pkg/svWidgets/R/tkMenu.R	2009-04-06 10:59:00 UTC (rev 126)
+++ pkg/svWidgets/R/tkMenu.R	2009-05-05 07:31:34 UTC (rev 127)
@@ -145,7 +145,7 @@
 		# Rework options
 		if (options == "") opts <- "" else opts <- paste(",", options)
 		cmd <- paste('tkadd(M, "command", label = "', lbl,
-			'", command = function() ', action, ', compound = "left"',
+			'", command = function() tkMenuItemCall( { ', action, ' } ) , compound = "left"',
 			Iopt, Aopt, Uopt, opts, ')', sep = "")
 		eval(parse(text = cmd))
 	}
@@ -162,6 +162,14 @@
 	return(invisible(item))
 }
 
+tkMenuItemCall <- function( expr ){
+	if( TRUE ){
+		text <- head(deparse( substitute( expr ) )[-1], -1)
+		.Internal( addhistory( text ) )
+	}
+	eval( expr, envir = parent.frame() )
+}
+
 "tkMenuDelItem" <-
 function (menu, item)
 {

Modified: pkg/svWidgets/R/tkTool.R
===================================================================
--- pkg/svWidgets/R/tkTool.R	2009-04-06 10:59:00 UTC (rev 126)
+++ pkg/svWidgets/R/tkTool.R	2009-05-05 07:31:34 UTC (rev 127)
@@ -100,11 +100,13 @@
 			Img <- ImgGet(image)
 			but <- ttkbutton(Tl, text = item, image = as.character(Img),
 				compound = "image", style = "Toolbutton",
-				command = eval(parse(text = paste("function()",  action))))
+				command = actionWrapper( action ) )
+				# command = eval(parse(text = paste("function()",  action))))
 		} else {
 			but <- ttkbutton(Tl, text = item,
 				compound = "left", style = "Toolbutton",
-				command = eval(parse(text = paste("function()",  action))))
+				command = actionWrapper( action ) ) 
+				# command = eval(parse(text = paste("function()",  action))))
 		}
 		tkgrid(but, row = 0, column = n, sticky = "nsew")
 		### TODO: This needs tcltk2 => how to get rid of this dependency?
@@ -126,6 +128,14 @@
 	return(invisible(itempath))
 }
 
+actionWrapper <- function( action ){
+	function(){
+		.Internal( addhistory( action ) )
+		eval( parse( text = action ) )
+	}
+}
+
+
 "tkToolDelItem" <-
 function (toolbar, item)
 {