1 | # implement next |
---|
2 | |
---|
3 | # platform-specific code |
---|
4 | if {$tcl_platform(platform) == "windows"} { |
---|
5 | if [catch {package require winexec}] { |
---|
6 | tk_dialog .err "WINEXEC Error" \ |
---|
7 | "Error -- Unable to load the WINEXEC package. This is needed in Win95 machines" \ |
---|
8 | error 0 Quit |
---|
9 | destroy . |
---|
10 | } |
---|
11 | if {$tcl_platform(os) == "Windows 95" || $tcl_platform(os) == "Windows 98" } { |
---|
12 | proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} { |
---|
13 | global env expgui |
---|
14 | # Windows environment variables |
---|
15 | # -95 does not seem to be able to use these |
---|
16 | set env(GSAS) [file nativename $expgui(gsasexe)] |
---|
17 | # PGPLOT_FONT is needed by PGPLOT |
---|
18 | set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]] |
---|
19 | # this is the number of lines/page in the .LST (etc.) file |
---|
20 | set env(LENPAGE) 60 |
---|
21 | set pwd [file nativename [pwd]] |
---|
22 | |
---|
23 | # check the path -- can DOS use it? |
---|
24 | if {[string first // [pwd]] != -1} { |
---|
25 | tk_dialog .braindead "Invalid Path" \ |
---|
26 | {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) \ |
---|
27 | Win-95 can't directly access a network drive in DOS} error 0 OK |
---|
28 | return |
---|
29 | } |
---|
30 | # all winexec commands are background commands |
---|
31 | # if $background |
---|
32 | |
---|
33 | # pause is hard coded in the .BAT file |
---|
34 | #if $wait { |
---|
35 | # append command " pause" |
---|
36 | #} |
---|
37 | |
---|
38 | # replace the forward slashes with backward |
---|
39 | regsub -all / $command \\ command |
---|
40 | # Win95 does not seem to inherit the environment from Tcl env vars |
---|
41 | # so define it in the .BAT file |
---|
42 | winexec -d [file nativename [pwd]] \ |
---|
43 | [file join $expgui(scriptdir) gsastcl.bat] \ |
---|
44 | "[file nativename $expgui(gsasdir)] $command" |
---|
45 | } |
---|
46 | } else { |
---|
47 | # now for - brain-dead Windows-NT |
---|
48 | proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} { |
---|
49 | global env expgui |
---|
50 | # Windows environment variables |
---|
51 | # -95 does not seem to be able to use these |
---|
52 | set env(GSAS) [file nativename $expgui(gsasexe)] |
---|
53 | # PGPLOT_FONT is needed by PGPLOT |
---|
54 | set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]] |
---|
55 | # this is the number of lines/page in the .LST (etc.) file |
---|
56 | set env(LENPAGE) 60 |
---|
57 | # all winexec commands are background commands -- ignore background arg |
---|
58 | |
---|
59 | # can't get pause to work! -- ignore wait |
---|
60 | |
---|
61 | set prevcmd {} |
---|
62 | foreach cmd $command { |
---|
63 | if {$prevcmd != ""} { |
---|
64 | tk_dialog .done_yet Confirm "Press OK to start command $cmd" "" 0 OK |
---|
65 | } |
---|
66 | # replace the forward slashes with backward |
---|
67 | regsub -all / $cmd \\ cmd |
---|
68 | # cmd.exe must be in the path -- lets hope that at least works! |
---|
69 | winexec -d [file nativename [pwd]] cmd.exe "/c $cmd" |
---|
70 | set prevcmd $cmd |
---|
71 | } |
---|
72 | } |
---|
73 | } |
---|
74 | } else { |
---|
75 | if [catch {set env(GSASBACKSPACE)}] {set env(GSASBACKSPACE) 1} |
---|
76 | |
---|
77 | proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} { |
---|
78 | global env expgui |
---|
79 | # UNIX environment variables |
---|
80 | set env(GSASEXE) $expgui(gsasexe) |
---|
81 | set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat] |
---|
82 | set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat] |
---|
83 | # PGPLOT_DIR is needed by PGPLOT |
---|
84 | set env(PGPLOT_DIR) [file join $expgui(gsasdir) pgl] |
---|
85 | # this is the number of lines/page in the .LST (etc.) file |
---|
86 | set env(LENPAGE) 60 |
---|
87 | set termopts {} |
---|
88 | if $env(GSASBACKSPACE) { |
---|
89 | append termopts \ |
---|
90 | {-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"} |
---|
91 | } |
---|
92 | if $scrollbar { |
---|
93 | append termopts " -sb" |
---|
94 | } else { |
---|
95 | append termopts " +sb" |
---|
96 | } |
---|
97 | if $background { |
---|
98 | set suffix {&} |
---|
99 | } else { |
---|
100 | set suffix {} |
---|
101 | } |
---|
102 | # |
---|
103 | if $wait { |
---|
104 | append command "\; echo -n Press Enter to continue \; read x" |
---|
105 | } |
---|
106 | if !$background {wm iconify .} |
---|
107 | catch {eval exec xterm $termopts -title [list $title] \ |
---|
108 | -e /bin/sh -c [list $command] $suffix} errmsg |
---|
109 | if $expgui(debug) {puts "xterm result = $errmsg"} |
---|
110 | if !$background {wm deiconify .} |
---|
111 | } |
---|
112 | } |
---|
113 | |
---|
114 | |
---|
115 | proc newexp {} { |
---|
116 | global infile outfile |
---|
117 | set frm .file |
---|
118 | catch {destroy $frm} |
---|
119 | toplevel $frm |
---|
120 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
---|
121 | pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left |
---|
122 | pack [button $frmC.b -text Create -command "valid_new_exp_file"] -side top |
---|
123 | bind $frm <Return> "valid_new_exp_file" |
---|
124 | pack [button $frmC.q -text Quit -command "set infile(done) 2"] -side top |
---|
125 | |
---|
126 | pack [label $frmA.0 -text "Enter an experiment file"] -side top -anchor center |
---|
127 | expfilebox $frmA infile 2 |
---|
128 | set infile(done) 0 |
---|
129 | # force the window to stay on top |
---|
130 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
---|
131 | |
---|
132 | wm withdraw $frm |
---|
133 | update idletasks |
---|
134 | # center the new window in the middle of the parent |
---|
135 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
---|
136 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
---|
137 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
---|
138 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
---|
139 | wm geom $frm +$x+$y |
---|
140 | wm deiconify $frm |
---|
141 | |
---|
142 | set oldFocus [focus] |
---|
143 | set oldGrab [grab current $frm] |
---|
144 | if {$oldGrab != ""} { |
---|
145 | set grabStatus [grab status $oldGrab] |
---|
146 | } |
---|
147 | grab $frm |
---|
148 | focus $frmC.b |
---|
149 | tkwait variable infile(done) |
---|
150 | destroy $frm |
---|
151 | catch {focus $oldFocus} |
---|
152 | if {$oldGrab != ""} { |
---|
153 | if {$grabStatus == "global"} { |
---|
154 | grab -global $oldGrab |
---|
155 | } else { |
---|
156 | grab $oldGrab |
---|
157 | } |
---|
158 | } |
---|
159 | if {$infile(done) == 2} return |
---|
160 | return [file join $infile(dir) $infile(name)] |
---|
161 | } |
---|
162 | |
---|
163 | proc getstring {what "chars 40" "quit 1" "initvalue {}"} { |
---|
164 | global expgui expmap |
---|
165 | set w .global |
---|
166 | catch {destroy $w} |
---|
167 | toplevel $w -bg beige |
---|
168 | wm title $w "Input $what" |
---|
169 | set expgui(temp) {} |
---|
170 | pack [frame $w.0 -bd 6 -relief groove -bg beige] \ |
---|
171 | -side top -expand yes -fill both |
---|
172 | grid [label $w.0.a -text "Input a value for the $what" \ |
---|
173 | -bg beige] \ |
---|
174 | -row 0 -column 0 -columnspan 10 |
---|
175 | grid [entry $w.0.b -textvariable expgui(temp) -width $chars] \ |
---|
176 | -row 1 -column 0 |
---|
177 | |
---|
178 | set expgui(temp) $initvalue |
---|
179 | pack [frame $w.b] -side top |
---|
180 | pack [button $w.b.2 -text Set -command "destroy $w"] -side left |
---|
181 | if $quit { |
---|
182 | pack [button $w.b.3 -text Quit \ |
---|
183 | -command "set expgui(temp) {}; destroy $w"] -side left |
---|
184 | } |
---|
185 | # force the window to stay on top |
---|
186 | wm transient $w [winfo toplevel [winfo parent $w]] |
---|
187 | |
---|
188 | bind $w <Return> "destroy $w" |
---|
189 | wm withdraw $w |
---|
190 | update idletasks |
---|
191 | # center the new window in the middle of the parent |
---|
192 | set x [expr [winfo x [winfo parent $w]] + [winfo width .]/2 - \ |
---|
193 | [winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]] |
---|
194 | set y [expr [winfo y [winfo parent $w]] + [winfo height .]/2 - \ |
---|
195 | [winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]] |
---|
196 | wm geom $w +$x+$y |
---|
197 | wm deiconify $w |
---|
198 | |
---|
199 | set oldFocus [focus] |
---|
200 | set oldGrab [grab current $w] |
---|
201 | if {$oldGrab != ""} { |
---|
202 | set grabStatus [grab status $oldGrab] |
---|
203 | } |
---|
204 | grab $w |
---|
205 | focus $w.b.2 |
---|
206 | tkwait window $w |
---|
207 | catch {focus $oldFocus} |
---|
208 | if {$oldGrab != ""} { |
---|
209 | if {$grabStatus == "global"} { |
---|
210 | grab -global $oldGrab |
---|
211 | } else { |
---|
212 | grab $oldGrab |
---|
213 | } |
---|
214 | } |
---|
215 | return $expgui(temp) |
---|
216 | } |
---|
217 | |
---|
218 | |
---|
219 | proc next {direction} { |
---|
220 | global |
---|
221 | set filelist [lsort [glob *.EXP]] |
---|
222 | set ind [lsearch $filelist $expnam.EXP] |
---|
223 | if {$ind == -1 && $expnam != ""} return |
---|
224 | if $direction { # true positive |
---|
225 | incr ind |
---|
226 | } { |
---|
227 | incr ind -1 |
---|
228 | } |
---|
229 | if {$ind < 0} {set ind [expr [llength $filelist]-1]} |
---|
230 | if {$ind >= [llength $filelist] } {set ind 0} |
---|
231 | set expnam [string toupper [file root [lindex $filelist $ind]]] |
---|
232 | showexp |
---|
233 | } |
---|
234 | |
---|
235 | proc runGSASprog {proglist} { |
---|
236 | global expgui tcl_platform |
---|
237 | set cmd {} |
---|
238 | foreach prog $proglist { |
---|
239 | if {$tcl_platform(platform) == "windows"} { |
---|
240 | append cmd " \"$expgui(gsasexe)/${prog}.exe \" " |
---|
241 | } else { |
---|
242 | if {$cmd != ""} {append cmd "\;"} |
---|
243 | append cmd "[file join $expgui(gsasexe) $prog]" |
---|
244 | } |
---|
245 | } |
---|
246 | forknewterm $prog $cmd 0 1 1 |
---|
247 | } |
---|
248 | |
---|
249 | proc runGSASwEXP {proglist} { |
---|
250 | global expgui tcl_platform |
---|
251 | # Save the current exp file |
---|
252 | savearchiveexp |
---|
253 | set cmd {} |
---|
254 | set expnam [file root [file tail $expgui(expfile)]] |
---|
255 | foreach prog $proglist { |
---|
256 | if {$prog == "expedt" && $expgui(archive)} archiveexp |
---|
257 | if {$tcl_platform(platform) == "windows"} { |
---|
258 | append cmd " \"$expgui(gsasexe)/${prog}.exe $expnam \" " |
---|
259 | } else { |
---|
260 | if {$cmd != ""} {append cmd "\;"} |
---|
261 | append cmd "[file join $expgui(gsasexe) $prog] $expnam" |
---|
262 | } |
---|
263 | } |
---|
264 | forknewterm "$prog -- $expnam" $cmd 0 1 1 |
---|
265 | wm deiconify . |
---|
266 | } |
---|
267 | |
---|
268 | proc liveplot {} { |
---|
269 | global expgui liveplot wishshell |
---|
270 | set expnam [file root [file tail $expgui(expfile)]] |
---|
271 | exec $wishshell [file join $expgui(scriptdir) liveplot] \ |
---|
272 | $expnam $expgui(gsasexe) $liveplot(hst) $liveplot(legend) & |
---|
273 | } |
---|
274 | |
---|
275 | proc lstview {} { |
---|
276 | global expgui wishshell |
---|
277 | set expnam [file root [file tail $expgui(expfile)]] |
---|
278 | exec $wishshell [file join $expgui(scriptdir) lstview] $expnam & |
---|
279 | } |
---|
280 | |
---|
281 | proc widplt {} { |
---|
282 | global expgui wishshell |
---|
283 | set expnam [file root [file tail $expgui(expfile)]] |
---|
284 | exec $wishshell [file join $expgui(scriptdir) widplt] $expgui(gsasexe) $expnam & |
---|
285 | } |
---|
286 | |
---|
287 | |
---|
288 | proc showhelp {} { |
---|
289 | global expgui_helplist helpmsg |
---|
290 | set helpmsg {} |
---|
291 | set frm .help |
---|
292 | catch {destroy $frm} |
---|
293 | toplevel $frm |
---|
294 | wm title $frm "Command Help" |
---|
295 | pack [message $frm.0 -text \ |
---|
296 | "Click on an entry below to see help on a GSAS command" ] \ |
---|
297 | -side top |
---|
298 | pack [frame $frm.a -width 20 -height 15] \ |
---|
299 | -side top -expand yes -fill both |
---|
300 | pack [message $frm.help -textvariable helpmsg -relief groove] \ |
---|
301 | -side left -fill both -expand yes |
---|
302 | set lst [array names expgui_helplist] |
---|
303 | listbox $frm.a.cmds -relief raised -bd 2 -yscrollcommand \ |
---|
304 | "$frm.a.scroll set" -height 15 -width 0 |
---|
305 | scrollbar $frm.a.scroll -command "$frm.a.cmds yview" |
---|
306 | foreach item [lsort $lst] { |
---|
307 | $frm.a.cmds insert end $item |
---|
308 | } |
---|
309 | if {[$frm.a.cmds curselection] == ""} {$frm.a.cmds selection set 0} |
---|
310 | button $frm.a.done -text Done -command "destroy $frm" |
---|
311 | bind $frm.a.cmds <ButtonRelease-1> \ |
---|
312 | "+set helpmsg \$expgui_helplist(\[$frm.a.cmds get \[$frm.a.cmds curselection\]\])" |
---|
313 | pack $frm.a.scroll -side left -fill y |
---|
314 | pack $frm.a.cmds -side left -expand yes -anchor w |
---|
315 | pack $frm.a.done -side right -expand no |
---|
316 | # get the size of the window and expand the message boxes to match |
---|
317 | update |
---|
318 | set width [lindex [split [wm geometry $frm] x+] 0] |
---|
319 | $frm.0 config -width $width |
---|
320 | $frm.help config -width $width |
---|
321 | # waitdone $frm |
---|
322 | } |
---|
323 | |
---|
324 | proc convfile {} { |
---|
325 | global tcl_platform |
---|
326 | if {$tcl_platform(platform) == "windows"} { |
---|
327 | convwin |
---|
328 | } else { |
---|
329 | convunix |
---|
330 | } |
---|
331 | } |
---|
332 | |
---|
333 | # file conversions for UNIX (convstod convdtos) |
---|
334 | proc convunix {} { |
---|
335 | global expgui infile outfile |
---|
336 | set frm .file |
---|
337 | catch {destroy $frm} |
---|
338 | toplevel $frm |
---|
339 | wm title $frm "Convert File" |
---|
340 | pack [frame [set frm0 $frm.0] -bd 2 -relief groove] -padx 3 -pady 3 -side top |
---|
341 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
---|
342 | pack [frame [set frmB $frm.2] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
---|
343 | pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left |
---|
344 | pack [button $frmC.b -text Convert -command "valid_conv_file"] -side top |
---|
345 | pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side top |
---|
346 | |
---|
347 | pack [label $frmA.0 -text "Select an input file"] -side top -anchor center |
---|
348 | pack [label $frmB.0 -text "Enter an output file"] -side top -anchor center |
---|
349 | |
---|
350 | pack [label $frm0.1 -text "Convert to:"] -side top -anchor w |
---|
351 | pack [radiobutton $frm0.2 -text "direct access" -value convstod \ |
---|
352 | -command setoutfile \ |
---|
353 | -variable outfile(type)] -side top -anchor w |
---|
354 | pack [radiobutton $frm0.3 -text "sequential" -value convdtos \ |
---|
355 | -command setoutfile \ |
---|
356 | -variable outfile(type)] -side top -anchor w |
---|
357 | set outfile(type) "" |
---|
358 | cnvfilebox $frmA infile 1 |
---|
359 | cnvfilebox $frmB outfile 0 |
---|
360 | set infile(done) 0 |
---|
361 | # force the window to stay on top |
---|
362 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
---|
363 | |
---|
364 | bind $frm <Return> "valid_conv_file" |
---|
365 | wm withdraw $frm |
---|
366 | update idletasks |
---|
367 | # center the new window in the middle of the parent |
---|
368 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
---|
369 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
---|
370 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
---|
371 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
---|
372 | wm geom $frm +$x+$y |
---|
373 | wm deiconify $frm |
---|
374 | |
---|
375 | set oldFocus [focus] |
---|
376 | set oldGrab [grab current $frm] |
---|
377 | if {$oldGrab != ""} { |
---|
378 | set grabStatus [grab status $oldGrab] |
---|
379 | } |
---|
380 | grab $frm |
---|
381 | focus $frmC.q |
---|
382 | update |
---|
383 | tkwait variable infile(done) |
---|
384 | catch {focus $oldFocus} |
---|
385 | if {$oldGrab != ""} { |
---|
386 | if {$grabStatus == "global"} { |
---|
387 | grab -global $oldGrab |
---|
388 | } else { |
---|
389 | grab $oldGrab |
---|
390 | } |
---|
391 | } |
---|
392 | destroy $frm |
---|
393 | } |
---|
394 | |
---|
395 | # validate the files and make the conversion |
---|
396 | proc valid_conv_file {} { |
---|
397 | global infile outfile expgui |
---|
398 | if {$outfile(type) == "convstod" || $outfile(type) == "convdtos"} { |
---|
399 | set convtype $outfile(type) |
---|
400 | } else { |
---|
401 | return |
---|
402 | } |
---|
403 | if {$infile(name) == ""} return |
---|
404 | if {$outfile(name) == ""} return |
---|
405 | if {$infile(name) == $outfile(name)} { |
---|
406 | tk_dialog .warn Notify "Sorry, filenames must differ" warning 0 OK |
---|
407 | return |
---|
408 | } |
---|
409 | if ![file exists [file join $infile(dir) $infile(name)]] { |
---|
410 | tk_dialog .warn Notify \ |
---|
411 | "Sorry, file $infile(name) not found in $infile(dir)" warning 0 OK |
---|
412 | return |
---|
413 | } |
---|
414 | if [file exists [file join $outfile(dir) $outfile(name)]] { |
---|
415 | if [tk_dialog .warn Notify \ |
---|
416 | "Warning: file $outfile(name) exists in $outfile(dir). OK to overwrite?" \ |
---|
417 | warning 0 OK No] return |
---|
418 | } |
---|
419 | if [catch { |
---|
420 | exec [file join $expgui(gsasexe) $convtype] < \ |
---|
421 | [file join $infile(dir) $infile(name)] > \ |
---|
422 | [file join $outfile(dir) $outfile(name)] |
---|
423 | } errmsg] { |
---|
424 | tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK |
---|
425 | } else { |
---|
426 | if [tk_dialog .converted Notify \ |
---|
427 | "File converted. Convert more files?" \ |
---|
428 | "" 0 Yes No] {set infile(done) 1} |
---|
429 | } |
---|
430 | } |
---|
431 | |
---|
432 | # file conversions for Windows |
---|
433 | proc convwin {} { |
---|
434 | global expgui infile outfile |
---|
435 | set frm .file |
---|
436 | catch {destroy $frm} |
---|
437 | toplevel $frm |
---|
438 | wm title $frm "Convert File" |
---|
439 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
---|
440 | pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left |
---|
441 | pack [button $frmC.b -text Convert -command "valid_conv_win"] -side top |
---|
442 | pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side top |
---|
443 | pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center |
---|
444 | cnvfilebox $frmA outfile 1 |
---|
445 | set infile(done) 0 |
---|
446 | # force the window to stay on top |
---|
447 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
---|
448 | |
---|
449 | bind $frm <Return> "valid_conv_file" |
---|
450 | wm withdraw $frm |
---|
451 | update idletasks |
---|
452 | # center the new window in the middle of the parent |
---|
453 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
---|
454 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
---|
455 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
---|
456 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
---|
457 | wm geom $frm +$x+$y |
---|
458 | wm deiconify $frm |
---|
459 | |
---|
460 | set oldFocus [focus] |
---|
461 | set oldGrab [grab current $frm] |
---|
462 | if {$oldGrab != ""} { |
---|
463 | set grabStatus [grab status $oldGrab] |
---|
464 | } |
---|
465 | grab $frm |
---|
466 | focus $frmC.q |
---|
467 | update |
---|
468 | tkwait variable infile(done) |
---|
469 | if {$oldGrab != ""} { |
---|
470 | if {$grabStatus == "global"} { |
---|
471 | grab -global $oldGrab |
---|
472 | } else { |
---|
473 | grab $oldGrab |
---|
474 | } |
---|
475 | } |
---|
476 | destroy $frm |
---|
477 | } |
---|
478 | |
---|
479 | # validate the files and make the conversion |
---|
480 | proc valid_conv_win {} { |
---|
481 | global infile outfile expgui |
---|
482 | if {$outfile(name) == ""} return |
---|
483 | if ![file exists $outfile(dir)/$outfile(name)] { |
---|
484 | tk_dialog .warn Notify \ |
---|
485 | "Sorry, file $outfile(name) not found in $outfile(dir)" warning 0 OK |
---|
486 | return |
---|
487 | } |
---|
488 | if [catch { |
---|
489 | set newname "[file rootname $outfile(name)].tmp" |
---|
490 | set oldname "[file rootname $outfile(name)].seq" |
---|
491 | set in [open $outfile(dir)/$outfile(name) r] |
---|
492 | set out [open $outfile(dir)/$newname w] |
---|
493 | set len [gets $in line] |
---|
494 | if {$len > 160} { |
---|
495 | # this is a UNIX file. Hope there are no control characters |
---|
496 | set i 0 |
---|
497 | set j 79 |
---|
498 | while {$j < $len} { |
---|
499 | puts $out [string range $line $i $j] |
---|
500 | incr i 80 |
---|
501 | incr j 80 |
---|
502 | } |
---|
503 | } else { |
---|
504 | while {$len >= 0} { |
---|
505 | append line " " |
---|
506 | append line " " |
---|
507 | set line [string range $line 0 79] |
---|
508 | puts $out $line |
---|
509 | set len [gets $in line] |
---|
510 | } |
---|
511 | } |
---|
512 | close $in |
---|
513 | close $out |
---|
514 | file rename $outfile(dir)/$outfile(name) $oldname |
---|
515 | file rename $newname $outfile(dir)/$outfile(name) |
---|
516 | } errmsg] { |
---|
517 | tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK |
---|
518 | } else { |
---|
519 | if [tk_dialog .converted Notify \ |
---|
520 | "File converted. Convert more files?" \ |
---|
521 | "" 0 Yes No] {set infile(done) 1} |
---|
522 | } |
---|
523 | } |
---|
524 | |
---|
525 | # validate the files and make the conversion |
---|
526 | proc valid_new_exp_file {} { |
---|
527 | global infile |
---|
528 | if {$infile(name) == ""} return |
---|
529 | set infile(name) [file root [string toupper $infile(name)]].EXP |
---|
530 | if [file exists [file join $infile(dir) $infile(name)]] { |
---|
531 | tk_dialog .warn Notify \ |
---|
532 | "Sorry, file $infile(name) found in $infile(dir)" warning 0 OK |
---|
533 | return |
---|
534 | } |
---|
535 | set infile(done) 1 |
---|
536 | } |
---|
537 | |
---|
538 | # create a file box |
---|
539 | proc expfilebox {bx filvar diropt} { |
---|
540 | global ${filvar} |
---|
541 | pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top |
---|
542 | set ${filvar}(dir) [pwd] |
---|
543 | pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both |
---|
544 | listbox $bx.a.files -relief raised -bd 2 -yscrollcommand "$bx.a.scroll set" \ |
---|
545 | -height 15 -width 0 |
---|
546 | scrollbar $bx.a.scroll -command "$bx.a.files yview" |
---|
547 | filchoose $bx $bx.a.files $filvar $diropt |
---|
548 | bind $bx.a.files <ButtonRelease-1> \ |
---|
549 | "filchoose $bx $bx.a.files $filvar $diropt" |
---|
550 | pack $bx.a.scroll -side left -fill y |
---|
551 | pack $bx.a.files -side left -fill both -expand yes |
---|
552 | pack [entry $bx.c -textvariable ${filvar}(name)] -side top |
---|
553 | } |
---|
554 | |
---|
555 | # create a file box for conversions |
---|
556 | proc cnvfilebox {bx filvar diropt} { |
---|
557 | global ${filvar} |
---|
558 | pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top |
---|
559 | set ${filvar}(dir) [pwd] |
---|
560 | pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both |
---|
561 | listbox $bx.a.files -relief raised -bd 2 -yscrollcommand "$bx.a.scroll set" \ |
---|
562 | -height 15 -width 0 |
---|
563 | scrollbar $bx.a.scroll -command "$bx.a.files yview" |
---|
564 | filchoose $bx $bx.a.files $filvar $diropt |
---|
565 | if {$filvar == "infile"} { |
---|
566 | bind $bx.a.files <ButtonRelease-1> \ |
---|
567 | "filchoose $bx $bx.a.files $filvar $diropt; setoutfile" |
---|
568 | } else { |
---|
569 | bind $bx.a.files <ButtonRelease-1> \ |
---|
570 | "filchoose $bx $bx.a.files $filvar $diropt" |
---|
571 | } |
---|
572 | pack $bx.a.scroll -side left -fill y |
---|
573 | pack $bx.a.files -side left -fill both -expand yes |
---|
574 | pack [entry $bx.c -textvariable ${filvar}(name)] -side top |
---|
575 | } |
---|
576 | |
---|
577 | # select a file or directory, also called when box is created to fill it |
---|
578 | proc filchoose {frm box filvar {dironly 1}} { |
---|
579 | global expnam $filvar |
---|
580 | set select [$box curselection] |
---|
581 | if {$select == ""} { |
---|
582 | set file . |
---|
583 | } else { |
---|
584 | set file [string trim [$box get $select]] |
---|
585 | } |
---|
586 | if [file isdirectory [file join [set ${filvar}(dir)] $file]] { |
---|
587 | if {$file == ".."} { |
---|
588 | set ${filvar}(dir) [file dirname [set ${filvar}(dir)] ] |
---|
589 | } elseif {$file != "."} { |
---|
590 | set ${filvar}(dir) [file join [set ${filvar}(dir)] $file] |
---|
591 | } |
---|
592 | set ${filvar}(name) {} |
---|
593 | $box delete 0 end |
---|
594 | $box insert end {.. } |
---|
595 | foreach file [lsort [glob -nocomplain \ |
---|
596 | [file join [set ${filvar}(dir)] *] ] ] { |
---|
597 | if {[file isdirectory $file]} { |
---|
598 | # is this / needed here? Does it cause a problem in MacGSAS? |
---|
599 | $box insert end [file tail $file]/ |
---|
600 | } elseif {$dironly == 1} { |
---|
601 | $box insert end [file tail $file] |
---|
602 | } elseif {$dironly == 2 && [file extension $file] == ".EXP"} { |
---|
603 | $box insert end [file tail $file] |
---|
604 | } |
---|
605 | } |
---|
606 | return |
---|
607 | } |
---|
608 | set ${filvar}(name) [file tail $file] |
---|
609 | } |
---|
610 | |
---|
611 | # set new file name from old |
---|
612 | proc setoutfile {} { |
---|
613 | global infile outfile |
---|
614 | if {$outfile(type) == "convstod"} { |
---|
615 | set lfile [string toupper $infile(name)] |
---|
616 | } elseif {$outfile(type) == "convdtos"} { |
---|
617 | set lfile [string tolower $infile(name)] |
---|
618 | } else { |
---|
619 | set lfile "" |
---|
620 | } |
---|
621 | if {$infile(name) == $lfile} { |
---|
622 | set outfile(name) {} |
---|
623 | } else { |
---|
624 | set outfile(name) $lfile |
---|
625 | } |
---|
626 | } |
---|
627 | |
---|
628 | proc liveplotopt {} { |
---|
629 | global liveplot |
---|
630 | set frm .file |
---|
631 | catch {destroy $frm} |
---|
632 | toplevel $frm |
---|
633 | pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left |
---|
634 | pack [scale $frmA.1 -label "Histogram number" -from 1 -to 9 \ |
---|
635 | -length 150 -orient horizontal -variable liveplot(hst)] -side top |
---|
636 | pack [checkbutton $frmA.2 -text {include plot legend}\ |
---|
637 | -variable liveplot(legend)] -side top |
---|
638 | pack [button $frm.2 -text OK \ |
---|
639 | -command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \ |
---|
640 | ] -side top |
---|
641 | bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"} |
---|
642 | # force the window to stay on top |
---|
643 | wm transient $frm [winfo toplevel [winfo parent $frm]] |
---|
644 | wm withdraw $frm |
---|
645 | update idletasks |
---|
646 | # center the new window in the middle of the parent |
---|
647 | set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \ |
---|
648 | [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]] |
---|
649 | set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \ |
---|
650 | [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]] |
---|
651 | wm geom $frm +$x+$y |
---|
652 | wm deiconify $frm |
---|
653 | |
---|
654 | set oldFocus [focus] |
---|
655 | set oldGrab [grab current $frm] |
---|
656 | if {$oldGrab != ""} { |
---|
657 | set grabStatus [grab status $oldGrab] |
---|
658 | } |
---|
659 | grab $frm |
---|
660 | focus $frm.2 |
---|
661 | tkwait window $frm |
---|
662 | catch {focus $oldFocus} |
---|
663 | if {$oldGrab != ""} { |
---|
664 | if {$grabStatus == "global"} { |
---|
665 | grab -global $oldGrab |
---|
666 | } else { |
---|
667 | grab $oldGrab |
---|
668 | } |
---|
669 | } |
---|
670 | } |
---|