source: trunk/gsascmds.tcl @ 62

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

# on 1999/02/19 18:18:23, toby did:
cleanup warnings
  • Property rcs:author set to toby
  • Property rcs:date set to 1999/02/19 18:18:23
  • Property rcs:lines set to +3 -4
  • Property rcs:rev set to 1.9
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 40.9 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}
734
735# validate the files and make the conversion
736proc valid_conv_win {frm} {
737    global expgui
738    if {$expgui(FileMenuCnvName) == "<Parent>"} {
739        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
740        ChooseCnvFil $frm
741        return
742    } elseif [file isdirectory \
743            [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
744        if {$expgui(FileMenuCnvName) != "."} {
745            set expgui(FileMenuDir) \
746                [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
747        }
748        ChooseCnvFil $frm
749        return
750    }
751 
752    set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
753    if ![file exists $file] {
754        tk_dialog .warn "Convert Error" \
755                "File $file does not exist" question 0 "OK"
756        return
757    }
758
759    set tmpname "[file join [file dirname $file] tempfile.xxx]"
760    set oldname "[file rootname $file].org"
761    if [file exists $oldname] {
762        set ans [tk_dialog .warn "OK to overwrite?" \
763                "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" question 0 \
764                "Yes" "No"]
765        if $ans return
766        catch {file delete $oldname}
767    }
768
769    if [catch {
770        set in [open $file r]
771        set out [open $tmpname w]
772        set len [gets $in line]
773        if {$len > 160} {
774            # this is a UNIX file. Hope there are no control characters
775            set i 0
776            set j 79
777            while {$j < $len} {
778                puts $out [string range $line $i $j]
779                incr i 80
780                incr j 80
781            }
782        } else {
783            while {$len >= 0} {
784                append line "                                        "
785                append line "                                        "
786                set line [string range $line 0 79]
787                puts $out $line
788                set len [gets $in line]
789            }
790        }
791        close $in
792        close $out
793        file rename $file $oldname
794        file rename $tmpname $file
795    } errmsg] {
796        tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
797    } else {
798        if [tk_dialog .converted Notify \
799                "File [file tail $file] converted. (Original saved as [file tail $oldname]).\n\n Convert more files?" \
800                ""  0 Yes No] {destroy $frm}
801    }
802}
803
804# create a file box
805proc winfilebox {bx} {
806    global expgui
807    pack [frame $bx.top] -side top
808    pack [label $bx.top.a -text "Directory" ] -side left
809    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
810    pack $bx.top.d -side left
811    set expgui(FileMenuDir) [pwd]
812    # the icon below is from tk8.0/tkfbox.tcl
813    set upfolder [image create bitmap -data {
814#define updir_width 28
815#define updir_height 16
816static char updir_bits[] = {
817   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
818   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
819   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
820   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
821   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
822   0xf0, 0xff, 0xff, 0x01};}]
823
824    pack [button $bx.top.b -image $upfolder \
825            -command "updir; ChooseCnvFil $bx" ]
826    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
827    listbox $bx.a.files -relief raised -bd 2 \
828            -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
829            -height 15 -width 0
830    listbox $bx.a.dates -relief raised -bd 2 \
831            -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
832            -height 15 -width 0 -takefocus 0
833    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
834    ChooseCnvFil $bx
835    bind $bx.a.files <ButtonRelease-1> "ReleaseCnvFil $bx"
836    bind $bx.a.dates <ButtonRelease-1> "ReleaseCnvFil $bx"
837    bind $bx.a.files <Double-1> "SelectCnvFil $bx"
838    bind $bx.a.dates <Double-1> "SelectCnvFil $bx"
839    pack $bx.a.scroll -side left -fill y
840    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
841    pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
842}
843
844# set the box or file in the selection window
845proc ReleaseCnvFil {frm} {
846    global expgui
847    set files $frm.a.files
848    set dates $frm.a.dates
849    set select [$files curselection]
850    if {$select == ""} {
851        set select [$dates curselection]
852    }
853    if {$select == ""} {
854        set expgui(FileMenuCnvName) ""
855    } else {
856        set expgui(FileMenuCnvName) [string trim [$files get $select]]
857    }
858    if {$expgui(FileMenuCnvName) == "<Parent>"} {
859        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
860        ChooseCnvFil $frm
861    } elseif [file isdirectory \
862            [file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
863        if {$expgui(FileMenuCnvName) != "."} {
864            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
865            ChooseCnvFil $frm
866        }
867    }
868    return
869}
870
871# select a file or directory -- called on double click
872proc SelectCnvFil {frm} {
873    global expgui
874    set files $frm.a.files
875    set dates $frm.a.dates
876    set select [$files curselection]
877    if {$select == ""} {
878        set select [$dates curselection]
879    }
880    if {$select == ""} {
881        set file .
882    } else {
883        set file [string trim [$files get $select]]
884    }
885    if {$file == "<Parent>"} {
886        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
887        ChooseCnvFil $frm
888    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
889        if {$file != "."} {
890            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
891            ChooseCnvFil $frm
892        }
893    } else {
894        set expgui(FileMenuCnvName) [file tail $file]
895        valid_conv_win $frm
896    }
897}
898
899# fill the files & dates & Directory selection box with current directory,
900# also called when box is created to fill it
901proc ChooseCnvFil {frm} {
902    global expgui
903    set files $frm.a.files
904    set dates $frm.a.dates
905    set expgui(FileMenuCnvName) {}
906    $files delete 0 end
907    $dates delete 0 end
908    $files insert end {<Parent>}
909    $dates insert end {(Directory)}
910    set filelist [glob -nocomplain \
911            [file join [set expgui(FileMenuDir)] *] ]
912    foreach file [lsort $filelist] {
913        if {[file isdirectory $file]} {
914            $files insert end [file tail $file]
915            $dates insert end {(Directory)}
916        }
917    }
918    foreach file [lsort $filelist] {
919        set modified [file mtime $file]
920        set modified [clock format [file mtime $file] -format "%T %D"]
921        $files insert end [file tail $file]
922        $dates insert end $modified
923    }
924    $expgui(FileDirButtonMenu)  delete 0 end
925    set list ""
926    set dir ""
927    foreach subdir [file split [set expgui(FileMenuDir)]] {
928        set dir [file join $dir $subdir]
929        lappend list $dir
930    }
931    foreach path $list {
932        $expgui(FileDirButtonMenu) add command -label $path \
933                -command "[list set expgui(FileMenuDir) $path]; \
934                ChooseCnvFil $frm"
935    }
936    return
937}
938
939#------------------------------------------------------------------------------
940# set options for liveplot
941proc liveplotopt {} {
942    global liveplot
943    set frm .file
944    catch {destroy $frm}
945    toplevel $frm
946    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
947    pack [scale  $frmA.1 -label "Histogram number" -from 1 -to 9 \
948            -length  150 -orient horizontal -variable liveplot(hst)] -side top
949    pack [checkbutton $frmA.2 -text {include plot legend}\
950            -variable liveplot(legend)] -side top
951    pack [button $frm.2 -text OK \
952            -command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
953            ] -side top
954    bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
955    # force the window to stay on top
956    wm transient $frm [winfo toplevel [winfo parent $frm]]
957    wm withdraw $frm
958    update idletasks
959    # center the new window in the middle of the parent
960    set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \
961            [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]]
962    set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \
963            [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]]
964    wm geom $frm +$x+$y
965    wm deiconify $frm
966
967    set oldFocus [focus]
968    set oldGrab [grab current $frm]
969    if {$oldGrab != ""} {
970        set grabStatus [grab status $oldGrab]
971    }
972    grab $frm
973    focus $frm.2
974    tkwait window $frm
975    catch {focus $oldFocus}
976    if {$oldGrab != ""} {
977        if {$grabStatus == "global"} {
978            grab -global $oldGrab
979        } else {
980            grab $oldGrab
981        }
982    }
983}
984
985#------------------------------------------------------------------------------
986# get an experiment file name
987#------------------------------------------------------------------------------
988proc getExpFileName {mode} {
989    global expgui
990    set frm .file
991    catch {destroy $frm}
992    toplevel $frm
993    wm title $frm "Experiment file"
994    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
995    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
996    pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
997    pack [radiobutton $frmC.1 -text "File Name" -value 1 \
998            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
999    pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
1000            -variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
1001    pack [button $frmC.b -text Read \
1002            -command "valid_exp_file $frmA $mode"] -side top
1003    if {$mode == "new"} {
1004        $frmC.b config -text Save
1005    }
1006    pack [button $frmC.q -text Quit \
1007            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side top
1008    bind $frm <Return> "$frmC.b invoke"
1009
1010    if {$mode == "new"} {
1011        pack [label $frmA.0 -text "Enter an experiment file to create"] \
1012                -side top -anchor center
1013    } else {
1014        pack [label $frmA.0 -text "Select an experiment file to read"] \
1015                -side top -anchor center
1016    }
1017    expfilebox $frmA $mode
1018    # force the window to stay on top
1019    wm transient $frm [winfo toplevel [winfo parent $frm]]
1020
1021    wm withdraw $frm
1022    update idletasks
1023    # center the new window in the middle of the parent
1024    set x [expr [winfo x [winfo parent $frm]] + [winfo width .]/2 - \
1025            [winfo reqwidth $frm]/2 - [winfo vrootx [winfo parent $frm]]]
1026    set y [expr [winfo y [winfo parent $frm]] + [winfo height .]/2 - \
1027            [winfo reqheight $frm]/2 - [winfo vrooty [winfo parent $frm]]]
1028    wm geom $frm +$x+$y
1029    wm deiconify $frm
1030
1031    set oldFocus [focus]
1032    set oldGrab [grab current $frm]
1033    if {$oldGrab != ""} {
1034        set grabStatus [grab status $oldGrab]
1035    }
1036    grab $frm
1037    focus $frmC.b
1038    tkwait window $frm
1039    catch {focus $oldFocus}
1040    if {$oldGrab != ""} {
1041        if {$grabStatus == "global"} {
1042            grab -global $oldGrab
1043        } else {
1044            grab $oldGrab
1045        }
1046    }
1047    if {$expgui(FileMenuEXPNAM) == ""} return
1048    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1049}
1050
1051# validation routine
1052proc valid_exp_file {frm mode} {
1053    global expgui
1054    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
1055        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1056        ChooseExpFil $frm
1057        return
1058    } elseif [file isdirectory \
1059            [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
1060        if {$expgui(FileMenuEXPNAM) != "."} {
1061            set expgui(FileMenuDir) \
1062                [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1063        }
1064        ChooseExpFil $frm
1065        return
1066    }
1067    set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
1068    if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
1069        append expgui(FileMenuEXPNAM) ".EXP"
1070    }
1071    if {[file extension $expgui(FileMenuEXPNAM)] != ".EXP"} {
1072        tk_dialog .expFileErrorMsg "File Open Error" \
1073            "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
1074            error 0 OK
1075        return
1076    }
1077    set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1078    if {$mode == "new" && [file exists $file]} {
1079        set ans [tk_dialog .expFileErrorMsg "File Open Error" \
1080            "File [file tail $file] already exists in [file dirname $file]. OK to overwrite?" question 0 \
1081             "Select other name" "Overwrite"]
1082        if $ans {destroy .file}
1083        return
1084    }
1085    if {$mode == "old" && ![file exists $file]} {
1086        set ans [tk_dialog .expFileErrorMsg "File Open Error" \
1087            "File [file tail $file] does not exist in [file dirname $file]. OK to create?" question 0 \
1088             "Select other name" "Create"]
1089        if $ans {destroy .file}
1090        return
1091    }
1092    destroy .file
1093}
1094
1095proc updir {} {
1096    global expgui
1097    set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
1098}
1099
1100# create a file box
1101proc expfilebox {bx mode} {
1102    global expgui
1103    pack [frame $bx.top] -side top
1104    pack [label $bx.top.a -text "Directory" ] -side left
1105    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
1106    pack $bx.top.d -side left
1107    set expgui(FileMenuDir) [pwd]
1108    # the icon below is from tk8.0/tkfbox.tcl
1109    set upfolder [image create bitmap -data {
1110#define updir_width 28
1111#define updir_height 16
1112static char updir_bits[] = {
1113   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1114   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1115   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1116   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1117   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1118   0xf0, 0xff, 0xff, 0x01};}]
1119
1120    pack [button $bx.top.b -image $upfolder \
1121            -command "updir; ChooseExpFil $bx" ]
1122    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
1123    listbox $bx.a.files -relief raised -bd 2 \
1124            -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
1125            -height 15 -width 0
1126    listbox $bx.a.dates -relief raised -bd 2 \
1127            -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
1128            -height 15 -width 0 -takefocus 0
1129    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
1130    ChooseExpFil $bx
1131    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
1132    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
1133    bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
1134    bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
1135    pack $bx.a.scroll -side left -fill y
1136    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
1137    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
1138}
1139proc sync2boxes {master slave scroll args} {
1140    $slave yview moveto [lindex [$master yview] 0]
1141    eval $scroll set $args
1142}
1143proc move2boxesY {boxlist args} {
1144    foreach listbox $boxlist { 
1145        eval $listbox yview $args
1146    }
1147}
1148
1149# set the box or file in the selection window
1150proc ReleaseExpFil {frm} {
1151    global expgui
1152    set files $frm.a.files
1153    set dates $frm.a.dates
1154    set select [$files curselection]
1155    if {$select == ""} {
1156        set select [$dates curselection]
1157    }
1158    if {$select == ""} {
1159        set expgui(FileMenuEXPNAM) ""
1160    } else {
1161        set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
1162    }
1163    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
1164        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
1165        ChooseExpFil $frm
1166    } elseif [file isdirectory \
1167            [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
1168        if {$expgui(FileMenuEXPNAM) != "."} {
1169            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
1170            ChooseExpFil $frm
1171        }
1172    }
1173    return
1174}
1175
1176# select a file or directory -- called on double click
1177proc SelectExpFil {frm mode} {
1178    global expgui
1179    set files $frm.a.files
1180    set dates $frm.a.dates
1181    set select [$files curselection]
1182    if {$select == ""} {
1183        set select [$dates curselection]
1184    }
1185    if {$select == ""} {
1186        set file .
1187    } else {
1188        set file [string trim [$files get $select]]
1189    }
1190    if {$file == "<Parent>"} {
1191        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1192        ChooseExpFil $frm
1193    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
1194        if {$file != "."} {
1195            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
1196            ChooseExpFil $frm
1197        }
1198    } else {
1199        set expgui(FileMenuEXPNAM) [file tail $file]
1200        valid_exp_file $frm $mode
1201    }
1202}
1203
1204# fill the files & dates & Directory selection box with current directory,
1205# also called when box is created to fill it
1206proc ChooseExpFil {frm} {
1207    global expgui
1208    set files $frm.a.files
1209    set dates $frm.a.dates
1210    set expgui(FileMenuEXPNAM) {}
1211    $files delete 0 end
1212    $dates delete 0 end
1213    $files insert end {<Parent>}
1214    $dates insert end {(Directory)}
1215    set filelist [glob -nocomplain \
1216            [file join [set expgui(FileMenuDir)] *] ]
1217    foreach file [lsort $filelist] {
1218        if {[file isdirectory $file]} {
1219            $files insert end [file tail $file]
1220            $dates insert end {(Directory)}
1221        }
1222    }
1223    set pairlist {}
1224    foreach file [lsort $filelist] {
1225        if {![file isdirectory $file]  && \
1226                [string toupper [file extension $file]] == ".EXP"} {
1227            set modified [file mtime $file]
1228            lappend pairlist "$file $modified"
1229        }
1230    }
1231    if {$expgui(filesort) == 0} {
1232        foreach pair [lsort -index 1 -integer $pairlist] {
1233            set file [lindex $pair 0]
1234            set modified [clock format [lindex $pair 1] -format "%T %D"]
1235            $files insert end [file tail $file]
1236            $dates insert end $modified
1237        }
1238    } else {
1239        foreach pair [lsort -index 0 $pairlist] {
1240            set file [lindex $pair 0]
1241            set modified [clock format [lindex $pair 1] -format "%T %D"]
1242            $files insert end [file tail $file]
1243            $dates insert end $modified
1244        }
1245    }
1246    $expgui(FileDirButtonMenu)  delete 0 end
1247    set list ""
1248    set dir ""
1249    foreach subdir [file split [set expgui(FileMenuDir)]] {
1250        set dir [file join $dir $subdir]
1251        lappend list $dir
1252    }
1253    foreach path $list {
1254        $expgui(FileDirButtonMenu) add command -label $path \
1255                -command "[list set expgui(FileMenuDir) $path]; \
1256                ChooseExpFil $frm"
1257    }
1258    # highlight the current experiment -- if present
1259    for {set i 0} {$i < [$files size]} {incr i} {
1260        set file [$files get $i]
1261        if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
1262            $files selection set $i
1263        }
1264    }
1265    return
1266}
1267
Note: See TracBrowser for help on using the repository browser.