[Sciviews-commits] r43 - in pkg: svGUI svMisc svMisc/R svMisc/man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Jul 6 15:07:41 CEST 2008


Author: phgrosjean
Date: 2008-07-06 15:07:40 +0200 (Sun, 06 Jul 2008)
New Revision: 43

Modified:
   pkg/svGUI/TODO
   pkg/svMisc/DESCRIPTION
   pkg/svMisc/NAMESPACE
   pkg/svMisc/NEWS
   pkg/svMisc/R/CompletePlus.R
   pkg/svMisc/TODO
   pkg/svMisc/man/CompletePlus.Rd
Log:
reworking of CompletePlus()

Modified: pkg/svGUI/TODO
===================================================================
--- pkg/svGUI/TODO	2008-07-03 12:57:42 UTC (rev 42)
+++ pkg/svGUI/TODO	2008-07-06 13:07:40 UTC (rev 43)
@@ -1,5 +1,8 @@
 = svGUI To Do list
 
+* A ko() function to manipulate komodo from the command line
+(+ correct installation under Mac OS X)
+
 * The svGUI-package.Rd man page
 
 * Write the whole API to access Komodo from R

Modified: pkg/svMisc/DESCRIPTION
===================================================================
--- pkg/svMisc/DESCRIPTION	2008-07-03 12:57:42 UTC (rev 42)
+++ pkg/svMisc/DESCRIPTION	2008-07-06 13:07:40 UTC (rev 43)
@@ -3,8 +3,8 @@
 Imports: utils, methods
 Depends: R (>= 2.7.0)
 Description: Supporting functions for the GUI API (various utilitary functions)
-Version: 0.9-43
-Date: 2008-06-06
+Version: 0.9-44
+Date: 2008-07-06
 Author: Philippe Grosjean
 Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
 License: GPL (>= 2)

Modified: pkg/svMisc/NAMESPACE
===================================================================
--- pkg/svMisc/NAMESPACE	2008-07-03 12:57:42 UTC (rev 42)
+++ pkg/svMisc/NAMESPACE	2008-07-06 13:07:40 UTC (rev 43)
@@ -1,5 +1,4 @@
 import(utils)
