Context Navigation

source: trunk/expgui @ 746

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

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

Download in other formats: