Changeset 914 for trunk

Timestamp:

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

Author:

toby

Message:

# on 2008/04/15 17:26:54, toby did:
implement new capability as macromon (macro monitor routine)
allow routine to be called directly (opens .LST file)

File:

• trunk/lstview (modified) (9 diffs, 3 props)

trunk/lstview

@@ -24 +24 @@
 # maximum characters to read initially from a .LST file
 set txtvw(maxchars) 1000000
+# what are we running here?
+set program [file tail $argv0]
+# fix up problem with starkit tcl
+if {$program != "lstview" && $program != "macromon"} {
+    set program [file tail [info script]]
+}
 if {$tcl_platform(platform) == "windows"} {
    # windows is slow!
@@ -29 +35 @@
 }
 if {[set expnam [lindex $argv 0]] == ""} {
-    tk_dialog .warn Notify "No filename specified" error 0 OK
-    destroy .
-}
-set filename $expnam.LST
+    set expnam [tk_getOpenFile -initialdir [pwd] \
+                    -parent . \
+                    -filetypes {{"GSAS LST files" .LST} {Everything .*}} \
+                    -defaultextension .LST  \
+                    -title "Choose Listing file to read"]
+    if {$expnam == ""} {exit}
+}
+
+if { ! [string match "*.LST" $expnam]} {
+    set filename $expnam.LST
+} else {
+    set filename $expnam
+}
+if {![file exists $filename]} {
+    tk_dialog .warn Notify "Filename $filename not found" error 0 OK
+    exit
+}
+
+if {[string match "*_macout*" $expnam]} {
+    set mode Macro
+    regsub "_macout" [file root [file tail $expnam]] "" expnam
+} elseif {$::program == "macromon"} {
+    set mode Macro
+} else {
+    set mode normal
+}
+
 set zfil {}
 set lstfp {}
@@ -64 +93 @@
     catch {destroy .wait}
 }
-waitmsg "Reading $expnam.LST, Please wait"
+waitmsg "Reading $filename, Please wait"
 
 set txtvw(runnumber) 0
@@ -292 +321 @@
     if {$fil == ""} {
         set repeat 1
-        after 5000 updatetext
+        if {$::mode == "Macro"} {
+            after 500 updatetext
+        } else {
+            after 5000 updatetext
+        }
         set fil $lstfp
     }
+    if {! [file exists abort_${::expnam}_macro.flag] && $::mode == "Macro"} {
+        .but.abort config -text "Abort Macro" -relief raised
+    }
+    if {$::program == "macromon" && ! [file exists running_${::expnam}_macro.flag]} {
+        exit
+    }
+
     set txt {}
     catch {set txt [read $fil]}
     if {$txt == ""} return
+    if {$::program == "macromon"} {
+        set i [string last "Cycle " $txt]
+        set ii [expr {$i + 23}]
+        if {[
+             regexp {Cycle *([0-9]+) +There} [string range $txt $i $ii] junk cycle
+            ]} {
+            set ::txtvw(lastcycle) "Cycle $cycle"
+        }
+        set i [string last "Reduced CHI**2 =" $txt]
+        set ii [expr {$i + 23}]
+        if {[
+             regexp { *= *([.0-9]+) *} [string range $txt $i $ii] junk chi
+            ]} {
+            set ::txtvw(lastchi) "Chi**2 $chi"
+        }
+        set i [string last "Final variable sum" $txt]
+        set ii [string first "Time" $txt $i]
+        if {[
+             regexp {: *([.0-9]+) *} [string range $txt $i $ii] junk finalshift
+            ]} {
+            set ::txtvw(finalshift) "Shift/SU $finalshift"
+        }
+        # resize 
+        wm geom . {}
+        return
+    }
+
     .txt config -state normal
     set oldend [.txt index end]
