# This is an example of using RGtk to create a simple command-line
# interface for R. This has a value in addition to being a simple
# example of RGtk. We can use it (or something similar) to conveniently
# provide a command line interface when R is embedded in another application
# which does not provide access to executing R commands directly by the user.
# For example, when running Gnumeric, or R inside GGobi (as opposed to
# using the Rggobi package), one often wants to be able to debug code,
# or simply interact with the interpreter directly.

#
# If help() had been written with a separation of a) find the contents
# b) show the contents, we would be able to trap calls to help from the menu
# and display them using gtkhtml. Then we would be able to do some interesting
# things such as i) handle links in special ways e.g. for running code examples
# ii) embedding elements in the HTML such as devices, etc.
# iii) we can use HTML forms, etc.

# This gives a local version of what we have in the SNetscape package
# only here we don't need the browser, JavaScript, JNI/JRI, etc.
# Obviously we give up the ``browser'' interface.  

# We can experiment with the filtering ideas that are in Omegahat and
# TILE that allow us to keep a live transcript of the session in HTML
# with links, etc. to previous commands.  We can use the RSXMLObjects
# to serialize the expressions to HTML and the output.  We can even
# convert the S objects to XML and then use XSLT to generate the HTML
# and then append it to the HTML widget.  #


# This is also in RGtkViewers and should eventually move to
# RGtkUtils. Especially if we split RGtk into different packages.
library(RGtkViewers)

