source: trunk/lstview @ 744

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

# on 2003/11/13 16:04:10, toby did:
Resize window for OSX

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