+    if {$::mode == "Macro"} {
+        regsub -all { *[0-9]+ *Out of *[0-9]+ *powder profile points processed *\n} $txt "" txt
+    }
+        
     # truncate the text if too long
     if {[string length $txt] > $txtvw(maxchars) && $repeat == 0} {
@@ -318 +389 @@
     update
     findsum .txt .a.goto.menu.sum $oldend
+    if {$::mode == "Macro"} {.txt see end}
     update
-    
+        
     if {$txtvw(string) != ""} {
         findsetstring .txt $txtvw(string) .a.goto.menu.str $oldend
@@ -377 +449 @@
 " {} 0 OK
 }
-
-#----------------------------------------------------------------
-# where are we?
-set expgui(script) [info script]
-# translate links -- go six levels deep
-foreach i {1 2 3 4 5 6} {
-    if {[file type $expgui(script)] == "link"} {
-        set link [file readlink $expgui(script)]
-        if { [file  pathtype  $link] == "absolute" } {
-h           set expgui(script) $link
-        } {
-            set expgui(script) [file dirname $expgui(script)]/$link
-        }
-    } else {
-        break
-    }
-}
-
-# fixup relative paths
-if {[file pathtype $expgui(script)] == "relative"} {
-    set expgui(script) [file join [pwd] $expgui(script)]
-}
-set expgui(scriptdir) [file dirname $expgui(script) ]
-set expgui(docdir) [file join $expgui(scriptdir) doc]
-# location for web pages, if not found locally
-set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
-
-source [file join $expgui(scriptdir) gsascmds.tcl]
-source [file join $expgui(scriptdir) opts.tcl]
-
-# override options with locally defined values
-set filelist [file join $expgui(scriptdir) localconfig]
-if {$tcl_platform(platform) == "windows"} {
-    lappend filelist "c:/gsas.config"
-} else {
-    lappend filelist [file join ~ .gsas_config]
-}
-if {[catch {
-    foreach file $filelist {
-        if [file exists $file] {source $file}
-    }
-} errmsg]} {
-    set msg "Error reading file $file (aka [file nativename $file]): $errmsg"
-    MyMessageBox -parent . -title "Customize warning" \
-        -message $msg -icon warning -type Ignore -default ignore \
-        -helplink "expguierr.html Customizewarning"
-}
-
-set txtvw(lastchi) {}
-set txtvw(lastcycle) {}
-set txtvw(finalshift) {}
-text .txt -width 100 -wrap none \
-        -yscrollcommand ".yscroll set" \
-        -xscrollcommand ".xscroll set" 
-if {$tcl_version >= 8.0} {.txt config -font $txtvw(font)}
-scrollbar .yscroll -command ".txt yview"
-scrollbar .xscroll -command ".txt xview" -orient horizontal
-grid .xscroll -column 0 -row 2 -sticky ew
-grid .txt -column 0 -row 1 -sticky nsew
-grid .yscroll -column 1 -row 1 -sticky ns
-grid columnconfigure . 0 -weight 1
-grid rowconfigure . 1 -weight 1
-wm title . "View $filename"
-wm iconname . $filename
-grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew
-pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \
-            -side left
-menu .a.file.menu
-.a.file.menu add command -label "Delete $filename" -command KillLSTfile
-.a.file.menu add command -label "Trim $filename" -command TrimLSTfile
-.a.file.menu add command -label Exit -command "destroy ."
-
-# windows copy command. Should not be needed in X windows
-pack [menubutton .a.edit -text Edit -underline 0 -menu .a.edit.menu] \
-    -side left
-menu .a.edit.menu
-if {$tcl_platform(platform) == "windows"} {
-    .a.edit.menu add command -label copy \
-            -command {catch {clipboard append [selection get]}}
-} else {
-    .a.edit.menu add command -label "Print Selection" \
-            -command {catch PrintSelection}
-}
-
-pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \
-        -side left
-menu .a.goto.menu
-.a.goto.menu add cascade -label "Cycle #"  -menu .a.goto.menu.cyc \
-        -state disabled
-menu .a.goto.menu.cyc
-.a.goto.menu add cascade -label "Refinement Run #"  -menu .a.goto.menu.run \
-        -state disabled
-menu .a.goto.menu.run
-.a.goto.menu add cascade -label "Summary #"  -menu .a.goto.menu.sum \
-        -state disabled
-menu .a.goto.menu.sum
-.a.goto.menu add command -label "Set Search String" -command GetSearchString 
-.a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
-menu .a.goto.menu.str
-
-pack [menubutton .a.options -text "Options" -underline 0 \
-        -menu .a.options.menu] \
-            -side left
-menu .a.options.menu
-.a.options.menu  add checkbutton -label "Auto Advance" -variable txtvw(followcycle) 
-
-if {$tcl_version >= 8.0} {
-    pack [label .a.fontl -text "  Font:"] -side left
-    set fontbut [tk_optionMenu .a.fontb txtvw(font) ""]
-    pack .a.fontb -side left
-    $fontbut delete 0 end
-    foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
-        $fontbut add command -label "Courier $f" -font "Courier $f"\
-                -command "set txtvw(font) \"Courier $f\"; \
-                .txt config -font \$txtvw(font)"
-    }
-}
-
-if {$tcl_platform(platform) != "windows"} {
-    .a.options.menu add command -label "Set print command" -underline 1 \
-        -command SetPrintCommand
-}
-.a.options.menu add command -label "Save Options" -underline 1 \
-        -command "SaveOptions"
 
 proc postingvars {} {
@@ -736 +684 @@
 }
 
