Extracts all calls to a function (except for those in standard packages)

my.fun_calls <- function(f)
{ 
    ## Purpose: Extracts all calls to a function (except for those in standard packages) in a function 
    ##          Differs from pryr::fun_calls by excluding basic functions. 
    ## Arguments:
    ##   f: a function
    ## Return: All calls to a function (that are not in standard packages, e.g. base, stats, etc.)
    ## Author: Feiming Chen, Date:  7 Sep 2017, 11:23
    ## ________________________________________________

    if (is.function(f)) {
        my.fun_calls(body(f))
    } else if (is.call(f)) {
        fname <- as.character(f[[1]])
        if (identical(fname, ".Internal")) fname3 <- NULL
        f1 <- try(pryr::where(fname), silent = TRUE)
        if (is.tryerror(f1)) {
            if (fname[1] == "::") {   # Example: pryr::where  fname = c("::", "pryr", "where")
                fname3 <- paste0(fname[2], fname[1], fname[3])
            } else {
                fname3 <- NULL
            }
        } else {
            fname2 <- environmentName(f1)
            if (fname2 %in% c("base", "package:stats", "package:graphics", "package:grDevices", "package:utils", "package:datasets", "package:methods")) {
                fname3 <- NULL
            } else {
                if (fname2 == "R_GlobalEnv") {
                    fname3 <- fname
                } else {                # attach package name if other than Global Environment
                    fname2m <- sub("package:", "", fname2) # remove "package:" prefix. 
                    if (fname2m == "") {
                        fname3 <- paste0(fname)
                    } else {                         
                        fname3 <- paste0(fname2m, "::", fname) 
                    }
                }
            }
        }

        if (F) fun_calls(lm)            # for testing purpose only

        unique(c(fname3, unlist(lapply(f[-1], my.fun_calls), use.names = FALSE)))
    }
}
if (F) {                                # Unit Test
    my.fun_calls(lm)                    # NULL

    sort(my.fun_calls(my.fun_calls))
    ## "is.tryerror"     "my.fun_calls"    "pryr::fun_calls" "pryr::where"    
}


## Test for the try-error class (from "try" function)
is.tryerror <- function(x) inherits(x, "try-error")