SCM

SCM Repository

[inlinedocs] Diff of /pkg/inlinedocs/R/parsers.R
ViewVC logotype

Diff of /pkg/inlinedocs/R/parsers.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 158, Mon Nov 8 12:26:12 2010 UTC revision 163, Tue Nov 16 12:06:29 2010 UTC
# Line 28  Line 28 
28  ### String without prefixes or newlines.  ### String without prefixes or newlines.
29  }  }
30    
31    forall <- function
32  ### For each object in the package that satisfies the criterion  ### For each object in the package that satisfies the criterion
33  ### checked by subfun, parse source using FUN and return the resulting  ### checked by subfun, parse source using FUN and return the resulting
34  ### documentation list.  ### documentation list.
 forall <- function  
35  (FUN,  (FUN,
36  ### Function to apply to each element in the package.  ### Function to apply to each element in the package.
37   subfun=function(x)TRUE   subfun=function(x)TRUE
# Line 43  Line 43 
43    f <- function(objs,docs,...){    f <- function(objs,docs,...){
44      objs <- objs[sapply(objs,subfun)]      objs <- objs[sapply(objs,subfun)]
45      L <- list()      L <- list()
46        on.exit(cat(sprintf("Parser Function failed on %s\n",N)))
47      for(N in names(docs)){      for(N in names(docs)){
48        o <- objs[[N]]        o <- objs[[N]]
49        L[[N]] <- FUN(src=attr(o,"source"),        L[[N]] <- FUN(src=attr(o,"source"),
50                      name=N,objs=objs,o=o,docs=docs,doc=docs[[N]],...)                      name=N,objs=objs,o=o,docs=docs,doc=docs[[N]],...)
51      }      }
52        on.exit()## remove warning message
53      L      L
54    }    }
55    class(f) <- c("allfun","function")    class(f) <- c("allfun","function")
# Line 67  Line 69 
69  ### For each function in the package, do something.  ### For each function in the package, do something.
70  forfun <- function(FUN)forall(FUN,is.function)  forfun <- function(FUN)forall(FUN,is.function)
71    
72    kill.prefix.whitespace <- function
73    ### Figure out what the whitespace preceding the example code is, and
74    ### then delete that from every line.
75    (ex
76    ### character vector of example code lines.
77     ){
78      tlines <- gsub("\\s*","",ex)
79      ##tlines <- gsub("#.*","",tlines)
80      prefixes <- unique(gsub("\\S.*","",ex[tlines!=""]))
81      FIND <- prefixes[which.min(nchar(prefixes))]
82      ## Eliminate leading tabulations or 2/4 spaces
83      sub(FIND, "", ex)
84    ### Character vector of code lines with preceding whitespace removed.
85    }
86    
87  examples.after.return <- function  examples.after.return <- function
88  ### Get examples from inline definitions after return()  ### Get examples from inline definitions after return()
89  ### PhG: this does not work well! Think of these situations:  ### PhG: this does not work well! Think of these situations:
# Line 111  Line 128 
128    ## Possibly eliminate a #}}} tag    ## Possibly eliminate a #}}} tag
129    ex <- ex[!grepl("#}}}", ex)]    ex <- ex[!grepl("#}}}", ex)]
130    ## Eliminate leading tabulations or four spaces    ## Eliminate leading tabulations or four spaces
131    prefixes <- gsub("(\\s*).*","\\1",ex,perl=TRUE)[grep("\\w",ex)]    ex <- kill.prefix.whitespace(ex)
   FIND <- prefixes[which.min(nchar(prefixes))]  
   ex <- sub(FIND,"",ex)  
132    ## Add an empty line before and after example    ## Add an empty line before and after example
133    ex <- c("", ex, "")    ex <- c("", ex, "")
134    ## Return examples and value    ## Return examples and value
# Line 136  Line 151 
151    starts <- c(1,bounds+1)    starts <- c(1,bounds+1)
152    ends <- c(bounds,length(clines))    ends <- c(bounds,length(clines))
153    ## detect body of function using paren matching    ## detect body of function using paren matching
154    f <- function(ch)cumsum(nchar(gsub(sprintf("[^%s]",ch),"",src)))    code <- gsub("#.*","",src)
155      f <- function(ch)cumsum(nchar(gsub(sprintf("[^%s]",ch),"",code)))
156    parens <- f("(")-f(")")    parens <- f("(")-f(")")
157    body.begin <- which(diff(parens)<0 & parens[-1]==0)+2    body.begin <- which(diff(parens)<0 & parens[-1]==0)+2
158    is.arg <- function(){    is.arg <- function(){
159      0 == length(grep("^\\s*#",src[start-1],perl=TRUE)) &&      gres <- grep("^\\s*#",src[start-1],perl=TRUE)
160        start<=body.begin      0 == length(gres) && start<=body.begin
161      }      }
162    res <- list()    res <- list()
163    for(i in seq_along(starts)){    for(i in seq_along(starts)){
# Line 471  Line 487 
487               }               }
488               ## Eliminate leading and trailing code               ## Eliminate leading and trailing code
489               ex <- ex[-c(1, length(ex))]               ex <- ex[-c(1, length(ex))]
490               ## Eliminate leading tabulations or 2/4 spaces               ## all the prefixes
491               ex <- sub("^\t|    |  ", "", ex)               ex <- kill.prefix.whitespace(ex)
492               ## Add an empty line before and after example               ## Add an empty line before and after example
493               ex <- c("", ex, "")               ex <- c("", ex, "")
494             }             }

Legend:
Removed from v.158  
changed lines
  Added in v.163

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge