if(!is.loaded("gtk_main"))
  library(RGtk)


# Mimicing the example from pygtk (in turn from Gtk)
#

# Added a tree example.
#  and gtkCombo
#
# status bar
#   no gtkStatusBar() function

# Complete.
# button box (ok)
# clist
# cursor
# dialog (ok)
# dnd  - functional, but not robust!
# pixmap
# range controls (ok)
# reparent (ok) (toggles between)
# scrolled windows (ok)

# The following work when R is embedded within a Gtk application,
#  e.g Gnumeric, GGobi
# but require extensions to the R event loop in the near future.

# progress bar
# tooltips
# idle & timeout
# 

testHandler <-
function(rc = NULL) {

  windows <- list()

  closeWindow <- function(which, other = NULL, ev = NULL) {
    cat("closing window", which, "\n")
    
    if(!is.na(match(which, names(windows)))) {
      win <- windows[[which]]
      win$Hide()
      win$Destroy()
      windows[[which]] <<- NULL
      return(TRUE)
    }

    return(FALSE)
  }

  
  getWindow <-
    function(name, dialog = FALSE, close=closeWindow) {
      if(!is.na(match(name, names(windows)))) {
        windows[[name]]$Show()
        return(NULL)
      } else {
        if(dialog) {
           win <- gtkDialog()
        }
        else
           win <- gtkWindow(show = FALSE)
        addWindow(win, name, close= close)
        return(win)
      }
   }

  addWindow <- function(win, name, close = closeWindow) {
    windows[[name]] <<- win

    win$SetTitle(name)
    
    gtkAddCallback(win, "delete_event", close, name, object = TRUE)
  }
 

  ######################################################

  
  buttons <- function(w) {
    if(!is.na(match("buttons", names(windows)))) {
      cat("Showing existing button window\n")
      windows[["buttons"]]$Show()
      return()
    }
    
    win <- gtkWindow()
    win$SetTitle("Buttons test")


    box1 <- gtkVBox(TRUE, 7)
    win$Add(box1)

    tbl <- gtkTable(3,3,FALSE)
    tbl$SetRowSpacings(5)
    tbl$SetColSpacings(5)
    tbl$SetBorderWidth(10)

    box1$PackStart(tbl)

    ctr <- 1
    for(i in 1:3) {
      for(j in 1:3) {
        b <- gtkButton(paste("Button", ctr))
        tbl$Attach(b, i-1, i, j-1, j)
        gtkAddCallback(b, "clicked",
                        eval(substitute(function(x) {
                                          cat("Button pressed",v,"\n")
                                        }, list(v=ctr))))
        ctr <- ctr + 1
      }
    }
    
    box1$PackStart(gtkHSeparatorNew(), expand=FALSE)

    b <- gtkButton("Close")
    b$AddCallback("clicked", function(x) closeWindow("buttons"))

    box1$PackEnd(b)
    addWindow(win, "buttons")
    win$Show()
  }

  toggleButtons <- function(w) {
   if(is.na(match("toggle", names(windows)))) {
     win <- gtkWindow(show = FALSE)
     win$SetTitle("toggle buttons")
     box <- gtkVBox(TRUE, 1)
     for(i in 1:3) {
       box$PackStart(gtkToggleButton(paste("button", i)))
     }

     box$PackStart(gtkHSeparator())
     box$PackStart(b <- gtkButton("Close"))
     b$AddCallback("clicked", function(x){ cat("Checking button status\n"); closeWindow("toggle")})
     win$Add(box)
     win$Show()
     addWindow(win, "toggle")
   } else
      windows[["toggle"]]$Show()
   
  }

   tooltips <- function(w) {
   if(is.na(match("tooltips", names(windows)))) {
     win <- gtkWindow(show = FALSE)
     win$SetTitle("Tooltips")
     box <- gtkVBox(TRUE, 1)
     tips <- gtkTooltips()

     for(i in 1:3) {
       b <- gtkToggleButton(paste("button", i))
       box$PackStart(b)
       tips$SetTip(b, paste("This is a tooltip for button",i))
     }

     box$PackStart(gtkHSeparator())
     box$PackStart(b <- gtkButton("Close"))
     tips$SetTip(b, "Close the window")
     b$AddCallback("clicked", function(x){ cat("Checking button status\n"); closeWindow("tooltips")})
     win$Add(box)
     tips$Enable()
     win$Show()
     addWindow(win, "tooltips")
   } else
      windows[["tooltips"]]$Show()
  }

  checkButtons <- function(w) {
   if(is.na(match("check", names(windows)))) {
     win <- gtkWindow(show = FALSE)
     win$SetTitle("check buttons")
     box <- gtkVBox(TRUE, 1)
     for(i in 1:3) {
       box$PackStart(gtkCheckButton(paste("button", i)))
     }

     box$PackStart(gtkHSeparator())
     box$PackStart(b <- gtkButton("Close"))
     b$AddCallback("clicked", function(x){ cat("Checking button status\n"); closeWindow("check")})
     win$Add(box)
     win$Show()
     addWindow(win, "check")
   } else
      windows[["check"]]$Show()
  }

  radioButtons <- function(w) {
   if(is.na(match("radio", names(windows)))) {
     win <- gtkWindow(show = FALSE)
     win$SetTitle("check buttons")
     box <- gtkVBox(TRUE, 1)

      # Create the first element of the group
      # ahead of time and then pass this as the first
      # argument to the constructors for the next button.
      # Note we are really calling
      #  gtkRadioButtonNewWithLabelFromWidget()
     b <- gtkRadioButton(NULL, paste("button", 1))
     box$PackStart(b)
     for(i in 2:3) {
       box$PackStart(gtkRadioButton(b, paste("button", i)))
     }

     box$PackStart(gtkHSeparator())
     box$PackStart(b <- gtkButton("Close"))
     b$AddCallback("clicked", function(x){ cat("Checking button status\n"); closeWindow("radio")})
     win$Add(box)
     win$Show()
     addWindow(win, "radio")
   } else
      windows[["radio"]]$Show()   
  }

  fileSelection <- function(w) {
   if(is.na(match("file select", names(windows)))) {
     win <- gtkFileSelection("File Selection Dialog")
     ok <- win[["OkButton"]]
     ok$AddCallback("clicked", function(x) {
                                cat("Selected",win$GetFilename(),"\n")
                                closeWindow("file select")
                               })
     ok <- win[["CancelButton"]]
     # Two ways to do this.
     #  ok$AddCallback("clicked", function(x) {
     #                                closeWindow("file select")
     #                             })
     # or, pass the name of the window as user-defined data
     # for this callback.
     ok$AddCallback("clicked", closeWindow, "file select")          

     addWindow(win, "file select")
   } else
     windows[["file select"]]$Show()
  }

  colorSelection <- function(w) {
   if(is.na(match("color select", names(windows)))) {
     win <- gtkColorSelectionDialog("Color Selection Dialog")
     addWindow(win, "color select")

      win[["CancelButton"]]$AddCallback("clicked", function(w) {
          closeWindow("color select")
       })
      win[["OkButton"]]$AddCallback("clicked", function(w) {
          closeWindow("color select")
       })               
     
   } else
     windows[["color select"]]$Show()
  }

  fontSelection <- function(w) {
   if(is.na(match("font select", names(windows)))) {
     win <- gtkFontSelectionDialog("Font Selection Dialog")
     addWindow(win, "font select")

     win[["OkButton"]]$AddCallback("clicked", function(w) {
          cat("Font name:", win$GetFontName(),"\n")
          closeWindow("font select")
       })

      win[["CancelButton"]]$AddCallback("clicked", function(w) {
          closeWindow("font select")
       })     
   } else
     windows[["font select"]]$Show()
  }  



  gammaCurve <- function(w) {
   if(is.na(match("gamma", names(windows)))) {
     win <- gtkWindow(show = FALSE)
     win$Add(gtkGammaCurveNew())
     win$Show()
     
     addWindow(win, "gamma")
   }
  }

  makeToolbar <- function(win) {
    bar <- gtkToolbar()
    buttonImages <- c("Horizontal",
                      "Vertical",
                      "Icons",
                      "Text",
                      "Both",
                      "",
                      "Small",
                      "Big",
                      "Enable",
                      "Disable"
                      )
    pix <- gtkRcLoadImage(gdkColormapGetSystem(), filename = "test.xpm")
    for(i in buttonImages) {
      if(i == "") {
        bar$AppendWidget(gtkEntry(), paste("tooltip for", i), '')        
      } else {
        tmp <- bar$AppendItem(i, paste("tooltip for", i), icon = gtkPixmap(pix))
        class(tmp) <- "GtkObject"
        class(tmp) <- gtkObjectGetClasses(tmp)
        tmp$AddCallback("clicked", function(cmd, x){
                                    switch(cmd,
                                          Icons = bar$SetStyle("icons"),
                                          Both = bar$SetStyle("both"),
                                          Text = bar$SetStyle("text"),
                                          Vertical = bar$SetOrientation("vertical"),
                                          Horizontal = bar$SetOrientation("horizontal"),
                                          Big = bar$SetSpaceSize(100),
                                          Small = bar$SetSpaceSize(15),
                                          Enable= bar$SetTooltips(TRUE),
                                          Disable= bar$SetTooltips(FALSE))
                                    print(cmd)
                                 }, data = i, object = TRUE)
     }
    }

    bar$SetStyle("both")
    bar
  }
  
  toolbar <- function(w) {
    if(is.null(win <- getWindow("toolbar")))
      return()
    
    bar <- makeToolbar(win)
    win$Add(bar)
    win$Show()
  }

  
  calendar <- function(w) {
    if(is.na(match("calendar", names(windows)))) {
       w <- gtkWindow(show=FALSE)
       w$Add(cal <- gtkCalendar())
       cal$SelectDay(14)
       w$Show()
       addWindow(w, "calendar")
     } else
         windows[["calendar"]]$Show()
  }

  List <- function(w) {
    if(is.na(match("list", names(windows)))) {
       w <- gtkWindow(show=FALSE)
       box <- gtkVBox(TRUE, 2)
       w$Add(box)
       sc <- gtkScrolledWindow()
       sc$SetPolicy("automatic", "automatic")
       l <- gtkList()

       data(eurodist)
       for(i in attr(eurodist,"Labels")) {
         item <- gtkListItem(i)
         l$Add(item)
       }
       
       sc$AddWithViewport(l)
       box$PackStart(sc, expand = TRUE)

       bbox <- gtkHBox(TRUE, 10)
       bbox$SetBorderWidth(10)
       bbox$PackStart(gtkButton("Add"), expand=FALSE)
       bbox$PackEnd(gtkButton("Remove"), expand=FALSE)
       box$PackEnd(bbox, expand = FALSE)
       
       w$Show()
       addWindow(w, "list")
     } else
         windows[["list"]]$Show()   
  }

  notebook <- function(w) {
     if(is.na(match("notebook", names(windows)))) {
       w <- gtkWindow(show=FALSE)
       w$SetTitle("Notebook")

       book <- gtkNotebook()
       book$SetTabPos("top")
       for(i in 1:5) {
         f <- gtkFrame(paste("Page",i))
         f$SetBorderWidth(10)
         f$SetUsize(200, 150)
         f$Add(gtkLabel(paste("Page",i)))
         book$AppendPage(f, gtkLabel(paste("Tab",i)))
       }
       addWindow(w, "notebook")
       w$Add(book)
       w$Show()
     } else
       windows[["notebook"]]$Show()   
  }

  entry <- function(w) {
    if(is.null(w <- getWindow("entry")))
      return()

     box <- gtkHBox(FALSE, 3)
     w$Add(box)
     box$PackStart(gtkLabel("Enter text"))
     box$PackEnd(gtkEntry())
     w$Show()
  }

  handle <- function(w)  {
    if(is.null(win <- getWindow("handle")))
      return()

    box <- gtkHandleBox()
    box$Add(makeToolbar(win))
    win$Add(box)
    win$Show()
  }

  Text <- function(w)  {
    if(is.null(win <- getWindow("text")))
      return()

    tbl <- gtkTable(2,2, FALSE)
    tbl$SetRowSpacing(0,2)
    tbl$SetColSpacing(0,2)    

    txt <- gtkText()
    txt$SetEditable(FALSE)
    if(FALSE) {
    tbl$Attach(txt, 0, 1, 0, 1)      
    hsc = gtkHScrollbar(txt$GetHAdjustment())
    table.attach(hsc, 0, 1, 1,2 )
    vsc = gtkVScrollbar(txt$GetVAdjustment())
    table.attach(vsc, 1, 2, 0, 1)
  } else {
    sc <- gtkScrolledWindow()
    sc$AddWithViewport(txt)
    tbl$Attach(sc, 0, 1, 0, 1)          
  }
    

    txt$Freeze()
    contents <- c("some text", "more text", "", "(a blank line)")
    for(i in contents) {
      chars <- paste(i, "\n")
      n <- nchar(chars)
      gtkTextInsert(txt, chars = chars, length = -1)
    }
    txt$Thaw()

    win$Add(tbl)
    
    win$Show()
  }

  combo <- function(w) {
    if(is.null(win <- getWindow("combo")))
      return()

    combo <- gtkCombo()
    data(mtcars)
    combo$SetPopdownStrings(names(mtcars))    

    gtkAddCallback(gtkComboGetList(combo), "select-child",
                     function(l, w) {
                       cat("Selected element", gtkChildren(w)[[1]][["label"]], "\n")
                     })
    win$Add(combo)
    win$Show();
  }

  
  rulers <- function(w) {
    if(is.null(win <- getWindow("rulers")))
      return()

    win$SetUsize(300, 300)
    tbl <- gtkTable(2, 3, FALSE)
    win$Add(tbl)

    h <- gtkHRuler()
    h$SetRange(5, 15, 0, 20)
    h$SetMetric("pixels")

#    mapGtkAttachOptions("shrink")
#return() 
    tbl$Attach(h, 1, 2, 0, 1, yoptions= "shrink", xoptions="GTK_FILL")
    v <- gtkVRuler()
    v$SetRange(5, 15, 0 , 20)
    v$SetMetric("pixels")

    tbl$Attach(v, 0, 1, 1, 2, xoptions = "shrink", yoptions ="fill" )

    label <- gtkLabel(paste("The rulers now work!",
                            "Apparently, they musn't have before.",
                            collapse="\n", sep="\n"))
    tbl$Attach(label, 1, 2, 1, 2)

    win$SetEvents(c("pointer-motion-mask", "pointer-motion-hint-mask"))
    win$AddCallback("motion_notify_event",
                       function(obj, ev) {
                           h$SignalEmit("motion_notify_event", ev)
                           v$SignalEmit("motion_notify_event", ev)
                           print(ev)
                       # the long way of doing this.
                       #   cat("(",gdkEventMotionGetX(ev), ",", gdkEventMotionGetY(ev), ")\n")
                       # and now the short-hand way using [[]]
                           cat("(", ev[["X"]], ",", ev[["Y"]], ")\n")                           
                       })
    
    win$Show()
  }

  createMenu <- function(n) {
     m <- gtkMenu()
     group <- NULL
     for(i in 1:5) {
       item <- gtkMenuItem(paste("item",n,i))
       group <- item
       m$Append(item)
       if(n > 1) {
         item$SetSubmenu(createMenu(n-1))
       }
     }

     m
  }
  
  menus <- function(w) {
    if(is.null(win <- getWindow("menus")))
      return()

    box <- gtkVBox(FALSE, 10)
    
    mbar <- gtkMenuBar()
    
    item <- gtkMenuItem("test\nline2")
    item$SetSubmenu(createMenu(2))
    mbar$Append(item)

    item <- gtkMenuItem("foo")
    item$SetSubmenu(createMenu(2))
    mbar$Append(item)


    item <- gtkMenuItem("bar")
    item$SetSubmenu(createMenu(2))
    item$RightJustify()
    mbar$Append(item)


    opt <- gtkOptionMenu()
    opt$SetMenu(createMenu(1))
    box$PackStart(mbar)
    box$PackEnd(opt)    
    win$Add(box)    

    win$Show()
  }

  panes <- function(w) {
    if(is.null(win <- getWindow("panes")))
      return()

     v <- gtkVPaned()
     win$Add(v)

     h <- gtkHPaned()
     v$Add1(h)

     f <- gtkFrame("A")
     f$SetShadowType("in")
     f$SetUsize(60, 60)
     h$Add1(f)

     f <- gtkFrame("B")
     f$SetShadowType("in")
     f$SetUsize(80, 60)
     h$Add2(f)

     v$Add2(gtkButton("A Button"))

     win$Show()
  }


  buttonBox <- function(w) {
    if(is.null(win <- getWindow("buttonBox")))
      return()

     box <- gtkHButtonBox()
     box$SetUsize(550, -1)
     box$SetSpacing(25)
     box$SetLayout("edge")
     box$SetBorderWidth(10)

     cb <- function(name,w) {
            box$SetLayout(tolower(name))
            box$QueueResize()
           }
     for(i in c("Start", "Edge", "Spread", "End")) {
       b <- gtkButton(i)
       box$Add(b)
       b$AddCallback("clicked", cb, i)
     }
     win$Add(box)
     win$Show()
  }


  clist <- function(w) {
    if(is.null(win <- getWindow("clist")))
      return()

     box1 <- gtkVBox(FALSE, 10)

     box <- gtkHBox(FALSE, 10)
     labels <- c(add1="Add 10 Rows", add2="Add 100 Rows",
                  clear="Clear List", remove="Remove Row")


     selectedRow <- -1
     removeRow <- function(row = selectedRow) {
        cat("Removing row",row,"\n") 
        if(row > -1)
          clist$Remove(row)
     }

      # It would be nice to add these 
     addRows <- function(n = 1000) {
        clist$Freeze()
        for(i in 1:n) {
          text <- c(paste("Row", i), paste("column", 1:6))
          clist$Append(text)
        }
        clist$Thaw()
     }
     for(i in names(labels)) {
        b <- gtkButton(labels[i])
        box$PackStart(b)
        b$AddCallback("clicked", function(cmd, x) {
                                   switch(cmd,
                                          add1= addRows(10),
                                          add2= addRows(100),
                                          clear=clist$Clear(),
                                          remove=removeRow())
                                 }, data = i, object = TRUE)
     }
     box1$PackStart(box, expand = FALSE)


     box <- gtkHBox(FALSE, 10)
     labels <- c(show="Show Title Buttons", hide = "Hide Title Buttons")
     for(i in names(labels)) {
        b <- gtkButton(labels[i])
        box$PackStart(b)
        b$AddCallback("clicked", function(cmd, x) {
                                   if(cmd == "show")
                                     clist$ColumnTitlesShow()
                                   else
                                     clist$ColumnTitlesHide()                                     
                                   
                                 }, i, object = TRUE)
     }
     box1$PackStart(box, expand = FALSE)    


      # Create a CList with 7 columns and titles for each.
     clist <- gtkCList(7, paste("Title", 1:7))
     clist$SetColumnWidth(0, 100)
     for(i in 1:6) {
        clist$SetColumnWidth(i, 80)
     }

     addRows(100)


     clist$AddCallback("select_row", function(w, r, c, ev, selected=TRUE) {
                                       selectedRow <<- r
                                       cat("Selected row",selectedRow,"\n")
                                       print(ev)
                                     })

     sw <- gtkScrolledWindow()
     sw$Add(clist)
     box1$PackStart(sw)

     win$Add(box1)
     win$Show()
  }

  cursor <- function(w) {
    if(is.null(win <- getWindow("cursor")))
      return()

     setCursor <- function(w) {
       val <- spinner$GetValueAsInt()
       if(!any(GdkCursorType == val)) {
         cat("No matching cursor value", val,"\n")
         return()
       }
       
       name <- names(GdkCursorType)[GdkCursorType == val]       
       cursor <- try(gdkCursorNew(val))
       if(inherits(cursor, "try-error"))
         cat("No such cursor type",name,"\n")
       else   {
          gdkWin <- gtkWidgetGetParentWindow(spinner)
          gdkWindowSetCursor(gdkWin, cursor)
          curName$SetText(name)
       }
     }
    
     mbox <- gtkVBox(FALSE, 5)
     mbox$SetBorderWidth(0)

     vbox <- gtkVBox(FALSE, 5)
     mbox$PackStart(vbox)

     hbox <- gtkHBox(FALSE, 5)
     vbox$PackStart(hbox, expand = FALSE)

     label <- gtkLabel("Cursor Value")
     label$SetAlignment(0, 0.5)
     hbox$PackStart(label, expand = FALSE)

     r <- range(GdkCursorType[-1])
     spinner <- gtkSpinButton(gtkAdjustment(r[1], r[1], r[2], 1, 10, 0), 0, 0)
     hbox$PackStart(spinner)

     spinner$AddCallback("changed", setCursor)
    
     frame <- gtkFrame("Cursor Area")
     frame$SetBorderWidth(10)
     frame$SetLabelAlign(0.5, 0)
     vbox$PackStart(frame)

     darea <- gtkDrawingArea()
     darea$SetUsize(80, 80)
     frame$Add(darea)

     curName <- gtkLabel("<cursor name>")
     vbox$PackStart(curName, expand = FALSE)
    
     win$Add(mbox)
    
     win$Show()
  }


  dialog <- function(w) {
    if(is.null(win <- getWindow("dialog", T)))
      return()

     ok <- gtkButton("Ok")
     ok$AddCallback("clicked", closeWindow, "dialog")
     win[["ActionArea"]]$PackStart(ok)
     toggle <- gtkButton("Toggle")
     setting <- FALSE
     l <- NULL
     labelToggle <- function(w) {
        if(setting) {
          l$Destroy()
          l <<- NULL
        } else {
          l <<- gtkLabel("Dialog Test")
          win[["Vbox"]]$PackStart(l)
        }

        setting <<- (!setting) 
     }
     toggle$AddCallback("clicked", labelToggle)
     win[["ActionArea"]]$PackStart(toggle)    

     win$Show()
  }

  dnd <- function(w) {
    if(is.null(win <- getWindow("dnd")))
      return()

    targets <- list(gtkTargetEntry("text/plain", 0, -1))
    
    box <- gtkHBox(FALSE, 5)
    f <- gtkFrame("Drag")
    box$PackStart(f)

    b <- gtkButton("Drag me!")
    f$Add(b)
    gtkDragSourceSet(b, c("GDK_BUTTON1_MASK", "GDK_BUTTON3_MASK"), targets, "GDK_ACTION_COPY")

    count <- 1
    dndDragDataGet <- function(w, ctxt, selData, info, time) {
      str <- paste("This is the text being dragged\nfrom widget to widget\n",
                    "count is", count)
      count <<- count + 1
      gtkSelectionDataSet(selData, NULL, as.integer(8), str)
    }
    b$AddCallback('drag_data_get', dndDragDataGet)

    f <- gtkFrame("Drop")
    to <- gtkButton("To") 
    f$Add(to)
    dndDataGet <- function(w, ctxt, x, y, data, info, time) {
                  if(data[["format"]] != 8) {
                    cat("Incorrect format for Drag-n-Drop\n")
                    return()
                  }

                  dlg <- gtkDialog()
                  label <- gtkLabel(data[["data"]])
                  dlg[["ActionArea"]]$Add(label)

                  # to[["label"]] <- data[["data"]]
               }
    
    gtkDragDestSet(to, "GTK_DEST_DEFAULT_ALL", targets, "GDK_ACTION_COPY")
    to$AddCallback('drag_data_received', dndDataGet)

    box$PackStart(f)
    win$Add(box)
    win$Show()
  }

  pixmap <- function(w) {
    if(is.null(win <- getWindow("pixmap")))
      return()

     pix <- gtkRcLoadImage(gdkColormapGetSystem(), filename = "test.xpm")
     btn <- gtkButton()
     
     pixmap <- gtkPixmap(pix)
     label <-  gtkLabel("Tesing the\nPixmap")
     box3 <- gtkHBox(TRUE, 2)
     box3$Add(pixmap)
     box3$Add(label)
     btn$Add(box3)
     win$Add(btn)
    
     win$Show()
  }

  progressBar <- function(w) {
    if(is.null(win <- getWindow("progressBar", TRUE)))
      return()

    box <- win[["Vbox"]]
    
    lab <- gtkLabel("Progress ...")
    lab$SetAlignment(0, 0.5)
    box$PackStart(lab, expand = FALSE)

    bar <- gtkProgressBar()
    bar$SetUsize(200, 20)
    box$PackStart(bar)

    ctr <- 0
    update <- function() {
#      cat("In update\n")
      ctr <<- ((ctr+1) %% 100)
      bar$Update(ctr/100)
      return(TRUE)
    }

    b <- gtkButton("Stop")

    box$PackStart(b)

    tid <- gtkAddTimeout(100, update)
    toggleTimeout <- function(obj = NULL, ev = NULL) {
      if(is.null(tid)) {
            tid <<- gtkAddTimeout(100, update)
            b[["label"]] <- "Stop"
      } else {
        cat("Removing timeout\n")
        gtkRemoveTimeout(tid)
        b[["label"]] <- "Start"        
        tid <<- NULL
      }
    }
  
    b$AddCallback("clicked", toggleTimeout)
    win$AddCallback("delete_event", toggleTimeout)
    
    win$Show()
  }

  rangeControls <- function(w) {
    if(is.null(win <- getWindow("range controls")))
      return()
     box <- gtkVBox(FALSE, 10)
     win$Add(box)
    
     adj <- gtkAdjustment(0, 0, 101, .1, 1, 1)
     scale <- gtkHScale(adj)
     scale$SetUsize(150, 30)
     scale$SetDigits(1)
     scale$SetDrawValue(TRUE)
     scale$SetUpdatePolicy("delayed")
     box$PackStart(scale)

     sb <- gtkHScrollbar(adj)
     box$PackStart(sb)
     sb$SetUpdatePolicy("delayed")

     win$Show()
  }

  reparent <- function(w) {
    if(is.null(win <- getWindow("reparent")))
      return()

     box <- gtkHBox(FALSE, 5)

     fr <- gtkFrame("Frame 1")
     box$PackStart(fr)
     boxA <- gtkVBox(TRUE, 5)
     fr$Add(boxA)
     b <- gtkButton("switch")
     boxA$PackStart(b, expand = FALSE)
     label <- gtkLabel("Hello World")
     boxA$PackStart(label, expand = FALSE)

     which <- 1
     cb <- function(w) {
       if(which == 0)
         x <- boxA
       else
         x <- boxB
       which <<- abs(which -1)
       label$Reparent(x)
     }
     b$AddCallback("clicked", cb)

     fr <- gtkFrame("Frame 2")
     box$PackStart(fr)
     boxB <- gtkVBox(FALSE, 5)
     b <- gtkButton("switch")
     b$AddCallback("clicked", cb)
     boxB$PackStart(b)
     fr$Add(boxB)

     win$Add(box)
     win$Show()
  }


  scrolledWindows <- function(w) {
    if(is.null(win <- getWindow("scrolled windows", TRUE)))
      return()

     win$SetUsize(300, 200)
     box <- win[["Vbox"]]

     sw <- gtkScrolledWindow()
     sw$SetPolicy("automatic", "automatic")

     box$PackStart(sw)

     tbl <- gtkTable(20, 20, TRUE)
     tbl$SetRowSpacings(10)
     tbl$SetColSpacings(10)

     sw$AddWithViewport(tbl)

     for(i in 1:20) {
        for(j in 1:20) {
          tbl$Attach(gtkButton(paste("button (", i,", ", j, ")")), i-1, i, j-1, j)
        }
     }
    
     win$Show()
  }

  statusBar <- function(w) {
    if(is.null(win <- getWindow("status bar", TRUE)))
      return()

     box <- gtkVBox(FALSE, 10)
     win[["ActionArea"]]$PackStart(box)

     h <- gtkHBox(TRUE, 3)
     box$Add(h)
     sb <- gtkStatusBar()
     box$Add(sb)

     for(i in c("Pop", "Push", "Close")) {
       b <- gtkButton(i)
       h$Add(b)
     }
    
     win$Show()
  }

  makeCount <- function(f, count, win) {
     box <- win[["Vbox"]]
     label <- gtkLabel(paste("Count:", count))
     box$PackStart(label)

     box2 <- gtkHBox(TRUE, 10)
     for(i in c("Close", "Start", "Stop")) {
        b <- gtkButton(i)
        box2$PackStart(b)
        b$AddCallback("clicked", f, i, object = TRUE)
     }

     box <- win[["ActionArea"]]
     box$PackStart(box2)
     label
  }

  idle <- function(w) {
    if(is.null(win <- getWindow("Idle Test", TRUE)))
      return()

     count <- 0
     incr <- function() {
       count <<- count + 1
       label$SetText(paste("Count:", count))
       TRUE
     }
    
     tid <- NULL
     f <- function(cmd, b) {
       if(cmd == "Start")  {
         tid <<- gtkAddIdle(incr)
       } else if(cmd == "Stop") {
         gtkRemoveIdle(tid)
         tid <<- NULL
       } else {
          win$Hide()
       }
     }
     label <- makeCount(f, count, win)

     win$Show()
  }

  timeout <- function(w) {

    closeHandler <- function(winName, win, ev = NULL) {
                         cat("Cleaning up timeouts\n")
                         if(!is.null(tid)) {
                            gtkRemoveTimeout(tid)
                         }
                         closeWindow(winName)
                    }
    
    if(is.null(win <- getWindow("timeout", TRUE, closeHandler)))
      return()

    count <- 0
     incr <- function() {
       count <<- count + 1
       label$SetText(paste("Count:", count))
       TRUE
     }
    
     tid <- NULL
     f <- function(cmd, b) {
       if(cmd == "Start")  {
         tid <<- gtkAddTimeout(250, incr)
       } else if(cmd == "Stop") {
         gtkRemoveTimeout(tid)
         tid <<- NULL
       } else {
          win$Hide()
       }
     }
     label <- makeCount(f, count, win)

         
     win$Show()
  }

  tree <- function(b) {
    if(is.null(win <- getWindow("Tree")))
      return()    

    win$SetUsize(300, 500)
    box <- gtkVBox(TRUE, 10)

    tr <- gtkTree()
    if(FALSE) {
      libs <- search()
      names(libs) <- gsub(".*:", "", libs)
    } else {
      tmp <- c("mva", "ctest", "eda", "tools")
      libs <- paste("package", tmp, sep=":")
      names(libs) <- tmp
    }

     # Force these to be loaded.
  sapply(names(libs), function(x) library(x, character.only=TRUE))

  for(i in names(libs)) {
      el <- gtkTreeItem(libs[i])
      tr$Append(el)

      subTr <- gtkTree()
      el$AddCallback("expand", function(name, obj) {
         desc <- scan(system.file("DESCRIPTION", package=name), what="", sep="\n")
         textArea$DeleteText(0, -1)
         textArea$Insert(chars=paste(desc,collapse="\n"), length = -1)
        }, i, object = TRUE)

      for(j in objects(libs[i])) {
        tmp <- gtkTreeItem(j)
        tmp$AddCallback("select",
                           function(name, i) {
                                txt <- deparse(get(name["symbol"], pos=paste("package", name["library"], sep=":")))
                                funcTextArea$DeleteText(0, -1)
                                funcTextArea$Insert(chars=paste(txt,collapse="\n"), length = -1)
                               },
                         data = c(symbol=j, "library"=i), object = TRUE)
        subTr$Append(tmp)
      }
      el$SetSubtree(subTr)
    }

   sw <- gtkScrolledWindow()
   sw$AddWithViewport(tr)
  
   box$PackStart(sw)

   book <- gtkNotebook()
   swtxt <- gtkScrolledWindow()
   textArea <- gtkText()
   swtxt$AddWithViewport(textArea)
   book$AppendPage(swtxt, gtkLabel("Description"))

   sw <- gtkScrolledWindow()
   funcTextArea <- gtkText()
   sw$AddWithViewport(funcTextArea)    
   book$AppendPage(sw, gtkLabel("Function"))    
   box$PackEnd(book)
    
   win$Add(box)
   win$Show()
  }

  unimplemented <- function(win, name) {
     win$Add(f <- gtkFrame("Unimplemented"))
     f$Add(gtkLabel(paste("The demo for",name,"\n", "is unimplemented at present.\nCome back later!")))
  }
  
  
   run <- function(omit = c("statusBar"))   {
         # parse a resource file if it is available.
       if(!is.null(rc) && file.exists(rc))
         gtkRcParse(rc)
  
       win <<- gtkWindow(show=FALSE)
       win$SetUsize(200, 400)
        
       sc <- gtkScrolledWindow()
       box <- gtkVBox(TRUE, 0)
       sc$AddWithViewport(box)

       for(i in sort(names(h)[-length(h)])) {
        b <- gtkButton(i)
        box$PackStart(b)
        if(!is.na(match(i, omit))) {
          cat("Functionality not implemented for", i, "\n")
          b$SetSensitive(FALSE)
        } else {
          f <- h[[i]]
          b$AddCallback("clicked", f)
        }
       }       
       
       win$Add(sc)
       win$Show()
       
       win
}
  
  
  list(buttons = buttons,
       rulers = rulers,
       toggleButtons = toggleButtons,
       checkButtons = checkButtons,
       radioButtons = radioButtons,
       gammaCurve = gammaCurve,
       toolbar = toolbar,
       calendar = calendar,
       "list" = List,
       tooltips = tooltips,
       colorSelection = colorSelection,
       fileSelection = fileSelection,
       notebook = notebook,
       entry = entry,
       handle = handle,
       Text = Text,
       menus = menus,
       panes = panes,
       buttonBox = buttonBox,
       clist = clist,
       combo = combo,
       cursor = cursor,
       dialog = dialog,
       dnd = dnd,
       pixmap = pixmap,
       progressBar = progressBar,
       rangeControls = rangeControls,
       reparent = reparent,
       scrolledWindows = scrolledWindows,
       statusBar = statusBar,
       idle = idle,
       timeout = timeout,
       tree = tree,
       fontSelection = fontSelection,
       windows = function(...) windows,
       run = run
       )
}  

h <- testHandler("/home/duncan/pygtk-0.6.8/examples/testgtk/testgtkrc")
h$run()