.packageName <- "Rpad"
#line 1 "/private/tmp/RtmpGqQCVl/R.INSTALL10d63af1/Rpad/R/Graphing.R"




# Rpad graphing functions 

"graphoptions" <- function (..., reset = FALSE, override.check = TRUE) {
  # set various Rpad graph options
  # modified based on code from ps.options
    l... <- length(new <- list(...))
    old <- check.options(new = new, envir = .RpadEnv, name.opt = ".RpadGraphOptions", 
        reset = as.logical(reset), assign.opt = l... > 0, override.check = override.check)
    if (reset || l... > 0) 
        invisible(old)
    else old
}

"newRpadPlotName" <- function(name = "") {
  # Create a new Rpad plot name
  # Updates the plot counter and name
  if (name == "") {
	Counter <- get("Rpad.plot.counter", envir = .RpadEnv)
    assign("Rpad.plot.counter", Counter + 1, envir = .RpadEnv)
    name <- paste("Rpad_plot", Counter, sep="")
  } 
  assign("Rpad.plot.name", name, envir = .RpadEnv)
  name
}

"RpadPlotName" <- function()
  get("Rpad.plot.name", envir = .RpadEnv)


 
"closeCurrentDevice" <- function() {
  # Closes the current device and if the current device is postscript,
  # process the output with ghostscript to generate the desired output.
  if (exists("RpadPlotParams", envir = .RpadEnv))
    p <- get("RpadPlotParams", envir = .RpadEnv)
  else
    return()
  dev.set(p$dev)
  if (.Device == "postscript") {
    dev.off()
    if (.Platform$OS.type == "windows") {
      gsexe <- Sys.getenv("R_GSCMD")
      if (is.null(gsexe) || nchar(gsexe) == 0) 
        gsexe <- ifelse(.Platform$OS.type == "windows", "gswin32c.exe", "gs")
        
      gshelp <- system(paste(gsexe, "-help"), intern = TRUE, invisible = TRUE)
      st <- grep("^Available", gshelp)
      en <- grep("^Search", gshelp)
      gsdevs <- gshelp[(st + 1):(en - 1)]
      devs <- c(strsplit(gsdevs, " "), recursive = TRUE)
      if (match(p$type, devs, 0) == 0) 
        stop(paste(paste("Device ", p$type, "is not available"), 
                   "Available devices are", paste(gsdevs, collapse = "\n"), 
                   sep = "\n"))
      cmd <- paste(gsexe, " -dNOPAUSE -dBATCH -q -sDEVICE=", p$type, 
                   " -r", p$res, " -g", ceiling(p$res * p$width), "x",
                   ceiling(p$res * p$height), " -sOutputFile=", p$name,
                   "-%03d.", p$extension, " ", p$name, ".eps", sep = "")
      system(cmd, intern = TRUE, invisible = TRUE)
    }
    for (fun in getHook("closeRpadDevice")) try(fun())
  } else if (.Device != "null device") {
    dev.off()
    for (fun in getHook("closeRpadDevice")) try(fun())
  }
  assign("RpadPlotParams", NULL, envir = .RpadEnv)
}

