R/items.R

In traitr: An interface for creating GUIs modeled in part after traits UI module for python.

##  Copyright (C) 2010 John Verzani
##
##  This program is free software; you can redistribute it and/or modify
##  it under the terms of the GNU General Public License as published by
##  the Free Software Foundation; either version 2 of the License, or
##  (at your option) any later version.
##
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##  GNU General Public License for more details.
##
##  A copy of the GNU General Public License is available at
##  http://www.r-project.org/Licenses/

##' @include editor.R
roxygen()

## TODO
## * Need to make more item groups:
##   * formulaItem
##   * dfeditItem

##################################################
## items

## An item is a model, a view (Editor) and a controller
## the init method should set up the controller.
## should have methods of a model

##' Base Trait for an Item
##'
##' An Item combines a model, view and controller interface into one convenient package.
##' Items may be combined into an ItemGroup or a Dialog to be shown.
##'
##' The \code{make_ui} method creates the user interface, initializes the model and the controller.
##' The \code{init_model}, \code{init_controller} and \code{init_ui} do the work.
##'
##' The model may be shared with different items. See \code{set_model_from_item} or
##' the \code{instance} proto method.
##'
##' Items implement the observer interface, so one can add observers to listen for changes to
##' the properties. (Properties are listed in the property "\code{properties}".)
##'
##' Items use the Adpater interface to link the model with the view (an Editor). The "\code{properties}"
##' property lists the names of model properties. One should use "value" for the special one to be
##' returned by the method \code{to_R}. (This method gathers values from the items after coercion)
##'
##' When an item's user interface is made, the method \code{on_realized} is called.
##' @export
Item <- BaseTrait$proto(class=c("Item", "Model", BaseTrait$class),
                         ## item properties
                         .doc_name=paste(
                           desc("Unique name for lookup and for storing key property")
                           ),
                         name = "",           # for lookup
                        ## label
                         .doc_label=paste(
                           desc("Default label for editor")
                           ),
                         label = "label",     # for display
                        ## show label
                         .doc_show_label=paste(
                           desc("Logical indicating if label should be drawn in editor")
                           ),
                         show_label=TRUE,   # FALSE to suppress label
                        ## help string
                         .doc_help=paste(
                           desc("Property for storing help on an item")
                           ),
                         help = "",           # for documentation
                        ## tooltip string
                         .doc_tooltip=paste(
                           desc("If not an empty string, provides tooltip text for widget")
                           ),
                         tooltip = "",        # for tooltip. Shorter than help
                        ## icon
                        .doc_icon=paste(
                          desc("A gWidgets stock icon for this item, empty string for no icon")
                          ),
                        icon="",
                        ## attr
                         .doc_attr=paste(
                           desc("List of attributes to pass to constructor of editor. Include size=c(x,y) to set size")
                           ),
                         attr=list(),         # for layout of item
                        ## parent
                        .doc_parent=paste(
                          desc("When item is member of itemGroup, this points to itemGroup, otherwise NULL")
                          ),
                        parent=NULL,
                        ## on realized method
                         .doc_on_realized=paste(
                           desc("Method called when widget is realized."),
                           param(".","Item object passed in, but no other")
                           ),
                         on_realized = NULL,  # call when widget is realized
                         ## Model properties
                         ## This list is used to figure out which values are in the model, if model
                         ## generated by init
                         ## the property "value" is special, as it gets aliased to get_name and set_name
                        value="default value",
                         .doc_properties=paste(
                           desc("Character vector of property names for which this item object creates a model for.",
                                "Always a property with the value of 'name' is created. This adds other.",
                                "When <code>init_model</code>method is called",
                                "getter and setter methods are created.",
                                "The set methods call <code>notify_observers</code>")
                           ),
#                         properties=c("value"),
                        properties=c(),
                         ## list of properties to use to set get_/set_ methods
                         excluded_property_names=c("editor", "model"),
                         .doc_coerce_with=paste(
                           desc("function to coerce values stored in model with before returning",
                                "the value through the </code>to_R</code> method.",
                                "As with all <code>proto</code> functions, this method should have a '.' for",
                                "an initial argument"),
                           param(".","Initial argument, passes in item object"),
                           param("value","Value to be coerced")
                           ),
                         coerce_with = NULL, # a function e.g., function(., value) as.numeric(value)
                         
                         ## property for controller
                         .doc_add_handler_name=paste(
                           desc("Character vector with gWidgets addHandlerXXX names. Can be more than 1. Set to ''",
                                "if no handler is desired")
                           ),
                         add_handler_name="addHandlerChanged", ## "" for no view->model
                         handler_user_data=NULL,     
                         ## Set up widget
                         ## UI
                         .doc_editor=paste(
                           desc("Property to store instance of <code>Editor</code> class. This is",
                                "created by the item when the <code>init</code> method is called (often",
                                "by <code>make_ui</code>")
                           ),
                         editor = NULL, # editor class -- a view
                         .doc_set_editor=paste(
                           desc("Method to set an editor for the item object."),
                           param("editor","An <code>Editor</code>instance")
                           ),
                         set_editor = function(., editor) {
                           if(is.proto(editor) && editor$is("Editor")) {
                             .$editor=editor
                             if(!is.null(.$controller)) {
                               .$controller$set_view(editor)
                             }
                           }
                         },
                         .doc_get_editor=paste(
                           desc("Convenience method to return editor")
                           ),
                         get_editor = function(.) .$editor,
                         ## method to make instance, context, ... ignored
                         .doc_make_ui=paste(
                           desc("Method to create the user interface for the item."),
                           param("cont","gWidgets container to pack editor widgets into"),
                           param("attr","list of attributes to pass to gWidgets constructor."),
                           param("context","context is an <code>Item</code> or <code>ItemGroup</code>instance",
                                 "to give a context to the editor. (The editor picks up properties such as a",
                                 "label from this.")
                           ),
                         make_ui = function(., container, attr=.$attr, context, ...) {
                           .$init_model()
                           .$init_ui(container, attr, context, ...)
                           .$init_controller()
                         },
                        ## make default gui layout really for itemgroups, this allows
                        ## one to modify per item, but not sure how it would be done.
                        .doc_make_default_gui_layout = paste(
                          desc("Function to specify the default layout")
                          ),
                        make_default_gui_layout = function(.) .,
                         
                         ## When update_ui() is called, these two conditions are checked. If FALSE, then
                         ## the methods visible and enabled are called on the editor
                          .doc_visible_when=paste(
                            desc("Method evaluated when <code>update_ui</code> is called to determine if the",
                                 "item should be visible. Should evaulate to a logical."),
                            returns("A logical value to determine if item is visible")
                            ),
                          visible_when = function(.) {TRUE}, # function call. When update_ui called
                          .doc_visible=paste(
                            desc("Method to set visibility of editor"),
                            param("value","a logical")
                            ),
                          visible = function(., value) {
                            .$get_editor()$visible(as.logical(value))
                          },
                       ## enabled
                          .doc_enabled_when=paste(
                            desc("Method evaluated when <code>update_ui</code> is called to determine if the",
                                 "item should be enabled (sensitive to user input). Should evaulate to a logical."),
                            returns("A logical value to determine if item is enabled")
                            ),
                          enabled_when = function(.) {TRUE}, # function call
                          .doc_enabled=paste(
                            desc("Method to set whether editor is enabled (sensitive to user input"),
                            param("value","a logical")
                            ),
                          enabled = function(., value) {
                            .$get_editor()$enabled(as.logical(value))
                          },
                         ## a function(., rawvalue) return list with retval=TRUE for valid, retval=FALSE for invalid
                         ## pass message through mesg component
                         ## uses rawvalue, can coerce with .$coerce_with, which model does
                         set_validate =function(.,f) .$validate <- f,
                         .doc_validate = paste(
                           desc("Check if main value is valid. The model accepts invalid input, but when",
                                "coerced to an R object, through the to_R method, the value will not be as",
                                "expected.",
                                "In an item, the main value shares the same name as the 'name' property",
                                "to validate other properties, a method <code>validate_PROPERTYNAME</code>",
                                "can be provided.",
                                "All validate methods should return the validated value or throw an error (stop)",
                                "with message describing reason value is valid. The base validate method",
                                "applies coerce_with, This can be called with"
                                ),
                           param("rawvalue", "The value from the widget is passed in. This may be coerced through",
                                 "the <code>coerced_with</code> method directly, by calling the validate model",
                                 "in <code>.super</code>."
                                 )
                           ),
                         validate=function(., rawvalue) {
                           warn_val <- getOption("warn")
                           options(warn=2)
                           on.exit(options(warn=warn_val))
                           if(!is.null(.$coerce_with))
                             return(.$do_call("coerce_with",list(value=rawvalue)))
                           else
                             return(rawvalue)
                         },
                         ## keep for validation -- prevents multiple calls
                         .last_error="",
                        ## is the value valid (validate doesn't tell!)
                        .doc_is_valid=paste(
                          desc("Does the item hold a valid value? It may not")
                          ),
                        is_valid=function(.) {
                          out <- try(.$validate(.$get_value()), silent=TRUE)
                          !inherits(out, "try-error")
                        },
                         ## the model
                         .doc_model=paste(
                           desc("Internal property to hold model instance")
                           ),
                         model=NULL,
                         .doc_set_model=paste(
                           desc("Method to set model for item object. Model must be of correct class, ",
                                "Either Model or another Item object. In the latter case the model is",
                                "shared"),
                           param("model","Either an Model or Item instance")
                           ),
                         set_model=function(., model) {
                           if(is.proto(model) && model$is("Item")) {
                             .$set_model_from_item(model)
                           } else if(is.proto(model) && model$is("Model")) {
                             old_model <- .$get_model()
                             .$model <- model
                             ## observers
                             
                             ## controller
                             if(!is.null(.$controller)) {
                               .$controller$set_model(model)
                             }
                             ## update views
                             if(!is.null(.$get_slot("editor")) && .$editor$is_realized()) {
                               sapply(.$model$list_observers(), function(o) {
                                 nms <- o$list_methods()
                                 sapply(nms, function(i) {
                                   if(grepl("^property_(.*)_value_changed$",i)) {
                                     prop <- gsub("property_(.*)_value_changed$","\\1",i)
                                     value <- .$do_call(sprintf("get_%s",prop))
                                     do.call(o$get_slot(i),
                                             list(.=o, value=value, old_value=value))
                                   }
                                 })
                               })
                             }
                           } 
                           invisible()
                         },
                         ## Use the model from a different item
                         set_model_from_item=function(., item) {
                           if(!missing(item) && (is.proto(item) && item$is("Item"))) {
                             item$init_model() # if not initialized, needs to be
                             m <- item$get_model()
                             .$set_model(m)
                           }
                         },
                         .doc_get_model=paste(
                           desc("Return model from Item object")
                           ),
                         get_model=function(.) .$model,
                         ## observers
                        .doc_add_observer=paste(
                          desc("Add an observer to this item"),
                          param("o", "an observer")
                          ),
                         add_observer = function(., o) {
                           .$get_model()$add_observer(o)
                         },
                        .doc_remove_observer=paste(
                          desc("Remove an observer from this item"),
                          param("o", "an observer")
                          ),
                         remove_observer = function(., o) {
                           .$get_model()$remove_observer(o)
                         },
                         ## defines get/set values for model
                        .doc_getattr=paste(
                          desc("Get the value stored in model. Coerces with <code>coerce_with</code> first"),
                          param("key", "key from model")
                          ),
                         getattr=function(., key) {
                           val <- .$model$getattr(key)
                           if(.$has_slot("coerce_with")) # && is.function(.$coerce_with))
                             val <- .$coerce_with(val)
                           val
                         },
                         .doc_setattr=paste(
                           desc("After validation, sets model attribute (property) which notifies the observers.",
                                "Also updates user interface"),
                           param("key","Property name"),
                           param("value","new model value"),
                           param("notify_private","For undo use, ignore")
                           ),
                         setattr=function(., key, value, notify_private=TRUE) {
                           ## we validate if key=name
                           ## or if there is a validate_KEY method
                           validate_method_name = ""
                           tmp <- sprintf("validate_%s", key)
                           if(key == .$name) {
                             validate_method_name="validate"
                           } else if (.$has_slot(tmp)) {
                             validate_method_name <- tmp
                           }
                           if(validate_method_name != "") {
                             validated_value <- try(.$do_call(validate_method_name, list(rawvalue=value)), silent=TRUE)
                             if(inherits(validated_value, "try-error")) {
                               if(digest(.$.last_error) != digest(validated_value)) {
                                 .$.last_error <- validated_value
                                 ## editor needs to be told it is invalid
                                 if(!is.null(.$editor) && .$editor$is_realized())
                                   .$editor$set_invalid(validated_value)
                                 else
                                   cat(sprintf("Not a valid value: %s\n", validated_value))
                               }
                             } else {
                               if(!is.null(.$editor) && .$editor$is_realized())
                                 .$editor$set_valid()
                             }
                             .$.last_error <- ""
                           }
                           ## we store the value (a string) not the validated value
                           .$model$setattr(key, value, notify_private) 
                           .$update_ui()
                           invisible()
                         },
                         ## defines initial model if not present
                        .doc_default_get=paste(
                          desc("Return function for default get method (get_name)")
                          ),
                        default_get=function(.) {
                          function(.) {.$getattr(.$name)}
                        },
                        .doc_default_set=paste(
                          desc("Default function for set_name(., value).",
                               "This allows items to override the default behaviour which is",
                               "to return the value stored in the property <code>.$name</code>.")
                          ),
                        default_set=function(.) {
                          function(., value) {.$setattr(.$name, value)}
                        },
                         .doc_init_model=paste(
                           desc("Method to initialize the model. If overriding, must be done prior to making the",
                                "user interface",
                                "This method fixes names and makes the model store the properties, not the item",
                                "instance.")
                           ),
                         init_model=function(.) {
                           model <- .$model
                           if(is.null(model) || (is.proto(model) && !model$is("Model"))) {
                             .$model <- Model$proto()
                           }
                           ## move properties from this object to model, where it fits better
                           sapply(c(.$name, .$properties), function(i) {
                             if(i %in% .$excluded_property_names) 
                               warning(sprintf("%s is a reserved property name",i))
                           })
                           ## assign name as default if not already defined
                           ## need to not look up, as things like "mean", "sd" etc are found
                           ## here. Might need to change though to search over all proto objects?
                           if(!.$model$has_local_slot(.$name) || is.null(.$model$get_local_slot(.$name))) {
                             .$model$assign_if_null(.$name, .$value)
                           }
                           
                           sapply(.$properties, function(i) {
                             if(.$has_slot(i))
                               val <- .$get_slot(i)
                             else
                               val <- NULL
                             .$model$assign_if_null(i, val)
                           })
                           .$model$init()

                           ## make get/set pairs for properties (push down to model)
                           QT <- sapply(.$properties, function(i) {
                             .$assign_if_null(paste("get_",i,sep=""),
                                    function(.) {
                                      .$getattr(i)
                                    })
                             .$assign_if_null(paste(".doc_get_",i,sep=""),"get value method")
                             ## set
                             .$assign_if_null(paste("set_",i,sep=""),
                                    function(., value) {
                                      .$setattr(i, value)
                                    })
                             .$assign_if_null(paste(".doc_set_",i,sep=""),"set value method")
                           })
                           ## default for .$name. Allows items to override default behaviour
                           .$assign_if_null(sprintf("get_%s",.$name), .$default_get())
                           .$assign_if_null(sprintf(".doc_get_%s",.$name), "Get main value")
                           .$assign_if_null(sprintf("set_%s",.$name), .$default_set())
                           .$assign_if_null(sprintf(".doc_set_%s",.$name), "Set main value")

                           ## we have "value" as special
                           if(!.$has_slot("set_value"))
                             .$set_value <- function(., value) .$do_call(sprintf("set_%s",.$name), list(value=value))
                           if(!.$has_slot("get_value"))
                             .$get_value <- function(.) .$do_call(sprintf("get_%s",.$name))
                           
                         },
                         ## return object stored in model
                         ## this may be coerced
                         .doc_to_R=paste(
                           desc("Method to return value item value as a named list",
                                "Name is given by <code>name<property> by default",
                                "default value is just value in this property, override in ",
                                "instances for something more interesting.",
                                "Called by <code>to_R</code>  ItemGroup method."),
                           param("drop","ignored. Used by itemGroup call")
                           ),
                         to_R = function(., drop=TRUE) {
                           value <- .$do_call(sprintf("get_%s",.$name),list())
#                           if(!is.null(.$coerce_with))
                           if(.$has_slot("coerce_with"))
                             value <- .$coerce_with(value)
                           l <- list(value)
                           if(exists("name", .))
                             names(l)[1] <- .$name
                           return(l)
                         },
                         ## return string representation
                         .doc_to_string=paste(
                           desc("Return model value as a string.",
                                "Default assumes key property is",
                                "named <code>value</code>"),
                           param("drop","Ignored. Used by itemgroup call")
                           ),
                         to_string = function(., drop=TRUE) {
                           value <- .$do_call(sprintf("get_%s",.$name),list())
                           ## any formatting??
                           return(value)
                         },


                        
                        ## controller
                        controller=NULL,
                        .doc_get_controller=paste(
                          desc("Return controller for this item")
                          ),
                        get_controller = function(.) .$controller,
                        ## set up controller if model and editor defined
                        init_controller=function(.) {
                          ## we make adapter to link model and view by default.
                          ## sub-class can override this to be more complicated
                          .$controller <-  Adapter$proto(model=., #.$model, (force use of setattr for validation)
                                                         view=.$editor,
                                                         property=.$name,
                                                         view_widget_name=.$editor$view_widget_name,
                                                         validate = .$validate,
                                                         add_handler_name=.$add_handler_name,
                                                         handler_user_data=handler_user_data)
                           .$controller$init()
                         },
                        .doc_init_ui=paste(
                          desc("Initialize the user interface",
                               "Does not set up controller, see <code>init_controller</code> for that.",
                               "Does not set up model, see <code>init_model</code> for that.",
                               "See <code>make_ui</code> to put this all together."
                               )
                          ),
                        init_ui=function(., container, attr=.$attr, context, ...) {
                          if(is.null(.$editor) || !.$editor$is_realized()) {
                            if(is.null(.$editor) || (is.proto(.$editor) && !.$editor$is("Editor")))
                              .$editor <- Editor$proto()
                            .$get_editor()$.make_ui(container, attr, context=.,...)
                            ## call when widget is realized
                             .$do_call("on_realized", list())
                          }
                        },

                        ## init sets up model.
                        ## see make_ui to set up model, view (init_ui) and controller 
                         init=function(.) {
                           .$init_model()
                         },
                         .doc_new=paste(
                           desc("This creates the item and initializes its model")
                           ),
                         new=function(.,...) {
                           obj <- .$proto(...)
                           obj$init_model()
                           obj
                         },
                         ## instance
                         .doc_instance=paste(
                           desc("Create a new instance of an object. Shares model, controller, but not view"),
                           "We don't actually have decoupling of item and view, as there is only a single editor",
                           "per item. However, through <code>instance</code> the model can be shared with a new instance",
                           "that can have its separate editor."
                           ),
                         instance=function(.) {
                           obj <- .$proto()
                           if(!is.null(.$editor)) 
                             obj$editor <- .$editor$instance()
                           obj$parent <- NULL # clear out parent
                           obj
                         },
                         ## used to update UI
                         .doc_update_ui=paste(
                           desc("Update the user interface. Checks visible_when and enabled_when")
                           ),
                         update_ui=function(.) {
                           ## do we need to do this? Or are only itemgroups/containers updated to be visible/enabled?
                                        #                           .$editor$visible(.$visible_when())
                                        #                           .$editor$enabled(.$enabled_when())
                           invisible()
                         }
                        )