commandLine <-
function()
{
 win <- NULL
 historyWindow <- NULL
 libraryWindow <- NULL 
 ctr <- 1
 commands <- character(0)
 output <- NULL
 mbar <- NULL
 
 create <- function() {
  if(!is.null(win)) {
    win$Show()
    return(win)
  }

  top <- gtkWindow(show=FALSE)

  topBox <- gtkVBox(FALSE, 5)

  mbar <<- gtkMenuBar()

   # The File menu  
  item <- gtkMenuItem("File")
  item$SetSubmenu(createSimpleMenu(c("Open...",
                                     "Source...",
                                     "Library ...",
                                     "",
                                     "Save",
                                     "Save As...",
                                     "",
                                     "Close",
                                     "Quit"), fileMenuHandler)$menu)
  mbar$Append(item)

   # The Tools menu
  item <- gtkMenuItem("Tools")
  item$SetSubmenu(createSimpleMenu(list("History",
                                        "Library",
                                        "Devices"=c("New Device",
                                                    "Close Current Device",
                                                    "Close All Devices",
                                                    "Devices")),
                                   toolMenuHandler)$menu)
  mbar$Append(item)

    # The Settings menu
  item <- gtkMenuItem("Settings")  
  item$SetSubmenu(createSimpleMenu("Preferences", preferencesDialog)$menu)
  mbar$Append(item)

    # The Help menu
  item <- gtkMenuItem("Help")
  demoNames <- demo()$results[,"Item"]
  item$SetSubmenu(createSimpleMenu(
                     list("HTML Index",
                          "Text Index",
                          "",
                          "License",
                          "Contributors",
                          "",                          
                          Demos=demoNames,
                          "",                          
                          "About"), helpMenuHandler)$menu)
  mbar$Append(item)    



  topBox$PackStart(mbar, expand = FALSE)
  
  pane <- gtkHPaned()
  cmdBox <- gtkVBox(FALSE, 5)
  input <- gtkTextNew()
  input$SetEditable(TRUE)
  cmdBox$PackStart(input, fill = TRUE, expand = TRUE)

input$Insert(chars="1:10\n", length =-1)
  
  bbox <- gtkHBox(TRUE, 4)
  btn <- gtkButton("Evaluate")
  btn$AddCallback("clicked", function(obj) {
                  txt <- input$GetChars(0,-1)
                  txt <- gsub("(.*)\\\n$", "\\1", txt)
                  if(evalCommand(txt))
                    input$DeleteText(0, -1)                 
                 })
  bbox$PackStart(btn, fill = FALSE)

  btn <- gtkButton("Help")
  bbox$PackStart(btn, fill = FALSE)  

  cmdBox$PackStart(bbox, expand = FALSE)
  pane$Add(cmdBox)

  output <<- gtkTextNew()
  pane$Add(output)  
  topBox$PackStart(pane)
  top$Add(topBox)

  win <<- top
  win$Show()
 }

 fileMenuHandler <- function(w, cmd) {
    if(cmd == "Quit") {
      win$Destroy()
      win <<- NULL
    } else if(cmd == "Close") {
      win$Hide()
    } else if(cmd == "Save") {
       save.image()
    } else if(cmd == "Save As...") {
       dlg <- gtkFileSelection("Save session")
       dlg[["CancelButton"]]$AddCallback("clicked", function(w) { dlg$Hide() ; dlg$Destroy()})
       dlg[["OkButton"]]$AddCallback("clicked",
                                     function(w) {
                                       f <- dlg$GetFilename()
                                       if(nchar(f))
                                         save.image(f)
                                       dlg$Destroy()
                                     })       
       dlg$Show()
    }  else if(cmd == "Source..." || cmd == "Open...") {
      dlg <- gtkFileSelection("Source")
      dlg[["CancelButton"]]$AddCallback("clicked", function(w) dlg$Destroy(dlg))    
      dlg[["OkButton"]]$AddCallback("clicked",
                                     function(w) {
                                       f <- dlg$GetFilename()
                                       if(nchar(f)) {
                                         if(cmd == "Source...")
                                           source(f)
                                         else {
                                           cat("Loading image from",f,"\n")
#xxx                                       # This causes problems .....
                                           load(f)
                                         }
                                       }
                                       dlg$Destroy()
                                     })
      dlg$Show()
    }
  }

  toolMenuHandler <- function(w, cmd) {
   if(cmd == "New Device") {
        get(options()$device)()
   } else if(cmd == "Close Current Device") {
          dev.off()
   } else if(cmd == "Close All Devices") {
          graphics.off()
   } else if(cmd == "History") {
      if(is.null(historyWindow)) {
         historyWindow <<- showHistory(commands)
         historyWindow$l$AddCallback("select-child", function(l, kid) {
                                             kid <- gtkChildren(kid)[[1]]
                                             evalCommand(kid$GetArgs("label"))
                                         })
      }
      
      historyWindow$win$Show()      
    } else if(cmd == "Library") {
      if(is.null(libraryWindow)) {
       libraryWindow <<- showSearchPath()
       libraryWindow$win$AddCallback("delete_event", function(w, ev) {
                                        libraryWindow <<- NULL
                                      })
     }
     libraryWindow$win$Show(TRUE)
    }
  }

 evalCommand <- function(txt) {
         if(nchar(txt) == 0)
           return(FALSE)
         e <- parse(text = txt)
         val <- eval(e, env = globalenv())
         out <- paste(paste("<",ctr,">", txt,"\n", sep=""),
                      paste(as.character(val), sep="", collapse=" "),
                      "\n", collapse="", sep="")
         output$Insert(chars = out, length = -1)
         ctr <<- ctr + 1
         addToHistory(txt)
         return(TRUE)
   }

 addToHistory <- function(cmd) {
    commands <<- c(commands, cmd)
    if(!is.null(historyWindow)) {
      historyWindow$l$Add(gtkListItem(cmd))
    }
    return(length(commands))
 }

 about <-
   function() {
    cat("The R splash screen!\n")
   }
 
 helpMenuHandler <-
   function(w, cmd) {
     f <- switch(cmd, "HTML Index"= help.start,
                      "Text Index" = help,
                      License = "license",
                      Contributors = "contributors",
                      About = about,
                      NULL
                     )
     if(!is.null(f)) {
       if(is.function(f))
          f()
       else if(is.character(f)) {
         eval(substitute(help(topic), list(topic=f)))
       }
     } else {
       demo(cmd, character.only = TRUE)
     }
   }


 
 list(create=create,
#      addTool = addTool,
      menuBar = function() {mbar},
      outputArea = function() output,
      historyWindow = function() historyWindow,
      libraryWindow = function() libraryWindow
     )
}  

showHistory <-
function(cmds)
{
   vbox <- gtkVBox(FALSE, 1)  
   historyWin <- gtkWindow(show = FALSE)
   mbar <- createMenuBar("File"= c(Clear=0, Load=2, Save=2, Close=1, Quit=2),
                         "Load"= c(ok=1))$bar

   vbox$PackStart(mbar, expand = FALSE)

   l <- gtkList()
   for(i in cmds) {
     print(i)
     item <- gtkListItem(i)
     l$Add(item)
   }

   sw <- gtkScrolledWindow()
   sw$AddWithViewport(l)

   vbox$PackEnd(sw)
   
   historyWin$Add(vbox)
   historyWin$Show()

   invisible(list(win=historyWin,l = l))
}



