source: trunk/expgui @ 152

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

# on 2000/05/18 15:58:18, toby did:
Add constraints support
move to 1st page before loading a new .EXP file in readnewexp
hange from grid/pack slaves to winfo children

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