source: trunk/expgui @ 997

Last change on this file since 997 was 997, checked in by toby, 10 years ago

fix awful bug introduced with prev. code rearangement that should not have been checked in; add ability to read archived files from command line; Add routines to read and write soft constrain records

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