source: trunk/lstview @ 914

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

# on 2008/04/15 17:26:54, toby did:
implement new capability as macromon (macro monitor routine)
allow routine to be called directly (opens .LST file)

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