[Sciviews-commits] r316 - in pkg/svIDE: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Sep 25 11:17:46 CEST 2010
Author: phgrosjean
Date: 2010-09-25 11:17:46 +0200 (Sat, 25 Sep 2010)
New Revision: 316
Added:
pkg/svIDE/R/sourceFormat.R
pkg/svIDE/R/svIDE-Internal.R
pkg/svIDE/man/Source-deprecated.Rd
pkg/svIDE/man/sourceFormat.Rd
pkg/svIDE/man/svIDE-package.Rd
Removed:
pkg/svIDE/R/Source.R
pkg/svIDE/R/Startup.R
pkg/svIDE/man/Source.Rd
Modified:
pkg/svIDE/DESCRIPTION
pkg/svIDE/NAMESPACE
pkg/svIDE/R/createCallTipFile.R
pkg/svIDE/R/createSyntaxFile.R
pkg/svIDE/R/getFunctions.R
pkg/svIDE/R/getKeywords.R
pkg/svIDE/R/guiDDEInstall.R
pkg/svIDE/R/kpfTranslate.R
pkg/svIDE/R/makeIconGallery.R
pkg/svIDE/TODO
pkg/svIDE/man/createSyntaxFile.Rd
pkg/svIDE/man/getFunctions.Rd
pkg/svIDE/man/getKeywords.Rd
pkg/svIDE/man/guiDDEInstall.Rd
pkg/svIDE/man/kpfTranslate.Rd
pkg/svIDE/man/makeIconGallery.Rd
Log:
Further stylistic changes in code and man pages...
Modified: pkg/svIDE/DESCRIPTION
===================================================================
--- pkg/svIDE/DESCRIPTION 2010-09-25 09:17:12 UTC (rev 315)
+++ pkg/svIDE/DESCRIPTION 2010-09-25 09:17:46 UTC (rev 316)
@@ -4,8 +4,8 @@
Depends: R (>= 2.6.0)
Imports: utils, tcltk, svMisc, XML
Description: Function for the GUI API to interact with external IDE/code editors
-Version: 0.9-49
-Date: 2010-01-03
+Version: 0.9-50
+Date: 2010-09-25
Author: Philippe Grosjean
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
Modified: pkg/svIDE/NAMESPACE
===================================================================
--- pkg/svIDE/NAMESPACE 2010-09-25 09:17:12 UTC (rev 315)
+++ pkg/svIDE/NAMESPACE 2010-09-25 09:17:46 UTC (rev 316)
@@ -5,11 +5,12 @@
getFunctions,
getKeywords,
guiCallTip,
- guiComplete,
+ guiComplete,
guiDDEInstall,
- Source,
- kpf2pot,
- kpz2pot,
- kpfTranslate,
- kpzTranslate,
- makeIconGallery)
+ Source,
+ sourceFormat,
+ kpf2pot,
+ kpz2pot,
+ kpfTranslate,
+ kpzTranslate,
+ makeIconGallery)
Deleted: pkg/svIDE/R/Source.R
===================================================================
--- pkg/svIDE/R/Source.R 2010-09-25 09:17:12 UTC (rev 315)
+++ pkg/svIDE/R/Source.R 2010-09-25 09:17:46 UTC (rev 316)
@@ -1,67 +0,0 @@
-"Source" <-
-function (file, out.form = getOption("R.output.format"), local = FALSE,
- echo = FALSE, print.eval = TRUE, verbose = getOption("verbose"),
- prompt.echo = getOption("prompt"), max.deparse.length = 150,
- chdir = FALSE, prompt = FALSE)
-{
-
- # This is a reworked version of .Rsource from RpadUtils (Tom Short)
- # but this version uses source() itself
-
- if (is.null(out.form)) out.form <- "text"
- # capture.all() is inspired from capture.output(), but it captures
- # both the output and the message streams and it evaluates in .GlobalEnv
- "capture.all" <- function(...) {
- args <- substitute(list(...))[-1]
- file <- textConnection("rval", "w", local = TRUE)
- sink(file, type = "output")
- sink(file, type = "message")
- on.exit({
- sink(type = "output")
- sink(type = "message")
- close(file)
- })
-
- for (i in seq(length = length(args))) {
- expr <- args[[i]]
- if (mode(expr) == "expression")
- tmp <- lapply(expr, withVisible) #tmp <- lapply(expr, evalVis)
- else if (mode(expr) == "call")
- tmp <- list(withVisible(expr)) #tmp <- list(evalVis(expr))
- else if (mode(expr) == "name")
- tmp <- list(withVisible(expr)) #tmp <- list(evalVis(expr))
- else stop("bad argument")
- for (item in tmp) {
- if (item$visible)
- print(item$value)
- }
- }
- sink(type = "output")
- sink(type = "message")
- cat("====\n")
- print(file)
- cat("====\n")
- return(file)
- }
-
- # We capture output from source() with default args slightly modified
- ### TODO: get rid of source() and use something like:
- # (try(parse(textConnection("ls()")), silent = TRUE))
- # with detection of incomplete lines and other error messages!
- res <- capture.all(source(file = file, local = FALSE, echo = echo,
- print.eval = print.eval, verbose = verbose, prompt.echo = prompt.echo,
- max.deparse.length = max.deparse.length, chdir = chdir))
- if (inherits(res, "list"))
- res <- paste(res, collapse = "\n")
- if (!out.form %in% c("none", "html"))
- res <- paste(paste(res, collapse="\n"), "\n", sep = "")
- # Note for out.form == "html", we want to use something like:
- #require(R2HTML) || stop("Package 'R2HTML' is required!")
- #res <- HTML(res, file = "")
- # But since we do not want a dependency to R2HTML here,
- # we should better put this in the SciViews-R manual
- if (prompt)
- res <- paste(res, options()$prompt, sep = "")
- # TODO: possibly use a continue prompt!
- invisible(res)
-}
Deleted: pkg/svIDE/R/Startup.R
===================================================================
--- pkg/svIDE/R/Startup.R 2010-09-25 09:17:12 UTC (rev 315)
+++ pkg/svIDE/R/Startup.R 2010-09-25 09:17:46 UTC (rev 316)
@@ -1,20 +0,0 @@
-".onLoad" <-
-function (lib, pkg)
-{
- # Starting the DDE server automatically if under Windows
- # and option use.DDE == TRUE
- use.DDE <- getOption("use.DDE")
- if (.Platform$OS.type == "windows" && !is.null(use.DDE) && use.DDE)
- guiDDEInstall()
-
- # If an IDE is defined, start it now
- IDE <- getOption("IDE")
- if (!is.null(IDE) && file.exists(IDE))
- system(paste("\"", IDE, "\"", sep = ""), wait = FALSE)
-}
-
-# This is to define writeClipboard() on other platforms than windows (but does
-# nothing currently!)
-if (.Platform$OS.type != "windows")
- "writeClipboard" <- function (str, format = 1)
- stop("Not implemented yet on other platforms than Windows")
Modified: pkg/svIDE/R/createCallTipFile.R
===================================================================
--- pkg/svIDE/R/createCallTipFile.R 2010-09-25 09:17:12 UTC (rev 315)
+++ pkg/svIDE/R/createCallTipFile.R 2010-09-25 09:17:46 UTC (rev 316)
@@ -1,19 +1,18 @@
-"createCallTipFile" <-
-function (file = "Rcalltips.txt", pos = 2:length(search()), field.sep = "=",
- only.args = FALSE, return.location = FALSE)
+createCallTipFile <- function (file = "Rcalltips.txt", pos = 2:length(search()),
+field.sep = "=", only.args = FALSE, return.location = FALSE)
{
- # Create a .txt file containing calltips for R functions.
+ ## Create a .txt file containing calltips for R functions.
cat("", file = file) # Create the beginning of the file
- # Get the list of keywords
+ ## Get the list of keywords
keys <- getKeywords(pos = pos)
- # For each keyword, write a line in the file with keyword=calltip
+ ## For each keyword, write a line in the file with keyword=calltip
for (key in keys) {
ctip <- CallTip(key, only.args = only.args)
if (ctip != "") {
if (return.location == TRUE) {
- # Get the package from where it is located and append it
+ ## Get the package from where it is located and append it
pkg <- sub("^package:", "", find(key, mode = "function"))
if (length(pkg) > 0 && pkg != ".GlobalEnv")
pkg <- paste(" [", pkg, "]", sep = "") else pkg <- " []"
Modified: pkg/svIDE/R/createSyntaxFile.R
===================================================================
--- pkg/svIDE/R/createSyntaxFile.R 2010-09-25 09:17:12 UTC (rev 315)
+++ pkg/svIDE/R/createSyntaxFile.R 2010-09-25 09:17:46 UTC (rev 316)
@@ -1,11 +1,10 @@
-"createSyntaxFile" <-
-function (svlfile = "R.svl", pos = 2:length(search()))
+createSyntaxFile <- function (svlfile = "R.svl", pos = 2:length(search()))
{
- # Create an .svl syntax file for R.
- # Note: use only main keywords for keywords2, because it is limited
- # to a little bit less than 32k (2.000 to 2.500 keywords)
+ ## Create an .svl syntax file for R.
+ ## Note: use only main keywords for keywords2, because it is limited
+ ## to a little bit less than 32k (2.000 to 2.500 keywords)
- # Create the beginning of the file
+ ## Create the beginning of the file
cat(";This is a config file internally used by SciViews.\n",
file = svlfile)
cat(";Do not change it manually, except if you exactly know what you are doing!\n\n",
@@ -31,7 +30,7 @@
cat("[Syntax]\n", file = svlfile, append = TRUE)
cat("CaseSensitive=1\n", file = svlfile, append = TRUE)
cat("SingleLineComment=#\n", file = svlfile, append = TRUE)
- #### TODO: starting from R 2.4.0, "`" inside strings raises a warning => temporarilly disabled
+### TODO: starting from R 2.4.0, "`" inside strings raises a warning => temporarilly disabled
#cat("ScopeKeywords1={,(,[,[[,$,@,¸\n", file = svlfile, append = TRUE)
cat("ScopeKeywords1={,(,[,[[,$,@\n", file = svlfile, append = TRUE)
#cat("ScopeKeywords2=},),],]],$,@,¸\n", file = svlfile, append = TRUE)
Modified: pkg/svIDE/R/getFunctions.R
===================================================================
--- pkg/svIDE/R/getFunctions.R 2010-09-25 09:17:12 UTC (rev 315)
+++ pkg/svIDE/R/getFunctions.R 2010-09-25 09:17:46 UTC (rev 316)
@@ -1,6 +1,5 @@
-"getFunctions" <-
-function (pos)
+getFunctions <- function (pos)
{
- # Get a list of all R functions in a certain position
+ ## Get a list of all R functions in a certain position
return(as.character(lsf.str(pos = pos, all.names = TRUE)))
}
Modified: pkg/svIDE/R/getKeywords.R
===================================================================
--- pkg/svIDE/R/getKeywords.R 2010-09-25 09:17:12 UTC (rev 315)
+++ pkg/svIDE/R/getKeywords.R 2010-09-25 09:17:46 UTC (rev 316)
@@ -1,25 +1,24 @@
-"getKeywords" <-
-function (pos = 2:length(search()))
+getKeywords <- function (pos = 2:length(search()))
{
- # Get a sorted list of unique function names for libraries loaded
- # in positions provided by pos
+ ## Get a sorted list of unique function names for libraries loaded
+ ## in positions provided by pos
res <- NULL
for (i in pos) {
if (search()[i] == "package:base") # Use builtins() instead
res <- c(res, builtins()) else
res <- c(res, as.character(getFunctions(i)))
}
- # Sort res and return only unique names
+ ## Sort res and return only unique names
res <- sort(res[!duplicated(res)])
- # Eliminate items containing <-, __, -, !, $, %, &, |, *, +, /, :, [ or =
+ ## Eliminate items containing <-, __, -, !, $, %, &, |, *, +, /, :, [ or =
searchit <- c("<-", "__", "-", "!", "[$]", "[%]", "[&]", "[|]", "[*]",
"[+]", "[/]", ":", "[[]", "=")
for (i in 1:length(searchit)) {
elim <- grep(searchit[i], res)
if (length(elim) > 0) res <- res[-elim]
}
- # Eliminate some other items (reserved keywords already introduced in
- # keyword1 list, and other stuff)
+ ## Eliminate some other items (reserved keywords already introduced in
+ ## keyword1 list, and other stuff)
reserved <- c("break", "else", "FALSE", "for", "function", "if", "in",
"Inf", "NA", "NaN", "next", "NULL", "repeat", "TRUE", "while", "(",
"?", "@", "^", "{", "~", "<", ">")
Modified: pkg/svIDE/R/guiDDEInstall.R
===================================================================
--- pkg/svIDE/R/guiDDEInstall.R 2010-09-25 09:17:12 UTC (rev 315)
+++ pkg/svIDE/R/guiDDEInstall.R 2010-09-25 09:17:46 UTC (rev 316)
@@ -1,28 +1,28 @@
-"guiCallTip" <-
-function (code, file = NULL, onlyargs = FALSE, width = 60, location = FALSE)
+guiCallTip <- function (code, file = NULL, onlyargs = FALSE, width = 60,
+location = FALSE)
{
- # This is an interface to CallTip for external programs
- # Clear ::SciViewsR_CallTip
+ ## This is an interface to CallTip for external programs
+ ## Clear ::SciViewsR_CallTip
.Tcl("set ::SciViewsR_CallTip {}")
- # Using a callback, all args are strings => convert
+ ## Using a callback, all args are strings => convert
if (length(file) == 0 || file == "" || file == "NULL") file <- NULL
onlyargs <- as.logical(onlyargs[1])
width <- as.integer(width[1])
- # Get the call tip
+ ## Get the call tip
ctip <- CallTip(code, only.args = onlyargs, location = location)
- # Possibly break long lines at reasonables widths
+ ## Possibly break long lines at reasonables widths
if (onlyargs) Exdent <- 0 else Exdent <- 4
if (!is.null(width) && !width < 1)
ctip <- paste(strwrap(ctip, width = width, exdent = Exdent), collapse = "\n")
- # Copy the result to a Tcl variable
+ ## Copy the result to a Tcl variable
.Tcl(paste("set ::SciViewsR_CallTip {", ctip, "}", sep = ""))
- if (!is.null(file)) { # Copy it also to the clipboard or a file
- # if file = clipboard and this is Windows, copy it to the clipboard
+ if (!is.null(file)) { # Copy it also to the clipboard or a file
+ ## If file = clipboard and this is Windows, copy it to the clipboard
if (file == "clipboard") {
if (.Platform$OS.type == "windows") {
writeClipboard(ctip)
@@ -61,59 +61,55 @@
} else {
stop("'clipboard' not supported yet on platforms different than Windows!")
}
- } else { # copy the completion list to the file
+ } else { # Copy the completion list to the file
cat(clist, file = file)
}
}
invisible(clist)
}
-"guiDDEInstall" <-
-function ()
+guiDDEInstall <- function ()
{
- # Register a dde server for R and install callbacks for serveur functions
+ ## Register a dde server for R and install callbacks for serveur functions
- # Make sure tcl/tk dde is operational
+ ## Make sure tcl/tk dde is operational
if (.Platform$OS.type != "windows")
return("DDE not installed: this is not Windows!")
if (!capabilities("tcltk"))
return("DDE not installed: this version of R cannot use Tcl/Tk!")
- # Not needed, since tcltk is now imported in NAMESPACE!
- #if (!require(tcltk))
- # return("DDE not installed: impossible to load tcltk package!")
tclRequire("dde", warn = TRUE)
- # Should be installed by default with the tcltk package under Windows
+ ## Should be installed by default with the tcltk package under Windows
- # Register a "SciViewsR" server
+ ## Register a "SciViewsR" server
topic <- "SciViewsR"
- # Verify if I am not already registered under this topic
+ ## Verify if I am not already registered under this topic
if (!tclvalue(.Tcl("dde servername {}")) == topic) {
- # Check that this server name does not exist yet
+ ## Check that this server name does not exist yet
if (length(grep(paste("[{]TclEval ", topic, "[}]", sep = ""),
tclvalue(.Tcl("dde services TclEval {}")))) > 0) {
mes <- "DDE not installed: server name already in use!"
return(invisible(mes))
}
- # Register me as a dde server with this topic name
+ ## Register me as a dde server with this topic name
.Tcl(paste("dde servername", topic))
- # Check that the server is set correctly (if not, return an error)
+ ## Check that the server is set correctly (if not, return an error)
if (!tclvalue(.Tcl("dde servername {}")) == topic) {
mes <- "DDE not installed: unknown error while starting the server!"
return(invisible(mes))
}
}
- # Install callbacks for guiXXXX functions, for DDE clients to access them
- # guiCallTip()... Take care: must be adapted if you change guiCallTip()!
+ ## Install callbacks for guiXXXX functions, for DDE clients to access them
+ ## guiCallTip()... Take care: must be adapted if you change guiCallTip()!
res <- .Tcl.args(guiCallTip)
.Tcl(paste("proc guiCallTip {code {file \"\"} {onlyargs FALSE}",
" {width 60} {location FALSE} }", gsub("%", "$", res), sep = ""))
- # guiComplete()... Take care: must be adapted if you change guiComplete()!
+ ## guiComplete()... Take care: must be adapted if you change guiComplete()!
res <- .Tcl.args(guiComplete)
.Tcl(paste("proc guiComplete {code {file \"\"}",
" {sep |} }", gsub("%", "$", res), sep = ""))
- # Done
- return(invisible("")) # OK!
+ ## Done
+ return(invisible("")) # OK!
}
Modified: pkg/svIDE/R/kpfTranslate.R
===================================================================
--- pkg/svIDE/R/kpfTranslate.R 2010-09-25 09:17:12 UTC (rev 315)
+++ pkg/svIDE/R/kpfTranslate.R 2010-09-25 09:17:46 UTC (rev 316)
@@ -1,14 +1,15 @@
-# Make a .pot file with translatable strings found in a Komodo project/package
-# Translatable strings are:
-# 1) All names
-# 2) In snippets:
-# [[%ask:R-desc:XXX]]
-# [[%ask:R-tip:XXX]]
-# [[%ask|pref:URL-help:XXX]] and [[%ask|pref:RWiki-help:XXX]]
-# [[%tr:XXX]
-# 3) In macros:
-# Strings inside _("XXX"), with _() being a function returning its argument
-kpf2pot <- function (kpfFile, potFile) {
+### Make a .pot file with translatable strings found in a Komodo project/package
+### Translatable strings are:
+### 1) All names
+### 2) In snippets:
+### [[%ask:R-desc:XXX]]
+### [[%ask:R-tip:XXX]]
+### [[%ask|pref:URL-help:XXX]] and [[%ask|pref:RWiki-help:XXX]]
+### [[%tr:XXX]
+### 3) In macros:
+### Strings inside _("XXX"), with _() being a function returning its argument
+kpf2pot <- function (kpfFile, potFile)
+{
if (missing(kpfFile) || is.null(kpfFile) || is.na(kpfFile))
stop("'kpfFile' must be provided")
if (length(kpfFile) != 1)
@@ -19,35 +20,35 @@
potFile <- sub("\\.kpf", ".pot", kpfFile)
if (kpfFile == potFile)
potFile <- paste(kpfFile, "pot", sep = ".")
- # Extract translatable strings from this file
+ ## Extract translatable strings from this file
doc <- xmlRoot(xmlTreeParse(kpfFile))
imax <- xmlSize(doc)
if (imax < 1) stop("No node found in the file!")
- # Collect all strings to be translated
+ ## Collect all strings to be translated
s <- character(0)
for (i in 1:imax) {
n <- xmlGetAttr(doc[[i]], "name")
if (!is.null(n)) {
s <- c(s, n)
type <- xmlName(doc[[i]])
- # If this is a snippet, look for other translatable strings
+ ## If this is a snippet, look for other translatable strings
if (type == "snippet") {
snip <- xmlValue(doc[[i]])
chunks <- strsplit(snip, "\\[\\[|\\]\\]")[[1]]
- # Keep only chunks starting with R-desc:, R-tip:, URL-help:
- # RWiki-help: or %tr:
+ ## Keep only chunks starting with R-desc:, R-tip:, URL-help:
+ ## RWiki-help: or %tr:
chunks <- chunks[grep("^%ask:R-desc:|^%ask:R-tip:|^%ask:URL-help:|^%ask:RWiki-help:|^%pref:URL-help|^%pref:RWiki-help|%tr:", chunks)]
- # Are there any remaining chunks?
+ ## Are there any remaining chunks?
l <- length(chunks)
if (l > 0) {
- # Eliminate leading stuff
+ ## Eliminate leading stuff
chunks <- sub("^%ask:[^:]+:|%tr:", "", chunks)
- # and add to the list of items to translate
+ ## and add to the list of items to translate
s <- c(s, chunks)
}
} else if (type == "macro") {
mac <- xmlValue(doc[[i]])
- # Collect tagged strings (i.e., strings inside _(...))
+ ## Collect tagged strings (i.e., strings inside _(...))
repeat {
str <- sub("^.*_\\(\"(.*[^\\\\])\"\\).*$", "\\1", mac)
if (str == mac) break
@@ -65,7 +66,7 @@
}
}
}
- # Keep only unique strings
+ ## Keep only unique strings
s <- unique(s)
s <- s[nzchar(s)]
tmp <- shQuote(encodeString(s), type = "cmd")
@@ -86,11 +87,12 @@
""))
for (e in tmp)
writeLines(con = con, c("", paste("msgid", e), "msgstr \"\""))
- # Check that the .pot file is created
+ ## Check that the .pot file is created
return(invisible(file.exists(potFile)))
}
-kpz2pot <- function (kpzFile, potFile) {
+kpz2pot <- function (kpzFile, potFile)
+{
if (missing(kpzFile) || is.null(kpzFile) || is.na(kpzFile))
stop("'kpzFile' must be provided")
if (length(kpzFile) != 1)
@@ -101,21 +103,22 @@
potFile <- sub("\\.kpz", ".pot", kpzFile)
if (kpzFile == potFile)
potFile <- paste(kpzFile, "pot", sep = ".")
- # The kpz file is a zipped file containing package.kpf in a subdirectory
+ ## The kpz file is a zipped file containing package.kpf in a subdirectory
f <- file.path(tempdir(), "package.kpf")
- unlink(f) # Make sure the file does not exist yet
+ unlink(f) # Make sure the file does not exist yet
unzip(kpzFile, junkpaths = TRUE, exdir = tempdir())
if (!file.exists(file.path(tempdir(), "package.kpf")))
stop("Impossible to extract the content of the .kpz file.")
- # Run kpf2pot() on this file
+ ## Run kpf2pot() on this file
kpf2pot(f, potFile)
- # Delete extracted file
+ ## Delete extracted file
unlink(f)
- # Check that the .pot file is created
+ ## Check that the .pot file is created
return(invisible(file.exists(potFile)))
}
-kpfTranslate <- function (kpfFile, langs, poFiles, kpf2Files) {
+kpfTranslate <- function (kpfFile, langs, poFiles, kpf2Files)
+{
if (missing(kpfFile) || is.null(kpfFile) || is.na(kpfFile))
stop("'kpfFile' must be provided")
if (length(kpfFile) != 1)
@@ -126,7 +129,7 @@
if (missing(poFiles) || is.na(poFiles)) poFiles <- NULL
if (missing(langs)) {
if (is.null(poFiles)) {
- # Try to get the list of suitable .po files in same dir as kpfFile
+ ## Try to get the list of suitable .po files in same dir as kpfFile
pattern <- paste(basename(proj), ".+\\.po$", sep = "-")
poFiles <- dir(dirname(kpfFile), pattern, full.names = TRUE)
if (length(poFiles) < 1)
@@ -136,7 +139,7 @@
if (is.null(poFiles)) {
if (is.null(langs))
stop("You must provide 'langs' (ex.: 'fr', or 'de'), or 'poFiles'")
- # Try to guess poFiles from langs
+ ## Try to guess poFiles from langs
poFiles <- paste(proj, "-", langs, ".po", sep = "")
}
if (any(kpfFile == poFiles))
@@ -144,7 +147,7 @@
if (any(!file.exists(poFiles)))
stop("One or more 'poFiles' not found!")
if (missing(kpf2Files)) {
- # Guess kpf2Files from poFiles
+ ## Guess kpf2Files from poFiles
kpf2Files <- sub("\\.po$", ".kpf", poFiles)
}
if (any(kpfFile == kpf2Files))
@@ -153,32 +156,32 @@
stop("'poFiles' and 'kpf2Files' cannot be the same")
if (length(poFiles) != length(kpf2Files))
stop("Number of items must be the same in 'poFiles' and in 'kpf2Files'")
- # Make sure we create new resulting files
+ ## Make sure we create new resulting files
unlink(kpf2Files)
- # Process each file in turn
+ ## Process each file in turn
for (h in 1:length(poFiles)) {
poFile <- poFiles[h]
kpf2File <- kpf2Files[h]
- # Read the content of the .po file
+ ## Read the content of the .po file
tr <- readLines(poFile, encoding = "UTF-8")
- # Keep only lines starting with msgid or msgstr
+ ## Keep only lines starting with msgid or msgstr
trid <- tr[regexpr("^msgid ", tr) == 1]
trid <- sub("^msgid ", "", trid)
trmsg <- tr[regexpr("^msgstr ", tr) == 1]
trmsg <- sub("^msgstr ", "", trmsg)
- # Check that both trid and trmsg have same length
+ ## Check that both trid and trmsg have same length
if (length(trid) != length(trmsg))
stop("Unequal number of id and translated strings in the .po file '", poFile, "'")
keep <- trid != "\"\""
trid <- trid[keep]
trmsg <- trmsg[keep]
- # We need to "unquote" the strings
+ ## We need to "unquote" the strings
unquote <- function (s) {
- # Replace any \\\" by \"
+ ## Replace any \\\" by \"
s <- gsub("\\\\\"", "\"", s)
- # Eliminate leading and trailing quotes
+ ## Eliminate leading and trailing quotes
s <- sub("^\"", "", s)
s <- sub("\"$", "", s)
return(s)
@@ -187,11 +190,11 @@
trmsg <- unquote(trmsg)
names(trmsg) <- trid
- # Extract translatable strings from the .kpf file
+ ## Extract translatable strings from the .kpf file
doc <- xmlRoot(xmlTreeParse(kpfFile))
imax <- xmlSize(doc)
if (imax < 1) stop("No node found in the kpfFile!")
- # Collect all strings to be translated
+ ## Collect all strings to be translated
trans <- function (s) {
tr <- as.character(trmsg[s])
if (is.na(tr) || tr == "") return(s) else return(tr)
@@ -201,15 +204,15 @@
for (i in 1:imax) {
n <- xmlGetAttr(doc[[i]], "name")
if (!is.null(n)) {
- # Replace name in attributes of this node
+ ## Replace name in attributes of this node
node <- addAttributes(doc[[i]], name = trans(n), append = TRUE)
type <- xmlName(node)
- # If this is a snippet, look for other translatable strings
+ ## If this is a snippet, look for other translatable strings
if (type == "snippet") {
snip <- xmlValue(node)
chunks <- strsplit(snip, "\\[\\[|\\]\\]")[[1]]
- # Translate chunks starting with R-desc:, R-tip:, URL-help:,
- # RWiki-help: or %tr:
+ ## Translate chunks starting with R-desc:, R-tip:, URL-help:,
+ ## RWiki-help: or %tr:
toTrans <- grep("^%ask:R-desc:|^%ask:R-tip:|^%ask:URL-help:|^%ask:RWiki-help:|^%pref:URL-help|^%pref:RWiki-help|%tr:", chunks)
if (length(toTrans) > 0) {
for (j in toTrans) {
@@ -217,16 +220,16 @@
header <- sub("^(%ask:[^:]+:|%tr:).*$", "\\1", chunks[j])
chunks[j] <- paste(header, trans(msg), sep = "")
}
- # Reconstitute the snippet content using translated messages
+ ## Reconstitute the snippet content using translated messages
snip <- paste(chunks, c("[[", "]]"),
sep = "", collapse = "")
- # We need to eliminate latest '[['
+ ## We need to eliminate latest '[['
snip <- sub("\\[\\[$", "", snip)
xmlValue(node) <- snip
}
} else if (type == "macro") {
mac <- xmlValue(node)
- # Translate tagged strings (i.e., strings inside _(...))
+ ## Translate tagged strings (i.e., strings inside _(...))
repeat {
str <- sub("^.*_\\(\"(.*[^\\\\])\"\\).*$", "\\1", mac)
if (str == mac) break
@@ -246,32 +249,33 @@
mac <- gsub("%%%%%%", "_", mac)
xmlValue(node) <- mac
}
- # Replace the node with its translated version
+ ## Replace the node with its translated version
doc[[i]] <- node
}
}
- # In case the project has a name, we change it now
+ ## In case the project has a name, we change it now
projname <- xmlGetAttr(doc, "name")
if (!is.null(projname))
doc <- addAttributes(doc, name = basename(kpf2File), append = TRUE)
- # Make sure the directory where to place the kpf2File exists
+ ## Make sure the directory where to place the kpf2File exists
dir.create(dirname(kpf2File), showWarnings = FALSE, recursive = TRUE)
- # Save the translated XML content into the second .kpf file
+ ## Save the translated XML content into the second .kpf file
saveXML(doc, file = kpf2File, prefix = '<?xml version="1.0" encoding="UTF-8"?>\n<!-- Komodo Project File - DO NOT EDIT -->\n')
}
- # We don't need .mo files => delete them
+ ## We don't need .mo files => delete them
moFiles <- sub("\\.po$", ".mo", poFiles)
if (any(moFiles != poFiles))
unlink(moFiles)
- # Check that all the translated .kpf files are produced
+ ## Check that all the translated .kpf files are produced
res <- file.exists(kpf2Files)
names(res) <- basename(kpf2Files)
return(invisible(res))
}
-kpzTranslate <- function (kpzFile, langs, poFiles, kpz2Files) {
+kpzTranslate <- function (kpzFile, langs, poFiles, kpz2Files)
+{
if (missing(kpzFile) || is.null(kpzFile) || is.na(kpzFile))
stop("'kpzFile' must be provided")
if (length(kpzFile) != 1)
@@ -282,7 +286,7 @@
if (missing(poFiles) || is.na(poFiles)) poFiles <- NULL
if (missing(langs)) {
if (is.null(poFiles)) {
- # Try to get the list of suitable .po files in same dir as kpfFile
+ ## Try to get the list of suitable .po files in same dir as kpfFile
pattern <- paste(basename(proj), ".+\\.po$", sep = "-")
poFiles <- dir(dirname(kpzFile), pattern, full.names = TRUE)
if (length(poFiles) < 1)
@@ -292,7 +296,7 @@
if (is.null(poFiles)) {
if (is.null(langs))
stop("You must provide 'langs' (ex.: 'fr', or 'de'), or 'poFiles'")
- # Try to guess poFiles from langs
+ ## Try to guess poFiles from langs
poFiles <- paste(proj, "-", langs, ".po", sep = "")
}
if (any(kpzFile == poFiles))
@@ -300,7 +304,7 @@
if (any(!file.exists(poFiles)))
stop("One or more 'poFiles' not found!")
if (missing(kpz2Files)) {
- # Guess kpz2Files from poFiles
+ ## Guess kpz2Files from poFiles
kpz2Files <- sub("\\.po$", ".kpz", poFiles)
}
if (any(kpzFile == kpz2Files))
@@ -309,41 +313,41 @@
stop("'poFiles' and 'kpz2Files' cannot be the same")
if (length(poFiles) != length(kpz2Files))
stop("Number of items must be the same in 'poFiles' and in 'kpz2Files'")
- # Make sure we create new resulting files
+ ## Make sure we create new resulting files
unlink(kpz2Files)
- # The kpz file is a zipped file containing package.kpf in a subdirectory
+ ## The kpz file is a zipped file containing package.kpf in a subdirectory
pack <- file.path(tempdir(), "package.kpf")
unlink(pack) # Make sure the file does not exist yet
unzip(kpzFile, junkpaths = TRUE, exdir = tempdir())
if (!file.exists(pack))
stop("Impossible to extract the content of the .kpz file.")
- # kpf2Files are "package.kpf" files in respective subdirectories with names
- # of the packages, like mypack-fr, mypack-it, etc.
+ ## kpf2Files are "package.kpf" files in respective subdirectories with names
+ ## of the packages, like mypack-fr, mypack-it, etc.
kpf2Dirs <- file.path(tempdir(), sub("\\.kpz$", "", basename(kpz2Files)))
kpf2Files <- file.path(kpf2Dirs, "package.kpf")
- # Call kpfTranslate on the created package.kpf file
+ ## Call kpfTranslate on the created package.kpf file
kpfTranslate(pack, poFiles = poFiles, kpf2Files = kpf2Files)
- # Eliminate the temporary extracted package.kpf file
+ ## Eliminate the temporary extracted package.kpf file
unlink(pack)
odir <- getwd()
on.exit(setwd(odir))
- # Compress the created files in kpz zipped archives named kpz2Files
+ ## Compress the created files in kpz zipped archives named kpz2Files
for (h in 1:length(kpz2Files)) {
kpz2File <- kpz2Files[h]
kpf2Dir <- kpf2Dirs[h]
if (file.exists(kpf2Dir)) {
setwd(dirname(kpz2File))
- # Note: the 'zip' program must be accessible!
+ ## Note: the 'zip' program must be accessible!
cmd <- paste('zip -rqm9 "', basename(kpz2File), '" "', kpf2Dir, '"',
sep = "")
try(system(cmd, intern = TRUE, wait = TRUE), silent = TRUE)
}
}
- # Check that all the translated .kpz files are produced
+ ## Check that all the translated .kpz files are produced
res <- file.exists(kpz2Files)
names(res) <- basename(kpz2Files)
return(invisible(res))
Modified: pkg/svIDE/R/makeIconGallery.R
===================================================================
--- pkg/svIDE/R/makeIconGallery.R 2010-09-25 09:17:12 UTC (rev 315)
+++ pkg/svIDE/R/makeIconGallery.R 2010-09-25 09:17:46 UTC (rev 316)
@@ -1,16 +1,17 @@
-# Create an iframe to represent all icons in a category in Komodo
-# iconpicker from a list of URIs
-makeIconGallery <- function (flist) {
+## Create an iframe to represent all icons in a category in Komodo
+## iconpicker from a list of URIs
+makeIconGallery <- function (flist)
+{
flist <- as.character(flist)[1]
if (!file.exists(flist))
stop("'flist' file not found")
- # Read the list
+ ## Read the list
icns <- readLines(flist)
- # Eliminate empty lines
+ ## Eliminate empty lines
icns <- icns[icns != ""]
if (length(icns) < 1)
stop("Nothing in the 'flist' file!")
- # Create the iframe
+ ## Create the iframe
iframe <- sub("\\.txt$", ".html", flist)
if (iframe == flist)
iframe <- paste(flist, "html", sep =".")
@@ -38,6 +39,6 @@
cat(itm, file = iframe, append = TRUE)
}
cat(tail, file = iframe, append = TRUE)
- # Check if the file exists
+ ## Check if the file exists
return(invisible(file.exists(iframe)))
-}
\ No newline at end of file
+}
Added: pkg/svIDE/R/sourceFormat.R
===================================================================
--- pkg/svIDE/R/sourceFormat.R (rev 0)
+++ pkg/svIDE/R/sourceFormat.R 2010-09-25 09:17:46 UTC (rev 316)
@@ -0,0 +1,71 @@
+Source <- function (...) {
+ .Deprecated("sourceFormat")
+ sourceFormat(...)
+}
+
+sourceFormat <- function (file, out.form = getOption("R.output.format"), local = FALSE,
+echo = FALSE, print.eval = TRUE, verbose = getOption("verbose"),
+prompt.echo = getOption("prompt"), max.deparse.length = 150,
+chdir = FALSE, prompt = FALSE)
+{
+
+ ## This is a reworked version of .Rsource from RpadUtils (Tom Short)
+ ## but this version uses source() itself
+
+ if (is.null(out.form)) out.form <- "text"
+ ## capture.all() is inspired from capture.output(), but it captures
+ ## both the output and the message streams and it evaluates in .GlobalEnv
+ capture.all <- function (...) {
+ args <- substitute(list(...))[-1]
+ file <- textConnection("rval", "w", local = TRUE)
+ sink(file, type = "output")
+ sink(file, type = "message")
+ on.exit({
+ sink(type = "output")
+ sink(type = "message")
+ close(file)
+ })
+
+ for (i in seq(length = length(args))) {
+ expr <- args[[i]]
+ if (mode(expr) == "expression")
+ tmp <- lapply(expr, withVisible) #tmp <- lapply(expr, evalVis)
+ else if (mode(expr) == "call")
+ tmp <- list(withVisible(expr)) #tmp <- list(evalVis(expr))
+ else if (mode(expr) == "name")
+ tmp <- list(withVisible(expr)) #tmp <- list(evalVis(expr))
+ else stop("bad argument")
+ for (item in tmp) {
+ if (item$visible)
+ print(item$value)
+ }
+ }
+ sink(type = "output")
+ sink(type = "message")
+ cat("====\n")
+ print(file)
+ cat("====\n")
+ return(file)
+ }
+
+ ## We capture output from source() with default args slightly modified
+### TODO: get rid of source() and use something like:
+ ## (try(parse(textConnection("ls()")), silent = TRUE))
+ ## with detection of incomplete lines and other error messages!
+ res <- capture.all(source(file = file, local = FALSE, echo = echo,
+ print.eval = print.eval, verbose = verbose, prompt.echo = prompt.echo,
+ max.deparse.length = max.deparse.length, chdir = chdir))
+ if (inherits(res, "list"))
+ res <- paste(res, collapse = "\n")
+ if (!out.form %in% c("none", "html"))
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 316
More information about the Sciviews-commits
mailing list