"newDevice" <- function(name, extension, type, res, width, height, deviceUsesPixels, pointsize, ...) {
  # Open a new device. If it's a ghostscript-based device, set up the
  # ghostscript handling.
  # If it's an R graphics device, initiate it.
  name <- newRpadPlotName(name)
  assign("Rpad.plot.type", type, envir = .RpadEnv)
  if (is.character(type) && type == "Rpng") { # for builtin png support
    unlink(grep(paste(name,".*\\.png",sep=""), dir(), value=T))
    png(file = paste(name,"-%03d.png",sep=""), width = width*res, height = height*res)
    assign("RpadPlotParams", list(dev=dev.cur(), extension="png"), envir = .RpadEnv)
  } else if (is.function(type)) { # for an arbitrary R graphics device
    unlink(grep(paste(name,".*\\.", extension, sep=""), dir(), value=T))
    funargs <- formals(type)
    callargs <- list(file = paste(name, "-%03d.", extension, sep=""))
    if (deviceUsesPixels) { 
      height <- height * res
      width <- width * res
    }
    extraargs <- c(list(res = res, width = width, height = height, pointsize = pointsize),
                   list(...))
    if ("..." %in% names(funargs)) { # the device function has a ..., so we (probably) can pass everything
      callargs <- c(callargs, extraargs)
    } else { # remove arguments not used by this device function
      callargs <- c(callargs, extraargs[intersect(names(extraargs), names(funargs))])
    }
    do.call("type", callargs)
    assign("RpadPlotParams", list(dev=dev.cur(), extension=extension), envir = .RpadEnv)
  } else { # for a ghostscript device using bitmap
    unlink(grep(paste(name,".*\\.", extension,sep=""), dir(), value=T))
    if (.Platform$OS.type == "windows") {
      cmd <- NULL
    } else {
      gsexe <- Sys.getenv("R_GSCMD")
      if (is.null(gsexe) || nchar(gsexe) == 0) 
        gsexe <- ifelse(.Platform$OS.type == "windows", "gswin32c.exe", "gs")
      gshelp <- system(paste(gsexe, "-help"), intern = TRUE)
      st <- grep("^Available", gshelp)
      en <- grep("^Search", gshelp)
      gsdevs <- gshelp[(st + 1):(en - 1)]
      devs <- c(strsplit(gsdevs, " "), recursive = TRUE)
      if (match(type, devs, 0) == 0) 
          stop(paste(paste("Device ", type, "is not available"), 
               "Available devices are", paste(gsdevs, collapse = "\n"), 
               sep = "\n"))
      cmd <- paste(gsexe, " -dNOPAUSE -dBATCH -q -sDEVICE=", type, 
                   " -r", res, " -g", ceiling(res * width), "x", ceiling(res * 
                   height), " -sOutputFile=", name, "-%03d.", extension, " ", sep = "")
    }
    postscript(file = paste(name,".eps",sep=""), width = width, height = height,
               pointsize = pointsize, 
               paper = "special", horizontal = FALSE, print.it = !is.null(cmd), 
               command = cmd, ...)
    assign("RpadPlotParams",
           list(dev=dev.cur(), name=name, type=type, width=width,
                height=height, res=res, extension=extension), envir = .RpadEnv)
  }
}

"newgraph" <- function(name = "", extension = graphoptions()$extension,
                       type = graphoptions()$type, res = graphoptions()$res,
                       width = graphoptions()$width, height = graphoptions()$height,
                       deviceUsesPixels = graphoptions()$deviceUsesPixels,
                       pointsize = graphoptions()$pointsize, sublines = graphoptions()$sublines,
                       toplines = graphoptions()$toplines, ratio = graphoptions()$ratio,
                       leftlines = graphoptions()$leftlines, lwd = graphoptions()$lwd, ...) {
# Start a new Rpad graph.
# uses code from bitmap and from Frank Harrell's Hmisc routine setps
  
  if (width == 0 & height == 0) 
    width <- 3.5
  if (width > 0 & height == 0) 
    height <- width/ratio
  if (width == 0 & height > 0) 
    width <- height * ratio
  closeCurrentDevice()
  newDevice(name, extension, type, res, width, height, deviceUsesPixels, pointsize, ...)

  par(lwd = lwd, mgp = c(2.5, 0.6, 0),
      mar = c(3 + sublines + 0.25 * (sublines > 0) + 
        0.5, 3 + leftlines + 0.5, toplines+.4,  1) + 0.1,
      cex.main=1,font.main=1,las=1)
  #require(lattice)

#  lattice::lset(lattice::canonical.theme("postscript", color = TRUE))

#  if (exists('xyplot')) {
#    trellis.device(col=T)
#    lset(list(axis.line=list(col="gray50"),axis.text=list(col="black"),
#              strip.background=list(col="white"),strip.shingle=list(col="gray70")))
#  }
  for (fun in getHook("newgraph")) try(fun())
  invisible()
}

"showgraph" <- function(name = RpadPlotName(), link = FALSE, ...) {
# Start a new Rpad graph, and show the existing graph(s).
  name
  newgraph()
  for (n in dir(pattern = paste(name, ".*", get("RpadPlotParams", envir = .RpadEnv)$extension, sep=""))) 
    print(HTMLimg(n))
  if (link && # show a link to an EPS file if specified and if using the ghostscript graphics
      get("Rpad.plot.type", envir = .RpadEnv) != "Rpng" &&
      !is.function(get("Rpad.plot.type", envir = .RpadEnv)))
    cat("<span contentEditable='false'>",
        "<sub><a href='", RpadURL(name), ".eps'>[EPS]</a></sub>",
        "</span>\n",
        sep="")
  invisible()
}


# Here's an example hook that you could use to add an EPS preview to eps files (requires epstool)

#eps.add.preview <- function(fname) system(paste("epstool -n1 -b -t6p -zbmp256 -r200 -g\"gswin32c\" -o",fname,".eps ",fname,".eps",sep=""),show.output.on.console = TRUE)
#
#setHook("closeRpadDevice", function() { # add a tiff preview to an eps file
#  name = RpadPlotName()
#  if (length(dir(pattern=paste(name,".eps",sep=""))) == 1)
#    eps.add.preview(name)
#})

