[Sciviews-commits] r411 - komodo/SciViews-K komodo/SciViews-K Unit pkg/SciViews/R pkg/svDialogs pkg/svDialogs/R pkg/svDialogs/man pkg/svSweave pkg/svSweave/R pkg/svSweave/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Dec 11 20:39:50 CET 2011
Author: phgrosjean
Date: 2011-12-11 20:39:50 +0100 (Sun, 11 Dec 2011)
New Revision: 411
Added:
pkg/SciViews/R/character.R
pkg/SciViews/R/file.R
pkg/svDialogs/R/menu.R
pkg/svDialogs/R/svDialogs-internal.R
pkg/svDialogs/man/menu.Rd
pkg/svSweave/R/tangleLyxRnw.R
pkg/svSweave/R/weaveLyxRnw.R
Modified:
komodo/SciViews-K Unit/install.rdf
komodo/SciViews-K Unit/sciviewskunit-0.7.3-ko.xpi
komodo/SciViews-K/install.rdf
pkg/svDialogs/DESCRIPTION
pkg/svDialogs/NAMESPACE
pkg/svDialogs/NEWS
pkg/svDialogs/TODO
pkg/svDialogs/man/svDialogs-package.Rd
pkg/svSweave/DESCRIPTION
pkg/svSweave/NAMESPACE
pkg/svSweave/NEWS
pkg/svSweave/R/cleanLyxRnw.R
pkg/svSweave/man/cleanLyxRnw.Rd
pkg/svSweave/man/svSweave-package.Rd
Log:
Various changes: menus in svDialogs, reworked version of svSweave for LyX 2.0
Modified: komodo/SciViews-K/install.rdf
===================================================================
--- komodo/SciViews-K/install.rdf 2011-12-11 18:22:17 UTC (rev 410)
+++ komodo/SciViews-K/install.rdf 2011-12-11 19:39:50 UTC (rev 411)
@@ -17,7 +17,7 @@
<!-- Komodo IDE's uuid -->
<em:id>{36E66FA0-F259-11D9-850E-000D935D3368}</em:id>
<em:minVersion>5.0</em:minVersion>
- <em:maxVersion>6.*</em:maxVersion>
+ <em:maxVersion>7.*</em:maxVersion>
</Description>
</em:targetApplication>
<em:targetApplication>
@@ -25,7 +25,7 @@
<!-- Komodo Edit's uuid -->
<em:id>{b1042fb5-9e9c-11db-b107-000d935d3368}</em:id>
<em:minVersion>5.0</em:minVersion>
- <em:maxVersion>6.*</em:maxVersion>
+ <em:maxVersion>7.*</em:maxVersion>
</Description>
</em:targetApplication>
</Description>
Modified: komodo/SciViews-K Unit/install.rdf
===================================================================
--- komodo/SciViews-K Unit/install.rdf 2011-12-11 18:22:17 UTC (rev 410)
+++ komodo/SciViews-K Unit/install.rdf 2011-12-11 19:39:50 UTC (rev 411)
@@ -15,16 +15,16 @@
<Description>
<!-- Komodo IDE's uuid -->
<em:id>{36E66FA0-F259-11D9-850E-000D935D3368}</em:id>
- <em:minVersion>4.1</em:minVersion>
- <em:maxVersion>6.*</em:maxVersion>
+ <em:minVersion>5.0</em:minVersion>
+ <em:maxVersion>7.*</em:maxVersion>
</Description>
</em:targetApplication>
<em:targetApplication>
<Description>
<!-- Komodo Edit's uuid -->
<em:id>{b1042fb5-9e9c-11db-b107-000d935d3368}</em:id>
- <em:minVersion>4.1</em:minVersion>
- <em:maxVersion>6.*</em:maxVersion>
+ <em:minVersion>5.0</em:minVersion>
+ <em:maxVersion>7.*</em:maxVersion>
</Description>
</em:targetApplication>
</Description>
Modified: komodo/SciViews-K Unit/sciviewskunit-0.7.3-ko.xpi
===================================================================
(Binary files differ)
Added: pkg/SciViews/R/character.R
===================================================================
--- pkg/SciViews/R/character.R (rev 0)
+++ pkg/SciViews/R/character.R 2011-12-11 19:39:50 UTC (rev 411)
@@ -0,0 +1,327 @@
+## Essentially a series of base R function that manipulate character strings
+## and that are renamed/rationalized for facility
+## TODO: deal with zero length strings and NAs appropriately in all functions
+
+## Count the number of characters
+## No: make an exception: after n (or nz) do not use uppercase!
+#nChar <- nchar
+#nzChar <- nzchar
+
+## Format character strings
+strEscape <- encodeString
+strWrap <- strwrap
+# Add strPad => pad a string left/right or both or Padb/Padl/Padr?
+#+sprintf/gettextf?
+
+## String find/replace using fixed pattern (str*) or regular expressions (reg*)
+## TODO: a rx object which prints an example of its work! => fine-tune it
+## to make it easy to experiment with the rx object
+rx <- glob2rx
+
+strFind <- function (x, pattern, ignore.case = FALSE,
+type = c("logical", "position", "value"), ...) # ... for useBytes
+{
+ type <- pmatch(type)
+ res <- switch(type,
+ logical = grepl(pattern, x, ignore.case = ignore.case,
+ fixed = TRUE, ...),
+ position = grep(pattern, x, ignore.case = ignore.case, value = FALSE,
+ fixed = TRUE, ...),
+ value = grep(pattern, x, ignore.case = ignore.case, value = TRUE,
+ fixed = TRUE, ...),
+ stop("Unknown type"))
+ return(res)
+}
+
+rxFind <- function (x, pattern, ignore.case = FALSE, max.distance = 0,
+type = c("logical", "position", "value"), ...) # ... for perl & useBytes
+{
+ type <- pmatch(type)
+ ## If max.distance > 0, use approximate search
+ if (max.distance > 0) { # Use agrep()
+ res <- switch(type,
+ logical = 1:length(x) %in% agrep(pattern, x,
+ ignore.case = ignore.case, value = FALSE,
+ max.distance = max.distance, ...),
+ position = agrep(pattern, x, ignore.case = ignore.case,
+ value = FALSE, max.distance = max.distance, ...),
+ value = agrep(pattern, x, ignore.case = ignore.case,
+ value = TRUE, max.distance = max.distance, ...),
+ stop("Unknown type"))
+ } else { # Use regular search (grep())
+ res <- switch(type,
+ logical = grepl(pattern, x, ignore.case = ignore.case,
+ fixed = FALSE, ...),
+ position = grep(pattern, x, ignore.case = ignore.case,
+ value = FALSE, fixed = FALSE, ...),
+ value = grep(pattern, x, ignore.case = ignore.case,
+ value = TRUE, fixed = FALSE, ...),
+ stop("Unknown type"))
+ }
+ return(res)
+}
+
+strSearch <- function (x, pattern, ignore.case = FALSE, ...) # ... for useBytes
+ return(regexpr(pattern, text = x, ignore.case = ignore.case, fixed = TRUE,
+ ...))
+
+rxSearch <- function (x, pattern, ignore.case = FALSE, ...) # ... for perl & useBytes
+ return(regexpr(pattern, text = x, ignore.case = ignore.case, fixed = FALSE,
+ ...))
+
+strSearchAll <- function (x, pattern, ignore.case = FALSE, ...) # ... for useBytes
+ return(gregexpr(pattern, text = x, ignore.case = ignore.case, fixed = TRUE,
+ ...))
+
+rxSearchAll <- function (x, pattern, ignore.case = FALSE, ...) # ... for perl & useBytes
+ return(gregexpr(pattern, text = x, ignore.case = ignore.case, fixed = FALSE,
+ ...))
+
+strReplace <- function (x, pattern, replacement, ignore.case = FALSE, ...) # ... for useBytes
+ return(sub(pattern, replacement, x, ignore.case = ignore.case, fixed = TRUE,
+ ...))
+
+rxReplace <- function (x, pattern, replacement, ignore.case = FALSE, ...) # ... for perl & useBytes
+ return(sub(pattern, replacement, x, ignore.case = ignore.case, fixed = FALSE,
+ ...))
+
+strReplAll <- function (x, pattern, replacement, ignore.case = FALSE, ...) # ... for useBytes
+ return(gsub(pattern, replacement, x, ignore.case = ignore.case, fixed = TRUE,
+ ...))
+
+rxReplAll <- function (x, pattern, replacement, ignore.case = FALSE, ...) # ... for perl & useBytes
+ return(gsub(pattern, replacement, x, ignore.case = ignore.case, fixed = FALSE,
+ ...))
+
+
+## Substrings
+strSplit <- function (x, pattern, ...) # for useBytes
+ return(strsplit(x, split = pattern, fixed = TRUE, ...))
+
+rxSplit <- function (x, pattern, ...) # for perl & useBytes
+ return(strsplit(x, split = pattern, fixed = FALSE, ...))
+
+strSub <- substr
+`strSub<-` <- `substr<-`
+strTrunc <- strtrim ## This indeed truncs strings!!!
+
+## paste() is rather long name, in comparison with, e.g., c().
+## Also the default argument of sep = " " is irritating and is not consistent
+## with stop() or warning() for instance.
+## Thus, we define:
+p <- function (..., sep = "", collapse = NULL)
+ .Internal(paste(list(...), sep, collapse))
+
+p_ <- paste
+
+## The same is true for cat() with sep = " "... and the default behaviour of
+## not ending with line feed is more confusing that useful => change this
+## behaviour by adding a end = "\n" argument.
+## TODO: by default, interpret unicode and formatting like ucat() or ecat()!
+ct <- function (..., file = "", sep = "", end = "\n", fill = FALSE,
+labels = NULL, append = FALSE)
+ return(cat(..., end, file = file, sep = sep, fill = fill, labels = labels,
+ append = append))
+
+cta <- function (..., file = "", sep = "", end = "\n", fill = FALSE,
+labels = NULL)
+ return(cat(..., end, file = file, sep = sep, fill = fill, labels = labels,
+ append = TRUE))
+
+ct_ <- function (..., file = "", sep = " ", end = "\n", fill = FALSE,
+labels = NULL, append = FALSE)
+ return(cat(..., end, file = file, sep = sep, fill = fill, labels = labels,
+ append = append))
+
+cta_ <- function (..., file = " ", sep = "", end = "\n", fill = FALSE,
+labels = NULL)
+ return(cat(..., end, file = file, sep = sep, fill = fill, labels = labels,
+ append = TRUE))
+
+
+strTrimb <- function (x, all.spaces = FALSE) # Trim both sides
+{
+ pat <- (if (isTRUE(all.spaces)) "[[:space:]]+" else "[[:blank:]]+")
+ ## Trim left first
+ x <- strReplace(p("^", pat), "", x)
+ ## ... then trim right
+ return(strReplace(p(pat, "$"), "", x))
+}
+
+strTriml <- function (x, all.spaces = FALSE) # Trim left-side only
+{
+ pat <- (if (is.TRUE(all.spaces)) "^[[:space:]]+" else "^[[:blank:]]+")
+ return(strReplace(pat, "", x))
+}
+
+strTrimr <- function (x, all.spaces = FALSE) # Trim right-side only
+{
+ pat <- (if (is.TRUE(all.space)) "[[:space:]]+$" else "[[:blank:]]+$")
+ return(strReplace(pat, "", x))
+}
+
+
+## Change case and translate
+strTr() <- chartr
+strCaseFold() <- casefold
+strLower() <- tolower
+strUpper() <- toupper
+
+## Character encoding
+encodingToNative() <- enc2native
+encodingToUTF8() <- enc2utf8
+encoding() <- Encoding
+`encoding<-` <- `Encoding<-`
+
+## Measure size of a string (package graphics)
+strHeight() <- strheight
+strWidth() <- strwidth
+
+## Match and expand character strings to a list of items
+strExpand() <- char.expand
+strMatch() <- charmatch
+# What to do with pmatch()???
+
+## Conversion to character string
+#as.character
+
+# To avoid using strtoi(), we prefer as.integerBase (because as.integer cannot
+# be converted into a generic function, because it is a primitive!)
+#strToInt() <- strtoi # Allows to choose the base used for char representation
+as.integerBase <- strtoi
+
+#+paste = cChar? + my special character string manipulation functions?
+# is.wholenumber(), see ?as.integer => define isWholeInt?
+
+## This should be nice:
+## Define a valid method to be applied to S3 objects to make sure they are
+## correct
+valid <- function (object, ...)
+ UseMethod("valid")
+
+valid.default <- function (object, ...)
+ return(object)
+
+ifIs <- function (x, what, yes = valid(x),
+no = stop("need a ", what, " object"))
+ return(if (inherits(x, what)) yes else no)
+
+ifElse <- ifelse
+
+## This is useful to get something similar to df$var or obj at slot
+## TODO: how to solve the case ll%a%metadata$OK for metadata being a list?
+`%a%` <- function (x, which)
+ return(attr(x, deparse(substitute(which)), exact = FALSE))
+
+`%a%<-` <- function (x, which, value)
+ return(`attr<-`(x, deparse(substitute(which)), value))
+
+## To be consistent with the other extraction functions:
+a <- function (x, which, exact = TRUE)
+ return(attr(x, which, exact))
+
+## Environments management
+## Usually, to create an object, we use its name, but
+## environment() means something else here!
+## So, OK, we'll stick with
+newEnv <- new.env
+## for the moment...
+## Now, we want to be able to use names() on it too!
+## Note that for environments, we got items by alphabetic order
+## => not exactly the same as for vector, list, or so!
+names <- function (x)
+ if (inherits(x, "environment")) ls(x, all = TRUE) else base::names(x)
+## Do we implement `names<-` for environments???
+
+## A more convenient setwd()/getwd() using objects
+wdir <- function (dir = NULL)
+{
+ if (is.null(dir)) {
+ dir <- getwd()
+ class(dir) <- c("filename", "character")
+ ## Make sure to use /, even under Windows
+ dir <- gsub("\\\\", "/", dir)
+ return(dir)
+ } else { # Change current working directory
+ owdir <- setwd(dir)
+ ## Make sure to use /, even under Windows
+ owdir <- gsub("\\\\", "/", owdir)
+ class(owdir) <- c("filename", "character")
+ ## Save old working directory
+ .owdir <<- owdir
+ return(owdir)
+ }
+}
+
+## Get or set session dir
+sdir <- function (dir = NULL)
+{
+ if (is.null(dir)) {
+ dir <- getOption("R.initdir")
+ if (is.null(dir)) return(NULL)
+ class(dir) <- c("filename", "character")
+ ## Make sure to use /, even under Windows
+ dir <- gsub("\\\\", "/", dir)
+ return(dir)
+ } else { # Change current session directory
+ osdir <- getOption("R.initdir")
+ ## TODO: make sure to do everything required to cleanly close current
+ ## session!
+ dir <- gsub("\\\\", "/", dir)
+ options(R.initdir = dir)
+ ## TODO: make everything we need to open the new session directory
+ ## Make sure to use /, even under Windows
+ osdir <- gsub("\\\\", "/", osdir)
+ class(osdir) <- c("filename", "character")
+ ## Save old session directory
+ .osdir <<- osdir
+ return(osdir)
+ }
+}
+
+
+subclass <- function (x, class, superclasses = NULL)
+{
+ ## TODO: check this is an S3 object that inherits from the gicven class(es)
+ if (!is.null(superclasses)) {
+ misClass <- inherits(x, as.character(superclasses), which = TRUE) == 0
+ if (any(misClass))
+ stop("'x' soes not inherits from", paste(superclasses[misClass],
+ collapse = ", "))
+ }
+ ## Check if new class in not already defined
+ if (class %in% class(x)) return(x)
+ ## Prepend that class
+ class(x) <- c(class, class(x))
+ return(x)
+}
+
+`subclass<-` <- function (x, value)
+{
+ if (!value %in% class(x)) class(x) <- c(value, class(x))
+ return(x)
+}
+
+filename <- function (...)
+{
+ ## Create a vector of filename objects inheriting from character
+ return(subclass(as.character(c(...)), "filename"))
+}
+
+print.filename <- function (x, ...)
+{
+ path <- as.character(x)
+ path <- gsub("\\\\", "/", path)
+ ## Make sure paths are ended with / to differentiate them from files
+ isdir <- file.info(path)$isdir
+ ## Non-existent files are these ones
+ nofile <- is.na(isdir)
+ path[nofile] <- paste(path[nofile], "*", sep = "")
+ ## These are directories
+ isdir <- (isdir & !grepl("/$", path))
+ isdir[is.na(isdir)] <- FALSE
+ path[isdir] <- paste(path[isdir], "/", sep = "")
+ ## Print it
+ print(noquote(paste("<", path, ">", sep = "")))
+ return(invisible(x))
+}
Added: pkg/SciViews/R/file.R
===================================================================
--- pkg/SciViews/R/file.R (rev 0)
+++ pkg/SciViews/R/file.R 2011-12-11 19:39:50 UTC (rev 411)
@@ -0,0 +1,159 @@
+## Essentially a series of base R function that manipulate files and directories
+## and that are renamed/rationalized for facility
+
+subclass <- function (x, class, superclasses = NULL)
+{
+ ## TODO: check this is an S3 object that inherits from the gicven class(es)
+ if (!is.null(superclasses)) {
+ misClass <- inherits(x, as.character(superclasses), which = TRUE) == 0
+ if (any(misClass))
+ stop("'x' soes not inherits from", paste(superclasses[misClass],
+ collapse = ", "))
+ }
+ ## Check if new class in not already defined
+ if (class %in% class(x)) return(x)
+ ## Prepend that class
+ class(x) <- c(class, class(x))
+ return(x)
+}
+
+`subclass<-` <- function (x, value)
+{
+ if (!value %in% class(x)) class(x) <- c(value, class(x))
+ return(x)
+}
+
+## A replacement for file.path
+filePath <- function (..., fsep = .Platform$file.sep)
+{
+ ## Create a filePath objects inheriting from character
+ return(structure(.Internal(file.path(list(...), fsep)),
+ class = c("filePath", "character")))
+}
+
+print.filePath <- function (x, ...)
+{
+ path <- as.character(x)
+ path <- gsub("\\\\", "/", path)
+ ## Make sure paths are ended with / to differentiate them from files
+ isdir <- file.info(path)$isdir
+ ## Non-existent files are these ones
+ nofile <- is.na(isdir)
+ path[nofile] <- paste(path[nofile], "*", sep = "")
+ ## These are directories
+ isdir <- (isdir & !grepl("/$", path))
+ isdir[is.na(isdir)] <- FALSE
+ path[isdir] <- paste(path[isdir], "/", sep = "")
+ ## Print it
+ print(noquote(paste("<", path, ">", sep = "")))
+ return(invisible(x))
+}
+
+## Rework file paths
+## basename
+fileName <- function (path)
+ return(structure(basename(path), class = c("filePath", "character")))
+
+## dirname
+fileDir <- function (path)
+ return(structure(dirname(path), class = c("filePath", "character")))
+
+## path.expand
+fileExpand <- function (path)
+ return(structure(path.expand(path), class = c("filePath", "character")))
+
+## normalizePath
+fileNormalize <- function (path, mustWork = FALSE)
+ return(structure(normalizePath(path, winslash = "/", mustWork = mustWork),
+ class = c("filePath", "character")))
+
+## Get various files or directories
+## R.home
+dirR <- function (component = "home")
+ return(structure(R.home(component), class = c("filePath", "character")))
+
+## system.file TODO: case it returns ""! And should we use mustWork?
+filePackage <- function (..., package = "base", lib.loc = NULL, mustWork = FALSE)
+ return(structure(system.file(..., package = package, lib.loc = lib.loc,
+ mustWork = mustWork), class = c("filePath", "character")))
+
+## tempdir
+dirTemp <- function ()
+ return(structure(.Internal(tempdir()), class = c("filePath", "character")))
+
+## tempfile
+fileTemp <- function (pattern = "file", tmpdir = tempdir(), fileext = "")
+ return(structure(.Internal(tempfile(pattern, tmpdir, fileext)),
+ class = c("filePath", "character")))
+
+## Sys.which, TODO: keep names and display them in print.filePath objects!
+fileFind <- function (names)
+ return(structure(Sys.which(names), class = c("filePath", "character")))
+
+
+dirList dir
+dirList list.dirs
+fileList list.files
+dirCreate dir.create
+fileAccess file.access
+fileAppend file.append
+fileChoose file.choose
+fileCopy file.copy
+fileCreate file.create
+fileExists file.exists
+fileInfo file.info
+fileLink file.link
+fileRemove file.remove
+fileRename file.rename
+fileShow file.show
+fileSymlink file.symlink
+fileChmod Sys.chmod
+fileGlob Sys.glob
+fileUnlink unlink
+# = isDir/isFile
+
+## A more convenient setwd()/getwd() using objects
+wdir <- function (dir = NULL)
+{
+ if (is.null(dir)) {
+ dir <- getwd()
+ class(dir) <- c("filename", "character")
+ ## Make sure to use /, even under Windows
+ dir <- gsub("\\\\", "/", dir)
+ return(dir)
+ } else { # Change current working directory
+ owdir <- setwd(dir)
+ ## Make sure to use /, even under Windows
+ owdir <- gsub("\\\\", "/", owdir)
+ class(owdir) <- c("filename", "character")
+ ## Save old working directory
+ .owdir <<- owdir
+ return(owdir)
+ }
+}
+
+## Get or set session dir
+sdir <- function (dir = NULL)
+{
+ if (is.null(dir)) {
+ dir <- getOption("R.initdir")
+ if (is.null(dir)) return(NULL)
+ class(dir) <- c("filePath", "character")
+ ## Make sure to use /, even under Windows
+ dir <- gsub("\\\\", "/", dir)
+ return(dir)
+ } else { # Change current session directory
+ osdir <- getOption("R.initdir")
+ ## TODO: make sure to do everything required to cleanly close current
+ ## session!
+ dir <- gsub("\\\\", "/", dir)
+ options(R.initdir = dir)
+ ## TODO: make everything we need to open the new session directory
+ ## Make sure to use /, even under Windows
+ osdir <- gsub("\\\\", "/", osdir)
+ class(osdir) <- c("filePath", "character")
+ ## Save old session directory
+ .osdir <<- osdir
+ return(osdir)
+ }
+}
Modified: pkg/svDialogs/DESCRIPTION
===================================================================
--- pkg/svDialogs/DESCRIPTION 2011-12-11 18:22:17 UTC (rev 410)
+++ pkg/svDialogs/DESCRIPTION 2011-12-11 19:39:50 UTC (rev 411)
@@ -5,8 +5,8 @@
SystemRequirements: TODO!!!
Description: Rapidly construct dialog boxes for your GUI, including an automatic
function assistant
-Version: 0.9-44
-Date: 2011-07-29
+Version: 0.9-45
+Date: 2011-11-11
Author: Philippe Grosjean
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
Modified: pkg/svDialogs/NAMESPACE
===================================================================
--- pkg/svDialogs/NAMESPACE 2011-12-11 18:22:17 UTC (rev 410)
+++ pkg/svDialogs/NAMESPACE 2011-12-11 19:39:50 UTC (rev 411)
@@ -1,8 +1,7 @@
# To be eliminated, except for svGUI
import(tcltk, svMisc, svGUI)
-export(
- dlgDir,
+export(dlgDir,
dlgInput,
dlgList,
dlgMessage,
@@ -16,7 +15,11 @@
guiPane.tcltk,
guiPane.entry.tcltk,
guiPane.list.tcltk,
- guiSetStyle.tcltk)
+ guiSetStyle.tcltk,
+ menuAdd,
+ menuAddItem,
+ menuDel,
+ menuDelItem)
# To be eliminated
S3method(display, guiDlg)
Modified: pkg/svDialogs/NEWS
===================================================================
--- pkg/svDialogs/NEWS 2011-12-11 18:22:17 UTC (rev 410)
+++ pkg/svDialogs/NEWS 2011-12-11 19:39:50 UTC (rev 411)
@@ -1,5 +1,13 @@
= svDialogs News
+== Changes in svDialogs 0.9-45
+
+* Similar custom menus as 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 ?menuAdd.
+
+
== Changes in svDialogs 0.9-44
* The guiDlgXXX() functions are reworked into S3 methods and their interface
Added: pkg/svDialogs/R/menu.R
===================================================================
--- pkg/svDialogs/R/menu.R (rev 0)
+++ pkg/svDialogs/R/menu.R 2011-12-11 19:39:50 UTC (rev 411)
@@ -0,0 +1,253 @@
+## Menu functions
+.menuClear <- function ()
+{
+ res <- switch(Sys.info()["sysname"],
+ Windows = NULL,
+ Darwin = .macMenuClear(),
+ .unixMenuClear()
+ )
+ return(invisible(res))
+}
+
+menuAdd <- function (menuname)
+{
+ res <- switch(Sys.info()["sysname"],
+ Windows = winMenuAdd(menuname),
+ Darwin = .macMenuAdd(menuname),
+ .unixMenuAdd(menuname)
+ )
+ return(invisible(res))
+}
+
+menuAddItem <- function (menuname, itemname, action)
+{
+ res <- switch(Sys.info()["sysname"],
+ Windows = winMenuAddItem(menuname, itemname, action),
+ Darwin = .macMenuAddItem(menuname, itemname, action),
+ .unixMenuAddItem(menuname, itemname, action)
+ )
+ return(invisible(res))
+}
+
+menuDel <- function (menuname)
+{
+ res <- switch(Sys.info()["sysname"],
+ Windows = try(winMenuDel(menuname), silent = TRUE),
+ Darwin = .macMenuDel(menuname),
+ .unixMenuDel(menuname)
+ )
+ return(invisible(res))
+}
+
+menuDelItem <- function (menuname, itemname)
+{
+ res <- switch(Sys.info()["sysname"],
+ Windows = try(winMenuDelItem(menuname, itemname), silent = TRUE),
+ Darwin = .macMenuDelItem(menuname, itemname),
+ .unixMenuDelItem(menuname, itemname)
+ )
+ return(invisible(res))
+}
+
+
+## Windows version and standard winMenuXXX
+## TODO: fallback system for Rterm???
+
+## Mac OS X version
+## Note, either we use AppleScript folder (by default) or the XMenu folder
+## Install XMenu from http://xmenu.en.softonic.com/mac.
+## You should use the custom commands only for R, because it will erase
+## everything in it everytime the svDialogs package starts!
+## Configure XMenu to display only User-Defined items, and name it R.
+## Select folders before files, for icons: None, Big font
+## and for menu titles: Text and then, Start at login
+#options(useXMenu = TRUE)
+.macMenuFolder <- function ()
+{
+ ## Get the root folder for the R menus, depends on wether we use XMenu or not
+ useXMenu <- getOption("useXMenu", default = NULL)
+ if (is.null(useXMenu)) {
+ ## If not specified, look if a "R" file or folder exists
+ useXMenu <- file.exists("~/Library/Application Support/XMenu/R")
+ } else useXMenu <- isTRUE(useXMenu)
+ return(getOption("menuFolder", default = if (useXMenu)
+ "~/Library/Application Support/XMenu/Custom" else
+ "~/Library/Scripts/Applications/R"))
+}
+
+.macMenuClear <- function () {
+ ## To be called when svDialogs package loads: make sure to zap all
+ ## custom menu items that may have been previously defined
+ ## (also call it when the package closes)
+ odir <- getwd()
+ on.exit(setwd(odir))
+ setwd(.macMenuFolder())
+ setwd("..")
+ folder <- file.path(".", basename(.macMenuFolder()))
+ unlink(folder, recursive = TRUE)
+ dir.create(folder, recursive = TRUE)
+ ## Now, I can assume that the dir is created and is empty
+ return(invisible(NULL))
+}
+
+.macMenuAdd <- function (menuname)
+{
+ ## Menus are folders created in ~/Scripts/Applications/R/Custom
+ ## I just need to create (recursively) the directories
+ dir.create(file.path(.macMenuFolder(), menuname),
+ showWarnings = FALSE, recursive = TRUE)
+ return(invisible(NULL))
+}
+
+.macMenuAddItem <- function (menuname, itemname, action)
+{
+ ## Make sure that the dir is created
+ .macMenuAdd(menuname)
+ ## Switch to this folder
+ odir <- getwd()
+ on.exit(setwd(odir))
+ setwd(file.path(.macMenuFolder(), menuname))
+ ## Add an executable file in it with 'itemname' name
+ ## that contains AppleScript code to run action in R
+ ## Determine if R is run in R.app or in a terminal window
+ if (.Platform$GUI == "AQUA") {
+ ## Can be R or R64 or SciViews R or SciViews R64!
+ app <- paste('"', system("osascript -e 'name of application \"R\"'",
+ intern = TRUE), '"', sep = "")
+ } else app <- "\"Terminal\""
+ ## Define action accordingly
+ if (action == "none") {
+ cmd <- "to activate"
+ } else {
+ ## Make sure to quote "
+ action <- gsub('"', '\\\\"', action)
+ ## Also replace \n, \r and \t
+ action <- gsub('\n', '\\\\\\\\n', action)
+ action <- gsub('\r', '\\\\\\\\r', action)
+ action <- gsub('\t', '\\\\\\\\t', action)
+ if (app == "\"Terminal\"") {
+ cmd <- paste("to do script \"", action, "\" in window 1", sep = "")
+ } else {
+ cmd <- paste("to cmd \"", action, "\"", sep = "")
+ }
+ }
+ ## Compile applescript item
+ system(paste("osacompile -e 'tell application ", app, " ", cmd,
+ "' -o \"", itemname, ".app\"", sep = ""), ignore.stdout = TRUE,
+ ignore.stderr = TRUE)
+ return(invisible(NULL))
+}
+
+.macMenuDel <- function (menuname)
+{
+ ## Unlink does not like ~ => change working dir first
+ odir <- getwd()
+ on.exit(setwd(odir))
+ setwd(.macMenuFolder())
+ unlink(menuname, recursive = TRUE)
+ return(invisible(NULL))
+}
+
+.macMenuDelItem <- function (menuname, itemname)
+{
+ ## Unlink does not like ~ => change working dir first
+ odir <- getwd()
+ on.exit(setwd(odir))
+ setwd(file.path(.macMenuFolder()))
+ unlink(file.path(".", menuname, paste(itemname, "app", sep = ".")),
+ recursive = TRUE)
+ return(invisible(NULL))
+}
+
+
+## Linux/Unix version
+## Explanation: to run this, you need to install xvkbd and file-browser-applet
+## for Gnome. Under Ubuntu, you make:
+## sudo apt-get install file-browser-apple
+## sudo apt-get install xvkbd
+## You need to log out and in again to make the applet available
+## Then, you need to install and configure a file browser applet in a panel
+## right-click in a panel, select 'add to Panel...' and drag&drop a 'File Browser'
+## Right-click on the file browser and select 'Preferences'. In the preference
+## box, eleminate the default entry (Home) and add all subdirectories from
+## ~/Scripts/Applications/R. You can access R menus from there, and it sends
+## corresponding commands to the focused window (e.g., a terminal running R)
+## TODO: find a similar item for KDE and new Ubuntu unity interface!
+## winMenuAdd(), winMenuAddItem(), winMenuDel() and winMenuDelItem() already
+## defined for windows RGui, but need a substitution for Rterm!
+.unixMenuFolder <- function ()
+{
+ ## Get the root folder for the R menus
+ return(getOption("menuFolder", default = "~/R/R menu"))
+}
+
+.unixMenuClear <- function () {
+ ## To be called when svDialogs package loads: make sure to zap all
+ ## custom menu items that may have been previously defined
+ ## (also call it when the package closes)
+ odir <- getwd()
+ on.exit(setwd(odir))
+ res <- try(setwd(.unixMenuFolder()), silent = TRUE)
+ if (inherits(res, "try-error")) {
+ ## The directory does not exists yet... create it!
+ dir.create(.uniMenuFolder(), recursive = TRUE)
+ } else {
+ ## The directory already exists... clear it now
+ setwd("..")
+ folder <- file.path(".", basename(.unixMenuFolder()))
+ unlink(folder, recursive = TRUE)
+ }
+ dir.create(folder, recursive = TRUE)
+ ## Now, I can assume that the dir is created and is empty
+ return(invisible(NULL))
+}
+
+.unixMenuAdd <- function (menuname) {
+ ## I just need to create (recursively) the directories
+ dir.create(file.path(.unixMenuFolder(), menuname),
+ showWarnings = FALSE, recursive = TRUE)
+ return(invisible(NULL))
+}
+
+.unixMenuAddItem <- function (menuname, itemname, action) {
+ ## Make sure that the dir is created
+ .unixMenuAdd(menuname)
+ ## Add an executable file in it with 'itemname' name
+ ## and containing: xvkbd -text "action\r" except if action is "none"
+ cmdFile <- file.path(.unixMenuFolder(), menuname, itemname)
+ if (action == "none") {
+ cat("\n", file = cmdFile)
+ } else {
+ ## Make sure to quote "
+ action <- gsub('"', '\\\\"', action)
+ ## Also replace \n, \r and \t (and wait 200ms between lines)
+ action <- gsub('\n', '\\\\r\\\\D2', action)
+ action <- gsub('\r', '\\\\r\\\\D2', action)
+ action <- gsub('\t', ' ', action)
+ cat("xvkbd -text \"", action, "\\r\"\n", sep = "", file = cmdFile)
+ }
+ ## Make this file executable
+ Sys.chmod(cmdFile, mode = "755")
+ return(invisible(NULL))
+}
+
+.unixMenuDel <- function (menuname) {
+ ## Unlink does not like ~ => change working dir first
+ odir <- getwd()
+ on.exit(setwd(odir))
+ setwd(.unixMenuFolder())
+ unlink(menuname, recursive = TRUE)
+ return(invisible(NULL))
+}
+
+.unixMenuDelItem <- function (menuname, itemname) {
+ ## Unlink does not like ~ => change working dir first
+ path <- file.path(.unixMenuFolder(), menuname)
+ if (file.exists(path) && file.info(path)$isdir) {
+ odir <- getwd()
+ on.exit(setwd(odir))
+ setwd(path)
+ unlink(itemname)
+ }
+ return(invisible(NULL))
+}
Added: pkg/svDialogs/R/svDialogs-internal.R
===================================================================
--- pkg/svDialogs/R/svDialogs-internal.R (rev 0)
+++ pkg/svDialogs/R/svDialogs-internal.R 2011-12-11 19:39:50 UTC (rev 411)
@@ -0,0 +1,13 @@
+.onLoad <- function (lib, pkg)
+{
+ ## Clear menus
+ .menuClear()
+}
+
+.onUnload <- function (libpath)
+{
+ ## Clear menus again
+ .menuClear()
+}
+
+.packageName <- "svDialogs"
Modified: pkg/svDialogs/TODO
===================================================================
--- pkg/svDialogs/TODO 2011-12-11 18:22:17 UTC (rev 410)
+++ pkg/svDialogs/TODO 2011-12-11 19:39:50 UTC (rev 411)
@@ -6,9 +6,6 @@
svDialogs..tcltk.
* Translation into different languages.
-
-* Control the terminal (where R runs) using osascript:
- osascript -e 'tell app "Terminal" to do script %s'
* Rename .GUI .UI, make UI() and use it instead? object name is UI. setUI(),
getUI(), startUI(), endUI(), and should they really be generic functions?
Added: pkg/svDialogs/man/menu.Rd
===================================================================
--- pkg/svDialogs/man/menu.Rd (rev 0)
+++ pkg/svDialogs/man/menu.Rd 2011-12-11 19:39:50 UTC (rev 411)
@@ -0,0 +1,107 @@
+\name{menuAdd}
+\alias{menuAdd}
+\alias{menuAddItem}
+\alias{menuDel}
+\alias{menuDelItem}
+
+\title{ Manage custom R menus }
+\description{
+ Create, populate and rework custom R menus.
+}
+
+\usage{
+menuAdd(menuname)
+menuAddItem(menuname, itemname, action)
+menuDel(menuname)
+menuDelItem(menuname, itemname)
+}
+
+\arguments{
+ \item{menuname}{ a character string naming a menu. }
+ \item{itemname}{ a character string naming a menu item on an existing menu. }
+ \item{action}{ a character string describing the action when that menu is
+ selected, or \code{"none"} for no action. }
+}
+
+\details{
+ On Windows, the function manages custom menus in RGui the same way as
+ \code{winMenuAdd()} and similar function do. Menus are added to the right
+ and new menu entries are added to the bottom of the menu. It is currently
+ not possible to add menus for Rterm.exe under Windows.
+
+ 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,
+ then, go to Preferences... and check 'Show script menu in menu bar'). Custom
+ R menus will be visible as folders in this menu bar item only when R.app or
+ R64.app is the formost application. there is an alternate interface using the
+ XMenu menu bar applet. It works with both R.app and R run in a terminal, but
+ you have to install and customize it first. Install XMenu from
+ http://xmenu.en.softonic.com/mac. You should use the custom commands only for
+ R custom menus, because svDialogs will erase everything in it everytime the
+ package starts!
+ Configure XMenu to display only User-Defined items, and name it \"R\". Select
+ \"Folders before files\". For icons, best rendering is obtained with \"None,
+ Big font\". For menu titles, select \"Text\" for entries that look like real
+ menus. Be sure to check also "Start at login". Selection of XMenu instead of
+ AppleScript menus is not automatic, but it can be enabled in two different
+ ways: (1) by entering \code{option(useXMenu = TRUE)}, or by placing a \"R\"
+ file or folder in '~/Library/Application Support/XMenu'.
+
+ On Unix/Linux, under Gnome, you must install xvkbd and the file-browser-applet
+ for Gnome. Under Ubuntu, you make:
+ sudo apt-get install file-browser-apple
+ sudo apt-get install xvkbd
+ You need to log out and in again to make the applet available. Then, you need
+ to install and configure a file browser applet in a panel right-click in a
+ panel, select 'add to Panel...' and drag&drop a 'File Browser'. Right-click on
+ the file browser and select 'Preferences'. In the preference box, eliminate
+ the default entry (Home) and add all subdirectories from
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 411
More information about the Sciviews-commits
mailing list