R devel - Apr 2009 - [macosx] improving quartz & Aqua Tk behaviour outside of RGui

Hello,

On Mac OS X, certain Aqua/Quartz UI functionality requires an
application to be launched from within an app bundle, or
(alternatively) requires a Carbon application with a resource fork.

Playing with the wxWidgets distribution, I discovered that it is quite
easy and transparent to make such a Carbon app from (I guess) any
command line application. When applied to the R executable called from
the command line
(/Library/Frameworks/R.framework/Resources/bin/exec/R), this indeed
improves the behaviour of Quartz graphics windows, and of dialogs made
with TclTk (Aqua version 8.4), which for me now behave like under X11.
(i.e. as if controlled by a separate thread while the prompt remains
usable.)

I've created a small, standalone, shell script that does the necessary
work, based on code and files from the wxWidgets distribution:

mkApp /Library/Frameworks/R.framework/Resources/bin/exec/R

does the trick. The script can be downloaded from

http://rjvbertin.free.fr/Programmes/mkApp.tar.gz

Hope this helps (and isn't too old news...)

R.B.

A couple of weeks ago I posted a trick in R-help on improving Quartz
behaviour in the command line version of R:
http://tolstoy.newcastle.edu.au/R/e6/help/09/04/12948.html .

Works with Aqua Tcl/Tk 8.5 too, but I discovered one annoying
side-effect. After having a Tk dialog open (and using it) for a while,
the R process starts eating more than 50% cpu on my PPC G4, using
either the 8.4 or the 8.5 Tcl/Tk libraries. (I'm currently running R
2.8.1 .)

This does NOT happen when running the exact same code in the same
commandline R version with the 8.4 X11 Tcl/Tk libraries, nor when I
run the Quartz version in R-GUI.

For completeness, here's the Tcl/Tk function:

dialog.test <- function(wait=FALSE)
{
	with3 <- function( data1, data2=.GlobalEnv, expr )
	{
		attach(data1)
		attach(data2)
		on.exit( detach(data1), add= FALSE )
		on.exit( detach(data2), add= TRUE )
	
		try( eval( substitute(expr), parent.frame() ) )
	}

	require(tcltk) || stop("tcltk support is absent")

	tt <- tktoplevel()
	tkwm.title(tt,"VG1 tests")
	tt.done <- tclVar("0")

	name <- paste('dialog.test',as.character(tt$ID), sep='')
	assign( name, tt, env=tdialog.env )

	dialogVals<-get("dialogVals", env=RJVB.env)
	data<-tclVar(dialogVals[1])
	crit<-tclVar(dialogVals[2])
	eval1st<-tclVar(dialogVals[9])
	func<-tclVar(dialogVals[3])
	args<-tclVar(dialogVals[4])
	args2<-tclVar(dialogVals[5])
	acomm<-tclVar(dialogVals[8])
	sumvar <- tclVar(dialogVals[7])
	done <- tclVar(0)
	savecmd<-tclVar(dialogVals[6]);
	devvar <- tclVar( dev.cur() )
	theData <- ""

	reset <- function()
	{
		tclvalue(data)<-""
		tclvalue(crit)<-""
		tclvalue(eval1st)<-""
		tclvalue(func)<-""
		tclvalue(args)<-""
		tclvalue(args2)<-""
		tclvalue(acomm)<-""
		tclvalue(sumvar)<-"0"
	}

	doSource <- function()
	{
		fileN <- tclvalue( tkgetOpenFile() )
		if( fileN != "" ){
			try( source(fileN) )
		}
	}

	dfInfo <- function(fnc)
	{
	## notice that tclvalue() is correct here, since it is the
	## string representation of xvar and yvar that is being
	## displayed in the entry fields

		dataf  <- tclvalue(data)
		crit  <- tclvalue(crit)
		eval1st  <- tclvalue(eval1st)

		if( is.null(crit) | !strlen(crit) ){
			theData <- paste( dataf )
			assign( "Selected.Cases", "", env=RJVB.env )
		}
		else{
			theData <- paste( "SelectCases(", dataf, ",\"",
crit, "\")" )
		}
		cmd<-paste( fnc, "( ", theData, " )" )
		try(
			cmd<-parse( text=cmd )
		);
		print( paste( "###", cmd ) )
		print( try( eval(cmd, envir=.GlobalEnv) ) )
		cmd
	}

	build <- function()
	{
	## notice that tclvalue() is correct here, since it is the
	## string representation of xvar and yvar that is being
	## displayed in the entry fields

		dataf  <- tclvalue(data)
		crit  <- tclvalue(crit)
		eval1st  <- tclvalue(eval1st)
		func  <- tclvalue(func)
		args  <- tclvalue(args)
		args2  <- tclvalue(args2)
		acomm  <- tclvalue(acomm)
		summ <- as.logical(tclObj(sumvar))

		assign( "dialogVals",
c(dataf,crit,func,args,args2,dialogVals[6],tclvalue(sumvar), acomm,
eval1st ), env=RJVB.env )

		if( is.null(crit) | !strlen(crit) ){
			theData <- paste( dataf )
			assign( "Selected.Cases", "", env=RJVB.env )
		}
		else{
			theData <- paste( "SelectCases(", dataf, ",\"",
crit, "\")" )
		}
		if( is.null(acomm) | is.na(acomm) | !strlen(acomm) ){
			acomm <- ""
		}
		else{
			acomm <- paste( ", add.comment=\"", acomm,
"\"" )
		}
		if( summ ){
			cmd<-paste( "with3( ", theData, ", tkdial.env, summary(
last.dialog.result<-", func, "(", args, ",", args2,
acomm, ") ) )" )
# 			cmd<-paste( "with2( ", theData, ", summary(
last.dialog.result<-", func, "(", args, ",", args2,
acomm, ") ) )" )
		}
		else{
			cmd<-paste( "with3( ", theData, ", tkdial.env,
last.dialog.result<-", func, "(", args, ",", args2,
acomm, ") )" )
# 			cmd<-paste( "with2( ", theData, ",
last.dialog.result<-", func,
"(", args, ",", args2, acomm, ") )" )
		}
		assign( "Selected.Data", theData, env=RJVB.env )
		try(
			cmd<-parse( text=cmd )
		);
		cmd
	}

	saveIt <- function()
	{
		cmd<-savecmd  <- tclvalue(savecmd)

		assign( "dialogVals",
c(dialogVals[1],dialogVals[2],dialogVals[3],dialogVals[4],dialogVals[5],cmd,dialogVals[7],
dialogVals[9]), env=RJVB.env )
		try(
			cmd<-parse( text=savecmd )
		);
		cmd
	}

	doIt <- function(cmd="")
	{
		orgDev <- dev.cur()
		try( dev.set( tclvalue(devvar) ) )
		func  <- tclvalue(func)
		eval1st  <- tclvalue(eval1st)

		eval( parse( text="tkdial.env <- new.env()"), env=.GlobalEnv )

		if( !is.null(eval1st) & strlen(eval1st) ){
			try(
				eval1st <- parse( text=eval1st )
			);
			cat(deparse(eval1st,width=500),sep="\n")
			print(
				try( eval(eval1st, env=tkdial.env) )
			);
			ls( env=tkdial.env )
		}

		cat("### Command executed via Tk ###\n")
		cat(deparse(cmd,width=500),sep="\n")
		cat("### Output:\n")
		dialogVals<-get("dialogVals", env=RJVB.env)
		print( system.time( print( try( res<-eval(cmd, envir=.GlobalEnv) ) ) ) )
		if( func == 'aov' | func == 'aov.VG1' ){
			cat('\n')
			try( print( TukeyHSD(res, ordered=TRUE) ), silent=TRUE)
		}
		cat( paste( "### ----------- (", deparse(tclvalue(data),width=132),
") ----------- ###\n", sep="" ) )

		try( dev.set(orgDev) )

		eval( parse( text="rm(tkdial.env)" ), env=.GlobalEnv )
	}

	doQuit <- function()
	{
		dQ <- function()
		{
			tclvalue(done)<-"cancel"
			tkdestroy(tt)
			tt.done<-"1"
		}

		 # if the window is referenced in the windowlist environment, remove
the reference and then close
		if( exists(name, env=tdialog.env) ){
			w <- get(name, env=tdialog.env)
			if( !is.null(w) && class(w) == "tkwin" ){
				try( assign( name, NULL, env=tdialog.env ) )
				try( rm( list=name, envir=tdialog.env ) )
				dQ()
			}
		}
		else{
		 # if not, close too. Probably means that dQ() can sstill be called
recursively...
			dQ()
		}
		return(0)
	}

	data.entry <- tkentry(tt, textvariable=data, width=100)
	crit.entry <- tkentry(tt, textvariable=crit, width=100)
	eval1st.entry <- tkentry(tt, textvariable=eval1st, width=100)
	func.entry <- tkentry(tt, textvariable=func, width=100)
	args.entry <- tkentry(tt, textvariable=args, width=100)
	args2.entry <- tkentry(tt, textvariable=args2, width=100)
	acomm.entry <- tkentry(tt, textvariable=acomm, width=100)
	dev.entry <- tkentry(tt, textvariable=devvar, width=2)

	summ.cbut <- tkcheckbutton(tt,text="Print summary()",
variable=sumvar)

	submit.but <- tkbutton(tt, text="submit",
				 command=function()doIt(build()) )

	savecmd.entry <- tkentry(tt, textvariable=savecmd, width=100)
	save.but <- tkbutton(tt, text="save",
				command=function()doIt(saveIt()) )

	reset.but <- tkbutton(tt, text="Reset", command=reset)
	source.but <- tkbutton(tt, text="Source",
command=function()doSource() )
	cancel.but <- tkbutton(tt, text="Cancel", command=doQuit )
	
	names.but <- tkbutton(tt, text="names",
command=function()dfInfo("names") )
	summary.but <- tkbutton(tt, text="summary",
command=function()dfInfo("summary") )

	tkgrid(tklabel(tt,text="Dataframe"), data.entry, names.but,
columnspan=3 )
	tkgrid(tklabel(tt,text="Sel.Crit"), crit.entry, summary.but,
columnspan=3 )
	tkgrid(tklabel(tt,text="Eval.1st"), eval1st.entry, columnspan=3 )
	tkgrid(tklabel(tt,text="Analysis"), func.entry, columnspan=3 )
	tkgrid(tklabel(tt,text="Variables"), args.entry, columnspan=3 )
	tkgrid(tklabel(tt,text="Options"), args2.entry, columnspan=3 )
	tkgrid(tklabel(tt,text="Comment"), acomm.entry, columnspan=3 )
	tkgrid(summ.cbut, tklabel(tt,text="Device"), dev.entry,
sticky="e" ,
columnspan=3 )
	tkgrid(tklabel(tt,text="Save cmd"), savecmd.entry, columnspan=3 )
	tkgrid(submit.but, save.but, reset.but, source.but, cancel.but,
columnspan=2, sticky="w")

## capture destroy (e.g. from window controls
## otherwise the tkwait hangs with nowhere to go)
#	tkbind(tt, "<Destroy>",
function()tclvalue(done)<-"quit")
	tkbind(tt, "<Destroy>", function()doQuit())
	tkbind(tt, "<Return>", function()doIt(build()) )
	tkbind(tt, "<Control-s>", function()doIt(saveIt()) )
	tkbind(tt, "<Control-S>", function()doSource() )

	.Tcl("update idletasks")

	if( wait ){
		while( tclvalue(done) != "cancel" ){
			tkwait.variable(done)
			doQuit()
		}
	}
# 	else{
# 		return(tt)
# 	}

## not necessary: button handlers do all the work, until tkdestroy().
# 	tkwait.variable(done)
#
# 	while( tclvalue(done)!= "cancel" ){
# 		if(tclvalue(done)=="quit") stop("aborted")
#
# 		if( tclvalue(done)=="save"){
# 			cmd <- saveIt()
# 		}
# 		else{
# 			cmd <- build()
# 		}
# 		cat("### Command executed via Tk ###\n")
# 		cat(deparse(cmd,width=132),sep="\n")
# 		cat("### Output:\n")
# 		dialogVals<-get("dialogVals", env=RJVB.env)
# 		print( try( eval.parent(cmd) ) )
# 		cat("### ----------------------- ###\n")
#
# 		tkwait.variable(done)
# 	}

# 	return(NULL)

}

On 2009-04-28, Ren? J.V. Bertin <rjvbertin at gmail.com> wrote:
>  mkApp /Library/Frameworks/R.framework/Resources/bin/exec/R
<snip>
>  improves the behaviour of Quartz graphics windows, and of dialogs made
>  with TclTk (Aqua version 8.4), which for me now behave like under X11.
>  (i.e. as if controlled by a separate thread while the prompt remains
>  usable.)