source: trunk/expgui @ 838

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

# on 2005/03/24 21:45:48, toby did:
fix up resize for OS X
add LS band width as option (thanx RBVD)
note Pawley phase (thanks RBVD)
attempt to fix missing expmap(atomlistboxcontents) bug
(not sure why this happens, so at least trap errors)
Reset phase selection in GetPhaseFlags? in case this causes the missing expmap(atomlistboxcontents)
prevent use of TRNS & SHFT when ZERO is refined
add new print option (#10) (thanx RBVD)

  • Property rcs:author set to toby
  • Property rcs:date set to 2005/03/24 21:45:48
  • Property rcs:lines set to +54 -9
  • Property rcs:rev set to 1.76
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 150.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: expgui 838 2009-12-04 23:12:54Z toby $
10set expgui(Revision) {$Revision: 838 $ $Date: 2009-12-04 23:12:54 +0000 (Fri, 04 Dec 2009) $}
11
12package require Tk
13
14# to do:
15#
16# need to change heading and button label depending on where getExpFileName
17# is called from?
18#
19# global background editing & profile work differently: should both
20# start out blank with a "load from option"?
21#
22# idea:
23# a scroll list for all histogram refinement flags ; click on takes you to the
24# appropriate menu.
25#
26# idea:
27#   change cell parameters to labels and have a edit cell button
28#   that enforces metric symmetry
29#
30# to allow "global" access on phase page
31#   change buttons from radio to multiple
32#   -- or display all 9 cell flag/damps and all atoms
33#   make editMultipleRecords work with multiple phases, also cell flag/damp
34#   blank cell entries
35#   add phase to atom number in listing
36#   DisplayAllAtoms needs to loop over phases
37#
38# idea: load more than one bank from a multi-bank .RAW file
39#
40if {$tcl_version < 8.0} {
41    tk_dialog .expFileErrorMsg "Version Error" \
42            "EXPGUI requires Tcl/Tk version 8.0 or higher" error 0 "Exit"
43    exit
44}
45
46# the shell variable tells expgui to act as a shell for GSAS
47# as well as edit the EXP file. In no-shell mode, it can
48# only be used to edit the .EXP file as a callable program
49set expgui(shell) 1
50catch {if $env(EXPGUI_NOSHELL) {set expgui(shell) 0}}
51
52if {$argv != ""} {
53    if {[string match *noshell* [string tolower $argv]]} {
54        #puts noshell
55        set expgui(shell) 0
56        set expgui(expfile) [lindex $argv 1]
57    } else {
58        set expgui(expfile) [lindex $argv 0]
59    }
60    if {[string match -nocase {.o[0-9a-f][0-9a-f]} \
61             [file extension $expgui(expfile)]]} {
62        # this is an archived file -- need to handle this later
63        tk_dialog .expFileErrorMsg "No archived files yet" \
64            "At present you must use open (expnam) to open archived files" warning 0 "Continue"
65        set expgui(expfile) {}
66    } elseif {[string toupper [file extension $expgui(expfile)]] != ".EXP"} {
67        append expgui(expfile) ".EXP"
68    }
69} else {
70    set expgui(expfile) {}
71}
72
73set expgui(curhist) {}
74set expmap(powderlist) {}
75set expgui(bkgcolor1) #fdf
76
77set expgui(debug) 0
78catch {if $env(DEBUG) {set expgui(debug) 1}}
79#set expgui(debug) 1
80
81# location for web pages, if not found locally
82set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
83# default for archive mode = on
84set expgui(archive) 1
85# default for autoexec load = off
86set expgui(autoexpload) 0
87# default for autostart GRWND = off
88set expgui(autoGRWND) 0
89# by default expgui is iconified while GENLES, etc runs
90set expgui(autoiconify) 1
91# default for show EXPTOOL output = off
92set expgui(showexptool) 0
93# save the name of the wish executable
94set wishshell [info nameofexecutable] 
95# misc constants
96set txtvw(font) "Courier"
97set expgui(font) 14
98set liveplot(hst) 1
99set liveplot(legend) 1
100set expgui(filesort) 1
101set expgui(initstring) {}
102# use a separate window for DISAGL (default)
103set expgui(disaglSeparateBox) 1
104set expgui(DefaultPeakType) 0
105# default: keep current atoms when replacing a phase
106set expgui(DeleteAllAtoms) 0
107# flags for running POWPREF
108set expgui(needpowpref) 0
109set expgui(needpowpref_why) ""
110# on Mac associate a app with .EXP file (on by default)
111set expgui(MacAssignApp) 1
112#=============================================================================
113#----------------------------------------------------------------
114# where are we?
115set expgui(script) [info script]
116# translate links -- go six levels deep
117foreach i {1 2 3 4 5 6} {
118    if {[file type $expgui(script)] == "link"} {
119        set link [file readlink $expgui(script)]
120        if { [file  pathtype  $link] == "absolute" } {
121            set expgui(script) $link
122        } {
123            set expgui(script) [file dirname $expgui(script)]/$link
124        }
125    } else {
126        break
127    }
128}
129# fixup relative paths
130if {[file pathtype $expgui(script)] == "relative"} {
131    set expgui(script) [file join [pwd] $expgui(script)]
132}
133set expgui(scriptdir) [file dirname $expgui(script) ]
134set expgui(gsasdir) [file dirname $expgui(scriptdir)]
135set expgui(gsasexe) [file join $expgui(gsasdir) exe]
136set expgui(docdir) [file join $expgui(scriptdir) doc]
137#----------------------------------------------------------------
138# use EXPGUI directory for packages
139lappend auto_path $expgui(scriptdir)
140#----------------------------------------------------------------
141source [file join $expgui(scriptdir) opts.tcl]
142# fetch EXP file processing routines
143source [file join $expgui(scriptdir) readexp.tcl]
144# commands for running GSAS programs
145source [file join $expgui(scriptdir) gsascmds.tcl]
146# contents of GSAS menus
147source [file join $expgui(scriptdir) gsasmenu.tcl]
148# commands for adding phases, histograms & atoms
149source [file join $expgui(scriptdir) addcmds.tcl]
150# commands for preferred orientation
151source [file join $expgui(scriptdir) orient.tcl]
152# setting data range/excluded regions
153source [file join $expgui(scriptdir) exclinit.tcl]
154#---------------------------------------------------------------------------
155# override options with locally defined values
156set filelist [file join $expgui(scriptdir) localconfig]
157if {$tcl_platform(platform) == "windows"} {
158    lappend filelist "c:/gsas.config"
159} else {
160    lappend filelist [file join ~ .gsas_config]
161}
162if {[catch {
163    foreach file $filelist {
164        if [file exists $file] {source $file}
165    }
166} errmsg]} {
167    set msg "Error reading file $file (aka [file nativename $file]): $errmsg"
168    MyMessageBox -parent . -title "Customize warning" \
169        -message $msg -icon warning -type Ignore -default ignore \
170        -helplink "expguierr.html Customizewarning"
171}
172if [catch {package require BWidget}] {
173    set msg "Error loading the BWidget package: This should not happen if you use the version of Tcl/Tk (tcl84+.exe) distributed with EXPGUI"
174    MyMessageBox -parent . -title "BWidget load error" \
175        -message $msg -icon error -type Error -default error \
176        -helplink "debug_tcltk.html"
177    destroy .
178}
179SetTkDefaultOptions $expgui(font)
180#---------------------------------------------------------------------------
181set expgui(resize) 0
182# platform-specific code
183if {$tcl_platform(platform) == "windows" \
184        && $tcl_platform(os) == "Windows 95"} {
185    if {[catch {package require winexec}] && \
186            [catch {package require winutils}]} {
187        MyMessageBox -parent . -title "WINEXEC Error" \
188            -message "Error -- Unable to load the WINEXEC or the WINUTILS package. This is needed in Win-95/-98/-me machines" \
189            -icon error -type Quit -default quit \
190            -helplink "expgui_Win_readme.html Winexec"
191        destroy .
192    }
193}
194if {$tcl_platform(platform) == "windows"} {
195    # check the path -- can DOS use it?
196    if {[string first {\\} $expgui(script) ] != -1} {
197        MyMessageBox -parent . -title "Networked Path" \
198                -message "Note -- You may have problems running EXPGUI/GSAS from a network drive. If you have errors, map $expgui(gsasdir) to a \"drive\" (like F:). (Use \"Map network drive\" to do this.)" \
199                -icon error -type {"Be brave"} -default "be brave" \
200                -helplink "expgui_Win_readme.html NetPath"
201    }
202    #
203    set expgui(exptool) [file join $expgui(gsasexe) exptool.exe]
204} else {
205    set expgui(exptool) [file join $expgui(gsasexe) exptool]
206    if {$tcl_platform(os) != "Darwin"} {
207        if [catch {set env(GSASBACKSPACE)}] {set env(GSASBACKSPACE) 1}
208    }
209}
210# do we have a PGPLOT fonts file?
211# if it is in the "wrong" place/name -- make it "right"
212if {![file exists [file join $expgui(gsasdir) pgl grfont.dat]] && \
213        [file exists [file join $expgui(gsasdir) fonts grfont.dat]]} {
214    catch {file mkdir [file join $expgui(gsasdir) pgl]}
215    file copy [file join $expgui(gsasdir) fonts grfont.dat] \
216            [file join $expgui(gsasdir) pgl grfont.dat]
217}
218# do we have a PGPLOT fonts file?
219if {![file exists [file join $expgui(gsasdir) pgl grfont.dat]] && \
220        [file exists [file join $expgui(gsasdir) fonts pgfont.dat]]} {
221    catch {file mkdir [file join $expgui(gsasdir) pgl]}
222    file copy [file join $expgui(gsasdir) fonts pgfont.dat] \
223            [file join $expgui(gsasdir) pgl grfont.dat]
224}
225# do we have a PGPLOT fonts file?
226if {![file exists [file join $expgui(gsasdir) pgl grfont.dat]] && \
227        [file exists [file join $expgui(gsasdir) pgl pgfont.dat]]} {
228    file copy [file join $expgui(gsasdir) pgl pgfont.dat] \
229            [file join $expgui(gsasdir) pgl grfont.dat]
230}
231if ![file exists [file join $expgui(gsasdir) pgl grfont.dat]] {
232    MyMessageBox -parent . -title "PGPLOT Error" \
233            -message "Warning -- Unable to find file GRFONT.DAT in [file join $expgui(gsasdir) pgl]. GSAS graphics will not work. Is GSAS correctly installed?" \
234            -icon warning -type {"Limp Ahead"} -default "Limp Ahead" \
235            -helplink "expguierr.html NoPGPLOT"
236    set expgui(resize) 1
237}
238#---------------------------------------------------------------------------
239if {$expgui(expfile) != ""} {
240   # is there a space in the EXP name?
241    if {[string first " " [file tail $expgui(expfile)]] != -1} {
242        update
243        MyMessageBox -parent . -title "File Name Error" \
244                -message "File name \"$expgui(expfile)\" is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
245                -icon warning -type Continue -default continue
246#               -helplink "expguierr.html OpenErr"
247        set expgui(expfile) {}
248        set expgui(resize) 1
249    } elseif {[string first " " [file dirname $expgui(expfile)]] != -1} {
250        update
251        MyMessageBox -parent . -title "Good luck..." \
252            -message "You are using a directory with a space in the name ([file dirname $expgui(expfile)]) -- You may encounter bugs in EXPGUI. Please e-mail them to Brian.Toby@NIST.gov so they can be fixed." \
253                -icon warning -type Continue -default continue
254#               -helplink "expguierr.html OpenErr"
255        set expgui(resize) 1
256    } elseif ![file exists $expgui(expfile)] {
257        update
258        set ans [
259        MyMessageBox -parent . -title "File Open Error" \
260                -message "File [file tail $expgui(expfile)] does not exist in [file dirname $expgui(expfile)]. OK to create?" \
261                -icon question -type {"Select other" "Create"} -default "select other" \
262                -helplink "expguierr.html OpenErr"
263        ]
264        if {[string tolower $ans] != "create"} {set expgui(expfile) {}}
265        set expgui(resize) 1
266    }
267}
268if {$expgui(expfile) == ""} {
269    # center the parent window because the getExpFileName window
270    # will be centered above it.
271    wm withdraw .
272    set x [expr [winfo screenwidth .]/2 - [winfo reqwidth .]/2 ]
273    set y [expr [winfo screenheight .]/2 - [winfo reqheight .]/2]
274    wm geom . +$x+$y
275    wm deiconify .
276    # windows needed this update before when using tk_getOpenFile.
277    # I am not sure it is still needed.
278    update
279    #
280    set expgui(expfile) [getExpFileName ""]
281    set expgui(resize) 1
282}
283if {$expgui(expfile) == ""} exit
284# you've been warned this .EXP does not exist!
285if ![file exists $expgui(expfile)] {
286    # create an "empty" exp file
287    createexp $expgui(expfile) \
288            [getstring "title for experiment $expgui(expfile)" 60 0]
289}
290catch {cd [string trim [file dirname $expgui(expfile)]]}
291
292#
293# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
294# <<<<<<<<<<    BEGINNING OF MAIN: GLOBAL AREA FOR DATA EXTRACTION >>>>>>>>>>>
295# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
296# load exp file and set up dialogs
297proc loadexp {expfile} {
298    global expgui expmap entryvar entrycmd tcl_platform
299    # is this a compressed archive file?
300    if {[string match {*.O[0-9A-F][0-9A-F]} $expfile]} {
301        set expgui(expfile) {}
302        set expnam [file rootname $expfile]
303        set ans [MyMessageBox -parent . -title "Load Archived File" \
304                -message "Loading archived version of $expnam. Do you want to continue using the same experiment name or work with the archived version under a new name?" \
305                -icon question -type "{Use New Name} {Continue with current}" \
306                -default {Use New Name} \
307                -helplink "expguierr.html LoadArchived"
308        ]
309        # archive the current .EXP file
310        if {$ans != "use new name" && [file exists $expfile]} {
311            # get the last archived version
312            set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
313            if {$lastf == ""} {
314                set num 01
315            } else {
316                regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
317                scan $num %x num
318                if {$num >= 255} {
319                    set num FF
320                } else {
321                    set num [string toupper [format %.2x [incr num]]]
322                }
323            }
324            catch {
325                set newfile $expnam.O$num
326                file rename -force $expnam.EXP $newfile
327                set fp [open $expnam.LST a+]
328                puts $fp "\n----------------------------------------------"
329                puts $fp "     Regressing to archive file [file tail $expfile]"
330                puts $fp "     but first archiving [file tail $expnam.EXP] as [file tail $newfile]"
331                puts $fp "----------------------------------------------\n"
332                close $fp
333            }
334            file copy -force $expfile $expnam.EXP
335            set expfile $expnam.EXP
336        }
337        if {$ans == "use new name"} {
338            set newexpfile [getExpFileName new]
339            if {$newexpfile == ""} return 
340            file copy -force $expfile $newexpfile
341            catch {cd [string trim [file dirname $expgui(expfile)]]}
342            set expfile [file tail $newexpfile]
343            set expgui(needpowpref) 2
344            set expgui(needpowpref_why) "\tA new .EXP file was created\n" 
345        }
346    }
347    set expgui(expfile) $expfile
348
349    # change the icon and assign an app to this .EXP file
350    global tcl_platform
351    if {$tcl_platform(os) == "Darwin" && $expgui(MacAssignApp)} {
352        MacSetResourceFork $expfile
353    }
354
355    # read in the .EXP file
356    set fmt [expload $expfile]
357    # if the file was not in the correct format, force a rewrite before use
358    if {$fmt < 0} {
359        # read error
360        return
361    } elseif {$fmt == 1} {
362        set expgui(changed) 0
363    } else {
364        set expgui(changed) 1
365    }
366    # force exp files to be upper case, force save if name changes
367    set filetail [file tail $expfile]
368    set filetailcaps [string toupper $filetail]
369    if {$tcl_platform(platform) == "unix" && $filetail != $filetailcaps} {
370        set expgui(changed) 1
371    }
372    if {[file dirname $expfile] == "."} {
373        set expgui(expfile) $filetailcaps
374    } else {
375        set expgui(expfile) [file join \
376                [file dirname $expfile] $filetailcaps]
377    }
378
379    mapexp
380    set expgui(expModifiedLast) 0
381    catch {
382        set expgui(expModifiedLast) [file mtime $expgui(expfile)]
383    }
384    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
385    # set the window/icon title
386    wm title . "EXPGUI $expfile"
387    set expgui(titleunchanged) 1
388    wm iconname . [file tail $expfile]
389
390    # reset the phase buttons
391    set expgui(curPhase) ""
392    # set the number of phases on the phase page
393    setphases
394
395    # disable the "global options" that don't make sense based on
396    # which histograms present
397    foreach num {1 2 3 4 5} {
398        set flag($num) 0
399    }
400    # save a list of the allowed modes, too
401    set expgui(AllowedHistSelectModes) {0 6}
402    foreach h $expmap(powderlist) {
403        if {[string range $expmap(htype_$h) 2 2] == "T"} {set flag(1) 1}
404        if {[string range $expmap(htype_$h) 1 2] == "NC"} {set flag(2) 1}
405        if {[string range $expmap(htype_$h) 1 2] == "XC" && \
406                [histinfo $h lam2] != 0.0} {set flag(3) 1}
407        if {[string range $expmap(htype_$h) 1 2] == "XC" && \
408                [histinfo $h lam2] == 0.0} {set flag(4) 1}
409        if {[string range $expmap(htype_$h) 1 2] == "XE"} {set flag(5) 1}
410    }
411    foreach num {1 2 3 4 5} \
412            lbl {TOF "CW Neutron" "Alpha12 Xray" "Monochromatic Xray" \
413            "Energy Disp Xray"} {
414        if $flag($num) {
415            $expgui(fm).option.menu.editmode entryconfigure $lbl -state normal
416            lappend expgui(AllowedHistSelectModes) $num
417        } else {
418            $expgui(fm).option.menu.editmode entryconfigure $lbl -state disabled
419        }
420    }
421    # disable traces on entryvar until we are ready
422    set entrycmd(trace) 0
423    trace vdelete entryvar w entvartrace
424
425    # propogate changes on the least squares page
426    set entryvar(cycles) [expinfo cycles]
427    set entrycmd(cycles) "expinfo cycles"
428    set entryvar(mbw) [expinfo mbw]
429    set entrycmd(mbw) "expinfo mbw"
430    # set expgui(globalmode) 0
431    set expgui(printopt) "Print Options ([expinfo print])"
432    set entryvar(title) [expinfo title]
433    global printopts
434    foreach num [array names printopts] {
435        set entrycmd(printopt$num) "printsetting $num"
436        set entryvar(printopt$num) [printsetting $num]
437    }
438    # enable traces on entryvar
439    set entrycmd(trace) 1
440    trace variable entryvar w entvartrace
441
442    # set fo extraction on LS page
443    SetupExtractHist
444    # set convergence criterion
445    InitLSvars
446
447    # update the histogram list & update the page
448    sethistlist
449
450    # start checking for external changes
451    afterawhile
452}
453
454# called to reread the .EXP file
455proc rereadexp {expfile} {
456    global expgui
457    if $expgui(changed) {
458        set decision [tk_dialog .instrSaveData {Save .EXP changes} \
459                {You have made changes to the Experiment. Rereading will cause the changes to be lost. Select an option:} \
460                {} 0 "Save and reread" "Reread without Save" "Cancel reread command"]
461        switch $decision {
462            0 { savearchiveexp }
463            1 { }
464            2 { return }
465        }
466    }
467    loadexp $expgui(expfile)
468}
469
470proc SaveAsFile {} {
471    global expgui
472    set newexpfile [getExpFileName new]
473    if {$newexpfile == ""} return 
474    expwrite $newexpfile
475    set expgui(expfile) $newexpfile
476    catch {cd [string trim [file dirname $expgui(expfile)]]}
477    # change the icon and assign an app to this .EXP file
478    global tcl_platform
479    if {$tcl_platform(os) == "Darwin" && $expgui(MacAssignApp)} {
480        MacSetResourceFork $expgui(expfile)
481    }
482    set expgui(changed) 0
483    set expgui(expModifiedLast) [file mtime $expgui(expfile)]
484    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
485    # set the window/icon title
486    wm title . $expgui(expfile)
487    set expgui(titleunchanged) 1
488    wm iconname . [file tail $expgui(expfile)]
489    # set convergence criterion
490    InitLSvars
491    set expgui(needpowpref) 2
492    set expgui(needpowpref_why) "\tA new .EXP file was created\n" 
493}
494
495# called to read a different .EXP file
496proc readnewexp {} {
497    global expgui expmap
498    if $expgui(changed) {
499        set decision [tk_dialog .instrSaveData {Save .EXP changes} \
500                {You have made changes to the Experiment. Reading a different file without first saving will cause the changes to be lost. Select an option:} \
501                {} 0 "Save and read" "Read without Save" "Cancel read command"]
502        switch $decision {
503            0 { savearchiveexp }
504            1 {                }
505            2 { return }
506        }
507    }
508    set newexpfile [getExpFileName old]
509    if {$newexpfile == ""} return 
510
511    # switch to the 1st page
512    RaisePage lsFrame
513
514    if ![file exists $newexpfile] {
515        # you've been warned this .EXP does not exist!
516        # create an "empty" exp file
517        createexp $newexpfile \
518                [getstring "title for experiment $newexpfile" 60 0]
519    }
520    set expgui(expfile) $newexpfile
521    catch {cd [string trim [file dirname $expgui(expfile)]]}
522    set expgui(globalmode) 0
523    loadexp $expgui(expfile)
524
525    # reset the phase selection
526    set expgui(curPhase) {}
527
528    # select the first histogram in the list by default (if there are any)
529    if {[llength $expmap(histlistboxcontents)] > 0} {
530        set expgui(curhist) 0
531    } else {
532        set expgui(curhist) {}
533    }
534    if {[CountHistory] > 100} {
535        DeleteHistoryRecords "This .EXP file has [CountHistory] history records\nErasing most will speed EXPGUI"
536    }
537}
538
539#------------- set up data read/write layer ----------------------
540# trace routine on entryvar
541proc entvartrace {array elem action} {
542    global expgui entrycmd entryvar entrybox
543    if !$entrycmd(trace) return
544   
545    catch {
546        if {$entrycmd($elem) == ""} return
547        incr expgui(changed)
548        if $expgui(debug) {puts "$entrycmd($elem)  set $entryvar($elem) "}
549        if {$entrycmd($elem) == ""} return
550        if [catch {
551            set result [eval $entrycmd($elem) set [list $entryvar($elem)]]
552            if {!$result} {
553                if $expgui(debug) {puts "error with $entrycmd($elem)"}
554                catch {$entrybox($elem) config -fg red}
555            } else {
556                catch {$entrybox($elem) config -fg black}
557            }
558            if {[string match "*atominfo" [lindex $entrycmd($elem) 0]]} {
559                after idle "UpdateAtomLine \
560                        [list [lindex $entrycmd($elem) 2]] \
561                        [lindex $entrycmd($elem) 1]"
562            }
563        } errmsg] {error $errmsg}       
564    }
565}
566
567# disable traces on entryvar until we are ready
568set entrycmd(trace) 0
569trace variable entryvar w entvartrace
570
571#
572#
573#
574##############################################################################
575#####                    #####################################################
576##### PROCEDURES SECTION #####################################################
577#####                    #####################################################
578##############################################################################
579
580# save some of the global options in ~/.gsas_config or ~/gsas.config in Windows
581proc SaveOptions {} {
582    global expgui env tcl_platform graph peakinfo
583    if {$tcl_platform(platform) == "windows"} {
584        set fp [open c:/gsas.config a]
585    } else {
586        set fp [open [file join ~ .gsas_config] a]
587    }
588
589    puts $fp "# EXPGUI saved options from [clock format [clock seconds]]"
590    set itemlist {archive asorttype hsorttype filesort disaglSeparateBox \
591        font autoexpload autoiconify autotick}
592    if {$tcl_platform(os) == "Darwin"} {
593        lappend itemlist MacAssignApp
594    }
595    if {$tcl_platform(platform) == "windows" && \
596            $tcl_platform(os) == "Windows 95"} {
597        lappend itemlist autoGRWND
598    }
599    foreach item $itemlist {
600        puts $fp "set expgui($item) [list $expgui($item)]"
601    }
602    if {$tcl_platform(platform) != "windows"} {
603        puts $fp "set env(GSASBACKSPACE) [list $env(GSASBACKSPACE)]"
604    }
605    foreach v {printout legend outname outcmd autoraise color_excl \
606            color_obs color_calc} {
607        puts $fp "set graph($v) [list $graph($v)]"
608    }
609    foreach v {obssym obssize exclsym exclsize} {
610        puts $fp "set peakinfo($v) [list $peakinfo($v)]"
611    }
612    close $fp
613}
614
615proc About { } {
616    global expgui expmap
617    tk_dialog .about {About...} \
618"EXPGUI\n\
619Brian Toby\n\
620NIST Center for Neutron Research\n\n\
621Not subject to copyright\n\n\
622Revision [lindex $expgui(Revision) 1] (readexp.tcl [lindex $expmap(Revision) 1])\n\n\
623Cite: B. H. Toby, EXPGUI, a graphical\n\
624user interface for GSAS, J. Appl. Cryst.\n\
62534, 210-21 (2001).
626\n\n\
627Generalized Structure Analysis System\n(GSAS)\n\
628A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
629" \
630        info 0 OK
631}
632proc Cite { } {
633    global expgui expmap
634    tk_dialog .about {Citations...} \
635"If you use EXPGUI, please cite\n\n\
636B.H. Toby, EXPGUI, a graphical\n\
637user interface for GSAS, J. Appl. Cryst.\n\
63834, 210-21 (2001).\n\n\
639as well as\n\n\
640A.C. Larson and R.B. Von Dreele,\n\
641\"General Structure Analysis System (GSAS)\",\n\
642Los Alamos National Laboratory Report\n\
643LAUR 86-748 (2004)." \
644        info 0 OK
645}
646
647# this proc is no longer called, but I am leaving it here as it may
648# be of use in the future
649proc MakeAppleScript {} {
650    global wishshell expgui
651    # create a local script directory, if it does not exist
652    if {![file exists ~/Library/Scripts]} {file mkdir  ~/Library/Scripts}
653    set tmpfile [file nativename ~/tmpscriptfile]
654    set startdir [tk_chooseDirectory -initialdir [pwd] -mustexist 1 \
655                      -title "Choose GSAS starting directory"]
656    if {$startdir == ""} {set startdir "~"}
657    set dir [file nativename  ~/Library/Scripts]
658    if {[set xterm [auto_execok xterm]] == ""} {
659        MyMessageBox -parent . -title "xterm not found " \
660            -message "The AppleScript could not be created because the X11 xterm application was not found. Please correct your path and try again." \
661            -icon "error" -type Sorry -default sorry
662#           -helplink "expguierr.html Customizewarning"
663        return
664    }
665    set file [tk_getSaveFile -initialdir $dir -initialfile EXPGUI.scpt \
666                      -title "Choose location to save script"]
667    set path {$PATH:}
668    append path [file dirname $xterm]
669    set fp [open $tmpfile w]
670    # the applescript starts here
671    puts $fp {on run}
672    puts $fp {  tell application "Finder"}
673    puts $fp {     launch application "X11"}
674    puts $fp {   end tell}
675    puts $fp "  set results to do shell script \"cd $startdir; DISPLAY=:0.0 PATH=$path $wishshell $expgui(script)  > /dev/null 2>&1 &\""
676    puts $fp {end run}
677    # drag & drop
678    puts $fp {on open these_files}
679    puts $fp {  tell application "Finder"}
680    puts $fp {     launch application "X11"}
681    puts $fp {   end tell}
682    puts $fp {  repeat with this_file in these_files}
683    puts $fp "  set results to do shell script \"cd $startdir; DISPLAY=:0.0 PATH=$path $wishshell $expgui(script) \" & the quoted form of the POSIX path of this_file & \" > /dev/null 2>&1 &\""
684    puts $fp {  end repeat}
685    puts $fp {end open}
686    close $fp
687    if {[catch {
688        exec osacompile -l AppleScript -o $file  $tmpfile
689        file delete -force $tmpfile
690        MyMessageBox -parent . -title "AppleScript created" \
691            -message "Script $file created & compiled. You may wish to use the Script Editor to save this as an application" \
692            -icon "info" -type OK -default ok \
693            -helplink "osx.html CompileAppleScript"
694    } errmsg]} {
695        MyMessageBox -parent . -title "AppleScript warning" \
696        -message "An error occurred while attempting to create the script. Please report this bug, including these details:\n$errmsg"\
697            -icon warning -type Ignore -default ignore
698#       -helplink "expguierr.html Customizewarning"
699    }
700}
701
702# this proc gets called when the export coordinate button is pressed
703# it loads export
704proc BuildCoordExpMenu {menu} {
705    global expgui_cmdlist expgui
706    # do this only once
707    $menu config -postcommand {}
708    $menu delete 1 end
709    # add the cif export routine
710    set cmd gsas2cif
711    set action {}
712    catch {set action [lindex $expgui_cmdlist($cmd) 0]}
713    if {$action != "" && $action != "-"} {
714        $menu add command -label $cmd -command [subst $action]
715    }
716    # get a list of files to read
717    set filelist [glob -nocomplain [file join $expgui(scriptdir) export_*.tcl]]
718    foreach file $filelist {
719        source $file
720        $menu add command -label $label -command $action
721    }
722}
723
724# utility export routines for the export_*.tcl files:
725# make a box for export
726proc MakeExportBox {win title webref} {
727    global expmap expgui
728    catch {destroy $win}
729    toplevel $win
730    wm title $win "Export coordinates"
731    if {$webref != ""} {
732        bind $win <Key-F1> $webref
733    }
734    pack [label $win.lbl -text $title] -side top -anchor center
735    pack [frame $win.ps] -side top -anchor w
736    pack [label $win.ps.lbl -text "Select phase: "] -side left
737    foreach num $expmap(phaselist) {
738        pack [button $win.ps.$num -text $num \
739                    -command "SetExportPhase $num $win"] -side left
740    }
741    # leave a place for format-specific items
742    pack [frame $win.special] -side top
743    pack [frame $win.but] -side top -fill x -expand yes
744    pack [button $win.but.1 -text Write -command "destroy $win"] -side left
745    SetExportPhase [lindex $expmap(phaselist) 0] $win
746    pack [button $win.but.2 -text Quit \
747            -command "set expgui(export_phase) 0;destroy $win"] -side left
748    pack [button $win.but.help -text Help -bg yellow \
749            -command "MakeWWWHelp expgui.html ExportMSI"] \
750            -side right
751}
752
753# set the phase in response to the button
754proc SetExportPhase {num win} {
755    global expmap expgui
756    foreach n $expmap(phaselist) { 
757        if {$n == $num} { 
758            $win.ps.$n config -relief sunken; 
759            set expgui(export_phase) $num 
760        } else { 
761            $win.ps.$n config -relief raised
762        }
763    }
764}
765
766# wait until idle
767proc afterawhile {} {
768    # cancel any other instances of this loop
769    after cancel afterawhile
770    after cancel whenidle
771    after cancel whenidle
772    after idle whenidle
773}
774
775# This is called every 2 seconds to check for changes to the .EXP file
776proc whenidle {} {
777    global expgui tcl_platform
778    if $expgui(titleunchanged) {
779        if {$expgui(changed) != 0} {
780            wm title . "$expgui(expfile) (modified)"
781            set expgui(titleunchanged) 0
782        }
783    }
784    if {$expgui(expModifiedLast) == 0} {
785        after 2000 afterawhile
786        return
787    }
788    if {![file exists $expgui(expfile)]} {
789        after 2000 afterawhile
790        return
791    }
792    if {[file mtime $expgui(expfile)] != $expgui(expModifiedLast)} {
793        # we are "locked". Note that whenidle loop will be restarted later
794        if {$tcl_platform(platform) == "windows" && [file exists expgui.lck]} {
795            return
796        }
797        set ans [ReloadExpMsg [file tail $expgui(expfile)] $expgui(changed)]
798
799        if {$ans == 0} {
800            loadexp $expgui(expfile)
801        } elseif {$ans == 1} {
802            # reset the time to the next version
803            set expgui(expModifiedLast) [file mtime $expgui(expfile)]
804        } elseif {$ans == 2} {
805            SaveAsFile
806        }
807    }
808    after 2000 afterawhile
809}
810
811# place a message about changes over the main window
812proc ReloadExpMsg {file changes} {
813    global expgui tcl_platform
814    set msg "File $file has been modified by another program"
815    if {$changes == 1} {
816        append msg " and you have made a change to this version.\n"
817    } elseif {$changes > 0} {
818        append msg " and you have made $changes changes to this version.\n"
819    } else {
820        append msg ".\n"
821    }
822    append msg "Do you want to use the newer (modified) version or continue with the older (previous) version of the file?"
823
824    set w .ask
825    catch {destroy $w}
826    toplevel $w -class Dialog
827    wm title $w "Reload?"
828    wm iconname $w "Reload?"
829    wm protocol $w WM_DELETE_WINDOW { }
830    wm transient $w .
831    bind $w <Key-F1> "MakeWWWHelp expguierr.html Overwrite"
832    pack [button $w.help -text Help -bg yellow \
833            -command "MakeWWWHelp expguierr.html Overwrite"] \
834            -side top -anchor e
835    frame $w.bot
836    pack $w.bot -side bottom
837    frame $w.top -class FixedFont
838    pack $w.top -side top -fill both -expand 1
839    label $w.top.msg -justify left \
840            -wraplength 5i -font {Times 18} \
841            -text $msg 
842    if {$tcl_platform(platform) == "windows"} {
843        $w.top.msg config -font {Times 14}
844    }
845    pack $w.top.msg  -side right -expand 1 -fill both -padx 3m -pady 3m
846    pack [button $w.bot.1 -text "Load new" \
847            -default active -command "set expgui(dialogbutton) 0" \
848            ] -side left -expand 1 -padx 3m -pady 2m
849    pack [button $w.bot.2 -text "Continue with old" \
850            -command "set expgui(dialogbutton) 1"] \
851            -side left -expand 1 -padx 3m -pady 2m
852    if {$changes > 0} {
853        pack [button $w.bot.3 -text "Save edited version" \
854            -command "set expgui(dialogbutton) 2"] \
855            -side left -expand 1 -padx 3m -pady 2m
856    }
857    # Create a binding for <Return> on the dialog
858    bind $w <Return> "$w.bot.1 invoke"
859    wm withdraw $w
860    update idletasks
861
862    # for windows put the box in the upper left, for
863    # unix center it over the parent (in unix it appears later)
864    #if {$tcl_platform(platform) == "windows"} {
865        #wm geom $w +0+0
866    #} else {
867
868    # compute widths with a catch, since this has been showing an error
869    # at least for one Mac user
870    set askwid 40
871    catch {set askwid [winfo reqwidth $w]}
872    set askhgt 80
873    catch {set askhgt [winfo reqheight $w]}
874        # for now, always center the message over the main window
875        # center the new window in the middle of the parent
876        set x [expr [winfo x .] + [winfo width .]/2 - \
877                $askwid/2 - [winfo vrootx .]]
878        set y [expr [winfo y .] + [winfo height .]/2 - \
879                $askhgt/2 - [winfo vrooty .]]
880        wm geom $w +$x+$y
881    #}
882    wm deiconify $w
883
884    # Grab the focus
885    set oldFocus [focus]
886    set oldGrab [grab current $w]
887    if {[string compare $oldGrab ""]} {
888        set grabStatus [grab status $oldGrab]
889    }
890    catch {grab $w}
891    focus $w.bot.1
892    # for windows rearrange window stacking
893    # -- Removed since this will normally happen after the GSAS program
894    # has finished
895    #if {$tcl_platform(platform) == "windows"} {
896        #lower .
897        #raise $w .
898    #}
899    update idletasks
900
901    tkwait variable expgui(dialogbutton)
902    catch {focus $oldFocus}
903    destroy $w
904    if {[string compare $oldGrab ""]} {
905        if {![string compare $grabStatus "global"]} {
906            catch {grab -global $oldGrab}
907        } else {
908            catch {grab $oldGrab}
909        }
910    }
911    # for windows rearrange window stacking
912    #if {$tcl_platform(platform) == "windows"} {
913        #raise .
914    #}
915    return $expgui(dialogbutton)
916}
917
918# --------  called to confirm before exiting
919proc catchQuit {} {
920    if {[confirmBeforeSave] == "Continue"} {
921        destroy .
922    }
923}
924# save the .EXP file before exiting?
925proc confirmBeforeSave {} {
926    global expgui
927    if !$expgui(changed) {
928        return "Continue"
929    }
930    set decision [tk_dialog .instrSaveData {Save .EXP changes} \
931            {You have made changes to the Experiment, but the changes are not saved. Select an option:} \
932            {} 0 "Save and Exit" "Exit without Save" "Cancel exit command"]
933    switch $decision {
934        0 { savearchiveexp;  return "Continue" }
935        1 {                  return "Continue" }
936        2 {                  return "Cancel"   }
937    }
938}
939
940# setup buttons for each phase on the phase page
941proc setphases {} {
942    global expgui expmap
943    eval destroy [winfo children $expgui(phaseFrame).top.ps]
944    pack [label $expgui(phaseFrame).top.ps.0 -text Phase:] -side left
945    foreach num $expmap(phaselist) {
946        pack [button $expgui(phaseFrame).top.ps.$num -text $num \
947                -command "SelectOnePhase $num" -padx 1.5m] -side left
948    }
949    if {[file executable $expgui(exptool)] && \
950            [llength $expmap(phaselist)]} {
951        pack [button $expgui(phaseFrame).top.ps.10 \
952                -text "Replace" -command MakeReplacePhaseBox \
953                ] -side left
954    }
955}
956
957# Procedure to respond to changes the phase.
958#  This loads the "phases" widgets with data corresponding to the selected phase.
959proc SelectOnePhase {num} {
960    global entryvar entrycmd entrybox expmap expgui
961    # if no phase has been selected, select the first one
962    if {$num == ""} {set num [lindex $expmap(phaselist) 0]}
963
964    set crsPhase {}
965    $expgui(atomxform) config -text "Xform Atoms" -state disabled
966    foreach n $expmap(phaselist) type $expmap(phasetype) {
967        if {$n == $num} {
968            catch {$expgui(phaseFrame).top.ps.$num config -relief sunken}
969            set crsPhase $num
970            if {$type == 3} {
971                set expgui(phasetype) "Magnetic\nOnly"
972            } elseif {$type == 2} {
973                set expgui(phasetype) "Magnetic\n& Nuclear"
974            } elseif {$type == 4} {
975                set expgui(phasetype) "Macromolecular"
976            } elseif {$type == 10} {
977                set expgui(phasetype) "Pawley"
978            } else {
979                set expgui(phasetype) ""
980            }
981        } else { 
982            catch {$expgui(phaseFrame).top.ps.$n config -relief raised}
983        }
984    }
985    # no phase is selected
986    if {$crsPhase == "" || [llength $expmap(phaselist)] == 0} {
987        # disable traces on entryvar
988        set entrycmd(trace) 0
989        set entrycmd(phasename) ""
990        set entryvar(phasename) ""
991        foreach ent {a b c alpha beta gamma} {
992            set entryvar($ent) ""
993        }
994        foreach ent {cellref celldamp} {
995            set entrycmd($ent) ""
996            set entryvar($ent) ""
997        }
998        set expgui(curPhase) {}
999        # enable traces on entryvar
1000        set entrycmd(trace) 1
1001        $expgui(EditingAtoms) config -text ""
1002        DisplayAtom 0 0
1003        DisplayU 0 0
1004        DisplayRefFlags 0 0
1005        $expgui(atomlistbox) delete 0 end
1006        return
1007    }
1008
1009    # don't reload the last displayed phase
1010    if {$expgui(curPhase) == $crsPhase} return
1011
1012    ##########################################################
1013    # load and display a phase
1014    ##########################################################
1015    # disable traces on entryvar while loading
1016    set entrycmd(trace) 0
1017    # phase title
1018    set entrycmd(phasename) "phaseinfo $crsPhase name"
1019    set entryvar(phasename) [phaseinfo $crsPhase name]
1020    # cell parameters & flags
1021    foreach ent {a b c alpha beta gamma} {
1022        set entryvar($ent) [phaseinfo $crsPhase $ent]
1023    }
1024    foreach ent {cellref celldamp} {
1025        set entrycmd($ent) "phaseinfo $crsPhase $ent"
1026        set entryvar($ent) [phaseinfo $crsPhase $ent]
1027    }
1028
1029    # initialize atoms display & disable
1030    DisplayAtom 0 0
1031    DisplayU 0 0
1032    DisplayRefFlags 0 0
1033    $expgui(EditingAtoms) config -text ""
1034
1035    DisplayAllAtoms $crsPhase
1036
1037    # enable traces on entryvar now
1038    set entrycmd(trace) 1
1039}
1040
1041set expgui(noreenterDisplayAllAtoms) 0
1042# Populate expgui(atomlistbox) (a ScrolledListBox) with atoms
1043# from the selected phase.
1044proc DisplayAllAtoms {curPhase "mode reset"} {
1045    global entryvar entrycmd expmap expgui
1046    # make sure that atomlistboxcontents element exists
1047    if {[catch {set expmap(atomlistboxcontents)}]} {
1048        set expmap(atomlistboxcontents) {}
1049    }
1050    # if it does not show, we don't have a phase or we are already displaying
1051    # don't bother
1052    if {$expgui(pagenow) != "phaseFrame"} return
1053    if {$curPhase == ""} return
1054    if $expgui(noreenterDisplayAllAtoms) return
1055    # prevent reentry
1056    set expgui(noreenterDisplayAllAtoms) 1
1057    # set the current phase
1058    set expgui(curPhase) $curPhase
1059    if {$mode != "reset"} {
1060        # save the scrolled position
1061        set pos [lindex [$expgui(atomlistbox) yview] 0]
1062    } else {
1063        # for reset, do not keep the previously selected atoms
1064        set expgui(selectedatomlist) {}
1065    }
1066    $expgui(atomlistbox) delete 0 end
1067    # displaying a macromolecular phase?
1068    if {[lindex $expmap(phasetype) [expr {$expgui(curPhase) - 1}]] == 4} {
1069        set mm 1
1070        $expgui(phaseFrame).top.ps.10 config -state disabled
1071        $expgui(AddAtomBut)  config -state disabled
1072        pleasewait "loading atoms..."
1073    } else {
1074        set mm 0
1075        if {[file executable $expgui(exptool)]} {
1076            $expgui(phaseFrame).top.ps.10 config -state normal
1077            $expgui(AddAtomBut) config -state normal
1078        }
1079    }
1080
1081    # prepare header info
1082    set maxline I
1083    set phase $expgui(curPhase)
1084    set atomlist {}
1085    set typehead "type  "
1086    set namehead "  name  "
1087    set multhead "Mult"
1088    set coordhead "   "
1089    if {$mm} {
1090        set cmd mmatominfo
1091        set frachead "Occ."
1092    } else {
1093        set cmd atominfo
1094        set frachead "Occupancy"
1095    }
1096    set reshead "res/grp/#"
1097    # sort the atoms, as requested
1098    if  {$expgui(asorttype) == "type"} {
1099        # sort on atom type
1100        set typehead "type* "
1101        foreach atom $expmap(atomlist_$phase) {
1102            lappend atomlist "$atom [$cmd $phase $atom type] $phase"
1103        }
1104        set expmap(atomlistboxcontents) [lsort -ascii -index 1 $atomlist]
1105    } elseif {$expgui(asorttype) == "number"} {
1106        # sort on atom number
1107        set namehead "* name  "
1108        foreach atom $expmap(atomlist_$phase) {
1109            lappend atomlist "$atom $atom $phase"
1110        }
1111        set expmap(atomlistboxcontents) [lsort -integer -index 1 $atomlist]
1112    } elseif {$expgui(asorttype) == "mult"} {
1113        if {$mm} {
1114            set reshead "res*/grp/#"
1115            foreach atom $expmap(atomlist_$phase) {
1116                lappend atomlist "$atom [mmatominfo $phase $atom residue] $phase"
1117            }
1118            set expmap(atomlistboxcontents) [lsort -ascii -index 1 $atomlist]
1119        } else {
1120            # sort on atom number
1121            set multhead "Mlt*"
1122            foreach atom $expmap(atomlist_$phase) {
1123                lappend atomlist "$atom [atominfo $phase $atom mult] $phase"
1124            }
1125            set expmap(atomlistboxcontents) [lsort -integer -decreasing -index 1 $atomlist]
1126        }
1127    } elseif {$expgui(asorttype) == "occupancy"} {
1128        # sort on atom number
1129        if {$mm} {
1130            set frachead "  Occ* "
1131        } else {
1132            set frachead "  Occup* "
1133        }
1134        foreach atom $expmap(atomlist_$phase) {
1135            lappend atomlist "$atom [$cmd $phase $atom frac] $phase"
1136        }
1137        set expmap(atomlistboxcontents) [lsort -real -decreasing -index 1 $atomlist]
1138    } elseif {$expgui(asorttype) == "x"} {
1139        # sort on x
1140        set coordhead "(x*)"
1141        foreach atom $expmap(atomlist_$phase) {
1142            lappend atomlist "$atom [$cmd $phase $atom x] $phase"
1143        }
1144        set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
1145    } elseif {$expgui(asorttype) == "y"} {
1146        # sort on y
1147        set coordhead "(y*)"
1148        foreach atom $expmap(atomlist_$phase) {
1149            lappend atomlist "$atom [$cmd $phase $atom y] $phase"
1150        }
1151        set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
1152    } elseif {$expgui(asorttype) == "z"} {
1153        # sort on z
1154        set coordhead "(z*)"
1155        foreach atom $expmap(atomlist_$phase) {
1156            lappend atomlist "$atom [$cmd $phase $atom z] $phase"
1157        }
1158        set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
1159    } else {
1160        error "Bad expgui(asorttype) = $expgui(asorttype)"
1161    }
1162
1163    set expgui(atomlistboxline) {}
1164    # loop over atoms
1165    foreach tuple $expmap(atomlistboxcontents) {
1166        set atom [lindex $tuple 0]
1167        set phase [lindex $tuple 2]
1168        lappend expgui(atomlistboxline) $atom
1169        $expgui(atomlistbox) insert end \
1170                [FormatAtomLine $atom $phase maxline]
1171    }
1172    $expgui(atomtitle) delete 0 end
1173
1174    # create the header
1175    if {$mm} {
1176        $expgui(atomtitle) insert end [format "%12s %9s  %6s %8s%29s %4s  %s" \
1177                $namehead $reshead $typehead "ref/damp  " \
1178                "fractional coordinates$coordhead" \
1179                "$frachead" \
1180                " Uiso"]
1181        donewait
1182    } elseif {$maxline == "A"} {
1183        $expgui(atomtitle) insert end [format "%10s %6s %8s%29s %9s  %s" \
1184                $namehead $typehead "ref/damp  " \
1185                "fractional coordinates$coordhead" \
1186                "$multhead $frachead" \
1187                " Uiso/Uij                                            "]
1188    } else {
1189        $expgui(atomtitle) insert end [format "%10s %6s %8s%29s %9s  %s" \
1190                $namehead $typehead "ref/damp  " \
1191                "fractional coordinates$coordhead" \
1192                "$multhead $frachead" \
1193                " Uiso"]
1194    }
1195    if {$mode != "reset"} {
1196        # restore the selected items
1197        foreach i $expgui(selectedatomlist) {
1198            $expgui(atomlistbox) selection set $i
1199        }
1200        # restore the last scrolled position
1201        $expgui(atomlistbox) yview moveto $pos
1202    }
1203    # clear the reentry flag
1204    set expgui(noreenterDisplayAllAtoms) 0
1205}
1206
1207proc FormatAtomLine {atom phase maxline_var} {
1208    global expmap
1209    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1210        foreach type {x u f} {
1211            if {[mmatominfo $phase $atom ${type}ref]} {
1212                append refflag "[string toupper $type][mmatominfo $phase $atom ${type}damp] "
1213            } else {
1214                append refflag " [mmatominfo $phase $atom ${type}damp] "
1215            }   
1216        }
1217        set line [format \
1218                "%5d %-6s %-3s%-2s%4d  %-6s %8s %9.5f%9.5f%9.5f%8.4f %7.4f" \
1219                $atom \
1220                [mmatominfo $phase $atom label] \
1221                [mmatominfo $phase $atom residue] \
1222                [mmatominfo $phase $atom group] \
1223                [mmatominfo $phase $atom resnum] \
1224                [mmatominfo $phase $atom type] \
1225                $refflag \
1226                [mmatominfo $phase $atom x] \
1227                [mmatominfo $phase $atom y] \
1228                [mmatominfo $phase $atom z] \
1229                [mmatominfo $phase $atom frac] \
1230                [mmatominfo $phase $atom Uiso] 
1231        ]
1232    } elseif {[atominfo $phase $atom temptype] == "A"} {
1233        foreach type {x u f} {
1234            if {[atominfo $phase $atom ${type}ref]} {
1235                append refflag "[string toupper $type][atominfo $phase $atom ${type}damp] "
1236            } else {
1237                append refflag " [atominfo $phase $atom ${type}damp] "
1238            }
1239        }
1240        # want to set maxline in parent
1241        upvar $maxline_var maxline
1242        set maxline A
1243        # aniso
1244        set line [format "%3d %-6s %-6s %8s %10.6f%10.6f%10.6f%4d%9.4f" \
1245                $atom \
1246                [atominfo $phase $atom label] \
1247                [atominfo $phase $atom type] \
1248                $refflag \
1249                [atominfo $phase $atom x] \
1250                [atominfo $phase $atom y] \
1251                [atominfo $phase $atom z] \
1252                [atominfo $phase $atom mult] \
1253                [atominfo $phase $atom frac] 
1254        ]
1255        append line [format "  %9.5f%9.5f%9.5f%9.5f%9.5f%9.5f" \
1256                [atominfo $phase $atom U11] \
1257                [atominfo $phase $atom U22] \
1258                [atominfo $phase $atom U33] \
1259                [atominfo $phase $atom U12] \
1260                [atominfo $phase $atom U23] \
1261                [atominfo $phase $atom U13] 
1262        ]
1263    } else {
1264        foreach type {x u f} {
1265            if {[atominfo $phase $atom ${type}ref]} {
1266                append refflag "[string toupper $type][atominfo $phase $atom ${type}damp] "
1267            } else {
1268                append refflag " [atominfo $phase $atom ${type}damp] "
1269            }   
1270        }
1271        set line [format \
1272                "%3d %-6s %-6s %8s %10.6f%10.6f%10.6f%4d%9.4f  %9.5f" \
1273                $atom \
1274                [atominfo $phase $atom label] \
1275                [atominfo $phase $atom type] \
1276                $refflag \
1277                [atominfo $phase $atom x] \
1278                [atominfo $phase $atom y] \
1279                [atominfo $phase $atom z] \
1280                [atominfo $phase $atom mult] \
1281                [atominfo $phase $atom frac] \
1282                [atominfo $phase $atom Uiso] 
1283        ]
1284    }
1285    return $line
1286}
1287
1288# update the display of atom as they are changed
1289proc UpdateAtomLine {atomlist phase} {
1290    global expgui
1291    # for lots of atoms, it is faster to repaint the listbox
1292    if {[llength $atomlist] > 25} {
1293        DisplayAllAtoms $expgui(curPhase) noreset
1294        return
1295    }
1296    foreach atom $atomlist {
1297        set linenum [lsearch -exact $expgui(atomlistboxline) $atom]
1298        $expgui(atomlistbox) delete $linenum
1299        $expgui(atomlistbox) insert $linenum \
1300                [FormatAtomLine $atom $phase maxline]
1301    }
1302    # restore the selected items
1303    foreach i $expgui(selectedatomlist) {
1304        $expgui(atomlistbox) selection set $i
1305    }
1306}
1307
1308# Procedure to select all atoms in response to a right-click
1309proc SelectAllAtoms {} {
1310    global expgui
1311    $expgui(atomlistbox) selection set 0 end
1312    # call editRecord in case trace was called before the selection was made
1313    editRecord
1314}
1315
1316# Procedure to respond to left mouse release in the atoms Pane
1317proc editRecord { args } {
1318    global entrycmd expgui
1319    set expgui(selectedatomlist) [$expgui(atomlistbox) curselection]
1320    # disable traces on entryvar for right now
1321    set entrycmd(trace) 0
1322
1323    if {[llength $expgui(selectedatomlist)] == 0} {
1324        if $expgui(debug) {error "Attempt display non-existent atoms"}
1325    } elseif {[llength $expgui(selectedatomlist)] == 1} {
1326        editOneRecord $expgui(selectedatomlist)
1327    } else {
1328        editMultipleRecords $expgui(selectedatomlist)
1329    }
1330    # reenable traces on entryvar
1331    set entrycmd(trace) 1
1332    # repaint the atoms box in case anything was changed
1333    #    DisplayAllAtoms noreset
1334}
1335
1336proc editOneRecord { AtomIndex } {
1337    global expmap expgui
1338    # make sure that atomlistboxcontents element exists
1339    if {[catch {set expmap(atomlistboxcontents)}]} return
1340
1341    # get atom number & phase
1342    set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
1343    set atomnum [lindex $tuple 0]
1344    set p [lindex $tuple 2]
1345    DisplayU $atomnum $p
1346    DisplayAtom $atomnum $p
1347    DisplayRefFlags $atomnum $p
1348    $expgui(EditingAtoms) config -text "Editing atom #$atomnum -- [atominfo $p $atomnum label]"
1349    $expgui(atomxform) config -text "Xform Atom" -state normal
1350}
1351
1352# this will not work for a multi-phase list of atoms (yet)
1353proc editMultipleRecords { AtomIndexList } {
1354    global expmap expgui
1355    # make sure that atomlistboxcontents element exists
1356    if {[catch {set expmap(atomlistboxcontents)}]} return
1357
1358    set numberList {}
1359    # current phase
1360    set p $expgui(curPhase)
1361    foreach AtomIndex $AtomIndexList {
1362        # get atom number & phase
1363        set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
1364        lappend numberList [lindex $tuple 0]
1365#       set p [lindex $tuple 2]
1366    }
1367    # this needs to track by phase
1368    $expgui(EditingAtoms) config -text \
1369            "Set refinement options: atoms [CompressList $numberList]"
1370    DisplayU 0 0
1371    DisplayAtom 0 0
1372    # this needs to track by phase
1373    DisplayRefFlags $numberList $p
1374    $expgui(atomxform) config -text "Xform Atoms" -state normal
1375}
1376
1377# format a string of numbers to save space, e.g. "1 2 3 4 6 7 19 13 14 15"
1378# becomes "1-4,6,7,13-15,19"
1379proc CompressList {numberList "max 9999"} {
1380    # format the number list to save space
1381    set lastnum -99
1382    set flist {}
1383    set count 0
1384    set length 0
1385    if [catch {set sortlist [lsort -integer $numberList]}] {return $numberList}
1386    foreach num $sortlist {
1387        set next [expr $lastnum+1]
1388        if {$num != $next} {
1389            if {$count == 0 && $flist != ""} {
1390                if {[string length $flist] - $length > $max} {
1391                    set length [string length $flist]
1392                    append flist ",\n$num"
1393                } else {
1394                    append flist ",$num"
1395                }
1396            } elseif {$count == 1 && $flist != ""} {
1397                if {[string length $flist] - $length > $max} {
1398                    set length [string length $flist]
1399                    append flist ",$lastnum,\n$num"
1400                } else {
1401                    append flist ",$lastnum,$num"
1402                }
1403            } elseif {$flist != ""} {
1404                if {[string length $flist] - $length > $max} {
1405                    set length [string length $flist]
1406                    append flist "-$lastnum,\n$num"
1407                } else {
1408                    append flist "-$lastnum,$num"
1409                }
1410            } else {
1411                append flist "$num"
1412            }
1413            set lastnum $num
1414            set count 0
1415        } else {
1416            incr count
1417            incr lastnum
1418        }
1419    }
1420    if {$count == 1 && $flist != ""} {
1421        append flist ",$lastnum"
1422    } elseif {$flist != "" && $count > 1} {
1423        append flist "-$lastnum"
1424    }
1425    return $flist
1426}
1427
1428# Procedure to display Isotropic or Anisotropic temperature factors
1429#  Changes the display to one entry widget for Isotropic motion OR
1430#   6 entry widgets for Anisotropic motion in Frame3.
1431#   or disables the widet entirly if atom = 0
1432proc DisplayU { atomnum p} {
1433    global expgui entryvar entrycmd expmap
1434    set mm 0
1435    if {$atomnum == 0} {
1436        set iOrA disable
1437    } elseif {[lindex $expmap(phasetype) 0] == 4} {
1438        set mm 1
1439        set iOrA I
1440    } else {
1441        set iOrA [atominfo $p $atomnum temptype]
1442    }
1443
1444    set firstbox [lindex $expgui(anisolabels) 0]
1445    if { $iOrA == "A" } {
1446        $firstbox config -text "U11 "
1447        foreach item $expgui(anisolabels) {
1448            $item config -fg black
1449        }
1450        foreach item $expgui(anisoentry) var {U11 U22 U33 U12 U13 U23} {
1451            set entrycmd($var) "atominfo $p $atomnum $var"
1452            set entryvar($var) [eval $entrycmd($var)]
1453            $item config -fg black -state normal  -bg white
1454        }
1455    } elseif { $iOrA == "I" || $iOrA == "disable"} {
1456        foreach item $expgui(anisolabels) {
1457            $item config -fg $expgui(bkgcolor1)
1458        }
1459        foreach item [lrange $expgui(anisoentry) 1 end] \
1460                var {U22 U33 U12 U13 U23} {
1461            set entrycmd($var) ""
1462            set entryvar($var) ""
1463            $item config -fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1) \
1464                    -state disabled
1465        }
1466        if { $iOrA == "disable"} {
1467            set entrycmd($var) ""
1468            set entryvar($var) ""
1469            [lindex $expgui(anisoentry) 0] config \
1470                    -fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1) \
1471                    -state disabled
1472        } elseif {$mm} {
1473            set entrycmd(U11) "mmatominfo $p $atomnum Uiso"
1474            set entryvar(U11) [eval $entrycmd(U11)]
1475            $firstbox config -text Uiso -fg black
1476            [lindex $expgui(anisoentry) 0] config -fg black -bg white -state normal
1477        } else {
1478            set entrycmd(U11) "atominfo $p $atomnum Uiso"
1479            set entryvar(U11) [eval $entrycmd(U11)]
1480            $firstbox config -text Uiso -fg black
1481            [lindex $expgui(anisoentry) 0] config -fg black -bg white -state normal
1482        }
1483    }
1484}
1485
1486# need to think about multiple phases
1487
1488# Procedure to display refinement flags
1489proc DisplayRefFlags { atomnum p} {
1490    global expgui entryvar entrycmd expmap
1491    if {$atomnum == 0} {
1492        foreach label $expgui(atomreflbl) {
1493            $label config -fg $expgui(bkgcolor1)
1494        }
1495        foreach entry $expgui(atomref) {
1496            $entry config -state disabled \
1497                    -fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1)
1498            # turn off checkbuttons
1499            catch {$entry deselect}
1500
1501        }
1502        return
1503    }
1504    foreach label $expgui(atomreflbl) {
1505        $label config -fg black
1506    }
1507    foreach entry $expgui(atomref) {
1508        $entry config -state normal -fg black -bg $expgui(bkgcolor1)
1509    }
1510    if {[lindex $expmap(phasetype) 0] == 4} {
1511        foreach var {xref uref fref xdamp udamp fdamp}  {
1512            set entrycmd($var) "mmatominfo $p [list $atomnum] $var"
1513            set entryvar($var) [eval $entrycmd($var)]
1514        }
1515    } else {
1516        foreach var {xref uref fref xdamp udamp fdamp}  {
1517            set entrycmd($var) "atominfo $p [list $atomnum] $var"
1518            set entryvar($var) [eval $entrycmd($var)]
1519        }
1520    }
1521}
1522
1523# Procedure to display an atom in the atom edit boxes
1524proc DisplayAtom { atomnum p} {
1525    global expgui entryvar entrycmd expmap
1526    if {$atomnum == 0} {
1527        foreach label $expgui(atomlabels) {
1528            $label config -fg $expgui(bkgcolor1)
1529        }
1530        foreach entry $expgui(atomentry) {
1531            $entry config -state disabled \
1532                    -fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1)
1533        }
1534        return
1535    }
1536    foreach label $expgui(atomlabels) {
1537        $label config -fg black
1538    }
1539    foreach entry $expgui(atomentry) {
1540        $entry config -state normal -fg black -bg white
1541    }
1542    if {[lindex $expmap(phasetype) 0] == 4} {
1543        foreach var {x y z label frac } {
1544            set entrycmd($var) "mmatominfo $p $atomnum $var"
1545            set entryvar($var) [eval $entrycmd($var)]
1546        }
1547    } else {
1548        foreach var {x y z label frac } {
1549            set entrycmd($var) "atominfo $p $atomnum $var"
1550            set entryvar($var) [eval $entrycmd($var)]
1551        }
1552    }
1553}
1554
1555# make a histogram box; used in MakeHistPane,
1556proc MakeHistBox {frm} {
1557    global expgui
1558    grid [label $frm.mode -text "Select a Histogram" \
1559            -bg beige -anchor center] \
1560            -row 0 -column 0 -columnspan 2 -sticky ew
1561    bind $frm.mode <Button-1> {
1562        set i [lsearch $expgui(AllowedHistSelectModes) $expgui(globalmode)]
1563        set expgui(globalmode) [lindex \
1564                "$expgui(AllowedHistSelectModes) \
1565                $expgui(AllowedHistSelectModes)" [incr i]]
1566        sethistlist
1567    }
1568    bind $frm.mode <Button-3> {set expgui(globalmode) 0; sethistlist}
1569    grid [listbox $frm.title -height 1 -relief flat \
1570            -exportselection 0 ] -row 1 -column 0 -sticky ew
1571    grid [listbox $frm.lbox -height 10 -width 25 \
1572            -exportselection 0 \
1573            -xscrollcommand "$frm.x set" \
1574            -yscrollcommand "$frm.y set" \
1575            ] -row 2 -column 0 -sticky news
1576    lappend expgui(HistSelectList) $frm
1577    grid [scrollbar $frm.x -orient horizontal \
1578            -command "move2boxesX \" $frm.title $frm.lbox \" " 
1579    ] -row 3 -column 0 -sticky ew
1580    grid [scrollbar $frm.y \
1581            -command "$frm.lbox yview"] \
1582            -row 2 -column 1 -sticky ns
1583    grid columnconfigure $frm 0 -weight 1
1584    grid rowconfigure $frm 2 -weight 1
1585}
1586
1587# update the histogram list
1588# to do: show histogram ref flags?
1589proc sethistlist {} {
1590    global expgui expmap
1591    array set lbl {
1592        1 "Select 1 or more\nTOF Histograms"
1593        2 "Select 1 or more\nCW Neutron Histograms"
1594        3 "Select 1 or more\nAlpha 1,2 X-ray Histograms"
1595        4 "Select 1 or more\nmonochromatic X-ray Histograms"
1596        5 "Select 1 or more Energy\nDispersive X-ray Histograms"
1597        6 "Select 1 or more of\n any type Histograms"
1598    }
1599    foreach lbox $expgui(HistSelectList) {
1600        $lbox.title delete 0 end
1601        $lbox.lbox delete 0 end
1602        if {$expgui(globalmode) != 0} {
1603            $lbox.lbox config -selectmode extended
1604            $lbox.mode config -text $lbl($expgui(globalmode)) -bg yellow
1605        } else {
1606            $lbox.lbox config -selectmode browse
1607            $lbox.mode config -text "Select a histogram" -bg beige
1608        }
1609    }
1610    # disable the unallowed pages in all mode
1611    if {$expgui(globalmode) == 6} {
1612        foreach pair $expgui(GlobalModeAllDisable) {
1613            if {$expgui(pagenow) == [lindex $pair 0]} {
1614                RaisePage lsFrame
1615            }
1616            eval [lindex $pair 1] -state disabled
1617        }
1618    } else {
1619        foreach pair $expgui(GlobalModeAllDisable) {
1620            eval [lindex $pair 1] -state normal
1621        }
1622    }
1623    set histlist {}
1624    if  {$expgui(hsorttype) == "type"} {
1625        # sort on histogram type
1626        foreach h [lsort -integer -increasing $expmap(powderlist)] {
1627            lappend histlist "$h [string range $expmap(htype_$h) 1 2]"
1628        }
1629        set expmap(histlistboxcontents) [lsort -ascii -index 1 $histlist]
1630    } elseif {$expgui(hsorttype) == "number"} {
1631        # sort on histogram number
1632        foreach h [lsort -integer -increasing $expmap(powderlist)] {
1633            lappend histlist "$h $h"
1634        }
1635        set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
1636    } elseif {$expgui(hsorttype) == "bank"} {
1637        # sort on original bank number
1638        foreach h [lsort -integer -increasing $expmap(powderlist)] {
1639            lappend histlist "$h [histinfo $h bank]"
1640        }
1641        set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
1642    } elseif {$expgui(hsorttype) == "angle"} {
1643        # sort on wavelength (CW) or angle (E disp.)
1644        foreach h [lsort -integer -increasing $expmap(powderlist)] {
1645            if {[string range $expmap(htype_$h) 2 2] == "T"} {
1646                set det [format %8.2f [histinfo $h tofangle]]
1647            } elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
1648                set det [format %8.5f [histinfo $h lam1]]
1649            } elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
1650                set det [format %8.2f [histinfo $h lam1]]
1651            } else {
1652                set det {}
1653            }
1654            lappend histlist "$h $det"
1655        }
1656        set expmap(histlistboxcontents) [lsort -real -index 1 $histlist]
1657    }
1658
1659    # title field needs to match longest title
1660    foreach lbox $expgui(HistSelectList) {
1661        $lbox.title insert end [format "%2s %s %4s %8s  %-67s" \
1662                "h#" \
1663                type \
1664                bank \
1665                "ang/wave" \
1666                "    title" \
1667                ]
1668    }
1669    foreach tuple $expmap(histlistboxcontents) {
1670        set h [lindex $tuple 0]
1671
1672        if {$expgui(globalmode) == 1} {
1673            if {[string range $expmap(htype_$h) 2 2] != "T"} continue
1674        } elseif {$expgui(globalmode) == 2} {
1675            if {[string range $expmap(htype_$h) 1 2] != "NC"} continue
1676        } elseif {$expgui(globalmode) == 3} {
1677            if {[string range $expmap(htype_$h) 1 2] != "XC" || \
1678                    [histinfo $h lam2] == 0.0} continue
1679        } elseif {$expgui(globalmode) == 4} {
1680            if {[string range $expmap(htype_$h) 1 2] != "XC" || \
1681                    [histinfo $h lam2] != 0.0} continue
1682        } elseif {$expgui(globalmode) == 5} {
1683            if {[string range $expmap(htype_$h) 1 2] != "XE"} continue
1684        }
1685
1686        if {[string range $expmap(htype_$h) 2 2] == "T"} {
1687            set det [format %8.2f [histinfo $h tofangle]]
1688        } elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
1689            set det [format %8.5f [histinfo $h lam1]]
1690        } elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
1691            set det [format %8.2f [histinfo $h lam1]]
1692        } else {
1693            set det {}
1694        }
1695        foreach lbox $expgui(HistSelectList) {
1696            $lbox.lbox insert end [format "%2d  %s %4d %8s  %-67s" \
1697                    $h \
1698                    [string range $expmap(htype_$h) 1 3] \
1699                    [histinfo $h bank] \
1700                    $det \
1701                    [string range [histinfo $h title] 0 66] \
1702                    ]
1703        }
1704    }
1705    UpdateCurrentPage
1706}
1707
1708proc UpdateCurrentPage {} {
1709    global expgui
1710    foreach set $expgui(frameactionlist) {
1711        if {$expgui(pagenow) == [lindex $set 0]} {catch [lindex $set 1]}
1712    }
1713}
1714
1715#-----------------------------------------------------------------------
1716# ----------- draw Histogram page
1717#-----------------------------------------------------------------------
1718proc DisplayHistogram {} {
1719    global expgui entrycmd entryvar entrybox expmap
1720
1721    # trap if more than one histogram is selected unless global mode
1722    if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
1723        set expgui(curhist) [lindex $expgui(curhist) 0] 
1724    }
1725
1726    # disable the add histogram button if no phases are present
1727    catch {
1728        foreach c [winfo children $expgui(histFrame).bb] {
1729            if {[llength $expmap(phaselist)] == 0} {
1730                $c configure -state disabled
1731            } else {
1732                $c configure -state normal
1733            } 
1734        }
1735    }
1736
1737    # display the selected histograms
1738    $expgui(histFrame).hs.lbox selection clear 0 end
1739    foreach h $expgui(curhist) {
1740        $expgui(histFrame).hs.lbox selection set $h
1741    }
1742
1743    # disable traces on entryvar for right now
1744    set entrycmd(trace) 0
1745
1746    # get histogram list
1747    set histlist {}
1748    foreach item $expgui(curhist) {
1749        lappend histlist [lindex $expmap(powderlist) $item]
1750    }
1751    # must have at least one histogram selected here
1752    if {[llength $histlist] == 0} {
1753        set expgui(backtermlbl) ""
1754        set expgui(backtypelbl) ""
1755        foreach var {bref bdamp absref absdamp} {
1756            set entrycmd($var) ""
1757            set entryvar($var) ""
1758        }
1759        $expgui(histFrame).top.txt config -text "No Selected Histograms"
1760        grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew       
1761        set expgui(bkglbl) ""
1762        set expgui(abslbl) ""
1763        eval destroy [winfo children $expgui(diffBox)]
1764        set entrycmd(trace) 1
1765        return
1766    }
1767
1768    if {$expgui(globalmode) != 0} {
1769        set expgui(backtermlbl) ""
1770        set expgui(backtypelbl) ""
1771        foreach var {bref bdamp absref absdamp} {
1772            set entrycmd($var) "histinfo [list $histlist] $var"
1773            set entryvar($var) [histinfo [lindex $histlist 0] $var]
1774        }
1775    } else {
1776        set hist $histlist
1777        set terms [histinfo $hist backterms]
1778        set expgui(backtermlbl) "($terms terms)"
1779        # background type 3 & 9 have gone away
1780        if {[histinfo $hist backtype] == 3 || [histinfo $hist backtype] == 9} {
1781            MyMessageBox -parent . -title "Background Change" \
1782                -type ok -default ok \
1783                -icon warning \
1784                -message "Background function #[histinfo $hist backtype] is no longer supported -- the function will now be changed to type #1 & the values reset"
1785            histinfo $histlist backtype set 1
1786            incr expgui(changed)
1787            for {set num 1 } { $num <= $terms } { incr num } {
1788                set var "bterm$num"
1789                histinfo $histlist $var set 0
1790                incr expgui(changed)
1791            }
1792        }
1793        set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
1794        foreach var {bref bdamp absref absdamp} {
1795            set entrycmd($var) "histinfo $hist $var"
1796            set entryvar($var) [eval $entrycmd($var)]
1797        }
1798    }
1799    # Top box
1800    catch {destroy $expgui(histFrame).pflag}
1801    if {$expgui(globalmode) != 0} {
1802        $expgui(histFrame).top.txt config \
1803                -text "Selected Histograms: [CompressList $histlist]"
1804        grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew       
1805        set expgui(bkglbl) "Globally Edit Background"
1806        set expgui(abslbl) "Globally Edit Absorption"
1807    } else {
1808        grid forget $expgui(histFrame).top
1809        set expgui(bkglbl) "Edit Background"
1810        set expgui(abslbl) "Edit Abs./Refl."
1811        if {[llength $expmap(phaselist)] > 1} {
1812            TitleFrame $expgui(histFrame).pflag  \
1813                    -borderwidth 4 -side left -relief groove \
1814                    -text "Phase Flags"
1815            set expgui(pflag) [$expgui(histFrame).pflag getframe]
1816            grid $expgui(histFrame).pflag -column 1 -row 1 -sticky nsew
1817            grid rowconfigure $expgui(histFrame) 2 -minsize 35
1818            foreach p $expmap(phaselist) {
1819                pack [checkbutton $expgui(pflag).$p \
1820                        -command "GetPhaseFlags $hist" \
1821                        -variable expgui(pflag$p) -text $p] -side left
1822                if {[lsearch $expmap(phaselist_$hist) $p] == -1} {
1823                    set expgui(pflag$p) 0
1824                } else {
1825                    set expgui(pflag$p) 1
1826                }
1827            }
1828        }
1829    }
1830
1831    # diffractometer constants
1832    foreach var {lam1 lam2 kratio pola ipola ddamp zero \
1833            wref pref dcref daref ratref ttref zref } {
1834        set entrycmd($var) "histinfo [list $histlist] $var"
1835        set entryvar($var) [histinfo [lindex $histlist 0] $var]
1836    }
1837
1838    eval destroy [winfo children $expgui(diffBox)]
1839    if {$expgui(globalmode) == 0} {
1840        if {[string range $expmap(htype_$hist) 2 2] == "T"} {
1841        #------
1842        # TOF |
1843        #------
1844            grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
1845                    -column 1 -row 1
1846            grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
1847                    -column 2 -row 1
1848            grid [ label $expgui(diffBox).lDCdifc -text DIFC ] \
1849                    -column 3 -row 1 -sticky w
1850            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1851                    -width 15 ] -column 4 -row 1
1852            set entrybox(lam1) $expgui(diffBox).eDCdifc
1853            #
1854            grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
1855                    -column 1 -row 2
1856            grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
1857                    -column 2 -row 2
1858            grid [ label $expgui(diffBox).lDCdifa -text DIFA ] \
1859                    -column 3 -row 2
1860            grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1861                    -width 15 ] -column 4 -row 2
1862            set entrybox(lam2) $expgui(diffBox).eDCdifa
1863            #
1864            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1865                    -column 3 -row 3
1866            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1867                    -width 15 ] -column 4 -row 3
1868            set entrybox(zero) $expgui(diffBox).eDCzero
1869            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1870                    -column 1 -row 3 -sticky w
1871            grid [ checkbutton $expgui(diffBox).rfDCzref \
1872                    -variable entryvar(zref) ] -column 2 -row 3
1873        } elseif {[string range $expmap(htype_$hist) 1 2] == "NC"} { 
1874        #---------------
1875        # CW - neutron |
1876        #---------------
1877            grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1878                    -column 1 -row 1
1879            grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1880                    -column 2 -row 1
1881            grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1882                    -column 3 -row 1 -sticky w
1883            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1884                    -width 15 ] -column 4 -row 1
1885            set entrybox(lam1) $expgui(diffBox).eDCdifc
1886            #
1887            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1888                    -column 1 -row 3 -sticky w
1889            grid [ checkbutton $expgui(diffBox).rfDCzref \
1890                    -variable entryvar(zref) ] -column 2 -row 3
1891            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1892                    -column 3 -row 3
1893            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1894                    -width 15 ] -column 4 -row 3
1895            set entrybox(zero) $expgui(diffBox).eDCzero
1896        } elseif {[string range $expmap(htype_$hist) 1 2] == "XC" && \
1897                [histinfo $hist lam2] == 0.0} {
1898        #--------------------------
1899        # CW - x-ray 1 wavelength |
1900        #--------------------------
1901            grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1902                    -column 1 -row 1
1903            grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1904                    -column 2 -row 1
1905            grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1906                    -column 3 -row 1 -sticky w
1907            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1908                    -width 15 ] -column 4 -row 1
1909            set entrybox(lam1) $expgui(diffBox).eDCdifc
1910            #
1911            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1912                    -column 1 -row 3 -sticky w
1913            grid [ checkbutton $expgui(diffBox).rfDCzref \
1914                    -variable entryvar(zref) ] -column 2 -row 3
1915            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1916                    -column 3 -row 3
1917            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1918                    -width 15 ] -column 4 -row 3
1919            set entrybox(zero) $expgui(diffBox).eDCzero
1920            #
1921            grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1922                    -column 1 -row 4 -sticky w
1923            grid [ checkbutton $expgui(diffBox).rfDCpref \
1924                    -variable entryvar(pref) ] -column 2 -row 4
1925            grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1926                    -column 3 -row 4
1927            grid [ entry $expgui(diffBox).eDCpola \
1928                    -textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1929            set entrybox(pola) $expgui(diffBox).eDCpola
1930            grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1931                    -column 5 -row 4
1932            grid [ entry $expgui(diffBox).eDCipola -width 2 \
1933                    -textvariable entryvar(ipola)] -column 6 -row 4
1934            set entrybox(ipola) $expgui(diffBox).eDCipola
1935        } elseif {[string range $expmap(htype_$hist) 1 2] == "XC"} {
1936        #---------------------------
1937        # CW - x-ray 2 wavelengths |
1938        #---------------------------
1939            grid [ label $expgui(diffBox).lDCdifc -text wavelengths ] \
1940                    -column 3 -row 1 -sticky w
1941            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1942                    -width 15 ] -column 4 -row 1
1943            set entrybox(lam1) $expgui(diffBox).eDCdifc
1944            grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1945                    -width 15 ] -column 5 -row 1
1946            set entrybox(lam2) $expgui(diffBox).eDCdifa
1947            #
1948            grid [ label $expgui(diffBox).lDCrref -text "Refine ratio" ] \
1949                    -column 1 -row 2 -sticky w
1950            grid [ checkbutton $expgui(diffBox).rfDCrref \
1951                    -variable entryvar(ratref) ] -column 2 -row 2
1952            grid [ label $expgui(diffBox).lDCratio -text Ratio ] \
1953                    -column 3 -row 2
1954            grid [ entry $expgui(diffBox).eDCkratio \
1955                    -textvariable entryvar(kratio) \
1956                    -width 15 ] -column 4 -row 2
1957            set entrybox(kratio) $expgui(diffBox).eDCkratio
1958            #
1959            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1960                    -column 3 -row 3
1961            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1962                    -width 15 ] -column 4 -row 3
1963            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1964                    -column 1 -row 3 -sticky w
1965            set entrybox(zero) $expgui(diffBox).eDCzero
1966            grid [ checkbutton $expgui(diffBox).rfDCzref \
1967                    -variable entryvar(zref) ] -column 2 -row 3
1968            grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1969                    -column 1 -row 4 -sticky w
1970            grid [ checkbutton $expgui(diffBox).rfDCpref \
1971                    -variable entryvar(pref) ] -column 2 -row 4
1972            grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1973                    -column 3 -row 4
1974            grid [ entry $expgui(diffBox).eDCpola \
1975                    -textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1976            set entrybox(pola) $expgui(diffBox).eDCpola
1977            grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1978                    -column 5 -row 4
1979            grid [ entry $expgui(diffBox).eDCipola -width 2 \
1980                    -textvariable entryvar(ipola)] -column 6 -row 4
1981            set entrybox(ipola) $expgui(diffBox).eDCipola
1982        } elseif {[string range $expmap(htype_$hist) 1 2] == "XE"} {
1983        #-------------
1984        # ED - x-ray |
1985        #-------------
1986            grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
1987                    -column 1 -row 1
1988            grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
1989                    -column 2 -row 1
1990            grid [ label $expgui(diffBox).lDCdifc -text 2Theta ] \
1991                    -column 3 -row 1 -sticky w
1992            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1993                    -width 15 ] -column 4 -row 1
1994            set entrybox(lam1) $expgui(diffBox).eDCdifc
1995            #
1996            grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1997                    -column 1 -row 4 -sticky w
1998            grid [ checkbutton $expgui(diffBox).rfDCpref \
1999                    -variable entryvar(pref) ] -column 2 -row 4
2000            grid [ label $expgui(diffBox).lDCpola -text POLA ] \
2001                    -column 3 -row 4
2002            grid [ entry $expgui(diffBox).eDCpola \
2003                    -textvariable entryvar(pola) -width 15 ] -column 4 -row 4
2004            set entrybox(pola) $expgui(diffBox).eDCpola
2005            grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
2006                    -column 5 -row 4
2007            grid [ entry $expgui(diffBox).eDCipola -width 2 \
2008                    -textvariable entryvar(ipola)] -column 6 -row 4
2009            set entrybox(ipola) $expgui(diffBox).eDCipola
2010        }
2011    } elseif {$expgui(globalmode) == 1} {
2012        #-------------
2013        # Global TOF |
2014        #-------------
2015        grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
2016                -column 1 -row 1
2017        grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
2018                -column 2 -row 1
2019        grid [button $expgui(diffBox).bDCdifc -text "Set DIFC Globally" \
2020                -command "editglobalparm histinfo difc {DIFC}"] -column 3 -row 1
2021        #
2022        grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
2023                -column 1 -row 2
2024        grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
2025                -column 2 -row 2
2026        grid [ button $expgui(diffBox).bDCdifa -text "Set DIFA Globally" \
2027                -command "editglobalparm histinfo difa {DIFA}"] -column 3 -row 2
2028        #
2029        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
2030                -column 1 -row 3 -sticky w
2031        grid [ checkbutton $expgui(diffBox).rfDCzref \
2032                -variable entryvar(zref) ] -column 2 -row 3
2033        grid [ button $expgui(diffBox).bDCzero -text "Set ZERO Globally" \
2034                -command "editglobalparm histinfo zero {Zero}"] -column 3 -row 3
2035    } elseif {$expgui(globalmode) == 2} {
2036        #--------------------
2037        # Global CW neutron |
2038        #--------------------
2039        grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
2040                -column 1 -row 1
2041        grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
2042                -column 2 -row 1
2043        grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
2044                -command "editglobalparm histinfo lam1 Wavelength"] \
2045                -column 3 -row 1
2046        #
2047        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
2048                -column 1 -row 3 -sticky w
2049        grid [ checkbutton $expgui(diffBox).rfDCzref \
2050                -variable entryvar(zref) ] -column 2 -row 3
2051        grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
2052                -command "editglobalparm histinfo zero Zero"] -column 3 -row 3
2053    } elseif {$expgui(globalmode) == 4} {
2054        #----------------------
2055        # Global CW mono xray |
2056        #----------------------
2057        grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
2058                -column 1 -row 1
2059        grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
2060                -column 2 -row 1
2061        grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
2062                -command "editglobalparm histinfo lam1 Wavelength"] \
2063                -column 3 -row 1
2064        #
2065        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
2066                -column 1 -row 3 -sticky w
2067        grid [ checkbutton $expgui(diffBox).rfDCzref \
2068                -variable entryvar(zref) ] -column 2 -row 3
2069        grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
2070                -command "editglobalparm histinfo zero Zero"] -column 3 -row 3
2071        #
2072        grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
2073                -column 1 -row 4 -sticky w
2074        grid [ checkbutton $expgui(diffBox).rfDCpref \
2075                -variable entryvar(pref) ] -column 2 -row 4
2076        grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
2077                -command "editglobalparm histinfo pola POLA"] -column 3 -row 4
2078        grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
2079                -command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
2080    } elseif {$expgui(globalmode) == 3} {
2081        #------------------------
2082        # Global alpha 1,2 xray |
2083        #------------------------
2084        grid [button $expgui(diffBox).bDCl1 -text "Set Wave1 Globally" \
2085                -command "editglobalparm histinfo lam1 {Wavelength 1}"] \
2086                -column 3 -row 1
2087        grid [button $expgui(diffBox).bDCl2 -text "Set Wave2 Globally" \
2088                -command "editglobalparm histinfo lam2 {Wavelength 2}"] \
2089                -column 4 -row 1
2090        #
2091        grid [ label $expgui(diffBox).lDCratref -text "Refine Ratio" ] \
2092                -column 1 -row 2 -sticky w
2093        grid [ checkbutton $expgui(diffBox).rfDCratref \
2094                -variable entryvar(ratref) ] -column 2 -row 2
2095        grid [button $expgui(diffBox).bDCrrat -text "Set Ratio Globally" \
2096                -command "editglobalparm histinfo ratio {Wavelength Ratio}"] \
2097                -column 3 -row 2
2098        #
2099        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
2100                -column 1 -row 3 -sticky w
2101        grid [ checkbutton $expgui(diffBox).rfDCzref \
2102                -variable entryvar(zref) ] -column 2 -row 3
2103        grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
2104                -command "editglobalparm histinfo zero Zero"] -column 3 -row 3
2105        #
2106        grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
2107                -column 1 -row 4 -sticky w
2108        grid [ checkbutton $expgui(diffBox).rfDCpref \
2109                -variable entryvar(pref) ] -column 2 -row 4
2110        grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
2111                -command "editglobalparm histinfo pola POLA"] -column 3 -row 4
2112        grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
2113                -command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
2114    } elseif {$expgui(globalmode) == 5} {
2115        #-----------------
2116        # Global ED xray |
2117        #-----------------
2118        grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
2119                -column 1 -row 1
2120        grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
2121                -column 2 -row 1
2122        grid [button $expgui(diffBox).bDCdifc -text "Set 2Theta Globally" \
2123                -command "editglobalparm histinfo ratio {Fixed 2Theta}"] \
2124                -column 3 -row 1
2125        #
2126        grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
2127                -column 1 -row 4 -sticky w
2128        grid [ checkbutton $expgui(diffBox).rfDCpref \
2129                -variable entryvar(pref) ] -column 2 -row 4
2130        grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
2131                -command "editglobalparm histinfo pola POLA"] -column 3 -row 4
2132        grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
2133                -command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
2134    }
2135    if {$expgui(globalmode) == 0} {
2136        grid [frame $expgui(diffBox).d] -column 5 -row 1 -rowspan 3 \
2137                -columnspan 2 -sticky e
2138    } else {
2139        grid [frame $expgui(diffBox).d] -column 4 -row 2 -rowspan 2 \
2140                -columnspan 2 -sticky e
2141    }
2142    grid [label $expgui(diffBox).d.lDamp -text "Damping  "] \
2143            -column 1 -row 1 
2144    tk_optionMenu $expgui(diffBox).d.om entryvar(ddamp) 0 1 2 3 4 5 6 7 8 9
2145    grid $expgui(diffBox).d.om -column 2 -row 1 
2146    grid columnconfigure $expgui(diffBox) 9  -weight 1
2147    grid columnconfigure $expgui(diffBox) 0  -weight 1
2148    update idletasks
2149    # enable traces on entryvar now
2150    set entrycmd(trace) 1
2151}
2152
2153# this gets the phase flags as set in the expgui(pflag*) elements
2154# (linked to phase flag checkbuttons) and the sets the "HST xx NPHAS" flags
2155# accordingly using SetPhaseFlag
2156proc GetPhaseFlags {hist} {
2157    global expmap expgui
2158    set plist {}
2159    foreach p $expmap(phaselist) {
2160        if {$expgui(pflag$p)} {lappend plist $p}
2161    }
2162    SetPhaseFlag $hist $plist
2163    incr expgui(changed)
2164    # set the powpref warning (1 = suggested)
2165    set expgui(needpowpref) 2
2166    set msg "Phase flags" 
2167    if {[string first $msg $expgui(needpowpref_why)] == -1} {
2168        append expgui(needpowpref_why) "\t$msg were changed\n"
2169    }
2170    mapexp
2171    # reset the phase selection
2172    set expgui(curPhase) {}
2173}
2174
2175#-----------------------------------------------------------------------
2176# populate the Scaling page
2177#-----------------------------------------------------------------------
2178proc DisplayFrac {} {
2179    global expgui entrycmd entryvar entrybox expmap
2180
2181    # trap if more than one histogram is selected unless global mode
2182    if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
2183        set expgui(curhist) [lindex $expgui(curhist) 0] 
2184    }
2185
2186    # display the selected histograms
2187    $expgui(fracFrame).hs.lbox selection clear 0 end
2188    foreach h $expgui(curhist) {
2189        $expgui(fracFrame).hs.lbox selection set $h
2190    }
2191
2192    # disable traces on entryvar
2193    set entrycmd(trace) 0
2194
2195    # get histogram list
2196    set histlist {}
2197    foreach item $expgui(curhist) {
2198        lappend histlist [lindex $expmap(powderlist) $item]
2199    }
2200
2201    # must have at least one histogram selected here
2202    if {[llength $histlist] == 0} {
2203        foreach var {scale sref sdamp} {
2204            set entrycmd($var) ""
2205            set entryvar($var) ""
2206        }
2207        set parm [grid info $expgui(scaleBox).but1]
2208        if {$parm != ""} {
2209            grid forget  $expgui(scaleBox).but1
2210            eval grid $expgui(scaleBox).ent1 $parm
2211        }
2212        # destroy the contents of the frame
2213        set phaseFractf1 $expgui(FracBox).f
2214        eval destroy [winfo children $phaseFractf1]
2215        # reenable traces on entryvar
2216        set entrycmd(trace) 1
2217        return
2218    }
2219
2220    #--------------
2221    # Scale factor
2222    #--------------
2223    if {$expgui(globalmode) != 0} {
2224        foreach var {scale sref sdamp} {
2225            set entrycmd($var) "histinfo [list $histlist] $var"
2226            set entryvar($var) [histinfo [lindex $histlist 0] $var]
2227        }
2228        # reset scale to black
2229        catch {$entrybox(scale) config -fg black}
2230        set parm [grid info $expgui(scaleBox).ent1]
2231        if {$parm != ""} {
2232            grid forget  $expgui(scaleBox).ent1
2233            eval grid $expgui(scaleBox).but1 $parm
2234        }
2235    } else {
2236        set hist $histlist
2237        foreach var {scale sref sdamp} {
2238            set entrycmd($var) "histinfo $hist $var"
2239            set entryvar($var) [eval $entrycmd($var)]
2240        }
2241        # reset scale to black
2242        catch {$entrybox(scale) config -fg black}
2243        set parm [grid info $expgui(scaleBox).but1]
2244        if {$parm != ""} {
2245            grid forget  $expgui(scaleBox).but1
2246            eval grid $expgui(scaleBox).ent1 $parm
2247        }
2248    }
2249
2250    #----------------
2251    # Phase Fractions
2252    #----------------
2253    set phaseFractf1 $expgui(FracBox).f
2254    # destroy the contents of the frame
2255    eval destroy [winfo children $phaseFractf1]
2256    if {$expgui(globalmode) != 0} {
2257        set txt "Phase Fractions for Histograms: [CompressList $histlist]"
2258    } else {
2259        set txt "Phase Fractions"
2260    }
2261    $expgui(fracFrame).f1.phaseFrac configure -text $txt
2262    # Create the frame inside the canvas, One frame for each Phase.
2263    foreach i {1 2 3 4 5 6 7 8 9} {set phasehistlist($i) ""}
2264    foreach hist $histlist {
2265        foreach i $expmap(phaselist_$hist) {
2266            lappend phasehistlist($i) $hist
2267        }
2268    }
2269    foreach i {1 2 3 4 5 6 7 8 9} {
2270        if {[llength $phasehistlist($i)] == 0} continue
2271        set framePF [frame $phaseFractf1.pF$i -relief groove  -bd 4]
2272        grid $framePF -column 0 -row $i -sticky ew
2273        # Label Heading for each phase.
2274        if {$expgui(globalmode) != 0} {
2275            grid [label $framePF.l1 \
2276                    -text "Phase $i Hist: [CompressList $phasehistlist($i)]"] \
2277                    -column 0 -row 0 -sticky nws
2278            grid [button $framePF.but1 -text "Set Globally" \
2279                    -command "editglobalparm hapinfo frac \"Phase $i Fraction\" \
2280                    [list $phasehistlist($i)] $i" \
2281                    ] -column 1 -row 0
2282        } else {
2283            grid [label $framePF.l1  -text "Phase $i"] \
2284                    -column 0 -row 0 -sticky nws
2285            grid [entry $framePF.ent -textvariable entryvar(frac$i) -width 15]\
2286                    -column 1 -row 0
2287            set entrybox(frac$i) $framePF.ent
2288        }
2289        set entrycmd(frac$i) "hapinfo $hist $i frac"
2290        set entryvar(frac$i) [hapinfo $hist $i frac]
2291        grid [label $framePF.l2  -text "  Refine"] \
2292                -column 2 -row 0 -sticky nws
2293        grid [checkbutton $framePF.cb -variable entryvar(frref$i)] \
2294                -column 3 -row 0 -sticky nws
2295        set entrycmd(frref$i) "hapinfo $hist $i frref"
2296        set entryvar(frref$i) [hapinfo $hist $i frref]
2297        grid [label $framePF.l3  -text "  Damping"] \
2298                -column 4 -row 0 -sticky nws
2299        tk_optionMenu $framePF.tkOptDamp entryvar(frdamp$i) \
2300                0 1 2 3 4 5 6 7 8 9     
2301        set entrycmd(frdamp$i) "hapinfo $hist $i frdamp"
2302        set entryvar(frdamp$i) [hapinfo $hist $i frdamp]
2303        grid $framePF.tkOptDamp -row 0 -sticky nsw -column 5
2304    }
2305    # resize the scroll window to match the actual
2306    update idletasks
2307    $expgui(FracBox) config -scrollregion [grid bbox $expgui(FracBox).f]
2308    $expgui(FracBox) config -width [lindex [grid bbox $expgui(FracBox).f] 2]
2309    update idletasks
2310    # enable traces on entryvar now
2311    set entrycmd(trace) 1
2312}
2313
2314#-----------------------------------------------------------------------
2315# display the profile page
2316#-----------------------------------------------------------------------
2317proc DisplayProfile {} {
2318    global expgui entrycmd entryvar entrybox expmap
2319
2320    # trap if more than one histogram is selected unless global mode
2321    if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
2322        set expgui(curhist) [lindex $expgui(curhist) 0] 
2323    }
2324    # display the selected histograms
2325    $expgui(profFrame).hs.lbox selection clear 0 end
2326    foreach h $expgui(curhist) {
2327        $expgui(profFrame).hs.lbox selection set $h
2328    }
2329
2330    # destroy the contents of the frame
2331    eval destroy [winfo children $expgui(ProfileBox).f]
2332    # since the next steps can take a while, do a screen update
2333    update idletasks
2334
2335    if {$expgui(globalmode) == 0} {
2336        # must have at least one histogram selected here
2337        if {[llength $expgui(curhist)] == 0} return
2338        # disable traces on entryvar for right now
2339        set entrycmd(trace) 0
2340        set hist [lindex $expmap(powderlist) $expgui(curhist)]
2341        # no defined histograms?
2342        if {$hist == ""} return
2343        # Create one frame for each Phase.
2344        set ind -1
2345        set htype [string range $expmap(htype_$hist) 2 2]
2346        set zflag 0
2347        if {$htype == "C"} {
2348            set zflag [histinfo $hist zref]
2349        }
2350        foreach i $expmap(phaselist_$hist) {
2351            incr ind
2352            # Label Heading for each phase.
2353            set ptype [string trim [hapinfo $hist $i proftype]]
2354            grid [TitleFrame $expgui(ProfileBox).f.$i \
2355                      -text "Hist $hist -- Phase $i (type $ptype)" \
2356                      -relief groove -bd 2] \
2357                -column 0 -row $ind -sticky ew
2358            set ProfileFrame [$expgui(ProfileBox).f.$i getframe]
2359            grid [frame $ProfileFrame.1] \
2360                -column 0 -row 0 -columnspan 10
2361            pack [label $ProfileFrame.1.l  \
2362                      -text Damping]\
2363                -side left
2364            tk_optionMenu $ProfileFrame.1.tkOptDamp entryvar(pdamp_$i) \
2365                    0 1 2 3 4 5 6 7 8 9
2366            set entrycmd(pdamp_$i) "hapinfo $hist $i pdamp"
2367            set entryvar(pdamp_$i) [hapinfo $hist $i pdamp]
2368            pack $ProfileFrame.1.tkOptDamp -side left
2369            pack [label $ProfileFrame.1.l1 \
2370                    -text "  Peak cutoff"]\
2371                    -side left
2372            pack [entry $ProfileFrame.1.e1  \
2373                    -width 10 -textvariable entryvar(pcut_$i)]\
2374                    -side left
2375            set entrybox(pcut_$i) $ProfileFrame.1.e1
2376            set entrycmd(pcut_$i) "hapinfo $hist $i pcut"
2377            set entryvar(pcut_$i) [hapinfo $hist $i pcut]
2378
2379            pack [button $ProfileFrame.1.b1  \
2380                    -text "Change Type" \
2381                    -command "ChangeProfileType $hist $i"]\
2382                    -side left
2383           
2384            set col -1
2385            set row 1
2386            set nterms [hapinfo $hist $i profterms]
2387            set lbls "dummy [GetProfileTerms $i $hist $ptype]"
2388            for { set num 1 } { $num <= $nterms } { incr num } {
2389                set term {}
2390                catch {set term [lindex $lbls $num]}
2391                if {$term == ""} {set term $num}
2392                incr col
2393                grid [label $ProfileFrame.l${num}_${i} -text "$term"] \
2394                        -row $row -column $col
2395                incr col
2396                grid [checkbutton $ProfileFrame.ref${num}_${i} \
2397                        -variable entryvar(pref${num}_$i)] -row $row -column $col
2398                set entrycmd(pref${num}_$i) "hapinfo $hist $i pref$num"
2399                set entryvar(pref${num}_$i) [hapinfo $hist $i pref$num]
2400                incr col
2401                grid [entry $ProfileFrame.ent${num}_${i} \
2402                        -textvariable entryvar(pterm${num}_$i)\
2403                        -width 12] -row $row -column $col
2404                set entrybox(pterm${num}_$i) $ProfileFrame.ent${num}_${i}
2405                set entrycmd(pterm${num}_$i) "hapinfo $hist $i pterm$num"
2406                set entryvar(pterm${num}_$i) [hapinfo $hist $i pterm$num]
2407                # disable trns & shft when zero is refined
2408                if {$zflag && ($term == "trns" || $term == "shft")} {
2409                    if {$entryvar(pref${num}_$i)} {
2410                        incr expgui(changed)
2411                        set entryvar(pref${num}_$i) 0
2412                    }
2413                    $ProfileFrame.l${num}_${i} config -fg gray
2414                    $ProfileFrame.ref${num}_${i} config -state disabled
2415                    $ProfileFrame.ent${num}_${i} config -fg gray
2416                }
2417                if {$col > 6} {set col -1; incr row}
2418            }
2419        }
2420        grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
2421    } else {
2422        # get histogram list
2423        set histlist {}
2424        foreach item $expgui(curhist) {
2425            lappend histlist [lindex $expmap(powderlist) $item]
2426        }
2427        # must have at least one histogram selected here
2428        if {[llength $histlist] == 0} return
2429        # disable traces on entryvar for right now
2430        set entrycmd(trace) 0
2431        # loop through histograms & phases, set up an array by phase & profile type
2432        catch {unset prtyparray histarray phasearray}
2433        foreach hist $histlist {
2434            foreach phase $expmap(phaselist_$hist) {
2435                set prtyp [string trim [hapinfo $hist $phase proftype]]
2436                set key ${prtyp}_$phase
2437                lappend prtyparray($key) $hist
2438                lappend histarray($key) $hist
2439                lappend phasearray($key) $phase
2440            }
2441        }
2442       
2443        set ptype ""
2444        set i -1
2445        # loop over all combined phases and profile types, sorted 1st by profile number
2446        foreach key [lsort [array names prtyparray]] {
2447            # split key
2448            scan $key %d_%d prftyp p
2449
2450            if {$ptype != $prftyp || !$expgui(globalphasemode)} {
2451                set ptype $prftyp
2452                set curhistlist $histarray($key)
2453                set curphaslist $phasearray($key)
2454               
2455                set hist1 [lindex $curhistlist 0]
2456                set phase1 [lindex $curphaslist 0]
2457                set nterms [hapinfo $hist1 $phase1 profterms]
2458                set htype [string range $expmap(htype_$hist1) 2 2]
2459                set lbls "dummy [GetProfileTerms $phase1 $hist1 $ptype]"
2460                # Create a frame for this type
2461                incr i
2462                set boxtitle "Phase $p, hist [CompressList $histarray($key)]"
2463                grid [TitleFrame $expgui(ProfileBox).f.$i \
2464                          -text "(type $ptype)" \
2465                          -relief groove -bd 2] \
2466                    -column 0 -row $i -sticky ew
2467                set ProfileFrame [$expgui(ProfileBox).f.$i getframe]
2468                grid [frame $ProfileFrame.0] \
2469                    -column 0 -row 0 -columnspan 20 -sticky ew
2470                grid [label $ProfileFrame.0.1  \
2471                        -anchor w] -row 0 -column 1
2472                grid [frame $ProfileFrame.1] \
2473                        -column 0 -row 1 -columnspan 20 -sticky ew
2474                grid [label $ProfileFrame.1.2  \
2475                        -text "Damping"] -row 0 -column 2
2476                tk_optionMenu $ProfileFrame.1.tkOptDamp \
2477                        entryvar(pdamp_$i) 0 1 2 3 4 5 6 7 8 9
2478                grid $ProfileFrame.1.tkOptDamp -row 0 -column 3
2479                grid [button $ProfileFrame.1.edit \
2480                        -text "Global Edit"] -row 0 -column 4 -sticky w
2481                set entryvar(pdamp_$i) [hapinfo $hist $phase pdamp]
2482                grid [button $ProfileFrame.1.b1 -text "Change Type"] \
2483                        -row 0 -column 5 -sticky w
2484                set col -1
2485                set row 2
2486                for { set num 1 } { $num <= $nterms } { incr num } {
2487                    set term {}
2488                    catch {set term [lindex $lbls $num]}
2489                    if {$term == ""} {set term $num}
2490                    incr col
2491                    grid [label $ProfileFrame.l${num}_${i} \
2492                            -text "$term"] -row $row -column $col
2493                    incr col
2494                    grid [checkbutton $ProfileFrame.ref${num}_${i} \
2495                            -variable entryvar(pref${num}_$i)] \
2496                            -row $row -column $col
2497                    set entryvar(pref${num}_$i) [hapinfo $hist $phase pref$num]
2498                    if {$col > 10} {set col -1; incr row}
2499                }
2500                grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
2501            } else {
2502                # add to the current entry
2503                eval lappend curhistlist $histarray($key)
2504                eval lappend curphaslist $phasearray($key)
2505                append boxtitle "\nPhase $p, hist [CompressList $histarray($key)]"
2506            }
2507            $ProfileFrame.0.1 config -text $boxtitle
2508            $ProfileFrame.1.edit config -command "\
2509                    EditProfile \"\n$boxtitle\" \
2510                    [list $curhistlist] \
2511                    [list $curphaslist]"
2512            $ProfileFrame.1.b1 config -command "ChangeProfileType \
2513                    [list $curhistlist] [list $curphaslist]" 
2514            set entrycmd(pdamp_$i) "hapinfo \
2515                    [list $curhistlist] \
2516                    [list $curphaslist] pdamp"
2517            for { set num 1 } { $num <= $nterms } { incr num } {
2518                set entrycmd(pref${num}_$i) "hapinfo \
2519                        [list $curhistlist] \
2520                        [list $curphaslist] pref$num"
2521            }
2522        }
2523    }
2524   
2525    # resize the scroll window to match the actual
2526    update idletasks
2527    $expgui(ProfileBox) config -scrollregion [grid bbox $expgui(ProfileBox).f]
2528    $expgui(ProfileBox) config -width [lindex [grid bbox $expgui(ProfileBox).f] 2]
2529    update idletasks
2530    ResizeNotebook
2531    # enable traces on entryvar now
2532    set entrycmd(trace) 1
2533}
2534
2535# process the bit settings in the print options
2536#   bitnum -- the number of the bit to be tested/set starting at 0 for the LSBit
2537proc printsetting {bitnum "action get" "value {}"} {
2538    global entryvar expgui
2539    if {$action == "get"} {
2540        return [expr ([expinfo print] & int(pow(2,$bitnum))) != 0]
2541    } elseif $value {
2542        set newval [expr ([expinfo print] | int(pow(2,$bitnum)))]
2543    } else {
2544        set newval [expr ([expinfo print] & ~int(pow(2,$bitnum)))]
2545    }
2546    expinfo print set $newval
2547    set expgui(printopt) "Print Options ([expinfo print])"
2548}
2549
2550# need to respond to mouse presses -- control variable associated with extract Fobs
2551# and set the LeBail extraction flags
2552proc SetupExtractHist {} {
2553    global expgui entrycmd entryvar expmap
2554
2555    # display the selected histograms
2556    $expgui(lsFrame).hs.lbox selection clear 0 end
2557    foreach h $expgui(curhist) {
2558        $expgui(lsFrame).hs.lbox selection set $h
2559    }
2560
2561    # get histogram list
2562    set histlist {}
2563    foreach item $expgui(curhist) {
2564        set hist [lindex $expmap(powderlist) $item]
2565        if {$hist != ""} {lappend histlist $hist}
2566    }
2567    set entrycmd(fobsextract) "histinfo [list $histlist] foextract"
2568    if {[llength $histlist] == 0 || [string trim $histlist] == ""} {
2569        set entrycmd(LBdamp) ""
2570        foreach phase {1 2 3 4 5 6 7 8 9} {
2571            $expgui(FobsExtractFrame).l$phase config -fg grey
2572            set expgui(Fextract$phase) {}
2573            foreach item $expgui(ExtractSettingsRadiobuttons) {
2574                ${item}$phase config -state disabled -bd 1
2575            }
2576        }
2577    } elseif {[llength $histlist] == 1} {
2578        # disable traces on entryvar
2579        set entrycmd(trace) 0
2580        set entryvar(fobsextract) [histinfo $histlist foextract]
2581        set entrycmd(LBdamp) "histinfo $histlist LBdamp"
2582        set entryvar(LBdamp) [histinfo $histlist LBdamp]
2583        foreach phase {1 2 3 4 5 6 7 8 9} {
2584            # is the phase present?
2585            if {[lsearch -exact $expmap(phaselist_$histlist) $phase] == -1} {
2586                $expgui(FobsExtractFrame).l$phase config -fg grey
2587                set expgui(Fextract$phase) {}
2588                foreach item $expgui(ExtractSettingsRadiobuttons) {
2589                    ${item}$phase config -state disabled -bd 1
2590                }
2591            } else {
2592                $expgui(FobsExtractFrame).l$phase config -fg black
2593                foreach item $expgui(ExtractSettingsRadiobuttons) {
2594                    ${item}$phase config -state normal -bd 2
2595                }
2596                set expgui(Fextract$phase) [hapinfo $histlist $phase extmeth]
2597            }
2598        }
2599    } elseif {[llength $histlist] > 1} {
2600        # disable traces on entryvar
2601        set entrycmd(LBdamp) "histinfo [list $histlist] LBdamp"
2602        set entryvar(LBdamp) [histinfo [lindex $histlist 0] LBdamp]
2603        set entrycmd(trace) 0
2604        # multiple histograms need phases in any histogram
2605        foreach phase {1 2 3 4 5 6 7 8 9} {
2606            set gotphase($phase) 0
2607        }           
2608        foreach hist $histlist {
2609            foreach phase $expmap(phaselist_$hist) {
2610                set gotphase($phase) 1
2611            }
2612        }
2613        foreach phase {1 2 3 4 5 6 7 8 9} {
2614            set expgui(Fextract$phase) {}
2615            if $gotphase($phase) {
2616                $expgui(FobsExtractFrame).l$phase config -fg black
2617                foreach item $expgui(ExtractSettingsRadiobuttons) {
2618                    ${item}$phase config -state normal -bd 2
2619                }
2620            } else {
2621                $expgui(FobsExtractFrame).l$phase config -fg grey
2622                foreach item $expgui(ExtractSettingsRadiobuttons) {
2623                    ${item}$phase config -state disabled -bd 1
2624                }
2625            }
2626        }
2627    }
2628    # reenable traces
2629    set entrycmd(trace) 1
2630}
2631# respond to a change in the fobs extraction method for a phase
2632# force the main extraction flag on, if fobs extraction is selected for any phase
2633proc HistExtractSet {phase} {
2634    global expgui entryvar expmap
2635    foreach item $expgui(curhist) {
2636        lappend histlist [lindex $expmap(powderlist) $item]
2637    }
2638    hapinfo $histlist $phase extmeth set $expgui(Fextract$phase)
2639    incr expgui(changed)
2640    if {$expgui(Fextract$phase) != 0} {set entryvar(fobsextract) 1}
2641}
2642#---------------------------- Global Edit Functions ------------------------
2643proc editbackground {} {
2644    global expgui expmap entrycmd
2645    set histlist {}
2646    foreach n $expgui(curhist) {
2647        lappend histlist [lindex $expmap(powderlist) $n]
2648    }
2649    if {[llength $histlist] == 0} return
2650
2651    set w .back
2652    catch {destroy $w}
2653    toplevel $w -bg beige
2654    if {$expgui(globalmode) != 0} {
2655        wm title $w "Global Edit Background" 
2656    } else {
2657        wm title $w "Edit Background" 
2658    }
2659   
2660    pack [frame $w.0 -bd 6 -relief groove  -bg beige \
2661            ] -side top -expand yes -fill both
2662    if {[llength $histlist] > 1} {
2663        grid [label $w.0.a \
2664            -text "Setting background terms for histograms [CompressList $histlist]" \
2665            -bg beige] -row 0 -column 0 -columnspan 10
2666    } else {
2667        grid [label $w.0.a \
2668            -text "Setting background terms for histogram $histlist" \
2669            -bg beige] -row 0 -column 0 -columnspan 4
2670        grid [button $w.0.bkg -text "Fit Background\nGraphically" \
2671                -command "QuitEditBackground $w; bkgedit $histlist"] \
2672                -row 0 -column 4 -rowspan 2
2673        grid columnconfig $w.0 0 -weight 1
2674        grid columnconfig $w.0 4 -weight 1
2675    }
2676    set hist [lindex $histlist 0]
2677    grid [label $w.0.b -text "Function type" -bg beige]  -row 1 -column 0 -sticky e
2678
2679    # disable traces on  expgui(backtype) & expgui(backterms) now
2680    set entrycmd(trace) 0
2681
2682    # number of terms
2683    set expgui(backtype) [histinfo $hist backtype]
2684    set expgui(orig_backtype) $expgui(backtype)
2685    set expgui(prev_backtype) $expgui(backtype)
2686    set typemenu [tk_optionMenu $w.0.type expgui(backtype) null]
2687    $typemenu delete 0 end
2688    foreach item {
2689        "1 - Shifted Chebyschev"
2690        "2 - Cosine Fourier series"
2691        "4 - Power series in Q**2n/n!"
2692        "5 - Power series in n!/Q**2n"
2693        "6 - Power series in Q**2n/n! and n!/Q**2n"
2694        "7 - Linear interpolation function"
2695        "8 - Reciprocal interpolation function"
2696    } {
2697        set val [lindex $item 0]
2698        $typemenu insert end radiobutton -variable expgui(backtype) \
2699                -label $item -value $val
2700    }
2701# removed
2702#       "3 - Radial distribution peaks"
2703
2704    grid $w.0.type   -row 1 -column 1
2705    grid [label $w.0.c -text "  Number of terms"  -bg beige] -row 1 -column 2
2706
2707    # function type
2708    set expgui(backterms) [histinfo $hist backterms]
2709    set expgui(orig_backterms) $expgui(backterms) 
2710    set list {}; for {set i 1} {$i <= 36} {incr i} {lappend list $i}
2711    eval tk_optionMenu $w.0.terms expgui(backterms) $list
2712    grid $w.0.terms   -row 1 -column 3 
2713    # enable traces on  expgui(backtype) & expgui(backterms) now
2714    set entrycmd(trace) 1
2715
2716    #set background terms
2717    for {set num 1 } { $num <= 36 } { incr num } {
2718        set var "bterm$num"
2719        set expgui($var) {}
2720        set expgui(orig_$var) {}
2721    }
2722    if {[llength $histlist] == 1} {
2723        for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2724            set var "bterm$num"
2725            set expgui($var) [histinfo $histlist $var]
2726            set expgui(orig_$var) $expgui($var)
2727        }
2728    }
2729
2730    pack [frame $w.1 -bd 6 -relief groove  -bg beige] -side top \
2731            -expand yes -fill both
2732    ShowBackTerms $w.1
2733
2734    set expgui(temp) {}
2735    pack [frame $w.b -bg beige] -fill x -expand yes -side top
2736    grid [button $w.b.2 -text Set -command "destroy $w"] -row 0 -column 1
2737    grid [button $w.b.3 -text Quit \
2738            -command "QuitEditBackground $w"] -row 0 -column 2
2739    grid [button $w.b.help -text Help -bg yellow \
2740            -command "MakeWWWHelp expgui3.html EditBackground"] \
2741            -row 0 -column 4
2742    grid columnconfig $w.b 0 -weight 1
2743    grid columnconfig $w.b 3 -weight 1
2744    bind $w <Key-F1> "MakeWWWHelp expgui3.html EditBackground"
2745    bind $w <Return> "destroy $w"
2746
2747    # force the window to stay on top
2748    putontop $w
2749
2750    focus $w.b.2
2751    tkwait window $w
2752    afterputontop
2753
2754    if {$expgui(temp) != ""} return
2755
2756    if {$expgui(orig_backtype) != $expgui(backtype)} {
2757        histinfo $histlist backtype set $expgui(backtype)
2758        incr expgui(changed)
2759    }
2760    if {$expgui(orig_backterms) != $expgui(backterms)} {
2761        histinfo $histlist backterms set $expgui(backterms)
2762        incr expgui(changed)
2763    }
2764    for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2765        set var "bterm$num"
2766        if {$expgui(orig_$var) != $expgui($var)} {
2767            histinfo $histlist $var set $expgui($var)
2768            incr expgui(changed)
2769        }
2770    }
2771
2772    if {$expgui(globalmode) == 0} {
2773        set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
2774        set expgui(backtermlbl) "([histinfo $hist backterms] terms)"
2775    }
2776}
2777
2778trace variable expgui(backterms) w ChangeBackTerms
2779proc ChangeBackTerms {a b c} {
2780    global entrycmd expgui
2781    if !$entrycmd(trace) return
2782    ShowBackTerms .back.1
2783}
2784
2785trace variable expgui(backtype) w ChangeBackType
2786# reset the terms to 1, 0, 0... when the number of terms increase
2787proc ChangeBackType {a b c} {
2788    global entrycmd expgui
2789    if !$entrycmd(trace) return
2790    if {$expgui(prev_backtype) == $expgui(backtype)} return
2791    set expgui(prev_backtype) $expgui(backtype)
2792    for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2793        set var "bterm$num"
2794        if {$num == 1} {
2795            set expgui($var) 1.0
2796        } else {
2797            set expgui($var) 0.0
2798        }
2799    }
2800}
2801
2802proc ShowBackTerms {w } {
2803    global expgui expmap
2804    # destroy the contents of the frame
2805    eval destroy [winfo children $w]
2806    set histlist {}
2807    foreach n $expgui(curhist) {
2808        lappend histlist [lindex $expmap(powderlist) $n]
2809    }
2810    set widgetsPerRow 4
2811    for {set rows 2; set num 1 } { $num <= $expgui(backterms) } { incr rows } {
2812        for {set cols 0} { (2*$widgetsPerRow > $cols) && ($num <= $expgui(backterms)) }  { incr num }  {
2813            set var "bterm$num"
2814            grid [label $w.l$num -text $num -bg beige]  \
2815                    -row $rows -column $cols -sticky nes
2816            incr cols
2817            grid [entry $w.e$num -width 15 -textvariable expgui($var) \
2818                    ] -row $rows  -column $cols  -sticky news
2819            incr cols
2820        }
2821    }
2822}
2823
2824proc QuitEditBackground {w} {
2825    global expgui
2826    # lets find out if anything changed
2827    set changed 0
2828    if {$expgui(orig_backtype) != $expgui(backtype)} {
2829        set changed 1
2830    }
2831    if {$expgui(orig_backterms) != $expgui(backterms)} {
2832        set changed 1
2833    }
2834    for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2835        set var "bterm$num"
2836        if {$expgui(orig_$var) != $expgui($var)} {
2837            set changed 1
2838            break
2839        }
2840    }
2841    if $changed {
2842        set decision [tk_dialog .changes "Abandon Changes" \
2843                "You have made changes to the background. Ok to abandon changes?" \
2844                warning 0 Abandon Keep]
2845        if !$decision {
2846            set expgui(temp) "Quit"
2847            destroy $w
2848        }
2849    } else {
2850        set expgui(temp) "Quit"
2851        destroy $w
2852    }
2853}
2854
2855# this probably needs work
2856proc editglobalparm {cmd variable title "histlist {}" "phase {}"} {
2857    global expgui expmap
2858    set w .global
2859    catch {destroy $w}
2860    toplevel $w -bg beige
2861    wm title $w "Edit Global Parameter"
2862    set expgui(temp) {}
2863    if {[llength $histlist] == 0} {
2864        set hist {}
2865        foreach n $expgui(curhist) {
2866            lappend hist [lindex $expmap(powderlist) $n]
2867        }
2868    } else {
2869        set hist $histlist
2870    }
2871    pack [frame $w.0 -bd 6 -relief groove -bg beige] \
2872            -side top -expand yes -fill both
2873    grid [label $w.0.a -text "Setting $title for histograms [CompressList $hist]"\
2874            -bg beige] \
2875            -row 0 -column 0 -columnspan 10
2876    grid [entry $w.0.b -textvariable expgui(temp)] \
2877            -row 1 -column 0 
2878
2879
2880    pack [frame $w.b -bg beige] -fill x -expand yes -side top
2881    pack [button $w.b.2 -text Set -command "destroy $w"] -side left
2882    pack [button $w.b.3 -text Quit -command "set expgui(temp) {}; destroy $w"] -side left
2883    pack [button $w.b.help -text Help -bg yellow \
2884            -command "MakeWWWHelp expgui3.html EditParm"] -side right
2885    bind $w <Key-F1> "MakeWWWHelp expgui3.html EditParm"
2886    bind $w <Return> "destroy $w"
2887
2888    # force the window to stay on top
2889    putontop $w
2890    focus $w.b.2
2891    tkwait window $w
2892    afterputontop
2893
2894    if {$expgui(temp) != ""} {
2895        foreach h $hist {
2896            if {$cmd == "histinfo"} {
2897                histinfo $h $variable set $expgui(temp)
2898                incr expgui(changed)
2899                if $expgui(debug) {
2900                    puts "histinfo $h $variable set $expgui(temp)"
2901                }
2902            } elseif {$cmd == "hapinfo"} {
2903                hapinfo $h $phase $variable set $expgui(temp)
2904                incr expgui(changed)
2905                if $expgui(debug) {
2906                    puts "hapinfo $phase $h $variable set $expgui(temp)"
2907                }
2908            } else {
2909                error "$cmd unimplemented"
2910            }
2911        }
2912    }
2913}
2914
2915proc EditProfile {title histlist phaselist} {
2916    global expgui expmap entrycmd
2917    set w .back
2918    catch {destroy $w}
2919    toplevel $w -bg beige
2920    wm title $w "Global Edit Profile"
2921    set hist [lindex $histlist 0]
2922    set phase [lindex $phaselist 0]
2923    set ptype [string trim [hapinfo $hist $phase proftype]]
2924    set htype [string range $expmap(htype_$hist) 2 2]
2925    set nterms [hapinfo $hist $phase profterms]
2926   
2927    pack [frame $w.0 -bd 6 -relief groove  -bg beige \
2928            ] -side top -expand yes -fill both
2929    grid [label $w.0.a \
2930            -text "Setting profile terms: $title" \
2931            -bg beige] -row 0 -column 0 -columnspan 10
2932    grid [label $w.0.b -text "Function type $ptype"  -bg beige]  -row 1 -column 0
2933    grid [label $w.0.c -text "  Peak cutoff" -bg beige] -row 1 -column 3 
2934    grid [entry $w.0.d -width 10 ]  -row 1 -column 4
2935    set entrylist {}
2936    lappend entrylist "pcut $w.0.d"
2937
2938    set col -1
2939    set row 1
2940    set lbls "dummy [GetProfileTerms $phase $hist $ptype]"
2941    pack [frame $w.1 -bd 6 -relief groove  -bg beige \
2942            ] -side top -expand yes -fill both
2943    for { set num 1 } { $num <= $nterms } { incr num } {
2944        set term {}
2945        catch {set term [lindex $lbls $num]}
2946        if {$term == ""} {set term $num}
2947        incr col
2948        grid [label $w.1.l${num} -text "$term" -bg beige] \
2949                -row $row -column $col
2950        incr col
2951        grid [entry $w.1.ent${num} \
2952                -width 14] -row $row -column $col
2953        lappend entrylist "pterm$num $w.1.ent${num}"   
2954        if {$col > 6} {set col -1; incr row}
2955    }
2956    pack [frame $w.b -bg beige] -fill x -expand yes -side top
2957    grid [button $w.b.2 -text Set \
2958            -command "SetEditProfile [list $entrylist] [list $phaselist] \
2959            [list $histlist] $w"] -row 0 -column 1
2960    grid [button $w.b.3 -text Quit \
2961            -command "QuitEditProfile $w [list $entrylist]"] -row 0 -column 2
2962    grid [button $w.b.help -text Help -bg yellow \
2963            -command "MakeWWWHelp expgui5.html GlobalEdit"] \
2964            -row 0 -column 4
2965    grid columnconfig $w.b 0 -weight 1
2966    grid columnconfig $w.b 3 -weight 1
2967    bind $w <Key-F1> "MakeWWWHelp expgui5.html GlobalEdit"
2968    bind $w <Return> "QuitEditProfile $w [list $entrylist]"
2969
2970    # force the window to stay on top
2971    putontop $w
2972    focus $w.b.2
2973    tkwait window $w
2974    afterputontop
2975}
2976
2977proc SetEditProfile {entrylist phaselist histlist w} {
2978    global expgui
2979    foreach item $entrylist {
2980        set value [ [lindex $item 1] get ]
2981        if {$value != ""} {
2982            hapinfo $histlist $phaselist [lindex $item 0] set $value
2983            incr expgui(changed)
2984            if $expgui(debug) {
2985                puts "hapinfo [list $phaselist] [list $histlist] [lindex $item 0] set $value"
2986            }
2987        }
2988    }
2989    destroy $w
2990}
2991
2992proc QuitEditProfile {w entrylist} {
2993    global expgui
2994    # lets find out if anything changed
2995    set changed 0
2996    foreach item $entrylist {
2997        if {[ [lindex $item 1] get ] != ""} {set changed 1; break}
2998    }
2999    if $changed {
3000        set decision [tk_dialog .changes "Abandon Changes" \
3001                "You have made changes to the Profile. Ok to abandon changes?" \
3002                warning 0 Abandon Keep]
3003        if !$decision {destroy $w}
3004    } else {
3005        destroy $w
3006    }
3007}
3008
3009# this is called to change the absorption correction mode and to
3010# change the absorption correction model.
3011proc editabsorption {} {
3012    global expgui expmap
3013    set histlist {}
3014    foreach n $expgui(curhist) {
3015        lappend histlist [lindex $expmap(powderlist) $n]
3016    }
3017    if {[llength $histlist] == 0} return
3018
3019    set w .abs
3020    catch {destroy $w}
3021    toplevel $w -bg beige
3022    if {$expgui(globalmode) != 0} {
3023        wm title $w "Global Edit Absorption/Reflectivity" 
3024    } else {
3025        wm title $w "Edit Absorption/Reflectivity"
3026    }
3027   
3028    pack [frame $w.0 -bd 6 -relief groove  -bg beige \
3029            ] -side top -expand yes -fill both
3030    if {[llength $histlist] > 1} {
3031        grid [label $w.0.a \
3032            -text "Changing settings for histograms [CompressList $histlist]" \
3033            -bg beige] -row 0 -column 0 -columnspan 10
3034    } else {
3035        grid [label $w.0.a \
3036            -text "Changing settings for histogram $histlist" \
3037            -bg beige] -row 0 -column 0 -columnspan 4
3038        #grid columnconfig $w.0 4 -weight 1
3039    }
3040    grid rowconfig $w.0 1 -min 10
3041    set hist [lindex $histlist 0]
3042
3043    grid [label $w.0.lb1 -text "Absorption Coefficient(s)" -bg beige] \
3044            -row 2 -column 1  -columnspan 2
3045    grid [label $w.0.lb1a -text "1" -bg beige] -row 3 -column 1
3046    set expgui(abs2box1) $w.0.lb2a
3047    grid [label $w.0.lb2a -text "2" -bg beige] -row 3 -column 2
3048    grid [label $w.0.lb3 -text Absorption\nFunction -bg beige] \
3049            -row 2 -column 6 -rowspan 2 -columnspan 2
3050    grid [entry $w.0.ent1 -textvariable expgui(abscor1) -width 15] \
3051            -row 4 -column 1
3052    set expgui(abs2box2) $w.0.ent2
3053    grid [entry $w.0.ent2 -textvariable expgui(abscor2) -width 15] \
3054            -row 4 -column 2 
3055    trace vdelete expgui(abstype) w AbsSetoptmsg
3056    eval tk_optionMenu $w.0.m1 expgui(abstype) 0 1 2 3 4
3057    trace variable expgui(abstype) w AbsSetoptmsg
3058    grid $w.0.m1 -row 4 -column 6 -columnspan 2
3059    grid [label $w.0.lb8 -textvariable expgui(opttxt) -bg beige \
3060          -wrap 300 -justify left] -row 5 -column 1  -sticky ne -columnspan 7
3061    grid rowconfig $w.0 5 -min 100
3062    # set the values, note the trace on abstype
3063    foreach var {abscor1 abscor2 abstype} {
3064        set expgui($var) [histinfo $hist $var]
3065    }
3066
3067    pack [frame $w.b -bg beige] -fill x -expand yes -side top
3068    grid [button $w.b.2 -text Set -command "AbsSaveEdit $w [list $histlist]"] \
3069            -row 0 -column 1
3070    grid [button $w.b.3 -text Quit \
3071            -command "destroy $w"] -row 0 -column 2
3072    grid [button $w.b.help -text Help -bg yellow \
3073            -command "MakeWWWHelp expgui3.html EditAbsorption"] \
3074            -row 0 -column 4
3075    grid columnconfig $w.b 0 -weight 1
3076    grid columnconfig $w.b 3 -weight 1
3077    bind $w <Key-F1> "MakeWWWHelp expgui3.html EditAbsorption"
3078    bind $w <Return> "destroy $w"
3079
3080    # force the window to stay on top
3081    putontop $w
3082
3083    focus $w.b.2
3084    tkwait window $w
3085    afterputontop
3086}
3087
3088proc AbsSetoptmsg {args} {
3089    global expgui
3090    array set opttxt {
3091        0 "Correction for cylindrical samples [Lobanov & Alte da Veiga]. OK for all data types, but not for Bragg-Brentano flat-plate geometry. Set term 1 to mu*R/lambda (TOF: mu*R for lambda=1). For CW x-ray/neutron, do not refine!"
3092        1 "Wavelength-dependent correction for container penetration. Use with TOF & Energy Disp x-ray only."
3093        2 "Surface roughness correction [Pitschke, Hermann & Muttern]. Use with flat-plate reflection geometry (usually Bragg-Brentano) only."
3094        3 "Surface roughness correction, [Suortti]. Use with flat-plate reflection geometry (usually Bragg-Brentano) only."
3095        4 "Flat plate samples in transmission mode. OK for all data types, but not Bragg-Brentano geometry. Term 2 is angle w/r to beam (usually 0). For CW, do not refine."
3096    }
3097    set expgui(opttxt) ""
3098    catch {set expgui(opttxt) [set opttxt($expgui(abstype))]}
3099    switch $expgui(abstype) {
3100        0 -
3101        1 {
3102            $expgui(abs2box1) config -fg gray
3103            $expgui(abs2box2) config -state disabled -fg gray
3104        } 
3105        2 -
3106        3 -
3107        4 {
3108            $expgui(abs2box1) config -fg black
3109            $expgui(abs2box2) config -state normal -fg black
3110        }
3111        default {
3112            set expgui(opttxt) "Please select an absorption function"
3113        }
3114    }
3115}
3116proc AbsSaveEdit {top histlist} {
3117    global expgui expmap
3118    # sanity check: look at the histogram type
3119    set h [lindex $histlist 0]
3120    if {[string range $expmap(htype_$h) 2 2] == "T"} {set flag 1}
3121    if {[string range $expmap(htype_$h) 1 2] == "NC"} {set flag 2}
3122    if {[string range $expmap(htype_$h) 1 2] == "XC" && \
3123            [histinfo $h lam2] != 0.0} {set flag 3}
3124    if {[string range $expmap(htype_$h) 1 2] == "XC" && \
3125            [histinfo $h lam2] == 0.0} {set flag 4}
3126    if {[string range $expmap(htype_$h) 1 2] == "XE"} {set flag 5}
3127
3128    set msg {}
3129    if {$expgui(abstype) == 0 && ($flag == 3 || $flag == 4)} {
3130        set msg "Mode 0 is appropriate for cylindrical (Debye-Scherrer) geometry only"
3131    } elseif {$expgui(abstype) == 1 && ($flag != 1 && $flag != 5)} {
3132        set msg "Mode 1 is appropriate for wavelength-dispersive (TOF/E.D. X-ray) data only"
3133    } elseif {($expgui(abstype) == 2 || $expgui(abstype) == 3) \
3134            && $flag != 3 && $flag != 4} {
3135        set msg "Mode 1 is appropriate for reflection geometry flat-plate (typically Bragg-Brentano) data only"
3136    } elseif {$expgui(abstype) == 4 && $flag <= 3} {
3137        set msg "Mode 4 is appropriate for flat-plate samples in transmission"
3138    }
3139    if {$msg != ""} {
3140        set result [\
3141                MyMessageBox -parent $top -title "Sanity check" \
3142                -type okcancel -default cancel \
3143                -icon warning -helplink "expgui3.html AbsorptionSanity" \
3144                -message "$msg  -- are you sure you want to do this?"]
3145        if {$result == "cancel"} return
3146    }
3147
3148    # validate abscor1 & abscor2 (if needed)
3149    set msg {}
3150    if {![validreal expgui(abscor1) 15 8]} {
3151        set msg "Term 1 is invalid"
3152    }
3153    if {$expgui(abstype) > 1} {
3154        if {![validreal expgui(abscor2) 15 8]} {
3155            if {$msg != ""} {append msg "\n"}
3156            append msg "Term 2 is invalid"
3157        }
3158    }
3159    if {$msg != ""} {
3160        MyMessageBox -parent $top -title "Entry error" \
3161                -type ok -default ok \
3162                -icon warning -helplink "" \
3163                -message "Invalid data entered. Please correct.\n$msg"
3164        return
3165    }
3166   
3167    histinfo $histlist abstype set $expgui(abstype)
3168    histinfo $histlist abscor1 set $expgui(abscor1)
3169    if {$expgui(abstype) > 1} {
3170        histinfo $histlist abscor2 set $expgui(abscor2)
3171    } else {
3172        histinfo $histlist abscor2 set 0.
3173    }
3174    # turn off refinement, just in case they didn't read
3175    if {($expgui(abstype) == 0 || $expgui(abstype) == 1 || $expgui(abstype) == 4) \
3176            && ($flag != 1 && $flag != 5)} {
3177        histinfo $histlist absref set 0
3178    }
3179    incr expgui(changed)
3180    destroy $top
3181}
3182
3183##############################################################################
3184##                               #############################################
3185## END OF THE PROCEDURES SECTION #############################################
3186##                               #############################################
3187##############################################################################
3188
3189# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
3190# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          <<<<<<<<<<<<<<<<<<<
3191# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<   BEGIN:  GUI SECTION    >>>>>>>>>>>>>>>>>>>
3192# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>                          >>>>>>>>>>>>>>>>>>>
3193# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
3194# A frame for menu items at top of display
3195set expgui(fm) [frame .fm -relief raised -borderwidth 2 -width 150 -height 40]
3196# Pack the menu frame.
3197pack $expgui(fm) -fill x -side top -anchor n
3198
3199# create a button bar
3200pack [frame .bar -relief raised -bd 2 -bg beige] -fill x -side top -anchor n
3201
3202# Creating the notebook and panes
3203
3204# create an array element describing each notebook page
3205# element 0 -- pane name
3206#         1 -- Label on frame
3207#         2 -- initialization command
3208#         3 -- update command
3209#         4 -- 0/1 Use 1 if pane should be disabled in when all histograms
3210#                are selected in global mode, 0 otherwise
3211#         5 -- Web page for pane
3212#         6 -- name anchor on Web page for pane
3213set expgui(notebookpagelist) {
3214    {lsFrame     "LS Controls" \
3215            "" \
3216            SetupExtractHist \
3217            0  expgui1.html ""}
3218    {phaseFrame   Phase        \
3219            "" \
3220            {SelectOnePhase $expgui(curPhase)} \
3221            0  expgui2.html ""}
3222    {histFrame    Histogram \
3223            MakeHistPane \
3224            DisplayHistogram \
3225            1  expgui3.html ""}
3226    {fracFrame    Scaling \
3227            MakeScalingPane \
3228            DisplayFrac \
3229            0  expgui4.html ""}
3230    {profFrame    Profile \
3231            MakeProfilePane \
3232            DisplayProfile \
3233            1  expgui5.html ""}
3234    {consFrame    Constraints \
3235            "source [file join $expgui(scriptdir) atomcons.tcl]; MakeConstraintsPane" \
3236            DisplayConstraintsPane \
3237            0  expgui6.html ""}
3238    {orientFrame  "MD Pref Orient" \
3239            MakeOrientPane \
3240            DisplayOrient \
3241            0  expgui7.html MD}
3242    {odfFrame  "SH Pref Orient" \
3243            "source [file join $expgui(scriptdir) odf.tcl]; MakeODFPane" \
3244            DisplayODFPane \
3245            0  expgui7.html ODF}
3246}
3247
3248pack [NoteBook .n -bd 2] -expand yes -fill both
3249# this should not be needed, but for some reason NoteBook is not
3250# using the optionDB
3251catch {.n configure -font [option get .n font Canvas]}
3252foreach item $expgui(notebookpagelist) {
3253    set frm [lindex $item 0]
3254    set expgui($frm) [\
3255            .n insert end $frm -text [lindex $item 1] \
3256            -createcmd "set expgui(pagenow) $frm; [lindex $item 2]" \
3257            -raisecmd "set expgui(pagenow) $frm; [lindex $item 3]"]
3258
3259    # at this time expgui(frameactionlist) is generated
3260    # from expgui(notebookpagelist), but in the future it might
3261    # make sense to use expgui(notebookpagelist) directly
3262    lappend expgui(frameactionlist) "$frm [list [lindex $item 3]]"
3263   
3264    # panes to disable in global "all" mode
3265    if {[lindex $item 4]} {
3266        lappend expgui(GlobalModeAllDisable) "$frm \{.n itemconfigure $frm\}"
3267    }
3268}
3269
3270# this is used to bring up the selected frame
3271proc RaisePage {nextpage} {
3272    global expgui
3273    set expgui(pagenow) $nextpage
3274    .n see $nextpage
3275    .n raise $nextpage
3276}
3277
3278# resize the notebook to fit all the tabs and the largest page
3279proc ResizeNotebook {} {
3280    global expgui
3281    .n compute_size
3282}
3283
3284#----------------------------------------------------------------------------
3285proc MakePhasePane {} {
3286    #\/ \/ \/ \/ \/ \/ \/ BEGINNING OF PHASE PANE CODE \/ \/ \/ \/ \/ \/ \/
3287    global expgui entryvar entrybox entrycmd
3288    frame $expgui(phaseFrame).top
3289    set frameLatt [frame $expgui(phaseFrame).frameLatt]
3290    #  This is a big frame in the Phase notebook pane to hold atomic data.
3291    set fbig [frame $expgui(phaseFrame).fbig -width 180 \
3292            -relief raised -borderwidth 4 -class Coord]
3293    #  This is a frame just below the big frame: for edits
3294    set frame3 [frame $expgui(phaseFrame).frame3 -width 100 \
3295            -relief raised -borderwidth 4 -bg $expgui(bkgcolor1)]
3296
3297    grid $expgui(phaseFrame).top -sticky news -row 0 -column 0 
3298    grid $frameLatt -sticky news -row 2 -column 0 
3299    grid $fbig -sticky news -row 3 -column 0 
3300    # give extra space to the atoms box
3301    grid columnconfigure $expgui(phaseFrame) 0 -weight 1
3302    grid rowconfigure $expgui(phaseFrame) 3 -weight 1
3303    grid $frame3 -sticky news -row 4 -column 0 
3304    grid columnconfigure $expgui(phaseFrame) 0 -weight 1
3305    grid rowconfigure $expgui(phaseFrame) 3 -weight 1
3306    grid [frame  $expgui(phaseFrame).top.ps] -column 0 -row 0 -sticky w
3307    # this is where the buttons will go
3308    pack [label $expgui(phaseFrame).top.ps.0 -text "No Phases"] -side left
3309   
3310    grid [label $expgui(phaseFrame).top.lA -text title: \
3311            -fg blue ] -column 1 -row 0 -sticky e
3312    grid [entry $expgui(phaseFrame).top.lB -textvariable entryvar(phasename) \
3313            -fg blue -width 45] -column 2 -row 0 -sticky e
3314    grid columnconfigure $expgui(phaseFrame).top 1 -weight 1
3315    # ------------- Lattice Parameter Box ------------------
3316    set row 0
3317    foreach col {2 4 6} var {a b c} lbl {a b c} {
3318        grid [label $frameLatt.l$var -text $lbl] \
3319                -column $col -row $row -padx 5 -sticky e
3320        incr col
3321        grid [label $frameLatt.e$var -textvariable entryvar($var) \
3322                -relief groove -bd 2 -width 10] \
3323                -column $col -row $row -padx 5
3324#       grid [entry $frameLatt.e$var -textvariable entryvar($var) -width 10] \
3325#           -column $col -row $row -padx 5
3326#       set entrybox($var) $frameLatt.e$var
3327    }
3328    incr row
3329    foreach col {2 4 6} var {alpha beta gamma} lbl {a b g} {
3330        grid [label $frameLatt.l$var -text $lbl] \
3331                -column $col -row $row -padx 5 -sticky e
3332        set font [$frameLatt.l$var cget -font]
3333        $frameLatt.l$var config -font "Symbol [lrange $font 1 end]"
3334
3335        incr col
3336        grid [label $frameLatt.e$var -textvariable entryvar($var)\
3337                -relief groove -bd 2 -width 10] \
3338            -column $col -row $row -padx 5
3339#       grid [entry $frameLatt.e$var -textvariable entryvar($var) -width 10] \
3340#           -column $col -row $row -padx 5
3341#       set entrybox($var) $frameLatt.e$var
3342    }
3343   
3344    grid [button $frameLatt.edit -text "Edit\nCell" -command EditCellConstants] \
3345            -column 8 -row 0 -rowspan 2 -padx 5 -sticky e
3346    grid [label $frameLatt.lr -text "Refine Cell"] -column 9 -row 0 -padx 5 -sticky e
3347    grid [label $frameLatt.ld -text "Cell damping"] -column 9 -row 1 -padx 5 -sticky e
3348    set cFlag [checkbutton $frameLatt.c -text "" -variable entryvar(cellref)]
3349    grid $cFlag -column 10 -row 0 -padx 5 -sticky e
3350    tk_optionMenu $frameLatt.om entryvar(celldamp) 0 1 2 3 4 5 6 7 8 9
3351    grid $frameLatt.om -column 10 -row 1 -padx 5 -sticky e
3352    grid [label $frameLatt.phasetype -textvariable expgui(phasetype) -fg blue] \
3353            -column 1 -row 0 -rowspan 2
3354    if [file executable $expgui(exptool)] {
3355        grid [button $expgui(phaseFrame).frameLatt.newp \
3356                -text "Add\nPhase" -padx 1.5m -command MakeAddPhaseBox \
3357                ] -column 0 -row 0 -rowspan 2 -sticky w
3358    }
3359    grid columnconfig $frameLatt  1 -weight 1
3360    grid columnconfig $frameLatt  0 -weight 1
3361    #-------------- Begin Atom Coordinates Box  ------------------------------
3362    grid [listbox  $fbig.title -height 1 -relief flat \
3363            -exportselection 0 -bg lightgrey -fg black \
3364            -selectforeground black -selectbackground lightgrey] \
3365            -row 0 -column 0 -sticky ew
3366    set expgui(atomtitle) $fbig.title
3367    bind $expgui(atomtitle) <Button-1> {
3368        set i [lsearch {number type mult x y z occupancy} $expgui(asorttype)]
3369        incr i
3370        set expgui(asorttype) [lindex {number type mult x y z occupancy number} $i]
3371        DisplayAllAtoms $expgui(curPhase)
3372    }
3373    bind $expgui(atomtitle) <Button-3> {set expgui(asorttype) number; DisplayAllAtoms $expgui(curPhase)}
3374
3375    $expgui(atomtitle) configure -selectmode extended
3376    grid [listbox   $fbig.lbox -height 10 \
3377            -exportselection 0 \
3378            -xscrollcommand " $fbig.bscr set"\
3379            -yscrollcommand " $fbig.rscr set"\
3380            ] -row 1 -column 0 -sticky news
3381    set expgui(atomlistbox) $fbig.lbox
3382    $expgui(atomlistbox) configure -selectmode extended
3383    grid [scrollbar $fbig.bscr -orient horizontal \
3384            -command "move2boxesX \" $fbig.title $fbig.lbox \" " \
3385            ] -row 2 -column 0 -sticky ew
3386    grid [scrollbar $fbig.rscr  -command "$fbig.lbox yview" \
3387            ] -row 1 -column 1 -sticky ns
3388    # give extra space to the atoms box
3389    grid columnconfigure $fbig 0 -weight 1
3390    grid rowconfigure $fbig 1 -weight 1
3391   
3392    #   BIND mouse in editbox
3393    bind $expgui(atomlistbox) <ButtonRelease-1>   editRecord
3394    bind $expgui(atomlistbox) <Button-3>   SelectAllAtoms
3395   
3396    #-------------- End Atoms Section  ---------------------------------
3397
3398    # --------------------------- Begin Edit Box ------------------------
3399    grid [set expgui(EditingAtoms) [label $frame3.top -bg $expgui(bkgcolor1) -fg blue]] \
3400            -column 0 -row 0 -padx 2 -pady 3 -columnspan 10 -sticky w
3401    if [file executable $expgui(exptool)] {
3402        button $frame3.newa -text "Add New Atoms" \
3403                -bg $expgui(bkgcolor1) -highlightthickness 0 \
3404                -command {MakeAddAtomsBox $expgui(curPhase)}
3405        grid $frame3.newa -column 11 -row 0
3406        set expgui(AddAtomBut) $frame3.newa
3407    }
3408    button [set expgui(atomxform) $frame3.xa] \
3409            -bg $expgui(bkgcolor1) -highlightthickness 0 \
3410            -command {MakeXformAtomsBox $expgui(curPhase)}
3411    grid $expgui(atomxform) -column 11 -row 1 -sticky ew
3412
3413    set f3l1 [label $frame3.l1 -text "Refinement Flags:" -bg $expgui(bkgcolor1)]
3414    grid $f3l1 -column 0 -row 1 -padx 2 -sticky nsw -pady 3
3415    foreach lbl {X U F} var {xref uref fref} col {1 2 3} {
3416        grid [checkbutton $frame3.cf$col \
3417                -text $lbl -variable entryvar($var) \
3418                -bg $expgui(bkgcolor1) -highlightthickness 0 \
3419                -activebackground $expgui(bkgcolor1)] \
3420                -column $col -row 1 -padx 4 -pady 3 -sticky w
3421    }
3422    set f3l4 [label $frame3.l4 -text "  Damping:" -bg $expgui(bkgcolor1)]
3423    grid $f3l4 -column 4 -row 1 -padx 2 -sticky nsw -pady 3
3424   
3425    set col 4
3426    foreach var {xdamp udamp fdamp} num {2 3 4} lbl {X U F} {
3427        grid [label $frame3.lom$num -text $lbl \
3428                -bg $expgui(bkgcolor1)] \
3429                -column [incr col] -row 1 -padx 2 -pady 3 -sticky w
3430        tk_optionMenu $frame3.om$num entryvar($var) 0 1 2 3 4 5 6 7 8 9
3431        $frame3.om$num config -highlightthickness 0
3432        grid $frame3.om$num -column [incr col] -row 1 -padx 2 -pady 3 -sticky w
3433    }
3434    set expgui(atomreflbl) "$frame3.l1 $frame3.l4 $frame3.lom2 $frame3.lom3 $frame3.lom4 "
3435    set expgui(atomref) "$frame3.cf1 $frame3.cf2 $frame3.cf3 $frame3.om2 $frame3.om3 $frame3.om4"
3436   
3437    set coords [frame $frame3.coords  -width 100 -borderwidth 0  -bg $expgui(bkgcolor1)]
3438    grid $coords -column 0 -row 6 -columnspan 12 -sticky nsew
3439   
3440    set f3l1 [label $frame3.coords.l1 -text "Label" -bg $expgui(bkgcolor1)]
3441    grid $f3l1 -column 0 -row 4 -padx 2 -sticky nsw -pady 3
3442    set expgui(atomlabels) $f3l1
3443
3444    set f3e1 [entry  $frame3.coords.e1 -textvariable entryvar(label) -width 6]
3445    grid $f3e1 -column 1 -row 4 -padx 2 -sticky nsw -pady 3
3446    set expgui(atomentry) $f3e1
3447
3448    set f3l8 [label $frame3.coords.l8 -text "Coordinates" -bg $expgui(bkgcolor1)]
3449    grid $f3l8 -column 2 -row 4 -padx 2 -sticky nsw -pady 3
3450    lappend expgui(atomlabels) $f3l8
3451    set f3l11 [label $frame3.coords.l11 -text "Occupancy" -bg $expgui(bkgcolor1)]
3452    grid $f3l11 -column 6 -row 4 -padx 2 -sticky nsw -pady 3
3453    lappend expgui(atomlabels) $f3l11
3454
3455    foreach var {x y z frac} col {3 4 5 7} {
3456        set entrybox($var) [entry $frame3.coords.e$var \
3457                -textvariable entryvar($var) -width 10]
3458        grid $entrybox($var) -column $col -row 4 -padx 2 -sticky nsw -pady 3
3459        lappend expgui(atomentry) $entrybox($var)
3460    }
3461
3462
3463    set f3f31 [frame $frame3.f3f31  -width 100 -borderwidth 0 -bg $expgui(bkgcolor1)]
3464    grid $f3f31 -column 0 -row 7 -columnspan 12
3465    set expgui(anisolabels) {}
3466    foreach lbl {13 14 15 16 17 18} txt {Uiso U22 U33 U12 U13 U23} {
3467        lappend expgui(anisolabels)  [\
3468                label $f3f31.l$lbl -text $txt -bg $expgui(bkgcolor1)
3469        ]
3470    }
3471    set expgui(anisoentry) {}
3472    foreach i {e13 e14 e15 e16 e17 e18} var {U11 U22 U33 U12 U13 U23} { 
3473        lappend expgui(anisoentry) [\
3474                entry $f3f31.$i -textvariable entryvar($var) \
3475                -width 10]
3476        set entrybox($var) $f3f31.$i
3477    }
3478   
3479    set col 0
3480    foreach item1 $expgui(anisolabels) item2 $expgui(anisoentry) {
3481        grid $item1 -column $col -row 0 -sticky nsw -pady 3
3482        incr col
3483        grid $item2 -column $col -row 0 -sticky nsw -pady 3
3484        incr col
3485    }
3486    # --------------------------- End Edit Box -------------------------
3487   
3488    #/\ /\ /\ /\ /\ /\ /\ END OF PHASE PANE CODE /\ /\ /\ /\ /\ /\ /\ /\ /
3489    # resize in case the pane needs more space
3490    ResizeNotebook
3491}
3492
3493# called to create a window for editing unit cell constants
3494proc EditCellConstants {} {
3495    global expgui entrybox
3496    set spg [phaseinfo $expgui(curPhase) spacegroup]
3497    set laueaxis [GetLaue $spg]
3498    set vary ""
3499    set equivL ""
3500    set equivA ""
3501    switch -exact $laueaxis {
3502        1bar {set vary "a b c alpha beta gamma"}
3503        2/ma {set vary "a b c alpha"}
3504        2/mb {set vary "a b c beta"}
3505        2/mc {set vary "a b c gamma"}
3506        mmm  {set vary "a b c"}
3507        4/m  -
3508        4/mmm {set vary "a c"; set equivL "a b"} 
3509        3barR     -
3510        "3bar mR" {
3511            set vary "a alpha"
3512            set equivL "a b c"
3513            set equivA "alpha beta gamma"
3514        }
3515        3bar    -
3516        3barm1  -
3517        3bar1m  -
3518        6/m     -
3519        6/mmm  {set vary "a c";set equivL "a b"}
3520        "m 3"  -
3521        m3m    {set vary a;set equivL "a b c"}
3522        default {
3523            MyMessageBox -parent . -title "Laue problem" \
3524                    -message "Error processing Laue code: $laueaxis\nError in space group \"$spg\"?\nUnable to edit cell. Fix or use EXPEDT." \
3525                    -icon warning -type OK -default ok \
3526                    -helplink "expguierr.html BadLaue"
3527        }
3528    }
3529    set row 0
3530    set w .cell
3531    toplevel $w -bg beige
3532    wm title $w "Edit Cell Parameters" 
3533#    bind $w <Key-F1> "MakeWWWHelp expgui3.html EditBackground"
3534    bind $w <Return> "set expgui(temp) 1; destroy $w"
3535    pack [label $w.l1 -bg yellow -anchor center -justify center \
3536            -text "Edit unit cell parameters for phase #$expgui(curPhase)" \
3537            ] -side top -expand yes -fill both
3538    pack [label $w.l2 -bg beige -justify left \
3539            -text "title: [phaseinfo $expgui(curPhase) name]\nSpace group: $spg\nLaue class: $laueaxis" \
3540            ] -side top -expand yes -fill both
3541    pack [frame $w.0 -bd 6 -relief groove  -bg beige \
3542            ] -side top -expand yes -fill both
3543    pack [frame $w.b -bg beige] -fill x -expand yes -side top
3544    grid [button $w.b.2 -text Set -command "set expgui(temp) 1; destroy $w"] -row 0 -column 1
3545    grid [button $w.b.3 -text Quit \
3546            -command "set expgui(temp) 0; destroy $w"] -row 0 -column 2
3547#    grid [button $w.b.help -text Help -bg yellow \
3548#           -command "MakeWWWHelp expgui3.html EditBackground"] \
3549#           -row 0 -column 4
3550
3551    global tmpvar
3552    trace variable tmpvar w TestCellEdit
3553    foreach ent {a b c alpha beta gamma} {
3554        set tmpvar($ent) [phaseinfo $expgui(curPhase) $ent]
3555    }
3556
3557    set frameLatt $w.0
3558    foreach col {2 4 6} var {a b c} lbl {a b c} {
3559        grid [label $frameLatt.l$var -text $lbl -bg beige] \
3560                -column $col -row $row -padx 5 -sticky e
3561        incr col
3562        if {[lsearch $equivL $var] == -1} {
3563            set v $var
3564        } else {
3565            set v [lindex $equivL 0]
3566        }
3567        if {[lsearch $vary $var] == -1} {
3568            grid [label $frameLatt.e$var -textvariable tmpvar($v) \
3569                    -width 10 -bg beige] \
3570                    -column $col -row $row -padx 5
3571        } else {
3572            grid [entry $frameLatt.e$var -textvariable tmpvar($v) \
3573                    -width 10] -column $col -row $row -padx 5
3574            set entrybox($var) $frameLatt.e$var 
3575        }
3576    }
3577    incr row
3578    foreach col {2 4 6} var {alpha beta gamma} lbl {a b g} {
3579        grid [label $frameLatt.l$var -text $lbl -bg beige] \
3580                -column $col -row $row -padx 5 -sticky e
3581        set font [$frameLatt.l$var cget -font]
3582        $frameLatt.l$var config -font "Symbol [lrange $font 1 end]"
3583
3584        incr col
3585        if {[lsearch $equivA $var] == -1} {
3586            set v $var
3587        } else {
3588            set v [lindex $equivA 0]
3589        }
3590        if {[lsearch $vary $var] == -1} {
3591            grid [label $frameLatt.e$var -textvariable tmpvar($v)\
3592                    -width 10 -bg beige] \
3593                    -column $col -row $row -padx 5
3594        } else {
3595            grid [entry $frameLatt.e$var -textvariable tmpvar($v) \
3596            -width 10] -column $col -row $row -padx 5
3597            set entrybox($var) $frameLatt.e$var 
3598        }
3599    }
3600    putontop $w
3601    tkwait window $w
3602    afterputontop
3603    global entryvar
3604    set change 0
3605    if {$expgui(temp)} {
3606        foreach var {a b c} {
3607            if {[lsearch $equivL $var] == -1} {
3608                set v $var
3609            } else {
3610                set v [lindex $equivL 0]
3611            }
3612            catch {
3613                expr [set val $tmpvar($v)]
3614                if {[phaseinfo $expgui(curPhase) $var] != $val} {
3615                    phaseinfo $expgui(curPhase) $var set $val
3616                    set entryvar($var) $val
3617                    incr expgui(changed)                   
3618                    set change 1
3619                }
3620            }
3621        }
3622        foreach var {alpha beta gamma} {
3623            if {[lsearch $equivA $var] == -1} {
3624                set v $var
3625            } else {
3626                set v [lindex $equivA 0]
3627            }
3628            catch {
3629                expr [set val $tmpvar($v)]
3630                if {[phaseinfo $expgui(curPhase) $var] != $val} {
3631                    phaseinfo $expgui(curPhase) $var set $val
3632                    set entryvar($var) $val
3633                    incr expgui(changed)                   
3634                    set change 1
3635                }
3636            }
3637        }
3638        if {$change} {
3639            # set the powpref warning (1 = suggested)
3640            if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1}
3641            append expgui(needpowpref_why) "\tCell parameters were changed\n"
3642        }
3643    }
3644    unset tmpvar
3645}
3646
3647# highlight errors in unit cell constants
3648proc TestCellEdit {var elem mode} {
3649    global tmpvar entrybox
3650    if {[catch {expr $tmpvar($elem)} errmsg]} {
3651        catch {$entrybox($elem) config -fg red}
3652    } else {
3653        catch {$entrybox($elem) config -fg black}
3654    }
3655}
3656
3657#-----------------------------------------------------------------------------
3658proc MakeHistPane {} {
3659    #v v v v v v v v v v  BEGINNING OF HISTOGRAM PANE CODE v v v v v v v v v v
3660    global expgui
3661   
3662    grid columnconfigure $expgui(histFrame) 0 -weight 1
3663    grid rowconfigure $expgui(histFrame) 1 -weight 1
3664    grid rowconfigure $expgui(histFrame) 2 -weight 1
3665    grid rowconfigure $expgui(histFrame) 3 -weight 1
3666
3667    grid [frame $expgui(histFrame).hs -class HistList] \
3668            -column 0 -row 0 -rowspan 10 -sticky nsew
3669    MakeHistBox $expgui(histFrame).hs
3670    bind $expgui(histFrame).hs.lbox <ButtonRelease-1>  {
3671        set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
3672        DisplayHistogram
3673    }
3674    bind $expgui(histFrame).hs.lbox <Button-3>  {
3675        if $expgui(globalmode) {
3676            $expgui(histFrame).hs.lbox selection set 0 end
3677            set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
3678            DisplayHistogram
3679        }
3680    }
3681   
3682    frame $expgui(histFrame).top -borderwidth 4 -relief groove
3683    grid [label $expgui(histFrame).top.txt] -row 0 -column 0
3684    foreach item {backBox diffBox absBox} num {2 3 4} title {Background "Diffractometer Constants" "Absorption/Reflectivity Correction"} {
3685        TitleFrame $expgui(histFrame).$item  \
3686            -borderwidth 4 -side left -relief groove -text $title
3687        set expgui($item) [$expgui(histFrame).$item getframe]
3688        grid $expgui(histFrame).$item -column 1 -row $num -sticky nsew
3689        grid rowconfigure $expgui(histFrame) $num -minsize 100
3690    }
3691    grid [frame $expgui(histFrame).bb] -column 1 -row 6
3692    if [file executable $expgui(exptool)] {
3693        button $expgui(histFrame).bb.newh -text "Add New\nHistogram" \
3694                -command MakeAddHistBox
3695        grid $expgui(histFrame).bb.newh -column 0 -row 1
3696    }
3697    button $expgui(histFrame).bb.excl \
3698            -text "Set Data Limits &\nExcluded Regions" -command excledit
3699    grid $expgui(histFrame).bb.excl -column 1 -row 1
3700
3701    button $expgui(histFrame).bb.use -text "Set Histogram\nUse Flags" \
3702            -command SetHistUseFlags
3703    grid $expgui(histFrame).bb.use -column 2 -row 1
3704
3705    # BACKGROUND information.
3706    # <<<<<<<<<<<<<<<<<<<<<<<<< BACKGROUND  <<<<<<<<<<<<<<<<<<<<<
3707    grid [frame $expgui(backBox).frm1 ] -row 0 -column 0  -columnspan 11
3708    grid [label $expgui(backBox).frm1.lBGType \
3709            -textvariable expgui(backtypelbl)] \
3710            -row 1 -column 0 -sticky nws  -padx 2 -pady 3
3711    grid [label $expgui(backBox).frm1.lBGTerms \
3712            -textvariable expgui(backtermlbl)] \
3713            -row 1 -column 1 -sticky nws  -padx 2 -pady 3
3714    grid [button $expgui(backBox).frm1.edit -textvariable expgui(bkglbl) \
3715            -command editbackground] \
3716            -row 1 -column 2 -columnspan 3 -sticky w -padx 2 -pady 3
3717    grid [frame $expgui(backBox).frm2 ] \
3718            -row 1 -column 0 -columnspan 11 -sticky e
3719    grid [label $expgui(backBox).frm2.lfBG -text "  Refine background" ] \
3720            -row 2 -column 1 -sticky news -padx 4 -pady 3
3721    grid [checkbutton $expgui(backBox).frm2.rfBG -text "" \
3722            -variable  entryvar(bref) ] \
3723            -row 2 -column 2 -sticky news -padx 4 -pady 3
3724    grid [label $expgui(backBox).frm2.lBGDamp -text Damping ] \
3725            -row 2 -column 3 -sticky w    -padx 2 -pady 3
3726    tk_optionMenu $expgui(backBox).frm2.om  entryvar(bdamp) 0 1 2 3 4 5 6 7 8 9
3727    grid $expgui(backBox).frm2.om \
3728            -row 2 -column 4 -sticky news -padx 4 -pady 3 -sticky e
3729    # Absorption information.
3730    grid [label $expgui(absBox).rf1 -text "  Refine Abs./Refl." ] \
3731            -row 2 -column 1 -sticky news -padx 4 -pady 3
3732    grid [checkbutton $expgui(absBox).rf2 -text "" \
3733            -variable  entryvar(absref) ] \
3734            -row 2 -column 2 -sticky news -padx 4 -pady 3
3735    grid [label $expgui(absBox).d1 -text Damping ] \
3736            -row 2 -column 3 -sticky w    -padx 2 -pady 3
3737    tk_optionMenu $expgui(absBox).d2  entryvar(absdamp) 0 1 2 3 4 5 6 7 8 9
3738    grid $expgui(absBox).d2 \
3739            -row 2 -column 4 -sticky news -padx 4 -pady 3 -sticky e
3740    grid [button $expgui(absBox).edit -textvariable expgui(abslbl) \
3741            -command editabsorption] \
3742            -row 2 -column 5 -sticky w -padx 2 -pady 3
3743
3744    #^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^END OF HISTOGRAM PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3745    # insert the histograms & resize in case the pane needs more space   
3746    sethistlist
3747    ResizeNotebook
3748}
3749###############################################################################
3750proc MakeScalingPane {} {
3751    #v v v v v v v v v v  BEGINNING OF SCALING PANE CODE v v v v v v v v v v
3752    global expgui entryvar entrybox
3753
3754    pack [frame $expgui(fracFrame).hs -class HistList] \
3755            -side left -expand y -fill both
3756    MakeHistBox $expgui(fracFrame).hs
3757    bind $expgui(fracFrame).hs.lbox <ButtonRelease-1> {
3758        set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
3759        DisplayFrac
3760    }
3761    bind $expgui(fracFrame).hs.lbox <Button-3>  {
3762        if $expgui(globalmode) {
3763            $expgui(fracFrame).hs.lbox selection set 0 end
3764            set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
3765            DisplayFrac
3766        }
3767    }
3768
3769    pack [frame $expgui(fracFrame).f1] -fill both -expand true
3770    # Create a large canvas area containing a frame for each phase in the data set.
3771    # The canvas and vertical scrollbar are inside a frame called f1
3772    TitleFrame $expgui(fracFrame).f1.scaleBox \
3773        -borderwidth 4 -text "Scale Factor"
3774    #       -borderwidth 4 -width 600 -height 100 -label "Scale Factor"
3775    grid $expgui(fracFrame).f1.scaleBox -column 0 -row 0 -sticky nsew -columnspan 2
3776    set expgui(scaleBox)  [$expgui(fracFrame).f1.scaleBox getframe]
3777    grid [label $expgui(scaleBox).histSFLabel -text Scale] \
3778        -row 1 -column 0 -sticky nws  -padx 2 -pady 3
3779    grid [entry $expgui(scaleBox).ent1 -textvariable entryvar(scale) -width 15] \
3780            -row 1 -column 1 -sticky ew -padx 4 -pady 3
3781    set entrybox(scale) $expgui(scaleBox).ent1
3782
3783    button $expgui(scaleBox).but1 -text "Set Globally" \
3784            -command "editglobalparm histinfo scale {Scale Factor}"
3785
3786    grid [label $expgui(scaleBox).histSFRLabel -text " Refine"] \
3787            -row 1 -column 2 -sticky nws  -padx 2 -pady 3
3788    grid [checkbutton $expgui(scaleBox).rf -variable entryvar(sref)] \
3789            -row 1 -column 3 -sticky news -padx 4 -pady 3
3790    grid [label $expgui(scaleBox).lD1 -text "Damping"] \
3791            -row 1 -column 4 -sticky w    -padx 2 -pady 3
3792    tk_optionMenu $expgui(scaleBox).om entryvar(sdamp) 0 1 2 3 4 5 6 7 8 9
3793    grid $expgui(scaleBox).om \
3794            -row 1 -column 5 -sticky news -padx 4 -pady 3
3795    grid columnconfigure $expgui(scaleBox) 6  -weight 1
3796   
3797    grid [TitleFrame $expgui(fracFrame).f1.phaseFrac -bd 4 \
3798              -text "Phase Fractions" -relief groove] \
3799        -sticky news -row 1 -column 0 -columnspan 2
3800    set PhaseFractBox [$expgui(fracFrame).f1.phaseFrac getframe]
3801    grid columnconfigure $expgui(fracFrame).f1 0 -weight 1
3802    grid rowconfigure $expgui(fracFrame).f1 1 -weight 1
3803   
3804    grid [set expgui(FracBox) [canvas $PhaseFractBox.fracBox \
3805            -scrollregion {0 0 5000 500} \
3806            -yscrollcommand "$PhaseFractBox.yscroll set" \
3807            -width 500 -height 350 -bg lightgrey]] \
3808            -sticky  news -row 1 -column 0
3809    grid [scrollbar $PhaseFractBox.yscroll \
3810            -command "$expgui(FracBox) yview" \
3811            -orient vertical] \
3812            -sticky ns -row 1 -column 1
3813    frame $expgui(FracBox).f -bd 0
3814    $expgui(FracBox) create window 0 0 -anchor nw  -window $expgui(FracBox).f
3815
3816    # the rest of the page is created in DisplayFrac
3817
3818    # insert the histograms & resize in case the pane needs more space
3819    sethistlist
3820    ResizeNotebook
3821    # ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF SCALING PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3822}
3823###############################################################################
3824proc MakeProfilePane {} {
3825    global expgui
3826    # v v v v v v v v v v BEGINNING OF PROFILE PANE CODE v v v v v v v v v v v
3827    pack [frame $expgui(profFrame).hs -class HistList] \
3828            -side left -expand y -fill both
3829    MakeHistBox $expgui(profFrame).hs
3830    bind $expgui(profFrame).hs.lbox <ButtonRelease-1> {
3831        set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
3832        DisplayProfile
3833    }
3834    bind $expgui(profFrame).hs.lbox <Button-3>  {
3835        if $expgui(globalmode) {
3836            $expgui(profFrame).hs.lbox selection set 0 end
3837            set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
3838            DisplayProfile
3839        }
3840    }
3841
3842    # Create a large canvas area containing a frame for each phase in the data set.
3843    # The canvas and vertical scrollbar are inside a frame called f1
3844    pack [frame $expgui(profFrame).f1] -fill both -expand true
3845    grid [set expgui(ProfileBox) [canvas $expgui(profFrame).f1.profileBox \
3846            -scrollregion {0 0 5000 500} -width 500 -height 350 -bg lightgrey]] \
3847            -sticky  news -row 0 -column 0
3848    grid [scrollbar $expgui(profFrame).f1.yscroll -orient vertical] \
3849            -sticky ns -row 0 -column 1
3850   
3851    $expgui(ProfileBox) config -yscrollcommand "$expgui(profFrame).f1.yscroll set"
3852    $expgui(profFrame).f1.yscroll config -command { $expgui(ProfileBox) yview }
3853   
3854    grid columnconfigure $expgui(profFrame).f1 1 -weight 1
3855    grid rowconfigure $expgui(profFrame).f1 0 -weight 1
3856    frame $expgui(ProfileBox).f -bd 0
3857    $expgui(ProfileBox) create window 0 0 -anchor nw  -window $expgui(ProfileBox).f
3858   
3859    # insert the histograms & resize in case the pane needs more space
3860    sethistlist
3861    ResizeNotebook
3862    # ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF PROFILE PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3863}
3864
3865##############################################################################
3866# v v v v v v v v v v BEGINNING OF LS PANE CODE v v v v v v v v v v v v v
3867array set printopts {
3868    0 "Print the reciprocal metric tensor changes"
3869    1 "Print the correlation matrix"
3870    2 "Print the Least-Squares matrices and vectors"
3871    4 "Print the linear constraint matrices"
3872    5 "Print the applied  shifts and shift factors"
3873    6 "Print the reciprocal metric tensor Var-Covar terms"
3874    7 "Print all parameters for each cycle"
3875    8 "Print summary shift/esd data after last cycle"
3876    9 "Print zero/unit pole figure constraint terms"
3877    10 "Output parameter name, value & esd to file"
3878}
3879pack [frame $expgui(lsFrame).hs -class HistList] \
3880        -side left -expand y -fill both
3881MakeHistBox $expgui(lsFrame).hs
3882bind $expgui(lsFrame).hs.lbox <ButtonRelease-1> {
3883    set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
3884    SetupExtractHist
3885}
3886bind $expgui(lsFrame).hs.lbox <Button-3>  {
3887    if $expgui(globalmode) {
3888        $expgui(lsFrame).hs.lbox selection set 0 end
3889        set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
3890        SetupExtractHist
3891    }
3892}
3893
3894pack [frame $expgui(lsFrame).f1] -fill both -expand true
3895set row 0
3896grid [label $expgui(lsFrame).f1.his1 -pady 6 -text "Last History:"] -row $row -column 0
3897grid [label $expgui(lsFrame).f1.his2 -relief raised -bd 2 -pady 6 \
3898        -textvariable expgui(last_History)] \
3899        -row $row -column 1 -columnspan 5 -sticky w
3900incr row
3901grid [label $expgui(lsFrame).f1.tit1 -pady 6 -text "Title:"] -row $row -column 0
3902grid [entry $expgui(lsFrame).f1.tit2 \
3903        -textvariable entryvar(title) -width 48] \
3904        -row $row -column 1 -columnspan 5 -sticky w
3905set entrycmd(title) "expinfo title"
3906
3907incr row
3908grid rowconfigure $expgui(lsFrame).f1 $row -weight 1
3909incr row
3910grid [frame $expgui(lsFrame).f1.b -bd 4 -relief groove] \
3911        -row $row -column 0 -columnspan 2 -pady 3  -sticky s
3912grid [label $expgui(lsFrame).f1.b.lcyc -text "Number of Cycles"] -row 0 -column 0
3913grid [entry $expgui(lsFrame).f1.b.ecyc -width 3 \
3914        -textvariable entryvar(cycles)] -row 0 -column 1
3915set entrybox(cycles) $expgui(lsFrame).f1.b.ecyc
3916
3917grid [frame $expgui(lsFrame).f1.cv -bd 4 -relief groove] \
3918        -row $row -column 2 -sticky ew
3919grid [label $expgui(lsFrame).f1.cv.l -text "Convgerence Criterion"] \
3920        -row 0 -column 0 -columnspan 2
3921grid [label $expgui(lsFrame).f1.cv.v -textvariable expgui(convlbl)] -row 1 -column 0
3922grid [scale $expgui(lsFrame).f1.cv.s -orient horizontal \
3923        -from -200 -to 200 -showvalue 0 -command SetConv -resolution 10 \
3924        -variable expgui(convg)] -row 1 -column 1
3925
3926incr row
3927grid [menubutton $expgui(lsFrame).f1.lprint -textvariable expgui(printopt) \
3928        -menu $expgui(lsFrame).f1.lprint.menu -bd 4 -relief raised \
3929        ] -row $row -column 0 -columnspan 2 
3930menu $expgui(lsFrame).f1.lprint.menu
3931foreach num [lsort -integer [array names printopts]] {
3932    $expgui(lsFrame).f1.lprint.menu add checkbutton \
3933        -label "$printopts($num) ([expr int(pow(2,$num))])"\
3934        -variable entryvar(printopt$num)
3935}
3936
3937grid [frame $expgui(lsFrame).f1.marq -bd 4 -relief groove] \
3938        -row $row -column 2 -sticky ew
3939grid [label $expgui(lsFrame).f1.marq.l -text "Marquardt Damping"] \
3940        -row 0 -column 0 -columnspan 2
3941grid [label $expgui(lsFrame).f1.marq.v -textvariable expgui(marq)] \
3942        -row 1 -column 0
3943grid [scale $expgui(lsFrame).f1.marq.s -orient horizontal \
3944        -from 1.0 -to 9.99 -showvalue 0 -command SetMarq -resolution 0.01 \
3945        -variable expgui(marq)] -row 1 -column 1
3946
3947incr row
3948grid [frame $expgui(lsFrame).f1.d -bd 4 -relief groove] \
3949        -row $row -column 2 -sticky ew
3950grid [label $expgui(lsFrame).f1.d.lmbw -text "LS matrix bandwidth"] -row 0 -column 0
3951grid [entry $expgui(lsFrame).f1.d.embw -width 4 \
3952        -textvariable entryvar(mbw)] -row 0 -column 1
3953set entrybox(mbw) $expgui(lsFrame).f1.d.embw
3954
3955incr row
3956grid rowconfigure $expgui(lsFrame).f1 $row -weight 1
3957
3958incr row
3959grid [TitleFrame $expgui(lsFrame).f1.a -bd 4 -relief groove \
3960          -text "Reflection Intensity Extraction" \
3961         ] -row $row -column 0 -columnspan 6
3962set expgui(FobsExtractFrame) [$expgui(lsFrame).f1.a getframe]
3963
3964grid [frame $expgui(FobsExtractFrame).c -bd 4 -relief groove] \
3965        -row 0 -column 8 -columnspan 3 -sticky ens
3966grid [label $expgui(FobsExtractFrame).c.fol -text "Extract Fobs"] \
3967        -row 0 -column 2
3968grid [checkbutton $expgui(FobsExtractFrame).c.foc \
3969        -variable entryvar(fobsextract)] -row 0 -column 3
3970
3971grid [frame $expgui(FobsExtractFrame).d -bd 4 -relief groove] \
3972        -row 0 -column 3 -columnspan 5 -sticky ens
3973grid [label $expgui(FobsExtractFrame).d.fol -text "LeBail damping"] \
3974        -row 0 -column 2
3975tk_optionMenu $expgui(FobsExtractFrame).d.d entryvar(LBdamp) \
3976        0 1 2 3 4 5 6 7 8 9
3977grid $expgui(FobsExtractFrame).d.d -row 0 -column 3
3978incr row
3979grid rowconfigure $expgui(lsFrame).f1 $row -weight 1
3980
3981
3982
3983foreach num {1 2 3 4 5 6 7 8 9} {
3984    grid [label $expgui(FobsExtractFrame).l$num -text $num] -row 1 -column $num
3985    grid [radiobutton $expgui(FobsExtractFrame).cc$num \
3986            -command "HistExtractSet $num" \
3987            -variable expgui(Fextract$num) -value 0] \
3988            -row 2 -column $num
3989    grid [radiobutton $expgui(FobsExtractFrame).ca$num \
3990            -command "HistExtractSet $num" \
3991            -variable expgui(Fextract$num) -value 1] \
3992            -row 3 -column $num
3993    grid [radiobutton $expgui(FobsExtractFrame).cb$num \
3994            -command "HistExtractSet $num" \
3995            -variable expgui(Fextract$num) -value 2] \
3996            -row 4 -column $num
3997}
3998set expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).cc
3999lappend expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).ca
4000lappend expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).cb
4001
4002grid [label $expgui(FobsExtractFrame).t \
4003        -text "Extraction\nMethod" -anchor c] \
4004        -column 0 -row 0 -sticky n
4005grid [label $expgui(FobsExtractFrame).t0 -text "(Phase #)" -anchor c] \
4006        -column 10 -row 1 -sticky w
4007grid [label $expgui(FobsExtractFrame).t1 -text "Rietveld" -anchor c] -column 0 -row 2
4008grid [label $expgui(FobsExtractFrame).t2 -text "F(calc) Weighted" -anchor c] -column 0 -row 3
4009grid [label $expgui(FobsExtractFrame).t3 -text "Equally Weighted" -anchor c] -column 0 -row 4
4010grid [label $expgui(FobsExtractFrame).t2a -text "(Model biased)" -anchor c] -column 10 -row 3
4011grid [label $expgui(FobsExtractFrame).t3a -text "(Le Bail method)" -anchor c] -column 10 -row 4
4012
4013proc InitLSvars {} {
4014    global expgui
4015    set expgui(convg) [set expgui(convinit) [expinfo convg]]
4016    set expgui(convlbl) [format %5.2f [expr pow(10,$expgui(convg)/100.)]]
4017    set expgui(marq) [set expgui(marqinit) [expinfo marq]]
4018    set expgui(mbw) [set expgui(mbwinit) [expinfo mbw]]
4019}
4020proc SetConv {x} {
4021    global expgui
4022    if {$x != $expgui(convinit) && $expgui(changed) <= 0} {
4023        incr expgui(changed)
4024    }
4025    if {$expgui(changed)} {expinfo convg set $x}
4026    set expgui(convlbl) [format %5.2f [expr {pow(10,$x/100.)}]]
4027}
4028proc SetMarq {x} {
4029    global expgui
4030    if {$x != $expgui(marqinit) && $expgui(changed) <= 0} {
4031        incr expgui(changed)
4032    }
4033    if {$expgui(changed)} {expinfo marq set $x}
4034}
4035# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF LS PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
4036#-------------------------------------------------------------------------
4037#-------------------------------------------------------------------------
4038#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv THE MENU BAR vvvvvvvvvvvvvvvvvvvvvv
4039
4040#---- file menu button
4041menubutton $expgui(fm).file -text File -menu $expgui(fm).file.menu
4042menu $expgui(fm).file.menu
4043if $expgui(debug) {
4044    $expgui(fm).file.menu add command -label "Reset" -command "reset"
4045}
4046if {$expgui(shell)} {
4047    $expgui(fm).file.menu add command -label "Open" -command readnewexp
4048    $expgui(fm).file.menu add command -label "expnam" -command readnewexp
4049}
4050$expgui(fm).file.menu add command -label "Save" -underline 0 \
4051        -command savearchiveexp
4052foreach c {s S} {bind . <Alt-$c> [list savearchiveexp]}
4053$expgui(fm).file.menu add command -label "Save As" \
4054        -command "SaveAsFile"
4055$expgui(fm).file.menu add command -label "Reread .EXP file" \
4056        -command {rereadexp $expgui(expfile)}
4057
4058#---- help menu button
4059menubutton $expgui(fm).help -text Help -menu $expgui(fm).help.menu
4060menu $expgui(fm).help.menu
4061$expgui(fm).help.menu add command -command showhelp -underline 0 \
4062        -label "Help Summary"
4063$expgui(fm).help.menu add command -command MakeWWWHelp  \
4064        -label "Help on current pane"
4065$expgui(fm).help.menu add command -command "MakeWWWHelp menu" \
4066        -label "Help on menu"
4067if {![catch {package require tkcon} errmsg]} {
4068    $expgui(fm).help.menu add command -label "Open console" \
4069        -command {tkcon show}
4070} elseif {$tcl_platform(platform) == "windows"} {
4071    $expgui(fm).help.menu add command -label "Open console" \
4072        -command {console show}
4073}
4074foreach c {h H} {bind . <Alt-$c> [list showhelp]}
4075# define help actions
4076bind . <Key-F1> MakeWWWHelp
4077$expgui(fm).help.menu add command -label "About..." -command About
4078$expgui(fm).help.menu add command -label "Cite..." -command Cite
4079
4080#---- options menu button
4081menubutton $expgui(fm).option -text Options \
4082        -menu $expgui(fm).option.menu
4083menu $expgui(fm).option.menu
4084
4085if {$expgui(shell)} {
4086    $expgui(fm).option.menu add checkbutton  -label "Archive EXP" \
4087            -variable expgui(archive)
4088    $expgui(fm).option.menu add checkbutton  -label "Use DISAGL window" \
4089            -variable expgui(disaglSeparateBox)
4090    $expgui(fm).option.menu  add checkbutton -label "Autoload EXP" \
4091            -variable expgui(autoexpload)
4092    $expgui(fm).option.menu  add checkbutton -label "Iconify during GSAS" \
4093            -variable expgui(autoiconify)
4094    if {$tcl_platform(platform) == "windows" && \
4095            $tcl_platform(os) == "Windows 95"} {
4096        $expgui(fm).option.menu  add checkbutton -label "Autostart GRWND" \
4097                -variable expgui(autoGRWND)
4098    }
4099}
4100$expgui(fm).option.menu add cascade -menu  $expgui(fm).option.menu.asort \
4101        -label "Sort atoms by"
4102
4103set expgui(asorttype) number
4104menu $expgui(fm).option.menu.asort
4105foreach opt {number type mult x y z occupancy} {
4106    $expgui(fm).option.menu.asort add radiobutton -command {DisplayAllAtoms $expgui(curPhase)}\
4107            -label $opt -value $opt -variable expgui(asorttype) 
4108}
4109
4110$expgui(fm).option.menu add cascade -menu  $expgui(fm).option.menu.hsort \
4111        -label "Sort histograms by"
4112
4113set expgui(hsorttype) number
4114menu $expgui(fm).option.menu.hsort
4115$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
4116        -label number -value number -variable expgui(hsorttype) 
4117$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
4118        -label "Histogram type" -value type -variable expgui(hsorttype) 
4119$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
4120        -label "Bank #" -value bank -variable expgui(hsorttype) 
4121$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
4122        -label "Angle/Wavelength" -value angle -variable expgui(hsorttype) 
4123
4124#---- Global mode menu button
4125$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.editmode \
4126        -label "Multiple hist. selection"
4127menu $expgui(fm).option.menu.editmode
4128$expgui(fm).option.menu.editmode add radiobutton  -label "Off" \
4129        -variable expgui(globalmode) -value 0 \
4130        -command sethistlist
4131$expgui(fm).option.menu.editmode add radiobutton  -label "All" \
4132        -variable expgui(globalmode) -value 6 \
4133        -command sethistlist
4134$expgui(fm).option.menu.editmode add radiobutton  -label "TOF" \
4135        -variable expgui(globalmode) -value 1 \
4136        -command sethistlist
4137$expgui(fm).option.menu.editmode add radiobutton  -label "CW Neutron" \
4138        -variable expgui(globalmode) -value 2  \
4139        -command sethistlist
4140$expgui(fm).option.menu.editmode add radiobutton  -label "Alpha12 Xray" \
4141        -variable expgui(globalmode) -value 3 \
4142        -command sethistlist
4143$expgui(fm).option.menu.editmode add radiobutton  -label "Monochromatic Xray" \
4144        -variable expgui(globalmode) -value 4 \
4145        -command sethistlist
4146$expgui(fm).option.menu.editmode add radiobutton  -label "Energy Disp Xray" \
4147        -variable expgui(globalmode) -value 5 \
4148        -command sethistlist
4149$expgui(fm).option.menu.editmode add separator
4150$expgui(fm).option.menu.editmode add checkbutton \
4151        -label "Group phases together" \
4152        -variable expgui(globalphasemode) \
4153        -command sethistlist
4154
4155set expgui(globalmode) 0
4156set expgui(globalphasemode) 1
4157
4158if {$tcl_platform(platform) == "unix"} {
4159    $expgui(fm).option.menu  add checkbutton -label "Override backspace" \
4160            -variable env(GSASBACKSPACE)
4161}
4162
4163$expgui(fm).option.menu add cascade -menu  $expgui(fm).option.menu.font \
4164        -label "Screen font"
4165menu $expgui(fm).option.menu.font
4166foreach f {10 11 12 13 14 16 18 20 22} {
4167    $expgui(fm).option.menu.font add radiobutton \
4168            -command {SetTkDefaultOptions $expgui(font); ResizeFont .; ResizeNotebook} \
4169        -label $f -value $f -variable expgui(font) -font "Helvetica -$f"
4170}
4171
4172$expgui(fm).option.menu  add checkbutton -label "Show EXPTOOL output" \
4173        -variable expgui(showexptool)
4174$expgui(fm).option.menu add command -label "Save Options" \
4175        -command "SaveOptions"
4176
4177pack $expgui(fm).file $expgui(fm).option -side left  -in $expgui(fm)
4178
4179if {$expgui(shell)} {
4180    foreach menu $expgui(menunames) {
4181        set m [string tolower $menu]
4182        pack [menubutton $expgui(fm).$m -text $menu \
4183                -menu $expgui(fm).$m.menu] -side left
4184        menu $expgui(fm).$m.menu
4185    }
4186}
4187pack $expgui(fm).help  -side right -in $expgui(fm)
4188
4189if {$expgui(shell)} {
4190    # add an export command to the last menu that gets filled in later
4191    $expgui(fm).$m.menu add  cascade -label "Coord Export" \
4192            -menu $expgui(fm).$m.menu.coordexp
4193    menu $expgui(fm).$m.menu.coordexp \
4194            -postcommand "BuildCoordExpMenu $expgui(fm).$m.menu.coordexp"
4195    $expgui(fm).$m.menu.coordexp add command -label "Building menu" \
4196            -state disabled
4197    $expgui(fm).$m.menu.coordexp add command -label "Please wait..." \
4198            -state disabled
4199
4200    $expgui(fm).$m.menu add  cascade -label "CIF Export" \
4201            -menu $expgui(fm).$m.menu.cifexp
4202    menu $expgui(fm).$m.menu.cifexp
4203    $expgui(fm).$m.menu.cifexp add command -label gsas2cif \
4204            -command "runGSASwEXP gsas2cif"
4205    $expgui(fm).$m.menu.cifexp add command -label FillTemplate \
4206            -command "exec $wishshell [file join $expgui(scriptdir) fillcif.tcl] \[file root \[file tail \$expgui(expfile)]]"
4207    $expgui(fm).$m.menu.cifexp add command -label CIFselect \
4208            -command {
4209        if {[info procs CIFselect] == ""} {
4210            source [file join $expgui(scriptdir) cifselect.tcl]
4211        }
4212        CIFselect $expgui(expfile)
4213    }
4214    # add the commands in expgui_menulist
4215    foreach menu [array names expgui_menulist ] {
4216        foreach cmd $expgui_menulist($menu) {
4217            set action {}
4218            set opt {}
4219            catch {set action [lindex $expgui_cmdlist($cmd) 0]}
4220            catch {set opt [lindex $expgui_cmdlist($cmd) 2]}
4221            if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
4222            if {$action != "" && $action != "-"} {
4223                eval $expgui(fm).$menu.menu add command \
4224                        -label $cmd $opt -command [list [subst $action]]
4225                if {[lindex $opt 0] == "-underline"} {
4226                    catch {
4227                        set num [lindex $opt 1]
4228                        set key [string range $cmd $num $num]
4229                        bind . <Alt-[string tolower $key]> [subst $action]
4230                        bind . <Alt-[string toupper $key]> [subst $action]
4231                    }
4232                }
4233            }
4234        }
4235    }
4236}
4237# setup command help
4238foreach cmd [array names expgui_cmdlist] {
4239    set help {}
4240    catch {set help [lindex $expgui_cmdlist($cmd) 1]}
4241    if {$help == ""} {
4242        if {$expgui(debug)} {puts "no help for $cmd"}
4243    } else {
4244        # remove
4245        regsub -all \x09 $help " " help
4246        # preserve blank lines
4247        regsub -all \x0A\x0A $help "AAA1234567890AAA" help
4248        regsub -all \x0A $help " " help
4249        regsub -all "AAA1234567890AAA" $help \x0A\x0A help
4250        regsub -all " +" $help " " help
4251        set expgui_helplist($cmd) [string trim $help]
4252    }
4253}
4254if {$expgui(shell)} {
4255    # set up button bar
4256    foreach cmd $expgui(buttonlist) {
4257        set action {}
4258        catch {set action [lindex $expgui_cmdlist($cmd) 0]}
4259        if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
4260        if {$action != ""} {
4261            pack [eval button .bar.$cmd -bg beige -activebackground yellow \
4262                    -padx 2m -pady 0 \
4263                    -text $cmd -command [list [subst $action]]] -side left
4264        }
4265    }
4266}
4267
4268if {$tcl_platform(os) == "Darwin"} {
4269#    $expgui(fm).file.menu add command -label "Create AppleScript" -command MakeAppleScript
4270    $expgui(fm).option.menu add checkbutton -label "Assign app to .EXP files" \
4271        -variable expgui(MacAssignApp)
4272}
4273$expgui(fm).file.menu add command -label "Exit"  -underline 1 -command catchQuit
4274foreach c {X x} {bind . <Alt-$c> [list catchQuit]}
4275#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF MENU DEFINITION ^^^^^^^^^^^^^^^^^^^
4276
4277# make the phase pane -- this must be done before setphases
4278# can be called (in loadexp)
4279MakePhasePane
4280
4281# handle indirect exits
4282wm protocol . WM_DELETE_WINDOW catchQuit
4283bind . <Control-c> catchQuit
4284
4285set expgui(pagenow) ""
4286set expgui(curhist) {}
4287set expgui(selectedatomlist) {}
4288
4289loadexp $expgui(expfile)
4290
4291# reset the phase selection
4292set expgui(curPhase) {}
4293# select the first histogram in the list by default (if there are any)
4294if {[llength $expmap(histlistboxcontents)] > 0} {
4295    set expgui(curhist) 0
4296} else {
4297    set expgui(curhist) {}
4298}
4299
4300# execute any local commands for final initialization
4301eval $expgui(initstring)
4302
4303# resize the notebook to fit all the tabs and the largest page
4304ResizeNotebook
4305if {$expgui(resize)} {
4306    # this appears to be needed by OSX
4307    update
4308    #wm geom . [winfo reqwidth .]x[winfo reqheight .]
4309    wm geom . {}
4310    # center the EXPGUI window
4311    wm withdraw .
4312    set x [expr [winfo screenwidth .]/2 - [winfo reqwidth .]/2 ]
4313    set y [expr [winfo screenheight .]/2 - [winfo reqheight .]/2]
4314    wm geom . +$x+$y
4315    wm deiconify .
4316}
4317
4318RaisePage lsFrame
4319if {[CountHistory] > 200} {
4320    DeleteHistoryRecords "This .EXP file has [CountHistory] history records\nErasing most will speed EXPGUI"
4321}
Note: See TracBrowser for help on using the repository browser.