source: trunk/gsascmds.tcl @ 17

Last change on this file since 17 was 17, checked in by toby, 11 years ago

# on 1999/01/06 04:03:01, toby did:
Initial revision

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