source: trunk/gsascmds.tcl @ 22

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

# on 1999/01/07 04:45:54, toby did:
remove compressprog -- not used

move definition of environment variables so they are defined at runtime

move xterm errors to catch statement

  • Property rcs:author set to toby
  • Property rcs:date set to 1999/01/07 04:45:54
  • Property rcs:lines set to +29 -24
  • Property rcs:rev set to 1.2
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 21.4 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    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
115proc 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
163proc 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
219proc 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
235proc 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
249proc 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
268proc 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
275proc 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
281proc 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
288proc 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
324proc 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)
334proc 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
396proc 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
433proc 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
480proc 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
526proc 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
539proc 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
556proc 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
578proc 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
612proc 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
628proc 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}
Note: See TracBrowser for help on using the repository browser.