##################################################
## Various Item instances
## See also some special files (eg. itemlist) for others

## Item instances
## An instance must have
## init_model, init_controller, init_ui
## the model interface: add_,remove_,notify_ observer
## a method default_get, default_set if desired

##' A string item
##' @export
##' @param value Default value for the model
##' @param regex If non \code{NULL} specifies a regular expression for validation.
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param eval_first Should value be run through eval/parse before coercion.
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200))
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto
##' @return A \code{proto} object. Call \code{obj\$show_help()} to view its methods and properties.
##' @seealso \code{\link{Item}}
##' @examples
##' ## basic usage
##' a <- stringItem("ac", name="x")
##' a$get_x()
##' a$set_x("abc213")
##' a$get_x()
##' ## eval first
##' a <- stringItem("ac", name="x", eval_first=TRUE)
##' a$set_x("2 + 2")
##' a$get_x()
##' a$to_R()
stringItem <- function(value="",        # initial vlaue
                       regex=NULL,      # if non-null a regular expression for validation
                       name,            # for lookup with item group
                       label=name,      # for display
                       help="",
                       tooltip="",
                       eval_first=FALSE, # call eval(parse(text=.)) before coercion
                       attr,
                       model,
                       editor,
                       ...) {


  if(missing(name))
    name <- "Anonymous"


  obj <- Item$proto(name=name, label=label, help=help,
                    tooltip=tooltip, value=value,
                    add_handler_name=paste("addHandler", c("Changed","Blur"), sep=""),
                    ...
                    )
  obj$add_class("StringItem")
  
  if(eval_first)
    obj$coerce_with <-  function(., value) {
    value <- eval(parse(text=value), envir=.GlobalEnv)
    as.character(value)
  }

  if(!is.null(regex)) {
    if(!is.character(regex))
      stop("Argument regex is a string specifying a regular expression for validation")
    obj$.regex <- regex
    obj$validate <- function(., rawvalue) {
      value <- .$next_method("validate")(., rawvalue)
      if(grepl(.$.regex, value))
        return(value)
      else
        stop(sprintf("%s does not match regular expression: %s", value, .$.regex))
    }
  }

  
  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)

  if(missing(editor))
    obj$editor <- EntryEditor$proto()
  
  if(!missing(model))
    obj$set_model(model)
  obj$init_model()
  
  return(obj)
}

