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 300, Fri Jun 17 07:37:46 2011 UTC revision 302, Tue Jul 12 12:06:42 2011 UTC
# Line 20  Line 20 
20  ### A list, same type as x, but with added elements from y.  ### A list, same type as x, but with added elements from y.
21  }  }
22    
23    
24    getSource <- function
25    ### Extract a function's source code.
26    (fun.obj
27    ### A function.
28     ) {
29          srcref <- attr(fun.obj, "srcref")
30          if (!is.null(srcref)) unlist(strsplit(as.character(srcref), "\n"))
31          else attr(fun.obj, "source")
32    ### Source code lines as a character vector.
33    }
34    
35  ### Prefix for code comments used with grep and gsub.  ### Prefix for code comments used with grep and gsub.
36  prefix <- "^[ \t]*###[ \t]*"  prefix <- "^[ \t]*###[ \t]*"
37    
# Line 52  Line 64 
64      on.exit(cat(sprintf("Parser Function failed on %s\n",N)))      on.exit(cat(sprintf("Parser Function failed on %s\n",N)))
65      for(N in union(names(docs),names(objs))){      for(N in union(names(docs),names(objs))){
66        o <- objs[[N]]        o <- objs[[N]]
67        L[[N]] <- FUN(src=attr(o,"source"),        L[[N]] <- FUN(src=getSource(o),
68                      name=N,objs=objs,o=o,docs=docs,doc=docs[[N]],...)                      name=N,objs=objs,o=o,docs=docs,doc=docs[[N]],...)
69      }      }
70      on.exit()## remove warning message      on.exit()## remove warning message
# Line 146  Line 158 
158  ### the return value  ### the return value
159  ##seealso<< foobar  ##seealso<< foobar
160  }  }
161  src <- attr(test,"source")  src <- getSource(test)
162  prefixed.lines(src)  prefixed.lines(src)
163  extract.xxx.chunks(src)  extract.xxx.chunks(src)
164  })  })
# Line 483  Line 495 
495             ## Special case for code contained in a function             ## Special case for code contained in a function
496             if (inherits(ex, "function")) {             if (inherits(ex, "function")) {
497               ## If source is available, start from there               ## If source is available, start from there
498               src <- attr(ex, "source")               src <- getSource(ex)
499               if (!is.null(src)) {               if (!is.null(src)) {
500                 ex <- src                 ex <- src
501               } else { ## Use the body of the function               } else { ## Use the body of the function
# Line 520  Line 532 
532           sum=x+y) ##<< their sum           sum=x+y) ##<< their sum
533      ##end<<      ##end<<
534    }    }
535    src <- attr(f,"source")    src <- getSource(f)
536    lonely$extract.xxx.chunks(src)    lonely$extract.xxx.chunks(src)
537    lonely$prefixed.lines(src)    lonely$prefixed.lines(src)
538  })  })
# Line 578  Line 590 
590      } else if(0 == length(res) && inherits(objs[[on]],"standardGeneric")){      } else if(0 == length(res) && inherits(objs[[on]],"standardGeneric")){
591        NULL        NULL
592      } else if(0 == length(res) && "function" %in% class(o)      } else if(0 == length(res) && "function" %in% class(o)
593                && 1 == length(osource <- attr(o,"source"))                && 1 == length(osource <- getSource(o))
594                && grepl(paste("UseMethod(",on,")",sep="\""),osource)                && grepl(paste("UseMethod(",on,")",sep="\""),osource)
595                ){                ){
596        ## phew - this should only pick up R.oo S3 generic definitions like:        ## phew - this should only pick up R.oo S3 generic definitions like:

Legend:
Removed from v.300  
changed lines
  Added in v.302

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