source: trunk/expgui @ 303

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

# on 2000/10/03 23:29:29, toby did:
Add definitions and implementation for entrybox array so that invalid
numbers are set to red. Valid ones, or when numbers are reread from
the .EXP are turned back to black

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