##' Item for numbers
##' @export
##' @param value Default value for the model
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param eval_first Should value be run through eval/parse before coercion.
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200))
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @seealso \code{\link{Item}}
##' @examples
##' ## basic use
##' a <- numericItem(0, name="x")
##' a$set_x(10)
##' a$get_x()
##' ## eval can be instructed
##' a <- numericItem(0, name="x", eval_first=TRUE)
##' a$set_x("1:5")
##' a$get_x()
##' a$to_R()

numericItem <- function(value=numeric(0), # a number
                        name,            # for lookup with item group
                        label=name,      # for display
                        help="",
                        tooltip="",
                        eval_first=FALSE, # call eval(parse(text=.), envir=.GlobalEnv) before coercion
                        attr,
                        model,
                        editor,
                        ...) {
  

  if(missing(name))
    name <- "Anonymous"

 

  obj <- Item$proto(name=name, label=label, help=help,
                    tooltip=tooltip, value=value,
                    add_handler_name=paste("addHandler", c("Changed","Blur"), sep=""),
                    ...
                    )
  obj$add_class("NumericItem")
  obj$validate <- function(., rawvalue) {
    value <- .$next_method("validate")(., rawvalue)
    if(is.numeric(value))
      return(value)
    else
      stop("Not numeric")
  }
  
  if(eval_first) {
    obj$coerce_with <- function(., value) {
      value <- eval(parse(text=value), envir=.GlobalEnv)
      as.numeric(value)
    }
  } else {
    obj$coerce_with <- function(., value) as.numeric(value)
  }
  
  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)
  
  if(missing(editor))
    obj$editor <- EntryEditor$proto()

  if(!missing(model)) 
    obj$set_model(model)

  obj$init_model()

  return(obj)
}

