source: trunk/expgui @ 234

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

# on 2000/07/06 22:43:40, toby did:
Change profile term labeling to use GetProfileTerms?
use file copy for archive (unix)
put site multiplity on atoms page
implement MakeHistBox? for histogram selection boxes
Add a heading for global mode to the histogram selection box
Implement changing profile type
add binding to select all atoms
click on atom box title rotates through atom sorting modes
new atom sort mode: mult

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