source: branches/sandbox/expgui @ 1100

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

fix bug on replace atoms; clean up loading/creation of exp files; add revert menu command; initial draft of rigid body support

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