##' Item for integers
##' @export
##' @param value Default value for the model
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param eval_first Should value be run through eval/parse before coercion.
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200))
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @seealso \code{\link{numericItem}}
integerItem <- function(value=integer(0),
                        name,            # for lookup with item group
                        label=name,      # for display
                        help="",
                        tooltip="",
                        eval_first=FALSE, # call eval(parse(text=.)) before coercion
                        attr,
                        model,
                        editor,
                        ...) {

  if(missing(name)) {
    name <- "Anonymous"
    label <- name
  }
  l <- list(value=value, name=name, label=label, help=help, tooltip=tooltip)
  theArgs <- list(...)
  for(i in names(theArgs))
    l[[i]] <- theArgs[[i]]
  
  obj <- do.call("numericItem", l)
  obj$add_class("IntegerItem")
  obj$validate <- function(., rawvalue) {
    value <- .$next_method("validate")(., rawvalue)
    if(is.integer(value))
      return(value)
    else
      stop("Not an integer")
  }
  
  ## difference is in coercion function
  if(eval_first) 
    obj$coerce_with <- function(., value) {
      value <- eval(parse(text=value), envir=.GlobalEnv)
      as.integer(value)
    }
  else
    obj$coerce_with <- function(., value) as.integer(value)

  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)

  if(missing(editor))
    obj$editor <- EntryEditor$proto()

  if(!missing(model)) 
    obj$set_model(model)

  obj$init_model()

  return(obj)
}


##' Item for typing in R expressions. These are eval-parsed in .GlobalEnv prior to return
##'
##' @export
##' @param value Default value for the model
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200))
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @seealso \code{\link{numericItem}}, \code{\link{integerItem}}, \code{\link{stringItem}}, as these are
##'    similar, but also validate the final results
expressionItem <- function(value="",
    name,            # for lookup with item group
    label=name,      # for display
    help="",
    tooltip="",
    attr,
    model,
    editor,
    ...) {


  

  if(missing(name))
    name <- "Anonymous"


  obj <- Item$proto(name=name, label=label, help=help,
                    tooltip=tooltip, value=value,
                    add_handler_name=paste("addHandler", c("Changed","Blur"), sep=""),
                    ...
                    )
  obj$add_class("ExpressionItem")
  
  obj$coerce_with <-  function(., value) {
    value <- eval(parse(text=value), envir=.GlobalEnv)
    value
  }

  obj$validate <- NULL

  
  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)

  if(missing(editor))
    obj$editor <- EntryEditor$proto()
  
  if(!missing(model))
    obj$set_model(model)

  obj$init_model()
  
  return(obj)
}



