Changeset 914


Ignore:
Timestamp:
Dec 4, 2009 5:14:14 PM (11 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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/lstview

    • Property rcs:date changed from 2005/03/24 21:43:24 to 2008/04/15 17:26:54
    • Property rcs:lines changed from +49 -8 to +236 -148
    • Property rcs:rev changed from 1.18 to 1.19
    r837 r914  
    2424# maximum characters to read initially from a .LST file
    2525set txtvw(maxchars) 1000000
     26# what are we running here?
     27set program [file tail $argv0]
     28# fix up problem with starkit tcl
     29if {$program != "lstview" && $program != "macromon"} {
     30    set program [file tail [info script]]
     31}
    2632if {$tcl_platform(platform) == "windows"} {
    2733   # windows is slow!
     
    2935}
    3036if {[set expnam [lindex $argv 0]] == ""} {
    31     tk_dialog .warn Notify "No filename specified" error 0 OK
    32     destroy .
    33 }
    34 set filename $expnam.LST
     37    set expnam [tk_getOpenFile -initialdir [pwd] \
     38                    -parent . \
     39                    -filetypes {{"GSAS LST files" .LST} {Everything .*}} \
     40                    -defaultextension .LST  \
     41                    -title "Choose Listing file to read"]
     42    if {$expnam == ""} {exit}
     43}
     44
     45if { ! [string match "*.LST" $expnam]} {
     46    set filename $expnam.LST
     47} else {
     48    set filename $expnam
     49}
     50if {![file exists $filename]} {
     51    tk_dialog .warn Notify "Filename $filename not found" error 0 OK
     52    exit
     53}
     54
     55if {[string match "*_macout*" $expnam]} {
     56    set mode Macro
     57    regsub "_macout" [file root [file tail $expnam]] "" expnam
     58} elseif {$::program == "macromon"} {
     59    set mode Macro
     60} else {
     61    set mode normal
     62}
     63
    3564set zfil {}
    3665set lstfp {}
     
    6493    catch {destroy .wait}
    6594}
    66 waitmsg "Reading $expnam.LST, Please wait"
     95waitmsg "Reading $filename, Please wait"
    6796
    6897set txtvw(runnumber) 0
     
    292321    if {$fil == ""} {
    293322        set repeat 1
    294         after 5000 updatetext
     323        if {$::mode == "Macro"} {
     324            after 500 updatetext
     325        } else {
     326            after 5000 updatetext
     327        }
    295328        set fil $lstfp
    296329    }
     330    if {! [file exists abort_${::expnam}_macro.flag] && $::mode == "Macro"} {
     331        .but.abort config -text "Abort Macro" -relief raised
     332    }
     333    if {$::program == "macromon" && ! [file exists running_${::expnam}_macro.flag]} {
     334        exit
     335    }
     336
    297337    set txt {}
    298338    catch {set txt [read $fil]}
    299339    if {$txt == ""} return
     340    if {$::program == "macromon"} {
     341        set i [string last "Cycle " $txt]
     342        set ii [expr {$i + 23}]
     343        if {[
     344             regexp {Cycle *([0-9]+) +There} [string range $txt $i $ii] junk cycle
     345            ]} {
     346            set ::txtvw(lastcycle) "Cycle $cycle"
     347        }
     348        set i [string last "Reduced CHI**2 =" $txt]
     349        set ii [expr {$i + 23}]
     350        if {[
     351             regexp { *= *([.0-9]+) *} [string range $txt $i $ii] junk chi
     352            ]} {
     353            set ::txtvw(lastchi) "Chi**2 $chi"
     354        }
     355        set i [string last "Final variable sum" $txt]
     356        set ii [string first "Time" $txt $i]
     357        if {[
     358             regexp {: *([.0-9]+) *} [string range $txt $i $ii] junk finalshift
     359            ]} {
     360            set ::txtvw(finalshift) "Shift/SU $finalshift"
     361        }
     362        # resize
     363        wm geom . {}
     364        return
     365    }
     366
    300367    .txt config -state normal
    301368    set oldend [.txt index end]
     369    if {$::mode == "Macro"} {
     370        regsub -all { *[0-9]+ *Out of *[0-9]+ *powder profile points processed *\n} $txt "" txt
     371    }
     372       
    302373    # truncate the text if too long
    303374    if {[string length $txt] > $txtvw(maxchars) && $repeat == 0} {
     
    318389    update
    319390    findsum .txt .a.goto.menu.sum $oldend
     391    if {$::mode == "Macro"} {.txt see end}
    320392    update
    321    
     393       
    322394    if {$txtvw(string) != ""} {
    323395        findsetstring .txt $txtvw(string) .a.goto.menu.str $oldend
     
    377449" {} 0 OK
    378450}
    379 
    380 #----------------------------------------------------------------
    381 # where are we?
    382 set expgui(script) [info script]
    383 # translate links -- go six levels deep
    384 foreach i {1 2 3 4 5 6} {
    385     if {[file type $expgui(script)] == "link"} {
    386         set link [file readlink $expgui(script)]
    387         if { [file  pathtype  $link] == "absolute" } {
    388 h           set expgui(script) $link
    389         } {
    390             set expgui(script) [file dirname $expgui(script)]/$link
    391         }
    392     } else {
    393         break
    394     }
    395 }
    396 
    397 # fixup relative paths
    398 if {[file pathtype $expgui(script)] == "relative"} {
    399     set expgui(script) [file join [pwd] $expgui(script)]
    400 }
    401 set expgui(scriptdir) [file dirname $expgui(script) ]
    402 set expgui(docdir) [file join $expgui(scriptdir) doc]
    403 # location for web pages, if not found locally
    404 set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
    405 
    406 source [file join $expgui(scriptdir) gsascmds.tcl]
    407 source [file join $expgui(scriptdir) opts.tcl]
    408 
    409 # override options with locally defined values
    410 set filelist [file join $expgui(scriptdir) localconfig]
    411 if {$tcl_platform(platform) == "windows"} {
    412     lappend filelist "c:/gsas.config"
    413 } else {
    414     lappend filelist [file join ~ .gsas_config]
    415 }
    416 if {[catch {
    417     foreach file $filelist {
    418         if [file exists $file] {source $file}
    419     }
    420 } errmsg]} {
    421     set msg "Error reading file $file (aka [file nativename $file]): $errmsg"
    422     MyMessageBox -parent . -title "Customize warning" \
    423         -message $msg -icon warning -type Ignore -default ignore \
    424         -helplink "expguierr.html Customizewarning"
    425 }
    426 
    427 set txtvw(lastchi) {}
    428 set txtvw(lastcycle) {}
    429 set txtvw(finalshift) {}
    430 text .txt -width 100 -wrap none \
    431         -yscrollcommand ".yscroll set" \
    432         -xscrollcommand ".xscroll set"
    433 if {$tcl_version >= 8.0} {.txt config -font $txtvw(font)}
    434 scrollbar .yscroll -command ".txt yview"
    435 scrollbar .xscroll -command ".txt xview" -orient horizontal
    436 grid .xscroll -column 0 -row 2 -sticky ew
    437 grid .txt -column 0 -row 1 -sticky nsew
    438 grid .yscroll -column 1 -row 1 -sticky ns
    439 grid columnconfigure . 0 -weight 1
    440 grid rowconfigure . 1 -weight 1
    441 wm title . "View $filename"
    442 wm iconname . $filename
    443 grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew
    444 pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \
    445             -side left
    446 menu .a.file.menu
    447 .a.file.menu add command -label "Delete $filename" -command KillLSTfile
    448 .a.file.menu add command -label "Trim $filename" -command TrimLSTfile
    449 .a.file.menu add command -label Exit -command "destroy ."
    450 
    451 # windows copy command. Should not be needed in X windows
    452 pack [menubutton .a.edit -text Edit -underline 0 -menu .a.edit.menu] \
    453     -side left
    454 menu .a.edit.menu
    455 if {$tcl_platform(platform) == "windows"} {
    456     .a.edit.menu add command -label copy \
    457             -command {catch {clipboard append [selection get]}}
    458 } else {
    459     .a.edit.menu add command -label "Print Selection" \
    460             -command {catch PrintSelection}
    461 }
    462 
    463 pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \
    464         -side left
    465 menu .a.goto.menu
    466 .a.goto.menu add cascade -label "Cycle #"  -menu .a.goto.menu.cyc \
    467         -state disabled
    468 menu .a.goto.menu.cyc
    469 .a.goto.menu add cascade -label "Refinement Run #"  -menu .a.goto.menu.run \
    470         -state disabled
    471 menu .a.goto.menu.run
    472 .a.goto.menu add cascade -label "Summary #"  -menu .a.goto.menu.sum \
    473         -state disabled
    474 menu .a.goto.menu.sum
    475 .a.goto.menu add command -label "Set Search String" -command GetSearchString
    476 .a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
    477 menu .a.goto.menu.str
    478 
    479 pack [menubutton .a.options -text "Options" -underline 0 \
    480         -menu .a.options.menu] \
    481             -side left
    482 menu .a.options.menu
    483 .a.options.menu  add checkbutton -label "Auto Advance" -variable txtvw(followcycle)
    484 
    485 if {$tcl_version >= 8.0} {
    486     pack [label .a.fontl -text "  Font:"] -side left
    487     set fontbut [tk_optionMenu .a.fontb txtvw(font) ""]
    488     pack .a.fontb -side left
    489     $fontbut delete 0 end
    490     foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
    491         $fontbut add command -label "Courier $f" -font "Courier $f"\
    492                 -command "set txtvw(font) \"Courier $f\"; \
    493                 .txt config -font \$txtvw(font)"
    494     }
    495 }
    496 
    497 if {$tcl_platform(platform) != "windows"} {
    498     .a.options.menu add command -label "Set print command" -underline 1 \
    499         -command SetPrintCommand
    500 }
    501 .a.options.menu add command -label "Save Options" -underline 1 \
    502         -command "SaveOptions"
    503451
    504452proc postingvars {} {
     
    736684}
    737685
    738 
     686proc AbortMacro {} {
     687    .but.abort config -text "Macro aborting..." -relief sunken
     688    close [open abort_${::expnam}_macro.flag w]
     689}
     690
     691#----------------------------------------------------------------
     692# where are we?
     693set expgui(script) [info script]
     694# translate links -- go six levels deep
     695foreach i {1 2 3 4 5 6} {
     696    if {[file type $expgui(script)] == "link"} {
     697        set link [file readlink $expgui(script)]
     698        if { [file  pathtype  $link] == "absolute" } {
     699h           set expgui(script) $link
     700        } {
     701            set expgui(script) [file dirname $expgui(script)]/$link
     702        }
     703    } else {
     704        break
     705    }
     706}
     707
     708# fixup relative paths
     709if {[file pathtype $expgui(script)] == "relative"} {
     710    set expgui(script) [file join [pwd] $expgui(script)]
     711}
     712set expgui(scriptdir) [file dirname $expgui(script) ]
     713set expgui(docdir) [file join $expgui(scriptdir) doc]
     714# location for web pages, if not found locally
     715set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
     716
     717source [file join $expgui(scriptdir) gsascmds.tcl]
     718source [file join $expgui(scriptdir) opts.tcl]
     719
     720# override options with locally defined values
     721set filelist [file join $expgui(scriptdir) localconfig]
     722if {$tcl_platform(platform) == "windows"} {
     723    lappend filelist "c:/gsas.config"
     724} else {
     725    lappend filelist [file join ~ .gsas_config]
     726}
     727if {[catch {
     728    foreach file $filelist {
     729        if [file exists $file] {source $file}
     730    }
     731} errmsg]} {
     732    set msg "Error reading file $file (aka [file nativename $file]): $errmsg"
     733    MyMessageBox -parent . -title "Customize warning" \
     734        -message $msg -icon warning -type Ignore -default ignore \
     735        -helplink "expguierr.html Customizewarning"
     736}
     737
     738set txtvw(lastchi) {}
     739set txtvw(lastcycle) {}
     740set txtvw(finalshift) {}
     741if {$::program != "macromon"} {
     742    text .txt -width 100 -wrap none \
     743        -yscrollcommand ".yscroll set" \
     744        -xscrollcommand ".xscroll set"
     745    if {$tcl_version >= 8.0} {.txt config -font $txtvw(font)}
     746    scrollbar .yscroll -command ".txt yview"
     747    scrollbar .xscroll -command ".txt xview" -orient horizontal
     748    grid .xscroll -column 0 -row 2 -sticky ew
     749    grid .txt -column 0 -row 1 -sticky nsew
     750    grid .yscroll -column 1 -row 1 -sticky ns
     751} else {
     752    grid [label .msg -text "\nMacro running\n" -padx 20 -pady 5] -column 0 -row 1 -sticky nsew
     753}
     754grid columnconfigure . 0 -weight 1
     755grid rowconfigure . 1 -weight 1
     756wm title . "View $filename"
     757wm iconname . $filename
     758grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew
     759pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \
     760            -side left
     761menu .a.file.menu
     762if {$::program != "macromon"} {
     763    .a.file.menu add command -label "Delete $filename" -command KillLSTfile
     764    .a.file.menu add command -label "Trim $filename" -command TrimLSTfile
     765}
     766.a.file.menu add command -label Exit -command "destroy ."
     767
     768if {$::program != "macromon"} {
     769    # windows copy command. Should not be needed in X windows
     770    pack [menubutton .a.edit -text Edit -underline 0 -menu .a.edit.menu] \
     771        -side left
     772    menu .a.edit.menu
     773    if {$tcl_platform(platform) == "windows"} {
     774        .a.edit.menu add command -label copy \
     775            -command {catch {clipboard append [selection get]}}
     776    } else {
     777        .a.edit.menu add command -label "Print Selection" \
     778            -command {catch PrintSelection}
     779    }
     780
     781    pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \
     782        -side left
     783    menu .a.goto.menu
     784    .a.goto.menu add cascade -label "Cycle #"  -menu .a.goto.menu.cyc \
     785        -state disabled
     786    menu .a.goto.menu.cyc
     787    .a.goto.menu add cascade -label "Refinement Run #"  -menu .a.goto.menu.run \
     788        -state disabled
     789    menu .a.goto.menu.run
     790    .a.goto.menu add cascade -label "Summary #"  -menu .a.goto.menu.sum \
     791        -state disabled
     792    menu .a.goto.menu.sum
     793    .a.goto.menu add command -label "Set Search String" -command GetSearchString
     794    .a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
     795    menu .a.goto.menu.str
     796
     797    pack [menubutton .a.options -text "Options" -underline 0 \
     798              -menu .a.options.menu] \
     799            -side left
     800    menu .a.options.menu
     801    .a.options.menu  add checkbutton -label "Auto Advance" -variable txtvw(followcycle)
     802   
     803    if {$tcl_version >= 8.0} {
     804        pack [label .a.fontl -text "  Font:"] -side left
     805        set fontbut [tk_optionMenu .a.fontb txtvw(font) ""]
     806        pack .a.fontb -side left
     807        $fontbut delete 0 end
     808        foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
     809            $fontbut add command -label "Courier $f" -font "Courier $f"\
     810                -command "set txtvw(font) \"Courier $f\"; \
     811                .txt config -font \$txtvw(font)"
     812        }
     813    }
     814
     815    if {$tcl_platform(platform) != "windows"} {
     816        .a.options.menu add command -label "Set print command" -underline 1 \
     817            -command SetPrintCommand
     818    }
     819    .a.options.menu add command -label "Save Options" -underline 1 \
     820        -command "SaveOptions"
     821    if {$txtvw(plotvars) && ![catch {package require BLT}]} {
     822        .a.options.menu add checkbutton -label "Show Plot" -command hideplot \
     823            -variable txtvw(hideplot)
     824    }
     825}
    739826pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
    740827menu .a.help.menu
     
    755842pack [label .but.lbl4 -textvariable txtvw(finalshift) \
    756843        -relief sunken -bd 2] -side left
    757 bind all <Control-KeyPress-c> {destroy .}
    758 bind . <KeyPress-Prior> ".txt yview scroll -1 page"
    759 bind . <KeyPress-Next> ".txt yview scroll 1 page"
    760 bind . <KeyPress-Up> ".txt yview scroll -1 unit"
    761 bind . <KeyPress-Down> ".txt yview scroll 1 unit"
    762 bind . <KeyPress-Home> ".txt yview 0"
    763 bind . <KeyPress-End> ".txt yview end"
    764 #pack [button .but.q -text close -command "destroy ." ] -side right
    765 .txt tag config cycle -background yellow
    766 .txt tag config rval -background  green
    767 .txt tag config chi -background  green
     844if {$mode == "Macro"} {
     845    pack [button .but.abort -text "Abort Macro "\
     846             -command AbortMacro] -side right
     847}
     848if {$::program != "macromon"} {
     849    #bind all <Control-KeyPress-c> {destroy .}
     850    bind . <KeyPress-Prior> ".txt yview scroll -1 page"
     851    bind . <KeyPress-Next> ".txt yview scroll 1 page"
     852    bind . <KeyPress-Up> ".txt yview scroll -1 unit"
     853    bind . <KeyPress-Down> ".txt yview scroll 1 unit"
     854    bind . <KeyPress-Home> ".txt yview 0"
     855    bind . <KeyPress-End> ".txt yview end"
     856    #pack [button .but.q -text close -command "destroy ." ] -side right
     857    .txt tag config cycle -background yellow
     858    .txt tag config rval -background  green
     859    .txt tag config chi -background  green
     860}
    768861if [file exists $filename] {
    769862    set lstfp [open $filename r]
     
    787880# now start reading with updates
    788881updatetext
    789 
    790 if {$txtvw(plotvars) && ![catch {package require BLT}]} {
    791     .a.options.menu add checkbutton -label "Show Plot" -command hideplot \
    792             -variable txtvw(hideplot)
    793 }
Note: See TracChangeset for help on using the changeset viewer.