source: trunk/expgui @ 238

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

# on 2000/07/20 22:13:40, toby did:
use file join on notebook.tcl
move source atomcons.tcl to be done when pane is initialized
create UpdateCurrentPage? to update all displayed panes
put UpdateCurrentPage? into sethistlist; atoms are now updated after a reload
use array element for notebook panes [expgui(notebookpagelist)]

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