source: trunk/lstview

Last change on this file was 1251, checked in by toby, 9 years ago

use svn ps svn:eol-style "native" * to change line ends
  • Property svn:eol-style set to native
  • 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 1251 2014-03-10 22:17:29Z toby $
10set Revision {$Revision: 1251 $ $Date: 2014-03-10 22:17:29 +0000 (Mon, 10 Mar 2014) $}
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\
446R. B. Von Dreele, Argonne National Lab\n
447and A. C. Larson, Los Alamos (retired)\n\n\
448LSTVIEW\nB. H. Toby, Argonne National Lab\n\n\
449$Revision\n\
450" {} 0 OK
451}
452
453proc postingvars {} {
454    global trackinglist
455    eval destroy [winfo children .plot.c.f]
456    set i 0
457    foreach var [lsort [array names trackinglist]] {
458        grid [checkbutton .plot.c.f.$i -text $trackinglist($var) \
459                -pady 0 -command plotvars -variable plotlist($var)] \
460                -column 0 -row [incr i] -sticky w
461    }
462}
463
464proc makeplot {} {
465    # handle Tcl/Tk v8+ where BLT is in a namespace
466    #  use the command so that it is loaded
467    catch {blt::graph}
468    catch {
469        namespace import blt::graph
470    }
471    toplevel .plot
472    grid [graph .plot.g] -column 0 -row 0 -sticky news
473    canvas .plot.c \
474            -scrollregion {0 0 5000 1000} -width 40 -height 250 \
475            -yscrollcommand ".plot.s set"
476    scrollbar .plot.s -command ".plot.c yview"
477    grid .plot.c -column 1 -row 0 -sticky news
478        frame .plot.c.f -class SmallFont
479    .plot.c create window 0 0 -anchor nw -window .plot.c.f
480    grid columnconfigure .plot 0 -weight 1
481    grid rowconfigure .plot 0 -weight 1
482    Blt_ZoomStack .plot.g
483    Blt_ActiveLegend .plot.g
484    .plot.g config -title ""
485    .plot.g xaxis config -title "cycle"
486    .plot.g yaxis config -title ""
487    wm iconify .plot
488}
489
490proc plotvars {} {
491    raise .plot
492    eval .plot.g element delete [.plot.g element names]
493    global trackinglist
494    global plotlist
495    set num 0
496    foreach v [lsort [array names trackinglist]] {
497        set datalist {}
498        if $plotlist($v) {
499            incr num
500            set var tracklist_$v
501            global $var
502            set color [lindex {red green blue magenta cyan yellow} \
503                    [expr $num % 6]]
504            foreach n [lsort -integer [array names $var]] {
505                lappend datalist $n [set ${var}($n)]
506            }
507            .plot.g element create "$var" -data $datalist -color $color \
508                    -label $trackinglist($v)
509        }
510    }
511}
512
513proc hideplot {} {
514    global txtvw
515    if {![winfo exists .plot]} {
516        makeplot
517        postingvars
518    }
519    # hide or show the plot
520    if {$txtvw(hideplot) != 1} {
521        wm iconify .plot
522    } else {
523        wm deiconify .plot
524        update idletasks
525        # size the box width & scrollregion height
526        set sizes [grid bbox .plot.c.f]
527        .plot.c config -scrollregion $sizes -width [lindex $sizes 2]
528        # is the scroll bar needed?
529        if {[winfo height .plot.c] >= [lindex $sizes 3]} {
530            grid forget .plot.s
531        } else {
532            grid .plot.s -column 2 -row 0 -sticky news
533        }
534    }
535}
536
537
538proc KillLSTfile {} {
539    global filename lstfp tcl_platform
540    # confirm the delete
541    set ans [tk_dialog .warn Notify \
542            "OK to delete the contents of $filename?" "" 0 Yes No]
543    if {$ans != 0} return
544    # stop the updates
545    after cancel updatetext
546    # zero out the file
547    close $lstfp
548    set lstfp [open $filename w+]
549    .txt config -state normal
550    .txt delete 0.0 end
551    ClearMenus
552    updatetext
553}
554
555proc TrimLSTfile {} {
556    global filename lstfp tcl_platform txtvw
557   
558    # get the last refinement run position
559    set loc {}
560    # get the starting location
561    catch {
562        set loc [lindex [.a.goto.menu.run entrycget 1 -command] end]
563        set loc [.txt index "$loc - 2lines"]
564        set txtvw(delete) [expr {100.*$loc/[.txt index end]}]
565        .txt see $loc
566
567    }
568    if {$loc == ""} {
569        set txtvw(delete) [expr {50.* \
570                ([lindex [.txt yview] 0] + [lindex [.txt yview] 1])}]
571        set loc [expr {int(0.5+ $txtvw(delete) * [.txt index end]/100.)}].0
572    }
573
574    catch {toplevel .trim}
575    eval destroy [winfo children .trim]
576    wm title .trim "Trim $filename"
577    pack [label .trim.0 -text "File $filename has [expr {int([.txt index end])}] lines total."] -side top
578    pack [label .trim.1 -text "Select percentage of file to delete."] \
579            -anchor w -side top
580   
581    # set the slider resolution so that 1 division is on the
582    # order of 1-2 lines
583    set res .5
584    while {$res > 200./[.txt index end] && $res > 0.01} {
585        if {[string match *5* $res]} {
586            set res [expr $res/2.5]
587        } else {
588            set res [expr $res/2.]
589        }
590    }
591    pack [scale .trim.2 -command HighlightText -orient horizontal \
592            -variable txtvw(delete) \
593            -resolution $res] -expand yes -fill x
594    pack [frame .trim.3]
595    pack [button .trim.3.a -text Trim \
596            -command {DeleteSelectedText; destroy .trim} \
597            ] -side left
598    pack [button .trim.3.b -text Cancel -command {destroy .trim} ] -side left
599    # create a binding so that we can click on the text box
600    .txt tag delete b
601    .txt tag add b 0.0 end
602    .txt tag bind b <1> "ClickHighlightText %x %y"
603    # show the region pending delete
604    .txt tag delete pend
605    .txt tag add pend 0.0 $loc
606    .txt tag config pend -foreground grey
607}
608
609proc ClickHighlightText {x y} {
610    global txtvw
611    if {![winfo exists .trim]} return
612    set loc [.txt index "@$x,$y linestart"]
613    set txtvw(delete) [expr {100.*$loc/[.txt index end]}]
614    .txt tag delete pend
615    .txt tag add pend 0.0 $loc
616    .txt tag config pend -foreground grey
617}
618
619proc DeleteSelectedText {} {
620    global filename lstfp
621    .txt config -state normal
622    eval .txt delete [.txt tag nextrange pend 0.0]
623    # stop the updates
624    after cancel updatetext
625    # zero out the file
626    close $lstfp
627    set lstfp [open $filename w+]
628    puts $lstfp [.txt get 0.0 end]
629    .txt delete 0.0 end
630    ClearMenus
631    seek $lstfp 0
632    updatetext
633}
634
635proc ClearMenus {} {
636    foreach m {str run cyc sum} {
637        .a.goto.menu.$m delete 1 end
638    }
639    foreach num {1 2 3 5} {
640        .a.goto.menu entryconfigure $num -state disabled
641    }
642    global txtvw
643    set txtvw(runnumber) 0
644    set txtvw(sum) 0
645}
646
647proc HighlightText {args} {
648    global txtvw
649    set loc [expr {int(0.5+ $txtvw(delete) * [.txt index end]/100.)}].0
650    .txt tag delete pend
651    .txt tag add pend 0.0 $loc
652    .txt tag config pend -foreground grey
653    .txt see $loc
654}
655
656proc PrintSelection {} {
657    global txtvw
658    if {[catch {
659        set fp [open "| $txtvw(printcommand)" w]
660        puts $fp [selection get]
661        close $fp
662    } errmsg]} {
663        MyMessageBox -parent . -title "Print error" \
664            -message "Error trying to print: $errmsg" \
665            -icon warning -type Ignore -default ignore
666        # -helplink "expguierr.html Customizewarning"
667    }
668    catch {close $fp}
669}
670
671proc SetPrintCommand {} {
672    set bx .opt
673    catch {destroy $bx}
674    toplevel $bx
675    wm iconname $bx "Print options"
676    wm title $bx "Print options"
677
678    pack [label $bx.0 -text "Set Print Command" ] -side top
679    pack [frame $bx.c] -side top
680    pack [frame $bx.b] -side top
681    pack [label $bx.c.a -text "Command:"] -side left
682    pack [entry $bx.c.b -textvariable txtvw(printcommand) -width 40] \
683            -side left
684    pack [button $bx.b.c -command "destroy $bx" -text Close ] -side right
685}
686
687proc AbortMacro {} {
688    .but.abort config -text "Macro aborting..." -relief sunken
689    close [open abort_${::expnam}_macro.flag w]
690}
691
692#----------------------------------------------------------------
693# where are we?
694set expgui(script) [info script]
695# translate links -- go six levels deep
696foreach i {1 2 3 4 5 6} {
697    if {[file type $expgui(script)] == "link"} {
698        set link [file readlink $expgui(script)]
699        if { [file  pathtype  $link] == "absolute" } {
700h           set expgui(script) $link
701        } {
702            set expgui(script) [file dirname $expgui(script)]/$link
703        }
704    } else {
705        break
706    }
707}
708
709# fixup relative paths
710if {[file pathtype $expgui(script)] == "relative"} {
711    set expgui(script) [file join [pwd] $expgui(script)]
712}
713set expgui(scriptdir) [file dirname $expgui(script) ]
714set expgui(docdir) [file join $expgui(scriptdir) doc]
715# location for web pages, if not found locally
716set expgui(website) 11bm.xor.aps.anl.gov/expguidoc/
717
718source [file join $expgui(scriptdir) gsascmds.tcl]
719source [file join $expgui(scriptdir) opts.tcl]
720
721# override options with locally defined values
722set filelist [file join $expgui(scriptdir) localconfig]
723if {$tcl_platform(platform) == "windows"} {
724    lappend filelist "c:/gsas.config"
725} else {
726    lappend filelist [file join ~ .gsas_config]
727}
728if {[catch {
729    foreach file $filelist {
730        if [file exists $file] {source $file}
731    }
732} errmsg]} {
733    set msg "Error reading file $file (aka [file nativename $file]): $errmsg"
734    MyMessageBox -parent . -title "Customize warning" \
735        -message $msg -icon warning -type Ignore -default ignore \
736        -helplink "expguierr.html Customizewarning"
737}
738
739set txtvw(lastchi) {}
740set txtvw(lastcycle) {}
741set txtvw(finalshift) {}
742if {$::program != "macromon"} {
743    text .txt -width 100 -wrap none \
744        -yscrollcommand ".yscroll set" \
745        -xscrollcommand ".xscroll set" 
746    if {$tcl_version >= 8.0} {.txt config -font $txtvw(font)}
747    scrollbar .yscroll -command ".txt yview"
748    scrollbar .xscroll -command ".txt xview" -orient horizontal
749    grid .xscroll -column 0 -row 2 -sticky ew
750    grid .txt -column 0 -row 1 -sticky nsew
751    grid .yscroll -column 1 -row 1 -sticky ns
752} else {
753    grid [label .msg -text "\nMacro running\n" -padx 20 -pady 5] -column 0 -row 1 -sticky nsew
754}
755grid columnconfigure . 0 -weight 1
756grid rowconfigure . 1 -weight 1
757wm title . "View $filename"
758wm iconname . $filename
759grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew
760pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \
761            -side left
762menu .a.file.menu
763if {$::program != "macromon"} {
764    .a.file.menu add command -label "Delete $filename" -command KillLSTfile
765    .a.file.menu add command -label "Trim $filename" -command TrimLSTfile
766}
767.a.file.menu add command -label Exit -command "destroy ."
768
769if {$::program != "macromon"} {
770    # windows copy command. Should not be needed in X windows
771    pack [menubutton .a.edit -text Edit -underline 0 -menu .a.edit.menu] \
772        -side left
773    menu .a.edit.menu
774    if {$tcl_platform(platform) == "windows"} {
775        .a.edit.menu add command -label copy \
776            -command {catch {clipboard append [selection get]}}
777    } else {
778        .a.edit.menu add command -label "Print Selection" \
779            -command {catch PrintSelection}
780    }
781
782    pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \
783        -side left
784    menu .a.goto.menu
785    .a.goto.menu add cascade -label "Cycle #"  -menu .a.goto.menu.cyc \
786        -state disabled
787    menu .a.goto.menu.cyc
788    .a.goto.menu add cascade -label "Refinement Run #"  -menu .a.goto.menu.run \
789        -state disabled
790    menu .a.goto.menu.run
791    .a.goto.menu add cascade -label "Summary #"  -menu .a.goto.menu.sum \
792        -state disabled
793    menu .a.goto.menu.sum
794    .a.goto.menu add command -label "Set Search String" -command GetSearchString
795    .a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
796    menu .a.goto.menu.str
797
798    pack [menubutton .a.options -text "Options" -underline 0 \
799              -menu .a.options.menu] \
800            -side left
801    menu .a.options.menu
802    .a.options.menu  add checkbutton -label "Auto Advance" -variable txtvw(followcycle) 
803   
804    if {$tcl_version >= 8.0} {
805        pack [label .a.fontl -text "  Font:"] -side left
806        set fontbut [tk_optionMenu .a.fontb txtvw(font) ""]
807        pack .a.fontb -side left
808        $fontbut delete 0 end
809        foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
810            $fontbut add command -label "Courier $f" -font "Courier $f"\
811                -command "set txtvw(font) \"Courier $f\"; \
812                .txt config -font \$txtvw(font)"
813        }
814    }
815
816    if {$tcl_platform(platform) != "windows"} {
817        .a.options.menu add command -label "Set print command" -underline 1 \
818            -command SetPrintCommand
819    }
820    .a.options.menu add command -label "Save Options" -underline 1 \
821        -command "SaveOptions"
822    if {$txtvw(plotvars) && ![catch {package require BLT}]} {
823        .a.options.menu add checkbutton -label "Show Plot" -command hideplot \
824            -variable txtvw(hideplot)
825    }
826}
827pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
828menu .a.help.menu
829.a.help.menu add command -command "MakeWWWHelp expgui.html LSTVIEW" \
830    -label "Web page"
831if {![catch {package require tkcon} errmsg]} {
832    .a.help.menu add command -label "Open console" -command {tkcon show}
833} elseif {$tcl_platform(platform) == "windows"} {
834    .a.help.menu add command -label "Open console" -command {console show}
835}
836.a.help.menu add command -command aboutgsas -label "About"
837
838grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew
839pack [label .but.lbl2 -textvariable txtvw(lastcycle) \
840        -relief sunken -bd 2] -side left
841pack [label .but.lbl3 -textvariable txtvw(lastchi) \
842        -relief sunken -bd 2] -side left
843pack [label .but.lbl4 -textvariable txtvw(finalshift) \
844        -relief sunken -bd 2] -side left
845if {$mode == "Macro"} {
846    pack [button .but.abort -text "Abort Macro "\
847             -command AbortMacro] -side right
848}
849if {$::program != "macromon"} {
850    #bind all <Control-KeyPress-c> {destroy .}
851    bind . <KeyPress-Prior> ".txt yview scroll -1 page"
852    bind . <KeyPress-Next> ".txt yview scroll 1 page"
853    bind . <KeyPress-Up> ".txt yview scroll -1 unit"
854    bind . <KeyPress-Down> ".txt yview scroll 1 unit"
855    bind . <KeyPress-Home> ".txt yview 0"
856    bind . <KeyPress-End> ".txt yview end"
857    #pack [button .but.q -text close -command "destroy ." ] -side right
858    .txt tag config cycle -background yellow
859    .txt tag config rval -background  green
860    .txt tag config chi -background  green
861}
862if [file exists $filename] {
863    set lstfp [open $filename r]
864} else {
865    # create a file if it does not exist
866    set lstfp [open $filename w+]
867}
868donewaitmsg
869# seems to be needed in OSX
870update
871wm geom . [winfo reqwidth .]x[winfo reqheight .]
872#
873
874# read a file compressed file, if present
875if {$zfil != ""} {
876    updatetext $zfil
877    close $zfil
878}
879# read the initial file
880updatetext $lstfp
881# now start reading with updates
882updatetext
Note: See TracBrowser for help on using the repository browser.