ess and debug package

[Stephen Eglen]

 > I was trying to use the new debug package from within emacs, I get the 
 > following error:
 > >library(debug)
 > Loading required package: mvbutils
 > MVBUTILS: no "tasks" vector found in ROOT
 > MVBUTILS loaded OK
 > Loading required package: tcltk
 > >mtrace(glm) # turns tracing on
 > >names( tracees) # "glm"
 > [1] "glm"
 > >names( tracees) # "glm"
 > [1] "glm"
 > >glm(stupid.args) # voila le debugger
 > Error in savehistory(file) : no history available to save
 > 
 > Has anybody been more succesfull?

I also just tried this sequence from Angel, and got the same error
with the CVS version of ESS.  (The sequence works fine when running R
from an xterm.)

I've generated the traceback in case it is of use to the debug package
author (cc'ed here).

Stephen
> library(debug)
Loading required package: mvbutils 
MVBUTILS: no "tasks" vector found in ROOT
MVBUTILS loaded OK
Loading required package: tcltk 
> mtrace(glm)
> glm(stupid.args)
Error in savehistory(file) : no history available to save
> traceback()
10: savehistory(debug.hist.file)
9: assign("answer", {
       assign("[[", my.index)
       assign("[[<-", my.index.assign)
       .frames. <- empty.data.frame(actual = , debug = 0, function.name = , 
           window.name = , subframe = "", has.window.yet = FALSE)
       .nothing. <- structure(0, class = "nullprint")
       .step. <- .skip. <- .evaluated.OK. <- .system. <- .print.result. <- .in.users.commands. <- .quit.debug. <- FALSE
       .end.debug. <- NULL
       back.colour <- c(" " = "White", "*" = "Red")
       select.colour <- c(" " = "Blue", "*" = "Red")
       values.of.typeof <- cq(symbol, pairlist, closure, environment, 
           promise, language, special, builtin, logical, integer, 
           double, complex, character, "...", any, expression, list, 
           externalptr)
       rogue.types <- c("for", "while", "repeat", "if", "switch", 
           "break", "next", "return", "{")
       dodgy.for.counter.types <- cq(language, symbol, promise, 
           environment, closure, "...", any, externalptr)
       dodgy.if.while.types <- cq("NULL", pairlist, closure, environment, 
           promise, language, special, builtin, "...", any, expression, 
           list, externalptr)
       valid.switch.types <- cq(character, logical, integer, double, 
           complex)
       list.of.command.subs <- named(cq(break, next, return, q, 
           on.exit, sys.on.exit, do.call))
       where.to.look <- "package:debug"
       if (where.to.look %!in% search()) 
           where.to.look <- match("debug", sapply(1:length(search()), 
               function(i) (names(attr(pos.to.env(i), "path")) %&% 
                   "")[1]))
       if (exists("debug.next", where.to.look)) 
           subfun <- function(x) as.name("debug." %&% x)
       else {
           subfun <- function(x) call(":::", quote(debug), as.name("debug." %&% 
               x))
           debug.namespace <- asNamespace("debug")
           funs <- ls(env = debug.namespace, all = TRUE) %except% 
               find.funs("package:debug")
           funs <- funs[sapply(funs, exists, env = debug.namespace, 
               mode = "function")]
           for (ifun in funs) assign(ifun, getFromNamespace(ifun, 
               debug.namespace))
       }
       list.of.command.subs <- lapply(list.of.command.subs, subfun)
       if (debug.command.recall <- option.or.default("debug.command.recall", 
           TRUE)) {
           debug.hist.file <- tempfile()
           savehistory(debug.hist.file)
       }
       ch <- function(...) paste(c(..., "."), collapse = ",")
       star.or.space <- function(bpex) if (is.logical(bpex) && length(bpex) == 
           1 && !is.na(bpex) && !bpex) 
           " "
       else "*"
       mark.bp <- function(bpex) !(is.logical(bpex) && length(bpex) == 
           1 && !is.na(bpex) && !bpex)
       augment.for.eval <- function(i, call.type) c(i, switch(call.type, 
           "for" = 3, "if" = , switch = , "while" = 2, numeric(0)))
       get.call.type <- function(ex) {
           if (!is.call(ex) || mode(ex) == "(" || !(i <- match(paste(as.character(ex[[1]]), 
               collapse = " "), rogue.types, 0))) {
               if (!is.call(ex) && is.expression(ex)) 
                   "expression"
               else "normal"
           }
           else rogue.types[i]
       }
   }, envir = <environment>)
8: eval(expr, envir, enclos)
7: eval(expr, envir = nlocal.env, enclos = sys.frame(sys.nframe()))
6: mlocal({
       assign("[[", my.index)
       assign("[[<-", my.index.assign)
       .frames. <- empty.data.frame(actual = , debug = 0, function.name = , 
           window.name = , subframe = "", has.window.yet = FALSE)
       .nothing. <- structure(0, class = "nullprint")
       .step. <- .skip. <- .evaluated.OK. <- .system. <- .print.result. <- .in.users.commands. <- .quit.debug. <- FALSE
       .end.debug. <- NULL
       back.colour <- c(" " = "White", "*" = "Red")
       select.colour <- c(" " = "Blue", "*" = "Red")
       values.of.typeof <- cq(symbol, pairlist, closure, environment, 
           promise, language, special, builtin, logical, integer, 
           double, complex, character, "...", any, expression, list, 
           externalptr)
       rogue.types <- c("for", "while", "repeat", "if", "switch", 
           "break", "next", "return", "{")
       dodgy.for.counter.types <- cq(language, symbol, promise, 
           environment, closure, "...", any, externalptr)
       dodgy.if.while.types <- cq("NULL", pairlist, closure, environment, 
           promise, language, special, builtin, "...", any, expression, 
           list, externalptr)
       valid.switch.types <- cq(character, logical, integer, double, 
           complex)
       list.of.command.subs <- named(cq(break, next, return, q, 
           on.exit, sys.on.exit, do.call))
       where.to.look <- "package:debug"
       if (where.to.look %!in% search()) 
           where.to.look <- match("debug", sapply(1:length(search()), 
               function(i) (names(attr(pos.to.env(i), "path")) %&% 
                   "")[1]))
       if (exists("debug.next", where.to.look)) 
           subfun <- function(x) as.name("debug." %&% x)
       else {
           subfun <- function(x) call(":::", quote(debug), as.name("debug." %&% 
               x))
           debug.namespace <- asNamespace("debug")
           funs <- ls(env = debug.namespace, all = TRUE) %except% 
               find.funs("package:debug")
           funs <- funs[sapply(funs, exists, env = debug.namespace, 
               mode = "function")]
           for (ifun in funs) assign(ifun, getFromNamespace(ifun, 
               debug.namespace))
       }
       list.of.command.subs <- lapply(list.of.command.subs, subfun)
       if (debug.command.recall <- option.or.default("debug.command.recall", 
           TRUE)) {
           debug.hist.file <- tempfile()
           savehistory(debug.hist.file)
       }
       ch <- function(...) paste(c(..., "."), collapse = ",")
       star.or.space <- function(bpex) if (is.logical(bpex) && length(bpex) == 
           1 && !is.na(bpex) && !bpex) 
           " "
       else "*"
       mark.bp <- function(bpex) !(is.logical(bpex) && length(bpex) == 
           1 && !is.na(bpex) && !bpex)
       augment.for.eval <- function(i, call.type) c(i, switch(call.type, 
           "for" = 3, "if" = , switch = , "while" = 2, numeric(0)))
       get.call.type <- function(ex) {
           if (!is.call(ex) || mode(ex) == "(" || !(i <- match(paste(as.character(ex[[1]]), 
               collapse = " "), rogue.types, 0))) {
               if (!is.call(ex) && is.expression(ex)) 
                   "expression"
               else "normal"
           }
           else rogue.types[i]
       }
   })
5: setup.debug.admin(nlocal = n.debug.HQ)
4: find.debug.HQ(TRUE)
3: do.in.envir(envir = find.debug.HQ(TRUE), {
       on.exit(.end.incarnation())
       next.incarnation()
       repeat {
           if (my.all.equal(i, 2) && in.body.code) 
               retval <- j
           else if (i[1] == 3) 
               break
           if (i[1] != 1) 
               in.body.code <- FALSE
           ch.i <- ch(i)
           .skip. <<- FALSE
           .skipto. <- 0
           repeat {
               if (.quit.debug.) {
                   cat("\rNo ")
                   stop("merely quitting mvb's debugger")
               }
               .evaluated.OK. <<- TRUE
               .print.result. <<- FALSE
               find.line <- match(ch.i, names(breakpoints))
               if (!is.na(find.line)) 
                   lno <- find.line
               if (!stop.here() || !.step.) 
                   break
               if (!stopped.yet) {
                   launch.debug.windows()
                   stopped.yet <- TRUE
               }
               command <- interact()
               try.j <- enact.command.r(command, frame)
               if (try.j %is.not.a% "try-error" && !.system.) 
                   j <- try.j[[1]]
               if (.evaluated.OK.) 
                   break
           }
           if (!.skip.) {
               call.type <- get.call.type(expr[[i]])
               if (call.type %in% c("normal", "if", "for", "while", 
                   "switch")) {
                   try.j <- eval.catching.errors(expr[[augment.for.eval(i, 
                     call.type)]], envir = frame)
                   if (.evaluated.OK.) {
                     j <- try.j
                     if (.print.result.) 
                       print.if.small(j)
                     .evaluated.OK. <<- check.legality(j, call.type)
                     if (!.evaluated.OK.) 
                       cat("Problem:", attr(.evaluated.OK., "message"), 
                         "\n")
                   }
                   if (!.evaluated.OK.) {
                     .step. <<- TRUE
                     next
                   }
               }
           }
           if (.skip.) 
               skipto.debug()
           else move.to.next.expression()
       }
       if (in.body.code) {
           cat("Function exited via \"skip\": return value may be strange\n")
           retval <- j
       }
       retval
   })
2: evaluator(fname = "glm")
1: glm(stupid.args)
>