Context Navigation

source: trunk/expgui @ 670

Last change on this file since 670 was 670, checked in by toby, 14 years ago
# on 2003/04/10 22:03:45, toby did: change header autostart GRWND option for Win-95/98/ME warnings to run POWPREF read customization from gsas.config as well as .gsas_config (no doc yet) warn on directories with spaces insert date in gsas.config & .gsas_config (use gsas.config on Win) move a,b,c... to separate menu
Property rcs:author set to `toby` Property rcs:date set to `2003/04/10 22:03:45` Property rcs:lines set to `+238 -25` Property rcs:rev set to `1.60` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 147.4 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: