R/parseFunction.R

In michelk/annotSrcDoc.R: Minimal documentation out of annotated function source code

parseFunction <-
    function     # ^ Parse annotated comments of a function definition
(
    cmts                # ^ lines with comments
   ,p   =               # ^ general annotation pattern
       '\\s*# \\^\\s*'
   ,pd  =                               # ^ descritption pattern
       "\\s*### \\^"
   ,fp  =                               # ^ function pattern
       '\\s* = function'
   ,rp  =                               # ^ return value pattern
       '^\\s*}'
)
{
    name <-
        strsplit(cmts[grep(fp, cmts)], "\\s*=\\s*")[[1]][1]

    strCmts <-
        paste(cmts, collapse = "\n")
    cts <-                          # concatenate multilines
        strsplit(gsub(paste('\n', p, sep = ""), "", strCmts), "\n")[[1]]

    topics <-
        list(
            title  = fp
           ,desc   = pd
           ,result = rp
        )
    ## * process title, desc and result
    fd <-
        Reduce(
            function(acc, x)
        {
            ptn <- topics[[x]]              # pattern
            i <- grep(ptn, acc[[1]])
            if (length(i) > 0)
            {
                value <-
                    paste(
                        sub(
                            paste(".*", p, sep = "")
                          , ''
                          , sub(ptn, '', acc[[1]][i]))
                      , collapse = "\n")
                list(acc[[1]][-i],
                     eval(parse(text = sprintf(
                                'new("FunctionDoc", acc[[2]], %s = "%s")',
                                x, value
                     ))))
            } else
                acc

        }
           ,names(topics)
           ,list(cts, new('FunctionDoc', name = name))
        )
    ## * process args
    args. <-
        lapply(
            strsplit(fd[[1]], p), function(x)
                list(
                    name =
                        sub('\\s*=\\.*', '', sub("\\s*,*", '',x[1]))
                   ,value = x[2]
                )
            )
    args <-
        setNames(lapply(args., function(x) x$value),
                     sapply(args., function(x) x$name))
    new('FunctionDoc', fd[[2]], args = args)
}                                       # ^ Returns a 'FunctionDoc'