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

Contents of /trunk/tcltk/TK/templates/AscMonoEntry2.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: 6912 byte(s)
Renaming 'tcltk98' to 'tcltk', continued...
1 # /************************************************************\ #
2 # Module: ascMonoEntry2.t
3 # written by Kirk Abbott
4 # Date:$Date: 1998/06/16 14:07:33 $
5 # Version:$Revision $
6 # \************************************************************/ #
7 #
8 # Module: ascMonoEntry2.t
9 # Tcl version: 8.0
10 # Tk version: 8.0
11 # XF version: 2.2
12 #
13 # ascMonoEntry2id $Id: AscMonoEntry2.t,v 1.6 1998/06/16 14:07:33 ballan Exp $
14 #
15
16 # /************************************************************\ #
17 # AscMonoEntry2
18 # Generic EntryBox for two pieces of information.
19 # Makes use of a global vector AscMonoEntry2
20 # Arguements :
21 # AscMonoEntry2Text -- a label for the data -- default Variable Value
22 # AscMonoEntry2Geom -- geometry -- default 400x100
23 # AscMonoEntry2InfoL -- information to be inserted in left box -- default ""
24 # AscMonoEntry2InfoR -- information to be inserted in right box -- default ""
25 # Returns :
26 # Will leave the result in the global vector if Ok button is pressed or if
27 # the <Return> key is pressed when the focus is in any box, i.e will leave
28 # the number of the button pressed (1-3), and will attempt to invoke a
29 # command called OKCommand.ascMonoEntry2 or CancelCommand.ascEntry2.
30 # Will leave the values of the data in AscMonoEntry2InfoL and in
31 # AscMonoEntry2InfoL for the left and right boxes respectively.
32 # Will return also a formatted list of : the button number, the left data
33 # and right data. This box is modal.
34 # Other :
35 # The tab key pressed in any entry box will toggle between the left and
36 # right boxes.
37 # user configurable properties
38 # AscMonoEntry2(font) -*-* (duh)
39 # \************************************************************/ #
40
41
42 global AscMonoEntry2
43 set AscMonoEntry2(button) 0
44 set AscMonoEntry2(resultL) ""
45 set AscMonoEntry2(resultR) ""
46 set AscMonoEntry2(font) -*-*
47
48 #
49 # procedures to show window .ascMonoEntry2
50 #
51 proc VShowWindow.ascMonoEntry2 { {AscMonoEntry2Text "Variable Value"}
52 {AscMonoEntry2Geom 400x100}
53 {AscMonoEntry2InfoL ""} {AscMonoEntry2InfoR ""}} {
54
55 # xf ignore me 5
56
57 global AscMonoEntry2
58 toplevel .ascMonoEntry2
59
60 # Window manager configurations
61 global tk_version
62 wm positionfrom .ascMonoEntry2 ""
63 wm sizefrom .ascMonoEntry2 ""
64 wm minsize .ascMonoEntry2 400 100
65 wm geometry .ascMonoEntry2 $AscMonoEntry2Geom
66 wm title .ascMonoEntry2 { }
67
68
69 # build widget .ascMonoEntry2.buttons_frm
70 frame .ascMonoEntry2.buttons_frm
71
72 # build widget .ascMonoEntry2.buttons_frm.cancel_btn
73 button .ascMonoEntry2.buttons_frm.cancel_btn \
74 -font $AscMonoEntry2(font) \
75 -text {Cancel} \
76 -command "
77 global AscMonoEntry2
78 CancelCommand.ascMonoEntry2
79 set AscMonoEntry2(button) 2
80 set AscMonoEntry2(resultL) {}
81 set AscMonoEntry2(resultR) {}
82 catch {destroy .ascMonoEntry2}"
83
84 # build widget .ascMonoEntry2.buttons_frm.help_btn
85 button .ascMonoEntry2.buttons_frm.help_btn \
86 -font $AscMonoEntry2(font) \
87 -text {Help} \
88 -command "
89 global AscMonoEntry2
90 set AscMonoEntry2(button) 3
91 puts {Not yet implemented}"
92
93 # build widget .ascMonoEntry2.buttons_frm.ok_btn
94 button .ascMonoEntry2.buttons_frm.ok_btn \
95 -font $AscMonoEntry2(font) \
96 -text {OK} \
97 -command "
98 global AscMonoEntry2
99 set AscMonoEntry2(resultL) \
100 \[.ascMonoEntry2.entry_frm.left_entry get\]
101 set AscMonoEntry2(resultR) \
102 \[.ascMonoEntry2.entry_frm.right_entry get\]
103 OKCommand.ascMonoEntry2
104 set AscMonoEntry2(button) 1
105 catch {destroy .ascMonoEntry2}"
106
107 # pack widget .ascMonoEntry2.buttons_frm
108 pack append .ascMonoEntry2.buttons_frm \
109 .ascMonoEntry2.buttons_frm.ok_btn {left frame e expand} \
110 .ascMonoEntry2.buttons_frm.cancel_btn {left frame center expand} \
111 .ascMonoEntry2.buttons_frm.help_btn {left frame w expand}
112
113 # build widget .ascMonoEntry2.entry_frm
114 frame .ascMonoEntry2.entry_frm
115
116 # build widget .ascMonoEntry2.entry_frm.left_entry
117 entry .ascMonoEntry2.entry_frm.left_entry \
118 -exportselection 0 \
119 -font $AscMonoEntry2(font) \
120 -width {25}
121 #
122 #Initial Entry
123 .ascMonoEntry2.entry_frm.left_entry delete 0 end
124 .ascMonoEntry2.entry_frm.left_entry insert end "$AscMonoEntry2InfoL"
125
126 #bindings
127 bind .ascMonoEntry2.entry_frm.left_entry <Return> "
128 global AscMonoEntry2
129 set AscMonoEntry2(resultL) \[.ascMonoEntry2.entry_frm.left_entry get\]
130 set AscMonoEntry2(resultR) \[.ascMonoEntry2.entry_frm.right_entry get\]
131 set AscMonoEntry2(button) 1
132 OKCommand.ascMonoEntry2
133 catch {destroy .ascMonoEntry2}"
134
135 # build widget .ascMonoEntry2.entry_frm.right_entry
136 entry .ascMonoEntry2.entry_frm.right_entry \
137 -exportselection 0 \
138 -font $AscMonoEntry2(font) \
139 -width {25}
140 #
141 #Initial Entry
142 .ascMonoEntry2.entry_frm.right_entry delete 0 end
143 .ascMonoEntry2.entry_frm.right_entry insert end "$AscMonoEntry2InfoR"
144
145 #bindings
146 bind .ascMonoEntry2.entry_frm.right_entry <Return> "
147 global AscMonoEntry2
148 set AscMonoEntry2(resultL) \[.ascMonoEntry2.entry_frm.left_entry get\]
149 set AscMonoEntry2(resultR) \[.ascMonoEntry2.entry_frm.right_entry get\]
150 set AscMonoEntry2(button) 1
151 OKCommand.ascMonoEntry2
152 catch {destroy .ascMonoEntry2}"
153
154 # pack widget .ascMonoEntry2.entry_frm
155 pack append .ascMonoEntry2.entry_frm \
156 .ascMonoEntry2.entry_frm.left_entry {left frame ne pady 4 expand filly} \
157 .ascMonoEntry2.entry_frm.right_entry {right frame nw pady 4 expand filly}
158
159 # build widget .ascMonoEntry2.label_frm
160 frame .ascMonoEntry2.label_frm
161
162 # build widget .ascMonoEntry2.label_frm.box_label
163 label .ascMonoEntry2.label_frm.box_label \
164 -font $AscMonoEntry2(font) \
165 -text "$AscMonoEntry2Text"
166
167 # build widget .ascMonoEntry2.label_frm.bmcanvas
168 set tl .ascMonoEntry2.label_frm
169 canvas $tl.bmcanvas -width 33 -height 27
170 $tl.bmcanvas create bitmap 0 0 -background yellow \
171 -anchor nw -bitmap grablock
172 pack append $tl $tl.bmcanvas {left frame center}
173
174 # pack widget .ascMonoEntry2.label_frm
175 pack append .ascMonoEntry2.label_frm \
176 .ascMonoEntry2.label_frm.box_label {top frame center expand fillx}
177
178 # pack widget .ascMonoEntry2
179 pack append .ascMonoEntry2 \
180 .ascMonoEntry2.label_frm {top frame center expand fill} \
181 .ascMonoEntry2.entry_frm {top frame center expand fill} \
182 .ascMonoEntry2.buttons_frm {top frame center expand fill}
183
184 #
185 # Get Data and Catch response.
186 #
187 # wait for the box to be destroyed
188 focus .ascMonoEntry2.entry_frm.left_entry
189 update idletask
190 bind .ascMonoEntry2 <Visibility> {ascKeepOnTop %W}
191 grab .ascMonoEntry2
192 tkwait window .ascMonoEntry2
193 set data [list $AscMonoEntry2(button) \
194 $AscMonoEntry2(resultL) $AscMonoEntry2(resultR)]
195 return $data
196 }
197
198 proc DestroyWindow.ascMonoEntry2 {} {# xf ignore me 7
199
200 catch "destroy .ascMonoEntry2"
201 update
202 }
203 proc OKCommand.ascMonoEntry2 {} {
204 global AscMonoEntry2
205 }
206 proc CancelCommand.ascMonoEntry2 {} {
207 global AscMonoEntry2
208 }
209
210 # eof
211 #
212

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