source: trunk/gsascmds.tcl @ 59

Last change on this file since 59 was 59, checked in by toby, 14 years ago

# on 1999/02/19 16:01:46, toby did:
Clean up file input dialogs for convert and .exp files
Add composition computation (composition & writelst)
Add XTL coordinate export routine (exp2xtl, SetExportPhase? & writextl)
  • Property rcs:author set to toby
  • Property rcs:date set to 1999/02/19 16:01:46
  • Property rcs:lines set to +508 -96
  • Property rcs:rev set to 1.7
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 40.9 KB
Line 
1# should do some work here on convert to make the file dialog much more
2# like that in getExpFileName (propogate to tkGSAS as well?)
3
4# platform-specific code
5if {$tcl_platform(platform) == "windows"} {
6    if [catch {package require winexec}] {
7        tk_dialog .err "WINEXEC Error" \
8                "Error -- Unable to load the WINEXEC package. This is needed in Win95 machines" \
9                error 0 Quit
10        destroy .
11    }
12    if {$tcl_platform(os) == "Windows 95" || $tcl_platform(os) == "Windows 98" } {
13        # this creates a DOS box to run a program in
14        proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
15            global env expgui
16            # Windows environment variables
17            # -95 does not seem to be able to use these
18            set env(GSAS) [file nativename $expgui(gsasdir)]
19            # PGPLOT_FONT is needed by PGPLOT
20            set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]]
21            # this is the number of lines/page in the .LST (etc.) file
22            set env(LENPAGE) 60
23            set pwd [file nativename [pwd]]
24
25            # check the path -- can DOS use it?
26            if {[string first // [pwd]] != -1} {
27                tk_dialog .braindead "Invalid Path" \
28                {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) \
29                Win-95 can't directly access a network drive in DOS} error 0 OK
30                return
31            }
32            # all winexec commands are background commands
33            #   if $background
34
35            # pause is hard coded in the .BAT file
36            #if $wait  {
37            #   append command " pause"
38            #}
39
40            # replace the forward slashes with backward
41            regsub -all / $command \\ command
42            # Win95 does not seem to inherit the environment from Tcl env vars
43            # so define it in the .BAT file
44            winexec -d [file nativename [pwd]] \
45                [file join $expgui(scriptdir) gsastcl.bat] \
46                "[file nativename $expgui(gsasdir)] $command"
47        }
48    } else {
49        # now for - brain-dead Windows-NT
50        # this creates a DOS box to run a program in
51        proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
52            global env expgui
53            # Windows environment variables
54            # -95 does not seem to be able to use these
55            set env(GSAS) [file nativename $expgui(gsasdir)]
56            # PGPLOT_FONT is needed by PGPLOT
57            set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]]
58            # this is the number of lines/page in the .LST (etc.) file
59            set env(LENPAGE) 60
60            # all winexec commands are background commands -- ignore background arg
61
62            # can't get pause to work! -- ignore wait
63
64            set prevcmd {}
65            foreach cmd $command {
66                if {$prevcmd != ""} {
67                    tk_dialog .done_yet Confirm "Press OK to start command $cmd" "" 0 OK
68                }
69                # replace the forward slashes with backward
70                regsub -all / $cmd \\ cmd
71                # cmd.exe must be in the path -- lets hope that at least works!
72                winexec -d [file nativename [pwd]] cmd.exe "/c $cmd"
73                set prevcmd $cmd
74            }
75        }
76    }
77} else {
78    if [catch {set env(GSASBACKSPACE)}] {set env(GSASBACKSPACE) 1}
79
80    # this creates a xterm window to run a program in
81    proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
82        global env expgui
83        # UNIX environment variables
84        set env(GSASEXE) $expgui(gsasexe)
85        set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
86        set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
87        # PGPLOT_DIR is needed by PGPLOT
88        set env(PGPLOT_DIR) [file join $expgui(gsasdir) pgl]
89        # this is the number of lines/page in the .LST (etc.) file
90        set env(LENPAGE) 60
91        set termopts {}
92        if $env(GSASBACKSPACE) {
93            append termopts \
94                    {-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"}
95        }
96        if $scrollbar {
97            append termopts " -sb"
98        } else {
99            append termopts " +sb"
100        }
101        if $background {
102            set suffix {&}
103        } else {
104            set suffix {}
105        }
106        #
107        if $wait  {
108            append command "\; echo -n Press Enter to continue \; read x"
109        }
110        if !$background {wm iconify .}
111        catch {eval exec xterm $termopts -title [list $title] \
112                -e /bin/sh -c [list $command] $suffix} errmsg
113        if $expgui(debug) {puts "xterm result = $errmsg"}
114        if !$background {wm deiconify .}
115    }
116}
117
118# get a value in a modal toplevel
119proc getstring {what "chars 40" "quit 1" "initvalue {}"} {
120    global expgui expmap
121    set w .global
122    catch {destroy $w}
123    toplevel $w -bg beige
124    wm title $w "Input $what"
125    set expgui(temp) {}
126    pack [frame $w.0 -bd 6 -relief groove -bg beige] \
127            -side top -expand yes -fill both
128    grid [label $w.0.a -text "Input a value for the $what" \
129            -bg beige] \
130            -row 0 -column 0 -columnspan 10
131    grid [entry $w.0.b -textvariable expgui(temp) -width $chars] \
132            -row 1 -column 0 
133
134    set expgui(temp) $initvalue
135    pack [frame $w.b] -side top
136    pack [button $w.b.2 -text Set -command "destroy $w"] -side left
137    if $quit {
138        pack [button $w.b.3 -text Quit \
139                -command "set expgui(temp) {}; destroy $w"] -side left
140    }
141    # force the window to stay on top
142    wm transient $w [winfo toplevel [winfo parent $w]]
143
144    bind $w <Return> "destroy $w"
145    wm withdraw $w
146    update idletasks
147    # center the new window in the middle of the parent
148    set x [expr [winfo x [winfo parent $w]] + [winfo width .]/2 - \
149            [winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]]
150    set y [expr [winfo y [winfo parent $w]] + [winfo height .]/2 - \
151            [winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]]
152    wm geom $w +$x+$y
153    wm deiconify $w
154
155    set oldFocus [focus]
156    set oldGrab [grab current $w]
157    if {$oldGrab != ""} {
158        set grabStatus [grab status $oldGrab]
159    }
160    grab $w
161    focus $w.b.2
162    tkwait window $w
163    catch {focus $oldFocus}
164    if {$oldGrab != ""} {
165        if {$grabStatus == "global"} {
166            grab -global $oldGrab
167        } else {
168            grab $oldGrab
169        }
170    }
171    return $expgui(temp)
172}
173
174# run a GSAS program that does not require an experiment file
175proc runGSASprog {proglist} {
176    global expgui tcl_platform
177    set cmd {}
178    foreach prog $proglist {
179        if {$tcl_platform(platform) == "windows"} {
180            append cmd " \"$expgui(gsasexe)/${prog}.exe \" "
181        } else {
182            if {$cmd != ""} {append cmd "\;"}
183            append cmd "[file join $expgui(gsasexe) $prog]"
184        }
185    }
186    forknewterm $prog $cmd 0 1 1
187}
188
189# run a GSAS program that requires an experiment file for input/output
190proc runGSASwEXP {proglist} {
191    global expgui tcl_platform
192    # Save the current exp file
193    savearchiveexp
194    set cmd {}
195    set expnam [file root [file tail $expgui(expfile)]]
196    foreach prog $proglist {
197        if {$prog == "expedt" && $expgui(archive)} archiveexp
198        if {$tcl_platform(platform) == "windows"} {
199            append cmd " \"$expgui(gsasexe)/${prog}.exe $expnam \" "
200        } else {
201            if {$cmd != ""} {append cmd "\;"}
202            append cmd "[file join $expgui(gsasexe) $prog] $expnam"
203        }
204    }
205    forknewterm "$prog -- $expnam" $cmd 0 1 1
206    wm deiconify .
207}
208
209# run liveplot
210proc liveplot {} {
211    global expgui liveplot wishshell
212    set expnam [file root [file tail $expgui(expfile)]]
213    exec $wishshell [file join $expgui(scriptdir) liveplot] \
214            $expnam $liveplot(hst) $liveplot(legend) &
215}
216
217# run lstview
218proc lstview {} {
219    global expgui wishshell
220    set expnam [file root [file tail $expgui(expfile)]]
221    exec $wishshell [file join $expgui(scriptdir) lstview] $expnam &
222}
223
224# run widplt
225proc widplt {} {
226    global expgui wishshell
227    exec $wishshell [file join $expgui(scriptdir) widplt] \
228            $expgui(expfile) &
229}
230
231# show help information
232proc showhelp {} {
233    global expgui_helplist helpmsg
234    set helpmsg {}
235    set frm .help
236    catch {destroy $frm}
237    toplevel $frm
238    wm title $frm "Command Help"
239    pack [message $frm.0 -text \
240            "Click on an entry below to see help on a GSAS command" ] \
241            -side top
242    pack [frame $frm.a -width 20 -height 15] \
243            -side top -expand yes -fill both
244    pack [message $frm.help -textvariable helpmsg -relief groove] \
245            -side left -fill both -expand yes
246    set lst [array names expgui_helplist]
247    listbox $frm.a.cmds -relief raised -bd 2 -yscrollcommand \
248            "$frm.a.scroll set" -height 15 -width 0
249    scrollbar $frm.a.scroll -command "$frm.a.cmds yview"
250    foreach item [lsort $lst] {
251        $frm.a.cmds insert end $item 
252    }
253    if {[$frm.a.cmds curselection] == ""} {$frm.a.cmds selection set 0}
254    button $frm.a.done -text Done -command "destroy $frm"
255    bind $frm.a.cmds <ButtonRelease-1> \
256            "+set helpmsg \$expgui_helplist(\[$frm.a.cmds get \[$frm.a.cmds curselection\]\])"
257    pack $frm.a.scroll -side left -fill y
258    pack $frm.a.cmds -side left -expand yes -anchor w
259    pack $frm.a.done -side right -expand no
260    # get the size of the window and expand the message boxes to match
261    update
262    set width [lindex [split [wm geometry $frm] x+] 0]
263    $frm.0 config -width $width
264    $frm.help config -width $width
265    # waitdone $frm
266}
267
268# compute the composition for each phase and display in a toplevel
269proc composition {} {
270    global expmap expgui
271    set Z 1
272    foreach phase $expmap(phaselist) {
273        catch {unset total}
274        foreach atom $expmap(atomlist_$phase) {
275            set type [atominfo $phase $atom type]
276            set mult [atominfo $phase $atom mult]
277            if [catch {set total($type)}] {
278                set total($type) [expr \
279                        $mult * [atominfo $phase $atom frac]]
280            } else {
281                set total($type) [expr $total($type) + \
282                        $mult * [atominfo $phase $atom frac]]
283            }
284            if {$mult > $Z} {set Z $mult}
285        }
286    }
287   
288    append text "Unit cell contents\n"
289    foreach phase $expmap(phaselist) {
290        append text "  Phase $phase\t"
291        foreach type [lsort [array names total]] {
292            append text "   $type[format %8.3f $total($type)]"
293        }
294        append text "\n"
295    }
296   
297    append text "\n\nAsymmetric Unit contents\n"
298    foreach phase $expmap(phaselist) {
299        append text "  Phase $phase (Z=$Z)\t"
300        foreach type [lsort [array names total]] {
301            append text "   $type[format %8.3f [expr $total($type)/$Z]]"
302        }
303        append text "\n"
304    }
305   
306    catch {destroy .comp}
307    toplevel .comp
308    wm title .comp Composition
309    pack [label .comp.results -text $text \
310            -font $expgui(coordfont) -justify left] -side top
311    pack [frame .comp.box]  -side top
312    pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
313    set lstnam [string toupper [file tail [file rootname $expgui(expfile)].LST]]
314    pack [button .comp.box.2 -text "Save to $lstnam file" \
315            -command "writelst [list $text] ; destroy .comp"] -side left
316}
317
318# write text to the .LST file
319proc writelst {text} {
320    global expgui
321    set lstnam [file rootname $expgui(expfile)].LST
322    set fp [open $lstnam a]
323    puts $fp "\n-----------------------------------------------------------------"
324    puts $fp $text
325    puts $fp "-----------------------------------------------------------------\n"
326    close $fp
327}
328
329# save coordinates in an MSI .xtl file
330proc exp2xtl {} {
331    global expmap expgui
332    catch {destroy .export}
333    toplevel .export
334    wm title .export "Export coordinates"
335    pack [label .export.lbl -text "Export coordinates in MSI .xtl format"\
336            ] -side top -anchor center
337    pack [frame .export.ps] -side top -anchor w
338    pack [label .export.ps.lbl -text "Select phase: "] -side left
339    foreach num $expmap(phaselist) {
340        pack [button .export.ps.$num -text $num \
341                -command "SetExportPhase $num"] -side left
342    }
343    pack [frame .export.sg] -side top
344    pack [label .export.sg.1 -text "Space Group: "] -side left
345    pack [entry .export.sg.2 -textvariable expgui(export_sg) -width 8] -side left
346    pack [checkbutton .export.sg.3 -variable expgui(export_orig) -text "Origin 2"] -side left
347    pack [frame .export.but] -side top
348    if {[llength $expmap(phaselist)] > 0} {
349        pack [button .export.but.1 -text Write -command writextl] -side left
350        SetExportPhase [lindex $expmap(phaselist) 0]
351    }
352    pack [button .export.but.2 -text Quit -command "destroy .export"] -side left
353}
354
355proc SetExportPhase {phase} {
356    global expmap expgui
357    foreach n $expmap(phaselist) {
358        if {$n == $phase} {
359            .export.ps.$n config -relief sunken
360        } else { 
361            .export.ps.$n config -relief raised
362        }
363    }
364    set expgui(export_phase) $phase
365    # remove spaces from space group
366    set spacegroup [phaseinfo $phase spacegroup]
367    if {[string toupper [string range $spacegroup end end]] == "R"} {
368        set spacegroup [string range $spacegroup 0 \
369                [expr [string length $spacegroup]-2]] 
370    }
371    regsub -all " " $spacegroup "" expgui(export_sg)   
372}
373
374
375proc writextl {} {
376    global expgui expmap
377    if ![catch {
378        set phase $expgui(export_phase)
379        set origin $expgui(export_orig)
380        set spsymbol $expgui(export_sg)
381    } errmsg] {
382        set errmsg {}
383        if {$phase == ""} {
384            set errmsg "Error: invalid phase number $phase"
385        } elseif {$spsymbol == ""} {
386            set errmsg "Error: invalid Space Group: $spsymbol"
387        }
388    }
389    if {$errmsg != ""} {
390        tk_dialog .errorMsg "Export error" $errmsg warning 0 "OK"
391        return
392    }
393
394    if [catch {
395        set filnam [file rootname $expgui(expfile)]_${phase}.xtl
396        set spacegroup [phaseinfo $phase spacegroup]
397        set fp [open $filnam w]
398        puts $fp "TITLE from $expgui(expfile)"
399        puts $fp "TITLE history [string trim [lindex [exphistory last] 1]]"
400        puts $fp "TITLE phase [phaseinfo $phase name]"
401        puts $fp "CELL"
402        puts $fp "  [phaseinfo $phase a] [phaseinfo $phase b] [phaseinfo $phase c] [phaseinfo $phase alpha] [phaseinfo $phase beta] [phaseinfo $phase gamma]"
403       
404        puts $fp "Symmetry Label $spsymbol"
405        set rhomb 0
406        if {[string toupper [string range $spacegroup end end]] == "R"} {
407            set rhomb 1
408        }
409        if $origin {
410            puts $fp "Symmetry Qualifier origin_2"
411        }
412        if $rhomb {
413            puts $fp "Symmetry Qualifier rhombohedral"
414        }
415       
416        # are there anisotropic atoms?
417        set aniso 0
418        foreach atom $expmap(atomlist_$phase) {
419            if {[atominfo $phase $atom temptype] == "A"} {set aniso 1}
420        }
421        puts $fp "ATOMS"
422        if $aniso {
423            puts $fp "NAME       X          Y          Z    OCCUP U11 U22 U33 U12 U13 U23"
424            foreach atom $expmap(atomlist_$phase) {
425                set label [atominfo $phase $atom label]
426                # remove () characters
427                if {[atominfo $phase $atom temptype] == "A"} {
428                    puts $fp "$label [atominfo $phase $atom x] \
429                            [atominfo $phase $atom y] [atominfo $phase $atom z] \
430                            [atominfo $phase $atom frac] \
431                            [atominfo $phase $atom U11] \
432                            [atominfo $phase $atom U22] \
433                            [atominfo $phase $atom U33] \
434                            [atominfo $phase $atom U12] \
435                            [atominfo $phase $atom U13] \
436                            [atominfo $phase $atom U23]"
437                } else {
438                    puts $fp "$label [atominfo $phase $atom x] \
439                            [atominfo $phase $atom y] [atominfo $phase $atom z] \
440                            [atominfo $phase $atom frac] \
441                            [atominfo $phase $atom Uiso] \
442                            [atominfo $phase $atom Uiso] \
443                            [atominfo $phase $atom Uiso] \
444                            0 0 0 "
445                }
446            }
447        } else {
448            puts $fp "NAME       X          Y          Z    UISO      OCCUP"
449            foreach atom $expmap(atomlist_$phase) {
450                set label [atominfo $phase $atom label]
451                # remove () characters
452                regsub -all "\[()\]" $label "" label
453                puts $fp "$label [atominfo $phase $atom x] \
454                        [atominfo $phase $atom y] [atominfo $phase $atom z] \
455                        [atominfo $phase $atom Uiso]  [atominfo $phase $atom frac]"
456            }
457        }
458    } errmsg] {
459        catch {close $fp}
460        tk_dialog .errorMsg "Export error" $errmsg warning 0 "OK"
461    } else {
462        catch {close $fp}
463        tk_dialog .ok "Done" \
464                "File [file tail $filnam] written in directory [file dirname $filnam]" \
465                warning 0 "OK"
466    }
467    if {[llength $expmap(phaselist)] == 1} {destroy .export}
468}
469
470
471# convert a file
472proc convfile {} {
473    global tcl_platform
474    if {$tcl_platform(platform) == "windows"} {
475        convwin
476    } else {
477        convunix
478    }
479}
480
481# file conversions for UNIX (convstod convdtos)
482proc convunix {} {
483    global expgui infile outfile
484    set frm .file
485    catch {destroy $frm}
486    toplevel $frm
487    wm title $frm "Convert File"
488
489    pack [frame [set frm0 $frm.0] -bd 2 -relief groove] \
490            -padx 3 -pady 3 -side top -fill x
491    pack [frame $frm.mid] -side top
492    pack [frame [set frmA $frm.mid.1] -bd 2 -relief groove] \
493            -padx 3 -pady 3 -side left
494    pack [label $frmA.0 -text "Select an input file"] -side top -anchor center
495    pack [frame [set frmB $frm.mid.2] -bd 2 -relief groove] \
496            -padx 3 -pady 3 -side left
497    pack [label $frmB.0 -text "Enter an output file"] -side top -anchor center
498    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side top
499
500    pack [label $frm0.1 -text "Convert to:"] -side top -anchor center
501    pack [frame $frm0.2] -side top -anchor center
502    pack [radiobutton $frm0.2.d -text "direct access" -value convstod \
503            -command setoutfile \
504            -variable outfile(type)] -side left -anchor center
505    pack [radiobutton $frm0.2.s -text "sequential" -value convdtos \
506            -command setoutfile \
507            -variable outfile(type)] -side right -anchor center
508    set outfile(type) ""
509
510    pack [button $frmC.b -text Convert -command "valid_conv_unix"] -side left
511    pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side left
512
513   
514    unixcnvbox $frmA infile 1 
515    unixcnvbox $frmB outfile 0 
516    set infile(done) 0
517    # force the window to stay on top
518    wm transient $frm [winfo toplevel [winfo parent $frm]]
519
520    bind $frm <Return> "valid_conv_unix"
521    wm withdraw $frm
522    update idletasks
523    # center the new window in the middle of the parent
524    set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \
525            [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]]
526    set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \
527            [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]]
528    wm geom $frm +$x+$y
529    wm deiconify $frm
530
531    set oldFocus [focus]
532    set oldGrab [grab current $frm]
533    if {$oldGrab != ""} {
534        set grabStatus [grab status $oldGrab]
535    }
536    grab $frm
537    focus $frmC.q 
538    update
539    tkwait variable infile(done)
540    catch {focus $oldFocus}
541    if {$oldGrab != ""} {
542        if {$grabStatus == "global"} {
543            grab -global $oldGrab
544        } else {
545            grab $oldGrab
546        }
547    }
548    destroy $frm
549}
550
551# validate the files and make the conversion -- unix
552proc valid_conv_unix {} {
553    global infile outfile expgui
554    set error {}
555    if {$outfile(type) == "convstod" || $outfile(type) == "convdtos"} {
556        set convtype $outfile(type)
557    } else {
558        append error "You must specify a conversion method: to direct access or to sequential.\n"
559    }
560    if {$infile(name) == ""} {
561        append error "You must specify an input file to convert.\n"
562    }
563    if {$outfile(name) == ""} {
564        append error "You must specify an output file name for the converted file.\n"
565    }
566    if {$error != ""} {
567        tk_dialog .warn Notify $error warning 0 OK
568        return
569    }
570
571    if {$infile(name) == $outfile(name)} {
572        tk_dialog .warn Notify "Sorry, filenames must differ" warning 0 OK
573        return
574    }
575    if ![file exists [file join $infile(dir) $infile(name)]] {
576        tk_dialog .warn Notify \
577                "Sorry, file $infile(name) not found in $infile(dir)" warning 0 OK
578        return
579    }
580    if [file exists [file join $outfile(dir) $outfile(name)]] {
581        if [tk_dialog .warn Notify \
582                "Warning: file $outfile(name) exists in $outfile(dir). OK to overwrite?" \
583                warning 0 OK No] return
584    }
585    if [catch {
586        exec [file join $expgui(gsasexe) $convtype] < \
587                [file join $infile(dir) $infile(name)] > \
588                [file join $outfile(dir) $outfile(name)]
589    } errmsg] {
590        tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
591    } else {
592        if [tk_dialog .converted Notify \
593                "File converted. Convert more files?" \
594                ""  0 Yes No] {set infile(done) 1}
595    }
596}
597
598# create a file box for UNIX conversions
599proc unixcnvbox {bx filvar diropt} {
600    global ${filvar} expgui
601    pack [frame $bx.top] -side top
602    pack [label $bx.top.a -text "Directory" ] -side left
603    set ${filvar}(FileDirButtonMenu) [tk_optionMenu $bx.top.d ${filvar}(dir) [pwd] ]
604    pack $bx.top.d -side left
605    set ${filvar}(dir) [pwd]
606
607#    pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top
608#    set ${filvar}(dir) [pwd]
609
610    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
611    listbox $bx.a.files -relief raised -bd 2 -yscrollcommand "$bx.a.scroll set" \
612            -height 15 -width 0
613    scrollbar $bx.a.scroll -command "$bx.a.files yview"
614    unixFilChoose $bx $bx.a.files $filvar $diropt
615    if {$filvar == "infile"} {
616        bind $bx.a.files <ButtonRelease-1> \
617                "unixFilChoose $bx $bx.a.files $filvar $diropt; setoutfile"
618    } else {
619        bind $bx.a.files <ButtonRelease-1> \
620                "unixFilChoose $bx $bx.a.files $filvar $diropt"
621    }
622    pack $bx.a.scroll -side left -fill y
623    pack $bx.a.files -side left -fill both -expand yes
624    pack [entry $bx.c -textvariable ${filvar}(name)] -side top
625}
626
627# select a file or directory, also called when box is created to fill it
628proc unixFilChoose {frm box filvar {dironly 1}} {
629    global $filvar
630    set select [$box curselection]
631    if {$select == ""} {
632        set file .
633    } else {
634        set file [string trim [$box get $select]]
635    }
636    if [file isdirectory [file join [set ${filvar}(dir)] $file]] {
637        if {$file == ".."} {
638            set ${filvar}(dir) [file dirname [set ${filvar}(dir)] ]
639        } elseif {$file != "."} {
640            set ${filvar}(dir) [file join [set ${filvar}(dir)] $file]
641        }
642        [set ${filvar}(FileDirButtonMenu)] delete 0 end
643        set list ""
644        set dir ""
645        foreach subdir [file split [set ${filvar}(dir)]] {
646            set dir [file join $dir $subdir]
647            lappend list $dir
648        }
649        foreach path $list {
650            [set ${filvar}(FileDirButtonMenu)] add command -label $path \
651                -command "[list set ${filvar}(dir) $path]; \
652                unixFilChoose $frm $box $filvar $dironly"
653        }
654        set ${filvar}(name) {}
655        $box delete 0 end
656        $box insert end {..   }
657        foreach file [lsort [glob -nocomplain \
658                [file join [set ${filvar}(dir)] *] ] ] {
659            if {[file isdirectory $file]} {
660                # is this / needed here? Does it cause a problem in MacGSAS?
661                $box insert end [file tail $file]/
662            } elseif {$dironly == 1} {
663                $box insert end [file tail $file]
664            } elseif {$dironly == 2 && [file extension $file] == ".EXP"} {
665                $box insert end [file tail $file]
666            }
667        }
668        return
669    }
670    set ${filvar}(name) [file tail $file]
671}
672
673# set new file name from old -- used for convunix
674proc setoutfile {} {
675    global infile outfile
676    if {$outfile(type) == "convstod"} {
677        set lfile [string toupper $infile(name)]
678    } elseif {$outfile(type) == "convdtos"} {
679        set lfile [string tolower $infile(name)]
680    } else {
681        set lfile ""
682    }
683    if {$infile(name) == $lfile} {
684        set outfile(name) {}
685    } else {
686        set outfile(name) $lfile
687    }
688}
689
690#------------------------------------------------------------------------------
691# file conversions for Windows
692#------------------------------------------------------------------------------
693proc convwin {} {
694    global expgui
695    set frm .file
696    catch {destroy $frm}
697    toplevel $frm
698    wm title $frm "Convert File"
699    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
700    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
701    pack [button $frmC.b -text Convert -command "valid_conv_win $frm"] \
702            -side top
703    pack [button $frmC.q -text Quit -command "destroy $frm"] -side top
704    pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
705    winfilebox $frmA 
706    # force the window to stay on top
707    wm transient $frm [winfo toplevel [winfo parent $frm]]
708
709    bind $frm <Return> "valid_conv_win $frm"
710    wm withdraw $frm
711    update idletasks
712    # center the new window in the middle of the parent
713    set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \
714            [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]]
715    set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \
716            [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]]
717    wm geom $frm +$x+$y
718    wm deiconify $frm
719
720    set oldFocus [focus]
721    set oldGrab [grab current $frm]
722    if {$oldGrab != ""} {
723        set grabStatus [grab status $oldGrab]
724    }
725    grab $frm
726    focus $frmC.q 
727    tkwait window $frm
728    catch {focus $oldFocus}
729    if {$oldGrab != ""} {
730        if {$grabStatus == "global"} {
731            grab -global $oldGrab
732        } else {
733            grab $oldGrab
734        }
735    }
736    destroy $frm
737}
738
739# validate the files and make the conversion
740proc valid_conv_win {frm} {
741    global expgui
742    if {$expgui(FileMenuCnvName) == "<Parent>"} {
743        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
744        ChooseCnvFil $frm
745        return
746    } elseif [file isdirectory \
747            [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
748        if {$expgui(FileMenuCnvName) != "."} {
749            set expgui(FileMenuDir) \
750                [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
751        }
752        ChooseCnvFil $frm
753        return
754    }
755 
756    set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
757    if ![file exists $file] {
758        tk_dialog .warn "Convert Error" \
759                "File $file does not exist" question 0 "OK"
760        return
761    }
762
763    set tmpname "[file join [file dirname $file] tempfile.xxx]"
764    set oldname "[file rootname $file].org"
765    if [file exists $oldname] {
766        set ans [tk_dialog .warn "OK to overwrite?" \
767                "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" question 0 \
768                "Yes" "No"]
769        if $ans return
770        catch {file delete $oldname}
771    }
772
773    if [catch {
774        set in [open $file r]
775        set out [open $tmpname w]
776        set len [gets $in line]
777        if {$len > 160} {
778            # this is a UNIX file. Hope there are no control characters
779            set i 0
780            set j 79
781            while {$j < $len} {
782                puts $out [string range $line $i $j]
783                incr i 80
784                incr j 80
785            }
786        } else {
787            while {$len >= 0} {
788                append line "                                        "
789                append line "                                        "
790                set line [string range $line 0 79]
791                puts $out $line
792                set len [gets $in line]
793            }
794        }
795        close $in
796        close $out
797        file rename $file $oldname
798        file rename $tmpname $file
799    } errmsg] {
800        tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
801    } else {
802        if [tk_dialog .converted Notify \
803                "File [file tail $file] converted. (Original saved as [file tail $oldname]).\n\n Convert more files?" \
804                ""  0 Yes No] {destroy $frm}
805    }
806}
807
808# create a file box
809proc winfilebox {bx} {
810    global expgui
811    pack [frame $bx.top] -side top
812    pack [label $bx.top.a -text "Directory" ] -side left
813    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
814    pack $bx.top.d -side left
815    set expgui(FileMenuDir) [pwd]
816    # the icon below is from tk8.0/tkfbox.tcl
817    set upfolder [image create bitmap -data {
818#define updir_width 28
819#define updir_height 16
820static char updir_bits[] = {
821   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
822   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
823   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
824   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
825   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
826   0xf0, 0xff, 0xff, 0x01};}]
827
828    pack [button $bx.top.b -image $upfolder \
829            -command "updir; ChooseCnvFil $bx" ]
830    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
831    listbox $bx.a.files -relief raised -bd 2 \
832            -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
833            -height 15 -width 0
834    listbox $bx.a.dates -relief raised -bd 2 \
835            -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
836            -height 15 -width 0 -takefocus 0
837    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
838    ChooseCnvFil $bx
839    bind $bx.a.files <ButtonRelease-1> "ReleaseCnvFil $bx"
840    bind $bx.a.dates <ButtonRelease-1> "ReleaseCnvFil $bx"
841    bind $bx.a.files <Double-1> "SelectCnvFil $bx"
842    bind $bx.a.dates <Double-1> "SelectCnvFil $bx"
843    pack $bx.a.scroll -side left -fill y
844    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
845    pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
846}
847
848# set the box or file in the selection window
849proc ReleaseCnvFil {frm} {
850    global expgui
851    set files $frm.a.files
852    set dates $frm.a.dates
853    set select [$files curselection]
854    if {$select == ""} {
855        set select [$dates curselection]
856    }
857    if {$select == ""} {
858        set expgui(FileMenuCnvName) ""
859    } else {
860        set expgui(FileMenuCnvName) [string trim [$files get $select]]
861    }
862    if {$expgui(FileMenuCnvName) == "<Parent>"} {
863        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
864        ChooseCnvFil $frm
865    } elseif [file isdirectory \
866            [file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
867        if {$expgui(FileMenuCnvName) != "."} {
868            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
869            ChooseCnvFil $frm
870        }
871    }
872    return
873}
874
875# select a file or directory -- called on double click
876proc SelectCnvFil {frm} {
877    global expgui
878    set files $frm.a.files
879    set dates $frm.a.dates
880    set select [$files curselection]
881    if {$select == ""} {
882        set select [$dates curselection]
883    }
884    if {$select == ""} {
885        set file .
886    } else {
887        set file [string trim [$files get $select]]
888    }
889    if {$file == "<Parent>"} {
890        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
891        ChooseCnvFil $frm
892    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
893        if {$file != "."} {
894            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
895            ChooseCnvFil $frm
896        }
897    } else {
898        set expgui(FileMenuCnvName) [file tail $file]
899        valid_conv_win $frm
900    }
901}
902
903# fill the files & dates & Directory selection box with current directory,
904# also called when box is created to fill it
905proc ChooseCnvFil {frm} {
906    global expgui
907    set files $frm.a.files
908    set dates $frm.a.dates
909    set expgui(FileMenuCnvName) {}
910    $files delete 0 end
911    $dates delete 0 end
912    $files insert end {<Parent>}
913    $dates insert end {(Directory)}
914    set filelist [glob -nocomplain \
915            [file join [set expgui(FileMenuDir)] *] ]
916    foreach file [lsort $filelist] {
917        if {[file isdirectory $file]} {
918            $files insert end [file tail $file]
919            $dates insert end {(Directory)}
920        }
921    }
922    foreach file [lsort $filelist] {
923        set modified [file mtime $file]
924        set modified [clock format [file mtime $file] -format "%T %D"]
925        $files insert end [file tail $file]
926        $dates insert end $modified
927    }
928    $expgui(FileDirButtonMenu)  delete 0 end
929    set list ""
930    set dir ""
931    foreach subdir [file split [set expgui(FileMenuDir)]] {
932        set dir [file join $dir $subdir]
933        lappend list $dir
934    }
935    foreach path $list {
936        $expgui(FileDirButtonMenu) add command -label $path \
937                -command "[list set expgui(FileMenuDir) $path]; \
938                ChooseCnvFil $frm"
939    }
940    return
941}
942
943#------------------------------------------------------------------------------
944# set options for liveplot
945proc liveplotopt {} {
946    global liveplot
947    set frm .file
948    catch {destroy $frm}
949    toplevel $frm
950    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
951    pack [scale  $frmA.1 -label "Histogram number" -from 1 -to 9 \
952            -length  150 -orient horizontal -variable liveplot(hst)] -side top
953    pack [checkbutton $frmA.2 -text {include plot legend}\
954            -variable liveplot(legend)] -side top
955    pack [button $frm.2 -text OK \
956            -command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
957            ] -side top
958    bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
959    # force the window to stay on top
960    wm transient $frm [winfo toplevel [winfo parent $frm]]
961    wm withdraw $frm
962    update idletasks
963    # center the new window in the middle of the parent
964    set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \
965            [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]]
966    set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \
967            [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]]
968    wm geom $frm +$x+$y
969    wm deiconify $frm
970
971    set oldFocus [focus]
972    set oldGrab [grab current $frm]
973    if {$oldGrab != ""} {
974        set grabStatus [grab status $oldGrab]
975    }
976    grab $frm
977    focus $frm.2
978    tkwait window $frm
979    catch {focus $oldFocus}
980    if {$oldGrab != ""} {
981        if {$grabStatus == "global"} {
982            grab -global $oldGrab
983        } else {
984            grab $oldGrab
985        }
986    }
987}
988
989#------------------------------------------------------------------------------
990# get an experiment file name
991#------------------------------------------------------------------------------
992proc getExpFileName {mode} {
993    global expgui
994    set frm .file
995    catch {destroy $frm}
996    toplevel $frm
997    wm title $frm "Experiment file"
998    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
999    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
1000    pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
1001    pack [radiobutton $frmC.1 -text "File Name" -value 1 \
1002            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
1003    pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
1004            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
1005    pack [button $frmC.b -text Read \
1006            -command "valid_exp_file $frmA $mode"] -side top
1007    if {$mode == "new"} {
1008        $frmC.b config -text Save
1009    }
1010    pack [button $frmC.q -text Quit \
1011            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side top
1012    bind $frm <Return> "$frmC.b invoke"
1013
1014    if {$mode == "new"} {
1015        pack [label $frmA.0 -text "Enter an experiment file to create"] \
1016                -side top -anchor center
1017    } else {
1018        pack [label $frmA.0 -text "Select an experiment file to read"] \
1019                -side top -anchor center
1020    }
1021    expfilebox $frmA $mode
1022    # force the window to stay on top
1023    wm transient $frm [winfo toplevel [winfo parent $frm]]
1024
1025    wm withdraw $frm
1026    update idletasks
1027    # center the new window in the middle of the parent
1028    set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \
1029            [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]]
1030    set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \
1031            [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]]
1032    wm geom $frm +$x+$y
1033    wm deiconify $frm
1034
1035    set oldFocus [focus]
1036    set oldGrab [grab current $frm]
1037    if {$oldGrab != ""} {
1038        set grabStatus [grab status $oldGrab]
1039    }
1040    grab $frm
1041    focus $frmC.b
1042    tkwait window $frm
1043    catch {focus $oldFocus}
1044    if {$oldGrab != ""} {
1045        if {$grabStatus == "global"} {
1046            grab -global $oldGrab
1047        } else {
1048            grab $oldGrab
1049        }
1050    }
1051    if {$expgui(FileMenuEXPNAM) == ""} return
1052    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1053}
1054
1055# validation routine
1056proc valid_exp_file {frm mode} {
1057    global expgui
1058    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
1059        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1060        ChooseExpFil $frm
1061        return
1062    } elseif [file isdirectory \
1063            [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
1064        if {$expgui(FileMenuEXPNAM) != "."} {
1065            set expgui(FileMenuDir) \
1066                [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1067        }
1068        ChooseExpFil $frm
1069        return
1070    }
1071    set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
1072    if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
1073        append expgui(FileMenuEXPNAM) ".EXP"
1074    }
1075    if {[file extension $expgui(FileMenuEXPNAM)] != ".EXP"} {
1076        tk_dialog .expFileErrorMsg "File Open Error" \
1077            "File $expgui(FileMenuEXPNAM) is not a valid name. Experiment files must end in \".EXP\"" \
1078            error 0 OK
1079        return
1080    }
1081    set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1082    if {$mode == "new" && [file exists $file]} {
1083        set ans [tk_dialog .expFileErrorMsg "File Open Error" \
1084            "File $file already exists. OK to overwrite?" question 0 \
1085             "Select other name" "Overwrite"]
1086        if $ans {destroy .file}
1087        return
1088    }
1089    if {$mode == "old" && ![file exists $file]} {
1090        set ans [tk_dialog .expFileErrorMsg "File Open Error" \
1091            "File $file does not exist. OK to create?" question 0 \
1092             "Select other name" "Create"]
1093        if $ans {destroy .file}
1094        return
1095    }
1096    destroy .file
1097}
1098
1099proc updir {} {
1100    global expgui
1101    set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
1102}
1103
1104# create a file box
1105proc expfilebox {bx mode} {
1106    global expgui
1107    pack [frame $bx.top] -side top
1108    pack [label $bx.top.a -text "Directory" ] -side left
1109    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
1110    pack $bx.top.d -side left
1111    set expgui(FileMenuDir) [pwd]
1112    # the icon below is from tk8.0/tkfbox.tcl
1113    set upfolder [image create bitmap -data {
1114#define updir_width 28
1115#define updir_height 16
1116static char updir_bits[] = {
1117   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1118   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1119   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1120   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1121   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1122   0xf0, 0xff, 0xff, 0x01};}]
1123
1124    pack [button $bx.top.b -image $upfolder \
1125            -command "updir; ChooseExpFil $bx" ]
1126    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
1127    listbox $bx.a.files -relief raised -bd 2 \
1128            -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
1129            -height 15 -width 0
1130    listbox $bx.a.dates -relief raised -bd 2 \
1131            -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
1132            -height 15 -width 0 -takefocus 0
1133    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
1134    ChooseExpFil $bx
1135    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
1136    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
1137    bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
1138    bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
1139    pack $bx.a.scroll -side left -fill y
1140    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
1141    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
1142}
1143proc sync2boxes {master slave scroll args} {
1144    $slave yview moveto [lindex [$master yview] 0]
1145    eval $scroll set $args
1146}
1147proc move2boxesY {boxlist args} {
1148    foreach listbox $boxlist { 
1149        eval $listbox yview $args
1150    }
1151}
1152
1153# set the box or file in the selection window
1154proc ReleaseExpFil {frm} {
1155    global expgui
1156    set files $frm.a.files
1157    set dates $frm.a.dates
1158    set select [$files curselection]
1159    if {$select == ""} {
1160        set select [$dates curselection]
1161    }
1162    if {$select == ""} {
1163        set expgui(FileMenuEXPNAM) ""
1164    } else {
1165        set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
1166    }
1167    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
1168        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
1169        ChooseExpFil $frm
1170    } elseif [file isdirectory \
1171            [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
1172        if {$expgui(FileMenuEXPNAM) != "."} {
1173            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1174            ChooseExpFil $frm
1175        }
1176    }
1177    return
1178}
1179
1180# select a file or directory -- called on double click
1181proc SelectExpFil {frm mode} {
1182    global expgui
1183    set files $frm.a.files
1184    set dates $frm.a.dates
1185    set select [$files curselection]
1186    if {$select == ""} {
1187        set select [$dates curselection]
1188    }
1189    if {$select == ""} {
1190        set file .
1191    } else {
1192        set file [string trim [$files get $select]]
1193    }
1194    if {$file == "<Parent>"} {
1195        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1196        ChooseExpFil $frm
1197    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
1198        if {$file != "."} {
1199            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
1200            ChooseExpFil $frm
1201        }
1202    } else {
1203        set expgui(FileMenuEXPNAM) [file tail $file]
1204        valid_exp_file $frm $mode
1205    }
1206}
1207
1208# fill the files & dates & Directory selection box with current directory,
1209# also called when box is created to fill it
1210proc ChooseExpFil {frm} {
1211    global expgui
1212    set files $frm.a.files
1213    set dates $frm.a.dates
1214    set expgui(FileMenuEXPNAM) {}
1215    $files delete 0 end
1216    $dates delete 0 end
1217    $files insert end {<Parent>}
1218    $dates insert end {(Directory)}
1219    set filelist [glob -nocomplain \
1220            [file join [set expgui(FileMenuDir)] *] ]
1221    foreach file [lsort $filelist] {
1222        if {[file isdirectory $file]} {
1223            $files insert end [file tail $file]
1224            $dates insert end {(Directory)}
1225        }
1226    }
1227    set pairlist {}
1228    foreach file [lsort $filelist] {
1229        if {![file isdirectory $file]  && \
1230                [string toupper [file extension $file]] == ".EXP"} {
1231            set modified [file mtime $file]
1232            lappend pairlist "$file $modified"
1233        }
1234    }
1235    if {$expgui(filesort) == 0} {
1236        foreach pair [lsort -index 1 -integer $pairlist] {
1237            set file [lindex $pair 0]
1238            set modified [clock format [lindex $pair 1] -format "%T %D"]
1239            $files insert end [file tail $file]
1240            $dates insert end $modified
1241        }
1242    } else {
1243        foreach pair [lsort -index 0 $pairlist] {
1244            set file [lindex $pair 0]
1245            set modified [clock format [lindex $pair 1] -format "%T %D"]
1246            $files insert end [file tail $file]
1247            $dates insert end $modified
1248        }
1249    }
1250    $expgui(FileDirButtonMenu)  delete 0 end
1251    set list ""
1252    set dir ""
1253    foreach subdir [file split [set expgui(FileMenuDir)]] {
1254        set dir [file join $dir $subdir]
1255        lappend list $dir
1256    }
1257    foreach path $list {
1258        $expgui(FileDirButtonMenu) add command -label $path \
1259                -command "[list set expgui(FileMenuDir) $path]; \
1260                ChooseExpFil $frm"
1261    }
1262    # highlight the current experiment -- if present
1263    for {set i 0} {$i < [$files size]} {incr i} {
1264        set file [$files get $i]
1265        if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
1266            $files selection set $i
1267        }
1268    }
1269    return
1270}
1271
Note: See TracBrowser for help on using the repository browser.