Changeset 1036

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:

• addcmds.tcl (modified) (1 diff)
• expgui (modified) (9 diffs)
• gsascmds.tcl (modified) (11 diffs)
• gsasmenu.tcl (modified) (2 diffs)
• rb.tcl (added)

branches/sandbox/addcmds.tcl

@@ -2519 +2519 @@
         incr expgui(changed)
     }
+    set expmap(atomlist_$phase) {}
     RecordMacroEntry "incr expgui(changed)" 0
     # write new atoms from table as input to exptool

branches/sandbox/expgui

@@ -326 +326 @@
             file copy -force $expgui(expfile) $expnam.EXP
             set expgui(expfile) $expnam.EXP
+            wm title . "EXPGUI interface to GSAS: [file tail $expgui(expfile)]"
+            set expgui(titleunchanged) 1
         } else {
             MyMessageBox -parent . -title "File not found" \
@@ -333 +335 @@
         }
     } else {
-        SetEXPfile $expgui(expfile)
+        set expgui(expfile) [SetEXPfile $expgui(expfile)]
     }
 }
@@ -348 +350 @@
     # I am not sure it is still needed.
     update
-    SetEXPfile [getExpFileName ""]
+    set expgui(expfile) [SetEXPfile [getExpFileName ""]]
     set expgui(resize) 1
 }
