[Sciviews-commits] r304 - in pkg/svMisc: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Sep 11 11:59:42 CEST 2010
Author: phgrosjean
Date: 2010-09-11 11:59:42 +0200 (Sat, 11 Sep 2010)
New Revision: 304
Modified:
pkg/svMisc/DESCRIPTION
pkg/svMisc/NEWS
pkg/svMisc/R/argsTip.R
pkg/svMisc/R/callTip.R
pkg/svMisc/R/completion.R
pkg/svMisc/R/objBrowse.R
pkg/svMisc/R/objInfo.R
pkg/svMisc/R/objList.R
pkg/svMisc/R/objSearch.R
pkg/svMisc/R/parseText.R
pkg/svMisc/R/svMisc-internal.R
pkg/svMisc/man/argsTip.Rd
pkg/svMisc/man/completion.Rd
pkg/svMisc/man/svMisc-package.Rd
Log:
Reworked argsTip() and callTip() to reflow text into width and possibly return a more informative callTip
Modified: pkg/svMisc/DESCRIPTION
===================================================================
--- pkg/svMisc/DESCRIPTION 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/DESCRIPTION 2010-09-11 09:59:42 UTC (rev 304)
@@ -6,7 +6,7 @@
Suggests: svUnit
Description: Supporting functions for the GUI API (various utilitary functions)
Version: 0.9-60
-Date: 2010-09-05
+Date: 2010-09-11
Author: Philippe Grosjean, Romain Francois & Kamil Barton
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL-2
Modified: pkg/svMisc/NEWS
===================================================================
--- pkg/svMisc/NEWS 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/NEWS 2010-09-11 09:59:42 UTC (rev 304)
@@ -29,7 +29,10 @@
susceptible to be used elsewere too).
* Args() is deprecated in favor of argsTip() and CallTip() is deprecated in
- favor of callTip() (further homogeneization of svMisc function names).
+ favor of callTip() (further homogeneization of svMisc function names). The
+ new argsTip() and callTip() functions can reflow the tip to a given width, and
+ callTip() can also return a short description of the function as well as the
+ list of available methods if the tip os asked for a generic function.
* Complete() and CompletePlus() are deprecated in favor of a unique completion()
function. Code of both original functions has been fused and reworked.
Modified: pkg/svMisc/R/argsTip.R
===================================================================
--- pkg/svMisc/R/argsTip.R 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/R/argsTip.R 2010-09-11 09:59:42 UTC (rev 304)
@@ -1,9 +1,9 @@
Args <- function (name, only.args = FALSE) {
.Deprecated("argsTip")
- return(argsTip(name, only.args = only.args))
+ return(argsTip(name, only.args = only.args, width = NULL))
}
-argsTip <- function (name, only.args = FALSE)
+argsTip <- function (name, only.args = FALSE, width = getOption("width"))
{
## TODO: handle primitives and S3/S4 methods for generic functions
ret <- try(res <- eval(parse(text = paste("argsAnywhere(", name, ")",
@@ -19,5 +19,8 @@
res <- sub("^function *", name, res)
res <- sub(" *$", "", res)
}
+ ## Reflow the tip
+ if (!is.null(width))
+ res <- paste(strwrap(res, width = width, exdent = 4), collapse = "\n")
return(res)
}
Modified: pkg/svMisc/R/callTip.R
===================================================================
--- pkg/svMisc/R/callTip.R 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/R/callTip.R 2010-09-11 09:59:42 UTC (rev 304)
@@ -3,15 +3,17 @@
return(callTip(code, only.args = only.args, location = location))
}
-callTip <- function (code, only.args = FALSE, location = FALSE)
+callTip <- function (code, only.args = FALSE, location = FALSE,
+description = FALSE, methods = FALSE, width = getOption("width"))
{
- code <- attr(completion(code, types = NA, describe = FALSE), "fguess")
+ code <- attr(completion(code, types = NA, description = FALSE), "fguess")
if (is.null(code) || !length(code) || code == "")
return("")
## Get the corresponding calltip
- ctip <- argsTip(code, only.args = only.args)
+ ctip <- argsTip(code, only.args = only.args, width =NULL) # Reflow later!
if (is.null(ctip)) return("")
+
## Do we need to append an indication of where this function is located?
if (isTRUE(location)) {
where <- res <- eval(parse(text = paste("getAnywhere(", code, ")",
@@ -19,5 +21,47 @@
if (!is.na(where) && where != ".GlobalEnv")
ctip <- paste(ctip, " [", sub("^package:", "", where), "]", sep = "")
}
+ ## Reflow the tip now
+ if (!is.null(width))
+ ctip <- paste(strwrap(ctip, width = width, exdent = 4), collapse = "\n")
+
+ ## Do we add the description of this function?
+ if (isTRUE(description)) {
+ desc <- descFun(code)
+ if (!is.null(desc) && length(desc) && desc != "") {
+ if (!is.null(width))
+ desc <- paste(strwrap(desc, width = width), collapse = "\n")
+ ctip <- paste(ctip, "\n\n", desc, sep = "")
+ }
+ }
+
+ ## Do we add a short mention of available methods if the function is generic?
+ if (isTRUE(methods)) {
+ mets <- listMethods(code)
+ if (length(mets)) {
+ ## How many 25 char strings can we put on width and 5 lines max?
+ ## Note: we use two space each time as separator, except for last
+ ## line => take this into account in the calculation
+ if (is.null(width)) nitems <- 3 else nitems <- (width + 2) %/% 27
+ if (nitems < 1) nitems <- 1
+
+ ## Make sure the list is not too long: restrict to nitems * 5 entries
+ if (length(mets) > nitems * 5) mets <- c(mets[1:(nitems * 5)], "...")
+
+ ## Make sure each method description is not longer than 25 characters
+ n <- nchar(mets)
+ ## Cut entries that are too long
+ tooLong <- n > 25
+ mets[tooLong] <- paste(substr(mets[tooLong], 1, 22), "...", sep = "")
+
+ ## Paste strings together
+ mets <- paste(format(mets, width = 25), c(rep(" ", nitems - 1), "\n"),
+ collapse = "", sep = "")
+ ## Add this info to the calltip
+ ctip <- paste(ctip,
+ "\n\nGeneric function with methods for the following classes:\n", mets,
+ sep = "")
+ }
+ }
return(ctip)
}
Modified: pkg/svMisc/R/completion.R
===================================================================
--- pkg/svMisc/R/completion.R 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/R/completion.R 2010-09-11 09:59:42 UTC (rev 304)
@@ -14,8 +14,8 @@
.Deprecated("completion")
res <- completion(linebuffer, pos = cursorPosition, min.length = minlength,
print = FALSE, what = types, types = NA, addition = FALSE,
- sort = FALSE, describe = TRUE, max.fun = 10000, skip.used.args = FALSE,
- field.sep = "\t")
+ sort = FALSE, description = TRUE, max.fun = 10000,
+ skip.used.args = FALSE, field.sep = "\t")
if (is.character(res) && length(res) && res == "") return(NULL) else {
if (isTRUE(simplify)) {
cat(apply(res[, c("completion", "context", "desc")], 1, paste,
@@ -26,8 +26,8 @@
completion <- function (code, pos = nchar(code), min.length = 2,
print = FALSE, types = c("default", "scintilla"), addition = FALSE, sort = TRUE,
-what = c("arguments", "functions", "packages"), describe = FALSE, max.fun = 100,
-skip.used.args = TRUE, sep = "\n", field.sep = "\t")
+what = c("arguments", "functions", "packages"), description = FALSE,
+max.fun = 100, skip.used.args = TRUE, sep = "\n", field.sep = "\t")
{
finalize <- function (completions) {
## Construct a data frame with completions
@@ -48,7 +48,7 @@
}
## Do we add descriptions?
- if (isTRUE(describe)) {
+ if (isTRUE(description)) {
ret <- cbind(ret, data.frame(desc = rep("", nrow(ret)),
context = rep("", nrow(ret)), stringsAsFactors = FALSE))
Modified: pkg/svMisc/R/objBrowse.R
===================================================================
--- pkg/svMisc/R/objBrowse.R 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/R/objBrowse.R 2010-09-11 09:59:42 UTC (rev 304)
@@ -118,11 +118,10 @@
if (is.null(path)) Data <- paste(c(Data, ChangedList),
collapse = "\n")
}
- ## TODO: allow different functions to pass data to different GUI clients
+
## Possibly call a .guiObjBrowse function to pass the data to the GUI client
CmdFun <- getTemp(".guiObjBrowse", mode = "function")
- if (!is.null(CmdFun))
- CmdFun(id = id, data = Data)
+ if (!is.null(CmdFun)) CmdFun(id = id, data = Data)
## Return the data invisibly
return(invisible(Data))
}
Modified: pkg/svMisc/R/objInfo.R
===================================================================
--- pkg/svMisc/R/objInfo.R 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/R/objInfo.R 2010-09-11 09:59:42 UTC (rev 304)
@@ -18,6 +18,7 @@
collapse = "\n"),
TempEnv = "SciViews temporary variables environment",
RcmdrEnv = "R Commander temporary variables environment",
+ `tools:RGUI` = "R.app tools environment",
Autoloads = "R autoloading objects environment",
if (regexpr("^package:", envir) > -1) {
pkg <- sub("^package:", "", envir)
@@ -54,8 +55,7 @@
InfoFile <- file.path(path, paste("Info_", id, ".txt", sep = ""))
cat(Info, collapse = "\n", file = InfoFile)
}
-
- ## TODO: allow different functions to pass data to different GUI clients
+
## Possibly call a .guiObjInfo function to pass the data to the GUI client
CmdFun <- getTemp(".guiObjInfo", mode = "function")
if (!is.null(CmdFun)) CmdFun(id = id, data = Info)
Modified: pkg/svMisc/R/objList.R
===================================================================
--- pkg/svMisc/R/objList.R 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/R/objList.R 2010-09-11 09:59:42 UTC (rev 304)
@@ -24,7 +24,7 @@
Nothing <- data.frame(Envir = character(0), Name = character(0),
Dims = character(0), Group = character(0), Class = character(0),
Recursive = logical(0), stringsAsFactors = FALSE)
- if (!all.info) Nothing <- Nothing[, -1]
+ if (!isTRUE(all.info)) Nothing <- Nothing[, -1]
attr(Nothing, "all.info") <- all.info
attr(Nothing, "envir") <- ename
attr(Nothing, "object") <- object
@@ -96,7 +96,7 @@
## Determine if it is required to refresh something
Changed <- TRUE
- if (compare) {
+ if (isTRUE(compare)) {
allList <- getTemp(".guiObjListCache", default = list())
if (identical(res, allList[[id]])) Changed <- FALSE else {
@@ -155,7 +155,7 @@
objname <- if (is.null(attr(x, "object"))) {
if (raw.output) "" else "<All>"
- } else attr(x, "object")
+ } else attr(x, "object")
cat(sprintf(header.fmt, attr(x, "envir"), objname))
}
@@ -178,7 +178,7 @@
silent = TRUE)
if (inherits(obj, "try-error")) return(NULL)
- if(is.environment(obj)) obj <- as.list(obj)
+ if (is.environment(obj)) obj <- as.list(obj)
if (mode(obj) == "S4") {
ret <- .lsObjS4(obj, objname)
@@ -191,7 +191,7 @@
itemnames <- fullnames <- names(obj)
if (is.null(itemnames)) {
itemnames <- seq_along(obj)
- fullnames <- paste(objname, "[[", seq_along(obj), "]]", sep = "")
+ fullnames <- paste(objname, "[[", itemnames, "]]", sep = "")
} else {
w.names <- itemnames != ""
.names <- itemnames[w.names]
Modified: pkg/svMisc/R/objSearch.R
===================================================================
--- pkg/svMisc/R/objSearch.R 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/R/objSearch.R 2010-09-11 09:59:42 UTC (rev 304)
@@ -1,7 +1,7 @@
objSearch <- function(sep = "\t", path = NULL, compare = TRUE)
{
Search <- search()
- if (compare) {
+ if (isTRUE(compare)) {
oldSearch <- getTemp(".guiObjSearchCache", default = "")
## Compare both versions
if (length(Search) != length(oldSearch) || !all(Search == oldSearch)) {
Modified: pkg/svMisc/R/parseText.R
===================================================================
--- pkg/svMisc/R/parseText.R 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/R/parseText.R 2010-09-11 09:59:42 UTC (rev 304)
@@ -1,6 +1,6 @@
Parse <- function (text)
{
- ## Deprecated, in favor of parseText
+ ## Deprecated, in favor of parseText()
.Deprecated("parseText")
return(parseText(text))
}
@@ -31,7 +31,7 @@
## There is still a case of incomplete code not catch: incomplete strings
dp <- deparse(expr)
## Is it an incomplete string (like "my string or 'my string)?
- if (regexpr("\\n\")$", dp) > 0 &&
+ if (regexpr("\\\\n\")$", dp) > 0 &&
regexpr("\n[\"'][ \t\r\n\v\f]*($|#.*$)", text) < 0)
return(NA)
Modified: pkg/svMisc/R/svMisc-internal.R
===================================================================
--- pkg/svMisc/R/svMisc-internal.R 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/R/svMisc-internal.R 2010-09-11 09:59:42 UTC (rev 304)
@@ -25,9 +25,9 @@
example = gettext("Example\nRun examples for this object"),
edit = gettext("Edit\nEdit an object"),
fix = gettext("Fix\nFix an R object"),
+ pkg = gettext("Load package(s)\nLoad one or several R packages"),
remove = gettext("Remove\nRemove (permanently!) one or several objects from memory"),
require = gettext("Require <<<pkg>>>\nRequire the package <<<pkg>>>"),
- r = gettext("Require (compact)\nCompact require one or several R packages"),
attach = gettext("Attach\nAttach an object to the search path"),
detach = gettext("Detach\nDetach an object or package from the search path"),
detachUnload = gettext("Detach and unload\nDetach a package from the search path and unload it"),
@@ -50,26 +50,26 @@
export = "guiExport(<<<obj>>>)",
report = "guiReport(<<<obj>>>)",
setwd = "guiSetwd([[[<<<dir>>>]]])",
- print = "<<<obj>>>",
- generic = "[[[<<<var>>>> <- ]]]<<<fun>>>(<<<obj>>>)",
+ print = "<<<obj>>>",
+ generic = "[[[<<<var>>>> <- ]]]<<<fun>>>(<<<obj>>>)",
names = "names(<<<obj>>>)",
- str = "str(<<<obj>>>)",
+ str = "str(<<<obj>>>)",
help = "help(<<<obj>>>)",
example = "example(<<<obj>>>)",
edit = "<<<obj>>> <- edit(<<<obj>>>)",
- fix = "fix(<<<obj>>>)", # There is no guarantee we fix the right one!
+ fix = "fix(<<<obj>>>)", # There is no guarantee we fix the right one!
+ pkg = "[[[<<<res>>> <- ]]]pkg(\"<<<pkgs>>>\")",
remove = "rm(<<<obj>>>[[[, pos = \"<<<envir>>>\"]]])",
require = "[[[<<<res>>> <- ]]]require(<<<pkg>>>)",
- r = "[[[<<<res>>> <- ]]]r(\"<<<pkgs>>>\")",
attach = "attach(<<<obj>>>)",
detach = "detach(<<<envir>>>)",
detachunload = "detach(<<<envir>>>, unload = TRUE)",
reattach = "detach(<<<obj>>>); attach(<<<obj>>>)",
pkgInfo = "<<<H>>>library(help = <<<package>>>)",
viewDef = "view(<<<obj>>>)",
- view = "view(<<<obj>>>, type = \"<<<type>>>\")",
- copyDef = "copy(<<<obj>>>)",
- copy = "copy(<<<obj>>>, type = \"<<<type>>>\")"
+ view = "view(<<<obj>>>, type = \"<<<type>>>\")",
+ copyDef = "copy(<<<obj>>>)",
+ copy = "copy(<<<obj>>>, type = \"<<<type>>>\")"
), replace = replace)
addTemp(".svActions", "state", c(
@@ -90,8 +90,7 @@
if (is.null(getOption("svGUI.methods")))
options(svGUI.methods = c("AIC", "anova", "confint", "BIC", "formula",
"head", "hist", "logLik", "plot", "predict", "residuals", "summary",
- "tail", "vcov"
- ))
+ "tail", "vcov"))
}
.createStripbar <- function (type = c("menubar", "popupbar", "toolbar", "buttonbar", "statusbar"))
@@ -138,7 +137,7 @@
stop("'widgets' must be 'menu', 'item', 'sep' or 'space'")
}
- ## Get tree hierachy of the menus being the number of dots before '_'
+ ## Get tree hierarchy of the menus being the number of dots before '_'
tree <- sub("^([.]+)_.*$", "\\1", wnames)
tree[regexpr("^[.]+$", tree) == -1] <- ""
tree <- gsub("[.]", "|", tree)
@@ -171,8 +170,7 @@
getTemp(".svIcons", default = character()))
## The function used to replace placeholders in text and code
- replace <- function (x, ...)
- {
+ replace <- function (x, ...) {
## Do replacement for ... arguments
args <- list(...)
largs <- length(args)
Modified: pkg/svMisc/man/argsTip.Rd
===================================================================
--- pkg/svMisc/man/argsTip.Rd 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/man/argsTip.Rd 2010-09-11 09:59:42 UTC (rev 304)
@@ -9,8 +9,9 @@
}
\usage{
-argsTip(name, only.args = FALSE)
-callTip(code, only.args = FALSE, location = FALSE)
+argsTip(name, only.args = FALSE, width = getOption("width"))
+callTip(code, only.args = FALSE, location = FALSE, description = FALSE,
+ methods = FALSE, width = getOption("width"))
}
\arguments{
@@ -20,12 +21,22 @@
\item{only.args}{ do we return only arguments of the function
(\code{arg1, arg2 = TRUE, ...}), or the full call, like
(\code{myfun(arg1, arg2 = TRUE, ...)}). }
+ \item{width}{ reformat the tip to fit that width, except if
+ \code{width = NULL}. }
\item{location}{ if \code{TRUE} then the location (in which package the
function resides) is appended to the calltip between square brackets. }
+ \item{description}{ if \code{TRUE} then a short description of the function is
+ added to the callTip (in fact, the title of the corresponding help page, if
+ it exists). }
+ \item{methods}{ if \code{TRUE} then a short message indicating if this is a
+ generic function and that lists, in this case, available methods. }
}
\value{
- A string with the calling syntax of the function.
+ A string with the calling syntax of the function, plus additional information,
+ depending on the flag used. Note that \code{methods} can considerably slow
+ down the execution, especially for generic functions that have many methods
+ like \code{print()}, or \code{summary}!
}
\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
Modified: pkg/svMisc/man/completion.Rd
===================================================================
--- pkg/svMisc/man/completion.Rd 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/man/completion.Rd 2010-09-11 09:59:42 UTC (rev 304)
@@ -8,7 +8,7 @@
\usage{
completion(code, pos = nchar(code), min.length = 2, print = FALSE,
types = c("default", "scintilla"), addition = FALSE, sort = TRUE,
- what = c("arguments", "functions", "packages"), describe = FALSE,
+ what = c("arguments", "functions", "packages"), description = FALSE,
max.fun = 100, skip.used.args = TRUE, sep = "\n", field.sep = "\t")
}
\arguments{
@@ -23,7 +23,8 @@
\item{sort}{ do wer sort the list of completions alphabetically? }
\item{what}{ what are we looking for? Allow to restrict search for faster
calculation. }
- \item{describe}{ do we describe items in the completion list (may be slow)? }
+ \item{description}{ do we describe items in the completion list
+ (may be slow)? }
\item{max.fun}{ in case we describe items, the maximum number of functions to
process (if longer, no description is returned for function) because it can
bz very slow otherwise. }
@@ -34,10 +35,10 @@
}
\value{
- If \code{types == NA} and \code{describe = FALSE}, a character vector giving the
- completions, otherwise a data frame with two columns: 'completion', and 'type'
- when \code{describe = FALSE}, or with four columns: "completion', 'type',
- 'desc' and 'context' when \code{describe = TRUE}.\cr
+ If \code{types == NA} and \code{description = FALSE}, a character vector
+ giving the completions, otherwise a data frame with two columns: 'completion',
+ and 'type' when \code{description = FALSE}, or with four columns: "completion',
+ 'type', 'desc' and 'context' when \code{description = TRUE}.\cr
Attributes:\cr
\code{attr(,"token")} - a completed token.\cr
\code{attr(,"triggerPos")} - number of already typed characters.\cr
@@ -102,10 +103,10 @@
completion("item2 <- t1@")
## A namespace
-completion("utils::", describe = TRUE)
+completion("utils::", description = TRUE)
## A partial identifier
-completion("item3 <- va", describe = TRUE)
+completion("item3 <- va", description = TRUE)
## Otherwise, a list with the content of .GlobalEnv
completion("item4 <- ")
Modified: pkg/svMisc/man/svMisc-package.Rd
===================================================================
--- pkg/svMisc/man/svMisc-package.Rd 2010-09-11 09:58:41 UTC (rev 303)
+++ pkg/svMisc/man/svMisc-package.Rd 2010-09-11 09:59:42 UTC (rev 304)
@@ -13,7 +13,7 @@
Package: \tab svMisc\cr
Type: \tab Package\cr
Version: \tab 0.9-60\cr
- Date: \tab 2009-09-05\cr
+ Date: \tab 2010-09-11\cr
License: \tab GPL 2 or above, at your convenience\cr
}
% TODO: add description of main functions here. Also add examples
More information about the Sciviews-commits
mailing list