-import(tools)
 importFrom(methods, getMethods, isGeneric, showMethods)
 
 export(	addActions,
@@ -15,8 +14,10 @@
 		clipsource,
 		compareRVersion,
 		Complete,
-    CompletePlus,
+		CompletePlus,
 		def,
+		descArgs,
+		descFun,
 		existsTemp,
 		getEnvironment,
 		getTemp,

Modified: pkg/svMisc/NEWS
===================================================================
--- pkg/svMisc/NEWS	2008-07-03 12:57:42 UTC (rev 42)
+++ pkg/svMisc/NEWS	2008-07-06 13:07:40 UTC (rev 43)
@@ -1,9 +1,17 @@
 = svMisc News
 
+== Changes in svMisc 0.9-44
+
+* CompletePlus() reworked to use man pages instead of .Rd files
+
+* descFun() and descArgs() added
+
+
 == Changes in svMisc 0.9-43
 
 * CompletePlus() created to obtain information on the completion possibilities
 
+
 == Changes in svMisc 0.9-42
 
 * objList() did not place each item in a line when result is written in a file
@@ -11,7 +19,7 @@
 * objXXX() functions did not always returned results invisibly. Solved.
 
 * Args() is more robust against bad 'name' parameter because it now calls
-  argsAnywhere() within a try().
+argsAnywhere() within a try().
 
 
 == Changes in svMisc 0.9-41
@@ -19,7 +27,7 @@
 * objInfo() returns also estimated size of objects that are not functions.
 
 * objSearch() is reworked to return a single string using 'sep' as separator
-  when sep is not NULL.
+when sep is not NULL.
 
 
 == Changes in svMisc 0.9-40

Modified: pkg/svMisc/R/CompletePlus.R
===================================================================
--- pkg/svMisc/R/CompletePlus.R	2008-07-03 12:57:42 UTC (rev 42)
+++ pkg/svMisc/R/CompletePlus.R	2008-07-06 13:07:40 UTC (rev 43)
@@ -1,160 +1,168 @@
-CompletePlus <- function (linebuffer, cursorPosition = nchar(linebuffer), minlength = 2, simplify = FALSE,
-  types = "arguments,functions,packages" ) {
-    
-    types <- strsplit( types, "," )[[1]]
-    
+CompletePlus <-
+function (linebuffer, cursorPosition = nchar(linebuffer), minlength = 2,
+simplify = FALSE, types = c("arguments", "functions", "packages")) {
     ### call the rcompgen API to get completions
     if (nchar(linebuffer, type = "chars") < minlength) return(invisible(NULL))
-    .assignLinebuffer(linebuffer)
-    .assignEnd(cursorPosition)
-    .guessTokenFromLine()
-    token <- .CompletionEnv[["token"]]
-    .completeToken()
-    comps <- .retrieveCompletions()
-    if ( !length(comps) ) return(invisible(NULL))
-    
+    utils:::.assignLinebuffer(linebuffer)
+    utils:::.assignEnd(cursorPosition)
+    utils:::.guessTokenFromLine()
+    token <- utils:::.CompletionEnv[["token"]]
+    utils:::.completeToken()
+    comps <- utils:::.retrieveCompletions()
+    if (!length(comps)) return(invisible(NULL))
+
     ### restrict the completion for which information is gathered (speed things up)
-    if( ! "arguments" %in% types ){
-      comps <- comps[ regexpr("=$", comps) < 0 ]
-    }
-    if ( !length(comps) ) return(invisible(NULL))
-    
-    if( ! "packages" %in% types ){
-      comps <- comps[ regexpr("::$", comps) < 0 ]
-    }
-    if ( !length(comps) ) return(invisible(NULL))
-    
-    if( ! "functions" %in% types ){
-      comps <- comps[ regexpr("(::|=)$", comps) > 0 ]
-    }
-    if ( !length(comps) ) return(invisible(NULL))
-    
+    if (!"arguments" %in% types)
+		comps <- comps[regexpr("=$", comps) < 0]
+    if (!length(comps))
+		return(invisible(NULL))
+
+    if (!"packages" %in% types)
+		comps <- comps[regexpr("::$", comps) < 0]
+    if (!length(comps))
+		return(invisible(NULL))
+
+    if (!"functions" %in% types)
+		comps <- comps[regexpr("(::|=)$", comps) > 0]
+    if (!length(comps))
+		return(invisible(NULL))
+
     ### build the output structure
-    out <- matrix( "", nrow = length(comps), ncol = 3 )
-    out[,1] <- comps
-    
-    # TODO: look at .win32consoleCompletion and figure out if the "additions" can be useful
-    
+    out <- matrix("", nrow = length(comps), ncol = 3)
+    out[, 1] <- comps
+
+    # TODO: look at utils:::.win32consoleCompletion and figure out if the
+	# "additions" can be useful
+
     ### deal with packages (completions ending with ::)
-    if(length(test.pack <- grep("::", comps) )){
-      out[ test.pack,3] <- sapply( sub("::", "", comps[test.pack]), packageDescription, fields = "Description"  ) 
-    }
-    
+    if (length(test.pack <- grep("::", comps)))
+		out[test.pack, 3] <- sapply(sub("::", "", comps[test.pack]),
+			packageDescription, fields = "Description")
+
     ### deal with argument completions (ending with =)
-    if(length(test.arg <- grep("=", comps) )){
-      arg <- sub("=$", "", comps[test.arg] )
-      fguess <- .CompletionEnv[["fguess"]]
-      pack <- sub( "^package:", "", find( fguess )[1] )
-      if(pack == ".GlobalEnv" ) {
-        out[ test.arg,3] <- ""
-      } else{
-        out[ test.arg,2] <- fguess
-        out[ test.arg,3] <- .extract_argument_description( pack, fguess, arg)
-      }
+    if (length(test.arg <- grep("=", comps))) {
+		arg <- sub("=$", "", comps[test.arg])
+		fguess <- utils:::.CompletionEnv[["fguess"]]
+		pack <- sub( "^package:", "", find(fguess)[1])
+		if(pack == ".GlobalEnv") {
+			out[test.arg, 3] <- ""
+		} else{
+			out[test.arg, 2] <- fguess
+			#out[test.arg, 3] <- .extract_argument_description(pack, fguess, arg)
+			out[test.arg, 3] <- descArgs(fguess, arg, pack)
+		}
     }
-    
+
     ### TODO: do not know what to do with these
     test.others <- grep(" ", comps)
     # TODO: are there other kind of completions I miss here
-    
+
     ### deal with function completions
-    test.fun <- setdiff( 1:length(comps), c(test.arg, test.pack, test.others) )
-    if( length(test.fun) ){
-      funs     <- comps[test.fun]
-      packs    <- sub( "^package:", "", sapply( funs , find ) )
-      desc.fun <- rep( "", length(packs) )
-      for( pack in unique(packs) ){
-        if( pack != ".GlobalEnv" ){
-          dir <- .find.package(pack)
-          rds <- file.path(dir, "Meta", "Rd.rds")
-          rd.data <- .readRDS(rds)
-          funInThisPack <- funs[ packs == pack ]
-          desc.fun[ packs == pack ] <- sapply( funInThisPack, function(x){
-            index <- which( sapply( rd.data$Aliases, function(y) any(x %in% y) ) )
-            rd.data$Title[ index ]
-          })
-        }
-      }
-      out[ test.fun, 2 ] <- packs
-      out[ test.fun, 3 ] <- desc.fun
+    test.fun <- setdiff(1:length(comps), c(test.arg, test.pack, test.others))
+    if (length(test.fun)) {
+		funs <- comps[test.fun]
+		packs <- sub("^package:", "", sapply(funs, find))
+		desc.fun <- rep("", length(packs))
+		for (pack in unique(packs)) {
+			if (pack != ".GlobalEnv") {
+				desc.fun[packs == pack] <- descFun(funs[packs == pack], pack)
+				#dir <- .find.package(pack)
+				#rds <- file.path(dir, "Meta", "Rd.rds")
+				#rd.data <- .readRDS(rds)
+				#funInThisPack <- funs[packs == pack]
+				#desc.fun[packs == pack] <- sapply(funInThisPack, function(x) {
+				#	index <- which(sapply(rd.data$Aliases, function(y)
+				#		any(x %in% y)))
+				#	rd.data$Title[index]
+				#})
+			}
+		}
+		out[test.fun, 2] <- packs
+		out[test.fun, 3] <- desc.fun
     }
-    
-    out[,3] <- gsub( "(\n|,)", " ", out[,3] )
-    
-    if( simplify ){
-      cat( apply( out, 1, paste, collapse="," ), sep = "\n" )
-    } else {
-      out
-    }
-    
-}
 
-.extract_argument_description <- function( package, fun, arg, lib.loc = NULL){  
-  dir <- .find.package(package, lib.loc)
-  rds <- file.path(dir, "Meta", "Rd.rds")
-  if (file_test("-f", rds)) {
-    rd.data <- .readRDS(rds)
-    index <- which( sapply( rd.data$Aliases, function(x) any(fun %in% x) ) )
-    if( length(index) == 1){
-      rdfile <- rd.data$File[index]
-      rddb <- Rd_db( package = package)
-      rdcontent <- paste( rddb[ basename(names(rddb)) == rdfile ][[1]], collapse = "\n" )
-      arguments <- .get_Rd_arguments_table( rdcontent )
-      arguments[ sapply( arg, function(x) which(arguments[,1] == x  )), 2 ]
-      # TODO: do some error handling
+    out[, 3] <- gsub("\t", "    ", out[, 3])
+	# Make sure that arguments are witten 'arg = ', and not 'arg='
+	out[, 1] <- sub("=$", " = ", out[, 1])
+
+    if (simplify) {
+		cat(apply(out, 1, paste, collapse = "\t"), sep = "\n")
     } else {
-      rep( "", length(arg) )
+		return(out)
     }
-  } else {
-    rep( "", length(arg))
-  }
-  
 }
 
-.get_Rd_arguments_table <-  function (txt) {
-    txt <- get_Rd_section(txt, "arguments")
-    tab <- get_Rd_items_table(txt)
-    txt <- tab[,1]
-    if (!length(txt)) 
-        return(character())
-    txt <- gsub("\\\\l?dots", "...", txt)
-    txt <- sub("^[[:space:]]+", "", txt)
-    txt <- sub("[[:space:]]+$", "", txt)
-    txt <- gsub("\\\\_", "_", txt)
-    tab[,1] <- txt
-    tab
-}
-
-### inspired from tools:::get_Rd_items
-### build a matrix where first column are the names of the arguments
-### and second column are the description
-### the function gets the information from the Rd help file
-get_Rd_items_table <- function (txt) {
-    out <- character() # item names
-    desc <- character() # item descriptions
-    
-    if (length(txt) != 1L) 
-        stop("argument 'txt' must be a character string")
-    pattern <- "(^|\n)[[:space:]]*\\\\item\\{"
-    while ((pos <- regexpr(pattern, txt)) != -1L) {
-        txt <- substring(txt, pos + attr(pos, "match.length") - 1L)
-        if ((pos <- delimMatch(txt)) == -1L) 
-            stop(gettextf("unmatched \\item name in '\\item{%s'", 
-                sub("\n.*$", "", txt)), domain = NA, call. = FALSE)
-        newout <- strsplit( substring(txt, pos + 1L, pos + attr(pos, "match.length") - 2L), " *, *" )[[1]]
-        out <- c(out, newout)
-        txt <- substring(txt, pos + attr(pos, "match.length"))
-        if ((pos <- regexpr("^[[:space:]]*\\{", txt)) == -1L) 
-            stop(gettextf("no \\item description for item '%s'", 
-                out[length(out)]), domain = NA, call. = FALSE)
-        txt <- substring(txt, pos + attr(pos, "match.length") - 1L)
-        if ((pos <- delimMatch(txt)) == -1L) 
-            stop(gettextf("unmatched \\item description for item '%s'", 
-                out[length(out)]), domain = NA, call. = FALSE)
-        desc <- c( desc, rep( substring(txt, 2L, pos + attr(pos, "match.length") - 2L), length(newout) ) )
-        txt <- substring(txt, pos + attr(pos, "match.length"))
-    }
-    cbind( out, desc )
-}
-
-
+## PhG: the following code is replaced by argsHelp() which is faster, and
+## do not depend on *experimental* code in the 'tools' package (limits also dependencies!)
+#.extract_argument_description <-
+#function (package, fun, arg, lib.loc = NULL) {
+#	dir <- .find.package(package, lib.loc)
+#	rds <- file.path(dir, "Meta", "Rd.rds")
+#	if (file_test("-f", rds)) {
+#		rd.data <- .readRDS(rds)
+#		index <- which(sapply(rd.data$Aliases, function(x) any(fun %in% x)))
+#		if (length(index) == 1) {
+#			rdfile <- rd.data$File[index]
+#			rddb <- Rd_db(package = package)
+#			rdcontent <- paste(rddb[basename(names(rddb)) == rdfile][[1]],
+#				collapse = "\n")
+#			arguments <- .get_Rd_arguments_table(rdcontent)
+#			arguments[sapply(arg, function(x) which(arguments[, 1] == x)), 2]
+#			# TODO: do some error handling
+#		} else {
+#			rep("", length(arg))
+#		}
+#	} else {
+#		rep("", length(arg))
+#	}
+#}
+#
+#.get_Rd_arguments_table <-
+#function (txt) {
+#    txt <- get_Rd_section(txt, "arguments")	# tools:::get_Rd_section
+#    tab <- get_Rd_items_table(txt)
+#    txt <- tab[, 1]
+#    if (!length(txt))
+#        return(character())
+#    txt <- gsub("\\\\l?dots", "...", txt)
+#    txt <- sub("^[[:space:]]+", "", txt)
+#    txt <- sub("[[:space:]]+$", "", txt)
+#    txt <- gsub("\\\\_", "_", txt)
+#    tab[, 1] <- txt
+#    tab
+#}
+#
+#### inspired from tools:::get_Rd_items
+#### build a matrix where first column are the names of the arguments
+#### and second column are the description
+#### the function gets the information from the Rd help file
+#get_Rd_items_table <-
+#function (txt) {
+#    out <- character() # item names
+#    desc <- character() # item descriptions
+#
+#    if (length(txt) != 1L)
+#        stop("argument 'txt' must be a character string")
+#    pattern <- "(^|\n)[[:space:]]*\\\\item\\{"
+#    while ((pos <- regexpr(pattern, txt)) != -1L) {
+#        txt <- substring(txt, pos + attr(pos, "match.length") - 1L)
+#        if ((pos <- delimMatch(txt)) == -1L)
+#            stop(gettextf("unmatched \\item name in '\\item{%s'",
+#                sub("\n.*$", "", txt)), domain = NA, call. = FALSE)
+#        newout <- strsplit(substring(txt, pos + 1L, pos +
+#			attr(pos, "match.length") - 2L), " *, *")[[1]]
+#        out <- c(out, newout)
+#        txt <- substring(txt, pos + attr(pos, "match.length"))
+#        if ((pos <- regexpr("^[[:space:]]*\\{", txt)) == -1L)
+#            stop(gettextf("no \\item description for item '%s'",
+#                out[length(out)]), domain = NA, call. = FALSE)
+#        txt <- substring(txt, pos + attr(pos, "match.length") - 1L)
+#        if ((pos <- delimMatch(txt)) == -1L)
+#            stop(gettextf("unmatched \\item description for item '%s'",
+#                out[length(out)]), domain = NA, call. = FALSE)
+#        desc <- c(desc, rep(substring(txt, 2L, pos + attr(pos, "match.length")
+#			- 2L), length(newout)))
+#        txt <- substring(txt, pos + attr(pos, "match.length"))
+#    }
+#    cbind(out, desc)
+#}

Modified: pkg/svMisc/TODO
===================================================================
--- pkg/svMisc/TODO	2008-07-03 12:57:42 UTC (rev 42)
+++ pkg/svMisc/TODO	2008-07-06 13:07:40 UTC (rev 43)
@@ -1,5 +1,9 @@
 = svMisc To Do list
 
+* CompletePlus() accelerate treatment (return completion and calculate desc
+later? limit the list to n entries?). Also, make sure that options for
+completion are correct for the given types
+
 * The svMisc-package.Rd man page
 
 * Write the code in objList() to list content inside objects

Modified: pkg/svMisc/man/CompletePlus.Rd
===================================================================
--- pkg/svMisc/man/CompletePlus.Rd	2008-07-03 12:57:42 UTC (rev 42)
+++ pkg/svMisc/man/CompletePlus.Rd	2008-07-06 13:07:40 UTC (rev 43)
@@ -6,31 +6,41 @@
   within the R help file to gather information about each completion.
 }
 \usage{
-CompletePlus(linebuffer, cursorPosition = nchar(linebuffer), minlength = 2, simplify = FALSE)
+CompletePlus(linebuffer, cursorPosition = nchar(linebuffer), minlength = 2,
+simplify = FALSE, types = c("arguments", "functions", "packages"))
 }
+
 \arguments{
   \item{linebuffer}{ R code fragment }
   \item{cursorPosition}{ Position of the cursor in the fragment }
-  \item{minlength}{ Minimum size the fragment needs to be to perform the completion }
-  \item{simplify}{ Logical. If TRUE, then the result is printed using a simpler syntax rather. }
+  \item{minlength}{ Minimum size the fragment needs to be to perform the
+    completion }
+  \item{simplify}{ Logical. If TRUE, then the result is printed in strings with
+    tabulation as field separators. }
+  \item{types}{ Which types of items should we be looking for? }
 }
+
 \details{
-  The information given back depends on the kind of completion performed. If a potential completion ends
-  with the equal sign, then \code{CompletePlus} tries to get information on the
-  argument from the guessed function. If the potential completion ends with \code{::}, then the
-  \code{CompletePlus} gets information about the package. If the potential completion is a function,
-  then \code{CompletePlus} retrieves the title of the function as documented in its Rd file if
-  the function is documented.
+  The information given back depends on the kind of completion performed. If a
+  potential completion ends with the equal sign, then \code{CompletePlus} tries
+  to get information on the argument from the guessed function. If the potential
+  completion ends with \code{::}, then the \code{CompletePlus} gets information
+  about the package. If the potential completion is a function, then
+  \code{CompletePlus} retrieves the title of the function as documented in
+  the man page, if the function is documented.
 }
+
 \value{
-  Either a matrix giving completion information. If simplify is set to TRUE, nothing is returned
-  but the result is \code{cat} directly to the console.
+  Either a matrix giving completion information. If simplify is set to TRUE,
+  nothing is returned but the result is \code{cat} directly to the console.
 }
+
 \author{ Romain Francois <rfrancois at mango-solutions.com> }
-\seealso{ \code{\link{Complete}} }
+
+\seealso{ \code{\link{Complete}}, \code{\link{descFun}} }
+
 \examples{
-  CompletePlus( "dn" )
-  CompletePlus( "rnorm( 10, me" )
+CompletePlus("dn")
+CompletePlus("rnorm(10, me")
 }
 \keyword{ utilities }
-



More information about the Sciviews-commits mailing list