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 115, Fri Jun 18 10:35:11 2010 UTC revision 128, Wed Sep 22 09:24:39 2010 UTC
# Line 77  Line 77 
77           if("title"%in%names(doc))list() else           if("title"%in%names(doc))list() else
78           list(title=gsub("[._]"," ",name))           list(title=gsub("[._]"," ",name))
79         }),         }),
80         # PhG: it is tests/FUN.R!!! I would like more flexibility here         ## PhG: it is tests/FUN.R!!! I would like more flexibility here
81             # please, let me choose which dir to use for examples!         ## please, let me choose which dir to use for examples!
82             ## Get examples for FUN from the file tests/FUN.R             ## Get examples for FUN from the file tests/FUN.R
83         examples.from.testfile=list(forfun,function(name,...){         examples.from.testfile=list(forfun,function(name,...){
84           tsubdir <- getOption("inlinedocs.exdir")           tsubdir <- getOption("inlinedocs.exdir")
# Line 89  Line 89 
89           else list()           else list()
90         }),         }),
91         ## Get examples from inline definitions after return()         ## Get examples from inline definitions after return()
92             # PhG: this does not work well! Think at these situations:         ## PhG: this does not work well! Think of these situations:
93             # 1) You have multiple return() in the code of your function,         ## 1) You have multiple return() in the code of your function,
94             # 2) You have return() appearing is some example code, ...         ## 2) You have return() appearing is some example code, ...
95             # I can hardly propose a hack here. The whole code of the function         ## I can hardly propose a hack here. The whole code of the function
96             # must be parsed, and one must determine which one is the last line         ## must be parsed, and one must determine which one is the last line
97             # of code that is actually executed.         ## of code that is actually executed.
98             #         ##
99             # I make two propositions here         ## I make two propositions here
100             # 1) to keep the same mechanism that has the advantage of simplicity         ## 1) to keep the same mechanism that has the advantage of simplicity
101             #    but to use a special tag ##examples<< or #{{{examples to separate         ##    but to use a special tag
102             #    function code from examples explicitly, and         ##examples<< or #{{{examples to separate
103             # 2) to place the example in an "ex" attribute attached to the function         ##    function code from examples explicitly, and
104             #    (see next parser). That solution will be also interesting for         ## 2) to place the example in an "ex" attribute
105             #    documenting datasets, something not done yet by inlinedocs!         ##    attached to the function
106             examples.after.return = list(forfun, function(name, src, ...) {         ##    (see next parser). That solution will be also interesting for
107                          # Look for the examples mark         ##    documenting datasets, something not done yet by inlinedocs!
108           examples.after.return = list(forfun,function(src,name="",...) {
109             ## Look for the examples mark
110                          m <- grep("##examples<<|#\\{\\{\\{examples", src)                          m <- grep("##examples<<|#\\{\\{\\{examples", src)
111                          if (!length(m)) return(list())                          if (!length(m)) return(list())
112                          if (length(m) > 1)                          if (length(m) > 1)
113                                  warning("More than one examples tag for ", name, ". Taking the last one")             warning("More than one examples tag for ", name,
114                       ". Taking the last one")
115                          m <- m[length(m)]                          m <- m[length(m)]
116                          # Look for the lines containing return value comments just before           ## Look for the lines containing return value comments just before
117                          r <- grep("\\s*### ", src[1:(m-1)])                          r <- grep("\\s*### ", src[1:(m-1)])
118                          if (!length(r)) {                          if (!length(r)) {
119                                  value <- NULL                                  value <- NULL
120                          } else {                          } else {
121                                  # Only take consecutive lines before the mark               ## Only take consecutive lines before the mark
122                                  keep <- rev((m - rev(r)) == 1:length(r))                                  keep <- rev((m - rev(r)) == 1:length(r))
123                                  if (!any(keep)) {                                  if (!any(keep)) {
124                                          value <- NULL                                          value <- NULL
# Line 123  Line 126 
126                                          value <- decomment(src[r[keep]])                                          value <- decomment(src[r[keep]])
127                                  }                                  }
128                          }                          }
129                          # Collect now the example code beneath the mark           ## Collect now the example code beneath the mark
130                          ex <- src[(m + 1):(length(src) - 1)]                          ex <- src[(m + 1):(length(src) - 1)]
131                          # Possibly eliminate a #}}} tag           ## Possibly eliminate a #}}} tag
132                          ex <- ex[!grepl("#}}}", ex)]                          ex <- ex[!grepl("#}}}", ex)]
133                          # Eliminate leading tabulations or four spaces           ## Eliminate leading tabulations or four spaces
134                          ex <- sub("^\t|    ", "", ex)           prefixes <- gsub("(\\s*).*","\\1",ex,perl=TRUE)[grep("\\w",ex)]
135                          # Add an empty line before and after example           FIND <- prefixes[which.min(nchar(prefixes))]
136             ex <- sub(FIND,"",ex)
137             ## Add an empty line before and after example
138                          ex <- c("", ex, "")                          ex <- c("", ex, "")
139                          # Return examples and value           ## Return examples and value
140                          list(examples = paste(ex, collapse = "\n"), value = value)                          list(examples = paste(ex, collapse = "\n"), value = value)
141             }),             }),
142             # PhG: here is what I propose for examples code in the 'ex' attribute         ## PhG: here is what I propose for examples code in the 'ex' attribute
143             examples.in.attr = list(forfun, function (name, o, ...) {         examples.in.attr = list(forall, function (name, o, ...) {
144                          ex <- attr(o, "ex")                          ex <- attr(o, "ex")
145                          if (!is.null(ex)) {                          if (!is.null(ex)) {
146                                  # Special case for code contained in a function             ## Special case for code contained in a function
147                                  if (inherits(ex, "function")) {                                  if (inherits(ex, "function")) {
148                                          # If source is available, start from there               ## If source is available, start from there
149                                          src <- attr(ex, "source")                                          src <- attr(ex, "source")
150                                          if (!is.null(src)) {                                          if (!is.null(src)) {
151                                                  ex <- src                                                  ex <- src
152                                          } else { # Use the body of the function               } else { ## Use the body of the function
153                                                  ex <- deparse(body(ex))                                                  ex <- deparse(body(ex))
154                                          }                                          }
155                                          # Eliminate leading and trailing code               ## Eliminate leading and trailing code
156                                          ex <- ex[-c(1, length(ex))]                                          ex <- ex[-c(1, length(ex))]
157                                          # Eliminate leading tabulations or four spaces               ## Eliminate leading tabulations or four spaces
158                                          ex <- sub("^\t|    ", "", ex)                                          ex <- sub("^\t|    ", "", ex)
159                                          # Add an empty line before and after example               ## Add an empty line before and after example
160                                          ex <- c("", ex, "")                                          ex <- c("", ex, "")
161                                  }                                  }
162                                  list(examples = paste(ex, collapse = "\n"))                                  list(examples = paste(ex, collapse = "\n"))
163                          } else list()                          } else list()
164             }))         })
165           )
166    
167  ### List of parser functions that operate on single objects. This list  ### List of parser functions that operate on single objects. This list
168  ### is useful for testing these functions, ie  ### is useful for testing these functions.
 ### lonely$parsefun(attr(extract.docs.file,"source"),"extract.docs.file")  