### This will set the default graphics option to the GDD device:
# library(GDD)
# graphoptions(type = GDD)
### This is how you could change the pointsize on a GDD device:
# newgraph(ps = 10) # the default is 12


#line 1 "/private/tmp/RtmpGqQCVl/R.INSTALL10d63af1/Rpad/R/HtmlTree.R"
# 
#
#
#
#
#

"Html" <- function(x,...) { 
  UseMethod("Html") 
}

"Html.default" <- function(x, ...) as.character(x)

"Html.integer" <- "Html.numeric" <- function(x, ...) paste(format(x), collapse = ", ")


"HtmlTree" <- function(tagName, ...) {  
  UseMethod("HtmlTree") 
}

"H" <- HtmlTree

"HtmlTree.HtmlTree" <- function(tagName, ..., standaloneTag = FALSE, collapseContents = TRUE) tagName

"jsQuote" <- function(string) {
  # uses code from shQuote
  # wraps strings in quotes, with priority to single quotes
  # cat(jsQuote("asdf")) -> 'asdf'
  # cat(jsQuote('asdf')) -> 'asdf'
  # cat(jsQuote('alert("hello")')) #-> 'alert("hello")'
  # cat(jsQuote("alert('hello')")) #-> "alert('hello')"
  # cat(jsQuote("alert(\"he\'l'lo\")")) #-> 'alert("he\'l\'lo")'
  has_single_quote <- grep("'", string)
  if (!length(has_single_quote)) 
    return(paste("'", string, "'", sep = ""))
  has_double_quote <- grep('"', string)
  if (!length(has_double_quote)) 
    return(paste('"', string, '"', sep = ""))
  # default - single-quote emphasis
  paste("'", gsub("'", "\\\\\'", string), "'", sep = "")
}

"HTMLargs" <- function(x) {
  # returns a string with the arguments as a="arg1", b="arg2", and so on
  names <- names(x)
  if (length(x) > 0) str <- " " else str <- ""
  for (i in seq(along = x))
    str <- paste(str, names[i], "=", jsQuote(x[[i]]), " ", sep = "")
}

"print.HtmlTree" <- function(x, file = "", ...)
  cat(file=file, x, "\n")

"HtmlTree.default" <- function(tagName, ..., standaloneTag = FALSE, collapseContents = TRUE) {
  # named arguments are attributes; unnamed are content
  args <- list(...)
  methodsOfHtml <- setdiff(c(gsub("^Html.","",(methods("Html"))), "HtmlTree"), "character")
  # if we can apply "html" to tagName, and it's by itself, do it (for non-character classes)
  if (length(args) == 0 && !is.character(tagName) && class(tagName) %in% methodsOfHtml)
    return(Html(tagName))
  if (length(names(args)) > 0) {
    tagContents <- args[names(args) == ""]    # unnamed arguments
    tagAttributes <- args[names(args) != ""]  # named arguments
  } else {
    tagContents <- args
    tagAttributes <- NULL
  }
  pasteList <- function(x) {
    str <- ""
    for (i in seq(along=x)) {
        str <- paste(str, Html(x[[i]]), sep = " ")
    }
    str
  }
  if (is.null(tagName)) {
    startTag <- ""
    contents <- pasteList(tagContents)
    endTag <- ""
  } else if (standaloneTag) {
    startTag <- paste("<", tagName, HTMLargs(tagAttributes), "/>", sep = "")
    contents <- ""
    endTag <- ""
  } else { # default case:
    startTag <- paste("<", tagName, HTMLargs(tagAttributes), ">", sep = "")
    contents <- paste(" ",pasteList(tagContents), "")
    endTag <- paste("</", tagName, ">", sep = "")
  }
  str <- paste(startTag, contents, endTag,
               sep = "", collapse = if (collapseContents) "" else NULL)
  class(str) <- "HtmlTree"
  str
}

"Html.data.frame" <- "Html.matrix" <- function(x, ...) {
## 
## Make an HtmlTree out of a data frame.
## First "format" then convert to a matrix.
## "..." arguments are passed directly to format.
## 
  
  x.formatted <- as.matrix(format(x, ...))
  x.formatted[is.na(x) | is.nan(x)] <- " "
  x.formatted[grep("^ *(NA|NaN) *$", x.formatted)] <- " "

  H("div", class = "RpadTableHolder",
    H("table",
      H("tbody",
        H("tr",                           # HEADER ROW
          H("th", 
            H("div", class = "tableheaderrow", 
              colnames(x), collapseContents = FALSE))), # collapseContents keeps the <th><div></div></th><th><div></div></th> nested pair
        H(NULL, # NULL groups consecutive tags together
          apply(x.formatted, MARGIN = 1,    # MAIN BODY - sweep the rows
            FUN = function (x)
              H("tr", 
                H("td", x)))))))
}