@@ -360 +362 @@
 proc loadexp {expfile} {
     global expgui expmap entryvar entrycmd tcl_platform
-    set prevexp $expgui(expfile)
-    # is this a compressed archive file? 
-    if {[string match {*.O[0-9A-F][0-9A-F]} $expfile]} {
-        set expnam [file rootname $expfile]
-        set ans [MyMessageBox -parent . -title "Load Archived File" \
-                -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?" \
-                -icon question -type "{Use New Name} {Continue with current}" \
-                -default {Use New Name} \
-                -helplink "expguierr.html LoadArchived"
-        ]
-        # archive the current .EXP file
-        if {$ans != "use new name" && [file exists $expfile]} {
-            # get the last archived version
-            set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
-            if {$lastf == ""} {
-                set num 01
-            } else {
-                regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
-                scan $num %x num
-                if {$num >= 255} {
-                    set num FF
-                } else {
-                    set num [string toupper [format %.2x [incr num]]]
-                }
-            }
-            catch {
-                set newfile $expnam.O$num
-                file rename -force $expnam.EXP $newfile
-                set fp [open $expnam.LST a+]
-                puts $fp "\n----------------------------------------------"
-                puts $fp "     Regressing to archive file [file tail $expfile]"
-                puts $fp "     but first archiving [file tail $expnam.EXP] as [file tail $newfile]"
-                puts $fp "----------------------------------------------\n"
-                close $fp
-            }
-            file copy -force $expfile $expnam.EXP
-            set expfile $expnam.EXP
-        }
-        if {$ans == "use new name"} {
-            set newexpfile [getExpFileName new]
-            if {$newexpfile == ""} return 
-            file copy -force $expfile $newexpfile
-            catch {cd [string trim [file dirname $expgui(expfile)]]}
-            set expfile [file tail $newexpfile]
-            set expgui(needpowpref) 2
-            set expgui(needpowpref_why) "\tA new .EXP file was created\n" 
-            SetEXPfile $newexpfile
-        } else {
-            SetEXPfile $expfile
-        }
-        if {$expgui(expfile) == ""} {
-            set expgui(expfile) $prevexp
-            return
-        }
-    }
-
+    set expfile [SetEXPfile $expfile]
+    if {$expfile == ""} {
+        return
+    }
     # change the icon and assign an app to this .EXP file
     if {$tcl_platform(os) == "Darwin" && $expgui(MacAssignApp)} {
         MacSetResourceFork $expfile
     }
-
-    SetEXPfile $expfile
-    if {$expgui(expfile) == ""} {
-        set expgui(expfile) $prevexp
-        return
-    }
     # read in the .EXP file
     set fmt [expload $expfile]
+    set expgui(expfile) $expfile
     # if the file was not in the correct format, force a rewrite before use
     if {$fmt < 0} {
@@ -452 +397 @@
     set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
     # set the window/icon title
-    wm title . "EXPGUI interface to GSAS: $expfile"
+    wm title . "EXPGUI interface to GSAS: [file tail $expgui(expfile)]"
     set expgui(titleunchanged) 1
     wm iconname . [file tail $expfile]
@@ -462 +407 @@
     afterawhile
 }
+
 
 # [re]load all screens with current state of EXPGUI file
@@ -546 +492 @@
     global expgui
     global tcl_platform
-    set prevexp $expgui(expfile) 
-    set newexpfile [getExpFileName new]
-    if {$newexpfile == ""} return 
-    SetEXPfile $newexpfile 1
-    if {$expgui(expfile) == ""} {
-        set expgui(expfile) $prevexp
-        return
-    }
+    set $newexpfile [SetEXPfile [getExpFileName new] 1]
+    if {$newexpfile == ""} return
     expwrite $newexpfile
     # change the icon and assign an app to this .EXP file
@@ -573 +513 @@
 
 # called to read a different .EXP file
-proc readnewexp {} {
+proc readnewexp {"mode 0"} {
     global expgui expmap
     if $expgui(changed) {
@@ -585 +525 @@
         }
     }
-    set prevexp $expgui(expfile) 
-    set newexpfile [getExpFileName old]
-    if {$newexpfile == ""} return 
-    SetEXPfile $newexpfile
-    if {$expgui(expfile) == ""} {
-        set expgui(expfile) $prevexp
-        return
-    }
+    if {$mode == 0} {
+        set newexpfile [getExpFileName old]
+    } else {
+        set newexpfile [RevertExpFile]
+    }
+    if {$newexpfile == ""} return
 
     # switch to the 1st page
     RaisePage lsFrame
     set expgui(globalmode) 0
-    loadexp $expgui(expfile)
+    loadexp $newexpfile
 
     # reset the phase selection

branches/sandbox/gsascmds.tcl

@@ -2011 +2011 @@
 proc SetEXPfile {expfile "newOK 0"} {
     global expgui tcl_platform
-    set expgui(expfile) {}
     if {[string trim $expfile] == ""} return
 
@@ -2067 +2066 @@
     # force exp files to be upper case, set to force save if name changes
     set origexp $expname
-    if {$expname != [string toupper $expfile]} {
-        set expname [string toupper [file tail $expfile]]
-        if {$tcl_platform(platform) != "windows"} {set expgui(changed) 1}
-    }
-    if {[file extension $expname] != ".EXP"} {
+    if {$expname != [file tail $expfile] && $tcl_platform(platform) != "windows"} {
+        set expgui(changed) 1
+    }
+    #puts $expgui(expfile)
+    if {[string match {.O[0-9A-F][0-9A-F]} [file extension $expname]]} {
+        set expname [ArchiveChoice $expname]
+        set dirname ""
+        if {$expname == ""} return
+    } elseif {[file extension $expname] != ".EXP"} {
         append expname ".EXP"
     }
-    if {$dirname == "."} {
+    if {$dirname == "." || $dirname == ""} {
         set newexpfile $expname
     } else {
@@ -2133 +2136 @@
         if {[string tolower $ans] == "create"} {
             # you've been warned this .EXP does not exist!
-            # create an "empty" exp file
-            createexp $newexpfile \
-                [getstring "title for experiment $expname" 60 0]
-            if {! [file exists [file join $dirname $expname]]} {
-                update
-                MyMessageBox -parent . -title "File Creation Error" \
-                    -message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \
-                    -icon warning -type Continue -default continue
-                set expgui(resize) 1
-                return
-            }
+            if [CreateMTexpfile $newexpfile] return
         } else {
             return
         }
     }
-    set expgui(expfile) $newexpfile
-    catch {cd [string trim [file dirname $expgui(expfile)]]}
+    catch {cd [string trim [file dirname $newexpfile]]}
+    return $newexpfile
+}
+
+proc ArchiveChoice {expfile} {
+    set expnam [file rootname $expfile]
+    set ans [MyMessageBox -parent . -title "Load Archived File" \
+        -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?" \
+        -icon question -type "{Use New Name} {Continue with current}" \
+        -default {Use New Name} \
+        -helplink "expguierr.html LoadArchived"
+    ]
+    # archive the current .EXP file
+    if {$ans != "use new name" && [file exists $expfile]} {
+        # get the last archived version
+        set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
+        if {$lastf == ""} {
+            set num 01
+        } else {
+            regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
+            scan $num %x num
+            if {$num >= 255} {
+                set num FF
+            } else {
+                set num [string toupper [format %.2x [incr num]]]
+            }
+        }
+        catch {
+            set newfile $expnam.O$num
+            file rename -force $expnam.EXP $newfile
+            set fp [open $expnam.LST a+]
+            puts $fp "\n----------------------------------------------"
+            puts $fp "     Regressing to archive file [file tail $expfile]"
+            puts $fp "     but first archiving [file tail $expnam.EXP] as [file tail $newfile]"
+            puts $fp "----------------------------------------------\n"
+            close $fp
+        }
+        file copy -force $expfile $expnam.EXP
+        set expfile $expnam.EXP
+    }
+    if {$ans == "use new name"} {
+        set newexpfile [getExpFileName new]
+        if {$newexpfile == ""} {
+            set expgui(FileMenuEXPNAM) ""
+            return 
+        }
+        file copy -force $expfile $newexpfile
+        set expgui(needpowpref) 2
+        set expgui(needpowpref_why) "\tA new .EXP file was created\n" 
+        return $newexpfile
+    } else {
+        return $expfile
+    }
+}
+
+# create an "empty" exp file
+proc CreateMTexpfile {newexpfile} {
+    set expname [file tail $newexpfile]
+    createexp $newexpfile \
+        [getstring "title for experiment $expname" 60 0]
+    if {! [file exists $newexpfile]} {
+        update
+        MyMessageBox -parent . -title "File Creation Error" \
+            -message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \
+            -icon warning -type Continue -default continue
+        set ::expgui(resize) 1
+        return 1
+    }
+    return 0
 }
 
@@ -2181 +2241 @@
                 -side top -fill both -expand yes -pady 5
     } elseif {$mode != "new"} {
-        # for initial read, don't access archived files
+        # for initial read, don't offer access to archived files
         pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
                 -class SmallFont] \
@@ -2210 +2270 @@
     afterputontop
     if {$expgui(FileMenuEXPNAM) == ""} return
-    # is there a space in the EXP name?
-#    if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} {
-#       update
-#       MyMessageBox -parent . -title "File Name Error" \
-#           -message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI can#not process experiment files with spaces in the name" \
-#           -icon warning -type Continue -default continue
-#               -helplink "expguierr.html OpenErr"
-#       return
-#    }
-#    if {[string first " " $expgui(FileMenuDir)] != -1} {
-#       set warn 1
-#       catch {set warn $expgui(warnonexpdirspace)}
-#       if $warn {
-#           update
-#           MyMessageBox -parent . -title "Good luck..." \
-#               -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." \
-#               -icon warning -type Continue -default continue
-#           #           -helplink "expguierr.html OpenErr"
-#           set expgui(warnonexpdirspace) 0
-#       }
-#    }
+    #puts "end getexp $expgui(expfile)"
     return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
 }
 
 # validation routine
+# called from getExpFileName, either from Read button or from SelectExpFil (see expfilebox)
 proc valid_exp_file {frm mode} {
     global expgui tcl_platform
@@ -2260 +2301 @@
         return
     }
-    # append a .EXP if not present
-    if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
+    set ext [string toupper [file extension $expgui(FileMenuEXPNAM)]]
+    if {$ext == ""} {
+        # append a .EXP if not present
         append expgui(FileMenuEXPNAM) ".EXP"
-    }
-    # is there a space in the name?
-#    if {[string first " " $expgui(FileMenuEXPNAM)] != -1} {
-#       MyMessageBox -parent . -title "File Name Error" \
-#               -message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
-#               -icon warning -type Continue -default continue
-#               -helplink "expguierr.html OpenErr"
-#       return
-#    }
-    # check for archive files
-    if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \
+    } elseif {[string match {*.O[0-9A-F][0-9A-F]} $ext] && \
             $mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
+        # check for archive files
         destroy .file
         return
-    } elseif {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
+    } elseif {$ext != ".EXP"} {
         # check for files that end in something other than .EXP .exp or .Exp...
         MyMessageBox -parent . -title "File Open Error" \
@@ -2310 +2343 @@
                 -helplink "expguierr.html OpenErr"
         ]
-        if {[string tolower $ans] == "create"} {destroy .file}
+        if {[string tolower $ans] == "create"} {
+            if [CreateMTexpfile $file] return
+            destroy .file
+        }
         return
     }
