hollorol/RBBGCMuso
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tcltk bug fix

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
RBBGCMuso/NAMESPACE
View File

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

23
RBBGCMuso/R/musoExample.R
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 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. #'@param destination The destination where the example files will be copied.
#'@import tcltk
#'@export #'@export
copyMusoExamleTo <- function(example = NULL, destination = NULL){ copyMusoExamleTo <- function(example = NULL, destination = NULL){
WindowsP <- Sys.info()[1] == "Windows" WindowsP <- Sys.info()[1] == "Windows"
chooseExample <- function(){ chooseExample <- function(){
choiceWin <- tktoplevel() tcltk::choiceWin <- tcltk::tktoplevel()
tclRequire("BWidget") tcltk::tclRequire("BWidget")
tktitle(choiceWin) <- "Choose an example!" tcltk::tktitle(choiceWin) <- "Choose an example!"
tcl("wm","geometry",choiceWin,"200x50") tcltk::tcl("wm","geometry",choiceWin,"200x50")
tcl("wm", "attributes", choiceWin, topmost=TRUE) tcltk::tcl("wm", "attributes", choiceWin, topmost=TRUE)
choiceValues <- basename(list.dirs(system.file("examples","",package = "RBBGCMuso"),recursive = FALSE)) choiceValues <- basename(list.dirs(system.file("examples","",package = "RBBGCMuso"),recursive = FALSE))
choices <- tkwidget(choiceWin,"ComboBox", choices <- tcltk::tkwidget(choiceWin,"ComboBox",
editable = FALSE, values = choiceValues, editable = FALSE, values = choiceValues,
textvariable = tclVar(choiceValues[1])) textvariable = tcltk::tclVar(choiceValues[1]))
tcltk::tkpack(choices) tcltk::tkpack(choices)
choiceValue <- NA choiceValue <- NA
closeSelection <- tkwidget(choiceWin,"button",text ="Select", command =function (){ closeSelection <- tcltk::tkwidget(choiceWin,"button",text ="Select", command =function (){
choiceValue <<- tclvalue(tcl(choices,"get")) choiceValue <<- tcltk::tclvalue(tcl(choices,"get"))
tkdestroy(choiceWin) tcltk::tkdestroy(choiceWin)
}) })
tcltk::tkpack(closeSelection) tcltk::tkpack(closeSelection)
while(as.numeric(tclvalue(tcl("winfo","exists",choiceWin)))){ while(as.numeric(tcltk::tclvalue(tcltk::tcl("winfo","exists",choiceWin)))){
} }
return(choiceValue) return(choiceValue)