-
+proc AbortMacro {} {
+    .but.abort config -text "Macro aborting..." -relief sunken
+    close [open abort_${::expnam}_macro.flag w]
+}
+
+#----------------------------------------------------------------
+# where are we?
+set expgui(script) [info script]
+# translate links -- go six levels deep
+foreach i {1 2 3 4 5 6} {
+    if {[file type $expgui(script)] == "link"} {
+        set link [file readlink $expgui(script)]
+        if { [file  pathtype  $link] == "absolute" } {
+h           set expgui(script) $link
+        } {
+            set expgui(script) [file dirname $expgui(script)]/$link
+        }
+    } else {
+        break
+    }
+}
+
+# fixup relative paths
+if {[file pathtype $expgui(script)] == "relative"} {
+    set expgui(script) [file join [pwd] $expgui(script)]
+}
+set expgui(scriptdir) [file dirname $expgui(script) ]
+set expgui(docdir) [file join $expgui(scriptdir) doc]
+# location for web pages, if not found locally
+set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
+
+source [file join $expgui(scriptdir) gsascmds.tcl]
+source [file join $expgui(scriptdir) opts.tcl]
+
+# override options with locally defined values
+set filelist [file join $expgui(scriptdir) localconfig]
+if {$tcl_platform(platform) == "windows"} {
+    lappend filelist "c:/gsas.config"
+} else {
+    lappend filelist [file join ~ .gsas_config]
+}
+if {[catch {
+    foreach file $filelist {
+        if [file exists $file] {source $file}
+    }
+} errmsg]} {
+    set msg "Error reading file $file (aka [file nativename $file]): $errmsg"
+    MyMessageBox -parent . -title "Customize warning" \
+        -message $msg -icon warning -type Ignore -default ignore \
+        -helplink "expguierr.html Customizewarning"
+}
+
+set txtvw(lastchi) {}
+set txtvw(lastcycle) {}
+set txtvw(finalshift) {}
+if {$::program != "macromon"} {
+    text .txt -width 100 -wrap none \
+        -yscrollcommand ".yscroll set" \
+        -xscrollcommand ".xscroll set" 
+    if {$tcl_version >= 8.0} {.txt config -font $txtvw(font)}
+    scrollbar .yscroll -command ".txt yview"
+    scrollbar .xscroll -command ".txt xview" -orient horizontal
+    grid .xscroll -column 0 -row 2 -sticky ew
+    grid .txt -column 0 -row 1 -sticky nsew
+    grid .yscroll -column 1 -row 1 -sticky ns
+} else {
+    grid [label .msg -text "\nMacro running\n" -padx 20 -pady 5] -column 0 -row 1 -sticky nsew
+}
+grid columnconfigure . 0 -weight 1
+grid rowconfigure . 1 -weight 1
+wm title . "View $filename"
+wm iconname . $filename
+grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew
+pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \
+            -side left
+menu .a.file.menu
+if {$::program != "macromon"} {
+    .a.file.menu add command -label "Delete $filename" -command KillLSTfile
+    .a.file.menu add command -label "Trim $filename" -command TrimLSTfile
+}
+.a.file.menu add command -label Exit -command "destroy ."
+
+if {$::program != "macromon"} {
+    # windows copy command. Should not be needed in X windows
+    pack [menubutton .a.edit -text Edit -underline 0 -menu .a.edit.menu] \
+        -side left
+    menu .a.edit.menu
+    if {$tcl_platform(platform) == "windows"} {
+        .a.edit.menu add command -label copy \
+            -command {catch {clipboard append [selection get]}}
+    } else {
+        .a.edit.menu add command -label "Print Selection" \
+            -command {catch PrintSelection}
+    }
+
+    pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \
+        -side left
+    menu .a.goto.menu
+    .a.goto.menu add cascade -label "Cycle #"  -menu .a.goto.menu.cyc \
+        -state disabled
+    menu .a.goto.menu.cyc
+    .a.goto.menu add cascade -label "Refinement Run #"  -menu .a.goto.menu.run \
+        -state disabled
+    menu .a.goto.menu.run
+    .a.goto.menu add cascade -label "Summary #"  -menu .a.goto.menu.sum \
+        -state disabled
+    menu .a.goto.menu.sum
+    .a.goto.menu add command -label "Set Search String" -command GetSearchString 
+    .a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
+    menu .a.goto.menu.str
+
+    pack [menubutton .a.options -text "Options" -underline 0 \
+              -menu .a.options.menu] \
+            -side left
+    menu .a.options.menu
+    .a.options.menu  add checkbutton -label "Auto Advance" -variable txtvw(followcycle) 
+    
+    if {$tcl_version >= 8.0} {
+        pack [label .a.fontl -text "  Font:"] -side left
+        set fontbut [tk_optionMenu .a.fontb txtvw(font) ""]
+        pack .a.fontb -side left
+        $fontbut delete 0 end
+        foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
+            $fontbut add command -label "Courier $f" -font "Courier $f"\
+                -command "set txtvw(font) \"Courier $f\"; \
+                .txt config -font \$txtvw(font)"
+        }
+    }
+
+    if {$tcl_platform(platform) != "windows"} {
+        .a.options.menu add command -label "Set print command" -underline 1 \
+            -command SetPrintCommand
+    }
+    .a.options.menu add command -label "Save Options" -underline 1 \
+        -command "SaveOptions"
+    if {$txtvw(plotvars) && ![catch {package require BLT}]} {
+        .a.options.menu add checkbutton -label "Show Plot" -command hideplot \
+            -variable txtvw(hideplot)
+    }
+}
 pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
 menu .a.help.menu
