source: trunk/gsascmds.tcl @ 72

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

# on 1999/03/19 17:07:59, toby did:
rename file directory routines
make file menus smarter w/r to windows usage
fix bug with spaces in filenames

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