[Sciviews-commits] r431 - in pkg: svDialogs svDialogs/R svDialogs/man svDialogstcltk svDialogstcltk/R svGUI/R svHttp/R svKomodo svKomodo/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Feb 11 09:15:42 CET 2012
Author: phgrosjean
Date: 2012-02-11 09:15:41 +0100 (Sat, 11 Feb 2012)
New Revision: 431
Added:
pkg/svDialogs/R/dlgOpen.R
pkg/svDialogs/man/dlgOpen.Rd
pkg/svDialogstcltk/R/dlgOpen.tcltkWidgets.R
Modified:
pkg/svDialogs/DESCRIPTION
pkg/svDialogs/NAMESPACE
pkg/svDialogs/NEWS
pkg/svDialogs/R/dlgDir.R
pkg/svDialogs/R/dlgList.R
pkg/svDialogs/R/dlgMessage.R
pkg/svDialogs/R/guiDlg.R
pkg/svDialogs/R/menu.R
pkg/svDialogs/R/svDialogs-internal.R
pkg/svDialogs/TODO
pkg/svDialogs/man/dlgDir.Rd
pkg/svDialogs/man/dlgMessage.Rd
pkg/svDialogstcltk/DESCRIPTION
pkg/svDialogstcltk/NAMESPACE
pkg/svDialogstcltk/NEWS
pkg/svDialogstcltk/R/dlgDir.tcltkWidgets.R
pkg/svDialogstcltk/R/dlgMessage.tcltkWidgets.R
pkg/svGUI/R/guiAdd.R
pkg/svHttp/R/httpServer.R
pkg/svKomodo/DESCRIPTION
pkg/svKomodo/NEWS
pkg/svKomodo/R/svKomodo-internal.R
Log:
Further work on svDialogs
Modified: pkg/svDialogs/DESCRIPTION
===================================================================
--- pkg/svDialogs/DESCRIPTION 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/DESCRIPTION 2012-02-11 08:15:41 UTC (rev 431)
@@ -5,8 +5,8 @@
SystemRequirements: TODO!!!
Description: Rapidly construct dialog boxes for your GUI, including an automatic
function assistant
-Version: 0.9-47
-Date: 2012-01-31
+Version: 0.9-48
+Date: 2012-02-05
Author: Philippe Grosjean
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
Modified: pkg/svDialogs/NAMESPACE
===================================================================
--- pkg/svDialogs/NAMESPACE 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/NAMESPACE 2012-02-11 08:15:41 UTC (rev 431)
@@ -5,8 +5,17 @@
dlgInput,
dlgList,
dlgMessage,
- #dlgOpen,
+ dlgOpen,
#dlgSave,
+ msgBox,
+ okCancelBox,
+ menuAdd,
+ menuAddItem,
+ menuDel,
+ menuDelItem,
+ menuNames,
+ menuItems,
+ .Last.lib,
# To be reworked
display,
guiDlg,
@@ -15,13 +24,7 @@
guiPane.tcltk,
guiPane.entry.tcltk,
guiPane.list.tcltk,
- guiSetStyle.tcltk,
- menuAdd,
- menuAddItem,
- menuDel,
- menuDelItem,
- menuNames,
- menuItems)
+ guiSetStyle.tcltk,)
# To be eliminated
S3method(display, guiDlg)
@@ -42,9 +45,9 @@
S3method(dlgMessage, textCLI)
S3method(dlgMessage, nativeGUI)
-#S3method(dlgOpen, gui)
-#S3method(dlgOpen, textCLI)
-#S3method(dlgOpen, nativeGUI)
+S3method(dlgOpen, gui)
+S3method(dlgOpen, textCLI)
+S3method(dlgOpen, nativeGUI)
#S3method(dlgSave, gui)
#S3method(dlgSave, textCLI)
Modified: pkg/svDialogs/NEWS
===================================================================
--- pkg/svDialogs/NEWS 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/NEWS 2012-02-11 08:15:41 UTC (rev 431)
@@ -1,5 +1,24 @@
= svDialogs News
+== Changes in svDialogs 0.9-48
+
+* Argument message is changed to title in dlgDir() function, to match
+ corresponding argument in dlgOpen() and dlgSave() and also to indicate it can
+ only be a single line of text!
+
+* Added msgBox() and okCancelBox() function for simpler message box handling.
+
+* dlgOpen() is now implemented and its textCLI version also accepts single and
+ double quotes around file path (allow to drag&drop from, e.g., nautilus to
+ gnome-terminal in Gnome Linux), on the contrary to file.choose().
+
+* dlgFilters is similar to Filters matrix under Windows, and it provides a
+ series of default file types and filters for dlgOpen() and dlgSave().
+
+* dlgSave() is also implemented, but it uses choose.files() on Windows, which is
+ merely designed to open file(s) instead of providing a file name to save to.
+
+
== Changes in svDialogs 0.9-47
* Now, menuAddItem() implements 'enable' and 'disable' in action to change the
Modified: pkg/svDialogs/R/dlgDir.R
===================================================================
--- pkg/svDialogs/R/dlgDir.R 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/R/dlgDir.R 2012-02-11 08:15:41 UTC (rev 431)
@@ -1,5 +1,5 @@
## Define the S3 method
-dlgDir <- function (default = getwd(), message, ..., 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"))
@@ -19,9 +19,9 @@
## is now / (tested in R 2.11.1) => replace it
if (.Platform$OS.type == "windows")
default <- gsub("\\\\", "/", default)
- if (missing(message) || message == "") message <- "Choose a directory" else
- message <- paste(message, collapse = "\n")
- gui$setUI(args = list(default = default, message = message))
+ if (missing(title) || title == "") title <- "Choose a directory" else
+ title <- paste(title, collapse = "\n")
+ gui$setUI(args = list(default = default, title = title))
## ... and dispatch to the method
UseMethod("dlgDir", gui)
@@ -29,7 +29,7 @@
## Used to break the chain of NextMethod(), searching for a usable method
## in the current context
-dlgDir.gui <- function (default = getwd(), message, ..., 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")
@@ -37,13 +37,16 @@
}
## The pure textual version used a fallback in case no GUI could be used
-dlgDir.textCLI <- function (default = getwd(), message, ..., gui = .GUI)
+dlgDir.textCLI <- function (default = getwd(), title, ..., gui = .GUI)
{
gui$setUI(widgets = "textCLI")
## Ask for the directory
- res <- readline(paste(gui$args$message, " [", gui$args$default, "]: ",
+ 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))
## To get the same behaviour as the GUI equivalents, we must make sure
## it is a directory, or try to create it (possibly recursively, if it
## does not exist). Also return absolute path
@@ -67,7 +70,7 @@
}
## The native version of the input box
-dlgDir.nativeGUI <- function (default = getwd(), message, ..., gui = .GUI)
+dlgDir.nativeGUI <- function (default = getwd(), title, ..., gui = .GUI)
{
gui$setUI(widgets = "nativeGUI")
## A 'choose a directory' dialog box
@@ -78,9 +81,9 @@
##
## It is a replacement for choose.dir(), tk_choose.dir() & tkchooseDirectory()
res <- switch(Sys.info()["sysname"],
- Windows = .winDlgDir(gui$args$default, gui$args$message),
- Darwin = .macDlgDir(gui$args$default, gui$args$message),
- .unixDlgDir(gui$args$default, gui$args$message)
+ Windows = .winDlgDir(gui$args$default, gui$args$title),
+ Darwin = .macDlgDir(gui$args$default, gui$args$title),
+ .unixDlgDir(gui$args$default, gui$args$title)
)
## Do we need to further dispatch?
@@ -91,15 +94,15 @@
}
## Windows version
-.winDlgDir <- function (default = getwd(), message = "")
+.winDlgDir <- function (default = getwd(), title = "")
{
- res <- choose.dir(default = default, caption = message)
+ res <- choose.dir(default = default, caption = title)
if (is.na(res)) res <- character(0) else res <- gsub("\\\\", "/", res)
return(res)
}
## Mac OS X version
-.macDlgDir <- function (default = getwd(), message = "")
+.macDlgDir <- function (default = getwd(), title = "")
{
## Display a modal directory selector with native Mac dialog box
if (.Platform$GUI == "AQUA") app <- "(name of application \"R\")" else
@@ -108,8 +111,8 @@
owarn <- getOption("warn")
on.exit(options(warn = owarn))
options(warn = -1)
- if (message == "") mcmd <- "" else mcmd <- paste("with prompt \"",
- message, "\" ", sep = "")
+ if (title == "") mcmd <- "" else mcmd <- paste("with prompt \"",
+ title, "\" ", sep = "")
cmd <- paste("-e 'tell application ", app,
" to set foldername to choose folder ", mcmd, "default location \"",
default , "\"' -e 'POSIX path of foldername'", sep = "")
@@ -132,7 +135,7 @@
}
## Linux/Unix version
-.unixDlgDir <- function (default = getwd(), message = "")
+.unixDlgDir <- function (default = getwd(), title = "")
{
## zenity must be installed on this machine!
if (Sys.which("zenity") == "") return(NULL)
@@ -142,20 +145,20 @@
options(warn = -1)
## Use zenity to display the directory selection
## There is no message area here, but one can set the title
- if (message == "") {
- message <- "Choose a directory" # Default message
- } else {
- ## Determine if the message is multiline...
- if (regexpr("\n", message) > 0) {
- ## Try to use a notification instead
- if (Sys.which("notify-send") != "") {
- system(paste("notify-send --category=\"R\"",
- " \"R message\" \"", message, "\"", sep = ""), wait = FALSE)
- message <- "Choose folder"
- } # Else the wole message cannot be displayed!!
- }
- }
- msg <- paste("zenity --file-selection --title=\"", message,
+ if (title == "") {
+ title <- "Choose a directory" # Default title
+ } #else {
+ # ## Determine if the title is multiline...
+ # if (regexpr("\n", title) > 0) {
+ # ## Try to use a notification instead
+ # if (Sys.which("notify-send") != "") {
+ # system(paste("notify-send --category=\"R\"",
+ # " \"R message\" \"", title, "\"", sep = ""), wait = FALSE)
+ # title <- "Choose folder"
+ # } # Else the wole title cannot be displayed!!
+ # }
+ #}
+ msg <- paste("zenity --file-selection --title=\"", title,
"\" --directory --filename=\"", default, "\"", sep = "")
res <- system(msg, intern = TRUE)
return(res)
Modified: pkg/svDialogs/R/dlgList.R
===================================================================
--- pkg/svDialogs/R/dlgList.R 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/R/dlgList.R 2012-02-11 08:15:41 UTC (rev 431)
@@ -50,7 +50,8 @@
## character(0) => change this for consistency
if (!multiple && res == "" && !"" %in% choices)
res <- character(0)
- res$gui <- res
+#PhG? To eliminate? res$gui <- res
+ gui$setUI(res = res, status = NULL)
return(invisible(gui))
}
Modified: pkg/svDialogs/R/dlgMessage.R
===================================================================
--- pkg/svDialogs/R/dlgMessage.R 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/R/dlgMessage.R 2012-02-11 08:15:41 UTC (rev 431)
@@ -1,3 +1,14 @@
+## Simplified versions of dlgMessage()
+msgBox <- function (message) {
+ require(svDialogs)
+ dlgMessage(message = message)$res
+}
+
+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) {
Added: pkg/svDialogs/R/dlgOpen.R
===================================================================
--- pkg/svDialogs/R/dlgOpen.R (rev 0)
+++ pkg/svDialogs/R/dlgOpen.R 2012-02-11 08:15:41 UTC (rev 431)
@@ -0,0 +1,233 @@
+## Default filters for dlgOpen() and dlgSave() boxes
+dlgFilters <- matrix(c(
+ "R or S files (*.R,*.q,*.ssc,*.S)", "*.R;*.q;*.ssc;*.S",
+ "Enhanced metafiles (*.emf)","*.emf",
+ "Postscript files (*.ps)", "*.ps",
+ "PDF files (*.pdf)", "*.pdf",
+ "Png files (*.png)", "*.png",
+ "Windows bitmap files (*.bmp)", "*.bmp",
+ "Jpeg files (*.jpeg,*.jpg)", "*.jpeg;*.jpg",
+ "Text files (*.txt)", "*.txt",
+ "R images (*.RData,*.rda)", "*.RData;*.rda",
+ "Zip files (*.zip)", "*.zip",
+ "All files (*.*)", "*.*" ), ncol = 2, byrow = TRUE)
+
+rownames(dlgFilters) <- c("R", "emf", "ps", "pdf", "png", "bmp", "jpeg",
+ "txt", "RData", "zip", "All")
+
+## Define the S3 method
+dlgOpen <- function (default, title, multiple = FALSE,
+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
+ ## defaultDir opens the dialog box in that directory
+ ## multi indicates if multiple selection is allowed
+ ## 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.
+ ## Note that caption is also accepted and is then mapped to title
+ ## (for compatibility with choose.files()), but index is ignored: it is
+ ## 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 (!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")
+ ## 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 and file already exists
+ dir <- dirname(default)
+ if (!file.exists(dir) || !file.info(dir)$isdir)
+ stop("Directory of 'default' does not exists (", dir, ")")
+ ## Check that file exists
+ file <- basename(default)
+ if (file != "*.*" && file != "*" && !file.exists(default))
+ stop("File provided as 'default' does not exists (", default, ")")
+ multiple <- isTRUE(as.logical(multiple))
+ if (missing(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")
+ } 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)
+ }
+ gui$setUI(args = list(default = default, title = title,
+ multiple = multiple, filters = filters))
+
+ ## ... and dispatch to the method
+ UseMethod("dlgOpen", gui)
+}
+
+## Used to break the chain of NextMethod(), searching for a usable method
+## in the current context
+dlgOpen.gui <- function (default, title, multiple = FALSE,
+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")
+ stop(msg)
+}
+
+## The pure textual version used as fallback in case no GUI could be used
+dlgOpen.textCLI <- function (default, title, multiple = FALSE,
+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
+ ## Multiple files are separated by commas
+ res <- strsplit(res, ",")[[1]]
+ ## In case we pasted a string with single, or double quotes, or spaces
+ ## eliminate them
+ res <- sub("^['\" ]+", "", sub("['\" ]+$", "", 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) {
+ warning("Only one file was expected... using only the first one")
+ res <- res[1]
+ }
+ ## Check that the file(s) exist
+ isThere <- file.exists(res)
+ if (!any(isThere)) {
+ warning("File(s) do not exist")
+ 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")
+ res <- res[isThere]
+ }
+ if (length(res)) res <- normalizePath(res)
+ gui$setUI(res = res, status = NULL)
+ return(invisible(gui))
+}
+
+## The native version of the file open box
+dlgOpen.nativeGUI <- function (default, title, multiple = FALSE,
+filters = dlgFilters["All", ], ..., gui = .GUI)
+{
+ gui$setUI(widgets = "nativeGUI")
+ ## An 'open file' dialog box
+ ## If cancelled, then return character(0)
+ ## This dialog box is always modal
+ ##
+ ## It is a 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),
+ Darwin = .macDlgOpen(gui$args$default, gui$args$title,
+ gui$args$multiple, gui$args$filters),
+ .unixDlgOpen(gui$args$default, gui$args$title,
+ gui$args$multiple, gui$args$filters)
+ )
+
+ ## Do we need to further dispatch?
+ if (is.null(res)) NextMethod("dlgOpen", gui) else {
+ gui$setUI(res = res, status = NULL)
+ return(invisible(gui))
+ }
+}
+
+## Windows version
+.winDlgOpen <- function (default, title, multiple = FALSE,
+filters = dlgFilters["All", ])
+{
+ res <- choose.files(default = default, caption = title, multi = multiple,
+ filters = filters, index = 1)
+ if (length(res)) res <- gsub("\\\\", "/", res)
+ return(res)
+}
+
+## Mac OS X version
+.macDlgOpen <- function (default, title, multiple = FALSE,
+filters = dlgFilters["All", ])
+{
+ ## TODO: filters are implemented differently on the Mac => how to do this???
+ ## Display a modal file open 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 (multiple) mcmd <- paste(mcmd, "multiple selections allowed true")
+ if (!is.null(default) && default != "") {
+ ## Default must be an existing file or dir... otherwise, the cmd fails!
+ if (!file.exists(default)) default <- dirname(default)
+ ## try a second time...
+ if (!file.exists(default)) default <- dirname(default)
+ if (file.exists(default)) mcmd <- paste(mcmd,
+ " default location \"", default, "\"", sep = "")
+ }
+ if (multiple) {
+ cmd <- paste("-e 'tell application ", app,
+ " to set filenames to choose file ", mcmd,
+ "' -e 'set res to \"\"' -e 'repeat with filename in filenames'",
+ " -e 'set res to res & (POSIX path of filename) & \"\n\"'",
+ " -e 'end repeat' -e 'res'", sep = "")
+ } else {
+ cmd <- paste("-e 'tell application ", app,
+ " 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
+ ## (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 desctroy 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
+ return(res)
+}
+
+## Linux/Unix version
+.unixDlgOpen <- function (default, title, multiple = FALSE,
+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 open selection
+ ## Construct the -file-filter options
+ if (multiple) fcmd <- "--multiple" else fcmd <- ""
+ 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 --title=\"", title,
+ "\" --filename=\"", default, "\" ", fcmd, sep = "")
+ res <- system(msg, intern = TRUE)
+ if (!length(res)) return(character(0)) else
+ return(strsplit(res, "|", fixed = TRUE)[[1]])
+}
Modified: pkg/svDialogs/R/guiDlg.R
===================================================================
--- pkg/svDialogs/R/guiDlg.R 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/R/guiDlg.R 2012-02-11 08:15:41 UTC (rev 431)
@@ -1,145 +1,3 @@
-#dlgOpen <- function (title = "Select file", defaultFile = "",
-#defaultDir = "", multi = FALSE, filters = c("All files (*.*)", "*.*"),
-#parent = 0, GUI = getOption("guiWidgets"))
-#{
-# ## An 'open file(s)' dialog box
-# ## title is used as caption of the dialog box
-# ## defaultFile allows to preselect a file
-# ## defaultDir opens the dialog box in that directory
-# ## multi indicates if multiple selection is allowed
-# ## filters is a n x 2 matrix of characters with description and filter
-# ## for instance: "R or S files" "*.R;*.q"
-# ## unlike Filters in utils, extensions should not be repeated in the
-# ## description, and index is always one (arrange the matrix so that
-# ## the first entry is the one you like as default!)
-# ## parent determines which is the parent window... if 0 then it is system modal
-# ## This dialog box is always modal
-#
-# ## Check arguments
-# if (!inherits(title, "character"))
-# stop("'title' must be a non empty character string!")
-# title <- title[1] # Keep only first item for title
-# if (!inherits(defaultFile, "character"))
-# stop("'defaultFile' must be a non empty character string!")
-# defaultFile <- defaultFile[1] # Keep only first item for defaultFile
-# if (!inherits(defaultDir, "character"))
-# stop("'defaultDir' must be a non empty character string!")
-# defaultDir <- defaultDir[1] # Keep only first item for defaultDir
-# ## If a directory is provided, it must exist
-# if (defaultDir != "")
-# if (!file.exists(defaultDir) || !file.info(defaultDir)$isdir)
-# stop("'defaultDir' must be an existing directory!")
-# if (!is.null(multi) && !is.na(multi)) multi <- (multi == TRUE) else
-# multi <- FALSE
-# ## filters is either a character vector of length 2 or a n * 2 matrix
-# if (inherits(filters, "character"))
-# filters <- matrix(filters, ncol = 2)
-# if (!inherits(filters, "matrix") || mode(filters) != "character" ||
-# ncol(filters) != 2)
-# stop("'filters' must be a n*2 matrix of characters!")
-#### TODO: check 'parent'!
-# if (!inherits(GUI, "character") && !is.null(GUI))
-# stop("'GUI' must be a character string or NULL!")
-#
-# ## Do we need to use a different widget than Tcl/Tk?
-# if (!is.null(GUI) && GUI != "tcltk") { # Custom GUI widgets
-# ## Look for a guiDlgOpen.<GUI> function
-# fun <- paste("guiDlgOpen", GUI, sep=".")
-# if (exists(fun, where = 1, mode = "function", inherits = TRUE)) {
-# res <- get(fun, pos = 1, mode = "function", inherits = TRUE)(
-# title = title, defaultFile = defaultFile, defaultDir = defaultDir,
-# multi = multi, filters = filters, parent = parent)
-# if (!is.null(res)) {
-# return(res)
-# } else warning("Using default Tcl/tk dialog box instead!")
-# }
-# }
-# ## Otherwise, use the default Tcl/Tk dialog box
-# ## In tkgetOpenFile, filters are presented differently!
-# filters <- paste("{\"", filters[, 1], "\" {\"", gsub(";", "\" \"",
-# filters[, 2]), "\"}}", sep = "", collapse = " ")
-# ## Use tkOpenFile()
-#### TODO: parent argument is defined, but not used yet here...
-#### should look how to implement it!
-# res <- tclvalue(tkgetOpenFile(title = title, initialfile = defaultFile,
-# initialdir = defaultDir, multiple = multi, filetypes = filters))
-# if (length(res) == 1 && res == "") res <- character(0)
-# return(res)
-#}
-#
-#dlgSave <- function (title = "Save As", defaultFile = "", defaultDir = "",
-#defaultExt = "", filters = c("All files (*.*)", "*.*"), parent = 0,
-#GUI = getOption("guiWidgets"))
-#{
-# ## A 'save as file' dialog box
-# ## It follows the convention of tkgetSaveFile() under Windows, except for
-# ## filters, where it is similar to filters argument of choose.files()
-# ## defaultFile is a suggested name (and possibly dir for the file)
-# ## defaultDir is the initial directory of the dialog box
-# ## defaultExt is the default extension (if non provided, automatically
-# ## append it to the file name)
-# ## filters is a n x 2 matrix of characters with description and filter
-# ## for instance: "R or S files" "*.R;*.q"
-# ## unlike Filters in utils, extensions should not be repeated in the
-# ## description, and index is always one (arrange the matrix so that
-# ## the first entry is the one you like as default!)
-# ## If the choosen file already exists, ask for confirmation to replace it!
-# ## parent determines which is the parent window... if 0 then it is system modal
-# ## This dialog box is always modal
-#
-# ## Check arguments
-# if (!inherits(title, "character"))
-# stop("'title' must be a non empty character string!")
-# title <- title[1] # Keep only first item for title
-# if (!inherits(defaultFile, "character"))
-# stop("'defaultFile' must be a non empty character string!")
-# defaultFile <- defaultFile[1] # Keep only first item for defaultFile
-# if (!inherits(defaultDir, "character"))
-# stop("'defaultDir' must be a non empty character string!")
-# defaultDir <- defaultDir[1] # Keep only first item for defaultDir
-# ## If a directory is provided, it must exist
-# if (defaultDir != "")
-# if (!file.exists(defaultDir) || !file.info(defaultDir)$isdir)
-# stop("'defaultDir' must be an existing directory!")
-# if (!inherits(defaultExt, "character"))
-# stop("'defaultExt' must be a character string!")
-# defaultExt <- defaultExt[1] # Keep only first item for defaultExt
-# ## filters is either a character vector of length 2 or a n * 2 matrix
-# if (inherits(filters, "character"))
-# filters <- matrix(filters, ncol = 2)
-# if (!inherits(filters, "matrix") || mode(filters) != "character" ||
-# ncol(filters) != 2)
-# stop("'filters' must be a n*2 matrix of characters!")
-#### TODO: check 'parent'!
-# if (!inherits(GUI, "character") && !is.null(GUI))
-# stop("'GUI' must be a character string or NULL!")
-#
-# ## Do we need to use a different widget than Tcl/Tk?
-# if (!is.null(GUI) && GUI != "tcltk") { # Custom GUI widgets
-# ## Look for a guiDlgSave.<GUI> function
-# fun <- paste("guiDlgSave", GUI, sep=".")
-# if (exists(fun, where = 1, mode = "function", inherits = TRUE)) {
-# res <- get(fun, pos = 1, mode = "function", inherits = TRUE)(
-# title = title, defaultFile = defaultFile, defaultDir = defaultDir,
-# defaultExt = defaultExt, filters = filters, parent = parent)
-# if (!is.null(res)) {
-# return(res)
-# } else warning("Using default Tcl/tk dialog box instead!")
-# }
-# }
-# ## Otherwise, use the default Tcl/Tk dialog box
-# ## In tkgetSaveFile, filters are presented differently!
-# filters <- paste("{\"", filters[, 1], "\" {\"", gsub(";", "\" \"",
-# filters[, 2]), "\"}}", sep = "", collapse = " ")
-# ## Use tkSaveFile()
-#### TODO: parent argument is defined, but not used yet here...
-#### should look how to implement it!
-# res <- tclvalue(tkgetSaveFile(title = title, initialfile = defaultFile,
-# initialdir = defaultDir, defaultextension = defaultExt,
-# filetypes = filters))
-# return(res)
-#}
-
## These items still need to be implemented!
#dlgAssistant <- function (...)
#{
Modified: pkg/svDialogs/R/menu.R
===================================================================
--- pkg/svDialogs/R/menu.R 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/R/menu.R 2012-02-11 08:15:41 UTC (rev 431)
@@ -301,7 +301,11 @@
.unixMenuFile <- function ()
{
## Get the name of the file that contains the R menu
- return(file.path(.unixMenuFolder(), paste(Sys.getenv("WINDOWID"),
+ winid <- getTemp(".winid", default = Sys.getenv("WINDOWID"))
+ assignTemp(".winid", winid)
+ user <- getTemp(".user", default = Sys.getenv("USER"))
+ assignTemp(".user", user)
+ return(file.path(.unixMenuFolder(), paste(user, winid,
"Menu.txt", sep = "")))
}
@@ -322,7 +326,11 @@
.unixCtxMenuFile <- function ()
{
## Get the name of the file that contains the R context menu
- return(file.path(.unixMenuFolder(), paste(Sys.getenv("WINDOWID"),
+ winid <- getTemp(".winid", default = Sys.getenv("WINDOWID"))
+ assignTemp(".winid", winid)
+ user <- getTemp(".user", default = Sys.getenv("USER"))
+ assignTemp(".user", user)
+ return(file.path(.unixMenuFolder(), paste(user, winid,
"CtxMenu.txt", sep = "")))
}
@@ -383,7 +391,7 @@
if (cmd == "none" || !is.null(attr(lst[[i]], "state"))) {
cmd <- "NULL" # This is the "no cmd" or "disabled" for ctxmenu
} else {
- cmd <- paste(cmd, "\\r", sep = "")
+ cmd <- paste(cmd, "\\n", sep = "")
cmd <- paste("xvkbd -text", shQuote(cmd))
}
cat("\n", ind, "item=", item, "\n", ind, "cmd=", cmd,
Modified: pkg/svDialogs/R/svDialogs-internal.R
===================================================================
--- pkg/svDialogs/R/svDialogs-internal.R 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/R/svDialogs-internal.R 2012-02-11 08:15:41 UTC (rev 431)
@@ -9,8 +9,14 @@
.onUnload <- function (libpath)
{
- ## Clear menus again
- .menuClear()
+ ## Clear menus
+ try(.menuClear())
}
+.Last.lib <- function (libpath)
+{
+ ## Clear menus
+ try(.menuClear())
+}
+
.packageName <- "svDialogs"
Modified: pkg/svDialogs/TODO
===================================================================
--- pkg/svDialogs/TODO 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/TODO 2012-02-11 08:15:41 UTC (rev 431)
@@ -6,6 +6,3 @@
svDialogs..tcltk.
* Translation into different languages.
-
-* Rename .GUI .UI, make UI() and use it instead? object name is UI. setUI(),
- getUI(), startUI(), endUI(), and should they really be generic functions?
Modified: pkg/svDialogs/man/dlgDir.Rd
===================================================================
--- pkg/svDialogs/man/dlgDir.Rd 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/man/dlgDir.Rd 2012-02-11 08:15:41 UTC (rev 431)
@@ -10,20 +10,17 @@
}
\usage{
-dlgDir(default = getwd(), message, \dots, gui = .GUI)
+dlgDir(default = getwd(), title, \dots, gui = .GUI)
## These should not be called directly
-\method{dlgDir}{gui}(default = getwd(), message, \dots, gui = .GUI)
-\method{dlgDir}{textCLI}(default = getwd(), message, \dots, gui = .GUI)
-\method{dlgDir}{nativeGUI}(default = getwd(), message, \dots, gui = .GUI)
+\method{dlgDir}{gui}(default = getwd(), title, \dots, gui = .GUI)
+\method{dlgDir}{textCLI}(default = getwd(), title, \dots, gui = .GUI)
+\method{dlgDir}{nativeGUI}(default = getwd(), title, \dots, gui = .GUI)
}
\arguments{
\item{default}{ the directory to start with. }
- \item{message}{ a message to display on top of the dialog box. Multiple
- lines are allowed, but avoid it as much as possible because in some
- implementations, only the first line of the message is displayed
- in the title of the dialog box. }
+ \item{title}{ a title to display on top of the dialog box. }
\item{\dots}{ pass further arguments to methods. }
\item{gui}{ the 'gui' object concerned by this dialog box. }
}
@@ -36,7 +33,7 @@
\author{Philippe Grosjean (\email{phgrosjean at sciviews.org})}
-%\seealso{ \code{\link{dlgOpen}}, \code{\link{dlgSave}} }
+\seealso{ \code{\link{dlgOpen}}, \code{\link{dlgSave}} }
\examples{
### A quick default directory changer
Modified: pkg/svDialogs/man/dlgMessage.Rd
===================================================================
--- pkg/svDialogs/man/dlgMessage.Rd 2012-02-08 08:59:39 UTC (rev 430)
+++ pkg/svDialogs/man/dlgMessage.Rd 2012-02-11 08:15:41 UTC (rev 431)
@@ -3,6 +3,8 @@
\alias{dlgMessage.gui}
\alias{dlgMessage.textCLI}
\alias{dlgMessage.nativeGUI}
+\alias{msgBox}
+\alias{okCancelBox}
\title{ Display a message box }
\description{
@@ -12,6 +14,8 @@
\usage{
dlgMessage(message, type = c("ok", "okcancel", "yesno", "yesnocancel"),
\dots, gui = .GUI)
+msgBox(message)
+okCancelBox(message)
## These should not be called directly
\method{dlgMessage}{gui}(message, type = c("ok", "okcancel", "yesno", "yesnocancel"),
@@ -35,6 +39,8 @@
The modified 'gui' object is returned invisibly. A string with the name of
the button ("ok", "cancel", "yes" or "no") that the user pressed can be
obtained from \code{gui$res} (see example).
+ \code{msgBox()} just returns the name of the button (ok), while okCancelBox()
+ returns \code{TRUE} if ok was clicked or \code{FALSE} if cancel was clicked.
}
\author{Philippe Grosjean (\email{phgrosjean at sciviews.org})}
@@ -54,6 +60,10 @@
## Idem, but one can interrupt too
res <- dlgMessage("Do you like oranges?", "yesnocancel")$res
if (res == "cancel") cat("Ah, ah! You refuse to answer!\n")
+
+## Simpler version with msgBox and okCancelBox
+msgBox("Information message") # Use this to interrupt script and inform user
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 431
More information about the Sciviews-commits
mailing list