##' Item for Boolean values
##' @export
##' @param value Default value for the model
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200))
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto. The value \code{editor_style="compact"} will pass
##'        this information to the editor causing it to render as a checkbox.
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @seealso \code{\link{Item}}
##' @examples
##' ## basic usage
##' a <- trueFalseItem(TRUE, name="x")
##' a$get_x()
##' a$set_x(FALSE)
##' a$get_x()
trueFalseItem <- function(value=TRUE,
                          name,
                          label=name,
                          help="",
                          tooltip="",
                          attr,
                          model,
                          editor,
                          ...) {

 if(missing(name))
   name <- "Anonymous"
 
 
 obj <- Item$proto(name=name, label=label, help=help,
                   tooltip=tooltip,
                   value=value,
                   add_handler_name="addHandlerChanged",
                   ...)
 obj$add_class("BooleanItem")

 ## override methods
 obj$validate <- function(., rawvalue) {
   value <- as.logical(.$next_method("validate")(., rawvalue))
   if(is.logical(value))
     return(value)
   else
     stop("Not logical")
 }
 obj$coerce_with <- function(., value) as.logical(value)

 if(!missing(attr))
   obj$attr <- merge(obj$attr, attr)
 
 if(!missing(model)) 
   obj$set_model(model)
 
 if(missing(editor))
   obj$editor <- BooleanEditor$proto()
 
 obj$init_model()
 return(obj)
 
}




##' Item for choosing one of several values
##' @export
##' @param value Default value for the model. This is specified by index (or indices if \code{multiple=TRUE})
##' @param values Values that one can select from. May be a data frame or vector. The editor depends on the size of
##'               this: small will be radio button or checkboxes; medium is combobox; large is a table. One can
##'               override the behaviour by passing in a value to \code{editor_type}.
##' @param by_index  Do we get and set the main value by index or by value?
##' @param multiple Multiple selection is allowed? If so, then only checkboxes or table widget is used
##' @param editable Can user edit value to be selected? If so, the combobox is used
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200)).
##'      The \code{expand=TRUE} value is a default for this.
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param editor_type overide choice of editor by heuristic based on the number of possible values.
##'        Must set attr to match desired.
##' @param ... Passed to parent proto object during call to proto
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @seealso \code{\link{Item}}
##' @examples
##' ## default is to get/set by value
##'          a <- choiceItem("a", letters, name="x")
##'          a$get_x()
##'          a$set_x("b")
##'          a$get_x()
##' ## or by index, which can be easier to do
##'          b <- choiceItem("a", letters, name="x", by_index=TRUE)
##'          b$get_x()
##'          b$set_x(2)
##'          b$get_x()
##' ## Size determines widget, unless you set editor_type
##' ## a radio group
##'          rg <- choiceItem("a", letters[1:3], name="x")
##' ## a combobox
##'          cb <- choiceItem("a", letters[1:8], name="x")
##' ## a table
##'          tb <- choiceItem("a", letters[1:26], name="x")
##' ## adjust size of table widget
##'          tb <- choiceItem("a", letters[1:26], name="x", attr=list(size=c(width=300,height=400)))
##' ## Multiple and size determines widget type
##' ## smaller uses checkboxgroup
##'          cbg <- choiceItem("a", letters[1:5], multiple=TRUE)
##' ## larger uses table
##'          tbl <- choiceItem("a", letters[1:15], multiple=TRUE)
##' ## place values in data frame to avoid generic header
##'          tbl <- choiceItem("a", data.frame("Column header"=letters[1:15]), multiple=TRUE)
choiceItem <- function(value="",
                       values="",       # items to choose from
                       by_index=FALSE,  # set/get by index or value
                       multiple=FALSE,  # select more than one?
                       editable=FALSE,  # if TRUE, use editable combobox
                       name,            # for lookup with item group
                       label=name,      # for display
                       help="",
                       tooltip="",
                       attr,
                       model,
                       editor,
                       editor_type=c("","gradio","gcombobox","gtable","gedit","gcheckboxgroup"),
                       ...) {

 
  
  
  if(missing(name))
    name <- "Anonymous"
  
  obj <- Item$proto(name=name, label=label, help=help,
                    tooltip=tooltip,
                    value=value, values=values,
                    properties=c("values"),
                    add_handler_name="addHandlerChanged",
                    by_index=by_index,
                    ...)

  obj$add_class("ChoiceItem")
  obj$update_ui=function(.) {}          # no enabled, visible
  ## put this in the controller -- it doesn't belong in view (editor)
  obj$init_controller=function(.) {
    .$controller <- Controller$proto(model=.$model, view=.$editor,
                                     adapters=list(
                                       value=list(
                                         property=.$name,
                                         view_widget_name=.$editor$view_widget_name,
                                         add_handler_name=.$add_handler_name)
                                       ),
                                     property_values_value_changed=function(., value, old_value) {
                                       view <- .$get_view()
                                       view$set_values_in_view(value)
                                     }
                                     )
    .$controller$by_index <- by_index
    .$controller$init()
  }

  ## fix attributes
  obj$attr <- merge(obj$attr, list(expand=TRUE, multiple=multiple))
  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)

  ## fix validate -- we pass in index
  obj$coerce_with <- function(., value) {
    if(.$by_index)
      value <- as.integer(value)
    value
  }
  obj$validate <- function(., rawvalue) {
    if(.$by_index)
      return(rawvalue)

    value <- .$next_method("validate")(., rawvalue)
    if(.$by_index) {
      if(is.integer(value))
        return(value)
      else
        stop("Not logical")
    } else {
      return(value)
    }
  }
  
  if(missing(editor))
    obj$editor <- ObjectWithValuesEditor$proto()
  
  ## automatically choose type of widget based on length of values and multiple/editable
  ## warning ugly dispatch ahead
  ed <- obj$get_editor()

  editor_type <- match.arg(editor_type)
  if(editor_type != "") {
    ed$editor_name <- editor_type
  } else if(editable) {
    ed$editor_name <- get_with_default(editor_type,"gcombobox")
    ed$attr <- c(ed$attr, list(editable=TRUE))
  } else if(!is.null(dim(values)) && length(dim(values)) == 2) {
    ed$editor_name <- "gtable"
    if(multiple)
      obj$attr <- merge(obj$attr, list(multiple=TRUE))
  } else {
    n <- length(values)
    if(multiple) {
      if(n > 0 && n <= 5) {
        ed$editor_name <- "gcheckboxgroup"
      } else {
        ed$editor_name <- "gtable"
        ed$attr <- merge(ed$attr, list(multiple=TRUE), overwrite=TRUE)
      }
    } else {
      if(n > 0 && n <= 3) {
        ed$editor_name <- "gradio"
      } else if (n > 0 && n <= 10) {
        ed$editor_name <- "gcombobox"
      } else {
        ed$editor_name <- "gtable"
      }
    }                  
  }

  ## table adjustment
  if(ed$editor_name == "gtable") {
    ## single click, not double click of addHandlerChanged
    obj$add_handler_name <- "addHandlerClicked"
    ## set default size of table -- it is just too small otherwise
    if(is.null(ed$attr$size))
      ed$attr$size <- c(300, 250)
  }
  
  ## specify how get/set is done
  obj$editor$by_index <- by_index
  obj$editor$multiple <- multiple

  if(!missing(model)) 
    obj$set_model(model)

  obj$init_model()
  
  return(obj)
}


