Context Navigation

source: trunk/expgui @ 763

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

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

Download in other formats: