# prints the currently displayed graph to the
# file filename; suffix can be "pdf", "png" or "jpg"
pr2file <- function (filename)
{
    origdev <- dev.cur()
    parts <- strsplit(filename,".",fixed=TRUE)
    nparts <- length(parts[[1]])
    suff <- parts[[1]][nparts]
    if (suff == "pdf") {
        pdf(filename)
    }
    else if (suff == "png") {
        png(filename,bg='white')
    }
    else jpeg(filename)
    devnum <- dev.cur()
    dev.set(origdev)
    dev.copy(which = devnum)
    dev.set(devnum)
    dev.off()
    dev.set(origdev)
} 

# invoke text editor on f, and write back to f; f is a character
# string
fedit <- function(f) {
   if (!is.character(f)) stop("f must be a character string")
   cmd <- paste(f," <- edit(",f,")")
   evalrstring(cmd)
}

relib <- function(pkg) {
   evalrstring(paste("detach(package:",pkg,")",sep=""))
   evalrstring(paste("library(",pkg,")"))
}

# execute the given R expression
evalr <- function(toexec) {
   eval(parse(text=toexec))
}

# list objects from the given loaded package
lsp <- function(pkg) {
   cmd <- paste('ls(package:',pkg,')')
   evalr(cmd)
}

# *****************  debugging  ********************

srcname <<- NULL

# sources the given .R file, sets up debugging per below; sets
# globals: 
#   'srcname', the currently-sourced file (NULL repeats last one)
#   'applines', the lines in 'srcname'
# creates the file 'debugrecord'
dbsrci <- function(src=srcname,dbf=NULL) 
{  require(cmdlinetools)   
   srcname <<- src
   srci(src)
   if (!is.null(dbf)) debug(get(dbf))
}

# for debugging exec errors; set this once, then call debugger() each
# time get an exec error
odf <- function() options(error=dump.frames)

dbtb <- function() traceback()

# find line on which the debugger currently stands
dbcurr <- function() {
   rec <- readLines("debugrecord")
   target <- "debug at"
   for (i in length(rec):1) {
      reci <- rec[i]
      ge <- gregexpr(target,reci)[[1]]
      if (ge == 1) {
         numbersign <- gregexpr("#",reci)[[1]][1]
         if (numbersign < 0) continue
         linenumstart <- numbersign + 1
         tmp <- substr(reci,linenumstart,nchar(reci))
         colon <- gregexpr(":",tmp)[[1]][1]
         return(as.integer(substr(tmp,1,colon-1)))
      }
   }
   print("line number not found")
}

# print the lines in app from m to n; if one of them is null, print all within
# 5 lines in that direciton
dbl <- function(m=NULL,n=NULL) {
   cl <- dbcurr()
   if (is.null(m)) {
      m <- max(1,cl-5)
   }
   if (is.null(n)) {
      n <- min(length(applines),cl+5)
   }
   for (i in m:n) {
      cat(i,applines[i],"\n",sep=" ")
   }
}

# set breakpoint at line linenum; can be turned off only by
# untrace(functionname)
dbb <- function(linenum) {
   setBreakpoint(appname,linenum)
}

# do debugonce(), and easy repeat if want a second time
db1 <- function(f) {savef <<- f; debugonce(f)}  # "debug once"
dba <- function() debugonce(savef)  # "debug again"
# example
# > g <- function(x) {x <- x+1; x^2}
# > db1(g)
# > g(5)
# debugging in: g(5)
# debug at #1: {
#     x <- x + 1
#     x^2
# }
# Browse[2]> c
# exiting from: g(5)
# [1] 36
# > dba()
# > g(3)
# debugging in: g(3)
# debug at #1: {
#     x <- x + 1
#     x^2
# }
# Browse[2]> Q