##' @include GWidget.R
NULL
##' toolkit implementation of gtext
##'
##' @inheritParams gWidgets2::gtext
##' @export
##' @rdname gWidgets2tcltk-undocumented
##' @method .gtext guiWidgetsToolkittcltk
.gtext.guiWidgetsToolkittcltk <- function(toolkit,
text = NULL, width = NULL, height = 300, font.attr = NULL,
wrap = TRUE,
handler = NULL, action = NULL, container = NULL,... ) {
GText$new(toolkit,
text = text, width = width, height = height,
font.attr = font.attr, wrap = wrap,
handler = handler, action = action, container = container, ...
)
}
GText <- setRefClass("GText",
contains="GWidget",
fields=list(
buffer="ANY",
tag_table="ANY",
xscr="ANY",
yscr="ANY"
),
methods=list(
initialize=function(toolkit=NULL,
text = NULL, width = NULL, height = 300,
font.attr = NULL, wrap = TRUE,
handler=NULL, action=NULL, container=NULL, ...) {
## arguments
if(wrap) wrap <- "word" else wrap <- "none"
init_widget(container)
tkconfigure(widget, wrap=wrap, undo=TRUE, setgrid=FALSE)
initFields(change_signal="<KeyRelease>")
## set point
tkmark.set(widget,"insert","0.0")
## font.attr sets text properties for entire buffer
if(!is.null(font.attr)) {
set_font(font.attr)
}
set_value(text)
add_to_parent(container, .self, ...)
handler_id <<- add_handler_changed(handler, action)
callSuper(toolkit)
},
init_widget=function(container) {
## set up block and widget with scrollbars
block <<- ttkframe(container$get_widget())
widget <<- tktext(block)
xscr <<- ttkscrollbar(block, orient="horizontal",
command=function(...)tkxview(widget,...))
yscr <<- ttkscrollbar(block,
command=function(...)tkyview(widget,...))
tkconfigure(widget,
xscrollcommand=function(...)tkset(xscr,...),
yscrollcommand=function(...)tkset(yscr,...)
)
## pack into a grid
## see tkFAQ 10.1 -- makes for automatic resizing
tkgrid(widget,row=0,column=0, sticky="news")
tkgrid(yscr,row=0,column=1, sticky="ns")
tkgrid(xscr, row=1, column=0, sticky="ew")
tkgrid.columnconfigure(block, 0, weight=1)
tkgrid.rowconfigure(block, 0, weight=1)
if(!is_aqua()) {
tcl("autoscroll::autoscroll", xscr)
tcl("autoscroll::autoscroll", yscr)
tkgrid.propagate(block, FALSE)
}
},
has_selection=function() {
as.character(tclvalue(tktag.ranges(widget, "sel"))) != ""
},
get_value=function(drop=FALSE, ...) {
"Return text, or selected text if drop=TRUE. If index=TRUE, return index of text"
## if drop=FALSE or NULL grab all text
## if drop=TRUE, get selected text only
if(is.null(drop) || drop == FALSE) {
val <- tclvalue(tkget(widget, "0.0", "end"))
## strip off last "\n"'s
val <- gsub("\n*$","",val)
} else {
range <- as.numeric(tktag.ranges(widget, "sel"))
## range is numeric(0) if none
if(length(range) > 0)
val <- tclvalue(tkget(getWidget(obj),"sel.first","sel.last"))
else
val <- ""
}
## val = unlist(strsplit(val,"\n"))
return(val)
},
set_value=function(value, drop=FALSE, ...) {
"Replace all text, pasted together with newline or replace selection"
value <- paste(value, collapse="\n")
if (drop) {
tcl(widget,"replace", "sel.first", "sel.last", value)
} else {
tkdelete(widget,"0.0", "end") # clear old
tkinsert(widget, "end", value)
tksee(widget, "0.0")
}
},
get_index = function(...) {
"Return the index of the selected text"
## get the selected text from gtext,
## return the index instead of text.
if(has_selection())
## row.column: row 1-based, column 0-based
val <- as.character(tktag.ranges(widget, "sel"))
else
val <- c(0,0)
return(as.numeric(val))
},
set_index = function(value,...) {
"set selection by range of rows"
start <- min(value)
end <- max(value)
### XXX
},
get_items = function(i, j, ..., drop=TRUE) {
stop("Not defined")
},
set_items = function(value, i, j, ...) {
stop("Not defined")
},
insert_text=function(value,
where=c("end", "beginning", "at.cursor"),
font.attr=NULL,
do.newline=TRUE, ...) {
where <- match.arg(where)
where <- c(end="end", at.cursor="insert", beginning="0.0")[where]
value <- paste(value,collapse="\n")
if(do.newline) {
value <- paste(value,"\n",sep="")
}
## Handle markup here
if(!is.null(font.attr) && length(font.attr) > 0) {
l <- list()
l$foreground <- font.attr$color
family <- font_family(font.attr$family)
if(family != "")
l$font <- sprintf("{%s %s %s %s}", family, font_size(font.attr$size),
font_style(font.attr$style), font_weight(font.attr$weight))
## pass on other attributes
others <- font.attr[setdiff(names(font.attr), c("color", "family", "size", "style", "weight"))]
if(length(others) > 1)
l <- merge_list(l, others)
## make a random tag name
tagname <- paste(sample(letters, 10,T), collapse="")
do.call(function(...) tktag.configure(widget, tagname, ...), l)
tkinsert(widget, where, value, tagname)
} else {
## no markup
tkinsert(widget, where, value)
}
## does this place the cursor? TK FAQ 10.6
## move cursor, unless an at.cursor event (which moves things down)
if(where != "insert")
tksee(widget, "insert")
},
set_font=function(value) {
if(has_selection()) {
selected <- as.character(tktag.ranges(widget, "sel"))
fname <- paste(as.character(date()),rnorm(1), sep="") ## some random string
## make font, tag in buffer, configure tag
fontList <- map_font_to_spec(value, TRUE)
do.call("tkfont.create", merge_list(fname, fontList))
tktag.add(widget, fname, selected[1], selected[2])
tktag.configure(widget, fname, font=fname)
if("color" %in% names(value))
tktag.configure(widget, fname, foreground=value$color)
} else {
## clear out old tags -- we are resetting
tagNames <- as.character(tktag.names(widget))
sapply(tagNames, function(i) tktag.delete(widget, i))
## set selection to entire buffer
tcl(widget, "tag", "add", "sel", "0.0", "end")
set_font(value)
tcl(widget, "tag", "remove", "sel", "0.0", "end") ## clear selection
}
},
add_handler_changed=function(handler, action=NULL, ...) {
add_handler_keystroke(handler, action=action, ...)
},
add_handler_selection_changed=function(handler, action=NULL, ...) {
add_handler("<<Selection>>", handler, action)
},
undo=function() {
tcl(widget, "undo")
},
redo=function() {
tcl(widget, "redo")
},
can_undo=function() {
## XXX no clue
},
can_redo=function() {
## XXX no clue
}
))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.