tcltk bug fix

This commit is contained in:
Roland Hollós 2019-01-15 20:43:26 +01:00
parent daad2a0e6c
commit 50dfa2ab78
2 changed files with 11 additions and 13 deletions

View File

@ -26,7 +26,6 @@ export(spinupMuso)
export(supportedMuso)
export(updateMusoMapping)
import(ggplot2)
import(tcltk)
import(utils)
importFrom(Rcpp,evalCpp)
importFrom(digest,digest)

View File

@ -4,31 +4,30 @@
#'
#'@param example The name of the example file, if it is NULL tcl/tk menu will pop up to select.
#'@param destination The destination where the example files will be copied.
#'@import tcltk
#'@export
copyMusoExamleTo <- function(example = NULL, destination = NULL){
WindowsP <- Sys.info()[1] == "Windows"
chooseExample <- function(){
choiceWin <- tktoplevel()
tclRequire("BWidget")
tktitle(choiceWin) <- "Choose an example!"
tcl("wm","geometry",choiceWin,"200x50")
tcl("wm", "attributes", choiceWin, topmost=TRUE)
tcltk::choiceWin <- tcltk::tktoplevel()
tcltk::tclRequire("BWidget")
tcltk::tktitle(choiceWin) <- "Choose an example!"
tcltk::tcl("wm","geometry",choiceWin,"200x50")
tcltk::tcl("wm", "attributes", choiceWin, topmost=TRUE)
choiceValues <- basename(list.dirs(system.file("examples","",package = "RBBGCMuso"),recursive = FALSE))
choices <- tkwidget(choiceWin,"ComboBox",
choices <- tcltk::tkwidget(choiceWin,"ComboBox",
editable = FALSE, values = choiceValues,
textvariable = tclVar(choiceValues[1]))
textvariable = tcltk::tclVar(choiceValues[1]))
tcltk::tkpack(choices)
choiceValue <- NA
closeSelection <- tkwidget(choiceWin,"button",text ="Select", command =function (){
choiceValue <<- tclvalue(tcl(choices,"get"))
tkdestroy(choiceWin)
closeSelection <- tcltk::tkwidget(choiceWin,"button",text ="Select", command =function (){
choiceValue <<- tcltk::tclvalue(tcl(choices,"get"))
tcltk::tkdestroy(choiceWin)
})
tcltk::tkpack(closeSelection)
while(as.numeric(tclvalue(tcl("winfo","exists",choiceWin)))){
while(as.numeric(tcltk::tclvalue(tcltk::tcl("winfo","exists",choiceWin)))){
}
return(choiceValue)