source: trunk/gsascmds.tcl @ 88

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

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