Changeset 1036 for branches/sandbox


Ignore:
Timestamp:
Nov 22, 2010 5:02:57 PM (10 years ago)
Author:
toby
Message:

fix bug on replace atoms; clean up loading/creation of exp files; add revert menu command; initial draft of rigid body support

Location:
branches/sandbox
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed
  • branches/sandbox/addcmds.tcl

    r1015 r1036  
    25192519        incr expgui(changed)
    25202520    }
     2521    set expmap(atomlist_$phase) {}
    25212522    RecordMacroEntry "incr expgui(changed)" 0
    25222523    # write new atoms from table as input to exptool
  • branches/sandbox/expgui

    r1021 r1036  
    326326            file copy -force $expgui(expfile) $expnam.EXP
    327327            set expgui(expfile) $expnam.EXP
     328            wm title . "EXPGUI interface to GSAS: [file tail $expgui(expfile)]"
     329            set expgui(titleunchanged) 1
    328330        } else {
    329331            MyMessageBox -parent . -title "File not found" \
     
    333335        }
    334336    } else {
    335         SetEXPfile $expgui(expfile)
     337        set expgui(expfile) [SetEXPfile $expgui(expfile)]
    336338    }
    337339}
     
    348350    # I am not sure it is still needed.
    349351    update
    350     SetEXPfile [getExpFileName ""]
     352    set expgui(expfile) [SetEXPfile [getExpFileName ""]]
    351353    set expgui(resize) 1
    352354}
     
    360362proc loadexp {expfile} {
    361363    global expgui expmap entryvar entrycmd tcl_platform
    362     set prevexp $expgui(expfile)
    363     # is this a compressed archive file?
    364     if {[string match {*.O[0-9A-F][0-9A-F]} $expfile]} {
    365         set expnam [file rootname $expfile]
    366         set ans [MyMessageBox -parent . -title "Load Archived File" \
    367                 -message "Loading archived version of $expnam. Do you want to continue using the same experiment name or work with the archived version under a new name?" \
    368                 -icon question -type "{Use New Name} {Continue with current}" \
    369                 -default {Use New Name} \
    370                 -helplink "expguierr.html LoadArchived"
    371         ]
    372         # archive the current .EXP file
    373         if {$ans != "use new name" && [file exists $expfile]} {
    374             # get the last archived version
    375             set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
    376             if {$lastf == ""} {
    377                 set num 01
    378             } else {
    379                 regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
    380                 scan $num %x num
    381                 if {$num >= 255} {
    382                     set num FF
    383                 } else {
    384                     set num [string toupper [format %.2x [incr num]]]
    385                 }
    386             }
    387             catch {
    388                 set newfile $expnam.O$num
    389                 file rename -force $expnam.EXP $newfile
    390                 set fp [open $expnam.LST a+]
    391                 puts $fp "\n----------------------------------------------"
    392                 puts $fp "     Regressing to archive file [file tail $expfile]"
    393                 puts $fp "     but first archiving [file tail $expnam.EXP] as [file tail $newfile]"
    394                 puts $fp "----------------------------------------------\n"
    395                 close $fp
    396             }
    397             file copy -force $expfile $expnam.EXP
    398             set expfile $expnam.EXP
    399         }
    400         if {$ans == "use new name"} {
    401             set newexpfile [getExpFileName new]
    402             if {$newexpfile == ""} return
    403             file copy -force $expfile $newexpfile
    404             catch {cd [string trim [file dirname $expgui(expfile)]]}
    405             set expfile [file tail $newexpfile]
    406             set expgui(needpowpref) 2
    407             set expgui(needpowpref_why) "\tA new .EXP file was created\n"
    408             SetEXPfile $newexpfile
    409         } else {
    410             SetEXPfile $expfile
    411         }
    412         if {$expgui(expfile) == ""} {
    413             set expgui(expfile) $prevexp
    414             return
    415         }
    416     }
    417 
     364    set expfile [SetEXPfile $expfile]
     365    if {$expfile == ""} {
     366        return
     367    }
    418368    # change the icon and assign an app to this .EXP file
    419369    if {$tcl_platform(os) == "Darwin" && $expgui(MacAssignApp)} {
    420370        MacSetResourceFork $expfile
    421371    }
    422 
    423     SetEXPfile $expfile
    424     if {$expgui(expfile) == ""} {
    425         set expgui(expfile) $prevexp
    426         return
    427     }
    428372    # read in the .EXP file
    429373    set fmt [expload $expfile]
     374    set expgui(expfile) $expfile
    430375    # if the file was not in the correct format, force a rewrite before use
    431376    if {$fmt < 0} {
     
    452397    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
    453398    # set the window/icon title
    454     wm title . "EXPGUI interface to GSAS: $expfile"
     399    wm title . "EXPGUI interface to GSAS: [file tail $expgui(expfile)]"
    455400    set expgui(titleunchanged) 1
    456401    wm iconname . [file tail $expfile]
     
    462407    afterawhile
    463408}
     409
    464410
    465411# [re]load all screens with current state of EXPGUI file
     
    546492    global expgui
    547493    global tcl_platform
    548     set prevexp $expgui(expfile)
    549     set newexpfile [getExpFileName new]
    550     if {$newexpfile == ""} return
    551     SetEXPfile $newexpfile 1
    552     if {$expgui(expfile) == ""} {
    553         set expgui(expfile) $prevexp
    554         return
    555     }
     494    set $newexpfile [SetEXPfile [getExpFileName new] 1]
     495    if {$newexpfile == ""} return
    556496    expwrite $newexpfile
    557497    # change the icon and assign an app to this .EXP file
     
    573513
    574514# called to read a different .EXP file
    575 proc readnewexp {} {
     515proc readnewexp {"mode 0"} {
    576516    global expgui expmap
    577517    if $expgui(changed) {
     
    585525        }
    586526    }
    587     set prevexp $expgui(expfile)
    588     set newexpfile [getExpFileName old]
    589     if {$newexpfile == ""} return
    590     SetEXPfile $newexpfile
    591     if {$expgui(expfile) == ""} {
    592         set expgui(expfile) $prevexp
    593         return
    594     }
     527    if {$mode == 0} {
     528        set newexpfile [getExpFileName old]
     529    } else {
     530        set newexpfile [RevertExpFile]
     531    }
     532    if {$newexpfile == ""} return
    595533
    596534    # switch to the 1st page
    597535    RaisePage lsFrame
    598536    set expgui(globalmode) 0
    599     loadexp $expgui(expfile)
     537    loadexp $newexpfile
    600538
    601539    # reset the phase selection
  • branches/sandbox/gsascmds.tcl

    r1026 r1036  
    20112011proc SetEXPfile {expfile "newOK 0"} {
    20122012    global expgui tcl_platform
    2013     set expgui(expfile) {}
    20142013    if {[string trim $expfile] == ""} return
    20152014
     
    20672066    # force exp files to be upper case, set to force save if name changes
    20682067    set origexp $expname
    2069     if {$expname != [string toupper $expfile]} {
    2070         set expname [string toupper [file tail $expfile]]
    2071         if {$tcl_platform(platform) != "windows"} {set expgui(changed) 1}
    2072     }
    2073     if {[file extension $expname] != ".EXP"} {
     2068    if {$expname != [file tail $expfile] && $tcl_platform(platform) != "windows"} {
     2069        set expgui(changed) 1
     2070    }
     2071    #puts $expgui(expfile)
     2072    if {[string match {.O[0-9A-F][0-9A-F]} [file extension $expname]]} {
     2073        set expname [ArchiveChoice $expname]
     2074        set dirname ""
     2075        if {$expname == ""} return
     2076    } elseif {[file extension $expname] != ".EXP"} {
    20742077        append expname ".EXP"
    20752078    }
    2076     if {$dirname == "."} {
     2079    if {$dirname == "." || $dirname == ""} {
    20772080        set newexpfile $expname
    20782081    } else {
     
    21332136        if {[string tolower $ans] == "create"} {
    21342137            # you've been warned this .EXP does not exist!
    2135             # create an "empty" exp file
    2136             createexp $newexpfile \
    2137                 [getstring "title for experiment $expname" 60 0]
    2138             if {! [file exists [file join $dirname $expname]]} {
    2139                 update
    2140                 MyMessageBox -parent . -title "File Creation Error" \
    2141                     -message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \
    2142                     -icon warning -type Continue -default continue
    2143                 set expgui(resize) 1
    2144                 return
    2145             }
     2138            if [CreateMTexpfile $newexpfile] return
    21462139        } else {
    21472140            return
    21482141        }
    21492142    }
    2150     set expgui(expfile) $newexpfile
    2151     catch {cd [string trim [file dirname $expgui(expfile)]]}
     2143    catch {cd [string trim [file dirname $newexpfile]]}
     2144    return $newexpfile
     2145}
     2146
     2147proc ArchiveChoice {expfile} {
     2148    set expnam [file rootname $expfile]
     2149    set ans [MyMessageBox -parent . -title "Load Archived File" \
     2150        -message "Loading archived version of $expnam. Do you want to continue using the same experiment name or work with the archived version under a new name?" \
     2151        -icon question -type "{Use New Name} {Continue with current}" \
     2152        -default {Use New Name} \
     2153        -helplink "expguierr.html LoadArchived"
     2154    ]
     2155    # archive the current .EXP file
     2156    if {$ans != "use new name" && [file exists $expfile]} {
     2157        # get the last archived version
     2158        set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
     2159        if {$lastf == ""} {
     2160            set num 01
     2161        } else {
     2162            regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
     2163            scan $num %x num
     2164            if {$num >= 255} {
     2165                set num FF
     2166            } else {
     2167                set num [string toupper [format %.2x [incr num]]]
     2168            }
     2169        }
     2170        catch {
     2171            set newfile $expnam.O$num
     2172            file rename -force $expnam.EXP $newfile
     2173            set fp [open $expnam.LST a+]
     2174            puts $fp "\n----------------------------------------------"
     2175            puts $fp "     Regressing to archive file [file tail $expfile]"
     2176            puts $fp "     but first archiving [file tail $expnam.EXP] as [file tail $newfile]"
     2177            puts $fp "----------------------------------------------\n"
     2178            close $fp
     2179        }
     2180        file copy -force $expfile $expnam.EXP
     2181        set expfile $expnam.EXP
     2182    }
     2183    if {$ans == "use new name"} {
     2184        set newexpfile [getExpFileName new]
     2185        if {$newexpfile == ""} {
     2186            set expgui(FileMenuEXPNAM) ""
     2187            return
     2188        }
     2189        file copy -force $expfile $newexpfile
     2190        set expgui(needpowpref) 2
     2191        set expgui(needpowpref_why) "\tA new .EXP file was created\n"
     2192        return $newexpfile
     2193    } else {
     2194        return $expfile
     2195    }
     2196}
     2197
     2198# create an "empty" exp file
     2199proc CreateMTexpfile {newexpfile} {
     2200    set expname [file tail $newexpfile]
     2201    createexp $newexpfile \
     2202        [getstring "title for experiment $expname" 60 0]
     2203    if {! [file exists $newexpfile]} {
     2204        update
     2205        MyMessageBox -parent . -title "File Creation Error" \
     2206            -message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \
     2207            -icon warning -type Continue -default continue
     2208        set ::expgui(resize) 1
     2209        return 1
     2210    }
     2211    return 0
    21522212}
    21532213
     
    21812241                -side top -fill both -expand yes -pady 5
    21822242    } elseif {$mode != "new"} {
    2183         # for initial read, don't access archived files
     2243        # for initial read, don't offer access to archived files
    21842244        pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
    21852245                -class SmallFont] \
     
    22102270    afterputontop
    22112271    if {$expgui(FileMenuEXPNAM) == ""} return
    2212     # is there a space in the EXP name?
    2213 #    if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} {
    2214 #       update
    2215 #       MyMessageBox -parent . -title "File Name Error" \
    2216 #           -message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI can#not process experiment files with spaces in the name" \
    2217 #           -icon warning -type Continue -default continue
    2218 #               -helplink "expguierr.html OpenErr"
    2219 #       return
    2220 #    }
    2221 #    if {[string first " " $expgui(FileMenuDir)] != -1} {
    2222 #       set warn 1
    2223 #       catch {set warn $expgui(warnonexpdirspace)}
    2224 #       if $warn {
    2225 #           update
    2226 #           MyMessageBox -parent . -title "Good luck..." \
    2227 #               -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." \
    2228 #               -icon warning -type Continue -default continue
    2229 #           #           -helplink "expguierr.html OpenErr"
    2230 #           set expgui(warnonexpdirspace) 0
    2231 #       }
    2232 #    }
     2272    #puts "end getexp $expgui(expfile)"
    22332273    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
    22342274}
    22352275
    22362276# validation routine
     2277# called from getExpFileName, either from Read button or from SelectExpFil (see expfilebox)
    22372278proc valid_exp_file {frm mode} {
    22382279    global expgui tcl_platform
     
    22602301        return
    22612302    }
    2262     # append a .EXP if not present
    2263     if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
     2303    set ext [string toupper [file extension $expgui(FileMenuEXPNAM)]]
     2304    if {$ext == ""} {
     2305        # append a .EXP if not present
    22642306        append expgui(FileMenuEXPNAM) ".EXP"
    2265     }
    2266     # is there a space in the name?
    2267 #    if {[string first " " $expgui(FileMenuEXPNAM)] != -1} {
    2268 #       MyMessageBox -parent . -title "File Name Error" \
    2269 #               -message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
    2270 #               -icon warning -type Continue -default continue
    2271 #               -helplink "expguierr.html OpenErr"
    2272 #       return
    2273 #    }
    2274     # check for archive files
    2275     if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \
     2307    } elseif {[string match {*.O[0-9A-F][0-9A-F]} $ext] && \
    22762308            $mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
     2309        # check for archive files
    22772310        destroy .file
    22782311        return
    2279     } elseif {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
     2312    } elseif {$ext != ".EXP"} {
    22802313        # check for files that end in something other than .EXP .exp or .Exp...
    22812314        MyMessageBox -parent . -title "File Open Error" \
     
    23102343                -helplink "expguierr.html OpenErr"
    23112344        ]
    2312         if {[string tolower $ans] == "create"} {destroy .file}
     2345        if {[string tolower $ans] == "create"} {
     2346            if [CreateMTexpfile $file] return
     2347            destroy .file
     2348        }
    23132349        return
    23142350    }
     
    23602396    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
    23612397}
     2398proc sync2boxesX {master slave scroll args} {           
     2399    $slave xview moveto [lindex [$master xview] 0]               
     2400    eval $scroll set $args               
     2401}               
     2402proc move2boxesX {boxlist args} {               
     2403    foreach listbox $boxlist {                   
     2404        eval $listbox xview $args               
     2405    }           
     2406}
    23622407proc sync2boxesY {master slave scroll args} {
    23632408    $slave yview moveto [lindex [$master yview] 0]
     
    24602505            - [winfo height $box.top] - [winfo height $box.scroll]-25]
    24612506}
    2462 
     2507proc RevertExpFile {} {
     2508    global expgui tcl_platform
     2509    set frm .file
     2510    catch {destroy $frm}
     2511    toplevel $frm
     2512    wm title $frm "Experiment file"
     2513    bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
     2514    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
     2515    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
     2516            -fill y -expand yes
     2517    pack [button $frmC.help -text Help -bg yellow \
     2518            -command "MakeWWWHelp expguierr.html open"] \
     2519            -side top -anchor e
     2520    set expgui(filesort) 0
     2521    set expgui(includearchived) 1
     2522    set expgui(FileInfoBox) $frmC.info
     2523    pack [label $frmC.ar -text "(Showing Archived Files Only)"] -side top -pady 10
     2524    pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
     2525              -class SmallFont] \
     2526        -side top -fill both -expand yes -pady 5
     2527
     2528    pack [button $frmC.b -text Read \
     2529            -command "valid_exp_file $frmA old"] -side bottom
     2530    pack [button $frmC.q -text Cancel \
     2531            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
     2532    bind $frm <Return> "$frmC.b invoke"
     2533
     2534    pack [label $frmA.0 -text "Select an archived experiment file to read"] \
     2535                -side top -anchor center
     2536    set bx $frmA
     2537    pack [frame $bx.top] -side top
     2538    #pack [label $bx.top.a -text "Directory" ] -side left
     2539    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
     2540    #pack $bx.top.d -side left
     2541    #set expgui(FileMenuDir) [pwd]
     2542    # the icon below is from tk8.0/tkfbox.tcl
     2543    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
     2544    listbox $bx.a.files -relief raised -bd 2 \
     2545            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
     2546            -height 15 -width 0 -exportselection 0
     2547    listbox $bx.a.dates -relief raised -bd 2 \
     2548            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
     2549            -height 15 -width 0 -takefocus 0 -exportselection 0
     2550    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
     2551    ChooseExpFil $bx 1
     2552    if {[llength [$bx.a.files get 0 end]] == 0} {
     2553        destroy $frm
     2554        MyMessageBox -parent . -title "No Archives" \
     2555            -message "Sorry no archived versions of $::expgui(expfile) are present" \
     2556                    -icon warning -type ok -default ok
     2557        return
     2558    }
     2559    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
     2560    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
     2561    bind $bx.a.files <Double-1> "SelectExpFil $bx old"
     2562    bind $bx.a.dates <Double-1> "SelectExpFil $bx old"
     2563    pack $bx.a.scroll -side left -fill y
     2564    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
     2565    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
     2566    # force the window to stay on top
     2567    putontop $frm
     2568    focus $frmC.b
     2569    tkwait window $frm
     2570    afterputontop
     2571    if {$expgui(FileMenuEXPNAM) == ""} return
     2572    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
     2573}
    24632574
    24642575# support routine for SetHistUseFlags
     
    26772788# fill the files & dates & Directory selection box with current directory,
    26782789# also called when box is created to fill it
    2679 proc ChooseExpFil {frm} {
     2790proc ChooseExpFil {frm "archiveonly 0"} {
    26802791    global expgui
    26812792    set files $frm.a.files
     
    26842795    $files delete 0 end
    26852796    $dates delete 0 end
    2686     $files insert end {<Parent>}
    2687     $dates insert end {(Directory)}
    2688     set filelist [glob -nocomplain \
    2689             [file join [set expgui(FileMenuDir)] *] ]
    2690     foreach file [lsort -dictionary $filelist] {
    2691         if {[file isdirectory $file]} {
    2692             $files insert end [file tail $file]
    2693             $dates insert end {(Directory)}
    2694         }
     2797    if {$archiveonly == 0} {
     2798        $files insert end {<Parent>}
     2799        $dates insert end {(Directory)}
     2800        set filelist [glob -nocomplain \
     2801                          [file join [set expgui(FileMenuDir)] *] ]
     2802        foreach file [lsort -dictionary $filelist] {
     2803            if {[file isdirectory $file]} {
     2804                $files insert end [file tail $file]
     2805                $dates insert end {(Directory)}
     2806            }
     2807        }
     2808    } else {   
     2809        set filelist [glob -nocomplain \
     2810                          [file root $expgui(expfile)].O* ]
    26952811    }
    26962812    set pairlist {}
    26972813    foreach file [lsort -dictionary $filelist] {
    26982814        if {![file isdirectory $file]  && \
    2699                 [string toupper [file extension $file]] == ".EXP"} {
     2815                [string toupper [file extension $file]] == ".EXP" \
     2816                && $archiveonly == 0} {
    27002817            set modified [file mtime $file]
    27012818            lappend pairlist [list $file $modified]
  • branches/sandbox/gsasmenu.tcl

    r1021 r1036  
    99array set expgui_menulist {
    1010    file {
     11        revert
    1112        EraseHistory
    1213        convert
     
    158159    }
    159160
     161    revert {{readnewexp archive} {
     162        Select an old version of the current GSAS file}
     163    }
     164
    160165    {archive EXP} {- {
    161166        Toggles archiving of .EXP files. When on, files are
Note: See TracChangeset for help on using the changeset viewer.