##' A range selection item
##'
##' Editor is a slider (with spinbutton when \code{by} value is an integer).
##' @param value Default data frame for the model
##' @param from Starting value of range
##' @param to Ending value of range
##' @param by Step size to step through range. If an integer, a spinbutton is also displaye
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200))
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to Item trait
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @export
##' @examples
##' i <- rangeItem(value=5, from=0, to=10, by=1, name="rng")
##' i$get_rng()
##' i$set_rng(10)
##' i$get_rng()
rangeItem <- function(value="",
                      from=0,
                      to=10,
                      by=1,
                      name,            # for lookup with item group
                      label=name,      # for display
                      help="",
                      tooltip="",
                      attr,
                      model,
                      editor,
                      ...) {
  
  if(missing(name))
    name <- "Anonymous"
 
  obj <- Item$proto(value=value,
                    from=from, to=to, by=by,
                    name=name, label=label,
                    help=help, tooltip=tooltip,
                    ...)

  
  obj$add_class("RangeItem")
  obj$add_handler_name <- "addHandlerChanged"

  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)
  
  if(!missing(model))
    obj$set_model(model)
  
  if(missing(editor)) 
    obj$editor <- RangeEditor$proto()

  ## Need to add an observer so that spinner gets updated
  obj$init_controller=function(.) {
    if(as.integer(by) == by) {
      .$controller2 <-  Adapter$proto(model=.,#$model,
                                      view=.$editor,
                                      property=.$name,
                                      view_widget_name="spinner",
                                      validate = .$validate,
                                      add_handler_name=.$add_handler_name)

      .$controller2$init()
    }
    ## now call the standard one
    .$next_method("init_controller")(.)
  }
  
  obj$init_model()
  return(obj)

}


##' A calendar date selection item
##'
##' @param value Default data frame for the model
##' @param format_string String to specify format of date to return. See \code{\link{strftime}} for codes.
##'        default value is \code{'\%Y-\%m-\%d'}
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. \code{attr=list(size=c(100,200))}
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto
##' @export
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @seealso \code{\link{Item}}
##' @examples
##' d <- dateItem(name="d") ## basic usage, no initial date.
##' # specify intial date and reformat -- can't start in that format, it is amibiguous
##' d <- dateItem('2000-12-25', format_string='\%m-\%d-\%Y', name='d')
##' 
dateItem <- function(value="",
                     format_string,  # for format
                     name,            # for lookup with item group
                     label=name,      # for display
                     help="",
                     tooltip="",
                     attr,
                     model,
                     editor,
                     ...) {


  if(missing(name))
    name <- "Anonymous"

  if(missing(format_string))
    format_string="%Y-%m-%d"

  obj <- Item$proto(name=name, label=label, help=help,
                    tooltip=tooltip, value=value,
                    add_handler_name="addHandlerChanged",
                    format_string=format_string,
                    ...
                    )
  obj$add_class("DateItem")

  obj$coerce_with <- function(., value) strftime(value, format=.$format_string)
  
  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)
  
  if(missing(editor))
    obj$editor <- DateEditor$proto()

  if(!missing(model)) 
    obj$set_model(model)

  obj$init_model()

  return(obj)
}

##' A file selection item
##'
##' 
##' @param value Default data frame for the model
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200))
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto
##' @export
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
fileItem <- function(value="",
                     name,            # for lookup with item group
                     label=name,      # for display
                     help="",
                     tooltip="",
                     attr,
                     model,
                     editor,
                     ...) {
  
  if(missing(name))
    name <- "Anonymous"

  obj <- Item$proto(name=name, label=label, help=help,
                    tooltip=tooltip, value=value,
                    attr=list(quote=FALSE),
                    add_handler_name=paste("addHandler",c("Changed","Blur"), sep=""),
                    ...
                    )
  obj$add_class("FileBrowseItem")
  
  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)
  
  if(missing(editor))
    obj$editor <- FileBrowseEditor$proto()

  if(!missing(model)) 
    obj$set_model(model)

  obj$init_model()
  return(obj)
}

##' Button item to initiate an action
##'
##' While dialogs have a \code{buttons} property for the main buttons,
##' this item allows other buttons to be used within a dialog. One
##' must define an action (a callback) to call  when the button is
##' clicked. There are some issues with how this method is defined and
##' where it is evaluated.
##' @param value Default value for the model
##' @param action function to call when clicked. Signature is
##' \code{function(., h, ...)  {}} (like gWidgets with extra leading
##' \code{.}). The "\code{.}" is the button item, not the itemgroup or
##' dialog that this item may be a part of. When that is the case,
##' \code{.$parent} refers to the parent itemgroup or dialog. The
##' evaluation environment is not that where the action is
##' defined. This can lead to unexpected sources of error.
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name. Use "" to have not label text.
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. \code{attr=list(size=c(100,200))}
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @export
##' @seealso \code{\link{Item}}
##' @examples
##' ## basic button. Note the extra "." compared to gWidgets handler
##' b <- buttonItem("click me", action=function(.,h,...) {
##'        print("hi")
##'
##'      })
##' ## An example within a dialog
##' dlg <- aDialog(items=list(
##'                 a = stringItem(""),
##'                 b = buttonItem("Click me", label="", action=function(., h, ...) {
##'                   galert(sprintf("Item a is \%s\n", .$parent$get_a()))
##'                 })
##'                 ),
##'               title="A dialog with a button item",
##'               buttons=c()               # no standard buttons
##'               )
##'    \dontrun{dlg$make_gui()}


