- Timestamp:
- Dec 4, 2009 5:06:22 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/gsascmds.tcl
- Property rcs:date changed from 2001/09/04 22:58:36 to 2001/09/25 23:31:59
- Property rcs:lines changed from +34 -0 to +180 -10
- Property rcs:rev changed from 1.37 to 1.38
r431 r450 379 379 } 380 380 381 proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}" } {381 proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}" "err 0"} { 382 382 catch {destroy $win} 383 383 toplevel $win 384 384 385 385 pack [label $win.l1 -text $labeltext] -side top 386 if {$err} {$win.l1 config -fg red} 386 387 pack [frame $win.f1] -side top -expand yes -fill both 387 388 grid [text $win.f1.t \ … … 997 998 set validlist {} 998 999 foreach ihist $expmap(powderlist) { 999 if {[string range $expmap(htype_$ihist) 3 3] == ""} { 1000 if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \ 1001 [string range $expmap(htype_$ihist) 3 3] == "D"} { 1000 1002 lappend validlist $ihist 1001 1003 } … … 1039 1041 set validlist {} 1040 1042 foreach ihist $expmap(powderlist) { 1041 if {[string range $expmap(htype_$ihist) 3 3] == "" || \1043 if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \ 1042 1044 [string range $expmap(htype_$ihist) 3 3] == "*"} { 1043 1045 lappend validlist $ihist … … 1073 1075 set validlist {} 1074 1076 foreach ihist $expmap(powderlist) { 1075 if {[string range $expmap(htype_$ihist) 3 3] == "" || \1077 if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" || \ 1076 1078 [string range $expmap(htype_$ihist) 3 3] == "*"} { 1079 # someday support DUMMY 1080 # [string range $expmap(htype_$ihist) 3 3] == "D" 1077 1081 lappend validlist $ihist 1078 1082 } … … 1609 1613 pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both 1610 1614 listbox $bx.a.files -relief raised -bd 2 \ 1611 -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \1615 -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \ 1612 1616 -height 15 -width 0 -exportselection 0 1613 1617 listbox $bx.a.dates -relief raised -bd 2 \ 1614 -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \1618 -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \ 1615 1619 -height 15 -width 0 -takefocus 0 -exportselection 0 1616 1620 scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" " … … 1910 1914 pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both 1911 1915 listbox $bx.a.files -relief raised -bd 2 \ 1912 -yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \1916 -yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \ 1913 1917 -height 15 -width 0 -exportselection 0 1914 1918 listbox $bx.a.dates -relief raised -bd 2 \ 1915 -yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \1919 -yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \ 1916 1920 -height 15 -width 0 -takefocus 0 -exportselection 0 1917 1921 scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" " … … 1925 1929 pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top 1926 1930 } 1927 proc sync2boxes {master slave scroll args} { 1931 proc sync2boxesX {master slave scroll args} { 1932 $slave xview moveto [lindex [$master xview] 0] 1933 eval $scroll set $args 1934 } 1935 proc move2boxesX {boxlist args} { 1936 foreach listbox $boxlist { 1937 eval $listbox xview $args 1938 } 1939 } 1940 proc sync2boxesY {master slave scroll args} { 1928 1941 $slave yview moveto [lindex [$master yview] 0] 1929 1942 eval $scroll set $args … … 1932 1945 foreach listbox $boxlist { 1933 1946 eval $listbox yview $args 1947 } 1948 } 1949 1950 # creates a table that is scrollable in both x and y, use ResizeScrollTable 1951 # to set sizes after gridding the boxes 1952 proc MakeScrollTable {box} { 1953 grid [label $box.0] -col 0 -row 0 1954 grid [set tbox [canvas $box.top \ 1955 -scrollregion {0 0 10 10} \ 1956 -xscrollcommand "sync2boxesX $box.top $box.can $box.scroll" \ 1957 -width 10 -height 10]] \ 1958 -sticky sew -row 0 -column 1 1959 grid [set sbox [canvas $box.side \ 1960 -scrollregion {0 0 10 10} \ 1961 -yscrollcommand "sync2boxesY $box.side $box.can $box.yscroll" \ 1962 -width 10 -height 10]] \ 1963 -sticky nes -row 1 -column 0 1964 grid [set bbox [canvas $box.can \ 1965 -scrollregion {0 0 10 10} \ 1966 -yscrollcommand "sync2boxesY $box.can $box.side $box.yscroll" \ 1967 -xscrollcommand "sync2boxesX $box.can $box.top $box.scroll" \ 1968 -width 200 -height 200 -bg lightgrey]] \ 1969 -sticky news -row 1 -column 1 1970 grid [set sxbox [scrollbar $box.scroll -orient horizontal \ 1971 -command "move2boxesX \" $box.can $box.top \" "]] \ 1972 -sticky ew -row 2 -column 1 1973 grid [set sybox [scrollbar $box.yscroll \ 1974 -command "move2boxesY \" $box.can $box.side \" "]] \ 1975 -sticky ns -row 1 -column 2 1976 frame $tbox.f -bd 0 1977 $tbox create window 0 0 -anchor nw -window $tbox.f 1978 frame $bbox.f -bd 2 1979 $bbox create window 0 0 -anchor nw -window $bbox.f 1980 frame $sbox.f -bd 2 -relief raised 1981 $sbox create window 0 0 -anchor nw -window $sbox.f 1982 grid columnconfig $box 1 -weight 1 1983 grid rowconfig $box 1 -weight 1 1984 return [list $tbox.f $bbox.f $sbox.f $box.0] 1985 } 1986 1987 proc ResizeScrollTable {box} { 1988 update idletasks 1989 for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} { 1990 set x1 [lindex [grid bbox $box.can.f 0 $i] 2] 1991 set x2 [lindex [grid bbox $box.top.f 0 $i] 2] 1992 if {$x2 > $x1} {set x1 $x2} 1993 grid columnconfigure $box.top.f $i -minsize $x2 1994 grid columnconfigure $box.can.f $i -minsize $x2 1995 } 1996 for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} { 1997 set x1 [lindex [grid bbox $box.can.f 0 $i] 3] 1998 set x2 [lindex [grid bbox $box.side.f 0 $i] 3] 1999 if {$x2 > $x1} {set x1 $x2} 2000 grid rowconfigure $box.can.f $i -minsize $x1 2001 grid rowconfigure $box.side.f $i -minsize $x1 2002 } 2003 update idletasks 2004 set sizes [grid bbox $box.can.f] 2005 $box.can config -scrollregion $sizes 2006 $box.side config -scrollregion $sizes 2007 $box.top config -scrollregion $sizes 2008 $box.top config -height [lindex [grid bbox $box.top.f] 3] 2009 $box.side config -width [lindex [grid bbox $box.side.f] 2] 2010 } 2011 2012 2013 # support routine for SetHistUseFlags 2014 proc InitHistUseFlags {} { 2015 global expmap expgui 2016 for {set i 1} {$i <= $expmap(nhst)} {incr i} { 2017 if {[string range $expmap(htype_$i) 0 0] == "P"} { 2018 set expgui(useflag_$i) [histinfo $i use] 2019 } 2020 } 2021 } 2022 2023 # show all Powder histograms; set use/do not use flags 2024 proc SetHistUseFlags {} { 2025 set box .test 2026 catch {toplevel $box} 2027 eval destroy [winfo children $box] 2028 grid [label $box.0 -text "Set histogram \"Use/Do Not Use\" flags" -bg white] -row 0 -column 0 -columnspan 2 2029 grid [frame $box.a] -row 1 -column 0 -columnspan 2 2030 grid [button $box.b -text Save -command "destroy $box"] -row 2 -column 0 -sticky e 2031 grid [button $box.c -text Cancel -command "InitHistUseFlags;destroy $box"] -row 2 -column 1 -sticky w 2032 grid columnconfig $box 0 -weight 1 2033 grid columnconfig $box 1 -weight 1 2034 foreach a [MakeScrollTable $box.a] b {tbox bbox sbox cbox} {set $b $a} 2035 $cbox config -text "Use\nFlag" 2036 [winfo parent $bbox] config -height 250 -width 400 2037 global expmap expgui 2038 set px 5 2039 set row -1 2040 for {set i 1} {$i <= $expmap(nhst)} {incr i} { 2041 if {[string range $expmap(htype_$i) 2 2] == "T"} { 2042 set det [format %8.2f [histinfo $i tofangle]] 2043 } elseif {[string range $expmap(htype_$i) 2 2] == "C"} { 2044 set det [format %8.5f [histinfo $i lam1]] 2045 } elseif {[string range $expmap(htype_$i) 2 2] == "E"} { 2046 set det [format %8.2f [histinfo $i lam1]] 2047 } else { 2048 set det {} 2049 } 2050 incr row 2051 if {[string range $expmap(htype_$i) 0 0] == "P"} { 2052 grid [checkbutton $sbox.$i -text $i -variable expgui(useflag_$i)] -row $row -col 0 2053 set expgui(useflag_$i) [histinfo $i use] 2054 } 2055 grid [label $bbox.0$i \ 2056 -text [string range $expmap(htype_$i) 1 3] \ 2057 ] -row $row -col 0 -padx $px 2058 grid [label $bbox.1$i -text [histinfo $i bank] \ 2059 ] -row $row -col 1 -padx $px 2060 grid [label $bbox.2$i -text $det] -row $row -col 2 -padx $px 2061 grid [label $bbox.3$i -text [string range [histinfo $i title] 0 66] \ 2062 ] -row $row -col 3 -padx $px -sticky ew 2063 } 2064 grid [label $tbox.0 -text type -bd 2 -relief raised] -row 0 -col 0 -padx $px 2065 grid [label $tbox.1 -text bank -bd 2 -relief raised] -row 0 -col 1 -padx $px 2066 grid [label $tbox.2 -text "ang/wave" -bd 2 -relief raised] -row 0 -col 2 -padx $px 2067 grid [label $tbox.3 -text "histogram title" -bd 2 -relief raised] -row 0 -col 3 -sticky w -padx $px 2068 ResizeScrollTable $box.a 2069 InitHistUseFlags 2070 putontop $box 2071 tkwait window $box 2072 afterputontop 2073 set prevchages $expgui(changed) 2074 for {set i 1} {$i <= $expmap(nhst)} {incr i} { 2075 if {[string range $expmap(htype_$i) 0 0] == "P"} { 2076 if {$expgui(useflag_$i) != [histinfo $i use]} { 2077 histinfo $i use set $expgui(useflag_$i) 2078 incr expgui(changed) 2079 } 2080 } 2081 } 2082 if {$prevchages != $expgui(changed)} { 2083 set msg "You have changed [expr $expgui(changed)-$prevchages] " 2084 append msg "histogram flag(s). You must run POWPREF " 2085 append msg "to include/remove these histograms. Do you want to " 2086 append msg "run POWPREF?" 2087 set ans [MyMessageBox -parent . -message $msg \ 2088 -title "Process changes?"\ 2089 -helplink "expguierr.html ProcessUse" \ 2090 -default {Run POWPREF} \ 2091 -type {{Run POWPREF} Skip}] 2092 2093 if {$ans == "skip"} { 2094 # save and reload the experiment file 2095 savearchiveexp 2096 loadexp $expgui(expfile) 2097 } else { 2098 # run powpref and force a reload 2099 set saveautoload $expgui(autoexpload) 2100 set expgui(autoexpload) 1 2101 runGSASwEXP powpref 2102 set expgui(autoexpload) $saveautoload 2103 } 1934 2104 } 1935 2105 }
Note: See TracChangeset
for help on using the changeset viewer.