source: trunk/expgui @ 250

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

# on 2000/07/28 20:29:34, toby did:
add phase flag box to histogram page when more than one phase is present
define GetPhaseFlags? & SetPhaseFlag? to implement above
fix title on edit background
label background type (as suggested by Barb & Lachlan)
start paring out "shell" capabilities for Mac

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/07/28 20:29:34
  • Property rcs:lines set to +117 -49
  • Property rcs:rev set to 1.30
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 116.1 KB
Line 
1#!/usr/local/bin/wish
2# $Id: expgui 250 2009-12-04 23:02:54Z toby $
3set expgui(Revision) {$Revision: 250 $ $Date: 2009-12-04 23:02:54 +0000 (Fri, 04 Dec 2009) $}
4
5# to do:
6#
7# need to change heading and button label depending on where getExpFileName
8# is called from?
9#
10# global background editing & profile work differently: should both
11# start out blank with a "load from option"?
12#
13# idea:
14# a scroll list for all histogram refinement flags ; click on takes you to the
15# appropriate menu.
16#
17# idea:
18#   change cell parameters to labels and have a edit cell button
19#   that enforces metric symmetry
20#
21# to allow "global" access on phase page
22#   change buttons from radio to multiple
23#   -- or display all 9 cell flag/damps and all atoms
24#   make editMultipleRecords work with multiple phases, also cell flag/damp
25#   blank cell entries
26#   add phase to atom number in listing
27#   DisplayAllAtoms needs to loop over phases: expgui(curPhase)
28#
29# idea: load more than one bank from a multi-bank .RAW file
30#
31if {$tcl_version < 8.0} {
32    tk_dialog .expFileErrorMsg "Version Error" \
33            "The program requires Tcl/Tk version 8.0 or higher" error 0 "Exit"
34    exit
35}
36
37if {$argv != ""} {
38    set expgui(expfile) $argv
39    if {[string toupper [file extension $expgui(expfile)]] != ".EXP"} {
40        append expgui(expfile) ".EXP"
41    }
42} else {
43    set expgui(expfile) {}
44}
45
46set expgui(curhist) {}
47set expmap(powderlist) {}
48
49set expgui(debug) 0
50catch {if $env(DEBUG) {set expgui(debug) 1}}
51#set expgui(debug) 1
52
53# default for archive mode = on
54set expgui(archive) 1
55# default for autoexec load = off
56set expgui(autoexpload) 0
57# save the name of the wish executable
58set wishshell [info nameofexecutable]
59# misc constants
60set txtvw(font) "Courier"
61set expgui(coordfont) "-*-courier-bold-r-normal--12-*"
62set expgui(histfont) "-*-courier-bold-r-normal--12-*"
63set liveplot(hst) 1
64set liveplot(legend) 1
65set expgui(filesort) 1
66set expgui(initstring) {}
67# use a separate window for DISAGL (default)
68set expgui(disaglSeparateBox) 1
69set expgui(DefaultPeakType) 0
70#=============================================================================
71#----------------------------------------------------------------
72# where are we?
73set expgui(script) [info script]
74# translate links -- go six levels deep
75foreach i {1 2 3 4 5 6} {
76    if {[file type $expgui(script)] == "link"} {
77        set link [file readlink $expgui(script)]
78        if { [file  pathtype  $link] == "absolute" } {
79            set expgui(script) $link
80        } {
81            set expgui(script) [file dirname $expgui(script)]/$link
82        }
83    } else {
84        break
85    }
86}
87# fixup relative paths
88if {[file pathtype $expgui(script)] == "relative"} {
89    set expgui(script) [file join [pwd] $expgui(script)]
90}
91set expgui(scriptdir) [file dirname $expgui(script) ]
92set expgui(gsasdir) [file dirname $expgui(scriptdir)]
93set expgui(gsasexe) [file join $expgui(gsasdir) exe]
94#----------------------------------------------------------------
95lappend auto_path $expgui(scriptdir)
96set expgui(havetix) 0
97set expgui(haveBW) 1
98# for debugging non-BWidget version set environment variable NOBWIDGET
99catch {if $env(NOBWIDGET) {set expgui(haveBW) 0}}
100if $expgui(haveBW) {
101    if [catch {package require BWidget}] {set expgui(haveBW) 0}
102}
103# get the notebook widget if not using BWidgets
104if {!$expgui(haveBW)} {source [file join $expgui(scriptdir) notebook.tcl]}
105#----------------------------------------------------------------
106if [file exists [file join $expgui(scriptdir) opts.tcl]] {
107    source [file join $expgui(scriptdir) opts.tcl]
108}
109# fetch EXP file processing routines
110source [file join $expgui(scriptdir) readexp.tcl]
111# commands for running GSAS programs
112source [file join $expgui(scriptdir) gsascmds.tcl]
113# contents of GSAS menus
114source [file join $expgui(scriptdir) gsasmenu.tcl]
115# commands for adding phases, histograms & atoms
116source [file join $expgui(scriptdir) addcmds.tcl]
117# commands for preferred orientation
118source [file join $expgui(scriptdir) orient.tcl]
119#---------------------------------------------------------------------------
120# override options with locally defined values
121if [file exists [file join $expgui(scriptdir) localconfig]] {
122    source [file join $expgui(scriptdir) localconfig]
123}
124if [file exists [file join ~ .gsas_config]] {
125    source [file join ~ .gsas_config]
126}
127if {$tcl_platform(platform) == "windows"} {
128    set expgui(exptool) [file join $expgui(gsasexe) exptool.exe]
129} else {
130    set expgui(exptool) [file join $expgui(gsasexe) exptool]
131}
132#---------------------------------------------------------------------------
133if {$expgui(expfile) != ""} {
134    if ![file exists $expgui(expfile)] {
135        update
136        set ans [tk_dialog .expFileErrorMsg "File Open Error" \
137                "File [file tail $expgui(expfile)] does not exist in [file dirname $expgui(expfile)]" \
138                error 0 "Create" "Open other"]
139        if $ans {set expgui(expfile) {}}
140    }
141}
142if {$expgui(expfile) == ""} {
143    # center the parent window because the getExpFileName window
144    # will be centered above it.
145    wm withdraw .
146    set x [expr [winfo screenwidth .]/2 - [winfo reqwidth .]/2 ]
147    set y [expr [winfo screenheight .]/2 - [winfo reqheight .]/2]
148    wm geom . +$x+$y
149    wm deiconify .
150    # windows needed this update before when using tk_getOpenFile.
151    # I am not sure it is still needed.
152    update
153    #
154    set expgui(expfile) [getExpFileName old]
155}
156if {$expgui(expfile) == ""} exit
157# you've been warned this .EXP does not exist!
158if ![file exists $expgui(expfile)] {
159    # create an "empty" exp file
160    createexp $expgui(expfile) \
161            [getstring "title for experiment $expgui(expfile)" 60 0]
162}
163catch {cd [string trim [file dirname $expgui(expfile)]]}
164
165#
166# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
167# <<<<<<<<<<    BEGINNING OF MAIN: GLOBAL AREA FOR DATA EXTRACTION >>>>>>>>>>>
168# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
169# load exp file and set up dialogs
170proc loadexp {expfile} {
171    global expgui expmap entryvar entrycmd tcl_platform
172    set exploadtime [time {set fmt [expload $expfile]}]
173    if $expgui(debug) {puts "expload $exploadtime"}
174    # if the file was not in the correct format, force a rewrite before use
175    if {$fmt < 0} {
176        # read error
177        return
178    } elseif {$fmt == 0 && $tcl_platform(platform) == "windows"} {
179        set expgui(changed) 1
180    } elseif {$fmt == 1 && $tcl_platform(platform) == "unix"} {
181        set expgui(changed) 1
182    } else {
183        set expgui(changed) 0
184    }
185
186    # force exp files to be upper case, force save if name changes
187    set filetail [file tail $expfile]
188    set filetailcaps [string toupper $filetail]
189    if {$tcl_platform(platform) == "unix" && $filetail != $filetailcaps} {
190        set expgui(changed) 1
191    }
192    if {[file dirname $expfile] == "."} {
193        set expgui(expfile) $filetailcaps
194    } else {
195        set expgui(expfile) [file join \
196                [file dirname $expfile] $filetailcaps]
197    }
198
199    mapexp
200    set expgui(expModifiedLast) 0
201    catch {
202        set expgui(expModifiedLast) [file mtime $expgui(expfile)]
203    }
204    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
205    # set the window/icon title
206    wm title . "EXPGUI $expfile"
207    set expgui(titleunchanged) 1
208    wm iconname . [file tail $expfile]
209
210    # set the number of phases on the phase page
211    setphases
212
213    # disable the "global options" that don't make sense based on
214    # which histograms present
215    foreach num {1 2 3 4 5} {
216        set flag($num) 0
217    }
218    # save a list of the allowed modes, too
219    set expgui(AllowedHistSelectModes) {0 6}
220    foreach h $expmap(powderlist) {
221        if {[string range $expmap(htype_$h) 2 2] == "T"} {set flag(1) 1}
222        if {[string range $expmap(htype_$h) 1 2] == "NC"} {set flag(2) 1}
223        if {[string range $expmap(htype_$h) 1 2] == "XC" && \
224                [histinfo $h lam2] != 0.0} {set flag(3) 1}
225        if {[string range $expmap(htype_$h) 1 2] == "XC" && \
226                [histinfo $h lam2] == 0.0} {set flag(4) 1}
227        if {[string range $expmap(htype_$h) 1 2] == "XE"} {set flag(5) 1}
228    }
229    foreach num {1 2 3 4 5} \
230            lbl {TOF "CW Neutron" "Alpha12 Xray" "Monochromatic Xray" \
231            "Energy Disp Xray"} {
232        if $flag($num) {
233            $expgui(fm).option.menu.editmode entryconfigure $lbl -state normal
234            lappend expgui(AllowedHistSelectModes) $num
235        } else {
236            $expgui(fm).option.menu.editmode entryconfigure $lbl -state disabled
237        }
238    }
239    # disable traces on entryvar until we are ready
240    set entrycmd(trace) 0
241    trace vdelete entryvar w entvartrace
242
243    # propogate changes on the least squares page
244    set entryvar(cycles) [expinfo cycles]
245    set entrycmd(cycles) "expinfo cycles"
246    # set expgui(globalmode) 0
247    set expgui(printopt) "Print Options ([expinfo print])"
248    set entryvar(title) [expinfo title]
249    global printopts
250    foreach num [array names printopts] {
251        set entrycmd(printopt$num) "printsetting $num"
252        set entryvar(printopt$num) [printsetting $num]
253    }
254    # enable traces on entryvar
255    set entrycmd(trace) 1
256    trace variable entryvar w entvartrace
257
258    # set fo extraction on LS page
259    SetupExtractHist
260
261    # update the histogram list & update the page
262    sethistlist
263
264    # start checking for external changes
265    afterawhile
266}
267
268# called to reread the .EXP file
269proc rereadexp {expfile} {
270    global expgui
271    if $expgui(changed) {
272        set decision [tk_dialog .instrSaveData {Save .EXP changes} \
273                {You have made changes to the Experiment. Rereading will cause the changes to be lost. Select an option:} \
274                {} 0 "Save and reread" "Reread without Save" "Cancel reread command"]
275        switch $decision {
276            0 { savearchiveexp }
277            1 { }
278            2 { return }
279        }
280    }
281    loadexp $expgui(expfile)
282}
283
284proc SaveAsFile {} {
285    global expgui
286    set newexpfile [getExpFileName new]
287    if {$newexpfile == ""} return
288    expwrite $newexpfile
289    set expgui(expfile) $newexpfile
290    catch {cd [string trim [file dirname $expgui(expfile)]]}
291    set expgui(changed) 0
292    set expgui(expModifiedLast) [file mtime $expgui(expfile)]
293    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
294    # set the window/icon title
295    wm title . $expgui(expfile)
296    set expgui(titleunchanged) 1
297    wm iconname . [file tail $expgui(expfile)]
298}
299
300# called to read a different .EXP file
301proc readnewexp {} {
302    global expgui expmap
303    if $expgui(changed) {
304        set decision [tk_dialog .instrSaveData {Save .EXP changes} \
305                {You have made changes to the Experiment. Reading a different file will cause the changes to be lost. Select an option:} \
306                {} 0 "Save and read" "Read without Save" "Cancel read command"]
307        switch $decision {
308            0 { savearchiveexp }
309            1 {                }
310            2 { return }
311        }
312    }
313    set newexpfile [getExpFileName old]
314    if {$newexpfile == ""} return
315
316    # switch to the 1st page
317    RaisePage lsFrame
318
319    if ![file exists $newexpfile] {
320        # you've been warned this .EXP does not exist!
321        # create an "empty" exp file
322        createexp $newexpfile \
323                [getstring "title for experiment $newexpfile" 60 0]
324    }
325    set expgui(expfile) $newexpfile
326    catch {cd [string trim [file dirname $expgui(expfile)]]}
327    set expgui(globalmode) 0
328    loadexp $expgui(expfile)
329
330    # select the 1st phase
331    SelectOnePhase [lindex $expmap(phaselist) 0]
332    # select the first histogram in the list by default (if there are any)
333    if {[llength $expmap(histlistboxcontents)] > 0} {
334        set expgui(curhist) 0
335    } else {
336        set expgui(curhist) {}
337    }
338    if {[CountHistory] > 100} {
339        DeleteHistoryRecords "This .EXP file has [CountHistory] history records\nErasing most will speed EXPGUI"
340    }
341}
342
343#------------- set up data read/write layer ----------------------
344# trace routine on entryvar
345proc entvartrace {array elem action} {
346    global expgui entrycmd entryvar
347    if !$entrycmd(trace) return
348   
349    catch {
350        if {$entrycmd($elem) == ""} return
351        incr expgui(changed)
352        if $expgui(debug) {puts "$entrycmd($elem)  set $entryvar($elem) "}
353        if {$entrycmd($elem) == ""} return
354        if [catch {
355            eval $entrycmd($elem) set [list $entryvar($elem)]
356            if {[lindex $entrycmd($elem) 0] == "atominfo"} {
357                after idle {DisplayAllAtoms noreset}
358            }
359        } errmsg] {puts "entvartrace error: $errmsg"}   
360    }
361}
362
363# disable traces on entryvar until we are ready
364set entrycmd(trace) 0
365trace variable entryvar w entvartrace
366
367#
368#
369#
370##############################################################################
371#####                    #####################################################
372##### PROCEDURES SECTION #####################################################
373#####                    #####################################################
374##############################################################################
375# reset routine is used for debugging
376proc reset {} {
377    global expgui script argv
378    set script $expgui(script)
379    set argv $expgui(expfile)
380    # remove traces
381    global entryvar
382    foreach cmd [trace vinfo entryvar] {
383        eval trace vdelete entryvar $cmd
384    }
385    global expgui
386    foreach cmd [trace vinfo expgui(backterms)] {
387        eval trace vdelete entryvar $cmd
388    }
389    foreach cmd [trace vinfo expgui(backtype)] {
390        eval trace vdelete entryvar $cmd
391    }
392    foreach a {
393        expmap expgui entryvar entrycmd 
394        expgui_menulist expgui_cmdlist expgui_helplist
395    } {
396        global $a
397        catch {unset  $a}
398    }
399    foreach w [winfo children .] {
400        destroy $w
401    }
402
403    uplevel #0 {source $script}
404}
405
406# save some of the global options in ~/.gsas_config
407proc SaveOptions {} {
408    global expgui env tcl_platform
409    set fp [open [file join ~ .gsas_config] a]
410    foreach item {archive asorttype hsorttype filesort disaglSeparateBox} {
411        puts $fp "set expgui($item) $expgui($item)"
412    }
413    if {$tcl_platform(platform) != "windows"} {
414        puts $fp "set env(GSASBACKSPACE) $env(GSASBACKSPACE)"
415        puts $fp "set expgui(autoexpload) $expgui(autoexpload)"
416    }
417    close $fp
418}
419
420proc About { } {
421    global expgui expmap
422    tk_dialog .about {About...} \
423"EXPGUI\n\
424Jonathan Wasserman and Brian Toby\n\
425NIST Center for Neutron Research\n\n\
4262000, Not subject to copyright\n\n\
427Revision [lindex $expgui(Revision) 1] (readexp.tcl [lindex $expmap(Revision) 1])\n\n\
428Generalized Structure Analysis System (GSAS)\n\
429A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
430" \
431        info 0 OK
432}
433
434# wait until idle
435proc afterawhile {} {
436    # cancel any other instances of this loop
437    after cancel afterawhile
438    after cancel whenidle
439    after cancel whenidle
440    after idle whenidle
441}
442
443# This is called every 2 seconds to check for changes to the .EXP file
444proc whenidle {} {
445    global expgui
446    if $expgui(titleunchanged) {
447        if {$expgui(changed) != 0} {
448            wm title . "$expgui(expfile) (modified)"
449            set expgui(titleunchanged) 0
450        }
451    }
452    if {$expgui(expModifiedLast) == 0} {
453        after 2000 afterawhile
454        return
455    }
456    if {[file mtime $expgui(expfile)] != $expgui(expModifiedLast)} {
457        set ans [ReloadExpMsg [file tail $expgui(expfile)] $expgui(changed)]
458        if {$ans == 0} {
459            loadexp $expgui(expfile)
460        } elseif {$ans == 1} {
461            # reset the time to the next version
462            set expgui(expModifiedLast) [file mtime $expgui(expfile)]
463        } elseif {$ans == 2} {
464            savearchiveexp
465        }
466    }
467    after 2000 afterawhile
468}
469
470# place a message about changes over the main window
471proc ReloadExpMsg {file changes} {
472    global expgui tcl_platform
473    set msg "File $file has been modified by another program"
474    if {$changes == 1} {
475        append msg " and you have made a change to this version.\n"
476    } elseif {$changes > 0} {
477        append msg " and you have made $changes changes to this version.\n"
478    } else {
479        append msg ".\n"
480    }
481    append msg "Do you want to use the newer (modified) version or continue with the older (previous) version of the file?"
482
483    set w .ask
484    catch {destroy $w}
485    toplevel $w -class Dialog
486    wm title $w "Reload?"
487    wm iconname $w "Reload?"
488    wm protocol $w WM_DELETE_WINDOW { }
489    wm transient $w .
490    frame $w.bot
491    pack $w.bot -side bottom
492    frame $w.top
493    pack $w.top -side top -fill both -expand 1
494    label $w.top.msg -justify left \
495            -wraplength 5i -font {Times 18} \
496            -text $msg
497    if {$tcl_platform(platform) == "windows"} {
498        $w.top.msg config -font {Times 14}
499    }
500    pack $w.top.msg  -side right -expand 1 -fill both -padx 3m -pady 3m
501    pack [button $w.bot.1 -text "Load new" \
502            -default active -command "set expgui(dialogbutton) 0" \
503            ] -side left -expand 1 -padx 3m -pady 2m
504    pack [button $w.bot.2 -text "Continue with old" \
505            -command "set expgui(dialogbutton) 1"] \
506            -side left -expand 1 -padx 3m -pady 2m
507    if {$changes > 0} {
508        pack [button $w.bot.3 -text "Save edited version" \
509            -command "set expgui(dialogbutton) 2"] \
510            -side left -expand 1 -padx 3m -pady 2m
511    }
512    # Create a binding for <Return> on the dialog
513    bind $w <Return> "tkButtonInvoke $w.bot.1"
514    wm withdraw $w
515    update idletasks
516
517    # for windows put the box in the upper left, for
518    # unix center it over the parent (in unix it appears later)
519    #if {$tcl_platform(platform) == "windows"} {
520        #wm geom $w +0+0
521    #} else {
522
523        # for now, always center the message over the main window
524        # center the new window in the middle of the parent
525        set x [expr [winfo x .] + [winfo width .]/2 - \
526                [winfo reqwidth $w]/2 - [winfo vrootx .]]
527        set y [expr [winfo y .] + [winfo height .]/2 - \
528                [winfo reqheight $w]/2 - [winfo vrooty .]]
529        wm geom $w +$x+$y
530    #}
531    wm deiconify $w
532
533    # Grab the focus
534    set oldFocus [focus]
535    set oldGrab [grab current $w]
536    if {[string compare $oldGrab ""]} {
537        set grabStatus [grab status $oldGrab]
538    }
539    grab $w
540    focus $w.bot.1
541    # for windows rearrange window stacking
542    if {$tcl_platform(platform) == "windows"} {
543        lower .
544        raise $w .
545    }
546    update idletasks
547
548    tkwait variable expgui(dialogbutton)
549    catch {focus $oldFocus}
550    destroy $w
551    if {[string compare $oldGrab ""]} {
552      if {![string compare $grabStatus "global"]} {
553            grab -global $oldGrab
554        } else {
555            grab $oldGrab
556        }
557    }
558    raise .
559    return $expgui(dialogbutton)
560}
561
562# --------  called to confirm before exiting
563proc catchQuit {} {
564    if {[confirmBeforeSave] == "Continue"} {
565        destroy .
566    }
567}
568# save the .EXP file before exiting?
569proc confirmBeforeSave {} {
570    global expgui
571    if !$expgui(changed) {
572        return "Continue"
573    }
574    set decision [tk_dialog .instrSaveData {Save .EXP changes} \
575            {You have made changes to the Experiment, but the changes are not saved. Select an option:} \
576            {} 0 "Save and Exit" "Exit without Save" "Cancel exit command"]
577    switch $decision {
578        0 { savearchiveexp;  return "Continue" }
579        1 {                  return "Continue" }
580        2 {                  return "Cancel"   }
581    }
582}
583
584proc archiveexp {} {
585    global expgui tcl_platform
586    # is there a file to archive
587    if {![file exists $expgui(expfile)]} return
588    catch {
589        set expnam [file rootname $expgui(expfile)]
590        if {$tcl_platform(platform) == "windows"} {
591            set version -1
592            catch {source $expnam.version}
593            incr version
594            if ![file executable [file join $expgui(scriptdir) pkzip.exe]] {
595                # archive w/o pkzip
596                set file $expnam![format "%3.3d" $version].EXP
597                file copy -force $expnam.EXP $file
598                set fp [open $expnam.lst a]
599                puts $fp "\n--------------------------------------------------------------"
600                puts $fp "Archiving $expnam.EXP as $file"
601                puts $fp "--------------------------------------------------------------\n"
602                close $fp
603            } else {
604                # archive with PKZIP           
605                # need to limit expnam to 8 characters
606                set sexp [string toupper [string range [file root [file tail $expnam] ] 0 7]]
607                # PKZIP can't handle long dir names either
608                cd [set dir [file dirname $expnam]]
609                set file $sexp.[format "%3.3d" $version]
610                file copy -force $expnam.EXP $file
611                exec [file join $expgui(scriptdir) pkzip.exe] -m $sexp $file > zip.out &
612                set fp [open $expnam.lst a]
613                puts $fp "\n--------------------------------------------------------------"
614                puts $fp "Archiving $expnam.EXP as $file in [file join $dir $sexp.ZIP]"
615                puts $fp "--------------------------------------------------------------\n"
616                close $fp
617            }
618            set fp [open $expnam.version w]
619            puts $fp "set version $version"
620            close $fp
621        } else {
622            set files [glob -nocomplain $expnam.EXP.*]
623            if {$files == ""} {
624                set file $expnam.EXP.000
625            } else {
626                set file [lindex [lsort -decreasing $files] 0]
627                regexp {.*\.EXP.0?0?([0-9]*).*} $file junk number
628                incr number
629                set file $expnam.EXP.[format "%3.3d" $number]
630            }
631            file copy $expgui(expfile) $file
632            if [catch {exec gzip $file}] {
633                exec echo "\n----------------------------------------------" >> $expnam.LST
634                exec echo "     Archiving $expnam.EXP as $file " >> $expnam.LST
635                exec echo "----------------------------------------------\n" >> $expnam.LST
636            } else {
637                exec echo "\n----------------------------------------------" >> $expnam.LST
638                exec echo "     Archiving $expnam.EXP as $file.gz " >> $expnam.LST
639                exec echo "----------------------------------------------\n" >> $expnam.LST
640            }
641        }
642    } errmsg
643    if {$errmsg != ""} {
644        tk_dialog .warn Confirm "Error in archive: $errmsg" warning 0 OK
645    }
646}
647
648# save and optionally archive the expfile
649proc savearchiveexp {} {
650    global expgui expmap
651    if !$expgui(changed) return
652    if $expgui(archive) archiveexp
653    # add a history record
654    exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds]]"
655    # now save the file
656    expwrite $expgui(expfile)
657    set expgui(changed) 0
658    set expgui(expModifiedLast) [file mtime $expgui(expfile)]
659    set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
660    wm title . $expgui(expfile)
661    set expgui(titleunchanged) 1
662}
663
664# setup buttons for each phase on the phase page
665proc setphases {} {
666    global expgui expmap
667    eval destroy [winfo children $expgui(phaseFrame).top.ps]
668    foreach num $expmap(phaselist) type $expmap(phasetype) {
669        pack [button $expgui(phaseFrame).top.ps.$num -text $num \
670                -command "SelectOnePhase $num"] -side left
671        if {$type > 3} {
672            $expgui(phaseFrame).top.ps.$num config -state disabled
673        }
674    }
675}
676
677# Procedure to respond to changes the phase.
678#  This loads the "phases" widgets with data corresponding to the selected phase.
679proc SelectOnePhase {num} {
680    global entryvar entrycmd expmap expgui
681    set crsPhase {}
682    foreach n $expmap(phaselist) type $expmap(phasetype) {
683        if {$n == $num && $type <= 3} {
684            catch {$expgui(phaseFrame).top.ps.$num config -relief sunken}
685            set crsPhase $num
686            if {$type == 3} {
687                set expgui(phasetype) "Magnetic\nOnly"
688            } elseif {$type == 2} {
689                set expgui(phasetype) "Magnetic\n& Nuclear"
690            } elseif {$type == 4} {
691                # this is not used at present
692                set expgui(phasetype) "Macromolecular"
693            } else {
694                set expgui(phasetype) ""
695            }
696        } else {
697            catch {$expgui(phaseFrame).top.ps.$n config -relief raised}
698        }
699    }
700    # no phase is selected
701    if {$crsPhase == "" || [llength $expmap(phaselist)] == 0} {
702        # disable traces on entryvar
703        set entrycmd(trace) 0
704        set entrycmd(phasename) ""
705        set entryvar(phasename) ""
706        foreach ent {a b c alpha beta gamma cellref celldamp} {
707            set entrycmd($ent) ""
708            set entryvar($ent) ""
709        }
710        set expgui(curPhase) {}
711        # enable traces on entryvar
712        set entrycmd(trace) 1
713        $expgui(EditingAtoms) config -text ""
714        DisplayAtom 0 0
715        DisplayU 0 0
716        DisplayRefFlags 0 0
717        $expgui(atomlistbox) delete 0 end
718        return
719    }
720
721    set expgui(curPhase) $crsPhase
722    # we have a phase
723
724    # disable traces on entryvar for right now
725    set entrycmd(trace) 0
726
727    ##########################################################
728    ######   SECTION: ASSIGNMENT OF DATA VARIABLES  ##########
729    ##########################################################
730    # phase title
731    set entrycmd(phasename) "phaseinfo $crsPhase name"
732    set entryvar(phasename) [phaseinfo $crsPhase name]
733    # cell parameters & flags
734    foreach ent {a b c alpha beta gamma cellref celldamp} {
735        set entrycmd($ent) "phaseinfo $crsPhase $ent"
736        set entryvar($ent) [phaseinfo $crsPhase $ent]
737    }
738
739    #Procedure call: DisplayU -- Display Anisotropic/Isotropic widget or disable
740    # initialize to diasbled
741    DisplayAtom 0 0
742    DisplayU 0 0
743    DisplayRefFlags 0 0
744    $expgui(EditingAtoms) config -text ""
745
746    DisplayAllAtoms
747
748    # enable traces on entryvar now
749    set entrycmd(trace) 1
750}
751
752set expgui(noreenterDisplayAllAtoms) 0
753# Populate expgui(atomlistbox) (ScrolledListBox) with atoms from selected phase.
754proc DisplayAllAtoms {"mode reset"} {
755    global entryvar entrycmd expmap expgui
756    # if it does not show, dont bother
757    if {$expgui(pagenow) != "phaseFrame"} return
758    if {$expgui(curPhase) == ""} return
759    if $expgui(noreenterDisplayAllAtoms) return
760   
761    set expgui(noreenterDisplayAllAtoms) 1
762    if {$mode != "reset"} {
763        # save the scrolled position
764        set pos [lindex [$expgui(atomlistbox) yview] 0]
765    } else {
766        # this is a reset -- clear the selected atoms list
767        set expgui(selectedatomlist) {}
768    }
769    $expgui(atomlistbox) delete 0 end
770    # loop over atoms
771    set maxline I
772    set phase $expgui(curPhase)
773    set atomlist {}
774    set typehead "type  "
775    set namehead "  name  "
776    set multhead "Mult"
777    set coordhead "   "
778    if  {$expgui(asorttype) == "type"} {
779        # sort on atom type
780        set typehead "type* "
781        foreach atom $expmap(atomlist_$phase) {
782            lappend atomlist "$atom [atominfo $phase $atom type] $phase"
783        }
784        set expmap(atomlistboxcontents) [lsort -ascii -index 1 $atomlist]
785    } elseif {$expgui(asorttype) == "number"} {
786        # sort on atom number
787        set namehead "* name  "
788        foreach atom $expmap(atomlist_$phase) {
789            lappend atomlist "$atom $atom $phase"
790        }
791        set expmap(atomlistboxcontents) [lsort -integer -index 1 $atomlist]
792    } elseif {$expgui(asorttype) == "mult"} {
793        # sort on atom number
794        set multhead "Mlt*"
795        foreach atom $expmap(atomlist_$phase) {
796            lappend atomlist "$atom [atominfo $phase $atom mult] $phase"
797        }
798        set expmap(atomlistboxcontents) [lsort -integer -decreasing -index 1 $atomlist]
799    } elseif {$expgui(asorttype) == "x"} {
800        # sort on x
801        set coordhead "(x*)"
802        foreach atom $expmap(atomlist_$phase) {
803            lappend atomlist "$atom [atominfo $phase $atom x] $phase"
804        }
805        set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
806    } elseif {$expgui(asorttype) == "y"} {
807        # sort on y
808        set coordhead "(y*)"
809        foreach atom $expmap(atomlist_$phase) {
810            lappend atomlist "$atom [atominfo $phase $atom y] $phase"
811        }
812        set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
813    } elseif {$expgui(asorttype) == "z"} {
814        # sort on z
815        set coordhead "(z*)"
816        foreach atom $expmap(atomlist_$phase) {
817            lappend atomlist "$atom [atominfo $phase $atom z] $phase"
818        }
819        set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
820    } else {
821        error "Bad expgui(asorttype) = $expgui(asorttype)"
822    }
823
824    foreach tuple $expmap(atomlistboxcontents) {
825        set atom [lindex $tuple 0]
826        set phase [lindex $tuple 2]
827        set refflag {}
828        foreach type {x u f} {
829            if {[atominfo $phase $atom ${type}ref]} {
830                append refflag "[string toupper $type][atominfo $phase $atom ${type}damp] "
831            } else {
832                append refflag " [atominfo $phase $atom ${type}damp] "
833            }   
834        }
835        set line [format "%3d %-6s %-6s %8s %10.6f%10.6f%10.6f%4d%9.4f" \
836                $atom \
837                [atominfo $phase $atom label] \
838                [atominfo $phase $atom type] \
839                $refflag \
840                [atominfo $phase $atom x] \
841                [atominfo $phase $atom y] \
842                [atominfo $phase $atom z] \
843                [atominfo $phase $atom mult] \
844                [atominfo $phase $atom frac]
845        ]
846
847        # add temperature factors (iso/anoiso)
848        if {[atominfo $phase $atom temptype] == "A"} {
849            set maxline A
850            append line [format "  %9.5f%9.5f%9.5f%9.5f%9.5f%9.5f" \
851                    [atominfo $phase $atom U11] \
852                    [atominfo $phase $atom U22] \
853                    [atominfo $phase $atom U33] \
854                    [atominfo $phase $atom U12] \
855                    [atominfo $phase $atom U23] \
856                    [atominfo $phase $atom U13]
857            ]
858        } else {
859            append line [format "  %9.5f" \
860                    [atominfo $phase $atom Uiso]
861            ]
862        }
863        $expgui(atomlistbox) insert end $line
864    }
865    $expgui(atomtitle) delete 0 end
866    if {$maxline == "A"} {
867        $expgui(atomtitle) insert end [format "%10s %6s %8s%29s %9s  %s" \
868                $namehead $typehead "ref/damp  " \
869                "fractional coordinates$coordhead" \
870                "$multhead Occupancy" \
871                "Uiso/Uij                                            "]
872    } else {
873        $expgui(atomtitle) insert end [format "%10s %6s %8s%29s %9s  %s" \
874                $namehead $typehead "ref/damp  " \
875                "fractional coordinates$coordhead" \
876                "$multhead Occupancy" \
877                "Uiso"]
878    }
879    if {$mode != "reset"} {
880        # restore the selected items
881        foreach i $expgui(selectedatomlist) {
882            $expgui(atomlistbox) selection set $i
883        }
884        # restore the last scrolled position
885        $expgui(atomlistbox) yview moveto $pos
886    }
887    set expgui(noreenterDisplayAllAtoms) 0
888}
889
890# Procedure to select all atoms in response to a right-click
891proc SelectAllAtoms {} {
892    global expgui
893    $expgui(atomlistbox) selection set 0 end
894    # call editRecord in case trace was called before the selection was made
895    editRecord
896}
897
898# Procedure to respond to left mouse release in the atoms Pane
899proc editRecord { args } {
900    global entrycmd expgui
901    set expgui(selectedatomlist) [$expgui(atomlistbox) curselection]
902    # disable traces on entryvar for right now
903    set entrycmd(trace) 0
904
905    if {[llength $expgui(selectedatomlist)] == 0} {
906        puts  "How did this happen: [$expgui(atomlistbox) curselection]"
907    } elseif {[llength $expgui(selectedatomlist)] == 1} {
908        editOneRecord $expgui(selectedatomlist)
909    } else {
910        editMultipleRecords $expgui(selectedatomlist)
911    }
912    # reenable traces on entryvar
913    set entrycmd(trace) 1
914    # repaint the atoms box in case anything was changed
915    #    DisplayAllAtoms noreset
916}
917
918proc editOneRecord { AtomIndex } {
919    global expmap expgui
920    # get atom number & phase
921    set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
922    set atomnum [lindex $tuple 0]
923    set p [lindex $tuple 2]
924    DisplayU $atomnum $p
925    DisplayAtom $atomnum $p
926    DisplayRefFlags $atomnum $p
927    $expgui(EditingAtoms) config -text "Editing atom #$atomnum -- [atominfo $p $atomnum label]"
928}
929
930# this will not work for a multi-phase list of atoms (yet)
931proc editMultipleRecords { AtomIndexList } {
932    global expmap expgui
933    set numberList {}
934    # current phase
935    set p $expgui(curPhase)
936    foreach AtomIndex $AtomIndexList {
937        # get atom number & phase
938        set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
939        lappend numberList [lindex $tuple 0]
940#       set p [lindex $tuple 2]
941    }
942    # this needs to track by phase
943    $expgui(EditingAtoms) config -text \
944            "Set refinement options: atoms [CompressList $numberList]"
945    DisplayU 0 0
946    DisplayAtom 0 0
947    # this needs to track by phase
948    DisplayRefFlags $numberList $p
949}
950
951# format a string of numbers to save space, e.g. "1 2 3 4 6 7 19 13 14 15"
952# becomes "1-4,6,7,13-15,19"
953proc CompressList {numberList} {
954    # format the number list to save space
955    set lastnum -99
956    set flist {}
957    set count 0
958    if [catch {set sortlist [lsort -integer $numberList]}] {return $numberList}
959    foreach num $sortlist {
960            set next [expr $lastnum+1]
961            if {$num != $next} {
962                if {$count == 0 && $flist != ""} {
963                    append flist ",$num"
964                } elseif {$count == 1 && $flist != ""} {
965                    append flist ",$lastnum,$num"
966                } elseif {$flist != ""} {
967                    append flist "-$lastnum,$num"
968            } else {
969                append flist "$num"
970            }
971            set lastnum $num
972            set count 0
973        } else {
974            incr count
975            incr lastnum
976        }
977    }
978    if {$count == 1 && $flist != ""} {
979        append flist ",$lastnum"
980    } elseif {$flist != "" && $count > 1} {
981        append flist "-$lastnum"
982    }
983    return $flist
984}
985
986# Procedure to display Isotropic or Anisotropic temperature factors
987#  Changes the display to one entry widget for Isotropic motion OR
988#   6 entry widgets for Anisotropic motion in Frame3.
989#   or disables the widet entirly if atom = 0
990proc DisplayU { atomnum p} {
991    global expgui entryvar entrycmd
992    if {$atomnum == 0} {
993        set iOrA disable
994    } else {
995        set iOrA [atominfo $p $atomnum temptype]
996    }
997
998    set firstbox [lindex $expgui(anisolabels) 0]
999    if { $iOrA == "A" } {
1000        $firstbox config -text "U11 "
1001        foreach item $expgui(anisolabels) {
1002            $item config -fg black
1003        }
1004        foreach item $expgui(anisoentry) var {U11 U22 U33 U12 U13 U23} {
1005            set entrycmd($var) "atominfo $p $atomnum $var"
1006            set entryvar($var) [eval $entrycmd($var)]
1007            $item config -fg black -state normal  -bg white
1008        }
1009    } elseif { $iOrA == "I" || $iOrA == "disable"} {
1010        foreach item $expgui(anisolabels) {
1011#           $item config -fg grey
1012            $item config -fg beige
1013        }
1014        foreach item [lrange $expgui(anisoentry) 1 end] \
1015                var {U22 U33 U12 U13 U23} {
1016            set entrycmd($var) ""
1017            set entryvar($var) ""
1018            $item config -fg beige -bg beige  -state disabled
1019        }
1020        if { $iOrA == "disable"} {
1021            set entrycmd($var) ""
1022            set entryvar($var) ""
1023#           [lindex $expgui(anisoentry) 0] config -fg white -state disabled
1024            [lindex $expgui(anisoentry) 0] config -fg beige -bg beige -state disabled
1025        } else {
1026            set entrycmd(U11) "atominfo $p $atomnum Uiso"
1027            set entryvar(U11) [eval $entrycmd(U11)]
1028            $firstbox config -text Uiso -fg black
1029            [lindex $expgui(anisoentry) 0] config -fg black -bg white -state normal
1030        }
1031    }
1032}
1033
1034# need to think about multiple phases
1035
1036# Procedure to display refinement flags
1037proc DisplayRefFlags { atomnum p} {
1038    global expgui entryvar entrycmd
1039    if {$atomnum == 0} {
1040        foreach label $expgui(atomreflbl) {
1041            $label config -fg beige
1042        }
1043        foreach entry $expgui(atomref) {
1044            $entry config -state disabled -fg beige -bg beige
1045        }
1046        return
1047    }
1048    foreach label $expgui(atomreflbl) {
1049        $label config -fg black
1050    }
1051    foreach entry $expgui(atomref) {
1052        $entry config -state normal -fg black -bg beige
1053    }
1054    foreach var {xref uref fref xdamp udamp fdamp}  {
1055        set entrycmd($var) "atominfo $p [list $atomnum] $var"
1056        set entryvar($var) [eval $entrycmd($var)]
1057    }
1058}
1059
1060# Procedure to display an atom in the atom edit boxes
1061proc DisplayAtom { atomnum p} {
1062    global expgui entryvar entrycmd
1063    if {$atomnum == 0} {
1064        foreach label $expgui(atomlabels) {
1065            $label config -fg beige
1066        }
1067        foreach entry $expgui(atomentry) {
1068            $entry config -state disabled -fg beige -bg beige
1069        }
1070        return
1071    }
1072    foreach label $expgui(atomlabels) {
1073        $label config -fg black
1074    }
1075    foreach entry $expgui(atomentry) {
1076        $entry config -state normal -fg black -bg white
1077    }
1078    foreach var {x y z label frac } {
1079        set entrycmd($var) "atominfo $p $atomnum $var"
1080        set entryvar($var) [eval $entrycmd($var)]
1081    }
1082}
1083
1084# make a histogram box; used in MakeHistPane,
1085proc MakeHistBox {frm} {
1086    global expgui
1087    grid [label $frm.mode -text "Select a Histogram" \
1088            -bg beige -anchor center] \
1089            -row 0 -column 0 -columnspan 2 -sticky ew
1090    bind $frm.mode <Button-1> {
1091        set i [lsearch $expgui(AllowedHistSelectModes) $expgui(globalmode)]
1092        set expgui(globalmode) [lindex \
1093                "$expgui(AllowedHistSelectModes) \
1094                $expgui(AllowedHistSelectModes)" [incr i]]
1095        sethistlist
1096    }
1097    bind $frm.mode <Button-3> {set expgui(globalmode) 0; sethistlist}
1098    grid [listbox $frm.title -height 1 -relief flat \
1099            -exportselection 0 \
1100            -font $expgui(histfont) ] -row 1 -column 0 -sticky ew
1101    grid [listbox $frm.lbox -height 10 -width 25 \
1102            -exportselection 0 \
1103            -font $expgui(histfont) \
1104            -xscrollcommand "$frm.x set" \
1105            -yscrollcommand "$frm.y set" \
1106            ] -row 2 -column 0 -sticky news
1107    lappend expgui(HistSelectList) $frm
1108    grid [scrollbar $frm.x -orient horizontal \
1109            -command "move2boxes \" $frm.title $frm.lbox \" "
1110    ] -row 3 -column 0 -sticky ew
1111    grid [scrollbar $frm.y \
1112            -command "$frm.lbox yview"] \
1113            -row 2 -column 1 -sticky ns
1114    grid columnconfigure $frm 0 -weight 1
1115    grid rowconfigure $frm 2 -weight 1
1116}
1117
1118# update the histogram list
1119# to do: show histogram ref flags?
1120proc sethistlist {} {
1121    global expgui expmap
1122    array set lbl {
1123        1 "Select 1 or more\nTOF Histograms"
1124        2 "Select 1 or more\nCW Neutron Histograms"
1125        3 "Select 1 or more\nAlpha 1,2 X-ray Histograms"
1126        4 "Select 1 or more\nmonochromatic X-ray Histograms"
1127        5 "Select 1 or more Energy\nDisperive X-ray Histograms"
1128        6 "Select 1 or more of\n any type Histograms"
1129    }
1130    foreach lbox $expgui(HistSelectList) {
1131        $lbox.title delete 0 end
1132        $lbox.lbox delete 0 end
1133        if {$expgui(globalmode) != 0} {
1134            $lbox.lbox config -selectmode extended
1135            $lbox.mode config -text $lbl($expgui(globalmode)) -bg yellow
1136        } else {
1137            $lbox.lbox config -selectmode browse
1138            $lbox.mode config -text "Select a histogram" -bg beige
1139        }
1140    }
1141    # disable the unallowed pages in all mode
1142    if {$expgui(globalmode) == 6} {
1143        foreach pair $expgui(GlobalModeAllDisable) {
1144            if {$expgui(pagenow) == [lindex $pair 0]} {
1145                RaisePage lsFrame
1146            }
1147            eval [lindex $pair 1] -state disabled
1148        }
1149    } else {
1150        foreach pair $expgui(GlobalModeAllDisable) {
1151            eval [lindex $pair 1] -state normal
1152        }
1153    }
1154    set histlist {}
1155    if  {$expgui(hsorttype) == "type"} {
1156        # sort on histogram type
1157        foreach h [lsort -integer -increasing $expmap(powderlist)] {
1158            lappend histlist "$h [string range $expmap(htype_$h) 1 2]"
1159        }
1160        set expmap(histlistboxcontents) [lsort -ascii -index 1 $histlist]
1161    } elseif {$expgui(hsorttype) == "number"} {
1162        # sort on histogram number
1163        foreach h [lsort -integer -increasing $expmap(powderlist)] {
1164            lappend histlist "$h $h"
1165        }
1166        set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
1167    } elseif {$expgui(hsorttype) == "bank"} {
1168        # sort on original bank number
1169        foreach h [lsort -integer -increasing $expmap(powderlist)] {
1170            lappend histlist "$h [histinfo $h bank]"
1171        }
1172        set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
1173    } elseif {$expgui(hsorttype) == "angle"} {
1174        # sort on wavelength (CW) or angle (E disp.)
1175        foreach h [lsort -integer -increasing $expmap(powderlist)] {
1176            if {[string range $expmap(htype_$h) 2 2] == "T"} {
1177                set det [format %8.2f [histinfo $h tofangle]]
1178            } elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
1179                set det [format %8.5f [histinfo $h lam1]]
1180            } elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
1181                set det [format %8.2f [histinfo $h lam1]]
1182            } else {
1183                set det {}
1184            }
1185            lappend histlist "$h $det"
1186        }
1187        set expmap(histlistboxcontents) [lsort -real -index 1 $histlist]
1188    }
1189
1190    # title field needs to match longest title
1191    foreach lbox $expgui(HistSelectList) {
1192        $lbox.title insert end [format "%2s %s %4s %8s  %-67s" \
1193                "h#" \
1194                type \
1195                bank \
1196                "ang/wave" \
1197                "    title" \
1198                ]
1199    }
1200    foreach tuple $expmap(histlistboxcontents) {
1201        set h [lindex $tuple 0]
1202
1203        if {$expgui(globalmode) == 1} {
1204            if {[string range $expmap(htype_$h) 2 2] != "T"} continue
1205        } elseif {$expgui(globalmode) == 2} {
1206            if {[string range $expmap(htype_$h) 1 2] != "NC"} continue
1207        } elseif {$expgui(globalmode) == 3} {
1208            if {[string range $expmap(htype_$h) 1 2] != "XC" || \
1209                    [histinfo $h lam2] == 0.0} continue
1210        } elseif {$expgui(globalmode) == 4} {
1211            if {[string range $expmap(htype_$h) 1 2] != "XC" || \
1212                    [histinfo $h lam2] != 0.0} continue
1213        } elseif {$expgui(globalmode) == 5} {
1214            if {[string range $expmap(htype_$h) 1 2] != "XE"} continue
1215        }
1216
1217        if {[string range $expmap(htype_$h) 2 2] == "T"} {
1218            set det [format %8.2f [histinfo $h tofangle]]
1219        } elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
1220            set det [format %8.5f [histinfo $h lam1]]
1221        } elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
1222            set det [format %8.2f [histinfo $h lam1]]
1223        } else {
1224            set det {}
1225        }
1226        foreach lbox $expgui(HistSelectList) {
1227            $lbox.lbox insert end [format "%2d  %s  %4d %8s  %-67s" \
1228                    $h \
1229                    [string range $expmap(htype_$h) 1 2] \
1230                    [histinfo $h bank] \
1231                    $det \
1232                    [string range [histinfo $h title] 0 66] \
1233                    ]
1234        }
1235    }
1236    UpdateCurrentPage
1237}
1238
1239proc UpdateCurrentPage {} {
1240    global expgui
1241    foreach set $expgui(frameactionlist) {
1242        if {$expgui(pagenow) == [lindex $set 0]} {catch [lindex $set 1]}
1243    }
1244}
1245
1246#-----------------------------------------------------------------------
1247# ----------- draw Histogram page
1248#-----------------------------------------------------------------------
1249proc DisplayHistogram {} {
1250    global expgui entrycmd entryvar expmap
1251
1252    # trap if more than one histogram is selected unless global mode
1253    if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
1254        set expgui(curhist) [lindex $expgui(curhist) 0]
1255    }
1256
1257    # display the selected histograms
1258    $expgui(histFrame).hs.lbox selection clear 0 end
1259    foreach h $expgui(curhist) {
1260        $expgui(histFrame).hs.lbox selection set $h
1261    }
1262
1263    # disable traces on entryvar for right now
1264    set entrycmd(trace) 0
1265
1266    # get histogram list
1267    set histlist {}
1268    foreach item $expgui(curhist) {
1269        lappend histlist [lindex $expmap(powderlist) $item]
1270    }
1271    # must have at least one histogram selected here
1272    if {[llength $histlist] == 0} {
1273        set expgui(backtermlbl) ""
1274        set expgui(backtypelbl) ""
1275        foreach var {bref bdamp} {
1276            set entrycmd($var) ""
1277            set entryvar($var) ""
1278        }
1279        $expgui(histFrame).top.txt config -text "No Selected Histograms"
1280        grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew       
1281        set expgui(bkglbl) ""
1282        eval destroy [winfo children $expgui(diffBox)]
1283        set entrycmd(trace) 1
1284        return
1285    }
1286
1287    if {$expgui(globalmode) != 0} {
1288        set expgui(backtermlbl) ""
1289        set expgui(backtypelbl) ""
1290        foreach var {bref bdamp} {
1291            set entrycmd($var) "histinfo [list $histlist] $var"
1292            set entryvar($var) [histinfo [lindex $histlist 0] $var]
1293        }
1294    } else {
1295        set hist $histlist
1296        set terms [histinfo $hist backterms]
1297        set expgui(backtermlbl) "($terms terms)"
1298        set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
1299        foreach var {bref bdamp} {
1300            set entrycmd($var) "histinfo $hist $var"
1301            set entryvar($var) [eval $entrycmd($var)]
1302        }
1303    }
1304    # Top box
1305    if $expgui(haveBW) {
1306        catch {destroy $expgui(histFrame).pflag}
1307    }
1308    if {$expgui(globalmode) != 0} {
1309        $expgui(histFrame).top.txt config \
1310                -text "Selected Histograms: [CompressList $histlist]"
1311        grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew       
1312        set expgui(bkglbl) "Globally Edit Background"
1313    } else {
1314        grid forget $expgui(histFrame).top
1315        set expgui(bkglbl) "Edit Background"
1316        if {$expgui(haveBW) && [llength $expmap(phaselist)] > 1} {
1317            TitleFrame $expgui(histFrame).pflag  \
1318                    -borderwidth 4 -side left -relief groove \
1319                    -text "Phase Flags"
1320            set expgui(pflag) [$expgui(histFrame).pflag getframe]
1321            grid $expgui(histFrame).pflag -column 1 -row 1 -sticky nsew
1322            grid rowconfigure $expgui(histFrame) 2 -minsize 35
1323            foreach p $expmap(phaselist) {
1324                pack [checkbutton $expgui(pflag).$p \
1325                        -command "GetPhaseFlags $hist" \
1326                        -variable expgui(pflag$p) -text $p] -side left
1327                if {[lsearch $expmap(phaselist_$hist) $p] == -1} {
1328                    set expgui(pflag$p) 0
1329                } else {
1330                    set expgui(pflag$p) 1
1331                }
1332            }
1333        }
1334    }
1335
1336    # diffractometer constants
1337    foreach var {lam1 lam2 kratio pola ipola ddamp zero \
1338            wref pref dcref daref ratref ttref zref } {
1339        set entrycmd($var) "histinfo [list $histlist] $var"
1340        set entryvar($var) [histinfo [lindex $histlist 0] $var]
1341    }
1342
1343    eval destroy [winfo children $expgui(diffBox)]
1344    if {$expgui(globalmode) == 0} {
1345        if {[string range $expmap(htype_$hist) 2 2] == "T"} {
1346        #------
1347        # TOF |
1348        #------
1349            grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
1350                    -column 1 -row 1
1351            grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
1352                    -column 2 -row 1
1353            grid [ label $expgui(diffBox).lDCdifc -text DIFC ] \
1354                    -column 3 -row 1 -sticky w
1355            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1356                    -width 15 ] -column 4 -row 1
1357            #
1358            grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
1359                    -column 1 -row 2
1360            grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
1361                    -column 2 -row 2
1362            grid [ label $expgui(diffBox).lDCdifa -text DIFA ] \
1363                    -column 3 -row 2
1364            grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1365                    -width 15 ] -column 4 -row 2
1366            #
1367            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1368                    -column 3 -row 3
1369            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1370                    -width 15 ] -column 4 -row 3
1371            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1372                    -column 1 -row 3 -sticky w
1373            grid [ checkbutton $expgui(diffBox).rfDCzref \
1374                    -variable entryvar(zref) ] -column 2 -row 3
1375        } elseif {[string range $expmap(htype_$hist) 1 2] == "NC"} {
1376        #---------------
1377        # CW - neutron |
1378        #---------------
1379            grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1380                    -column 1 -row 1
1381            grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1382                    -column 2 -row 1
1383            grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1384                    -column 3 -row 1 -sticky w
1385            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1386                    -width 15 ] -column 4 -row 1
1387            #
1388            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1389                    -column 1 -row 3 -sticky w
1390            grid [ checkbutton $expgui(diffBox).rfDCzref \
1391                    -variable entryvar(zref) ] -column 2 -row 3
1392            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1393                    -column 3 -row 3
1394            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1395                    -width 15 ] -column 4 -row 3
1396        } elseif {[string range $expmap(htype_$hist) 1 2] == "XC" && \
1397                [histinfo $hist lam2] == 0.0} {
1398        #--------------------------
1399        # CW - x-ray 1 wavelength |
1400        #--------------------------
1401            grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1402                    -column 1 -row 1
1403            grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1404                    -column 2 -row 1
1405            grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1406                    -column 3 -row 1 -sticky w
1407            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1408                    -width 15 ] -column 4 -row 1
1409            #
1410            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1411                    -column 1 -row 3 -sticky w
1412            grid [ checkbutton $expgui(diffBox).rfDCzref \
1413                    -variable entryvar(zref) ] -column 2 -row 3
1414            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1415                    -column 3 -row 3
1416            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1417                    -width 15 ] -column 4 -row 3
1418            #
1419            grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1420                    -column 1 -row 4 -sticky w
1421            grid [ checkbutton $expgui(diffBox).rfDCpref \
1422                    -variable entryvar(pref) ] -column 2 -row 4
1423            grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1424                    -column 3 -row 4
1425            grid [ entry $expgui(diffBox).eDCpola \
1426                    -textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1427            grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1428                    -column 5 -row 4
1429            grid [ entry $expgui(diffBox).eDCipola -width 2 \
1430                    -textvariable entryvar(ipola)] -column 6 -row 4
1431        } elseif {[string range $expmap(htype_$hist) 1 2] == "XC"} {
1432        #---------------------------
1433        # CW - x-ray 2 wavelengths |
1434        #---------------------------
1435            grid [ label $expgui(diffBox).lDCdifc -text wavelengths ] \
1436                    -column 3 -row 1 -sticky w
1437            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1438                    -width 15 ] -column 4 -row 1
1439            grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1440                    -width 15 ] -column 5 -row 1
1441            #
1442            grid [ label $expgui(diffBox).lDCrref -text "Refine ratio" ] \
1443                    -column 1 -row 2 -sticky w
1444            grid [ checkbutton $expgui(diffBox).rfDCrref \
1445                    -variable entryvar(ratref) ] -column 2 -row 2
1446            grid [ label $expgui(diffBox).lDCratio -text Ratio ] \
1447                    -column 3 -row 2
1448            grid [ entry $expgui(diffBox).eDCkratio \
1449                    -textvariable entryvar(kratio) \
1450                    -width 15 ] -column 4 -row 2
1451            #
1452            grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1453                    -column 3 -row 3
1454            grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1455                    -width 15 ] -column 4 -row 3
1456            grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1457                    -column 1 -row 3 -sticky w
1458            grid [ checkbutton $expgui(diffBox).rfDCzref \
1459                    -variable entryvar(zref) ] -column 2 -row 3
1460            grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1461                    -column 1 -row 4 -sticky w
1462            grid [ checkbutton $expgui(diffBox).rfDCpref \
1463                    -variable entryvar(pref) ] -column 2 -row 4
1464            grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1465                    -column 3 -row 4
1466            grid [ entry $expgui(diffBox).eDCpola \
1467                    -textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1468            grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1469                    -column 5 -row 4
1470            grid [ entry $expgui(diffBox).eDCipola -width 2 \
1471                    -textvariable entryvar(ipola)] -column 6 -row 4
1472        } elseif {[string range $expmap(htype_$hist) 1 2] == "XE"} {
1473        #-------------
1474        # ED - x-ray |
1475        #-------------
1476            grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
1477                    -column 1 -row 1
1478            grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
1479                    -column 2 -row 1
1480            grid [ label $expgui(diffBox).lDCdifc -text 2Theta ] \
1481                    -column 3 -row 1 -sticky w
1482            grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1483                    -width 15 ] -column 4 -row 1
1484            #
1485            grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1486                    -column 1 -row 4 -sticky w
1487            grid [ checkbutton $expgui(diffBox).rfDCpref \
1488                    -variable entryvar(pref) ] -column 2 -row 4
1489            grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1490                    -column 3 -row 4
1491            grid [ entry $expgui(diffBox).eDCpola \
1492                    -textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1493            grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1494                    -column 5 -row 4
1495            grid [ entry $expgui(diffBox).eDCipola -width 2 \
1496                    -textvariable entryvar(ipola)] -column 6 -row 4
1497        }
1498    } elseif {$expgui(globalmode) == 1} {
1499        #-------------
1500        # Global TOF |
1501        #-------------
1502        grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
1503                -column 1 -row 1
1504        grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
1505                -column 2 -row 1
1506        grid [button $expgui(diffBox).bDCdifc -text "Set DIFC Globally" \
1507                -command "editglobalparm histinfo difc {DIFC}"] -column 3 -row 1
1508        #
1509        grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
1510                -column 1 -row 2
1511        grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
1512                -column 2 -row 2
1513        grid [ button $expgui(diffBox).bDCdifa -text "Set DIFA Globally" \
1514                -command "editglobalparm histinfo difa {DIFA}"] -column 3 -row 2
1515        #
1516        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1517                -column 1 -row 3 -sticky w
1518        grid [ checkbutton $expgui(diffBox).rfDCzref \
1519                -variable entryvar(zref) ] -column 2 -row 3
1520        grid [ button $expgui(diffBox).bDCzero -text "Set ZERO Globally" \
1521                -command "editglobalparm histinfo zero {Zero}"] -column 3 -row 3
1522    } elseif {$expgui(globalmode) == 2} {
1523        #--------------------
1524        # Global CW neutron |
1525        #--------------------
1526        grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1527                -column 1 -row 1
1528        grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1529                -column 2 -row 1
1530        grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
1531                -command "editglobalparm histinfo lam1 Wavelength"] \
1532                -column 3 -row 1
1533        #
1534        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1535                -column 1 -row 3 -sticky w
1536        grid [ checkbutton $expgui(diffBox).rfDCzref \
1537                -variable entryvar(zref) ] -column 2 -row 3
1538        grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1539                -command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1540    } elseif {$expgui(globalmode) == 4} {
1541        #----------------------
1542        # Global CW mono xray |
1543        #----------------------
1544        grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1545                -column 1 -row 1
1546        grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1547                -column 2 -row 1
1548        grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
1549                -command "editglobalparm histinfo lam1 Wavelength"] \
1550                -column 3 -row 1
1551        #
1552        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1553                -column 1 -row 3 -sticky w
1554        grid [ checkbutton $expgui(diffBox).rfDCzref \
1555                -variable entryvar(zref) ] -column 2 -row 3
1556        grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1557                -command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1558        #
1559        grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1560                -column 1 -row 4 -sticky w
1561        grid [ checkbutton $expgui(diffBox).rfDCpref \
1562                -variable entryvar(pref) ] -column 2 -row 4
1563        grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1564                -command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1565        grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1566                -command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1567    } elseif {$expgui(globalmode) == 3} {
1568        #------------------------
1569        # Global alpha 1,2 xray |
1570        #------------------------
1571        grid [button $expgui(diffBox).bDCl1 -text "Set Wave1 Globally" \
1572                -command "editglobalparm histinfo lam1 {Wavelength 1}"] \
1573                -column 3 -row 1
1574        grid [button $expgui(diffBox).bDCl2 -text "Set Wave2 Globally" \
1575                -command "editglobalparm histinfo lam2 {Wavelength 2}"] \
1576                -column 4 -row 1
1577        #
1578        grid [ label $expgui(diffBox).lDCratref -text "Refine Ratio" ] \
1579                -column 1 -row 3 -sticky w
1580        grid [ checkbutton $expgui(diffBox).rfDCratref \
1581                -variable entryvar(ratref) ] -column 2 -row 3
1582        grid [button $expgui(diffBox).bDCrrat -text "Set Ratio Globally" \
1583                -command "editglobalparm histinfo ratio {Wavelength Ratio}"] \
1584                -column 3 -row 3
1585        #
1586        grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1587                -column 1 -row 3 -sticky w
1588        grid [ checkbutton $expgui(diffBox).rfDCzref \
1589                -variable entryvar(zref) ] -column 2 -row 3
1590        grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1591                -command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1592        #
1593        grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1594                -column 1 -row 4 -sticky w
1595        grid [ checkbutton $expgui(diffBox).rfDCpref \
1596                -variable entryvar(pref) ] -column 2 -row 4
1597        grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1598                -command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1599        grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1600                -command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1601    } elseif {$expgui(globalmode) == 5} {
1602        #-----------------
1603        # Global ED xray |
1604        #-----------------
1605        grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
1606                -column 1 -row 1
1607        grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
1608                -column 2 -row 1
1609        grid [button $expgui(diffBox).bDCdifc -text "Set 2Theta Globally" \
1610                -command "editglobalparm histinfo ratio {Fixed 2Theta}"] \
1611                -column 3 -row 1
1612        #
1613        grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1614                -column 1 -row 4 -sticky w
1615        grid [ checkbutton $expgui(diffBox).rfDCpref \
1616                -variable entryvar(pref) ] -column 2 -row 4
1617        grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1618                -command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1619        grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1620                -command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1621    }
1622    if {$expgui(globalmode) == 0} {
1623        grid [frame $expgui(diffBox).d] -column 5 -row 5 \
1624                -columnspan 2 -sticky e
1625    } else {
1626        grid [frame $expgui(diffBox).d] -column 4 -row 5 \
1627                -columnspan 2 -sticky e
1628    }
1629    grid [label $expgui(diffBox).d.lDamp -text "Damping  "] \
1630            -column 1 -row 1
1631    tk_optionMenu $expgui(diffBox).d.om entryvar(ddamp) 0 1 2 3 4 5 6 7 8 9
1632    grid $expgui(diffBox).d.om -column 2 -row 1
1633    grid columnconfigure $expgui(diffBox) 9  -weight 1
1634    grid columnconfigure $expgui(diffBox) 0  -weight 1
1635    update idletasks
1636    # enable traces on entryvar now
1637    set entrycmd(trace) 1
1638}
1639
1640proc GetPhaseFlags {hist} {
1641    global expmap expgui
1642    set plist {}
1643    foreach p $expmap(phaselist) {
1644        if {$expgui(pflag$p)} {lappend plist $p}
1645    }
1646    SetPhaseFlag $hist $plist
1647    incr expgui(changed)
1648    mapexp
1649}
1650
1651proc SetPhaseFlag {hist plist} {
1652    # make a 2 digit key -- hh
1653    if {$hist < 10} {
1654        set hh " $hist"
1655    } else {
1656        set hh $hist
1657    }
1658    set key "HST $hh NPHAS"
1659    set str {}
1660    foreach iph {1 2 3 4 5 6 7 8 9} {
1661        if {[lsearch $plist $iph] != -1} {
1662            append str {    1}
1663        } else {
1664            append str {    0}     
1665        }
1666    }
1667    setexp $key $str 1 68
1668}
1669
1670#-----------------------------------------------------------------------
1671# populate the Scaling page
1672#-----------------------------------------------------------------------
1673proc DisplayFrac {} {
1674    global expgui entrycmd entryvar expmap
1675
1676    # trap if more than one histogram is selected unless global mode
1677    if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
1678        set expgui(curhist) [lindex $expgui(curhist) 0]
1679    }
1680
1681    # display the selected histograms
1682    $expgui(fracFrame).hs.lbox selection clear 0 end
1683    foreach h $expgui(curhist) {
1684        $expgui(fracFrame).hs.lbox selection set $h
1685    }
1686
1687    # disable traces on entryvar
1688    set entrycmd(trace) 0
1689
1690    # get histogram list
1691    set histlist {}
1692    foreach item $expgui(curhist) {
1693        lappend histlist [lindex $expmap(powderlist) $item]
1694    }
1695
1696    # must have at least one histogram selected here
1697    if {[llength $histlist] == 0} {
1698        foreach var {scale sref sdamp} {
1699            set entrycmd($var) ""
1700            set entryvar($var) ""
1701        }
1702        set parm [grid info $expgui(scaleBox).but1]
1703        if {$parm != ""} {
1704            grid forget  $expgui(scaleBox).but1
1705            eval grid $expgui(scaleBox).ent1 $parm
1706        }
1707        # destroy the contents of the frame
1708        set phaseFractf1 $expgui(FracBox).f
1709        eval destroy [winfo children $phaseFractf1]
1710        # reenable traces on entryvar
1711        set entrycmd(trace) 1
1712        return
1713    }
1714
1715    #--------------
1716    # Scale factor
1717    #--------------
1718    if {$expgui(globalmode) != 0} {
1719        foreach var {scale sref sdamp} {
1720            set entrycmd($var) "histinfo [list $histlist] $var"
1721            set entryvar($var) [histinfo [lindex $histlist 0] $var]
1722        }
1723        set parm [grid info $expgui(scaleBox).ent1]
1724        if {$parm != ""} {
1725            grid forget  $expgui(scaleBox).ent1
1726            eval grid $expgui(scaleBox).but1 $parm
1727        }
1728    } else {
1729        set hist $histlist
1730        foreach var {scale sref sdamp} {
1731            set entrycmd($var) "histinfo $hist $var"
1732            set entryvar($var) [eval $entrycmd($var)]
1733        }
1734        set parm [grid info $expgui(scaleBox).but1]
1735        if {$parm != ""} {
1736            grid forget  $expgui(scaleBox).but1
1737            eval grid $expgui(scaleBox).ent1 $parm
1738        }
1739    }
1740
1741    #----------------
1742    # Phase Fractions
1743    #----------------
1744    set phaseFractf1 $expgui(FracBox).f
1745    # destroy the contents of the frame
1746    eval destroy [winfo children $phaseFractf1]
1747    if {$expgui(globalmode) != 0} {
1748        set txt "Phase Fractions for Histograms: [CompressList $histlist]"
1749    } else {
1750        set txt "Phase Fractions"
1751    }
1752    if $expgui(haveBW) {
1753        $expgui(fracFrame).f1.phaseFrac configure -text $txt
1754    } else {
1755        grid [label $phaseFractf1.txt -anchor center -text $txt] \
1756                -column 0 -row 0 -sticky news
1757    }
1758    # Create the frame inside the canvas, One frame for each Phase.
1759    foreach i {1 2 3 4 5 6 7 8 9} {set phasehistlist($i) ""}
1760    foreach hist $histlist {
1761        foreach i $expmap(phaselist_$hist) {
1762            lappend phasehistlist($i) $hist
1763        }
1764    }
1765    foreach i {1 2 3 4 5 6 7 8 9} {
1766        if {[llength $phasehistlist($i)] == 0} continue
1767        set framePF [frame $phaseFractf1.pF$i -relief groove  -bd 4]
1768        grid $framePF -column 0 -row $i -sticky ew
1769        # Label Heading for each phase.
1770        if {$expgui(globalmode) != 0} {
1771            grid [label $framePF.l1 \
1772                    -text "Phase $i Hist: [CompressList $phasehistlist($i)]"] \
1773                    -column 0 -row 0 -sticky nws
1774            grid [button $framePF.but1 -text "Set Globally" \
1775                    -command "editglobalparm hapinfo frac \"Phase $i Fraction\" \
1776                    [list $phasehistlist($i)] $i" \
1777                    ] -column 1 -row 0
1778        } else {
1779            grid [label $framePF.l1  -text "Phase $i"] \
1780                    -column 0 -row 0 -sticky nws
1781            grid [entry $framePF.ent -textvariable entryvar(frac$i) -width 15]\
1782                    -column 1 -row 0
1783        }
1784        set entrycmd(frac$i) "hapinfo $hist $i frac"
1785        set entryvar(frac$i) [hapinfo $hist $i frac]
1786        grid [label $framePF.l2  -text "  Refine"] \
1787                -column 2 -row 0 -sticky nws
1788        grid [checkbutton $framePF.cb -variable entryvar(frref$i)] \
1789                -column 3 -row 0 -sticky nws
1790        set entrycmd(frref$i) "hapinfo $hist $i frref"
1791        set entryvar(frref$i) [hapinfo $hist $i frref]
1792        grid [label $framePF.l3  -text "  Damping"] \
1793                -column 4 -row 0 -sticky nws
1794        tk_optionMenu $framePF.tkOptDamp entryvar(frdamp$i) \
1795                0 1 2 3 4 5 6 7 8 9     
1796        set entrycmd(frdamp$i) "hapinfo $hist $i frdamp"
1797        set entryvar(frdamp$i) [hapinfo $hist $i frdamp]
1798        grid $framePF.tkOptDamp -row 0 -sticky nsw -column 5
1799    }
1800    # resize the scroll window to match the actual
1801    update idletasks
1802    $expgui(FracBox) config -scrollregion [grid bbox $expgui(FracBox).f]
1803    $expgui(FracBox) config -width [lindex [grid bbox $expgui(FracBox).f] 2]
1804    update idletasks
1805    # enable traces on entryvar now
1806    set entrycmd(trace) 1
1807}
1808
1809#-----------------------------------------------------------------------
1810# display the profile page
1811#-----------------------------------------------------------------------
1812proc DisplayProfile {} {
1813    global expgui entrycmd entryvar expmap
1814
1815    # trap if more than one histogram is selected unless global mode
1816    if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
1817        set expgui(curhist) [lindex $expgui(curhist) 0]
1818    }
1819    # display the selected histograms
1820    $expgui(profFrame).hs.lbox selection clear 0 end
1821    foreach h $expgui(curhist) {
1822        $expgui(profFrame).hs.lbox selection set $h
1823    }
1824
1825    # destroy the contents of the frame
1826    eval destroy [winfo children $expgui(ProfileBox).f]
1827
1828    if {$expgui(globalmode) == 0} {
1829        # must have at least one histogram selected here
1830        if {[llength $expgui(curhist)] == 0} return
1831        # disable traces on entryvar for right now
1832        set entrycmd(trace) 0
1833        set hist [lindex $expmap(powderlist) $expgui(curhist)]
1834        # no defined histograms?
1835        if {$hist == ""} return
1836        # Create one frame for each Phase.
1837        set ind -1
1838        set htype [string range $expmap(htype_$hist) 2 2]
1839        foreach i $expmap(phaselist_$hist) {
1840            incr ind
1841            # Label Heading for each phase.
1842            set ptype [string trim [hapinfo $hist $i proftype]]
1843            if {$expgui(haveBW)} {
1844                grid [TitleFrame $expgui(ProfileBox).f.$i \
1845                        -text "Hist $hist -- Phase $i (type $ptype)" \
1846                        -relief groove -bd 2] \
1847                        -column 0 -row $ind -sticky ew
1848                set ProfileFrame [$expgui(ProfileBox).f.$i getframe]
1849                grid [frame $ProfileFrame.1] \
1850                        -column 0 -row 0 -columnspan 10
1851                pack [label $ProfileFrame.1.l  \
1852                        -text Damping]\
1853                        -side left
1854            } else {
1855                grid [frame $expgui(ProfileBox).f.$i -relief groove -bd 4] \
1856                        -column 0 -row $ind -sticky ew
1857                set ProfileFrame $expgui(ProfileBox).f.$i
1858                grid [frame $ProfileFrame.1] \
1859                        -column 0 -row 0 -columnspan 10 -sticky ew
1860                pack [label $ProfileFrame.1.l  \
1861                        -text "Phase $i (type $ptype)    Damping"]\
1862                        -side left
1863            }
1864            tk_optionMenu $ProfileFrame.1.tkOptDamp entryvar(pdamp_$i) \
1865                    0 1 2 3 4 5 6 7 8 9
1866            set entrycmd(pdamp_$i) "hapinfo $hist $i pdamp"
1867            set entryvar(pdamp_$i) [hapinfo $hist $i pdamp]
1868            pack $ProfileFrame.1.tkOptDamp -side left
1869            pack [label $ProfileFrame.1.l1 \
1870                    -text "  Peak cutoff"]\
1871                    -side left
1872            pack [entry $ProfileFrame.1.e1  \
1873                    -width 10 -textvariable entryvar(pcut_$i)]\
1874                    -side left
1875            set entrycmd(pcut_$i) "hapinfo $hist $i pcut"
1876            set entryvar(pcut_$i) [hapinfo $hist $i pcut]
1877
1878            pack [button $ProfileFrame.1.b1  \
1879                    -text "Change Type" \
1880                    -command "ChangeProfileType $hist $i"]\
1881                    -side left
1882           
1883            set col -1
1884            set row 1
1885            set nterms [hapinfo $hist $i profterms]
1886            set lbls "dummy [GetProfileTerms $i $hist $ptype]"
1887            for { set num 1 } { $num <= $nterms } { incr num } {
1888                set term {}
1889                catch {set term [lindex $lbls $num]}
1890                if {$term == ""} {set term $num}
1891                incr col
1892                grid [label $ProfileFrame.l${num}_${i} -text "$term"] \
1893                        -row $row -column $col
1894                incr col
1895                grid [checkbutton $ProfileFrame.ref${num}_${i} \
1896                        -variable entryvar(pref${num}_$i)] -row $row -column $col
1897                set entrycmd(pref${num}_$i) "hapinfo $hist $i pref$num"
1898                set entryvar(pref${num}_$i) [hapinfo $hist $i pref$num]
1899                incr col
1900                grid [entry $ProfileFrame.ent${num}_${i} \
1901                        -textvariable entryvar(pterm${num}_$i)\
1902                        -width 12] -row $row -column $col
1903                set entrycmd(pterm${num}_$i) "hapinfo $hist $i pterm$num"
1904                set entryvar(pterm${num}_$i) [hapinfo $hist $i pterm$num]
1905                if {$col > 6} {set col -1; incr row}
1906            }
1907        }
1908        grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
1909    } else {
1910        # get histogram list
1911        set histlist {}
1912        foreach item $expgui(curhist) {
1913            lappend histlist [lindex $expmap(powderlist) $item]
1914        }
1915        # must have at least one histogram selected here
1916        if {[llength $histlist] == 0} return
1917        # disable traces on entryvar for right now
1918        set entrycmd(trace) 0
1919        # loop through histograms & phases, set up an array by phase & profile type
1920        catch {unset prtyparray histarray phasearray}
1921        foreach hist $histlist {
1922            foreach phase $expmap(phaselist_$hist) {
1923                set prtyp [string trim [hapinfo $hist $phase proftype]]
1924                set key ${prtyp}_$phase
1925                lappend prtyparray($key) $hist
1926                lappend histarray($key) $hist
1927                lappend phasearray($key) $phase
1928            }
1929        }
1930       
1931        set ptype ""
1932        set i -1
1933        # loop over all combined phases and profile types, sorted 1st by profile number
1934        foreach key [lsort [array names prtyparray]] {
1935            # split key
1936            scan $key %d_%d prftyp p
1937
1938            if {$ptype != $prftyp || !$expgui(globalphasemode)} {
1939                set ptype $prftyp
1940                set curhistlist $histarray($key)
1941                set curphaslist $phasearray($key)
1942               
1943                set hist1 [lindex $curhistlist 0]
1944                set phase1 [lindex $curphaslist 0]
1945                set nterms [hapinfo $hist1 $phase1 profterms]
1946                set htype [string range $expmap(htype_$hist1) 2 2]
1947                set lbls "dummy [GetProfileTerms $phase1 $hist1 $ptype]"
1948                # Create a frame for this type
1949                incr i
1950                set boxtitle "Phase $p, hist [CompressList $histarray($key)]"
1951                if {$expgui(haveBW)} {
1952                    grid [TitleFrame $expgui(ProfileBox).f.$i \
1953                            -text "(type $ptype)" \
1954                            -relief groove -bd 2] \
1955                            -column 0 -row $i -sticky ew
1956                    set ProfileFrame [$expgui(ProfileBox).f.$i getframe]
1957                    grid [frame $ProfileFrame.0] \
1958                            -column 0 -row 0 -columnspan 20 -sticky ew
1959                } else {
1960                    grid [frame $expgui(ProfileBox).f.$i \
1961                            -relief groove -bd 4] \
1962                            -column 0 -row $i -sticky ew
1963                    set ProfileFrame $expgui(ProfileBox).f.$i
1964                    grid [frame $ProfileFrame.0] \
1965                            -column 0 -row 0 -columnspan 20 -sticky ew
1966                    grid [label $ProfileFrame.0.0  \
1967                            -text "Profile Type $ptype   "] -row 0 -column 0
1968                }
1969                grid [label $ProfileFrame.0.1  \
1970                        -anchor w] -row 0 -column 1
1971                grid [frame $ProfileFrame.1] \
1972                        -column 0 -row 1 -columnspan 20 -sticky ew
1973                grid [label $ProfileFrame.1.2  \
1974                        -text "Damping"] -row 0 -column 2
1975                tk_optionMenu $ProfileFrame.1.tkOptDamp \
1976                        entryvar(pdamp_$i) 0 1 2 3 4 5 6 7 8 9
1977                grid $ProfileFrame.1.tkOptDamp -row 0 -column 3
1978                grid [button $ProfileFrame.1.edit \
1979                        -text "Global Edit"] -row 0 -column 4 -sticky w
1980                set entryvar(pdamp_$i) [hapinfo $hist $phase pdamp]
1981                grid [button $ProfileFrame.1.b1 -text "Change Type"] \
1982                        -row 0 -column 5 -sticky w
1983                set col -1
1984                set row 2
1985                for { set num 1 } { $num <= $nterms } { incr num } {
1986                    set term {}
1987                    catch {set term [lindex $lbls $num]}
1988                    if {$term == ""} {set term $num}
1989                    incr col
1990                    grid [label $ProfileFrame.l${num}_${i} \
1991                            -text "$term"] -row $row -column $col
1992                    incr col
1993                    grid [checkbutton $ProfileFrame.ref${num}_${i} \
1994                            -variable entryvar(pref${num}_$i)] \
1995                            -row $row -column $col
1996                    set entryvar(pref${num}_$i) [hapinfo $hist $phase pref$num]
1997                    if {$col > 10} {set col -1; incr row}
1998                }
1999                grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
2000            } else {
2001                # add to the current entry
2002                eval lappend curhistlist $histarray($key)
2003                eval lappend curphaslist $phasearray($key)
2004                append boxtitle "\nPhase $p, hist [CompressList $histarray($key)]"
2005            }
2006            $ProfileFrame.0.1 config -text $boxtitle
2007            $ProfileFrame.1.edit config -command "\
2008                    EditProfile \"\n$boxtitle\" \
2009                    [list $curhistlist] \
2010                    [list $curphaslist]"
2011            $ProfileFrame.1.b1 config -command "ChangeProfileType \
2012                    [list $curhistlist] [list $curphaslist]"
2013            set entrycmd(pdamp_$i) "hapinfo \
2014                    [list $curhistlist] \
2015                    [list $curphaslist] pdamp"
2016            for { set num 1 } { $num <= $nterms } { incr num } {
2017                set entrycmd(pref${num}_$i) "hapinfo \
2018                        [list $curhistlist] \
2019                        [list $curphaslist] pref$num"
2020            }
2021        }
2022    }
2023   
2024    # resize the scroll window to match the actual
2025    update idletasks
2026    $expgui(ProfileBox) config -scrollregion [grid bbox $expgui(ProfileBox).f]
2027    $expgui(ProfileBox) config -width [lindex [grid bbox $expgui(ProfileBox).f] 2]
2028    update idletasks
2029    ResizeNotebook
2030    # enable traces on entryvar now
2031    set entrycmd(trace) 1
2032}
2033
2034# process the bit settings in the print options
2035#   bitnum -- the number of the bit to be tested/set starting at 0 for the LSBit
2036proc printsetting {bitnum "action get" "value {}"} {
2037    global entryvar expgui
2038    if {$action == "get"} {
2039        return [expr ([expinfo print] & int(pow(2,$bitnum))) != 0]
2040    } elseif $value {
2041        set newval [expr ([expinfo print] | int(pow(2,$bitnum)))]
2042    } else {
2043        set newval [expr ([expinfo print] & ~int(pow(2,$bitnum)))]
2044    }
2045    expinfo print set $newval
2046    set expgui(printopt) "Print Options ([expinfo print])"
2047}
2048
2049# need to respond to mouse presses -- control variable associated with extract Fobs
2050# and set the LeBail extraction flags
2051proc SetupExtractHist {} {
2052    global expgui entrycmd entryvar expmap
2053
2054    # display the selected histograms
2055    $expgui(lsFrame).hs.lbox selection clear 0 end
2056    foreach h $expgui(curhist) {
2057        $expgui(lsFrame).hs.lbox selection set $h
2058    }
2059
2060    # get histogram list
2061    set histlist {}
2062    foreach item $expgui(curhist) {
2063        set hist [lindex $expmap(powderlist) $item]
2064        if {$hist != ""} {lappend histlist $hist}
2065    }
2066    set entrycmd(fobsextract) "histinfo [list $histlist] foextract"
2067    if {[llength $histlist] == 0 || [string trim $histlist] == ""} {
2068        foreach phase {1 2 3 4 5 6 7 8 9} {
2069            $expgui(FobsExtractFrame).l$phase config -fg grey
2070            set expgui(Fextract$phase) {}
2071            foreach item $expgui(ExtractSettingsRadiobuttons) {
2072                ${item}$phase config -state disabled -bd 1
2073            }
2074        }
2075    } elseif {[llength $histlist] == 1} {
2076        # disable traces on entryvar
2077        set entrycmd(trace) 0
2078        set entryvar(fobsextract) [histinfo $histlist foextract]
2079        foreach phase {1 2 3 4 5 6 7 8 9} {
2080            # is the phase present?
2081            if {[lsearch -exact $expmap(phaselist_$histlist) $phase] == -1} {
2082                $expgui(FobsExtractFrame).l$phase config -fg grey
2083                set expgui(Fextract$phase) {}
2084                foreach item $expgui(ExtractSettingsRadiobuttons) {
2085                    ${item}$phase config -state disabled -bd 1
2086                }
2087            } else {
2088                $expgui(FobsExtractFrame).l$phase config -fg black
2089                foreach item $expgui(ExtractSettingsRadiobuttons) {
2090                    ${item}$phase config -state normal -bd 2
2091                }
2092                set expgui(Fextract$phase) [hapinfo $histlist $phase extmeth]
2093            }
2094        }
2095    } elseif {[llength $histlist] > 1} {
2096        # disable traces on entryvar
2097        set entrycmd(trace) 0
2098        # multiple histograms need phases in any histogram
2099        foreach phase {1 2 3 4 5 6 7 8 9} {
2100            set gotphase($phase) 0
2101        }           
2102        foreach hist $histlist {
2103            foreach phase $expmap(phaselist_$hist) {
2104                set gotphase($phase) 1
2105            }
2106        }
2107        foreach phase {1 2 3 4 5 6 7 8 9} {
2108            set expgui(Fextract$phase) {}
2109            if $gotphase($phase) {
2110                $expgui(FobsExtractFrame).l$phase config -fg black
2111                foreach item $expgui(ExtractSettingsRadiobuttons) {
2112                    ${item}$phase config -state normal -bd 2
2113                }
2114            } else {
2115                $expgui(FobsExtractFrame).l$phase config -fg grey
2116                foreach item $expgui(ExtractSettingsRadiobuttons) {
2117                    ${item}$phase config -state disabled -bd 1
2118                }
2119            }
2120        }
2121    }
2122    # reenable traces
2123    set entrycmd(trace) 1
2124}
2125# respond to a change in the fobs extraction method for a phase
2126# force the main extraction flag on, if fobs extraction is selected for any phase
2127proc HistExtractSet {phase} {
2128    global expgui entryvar expmap
2129    foreach item $expgui(curhist) {
2130        lappend histlist [lindex $expmap(powderlist) $item]
2131    }
2132    hapinfo $histlist $phase extmeth set $expgui(Fextract$phase)
2133    incr expgui(changed)
2134    if {$expgui(Fextract$phase) != 0} {set entryvar(fobsextract) 1}
2135}
2136#---------------------------- Global Edit Functions ------------------------
2137proc editbackground {} {
2138    global expgui expmap entrycmd
2139    set histlist {}
2140    foreach n $expgui(curhist) {
2141        lappend histlist [lindex $expmap(powderlist) $n]
2142    }
2143    if {[llength $histlist] == 0} return
2144
2145    set w .back
2146    catch {destroy $w}
2147    toplevel $w -bg beige
2148    if {$expgui(globalmode) != 0} {
2149        wm title $w "Global Edit Background"
2150    } else {
2151        wm title $w "Edit Background"
2152    }
2153   
2154    pack [frame $w.0 -bd 6 -relief groove  -bg beige \
2155            ] -side top -expand yes -fill both
2156    if {[llength $histlist] > 1} {
2157        grid [label $w.0.a \
2158            -text "Setting background terms for histograms [CompressList $histlist]" \
2159            -bg beige] -row 0 -column 0 -columnspan 10
2160    } else {
2161        grid [label $w.0.a \
2162            -text "Setting background terms for histogram $histlist" \
2163            -bg beige] -row 0 -column 0 -columnspan 10
2164    }
2165    set hist [lindex $histlist 0]
2166    grid [label $w.0.b -text "Function type"  -bg beige]  -row 1 -column 0
2167
2168    # disable traces on  expgui(backtype) & expgui(backterms) now
2169    set entrycmd(trace) 0
2170
2171    # number of terms
2172    set expgui(backtype) [histinfo $hist backtype]
2173    set expgui(orig_backtype) $expgui(backtype)
2174    set expgui(prev_backtype) $expgui(backtype)
2175    set typemenu [tk_optionMenu $w.0.type expgui(backtype) null]
2176    $typemenu delete 0 end
2177    foreach item {
2178        "1 - Shifted Chebyshev"
2179        "2 - Cosine Fourier series"
2180        "3 - Radial distribution peaks"
2181        "4 - Power series in Q**2n/n!"
2182        "5 - Power series in n!/Q**2n"
2183        "6 - Power series in Q**2n/n! and n!/Q**2n"
2184        "7 - Linear interpolation function"
2185        "8 - Reciprocal interpolation function"
2186    } {
2187        set val [lindex $item 0]
2188        $typemenu insert end radiobutton -variable expgui(backtype) \
2189                -label $item -value $val
2190    }
2191
2192    grid $w.0.type   -row 1 -column 1
2193    grid [label $w.0.c -text "  Number of terms"  -bg beige] -row 1 -column 2
2194
2195    # function type
2196    set expgui(backterms) [histinfo $hist backterms]
2197    set expgui(orig_backterms) $expgui(backterms)
2198    set list {}; for {set i 1} {$i <= 36} {incr i} {lappend list $i}
2199    eval tk_optionMenu $w.0.terms expgui(backterms) $list
2200    grid $w.0.terms   -row 1 -column 3
2201    # enable traces on  expgui(backtype) & expgui(backterms) now
2202    set entrycmd(trace) 1
2203
2204    #set background terms
2205    for {set num 1 } { $num <= 36 } { incr num } {
2206        set var "bterm$num"
2207        set expgui($var) {}
2208        set expgui(orig_$var) {}
2209    }
2210    if {[llength $histlist] == 1} {
2211        for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2212            set var "bterm$num"
2213            set expgui($var) [histinfo $histlist $var]
2214            set expgui(orig_$var) $expgui($var)
2215        }
2216    }
2217
2218    pack [frame $w.1 -bd 6 -relief groove  -bg beige] -side top \
2219            -expand yes -fill both
2220    ShowBackTerms $w.1
2221
2222    set expgui(temp) {}
2223    pack [frame $w.b] -side top
2224    pack [button $w.b.2 -text Set -command "destroy $w"] -side left
2225    pack [button $w.b.3 -text Quit \
2226            -command "QuitEditBackground $w"] -side left
2227    bind $w <Return> "destroy $w"
2228
2229    # force the window to stay on top
2230    putontop $w
2231
2232    focus $w.b.2
2233    tkwait window $w
2234    afterputontop
2235
2236    if {$expgui(temp) != ""} return
2237
2238    if {$expgui(orig_backtype) != $expgui(backtype)} {
2239        histinfo $histlist backtype set $expgui(backtype)
2240        incr expgui(changed)
2241    }
2242    if {$expgui(orig_backterms) != $expgui(backterms)} {
2243        histinfo $histlist backterms set $expgui(backterms)
2244        incr expgui(changed)
2245    }
2246    for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2247        set var "bterm$num"
2248        if {$expgui(orig_$var) != $expgui($var)} {
2249            histinfo $histlist $var set $expgui($var)
2250            incr expgui(changed)
2251        }
2252    }
2253
2254    if {$expgui(globalmode) == 0} {
2255        set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
2256        set expgui(backtermlbl) "([histinfo $hist backterms] terms)"
2257    }
2258}
2259
2260trace variable expgui(backterms) w ChangeBackTerms
2261proc ChangeBackTerms {a b c} {
2262    global entrycmd expgui
2263    if !$entrycmd(trace) return
2264    ShowBackTerms .back.1
2265}
2266
2267trace variable expgui(backtype) w ChangeBackType
2268# reset the terms to 1, 0, 0... when the number of terms increase
2269proc ChangeBackType {a b c} {
2270    global entrycmd expgui
2271    if !$entrycmd(trace) return
2272    if {$expgui(prev_backtype) == $expgui(backtype)} return
2273    set expgui(prev_backtype) $expgui(backtype)
2274    for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2275        set var "bterm$num"
2276        if {$num == 1} {
2277            set expgui($var) 1.0
2278        } else {
2279            set expgui($var) 0.0
2280        }
2281    }
2282}
2283
2284proc ShowBackTerms {w } {
2285    global expgui expmap
2286    # destroy the contents of the frame
2287    eval destroy [winfo children $w]
2288    set histlist {}
2289    foreach n $expgui(curhist) {
2290        lappend histlist [lindex $expmap(powderlist) $n]
2291    }
2292    set widgetsPerRow 4
2293    for {set rows 2; set num 1 } { $num <= $expgui(backterms) } { incr rows } {
2294        for {set cols 0} { (2*$widgetsPerRow > $cols) && ($num <= $expgui(backterms)) }  { incr num }  {
2295            set var "bterm$num"
2296            grid [label $w.l$num -text $num -bg beige]  \
2297                    -row $rows -column $cols -sticky nes
2298            incr cols
2299            grid [entry $w.e$num -width 15 -textvariable expgui($var) \
2300                    ] -row $rows  -column $cols  -sticky news
2301            incr cols
2302        }
2303    }
2304}
2305
2306proc QuitEditBackground {w} {
2307    global expgui
2308    # lets find out if anything changed
2309    set changed 0
2310    if {$expgui(orig_backtype) != $expgui(backtype)} {
2311        set changed 1
2312    }
2313    if {$expgui(orig_backterms) != $expgui(backterms)} {
2314        set changed 1
2315    }
2316    for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2317        set var "bterm$num"
2318        if {$expgui(orig_$var) != $expgui($var)} {
2319            set changed 1
2320            break
2321        }
2322    }
2323    if $changed {
2324        set decision [tk_dialog .changes "Abandon Changes" \
2325                "You have made changes to the background. Ok to abandon changes?" \
2326                warning 0 Abandon Keep]
2327        if !$decision {
2328            set expgui(temp) "Quit"
2329            destroy $w
2330        }
2331    } else {
2332        set expgui(temp) "Quit"
2333        destroy $w
2334    }
2335}
2336
2337# this probably needs work
2338proc editglobalparm {cmd variable title "histlist {}" "phase {}"} {
2339    global expgui expmap
2340    set w .global
2341    catch {destroy $w}
2342    toplevel $w -bg beige
2343    wm title $w "Edit Global Parameter"
2344    set expgui(temp) {}
2345    if {[llength $histlist] == 0} {
2346        set hist {}
2347        foreach n $expgui(curhist) {
2348            lappend hist [lindex $expmap(powderlist) $n]
2349        }
2350    } else {
2351        set hist $histlist
2352    }
2353    pack [frame $w.0 -bd 6 -relief groove -bg beige] \
2354            -side top -expand yes -fill both
2355    grid [label $w.0.a -text "Setting $title for histograms [CompressList $hist]"\
2356            -bg beige] \
2357            -row 0 -column 0 -columnspan 10
2358    grid [entry $w.0.b -textvariable expgui(temp)] \
2359            -row 1 -column 0
2360
2361
2362    pack [frame $w.b] -side top
2363    pack [button $w.b.2 -text Set -command "destroy $w"] -side left
2364    pack [button $w.b.3 -text Quit -command "set expgui(temp) {}; destroy $w"] -side left
2365    bind $w <Return> "destroy $w"
2366
2367    # force the window to stay on top
2368    putontop $w
2369    focus $w.b.2
2370    tkwait window $w
2371    afterputontop
2372
2373    if {$expgui(temp) != ""} {
2374        foreach h $hist {
2375            if {$cmd == "histinfo"} {
2376                histinfo $h $variable set $expgui(temp)
2377                incr expgui(changed)
2378                if $expgui(debug) {
2379                    puts "histinfo $h $variable set $expgui(temp)"
2380                }
2381            } elseif {$cmd == "hapinfo"} {
2382                hapinfo $h $phase $variable set $expgui(temp)
2383                incr expgui(changed)
2384                if $expgui(debug) {
2385                    puts "hapinfo $phase $h $variable set $expgui(temp)"
2386                }
2387            } else {
2388                error "$cmd unimplemented"
2389            }
2390        }
2391    }
2392}
2393
2394proc EditProfile {title histlist phaselist} {
2395    global expgui expmap entrycmd
2396    set w .back
2397    catch {destroy $w}
2398    toplevel $w -bg beige
2399    wm title $w "Global Edit Profile"
2400    set hist [lindex $histlist 0]
2401    set phase [lindex $phaselist 0]
2402    set ptype [string trim [hapinfo $hist $phase proftype]]
2403    set htype [string range $expmap(htype_$hist) 2 2]
2404    set nterms [hapinfo $hist $phase profterms]
2405   
2406    pack [frame $w.0 -bd 6 -relief groove  -bg beige \
2407            ] -side top -expand yes -fill both
2408    grid [label $w.0.a \
2409            -text "Setting profile terms: $title" \
2410            -bg beige] -row 0 -column 0 -columnspan 10
2411    grid [label $w.0.b -text "Function type $ptype"  -bg beige]  -row 1 -column 0
2412    grid [label $w.0.c -text "  Peak cutoff" -bg beige] -row 1 -column 3
2413    grid [entry $w.0.d -width 10 ]  -row 1 -column 4
2414    set entrylist {}
2415    lappend entrylist "pcut $w.0.d"
2416
2417    set col -1
2418    set row 1
2419    set lbls "dummy [GetProfileTerms $phase $hist $ptype]"
2420    pack [frame $w.1 -bd 6 -relief groove  -bg beige \
2421            ] -side top -expand yes -fill both
2422    for { set num 1 } { $num <= $nterms } { incr num } {
2423        set term {}
2424        catch {set term [lindex $lbls $num]}
2425        if {$term == ""} {set term $num}
2426        incr col
2427        grid [label $w.1.l${num} -text "$term" -bg beige] \
2428                -row $row -column $col
2429        incr col
2430        grid [entry $w.1.ent${num} \
2431                -width 14] -row $row -column $col
2432        lappend entrylist "pterm$num $w.1.ent${num}"   
2433        if {$col > 6} {set col -1; incr row}
2434    }
2435    pack [frame $w.b] -side top
2436    pack [button $w.b.2 -text Set \
2437            -command "SetEditProfile [list $entrylist] [list $phaselist] \
2438            [list $histlist] $w"] -side left
2439    pack [button $w.b.3 -text Quit \
2440            -command "QuitEditProfile $w [list $entrylist]"] -side left
2441    bind $w <Return> "destroy $w"
2442
2443    # force the window to stay on top
2444    putontop $w
2445    focus $w.b.2
2446    tkwait window $w
2447    afterputontop
2448}
2449
2450proc SetEditProfile {entrylist phaselist histlist w} {
2451    global expgui
2452    foreach item $entrylist {
2453        set value [ [lindex $item 1] get ]
2454        if {$value != ""} {
2455            hapinfo $histlist $phaselist [lindex $item 0] set $value
2456            incr expgui(changed)
2457            if $expgui(debug) {
2458                puts "hapinfo [list $phaselist] [list $histlist] [lindex $item 0] set $value"
2459            }
2460        }
2461    }
2462    destroy $w
2463}
2464
2465proc QuitEditProfile {w entrylist} {
2466    global expgui
2467    # lets find out if anything changed
2468    set changed 0
2469    foreach item $entrylist {
2470        if {[ [lindex $item 1] get ] != ""} {set changed 1; break}
2471    }
2472    if $changed {
2473        set decision [tk_dialog .changes "Abandon Changes" \
2474                "You have made changes to the Profile. Ok to abandon changes?" \
2475                warning 0 Abandon Keep]
2476        if !$decision {destroy $w}
2477    } else {
2478        destroy $w
2479    }
2480}
2481
2482##############################################################################
2483##                               #############################################
2484## END OF THE PROCEDURES SECTION #############################################
2485##                               #############################################
2486##############################################################################
2487
2488# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
2489# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<                          <<<<<<<<<<<<<<<<<<<
2490# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<   BEGIN:  GUI SECTION    >>>>>>>>>>>>>>>>>>>
2491# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>                          >>>>>>>>>>>>>>>>>>>
2492# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
2493# A frame for menu items at top of display
2494set expgui(fm) [frame .fm -relief raised -borderwidth 2 -width 150 -height 40]
2495# Pack the menu frame.
2496pack $expgui(fm) -fill x -side top -anchor n
2497
2498# create a button bar
2499pack [frame .bar -relief raised -bd 2 -bg beige] -fill x -side top -anchor n
2500
2501# Creating the notebook with 5 panes: Phase, Histogram, Scaling, Profile
2502# & LS controls
2503# 0 name,
2504# 1 title
2505# 2 create command
2506# 3 raise command
2507# 4 disable page in global mode (0/1)
2508
2509if $expgui(haveBW) {
2510    pack [NoteBook .n -bd 2] -expand yes -fill both
2511    # create an array element describing each notebook page
2512    # element 0 -- pane name
2513    #         1 -- Label on frame
2514    #         2 -- initialization command
2515    #         3 -- update command
2516    #         4 -- 0/1 Use 1 if pane should be disabled in when all histograms
2517    #                are selected in global mode, 0 otherwise
2518    set expgui(notebookpagelist) {
2519        {lsFrame     "LS Controls" \
2520                "" \
2521                SetupExtractHist \
2522                0}
2523        {phaseFrame   Phase        \
2524                "" \
2525                "SelectOnePhase \$expgui(curPhase); DisplayAllAtoms noreset" \
2526                0}
2527        {histFrame    Histogram \
2528                MakeHistPane \
2529                DisplayHistogram \
2530                1}
2531        {fracFrame    Scaling \
2532                MakeScalingPane \
2533                DisplayFrac \
2534                0}
2535        {profFrame    Profile \
2536                MakeProfilePane \
2537                DisplayProfile \
2538                1}
2539        {consFrame    Constraints \
2540                "source [file join $expgui(scriptdir) atomcons.tcl]; MakeConstraintsPane" \
2541                DisplayConstraintsPane \
2542                0}
2543        {orientFrame  "MD Pref Orient" \
2544                MakeOrientPane \
2545                DisplayOrient \
2546                0}
2547        {odfFrame  "SH Pref Orient" \
2548                "source [file join $expgui(scriptdir) odf.tcl]; MakeODFPane" \
2549                DisplayODFPane \
2550                0}
2551    }
2552    foreach item $expgui(notebookpagelist) {
2553        set frm [lindex $item 0]
2554        set expgui($frm) [\
2555            .n insert end $frm -text [lindex $item 1] \
2556            -createcmd [lindex $item 2] \
2557            -raisecmd "set expgui(pagenow) $frm; [lindex $item 3]"]
2558
2559        # at this time expgui(frameactionlist) is generated
2560        # from expgui(notebookpagelist), but in the future it might
2561        # make sense to use expgui(notebookpagelist) directly
2562        lappend expgui(frameactionlist) "$frm [list [lindex $item 3]]"
2563
2564        # panes to disable in global "all" mode
2565        if {[lindex $item 4]} {
2566            lappend expgui(GlobalModeAllDisable) \
2567                    "$frm \{.n itemconfigure $frm\}"
2568        }
2569    }
2570} else {
2571    Notebook:create .n \
2572            -pages {lsFrame phaseFrame histFrame fracFrame profFrame}
2573    pack .n -anchor w -fill both -expand yes
2574    foreach item {lsFrame phaseFrame histFrame fracFrame profFrame \
2575            orientFrame} \
2576            page {"LS Controls" Phase Histogram Scaling Profile \
2577            "MD Pref Orient"} {
2578        set expgui($item) [Notebook:frame .n $item]
2579        Notebook:pageconfig .n $item -command "InitPage $item" -title $page
2580    }
2581    lappend expgui(frameactionlist) "lsFrame SetupExtractHist"
2582    lappend expgui(frameactionlist) "phaseFrame {DisplayAllAtoms noreset}"
2583    lappend expgui(frameactionlist) "histFrame DisplayHistogram"
2584    lappend expgui(frameactionlist) "fracFrame DisplayFrac"
2585    lappend expgui(frameactionlist) "profFrame DisplayProfile"
2586    lappend expgui(frameactionlist) "orientFrame DisplayOrient"
2587    set expgui(GlobalModeAllDisable) {}
2588    lappend expgui(GlobalModeAllDisable) "histFrame {Notebook:pageconfig .n histFrame}"
2589    lappend expgui(GlobalModeAllDisable) "profFrame {Notebook:pageconfig .n profFrame}"
2590}
2591
2592# this is used to bring up the selected frame
2593proc RaisePage {nextpage} {
2594    global expgui
2595    if $expgui(haveBW) {
2596        .n see $nextpage
2597        .n raise $nextpage
2598        set expgui(pagenow) $nextpage
2599    } else {
2600        Notebook:raise .n $nextpage
2601        InitPage $nextpage
2602    }
2603}
2604# this is only called when BWidget is not in use
2605proc InitPage {nextpage} {
2606    global expgui
2607    set expgui(pagenow) $nextpage
2608    UpdateCurrentPage
2609}
2610# resize the notebook to fit all the tabs and the largest page
2611proc ResizeNotebook {} {
2612    global expgui
2613    if {$expgui(haveBW)} {
2614        .n compute_size
2615    } else {
2616        Notebook:resize .n
2617    }
2618}
2619
2620#----------------------------------------------------------------------------
2621proc MakePhasePane {} {
2622    #\/ \/ \/ \/ \/ \/ \/ BEGINNING OF PHASE PANE CODE \/ \/ \/ \/ \/ \/ \/
2623    global expgui
2624    frame $expgui(phaseFrame).top
2625    set frameLatt [frame $expgui(phaseFrame).frameLatt]
2626    #  This is a big frame in the Phase notebook pane to hold atomic data.
2627    set fbig [frame $expgui(phaseFrame).fbig -width 180 \
2628            -relief raised -borderwidth 4 -bg beige]
2629    #  This is a frame just below the big frame: for edits
2630    set frame3 [frame $expgui(phaseFrame).frame3 -width 100 \
2631            -relief raised -borderwidth 4 -bg beige]
2632
2633    grid $expgui(phaseFrame).top -sticky news -row 0 -column 0
2634    grid $frameLatt -sticky news -row 2 -column 0
2635    grid $fbig -sticky news -row 3 -column 0
2636    # give extra space to the atoms box
2637    grid columnconfigure $expgui(phaseFrame) 0 -weight 1
2638    grid rowconfigure $expgui(phaseFrame) 3 -weight 1
2639    grid $frame3 -sticky news -row 4 -column 0
2640    grid columnconfigure $expgui(phaseFrame) 0 -weight 1
2641    grid rowconfigure $expgui(phaseFrame) 3 -weight 1
2642    grid [frame  $expgui(phaseFrame).top.ps] -column 0 -row 0 -sticky w
2643    # this is where the buttons will go
2644    pack [label $expgui(phaseFrame).top.ps.0 -text "No Phases"] -side left
2645   
2646    grid [label $expgui(phaseFrame).top.lA -text "  Phase name:" \
2647            -fg blue ] -column 1 -row 0 -sticky e
2648    grid [entry $expgui(phaseFrame).top.lB -textvariable entryvar(phasename) \
2649            -fg blue -width 45] -column 2 -row 0 -sticky e
2650    grid columnconfigure $expgui(phaseFrame).top 1 -weight 1
2651    # ------------- Lattice Parameter Box ------------------
2652    set row 0
2653    foreach col {2 4 6} var {a b c} lbl {a b c} {
2654        grid [label $frameLatt.l$var -text $lbl] \
2655                -column $col -row $row -padx 5 -sticky e
2656        incr col
2657        grid [entry $frameLatt.e$var -textvariable entryvar($var) -width 10] \
2658            -column $col -row $row -padx 5
2659    }
2660    incr row
2661    foreach col {2 4 6} var {alpha beta gamma} lbl {a b g} {
2662        grid [label $frameLatt.l$var -text $lbl -font symbol] \
2663                -column $col -row $row -padx 5 -sticky e
2664        incr col
2665        grid [entry $frameLatt.e$var -textvariable entryvar($var) -width 10] \
2666            -column $col -row $row -padx 5
2667    }
2668   
2669    grid [label $frameLatt.lr -text "Refine Cell"] -column 8 -row 0 -padx 5 -sticky e
2670    grid [label $frameLatt.ld -text "Cell damping"] -column 8 -row 1 -padx 5 -sticky e
2671    set cFlag [checkbutton $frameLatt.c -text "" -variable entryvar(cellref)]
2672    grid $cFlag -column 9 -row 0 -padx 5 -sticky e
2673    tk_optionMenu $frameLatt.om entryvar(celldamp) 0 1 2 3 4 5 6 7 8 9
2674    grid $frameLatt.om -column 9 -row 1 -padx 5 -sticky e
2675    grid [label $frameLatt.phasetype -textvariable expgui(phasetype) -fg blue] \
2676            -column 1 -row 0 -rowspan 2
2677    if [file executable $expgui(exptool)] {
2678        button $frameLatt.newp -text Add\nPhase -command MakeAddPhaseBox
2679        grid $frameLatt.newp -column 0 -row 0 -rowspan 2 -sticky w
2680    }
2681    grid columnconfig $frameLatt  1 -weight 1
2682    grid columnconfig $frameLatt  0 -weight 1
2683    #-------------- Begin Atom Coordinates Box  ------------------------------
2684    grid [listbox  $fbig.title -height 1 -relief flat \
2685            -exportselection 0 -bg lightgrey -fg black \
2686            -selectforeground black -selectbackground lightgrey] \
2687            -row 0 -column 0 -sticky ew
2688    set expgui(atomtitle) $fbig.title
2689    bind $expgui(atomtitle) <Button-1> {
2690        set i [lsearch {number type mult x y z} $expgui(asorttype)]
2691        incr i
2692        set expgui(asorttype) [lindex {number type mult x y z number} $i]
2693        DisplayAllAtoms
2694    }
2695    bind $expgui(atomtitle) <Button-3> {set expgui(asorttype) number; DisplayAllAtoms}
2696
2697    $expgui(atomtitle) configure -font $expgui(coordfont) -selectmode extended
2698    grid [listbox   $fbig.lbox -height 10 \
2699            -exportselection 0 \
2700            -xscrollcommand " $fbig.bscr set"\
2701            -yscrollcommand " $fbig.rscr set"\
2702            ] -row 1 -column 0 -sticky news
2703    set expgui(atomlistbox) $fbig.lbox
2704    $expgui(atomlistbox) configure -font $expgui(coordfont) -selectmode extended
2705    grid [scrollbar $fbig.bscr -orient horizontal \
2706            -command "move2boxes \" $fbig.title $fbig.lbox \" " \
2707            ] -row 2 -column 0 -sticky ew
2708    grid [scrollbar $fbig.rscr  -command "$fbig.lbox yview" \
2709            ] -row 1 -column 1 -sticky ns
2710    # give extra space to the atoms box
2711    grid columnconfigure $fbig 0 -weight 1
2712    grid rowconfigure $fbig 1 -weight 1
2713   
2714    #   BIND mouse in editbox
2715    bind $expgui(atomlistbox) <ButtonRelease-1>   editRecord
2716    bind $expgui(atomlistbox) <Button-3>   SelectAllAtoms
2717   
2718    #-------------- End Atoms Section  ---------------------------------
2719
2720    # --------------------------- Begin Edit Box ------------------------
2721    grid [set expgui(EditingAtoms) [label $frame3.top -bg beige -fg blue]] \
2722            -column 0 -row 0 -padx 2 -pady 3 -columnspan 10 -sticky w
2723    if [file executable $expgui(exptool)] {
2724        button $frame3.newa -text "Add New Atom" \
2725                -command {MakeAddAtomsBox $expgui(curPhase)}
2726        grid $frame3.newa -column 11 -row 0
2727    }
2728   
2729    set f3l1 [label $frame3.l1 -text "Refinement Flags " -bg beige]
2730    grid $f3l1 -column 0 -row 1 -padx 2 -sticky nsw -pady 3
2731   
2732    set f3cFlag1 [checkbutton $frame3.cf1 -text "X" -variable entryvar(xref) -bg beige]
2733    set f3cFlag2 [checkbutton $frame3.cf2 -text "U" -variable entryvar(uref) -bg beige]
2734    set f3cFlag3 [checkbutton $frame3.cf3 -text "F" -variable entryvar(fref) -bg beige]
2735    grid $f3cFlag1 -column 1 -row 1 -padx 2 -pady 3 -sticky w
2736    grid $f3cFlag2 -column 2 -row 1 -padx 2 -pady 3 -sticky w
2737    grid $f3cFlag3 -column 3 -row 1 -padx 2 -pady 3 -sticky w
2738   
2739    set f3l4 [label $frame3.l4 -text "Damping Factors " -bg beige]
2740    grid $f3l4 -column 4 -row 1 -padx 2 -sticky nsw -pady 3
2741   
2742    tk_optionMenu $frame3.om2 entryvar(xdamp) 0 1 2 3 4 5 6 7 8 9
2743    tk_optionMenu $frame3.om3 entryvar(udamp) 0 1 2 3 4 5 6 7 8 9
2744    tk_optionMenu $frame3.om4 entryvar(fdamp) 0 1 2 3 4 5 6 7 8 9
2745    grid [label $frame3.lom2 -text X -bg beige] -column 5 -row 1 -padx 2 -pady 3 -sticky w
2746    grid $frame3.om2 -column 6 -row 1 -padx 2 -pady 3 -sticky w
2747    grid [label $frame3.lom3 -text U -bg beige] -column 7 -row 1 -padx 2 -pady 3 -sticky w
2748    grid $frame3.om3 -column 8 -row 1 -padx 2 -pady 3 -sticky w
2749    grid [label $frame3.lom4 -text F -bg beige] -column 9 -row 1 -padx 2 -pady 3 -sticky w
2750    grid $frame3.om4 -column 10 -row 1 -padx 2 -pady 3 -sticky w
2751
2752    set expgui(atomreflbl) "$frame3.l1 $frame3.l4 $frame3.lom2 $frame3.lom3 $frame3.lom4 "
2753    set expgui(atomref) "$frame3.cf1 $frame3.cf2 $frame3.cf3 $frame3.om2 $frame3.om3 $frame3.om4"
2754   
2755    set coords [frame $frame3.coords  -width 100 -borderwidth 0  -bg beige]
2756    grid $coords -column 0 -row 6 -columnspan 12 -sticky nsew
2757   
2758    set f3l1 [label $frame3.coords.l1 -text "Label" -bg beige]
2759    set f3e1  [entry  $frame3.coords.e1 -textvariable entryvar(label) -width 6]
2760    set f3l8 [label $frame3.coords.l8 -text "Coordinates" -bg beige]
2761    set f3e8  [entry  $frame3.coords.e8 -textvariable entryvar(x) -width 10]
2762    set f3e9  [entry  $frame3.coords.e9 -textvariable entryvar(y) -width 10]
2763    set f3e10 [entry $frame3.coords.e10 -textvariable entryvar(z) -width 10]
2764    set f3l11 [label $frame3.coords.l11 -text "Occupancy" -bg beige]
2765    set f3e11 [entry $frame3.coords.e11 -textvariable entryvar(frac) -width 10]
2766    set expgui(atomlabels) "$frame3.coords.l1 $frame3.coords.l8 $frame3.coords.l11"
2767    set expgui(atomentry)  "$frame3.coords.e1 $frame3.coords.e8 $frame3.coords.e9 $frame3.coords.e10 $frame3.coords.e11"
2768   
2769    grid $f3l1 -column 0 -row 4 -padx 2 -sticky nsw -pady 3
2770    grid $f3e1 -column 1 -row 4 -padx 2 -sticky nsw -pady 3
2771    grid $f3l8 -column 2 -row 4 -padx 2 -sticky nsw -pady 3
2772    grid $f3e8 -column 3 -row 4 -padx 2 -sticky nsw -pady 3
2773    grid $f3e9 -column 4 -row 4 -padx 2 -sticky nsw -pady 3
2774    grid $f3e10 -column 5 -row 4 -padx 2 -sticky nsw -pady 3
2775    grid $f3l11 -column 6 -row 4 -padx 2 -sticky nsw -pady 3
2776    grid $f3e11 -column 7 -row 4 -padx 2 -sticky nsw -pady 3
2777
2778    set f3f31 [frame $frame3.f3f31  -width 100 -borderwidth 0 -bg beige]
2779    grid $f3f31 -column 0 -row 7 -columnspan 12
2780    set expgui(anisolabels) {}
2781    lappend expgui(anisolabels)  [label $f3f31.l13 -text "Uiso" -bg beige]
2782    lappend expgui(anisolabels)  [label $f3f31.l14 -text "U22" -bg beige]
2783    lappend expgui(anisolabels)  [label $f3f31.l15 -text "U33" -bg beige]
2784    lappend expgui(anisolabels)  [label $f3f31.l16 -text "U12" -bg beige]
2785    lappend expgui(anisolabels)  [label $f3f31.l17 -text "U13" -bg beige]
2786    lappend expgui(anisolabels)  [label $f3f31.l18 -text "U23" -bg beige]
2787
2788    set expgui(anisoentry) {}
2789    lappend expgui(anisoentry) [entry $f3f31.e13 -textvariable entryvar(U11) -width 10]
2790    lappend expgui(anisoentry) [entry $f3f31.e14 -textvariable entryvar(U22) -width 10]
2791    lappend expgui(anisoentry) [entry $f3f31.e15 -textvariable entryvar(U33) -width 10]
2792    lappend expgui(anisoentry) [entry $f3f31.e16 -textvariable entryvar(U12) -width 10]
2793    lappend expgui(anisoentry) [entry $f3f31.e17 -textvariable entryvar(U13) -width 10]
2794    lappend expgui(anisoentry) [entry $f3f31.e18 -textvariable entryvar(U23) -width 10]
2795   
2796    set col 0
2797    foreach item1 $expgui(anisolabels) item2 $expgui(anisoentry) {
2798        grid $item1 -column $col -row 0 -sticky nsw -pady 3
2799        incr col
2800        grid $item2 -column $col -row 0 -sticky nsw -pady 3
2801        incr col
2802    }
2803    # --------------------------- End Edit Box -------------------------
2804   
2805    #/\ /\ /\ /\ /\ /\ /\ END OF PHASE PANE CODE /\ /\ /\ /\ /\ /\ /\ /\ /
2806    # resize in case the pane needs more space
2807    ResizeNotebook
2808}
2809
2810proc move2boxes {boxlist args} {
2811    foreach listbox $boxlist {
2812        eval $listbox xview $args
2813    }
2814}
2815#-----------------------------------------------------------------------------
2816proc MakeHistPane {} {
2817    #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
2818    global expgui
2819   
2820    grid columnconfigure $expgui(histFrame) 0 -weight 1
2821    grid rowconfigure $expgui(histFrame) 1 -weight 1
2822    grid rowconfigure $expgui(histFrame) 2 -weight 1
2823    grid rowconfigure $expgui(histFrame) 3 -weight 1
2824
2825    grid [frame $expgui(histFrame).hs] \
2826            -column 0 -row 0 -rowspan 10 -sticky nsew
2827    MakeHistBox $expgui(histFrame).hs
2828    bind $expgui(histFrame).hs.lbox <ButtonRelease-1>  {
2829        set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
2830        DisplayHistogram
2831    }
2832    bind $expgui(histFrame).hs.lbox <Button-3>  {
2833        if $expgui(globalmode) {
2834            $expgui(histFrame).hs.lbox selection set 0 end
2835            set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
2836            DisplayHistogram
2837        }
2838    }
2839   
2840    frame $expgui(histFrame).top -borderwidth 4 -relief groove
2841    grid [label $expgui(histFrame).top.txt] -row 0 -column 0
2842    if $expgui(haveBW) {
2843        foreach item {backBox diffBox} num {2 3} \
2844                title {Background "Diffractometer Constants"} {
2845            TitleFrame $expgui(histFrame).$item  \
2846                    -borderwidth 4 -side left -relief groove -text $title
2847            set expgui($item) [$expgui(histFrame).$item getframe]
2848            grid $expgui(histFrame).$item -column 1 -row $num -sticky nsew
2849            grid rowconfigure $expgui(histFrame) $num -minsize 100
2850        }
2851    } else {
2852        foreach item {backBox diffBox} num {1 2} \
2853                title {Background "Diffractometer Constants"} {
2854            frame $expgui(histFrame).$item  -borderwidth 4 -relief groove
2855            grid $expgui(histFrame).$item -column 1 -row $num -sticky nsew
2856            set expgui($item)  $expgui(histFrame).$item
2857            grid [label $expgui(histFrame).$item.title -text $title] \
2858                    -row 0 -column 0 -columnspan 10 -sticky nw
2859        }
2860    }
2861    if [file executable $expgui(exptool)] {
2862        button $expgui(histFrame).newh -text "Add New Histogram" -command MakeAddHistBox
2863        grid $expgui(histFrame).newh -column 1 -row 6
2864    }
2865
2866    # BACKGROUND information.
2867    # <<<<<<<<<<<<<<<<<<<<<<<<< BACKGROUND  <<<<<<<<<<<<<<<<<<<<<
2868    grid [frame $expgui(backBox).frm1 ] -row 0 -column 0  -columnspan 11
2869    grid [label $expgui(backBox).frm1.lBGType \
2870            -textvariable expgui(backtypelbl)] \
2871            -row 1 -column 0 -sticky nws  -padx 2 -pady 3
2872    grid [label $expgui(backBox).frm1.lBGTerms \
2873            -textvariable expgui(backtermlbl)] \
2874            -row 1 -column 1 -sticky nws  -padx 2 -pady 3
2875    grid [button $expgui(backBox).frm1.edit -textvariable expgui(bkglbl) \
2876            -command editbackground] \
2877            -row 1 -column 2 -columnspan 3 -sticky w -padx 2 -pady 3
2878    grid [frame $expgui(backBox).frm2 ] \
2879            -row 1 -column 0 -columnspan 11 -sticky e
2880    grid [label $expgui(backBox).frm2.lfBG -text "  Refine background" ] \
2881            -row 2 -column 1 -sticky news -padx 4 -pady 3
2882    grid [checkbutton $expgui(backBox).frm2.rfBG -text "" \
2883            -variable  entryvar(bref) ] \
2884            -row 2 -column 2 -sticky news -padx 4 -pady 3
2885    grid [label $expgui(backBox).frm2.lBGDamp -text Damping ] \
2886            -row 2 -column 3 -sticky w    -padx 2 -pady 3
2887    tk_optionMenu $expgui(backBox).frm2.om  entryvar(bdamp) 0 1 2 3 4 5 6 7 8 9
2888    grid $expgui(backBox).frm2.om \
2889            -row 2 -column 4 -sticky news -padx 4 -pady 3 -sticky e
2890    #^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^END OF HISTOGRAM PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
2891    # insert the histograms & resize in case the pane needs more space
2892    sethistlist
2893    ResizeNotebook
2894}
2895###############################################################################
2896proc MakeScalingPane {} {
2897    #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
2898    global expgui
2899
2900    pack [frame $expgui(fracFrame).hs] -side left -expand y -fill both
2901    MakeHistBox $expgui(fracFrame).hs
2902    bind $expgui(fracFrame).hs.lbox <ButtonRelease-1> {
2903        set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
2904        DisplayFrac
2905    }
2906    bind $expgui(fracFrame).hs.lbox <Button-3>  {
2907        if $expgui(globalmode) {
2908            $expgui(fracFrame).hs.lbox selection set 0 end
2909            set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
2910            DisplayFrac
2911        }
2912    }
2913
2914    pack [frame $expgui(fracFrame).f1] -fill both -expand true
2915    # Create a large canvas area containing a frame for each phase in the data set.
2916    # The canvas and vertical scrollbar are inside a frame called f1
2917    if $expgui(haveBW) {
2918        TitleFrame $expgui(fracFrame).f1.scaleBox \
2919                -borderwidth 4 -text "Scale Factor"
2920        #           -borderwidth 4 -width 600 -height 100 -label "Scale Factor"
2921        grid $expgui(fracFrame).f1.scaleBox -column 0 -row 0 -sticky nsew -columnspan 2
2922        set expgui(scaleBox)  [$expgui(fracFrame).f1.scaleBox getframe]
2923        grid [label $expgui(scaleBox).histSFLabel -text Scale] \
2924                -row 1 -column 0 -sticky nws  -padx 2 -pady 3
2925    } else {
2926        frame $expgui(fracFrame).f1.scaleBox  -borderwidth 4 -relief groove
2927        grid $expgui(fracFrame).f1.scaleBox -column 0 -row 0 -sticky nsew -columnspan 2
2928        set expgui(scaleBox)  $expgui(fracFrame).f1.scaleBox
2929        grid [label $expgui(scaleBox).histSFLabel -text "Scale Factor"] \
2930                -row 1 -column 0 -sticky nws  -padx 2 -pady 3
2931    }
2932    grid [entry $expgui(scaleBox).ent1 -textvariable entryvar(scale) -width 15] \
2933            -row 1 -column 1 -sticky ew -padx 4 -pady 3
2934    button $expgui(scaleBox).but1 -text "Set Globally" \
2935            -command "editglobalparm histinfo scale {Scale Factor}"
2936
2937    grid [label $expgui(scaleBox).histSFRLabel -text " Refine"] \
2938            -row 1 -column 2 -sticky nws  -padx 2 -pady 3
2939    grid [checkbutton $expgui(scaleBox).rf -variable entryvar(sref)] \
2940            -row 1 -column 3 -sticky news -padx 4 -pady 3
2941    grid [label $expgui(scaleBox).lD1 -text "Damping"] \
2942            -row 1 -column 4 -sticky w    -padx 2 -pady 3
2943    tk_optionMenu $expgui(scaleBox).om entryvar(sdamp) 0 1 2 3 4 5 6 7 8 9
2944    grid $expgui(scaleBox).om \
2945            -row 1 -column 5 -sticky news -padx 4 -pady 3
2946    grid columnconfigure $expgui(scaleBox) 6  -weight 1
2947   
2948    if $expgui(haveBW) {
2949        grid [TitleFrame $expgui(fracFrame).f1.phaseFrac -bd 4 \
2950                -text "Phase Fractions" -relief groove] \
2951                -sticky news -row 1 -column 0 -columnspan 2
2952        set PhaseFractBox [$expgui(fracFrame).f1.phaseFrac getframe]
2953    } else {
2954        set PhaseFractBox $expgui(fracFrame).f1
2955    }
2956    grid columnconfigure $expgui(fracFrame).f1 0 -weight 1
2957    grid rowconfigure $expgui(fracFrame).f1 1 -weight 1
2958   
2959    grid [set expgui(FracBox) [canvas $PhaseFractBox.fracBox \
2960            -scrollregion {0 0 5000 500} \
2961            -yscrollcommand "$PhaseFractBox.yscroll set" \
2962            -width 500 -height 350 -bg lightgrey]] \
2963            -sticky  news -row 1 -column 0
2964    grid [scrollbar $PhaseFractBox.yscroll \
2965            -command "$expgui(FracBox) yview" \
2966            -orient vertical] \
2967            -sticky ns -row 1 -column 1
2968    frame $expgui(FracBox).f -bd 0
2969    $expgui(FracBox) create window 0 0 -anchor nw  -window $expgui(FracBox).f
2970
2971    # the rest of the page is created in DisplayFrac
2972
2973    # insert the histograms & resize in case the pane needs more space
2974    sethistlist
2975    ResizeNotebook
2976    # ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF SCALING PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
2977}
2978###############################################################################
2979proc MakeProfilePane {} {
2980    global expgui
2981    # 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
2982    pack [frame $expgui(profFrame).hs] -side left -expand y -fill both
2983    MakeHistBox $expgui(profFrame).hs
2984    bind $expgui(profFrame).hs.lbox <ButtonRelease-1> {
2985        set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
2986        DisplayProfile
2987    }
2988    bind $expgui(profFrame).hs.lbox <Button-3>  {
2989        if $expgui(globalmode) {
2990            $expgui(profFrame).hs.lbox selection set 0 end
2991            set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
2992            DisplayProfile
2993        }
2994    }
2995
2996    # Create a large canvas area containing a frame for each phase in the data set.
2997    # The canvas and vertical scrollbar are inside a frame called f1
2998    pack [frame $expgui(profFrame).f1] -fill both -expand true
2999    grid [set expgui(ProfileBox) [canvas $expgui(profFrame).f1.profileBox \
3000            -scrollregion {0 0 5000 500} -width 500 -height 350 -bg lightgrey]] \
3001            -sticky  news -row 0 -column 0
3002    grid [scrollbar $expgui(profFrame).f1.yscroll -orient vertical] \
3003            -sticky ns -row 0 -column 1
3004   
3005    $expgui(ProfileBox) config -yscrollcommand "$expgui(profFrame).f1.yscroll set"
3006    $expgui(profFrame).f1.yscroll config -command { $expgui(ProfileBox) yview }
3007   
3008    grid columnconfigure $expgui(profFrame).f1 1 -weight 1
3009    grid rowconfigure $expgui(profFrame).f1 0 -weight 1
3010    frame $expgui(ProfileBox).f -bd 0
3011    $expgui(ProfileBox) create window 0 0 -anchor nw  -window $expgui(ProfileBox).f
3012   
3013    # insert the histograms & resize in case the pane needs more space
3014    sethistlist
3015    ResizeNotebook
3016    # ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF PROFILE PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3017}
3018
3019##############################################################################
3020# 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
3021array set printopts {
3022    0 "Print the reciprocal metric tensor changes"
3023    1 "Print the correlation matrix"
3024    2 "Print the Least-Squares matrices and vectors"
3025    4 "Print the linear constraint matrices"
3026    5 "Print the applied  shifts and shift factors"
3027    6 "Print the reciprocal metric tensor Var-Covar terms"
3028    7 "Print all parameters for each cycle"
3029    8 "Print summary shift/esd data after last cycle"
3030    9 "Print zero/unit pole figure constraint terms"
3031}
3032pack [frame $expgui(lsFrame).hs] -side left -expand y -fill both
3033MakeHistBox $expgui(lsFrame).hs
3034bind $expgui(lsFrame).hs.lbox <ButtonRelease-1> {
3035    set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
3036    SetupExtractHist
3037}
3038bind $expgui(lsFrame).hs.lbox <Button-3>  {
3039    if $expgui(globalmode) {
3040        $expgui(lsFrame).hs.lbox selection set 0 end
3041        set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
3042        SetupExtractHist
3043    }
3044}
3045
3046pack [frame $expgui(lsFrame).f1] -fill both -expand true
3047grid rowconfigure $expgui(lsFrame).f1  4 -weight 1
3048set row 0
3049grid [label $expgui(lsFrame).f1.his1 -pady 6 -text "Last History:"] -row $row -column 0
3050grid [label $expgui(lsFrame).f1.his2 -relief raised -bd 2 -pady 6 \
3051        -textvariable expgui(last_History)] \
3052        -row $row -column 1 -columnspan 5 -sticky w
3053incr row
3054grid [label $expgui(lsFrame).f1.tit1 -pady 6 -text "Title:"] -row $row -column 0
3055grid [entry $expgui(lsFrame).f1.tit2 \
3056        -textvariable entryvar(title) -width 48] \
3057        -row $row -column 1 -columnspan 5 -sticky w
3058set entrycmd(title) "expinfo title"
3059
3060incr row
3061grid [frame $expgui(lsFrame).f1.b -bd 4 -relief groove] \
3062        -row $row -column 0 -columnspan 2 -pady 3
3063grid [label $expgui(lsFrame).f1.b.lcyc -text "Number of Cycles"] -row 0 -column 0
3064grid [entry $expgui(lsFrame).f1.b.ecyc -width 3 \
3065        -textvariable entryvar(cycles)] -row 0 -column 1
3066grid [menubutton $expgui(lsFrame).f1.lprint -textvariable expgui(printopt) \
3067        -menu $expgui(lsFrame).f1.lprint.menu -bd 4 -relief raised \
3068        ] -row $row -column 2
3069menu $expgui(lsFrame).f1.lprint.menu
3070foreach num [lsort [array names printopts]] {
3071    $expgui(lsFrame).f1.lprint.menu add checkbutton \
3072            -label "$printopts($num) ([expr int(pow(2,$num))])"\
3073        -variable entryvar(printopt$num)
3074}
3075#grid [frame $expgui(lsFrame).f1.c -bd 4 -relief groove] -row $row -column 3
3076#grid [label $expgui(lsFrame).f1.c.fol -text "Extract Fobs"] -row 0 -column 2
3077#grid [checkbutton $expgui(lsFrame).f1.c.foc -variable entryvar(fobsextract)] -row 0 -column 3
3078incr row
3079if {$expgui(haveBW)} {
3080    grid [TitleFrame $expgui(lsFrame).f1.a -bd 4 -relief groove \
3081            -text "Reflection Intensity Extraction" \
3082            ] -row $row -column 0 -columnspan 6
3083    set expgui(FobsExtractFrame) [$expgui(lsFrame).f1.a getframe]
3084} else {
3085    grid [frame $expgui(lsFrame).f1.a -bd 4 -relief groove \
3086            ] -row $row -column 0 -columnspan 6
3087    set expgui(FobsExtractFrame) $expgui(lsFrame).f1.a
3088}
3089grid rowconfigure $expgui(lsFrame).f1 $row -pad 16
3090grid [frame $expgui(FobsExtractFrame).c -bd 4 -relief groove] \
3091        -row 0 -column 8 -columnspan 3 -sticky e
3092grid [label $expgui(FobsExtractFrame).c.fol -text "Extract Fobs"] \
3093        -row 0 -column 2
3094grid [checkbutton $expgui(FobsExtractFrame).c.foc \
3095        -variable entryvar(fobsextract)] -row 0 -column 3
3096foreach num {1 2 3 4 5 6 7 8 9} {
3097    grid [label $expgui(FobsExtractFrame).l$num -text $num] -row 1 -column $num
3098    grid [radiobutton $expgui(FobsExtractFrame).cc$num \
3099            -command "HistExtractSet $num" \
3100            -variable expgui(Fextract$num) -value 0] \
3101            -row 2 -column $num
3102    grid [radiobutton $expgui(FobsExtractFrame).ca$num \
3103            -command "HistExtractSet $num" \
3104            -variable expgui(Fextract$num) -value 1] \
3105            -row 3 -column $num
3106    grid [radiobutton $expgui(FobsExtractFrame).cb$num \
3107            -command "HistExtractSet $num" \
3108            -variable expgui(Fextract$num) -value 2] \
3109            -row 4 -column $num
3110}
3111set expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).cc
3112lappend expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).ca
3113lappend expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).cb
3114
3115grid [label $expgui(FobsExtractFrame).t \
3116        -text "Extraction\nMethod" -anchor c] \
3117        -column 0 -row 0 -rowspan 2 -sticky s
3118grid [label $expgui(FobsExtractFrame).t0 -text "Phase #" -anchor sw] \
3119        -column 1 -row 0 -columnspan 7 -sticky sw
3120grid [label $expgui(FobsExtractFrame).t1 -text "Rietveld" -anchor c] -column 0 -row 2
3121grid [label $expgui(FobsExtractFrame).t2 -text "F(calc) Weighted" -anchor c] -column 0 -row 3
3122grid [label $expgui(FobsExtractFrame).t3 -text "Equally Weighted" -anchor c] -column 0 -row 4
3123grid [label $expgui(FobsExtractFrame).t2a -text "(Model biased)" -anchor c] -column 10 -row 3
3124grid [label $expgui(FobsExtractFrame).t3a -text "(Le Bail method)" -anchor c] -column 10 -row 4
3125# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF LS PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3126#-------------------------------------------------------------------------
3127#-------------------------------------------------------------------------
3128#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv THE MENU BAR vvvvvvvvvvvvvvvvvvvvvv
3129
3130#---- file menu button
3131menubutton $expgui(fm).file -text File -menu $expgui(fm).file.menu
3132menu $expgui(fm).file.menu
3133if $expgui(debug) {
3134    $expgui(fm).file.menu add command -label "Reset" -command "reset"
3135}
3136if {$tcl_platform(platform) != "macintosh"} {
3137    $expgui(fm).file.menu add command -label "expnam" -command readnewexp
3138}
3139$expgui(fm).file.menu add command -label "Save" -underline 0 \
3140        -command savearchiveexp
3141foreach c {s S} {bind . <Alt-$c> [list savearchiveexp]}
3142$expgui(fm).file.menu add command -label "Save As" \
3143        -command "SaveAsFile"
3144$expgui(fm).file.menu add command -label "Reread .EXP file" \
3145        -command {rereadexp $expgui(expfile)}
3146
3147#---- help menu button
3148menubutton $expgui(fm).help -text Help -menu $expgui(fm).help.menu
3149menu $expgui(fm).help.menu
3150$expgui(fm).help.menu add command -command showhelp -underline 0 \
3151        -label "Help on Command"
3152foreach c {h H} {bind . <Alt-$c> [list showhelp]}
3153$expgui(fm).help.menu add command -label "About..." -command About
3154
3155#---- options menu button
3156menubutton $expgui(fm).option -text Options \
3157        -menu $expgui(fm).option.menu
3158menu $expgui(fm).option.menu
3159
3160if {$tcl_platform(platform) != "macintosh"} {
3161    $expgui(fm).option.menu add checkbutton  -label "Archive EXP" \
3162            -variable expgui(archive)
3163    $expgui(fm).option.menu add checkbutton  -label "Use DISAGL window" \
3164            -variable expgui(disaglSeparateBox)
3165}
3166$expgui(fm).option.menu add cascade -menu  $expgui(fm).option.menu.asort \
3167        -label "Sort atoms by"
3168
3169set expgui(asorttype) number
3170menu $expgui(fm).option.menu.asort
3171foreach opt {number type mult x y z} {
3172    $expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
3173            -label $opt -value $opt -variable expgui(asorttype)
3174}
3175
3176$expgui(fm).option.menu add cascade -menu  $expgui(fm).option.menu.hsort \
3177        -label "Sort histograms by"
3178
3179set expgui(hsorttype) number
3180menu $expgui(fm).option.menu.hsort
3181$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
3182        -label number -value number -variable expgui(hsorttype)
3183$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
3184        -label "Histogram type" -value type -variable expgui(hsorttype)
3185$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
3186        -label "Bank #" -value bank -variable expgui(hsorttype)
3187$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
3188        -label "Angle/Wavelength" -value angle -variable expgui(hsorttype)
3189
3190#---- Global mode menu button
3191$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.editmode \
3192        -label "Multiple hist. selection"
3193menu $expgui(fm).option.menu.editmode
3194$expgui(fm).option.menu.editmode add radiobutton  -label "Off" \
3195        -variable expgui(globalmode) -value 0 \
3196        -command sethistlist
3197$expgui(fm).option.menu.editmode add radiobutton  -label "All" \
3198        -variable expgui(globalmode) -value 6 \
3199        -command sethistlist
3200$expgui(fm).option.menu.editmode add radiobutton  -label "TOF" \
3201        -variable expgui(globalmode) -value 1 \
3202        -command sethistlist
3203$expgui(fm).option.menu.editmode add radiobutton  -label "CW Neutron" \
3204        -variable expgui(globalmode) -value 2  \
3205        -command sethistlist
3206$expgui(fm).option.menu.editmode add radiobutton  -label "Alpha12 Xray" \
3207        -variable expgui(globalmode) -value 3 \
3208        -command sethistlist
3209$expgui(fm).option.menu.editmode add radiobutton  -label "Monochromatic Xray" \
3210        -variable expgui(globalmode) -value 4 \
3211        -command sethistlist
3212$expgui(fm).option.menu.editmode add radiobutton  -label "Energy Disp Xray" \
3213        -variable expgui(globalmode) -value 5 \
3214        -command sethistlist
3215$expgui(fm).option.menu.editmode add separator
3216$expgui(fm).option.menu.editmode add checkbutton \
3217        -label "Group phases together" \
3218        -variable expgui(globalphasemode) \
3219        -command sethistlist
3220
3221set expgui(globalmode) 0
3222set expgui(globalphasemode) 1
3223
3224if {$tcl_platform(platform) == "unix"} {
3225    $expgui(fm).option.menu  add checkbutton -label "Override backspace" \
3226            -variable env(GSASBACKSPACE)
3227    $expgui(fm).option.menu  add checkbutton -label "Autoload EXP" \
3228            -variable expgui(autoexpload)
3229}
3230
3231$expgui(fm).option.menu add command -label "Save Options" \
3232        -command "SaveOptions"
3233
3234pack $expgui(fm).file $expgui(fm).option -side left  -in $expgui(fm)
3235
3236if {$tcl_platform(platform) != "macintosh"} {
3237    foreach menu $expgui(menunames) {
3238        set m [string tolower $menu]
3239        pack [menubutton $expgui(fm).$m -text $menu \
3240                -menu $expgui(fm).$m.menu] -side left
3241        menu $expgui(fm).$m.menu
3242    }
3243}
3244pack $expgui(fm).help  -side right -in $expgui(fm)
3245
3246if {$tcl_platform(platform) != "macintosh"} {
3247    # add the commands in expgui_menulist
3248    foreach menu [array names expgui_menulist ] {
3249        foreach cmd $expgui_menulist($menu) {
3250            set action {}
3251            set opt {}
3252            catch {set action [lindex $expgui_cmdlist($cmd) 0]}
3253            catch {set opt [lindex $expgui_cmdlist($cmd) 2]}
3254            if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
3255            if {$action != "" && $action != "-"} {
3256                eval $expgui(fm).$menu.menu add command \
3257                        -label $cmd $opt -command [list [subst $action]]
3258                if {[lindex $opt 0] == "-underline"} {
3259                    catch {
3260                        set num [lindex $opt 1]
3261                        set key [string range $cmd $num $num]
3262                        bind . <Alt-[string tolower $key]> [subst $action]
3263                        bind . <Alt-[string toupper $key]> [subst $action]
3264                    }
3265                }
3266            }
3267        }
3268    }
3269}
3270# setup command help
3271foreach cmd [array names expgui_cmdlist] {
3272    set help {}
3273    catch {set help [lindex $expgui_cmdlist($cmd) 1]}
3274    if {$help == ""} {
3275        if {$expgui(debug)} {puts "no help for $cmd"}
3276    } else {
3277        # remove
3278        regsub -all \x09 $help " " help
3279        # preserve blank lines
3280        regsub -all \x0A\x0A $help "AAA1234567890AAA" help
3281        regsub -all \x0A $help " " help
3282        regsub -all "AAA1234567890AAA" $help \x0A\x0A help
3283        regsub -all " +" $help " " help
3284        set expgui_helplist($cmd) [string trim $help]
3285    }
3286}
3287if {$tcl_platform(platform) != "macintosh"} {
3288    # set up button bar
3289    foreach cmd $expgui(buttonlist) {
3290        set action {}
3291        catch {set action [lindex $expgui_cmdlist($cmd) 0]}
3292        if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
3293        if {$action != ""} {
3294            pack [eval button .bar.$cmd -bg beige -activebackground yellow \
3295                    -text $cmd -command [list [subst $action]]] -side left
3296        }
3297    }
3298}
3299
3300$expgui(fm).file.menu add command -label "Exit"  -underline 1 -command catchQuit
3301foreach c {X x} {bind . <Alt-$c> [list catchQuit]}
3302#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF MENU DEFINITION ^^^^^^^^^^^^^^^^^^^
3303
3304# make the phase pane
3305MakePhasePane
3306# and the rest of the windows w/o BWidget
3307if !$expgui(haveBW) {
3308    MakeHistPane
3309    MakeScalingPane
3310    MakeProfilePane
3311}
3312
3313# handle indirect exits
3314wm protocol . WM_DELETE_WINDOW catchQuit
3315bind . <Control-c> catchQuit
3316
3317set expgui(curPhase) ""
3318set expgui(pagenow) ""
3319set expgui(curhist) {}
3320set expgui(selectedatomlist) {}
3321
3322loadexp $expgui(expfile)
3323
3324# select the 1st phase
3325SelectOnePhase [lindex $expmap(phaselist) 0]
3326# select the first histogram in the list by default (if there are any)
3327if {[llength $expmap(histlistboxcontents)] > 0} {
3328    set expgui(curhist) 0
3329} else {
3330    set expgui(curhist) {}
3331}
3332
3333# execute any local commands for final initialization
3334eval $expgui(initstring)
3335
3336# resize the notebook to fit all the tabs and the largest page
3337ResizeNotebook
3338
3339RaisePage lsFrame
3340if {[CountHistory] > 100} {
3341    DeleteHistoryRecords "This .EXP file has [CountHistory] history records\nErasing most will speed EXPGUI"
3342}
Note: See TracBrowser for help on using the repository browser.