Context Navigation

source: trunk/expgui @ 883

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

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

Download in other formats: