source: trunk/lstview @ 830

Last change on this file since 830 was 799, checked in by toby, 16 years ago

# on 2004/09/20 15:26:54, toby did:
add "package require Tk" for starkit use
  • Property rcs:author set to toby
  • Property rcs:date set to 2004/09/20 15:26:54
  • Property rcs:lines set to +3 -2
  • Property rcs:rev set to 1.17
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 22.2 KB
Line 
1#!/bin/sh
2# the next line restarts this script using wish found in the path\
3exec wish "$0" "$@"
4# If this does not work, change the #!/usr/bin/wish line below
5# to reflect the actual wish location and delete all preceeding lines
6#
7# (delete here and above)
8#!/usr/bin/wish
9# $Id: lstview 799 2009-12-04 23:12:13Z toby $
10set Revision {$Revision: 799 $ $Date: 2009-12-04 23:12:13 +0000 (Fri, 04 Dec 2009) $}
11# display a .LST file in a text box
12# updates 8/26 add bindings for page-up, -down, uparrow, downarrow
13# read from gzip .LST.gz files using gunzip and then append the .LST file
14# start work on plotting variables change next line to use
15package require Tk
16set txtvw(plotvars) 1
17set txtvw(font) "Courier"
18set txtvw(menulength) 25
19set txtvw(stringcount) 0
20set txtvw(string) {}
21set txtvw(sum) 0
22set txtvw(hideplot) 0
23# maximum characters to read initially from a .LST file
24set txtvw(maxchars) 1000000
25if {$tcl_platform(platform) == "windows"} {
26   # windows is slow!
27   set txtvw(maxchars) 200000
28}
29if {[set expnam [lindex $argv 0]] == ""} {
30    tk_dialog .warn Notify "No filename specified" error 0 OK
31    destroy .
32}
33set filename $expnam.LST
34set zfil {}
35set lstfp {}
36# is there a compressed version of the file?
37if {[file exists $filename.gz] && $tcl_platform(platform) != "windows"} {
38    set zfil [open "|gunzip < $filename.gz" r]
39}
40set box {}
41set txtvw(followcycle) 1
42
43proc waitmsg {message} {
44    set w .wait
45    # kill any window/frame with this name
46    catch {destroy $w}
47    pack [frame $w]
48    frame $w.bot -relief raised -bd 1
49    pack $w.bot -side bottom -fill both
50    frame $w.top -relief raised -bd 1
51    pack $w.top -side top -fill both -expand 1
52    label $w.msg -justify left -text $message -wrap 3i
53    catch {$w.msg configure -font \
54                -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
55    }
56    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
57    label $w.bitmap -bitmap info
58    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
59    update
60}
61
62proc donewaitmsg {} {
63    catch {destroy .wait}
64}
65waitmsg "Reading $expnam.LST, Please wait"
66
67set txtvw(runnumber) 0
68
69proc findcyc {win menu {pos 0.0}} {
70    global txtvw
71    global trackinglist
72    set i 0
73    set lastpos {}
74    # loop over cycles
75    set startpos $pos
76    # get current cycle number
77    set pos [$win search -regexp -count chars \
78            {Cycle *[0-9]+ +There} $pos+1line end]
79    while {$pos != ""} {
80        # add the current cycle number to the menu
81        set line [lindex [split $pos .] 0]
82        $win tag add cycle $line.1 $line.10
83        incr i
84        set cycle {}
85        regexp {Cycle *([0-9]+) +There} [$win get $pos $line.end] x cycle
86        if {$cycle != ""} {
87            set lastpos $pos
88            set txtvw(lastcycle) "Cycle $cycle"
89            .a.goto.menu entryconfigure 1 -state normal
90            $menu insert 1 command \
91                    -font 6x12 \
92                    -label "Cycle $cycle" \
93                    -command "$win see $pos"
94            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
95        }
96        # get next cycle number
97        set nextpos [$win search -regexp -count chars \
98                {Cycle *[0-9]+ +There} $pos+1line end]
99        if {$nextpos == ""} {
100            set epos end
101        } else {
102            set epos $nextpos
103        }
104
105        # loop to highlight all Rwp & Rp values
106        set npos $startpos
107        set npos [$win search -regexp -count chars \
108                {Hstgm *[0-9]+} $npos+1line $pos]
109        while {$npos != ""} {
110            set line [lindex [split $npos .] 0]
111            set x [$win get $line.0 $line.end]
112            scan $x %s%d%s%d%d%f%f%f a hst c d e f rwp rp
113            foreach d {Rwp Rp} value "$rwp $rp" {
114                set v ${d}_$hst
115                set var tracklist_$v
116                set trackinglist($v) "$d hist $hst"
117                global $var
118                set ${var}($cycle) $value
119            }
120            $win tag add rval $npos $line.end
121            set npos [$win search -regexp -count chars \
122                {Hstgm *[0-9]+} $npos+1line $pos]
123        }
124        # get the CHI**2 value
125        set chipos [$win search {Reduced CHI**2 =} $pos $epos]
126        if {$chipos != ""} {
127            $win tag add chi $chipos+8chars $chipos+23chars
128            set chi [string trim [$win get $chipos+16chars $chipos+23chars]]
129            set txtvw(lastchi) "Chi**2 $chi"
130            set var tracklist_chi2
131            set trackinglist(chi2) "red. Chi squared"
132            global $var
133            set ${var}($cycle) $chi
134        }
135        set sumpos [$win search {Final variable sum} $pos $epos]
136        if {$sumpos != ""} {
137            set line [$win get $sumpos "$sumpos lineend"]
138            regexp {: *([0-9\.]+) } $line a finalshift
139            set txtvw(finalshift) "Shift/SU $finalshift"
140            set var tracklist_fshft2
141            set trackinglist(fshft2) "Sum((shft/su)**2)"
142            global $var
143            set ${var}($cycle) $finalshift
144        }
145        # loop to highlight all R(F**2) values
146        set npos $pos
147        set npos [$win search -regexp -count chars \
148                {Histogram *[0-9]+} $npos+1line $epos]
149        while {$npos != ""} {
150            set line [lindex [split $npos .] 0]
151            set x [$win get $line.0 $line.end]
152            catch {
153                regexp {gram *([0-9]+).*\) =(.*)} $x a hst rf2
154                set var tracklist_Rbragg_$hst
155                set trackinglist(Rbragg_$hst) "R(Bragg) hist $hst"
156                global $var
157                set ${var}($cycle) $rf2
158            }
159            $win tag add rval $npos $line.end
160            set npos [$win search -regexp -count chars \
161                    {Histogram *[0-9]+} $npos+1line $epos]
162        }
163        # get ready to loop again
164        set startpos $pos
165        set pos $nextpos
166    }
167    if {$txtvw(followcycle) && $lastpos != ""} {$win see $lastpos}
168}
169
170proc findrun {win {menu ""} {pos 0.0}} {
171    global txtvw
172    while {$pos != ""} {
173        set pos [$win search "Program GENLES" $pos+1line end]
174        if {$menu != "" && $pos != ""} {
175            incr txtvw(runnumber)
176            .a.goto.menu entryconfigure 2 -state normal
177            $menu insert 1 command \
178                    -font 6x12 \
179                    -label "Run $txtvw(runnumber)" \
180                    -command "$win see $pos"
181            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
182        }
183    }
184}
185
186
187proc findsum {win menu {pos 0.0}} {
188    global txtvw
189    global trackinglist
190    set pos [$win search {Summary table} $pos+1line end]
191    # found a summary, now search back for the cycle number
192    while {$pos != ""} {
193        # add it to the menu
194        incr txtvw(sum)
195        .a.goto.menu entryconfigure 3 -state normal
196        $menu insert 1 command \
197                -font 6x12 \
198                -label "Summary $txtvw(sum)" \
199                -command "$win see $pos"
200        if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
201       
202        set npos [$win index "$pos+1line linestart"]
203        set fpos [$win index $pos-1line]
204       
205        if {!$txtvw(plotvars)} continue
206
207        # parse outs the last listed cycle number
208        set lstcyc {}
209        set fpos [$win search -backwards -nocase -regexp {cycle *[0-9]+ } $pos]
210        if {$fpos != ""} {
211            set end [$win index "$fpos lineend"]
212            set lstcyc [lindex [$win get $fpos $end] 1]
213        }
214        # get the cycle offset
215        set ncyc [lindex [$win get $npos "$npos lineend"] end]
216        set npos [$win index "$npos+1line linestart"]
217       
218        set end [$win index end]
219        # now read through the summary table
220        while {![string match *Fraction* \
221                [set line [$win get $npos "$npos lineend"]] \
222                ]} {
223            set v1 [string range $line 1 9]
224            # make a name without spaces
225            set v "zz$v1"
226            regsub -all " " $v "_" v
227            set var tracklist_$v
228            catch {
229                # are there any invalid numbers in the list?
230                foreach value [string range $line 10 end] {
231                    expr [string trim $value]
232                }
233
234                # passed syntax check, add to list
235                set trackinglist($v) "shift/SU $v1"
236                global $var
237               
238                set i 0
239                foreach value [string range $line 10 end] {
240                    incr i
241                    set cycle [expr {$lstcyc - $ncyc + $i}]
242                    set ${var}($cycle) $value
243                }
244            }
245            set npos [$win index "$npos+1line linestart"]
246            if {$npos == $end} break
247        }
248        set pos [$win search {Summary table} $npos+1line end]
249    }
250}
251
252proc findsetstring {win string {menu ""} {pos 0.0}} {
253    global txtvw
254    while {$pos != ""} {
255        set pos [$win search -regexp -count chars \
256                $string $pos+1line end]
257        if {$menu != "" && $pos != ""} {
258            $win tag add found $pos "$pos + $chars chars"
259            incr txtvw(stringcount)
260            $menu insert 1 command \
261                    -font 6x12 \
262                    -label "loc #$txtvw(stringcount)" \
263                    -command "$win see $pos"
264            if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
265        }
266    }
267}
268
269proc setsearchstring { } {
270    global txtvw
271    set txtvw(stringcount) 0
272    .a.goto.menu entryconfigure 5 -state disabled -label ""
273    .a.goto.menu.str delete 1 end
274    catch {.txt tag delete found}
275    .txt tag config found -foreground red
276    if {[string trim $txtvw(entry)] == ""} {
277        set txtvw(string) {}
278        return
279    } else {
280        set txtvw(string) [string trim $txtvw(entry)]
281    }
282    findsetstring .txt $txtvw(string) .a.goto.menu.str
283    if {$txtvw(stringcount) > 0} {
284        .a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
285    }
286}
287
288proc updatetext {"fil {}"} {
289    global txtvw filename tcl_platform lstfp
290    set repeat 0
291    if {$fil == ""} {
292        set repeat 1
293        after 5000 updatetext
294        set fil $lstfp
295    }
296    set txt {}
297    catch {set txt [read $fil]}
298    if {$txt == ""} return
299    .txt config -state normal
300    set oldend [.txt index end]
301    # truncate the text if too long
302    if {[string length $txt] > $txtvw(maxchars) && $repeat == 0} {
303        set beg [expr [string length $txt] - $txtvw(maxchars)]
304        .txt insert end "(first $beg characters in file skipped)\n"
305        .txt insert end [string range $txt $beg end]
306    } else {
307        .txt insert end $txt
308    }
309    # don't disable in Win as this prevents the highlighting of selected text
310    if {$tcl_platform(platform) != "windows"} {
311        .txt config -state disabled
312    }
313    update idletasks
314    findrun .txt .a.goto.menu.run $oldend
315    update
316    findcyc .txt .a.goto.menu.cyc $oldend
317    update
318    findsum .txt .a.goto.menu.sum $oldend
319    update
320   
321    if {$txtvw(string) != ""} {
322        findsetstring .txt $txtvw(string) .a.goto.menu.str $oldend
323        if {$txtvw(stringcount) > 0} {
324            .a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
325        }
326    }
327}
328
329proc GetSearchString {} {
330    catch {destroy .str}
331    toplevel .str
332    grab .str
333    pack [frame .str.1] -side top
334    pack [frame .str.2] -side top
335    pack [label .str.1.l -text "Search String"] -side left
336    pack [entry .str.1.e -textvariable txtvw(entry) -width 12] -side left
337    pack [label .str.1.2 -text "(regexp)"] -side left
338    pack [button .str.2.ok -text "Search" -command \
339            "setsearchstring; destroy .str" ] -side left
340    pack [button .str.2.q -text "Quit" -command \
341            "destroy .str" ] -side left
342# bind to RETURN here   
343#    bind .str
344}
345
346proc findstring {win str1 {str2 ""}} {
347    set pos [$win search -backwards $str1 end]
348    if {$pos == "" && $str2 != ""} {
349        set pos [$win search -backwards $str2 end]
350    }
351    if {$pos == ""} return
352    $win see $pos
353}
354
355proc SaveOptions {} {
356    global txtvw tcl_platform
357    if {$tcl_platform(platform) == "windows"} {
358        set fp [open c:/gsas.config a]
359    } else {
360        set fp [open [file join ~ .gsas_config] a]
361    }
362    puts $fp "# LSTVIEW saved options from [clock format [clock ticks]]"
363    puts $fp "set txtvw(followcycle) [list $txtvw(followcycle)]"
364    puts $fp "set txtvw(font) [list $txtvw(font)]"
365    close $fp
366}
367
368proc aboutgsas {} {
369    global Revision
370    tk_dialog .warn About "
371GSAS\n\
372A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
373LSTVIEW\nB. Toby, NIST\nNot subject to copyright\n\n\
374$Revision\n\
375" {} 0 OK
376}
377
378#----------------------------------------------------------------
379# where are we?
380set expgui(script) [info script]
381# translate links -- go six levels deep
382foreach i {1 2 3 4 5 6} {
383    if {[file type $expgui(script)] == "link"} {
384        set link [file readlink $expgui(script)]
385        if { [file  pathtype  $link] == "absolute" } {
386h           set expgui(script) $link
387        } {
388            set expgui(script) [file dirname $expgui(script)]/$link
389        }
390    } else {
391        break
392    }
393}
394
395# fixup relative paths
396if {[file pathtype $expgui(script)] == "relative"} {
397    set expgui(script) [file join [pwd] $expgui(script)]
398}
399set expgui(scriptdir) [file dirname $expgui(script) ]
400set expgui(docdir) [file join $expgui(scriptdir) doc]
401# location for web pages, if not found locally
402set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
403
404source [file join $expgui(scriptdir) gsascmds.tcl]
405source [file join $expgui(scriptdir) opts.tcl]
406
407# override options with locally defined values
408set filelist [file join $expgui(scriptdir) localconfig]
409if {$tcl_platform(platform) == "windows"} {
410    lappend filelist "c:/gsas.config"
411} else {
412    lappend filelist [file join ~ .gsas_config]
413}
414if {[catch {
415    foreach file $filelist {
416        if [file exists $file] {source $file}
417    }
418} errmsg]} {
419    set msg "Error reading file $file (aka [file nativename $file]): $errmsg"
420    MyMessageBox -parent . -title "Customize warning" \
421        -message $msg -icon warning -type Ignore -default ignore \
422        -helplink "expguierr.html Customizewarning"
423}
424
425set txtvw(lastchi) {}
426set txtvw(lastcycle) {}
427set txtvw(finalshift) {}
428text .txt -width 100 -wrap none \
429        -yscrollcommand ".yscroll set" \
430        -xscrollcommand ".xscroll set" 
431if {$tcl_version >= 8.0} {.txt config -font $txtvw(font)}
432scrollbar .yscroll -command ".txt yview"
433scrollbar .xscroll -command ".txt xview" -orient horizontal
434grid .xscroll -column 0 -row 2 -sticky ew
435grid .txt -column 0 -row 1 -sticky nsew
436grid .yscroll -column 1 -row 1 -sticky ns
437grid columnconfigure . 0 -weight 1
438grid rowconfigure . 1 -weight 1
439wm title . "View $filename"
440wm iconname . $filename
441grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew
442pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \
443            -side left
444menu .a.file.menu
445.a.file.menu add command -label "Delete $filename" -command KillLSTfile
446.a.file.menu add command -label "Trim $filename" -command TrimLSTfile
447.a.file.menu add command -label Exit -command "destroy ."
448
449# windows copy command. Should not be needed in X windows
450if {$tcl_platform(platform) == "windows"} {
451    pack [menubutton .a.edit -text Edit -underline 0 -menu .a.edit.menu] \
452            -side left
453    menu .a.edit.menu
454    .a.edit.menu add command -label copy \
455            -command {catch {clipboard append [selection get]}}
456}
457
458pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \
459        -side left
460menu .a.goto.menu
461.a.goto.menu add cascade -label "Cycle #"  -menu .a.goto.menu.cyc \
462        -state disabled
463menu .a.goto.menu.cyc
464.a.goto.menu add cascade -label "Refinement Run #"  -menu .a.goto.menu.run \
465        -state disabled
466menu .a.goto.menu.run
467.a.goto.menu add cascade -label "Summary #"  -menu .a.goto.menu.sum \
468        -state disabled
469menu .a.goto.menu.sum
470.a.goto.menu add command -label "Set Search String" -command GetSearchString
471.a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
472menu .a.goto.menu.str
473
474pack [menubutton .a.options -text "Options" -underline 0 \
475        -menu .a.options.menu] \
476            -side left
477menu .a.options.menu
478.a.options.menu  add checkbutton -label "Auto Advance" -variable txtvw(followcycle) 
479
480if {$tcl_version >= 8.0} {
481    pack [label .a.fontl -text "  Font:"] -side left
482    set fontbut [tk_optionMenu .a.fontb txtvw(font) ""]
483    pack .a.fontb -side left
484    $fontbut delete 0 end
485    foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
486        $fontbut add command -label "Courier $f" -font "Courier $f"\
487                -command "set txtvw(font) \"Courier $f\"; \
488                .txt config -font \$txtvw(font)"
489    }
490}
491
492.a.options.menu add command -label "Save Options" -underline 1 \
493        -command "SaveOptions"
494
495proc postingvars {} {
496    global trackinglist
497    eval destroy [winfo children .plot.c.f]
498    set i 0
499    foreach var [lsort [array names trackinglist]] {
500        grid [checkbutton .plot.c.f.$i -text $trackinglist($var) \
501                -pady 0 -command plotvars -variable plotlist($var)] \
502                -column 0 -row [incr i] -sticky w
503    }
504}
505
506proc makeplot {} {
507    # handle Tcl/Tk v8+ where BLT is in a namespace
508    #  use the command so that it is loaded
509    catch {blt::graph}
510    catch {
511        namespace import blt::graph
512    }
513    toplevel .plot
514    grid [graph .plot.g] -column 0 -row 0 -sticky news
515    canvas .plot.c \
516            -scrollregion {0 0 5000 1000} -width 40 -height 250 \
517            -yscrollcommand ".plot.s set"
518    scrollbar .plot.s -command ".plot.c yview"
519    grid .plot.c -column 1 -row 0 -sticky news
520        frame .plot.c.f -class SmallFont
521    .plot.c create window 0 0 -anchor nw -window .plot.c.f
522    grid columnconfigure .plot 0 -weight 1
523    grid rowconfigure .plot 0 -weight 1
524    Blt_ZoomStack .plot.g
525    Blt_ActiveLegend .plot.g
526    .plot.g config -title ""
527    .plot.g xaxis config -title "cycle"
528    .plot.g yaxis config -title ""
529    wm iconify .plot
530}
531
532proc plotvars {} {
533    raise .plot
534    eval .plot.g element delete [.plot.g element names]
535    global trackinglist
536    global plotlist
537    set num 0
538    foreach v [lsort [array names trackinglist]] {
539        set datalist {}
540        if $plotlist($v) {
541            incr num
542            set var tracklist_$v
543            global $var
544            set color [lindex {red green blue magenta cyan yellow} \
545                    [expr $num % 6]]
546            foreach n [lsort -integer [array names $var]] {
547                lappend datalist $n [set ${var}($n)]
548            }
549            .plot.g element create "$var" -data $datalist -color $color \
550                    -label $trackinglist($v)
551        }
552    }
553}
554
555proc hideplot {} {
556    global txtvw
557    if {![winfo exists .plot]} {
558        makeplot
559        postingvars
560    }
561    # hide or show the plot
562    if {$txtvw(hideplot) != 1} {
563        wm iconify .plot
564    } else {
565        wm deiconify .plot
566        update idletasks
567        # size the box width & scrollregion height
568        set sizes [grid bbox .plot.c.f]
569        .plot.c config -scrollregion $sizes -width [lindex $sizes 2]
570        # is the scroll bar needed?
571        if {[winfo height .plot.c] >= [lindex $sizes 3]} {
572            grid forget .plot.s
573        } else {
574            grid .plot.s -column 2 -row 0 -sticky news
575        }
576    }
577}
578
579
580proc KillLSTfile {} {
581    global filename lstfp tcl_platform
582    # confirm the delete
583    set ans [tk_dialog .warn Notify \
584            "OK to delete the contents of $filename?" "" 0 Yes No]
585    if {$ans != 0} return
586    # stop the updates
587    after cancel updatetext
588    # zero out the file
589    close $lstfp
590    set lstfp [open $filename w+]
591    .txt config -state normal
592    .txt delete 0.0 end
593    ClearMenus
594    updatetext
595}
596
597proc TrimLSTfile {} {
598    global filename lstfp tcl_platform txtvw
599   
600    # get the last refinement run position
601    set loc {}
602    # get the starting location
603    catch {
604        set loc [lindex [.a.goto.menu.run entrycget 1 -command] end]
605        set loc [.txt index "$loc - 2lines"]
606        set txtvw(delete) [expr {100.*$loc/[.txt index end]}]
607        .txt see $loc
608
609    }
610    if {$loc == ""} {
611        set txtvw(delete) [expr {50.* \
612                ([lindex [.txt yview] 0] + [lindex [.txt yview] 1])}]
613        set loc [expr {int(0.5+ $txtvw(delete) * [.txt index end]/100.)}].0
614    }
615
616    catch {toplevel .trim}
617    eval destroy [winfo children .trim]
618    wm title .trim "Trim $filename"
619    pack [label .trim.0 -text "File $filename has [expr {int([.txt index end])}] lines total."] -side top
620    pack [label .trim.1 -text "Select percentage of file to delete."] \
621            -anchor w -side top
622   
623    # set the slider resolution so that 1 division is on the
624    # order of 1-2 lines
625    set res .5
626    while {$res > 200./[.txt index end] && $res > 0.01} {
627        if {[string match *5* $res]} {
628            set res [expr $res/2.5]
629        } else {
630            set res [expr $res/2.]
631        }
632    }
633    pack [scale .trim.2 -command HighlightText -orient horizontal \
634            -variable txtvw(delete) \
635            -resolution $res] -expand yes -fill x
636    pack [frame .trim.3]
637    pack [button .trim.3.a -text Trim \
638            -command {DeleteSelectedText; destroy .trim} \
639            ] -side left
640    pack [button .trim.3.b -text Cancel -command {destroy .trim} ] -side left
641    # create a binding so that we can click on the text box
642    .txt tag delete b
643    .txt tag add b 0.0 end
644    .txt tag bind b <1> "ClickHighlightText %x %y"
645    # show the region pending delete
646    .txt tag delete pend
647    .txt tag add pend 0.0 $loc
648    .txt tag config pend -foreground grey
649}
650
651proc ClickHighlightText {x y} {
652    global txtvw
653    if {![winfo exists .trim]} return
654    set loc [.txt index "@$x,$y linestart"]
655    set txtvw(delete) [expr {100.*$loc/[.txt index end]}]
656    .txt tag delete pend
657    .txt tag add pend 0.0 $loc
658    .txt tag config pend -foreground grey
659}
660
661proc DeleteSelectedText {} {
662    global filename lstfp
663    .txt config -state normal
664    eval .txt delete [.txt tag nextrange pend 0.0]
665    # stop the updates
666    after cancel updatetext
667    # zero out the file
668    close $lstfp
669    set lstfp [open $filename w+]
670    puts $lstfp [.txt get 0.0 end]
671    .txt delete 0.0 end
672    ClearMenus
673    seek $lstfp 0
674    updatetext
675}
676
677proc ClearMenus {} {
678    foreach m {str run cyc sum} {
679        .a.goto.menu.$m delete 1 end
680    }
681    foreach num {1 2 3 5} {
682        .a.goto.menu entryconfigure $num -state disabled
683    }
684    global txtvw
685    set txtvw(runnumber) 0
686    set txtvw(sum) 0
687}
688
689proc HighlightText {args} {
690    global txtvw
691    set loc [expr {int(0.5+ $txtvw(delete) * [.txt index end]/100.)}].0
692    .txt tag delete pend
693    .txt tag add pend 0.0 $loc
694    .txt tag config pend -foreground grey
695    .txt see $loc
696}
697
698pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
699menu .a.help.menu
700.a.help.menu add command -command "MakeWWWHelp expgui.html LSTVIEW" \
701    -label "Web page"
702if {![catch {package require tkcon} errmsg]} {
703    .a.help.menu add command -label "Open console" -command {tkcon show}
704} elseif {$tcl_platform(platform) == "windows"} {
705    .a.help.menu add command -label "Open console" -command {console show}
706}
707.a.help.menu add command -command aboutgsas -label "About"
708
709grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew
710pack [label .but.lbl2 -textvariable txtvw(lastcycle) \
711        -relief sunken -bd 2] -side left
712pack [label .but.lbl3 -textvariable txtvw(lastchi) \
713        -relief sunken -bd 2] -side left
714pack [label .but.lbl4 -textvariable txtvw(finalshift) \
715        -relief sunken -bd 2] -side left
716bind all <Control-KeyPress-c> {destroy .}
717bind . <KeyPress-Prior> ".txt yview scroll -1 page"
718bind . <KeyPress-Next> ".txt yview scroll 1 page"
719bind . <KeyPress-Up> ".txt yview scroll -1 unit"
720bind . <KeyPress-Down> ".txt yview scroll 1 unit"
721bind . <KeyPress-Home> ".txt yview 0"
722bind . <KeyPress-End> ".txt yview end"
723#pack [button .but.q -text close -command "destroy ." ] -side right
724.txt tag config cycle -background yellow
725.txt tag config rval -background  green
726.txt tag config chi -background  green
727if [file exists $filename] {
728    set lstfp [open $filename r]
729} else {
730    # create a file if it does not exist
731    set lstfp [open $filename w+]
732}
733donewaitmsg
734# seems to be needed in OSX
735update
736wm geom . [winfo reqwidth .]x[winfo reqheight .]
737#
738
739# read a file compressed file, if present
740if {$zfil != ""} {
741    updatetext $zfil
742    close $zfil
743}
744# read the initial file
745updatetext $lstfp
746# now start reading with updates
747updatetext
748
749if {$txtvw(plotvars) && ![catch {package require BLT}]} {
750    .a.options.menu add checkbutton -label "Show Plot" -command hideplot \
751            -variable txtvw(hideplot)
752}
Note: See TracBrowser for help on using the repository browser.