[R-gui] tk2menubutton command

[Philippe Grosjean]

Hello,

This is not so easy (but still feasible), because you want to change the 
default behaviour of the MenuButton, which is to always show the menu 
wherever you click. Here is one solution. A better one would be to 
define a completely new class!
Best,

Philippe Grosjean

P.S.: in your example, use short English names for your variables: it 
helps concentrate on the problem for non-Spanish speaking people. By the 
way, do the same for code you want to release publicly!



require(tcltk2)

# Create a new window
winTk <- tktoplevel()
tktitle(winTk) <- "tk2menubutton"

# Define the menubutton and its associated menu
mbVar <-  tclVar('Black')
mbBut <- tk2menubutton(winTk, textvariable = mbVar, width = 6)
# The following is required to display plain Tk MenuButtons correctly
# when tile is not available or not used
if (as.character(.Tcl(paste("winfo class", mbBut$ID))) == "Menubutton")
     tkconfigure(mbBut, indicatoron = 1)
mnButMenu <- tk2menu(mbBut, tearoff = FALSE)
# Usually, selecting an entry in the menu of a menubutton also issues
# the corresponding command (not the case is your code)
tkadd(mnButMenu, 'command' , label = 'White',
     command = function() { tclvalue(mbVar) <<- 'White'; mbButFun() })
tkadd(mnButMenu, 'command' , label = 'Black',
     command = function() { tclvalue(mbVar) <<- 'Black'; mbButFun() })
tkconfigure(mbBut, menu = mnButMenu)
tkpack(mbBut)

# Redefine binding of mouse-1 click for this menubutton
mbButClick <- function(x) {
     wx <- as.numeric(.Tcl(paste("winfo rootx", mbBut$ID)))
     wy <- as.numeric(.Tcl(paste("winfo rooty", mbBut$ID)))
     width <- as.numeric(.Tcl(paste("winfo width", mbBut$ID)))
     height <- as.numeric(.Tcl(paste("winfo height", mbBut$ID)))
     # Determine if we click the arrow or the button
     # 17 is only a guess for arrow width (good compromize for
     # Menubutton and TMenubutton on most platforms!
     isarrow <- ((width - as.numeric(x)) <= 17)
     if (isarrow) {	# Show the menu
         tkpost(mnButMenu, wx, wy + height)	
     } else {		# Execute mbButFun()
         mbButFun()
     }
}
# tkbind(mbBut, "<1>", mbButClick) cannot be used because it does not
# cancel the event associated with the menubutton class
# One must specify 'break' in the event binding to prevent this
.Tcl(paste("bind ", mbBut$ID, " <1> {", .Tcl.callback(mbButClick),
     "; break}", sep = ""))

# Action for the menubutton (just a toy example)!
mbButFun <- function(){
     if (as.character(tclvalue(mbVar)) == 'White') {
         cat("You selected 'White'!\n")
     } else {
         cat("You selected 'Black'!\n")
     }
}

# A button to close the window
tkpack(tk2button(winTk, text = "Exit",
     command = function() tkdestroy(winTk)))


eduardo san miguel wrote:
> Hello all,
> 
> I´d like a tk2menubutton to display a menu when clicking the 'arrow' and to
> trigger a function when clicking the text.
> 
> I have the following:
> 
> require(tcltk2)
> widgetPrincipal <- tktoplevel()
> tipo.busqueda.valores <-  tclVar('Single-Query')
> tipo.busqueda.boton <- tk2menubutton(widgetPrincipal, textvariable =
> tipo.busqueda.valores,
>       width = 15 )
> tipo.busqueda.menu <- tk2menu(tipo.busqueda.boton, tearoff = FALSE)
> tkadd( tipo.busqueda.menu, 'command' , label = 'Tesauro',
>  command = function() {tclvalue(tipo.busqueda.valores )<<- 'Tesauro'})
> tkadd( tipo.busqueda.menu, 'command' , label = 'Single-Query',
>  command = function() {tclvalue(tipo.busqueda.valores )<<- 'Single-Query'})
> tkconfigure(tipo.busqueda.boton, menu = tipo.busqueda.menu)
> tkpack(tipo.busqueda.boton)
> 
> # this being the function I would like to trigger
> 
> tipo.busqueda.accion = function(){
>  if (as.character(tclvalue(tipo.busqueda.valores)) == 'Tesauro') {
>   # do A
>  }else{
>   # do B
>  }
> }
> 
> Any tips.
> 
> Thanks
> 
> 	[[alternative HTML version deleted]]
> 
> 
> 
> ------------------------------------------------------------------------
> 
> _______________________________________________
> R-SIG-GUI mailing list
> R-SIG-GUI at stat.math.ethz.ch
> https://stat.ethz.ch/mailman/listinfo/r-sig-gui