[Sciviews-commits] r480 - in pkg/svDialogs: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun May 6 21:40:21 CEST 2012
Author: phgrosjean
Date: 2012-05-06 21:40:20 +0200 (Sun, 06 May 2012)
New Revision: 480
Modified:
pkg/svDialogs/DESCRIPTION
pkg/svDialogs/NEWS
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/dlgSave.R
pkg/svDialogs/R/menu.R
pkg/svDialogs/R/svDialogs-internal.R
pkg/svDialogs/inst/NEWS.Rd
pkg/svDialogs/man/menu.Rd
pkg/svDialogs/man/svDialogs-package.Rd
Log:
Add support for JGR in svDialogs
Modified: pkg/svDialogs/DESCRIPTION
===================================================================
--- pkg/svDialogs/DESCRIPTION 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/DESCRIPTION 2012-05-06 19:40:20 UTC (rev 480)
@@ -1,7 +1,7 @@
Package: svDialogs
Type: Package
-Version: 0.9-52
-Date: 2012-04-04
+Version: 0.9-53
+Date: 2012-05-05
Title: SciViews GUI API - Dialog boxes
Authors at R: c(person("Philippe", "Grosjean", role = c("aut", "cre"),
email = "phgrosjean at sciviews.org"))
Modified: pkg/svDialogs/NEWS
===================================================================
--- pkg/svDialogs/NEWS 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/NEWS 2012-05-06 19:40:20 UTC (rev 480)
@@ -1,5 +1,12 @@
= svDialogs News
+== Changes in svDialogs 0.9-53
+
+* Added support for JGR in dialog boxes under Mac OS X.
+
+* The menuXXX() functions can manage menus and submenus in JGR.
+
+
== Changes in svDialogs 0.9-52
* menuXXX() functions do not generate files in \tmp dir on Linux, unless in
Modified: pkg/svDialogs/R/dlgDir.R
===================================================================
--- pkg/svDialogs/R/dlgDir.R 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/R/dlgDir.R 2012-05-06 19:40:20 UTC (rev 480)
@@ -107,7 +107,7 @@
{
## Display a modal directory selector with native Mac dialog box
if (.Platform$GUI == "AQUA") app <- "(name of application \"R\")" else
- app <- "\"Terminal\""
+ if (.isJGR()) app <- "\"JGR\"" else app <- "\"Terminal\""
## Avoid displaying warning message when the user clicks on 'Cancel'
owarn <- getOption("warn")
on.exit(options(warn = owarn))
Modified: pkg/svDialogs/R/dlgInput.R
===================================================================
--- pkg/svDialogs/R/dlgInput.R 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/R/dlgInput.R 2012-05-06 19:40:20 UTC (rev 480)
@@ -74,7 +74,7 @@
{
## Display a modal message with native Mac dialog box
if (.Platform$GUI == "AQUA") app <- "(name of application \"R\")" else
- app <- "\"Terminal\""
+ if (.isJGR()) app <- "\"JGR\"" else app <- "\"Terminal\""
## Avoid displaying warning message when the user clicks on 'Cancel'
owarn <- getOption("warn")
on.exit(options(warn = owarn))
Modified: pkg/svDialogs/R/dlgList.R
===================================================================
--- pkg/svDialogs/R/dlgList.R 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/R/dlgList.R 2012-05-06 19:40:20 UTC (rev 480)
@@ -102,32 +102,34 @@
preselect <- choices[1]
return(select.list(choices = choices, preselect = preselect,
multiple = multiple, title = title, graphics = TRUE))
- } else { # Probably run from terminal, use osascript to display the list box
- ## Make sure to keep only first preselection if !multiple
- if (!multiple) preselect <- preselect[1]
- ## Format preselect into a single character string
- sel <- paste('"', preselect, ' "', sep = "", collapse = ",")
- ## Format choices in a single string
- items <- paste('"', choices, ' "', sep = "", collapse = ",")
- ## Default title
- if (is.null(title)) if (multiple) title <- "Select one or more" else
- title <- "Select one"
- ## Avoid displaying warning message when the user clicks on 'Cancel'
- owarn <- getOption("warn")
- on.exit(options(warn = owarn))
- options(warn = -1)
- cmd <- paste("-e 'tell application \"Terminal\" to choose from list {",
- items, "} with title \"Make your selection\" with prompt \"", title,
- "\" multiple selections allowed ", multiple, " default items {",
- sel, "}'", sep = "")
- #res <- system2("osascript", cmd, stdout = TRUE, stderr = TRUE, wait = TRUE)
- res <- system(paste("osascript", cmd), intern = TRUE, wait = TRUE)
- if (res == "false") {
- return(character(0))
- } else {
- res <- unlist(strsplit(sub(" $", "", res), " , ", fixed = TRUE))
- return(res)
- }
+ } else if (.isJGR()) { # This seems to be JGR
+ app <- "JGR"
+ } else app <- "Terminal" # Probably run from terminal
+ ## Use osascript to display the list box
+ ## Make sure to keep only first preselection if !multiple
+ if (!multiple) preselect <- preselect[1]
+ ## Format preselect into a single character string
+ sel <- paste('"', preselect, ' "', sep = "", collapse = ",")
+ ## Format choices in a single string
+ items <- paste('"', choices, ' "', sep = "", collapse = ",")
+ ## Default title
+ if (is.null(title)) if (multiple) title <- "Select one or more" else
+ title <- "Select one"
+ ## Avoid displaying warning message when the user clicks on 'Cancel'
+ owarn <- getOption("warn")
+ on.exit(options(warn = owarn))
+ options(warn = -1)
+ cmd <- paste("-e 'tell application \"", app, "\" to choose from list {",
+ items, "} with title \"Make your selection\" with prompt \"", title,
+ "\" multiple selections allowed ", multiple, " default items {",
+ sel, "}'", sep = "")
+ #res <- system2("osascript", cmd, stdout = TRUE, stderr = TRUE, wait = TRUE)
+ res <- system(paste("osascript", cmd), intern = TRUE, wait = TRUE)
+ if (res == "false") {
+ return(character(0))
+ } else {
+ res <- unlist(strsplit(sub(" $", "", res), " , ", fixed = TRUE))
+ return(res)
}
}
Modified: pkg/svDialogs/R/dlgMessage.R
===================================================================
--- pkg/svDialogs/R/dlgMessage.R 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/R/dlgMessage.R 2012-05-06 19:40:20 UTC (rev 480)
@@ -102,7 +102,7 @@
{
## Display a modal message with native Mac dialog box
if (.Platform$GUI == "AQUA") app <- "(name of application \"R\")" else
- app <- "\"Terminal\""
+ if (.isJGR()) app <- "\"JGR\"" else app <- "\"Terminal\""
type <- match.arg(type)
buttons <- switch(type,
ok = "\"OK\"",
Modified: pkg/svDialogs/R/dlgOpen.R
===================================================================
--- pkg/svDialogs/R/dlgOpen.R 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/R/dlgOpen.R 2012-05-06 19:40:20 UTC (rev 480)
@@ -174,7 +174,7 @@
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\""
+ if (.isJGR()) app <- "\"JGR\"" else app <- "\"Terminal\""
## Avoid displaying warning message when the user clicks on 'Cancel'
owarn <- getOption("warn")
on.exit(options(warn = owarn))
Modified: pkg/svDialogs/R/dlgSave.R
===================================================================
--- pkg/svDialogs/R/dlgSave.R 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/R/dlgSave.R 2012-05-06 19:40:20 UTC (rev 480)
@@ -140,7 +140,7 @@
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\""
+ if (.isJGR()) app <- "\"JGR\"" else app <- "\"Terminal\""
## Avoid displaying warning message when the user clicks on 'Cancel'
owarn <- getOption("warn")
on.exit(options(warn = owarn))
Modified: pkg/svDialogs/R/menu.R
===================================================================
--- pkg/svDialogs/R/menu.R 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/R/menu.R 2012-05-06 19:40:20 UTC (rev 480)
@@ -1,6 +1,7 @@
## Menu functions
.menuClear <- function ()
{
+ if (.isJGR()) return(invisible(NULL))
res <- switch(Sys.info()["sysname"],
Windows = NULL,
Darwin = .macMenuClear(),
@@ -11,6 +12,7 @@
.menuFileInit <- function ()
{
+ if (.isJGR()) return(invisible(NULL))
res <- switch(Sys.info()["sysname"],
Windows = NULL,
Darwin = NULL, # TODO: should we have a default menu?
@@ -36,6 +38,7 @@
if (length(menuname) != 1)
stop("'menuname' must be a single character string")
+ ## TODO: this is not allowed in JGR!
## $ConsoleMain/<menu> is equivalent, and thus, transformed into <menu>
menuname <- sub("^\\$ConsoleMain/", "", menuname)
@@ -55,6 +58,7 @@
menuNames <- function ()
{
+ if (.isJGR()) return(.jgrMenuNames())
res <- switch(Sys.info()["sysname"],
Windows = winMenuNames(),
Darwin = .macMenuNames(),
@@ -67,6 +71,7 @@
{
menuname <- .checkMenuName(menuname)
+ if (.isJGR()) return(.jgrMenuItems(menuname))
res <- switch(Sys.info()["sysname"],
Windows = winMenuItems(menuname),
Darwin = .macMenuItems(menuname),
@@ -79,6 +84,7 @@
{
menuname <- .checkMenuName(menuname)
+ if (.isJGR()) return(invisible(.jgrMenuAdd(menuname)))
res <- switch(Sys.info()["sysname"],
Windows = winMenuAdd(menuname),
Darwin = .macMenuAdd(menuname),
@@ -91,6 +97,7 @@
{
menuname <- .checkMenuName(menuname)
+ if (.isJGR()) return(invisible(.jgrMenuAddItem(menuname, itemname, action)))
res <- switch(Sys.info()["sysname"],
Windows = .winMenuAddItem(menuname, itemname, action),
Darwin = .macMenuAddItem(menuname, itemname, action),
@@ -103,6 +110,7 @@
{
menuname <- .checkMenuName(menuname)
+ if (.isJGR()) return(invisible(.jgrMenuDel(menuname)))
res <- switch(Sys.info()["sysname"],
Windows = try(winMenuDel(menuname), silent = TRUE),
Darwin = .macMenuDel(menuname),
@@ -115,6 +123,7 @@
{
menuname <- .checkMenuName(menuname)
+ if (.isJGR()) return(invisible(.jgrMenuDelItem(menuname, itemname)))
res <- switch(Sys.info()["sysname"],
Windows = try(winMenuDelItem(menuname, itemname), silent = TRUE),
Darwin = .macMenuDelItem(menuname, itemname),
@@ -124,6 +133,483 @@
}
+## JGR menus manipulation functions
+## The default menus in JGR (for consistence with other implementations, we
+## don't want to see them!)
+.jgrDefaultMenus <-
+ c("File", "Edit", "Workspace", "Packages & Data", "Window", "Help")
+
+.jgrMenuMem <- function ()
+{
+ ## Get an environment with info about JGR menus I cannot get otherwise
+ ## Basically, I keep track of two things here:
+ ## 1) which menu action is related to which menu entry
+ ## 2) for separators, names can be any number of '-', but it is only '-'
+ ## in JGR => keep track of the correspondance!
+ mnu <- getTemp(".jgrMenuMem")
+ if (is.null(mnu)) {
+ mnu <- new.env()
+ assignTemp(".jgrMenuMem", mnu)
+ }
+ return(mnu)
+}
+
+.jgrMenuMemAdd <- function (menuname, itemname, action)
+{
+ e <- .jgrMenuMem()
+ e[[paste(menuname, itemname, sep = "//")]] <- action
+}
+
+.jgrMenuMemGet <- function (menuname, itemname)
+{
+ e <- .jgrMenuMem()
+ e[[paste(menuname, itemname, sep = "//")]]
+}
+
+.jgrMenuMemDel <- function (menuname, itemname)
+{
+ e <- .jgrMenuMem()
+ item <- paste(menuname, itemname, sep = "//")
+ if (exists(item, envir = e, inherits = FALSE)) rm(list = item, envir = e)
+}
+
+## I redefine the jgr.XXX() function here because I don't want to depend
+## on JGR in this package (too much trouble on install of JGR and I never
+## want to force users of svDialogs to install JGR)
+.jgr.register.function <- function (fun)
+{
+ if (is.null(.GlobalEnv$.jgr.user.functions))
+ .GlobalEnv$.jgr.user.functions <- list()
+ fnc <- length(.GlobalEnv$.jgr.user.functions) + 1
+ .GlobalEnv$.jgr.user.functions[[fnc]] <- fun
+ paste(".jgr.user.functions[[", fnc, "]]()", sep = "")
+}
+
+.jgr.getMenuNames <- function ()
+{
+ if (!.isJGR()) {
+ cat(".jgr.getMenuNames() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ J <- function (...) return() # Just to avoir R CMD check warning
+ }
+ J("org/rosuda/JGR/JGR")$getMenuNames()
+}
+
+.jgr.getMenuItemNames <- function (menu)
+{
+ if (!.isJGR()) {
+ cat("/jgr.getMenuItemNames() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ J <- function (...) return() # Just to avoir R CMD check warning
+ }
+ J("org/rosuda/JGR/JGR")$getMenuItemNames(as.character(menu))
+}
+
+.jgr.addMenu <- function (name)
+{
+ if (!.isJGR()) {
+ cat(".jgr.addMenu() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ .jcall <- function (...) return() # Just to avoir R CMD check warning
+ }
+ invisible(.jcall("org/rosuda/JGR/JGR", "V", "addMenu", as.character(name)))
+}
+
+.jgr.insertMenu <- function (name, index)
+{
+ if (!.isJGR()) {
+ cat(".jgr.insertMenu() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ .jcall <- function (...) return() # Just to avoir R CMD check warning
+ }
+ invisible(.jcall("org/rosuda/JGR/JGR", "V", "insertMenu",
+ as.character(name), as.integer(index - 1)))
+}
+
+.jgr.addMenuItem <- function (menu, name, command, silent = TRUE)
+{
+ if (!.isJGR()) {
+ cat(".jgr.addMenuItem() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ .jcall <- function (...) return() # Just to avoir R CMD check warning
+ }
+ if (is.function(command))
+ command <- .jgr.register.function(command)
+ invisible(.jcall("org/rosuda/JGR/JGR", "V", "addMenuItem",
+ as.character(menu), as.character(name), as.character(command),
+ as.logical(silent)))
+}
+
+.jgr.insertMenuItem <- function (menu, name, command, index, silent = TRUE)
+{
+ if (!.isJGR()) {
+ cat(".jgr.insertMenuItem() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ .jcall <- function (...) return() # Just to avoir R CMD check warning
+ }
+ if (is.function(command))
+ command <- .jgr.register.function(command)
+ invisible(.jcall("org/rosuda/JGR/JGR", "V", "insertMenuItem",
+ as.character(menu), as.character(name), as.character(command),
+ as.logical(silent), as.integer(index - 1)))
+}
+
+.jgr.addMenuSeparator <- function (menu)
+{
+ if (!.isJGR()) {
+ cat(".jgr.addMenuSeparator() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ .jcall <- function (...) return() # Just to avoir R CMD check warning
+ }
+ invisible(.jcall("org/rosuda/JGR/JGR", "V", "addMenuSeparator",
+ as.character(menu)))
+}
+
+.jgr.insertMenuSeparator <- function (menu, index)
+{
+ if (!.isJGR()) {
+ cat(".jgr.insertMenuSeparator() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ .jcall <- function (...) return() # Just to avoir R CMD check warning
+ }
+ invisible(.jcall("org/rosuda/JGR/JGR", "V", "insertMenuSeparator",
+ as.character(menu), as.integer(index - 1)))
+}
+
+.jgr.addSubMenu <- function (menu, subMenuName, labels, commands)
+{
+ if (!.isJGR()) {
+ cat(".jgr.addSubMenu() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ J <- function (...) return() # Just to avoir R CMD check warning
+ }
+ invisible(J("org/rosuda/JGR/JGR")$addSubMenu(menu, subMenuName,
+ labels, commands))
+}
+
+## There seems to be a bug in the original jgr.insertSubMenu() function
+.jgr.insertSubMenu <- function (menu, subMenuName, labels, commands, index)
+{
+ if (!.isJGR()) {
+ cat(".jgr.addSubMenu() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ J <- function (...) return() # Just to avoir R CMD check warning
+ }
+ invisible(J("org/rosuda/JGR/JGR")$insertSubMenu(menu, subMenuName,
+ as.integer(index - 1), labels, commands))
+}
+
+.jgr.removeMenu <- function (index)
+{
+ if (!.isJGR()) {
+ cat(".jgr.removeMenu() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ J <- function (...) return() # Just to avoir R CMD check warning
+ }
+ J("org/rosuda/JGR/JGR")$removeMenu(as.integer(index - 1))
+}
+
+.jgr.removeMenuItem <- function (menu, index)
+{
+ if (!.isJGR()) {
+ cat(".jgr.removeMenuItem() cannot be used outside JGR.\n")
+ return(invisible(NULL))
+ J <- function (...) return() # Just to avoir R CMD check warning
+ }
+ J("org/rosuda/JGR/JGR")$removeMenuItem(as.character(menu),
+ as.integer(index - 1))
+}
+
+.jgrRun <- function (cmd, envir = .GlobalEnv)
+{
+ ## This function is used for submenus where it is not currently possible
+ ## to declare silent = FALSE
+ ## Basically, it prints the command, then, evaluate it, capturing output
+ ## and finally, it prints that output
+ cat("> ", deparse(substitute(cmd)), "\n", sep = "")
+ res <- capture.output(cmd)
+ cat(res)
+ cat("\n")
+}
+
+## Prepare a command to be printed more or less correctly on screen
+## for JGR submenus
+.jgrAction <- function (cmd) paste("svDialogs:::.jgrRun(", cmd, ")", sep = "")
+
+## Implementation of JGR menus manipulation
+.jgrMenuNames <- function ()
+{
+ ## For consistency with the other implementations, do not return
+ ## the stadard menus File, Edit, Workspace, Packages & Data, Window, Help
+ res <- .jgr.getMenuNames()
+ res <- res[!res %in% .jgrDefaultMenus]
+ return(res)
+}
+
+.jgrMenuItems <- function (menuname)
+{
+ ## For consistency with the other implementations, return character(0)
+ res <- try(.jgr.getMenuItemNames(menuname), silent = TRUE)
+ ## if the menu is not found
+ if (inherits(res, "try-error")) return(character(0)) else return(res)
+}
+
+.jgrMenuAdd <- function (menuname)
+{
+ ## In JGR, one accepts only menus and one level of submenus... and
+ ## submenus are managed in a quite different way!
+ ## For compatibility, we allow to use menu/submenu
+ mnu <- strsplit(menuname[1], "/", fixed = TRUE)[[1]]
+ l <- length(mnu)
+ if (l == 0) return(invisible(NULL))
+
+ .addTopMenu <- function (topmenu) {
+ if (!topmenu %in% .jgr.getMenuNames()) # Here, we check all JGR menus!
+ .jgr.addMenu(topmenu)
+ }
+
+ if (l == 1) {
+ .addTopMenu(mnu)
+ return(invisible(NULL))
+ }
+ if (l > 2) stop("Only one submenu level allowed on JGR")
+ ## Make sure the topmenu is define, and add an empty submenu to it
+ .addTopMenu(mnu[1])
+ .jgr.addSubMenu(mnu[1], mnu[2], character(0), character(0))
+ return(invisible(NULL))
+}
+
+.jgrMenuAddItem <- function (menuname, itemname, action)
+{
+ ## In JGR, one accepts only menus and one level of submenus... and
+ ## submenus are managed in a quite different way!
+ ## For compatibility, we allow to use menu/submenu
+ mnu <- strsplit(menuname[1], "/", fixed = TRUE)[[1]]
+ l <- length(mnu)
+ if (l == 0) return(invisible(NULL)) # Nothing to do...
+
+ silent <- FALSE
+ ## Special cases for "none", no action associated with this menu
+ if (action == "none") {
+ action <- ""
+ silent <- TRUE
+ }
+ ## Replace \n by \\n, and \t by \\t
+ action <- gsub("\n", "\\\\n", action)
+ action <- gsub("\t", "\\\\t", action)
+
+ if (l == 1) {
+ ## First, make sure the menu exists
+ .jgrMenuAdd(mnu)
+ ## Are we trying to add a separator?
+ if (grepl("^-+$", itemname)) { # This must be a separator
+ .jgr.addMenuSeparator(mnu)
+ } else { # This must be a menu entry
+ ## Is the menu entry already implemented?
+ items <- .jgrMenuItems(mnu)
+ if (itemname %in% items) {
+ ## Delete and recreate it with the new action
+ idx <- (1:length(items))[items == itemname][1]
+ .jgr.removeMenuItem(mnu, idx)
+ if (action == "enable")
+ action <- .jgrMenuMemGet(mnu, itemname)
+ if (is.null(action)) action <- ""
+ if (action == "disable") {
+ action <- 'cat("- disabled menu item...\n")'
+ silent <- TRUE
+ .jgr.insertMenuItem(mnu, itemname, action, idx,
+ silent = silent)
+ ## Don't change action in .jgrMenus() so that we can
+ ## recover it with "enable"!
+ } else {
+ .jgr.insertMenuItem(mnu, itemname, action, idx,
+ silent = silent)
+ .jgrMenuMemAdd(mnu, itemname, action)
+ }
+ } else {
+ ## This is a new item => just add it
+ if (action == "enable") action <- ""
+ if (action == "disable") {
+ action <- 'cat("- disabled menu item...\n")'
+ silent <- TRUE
+ .jgr.addMenuItem(mnu, itemname, action, silent = silent)
+ .jgrMenuMemAdd(mnu, itemname, "")
+ } else {
+ .jgr.addMenuItem(mnu, itemname, action, silent = silent)
+ .jgrMenuMemAdd(mnu, itemname, action)
+ }
+ }
+ }
+ return(invisible(NULL))
+ }
+
+ if (l == 2) {
+ ## We add an entry in a submenu. In JGR, we must delete and
+ ## reconstruct the submenu entirely!
+ ## Does this submenu already exists?
+ ## (note: in JGR it can be a menu entry as well!)
+ items <- .jgrMenuItems(mnu[1])
+ if (mnu[2] %in% items) { # The submenu already exists...
+ ## Delete it and reconstruct it with the added or changed item
+ idx <- (1:length(items))[items == mnu[2]][1]
+ .jgr.removeMenuItem(mnu[1], idx)
+ ## Get the list of entries in the submenu from .jgrMenus
+ ## (how to get it otherwise???)
+ actions <- .jgrMenuMemGet(mnu[1], mnu[2])
+ if (is.null(actions)) { # Apparently nothing in there yet
+ if (action == "enable") action <- ""
+ if (action == "disable") {
+ action <- 'cat("- disabled menu item...\n")'
+ .jgr.insertSubMenu(mnu[1], mnu[2], c(itemname, "-"),
+ c(action, ""), idx)
+ actions <- ""
+ } else {
+ action <- .jgrAction(action)
+ .jgr.insertSubMenu(mnu[1], mnu[2], c(itemname, "-"),
+ c(action, ""), idx)
+ actions <- action
+ }
+ names(actions) <- itemname
+ .jgrMenuMemAdd(mnu[1], mnu[2], actions)
+ } else { # There are already items in this submenu
+ if (action == "disable") { # We want to disable one action
+ if (!itemname %in% names(actions))
+ return(invisible(NULL))
+ actions[[itemname]] <- 'cat("- disabled menu item...\n")'
+ if (length(actions) == 1) {
+ .jgr.insertSubMenu(mnu[1], mnu[2],
+ c(names(actions), "-"), c(actions, ""), idx)
+ } else {
+ .jgr.insertSubMenu(mnu[1], mnu[2],
+ names(actions), actions, idx)
+ }
+ } else if (action == "enable") {
+ if (!itemname %in% names(actions))
+ return(invisible(NULL))
+ if (length(actions) == 1) {
+ .jgr.insertSubMenu(mnu[1], mnu[2],
+ c(names(actions), "-"), c(actions, ""), idx)
+ } else {
+ .jgr.insertSubMenu(mnu[1], mnu[2],
+ names(actions), actions, idx)
+ }
+ } else { # An action is defined
+ actions[[itemname]] <- .jgrAction(action)
+ if (length(actions) == 1) {
+ .jgr.insertSubMenu(mnu[1], mnu[2],
+ c(names(actions), "-"), c(actions, ""), idx)
+ } else {
+ .jgr.insertSubMenu(mnu[1], mnu[2],
+ names(actions), actions, idx)
+ }
+ .jgrMenuMemAdd(mnu[1], mnu[2], actions)
+ }
+ }
+ } else { # The submenu does not exists yet, create it now
+ ## First, make sure the top menu exists
+ .jgrMenuAdd(mnu[1])
+ if (action == "enable") action <- ""
+ if (action == "disable") {
+ action <- 'cat("- disabled menu item...\n")'
+ .jgr.addSubMenu(mnu[1], mnu[2], c(itemname, "-"), c(action, ""))
+ actions <- ""
+ } else {
+ action <- .jgrAction(action)
+ .jgr.addSubMenu(mnu[1], mnu[2], c(itemname, "-"), c(action, ""))
+ actions <- action
+ }
+ names(actions) <- itemname
+ .jgrMenuMemAdd(mnu[1], mnu[2], actions)
+ }
+ return(invisible(NULL))
+ }
+
+ if (l > 2) stop("Only one submenu level allowed on JGR")
+}
+
+.jgrMenuDel <- function (menuname)
+{
+ ## In JGR, one accepts only menus and one level of submenus... and
+ ## submenus are managed in a quite different way!
+ ## For compatibility, we allow to use menu/submenu
+ mnu <- strsplit(menuname[1], "/", fixed = TRUE)[[1]]
+ l <- length(mnu)
+ if (l == 0) return(invisible(NULL))
+
+ if (l == 1) {
+ if (mnu %in% .jgrDefaultMenus) # Do not allow to delete default menus
+ return(invisible(NULL))
+ ## Get the position of this menu and make sure it is not a default menu!
+ allmnu <- .jgr.getMenuNames()
+ allpos <- 1:length(allmnu)
+ pos <- allpos[allmnu == mnu]
+ if (!length(pos)) return(invisible(NULL)) # Not found
+ pos <- rev(pos)[1]
+ .jgr.removeMenu(pos)
+ }
+ if (l == 2) # Remove a submenu (note, that for JGR, this is the same as removing a menu item!)
+ .jgrMenuDelItem(mnu[1], mnu[2])
+ ## If there are more levels, do nothing because these submenus do not exist!
+ return(invisible(NULL))
+}
+
+.jgrMenuDelItem <- function (menuname, itemname)
+{
+ ## On JGR, all separators are named "-", but on, e.g., Windows, I must
+ ## use a different name for each separator => What should we do???
+ ## Here, we consider '-' for the first one, '--' for the second one, etc.
+ mnu <- strsplit(menuname[1], "/", fixed = TRUE)[[1]]
+ l <- length(mnu)
+ if (l == 0) return(invisible(NULL))
+
+ if (l == 1) {
+ ## Are we trying to delete a separator?
+ items <- .jgrMenuItems(mnu)
+ if (grepl("^-+$", itemname)) { # This must be a separator
+ isSep <- items == "-"
+ posSep <- (1:length(items))[isSep]
+ ## Depending on the number of minus signs we try to remove
+ ## first, second, etc. separator
+ nsep <- nchar(itemname)
+ if (length(posSep) < nsep) return(invisible(NULL))
+ idx <- posSep[nsep]
+ } else { # This must be a menu entry
+ idx <- (1:length(items))[itemname == items]
+ }
+ if (!length(idx)) return(invisible(NULL))
+ .jgr.removeMenuItem(mnu, idx)
+ .jgrMenuMemDel(mnu, itemname)
+ }
+
+ if (l == 2) {
+ ## We want to eliminate an item from a submenu. In JGR, there is no
+ ## function for that, but we can delete and recreate the submenu
+ ## without this item!
+ items <- .jgrMenuItems(mnu[1])
+ if (!mnu[2] %in% items) return(invisible(NULL)) # Submenu not there
+ ## Get the list of submenus currently defined from our cache version
+ actions <- .jgrMenuMemGet(mnu[1], mnu[2])
+ if (is.null(actions) || !itemname %in% names(actions)) # Apparently not there
+ return(invisible(NULL))
+ ## Delete and reconstruct the submenu without itemname
+ idx <- (1:length(items))[items == mnu[2]][1]
+ .jgr.removeMenuItem(mnu[1], idx)
+ ## Recreate the submenu after eliminating itemname
+ actions <- actions[names(actions) != itemname]
+ if (!length(actions)) {
+ .jgr.insertSubMenu(mnu[1], mnu[2], character(0), character(0), idx)
+ } else if (length(actions) == 1) {
+ .jgr.insertSubMenu(mnu[1], mnu[2], c(names(actions), "-"),
+ c(actions, ""), idx)
+ } else {
+ .jgr.insertSubMenu(mnu[1], mnu[2], names(actions), actions, idx)
+ }
+ .jgrMenuMemAdd(mnu[1], mnu[2], actions)
+ }
+ return(invisible(NULL)) # Not more than one submenu level allowed!
+}
+
+
## Windows version and standard winMenuXXX
## TODO: fallback system for Rterm???
.winMenuAddItem <- function (menuname, itemname, action)
@@ -165,7 +651,7 @@
}
.macMenuClear <- function () {
- stop("Not implemented yet!")
+ stop("Not implemented yet!")
# ## To be called when svDialogs package loads: make sure to zap all
# ## custom menu items that may have been previously defined
@@ -204,7 +690,7 @@
.macMenuAddItem <- function (menuname, itemname, action)
{
- stop("Not implemented yet!")
+ stop("Not implemented yet!")
# ## TODO: manage 'enable' and 'disable'!!!
# ## Make sure that the dir is created
@@ -246,7 +732,7 @@
.macMenuDel <- function (menuname)
{
- stop("Not implemented yet!")
+ stop("Not implemented yet!")
# ## Unlink does not like ~ => change working dir first
# odir <- getwd()
@@ -270,7 +756,6 @@
}
-
## This holds the custom menu structure in an R object
.Rmenu <- function ()
{
Modified: pkg/svDialogs/R/svDialogs-internal.R
===================================================================
--- pkg/svDialogs/R/svDialogs-internal.R 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/R/svDialogs-internal.R 2012-05-06 19:40:20 UTC (rev 480)
@@ -22,3 +22,5 @@
}
.packageName <- "svDialogs"
+
+.isJGR <- function () "package:JGR" %in% search()
Modified: pkg/svDialogs/inst/NEWS.Rd
===================================================================
--- pkg/svDialogs/inst/NEWS.Rd 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/inst/NEWS.Rd 2012-05-06 19:40:20 UTC (rev 480)
@@ -1,9 +1,17 @@
\name{NEWS}
\title{NEWS file for the svDialogs package}
+\section{Changes in version 0.9-53}{
+ \itemize{
+ \item{ Added support for \preformatted{JGR} in dialog boxes under Mac OS X. }
+
+ \item{ The \code{menuXXX()} functions can manage menus and submenus in JGR. }
+ }
+}
+
\section{Changes in version 0.9-52}{
\itemize{
- \item{ \code{menuXXX()} functions do not generate files in
+ \item{ \code{menuXXX()} functions do not generate files in
\preformatted{tmp} dir on Linux, unless in \code{interactive()} session,
and with explicit user's acknowledgement. Moreover, the user name is not
used anymore as part of the name of the temporary files generated (cf CRAN
@@ -17,13 +25,13 @@
\section{Changes in version 0.9-51}{
\itemize{
- \item{ NEWS file reworked to use the new Rd format. }
+ \item{ NEWS file reworked to use the new Rd format. }
}
}
\section{Changes in version 0.9-50}{
\itemize{
- \item{ Slight changes in flexible dialog functions according to notes
+ \item{ Slight changes in flexible dialog functions according to notes
generated by \preformatted{R CMD check} (2.15.0), i.e., partial matching
of argument env(ir) and use of \code{.Internal} in \code{eval.with.vis()};
replaced by the function \code{withVisible()}. }
@@ -32,7 +40,7 @@
\section{Changes in version 0.9-49}{
\itemize{
- \item{ Added \code{dlgForm()} for flexible form dialog box. Only the Linux
+ \item{ Added \code{dlgForm()} for flexible form dialog box. Only the Linux
implementation using \code{yad} and the textual version are currently
done. }
}
@@ -40,7 +48,7 @@
\section{Changes in version 0.9-48}{
\itemize{
- \item{ Argument message is changed to title in \code{dlgDir()} function, to
+ \item{ Argument message is changed to title in \code{dlgDir()} function, to
match corresponding argument in \code{dlgOpen()} and \code{dlgSave()} and
also to indicate it can only be a single line of text. }
@@ -64,7 +72,7 @@
\section{Changes in version 0.9-47}{
\itemize{
- \item{ Now, \code{menuAddItem()} implements \code{'enable'} and
+ \item{ Now, \code{menuAddItem()} implements \code{'enable'} and
\code{'disable'} in action to change the state of an existing menu item. }
\item{ On Windows, using an action as \code{'enable'} or \code{'disable'} on
@@ -92,7 +100,7 @@
\section{Changes in version 0.9-46}{
\itemize{
- \item{ The functions to handle menus in Linux are completely rewritten to
+ \item{ The functions to handle menus in Linux are completely rewritten to
use a menu configuration file that a modified version of myGtkMenu (named
ctxmenu) can read and interpret to display the corresponding menus. }
}
@@ -100,7 +108,7 @@
\section{Changes in version 0.9-45}{
\itemize{
- \item{ Similar custom menus as \code{winMenuXXX()} functions are added and
+ \item{ Similar custom menus as \code{winMenuXXX()} functions are added and
allow to add custom menus on the Mac (both R.app and terminal) and for R
run on a Gnome desktop, providing the system is configured to manage such
menus, see \code{?menuAdd}. }
@@ -109,11 +117,11 @@
\section{Changes in version 0.9-44}{
\itemize{
- \item{ The \code{guiDlgXXX()} functions are reworked into S3 methods and
+ \item{ The \code{guiDlgXXX()} functions are reworked into S3 methods and
their interface changes. To avoid any confusion, they are renamed
\code{dlgXXX()}. }
- \item{ \code{dlgMessage()} is reworked into native dialog box, but it looses
+ \item{ \code{dlgMessage()} is reworked into native dialog box, but it looses
a couple of options during the process (title, icon, parent). The previous
code is now moved to \pkg{svDialogstcltk}. }
@@ -133,27 +141,27 @@
\section{Changes in version 0.9-43}{
\itemize{
- \item{ The \pkg{tcltk} \R package is moved from depends to imports. }
+ \item{ The \pkg{tcltk} \R package is moved from depends to imports. }
}
}
\section{Changes in version 0.9-42}{
\itemize{
- \item{ \code{guiDlgFun()} is adapted to the new help system provided in
+ \item{ \code{guiDlgFun()} is adapted to the new help system provided in
\R 2.10. }
}
}
\section{Changes in version 0.9-41}{
\itemize{
- \item{ When the path contained spaces, \code{guiDlgOpen()} and
+ \item{ When the path contained spaces, \code{guiDlgOpen()} and
\code{guiDlgSave()} returned them in pieces. }
}
}
\section{Changes in version 0.9-40}{
\itemize{
- \item{ This is the first version distributed on R-forge. It is completely
+ \item{ This is the first version distributed on R-forge. It is completely
refactored from older versions (on CRAN since 2003) to make it run with
\preformatted{SciViews-K} and \preformatted{Komodo Edit} (
\preformatted{SciViews-R Console} not supported any more). }
Modified: pkg/svDialogs/man/menu.Rd
===================================================================
--- pkg/svDialogs/man/menu.Rd 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/man/menu.Rd 2012-05-06 19:40:20 UTC (rev 480)
@@ -52,7 +52,8 @@
the \preformatted{README} file in the \preformatted{ctxmenu} download.
On Mac OS X, these functions are not implemented yet (but see source of the
- package for experimental code commented out).
+ package for experimental code commented out and try the JGR version for a
+ first implementation there).
%On Mac OS X, AppleScript custom application folder is used by default. It
%can be used only with R.app and you can access it through Mac script menu
%displayed in menu bar (to activate it, open Utilities -> AppleScript editor,
Modified: pkg/svDialogs/man/svDialogs-package.Rd
===================================================================
--- pkg/svDialogs/man/svDialogs-package.Rd 2012-05-01 21:16:47 UTC (rev 479)
+++ pkg/svDialogs/man/svDialogs-package.Rd 2012-05-06 19:40:20 UTC (rev 480)
@@ -12,8 +12,8 @@
\tabular{ll}{
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 480
More information about the Sciviews-commits
mailing list