source: trunk/expgui @ 996

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

Many revisions for handling file names with spaces using new SetEXPfile proc.
Use of directories with spaces for data files is probably not a problem, since we cd there, but EXP file names and install locations can be messy. Convert names on windows, where possible, and warn for now.

fix DISAGL window buttons for files with spaces.

cleanup MakeScrollTable?

allow ~/.gsas_config on Windows.

for use update.bat instead of building file as needed;

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