Changeset 470 for trunk/gsascmds.tcl

Timestamp:

Dec 4, 2009 5:06:42 PM (11 years ago)

Author:

toby

Message:

# on 2001/10/18 23:30:15, toby did:
fix web page display problem in windows-NT
move EXP archiving here & now use the .O?? files

File:

• trunk/gsascmds.tcl (modified) (6 diffs, 3 props)

trunk/gsascmds.tcl

@@ -881 +881 @@
 
             # Substitute the HTML filename into the command for %1
-            regsub %1 $appCmd $url appCmd
+            # or stick it on the end
+            if {[string first %1 $appCmd] != -1} {
+                regsub %1 $appCmd $url appCmd
+            } else {
+                append appCmd " " $url
+            }
             
             # Double up the backslashes for eval (below)
@@ -1323 +1328 @@
 }
 
+proc archiveexp {} {
+    global expgui tcl_platform
+    # is there a file to archive?
+    if {![file exists $expgui(expfile)]} return
+    set expnam [file rootname $expgui(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 file $expnam.O$num
+        file rename -force $expgui(expfile) $file
+        exec echo "\n----------------------------------------------" >> $expnam.LST
+        exec echo "     Archiving [file tail $expnam.EXP] as [file tail $file]" >> $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(expfile) == ""} {
+        SaveAsFile
+        return
+    }
+    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
+}
+
 #------------------------------------------------------------------------------
 # GSAS interface routines
@@ -1358 +1415 @@
     set expnam [file root [file tail $expgui(expfile)]]
     foreach prog $proglist {
-        if {$prog == "expedt" && $expgui(archive)} archiveexp
         if {$tcl_platform(platform) == "windows"} {
             append cmd " \"$expgui(gsasexe)/${prog}.exe $expnam \" "
@@ -1778 +1834 @@
 
     set expgui(includearchived) 0
-    if {$tcl_platform(platform) == "unix" && $mode == "old"} {
+    if {$mode == "old"} {
         pack [checkbutton $frmC.ar -text "Include Archived Files" \
                 -variable expgui(includearchived) \
@@ -1840 +1896 @@
     }
     # check for archive files
-    if {([string match {*.EXP.[0-9][0-9][0-9].gz} $expgui(FileMenuEXPNAM)] || \
-            [string match {*.EXP.[0-9][0-9][0-9]} $expgui(FileMenuEXPNAM)]) && \
-            $tcl_platform(platform) == "unix" && \
+    if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \
             $mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
         destroy .file
@@ -2186 +2240 @@
             lappend pairlist [list $file $modified]
         } elseif {![file isdirectory $file] && $expgui(includearchived) && \
-                ([string match {*.EXP.[0-9][0-9][0-9].gz} $file] ||\
-                [string match {*.EXP.[0-9][0-9][0-9]} $file])} {
+                [string match {*.O[0-9A-F][0-9A-F]} $file]} {
             set modified [file mtime $file]
             lappend pairlist [list $file $modified]