source: trunk/lstview @ 881

Last change on this file since 881 was 837, checked in by toby, 16 years ago

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