@@ -2360 +2396 @@
     pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
 }
+proc sync2boxesX {master slave scroll args} {            
+    $slave xview moveto [lindex [$master xview] 0]               
+    eval $scroll set $args               
+}                
+proc move2boxesX {boxlist args} {                
+    foreach listbox $boxlist {                   
+        eval $listbox xview $args                
+    }            
+}
 proc sync2boxesY {master slave scroll args} {
     $slave yview moveto [lindex [$master yview] 0]
@@ -2460 +2505 @@
             - [winfo height $box.top] - [winfo height $box.scroll]-25]
 }
-
+proc RevertExpFile {} {
+    global expgui tcl_platform
+    set frm .file
+    catch {destroy $frm}
+    toplevel $frm
+    wm title $frm "Experiment file"
+    bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
+    pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
+    pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
+            -fill y -expand yes
+    pack [button $frmC.help -text Help -bg yellow \
+            -command "MakeWWWHelp expguierr.html open"] \
+            -side top -anchor e
+    set expgui(filesort) 0
+    set expgui(includearchived) 1
+    set expgui(FileInfoBox) $frmC.info
+    pack [label $frmC.ar -text "(Showing Archived Files Only)"] -side top -pady 10
+    pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
+              -class SmallFont] \
+        -side top -fill both -expand yes -pady 5
+
+    pack [button $frmC.b -text Read \
+            -command "valid_exp_file $frmA old"] -side bottom
+    pack [button $frmC.q -text Cancel \
+            -command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
+    bind $frm <Return> "$frmC.b invoke"
+
+    pack [label $frmA.0 -text "Select an archived experiment file to read"] \
+                -side top -anchor center
+    set bx $frmA 
+    pack [frame $bx.top] -side top 
+    #pack [label $bx.top.a -text "Directory" ] -side left 
+    set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
+    #pack $bx.top.d -side left
+    #set expgui(FileMenuDir) [pwd]
+    # the icon below is from tk8.0/tkfbox.tcl
+    pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
+    listbox $bx.a.files -relief raised -bd 2 \
+            -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
+            -height 15 -width 0 -exportselection 0 
+    listbox $bx.a.dates -relief raised -bd 2 \
+            -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
+            -height 15 -width 0 -takefocus 0 -exportselection 0 
+    scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
+    ChooseExpFil $bx 1
+    if {[llength [$bx.a.files get 0 end]] == 0} {
+        destroy $frm
+        MyMessageBox -parent . -title "No Archives" \
+            -message "Sorry no archived versions of $::expgui(expfile) are present" \
+                    -icon warning -type ok -default ok
+        return
+    }
+    bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
+    bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
+    bind $bx.a.files <Double-1> "SelectExpFil $bx old"
+    bind $bx.a.dates <Double-1> "SelectExpFil $bx old"
+    pack $bx.a.scroll -side left -fill y 
+    pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
+    pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
+    # force the window to stay on top
+    putontop $frm
+    focus $frmC.b
+    tkwait window $frm
+    afterputontop
+    if {$expgui(FileMenuEXPNAM) == ""} return
+    return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
+}
 
 # support routine for SetHistUseFlags