169  lonely <- sapply(forall.parsers,function(L)L[[2]])  lonely <- sapply(forall.parsers,function(L)L[[2]])
170    attr(lonely,"ex") <- function(){
171      lonely$parsefun(attr(extract.docs.file,"source"),"extract.docs.file")
172    }
173    
174  extra.code.docs <- function # Extract documentation from code chunks  extra.code.docs <- function # Extract documentation from code chunks
175  ### Parse R code to extract inline documentation from comments around  ### Parse R code to extract inline documentation from comments around
# Line 796  Line 804 
804  ### A list of extracted documentation from code.  ### A list of extracted documentation from code.
805  }  }
806    
807    ### Parsers that operate only on R code, independently of the
808    ### description file.
809    nondesc.parsers <- c(extra.code.docs=list(extra.code.docs),
810      default.parsers[c("parsefun","examples.after.return","examples.in.attr")])
811    
812  extract.docs.file <- function  extract.docs.file <- function
813  ### Apply all parsers relevant to extract info from just 1 code file.  ### Apply all parsers relevant to extract info from just 1 code file.
814  (f,  (f,
815  ### File name of R code to read and parse.  ### File name of R code to read and parse.
816   parsers=list(extra.code.docs,default.parsers$parsefun),   parsers=nondesc.parsers,
817  ### Parser Functions to use to parse the code and extract  ### Parser Functions to use to parse the code and extract
818  ### documentation.  ### documentation.
819   ...   ...

Legend:
Removed from v.115  
changed lines
  Added in v.128

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