buttonItem <- function(value="button label",
                       action=NULL,          # function(., h, ...) {}??
                       name,            # for lookup with item group
                       label=name,      # for display
                       help="",
                       tooltip="",
                       attr,
                       model,
                       editor,
                       ...) {
  if(missing(name))
    name <- "Anonymous"


  obj <- Item$proto(name=name, label=label, help=help,
                    tooltip=tooltip,
                    value=value, action=action,
                    properties=c("action"),
                    add_handler_name="addHandlerClicked",
                    ...
                    )

  obj$add_class("ButtonItem")
  
  ## put this in the controller -- it doesn't belong in view (editor)
  obj$init_controller=function(.) {
    ed <- .$get_editor()
    widget <- ed$get_widget_by_name(ed$view_widget_name)
    addHandlerClicked(widget, function(h,...) {
      . <- h$action
#      f <- .$get_action()   # use item$set_action(function(.,h,...) {}) to change
      if(.$has_slot("action"))
        .[['action']](.,h,...)
    }, action=.)
  }

  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)
  
  if(!missing(model)) 
    obj$set_model(model)

  if(missing(editor))
    obj$editor <- ButtonEditor$proto()
  
  obj$init_model()

  obj[['action']] <- action ## XXX
  
  return(obj)
  
}

##' Simple label item
##'
##' Useful to adding text to a dialog. Has no interactivity.
##' @param value Default value for the label
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Same as \code{value}. Here for consistency, but needn't be used
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200))
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto
##' @return A proto object. Call \code{obj$show_help()} for its methods and properties
##' @export
labelItem <-  function(value="label",
                       name,            # for lookup with item group
                       label,
                       help="",
                       tooltip="",
                       attr,
                       model,
                       editor,
                       ...) {
  if(missing(name))
    name <- "Anonymous"

  if(!missing(label))
    value <- label
  
  obj <- Item$proto(name=name, label="", help=help,
                    value=value,                     
                    show_label=FALSE,
                    tooltip=tooltip,
                    add_handler_name="",
                    ...)

  obj$add_class("LabelItem")
  

  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)
  
  if(!missing(model)) 
    obj$set_model(model)

  if(missing(editor))
    obj$editor <- LabelEditor$proto()

  obj$init_model()
  return(obj)
  
}



##' Visual separator item
##'
##' Creates a horizontal (or vertical if done through "attr") line to separate GUI elements.
##' @param name name of widget
##' @param attr passed to widget constructor. Use list(horizontal=FALSE) to get vertical
##' @param ... ignored
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @export
separatorItem <- function(name=".seperator",
                          attr=list(horizontal=TRUE),
                          ...) {
  obj <- Item$proto(name=name,
                    add_handler_name="",
                    editor=SeparatorEditor$proto(),
                    show_label=FALSE,
                    init=function(.,...) {}
                    )
  obj$add_class("SeparatorItem")

  return(obj)
}

##' Item to select a data frame from the available data frames in .GlobalEnv
##'
##' This widget checks every second or so for new data frames and updates selection accordingly
##' @export
##' @param value Default data frame for the model, defaults to .GlobalEnv
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200)) This widget uses a gtable instance and specifying the size is suggested
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
dataframeItem <- function(value="",     # name of data frame
                          name,            # for lookup with item group
                          label=name,      # for display
                          help="",
                          tooltip="",
                          attr,
                          model,
                          editor,
                          ...) {


  findAvailableDataFrames <- function(., envir=.GlobalEnv) {
    tmp <- ls(envir=envir)
    ind <- sapply(tmp, function(i) {
      obj <- get(i, envir=envir)
      is.data.frame(obj)
    })
    c(".GlobalEnv",tmp[ind])
  }
  
  if(missing(name))
    name <- "Anonymous"

  values <- findAvailableDataFrames()
  if(!value %in% values)
    value <- values[1]
  
  obj <- choiceItem(value=value, values=findAvailableDataFrames(),
                    name=name, label=label,
                    help=help, tooltip=tooltip,
                    by_index=FALSE,
                    ...
                    )

  obj$add_class("DataFrameItem")
    
  ## modify some properties, methods
  obj$add_handler_name="addHandlerClicked"
  obj$.find_data_frames=findAvailableDataFrames
  ## add idle timer to update data frames
  obj$on_realized=function(.) {
    ed <- .$get_editor()
    widget <- ed$get_widget_by_name(ed$view_widget_name)
    addHandlerIdle(widget, handler = function(h,...) {
      . <- h$action$item
      old_dfs <- .$get_values()
      new_dfs <- .$.find_data_frames()
      if(digest(old_dfs) != digest(new_dfs))
        .$set_values(new_dfs)
    },
                   action=list(item=.))
  }
  
  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)

  
  if(!missing(model))
    obj$set_model(model)
  

  if(missing(editor))
    obj$editor <- ObjectWithValuesEditor$proto()

  editor <- obj$get_editor()
  editor$editor_name <- "gtable"
  editor$by_index <- FALSE
  
  obj$init_model()
  return(obj)
  
}


##' Item to select a variable (or variables) from a selected data frame
##'
##' Needs to have a dataframeItem specified to be useful. 
##' @export
##' @param value Default data frame for the model, defaults to .GlobalEnv
##' @param multiple Allow multiple selection?
##' @param dataframeItem A required dataframeItem instance. This need not be in same display, or even displayed
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200)) This widget uses a gtable instance and specifying the size is suggested
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto
##' @seealso \code{\link{dataframeItem}}, \code{\link{Item}}
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @examples
##' df <- data.frame(a=1:3, b= letters[1:3], c=rnorm(3)) # make a data frame
##' dfI <- dataframeItem(value="df", name="dfI")
##' dlg <- aDialog(items=list(
##'        dfI,                      ## a bit awkward -- can't define dfI in list of items
##' variable=variableSelectorItem(dataframeItem=dfI))
##' )
##' \dontrun{ dlg$make_gui() }
variableSelectorItem <- function(value=NA,
                                 multiple=FALSE,
                                 dataframeItem, # necessary
                                 name,            # for lookup with item group
                                 label=name,      # for display
                                 help="",
                                 tooltip="",
                                 attr,
                                 model,
                                 editor,
                                 ...
                                 ) {

  list_possible_variables <- function(., dfname) {
    if(dfname == ".GlobalEnv" || dfname=="") {
      ## list all for now
      values <- ls(envir=.GlobalEnv)
    } else {
      values <- names(get(dfname, envir=.GlobalEnv))
    }
    return(values)
  }

  if(missing(name))
    name <- "Anonymous"

  dfi <- dataframeItem$instance()
  df <- dfi$getattr(dfi$name)
  obj <- choiceItem(value=value, values=list_possible_variables(NA,df),
                    name=name, label=label,
                    help=help, tooltip=tooltip,
                    by_index=FALSE,
                    multiple=as.logical(multiple),
                    ...)
  
  obj$add_class("VariableSelectorItem")
  obj$add_handler_name <- "addHandlerClicked"
  obj$.list_possible_variables <- list_possible_variables
  obj$validate = function(...) {}
  ## we need to add an observer to the dataframeItem model so we update values in obj
  ## when data frame has changed
  cont <- Controller$proto(.item = obj)
  assign(sprintf("property_%s_value_changed",dfi$name), function(., value, old_value) {
    i <- .$.item
    ## can cause error on initialization ????
    values <- try(i$.list_possible_variables(value), silent=TRUE)
    if(!inherits(values, "try-error"))
      i$set_values(values)
    invisible()
  }, envir=cont)
  
  dataframeItem$add_observer(cont)


  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)
  
  if(!missing(model))
    obj$set_model(model)

  if(missing(editor))
    obj$editor <- ObjectWithValuesEditor$proto(editor_name="gtable")

  obj$init_model()
  return(obj)
}