"asFilteringTable" <- function(x, ...) {
## 
## The Dojo filtering table has a bit different layout
## than the default for HtmlTree.data.frame, so
## we'll just rewrite it.
## I've left out styling. Do that in CSS.
## It still needs some more smarts to tag column headers with the appropriate sort type.
  x.formatted <- as.matrix(format(x, ...))
  x.formatted[is.na(x) | is.nan(x)] <- " "
  x.formatted[grep("^ *(NA|NaN) *$", x.formatted)] <- " "
  mapColumnType <- function(x) {
    jsMapping <- c(Date = "Date", POSIXct = "Date", numeric = "Number",
                   factor = "String", character = "String")
    rowClass <- sapply(x, class)
    jsClass <- jsMapping[rowClass]
    jsClass[is.na(jsClass)] <- "String"
    names(jsClass) <- NULL
    jsClass
  }
  H("table", dojoType="filteringTable", class="filteringtable", enableAlternateRows="true",
    H("thead",
      H("tr",                             # HEADER ROW
        H("th", dataType = mapColumnType(x),
                field = gsub("\\.", "_", names(x)), # get rid of "." - causes col's to disappear
          names(x)))),
    H("tbody",
      H("tr", value = 1:NROW(x.formatted),
        apply(x.formatted, MARGIN = 1,    # MAIN BODY - sweep the rows
          FUN = function (x, idx)
            H("td", x)))))
}

# broken:
#"HtmlTree.list" <- "Html.list" <- function (x, first = TRUE, ...) {
#  res = rep(H("dum"), length = 2*length(x))
#  res[seq(1, 2*length(x), by = 2)] = H(NULL, names(x), collapseContents = FALSE)
#  res[seq(2, 2*length(x), by = 2)] = sapply(x, FUN = function(x)
#       H("ul",
#         Html(x, first = FALSE)))
#  if (first)  # IE needs contenteditable off
#    H("div", contentEditable='false',
#      H("ul",
#        H("li",
#          H(NULL, res))))
#  else
#    H("li",
#      H(NULL, res))
#}

"HTMLbutton" <- function(label = "Calculate", js = "rpad.calculatePage()", ...) 
  # Other useful js parameters:
  #   js = "rpad.calculateNext(this)"  # calculate the next Rpad block
  #   js = "rpad.send('put commands here')"
  H("input", onclick = paste("javascript:", js, sep=""),
          value = label, type = "button", ...)

"HTMLradio" <- function(variableName, commonName = "radio", text = "", ...) 
  # outputs an HTML radio button wrapped in a contentEditable=false 
  H("span", contentEditable="false",
    H("input", type = 'radio', name = commonName, value = variableName, id = variableName, ...),
    H("label", "for" = variableName,
      text))

"HTMLcheckbox" <- function(name, text = "", ...)
  H("span", contentEditable="false",
    H("input", type = 'checkbox', name = name, id = name, ...),
    H("label", "for" = name,
      text))

"HTMLinput" <- function(name, value = "", rpadType = "Rvariable", contenteditablewrapper = TRUE, ...) {
  res <- H("input", name = name, value = value, rpadType = rpadType, standaloneTag = TRUE, ...)
  if (contenteditablewrapper)
    H("span", contentEditable = "false", 
      res)
  else
    res
}

"HTMLselect" <- function(name, text, default=1, size=1, id=name, contenteditablewrapper=TRUE,
                         optionvalue=text, ...) {
# generate a select box

  options =
    H("option", value = optionvalue,
      text, collapseContents = FALSE)
  
  if (default > 1 & default <= length(text)) 
    options[default] =
      H("option", value = optionvalue[default], selected = "selected",
        text[default])

  res =
    H("select", name = name, size = size, id = id, ...,
      H(NULL, options))

  if (contenteditablewrapper)
    H("span", contentEditable = "false",
      res)
  else
    res
}

"HTMLlink" <- function(url, text, ...) 
  H("span", contentEditable="false",
    H("a", href = url, ...,
      text))

"HTMLimg" <- function(filename = RpadPlotName(), ...) 
  H("img", src = RpadURL(filename), ...)

"HTMLembed" <- function(filename, width = 600, height = 600, ...) 
  H("embed", src = filename, width = width, height = height, ...)

