source: branches/sandbox/expgui @ 1104

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

for new .EXP files, bring users to the histogram or phase panels, as appropriate

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