## graph item,  dataEditItem?, menu, toolbar for dialog

## These are kind of not needed -- we can use gWidgets gaction here.



##' A graphic device item. (Only with RGtk2 and cairoDevice!)
##'
##' This device will become the current one if the mouse clicks in the window,
##' This isn't perfect, but should be easy enough to get used to.
##' This only works with gWidgetsRGtk2, gWidgetsQt
##' @export
##' @param value ingored
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200)).
##' @param model ignored
##' @param editor ignored
##' @param ... Passed to parent proto object during call to proto
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @note With \pkg{gWidgetsRGtk2}, there is some thing odd that
##' causes a display to pop up before the cairo Device if no devices
##' are open.
##' @seealso \code{\link{Item}}
##' @examples
##' graphIt <- function(n, ...) hist(rnorm(n))
##' dlg <- aDialog(items=list(n=integerItem(10), out=graphicDeviceItem()),
##' model_value_changed=function(.) do.call("graphIt", .$to_R()) ## ... allows out to pass in unnoticed
##' )
##' \dontrun{dlg$make_gui()
##' graphIt(dlg$get_n()) ## initial graphic
##' }
##' 
graphicDeviceItem <- function(value="", # ignored
                              name,            # for lookup with item group
                              label=name,      # for display
                              help="",
                              tooltip="",
                              attr = list(size=c(480,480)),
                              model,   # ignored
                              editor,   # ignored
                              ...
                              ) {

  if(missing(name))
    name <- "Anonymous"
  
  obj <- Item$proto(name=name,
                    editor=GraphEditor$proto(),
                    attr=attr,
                    add_handler_name="",
                    show_label=FALSE,
                    init=function(.,...) {},
                    ...
                    )
  obj$add_class("GraphItem")
  
  return(obj)
}


##' Display an image specified by its filename.
##'
##' @param value name of file
##' @param name Required name for object. Names should be unique within a group of items
##' @param label ignored
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200)).
##' @param model ignored
##' @param editor ignored
##' @param ... Passed to parent proto object during call to proto
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @export
##' @seealso \code{\link{Item}}
##' @examples
##' img <- system.file("images/plot.gif", package="gWidgets")   ## some image
##' i <- imageItem(img)                                         ## constructor
##' \dontrun{i$make_ui(container=gwindow("Image"))}                       ## show item directly
imageItem <- function(value="", 
                      name,            # for lookup with item group
                      label=name,      # ignored
                      help="",
                      tooltip="",
                      attr = list(),
                      model,  
                      editor,
                      ...
                      ) {
  
  if(missing(name))
    name <- "Anonymous"
  
  obj <- Item$proto(value=value,
                    name=name,
                    help=help, tooltip=tooltip,
                    show_label=FALSE,
                    add_handler_name="", # "" for no view->model
                    ...
                    )
  obj$add_class("ImageItem")

  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)

  
  if(!missing(model))
    obj$set_model(model)
  

  if(missing(editor))
    obj$editor <- ImageEditor$proto()


  obj$init_model()
  return(obj)
}

##' List editor -- list <-> tree, must have special structure to list?
##' XXX This needs writing

##' An item to display a table of data (given as a matrix or data.frame)
##'
##' @param value Default value of data frame
##' @param name Required name for object. Names should be unique within a group of items
##' @param label ignored
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200)).
##' @param model ignored
##' @param editor ignored
##' @param ... Passed to parent proto object during call to proto
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
##' @seealso \code{\link{Item}}
##' @examples
##' ## to change data frame
##' i <- tableItem(mtcars, name="a")
##' i$set_a(mtcars[1:3, 1:3])
##' @export
tableItem <- function(value=data.frame(V1="",V2=""),
                      name,            # for lookup with item group
                      label=name,      # ignored
                      help="",
                      tooltip="",
                      attr = list(expand=TRUE),
                      model,  
                      editor,
                      ...
                      ) {
  
  if(missing(name))
    name <- "Anonymous"
  
  obj <- Item$proto(value=value,
                    name=name,
                    help=help, tooltip=tooltip,
                    show_label=FALSE,
                    add_handler_name="", # "" for no view->model
                    ...
                    )

  obj$add_class("TableItem")
  obj$coerce_with <- function(.,value, ...) value
  obj$validate <- NULL

  obj$to_R <- function(., drop=TRUE) {
    l <- list()
    l[[.$name]] <- svalue(.$editor$get_widget(), drop=drop)
    l
  }
  
  if(!missing(attr))
    obj$attr <- merge(obj$attr, attr)
  
  
  if(!missing(model))
    obj$set_model(model)

  if(missing(editor))
    obj$editor <- TableEditor$proto()
  
  obj$init_model()

  return(obj)
}



### XXX -- XXX -- WRITE ME -- XXX -- XXX
##' A formula Item
##' @export
##' @param value Default data frame for the model
##' @param dataframeItem A required dataframeItem instance. This need not be in same display, or even displayed
##' @param name Required name for object. Names should be unique within a group of items
##' @param label Optional label, default value is the name
##' @param help Optional help string
##' @param tooltip Optional tooltip to display
##' @param attr A list of attributes to pass to widget on construction. Eg. attr=list(size=c(100,200)) This widget uses a gtable instance and specifying the size is suggested
##' @param model Optional model. Useful if one wishes to use same model for multiple views
##' @param editor Specification of editor (a view) to override default
##' @param ... Passed to parent proto object during call to proto
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
formulaItem <- function(value="",
                        dataframeItem, # necessary
                        name,            # for lookup with item group
                        label=name,      # for display
                        help="",
                        tooltip="",
                        attr,
                        model,
                        editor,
                        ...
                        ) {
  cat("XXX This needs to be written, but first write gwidgets gformula function XXX")
  labelItem(value="no formulaItem yet", name=name)
}


  ## XXX
##' data frame editor item. Needs writing
##'
##' Write me
##' @param ... to be replaced with actual arguments
##' @export
##' @return A \code{proto} object. Call \code{obj$show_help()} to view its methods and properties.
dfEditItem <- function(...) {
  cat("XXX This needs to be written XXX")
  labelItem(value="no data frame editing item yet (gdf)", name="Anonymous")
}