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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
# ----------------------------------------------------------------------
# EXAMPLE: TextDisplay widget
# ----------------------------------------------------------------------
# COURSE: Object-Oriented Programming with [incr Tcl]
# AUTHOR: Michael J. McLennan, Bell Labs Innovations
# ======================================================================
# Copyright (c) 1996 Lucent Technologies
# ======================================================================
option add *TextDisplay.width 3i widgetDefault
option add *TextDisplay.height 2i widgetDefault
option add *TextDisplay.scrollbar auto widgetDefault
option add *TextDisplay.wrap none widgetDefault
option add *TextDisplay.textBackground ivory widgetDefault
class TextDisplay {
inherit itk::Widget
constructor {args} {
itk_option add hull.width hull.height
itk_component add text {
text $itk_interior.info -state disabled -width 1 -height 1 \
-yscrollcommand [code $itk_interior.sbar set]
} {
usual
keep -wrap -tabs
rename -background -textbackground textBackground Background
}
pack $itk_component(text) -side left -expand yes -fill both
itk_component add scrollbar {
scrollbar $itk_interior.sbar \
-command [code $itk_interior.info yview]
}
pack $itk_component(scrollbar) -side right -fill y
eval itk_initialize $args
pack propagate $itk_component(hull) 0
fixScrollbar
bind $itk_component(text) <Configure> [code $this fixScrollbar]
$itk_component(text) tag configure bold \
-font -*-courier-bold-r-normal--*-120-*
$itk_component(text) tag configure italic \
-font -*-courier-medium-o-normal--*-120-*
}
public method display {info}
public method append {info}
public method substitute {word newword}
itk_option define -scrollbar scrollbar Scrollbar "on" {
switch -- $itk_option(-scrollbar) {
on - off - auto {
fixScrollbar
}
default {
error "bad value \"$itk_option(-scollbar)\""
}
}
}
protected method fixScrollbar {}
private variable sbvisible 1
}
body TextDisplay::display {args} {
$itk_component(text) configure -state normal
$itk_component(text) delete 1.0 end
eval $itk_component(text) insert 1.0 $args
$itk_component(text) configure -state disabled
fixScrollbar
}
body TextDisplay::append {args} {
$itk_component(text) configure -state normal
eval $itk_component(text) insert end $args
$itk_component(text) configure -state disabled
fixScrollbar
}
body TextDisplay::substitute {word newword} {
$itk_component(text) configure -state normal
set index 1.0
while {1} {
set index [$itk_component(text) search -count len $word $index]
if {$index != ""} {
$itk_component(text) delete $index "$index + $len chars"
$itk_component(text) insert $index $newword
} else {
break
}
}
$itk_component(text) configure -state disabled
fixScrollbar
}
body TextDisplay::fixScrollbar {} {
switch $itk_option(-scrollbar) {
on { set sbstate 1 }
off { set sbstate 0 }
auto {
if {[$itk_component(text) bbox 1.0] == "" ||
[$itk_component(text) bbox end-1char] == ""} {
set sbstate 1
} else {
set sbstate 0
}
}
}
if {$sbstate != $sbvisible} {
if {$sbstate} {
pack $itk_component(scrollbar) -side right -fill y
} else {
pack forget $itk_component(scrollbar)
}
set sbvisible $sbstate
}
}
usual TextDisplay {
keep -background -cursor -foreground -font
keep -activebackground -activerelief
keep -highlightcolor -highlightthickness
keep -insertbackground -insertborderwidth -insertwidth
keep -insertontime -insertofftime
keep -selectbackground -selectborderwidth -selectforeground
keep -textbackground -troughcolor
}
|