"HTMLjs" <- function(js)
  # Runs a javascript snippet. HTML must be enabled.
  # doesn't work because scripts won't get executed when inserted via innerHTML
  H("script", type="text/javascript",
    js)

"HTMLjs" <- function(js)
  # Runs a javascript snippet by attaching it to an error handler for an image.
  # HTML must be enabled.
  # see also: # http://24ways.org/advent/have-your-dom-and-script-it-too
  #   <img src="g.gif?randomnum" alt="" 
  #        onload="alert('Now that I have your attention...');this.parentNode.removeChild(this);" />
  H("img", src = "", alt = "", style = "display:none",
    onerror = paste(js, ";this.parentNode.removeChild(this);"))

"HTMLSetInnerHtml" <- function(id, html) 
  # Sets the innerHTML of the element "id" to "html".
  # Runs a bit of javascript to do it. HTML must be enabled.
  # It's probably better to do this sort of thing on the javascript side.
  HTMLjs(paste("dojo.byId('", id, "').innerHTML = '", html, "'", sep=""))

"BR" = H("br", standaloneTag = TRUE) # <br/>

"HTMLh1" <- function(text) {
  H("h1", text)
}
"HTMLh2" <- function(text) {
  H("h2", text)
}
"HTMLh3" <- function(text) {
  H("h3", text)
}
"HTMLh4" <- function(text) {
  H("h4", text)
}
"HTMLh5" <- function(text) {
  H("h5", text)
}

"HTMLon" <- function()
  H("htmlon", standaloneTag = TRUE)

"HTMLoff" <- function()
  H("htmloff", standaloneTag = TRUE)

"ROutputFormat" <- function(Format)
  options(R.output.format = Format)

"HTMLtag" <- function(tagName, ...) {
  # outputs the given HTML tagName with arguments supplied in ...
  str <- paste("<", tagName, HTMLargs(list(...)), ">", sep = "", collapse = "")
  class(str) <- "HtmlTree"
  str
}

"HTMLetag" <- function(tagName) {
  str <- paste("</", tagName, ">\n", sep = "")
  class(str) <- "HtmlTree"
  str
}

"print.condition" <- function (x, ...) {
	# redefine this to get rid of the <> brackets around error messages

	msg <- conditionMessage(x)
    call <- conditionCall(x)
    cl <- class(x)[1]
    if (!is.null(call)) {
        cat("** ", cl, " in ", deparse(call), ": ", msg, " **\n", sep = "")
    } else {
		cat("** ", cl, ": ", msg, " **\n", sep = "")
	}
}

"HfromHTML" <- function(x) {
  if(require("R2HTML")) {
    res <- capture.output({HTML(x);cat("\n")}) # the \n makes sure to get a complete line
    class(res) <- "HtmlTree"
    res
  } else {
    Html(x)
  }
}
                     
"dojoTree" <- function(x, first = TRUE, ...) {
  x <- as.list(x)
  res <- sapply(seq(len = length(x)), 
    function(i)
      H("div", dojoType="TreeNodeV3", ..., 
        title = names(x)[i],
        if (is.list(x[[i]]) && !(any(class(x[[i]]) %in% gsub("^Html.","",methods(Html)))))
          dojoTree(x[[i]], first = FALSE)
        else
          H("div", dojoType="TreeNodeV3", title = Html(x[[i]]))))
  res <- paste(res, collapse="") # combine the list elements
  if (first) {
    H(NULL,
      H("div", dojoType = "TreeBasicControllerV3", widgetId="controller"),
      H("div", dojoType="TreeV3", listeners="controller",
        res))
   } else {
     res
   }
}

## ##tests for dojoTree
## x = list(a = 1:2, 44, b = list(a = 3:4, b = 6:5), c = data.frame(a=1:5, b = 11:15))
## HTMLon()
## H("p", "A simple tree:")
## dojoTree(x)
## H("p", "An expanded version:")
## dojoTree(x, expandLevel = 2)
## H("p", "A bigger tree:")
## dojoTree(as.list(lm(1:10 ~ rnorm(10))))
#line 1 "/private/tmp/RtmpGqQCVl/R.INSTALL10d63af1/Rpad/R/LocalVersion.R"

# Rpad utility functions for running Rpad locally.
# Here we use a local Tcl httpd server to receive Rpad commands.

