1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
setClass("gLabeltcltk",
contains="gComponenttcltk",
representation = representation("gComponenttcltk",
markup="logical"),
prototype=prototype(new("gComponenttcltk"))
)
## constructor
setMethod(".glabel",
signature(toolkit="guiWidgetsToolkittcltk"),
function(toolkit,
text= "", markup = FALSE, editable = FALSE, handler = NULL,
action = NULL, container = NULL,
...
) {
force(toolkit)
if(markup) {
gwCat(gettext("In gWidgetstcltk there is no markup language. Use font()<- instead.\n"))
}
if(is(container,"logical") && container)
container = gwindow()
if(!(is(container,"guiWidget") || is(container,"gWidgettcltk"))) {
warning("Container is not correct. No NULL containers possible\n" )
return()
}
tt <- getWidget(container)
label <- ttklabel(tt, text="")
obj <- new("gLabeltcltk",
block=label, widget=label, markup=markup,
toolkit=toolkit,ID=getNewID(), e = new.env())
## add text
svalue(obj) <- text
## add to container
add(container, obj, ...)
if(editable) {
handler <- function(h,...) {
val = ginput(message="Change label value:",text=svalue(h$obj),
title="Change text for label", icon="question")
if(!is.na(val))
svalue(obj) <- val
}
}
if(!is.null(handler)) {
id <- addhandlerclicked(obj, handler=handler,action=action)
}
invisible(obj)
})
### methods
setMethod(".svalue",
signature(toolkit="guiWidgetsToolkittcltk",obj="gLabeltcltk"),
function(obj, toolkit, index=NULL, drop=NULL, ...) {
val = tclvalue(tkcget(getWidget(obj),"-text")) # respects "\n"
if(length(val) == 0)
val=""
return(val)
})
setReplaceMethod(".svalue",
signature(toolkit="guiWidgetsToolkittcltk",obj="gLabeltcltk"),
function(obj, toolkit, index=NULL, ..., value) {
txt <- paste(as.character(value), collapse="\n")
tkconfigure(obj@widget, text=txt)
return(obj)
})
setMethod(".addhandlerchanged",
signature(toolkit="guiWidgetsToolkittcltk",obj="gLabeltcltk"),
function(obj, toolkit, handler, action=NULL, ...) {
.addhandlerclicked(obj, toolkit, handler, action, ...)
})
##################################################
## internal function -- used by gvariables in gcommandline
setGeneric("gaddlabel", function(obj, text="", markup=FALSE, pos=1, container=NULL, ...) standardGeneric("gaddlabel"))
setMethod("gaddlabel",
signature("guiWidget"),
function(obj, text="", markup=FALSE, pos=1, container=NULL, ...)
gaddlabel(obj@widget, text, markup, pos, container, ...)
)
setMethod("gaddlabel",
signature("gWidgettcltk"),
function(obj, text="", markup=FALSE, pos=1, container=NULL, ...) {
## wrap widget into a new package with label
if(pos %in% c(2,4)) {
group = ggroup(horizontal=TRUE,container=container,
toolkit=obj@toolkit)
} else {
group = ggroup(horizontal=FALSE,container=container,
toolkit=obj@toolkit)
}
if(pos %in% 2:3) {
glabel(text, markup=markup, container=group, toolkit=obj@toolkit)
add(group, obj,expand=TRUE)
} else {
add(group, obj,expand=TRUE)
glabel(text, markup=markup, container=group, toolkit=obj@toolkit)
}
## group is returned. No methods added here, just a new package
return(group)
})
|