@@ -2677 +2788 @@
 # fill the files & dates & Directory selection box with current directory,
 # also called when box is created to fill it
-proc ChooseExpFil {frm} {
+proc ChooseExpFil {frm "archiveonly 0"} {
     global expgui
     set files $frm.a.files
@@ -2684 +2795 @@
     $files delete 0 end
     $dates delete 0 end
-    $files insert end {<Parent>}
-    $dates insert end {(Directory)}
-    set filelist [glob -nocomplain \
-            [file join [set expgui(FileMenuDir)] *] ]
-    foreach file [lsort -dictionary $filelist] {
-        if {[file isdirectory $file]} {
-            $files insert end [file tail $file]
-            $dates insert end {(Directory)}
-        }
+    if {$archiveonly == 0} {
+        $files insert end {<Parent>}
+        $dates insert end {(Directory)}
+        set filelist [glob -nocomplain \
+                          [file join [set expgui(FileMenuDir)] *] ]
+        foreach file [lsort -dictionary $filelist] {
+            if {[file isdirectory $file]} {
+                $files insert end [file tail $file]
+                $dates insert end {(Directory)}
+            }
+        }
+    } else {    
+        set filelist [glob -nocomplain \
+                          [file root $expgui(expfile)].O* ]
     }
     set pairlist {}
     foreach file [lsort -dictionary $filelist] {
         if {![file isdirectory $file]  && \
-                [string toupper [file extension $file]] == ".EXP"} {
+                [string toupper [file extension $file]] == ".EXP" \
+                && $archiveonly == 0} {
             set modified [file mtime $file]
             lappend pairlist [list $file $modified]

branches/sandbox/gsasmenu.tcl

@@ -9 +9 @@
 array set expgui_menulist {
     file {
+        revert
         EraseHistory
         convert
@@ -158 +159 @@
     }
 
+    revert {{readnewexp archive} {
+        Select an old version of the current GSAS file}
+    }
+
     {archive EXP} {- {
         Toggles archiving of .EXP files. When on, files are