source: trunk/expgui @ 997

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

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

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