"processRpadCommands" <-
function() {
  require("tcltk")
  commands <- tclvalue(.Tcl("set user(R_commands)"))
  textcommands <- textConnection(commands)
  .dev.active <- dev.cur()
  if (exists("RpadPlotParams", envir = .RpadEnv))
    dev.set( get("RpadPlotParams", envir = .RpadEnv)$dev )

  results <- tryCatch({
    tc <- textConnection("textfromconnection",open="w")
    sink(file=tc)
    guiSource(textcommands)
    sink()
    close(tc)
    textfromconnection
  }, error=function(e) {
    sink()
    close(tc)
    cat('ERROR1: ')
    paste(paste(textfromconnection, "\n", collapse=""), '\n', e)},
                      finally=close(textcommands))
  dev.set(.dev.active)
  formattedresults <- paste(results,"\n",sep="",collapse="")
#  cat(formattedresults)
  escapeBrackets <- function(x) gsub("(\\{|\\})", "\\\\\\1", x)
  .Tcl(paste("set RpadTclResults {", escapeBrackets(formattedresults), "}", sep=""))
}


"Rpad" <-
function(file = "", defaultfile = "LocalDefault.Rpad", port = 8079) {
    startRpadServer(defaultfile, port)
    browseURL(paste("http://127.0.0.1:", port, "/", file, sep = ""))
}

"startRpadServer" <-
function(defaultfile = "LocalDefault.Rpad", port = 8079) {
    require("tcltk")
    # This is the main function that starts the server
	# This function implements a basic http server on 'port'
 	# The server is written in Tcl.
    # This way it is not blocking the R command-line!

    if (!require("tcltk")) stop("package tcltk required for the local Rpad http server")
    assign("RpadLocal", TRUE, envir = .RpadEnv)
    assign("RpadDir",   ".",  envir = .RpadEnv)
    assign("RpadPort",  port, envir = .RpadEnv)
    graphoptions(type = "Rpng")
    tclfile <- file.path(.find.package(package = "Rpad"), "tcl", "mini1.1.tcl")
    htmlroot <- file.path(.find.package(package = "Rpad"), "basehtml")
    tcl("source", tclfile)
    tcl("Httpd_Server", htmlroot, port, defaultfile)
    unlink(dir(pattern="Rpad_plot.*\\.png")) # delete the Rpad graphics files in the dir
    unlink(dir(pattern="Rpad_plot.*\\.eps"))
    if(interactive() && .Device == "null device") x11() # turn on the interactive plotting device so as not to confuse the command-line user if they later plot
    dev <- dev.cur() 
    newgraph()
    dev.set(dev) # switch back to the existing device to not confuse the user
    return(TRUE)
}

"stopRpadServer" <-
function() {
    require("tcltk")
    assign("RpadLocal",    FALSE, envir = .RpadEnv)
    unlink(dir(pattern="Rpad_plot.*\\.png")) # delete the Rpad graphics files in the dir
    unlink(dir(pattern="Rpad_plot.*\\.eps"))
    .Tcl("close $Httpd(listen)")
    .Tcl("unset Httpd")
}

"restartRpadServer" <-
function() {
  stopRpadServer()
  startRpadServer()
}


#line 1 "/private/tmp/RtmpGqQCVl/R.INSTALL10d63af1/Rpad/R/Rpad-internal.R"
.RpadEnv <- new.env()

".onLoad" <-
function(lib, pkg) {
    require("graphics")
    require("utils")
    isR2HMTLAvailable <- length(.find.package("R2HTML", quiet = TRUE)) != 0
    if (isR2HMTLAvailable) { 
      options(R2HTML.sortableDF = TRUE)
      options(R2HTML.format.digits = 3)
      options(R2HTML.format.nsmall = 0)
      options(R2HTML.format.big.mark = "")
      options(R2HTML.format.big.interval = 3)
      options(R2HTML.format.decimal.mark = Sys.localeconv()[["decimal_point"]])
      .HTML.file <<- ""
    }
    # The following uses the environment variable DOCUMENT_ROOT with apache to find
	# the directory of the R process. Change may be required for another server.
	if (Sys.getenv("DOCUMENT_ROOT") != "") { # works for Apache 1.3 linux & win
		RpadDir <- gsub(Sys.getenv("DOCUMENT_ROOT"), "",
                        getwd(),  ignore.case = TRUE) # strip off the document root
	} else if (Sys.getenv("SCRIPT_NAME") != "") { # for Apache 2.0
        RpadDir <- paste(gsub("R_process.pl", "", Sys.getenv("SCRIPT_NAME"), ignore.case = TRUE),
                         gsub(".*/", "", getwd()),
                         sep="")
	} else if (Sys.getenv("PATH_INFO") != "") { # for microsoft IIS
        RpadDir <- paste(gsub("R_process.pl", "", Sys.getenv("PATH_INFO"), ignore.case = TRUE),
                         gsub(".*/", "", getwd()),
                         sep="")
	} else {
		.rootdir = ifelse(.Platform$OS.type == "windows", "C:/www", "/var/www")
		RpadDir <- gsub(.rootdir, "", getwd(),  ignore.case = TRUE)
	}

	options(R.output.format = "text") # do we need or want this anymore? If we do, why don't we put it in .RpadEnv?

    
	assign(".RpadGraphOptions",
           list(type = "pngalpha", extension = "png",
                res = 120, width = 0, height = 0, deviceUsesPixels = TRUE, pointsize = 10,
                sublines = 0, toplines = .6, ratio = 4/3, leftlines = 0, lwd = 0.6),
           envir = .RpadEnv)
    assign("RpadLocal", FALSE, envir = .RpadEnv)
    assign("RpadDir", RpadDir, envir = .RpadEnv)
    assign("Rpad.plot.counter",  0, envir = .RpadEnv)
}

