[Sciviews-commits] r317 - in pkg/svWidgets: . R inst/gui man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Sep 25 11:44:18 CEST 2010
Author: phgrosjean
Date: 2010-09-25 11:44:18 +0200 (Sat, 25 Sep 2010)
New Revision: 317
Added:
pkg/svWidgets/man/svWidgets-package.Rd
Modified:
pkg/svWidgets/DESCRIPTION
pkg/svWidgets/NAMESPACE
pkg/svWidgets/NEWS
pkg/svWidgets/R/Img.R
pkg/svWidgets/R/Menu.R
pkg/svWidgets/R/Tool.R
pkg/svWidgets/R/Win.R
pkg/svWidgets/R/tkImg.R
pkg/svWidgets/R/tkMenu.R
pkg/svWidgets/R/tkTool.R
pkg/svWidgets/R/tkWin.R
pkg/svWidgets/R/winMenu.R
pkg/svWidgets/inst/gui/Menus.txt
pkg/svWidgets/man/Img.Rd
pkg/svWidgets/man/Menu.Rd
pkg/svWidgets/man/Tool.Rd
pkg/svWidgets/man/Win.Rd
pkg/svWidgets/man/tkImg.Rd
pkg/svWidgets/man/tkMenu.Rd
pkg/svWidgets/man/tkTool.Rd
pkg/svWidgets/man/tkWin.Rd
pkg/svWidgets/man/winMenu.Rd
Log:
Addition of tkMenuItemCall() and a package man page
Reworking style in all man pages and R code
Modified: pkg/svWidgets/DESCRIPTION
===================================================================
--- pkg/svWidgets/DESCRIPTION 2010-09-25 09:17:46 UTC (rev 316)
+++ pkg/svWidgets/DESCRIPTION 2010-09-25 09:44:18 UTC (rev 317)
@@ -4,8 +4,8 @@
Depends: R (>= 2.7.0)
Imports: tcltk, utils, svMisc
Description: High level management of widgets, windows and other graphical resources.
-Version: 0.9-40
-Date: 2009-02-20
+Version: 0.9-41
+Date: 2010-09-25
Author: Philippe Grosjean
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
Modified: pkg/svWidgets/NAMESPACE
===================================================================
--- pkg/svWidgets/NAMESPACE 2010-09-25 09:17:46 UTC (rev 316)
+++ pkg/svWidgets/NAMESPACE 2010-09-25 09:44:18 UTC (rev 317)
@@ -28,6 +28,7 @@
tkMenuDel,
tkMenuDelItem,
tkMenuInvoke,
+ tkMenuItemCall,
tkMenuItems,
tkMenuStateItem,
tkToolAdd,
Modified: pkg/svWidgets/NEWS
===================================================================
--- pkg/svWidgets/NEWS 2010-09-25 09:17:46 UTC (rev 316)
+++ pkg/svWidgets/NEWS 2010-09-25 09:44:18 UTC (rev 317)
@@ -1,5 +1,12 @@
= svWidgets News
+== Changes in svWidgets 0.9-41
+
+* Addition of a package man page.
+
+* Addition of tkMenuItemCall().
+
+
== Changes in svWidgets 0.9-40
This is the first version distributed on R-forge. It is completely refactored
Modified: pkg/svWidgets/R/Img.R
===================================================================
--- pkg/svWidgets/R/Img.R 2010-09-25 09:17:46 UTC (rev 316)
+++ pkg/svWidgets/R/Img.R 2010-09-25 09:44:18 UTC (rev 317)
@@ -1,13 +1,11 @@
-"print.guiImg" <-
-function (x, ...)
+print.guiImg <- function (x, ...)
{
cat("A SciViews GUI image object:", "\n")
print(unclass(x))
return(invisible(x))
}
-"ImgAdd" <-
-function (file, type = "gif", imgtype = "tkImage", update = FALSE, ...)
+ImgAdd <- function (file, type = "gif", imgtype = "tkImage", update = FALSE, ...)
{
res <- switch(imgtype,
tkImage = tkImgAdd(file = file, type = type, update = update),
@@ -15,55 +13,50 @@
return(invisible(res))
}
-"ImgDel" <-
-function (image)
+ImgDel <- function (image)
{
res <- switch(ImgType(image),
tkImage = tkImgDel(image))
return(invisible(res))
}
-"ImgGet" <-
-function (image)
+ImgGet <- function (image)
{
- # Get the image
+ ## Get the image
return(getTemp(".guiImgs")[[image]])
}
-"ImgType" <-
-function (image, warn = TRUE)
+ImgType <- function (image, warn = TRUE)
{
- # Get the type of image
+ ## Get the type of image
if (regexpr("^[$]Tk[.]", image) > 0) return("tkImage") else {
if (warn) warning("Unrecognized image type for ", image)
return(NA)
}
}
-"ImgNames" <-
-function ()
+ImgNames <- function ()
{
- # List all available images
+ ## List all available images
res <- names(getTemp(".guiImgs"))
if (is.null(res)) res <- character(0)
return(res)
}
-"ImgRead" <-
-function (dir, type = "gif", imgtype = "tkImage")
+ImgRead <- function (dir, type = "gif", imgtype = "tkImage")
{
- # Depending on 'imgtype', we call a different function
+ ## Depending on 'imgtype', we call a different function
res <- switch(imgtype,
tkImage = tkImgRead(dir = dir, type = type),
stop("Unrecognized image type '", imgtype, "'"))
return(invisible(res))
}
-"ImgReadPackage" <-
-function (package, subdir = "gui", type = "gif", imgtype = "tkImage")
+ImgReadPackage <- function (package, subdir = "gui", type = "gif",
+imgtype = "tkImage")
{
- # Create image resources by reading a series of image files from the 'gui'
- # subdirectory of a package
+ ## Create image resources by reading a series of image files from the 'gui'
+ ## subdirectory of a package
dir <- system.file(subdir, package = package)
res <- ImgRead(dir= dir, type = type, imgtype = imgtype)
return(invisible(res))
Modified: pkg/svWidgets/R/Menu.R
===================================================================
--- pkg/svWidgets/R/Menu.R 2010-09-25 09:17:46 UTC (rev 316)
+++ pkg/svWidgets/R/Menu.R 2010-09-25 09:44:18 UTC (rev 317)
@@ -1,13 +1,11 @@
-"print.guiMenu" <-
-function (x, ...)
+print.guiMenu <- function (x, ...)
{
cat("A SciViews GUI menu object:", "\n")
print(unclass(x))
return(invisible(x))
}
-"MenuAdd" <-
-function (menu, ...)
+MenuAdd <- function (menu, ...)
{
res <- switch(MenuType(menu),
winMenu = if (isRgui()) winMenuAdd(menu),
@@ -15,8 +13,7 @@
return(invisible(res))
}
-"MenuAddItem" <-
-function (menu, item, action, image = "", accel = "", options = "")
+MenuAddItem <- function (menu, item, action, image = "", accel = "", options = "")
{
res <- switch(MenuType(menu),
winMenu = if (isRgui()) {
@@ -27,8 +24,7 @@
return(invisible(res))
}
-"MenuDel" <-
-function (menu)
+MenuDel <- function (menu)
{
res <- switch(MenuType(menu),
winMenu = if (isRgui()) winMenuDel(menu),
@@ -36,8 +32,7 @@
return(invisible(res))
}
-"MenuDelItem" <-
-function (menu, item)
+MenuDelItem <- function (menu, item)
{
res <- switch(MenuType(menu),
winMenu = if (isRgui()) winMenuDelItem(menu, item),
@@ -45,22 +40,20 @@
return(invisible(res))
}
-"MenuNames" <-
-function ()
+MenuNames <- function ()
{
res <- character(0)
if (isRgui()) res <- winMenuNames()
- # Eliminate menu names not correctly created (not starting with $...)
+ ## Eliminate menu names not correctly created (not starting with $...)
if (length(res) > 0) res <- res[regexpr("^[$]", res) > 0]
- # retrieve menu names from tk menus as well
+ ## Retrieve menu names from tk menus as well
res <- c(res, names(getTemp(".guiMenus")))
- # eliminate toplevel entries
+ ## Eliminate toplevel entries
if (length(res) > 0) res <- res[regexpr("/", res) > 0]
return(res)
}
-"MenuItems" <-
-function (menu)
+MenuItems <- function (menu)
{
res <- switch(MenuType(menu),
winMenu = if (isRgui()) winMenuItems(menu),
@@ -68,10 +61,9 @@
return(res)
}
-"MenuType" <-
-function (menu, warn = TRUE)
+MenuType <- function (menu, warn = TRUE)
{
- # Given a menu, return its type ("winMenu", "tkMenu", NA)
+ ## Given a menu, return its type ("winMenu", "tkMenu", NA)
if (regexpr("^[$]Console(Main|Popup)/", menu) > 0) return("winMenu") else
if (regexpr("^[$]Graph[0-9]+(Main|Popup)/", menu) > 0) return("winMenu") else
if (regexpr("^[$]Tk[.].+/", menu) > 0) return("tkMenu") else {
@@ -80,54 +72,50 @@
}
}
-"MenuChangeItem" <-
-function (menu, item, action = "", options = "")
+MenuChangeItem <- function (menu, item, action = "", options = "")
{
- # Change action or options for menu entries
+ ## Change action or options for menu entries
res <- switch(MenuType(menu),
winMenu = if (isRgui()) winMenuChangeItem(menu, item, action, options),
tkMenu = tkMenuChangeItem(menu, item, action, options))
return(invisible(res))
}
-"MenuStateItem" <-
-function (menu, item, active = TRUE)
+MenuStateItem <- function (menu, item, active = TRUE)
{
- # Activate/inactivate menu entries
+ ## Activate/inactivate menu entries
res <- switch(MenuType(menu),
winMenu = if (isRgui()) winMenuStateItem(menu, item, active),
tkMenu = tkMenuStateItem(menu, item, active))
return(invisible(res))
}
-"MenuInvoke" <-
-function (menu, item)
+MenuInvoke <- function (menu, item)
{
- # Trigger a menu entry by code
+ ## Trigger a menu entry by code
res <- switch(MenuType(menu),
winMenu = if (isRgui()) winMenuInvoke(menu, item),
tkMenu = tkMenuInvoke(menu, item))
return(invisible(res))
}
-"MenuRead" <-
-function (file = "Menus.txt")
+MenuRead <- function (file = "Menus.txt")
{
- # Read a menu from a file
+ ## Read a menu from a file
M <- scan(file, character(0), sep = "\n", comment.char = "#", quiet = TRUE)
- # Split the lines into item, command, options
+ ## Split the lines into item, command, options
M <- strsplit(M, "~~")
- # Strip leading and trailing spaces/tabs (used to align items in the file)
+ ## Strip leading and trailing spaces/tabs (used to align items in the file)
M <- lapply(M, function(x) sub("[ \t]+$", "", sub("^[ \t]+", "", x)))
- # Move line after line and replace '|' by values
+ ## Move line after line and replace '|' by values
N <- length(M)
- # Must have at least two entries
+ ## Must have at least two entries
if (N < 2) return(invisible())
- # First entry must be a toplevel, thus, it must start with '$'
+ ## First entry must be a toplevel, thus, it must start with '$'
if (regexpr("^[$]", M[[1]][1]) < 0)
stop("first entry is not a toplevel menu!")
menuLevels <- M[[1]][1]
- # Initialize a data frame to contain decrypted info
+ ## Initialize a data frame to contain decrypted info
dat <- rep("", N)
L <- data.frame(menu = I(dat), item = I(dat), image = I(dat),
accel = I(dat), action = I(dat), options = I(dat))
@@ -136,33 +124,33 @@
L[1, ] <- Litem
for (i in 2:N) {
entry <- M[[i]][1]
- # Split on '|'
+ ## Split on '|'
split <- strsplit(entry, "[|]")[[1]]
- # Combine menuLevels & split
+ ## Combine menuLevels & split
last <- length(split)
menuLevels[last] <- split[last]
menuLevels <- menuLevels[1:last]
- # Recombine menuLevels for getting recalculated entry
+ ## Recombine menuLevels for getting recalculated entry
entry <- paste(menuLevels, collapse = "/")
- # Is this just a menu, or a menu/item?
+ ## Is this just a menu, or a menu/item?
lastentry <- basename(entry)
if (regexpr("^[$]", lastentry) > 0) { # This is a menu
- # Remove '$' before menu entries
+ ## Remove '$' before menu entries
menu <- gsub("/[$]", "/", entry)
item <- "" # No item
image <- "" # No image
accel <- "" # No accel
action <- if (last == 1) "[top]" else "[menu]"
options <- "" # No options (currently)
- } else { # This is an entry
- # menu = entry minus last item (remove '$' before menu entries)
+ } else { # This is an entry
+ ## menu = entry minus last item (remove '$' before menu entries)
menu <- gsub("/[$]", "/", dirname(entry))
- # Decrypt lastentry to get image, item & accel ([image]item\taccel)
+ ## Decrypt lastentry to get image, item & accel ([image]item\taccel)
lastentry <- strsplit(lastentry, "\t")[[1]]
item <- sub("^[[][a-zA-Z0-9 ._-]+[]]", "", lastentry[1])
if (item == lastentry[1]) image <- "" else {
image <- sub("^[[]([a-zA-Z0-9 ._-]+)[]].+$", "\\1", lastentry[1])
- # Since these are Tk images resources, I have to prefix '$Tk.'
+ ## Since these are Tk images resources, I have to prefix '$Tk.'
image <- paste("$Tk.", image, sep = "")
}
accel <- lastentry[2]
@@ -174,41 +162,39 @@
}
Litem <- data.frame(menu = I(menu), item = I(item), image = I(image),
accel = I(accel), action = I(action), options = I(options))
- # add it to the data.frame
+ ## Add it to the data.frame
L[i, ] <- Litem
}
- # The [top] entries are not needed
+ ## The [top] entries are not needed
L <- L[L$action != "[top]", ]
- # Execute this line-by-line to create the various menus
+ ## Execute this line-by-line to create the various menus
N <- nrow(L)
for (i in 1:N) {
action <- L$action[i]
- if (action == "[menu]") { # Create a menu
+ if (action == "[menu]") { # Create a menu
MenuAdd(menu = L$menu[i])
- } else { # Create a menu entry
+ } else { # Create a menu entry
MenuAddItem(menu = L$menu[i], item = L$item[i], action = L$action[i],
image = L$image[i], accel = L$accel[i], options = L$options[i])
}
}
- # Return L invisibly
return(invisible(L))
}
-"MenuReadPackage" <-
-function (package, subdir = "gui", file = "Menus.txt")
+MenuReadPackage <- function (package, subdir = "gui", file = "Menus.txt")
{
- # Create menus using a menu definition file located in a R package
+ ## Create menus using a menu definition file located in a R package
dir <- system.file(subdir, package = package)
- # Check that the dir exists
+ ## Check that the dir exists
if (!file.exists(dir) || !file.info(dir)$isdir)
stop("'", dir, "' does not exist, or is not a directory!")
- # Check that the file exists
+ ## Check that the file exists
File <- file.path(dir, file)
if (!file.exists(File))
stop("'", file, "' not found in '", dir, "'!")
- # Read the menu file
+ ## Read the menu file
res <- MenuRead(File)
return(invisible(res))
}
Modified: pkg/svWidgets/R/Tool.R
===================================================================
--- pkg/svWidgets/R/Tool.R 2010-09-25 09:17:46 UTC (rev 316)
+++ pkg/svWidgets/R/Tool.R 2010-09-25 09:44:18 UTC (rev 317)
@@ -1,22 +1,18 @@
-"print.guiTool" <-
-function (x, ...)
+print.guiTool <- function (x, ...)
{
cat("A SciViews GUI tool object:", "\n")
print(unclass(x))
return(invisible(x))
}
-"ToolAdd" <-
-function (toolbar, side = "top")
+ToolAdd <- function (toolbar, side = "top")
{
res <- switch(ToolType(toolbar),
- tkTool = tkToolAdd(toolbar = toolbar, side = side)
- )
+ tkTool = tkToolAdd(toolbar = toolbar, side = side))
return(invisible(res))
}
-"ToolAddItem" <-
-function (toolbar, item, action, image = "", options = "")
+ToolAddItem <- function (toolbar, item, action, image = "", options = "")
{
res <- switch(ToolType(toolbar),
tkTool = tkToolAddItem(toolbar = toolbar, item = item, action = action,
@@ -24,96 +20,87 @@
return(invisible(res))
}
-"ToolDel" <-
-function (toolbar)
+ToolDel <- function (toolbar)
{
res <- switch(ToolType(toolbar),
tkTool = tkToolDel(toolbar = toolbar))
return(invisible(res))
}
-"ToolDelItem" <-
-function (toolbar, item)
+ToolDelItem <- function (toolbar, item)
{
res <- switch(ToolType(toolbar),
tkTool = tkToolDelItem(toolbar = toolbar, item = item))
return(invisible(res))
}
-"ToolNames" <-
-function ()
+ToolNames <- function ()
{
res <- character(0)
- # retrieve toolbar names from tk toolbars
+ ## Retrieve toolbar names from tk toolbars
res <- c(res, names(getTemp(".guiTools")))
- # eliminate toplevel entries
+ ## Eliminate toplevel entries
if (length(res) > 0) res <- res[regexpr("/", res) > 0]
return(res)
}
-"ToolItems" <-
-function (toolbar)
+ToolItems <- function (toolbar)
{
res <- switch(ToolType(toolbar),
tkTool = tkToolItems(toolbar = toolbar))
return(res)
}
-"ToolType" <-
-function (toolbar, warn = TRUE)
+ToolType <- function (toolbar, warn = TRUE)
{
- # Given a toolbar, return its type ("tkTool", NA)
+ ## Given a toolbar, return its type ("tkTool", NA)
if (regexpr("^[$]Tk[.].+/", toolbar) > 0) return("tkTool") else {
if (warn) warning("Unrecognized toolbar type for ", toolbar)
return(NA)
}
}
-"ToolChangeItem" <-
-function (toolbar, item, action = "", options = "")
+ToolChangeItem <- function (toolbar, item, action = "", options = "")
{
- # Change action or options for toolbar entries
+ ## Change action or options for toolbar entries
res <- switch(ToolType(toolbar),
tkTool = tkToolChangeItem(toolbar, item, action, options))
return(invisible(res))
}
-"ToolStateItem" <-
-function (toolbar, item, active = TRUE)
+ToolStateItem <- function (toolbar, item, active = TRUE)
{
- # Activate/inactivate toolbar entries
+ ## Activate/inactivate toolbar entries
res <- switch(ToolType(toolbar),
tkTool = tkToolStateItem(toolbar, item, active))
return(invisible(res))
}
-"ToolInvoke" <-
-function (toolbar, item)
+ToolInvoke <- function (toolbar, item)
{
- # Invoke a toolbutton
+ ## Invoke a toolbutton
res <- switch(ToolType(toolbar),
tkTool = tkToolInvoke(toolbar, item))
return(invisible(res))
}
-"ToolRead" <-
-function (file = "Tools.txt")
+ToolRead <- function (file = "Tools.txt")
{
- # Read toolbars from a file
+ ## Read toolbars from a file
T <- scan(file, character(0), sep = "\n", comment.char = "#", quiet = TRUE)
- # Split the lines into item, command, options
+ ## Split the lines into item, command, options
T <- strsplit(T, "~~")
- # Strip leading and trailing spaces/tabs (used to align items in the file)
+ ## Strip leading and trailing spaces/tabs (used to align items in the file)
T <- lapply(T, function(x) sub("[ \t]+$", "", sub("^[ \t]+", "", x)))
- # Move line after line and replace '|' by values
+ ## Move line after line and replace '|' by values
N <- length(T)
- # Must have at least two entries
+ ## Must have at least two entries
if (N < 2) return(invisible())
- # First entry must be a toplevel, thus, it must start with '$'
+ ## First entry must be a toplevel, thus, it must start with '$'
if (regexpr("^[$]", T[[1]][1]) < 0)
stop("first entry is not a toolbar!")
toolLevels <- T[[1]][1]
- # Initialize a data frame to contain decrypted info
+ ## Initialize a data frame to contain decrypted info
dat <- rep("", N)
L <- data.frame(tool = I(dat), item = I(dat), image = I(dat),
action = I(dat), options = I(dat))
@@ -122,31 +109,31 @@
L[1, ] <- Litem
for (i in 2:N) {
entry <- T[[i]][1]
- # Split on '|'
+ ## Split on '|'
split <- strsplit(entry, "[|]")[[1]]
- # Combine toolLevels & split
+ ## Combine toolLevels & split
last <- length(split)
toolLevels[last] <- split[last]
toolLevels <- toolLevels[1:last]
- # Recombine toolLevels for getting recalculated entry
+ ## Recombine toolLevels for getting recalculated entry
entry <- paste(toolLevels, collapse = "/")
- # Is this just a tool button, or a menu tool button/menu item?
+ ## Is this just a tool button, or a menu tool button/menu item?
lastentry <- basename(entry)
if (regexpr("^[$]", lastentry) > 0) { # This is a tool button
- # Remove '$' before tool button entries
+ ## Remove '$' before tool button entries
tool <- gsub("/[$]", "/", entry)
item <- "" # No item
image <- "" # No image
action <- if (last == 1) "[toolbar]" else "[tool]"
options <- "" # No options (currently)
- } else { # This is an menu entry in a tool button menu
- # tool = entry minus last item (remove '$' before tool entries)
+ } else { # This is an menu entry in a tool button menu
+ ## tool = entry minus last item (remove '$' before tool entries)
tool <- gsub("/[$]", "/", dirname(entry))
- # Decrypt lastentry to get image & item ([image]item)
+ ## Decrypt lastentry to get image & item ([image]item)
item <- sub("^[[][a-zA-Z0-9 ._-]+[]]", "", lastentry)
if (item == lastentry) image <- "" else {
image <- sub("^[[]([a-zA-Z0-9 ._-]+)[]].+$", "\\1", lastentry)
- # Since these are Tk images resources, I have to prefix '$Tk.'
+ ## Since these are Tk images resources, I have to prefix '$Tk.'
image <- paste("$Tk.", image, sep = "")
}
action <- T[[i]][2]
@@ -156,49 +143,47 @@
}
Litem <- data.frame(tool = I(tool), item = I(item), image = I(image),
action = I(action), options = I(options))
- # add it to the data.frame
+ ## Add it to the data.frame
L[i, ] <- Litem
}
- # The [toolbar] entries are not needed
+ ## The [toolbar] entries are not needed
L <- subset( L, action != "[toolbar]" )
- # Execute this line-by-line to create the various tools
+ ## Execute this line-by-line to create the various tools
N <- nrow(L)
for (i in 1:N) {
action <- L$action[i]
if (action == "[tool]") { # Create a toolbar
ToolAdd(toolbar = L$tool[i])
-# } else if (action == "[tool]") { # Create a tool button
+# } else if (action == "[tool]") { # Create a tool button
# ### TODO: determine which type of tool button it is!
# ToolAddItem(toolbar = L$menu[i])
# } else { # Create a menu entry for a menu tool button
# MenuAddItem(menu = L$tool[i], item = L$item[i], action = L$action[i],
# image = L$image[i], options = L$options[i])
# }
- } else { # Create a tool in the toolbar
+ } else { # Create a tool in the toolbar
ToolAddItem(tool = L$tool[i], item = L$item[i], action = L$action[i],
image = L$image[i], options = L$options[i])
}
}
- # Return L invisibly
return(invisible(L))
}
-"ToolReadPackage" <-
-function (package, subdir = "gui", file = "Tools.txt")
+ToolReadPackage <- function (package, subdir = "gui", file = "Tools.txt")
{
- # Create toolbars using a toolbar definition file located in a R package
+ ## Create toolbars using a toolbar definition file located in a R package
dir <- system.file(subdir, package = package)
- # Check that the dir exists
+ ## Check that the dir exists
if (!file.exists(dir) || !file.info(dir)$isdir)
stop("'", dir, "' does not exist, or is not a directory!")
- # Check that the file exists
+ ## Check that the file exists
File <- file.path(dir, file)
if (!file.exists(File))
stop("'", file, "' not found in '", dir, "'!")
- # Read the toolbar file
+ ## Read the toolbar file
res <- ToolRead(File)
return(invisible(res))
}
Modified: pkg/svWidgets/R/Win.R
===================================================================
--- pkg/svWidgets/R/Win.R 2010-09-25 09:17:46 UTC (rev 316)
+++ pkg/svWidgets/R/Win.R 2010-09-25 09:44:18 UTC (rev 317)
@@ -1,17 +1,15 @@
-"print.guiWin" <-
-function (x, ...)
+print.guiWin <- function (x, ...)
{
cat("A SciViews GUI window object:", "\n")
print(unclass(x))
return(invisible(x))
}
-"WinAdd" <-
-function (name = "win1", type = "tkWin", parent = .TkRoot, title = NULL,
- pos = NULL, bind.delete = TRUE, ...)
+WinAdd <- function (name = "win1", type = "tkWin", parent = .TkRoot,
+title = NULL, pos = NULL, bind.delete = TRUE, ...)
{
- # Add a window. This mechanism should be able to use different kinds of
- # groahical widgets, but currently, only Tcl/Tk is supported.
+ ## Add a window. This mechanism should be able to use different kinds of
+ ## graphical widgets, but currently, only Tcl/Tk is supported.
res <- switch(type,
tkWin = tkWinAdd(name = name, parent = parent, title = title, pos = pos,
bind.delete = bind.delete, ...),
@@ -19,28 +17,25 @@
return(invisible(res))
}
-"WinDel" <-
-function (window)
+WinDel <- function (window)
{
- # Process depends on the kind of window to delete
- # Currently, only Tk windows are supported
+ ## Process depends on the kind of window to delete
+ ## Currently, only Tk windows are supported
if (inherits(WinGet(window), "tkguiWin")) {
return(invisible(tkWinDel(window)))
} else stop("Unsupported window type")
}
-"WinGet" <-
-function (window)
+WinGet <- function (window)
{
- # Retrieve a "guiWin" object from .guiWins, given its name
+ ## Retrieve a "guiWin" object from .guiWins, given its name
return(getTemp(".guiWins")[[window]])
}
-"WinNames" <-
-function ()
+WinNames <- function ()
{
- # List all recorded windows in .guiWins
- ### TODO: if Rgui, list also console, graph, editors and pagers!
+ ## List all recorded windows in .guiWins
+### TODO: if Rgui, list also console, graph, editors and pagers!
res <- names(getTemp(".guiWins"))
if (is.null(res)) res <- character(0)
return(res)
Modified: pkg/svWidgets/R/tkImg.R
===================================================================
--- pkg/svWidgets/R/tkImg.R 2010-09-25 09:17:46 UTC (rev 316)
+++ pkg/svWidgets/R/tkImg.R 2010-09-25 09:44:18 UTC (rev 317)
@@ -1,26 +1,25 @@
-"tkImgAdd" <-
-function (file, type = "gif", update = FALSE)
+tkImgAdd <- function (file, type = "gif", update = FALSE)
{
- # Add a Tk image to the list (just GIF for the moment,
- # but the Tcl/Tk Img package allows for more!)
+ ## Add a Tk image to the list (just GIF for the moment,
+ ## but the Tcl/Tk Img package allows for more!)
if (type != "gif")
stop("Only 'gif' images currently supported!")
if (!file.exists(file))
stop("File '", file, "' not found!")
- # Load the image and assign it to an item to the .guiImgs object in TempEnv
+ ## Load the image and assign it to an item to the .guiImgs object in TempEnv
.guiImgs <- getTemp(".guiImgs")
if (is.null(.guiImgs)) {
.guiImgs <- list()
class(.guiImgs) <- c("guiImg", "gui", class(.guiImgs))
}
- # Calculate image name as being the basename of the file without extension
+ ## Calculate image name as being the basename of the file without extension
Iname <- sub("[.][^.]+$", "", basename(file))
- # In order to indicate it is a Tk resource, prepend '$Tk.'
+ ## In order to indicate it is a Tk resource, prepend '$Tk.'
Iname <- paste("$Tk.", Iname, sep = "")
- # If that name already exists, do nothing, except if we ask to update it
+ ## If that name already exists, do nothing, except if we ask to update it
if (Iname %in% names(.guiImgs)) {
if (update) {
- # Delete the image to recreate it with new resource
+ ## Delete the image to recreate it with new resource
tcl("image", "delete", Iname)
} else return(invisible(Iname)) # Do nothing
}
@@ -28,37 +27,35 @@
tcl("image", "create", "photo", Image, file = file)
.guiImgs[[Iname]] <- Image
- # Reassign .guiImgs to TempEnv
+ ## Reassign .guiImgs to TempEnv
assignTemp(".guiImgs", .guiImgs)
return(invisible(Iname))
}
-"tkImgDel" <-
-function (image)
+tkImgDel <- function (image)
{
- # Delete a tk image ressource from the list
+ ## Delete a tk image ressource from the list
.guiImgs <- getTemp(".guiImgs")
- # Is the image there?
+ ## Is the image there?
if (!image %in% names(.guiImgs)) return(invisible(FALSE))
- # Delete the image
+ ## Delete the image
Image <- .guiImgs[[image]]
tcl("image", "delete", Image)
- # Eliminate it from the list in .guiImgs
+ ## Eliminate it from the list in .guiImgs
.guiImgs[[image]] <- NULL
- # Reassign .guiImgs to TempEnv
+ ## Reassign .guiImgs to TempEnv
assignTemp(".guiImgs", .guiImgs)
- # Indicate that the image is actually deleted
+ ## Indicate that the image is actually deleted
return(invisible(TRUE))
}
-"tkImgRead" <-
-function (dir, type = "gif")
+tkImgRead <- function (dir, type = "gif")
{
- # Read all gif images from a directory into tkImage resources
- # Check that the dir exists
+ ## Read all gif images from a directory into tkImage resources
+ ## Check that the dir exists
if (!file.exists(dir) || !file.info(dir)$isdir)
stop("'", dir, "' does not exist, or is not a directory!")
- # List all file of 'type' in that directory
+ ## List all file of 'type' in that directory
if (type != "gif")
stop("only type = 'gif' is currently supported")
pattern <- "[.][gG][iI][fF]$"
Modified: pkg/svWidgets/R/tkMenu.R
===================================================================
--- pkg/svWidgets/R/tkMenu.R 2010-09-25 09:17:46 UTC (rev 316)
+++ pkg/svWidgets/R/tkMenu.R 2010-09-25 09:44:18 UTC (rev 317)
@@ -1,5 +1,4 @@
-"tkMenuItems" <-
-function (menu)
+tkMenuItems <- function (menu)
{
M <- getTemp(".guiMenus")[[menu]]
if (is.null(M))
@@ -15,59 +14,58 @@
return(res)
}
-"tkMenuAdd" <-
-function (menu, tearoff = FALSE)
+tkMenuAdd <- function (menu, tearoff = FALSE)
{
- # Get the menu name
+ ## Get the menu name
Mname <- basename(menu)
- # Get the name of the parent
+ ## Get the name of the parent
Pname <- dirname(menu)
- # Look if the parent exists (must be in .guiMenus in TempEnv)
+ ## Look if the parent exists (must be in .guiMenus in TempEnv)
.guiMenus <- getTemp(".guiMenus")
- # If .guiMenus was not there, create it
+ ## If .guiMenus was not there, create it
if (is.null(.guiMenus)) {
.guiMenus <- list()
class(.guiMenus) <- c("guiMenu", "gui", class(.guiMenus))
}
- # Do not create the menu if it already exists
+ ## Do not create the menu if it already exists
if (menu %in% names(.guiMenus))
stop("menu ", menu, " already exists!")
Parent <- .guiMenus[[Pname]]
if (is.null(Parent)) {
- # If base menu is a "root", try to create the corresponding Tk top menu
+ ## If base menu is a "root", try to create the corresponding Tk top menu
if (regexpr("/", Pname) < 0) {
- # Get the name of the Tk window that hosts the menu
+ ## Get the name of the Tk window that hosts the menu
TkWinName <- sub("^[$]Tk[.]", "", Pname)
- # Look if such a Tk window is recorded in .gui.Wins
+ ## Look if such a Tk window is recorded in .gui.Wins
TkWin <- WinGet(TkWinName)
if (is.null(TkWin))
stop("menu does not exist, and the parent Tk window cannot be found!")
- # Create the menu
+ ## Create the menu
Parent <- tkmenu(TkWin)
tkconfigure(TkWin, menu = Parent)
- # Add an entry for this top menu in .guiMenus
+ ## Add an entry for this top menu in .guiMenus
.guiMenus[[Pname]] <- Parent
} else stop("unable to add menu\n(base menu does not exists)")
}
- # Check that the name is not already used (for a menu entry, for instance)
+ ## Check that the name is not already used (for a menu entry, for instance)
items <- Parent$Items
if (!is.null(items) && Mname %in% items$name)
stop("the menu name is already used in this menu!")
- # Now that the parent menu exists, we can create this menu
- # Look where to place the underline (menu shortcut)
+ ## Now that the parent menu exists, we can create this menu
+ ## Look where to place the underline (menu shortcut)
Under <- regexpr("&", Mname)
- if (Under < 0) { # No '&', place the underline at first position
+ if (Under < 0) { # No '&', place the underline at first position
Under <- 0
item <- Mname
} else {
- Under <- Under - 1 # Because Tk starts numbering at 0
+ Under <- Under - 1 # Because Tk starts numbering at 0
item <- sub("&", "", Mname)
}
Child <- tkmenu(Parent, tearoff = tearoff)
tkadd(Parent, "cascade", label = item, menu = Child, underline = Under)
- # Add an entry for this child menu in .guiMenus
+ ## Add an entry for this child menu in .guiMenus
.guiMenus[[menu]] <- Child
- # ... and register it in the items of parent menu in .guiMenus
+ ## ... and register it in the items of parent menu in .guiMenus
if (tearoff) options <- "tearoff = TRUE" else options <- "tearoff = FALSE"
entry <- data.frame(name = I(Mname), action = I("[menu]"), image = (""),
accel = I(""), options = I(options))
@@ -75,81 +73,88 @@
.guiMenus[[Pname]]$Items <- entry
else
.guiMenus[[Pname]]$Items <- rbind(items, entry)
- # Update the TempEnv version of .guiMenus
+ ## Update the TempEnv version of .guiMenus
assignTemp(".guiMenus", .guiMenus)
return(invisible(menu))
}
-"tkMenuAddItem" <-
-function (menu, item, action, image = "", accel = "", options = "")
-{
- # Look if the menu exists (must be in .guiMenus in TempEnv)
+tkMenuItemCall <- function (expr) {
+ ## Remove { and } from the deparsed expression
+ text <- head(deparse(substitute(expr))[-1], -1)
+ cat(">> ", text, "\n")
+ .Internal(addhistory(text))
+ return(eval(expr, envir = parent.frame()))
+}
+
+tkMenuAddItem <- function (menu, item, action, image = "", accel = "", options = "")
+{
+ ## Look if the menu exists (must be in .guiMenus in TempEnv)
.guiMenus <- getTemp(".guiMenus")
M <- .guiMenus[[menu]]
if (is.null(M)) {
- # On the contrary to winMenuAddItem(), if the menu does not exist yet
- # generate an error (but we can later change this behaviour, of course!)
+ ## On the contrary to winMenuAddItem(), if the menu does not exist yet
+ ## generate an error (but we can later change this behaviour, of course!)
stop("menu does not exist!")
}
- # Look if the menu already exists
+ ## Look if the menu already exists
Items <- M$Items
if (!is.null(Items) && item %in% Items$name) {
- # On the contrary to winMenuAddItem(), it is not allowed to add twice
- # the same menu (would change value, but in Tk, it would add a second
- # time the same menu)
+ ## On the contrary to winMenuAddItem(), it is not allowed to add twice
+ ## the same menu (would change value, but in Tk, it would add a second
+ ## time the same menu)
stop("the menu item ", item, " already exists!")
}
- # Add the entry at the end of the Tk menu (### TODO: allow other positions)
- # First look if it is a command or a separator
+ ## Add the entry at the end of the Tk menu (### TODO: allow other positions)
+ ## First look if it is a command or a separator
if (regexpr("^-+$", item) > 0) { #This must be a command
tkadd(M, "separator")
action <- "[separator]"
options <- ""
- } else { # This is a menu command
- # Look for the '&', indicating where the underline should be located
+ } else { # This is a menu command
+ ## Look for the '&', indicating where the underline should be located
Under <- regexpr("&", item)
- if (Under < 0) { # No '&', place the underline at first position
+ if (Under < 0) { # No '&', place the underline at first position
Uopt <- ", underline = 0"
lbl <- item
} else {
- Uopt <- paste(", underline =", Under - 1) # Tk starts numbering at 0
+ Uopt <- paste(", underline =", Under - 1) # Tk starts numbering at 0
lbl <- sub("&", "", item)
}
- # Do we have to add an image to the menu?
+ ## Do we have to add an image to the menu?
if (image != "") {
- # Look if the image resource is available
+ ## Look if the image resource is available
Img <- ImgGet(image)
if (!is.null(Img)) {
Iopt <- paste(", image = '", as.character(Img), "'", sep ="")
} else Iopt <- ""
} else Iopt <- ""
- # Do we have an accelerator defined for this menu?
+ ## Do we have an accelerator defined for this menu?
if (accel != "") {
Aopt <- paste(', accelerator = "', accel, '"', sep = "")
- # Compute the Tk accelerator and make corresponding binding
+ ## Compute the Tk accelerator and make corresponding binding
tkAccel <- paste("<", tolower(accel), ">", sep ="")
- # 'ctrl+' becomes 'Control-'
+ ## 'ctrl+' becomes 'Control-'
tkAccel <- sub("ctrl[+]", "Control-", tkAccel)
- # 'shift+' becomes 'Shift-'
+ ## 'shift+' becomes 'Shift-'
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 317
More information about the Sciviews-commits
mailing list