source: trunk/gsascmds.tcl @ 60

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

# on 1999/02/19 16:02:23, toby did:
* empty log message *

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