".onUnload" <-
function(libpath) {
 	if (interactive()) stopRpadServer()
}

".packageName" <- "Rpad"
#line 1 "/private/tmp/RtmpGqQCVl/R.INSTALL10d63af1/Rpad/R/Util.R"




# Rpad utility functions.

"guiSource" <-
function (file, out.form = getOption("R.output.format"), local = FALSE,
          echo = verbose, print.eval = TRUE,
          verbose = getOption("verbose"), prompt.echo = getOption("prompt"),
          max.deparse.length = 150, chdir = FALSE)
{
    eval.with.vis <- function(expr, envir = parent.frame(), enclos = if (is.list(envir) ||
        is.pairlist(envir))
        parent.frame()) .Internal(eval.with.vis(expr, envir,
        enclos))
    envir <- if (local)
        parent.frame()
    else .GlobalEnv
    if (!missing(echo)) {
        if (!is.logical(echo))
            stop("echo must be logical")
        if (!echo && verbose) {
            warning(paste("verbose is TRUE, echo not; ... coercing",
                sQuote("echo <- TRUE")))
            echo <- TRUE
        }
    }
    if (verbose) {
        cat(sQuote("envir"), "chosen:")
        print(envir)
    }
    Ne <- length(exprs <- parse(n = -1, file = file))
    if (verbose)
        cat("--> parsed", Ne, "expressions; now eval(.)ing them:\n")
    if (Ne == 0)
        return(invisible())
    if (chdir && (path <- dirname(file)) != ".") {
        owd <- getwd()
        on.exit(setwd(owd))
        setwd(path)
    }
    if (echo) {
        sd <- "\""
        nos <- "[^\"]*"
        oddsd <- paste("^", nos, sd, "(", nos, sd, nos, sd, ")*",
            nos, "$", sep = "")
    }
    for (i in 1:Ne) {
        if (verbose)
            cat("\n>>>> eval(expression_nr.", i, ")\n\t\t =================\n")
        ei <- exprs[i]
        if (echo) {
            dep <- substr(paste(deparse(ei), collapse = "\n"),
                12, 1e+06)
            nd <- nchar(dep) - 1
            do.trunc <- nd > max.deparse.length
            dep <- substr(dep, 1, if (do.trunc)
                max.deparse.length
            else nd)
            cat("\n", prompt.echo, dep, if (do.trunc)
                paste(if (length(grep(sd, dep)) && length(grep(oddsd,
                  dep)))
                  " ...\" ..."
                else " ....", "[TRUNCATED] "), "\n", sep = "")
        }
        yy <- eval.with.vis(ei, envir)
        i.symbol <- mode(ei[[1]]) == "name"
        if (!i.symbol) {
            curr.fun <- ei[[1]][[1]]
            if (verbose) {
                cat("curr.fun:")
                str(curr.fun)
            }
        }
        if (verbose >= 2) {
            cat(".... mode(ei[[1]])=", mode(ei[[1]]), "; paste(curr.fun)=")
            str(paste(curr.fun))
        }
        if ( yy$visible ) {
          printoutput = capture.output(print(yy$value)) # always print, even if not shown for side effects
          if (out.form == "html" && exists("HTML"))
              HTML(yy$value)
          else if (out.form != "none")
              cat(paste(printoutput,collapse="\n"),"\n")
        }
        if (verbose)
          cat(" .. after ", sQuote(deparse(ei)), "\n", sep = "")
    }
    invisible(yy)
}


"RpadURL" <- function(filename = "") {
  # returns the URL for the given filename
  #   "./filename" for the local version
  #   "/Rpad/server/dd????????/filename" for the server version
  # use this to output HTML links for the user
  paste(get("RpadDir", envir = .RpadEnv), "/", filename, sep="")
}