showSearchPath <-
function(path = search(), createPage = showTable)
{
 win <- NULL
 win <- gtkWindow(show = FALSE)

 box <- gtkVBox(FALSE, 10)

 box$PackStart(createMenuBar(File=c(Close=function(w){
                                           win$Destroy()
                                          }))$bar, expand = FALSE)
 
 pkgs <- sort(.packages(all.available = TRUE))

 sw <- gtkScrolledWindow()
 l <- gtkList()
 for(i in pkgs) {
    l$Add(gtkListItem(i))
 }
 l$AddCallback("select-child", function(l, kid) {
                                pkg <- gtkChildren(kid)[[1]]$GetArg("label")
                                print(pkg)
                                library(pkg, character.only = TRUE)
                               })

 sw$AddWithViewport(l)
 
 book <- gtkNotebook()
 for(i in path) {
   w <- createPage(i)
   book$AppendPage(w, gtkLabel(i))
 }

 pane <- gtkHPaned()
 pane$Add(sw) 
 pane$Add(book)
 box$PackStart(pane)
 win$Add(box)
 list(win = win, l = l)
}  

showTable <-
function(name)
{
  els <- objects(all = T, pos = name)
  els <- els[1:(min(10, length(els)))]
  l <- gtkList()
  sw <- gtkScrolledWindow()  
  for(i in els) {
    l$Add(gtkListItem(i))
  }
  sw$AddWithViewport(l)
  return(sw)
}


appearanceFrame <-
function(els, name=NULL, callbacks = NULL, frame)
{

  fontHandler <-
    function(w, cbdata) {
      cat("fontHandler\n")
      dlg <- gtkFontSelectionDialog("Font selection")
      dlg[["OkButton"]]$AddCallback("clicked",
                                     function(w, data) {
                                        data[[1]](dlg)
                                        dlg$Destroy()
                                     })
      dlg[["CancelButton"]]$AddCallback("clicked", function(w) dlg$Destroy())     
      dlg$Show()
    }

  colorHandler <-
    function(w, cbdata) {
      dlg <- gtkColorSelectionDialog("Color selection")
      dlg[["OkButton"]]$AddCallback("clicked",
                                     function(w, data) {
                                        data[[1]](dlg)
                                        dlg$Destroy()
                                     })
      dlg[["CancelButton"]]$AddCallback("clicked", function(w) dlg$Destroy())     

      dlg$Show()
    }
  
  
  f <- gtkFrame(frame)
  bbox <- gtkVBox(TRUE, 3)
  for(i in names(els)) {
   box <- gtkHBox(TRUE, 3)   
   box$PackStart(gtkLabel(i))
   type <- ifelse(els[i],"font","color")
   btn <- gtkButton(type)
   box$PackEnd(btn, expand = FALSE, fill = FALSE)
   if(!is.null(callbacks)) {
    if(els[i])
     fun <- fontHandler
    else
     fun <- colorHandler
    btn$AddCallback("clicked", fun, data= list(callbacks[type], name))
   }

   bbox$PackStart(box)
  }

  f$Add(bbox)

  f
}

preferencesDialog <-
function(w = NULL, cmd)
{
 dlg <- gtkDialog(show = FALSE)
 book <- gtkNotebook()
  
  book$AppendPage(appearanceFrame(c("Font"=TRUE,
                                    "Output text color" = FALSE,
                                    "Input text color" = FALSE,
                                    "Background color" = FALSE),
                                  frame = "Text settings",
                                  callbacks=list(color=function(dlg){print("color")},
                                                 font = function(dlg){print("font")}
                                                )),
                              gtkLabel("Console")
                     )

  box <- gtkVBox(TRUE, 8)
  box$PackStart(appearanceFrame(c(Font=TRUE, "Text color"=FALSE, "Background color"=FALSE),
                                frame = "Title text settings"))
  box$PackEnd(appearanceFrame(c("Font" = TRUE,
                              "Text color" = FALSE,
                              "Background color" = FALSE),
                              frame = "Body text settings"))

  book$AppendPage(box, gtkLabel("Pager"))

  book$AppendPage(radioFrame(c("Always restore", "Never restore"), "Restore workspace"),
                  gtkLabel("Startup"))

  book$AppendPage(radioFrame(c("Prompt", "Always save", "Never save"), "Restore workspace"),
                  gtkLabel("Exit"))

  dlg[["ActionArea"]]$Add(book)
  dlg$Show()

  dlg
}  

radioFrame <-
function(buttonNames,  title)
{
 Startup <- gtkFrame("Restore workspace")  
 box <- gtkVBox(TRUE, 10)

 group <- NULL
 for(i in buttonNames) {
   b <- gtkRadioButton(group, i)
   box$PackStart(b, expand = FALSE)
 }

 Startup$Add(box)

 Startup
}