Changeset 59


Ignore:
Timestamp:
Dec 4, 2009 4:59:43 PM (14 years ago)
Author:
toby
Message:

# on 1999/02/19 16:01:46, toby did:
Clean up file input dialogs for convert and .exp files
Add composition computation (composition & writelst)
Add XTL coordinate export routine (exp2xtl, SetExportPhase? & writextl)

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/gsascmds.tcl

    • Property rcs:date changed from 1999/02/16 18:03:01 to 1999/02/19 16:01:46
    • Property rcs:lines changed from +2 -1 to +508 -96
    • Property rcs:rev changed from 1.6 to 1.7
    r52 r59  
    266266}
    267267
     268# compute the composition for each phase and display in a toplevel
     269proc composition {} {
     270    global expmap expgui
     271    set Z 1
     272    foreach phase $expmap(phaselist) {
     273        catch {unset total}
     274        foreach atom $expmap(atomlist_$phase) {
     275            set type [atominfo $phase $atom type]
     276            set mult [atominfo $phase $atom mult]
     277            if [catch {set total($type)}] {
     278                set total($type) [expr \
     279                        $mult * [atominfo $phase $atom frac]]
     280            } else {
     281                set total($type) [expr $total($type) + \
     282                        $mult * [atominfo $phase $atom frac]]
     283            }
     284            if {$mult > $Z} {set Z $mult}
     285        }
     286    }
     287   
     288    append text "Unit cell contents\n"
     289    foreach phase $expmap(phaselist) {
     290        append text "  Phase $phase\t"
     291        foreach type [lsort [array names total]] {
     292            append text "   $type[format %8.3f $total($type)]"
     293        }
     294        append text "\n"
     295    }
     296   
     297    append text "\n\nAsymmetric Unit contents\n"
     298    foreach phase $expmap(phaselist) {
     299        append text "  Phase $phase (Z=$Z)\t"
     300        foreach type [lsort [array names total]] {
     301            append text "   $type[format %8.3f [expr $total($type)/$Z]]"
     302        }
     303        append text "\n"
     304    }
     305   
     306    catch {destroy .comp}
     307    toplevel .comp
     308    wm title .comp Composition
     309    pack [label .comp.results -text $text \
     310            -font $expgui(coordfont) -justify left] -side top
     311    pack [frame .comp.box]  -side top
     312    pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
     313    set lstnam [string toupper [file tail [file rootname $expgui(expfile)].LST]]
     314    pack [button .comp.box.2 -text "Save to $lstnam file" \
     315            -command "writelst [list $text] ; destroy .comp"] -side left
     316}
     317
     318# write text to the .LST file
     319proc writelst {text} {
     320    global expgui
     321    set lstnam [file rootname $expgui(expfile)].LST
     322    set fp [open $lstnam a]
     323    puts $fp "\n-----------------------------------------------------------------"
     324    puts $fp $text
     325    puts $fp "-----------------------------------------------------------------\n"
     326    close $fp
     327}
     328
     329# save coordinates in an MSI .xtl file
     330proc exp2xtl {} {
     331    global expmap expgui
     332    catch {destroy .export}
     333    toplevel .export
     334    wm title .export "Export coordinates"
     335    pack [label .export.lbl -text "Export coordinates in MSI .xtl format"\
     336            ] -side top -anchor center
     337    pack [frame .export.ps] -side top -anchor w
     338    pack [label .export.ps.lbl -text "Select phase: "] -side left
     339    foreach num $expmap(phaselist) {
     340        pack [button .export.ps.$num -text $num \
     341                -command "SetExportPhase $num"] -side left
     342    }
     343    pack [frame .export.sg] -side top
     344    pack [label .export.sg.1 -text "Space Group: "] -side left
     345    pack [entry .export.sg.2 -textvariable expgui(export_sg) -width 8] -side left
     346    pack [checkbutton .export.sg.3 -variable expgui(export_orig) -text "Origin 2"] -side left
     347    pack [frame .export.but] -side top
     348    if {[llength $expmap(phaselist)] > 0} {
     349        pack [button .export.but.1 -text Write -command writextl] -side left
     350        SetExportPhase [lindex $expmap(phaselist) 0]
     351    }
     352    pack [button .export.but.2 -text Quit -command "destroy .export"] -side left
     353}
     354
     355proc SetExportPhase {phase} {
     356    global expmap expgui
     357    foreach n $expmap(phaselist) {
     358        if {$n == $phase} {
     359            .export.ps.$n config -relief sunken
     360        } else {
     361            .export.ps.$n config -relief raised
     362        }
     363    }
     364    set expgui(export_phase) $phase
     365    # remove spaces from space group
     366    set spacegroup [phaseinfo $phase spacegroup]
     367    if {[string toupper [string range $spacegroup end end]] == "R"} {
     368        set spacegroup [string range $spacegroup 0 \
     369                [expr [string length $spacegroup]-2]]
     370    }
     371    regsub -all " " $spacegroup "" expgui(export_sg)   
     372}
     373
     374
     375proc writextl {} {
     376    global expgui expmap
     377    if ![catch {
     378        set phase $expgui(export_phase)
     379        set origin $expgui(export_orig)
     380        set spsymbol $expgui(export_sg)
     381    } errmsg] {
     382        set errmsg {}
     383        if {$phase == ""} {
     384            set errmsg "Error: invalid phase number $phase"
     385        } elseif {$spsymbol == ""} {
     386            set errmsg "Error: invalid Space Group: $spsymbol"
     387        }
     388    }
     389    if {$errmsg != ""} {
     390        tk_dialog .errorMsg "Export error" $errmsg warning 0 "OK"
     391        return
     392    }
     393
     394    if [catch {
     395        set filnam [file rootname $expgui(expfile)]_${phase}.xtl
     396        set spacegroup [phaseinfo $phase spacegroup]
     397        set fp [open $filnam w]
     398        puts $fp "TITLE from $expgui(expfile)"
     399        puts $fp "TITLE history [string trim [lindex [exphistory last] 1]]"
     400        puts $fp "TITLE phase [phaseinfo $phase name]"
     401        puts $fp "CELL"
     402        puts $fp "  [phaseinfo $phase a] [phaseinfo $phase b] [phaseinfo $phase c] [phaseinfo $phase alpha] [phaseinfo $phase beta] [phaseinfo $phase gamma]"
     403       
     404        puts $fp "Symmetry Label $spsymbol"
     405        set rhomb 0
     406        if {[string toupper [string range $spacegroup end end]] == "R"} {
     407            set rhomb 1
     408        }
     409        if $origin {
     410            puts $fp "Symmetry Qualifier origin_2"
     411        }
     412        if $rhomb {
     413            puts $fp "Symmetry Qualifier rhombohedral"
     414        }
     415       
     416        # are there anisotropic atoms?
     417        set aniso 0
     418        foreach atom $expmap(atomlist_$phase) {
     419            if {[atominfo $phase $atom temptype] == "A"} {set aniso 1}
     420        }
     421        puts $fp "ATOMS"
     422        if $aniso {
     423            puts $fp "NAME       X          Y          Z    OCCUP U11 U22 U33 U12 U13 U23"
     424            foreach atom $expmap(atomlist_$phase) {
     425                set label [atominfo $phase $atom label]
     426                # remove () characters
     427                if {[atominfo $phase $atom temptype] == "A"} {
     428                    puts $fp "$label [atominfo $phase $atom x] \
     429                            [atominfo $phase $atom y] [atominfo $phase $atom z] \
     430                            [atominfo $phase $atom frac] \
     431                            [atominfo $phase $atom U11] \
     432                            [atominfo $phase $atom U22] \
     433                            [atominfo $phase $atom U33] \
     434                            [atominfo $phase $atom U12] \
     435                            [atominfo $phase $atom U13] \
     436                            [atominfo $phase $atom U23]"
     437                } else {
     438                    puts $fp "$label [atominfo $phase $atom x] \
     439                            [atominfo $phase $atom y] [atominfo $phase $atom z] \
     440                            [atominfo $phase $atom frac] \
     441                            [atominfo $phase $atom Uiso] \
     442                            [atominfo $phase $atom Uiso] \
     443                            [atominfo $phase $atom Uiso] \
     444                            0 0 0 "
     445                }
     446            }
     447        } else {
     448            puts $fp "NAME       X          Y          Z    UISO      OCCUP"
     449            foreach atom $expmap(atomlist_$phase) {
     450                set label [atominfo $phase $atom label]
     451                # remove () characters
     452                regsub -all "\[()\]" $label "" label
     453                puts $fp "$label [atominfo $phase $atom x] \
     454                        [atominfo $phase $atom y] [atominfo $phase $atom z] \
     455                        [atominfo $phase $atom Uiso]  [atominfo $phase $atom frac]"
     456            }
     457        }
     458    } errmsg] {
     459        catch {close $fp}
     460        tk_dialog .errorMsg "Export error" $errmsg warning 0 "OK"
     461    } else {
     462        catch {close $fp}
     463        tk_dialog .ok "Done" \
     464                "File [file tail $filnam] written in directory [file dirname $filnam]" \
     465                warning 0 "OK"
     466    }
     467    if {[llength $expmap(phaselist)] == 1} {destroy .export}
     468}
     469
     470
    268471# convert a file
    269472proc convfile {} {
    … …  
    283486    toplevel $frm
    284487    wm title $frm "Convert File"
    285     pack [frame [set frm0 $frm.0] -bd 2 -relief groove] -padx 3 -pady 3 -side top
    286     pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
    287     pack [frame [set frmB $frm.2] -bd 2 -relief groove] -padx 3 -pady 3 -side left
    288     pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
    289     pack [button $frmC.b -text Convert -command "valid_conv_file"] -side top
    290     pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side top
    291 
     488
     489    pack [frame [set frm0 $frm.0] -bd 2 -relief groove] \
     490            -padx 3 -pady 3 -side top -fill x
     491    pack [frame $frm.mid] -side top
     492    pack [frame [set frmA $frm.mid.1] -bd 2 -relief groove] \
     493            -padx 3 -pady 3 -side left
    292494    pack [label $frmA.0 -text "Select an input file"] -side top -anchor center
     495    pack [frame [set frmB $frm.mid.2] -bd 2 -relief groove] \
     496            -padx 3 -pady 3 -side left
    293497    pack [label $frmB.0 -text "Enter an output file"] -side top -anchor center
     498    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side top
     499
     500    pack [label $frm0.1 -text "Convert to:"] -side top -anchor center
     501    pack [frame $frm0.2] -side top -anchor center
     502    pack [radiobutton $frm0.2.d -text "direct access" -value convstod \
     503            -command setoutfile \
     504            -variable outfile(type)] -side left -anchor center
     505    pack [radiobutton $frm0.2.s -text "sequential" -value convdtos \
     506            -command setoutfile \
     507            -variable outfile(type)] -side right -anchor center
     508    set outfile(type) ""
     509
     510    pack [button $frmC.b -text Convert -command "valid_conv_unix"] -side left
     511    pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side left
     512
    294513   
    295     pack [label $frm0.1 -text "Convert to:"] -side top -anchor w
    296     pack [radiobutton $frm0.2 -text "direct access" -value convstod \
    297             -command setoutfile \
    298             -variable outfile(type)] -side top -anchor w
    299     pack [radiobutton $frm0.3 -text "sequential" -value convdtos \
    300             -command setoutfile \
    301             -variable outfile(type)] -side top -anchor w
    302     set outfile(type) ""
    303     cnvfilebox $frmA infile 1
    304     cnvfilebox $frmB outfile 0
     514    unixcnvbox $frmA infile 1
     515    unixcnvbox $frmB outfile 0
    305516    set infile(done) 0
    306517    # force the window to stay on top
    307518    wm transient $frm [winfo toplevel [winfo parent $frm]]
    308519
    309     bind $frm <Return> "valid_conv_file"
     520    bind $frm <Return> "valid_conv_unix"
    310521    wm withdraw $frm
    311522    update idletasks
    … …  
    338549}
    339550
    340 # validate the files and make the conversion
    341 proc valid_conv_file {} {
     551# validate the files and make the conversion -- unix
     552proc valid_conv_unix {} {
    342553    global infile outfile expgui
     554    set error {}
    343555    if {$outfile(type) == "convstod" || $outfile(type) == "convdtos"} {
    344556        set convtype $outfile(type)
    345557    } else {
     558        append error "You must specify a conversion method: to direct access or to sequential.\n"
     559    }
     560    if {$infile(name) == ""} {
     561        append error "You must specify an input file to convert.\n"
     562    }
     563    if {$outfile(name) == ""} {
     564        append error "You must specify an output file name for the converted file.\n"
     565    }
     566    if {$error != ""} {
     567        tk_dialog .warn Notify $error warning 0 OK
    346568        return
    347569    }
    348     if {$infile(name) == ""} return
    349     if {$outfile(name) == ""} return
     570
    350571    if {$infile(name) == $outfile(name)} {
    351572        tk_dialog .warn Notify "Sorry, filenames must differ" warning 0 OK
    … …  
    375596}
    376597
     598# create a file box for UNIX conversions
     599proc unixcnvbox {bx filvar diropt} {
     600    global ${filvar} expgui
     601    pack [frame $bx.top] -side top
     602    pack [label $bx.top.a -text "Directory" ] -side left
     603    set ${filvar}(FileDirButtonMenu) [tk_optionMenu $bx.top.d ${filvar}(dir) [pwd] ]
     604    pack $bx.top.d -side left
     605    set ${filvar}(dir) [pwd]
     606
     607#    pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top
     608#    set ${filvar}(dir) [pwd]
     609
     610    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
     611    listbox $bx.a.files -relief raised -bd 2 -yscrollcommand "$bx.a.scroll set" \
     612            -height 15 -width 0
     613    scrollbar $bx.a.scroll -command "$bx.a.files yview"
     614    unixFilChoose $bx $bx.a.files $filvar $diropt
     615    if {$filvar == "infile"} {
     616        bind $bx.a.files <ButtonRelease-1> \
     617                "unixFilChoose $bx $bx.a.files $filvar $diropt; setoutfile"
     618    } else {
     619        bind $bx.a.files <ButtonRelease-1> \
     620                "unixFilChoose $bx $bx.a.files $filvar $diropt"
     621    }
     622    pack $bx.a.scroll -side left -fill y
     623    pack $bx.a.files -side left -fill both -expand yes
     624    pack [entry $bx.c -textvariable ${filvar}(name)] -side top
     625}
     626
     627# select a file or directory, also called when box is created to fill it
     628proc unixFilChoose {frm box filvar {dironly 1}} {
     629    global $filvar
     630    set select [$box curselection]
     631    if {$select == ""} {
     632        set file .
     633    } else {
     634        set file [string trim [$box get $select]]
     635    }
     636    if [file isdirectory [file join [set ${filvar}(dir)] $file]] {
     637        if {$file == ".."} {
     638            set ${filvar}(dir) [file dirname [set ${filvar}(dir)] ]
     639        } elseif {$file != "."} {
     640            set ${filvar}(dir) [file join [set ${filvar}(dir)] $file]
     641        }
     642        [set ${filvar}(FileDirButtonMenu)] delete 0 end
     643        set list ""
     644        set dir ""
     645        foreach subdir [file split [set ${filvar}(dir)]] {
     646            set dir [file join $dir $subdir]
     647            lappend list $dir
     648        }
     649        foreach path $list {
     650            [set ${filvar}(FileDirButtonMenu)] add command -label $path \
     651                -command "[list set ${filvar}(dir) $path]; \
     652                unixFilChoose $frm $box $filvar $dironly"
     653        }
     654        set ${filvar}(name) {}
     655        $box delete 0 end
     656        $box insert end {..   }
     657        foreach file [lsort [glob -nocomplain \
     658                [file join [set ${filvar}(dir)] *] ] ] {
     659            if {[file isdirectory $file]} {
     660                # is this / needed here? Does it cause a problem in MacGSAS?
     661                $box insert end [file tail $file]/
     662            } elseif {$dironly == 1} {
     663                $box insert end [file tail $file]
     664            } elseif {$dironly == 2 && [file extension $file] == ".EXP"} {
     665                $box insert end [file tail $file]
     666            }
     667        }
     668        return
     669    }
     670    set ${filvar}(name) [file tail $file]
     671}
     672
     673# set new file name from old -- used for convunix
     674proc setoutfile {} {
     675    global infile outfile
     676    if {$outfile(type) == "convstod"} {
     677        set lfile [string toupper $infile(name)]
     678    } elseif {$outfile(type) == "convdtos"} {
     679        set lfile [string tolower $infile(name)]
     680    } else {
     681        set lfile ""
     682    }
     683    if {$infile(name) == $lfile} {
     684        set outfile(name) {}
     685    } else {
     686        set outfile(name) $lfile
     687    }
     688}
     689
     690#------------------------------------------------------------------------------
    377691# file conversions for Windows
     692#------------------------------------------------------------------------------
    378693proc convwin {} {
    379     global expgui infile outfile
     694    global expgui
    380695    set frm .file
    381696    catch {destroy $frm}
    … …  
    384699    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
    385700    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
    386     pack [button $frmC.b -text Convert -command "valid_conv_win"] -side top
    387     pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side top
     701    pack [button $frmC.b -text Convert -command "valid_conv_win $frm"] \
     702            -side top
     703    pack [button $frmC.q -text Quit -command "destroy $frm"] -side top
    388704    pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
    389     cnvfilebox $frmA outfile 1
    390     set infile(done) 0
     705    winfilebox $frmA
    391706    # force the window to stay on top
    392707    wm transient $frm [winfo toplevel [winfo parent $frm]]
    393708
    394     bind $frm <Return> "valid_conv_file"
     709    bind $frm <Return> "valid_conv_win $frm"
    395710    wm withdraw $frm
    396711    update idletasks
    … …  
    410725    grab $frm
    411726    focus $frmC.q
    412     update
    413     tkwait variable infile(done)
     727    tkwait window $frm
     728    catch {focus $oldFocus}
    414729    if {$oldGrab != ""} {
    415730        if {$grabStatus == "global"} {
    … …  
    423738
    424739# validate the files and make the conversion
    425 proc valid_conv_win {} {
    426     global infile outfile expgui
    427     if {$outfile(name) == ""} return
    428     if ![file exists $outfile(dir)/$outfile(name)] {
    429         tk_dialog .warn Notify \
    430                 "Sorry, file $outfile(name) not found in $outfile(dir)" warning 0 OK
     740proc valid_conv_win {frm} {
     741    global expgui
     742    if {$expgui(FileMenuCnvName) == "<Parent>"} {
     743        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
     744        ChooseCnvFil $frm
    431745        return
    432     }
     746    } elseif [file isdirectory \
     747            [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
     748        if {$expgui(FileMenuCnvName) != "."} {
     749            set expgui(FileMenuDir) \
     750                [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
     751        }
     752        ChooseCnvFil $frm
     753        return
     754    }
     755 
     756    set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
     757    if ![file exists $file] {
     758        tk_dialog .warn "Convert Error" \
     759                "File $file does not exist" question 0 "OK"
     760        return
     761    }
     762
     763    set tmpname "[file join [file dirname $file] tempfile.xxx]"
     764    set oldname "[file rootname $file].org"
     765    if [file exists $oldname] {
     766        set ans [tk_dialog .warn "OK to overwrite?" \
     767                "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" question 0 \
     768                "Yes" "No"]
     769        if $ans return
     770        catch {file delete $oldname}
     771    }
     772
    433773    if [catch {
    434         set newname "[file rootname $outfile(name)].tmp"
    435         set oldname "[file rootname $outfile(name)].seq"
    436         set in [open $outfile(dir)/$outfile(name) r]
    437         set out [open $outfile(dir)/$newname w]
     774        set in [open $file r]
     775        set out [open $tmpname w]
    438776        set len [gets $in line]
    439777        if {$len > 160} {
    … …  
    457795        close $in
    458796        close $out
    459         file rename $outfile(dir)/$outfile(name) $oldname
    460         file rename $newname $outfile(dir)/$outfile(name)
     797        file rename $file $oldname
     798        file rename $tmpname $file
    461799    } errmsg] {
    462800        tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
    463801    } else {
    464802        if [tk_dialog .converted Notify \
    465                 "File converted. Convert more files?" \
    466                 ""  0 Yes No] {set infile(done) 1}
    467     }
    468 }
    469 
    470 # create a file box for conversions
    471 proc cnvfilebox {bx filvar diropt} {
    472     global ${filvar}
    473     pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top
    474     set ${filvar}(dir) [pwd]
     803                "File [file tail $file] converted. (Original saved as [file tail $oldname]).\n\n Convert more files?" \
     804                ""  0 Yes No] {destroy $frm}
     805    }
     806}
     807
     808# create a file box
     809proc winfilebox {bx} {
     810    global expgui
     811    pack [frame $bx.top] -side top
     812    pack [label $bx.top.a -text "Directory" ] -side left
     813    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
     814    pack $bx.top.d -side left
     815    set expgui(FileMenuDir) [pwd]
     816    # the icon below is from tk8.0/tkfbox.tcl
     817    set upfolder [image create bitmap -data {
     818#define updir_width 28
     819#define updir_height 16
     820static char updir_bits[] = {
     821   0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
     822   0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
     823   0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
     824   0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
     825   0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
     826   0xf0, 0xff, 0xff, 0x01};}]
     827
     828    pack [button $bx.top.b -image $upfolder \
     829            -command "updir; ChooseCnvFil $bx" ]
    475830    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
    476     listbox $bx.a.files -relief raised -bd 2 -yscrollcommand "$bx.a.scroll set" \
     831    listbox $bx.a.files -relief raised -bd 2 \
     832            -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
    477833            -height 15 -width 0
    478     scrollbar $bx.a.scroll -command "$bx.a.files yview"
    479     filchoose $bx $bx.a.files $filvar $diropt
    480     if {$filvar == "infile"} {
    481         bind $bx.a.files <ButtonRelease-1> \
    482                 "filchoose $bx $bx.a.files $filvar $diropt; setoutfile"
    483     } else {
    484         bind $bx.a.files <ButtonRelease-1> \
    485                 "filchoose $bx $bx.a.files $filvar $diropt"
    486     }
     834    listbox $bx.a.dates -relief raised -bd 2 \
     835            -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
     836            -height 15 -width 0 -takefocus 0
     837    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
     838    ChooseCnvFil $bx
     839    bind $bx.a.files <ButtonRelease-1> "ReleaseCnvFil $bx"
     840    bind $bx.a.dates <ButtonRelease-1> "ReleaseCnvFil $bx"
     841    bind $bx.a.files <Double-1> "SelectCnvFil $bx"
     842    bind $bx.a.dates <Double-1> "SelectCnvFil $bx"
    487843    pack $bx.a.scroll -side left -fill y
    488     pack $bx.a.files -side left -fill both -expand yes
    489     pack [entry $bx.c -textvariable ${filvar}(name)] -side top
    490 }
    491 
    492 # select a file or directory, also called when box is created to fill it
    493 proc filchoose {frm box filvar {dironly 1}} {
    494     global $filvar
    495     set select [$box curselection]
     844    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
     845    pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
     846}
     847
     848# set the box or file in the selection window
     849proc ReleaseCnvFil {frm} {
     850    global expgui
     851    set files $frm.a.files
     852    set dates $frm.a.dates
     853    set select [$files curselection]
     854    if {$select == ""} {
     855        set select [$dates curselection]
     856    }
     857    if {$select == ""} {
     858        set expgui(FileMenuCnvName) ""
     859    } else {
     860        set expgui(FileMenuCnvName) [string trim [$files get $select]]
     861    }
     862    if {$expgui(FileMenuCnvName) == "<Parent>"} {
     863        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
     864        ChooseCnvFil $frm
     865    } elseif [file isdirectory \
     866            [file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
     867        if {$expgui(FileMenuCnvName) != "."} {
     868            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
     869            ChooseCnvFil $frm
     870        }
     871    }
     872    return
     873}
     874
     875# select a file or directory -- called on double click
     876proc SelectCnvFil {frm} {
     877    global expgui
     878    set files $frm.a.files
     879    set dates $frm.a.dates
     880    set select [$files curselection]
     881    if {$select == ""} {
     882        set select [$dates curselection]
     883    }
    496884    if {$select == ""} {
    497885        set file .
    498886    } else {
    499         set file [string trim [$box get $select]]
    500     }
    501     if [file isdirectory [file join [set ${filvar}(dir)] $file]] {
    502         if {$file == ".."} {
    503             set ${filvar}(dir) [file dirname [set ${filvar}(dir)] ]
    504         } elseif {$file != "."} {
    505             set ${filvar}(dir) [file join [set ${filvar}(dir)] $file]
    506         }
    507         set ${filvar}(name) {}
    508         $box delete 0 end
    509         $box insert end {..   }
    510         foreach file [lsort [glob -nocomplain \
    511                 [file join [set ${filvar}(dir)] *] ] ] {
    512             if {[file isdirectory $file]} {
    513                 # is this / needed here? Does it cause a problem in MacGSAS?
    514                 $box insert end [file tail $file]/
    515             } elseif {$dironly == 1} {
    516                 $box insert end [file tail $file]
    517             } elseif {$dironly == 2 && [file extension $file] == ".EXP"} {
    518                 $box insert end [file tail $file]
    519             }
    520         }
    521         return
    522     }
    523     set ${filvar}(name) [file tail $file]
    524 }
    525 
    526 # set new file name from old -- used for convert
    527 proc setoutfile {} {
    528     global infile outfile
    529     if {$outfile(type) == "convstod"} {
    530         set lfile [string toupper $infile(name)]
    531     } elseif {$outfile(type) == "convdtos"} {
    532         set lfile [string tolower $infile(name)]
    533     } else {
    534         set lfile ""
    535     }
    536     if {$infile(name) == $lfile} {
    537         set outfile(name) {}
    538     } else {
    539         set outfile(name) $lfile
    540     }
    541 }
    542 
     887        set file [string trim [$files get $select]]
     888    }
     889    if {$file == "<Parent>"} {
     890        set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
     891        ChooseCnvFil $frm
     892    } elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
     893        if {$file != "."} {
     894            set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
     895            ChooseCnvFil $frm
     896        }
     897    } else {
     898        set expgui(FileMenuCnvName) [file tail $file]
     899        valid_conv_win $frm
     900    }
     901}
     902
     903# fill the files & dates & Directory selection box with current directory,
     904# also called when box is created to fill it
     905proc ChooseCnvFil {frm} {
     906    global expgui
     907    set files $frm.a.files
     908    set dates $frm.a.dates
     909    set expgui(FileMenuCnvName) {}
     910    $files delete 0 end
     911    $dates delete 0 end
     912    $files insert end {<Parent>}
     913    $dates insert end {(Directory)}
     914    set filelist [glob -nocomplain \
     915            [file join [set expgui(FileMenuDir)] *] ]
     916    foreach file [lsort $filelist] {
     917        if {[file isdirectory $file]} {
     918            $files insert end [file tail $file]
     919            $dates insert end {(Directory)}
     920        }
     921    }
     922    foreach file [lsort $filelist] {
     923        set modified [file mtime $file]
     924        set modified [clock format [file mtime $file] -format "%T %D"]
     925        $files insert end [file tail $file]
     926        $dates insert end $modified
     927    }
     928    $expgui(FileDirButtonMenu)  delete 0 end
     929    set list ""
     930    set dir ""
     931    foreach subdir [file split [set expgui(FileMenuDir)]] {
     932        set dir [file join $dir $subdir]
     933        lappend list $dir
     934    }
     935    foreach path $list {
     936        $expgui(FileDirButtonMenu) add command -label $path \
     937                -command "[list set expgui(FileMenuDir) $path]; \
     938                ChooseCnvFil $frm"
     939    }
     940    return
     941}
     942
     943#------------------------------------------------------------------------------
    543944# set options for liveplot
    544945proc liveplotopt {} {
    … …  
    594995    catch {destroy $frm}
    595996    toplevel $frm
     997    wm title $frm "Experiment file"
    596998    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
    597999    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
    … …  
    7631165        set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
    7641166    }
     1167    if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
     1168        set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
     1169        ChooseExpFil $frm
     1170    } elseif [file isdirectory \
     1171            [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
     1172        if {$expgui(FileMenuEXPNAM) != "."} {
     1173            set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
     1174            ChooseExpFil $frm
     1175        }
     1176    }
    7651177    return
    7661178}
Note: See TracChangeset for help on using the changeset viewer.