source: trunk/lstview @ 135

Last change on this file since 135 was 135, checked in by toby, 11 years ago

# on 2000/05/17 16:30:57, toby did:
change donewait to donewaitmsg to avoid conflict with pleasewait/donewait

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/05/17 16:30:57
  • Property rcs:lines set to +4 -4
  • Property rcs:rev set to 1.7
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 15.0 KB
Line 
1#!/usr/local/bin/wish
2# $Id: lstview 135 2009-12-04 23:00:59Z toby $
3set Revision {$Revision: 135 $ $Date: 2009-12-04 23:00:59 +0000 (Fri, 04 Dec 2009) $}
4# display a .LST file in a text box
5# updates 8/26 add bindings for page-up, -down, uparrow, downarrow
6# read from gzip .LST.gz files using gunzip and then append the .LST file
7# start work on plotting variables change next line to use
8set plotvars 0
9set txtvw(font) "Courier"
10set txtvw(menulength) 25
11set txtvw(stringcount) 0
12set txtvw(string) {}
13set txtvw(sum) 0
14# maximum characters to read initially from a .LST file
15set txtvw(maxchars) 1000000
16if {$tcl_platform(platform) == "windows"} {
17   # windows is slow!
18   set txtvw(maxchars) 200000
19}
20if {[set expnam [lindex $argv 0]] == ""} {
21    tk_dialog .warn Notify "No filename specified" error 0 OK
22    destroy .
23}
24set filename $expnam.LST
25set zfil {}
26set fil {}
27# is there a compressed version of the file?
28if {[file exists $filename.gz] && $tcl_platform(platform) != "windows"} {
29    set zfil [open "|gunzip < $filename.gz" r]
30}
31set box {}
32set txtvw(followcycle) 1
33
34proc waitmsg {message} {
35    set w .wait
36    # kill any window/frame with this name
37    catch {destroy $w}
38    pack [frame $w]
39    frame $w.bot -relief raised -bd 1
40    pack $w.bot -side bottom -fill both
41    frame $w.top -relief raised -bd 1
42    pack $w.top -side top -fill both -expand 1
43    label $w.msg -justify left -text $message -wrap 3i
44    catch {$w.msg configure -font \
45                -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
46    }
47    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
48    label $w.bitmap -bitmap info
49    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
50    update
51}
52
53proc donewaitmsg {} {
54    catch {destroy .wait}
55}
56waitmsg "Reading $expnam.LST, Please wait"
57
58set txtvw(runnumber) 0
59
60proc findcyc {win menu {pos 0.0}} {
61    global txtvw valuelst
62    set i 0
63    set lastpos {}
64    # loop over cycles
65    set startpos $pos
66    # get current cycle number
67    set pos [$win search -regexp -count chars \
68            {Cycle *[0-9]+ +There} $pos+1line end]
69    while {$pos != ""} {
70        # add the current cycle number to the menu
71        set line [lindex [split $pos .] 0]
72        $win tag add cycle $line.1 $line.10
73        incr i
74        set cycle {}
75        regexp {Cycle *([0-9]+) +There} [$win get $pos $line.end] x cycle
76        if {$cycle != ""} {
77            set lastpos $pos
78            set txtvw(lastcycle) "Cycle $cycle"
79            .a.goto.menu entryconfigure 1 -state normal
80            $menu insert 1 command \
81                    -font 6x12 \
82                    -label "Cycle $cycle" \
83                    -command "$win see $pos"
84            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
85        }
86        # get next cycle number
87        set nextpos [$win search -regexp -count chars \
88                {Cycle *[0-9]+ +There} $pos+1line end]
89        if {$nextpos == ""} {
90            set epos end
91        } else {
92            set epos $nextpos
93        }
94
95        # loop to highlight all Rwp & Rp values
96        set npos $startpos
97        set npos [$win search -regexp -count chars \
98                {Hstgm *[0-9]+} $npos+1line $pos]
99        while {$npos != ""} {
100            set line [lindex [split $npos .] 0]
101            set x [$win get $line.0 $line.end]
102            scan $x %s%d%s%d%d%f%f%f a hst c d e f rwp rp
103            lappend valuelst(Rwp$hst) $cycle $rwp
104            lappend valuelst(Rp$hst) $cycle $rp
105            $win tag add rval $npos $line.end
106            set npos [$win search -regexp -count chars \
107                {Hstgm *[0-9]+} $npos+1line $pos]
108        }
109        # get the CHI**2 value
110        set chipos [$win search {Reduced CHI**2 =} $pos $epos]
111        if {$chipos != ""} {
112            $win tag add chi $chipos+8chars $chipos+23chars
113            set chi [string trim [$win get $chipos+16chars $chipos+23chars]]
114            set txtvw(lastchi) "Chi**2 $chi"
115            lappend valuelst(chi2) $cycle $chi
116#           puts "$cycle $chi"
117        }
118        set sumpos [$win search {Final sum} $pos $epos]
119        if {$sumpos != ""} {
120            set finalshift [string trim [$win get $sumpos+42chars $sumpos+54chars]]
121            set txtvw(finalshift) "Shift $finalshift"
122            lappend valuelst(final_shft2) $cycle $finalshift
123        }
124        # loop to highlight all R(F**2) values
125        set npos $pos
126        set npos [$win search -regexp -count chars \
127                {Histogram *[0-9]+} $npos+1line $epos]
128        while {$npos != ""} {
129            set line [lindex [split $npos .] 0]
130            set x [$win get $line.0 $line.end]
131            catch {
132                regexp {gram *([0-9]+).*\) =(.*)} $x a hst rf2
133                lappend valuelst(Rbragg$hst) $cycle $rf2
134            }
135            $win tag add rval $npos $line.end
136            set npos [$win search -regexp -count chars \
137                    {Histogram *[0-9]+} $npos+1line $epos]
138        }
139        # get ready to loop again
140        set startpos $pos
141        set pos $nextpos
142    }
143    if {$txtvw(followcycle) && $lastpos != ""} {$win see $lastpos}
144}
145
146proc findrun {win {menu ""} {pos 0.0}} {
147    global txtvw
148    while {$pos != ""} {
149        set pos [$win search "Program GENLES" $pos+1line end]
150        if {$menu != "" && $pos != ""} {
151            incr txtvw(runnumber)
152            .a.goto.menu entryconfigure 2 -state normal
153            $menu insert 1 command \
154                    -font 6x12 \
155                    -label "Run $txtvw(runnumber)" \
156                    -command "$win see $pos"
157            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
158        }
159    }
160}
161
162
163proc findsum {win menu {pos 0.0}} {
164    global txtvw
165    set fpos [$win search {Final sum(} $pos+1line end]
166    if {$fpos == ""} return
167    set pos [$win search {Summary table} $fpos+1line end]
168    while {$pos != ""} {
169        set line [lindex [split $fpos .] 0]
170        set x [$win get $line.0 $line.end]
171        regexp {cycle *([0-9]+) is} $x a lstcyc
172        incr txtvw(sum)
173        .a.goto.menu entryconfigure 3 -state normal
174        $menu insert 1 command \
175                -font 6x12 \
176                -label "Summary $txtvw(sum)" \
177                -command "$win see $pos"
178        if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
179        set line [lindex [split $pos .] 0]
180        incr line
181        set ncyc [string range [string trim [$win get $line.0 $line.end]] end end]
182        while {[set x [$win get $line.0 $line.end]] != ""} {
183            incr line
184            set lbl [string trim [string range $x 0 8]]
185            if {$lbl != "Name" && [string range $x 0 0] != "1"} {
186                # are there values here?
187                set len [llength [set vals [string range $x 9 end]]]
188                foreach val $vals {
189                    if {[scan $val %f s] == 1} {
190                        lappend valuelst($lbl) [expr $lstcyc - $ncyc +1] $s
191                    }
192                }
193            }
194        }
195        set fpos [$win search {Final sum(} $pos+1line end]
196        if {$fpos == ""} return
197        set pos [$win search {Summary table} $fpos+1line end]
198    }
199}
200
201proc findsetstring {win string {menu ""} {pos 0.0}} {
202    global txtvw
203    while {$pos != ""} {
204        set pos [$win search -regexp -count chars \
205                $string $pos+1line end]
206        if {$menu != "" && $pos != ""} {
207            $win tag add found $pos "$pos + $chars chars"
208            incr txtvw(stringcount)
209            $menu insert 1 command \
210                    -font 6x12 \
211                    -label "loc #$txtvw(stringcount)" \
212                    -command "$win see $pos"
213            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
214        }
215    }
216}
217
218proc setsearchstring { } {
219    global txtvw
220    set txtvw(stringcount) 0
221    .a.goto.menu entryconfigure 5 -state disabled -label ""
222    .a.goto.menu.str delete 1 end
223    catch {.txt tag delete found}
224    .txt tag config found -foreground red
225    if {[string trim $txtvw(entry)] == ""} {
226        set txtvw(string) {}
227        return
228    } else {
229        set txtvw(string) [string trim $txtvw(entry)]
230    }
231    findsetstring .txt $txtvw(string) .a.goto.menu.str
232    if {$txtvw(stringcount) > 0} {
233        .a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
234    }
235}
236
237proc updatetext {fil {repeat 1}} {
238    global txtvw filename tcl_platform
239    if $repeat {after 5000 updatetext $fil}
240    set txt [read $fil]
241    if {$txt == ""} return
242    .txt config -state normal
243    set oldend [.txt index end]
244    # truncate the text if too long
245    if {[string length $txt] > $txtvw(maxchars) && $repeat == 0} {
246        set beg [expr [string length $txt] - $txtvw(maxchars)]
247        .txt insert end "(first $beg characters in file skipped)\n"
248        .txt insert end [string range $txt $beg end]
249    } else {
250        .txt insert end $txt
251    }
252    # don't disable in Win as this prevents the highlighting of selected text
253    if {$tcl_platform(platform) != "windows"} {
254        .txt config -state disabled
255    }
256    update idletasks
257    findrun .txt .a.goto.menu.run $oldend
258    update
259    findcyc .txt .a.goto.menu.cyc $oldend
260    update
261    findsum .txt .a.goto.menu.sum $oldend
262    update
263   
264    if {$txtvw(string) != ""} {
265        findsetstring .txt $txtvw(string) .a.goto.menu.str $oldend
266        if {$txtvw(stringcount) > 0} {
267            .a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
268        }
269    }
270}
271proc getstring {} {
272    catch {destroy .str}
273    toplevel .str
274    grab .str
275    pack [frame .str.1] -side top
276    pack [frame .str.2] -side top
277    pack [label .str.1.l -text "Search String"] -side left
278    pack [entry .str.1.e -textvariable txtvw(entry) -width 12] -side left
279    pack [label .str.1.2 -text "(regexp)"] -side left
280    pack [button .str.2.ok -text "Search" -command \
281            "setsearchstring; destroy .str" ] -side left
282    pack [button .str.2.q -text "Quit" -command \
283            "destroy .str" ] -side left
284# bind to RETURN here   
285#    bind .str
286}
287
288proc findstring {win str1 {str2 ""}} {
289    set pos [$win search -backwards $str1 end]
290    if {$pos == "" && $str2 != ""} {
291        set pos [$win search -backwards $str2 end]
292    }
293    if {$pos == ""} return
294    $win see $pos
295}
296
297proc SaveOptions {} {
298    global txtvw
299    set fp [open [file join ~ .gsas_config] a]
300    puts $fp "set txtvw(followcycle) $txtvw(followcycle)"
301    puts $fp "set txtvw(font) [list $txtvw(font)]"
302    close $fp
303}
304
305proc aboutgsas {} {
306    global Revision
307    tk_dialog .warn About "
308GSAS\n\
309A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
310LSTVIEW\nB. Toby, NIST\nNot subject to copyright\n\n\
311$Revision\n\
312" {} 0 OK
313}
314
315#----------------------------------------------------------------
316# where are we?
317set expgui(script) [info script]
318# translate links -- go six levels deep
319foreach i {1 2 3 4 5 6} {
320    if {[file type $expgui(script)] == "link"} {
321        set link [file readlink $expgui(script)]
322        if { [file  pathtype  $link] == "absolute" } {
323h           set expgui(script) $link
324        } {
325            set expgui(script) [file dirname $expgui(script)]/$link
326        }
327    } else {
328        break
329    }
330}
331
332# fixup relative paths
333if {[file pathtype $expgui(script)] == "relative"} {
334    set expgui(script) [file join [pwd] $expgui(script)]
335}
336set expgui(scriptdir) [file dirname $expgui(script) ]
337# override options with locally defined values
338if [file exists [file join $expgui(scriptdir) localconfig]] {
339    source [file join $expgui(scriptdir) localconfig]
340}
341if [file exists [file join ~ .gsas_config]] {
342    source [file join ~ .gsas_config]
343}
344
345
346set txtvw(lastchi) {}
347set txtvw(lastcycle) {}
348set txtvw(finalshift) {}
349text .txt -width 100 -wrap none \
350        -yscrollcommand ".yscroll set" \
351        -xscrollcommand ".xscroll set"
352if {$tcl_version >= 8.0} {.txt config -font $txtvw(font)}
353scrollbar .yscroll -command ".txt yview"
354scrollbar .xscroll -command ".txt xview" -orient horizontal
355grid .xscroll -column 0 -row 2 -sticky ew
356grid .txt -column 0 -row 1 -sticky nsew
357grid .yscroll -column 1 -row 1 -sticky ns
358grid columnconfigure . 0 -weight 1
359grid rowconfigure . 1 -weight 1
360wm title . "View $filename"
361wm iconname . $filename
362grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew
363pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \
364            -side left
365menu .a.file.menu
366.a.file.menu add command -label Exit -command "destroy ."
367
368# windows copy command. Should not be needed in X windows
369if {$tcl_platform(platform) == "windows"} {
370    pack [menubutton .a.edit -text Edit -underline 0 -menu .a.edit.menu] \
371            -side left
372    menu .a.edit.menu
373    .a.edit.menu add command -label copy \
374            -command {catch {clipboard append [selection get]}}
375}
376
377pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \
378        -side left
379menu .a.goto.menu
380.a.goto.menu add cascade -label "Cycle #"  -menu .a.goto.menu.cyc \
381        -state disabled
382menu .a.goto.menu.cyc
383.a.goto.menu add cascade -label "Refinement Run #"  -menu .a.goto.menu.run \
384        -state disabled
385menu .a.goto.menu.run
386.a.goto.menu add cascade -label "Summary #"  -menu .a.goto.menu.sum \
387        -state disabled
388menu .a.goto.menu.sum
389.a.goto.menu add command -label "Set Search String" -command getstring
390#pack [button .but.lbl1 -text "Set Search String" -command getstring] -side left
391.a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
392menu .a.goto.menu.str
393
394pack [menubutton .a.options -text "Options" -underline 0 \
395        -menu .a.options.menu] \
396            -side left
397menu .a.options.menu
398.a.options.menu  add checkbutton -label "Auto Advance" -variable txtvw(followcycle)
399
400if {$tcl_version >= 8.0} {
401    .a.options.menu add cascade -label Font -menu .a.options.menu.font
402    menu .a.options.menu.font
403    foreach size {5 6 7 8 9 10 11 12 13 14 15 16} {
404        .a.options.menu.font add command -label "Courier $size" \
405                -command "set txtvw(font) \"Courier $size\"; \
406                .txt config -font \$txtvw(font)"
407    }
408}
409
410.a.options.menu add command -label "Save Options" -underline 1 \
411        -command "SaveOptions"
412
413if {$plotvars && ![catch {package require BLT}]} {
414    pack [menubutton .a.plot -text "Plot" -underline 0 -menu .a.plot.menu ] \
415            -side left
416    menu .a.plot.menu -postcommand postingvars
417    .a.plot.menu add cascade -label "Variable(s)" -menu .a.plot.menu.vars
418    menu .a.plot.menu.vars
419}
420
421proc postingvars {} {
422    global valuelst
423    .a.plot.menu.vars delete 1 end
424    foreach var [lsort [array names valuelst]] {
425        .a.plot.menu.vars add checkbutton -label $var -command plotvars \
426                -variable plotlist($var)
427    }
428}
429proc plotvars {} {
430    global valuelst plotlist
431    catch {
432        toplevel .plot
433        pack [graph .plot.g]
434        Blt_ZoomStack .plot.g
435        Blt_ActiveLegend .plot.g
436        .plot.g config -title ""
437        .plot.g xaxis config -title "cycle"
438        .plot.g yaxis config -title ""
439    }
440    raise .plot
441    .plot.g element delete *
442    set num 0
443    foreach var [lsort [array names valuelst]] {
444        if $plotlist($var) {
445            incr num
446            set color [lindex {red green blue magenta cyan yellow} [expr $num % 6]]
447            .plot.g element create "$var" -data $valuelst($var) -color $color
448        }
449    }
450}
451
452pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
453menu .a.help.menu
454.a.help.menu add command -command aboutgsas -label "About"
455
456grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew
457pack [label .but.lbl2 -textvariable txtvw(lastcycle) -relief sunken] -side left
458pack [label .but.lbl3 -textvariable txtvw(lastchi) -relief sunken] -side left
459pack [label .but.lbl4 -textvariable txtvw(finalshift) -relief sunken] -side left
460bind all <Control-KeyPress-c> {destroy .}
461bind . <KeyPress-Prior> ".txt yview scroll -1 page"
462bind . <KeyPress-Next> ".txt yview scroll 1 page"
463bind . <KeyPress-Up> ".txt yview scroll -1 unit"
464bind . <KeyPress-Down> ".txt yview scroll 1 unit"
465bind . <KeyPress-Home> ".txt yview 0"
466bind . <KeyPress-End> ".txt yview end"
467#pack [button .but.q -text close -command "destroy ." ] -side right
468.txt tag config cycle -background yellow
469.txt tag config rval -background  green
470.txt tag config chi -background  green
471if [file exists $filename] {
472    set fil [open $filename r]
473} else {
474    # create a file if it does not exist
475    set fil [open $filename a+]
476    close $fil
477    set fil [open $filename r]
478}
479donewaitmsg
480# read a file compressed file
481if {$zfil != ""} {updatetext $zfil 0; close $zfil}
482# read the initial file
483updatetext $fil 0
484# now start reading with updates
485updatetext $fil 1
Note: See TracBrowser for help on using the repository browser.