Changeset 996 for trunk/gsascmds.tcl


Ignore:
Timestamp:
Aug 27, 2010 11:14:50 PM (13 years ago)
Author:
toby
Message:

Many revisions for handling file names with spaces using new SetEXPfile proc.
Use of directories with spaces for data files is probably not a problem, since we cd there, but EXP file names and install locations can be messy. Convert names on windows, where possible, and warn for now.

fix DISAGL window buttons for files with spaces.

cleanup MakeScrollTable?

allow ~/.gsas_config on Windows.

for use update.bat instead of building file as needed;

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/gsascmds.tcl

    r995 r996  
    15741574        grid columnconfig .disagl.f 2 -weight 1
    15751575        grid [button .disagl.f.close -text "Close & Delete" \
    1576                 -command "destroy .disagl; file delete $root.tmp"] \
     1576                  -command "destroy .disagl; file delete \[list $root.tmp\]"] \
    15771577                -column 3 -row 0 -sticky e
    15781578        grid [button .disagl.f.rename \
    1579                 -command "RenameAsFile $root.tmp $root.DIS .disagl" \
     1579                  -command "RenameAsFile \[list $root.tmp\] \[list $root.DIS\] .disagl" \
    15801580                -text "Close & Save as..."] \
    15811581                -column 4 -row 0 -sticky e
    … …  
    19491949
    19501950#------------------------------------------------------------------------------
    1951 # get an experiment file name
     1951# get/validate an experiment file name
    19521952#------------------------------------------------------------------------------
     1953# validate and store the EXP file name. Create a new .EXP file if it does not
     1954# exist and set the wd to the location of the .EXP file.
     1955proc SetEXPfile {expfile} {
     1956    global expgui tcl_platform
     1957    set expgui(expfile) {}
     1958    if {[string trim $expfile] == ""} return
     1959
     1960    # break up the file name and directory
     1961    set dirname [file dirname $expfile]
     1962    set expname [string toupper [file tail $expfile]]
     1963
     1964    # check the directory exists
     1965    if {(! [file exists $dirname]) || (! [file isdir $dirname])} {
     1966        update
     1967        MyMessageBox -parent . -title "Directory not found" \
     1968            -message "Experiment file location \"$dirname\" is invalid -- no such directory exists" \
     1969            -icon warning -type Continue -default continue
     1970        set expgui(resize) 1
     1971        return
     1972    }
     1973
     1974    # is there a space in the directory name? On windows, try to fix it
     1975    set origdir $dirname
     1976    if {[string first " " $dirname] != -1} {
     1977        set warn 1
     1978        catch {set warn $expgui(warnonspaceonce)}
     1979        if {$tcl_platform(platform) == "windows"} {
     1980            set dirname [file attributes $dirname -shortname]
     1981            # was the fix successful?
     1982            if {[string first " " $dirname] == -1} {
     1983                if {$warn} {
     1984                    update
     1985                    MyMessageBox -parent . -title "Still debugging..." \
     1986                        -message "You are using a directory with a space in the name ($origdir) that will be translated for Windows (to $dirname) -- This should obliviate bugs in EXPGUI, but if still you encounter any please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
     1987                    -icon warning -type Continue -default continue
     1988                    set expgui(resize) 1
     1989                }
     1990            } else {
     1991                if {$warn} {
     1992                    update
     1993                    MyMessageBox -parent . -title "Can't fix dir" \
     1994                        -message "You are using a directory with a space in the name ($origdir) in Windows that cannot be translated to a name without spaces (is this a network drive?) -- this could cause problems in EXPGUI. Please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
     1995                        -icon warning -type Continue -default continue
     1996                    set expgui(resize) 1
     1997                }
     1998            }
     1999        } elseif {$warn} {
     2000            if {$warn} {
     2001                update
     2002                MyMessageBox -parent . -title "Still debugging..." \
     2003                    -message "You are using a directory with a space in the name ($origdir). This is not perhaps a wise idea, but I am trying to catch any bugs this causes in EXPGUI. If you encounter any, please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
     2004                    -icon warning -type Continue -default continue
     2005                set expgui(resize) 1
     2006            }
     2007        }
     2008        set expgui(warnonspaceonce) 0
     2009    }
     2010
     2011    # force exp files to be upper case, set to force save if name changes
     2012    set origexp $expname
     2013    if {$expname != [string toupper $expfile]} {
     2014        set expname [string toupper [file tail $expfile]]
     2015        if {$tcl_platform(platform) != "windows"} {set expgui(changed) 1}
     2016    }
     2017    if {[file extension $expname] != ".EXP"} {
     2018        append expname ".EXP"
     2019    }
     2020    if {$dirname == "."} {
     2021        set newexpfile $expname
     2022    } else {
     2023        set newexpfile [file join $dirname $expname]
     2024    }
     2025    # is there a space in the EXP name?
     2026    if {[string first " " $expname] != -1} {
     2027        # If the file exists in windows, see if there is an equivalent name available.
     2028        # if not, we could try to create it and then see, but that is too much
     2029        # work.
     2030        if {$tcl_platform(platform) == "windows"} {
     2031            if {[file exists $newexpfile]} {
     2032                # try to translate it, if possible
     2033                set expname [file tail [file attributes $newexpfile -shortname]]
     2034                set newexpfile [file join $dirname $expname]
     2035                # fixed?
     2036                if {[string first " " $expname] == -1} {
     2037                    set warn 1
     2038                    catch {set warn $expgui(warnonexpspaceonce)}
     2039                    if {$warn} {
     2040                        update
     2041                        MyMessageBox -parent . -title "Still debugging..." \
     2042                            -message "You are using an EXP file name with a space in the name ($origexp) that will be translated for Windows (to $expname) -- This should obliviate bugs in EXPGUI, but if you still do encounter any please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
     2043                            -icon warning -type Continue -default continue
     2044                    set expgui(resize) 1
     2045                    }
     2046                    set expgui(warnonexpspaceonce) 0
     2047                }
     2048            }
     2049            if {[string first " " $expname] != -1} {
     2050                # not fixed (file does not exist or shortname not supported)
     2051                update
     2052                MyMessageBox -parent . -title "Can't fix name" \
     2053                    -message "You are using an EXP file name with a space in the name ($origexp) in Windows that cannot be translated without spaces (is this a network drive?) -- this will cause problems in EXPGUI. Sorry." \
     2054                    -icon warning -type Continue -default continue
     2055                set expgui(resize) 1
     2056                return
     2057            }
     2058        } else {
     2059            update
     2060            MyMessageBox -parent . -title "Space in name" \
     2061                -message "You are using an EXP file name with a space in the name ($origexp). This is likely to cause problems. Please rename the file or create one with another name. Sorry." \
     2062                -icon warning -type Continue -default continue
     2063            set expgui(resize) 1
     2064            return
     2065        }
     2066    }
     2067
     2068    if {! [file exists $newexpfile]} {
     2069        update
     2070        set ans [
     2071                 MyMessageBox -parent . -title "File Open Error" \
     2072                     -message "File $expname does not exist in ${dirname}. OK to create?" \
     2073                     -icon question -type {"Select other" "Create"} -default "select other" \
     2074                     -helplink "expguierr.html OpenErr"
     2075                ]
     2076        set expgui(resize) 1
     2077        if {[string tolower $ans] == "create"} {
     2078            # you've been warned this .EXP does not exist!
     2079            # create an "empty" exp file
     2080            createexp $newexpfile \
     2081                [getstring "title for experiment $expname" 60 0]
     2082            if {! [file exists [file join $dirname $expname]]} {
     2083                update
     2084                MyMessageBox -parent . -title "File Creation Error" \
     2085                    -message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \
     2086                    -icon warning -type Continue -default continue
     2087                set expgui(resize) 1
     2088                return
     2089            }
     2090        } else {
     2091            return
     2092        }
     2093    }
     2094    set expgui(expfile) $newexpfile
     2095    catch {cd [string trim [file dirname $expgui(expfile)]]}
     2096}
     2097
    19532098proc getExpFileName {mode} {
    19542099    global expgui tcl_platform
    … …  
    20102155    if {$expgui(FileMenuEXPNAM) == ""} return
    20112156    # is there a space in the EXP name?
    2012     if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} {
    2013         update
    2014         MyMessageBox -parent . -title "File Name Error" \
    2015             -message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
    2016             -icon warning -type Continue -default continue
     2157#    if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} {
     2158#       update
     2159#       MyMessageBox -parent . -title "File Name Error" \
     2160#           -message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI can#not process experiment files with spaces in the name" \
     2161#           -icon warning -type Continue -default continue
    20172162#               -helplink "expguierr.html OpenErr"
    2018         return
    2019     }
    2020     if {[string first " " $expgui(FileMenuDir)] != -1} {
    2021         update
    2022         MyMessageBox -parent . -title "Good luck..." \
    2023             -message "You are using a directory with a space in the name ([file dirname $expgui(FileMenuDir)]) -- You may encounter bugs in EXPGUI. Please e-mail them to Brian.Toby@ANL.gov so they can be fixed." \
    2024             -icon warning -type Continue -default continue
    2025 #               -helplink "expguierr.html OpenErr"
    2026     }
     2163#       return
     2164#    }
     2165#    if {[string first " " $expgui(FileMenuDir)] != -1} {
     2166#       set warn 1
     2167#       catch {set warn $expgui(warnonexpdirspace)}
     2168#       if $warn {
     2169#           update
     2170#           MyMessageBox -parent . -title "Good luck..." \
     2171#               -message "You are using a directory with a space in the name ($expgui(FileMenuDir)) -- You may encounter bugs in EXPGUI. Please e-mail them to Brian.Toby@ANL.gov so they can be fixed." \
     2172#               -icon warning -type Continue -default continue
     2173#           #           -helplink "expguierr.html OpenErr"
     2174#           set expgui(warnonexpdirspace) 0
     2175#       }
     2176#    }
    20272177    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
    20282178}
    … …  
    20592209    }
    20602210    # is there a space in the name?
    2061     if {[string first " " $expgui(FileMenuEXPNAM)] != -1} {
    2062         MyMessageBox -parent . -title "File Name Error" \
    2063                 -message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
    2064                 -icon warning -type Continue -default continue
     2211#    if {[string first " " $expgui(FileMenuEXPNAM)] != -1} {
     2212#       MyMessageBox -parent . -title "File Name Error" \
     2213#               -message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
     2214#               -icon warning -type Continue -default continue
    20652215#               -helplink "expguierr.html OpenErr"
    2066         return
    2067     }
     2216#       return
     2217#    }
    20682218    # check for archive files
    20692219    if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \
    … …  
    21542304    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
    21552305}
    2156 proc sync2boxesX {master slave scroll args} {
    2157     $slave xview moveto [lindex [$master xview] 0]
    2158     eval $scroll set $args
    2159 }
    2160 proc move2boxesX {boxlist args} {
    2161     foreach listbox $boxlist {
    2162         eval $listbox xview $args
    2163     }
    2164 }
    21652306proc sync2boxesY {master slave scroll args} {
    21662307    $slave yview moveto [lindex [$master yview] 0]
    … …  
    21742315
    21752316# creates a table that is scrollable in both x and y, use ResizeScrollTable
    2176 # to set sizes after gridding the boxes
     2317# to set sizes after gridding the widgets
    21772318proc MakeScrollTable {box} {
     2319    proc sync2boxes {cmd master slave scroll args} {
     2320        $slave $cmd moveto [lindex [$master $cmd] 0]
     2321        eval $scroll set $args
     2322    }
     2323    proc move2boxes {cmd box1 box2 args} {
     2324        eval $box1 $cmd $args
     2325        eval $box2 $cmd $args
     2326    }
    21782327    grid [label $box.0] -column 0 -row 0
    2179     grid [set tbox [canvas $box.top \
    2180             -scrollregion {0 0 10 10} \
    2181             -xscrollcommand "sync2boxesX $box.top $box.can $box.scroll" \
    2182             -width 10 -height 10]] \
    2183             -sticky sew -row 0 -column 1
    2184     grid [set sbox [canvas $box.side \
    2185             -scrollregion {0 0 10 10} \
    2186             -yscrollcommand "sync2boxesY $box.side $box.can $box.yscroll" \
    2187             -width 10 -height 10]] \
    2188             -sticky nes -row 1 -column 0
    2189     grid [set bbox [canvas $box.can \
    2190             -scrollregion {0 0 10 10} \
    2191             -yscrollcommand "sync2boxesY $box.can $box.side $box.yscroll" \
    2192             -xscrollcommand "sync2boxesX $box.can $box.top $box.scroll" \
    2193             -width 200 -height 200 -bg lightgrey]] \
    2194             -sticky news -row 1 -column 1
     2328    grid [canvas $box.top -scrollregion {0 0 10 10} \
     2329            -xscrollcommand "sync2boxes xview $box.top $box.can $box.scroll" \
     2330            -width 10 -height 10] -sticky sew -row 0 -column 1
     2331    grid [canvas $box.side -scrollregion {0 0 10 10} \
     2332            -yscrollcommand "sync2boxes yview $box.side $box.can $box.yscroll" \
     2333            -width 10 -height 10] -sticky nes -row 1 -column 0
     2334    grid [canvas $box.can -scrollregion {0 0 10 10} \
     2335            -yscrollcommand "sync2boxes yview $box.can $box.side $box.yscroll" \
     2336            -xscrollcommand "sync2boxes xview $box.can $box.top $box.scroll" \
     2337            -width 200 -height 200 -bg lightgrey] -sticky news -row 1 -column 1
    21952338    grid [set sxbox [scrollbar $box.scroll -orient horizontal \
    2196             -command "move2boxesX \" $box.can $box.top \" "]] \
     2339                         -command "move2boxes xview $box.can $box.top"]] \
    21972340            -sticky ew -row 2 -column 1
    21982341    grid [set sybox [scrollbar $box.yscroll \
    2199             -command "move2boxesY \" $box.can $box.side \" "]] \
     2342                         -command "move2boxes yview $box.can $box.side"]] \
    22002343            -sticky ns -row 1 -column 2
    2201     frame $tbox.f -bd 0
    2202     $tbox create window 0 0 -anchor nw  -window $tbox.f
    2203     frame $bbox.f -bd 2
    2204     $bbox create window 0 0 -anchor nw  -window $bbox.f
    2205     frame $sbox.f -bd 2 -relief raised
    2206     $sbox create window 0 0 -anchor nw  -window $sbox.f
     2344
     2345    $box.top create window 0 0 -anchor nw  -window [frame $box.top.f -bd 0]
     2346    $box.can create window 0 0 -anchor nw  -window [frame $box.can.f -bd 2]
     2347    $box.side create window 0 0 -anchor nw  -window [frame $box.side.f -bd 2]
     2348
    22072349    grid columnconfig $box 1 -weight 1
    22082350    grid rowconfig $box 1 -weight 1
    2209     return [list  $tbox.f  $bbox.f $sbox.f $box.0]
     2351    return [list  $box.top.f  $box.can.f $box.side.f $box.0]
    22102352}
    22112353
    … …  
    22312373    $box.side config -scrollregion $sizes
    22322374    $box.top config -scrollregion $sizes
     2375    $box.side config -width [lindex [grid bbox $box.side.f] 2]
    22332376    $box.top config -height [lindex [grid bbox $box.top.f] 3]
    2234     $box.side config -width [lindex [grid bbox $box.side.f] 2]
    2235 }
     2377    # remove the scroll when not needed
     2378    if {[lindex $sizes 3] > [winfo height $box.can]} {
     2379        grid $box.yscroll -sticky ns -column 2 -row 1
     2380    } else {
     2381        grid forget $box.yscroll
     2382    }
     2383    if {[lindex $sizes 2] > [winfo width $box.can]} {
     2384        grid $box.scroll -sticky ew -column 1 -row 2
     2385    } else {
     2386        grid forget $box.scroll
     2387    }
     2388}
     2389
     2390# this is used in cifselect -- not sure why anymore
    22362391proc ExpandScrollTable {box} {
    22372392    # set height & width of central box
    … …  
    34023557    if {[confirmBeforeSave] == "Cancel"} return
    34033558
    3404      # special upgrade for windows, where the wish exec blocks upgrade of the exe directory
     3559    # special upgrade for windows, where the wish exec blocks upgrade of the exe directory
    34053560    if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {
    3406         # create a batch file
    3407         set out [file normalize ~/expgui_update.bat]
    3408         set fp [open [file normalize ~/expgui_update.bat] w]
    3409         puts $fp "@echo *"
    3410         puts $fp "@echo ******************************************************************"
    3411         puts $fp "@echo Preparing to start upgrade of EXPGUI."
    3412         puts $fp "@pause"
    3413         puts $fp "$SVN cleanup $::expgui(gsasdir)"
    3414         puts $fp "$SVN up $::expgui(gsasdir)"
    3415         puts $fp "@echo *"
    3416         puts $fp "@echo ******************************************************************"
    3417         puts $fp "@echo Upgrade is complete. This window will close and EXPGUI will restart."
    3418         puts $fp "@pause"
    3419         puts $fp "$::env(COMSPEC) /c \"start [info nameofexecutable] \
    3420 [file attributes [file normalize $::expgui(script)] -shortname] \
    3421 [file attributes [file normalize $::expgui(expfile)] -shortname] \""
    3422         puts $fp "exit"
    3423         close $fp
     3561        # split the directory and EXP file and get rid os spaces in the directory name
     3562        set exp [file normalize $::expgui(expfile)]
     3563        set dir [file attributes [file dirname $exp] -shortname]
     3564        cd $::expgui(gsasdir)
    34243565        #run the batch file
    3425         exec $::env(COMSPEC) /c "start [file nativename [file attributes $out -shortname]]" &
     3566        exec $::env(COMSPEC) /c {start .\update.bat [file join $dir [file tail $exp]]} &
    34263567        exit
    34273568    }
Note: See TracChangeset for help on using the changeset viewer.