"RpadBaseURL" <- function(filename = "") {
  # returns the base URL
  #   "filename" for the local version
  #   "/Rpad/filename" for the server version
  # use this to read in data files or save data files somewhere permanent
  if ( RpadIsLocal() )
    filename
  else
    paste("../../", filename, sep="")
}

"RpadBaseFile" <- function(filename = "") {
  # returns the file name relative to the base R directory
  #   "filename" for the local version
  #   "../../filename" for the server version
  # use this to read in data files or save data files somewhere permanent
  if ( RpadIsLocal() )
    paste("./", filename, sep="")
  else
    paste("../../", filename, sep="")
}

"RpadIsLocal" <- function() 
  get("RpadLocal", envir = .RpadEnv)    

#line 1 "/private/tmp/RtmpGqQCVl/R.INSTALL10d63af1/Rpad/R/json.R"
json <- function (x, ...) 
  UseMethod("json")

json.list <- function(x, ...) {
  res <- array("", length(x))
  for (i in seq(len=length(x)))
    res[i] <- json(x[[i]])
  nms <- names(x)
  if (is.null(nms)) nms = seq(from = 0, len = length(x))
  idx <- which(nms == "")
  nms[idx] <- seq(from = 0, along = idx)
  result <- paste('{', paste('"', nms, '":', res, collapse = ',', sep = ''), '}', sep = '')
  class(result) <- "json"
  result
}

json.numeric <- function(x, ...) {
  if (!is.null(names(x)))
    result <- paste('{',
                    paste('"', names(x), '":', ifelse(is.na(x), 'NaN', x), sep = '', collapse = ','),
                 '}', sep = '')
  else if (length(x) > 1)
    result <- paste('[', paste(ifelse(is.na(x), 'NaN', x), collapse = ',' ), ']', sep = '')
  else
    result <- paste(ifelse(is.na(x), 'NaN', x))
  class(result) <- "json"
  result
}

json.logical <- function(x, ...) {
  if (!is.null(names(x)))
    result <- paste('{',
                 paste('"', names(x), '" : ', ifelse(x, 'true', 'false'), sep = '', collapse = ','),
                 '}', sep = '')
  else if (length(x) > 1)
    result <- paste('[', paste(ifelse(x, 'true', 'false'), collapse = ',' ), ']', sep = '')
  else
    result <- paste(ifelse(x, 'true', 'false'))
  class(result) <- "json"
  result
}

escapeStrings <- function(s) {
  s <- gsub('/', '\\\\/', s)
  s <- gsub('"', '\\\\"', s)
  s <- gsub('\\\\', '\\\\', s)
  s <- gsub('\b', '\\\\b', s)
  s <- gsub('\f', '\\\\f', s)
  s <- gsub('\n', '\\\\n', s)
  s <- gsub('\r', '\\\\r', s)
  s <- gsub('\t', '\\\\t', s)
  s
}

json.character <- function(x, ...) {
  if (!is.null(names(x)))
    result <- paste('{',
                 paste('"', names(x), '" : "', escapeStrings(x), '"', sep = '', collapse = ','),
                 '}', sep = '')
  else if (length(x) > 1)
    result <- paste('[', paste('"', escapeStrings(x), '"', collapse = ',', sep = ''), ']', sep = '')
  else
    result <- paste('"', escapeStrings(x), '"', sep = '')
  class(result) <- "json"
  result
}

json.default <- function(x, ...) {
  if (is.list(x))
    result <- json.list(x)
  else if (is.numeric(x))
    result <- json.numeric(x)
  else if (is.character(x))
    result <- json.character(x)
  else if (!is.null(names(x)))
    result <- paste('{',
                    paste('"', names(x), '" : "', escapeStrings(as.character(x)), '"', sep = '', collapse = ','),
                    '}', sep = '')
  else if (length(x) > 1)
    result <- paste('[', paste('"', escapeStrings(as.character(x)), '"', collapse = ',', sep=''), ']', sep = '')
  else
    result <- paste('"', escapeStrings(as.character(x)), '"', sep = '')
  class(result) <- "json"
  result
}

json.NULL <- function(x, ...) {
  result <- "null"
  class(result) <- "json"
  result
}

json.data.frame <- json.list
print.json <- function(x, ...) cat(x, '\n')

# This complicated regex:
# cat(gsub('((?:"[^"]*"|[^"{])*){','\\1list(', '{"a":"sdf{asdf", "b": 2}'  , perl=T) , "\n")
# from: http://regexadvice.com/forums/thread/23957.aspx
# could be used to convert json back to R
#