@@ -755 +842 @@
 pack [label .but.lbl4 -textvariable txtvw(finalshift) \
         -relief sunken -bd 2] -side left
-bind all <Control-KeyPress-c> {destroy .}
-bind . <KeyPress-Prior> ".txt yview scroll -1 page"
-bind . <KeyPress-Next> ".txt yview scroll 1 page"
-bind . <KeyPress-Up> ".txt yview scroll -1 unit"
-bind . <KeyPress-Down> ".txt yview scroll 1 unit"
-bind . <KeyPress-Home> ".txt yview 0"
-bind . <KeyPress-End> ".txt yview end"
-#pack [button .but.q -text close -command "destroy ." ] -side right
-.txt tag config cycle -background yellow
-.txt tag config rval -background  green
-.txt tag config chi -background  green
+if {$mode == "Macro"} {
+    pack [button .but.abort -text "Abort Macro "\
+             -command AbortMacro] -side right
+}
+if {$::program != "macromon"} {
+    #bind all <Control-KeyPress-c> {destroy .}
+    bind . <KeyPress-Prior> ".txt yview scroll -1 page"
+    bind . <KeyPress-Next> ".txt yview scroll 1 page"
+    bind . <KeyPress-Up> ".txt yview scroll -1 unit"
+    bind . <KeyPress-Down> ".txt yview scroll 1 unit"
+    bind . <KeyPress-Home> ".txt yview 0"
+    bind . <KeyPress-End> ".txt yview end"
+    #pack [button .but.q -text close -command "destroy ." ] -side right
+    .txt tag config cycle -background yellow
+    .txt tag config rval -background  green
+    .txt tag config chi -background  green
+}
 if [file exists $filename] {
     set lstfp [open $filename r]
@@ -787 +880 @@
 # now start reading with updates
 updatetext
-
-if {$txtvw(plotvars) && ![catch {package require BLT}]} {
-    .a.options.menu add checkbutton -label "Show Plot" -command hideplot \
-            -variable txtvw(hideplot)
-}