[Sciviews-commits] r432 - in pkg: svDialogs svDialogs/R svDialogs/man svDialogstcltk svDialogstcltk/R svDialogstcltk/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Feb 11 15:34:34 CET 2012
Author: phgrosjean
Date: 2012-02-11 15:34:33 +0100 (Sat, 11 Feb 2012)
New Revision: 432
Added:
pkg/svDialogs/R/dlgSave.R
pkg/svDialogs/man/dlgSave.Rd
pkg/svDialogstcltk/R/dlgDir.tcltkGUI.R
pkg/svDialogstcltk/R/dlgInput.tcltkGUI.R
pkg/svDialogstcltk/R/dlgList.tcltkGUI.R
pkg/svDialogstcltk/R/dlgMessage.tcltkGUI.R
pkg/svDialogstcltk/R/dlgOpen.tcltkGUI.R
pkg/svDialogstcltk/R/dlgSave.tcltkGUI.R
pkg/svDialogstcltk/R/svDialogstcltk-Internal.R
Removed:
pkg/svDialogstcltk/R/dlgDir.tcltkWidgets.R
pkg/svDialogstcltk/R/dlgInput.tcltkWidgets.R
pkg/svDialogstcltk/R/dlgList.tcltkWidgets.R
pkg/svDialogstcltk/R/dlgMessage.tcltkWidgets.R
pkg/svDialogstcltk/R/dlgOpen.tcltkWidgets.R
pkg/svDialogstcltk/R/svDialogs.tcltk-Internal.R
Modified:
pkg/svDialogs/NAMESPACE
pkg/svDialogs/R/dlgDir.R
pkg/svDialogs/R/dlgInput.R
pkg/svDialogs/R/dlgList.R
pkg/svDialogs/R/dlgMessage.R
pkg/svDialogs/R/dlgOpen.R
pkg/svDialogs/R/guiDlg.R
pkg/svDialogs/TODO
pkg/svDialogstcltk/NAMESPACE
pkg/svDialogstcltk/NEWS
pkg/svDialogstcltk/man/svDialogstcltk-package.Rd
Log:
dlgSave() + bugs corrections in svDialogs and svDialogstcltk
Modified: pkg/svDialogs/NAMESPACE
===================================================================
--- pkg/svDialogs/NAMESPACE 2012-02-11 08:15:41 UTC (rev 431)
+++ pkg/svDialogs/NAMESPACE 2012-02-11 14:34:33 UTC (rev 432)
@@ -6,7 +6,8 @@
dlgList,
dlgMessage,
dlgOpen,
- #dlgSave,
+ dlgSave,
+ dlgFilters,
msgBox,
okCancelBox,
menuAdd,
@@ -15,8 +16,7 @@
menuDelItem,
menuNames,
menuItems,
- .Last.lib,
- # To be reworked
+ ".Last.lib",
display,
guiDlg,
guiDlgFunction,
@@ -24,7 +24,7 @@
guiPane.tcltk,
guiPane.entry.tcltk,
guiPane.list.tcltk,
- guiSetStyle.tcltk,)
+ guiSetStyle.tcltk)
# To be eliminated
S3method(display, guiDlg)
@@ -49,6 +49,6 @@
S3method(dlgOpen, textCLI)
S3method(dlgOpen, nativeGUI)
-#S3method(dlgSave, gui)
-#S3method(dlgSave, textCLI)
-#S3method(dlgSave, nativeGUI)
+S3method(dlgSave, gui)
+S3method(dlgSave, textCLI)
+S3method(dlgSave, nativeGUI)
Modified: pkg/svDialogs/R/dlgDir.R
===================================================================
--- pkg/svDialogs/R/dlgDir.R 2012-02-11 08:15:41 UTC (rev 431)
+++ pkg/svDialogs/R/dlgDir.R 2012-02-11 14:34:33 UTC (rev 432)
@@ -1,26 +1,26 @@
## Define the S3 method
-dlgDir <- function (default = getwd(), title, ..., gui = .GUI) {
+dlgDir <- function (default = getwd(), title, ..., gui = .GUI)
+{
if (!gui$startUI("dlgDir", call = match.call(), default = default,
msg = "Displaying a modal dir selection dialog box",
msg.no.ask = "A modal dir selection dialog box was by-passed"))
return(invisible(gui))
## Check and rework main arguments and place them in gui$args
- if (!is.null(default) && !inherits(default, "character") &&
- length(default) != 1)
- stop("'default' must be a length 1 character string or NULL")
- if (is.null(default)) default <- getwd()
- if (file.exists(default)) {
- if (!file.info(default)$isdir)
- stop("'default' must be a directory, not a file!")
- }
+ if (!length(default)) default <- getwd() else
+ default <- as.character(default)[1]
+ if (file.exists(default))
+ if (!file.info(default)$isdir) default <- dirname(default) # Need a dir
default <- path.expand(default)
## Under Windows, it uses \\ as separator, although .Platform$file.sep
## is now / (tested in R 2.11.1) => replace it
if (.Platform$OS.type == "windows")
default <- gsub("\\\\", "/", default)
- if (missing(title) || title == "") title <- "Choose a directory" else
- title <- paste(title, collapse = "\n")
+ if (missing(title) || !length(title) || title == "") {
+ title <- "Choose a directory"
+ } else {
+ title <- paste(as.character(title), collapse = "\n")
+ }
gui$setUI(args = list(default = default, title = title))
## ... and dispatch to the method
@@ -29,7 +29,8 @@
## Used to break the chain of NextMethod(), searching for a usable method
## in the current context
-dlgDir.gui <- function (default = getwd(), title, ..., gui = .GUI) {
+dlgDir.gui <- function (default = getwd(), title, ..., gui = .GUI)
+{
msg <- paste("No workable method available to display a dir selection dialog box using:",
paste(guiWidgets(gui), collapse = ", "))
gui$setUI(status = "error", msg = msg, widgets = "none")
@@ -79,7 +80,7 @@
## If cancelled, then return character(0)
## This dialog box is always modal
##
- ## It is a replacement for choose.dir(), tk_choose.dir() & tkchooseDirectory()
+ ## Replacement for choose.dir(), tk_choose.dir() & tkchooseDirectory()
res <- switch(Sys.info()["sysname"],
Windows = .winDlgDir(gui$args$default, gui$args$title),
Darwin = .macDlgDir(gui$args$default, gui$args$title),
@@ -116,7 +117,7 @@
cmd <- paste("-e 'tell application ", app,
" to set foldername to choose folder ", mcmd, "default location \"",
default , "\"' -e 'POSIX path of foldername'", sep = "")
- ## For some reasons, I cannot use system(intern = TRUE) with this in R.app/R64.app
+ ## I cannot use system(intern = TRUE) with this in R.app/R64.app
## (deadlock situation?), but I can in R run in a terminal. system2() also
## works, but this preclue of using svDialogs on R < 2.12.0.
## The hack is thus to redirect output to a file, then, to read the content
@@ -128,9 +129,6 @@
if (inherits(res, "try-error") || !length(res)) return(character(0))
if (res > 0) return(character(0)) # User cancelled input
res <- readLines(tfile)
- #res <- sub("^text returned:", "", res)
- #res <- sub(", button returned:.*$", "", res)
- #res <- paste(res, collapse = " ")
return(res)
}
Modified: pkg/svDialogs/R/dlgInput.R
===================================================================
--- pkg/svDialogs/R/dlgInput.R 2012-02-11 08:15:41 UTC (rev 431)
+++ pkg/svDialogs/R/dlgInput.R 2012-02-11 14:34:33 UTC (rev 432)
@@ -1,19 +1,16 @@
## Define the S3 method
dlgInput <- function (message = "Enter a value",
-default = "", ..., gui = .GUI) {
+default = "", ..., gui = .GUI)
+{
if (!gui$startUI("dlgInput", call = match.call(), default = default,
msg = "Displaying a modal input dialog box",
msg.no.ask = "A modal input dialog box was by-passed"))
return(invisible(gui))
## Check and rework main arguments and place them in gui$args
- if (is.null(message) || !inherits(message, "character"))
- stop("'message' must be a character string!")
- message <- paste(message, collapse = "\n")
- if (is.null(default)) default <- "" else {
- if (!inherits(default, "character") || length(default) != 1)
- stop("'default' must be a unique character string or NULL!")
- }
+ if (!length(message)) message <- "Enter a value"
+ message <- paste(as.character(message), collapse = "\n")
+ if (is.null(default)) default <- "" else default <- as.character(default)[1]
gui$setUI(args = list(message = message, default = default))
## ... and dispatch to the method
@@ -23,7 +20,8 @@
## Used to break the chain of NextMethod(), searching for a usable method
## in the current context
dlgInput.gui <- function (message = "Enter a value",
-default = "", ..., gui = .GUI) {
+default = "", ..., gui = .GUI)
+{
msg <- paste("No workable method available to display an input dialog box using:",
paste(guiWidgets(gui), collapse = ", "))
gui$setUI(status = "error", msg = msg, widgets = "none")
@@ -85,7 +83,7 @@
" to display dialog \"", message, "\" default answer \"", default,
"\" with title \"Question\" buttons {\"Cancel\",\"OK\"} cancel button 1",
" default button 2'", sep = "")
- ## For some reasons, I cannot use system(intern = TRUE) with this in R.app/R64.app
+ ## FI cannot use system(intern = TRUE) with this in R.app/R64.app
## (deadlock situation?), but I can in R run in a terminal. system2() also
## works, but this preclue of using svDialogs on R < 2.12.0.
## The hack is thus to redirect output to a file, then, to read the content
Modified: pkg/svDialogs/R/dlgList.R
===================================================================
--- pkg/svDialogs/R/dlgList.R 2012-02-11 08:15:41 UTC (rev 431)
+++ pkg/svDialogs/R/dlgList.R 2012-02-11 14:34:33 UTC (rev 432)
@@ -1,10 +1,10 @@
## Define the S3 method
dlgList <- function (choices, preselect = NULL, multiple = FALSE, title = NULL,
-..., gui = .GUI) {
+..., gui = .GUI)
+{
## Check arguments
choices <- as.character(choices)
- if (is.null(choices) || !length(choices)) # Nothing to select
- return(character(0))
+ if (!length(choices)) return(character(0)) # Nothing to select
preselect <- as.character(preselect)
preselect <- preselect[preselect %in% choices]
if (!length(preselect)) preselect <- choices[1] # Select first item by default
@@ -16,10 +16,8 @@
return(invisible(gui))
## Further argument checking
- if (!is.null(multiple) && !is.na(multiple))
- multiple <- (multiple[1] == TRUE) else multiple <- FALSE
- if (!is.null(title) && (!is.character(title) || length(title) != 1))
- stop("'title' must be NULL or a length-1 character vector")
+ multiple <- isTRUE(as.logical(multiple))
+ if (!length(title)) title <- NULL else title <- as.character(title)[1]
gui$setUI(args = list(choices = choices, preselect = preselect,
multiple = multiple, title = title))
@@ -30,7 +28,8 @@
## Used to break the chain of NextMethod(), searching for a usable method
## in the current context
dlgList.gui <- function (choices, preselect = NULL, multiple = FALSE,
-title = NULL, ..., gui = .GUI) {
+title = NULL, ..., gui = .GUI)
+{
msg <- paste("No workable method available to display a list dialog box using:",
paste(guiWidgets(gui), collapse = ", "))
gui$setUI(status = "error", msg = msg, widgets = "none")
@@ -39,7 +38,8 @@
## The pure textual version used a fallback in case no GUI could be used
dlgList.textCLI <- function (choices, preselect = NULL, multiple = FALSE,
-title = NULL, ..., gui = .GUI) {
+title = NULL, ..., gui = .GUI)
+{
gui$setUI(widgets = "textCLI")
## Ask a selection in a textual menu
choices <- gui$args$choices
@@ -50,7 +50,6 @@
## character(0) => change this for consistency
if (!multiple && res == "" && !"" %in% choices)
res <- character(0)
-#PhG? To eliminate? res$gui <- res
gui$setUI(res = res, status = NULL)
return(invisible(gui))
}
@@ -134,7 +133,8 @@
## Linux/Unix version
.unixDlgList <- function (choices, preselect = NULL, multiple = FALSE,
-title = NULL) {
+title = NULL)
+{
## We don't use the ugly (on Linux) Tk version tk_select.list()
## In zenity, the normal list mode do not allow for preselections
## => switch to --checklist (multiple) or --radiolist (single) in this case
@@ -144,7 +144,7 @@
} else {
kind <- "--radiolist --column=\"Pick\" --column=\"Item\""
}
- ## Make sure only one item is preselected if multiple is FALSE (keep first one)
+ ## Only one item is preselected if multiple is FALSE (keep first one)
if (!multiple) preselect <- preselect[1]
## Create a string with TRUE/FALSE item alternated
sel <- choices %in% preselect
Modified: pkg/svDialogs/R/dlgMessage.R
===================================================================
--- pkg/svDialogs/R/dlgMessage.R 2012-02-11 08:15:41 UTC (rev 431)
+++ pkg/svDialogs/R/dlgMessage.R 2012-02-11 14:34:33 UTC (rev 432)
@@ -1,26 +1,28 @@
## Simplified versions of dlgMessage()
-msgBox <- function (message) {
+msgBox <- function (message)
+{
require(svDialogs)
dlgMessage(message = message)$res
}
-okCancelBox <- function (message) {
+okCancelBox <- function (message)
+{
require(svDialogs)
return(dlgMessage(message = message, type = "okcancel")$res == "ok")
}
## Define the S3 method
dlgMessage <- function (message, type = c("ok", "okcancel", "yesno",
-"yesnocancel"), ..., gui = .GUI) {
+"yesnocancel"), ..., gui = .GUI)
+{
if (!gui$startUI("dlgMessage", call = match.call(), default = "ok",
msg = "Displaying a modal message dialog box",
msg.no.ask = "A modal message dialog box was by-passed"))
return(invisible(gui))
## Check and rework main arguments and place them in gui$args
- if (missing(message) || !inherits(message, "character"))
- stop("'message' must be a character string!")
- message <- paste(message, collapse = "\n")
+ if (missing(message)) message <- "[Your message here...]"
+ message <- paste(as.character(message), collapse = "\n")
type <- match.arg(type)
gui$setUI(args = list(message = message, type = type))
@@ -31,7 +33,8 @@
## Used to break the chain of NextMethod(), searching for a usable method
## in the current context
dlgMessage.gui <- function (message, type = c("ok", "okcancel", "yesno",
-"yesnocancel"), ..., gui = .GUI) {
+"yesnocancel"), ..., gui = .GUI)
+{
msg <- paste("No workable method available to display a message dialog box using:",
paste(guiWidgets(gui), collapse = ", "))
gui$setUI(status = "error", msg = msg, widgets = "none")
@@ -89,7 +92,7 @@
"yesnocancel"))
{
res <- winDialog(type = type, message = message)
- ## Rework result to match the other functions
+ ## Rework result to match the result from the other functions
if (type == "ok") return(invisible("ok")) else return(tolower(res))
}
@@ -168,7 +171,8 @@
if (res > 1) return(NULL) else res <- results[res + 1]
## Do we ask to continue (if was yesnocancel)?
if (confirm) {
- conf <- system("zenity --question --text=\"Continue?\" --ok-label=\"OK\" --cancel-label=\"Cancel\" --title=\"Confirm\"")
+ conf <- system(paste("zenity --question --text=\"Continue?\"",
+ "--ok-label=\"OK\" --cancel-label=\"Cancel\" --title=\"Confirm\""))
if (conf == 1) return("cancel")
}
return(res)
Modified: pkg/svDialogs/R/dlgOpen.R
===================================================================
--- pkg/svDialogs/R/dlgOpen.R 2012-02-11 08:15:41 UTC (rev 431)
+++ pkg/svDialogs/R/dlgOpen.R 2012-02-11 14:34:33 UTC (rev 432)
@@ -17,7 +17,8 @@
## Define the S3 method
dlgOpen <- function (default, title, multiple = FALSE,
-filters = dlgFilters["All", ], ..., gui = .GUI) {
+filters = dlgFilters["All", ], ..., gui = .GUI)
+{
## An 'open file(s)' dialog box
## title is used as caption of the dialog box
## defaultFile allows to preselect a file
@@ -32,17 +33,16 @@
## always the first filter that is selected by default in the dialog box
## To specify an initial dir, but no initial file, use /dir/*.*
+ if (missing(default) || !length(default)) default <- character(0)
if (!gui$startUI("dlgOpen", call = match.call(), default = default,
msg = "Displaying a modal open file dialog box",
msg.no.ask = "A modal open file dialog box was by-passed"))
return(invisible(gui))
## Check and rework main arguments and place them in gui$args
- if (missing(default) || is.null(default))
- default <- file.path(path.expand(getwd()), "*.*", sep = "")
- if (!is.null(default) && !inherits(default, "character") &&
- length(default) != 1)
- stop("'default' must be a length 1 character string or NULL")
+ if (missing(default) || !length(default))
+ default <- file.path(path.expand(getwd()), "*.*")
+ default <- as.character(default)[1]
## Under Windows, it uses \\ as separator, although .Platform$file.sep
## is now / (tested in R 2.11.1) => replace it
if (.Platform$OS.type == "windows")
@@ -50,24 +50,25 @@
## Check that dir and file already exists
dir <- dirname(default)
if (!file.exists(dir) || !file.info(dir)$isdir)
- stop("Directory of 'default' does not exists (", dir, ")")
+ default <- file.path(getwd(), basename(default))
## Check that file exists
file <- basename(default)
if (file != "*.*" && file != "*" && !file.exists(default))
- stop("File provided as 'default' does not exists (", default, ")")
+ default <- file.path(dirname(default), "*.*")
multiple <- isTRUE(as.logical(multiple))
- if (missing(title) || title == "") {
+ if (missing(title) || !length(title) || title == "") {
if (multiple) title <- "Select files" else title <- "Select file"
} else title <- as.character(title)[1]
## Check that filter is a nx2 character matrix, or try reshape it as such
if (is.matrix(filters)) {
if (ncol(filters) != 2 || !is.character(filters))
- stop("'filters' must be a nx2 matrix of character strings")
+ filters <- dlgFilters["All", , drop = FALSE]
} else {
- if (length(filters) %% 2 != 0)
- stop("'filters' but be a vector of characters with an even length")
- ## Try to reshape it
- filters <- matrix(as.character(filters), ncol = 2, byrow = TRUE)
+ if (length(filters) %% 2 != 0) {
+ filters <- dlgFilters["All", , drop = FALSE]
+ } else { # Try to reshape it
+ filters <- matrix(as.character(filters), ncol = 2, byrow = TRUE)
+ }
}
gui$setUI(args = list(default = default, title = title,
multiple = multiple, filters = filters))
@@ -76,10 +77,11 @@
UseMethod("dlgOpen", gui)
}
-## Used to break the chain of NextMethod(), searching for a usable method
+## Used to break the chain of NextMethod(), searching for an usable method
## in the current context
dlgOpen.gui <- function (default, title, multiple = FALSE,
-filters = dlgFilters["All", ], ..., gui = .GUI) {
+filters = dlgFilters["All", ], ..., gui = .GUI)
+{
msg <- paste("No workable method available to display a file open dialog box using:",
paste(guiWidgets(gui), collapse = ", "))
gui$setUI(status = "error", msg = msg, widgets = "none")
@@ -87,8 +89,11 @@
}
## The pure textual version used as fallback in case no GUI could be used
+## TODO: there is a problem with /dir/*.* => return => use it as a default
+## and then, issues a warning that the file does not exist!
dlgOpen.textCLI <- function (default, title, multiple = FALSE,
-filters = dlgFilters["All", ], ..., gui = .GUI) {
+filters = dlgFilters["All", ], ..., gui = .GUI)
+{
gui$setUI(widgets = "textCLI")
## Ask for the file
res <- readline(paste(gui$args$title, " [", gui$args$default, "]: ",
@@ -99,6 +104,7 @@
## In case we pasted a string with single, or double quotes, or spaces
## eliminate them
res <- sub("^['\" ]+", "", sub("['\" ]+$", "", res))
+ res <- res[res != ""]
## If we have serveral files returned, but multiple is FALSE, keep only
## first one with a warning
if (!gui$args$multiple && length(res) > 1) {
@@ -112,7 +118,8 @@
res <- character(0) # Same as if the user did cancel the dialog box
} else {
## Keep only existing files
- warning("There are inexistent files that will be ignored")
+ if (!all(isThere))
+ warning("There are inexistent files that will be ignored")
res <- res[isThere]
}
if (length(res)) res <- normalizePath(res)
@@ -129,7 +136,7 @@
## If cancelled, then return character(0)
## This dialog box is always modal
##
- ## It is a replacement for choose.files(), tkgetOpenFile() & file.choose(new = FALSE)
+ ## Replacement for choose.files(), tkgetOpenFile() & file.choose(new=FALSE)
res <- switch(Sys.info()["sysname"],
Windows = .winDlgOpen(gui$args$default, gui$args$title,
gui$args$multiple, gui$args$filters),
@@ -150,9 +157,12 @@
.winDlgOpen <- function (default, title, multiple = FALSE,
filters = dlgFilters["All", ])
{
+ if (!is.matrix(filters)) filters <- matrix(filters, ncol = 2, byrow = TRUE)
+ if (missing(default) || !length(default)) default <- ""
res <- choose.files(default = default, caption = title, multi = multiple,
filters = filters, index = 1)
if (length(res)) res <- gsub("\\\\", "/", res)
+ if (length(res) == 1 && res == "") res <- character(0)
return(res)
}
@@ -161,6 +171,7 @@
filters = dlgFilters["All", ])
{
## TODO: filters are implemented differently on the Mac => how to do this???
+ if (!is.matrix(filters)) filters <- matrix(filters, ncol = 2, byrow = TRUE)
## Display a modal file open selector with native Mac dialog box
if (.Platform$GUI == "AQUA") app <- "(name of application \"R\")" else
app <- "\"Terminal\""
@@ -190,7 +201,7 @@
" to set filename to choose file ", mcmd,
"' -e 'POSIX path of filename'", sep = "")
}
- ## For some reasons, I cannot use system(intern = TRUE) with this in R.app/R64.app
+ ## I cannot use system(intern = TRUE) with this in R.app/R64.app
## (deadlock situation?), but I can in R run in a terminal. system2() also
## works, but this preclue of using svDialogs on R < 2.12.0.
## The hack is thus to redirect output to a file, then, to read the content
@@ -221,6 +232,7 @@
## Use zenity to display the file open selection
## Construct the -file-filter options
if (multiple) fcmd <- "--multiple" else fcmd <- ""
+ if (!is.matrix(filters)) filters <- matrix(filters, ncol = 2, byrow = TRUE)
nf <- nrow(filters)
if (nf > 0) for (i in 1:nf)
fcmd <- paste(fcmd, " --file-filter=\"", filters[i, 1], " | ",
Added: pkg/svDialogs/R/dlgSave.R
===================================================================
--- pkg/svDialogs/R/dlgSave.R (rev 0)
+++ pkg/svDialogs/R/dlgSave.R 2012-02-11 14:34:33 UTC (rev 432)
@@ -0,0 +1,213 @@
+## Define the S3 method
+## TODO: define default extension!!!
+dlgSave <- function (default, title, filters = dlgFilters["All", ],
+..., gui = .GUI)
+{
+ ## A 'save file' dialog box
+ ## title is used as caption of the dialog box
+ ## default allows to preselect a file
+ ## Always ask for confirmation in case the file already exists
+ ## filters is a n x 2 matrix of characters with description and filter
+ ## for instance: "R or S files (*.R, *.q)" "*.R;*.q"
+ ## It could be also an even number of character strings that will be
+ ## reorganized into a n x 2 matrix.
+
+ if (missing(default) || !length(default)) default <- character(0)
+ if (!gui$startUI("dlgSave", call = match.call(), default = default,
+ msg = "Displaying a modal save file dialog box",
+ msg.no.ask = "A modal save file dialog box was by-passed"))
+ return(invisible(gui))
+
+ ## Check and rework main arguments and place them in gui$args
+ if (missing(default) || is.null(default))
+ default <- file.path(path.expand(getwd()), "untitled", sep = "")
+ if (!length(default)) default <- NULL
+ if (!is.null(default)) {
+ default <- as.character(default)[1]
+ ## Under Windows, it uses \\ as separator, although .Platform$file.sep
+ ## is now / (tested in R 2.11.1) => replace it
+ if (.Platform$OS.type == "windows")
+ default <- gsub("\\\\", "/", default)
+ ## Check that dir of default already exists
+ dir <- dirname(default)
+ ## If not there, or not a dire, replace by current working dir...
+ if (!file.exists(dir) || !file.info(dir)$isdir)
+ default <- file.path(getwd(), basename(default))
+ }
+ if (missing(title) || title == "") {
+ title <- "Save file as"
+ } else title <- as.character(title)[1]
+ ## Check that filter is a nx2 character matrix, or try reshape it as such
+ if (is.matrix(filters)) {
+ if (ncol(filters) != 2 || !is.character(filters))
+ filters <- NULL
+ } else {
+ if (length(filters) %% 2 != 0) {
+ filters <- NULL
+ } else { # Try to reshape it
+ filters <- matrix(as.character(filters), ncol = 2, byrow = TRUE)
+ }
+ }
+ gui$setUI(args = list(default = default, title = title, filters = filters))
+
+ ## ... and dispatch to the method
+ UseMethod("dlgSave", gui)
+}
+
+## Used to break the chain of NextMethod(), searching for a usable method
+## in the current context
+dlgSave.gui <- function (default, title, filters = dlgFilters["All", ], ..., gui = .GUI)
+{
+ msg <- paste("No workable method available to display a file save dialog box using:",
+ paste(guiWidgets(gui), collapse = ", "))
+ gui$setUI(status = "error", msg = msg, widgets = "none")
+ stop(msg)
+}
+
+## The pure textual version used as fallback in case no GUI could be used
+dlgSave.textCLI <- function (default, title, filters = dlgFilters["All", ],
+..., gui = .GUI)
+{
+ gui$setUI(widgets = "textCLI")
+ ## Ask for the file
+ res <- readline(paste(gui$args$title, " [", gui$args$default, "]: ",
+ sep = ""))
+ if (res == "") res <- gui$args$default else res <- res
+ ## In case we pasted a string with single, or double quotes, or spaces
+ ## eliminate them
+ res <- sub("^['\" ]+", "", sub("['\" ]+$", "", res))
+ if (length(res)) {
+ res <- normalizePath(res)
+ ## If file already exists => ask for confirmation...
+ if (file.exists(res)) {
+ choices <- c("ok", "cancel")
+ ret <- select.list(choices,
+ title = "Confirm you want to replace this file", graphics = FALSE)
+ if (ret == "" || ret == "cancel") res <- character(0) # Cancelled
+ }
+ }
+ gui$setUI(res = res, status = NULL)
+ return(invisible(gui))
+}
+
+## The native version of the file save dialog box
+dlgSave.nativeGUI <- function (default, title, filters = dlgFilters["All", ],
+..., gui = .GUI)
+{
+ gui$setUI(widgets = "nativeGUI")
+ ## A 'save file' dialog box
+ ## If cancelled, then return character(0)
+ ## This dialog box is always modal
+ ##
+ ## It is a replacement for choose.files(), tkgetSaveFile()
+ ## & file.choose(new = TRUE), not implemented yet in R 2.14, by the way
+ res <- switch(Sys.info()["sysname"],
+ Windows = .winDlgSave(gui$args$default, gui$args$title, gui$args$filters),
+ Darwin = .macDlgSave(gui$args$default, gui$args$title, gui$args$filters),
+ .unixDlgSave(gui$args$default, gui$args$title, gui$args$filters)
+ )
+
+ ## Do we need to further dispatch?
+ if (is.null(res)) NextMethod("dlgSave", gui) else {
+ gui$setUI(res = res, status = NULL)
+ return(invisible(gui))
+ }
+}
+
+## Windows version
+.winDlgSave <- function (default, title, filters = dlgFilters["All", ])
+{
+ ## Note: this dialog box is a very bad design for saving as dialog box:
+ ## It displays the "Open" button and complains if the file does not exist!
+ ## TODO: should be replaced by the Tk version for now
+ if (!is.matrix(filters)) filters <- matrix(filters, ncol = 2, byrow = TRUE)
+ if (!length(default)) default <- ""
+ res <- choose.files(default = default, caption = title,
+ multi = FALSE, filters = filters, index = 1)
+ if (length(res)) {
+ res <- gsub("\\\\", "/", res)
+ if (file.exists(res) && tolower(winDialog(type = "okcancel",
+ message = "The file already exists. It will be replaced!")) == "cancel")
+ res <- character(0) # User cancelled!
+ }
+ return(res)
+}
+
+## Mac OS X version
+.macDlgSave <- function (default, title, filters = dlgFilters["All", ])
+{
+ ## TODO: filters are implemented differently on the Mac => how to do this???
+ if (!is.matrix(filters)) filters <- matrix(filters, ncol = 2, byrow = TRUE)
+ ## Display a modal file save selector with native Mac dialog box
+ if (.Platform$GUI == "AQUA") app <- "(name of application \"R\")" else
+ app <- "\"Terminal\""
+ ## Avoid displaying warning message when the user clicks on 'Cancel'
+ owarn <- getOption("warn")
+ on.exit(options(warn = owarn))
+ options(warn = -1)
+ if (title == "") mcmd <- "" else mcmd <- paste("with prompt \"",
+ title, "\" ", sep = "")
+ if (length(default) && default != "") {
+ ## Default dir must be an existing dir... otherwise, the cmd fails!
+ defdir <- dirname(default)
+ if (!file.exists(defdir) || !file.info(defdir)$isdir)
+ defdir <- getwd()
+ mcmd <- paste(mcmd, " default location \"", defdir, "\"", sep = "")
+ deffile <- basename(default)
+ if (deffile != "*.*" && deffile != "*")
+ mcmd <- paste(mcmd, " default name \"", deffile, "\"", sep = "")
+ }
+ cmd <- paste("-e 'tell application ", app,
+ " to set filename to choose file name ", mcmd,
+ "' -e 'POSIX path of filename'", sep = "")
+ ## I cannot use system(intern = TRUE) with this in R.app/R64.app
+ ## (deadlock situation?), but I can in R run in a terminal. system2() also
+ ## works, but this preclue of using svDialogs on R < 2.12.0.
+ ## The hack is thus to redirect output to a file, then, to read the content
+ ## of that file and to destroy it
+ tfile <- tempfile()
+ on.exit(unlink(tfile))
+ res <- try(system(paste("osascript", cmd, ">", tfile), wait = TRUE,
+ intern = FALSE, ignore.stderr = TRUE), silent = TRUE)
+ if (inherits(res, "try-error") || !length(res)) return(character(0))
+ if (res > 0) return(character(0)) # User cancelled input
+ res <- readLines(tfile)
+ res <- res[res != ""] # Eliminate empty lines
+ ## Note: confirmation of replacement is built-in here
+ return(res)
+}
+
+## Linux/Unix version
+## TODO: if no extension provided, displays '.' => make sure to change this!
+.unixDlgSave <- function (default, title, filters = dlgFilters["All", ])
+{
+ ## Note: only existing filenames can be selected as default, otherwise, the
+ ## argument is ignored!
+ ## zenity must be installed on this machine!
+ if (Sys.which("zenity") == "") return(NULL)
+ ## Avoid displaying warning message in case user clicks on Cancel
+ owarn <- getOption("warn")
+ on.exit(options(warn = owarn))
+ options(warn = -1)
+ ## Use zenity to display the file save selection
+ ## Construct the -file-filter options
+ fcmd <- ""
+ if (!is.matrix(filters)) filters <- matrix(filters, ncol = 2, byrow = TRUE)
+ nf <- nrow(filters)
+ if (nf > 0) for (i in 1:nf)
+ fcmd <- paste(fcmd, " --file-filter=\"", filters[i, 1], " | ",
+ gsub(";", " ", filters[i, 2]), "\"", sep = "")
+ msg <- paste("zenity --file-selection --save --title=\"", title,
+ "\" --filename=\"", default, "\" ", fcmd, sep = "")
+ res <- system(msg, intern = TRUE, ignore.stderr = TRUE) # Because error if file not found!
+ if (!length(res)) return(character(0)) else {
+ if (file.exists(res)) { # Ask for confirmation!
+ msg <- paste("zenity --question --text=\"",
+ "This file already exists. It will be replaced!",
+ "\" --ok-label=\"OK\" --cancel-label=\"Cancel\"",
+ " --title=\"Question\"", sep = "")
+ if (system(msg) > 0) return(character(0)) # Cancelled, or another error
+ }
+ return(strsplit(res, "|", fixed = TRUE)[[1]])
+ }
+}
Modified: pkg/svDialogs/R/guiDlg.R
===================================================================
--- pkg/svDialogs/R/guiDlg.R 2012-02-11 08:15:41 UTC (rev 431)
+++ pkg/svDialogs/R/guiDlg.R 2012-02-11 14:34:33 UTC (rev 432)
@@ -1,15 +1,22 @@
## These items still need to be implemented!
-#dlgAssistant <- function (...)
+#dlgColor <- function (...)
#{
-# ## This is a non modal assistant dialog box... could also display tips
+# ## A color selection dialog box
+# ## TODO: a color range selector?
+# stop("Not yet implemented!")
+#}
+
+#dlgFont <- function (...)
+#{
+# ## A font selector dialog box
# ## TODO...
# stop("Not yet implemented!")
#}
-#dlgColor <- function (...)
+#dlgAssistant <- function (...)
#{
-# ## A color selection dialog box
-# ## TODO: a color range selector?
+# ## This is a non modal assistant dialog box... could also display tips
+# ## TODO...
# stop("Not yet implemented!")
#}
@@ -25,13 +32,6 @@
# stop("Not yet implemented!")
#}
-#dlgFont <- function (...)
-#{
-# ## A font selector dialog box
-# ## TODO...
-# stop("Not yet implemented!")
-#}
-
#dlgFormula <- function (...)
#{
# ## This dialog box helps to create S language formulas
Modified: pkg/svDialogs/TODO
===================================================================
--- pkg/svDialogs/TODO 2012-02-11 08:15:41 UTC (rev 431)
+++ pkg/svDialogs/TODO 2012-02-11 14:34:33 UTC (rev 432)
@@ -5,4 +5,7 @@
* Eliminate the dependency to tcltk, once all old code will be moved to
svDialogs..tcltk.
+* For the Mac one can also use:
+ - osascript -e 'tell application "Terminal" to choose color default color {12, 56, 78}' # Warning: 0-65535!
+
* Translation into different languages.
Added: pkg/svDialogs/man/dlgSave.Rd
===================================================================
--- pkg/svDialogs/man/dlgSave.Rd (rev 0)
+++ pkg/svDialogs/man/dlgSave.Rd 2012-02-11 14:34:33 UTC (rev 432)
@@ -0,0 +1,51 @@
+\name{dlgSave}
+\alias{dlgSave}
+\alias{dlgSave.gui}
+\alias{dlgSave.textCLI}
+\alias{dlgSave.nativeGUI}
+
+\title{ A select file to save dialog box }
+\description{
+ Allows to easily select one filename to save data.
+}
+
+\usage{
+dlgSave(default, title, filters = dlgFilters["All", ], \dots, gui = .GUI)
+
+## These should not be called directly
+\method{dlgSave}{gui}(default, title, filters = dlgFilters["All", ], \dots, gui = .GUI)
+\method{dlgSave}{textCLI}(default, title, filters = dlgFilters["All", ], \dots, gui = .GUI)
+\method{dlgSave}{nativeGUI}(default, title, filters = dlgFilters["All", ], \dots, gui = .GUI)
+}
+
+\arguments{
+ \item{default}{ the default file to start with (use \code{/dir/*} or
+ \code{/dir/*.*} to start in a given directory, but without predefined name). }
+ \item{title}{ a title to display on top of the dialog box. }
+ \item{filters}{ a specification of file filters as a nx2 matrix, or a
+ character string with even number of items. First items is the label, second
+ one is the filter. See \code{dlgFilters for examples}. This is currently
+ ignored on Mac OS X, since such kind of filter is defined differently there. }
+ \item{\dots}{ pass further arguments to methods. }
+ \item{gui}{ the 'gui' object concerned by this dialog box. }
+}
+
+\value{
+ The modified 'gui' object is returned invisibly. The choosen file, or an
+ empty string (if the cancel button was clicked or confirmation was
+ cancelled) is placed in \code{gui$res} (see example). For existing files,
+ confirmation is always asked!
+}
+
+\author{Philippe Grosjean (\email{phgrosjean at sciviews.org})}
+
+\seealso{ \code{\link{dlgSave}}, \code{\link{dlgFilters}}, \code{\link{dlgDir}} }
+
+\examples{
+## Choose one R filename to save some R script into it
+dlgSave(title = "Save R script to", filters = dlgFilters[c("R", "All"), ])$res
+}
+
+\keyword{ misc }
+
+\concept{ GUI API dialog boxes }
Property changes on: pkg/svDialogs/man/dlgSave.Rd
___________________________________________________________________
Added: svn:executable
+ *
Modified: pkg/svDialogstcltk/NAMESPACE
===================================================================
--- pkg/svDialogstcltk/NAMESPACE 2012-02-11 08:15:41 UTC (rev 431)
+++ pkg/svDialogstcltk/NAMESPACE 2012-02-11 14:34:33 UTC (rev 432)
@@ -2,9 +2,9 @@
#export()
-S3method(dlgDir, tcltkWidgets)
-S3method(dlgInput, tcltkWidgets)
-S3method(dlgList, tcltkWidgets)
-S3method(dlgMessage, tcltkWidgets)
-S3method(dlgOpen, tcltkWidgets)
-S3method(dlgSave, tcltkWidgets)
+S3method(dlgDir, tcltkGUI)
+S3method(dlgInput, tcltkGUI)
+S3method(dlgList, tcltkGUI)
+S3method(dlgMessage, tcltkGUI)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 432
More information about the Sciviews-commits
mailing list