Nothing
##' @include GWidget.R
NULL
##' Toolkit constructor
##'
##' @inheritParams gWidgets2::gcombobox
##' @export
##' @rdname gWidgets2tcltk-undocumented
##' @method .gcombobox guiWidgetsToolkittcltk
.gcombobox.guiWidgetsToolkittcltk <- function(toolkit,
items, selected = 1, editable = FALSE, coerce.with = NULL,
handler = NULL,action = NULL, container = NULL, ... ) {
if(editable)
GComboBoxWithEntry$new(toolkit,
items, selected = selected, coerce.with = coerce.with,
handler = handler,action = action, container = container, ...)
else
GComboBoxNoEntry$new(toolkit,
items, selected = selected, coerce.with = coerce.with,
handler = handler,action = action, container = container, ...)
}
## We create two subclasses of this to handle editable and
## non-editable situation. These methods end up being in common for
## both.
GComboBox <- setRefClass("GComboBox",
contains="GWidgetWithTclVariable",
fields=list(
items="ANY"
),
methods=list(
normalize_items=function(value) {
## no icons, tooltips, ... in tcltk
if(inherits(value,"data.frame")) {
value <- value[,1, drop=TRUE]
}
value <- unique(as.vector(value))
value
},
get_value=function(...) {
val <- as.character(tclvalue(t_var))
if(nchar(val) == 0)
val <- get_items(integer(0)) # 0-length object with same class as items
val
},
## set value in subclass
get_index = function(...) {
val <- get_value()
if(length(val) == 0)
return(0L)
ind <- match(val, items)
ind
},
set_index = function(value,...) {
value <- min(get_length(), max(0, as.integer(value)))
set_value(items[value])
},
set_items=function(value, i, ...) {
value <- normalize_items(value)
items <<- value
## careful with length 1
if(length(value) == 1)
values <- as.tclObj(as.character(value))
else
values <- as.character(value)
tkconfigure(widget, values=values)
set_value("")
},
get_items=function(i, ...) {
items[i]
},
## ,
## add_handler_changed=function(handler, action=NULL, ...) {
## add_handler_clicked(handler, action=NULL, ...)
## },
get_length=function() {
base::length(items)
},
add_handler_clicked = function(handler, action=NULL, ...) {
add_handler("changed", handler, action=action, ...)
},
## work around https://github.com/jverzani/gWidgets2/issues/98
set_font_ttk = function(value, obj=get_widget(), listbox=TRUE) {
spec <- map_font_to_spec(value, FALSE)
speclst <- map_font_to_spec(value, TRUE)
## we create a style
color <- value$color
spec <- gsub("\\s*$", "", spec)
kls <- as.character(tkwinfo("class", obj))
style_name <- sprintf("%s_%s.%s", gsub(" ", "", spec), ifelse(is.null(color), "black", color), kls)
fnt <- sprintf("font create %s %s", style_name, paste("-", names(speclst), " ", speclst, sep="", collapse=" "))
.Tcl(fnt) # make a font
tkconfigure(obj, font=style_name) # apply to widget
if (listbox)
.Tcl(sprintf("option add *TCombobox*Listbox.font %s",style_name)) # add font to *all* dropdown values
if(!is.null(color))
tcl("ttk::style", "configure", style_name, font=spec, foreground=color)
#tkconfigure(obj, style=style_name)
}
))
## combobox without entry can have icons, use rGtkDataFrame
GComboBoxNoEntry <- setRefClass("GComboBoxNoEntry",
contains="GComboBox",
methods=list(
initialize=function(toolkit,
items, selected = 1, coerce.with = NULL,
handler = NULL,action = NULL, container = NULL, ...) {
value <- normalize_items(items)
t_var <<- tclVar(value[selected])
widget <<- ttkcombobox(container$get_widget(),
values="",
textvariable=t_var,
state="readonly"
)
initFields(block=widget,
coerce_with=coerce.with,
change_signal="<<ComboboxSelected>>"
)
set_items(value)
set_index(selected)
add_to_parent(container, .self, ...)
handler_id <<- add_handler_changed(handler, action)
callSuper(toolkit)
},
set_value=function(value, ...) {
if(is.factor(value))
value <- as.character(value)
tmp <- t_var
if(length(value) == 0 || value == "")
tclvalue(tmp) <- ""
else if(value %in% items) {
tclvalue(tmp) <- value
}
}
))
## The editable code is *different* from the non-editable code, as the
## gtkComboBoxNewWithEntry method isn't there yet. Instead we need to
## use a convenience function and manipulate the values with that.
## This method is deprecated as of 2.24, but that isn't what I have
## installed
GComboBoxWithEntry <- setRefClass("GComboBoxWithEntry",
contains="GComboBox",
fields=list(
poss_items="ANY"
),
methods=list(
initialize=function(toolkit=NULL,
items,
selected = 1, # use 0 for blank
coerce.with = NULL,
handler, action, container, ...) {
## mostly repeats above
value <- normalize_items(items)
t_var <<- tclVar(value[selected])
widget <<- ttkcombobox(container$get_widget(),
values="",
textvariable=t_var,
state="normal"
)
initFields(block=widget,
coerce_with=coerce.with,
change_signal="<<ComboboxSelected>>"
)
set_items(value)
set_index(selected)
add_to_parent(container, .self, ...)
handler_id <<- add_handler_changed(handler, action)
callSuper(toolkit)
},
set_value=function(value, ...) {
if(length(value) == 0)
value <- ""
tmp <- t_var
tclvalue(tmp) <- value
},
## if editable, allow us to toggle
get_editable=function(...) {
as.character(tkcget(widget, "state")) == "normal"
},
set_editable=function(value) {
tkconfigure(widget, state=ifelse(value, "normal", "readonly"))
},
## does this map to addHandlerEnter??
add_handler_edited = function(handler, action=NULL, ...) {
"For editing -- need a better name XXX"
add_handler("<Return>", handler, action, ...)
}
))
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.