/[ascend]/trunk/tcltk/TK/templates/AscMonoEntry1.t
ViewVC logotype

Contents of /trunk/tcltk/TK/templates/AscMonoEntry1.t

Parent Directory Parent Directory | Revision Log Revision Log


Revision 571 - (show annotations) (download) (as text)
Tue May 9 00:14:59 2006 UTC (18 years ago) by johnpye
File MIME type: application/x-troff
File size: 6419 byte(s)
Renaming 'tcltk98' to 'tcltk', continued...
1 # /************************************************************\ #
2 # Module: ascMonoEntry1.t
3 # written by Kirk Abbott
4 # Date: $Date: 1998/06/16 14:07:32 $
5 # Version: $Revision: 1.7 $
6 # \************************************************************/ #
7 #
8 # Module: ascMonoEntry1.t
9 # Tcl version: 8.0
10 # Tk version: 8.0
11 # XF version: 2.2
12 #
13 # ascMonoEntry1id $Id: AscMonoEntry1.t,v 1.7 1998/06/16 14:07:32 ballan Exp $
14 #
15
16 # /************************************************************\ #
17 # AscMonoEntry1
18 # Generic EntryBox for one bit of information.
19 # Makes use of a global vector AscMonoEntry1
20 # Takes colors from internal resources
21 # Arguements :
22 # AscMonoEntry1Text -- a label for the data -- default Variable Value
23 # AscMonoEntry1Geom -- geometry -- default 400x100
24 # AscMonoEntry1Info -- information to be inserted in the box -- default ""
25 # AscMonoEntry1Label -- Command prompt -- default "Enter Value"
26 # Returns :
27 # Will leave the result in the global vector if Ok button is pressed or if
28 # the <Return> key is pressed when the focus is in the box, i.e will leave
29 # the number of the button pressed (1-3), and will attempt to invoke a
30 # command called OKCommand.ascMonoEntry1 or CancelCommand.ascEntry1.
31 # Will leave the value of the data in AscMonoEntry1Info.
32 # Will return also a formatted list of :the button number and the value of
33 # the data.This box is modal.
34 #
35 # user configurable properties
36 # AscMonoEntry1(font) -*-* (duh)
37 # dealing with the help button request is the callers problem.
38 # \************************************************************/ #
39
40 global AscMonoEntry1
41
42 set AscMonoEntry1(button) 0
43 set AscMonoEntry1(result) ""
44 set AscMonoEntry1(font) -*-*
45 #
46 # procedures to show window .ascMonoEntry1
47 #
48 proc VShowWindow.ascMonoEntry1 {{AscMonoEntry1Text "Variable Value"} \
49 {AscMonoEntry1Geom 400x100} \
50 {AscMonoEntry1Info ""} \
51 {AscMonoEntry1Label "Enter Value"} \
52 {helpcommand "error no-help-yet sloppy-ui-author--not-a-bug"}} {
53 # xf ignore me 5
54
55 global AscMonoEntry1
56 toplevel .ascMonoEntry1
57
58 # Window manager configurations
59 global tk_version
60 wm positionfrom .ascMonoEntry1 ""
61 wm sizefrom .ascMonoEntry1 ""
62 wm minsize .ascMonoEntry1 400 100
63 wm geometry .ascMonoEntry1 $AscMonoEntry1Geom
64 wm title .ascMonoEntry1 "Enter $AscMonoEntry1Text"
65 wm iconname .ascMonoEntry1 "Enter $AscMonoEntry1Text"
66
67
68 # build widget .ascMonoEntry1.buttons_frm
69 frame .ascMonoEntry1.buttons_frm
70
71
72 # build widget .ascMonoEntry1.buttons_frm.ok_btn
73 button .ascMonoEntry1.buttons_frm.ok_btn \
74 -font $AscMonoEntry1(font) \
75 -text {OK} \
76 -width {10} \
77 -command "
78 global AscMonoEntry1
79 set AscMonoEntry1(result) \
80 \[.ascMonoEntry1.entry_frm.left_entry get\]
81 OKCommand.ascMonoEntry1
82 set AscMonoEntry1(button) 1
83 catch {destroy .ascMonoEntry1}"
84
85 # build widget .ascMonoEntry1.buttons_frm.cancel_btn
86 button .ascMonoEntry1.buttons_frm.cancel_btn \
87 -font $AscMonoEntry1(font) \
88 -text {Cancel} \
89 -width {10} \
90 -command "
91 global AscMonoEntry1
92 CancelCommand.ascMonoEntry1
93 set AscMonoEntry1(button) 2
94 set AscMonoEntry1(result) {}
95 catch {destroy .ascMonoEntry1}"
96
97 # build widget .ascMonoEntry1.buttons_frm.help_btn
98 button .ascMonoEntry1.buttons_frm.help_btn \
99 -font $AscMonoEntry1(font) \
100 -text {Help} \
101 -width {10} \
102 -command "
103 global AscMonoEntry1
104 set AscMonoEntry1(button) 3
105 $helpcommand
106 catch {destroy .ascMonoEntry1}"
107
108 # pack widget .ascMonoEntry1.buttons_frm
109 pack append .ascMonoEntry1.buttons_frm \
110 .ascMonoEntry1.buttons_frm.ok_btn {left frame e expand} \
111 .ascMonoEntry1.buttons_frm.cancel_btn {left frame center expand} \
112 .ascMonoEntry1.buttons_frm.help_btn {left frame w expand}
113
114 # build widget .ascMonoEntry1.entry_frm
115 frame .ascMonoEntry1.entry_frm
116
117 # build widget .ascMonoEntry1.entry_frm.left_entry
118 entry .ascMonoEntry1.entry_frm.left_entry \
119 -exportselection 0 \
120 -font $AscMonoEntry1(font) \
121 -width {33}
122 #
123 #Initial Entry
124 .ascMonoEntry1.entry_frm.left_entry delete 0 end
125 .ascMonoEntry1.entry_frm.left_entry insert end "$AscMonoEntry1Info"
126
127 #bindings
128 bind .ascMonoEntry1.entry_frm.left_entry <Return> "
129 global AscMonoEntry1
130 set AscMonoEntry1(result) \[%W get\]
131 set AscMonoEntry1(button) 1
132 OKCommand.ascMonoEntry1
133 catch {destroy .ascMonoEntry1}"
134
135 # build widget .ascMonoEntry1.entry_frm.value_label
136 label .ascMonoEntry1.entry_frm.value_label \
137 -width {15} \
138 -font $AscMonoEntry1(font) \
139 -text "$AscMonoEntry1Text"
140
141 # build widget .ascMonoEntry1.entry_frm.bmcanvas
142 set tl .ascMonoEntry1.entry_frm
143 canvas $tl.bmcanvas -width 33 -height 27
144 $tl.bmcanvas create bitmap 0 0 -background yellow \
145 -anchor nw -bitmap grablock
146 pack append $tl $tl.bmcanvas {left frame center}
147
148 # pack widget .ascMonoEntry1.entry_frm
149 pack append .ascMonoEntry1.entry_frm \
150 .ascMonoEntry1.entry_frm.value_label {left frame center filly} \
151 .ascMonoEntry1.entry_frm.left_entry {left frame center expand fill}
152
153 if {[info exists AscMonoEntry1Label] && $AscMonoEntry1Label != ""} {
154 # build widget .ascMonoEntry1.label_frm
155 frame .ascMonoEntry1.label_frm
156
157 # build widget .ascMonoEntry1.label_frm.box_label
158 label .ascMonoEntry1.label_frm.box_label \
159 -font $AscMonoEntry1(font) \
160 -text "$AscMonoEntry1Label"
161
162 # pack widget .ascMonoEntry1.label_frm
163 pack append .ascMonoEntry1.label_frm \
164 .ascMonoEntry1.label_frm.box_label {left frame center}
165
166 pack append .ascMonoEntry1 \
167 .ascMonoEntry1.label_frm {top frame center expand fill} \
168 }
169 # pack widget .ascMonoEntry1
170 pack append .ascMonoEntry1 \
171 .ascMonoEntry1.entry_frm {top frame center expand fill} \
172 .ascMonoEntry1.buttons_frm {top frame center expand fill}
173
174 #
175 # Get Data and Catch response.
176 #
177 # wait for the box to be destroyed
178 focus .ascMonoEntry1.entry_frm.left_entry
179 update idletask
180 bind .ascMonoEntry1 <Visibility> {ascKeepOnTop %W}
181 grab .ascMonoEntry1
182 tkwait window .ascMonoEntry1
183 set data [list $AscMonoEntry1(button) $AscMonoEntry1(result)]
184 return $data
185 }
186
187
188 proc DestroyWindow.ascMonoEntry1 {} {# xf ignore me 5
189
190 catch "destroy .ascMonoEntry1"
191 update
192 }
193 proc OKCommand.ascMonoEntry1 {} {
194 global AscMonoEntry1
195 }
196 proc CancelCommand.ascMonoEntry1 {} {
197 global AscMonoEntry1
198 }
199 # eof
200 #
201
202
203
204
205
206
207
208
209

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22