Changeset 466

Timestamp:

Dec 4, 2009 5:06:38 PM (14 years ago)

Author:

toby

Message:

# on 2001/10/18 23:22:57, toby did:
update archiving

File:

• trunk/expgui (modified) (4 diffs, 3 props)

trunk/expgui

@@ -242 +242 @@
     global expgui expmap entryvar entrycmd tcl_platform
     # is this a compressed archive file? 
-    if {[string match {*.EXP.[0-9][0-9][0-9].gz} $expfile] && \
-            $tcl_platform(platform) == "unix"} {
-        regexp {.*.EXP} $expfile rootname
-        if {[auto_execok gunzip] == ""} {
-            # tno gunzip -- bail out
-            MyMessageBox -parent . -title "Cannot Load Archived File" \
-                -message "Unable to find the gunzip program in your path. Loading this archived version of [file tail $rootname] requires the gzip program. Load gunzip or fix your path and then restart EXPGUI" \
-                -icon error
-            return
-        }
+    if {[string match {*.O[0-9A-F][0-9A-F]} $expfile]} {
+        set expgui(expfile) {}
+        set expnam [file rootname $expfile]
         set ans [MyMessageBox -parent . -title "Load Archived File" \
-                -message "Loading archived version of [file tail $rootname]. Do you want to overwrite $rootname or save the archived version under a new name?" \
-                -icon question -type "{Use New Name} Overwrite"\
+                -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 $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
+                exec echo "\n----------------------------------------------" >> $expnam.LST
+                exec echo "     Regressing to archive file [file tail $expfile]" >> $expnam.LST
+                exec echo "     but first archiving [file tail $expnam.EXP] as [file tail $newfile]" >> $expnam.LST
+                exec echo "----------------------------------------------\n" >> $expnam.LST
+            }
+        }
+        file copy -force $expfile $expnam.EXP
         set fmt [expload $expfile]
+        # if the file was not in the correct format, force a rewrite before use
         if {$fmt < 0} {
             # read error
             return
-        }
-        set expgui(changed) 1
-        set expfile $rootname
-        if {$ans == "use new name"} {
-            SaveAsFile
-            set expfile $expgui(expfile)
-        }
-    # is this an uncompressed archive file? 
-    } elseif {[string match {*.EXP.[0-9][0-9][0-9]} $expfile] && \
-            $tcl_platform(platform) == "unix"} {
-        regexp {.*.EXP} $expfile rootname
-        set ans [MyMessageBox -parent . -title "Load Archived File" \
-                -message "Loading archived version of [file tail $rootname]. Do you want to overwrite $rootname or save the archived version under a new name?" \
-                -icon question -type "{Use New Name} Overwrite"\
-                -default {Use New Name} \
-                -helplink "expguierr.html LoadArchived"
-        ]
-        set fmt [expload $expfile]
-        if {$fmt < 0} {
-            # read error
-            return
-        }
-        set expgui(changed) 1
-        set expfile $rootname
+        } elseif {$fmt == 1} {
+            set expgui(changed) 0
+        } else {
+            set expgui(changed) 1
+        }
+        set expfile $expnam.EXP
         if {$ans == "use new name"} {
             SaveAsFile
@@ -426 +427 @@
     if $expgui(changed) {
         set decision [tk_dialog .instrSaveData {Save .EXP changes} \
-                {You have made changes to the Experiment. Reading a different file will cause the changes to be lost. Select an option:} \
+                {You have made changes to the Experiment. Reading a different file without first saving will cause the changes to be lost. Select an option:} \
                 {} 0 "Save and read" "Read without Save" "Cancel read command"]
         switch $decision {
@@ -570 +571 @@
         return
     }
+    if {![file exists $expgui(expfile)]} {
+        after 2000 afterawhile
+        return
+    }
     if {[file mtime $expgui(expfile)] != $expgui(expModifiedLast)} {
         # we are "locked". Note that whenidle loop will be restarted later
@@ -710 +715 @@
         2 {                  return "Cancel"   }
     }
-}
-
-proc archiveexp {} {
-    global expgui tcl_platform
-    # is there a file to archive
-    if {![file exists $expgui(expfile)]} return
-    catch {
-        set expnam [file rootname $expgui(expfile)]
-        if {$tcl_platform(platform) == "windows"} {
-            set version -1
-            catch {source $expnam.version}
-            incr version
-            if ![file executable [file join $expgui(scriptdir) pkzip.exe]] {
-                # archive w/o pkzip
-                set file $expnam![format "%3.3d" $version].EXP
-                file copy -force $expnam.EXP $file
-                set fp [open $expnam.lst a]
-                puts $fp "\n--------------------------------------------------------------"
-                puts $fp "Archiving $expnam.EXP as $file"
-                puts $fp "--------------------------------------------------------------\n"
-                close $fp
-            } else {
-                # archive with PKZIP            
-                # need to limit expnam to 8 characters
-                set sexp [string toupper [string range [file root [file tail $expnam] ] 0 7]]
-                # PKZIP can't handle long dir names either
-                cd [set dir [file dirname $expnam]]
-                set file $sexp.[format "%3.3d" $version]
-                file copy -force $expnam.EXP $file
-                exec [file join $expgui(scriptdir) pkzip.exe] -m $sexp $file > zip.out &
-                set fp [open $expnam.lst a]
-                puts $fp "\n--------------------------------------------------------------"
-                puts $fp "Archiving $expnam.EXP as $file in [file join $dir $sexp.ZIP]"
-                puts $fp "--------------------------------------------------------------\n"
-                close $fp
-            }
-            set fp [open $expnam.version w]
-            puts $fp "set version $version"
-            close $fp
-        } else {
-            set files [glob -nocomplain $expnam.EXP.*]
-            if {$files == ""} {
-                set file $expnam.EXP.000
-            } else {
-                set number {}
-                foreach file [lsort -decreasing $files] {
-                    if [catch {
-                        regexp {.*\.EXP\.([0-9][0-9][0-9]).*} $file junk number
-                        regexp {0?0?([0-9]*)} $number junk number
-                        incr number
-                    }] {
-                        continue
-                    } else {
-                        break
-                    }
-                }
-                if {$number == ""} {set number 0}
-                set file $expnam.EXP.[format "%3.3d" $number]
-            }
-            file copy $expgui(expfile) $file
-            if [catch {exec gzip $file}] {
-                exec echo "\n----------------------------------------------" >> $expnam.LST
-                exec echo "     Archiving $expnam.EXP as $file " >> $expnam.LST
-                exec echo "----------------------------------------------\n" >> $expnam.LST
-            } else { 
-                exec echo "\n----------------------------------------------" >> $expnam.LST
-                exec echo "     Archiving $expnam.EXP as $file.gz " >> $expnam.LST
-                exec echo "----------------------------------------------\n" >> $expnam.LST
-            }
-        }
-    } errmsg
-    if {$errmsg != ""} {
-        tk_dialog .warn Confirm "Error archiving the current .EXP file: $errmsg" warning 0 OK
-    }
-}
-
-# save and optionally archive the expfile
-proc savearchiveexp {} {
-    global expgui expmap
-    if !$expgui(changed) return
-    if $expgui(archive) archiveexp
-    # add a history record
-    exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds]]"
-    # now save the file
-    expwrite $expgui(expfile)
-    set expgui(changed) 0
-    set expgui(expModifiedLast) [file mtime $expgui(expfile)]
-    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
-    wm title . $expgui(expfile)
-    set expgui(titleunchanged) 1
-    # set convergence criterion
-    InitLSvars
 }