source: trunk/expgui @ 801

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

# on 2004/09/20 15:28:29, toby did:
add "package require Tk" for starkit use

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