Context Navigation

source: trunk/expgui @ 306

Last change on this file since 306 was 306, checked in by toby, 13 years ago

# on 2000/10/04 20:35:17, toby did:
variable expgui(bkgcolor1) provides the background color for editing
coordinates on the phase panel

A no-shell mode is now defined using env(EXPGUI_NOSHELL) or /noshell

Property rcs:author set to toby
Property rcs:date set to 2000/10/04 20:35:17
Property rcs:lines set to +72 -53
Property rcs:rev set to 1.36
Property rcs:state set to Exp
Property svn:keywords set to Author Date Revision Id

File size: 117.3 KB

Line
1	#!/usr/local/bin/wish
2	# $Id: expgui 306 2009-12-04 23:03:51Z toby $
3	set expgui(Revision) {$Revision: 306 $ $Date: 2009-12-04 23:03:51 +0000 (Fri, 04 Dec 2009) $}
4
5	# to do:
6	#
7	# need to change heading and button label depending on where getExpFileName
8	# is called from?
9	#
10	# global background editing & profile work differently: should both
11	# start out blank with a "load from option"?
12	#
13	# idea:
14	# a scroll list for all histogram refinement flags ; click on takes you to the
15	# appropriate menu.
16	#
17	# idea:
18	# change cell parameters to labels and have a edit cell button
19	# that enforces metric symmetry
20	#
21	# to allow "global" access on phase page
22	# change buttons from radio to multiple
23	# -- or display all 9 cell flag/damps and all atoms
24	# make editMultipleRecords work with multiple phases, also cell flag/damp
25	# blank cell entries
26	# add phase to atom number in listing
27	# DisplayAllAtoms needs to loop over phases: expgui(curPhase)
28	#
29	# idea: load more than one bank from a multi-bank .RAW file
30	#
31	if {$tcl_version < 8.0} {
32	tk_dialog .expFileErrorMsg "Version Error" \
33	"The program requires Tcl/Tk version 8.0 or higher" error 0 "Exit"
34	exit
35	}
36
37	# the shell variable tells expgui to act as a shell for GSAS
38	# as well as edit the EXP file. In no-shell mode, it can
39	# only be used to edit the .EXP file as a callable program
40	set expgui(shell) 1
41	catch {if $env(EXPGUI_NOSHELL) {set expgui(shell) 0}}
42
43	if {$argv != ""} {
44	if {[string match noshell [string tolower $argv]]} {
45	puts noshell
46	set expgui(shell) 0
47	set expgui(expfile) [lindex $argv 1]
48	} else {
49	set expgui(expfile) [lindex $argv 0]
50	}
51	if {[string toupper [file extension $expgui(expfile)]] != ".EXP"} {
52	append expgui(expfile) ".EXP"
53	}
54	} else {
55	set expgui(expfile) {}
56	}
57
58	set expgui(curhist) {}
59	set expmap(powderlist) {}
60	set expgui(bkgcolor1) #fdf
61
62	set expgui(debug) 0
63	catch {if $env(DEBUG) {set expgui(debug) 1}}
64	#set expgui(debug) 1
65
66	# default for archive mode = on
67	set expgui(archive) 1
68	# default for autoexec load = off
69	set expgui(autoexpload) 0
70	# save the name of the wish executable
71	set wishshell [info nameofexecutable]
72	# misc constants
73	set txtvw(font) "Courier"
74	set expgui(coordfont) "--courier-bold-r-normal--12-"
75	set expgui(histfont) "--courier-bold-r-normal--12-"
76	set liveplot(hst) 1
77	set liveplot(legend) 1
78	set expgui(filesort) 1
79	set expgui(initstring) {}
80	# use a separate window for DISAGL (default)
81	set expgui(disaglSeparateBox) 1
82	set expgui(DefaultPeakType) 0
83	# default: keep current atoms when replacing a phase
84	set expgui(DeleteAllAtoms) 0
85	#=============================================================================
86	#----------------------------------------------------------------
87	# where are we?
88	set expgui(script) [info script]
89	# translate links -- go six levels deep
90	foreach i {1 2 3 4 5 6} {
91	if {[file type $expgui(script)] == "link"} {
92	set link [file readlink $expgui(script)]
93	if { [file pathtype $link] == "absolute" } {
94	set expgui(script) $link
95	} {
96	set expgui(script) [file dirname $expgui(script)]/$link
97	}
98	} else {
99	break
100	}
101	}
102	# fixup relative paths
103	if {[file pathtype $expgui(script)] == "relative"} {
104	set expgui(script) [file join [pwd] $expgui(script)]
105	}
106	set expgui(scriptdir) [file dirname $expgui(script) ]
107	set expgui(gsasdir) [file dirname $expgui(scriptdir)]
108	set expgui(gsasexe) [file join $expgui(gsasdir) exe]
109	#----------------------------------------------------------------
110	lappend auto_path $expgui(scriptdir)
111	set expgui(havetix) 0
112	set expgui(haveBW) 1
113	# for debugging non-BWidget version set environment variable NOBWIDGET
114	catch {if $env(NOBWIDGET) {set expgui(haveBW) 0}}
115	if $expgui(haveBW) {
116	if [catch {package require BWidget}] {set expgui(haveBW) 0}
117	}
118	# get the notebook widget if not using BWidgets
119	if {!$expgui(haveBW)} {source [file join $expgui(scriptdir) notebook.tcl]}
120	#----------------------------------------------------------------
121	if [file exists [file join $expgui(scriptdir) opts.tcl]] {
122	source [file join $expgui(scriptdir) opts.tcl]
123	}
124	# fetch EXP file processing routines
125	source [file join $expgui(scriptdir) readexp.tcl]
126	# commands for running GSAS programs
127	source [file join $expgui(scriptdir) gsascmds.tcl]
128	# contents of GSAS menus
129	source [file join $expgui(scriptdir) gsasmenu.tcl]
130	# commands for adding phases, histograms & atoms
131	source [file join $expgui(scriptdir) addcmds.tcl]
132	# commands for preferred orientation
133	source [file join $expgui(scriptdir) orient.tcl]
134	#---------------------------------------------------------------------------
135	# override options with locally defined values
136	if [file exists [file join $expgui(scriptdir) localconfig]] {
137	source [file join $expgui(scriptdir) localconfig]
138	}
139	if [file exists [file join ~ .gsas_config]] {
140	source [file join ~ .gsas_config]
141	}
142	if {$tcl_platform(platform) == "windows"} {
143	set expgui(exptool) [file join $expgui(gsasexe) exptool.exe]
144	} else {
145	set expgui(exptool) [file join $expgui(gsasexe) exptool]
146	}
147	#---------------------------------------------------------------------------
148	if {$expgui(expfile) != ""} {
149	if ![file exists $expgui(expfile)] {
150	update
151	set ans [tk_dialog .expFileErrorMsg "File Open Error" \
152	"File [file tail $expgui(expfile)] does not exist in [file dirname $expgui(expfile)]" \
153	error 0 "Create" "Open other"]
154	if $ans {set expgui(expfile) {}}
155	}
156	}
157	if {$expgui(expfile) == ""} {
158	# center the parent window because the getExpFileName window
159	# will be centered above it.
160	wm withdraw .
161	set x [expr [winfo screenwidth .]/2 - [winfo reqwidth .]/2 ]
162	set y [expr [winfo screenheight .]/2 - [winfo reqheight .]/2]
163	wm geom . +$x+$y
164	wm deiconify .
165	# windows needed this update before when using tk_getOpenFile.
166	# I am not sure it is still needed.
167	update
168	#
169	set expgui(expfile) [getExpFileName old]
170	}
171	if {$expgui(expfile) == ""} exit
172	# you've been warned this .EXP does not exist!
173	if ![file exists $expgui(expfile)] {
174	# create an "empty" exp file
175	createexp $expgui(expfile) \
176	[getstring "title for experiment $expgui(expfile)" 60 0]
177	}
178	catch {cd [string trim [file dirname $expgui(expfile)]]}
179
180	#
181	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
182	# <<<<<<<<<< BEGINNING OF MAIN: GLOBAL AREA FOR DATA EXTRACTION >>>>>>>>>>>
183	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
184	# load exp file and set up dialogs
185	proc loadexp {expfile} {
186	global expgui expmap entryvar entrycmd tcl_platform
187	set exploadtime [time {set fmt [expload $expfile]}]
188	if $expgui(debug) {puts "expload $exploadtime"}
189	# if the file was not in the correct format, force a rewrite before use
190	if {$fmt < 0} {
191	# read error
192	return
193	} elseif {$fmt == 0 && $tcl_platform(platform) == "windows"} {
194	set expgui(changed) 1
195	} elseif {$fmt == 1 && $tcl_platform(platform) == "unix"} {
196	set expgui(changed) 1
197	} else {
198	set expgui(changed) 0
199	}
200
201	# force exp files to be upper case, force save if name changes
202	set filetail [file tail $expfile]
203	set filetailcaps [string toupper $filetail]
204	if {$tcl_platform(platform) == "unix" && $filetail != $filetailcaps} {
205	set expgui(changed) 1
206	}
207	if {[file dirname $expfile] == "."} {
208	set expgui(expfile) $filetailcaps
209	} else {
210	set expgui(expfile) [file join \
211	[file dirname $expfile] $filetailcaps]
212	}
213
214	mapexp
215	set expgui(expModifiedLast) 0
216	catch {
217	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
218	}
219	set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
220	# set the window/icon title
221	wm title . "EXPGUI $expfile"
222	set expgui(titleunchanged) 1
223	wm iconname . [file tail $expfile]
224
225	# set the number of phases on the phase page
226	setphases
227
228	# disable the "global options" that don't make sense based on
229	# which histograms present
230	foreach num {1 2 3 4 5} {
231	set flag($num) 0
232	}
233	# save a list of the allowed modes, too
234	set expgui(AllowedHistSelectModes) {0 6}
235	foreach h $expmap(powderlist) {
236	if {[string range $expmap(htype_$h) 2 2] == "T"} {set flag(1) 1}
237	if {[string range $expmap(htype_$h) 1 2] == "NC"} {set flag(2) 1}
238	if {[string range $expmap(htype_$h) 1 2] == "XC" && \
239	[histinfo $h lam2] != 0.0} {set flag(3) 1}
240	if {[string range $expmap(htype_$h) 1 2] == "XC" && \
241	[histinfo $h lam2] == 0.0} {set flag(4) 1}
242	if {[string range $expmap(htype_$h) 1 2] == "XE"} {set flag(5) 1}
243	}
244	foreach num {1 2 3 4 5} \
245	lbl {TOF "CW Neutron" "Alpha12 Xray" "Monochromatic Xray" \
246	"Energy Disp Xray"} {
247	if $flag($num) {
248	$expgui(fm).option.menu.editmode entryconfigure $lbl -state normal
249	lappend expgui(AllowedHistSelectModes) $num
250	} else {
251	$expgui(fm).option.menu.editmode entryconfigure $lbl -state disabled
252	}
253	}
254	# disable traces on entryvar until we are ready
255	set entrycmd(trace) 0
256	trace vdelete entryvar w entvartrace
257
258	# propogate changes on the least squares page
259	set entryvar(cycles) [expinfo cycles]
260	set entrycmd(cycles) "expinfo cycles"
261	# set expgui(globalmode) 0
262	set expgui(printopt) "Print Options ([expinfo print])"
263	set entryvar(title) [expinfo title]
264	global printopts
265	foreach num [array names printopts] {
266	set entrycmd(printopt$num) "printsetting $num"
267	set entryvar(printopt$num) [printsetting $num]
268	}
269	# enable traces on entryvar
270	set entrycmd(trace) 1
271	trace variable entryvar w entvartrace
272
273	# set fo extraction on LS page
274	SetupExtractHist
275
276	# update the histogram list & update the page
277	sethistlist
278
279	# start checking for external changes
280	afterawhile
281	}
282
283	# called to reread the .EXP file
284	proc rereadexp {expfile} {
285	global expgui
286	if $expgui(changed) {
287	set decision [tk_dialog .instrSaveData {Save .EXP changes} \
288	{You have made changes to the Experiment. Rereading will cause the changes to be lost. Select an option:} \
289	{} 0 "Save and reread" "Reread without Save" "Cancel reread command"]
290	switch $decision {
291	0 { savearchiveexp }
292	1 { }
293	2 { return }
294	}
295	}
296	loadexp $expgui(expfile)
297	}
298
299	proc SaveAsFile {} {
300	global expgui
301	set newexpfile [getExpFileName new]
302	if {$newexpfile == ""} return
303	expwrite $newexpfile
304	set expgui(expfile) $newexpfile
305	catch {cd [string trim [file dirname $expgui(expfile)]]}
306	set expgui(changed) 0
307	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
308	set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
309	# set the window/icon title
310	wm title . $expgui(expfile)
311	set expgui(titleunchanged) 1
312	wm iconname . [file tail $expgui(expfile)]
313	}
314
315	# called to read a different .EXP file
316	proc readnewexp {} {
317	global expgui expmap
318	if $expgui(changed) {
319	set decision [tk_dialog .instrSaveData {Save .EXP changes} \
320	{You have made changes to the Experiment. Reading a different file will cause the changes to be lost. Select an option:} \
321	{} 0 "Save and read" "Read without Save" "Cancel read command"]
322	switch $decision {
323	0 { savearchiveexp }
324	1 { }
325	2 { return }
326	}
327	}
328	set newexpfile [getExpFileName old]
329	if {$newexpfile == ""} return
330
331	# switch to the 1st page
332	RaisePage lsFrame
333
334	if ![file exists $newexpfile] {
335	# you've been warned this .EXP does not exist!
336	# create an "empty" exp file
337	createexp $newexpfile \
338	[getstring "title for experiment $newexpfile" 60 0]
339	}
340	set expgui(expfile) $newexpfile
341	catch {cd [string trim [file dirname $expgui(expfile)]]}
342	set expgui(globalmode) 0
343	loadexp $expgui(expfile)
344
345	# select the 1st phase
346	SelectOnePhase [lindex $expmap(phaselist) 0]
347	# select the first histogram in the list by default (if there are any)
348	if {[llength $expmap(histlistboxcontents)] > 0} {
349	set expgui(curhist) 0
350	} else {
351	set expgui(curhist) {}
352	}
353	if {[CountHistory] > 100} {
354	DeleteHistoryRecords "This .EXP file has [CountHistory] history records\nErasing most will speed EXPGUI"
355	}
356	}
357
358	#------------- set up data read/write layer ----------------------
359	# trace routine on entryvar
360	proc entvartrace {array elem action} {
361	global expgui entrycmd entryvar entrybox
362	if !$entrycmd(trace) return
363
364	catch {
365	if {$entrycmd($elem) == ""} return
366	incr expgui(changed)
367	if $expgui(debug) {puts "$entrycmd($elem) set $entryvar($elem) "}
368	if {$entrycmd($elem) == ""} return
369	if [catch {
370	set result [eval $entrycmd($elem) set [list $entryvar($elem)]]
371	if {!$result} {
372	if $expgui(debug) {puts "error with $entrycmd($elem)"}
373	catch {$entrybox($elem) config -fg red}
374	} else {
375	catch {$entrybox($elem) config -fg black}
376	}
377	if {[lindex $entrycmd($elem) 0] == "atominfo"} {
378	after idle {DisplayAllAtoms noreset}
379	}
380	} errmsg] {error $errmsg}
381	}
382	}
383
384	# disable traces on entryvar until we are ready
385	set entrycmd(trace) 0
386	trace variable entryvar w entvartrace
387
388	#
389	#
390	#
391	##############################################################################
392	##### #####################################################
393	##### PROCEDURES SECTION #####################################################
394	##### #####################################################
395	##############################################################################
396
397	# save some of the global options in ~/.gsas_config
398	proc SaveOptions {} {
399	global expgui env tcl_platform
400	set fp [open [file join ~ .gsas_config] a]
401	foreach item {archive asorttype hsorttype filesort disaglSeparateBox} {
402	puts $fp "set expgui($item) $expgui($item)"
403	}
404	if {$tcl_platform(platform) != "windows"} {
405	puts $fp "set env(GSASBACKSPACE) $env(GSASBACKSPACE)"
406	puts $fp "set expgui(autoexpload) $expgui(autoexpload)"
407	}
408	close $fp
409	}
410
411	proc About { } {
412	global expgui expmap
413	tk_dialog .about {About...} \
414	"EXPGUI\n\
415	Jonathan Wasserman and Brian Toby\n\
416	NIST Center for Neutron Research\n\n\
417	2000, Not subject to copyright\n\n\
418	Revision [lindex $expgui(Revision) 1] (readexp.tcl [lindex $expmap(Revision) 1])\n\n\
419	Generalized Structure Analysis System (GSAS)\n\
420	A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
421	" \
422	info 0 OK
423	}
424
425	# wait until idle
426	proc afterawhile {} {
427	# cancel any other instances of this loop
428	after cancel afterawhile
429	after cancel whenidle
430	after cancel whenidle
431	after idle whenidle
432	}
433
434	# This is called every 2 seconds to check for changes to the .EXP file
435	proc whenidle {} {
436	global expgui
437	if $expgui(titleunchanged) {
438	if {$expgui(changed) != 0} {
439	wm title . "$expgui(expfile) (modified)"
440	set expgui(titleunchanged) 0
441	}
442	}
443	if {$expgui(expModifiedLast) == 0} {
444	after 2000 afterawhile
445	return
446	}
447	if {[file mtime $expgui(expfile)] != $expgui(expModifiedLast)} {
448	set ans [ReloadExpMsg [file tail $expgui(expfile)] $expgui(changed)]
449	if {$ans == 0} {
450	loadexp $expgui(expfile)
451	} elseif {$ans == 1} {
452	# reset the time to the next version
453	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
454	} elseif {$ans == 2} {
455	savearchiveexp
456	}
457	}
458	after 2000 afterawhile
459	}
460
461	# place a message about changes over the main window
462	proc ReloadExpMsg {file changes} {
463	global expgui tcl_platform
464	set msg "File $file has been modified by another program"
465	if {$changes == 1} {
466	append msg " and you have made a change to this version.\n"
467	} elseif {$changes > 0} {
468	append msg " and you have made $changes changes to this version.\n"
469	} else {
470	append msg ".\n"
471	}
472	append msg "Do you want to use the newer (modified) version or continue with the older (previous) version of the file?"
473
474	set w .ask
475	catch {destroy $w}
476	toplevel $w -class Dialog
477	wm title $w "Reload?"
478	wm iconname $w "Reload?"
479	wm protocol $w WM_DELETE_WINDOW { }
480	wm transient $w .
481	frame $w.bot
482	pack $w.bot -side bottom
483	frame $w.top
484	pack $w.top -side top -fill both -expand 1
485	label $w.top.msg -justify left \
486	-wraplength 5i -font {Times 18} \
487	-text $msg
488	if {$tcl_platform(platform) == "windows"} {
489	$w.top.msg config -font {Times 14}
490	}
491	pack $w.top.msg -side right -expand 1 -fill both -padx 3m -pady 3m
492	pack [button $w.bot.1 -text "Load new" \
493	-default active -command "set expgui(dialogbutton) 0" \
494	] -side left -expand 1 -padx 3m -pady 2m
495	pack [button $w.bot.2 -text "Continue with old" \
496	-command "set expgui(dialogbutton) 1"] \
497	-side left -expand 1 -padx 3m -pady 2m
498	if {$changes > 0} {
499	pack [button $w.bot.3 -text "Save edited version" \
500	-command "set expgui(dialogbutton) 2"] \
501	-side left -expand 1 -padx 3m -pady 2m
502	}
503	# Create a binding for <Return> on the dialog
504	bind $w <Return> "tkButtonInvoke $w.bot.1"
505	wm withdraw $w
506	update idletasks
507
508	# for windows put the box in the upper left, for
509	# unix center it over the parent (in unix it appears later)
510	#if {$tcl_platform(platform) == "windows"} {
511	#wm geom $w +0+0
512	#} else {
513
514	# for now, always center the message over the main window
515	# center the new window in the middle of the parent
516	set x [expr [winfo x .] + [winfo width .]/2 - \
517	[winfo reqwidth $w]/2 - [winfo vrootx .]]
518	set y [expr [winfo y .] + [winfo height .]/2 - \
519	[winfo reqheight $w]/2 - [winfo vrooty .]]
520	wm geom $w +$x+$y
521	#}
522	wm deiconify $w
523
524	# Grab the focus
525	set oldFocus [focus]
526	set oldGrab [grab current $w]
527	if {[string compare $oldGrab ""]} {
528	set grabStatus [grab status $oldGrab]
529	}
530	grab $w
531	focus $w.bot.1
532	# for windows rearrange window stacking
533	if {$tcl_platform(platform) == "windows"} {
534	lower .
535	raise $w .
536	}
537	update idletasks
538
539	tkwait variable expgui(dialogbutton)
540	catch {focus $oldFocus}
541	destroy $w
542	if {[string compare $oldGrab ""]} {
543	if {![string compare $grabStatus "global"]} {
544	grab -global $oldGrab
545	} else {
546	grab $oldGrab
547	}
548	}
549	# for windows rearrange window stacking
550	if {$tcl_platform(platform) == "windows"} {
551	raise .
552	}
553	return $expgui(dialogbutton)
554	}
555
556	# -------- called to confirm before exiting
557	proc catchQuit {} {
558	if {[confirmBeforeSave] == "Continue"} {
559	destroy .
560	}
561	}
562	# save the .EXP file before exiting?
563	proc confirmBeforeSave {} {
564	global expgui
565	if !$expgui(changed) {
566	return "Continue"
567	}
568	set decision [tk_dialog .instrSaveData {Save .EXP changes} \
569	{You have made changes to the Experiment, but the changes are not saved. Select an option:} \
570	{} 0 "Save and Exit" "Exit without Save" "Cancel exit command"]
571	switch $decision {
572	0 { savearchiveexp; return "Continue" }
573	1 { return "Continue" }
574	2 { return "Cancel" }
575	}
576	}
577
578	proc archiveexp {} {
579	global expgui tcl_platform
580	# is there a file to archive
581	if {![file exists $expgui(expfile)]} return
582	catch {
583	set expnam [file rootname $expgui(expfile)]
584	if {$tcl_platform(platform) == "windows"} {
585	set version -1
586	catch {source $expnam.version}
587	incr version
588	if ![file executable [file join $expgui(scriptdir) pkzip.exe]] {
589	# archive w/o pkzip
590	set file $expnam![format "%3.3d" $version].EXP
591	file copy -force $expnam.EXP $file
592	set fp [open $expnam.lst a]
593	puts $fp "\n--------------------------------------------------------------"
594	puts $fp "Archiving $expnam.EXP as $file"
595	puts $fp "--------------------------------------------------------------\n"
596	close $fp
597	} else {
598	# archive with PKZIP
599	# need to limit expnam to 8 characters
600	set sexp [string toupper [string range [file root [file tail $expnam] ] 0 7]]
601	# PKZIP can't handle long dir names either
602	cd [set dir [file dirname $expnam]]
603	set file $sexp.[format "%3.3d" $version]
604	file copy -force $expnam.EXP $file
605	exec [file join $expgui(scriptdir) pkzip.exe] -m $sexp $file > zip.out &
606	set fp [open $expnam.lst a]
607	puts $fp "\n--------------------------------------------------------------"
608	puts $fp "Archiving $expnam.EXP as $file in [file join $dir $sexp.ZIP]"
609	puts $fp "--------------------------------------------------------------\n"
610	close $fp
611	}
612	set fp [open $expnam.version w]
613	puts $fp "set version $version"
614	close $fp
615	} else {
616	set files [glob -nocomplain $expnam.EXP.*]
617	if {$files == ""} {
618	set file $expnam.EXP.000
619	} else {
620	set file [lindex [lsort -decreasing $files] 0]
621	regexp {.\.EXP.0?0?([0-9]).*} $file junk number
622	incr number
623	set file $expnam.EXP.[format "%3.3d" $number]
624	}
625	file copy $expgui(expfile) $file
626	if [catch {exec gzip $file}] {
627	exec echo "\n----------------------------------------------" >> $expnam.LST
628	exec echo " Archiving $expnam.EXP as $file " >> $expnam.LST
629	exec echo "----------------------------------------------\n" >> $expnam.LST
630	} else {
631	exec echo "\n----------------------------------------------" >> $expnam.LST
632	exec echo " Archiving $expnam.EXP as $file.gz " >> $expnam.LST
633	exec echo "----------------------------------------------\n" >> $expnam.LST
634	}
635	}
636	} errmsg
637	if {$errmsg != ""} {
638	tk_dialog .warn Confirm "Error in archive: $errmsg" warning 0 OK
639	}
640	}
641
642	# save and optionally archive the expfile
643	proc savearchiveexp {} {
644	global expgui expmap
645	if !$expgui(changed) return
646	if $expgui(archive) archiveexp
647	# add a history record
648	exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds]]"
649	# now save the file
650	expwrite $expgui(expfile)
651	set expgui(changed) 0
652	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
653	set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
654	wm title . $expgui(expfile)
655	set expgui(titleunchanged) 1
656	}
657
658	# setup buttons for each phase on the phase page
659	proc setphases {} {
660	global expgui expmap
661	eval destroy [winfo children $expgui(phaseFrame).top.ps]
662	pack [label $expgui(phaseFrame).top.ps.0 -text Phase:] -side left
663	foreach num $expmap(phaselist) type $expmap(phasetype) {
664	pack [button $expgui(phaseFrame).top.ps.$num -text $num \
665	-command "SelectOnePhase $num" -padx 1.5m] -side left
666	if {$type > 3} {
667	$expgui(phaseFrame).top.ps.$num config -state disabled
668	}
669	}
670	if {[file executable $expgui(exptool)] && \
671	[llength $expmap(phaselist)]} {
672	pack [button $expgui(phaseFrame).top.ps.10 -text "Add Phase" \
673	-padx 1.5m -command MakeAddPhaseBox] -side left
674	}
675	}
676
677	# Procedure to respond to changes the phase.
678	# This loads the "phases" widgets with data corresponding to the selected phase.
679	proc SelectOnePhase {num} {
680	global entryvar entrycmd entrybox expmap expgui
681	set crsPhase {}
682	$expgui(atomxform) config -text "Xform Atoms" -state disabled
683	foreach n $expmap(phaselist) type $expmap(phasetype) {
684	if {$n == $num && $type <= 3} {
685	catch {$expgui(phaseFrame).top.ps.$num config -relief sunken}
686	set crsPhase $num
687	if {$type == 3} {
688	set expgui(phasetype) "Magnetic\nOnly"
689	} elseif {$type == 2} {
690	set expgui(phasetype) "Magnetic\n& Nuclear"
691	} elseif {$type == 4} {
692	# this is not used at present
693	set expgui(phasetype) "Macromolecular"
694	} else {
695	set expgui(phasetype) ""
696	}
697	} else {
698	catch {$expgui(phaseFrame).top.ps.$n config -relief raised}
699	}
700	}
701	# no phase is selected
702	if {$crsPhase == "" \|\| [llength $expmap(phaselist)] == 0} {
703	# disable traces on entryvar
704	set entrycmd(trace) 0
705	set entrycmd(phasename) ""
706	set entryvar(phasename) ""
707	foreach ent {a b c alpha beta gamma cellref celldamp} {
708	set entrycmd($ent) ""
709	set entryvar($ent) ""
710	}
711	set expgui(curPhase) {}
712	# enable traces on entryvar
713	set entrycmd(trace) 1
714	$expgui(EditingAtoms) config -text ""
715	DisplayAtom 0 0
716	DisplayU 0 0
717	DisplayRefFlags 0 0
718	$expgui(atomlistbox) delete 0 end
719	return
720	}
721
722	set expgui(curPhase) $crsPhase
723	# we have a phase
724
725	# disable traces on entryvar for right now
726	set entrycmd(trace) 0
727
728	##########################################################
729	###### SECTION: ASSIGNMENT OF DATA VARIABLES ##########
730	##########################################################
731	# phase title
732	set entrycmd(phasename) "phaseinfo $crsPhase name"
733	set entryvar(phasename) [phaseinfo $crsPhase name]
734	# cell parameters & flags
735	foreach ent {a b c alpha beta gamma cellref celldamp} {
736	set entrycmd($ent) "phaseinfo $crsPhase $ent"
737	set entryvar($ent) [phaseinfo $crsPhase $ent]
738	# reset item to black
739	catch {$entrybox($ent) config -fg black}
740	}
741
742	#Procedure call: DisplayU -- Display Anisotropic/Isotropic widget or disable
743	# initialize to diasbled
744	DisplayAtom 0 0
745	DisplayU 0 0
746	DisplayRefFlags 0 0
747	$expgui(EditingAtoms) config -text ""
748
749	DisplayAllAtoms
750
751	# enable traces on entryvar now
752	set entrycmd(trace) 1
753	}
754
755	set expgui(noreenterDisplayAllAtoms) 0
756	# Populate expgui(atomlistbox) (ScrolledListBox) with atoms from selected phase.
757	proc DisplayAllAtoms {"mode reset"} {
758	global entryvar entrycmd expmap expgui
759	# if it does not show, dont bother
760	if {$expgui(pagenow) != "phaseFrame"} return
761	if {$expgui(curPhase) == ""} return
762	if $expgui(noreenterDisplayAllAtoms) return
763
764	set expgui(noreenterDisplayAllAtoms) 1
765	if {$mode != "reset"} {
766	# save the scrolled position
767	set pos [lindex [$expgui(atomlistbox) yview] 0]
768	} else {
769	# this is a reset -- clear the selected atoms list
770	set expgui(selectedatomlist) {}
771	}
772	$expgui(atomlistbox) delete 0 end
773	# loop over atoms
774	set maxline I
775	set phase $expgui(curPhase)
776	set atomlist {}
777	set typehead "type "
778	set namehead " name "
779	set multhead "Mult"
780	set coordhead " "
781	set frachead "Occupancy"
782	if {$expgui(asorttype) == "type"} {
783	# sort on atom type
784	set typehead "type* "
785	foreach atom $expmap(atomlist_$phase) {
786	lappend atomlist "$atom [atominfo $phase $atom type] $phase"
787	}
788	set expmap(atomlistboxcontents) [lsort -ascii -index 1 $atomlist]
789	} elseif {$expgui(asorttype) == "number"} {
790	# sort on atom number
791	set namehead "* name "
792	foreach atom $expmap(atomlist_$phase) {
793	lappend atomlist "$atom $atom $phase"
794	}
795	set expmap(atomlistboxcontents) [lsort -integer -index 1 $atomlist]
796	} elseif {$expgui(asorttype) == "mult"} {
797	# sort on atom number
798	set multhead "Mlt*"
799	foreach atom $expmap(atomlist_$phase) {
800	lappend atomlist "$atom [atominfo $phase $atom mult] $phase"
801	}
802	set expmap(atomlistboxcontents) [lsort -integer -decreasing -index 1 $atomlist]
803	} elseif {$expgui(asorttype) == "occupancy"} {
804	# sort on atom number
805	set frachead " Occup* "
806	foreach atom $expmap(atomlist_$phase) {
807	lappend atomlist "$atom [atominfo $phase $atom frac] $phase"
808	}
809	set expmap(atomlistboxcontents) [lsort -real -decreasing -index 1 $atomlist]
810	} elseif {$expgui(asorttype) == "x"} {
811	# sort on x
812	set coordhead "(x*)"
813	foreach atom $expmap(atomlist_$phase) {
814	lappend atomlist "$atom [atominfo $phase $atom x] $phase"
815	}
816	set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
817	} elseif {$expgui(asorttype) == "y"} {
818	# sort on y
819	set coordhead "(y*)"
820	foreach atom $expmap(atomlist_$phase) {
821	lappend atomlist "$atom [atominfo $phase $atom y] $phase"
822	}
823	set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
824	} elseif {$expgui(asorttype) == "z"} {
825	# sort on z
826	set coordhead "(z*)"
827	foreach atom $expmap(atomlist_$phase) {
828	lappend atomlist "$atom [atominfo $phase $atom z] $phase"
829	}
830	set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
831	} else {
832	error "Bad expgui(asorttype) = $expgui(asorttype)"
833	}
834
835	foreach tuple $expmap(atomlistboxcontents) {
836	set atom [lindex $tuple 0]
837	set phase [lindex $tuple 2]
838	set refflag {}
839	foreach type {x u f} {
840	if {[atominfo $phase $atom ${type}ref]} {
841	append refflag "[string toupper $type][atominfo $phase $atom ${type}damp] "
842	} else {
843	append refflag " [atominfo $phase $atom ${type}damp] "
844	}
845	}
846	set line [format "%3d %-6s %-6s %8s %10.6f%10.6f%10.6f%4d%9.4f" \
847	$atom \
848	[atominfo $phase $atom label] \
849	[atominfo $phase $atom type] \
850	$refflag \
851	[atominfo $phase $atom x] \
852	[atominfo $phase $atom y] \
853	[atominfo $phase $atom z] \
854	[atominfo $phase $atom mult] \
855	[atominfo $phase $atom frac]
856	]
857
858	# add temperature factors (iso/anoiso)
859	if {[atominfo $phase $atom temptype] == "A"} {
860	set maxline A
861	append line [format " %9.5f%9.5f%9.5f%9.5f%9.5f%9.5f" \
862	[atominfo $phase $atom U11] \
863	[atominfo $phase $atom U22] \
864	[atominfo $phase $atom U33] \
865	[atominfo $phase $atom U12] \
866	[atominfo $phase $atom U23] \
867	[atominfo $phase $atom U13]
868	]
869	} else {
870	append line [format " %9.5f" \
871	[atominfo $phase $atom Uiso]
872	]
873	}
874	$expgui(atomlistbox) insert end $line
875	}
876	$expgui(atomtitle) delete 0 end
877	if {$maxline == "A"} {
878	$expgui(atomtitle) insert end [format "%10s %6s %8s%29s %9s %s" \
879	$namehead $typehead "ref/damp " \
880	"fractional coordinates$coordhead" \
881	"$multhead $frachead" \
882	" Uiso/Uij "]
883	} else {
884	$expgui(atomtitle) insert end [format "%10s %6s %8s%29s %9s %s" \
885	$namehead $typehead "ref/damp " \
886	"fractional coordinates$coordhead" \
887	"$multhead $frachead" \
888	" Uiso"]
889	}
890	if {$mode != "reset"} {
891	# restore the selected items
892	foreach i $expgui(selectedatomlist) {
893	$expgui(atomlistbox) selection set $i
894	}
895	# restore the last scrolled position
896	$expgui(atomlistbox) yview moveto $pos
897	}
898	set expgui(noreenterDisplayAllAtoms) 0
899	}
900
901	# Procedure to select all atoms in response to a right-click
902	proc SelectAllAtoms {} {
903	global expgui
904	$expgui(atomlistbox) selection set 0 end
905	# call editRecord in case trace was called before the selection was made
906	editRecord
907	}
908
909	# Procedure to respond to left mouse release in the atoms Pane
910	proc editRecord { args } {
911	global entrycmd expgui
912	set expgui(selectedatomlist) [$expgui(atomlistbox) curselection]
913	# disable traces on entryvar for right now
914	set entrycmd(trace) 0
915
916	if {[llength $expgui(selectedatomlist)] == 0} {
917	if $expgui(debug) {error "Attempt display non-existent atoms"}
918	} elseif {[llength $expgui(selectedatomlist)] == 1} {
919	editOneRecord $expgui(selectedatomlist)
920	} else {
921	editMultipleRecords $expgui(selectedatomlist)
922	}
923	# reenable traces on entryvar
924	set entrycmd(trace) 1
925	# repaint the atoms box in case anything was changed
926	# DisplayAllAtoms noreset
927	}
928
929	proc editOneRecord { AtomIndex } {
930	global expmap expgui
931	# get atom number & phase
932	set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
933	set atomnum [lindex $tuple 0]
934	set p [lindex $tuple 2]
935	DisplayU $atomnum $p
936	DisplayAtom $atomnum $p
937	DisplayRefFlags $atomnum $p
938	$expgui(EditingAtoms) config -text "Editing atom #$atomnum -- [atominfo $p $atomnum label]"
939	$expgui(atomxform) config -text "Xform Atom" -state normal
940	}
941
942	# this will not work for a multi-phase list of atoms (yet)
943	proc editMultipleRecords { AtomIndexList } {
944	global expmap expgui
945	set numberList {}
946	# current phase
947	set p $expgui(curPhase)
948	foreach AtomIndex $AtomIndexList {
949	# get atom number & phase
950	set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
951	lappend numberList [lindex $tuple 0]
952	# set p [lindex $tuple 2]
953	}
954	# this needs to track by phase
955	$expgui(EditingAtoms) config -text \
956	"Set refinement options: atoms [CompressList $numberList]"
957	DisplayU 0 0
958	DisplayAtom 0 0
959	# this needs to track by phase
960	DisplayRefFlags $numberList $p
961	$expgui(atomxform) config -text "Xform Atoms" -state normal
962	}
963
964	# format a string of numbers to save space, e.g. "1 2 3 4 6 7 19 13 14 15"
965	# becomes "1-4,6,7,13-15,19"
966	proc CompressList {numberList} {
967	# format the number list to save space
968	set lastnum -99
969	set flist {}
970	set count 0
971	if [catch {set sortlist [lsort -integer $numberList]}] {return $numberList}
972	foreach num $sortlist {
973	set next [expr $lastnum+1]
974	if {$num != $next} {
975	if {$count == 0 && $flist != ""} {
976	append flist ",$num"
977	} elseif {$count == 1 && $flist != ""} {
978	append flist ",$lastnum,$num"
979	} elseif {$flist != ""} {
980	append flist "-$lastnum,$num"
981	} else {
982	append flist "$num"
983	}
984	set lastnum $num
985	set count 0
986	} else {
987	incr count
988	incr lastnum
989	}
990	}
991	if {$count == 1 && $flist != ""} {
992	append flist ",$lastnum"
993	} elseif {$flist != "" && $count > 1} {
994	append flist "-$lastnum"
995	}
996	return $flist
997	}
998
999	# Procedure to display Isotropic or Anisotropic temperature factors
1000	# Changes the display to one entry widget for Isotropic motion OR
1001	# 6 entry widgets for Anisotropic motion in Frame3.
1002	# or disables the widet entirly if atom = 0
1003	proc DisplayU { atomnum p} {
1004	global expgui entryvar entrycmd
1005	if {$atomnum == 0} {
1006	set iOrA disable
1007	} else {
1008	set iOrA [atominfo $p $atomnum temptype]
1009	}
1010
1011	set firstbox [lindex $expgui(anisolabels) 0]
1012	if { $iOrA == "A" } {
1013	$firstbox config -text "U11 "
1014	foreach item $expgui(anisolabels) {
1015	$item config -fg black
1016	}
1017	foreach item $expgui(anisoentry) var {U11 U22 U33 U12 U13 U23} {
1018	set entrycmd($var) "atominfo $p $atomnum $var"
1019	set entryvar($var) [eval $entrycmd($var)]
1020	$item config -fg black -state normal -bg white
1021	}
1022	} elseif { $iOrA == "I" \|\| $iOrA == "disable"} {
1023	foreach item $expgui(anisolabels) {
1024	$item config -fg $expgui(bkgcolor1)
1025	}
1026	foreach item [lrange $expgui(anisoentry) 1 end] \
1027	var {U22 U33 U12 U13 U23} {
1028	set entrycmd($var) ""
1029	set entryvar($var) ""
1030	$item config -fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1) \
1031	-state disabled
1032	}
1033	if { $iOrA == "disable"} {
1034	set entrycmd($var) ""
1035	set entryvar($var) ""
1036	[lindex $expgui(anisoentry) 0] config \
1037	-fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1) \
1038	-state disabled
1039	} else {
1040	set entrycmd(U11) "atominfo $p $atomnum Uiso"
1041	set entryvar(U11) [eval $entrycmd(U11)]
1042	$firstbox config -text Uiso -fg black
1043	[lindex $expgui(anisoentry) 0] config -fg black -bg white -state normal
1044	}
1045	}
1046	}
1047
1048	# need to think about multiple phases
1049
1050	# Procedure to display refinement flags
1051	proc DisplayRefFlags { atomnum p} {
1052	global expgui entryvar entrycmd
1053	if {$atomnum == 0} {
1054	foreach label $expgui(atomreflbl) {
1055	$label config -fg $expgui(bkgcolor1)
1056	}
1057	foreach entry $expgui(atomref) {
1058	$entry config -state disabled \
1059	-fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1)
1060	# turn off checkbuttons
1061	catch {$entry deselect}
1062
1063	}
1064	return
1065	}
1066	foreach label $expgui(atomreflbl) {
1067	$label config -fg black
1068	}
1069	foreach entry $expgui(atomref) {
1070	$entry config -state normal -fg black -bg $expgui(bkgcolor1)
1071	}
1072	foreach var {xref uref fref xdamp udamp fdamp} {
1073	set entrycmd($var) "atominfo $p [list $atomnum] $var"
1074	set entryvar($var) [eval $entrycmd($var)]
1075	}
1076	}
1077
1078	# Procedure to display an atom in the atom edit boxes
1079	proc DisplayAtom { atomnum p} {
1080	global expgui entryvar entrycmd
1081	if {$atomnum == 0} {
1082	foreach label $expgui(atomlabels) {
1083	$label config -fg $expgui(bkgcolor1)
1084	}
1085	foreach entry $expgui(atomentry) {
1086	$entry config -state disabled \
1087	-fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1)
1088	}
1089	return
1090	}
1091	foreach label $expgui(atomlabels) {
1092	$label config -fg black
1093	}
1094	foreach entry $expgui(atomentry) {
1095	$entry config -state normal -fg black -bg white
1096	}
1097	foreach var {x y z label frac } {
1098	set entrycmd($var) "atominfo $p $atomnum $var"
1099	set entryvar($var) [eval $entrycmd($var)]
1100	}
1101	}
1102
1103	# make a histogram box; used in MakeHistPane,
1104	proc MakeHistBox {frm} {
1105	global expgui
1106	grid [label $frm.mode -text "Select a Histogram" \
1107	-bg beige -anchor center] \
1108	-row 0 -column 0 -columnspan 2 -sticky ew
1109	bind $frm.mode <Button-1> {
1110	set i [lsearch $expgui(AllowedHistSelectModes) $expgui(globalmode)]
1111	set expgui(globalmode) [lindex \
1112	"$expgui(AllowedHistSelectModes) \
1113	$expgui(AllowedHistSelectModes)" [incr i]]
1114	sethistlist
1115	}
1116	bind $frm.mode <Button-3> {set expgui(globalmode) 0; sethistlist}
1117	grid [listbox $frm.title -height 1 -relief flat \
1118	-exportselection 0 \
1119	-font $expgui(histfont) ] -row 1 -column 0 -sticky ew
1120	grid [listbox $frm.lbox -height 10 -width 25 \
1121	-exportselection 0 \
1122	-font $expgui(histfont) \
1123	-xscrollcommand "$frm.x set" \
1124	-yscrollcommand "$frm.y set" \
1125	] -row 2 -column 0 -sticky news
1126	lappend expgui(HistSelectList) $frm
1127	grid [scrollbar $frm.x -orient horizontal \
1128	-command "move2boxes \" $frm.title $frm.lbox \" "
1129	] -row 3 -column 0 -sticky ew
1130	grid [scrollbar $frm.y \
1131	-command "$frm.lbox yview"] \
1132	-row 2 -column 1 -sticky ns
1133	grid columnconfigure $frm 0 -weight 1
1134	grid rowconfigure $frm 2 -weight 1
1135	}
1136
1137	# update the histogram list
1138	# to do: show histogram ref flags?
1139	proc sethistlist {} {
1140	global expgui expmap
1141	array set lbl {
1142	1 "Select 1 or more\nTOF Histograms"
1143	2 "Select 1 or more\nCW Neutron Histograms"
1144	3 "Select 1 or more\nAlpha 1,2 X-ray Histograms"
1145	4 "Select 1 or more\nmonochromatic X-ray Histograms"
1146	5 "Select 1 or more Energy\nDisperive X-ray Histograms"
1147	6 "Select 1 or more of\n any type Histograms"
1148	}
1149	foreach lbox $expgui(HistSelectList) {
1150	$lbox.title delete 0 end
1151	$lbox.lbox delete 0 end
1152	if {$expgui(globalmode) != 0} {
1153	$lbox.lbox config -selectmode extended
1154	$lbox.mode config -text $lbl($expgui(globalmode)) -bg yellow
1155	} else {
1156	$lbox.lbox config -selectmode browse
1157	$lbox.mode config -text "Select a histogram" -bg beige
1158	}
1159	}
1160	# disable the unallowed pages in all mode
1161	if {$expgui(globalmode) == 6} {
1162	foreach pair $expgui(GlobalModeAllDisable) {
1163	if {$expgui(pagenow) == [lindex $pair 0]} {
1164	RaisePage lsFrame
1165	}
1166	eval [lindex $pair 1] -state disabled
1167	}
1168	} else {
1169	foreach pair $expgui(GlobalModeAllDisable) {
1170	eval [lindex $pair 1] -state normal
1171	}
1172	}
1173	set histlist {}
1174	if {$expgui(hsorttype) == "type"} {
1175	# sort on histogram type
1176	foreach h [lsort -integer -increasing $expmap(powderlist)] {
1177	lappend histlist "$h [string range $expmap(htype_$h) 1 2]"
1178	}
1179	set expmap(histlistboxcontents) [lsort -ascii -index 1 $histlist]
1180	} elseif {$expgui(hsorttype) == "number"} {
1181	# sort on histogram number
1182	foreach h [lsort -integer -increasing $expmap(powderlist)] {
1183	lappend histlist "$h $h"
1184	}
1185	set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
1186	} elseif {$expgui(hsorttype) == "bank"} {
1187	# sort on original bank number
1188	foreach h [lsort -integer -increasing $expmap(powderlist)] {
1189	lappend histlist "$h [histinfo $h bank]"
1190	}
1191	set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
1192	} elseif {$expgui(hsorttype) == "angle"} {
1193	# sort on wavelength (CW) or angle (E disp.)
1194	foreach h [lsort -integer -increasing $expmap(powderlist)] {
1195	if {[string range $expmap(htype_$h) 2 2] == "T"} {
1196	set det [format %8.2f [histinfo $h tofangle]]
1197	} elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
1198	set det [format %8.5f [histinfo $h lam1]]
1199	} elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
1200	set det [format %8.2f [histinfo $h lam1]]
1201	} else {
1202	set det {}
1203	}
1204	lappend histlist "$h $det"
1205	}
1206	set expmap(histlistboxcontents) [lsort -real -index 1 $histlist]
1207	}
1208
1209	# title field needs to match longest title
1210	foreach lbox $expgui(HistSelectList) {
1211	$lbox.title insert end [format "%2s %s %4s %8s %-67s" \
1212	"h#" \
1213	type \
1214	bank \
1215	"ang/wave" \
1216	" title" \
1217	]
1218	}
1219	foreach tuple $expmap(histlistboxcontents) {
1220	set h [lindex $tuple 0]
1221
1222	if {$expgui(globalmode) == 1} {
1223	if {[string range $expmap(htype_$h) 2 2] != "T"} continue
1224	} elseif {$expgui(globalmode) == 2} {
1225	if {[string range $expmap(htype_$h) 1 2] != "NC"} continue
1226	} elseif {$expgui(globalmode) == 3} {
1227	if {[string range $expmap(htype_$h) 1 2] != "XC" \|\| \
1228	[histinfo $h lam2] == 0.0} continue
1229	} elseif {$expgui(globalmode) == 4} {
1230	if {[string range $expmap(htype_$h) 1 2] != "XC" \|\| \
1231	[histinfo $h lam2] != 0.0} continue
1232	} elseif {$expgui(globalmode) == 5} {
1233	if {[string range $expmap(htype_$h) 1 2] != "XE"} continue
1234	}
1235
1236	if {[string range $expmap(htype_$h) 2 2] == "T"} {
1237	set det [format %8.2f [histinfo $h tofangle]]
1238	} elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
1239	set det [format %8.5f [histinfo $h lam1]]
1240	} elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
1241	set det [format %8.2f [histinfo $h lam1]]
1242	} else {
1243	set det {}
1244	}
1245	foreach lbox $expgui(HistSelectList) {
1246	$lbox.lbox insert end [format "%2d %s %4d %8s %-67s" \
1247	$h \
1248	[string range $expmap(htype_$h) 1 2] \
1249	[histinfo $h bank] \
1250	$det \
1251	[string range [histinfo $h title] 0 66] \
1252	]
1253	}
1254	}
1255	UpdateCurrentPage
1256	}
1257
1258	proc UpdateCurrentPage {} {
1259	global expgui
1260	foreach set $expgui(frameactionlist) {
1261	if {$expgui(pagenow) == [lindex $set 0]} {catch [lindex $set 1]}
1262	}
1263	}
1264
1265	#-----------------------------------------------------------------------
1266	# ----------- draw Histogram page
1267	#-----------------------------------------------------------------------
1268	proc DisplayHistogram {} {
1269	global expgui entrycmd entryvar entrybox expmap
1270
1271	# trap if more than one histogram is selected unless global mode
1272	if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
1273	set expgui(curhist) [lindex $expgui(curhist) 0]
1274	}
1275
1276	# display the selected histograms
1277	$expgui(histFrame).hs.lbox selection clear 0 end
1278	foreach h $expgui(curhist) {
1279	$expgui(histFrame).hs.lbox selection set $h
1280	}
1281
1282	# disable traces on entryvar for right now
1283	set entrycmd(trace) 0
1284
1285	# get histogram list
1286	set histlist {}
1287	foreach item $expgui(curhist) {
1288	lappend histlist [lindex $expmap(powderlist) $item]
1289	}
1290	# must have at least one histogram selected here
1291	if {[llength $histlist] == 0} {
1292	set expgui(backtermlbl) ""
1293	set expgui(backtypelbl) ""
1294	foreach var {bref bdamp} {
1295	set entrycmd($var) ""
1296	set entryvar($var) ""
1297	}
1298	$expgui(histFrame).top.txt config -text "No Selected Histograms"
1299	grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew
1300	set expgui(bkglbl) ""
1301	eval destroy [winfo children $expgui(diffBox)]
1302	set entrycmd(trace) 1
1303	return
1304	}
1305
1306	if {$expgui(globalmode) != 0} {
1307	set expgui(backtermlbl) ""
1308	set expgui(backtypelbl) ""
1309	foreach var {bref bdamp} {
1310	set entrycmd($var) "histinfo [list $histlist] $var"
1311	set entryvar($var) [histinfo [lindex $histlist 0] $var]
1312	}
1313	} else {
1314	set hist $histlist
1315	set terms [histinfo $hist backterms]
1316	set expgui(backtermlbl) "($terms terms)"
1317	set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
1318	foreach var {bref bdamp} {
1319	set entrycmd($var) "histinfo $hist $var"
1320	set entryvar($var) [eval $entrycmd($var)]
1321	}
1322	}
1323	# Top box
1324	if $expgui(haveBW) {
1325	catch {destroy $expgui(histFrame).pflag}
1326	}
1327	if {$expgui(globalmode) != 0} {
1328	$expgui(histFrame).top.txt config \
1329	-text "Selected Histograms: [CompressList $histlist]"
1330	grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew
1331	set expgui(bkglbl) "Globally Edit Background"
1332	} else {
1333	grid forget $expgui(histFrame).top
1334	set expgui(bkglbl) "Edit Background"
1335	if {$expgui(haveBW) && [llength $expmap(phaselist)] > 1} {
1336	TitleFrame $expgui(histFrame).pflag \
1337	-borderwidth 4 -side left -relief groove \
1338	-text "Phase Flags"
1339	set expgui(pflag) [$expgui(histFrame).pflag getframe]
1340	grid $expgui(histFrame).pflag -column 1 -row 1 -sticky nsew
1341	grid rowconfigure $expgui(histFrame) 2 -minsize 35
1342	foreach p $expmap(phaselist) {
1343	pack [checkbutton $expgui(pflag).$p \
1344	-command "GetPhaseFlags $hist" \
1345	-variable expgui(pflag$p) -text $p] -side left
1346	if {[lsearch $expmap(phaselist_$hist) $p] == -1} {
1347	set expgui(pflag$p) 0
1348	} else {
1349	set expgui(pflag$p) 1
1350	}
1351	}
1352	}
1353	}
1354
1355	# diffractometer constants
1356	foreach var {lam1 lam2 kratio pola ipola ddamp zero \
1357	wref pref dcref daref ratref ttref zref } {
1358	set entrycmd($var) "histinfo [list $histlist] $var"
1359	set entryvar($var) [histinfo [lindex $histlist 0] $var]
1360	}
1361
1362	eval destroy [winfo children $expgui(diffBox)]
1363	if {$expgui(globalmode) == 0} {
1364	if {[string range $expmap(htype_$hist) 2 2] == "T"} {
1365	#------
1366	# TOF \|
1367	#------
1368	grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
1369	-column 1 -row 1
1370	grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
1371	-column 2 -row 1
1372	grid [ label $expgui(diffBox).lDCdifc -text DIFC ] \
1373	-column 3 -row 1 -sticky w
1374	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1375	-width 15 ] -column 4 -row 1
1376	set entrybox(lam1) $expgui(diffBox).eDCdifc
1377	#
1378	grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
1379	-column 1 -row 2
1380	grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
1381	-column 2 -row 2
1382	grid [ label $expgui(diffBox).lDCdifa -text DIFA ] \
1383	-column 3 -row 2
1384	grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1385	-width 15 ] -column 4 -row 2
1386	set entrybox(lam2) $expgui(diffBox).eDCdifa
1387	#
1388	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1389	-column 3 -row 3
1390	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1391	-width 15 ] -column 4 -row 3
1392	set entrybox(zero) $expgui(diffBox).eDCzero
1393	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1394	-column 1 -row 3 -sticky w
1395	grid [ checkbutton $expgui(diffBox).rfDCzref \
1396	-variable entryvar(zref) ] -column 2 -row 3
1397	} elseif {[string range $expmap(htype_$hist) 1 2] == "NC"} {
1398	#---------------
1399	# CW - neutron \|
1400	#---------------
1401	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1402	-column 1 -row 1
1403	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1404	-column 2 -row 1
1405	grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1406	-column 3 -row 1 -sticky w
1407	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1408	-width 15 ] -column 4 -row 1
1409	set entrybox(lam1) $expgui(diffBox).eDCdifc
1410	#
1411	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1412	-column 1 -row 3 -sticky w
1413	grid [ checkbutton $expgui(diffBox).rfDCzref \
1414	-variable entryvar(zref) ] -column 2 -row 3
1415	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1416	-column 3 -row 3
1417	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1418	-width 15 ] -column 4 -row 3
1419	set entrybox(zero) $expgui(diffBox).eDCzero
1420	} elseif {[string range $expmap(htype_$hist) 1 2] == "XC" && \
1421	[histinfo $hist lam2] == 0.0} {
1422	#--------------------------
1423	# CW - x-ray 1 wavelength \|
1424	#--------------------------
1425	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1426	-column 1 -row 1
1427	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1428	-column 2 -row 1
1429	grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1430	-column 3 -row 1 -sticky w
1431	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1432	-width 15 ] -column 4 -row 1
1433	set entrybox(lam1) $expgui(diffBox).eDCdifc
1434	#
1435	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1436	-column 1 -row 3 -sticky w
1437	grid [ checkbutton $expgui(diffBox).rfDCzref \
1438	-variable entryvar(zref) ] -column 2 -row 3
1439	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1440	-column 3 -row 3
1441	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1442	-width 15 ] -column 4 -row 3
1443	set entrybox(zero) $expgui(diffBox).eDCzero
1444	#
1445	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1446	-column 1 -row 4 -sticky w
1447	grid [ checkbutton $expgui(diffBox).rfDCpref \
1448	-variable entryvar(pref) ] -column 2 -row 4
1449	grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1450	-column 3 -row 4
1451	grid [ entry $expgui(diffBox).eDCpola \
1452	-textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1453	set entrybox(pola) $expgui(diffBox).eDCpola
1454	grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1455	-column 5 -row 4
1456	grid [ entry $expgui(diffBox).eDCipola -width 2 \
1457	-textvariable entryvar(ipola)] -column 6 -row 4
1458	set entrybox(ipola) $expgui(diffBox).eDCipola
1459	} elseif {[string range $expmap(htype_$hist) 1 2] == "XC"} {
1460	#---------------------------
1461	# CW - x-ray 2 wavelengths \|
1462	#---------------------------
1463	grid [ label $expgui(diffBox).lDCdifc -text wavelengths ] \
1464	-column 3 -row 1 -sticky w
1465	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1466	-width 15 ] -column 4 -row 1
1467	set entrybox(lam1) $expgui(diffBox).eDCdifc
1468	grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1469	-width 15 ] -column 5 -row 1
1470	set entrybox(lam2) $expgui(diffBox).eDCdifa
1471	#
1472	grid [ label $expgui(diffBox).lDCrref -text "Refine ratio" ] \
1473	-column 1 -row 2 -sticky w
1474	grid [ checkbutton $expgui(diffBox).rfDCrref \
1475	-variable entryvar(ratref) ] -column 2 -row 2
1476	grid [ label $expgui(diffBox).lDCratio -text Ratio ] \
1477	-column 3 -row 2
1478	grid [ entry $expgui(diffBox).eDCkratio \
1479	-textvariable entryvar(kratio) \
1480	-width 15 ] -column 4 -row 2
1481	set entrybox(kratio) $expgui(diffBox).eDCkratio
1482	#
1483	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1484	-column 3 -row 3
1485	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1486	-width 15 ] -column 4 -row 3
1487	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1488	-column 1 -row 3 -sticky w
1489	set entrybox(zero) $expgui(diffBox).eDCzero
1490	grid [ checkbutton $expgui(diffBox).rfDCzref \
1491	-variable entryvar(zref) ] -column 2 -row 3
1492	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1493	-column 1 -row 4 -sticky w
1494	grid [ checkbutton $expgui(diffBox).rfDCpref \
1495	-variable entryvar(pref) ] -column 2 -row 4
1496	grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1497	-column 3 -row 4
1498	grid [ entry $expgui(diffBox).eDCpola \
1499	-textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1500	set entrybox(pola) $expgui(diffBox).eDCpola
1501	grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1502	-column 5 -row 4
1503	grid [ entry $expgui(diffBox).eDCipola -width 2 \
1504	-textvariable entryvar(ipola)] -column 6 -row 4
1505	set entrybox(ipola) $expgui(diffBox).eDCipola
1506	} elseif {[string range $expmap(htype_$hist) 1 2] == "XE"} {
1507	#-------------
1508	# ED - x-ray \|
1509	#-------------
1510	grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
1511	-column 1 -row 1
1512	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
1513	-column 2 -row 1
1514	grid [ label $expgui(diffBox).lDCdifc -text 2Theta ] \
1515	-column 3 -row 1 -sticky w
1516	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1517	-width 15 ] -column 4 -row 1
1518	set entrybox(lam1) $expgui(diffBox).eDCdifc
1519	#
1520	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1521	-column 1 -row 4 -sticky w
1522	grid [ checkbutton $expgui(diffBox).rfDCpref \
1523	-variable entryvar(pref) ] -column 2 -row 4
1524	grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1525	-column 3 -row 4
1526	grid [ entry $expgui(diffBox).eDCpola \
1527	-textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1528	set entrybox(pola) $expgui(diffBox).eDCpola
1529	grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1530	-column 5 -row 4
1531	grid [ entry $expgui(diffBox).eDCipola -width 2 \
1532	-textvariable entryvar(ipola)] -column 6 -row 4
1533	set entrybox(ipola) $expgui(diffBox).eDCipola
1534	}
1535	} elseif {$expgui(globalmode) == 1} {
1536	#-------------
1537	# Global TOF \|
1538	#-------------
1539	grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
1540	-column 1 -row 1
1541	grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
1542	-column 2 -row 1
1543	grid [button $expgui(diffBox).bDCdifc -text "Set DIFC Globally" \
1544	-command "editglobalparm histinfo difc {DIFC}"] -column 3 -row 1
1545	#
1546	grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
1547	-column 1 -row 2
1548	grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
1549	-column 2 -row 2
1550	grid [ button $expgui(diffBox).bDCdifa -text "Set DIFA Globally" \
1551	-command "editglobalparm histinfo difa {DIFA}"] -column 3 -row 2
1552	#
1553	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1554	-column 1 -row 3 -sticky w
1555	grid [ checkbutton $expgui(diffBox).rfDCzref \
1556	-variable entryvar(zref) ] -column 2 -row 3
1557	grid [ button $expgui(diffBox).bDCzero -text "Set ZERO Globally" \
1558	-command "editglobalparm histinfo zero {Zero}"] -column 3 -row 3
1559	} elseif {$expgui(globalmode) == 2} {
1560	#--------------------
1561	# Global CW neutron \|
1562	#--------------------
1563	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1564	-column 1 -row 1
1565	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1566	-column 2 -row 1
1567	grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
1568	-command "editglobalparm histinfo lam1 Wavelength"] \
1569	-column 3 -row 1
1570	#
1571	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1572	-column 1 -row 3 -sticky w
1573	grid [ checkbutton $expgui(diffBox).rfDCzref \
1574	-variable entryvar(zref) ] -column 2 -row 3
1575	grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1576	-command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1577	} elseif {$expgui(globalmode) == 4} {
1578	#----------------------
1579	# Global CW mono xray \|
1580	#----------------------
1581	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1582	-column 1 -row 1
1583	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1584	-column 2 -row 1
1585	grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
1586	-command "editglobalparm histinfo lam1 Wavelength"] \
1587	-column 3 -row 1
1588	#
1589	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1590	-column 1 -row 3 -sticky w
1591	grid [ checkbutton $expgui(diffBox).rfDCzref \
1592	-variable entryvar(zref) ] -column 2 -row 3
1593	grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1594	-command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1595	#
1596	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1597	-column 1 -row 4 -sticky w
1598	grid [ checkbutton $expgui(diffBox).rfDCpref \
1599	-variable entryvar(pref) ] -column 2 -row 4
1600	grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1601	-command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1602	grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1603	-command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1604	} elseif {$expgui(globalmode) == 3} {
1605	#------------------------
1606	# Global alpha 1,2 xray \|
1607	#------------------------
1608	grid [button $expgui(diffBox).bDCl1 -text "Set Wave1 Globally" \
1609	-command "editglobalparm histinfo lam1 {Wavelength 1}"] \
1610	-column 3 -row 1
1611	grid [button $expgui(diffBox).bDCl2 -text "Set Wave2 Globally" \
1612	-command "editglobalparm histinfo lam2 {Wavelength 2}"] \
1613	-column 4 -row 1
1614	#
1615	grid [ label $expgui(diffBox).lDCratref -text "Refine Ratio" ] \
1616	-column 1 -row 3 -sticky w
1617	grid [ checkbutton $expgui(diffBox).rfDCratref \
1618	-variable entryvar(ratref) ] -column 2 -row 3
1619	grid [button $expgui(diffBox).bDCrrat -text "Set Ratio Globally" \
1620	-command "editglobalparm histinfo ratio {Wavelength Ratio}"] \
1621	-column 3 -row 3
1622	#
1623	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1624	-column 1 -row 3 -sticky w
1625	grid [ checkbutton $expgui(diffBox).rfDCzref \
1626	-variable entryvar(zref) ] -column 2 -row 3
1627	grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1628	-command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1629	#
1630	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1631	-column 1 -row 4 -sticky w
1632	grid [ checkbutton $expgui(diffBox).rfDCpref \
1633	-variable entryvar(pref) ] -column 2 -row 4
1634	grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1635	-command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1636	grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1637	-command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1638	} elseif {$expgui(globalmode) == 5} {
1639	#-----------------
1640	# Global ED xray \|
1641	#-----------------
1642	grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
1643	-column 1 -row 1
1644	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
1645	-column 2 -row 1
1646	grid [button $expgui(diffBox).bDCdifc -text "Set 2Theta Globally" \
1647	-command "editglobalparm histinfo ratio {Fixed 2Theta}"] \
1648	-column 3 -row 1
1649	#
1650	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1651	-column 1 -row 4 -sticky w
1652	grid [ checkbutton $expgui(diffBox).rfDCpref \
1653	-variable entryvar(pref) ] -column 2 -row 4
1654	grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1655	-command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1656	grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1657	-command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1658	}
1659	if {$expgui(globalmode) == 0} {
1660	grid [frame $expgui(diffBox).d] -column 5 -row 5 \
1661	-columnspan 2 -sticky e
1662	} else {
1663	grid [frame $expgui(diffBox).d] -column 4 -row 5 \
1664	-columnspan 2 -sticky e
1665	}
1666	grid [label $expgui(diffBox).d.lDamp -text "Damping "] \
1667	-column 1 -row 1
1668	tk_optionMenu $expgui(diffBox).d.om entryvar(ddamp) 0 1 2 3 4 5 6 7 8 9
1669	grid $expgui(diffBox).d.om -column 2 -row 1
1670	grid columnconfigure $expgui(diffBox) 9 -weight 1
1671	grid columnconfigure $expgui(diffBox) 0 -weight 1
1672	update idletasks
1673	# enable traces on entryvar now
1674	set entrycmd(trace) 1
1675	}
1676
1677	# this gets the phase flags as set in the expgui(pflag*) elements
1678	# (linked to phase flag checkbuttons) and the sets the "HST xx NPHAS" flags
1679	# accordingly using SetPhaseFlag
1680	proc GetPhaseFlags {hist} {
1681	global expmap expgui
1682	set plist {}
1683	foreach p $expmap(phaselist) {
1684	if {$expgui(pflag$p)} {lappend plist $p}
1685	}
1686	SetPhaseFlag $hist $plist
1687	incr expgui(changed)
1688	mapexp
1689	}
1690
1691	#-----------------------------------------------------------------------
1692	# populate the Scaling page
1693	#-----------------------------------------------------------------------
1694	proc DisplayFrac {} {
1695	global expgui entrycmd entryvar entrybox expmap
1696
1697	# trap if more than one histogram is selected unless global mode
1698	if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
1699	set expgui(curhist) [lindex $expgui(curhist) 0]
1700	}
1701
1702	# display the selected histograms
1703	$expgui(fracFrame).hs.lbox selection clear 0 end
1704	foreach h $expgui(curhist) {
1705	$expgui(fracFrame).hs.lbox selection set $h
1706	}
1707
1708	# disable traces on entryvar
1709	set entrycmd(trace) 0
1710
1711	# get histogram list
1712	set histlist {}
1713	foreach item $expgui(curhist) {
1714	lappend histlist [lindex $expmap(powderlist) $item]
1715	}
1716
1717	# must have at least one histogram selected here
1718	if {[llength $histlist] == 0} {
1719	foreach var {scale sref sdamp} {
1720	set entrycmd($var) ""
1721	set entryvar($var) ""
1722	}
1723	set parm [grid info $expgui(scaleBox).but1]
1724	if {$parm != ""} {
1725	grid forget $expgui(scaleBox).but1
1726	eval grid $expgui(scaleBox).ent1 $parm
1727	}
1728	# destroy the contents of the frame
1729	set phaseFractf1 $expgui(FracBox).f
1730	eval destroy [winfo children $phaseFractf1]
1731	# reenable traces on entryvar
1732	set entrycmd(trace) 1
1733	return
1734	}
1735
1736	#--------------
1737	# Scale factor
1738	#--------------
1739	if {$expgui(globalmode) != 0} {
1740	foreach var {scale sref sdamp} {
1741	set entrycmd($var) "histinfo [list $histlist] $var"
1742	set entryvar($var) [histinfo [lindex $histlist 0] $var]
1743	}
1744	# reset scale to black
1745	catch {$entrybox(scale) config -fg black}
1746	set parm [grid info $expgui(scaleBox).ent1]
1747	if {$parm != ""} {
1748	grid forget $expgui(scaleBox).ent1
1749	eval grid $expgui(scaleBox).but1 $parm
1750	}
1751	} else {
1752	set hist $histlist
1753	foreach var {scale sref sdamp} {
1754	set entrycmd($var) "histinfo $hist $var"
1755	set entryvar($var) [eval $entrycmd($var)]
1756	}
1757	# reset scale to black
1758	catch {$entrybox(scale) config -fg black}
1759	set parm [grid info $expgui(scaleBox).but1]
1760	if {$parm != ""} {
1761	grid forget $expgui(scaleBox).but1
1762	eval grid $expgui(scaleBox).ent1 $parm
1763	}
1764	}
1765
1766	#----------------
1767	# Phase Fractions
1768	#----------------
1769	set phaseFractf1 $expgui(FracBox).f
1770	# destroy the contents of the frame
1771	eval destroy [winfo children $phaseFractf1]
1772	if {$expgui(globalmode) != 0} {
1773	set txt "Phase Fractions for Histograms: [CompressList $histlist]"
1774	} else {
1775	set txt "Phase Fractions"
1776	}
1777	if $expgui(haveBW) {
1778	$expgui(fracFrame).f1.phaseFrac configure -text $txt
1779	} else {
1780	grid [label $phaseFractf1.txt -anchor center -text $txt] \
1781	-column 0 -row 0 -sticky news
1782	}
1783	# Create the frame inside the canvas, One frame for each Phase.
1784	foreach i {1 2 3 4 5 6 7 8 9} {set phasehistlist($i) ""}
1785	foreach hist $histlist {
1786	foreach i $expmap(phaselist_$hist) {
1787	lappend phasehistlist($i) $hist
1788	}
1789	}
1790	foreach i {1 2 3 4 5 6 7 8 9} {
1791	if {[llength $phasehistlist($i)] == 0} continue
1792	set framePF [frame $phaseFractf1.pF$i -relief groove -bd 4]
1793	grid $framePF -column 0 -row $i -sticky ew
1794	# Label Heading for each phase.
1795	if {$expgui(globalmode) != 0} {
1796	grid [label $framePF.l1 \
1797	-text "Phase $i Hist: [CompressList $phasehistlist($i)]"] \
1798	-column 0 -row 0 -sticky nws
1799	grid [button $framePF.but1 -text "Set Globally" \
1800	-command "editglobalparm hapinfo frac \"Phase $i Fraction\" \
1801	[list $phasehistlist($i)] $i" \
1802	] -column 1 -row 0
1803	} else {
1804	grid [label $framePF.l1 -text "Phase $i"] \
1805	-column 0 -row 0 -sticky nws
1806	grid [entry $framePF.ent -textvariable entryvar(frac$i) -width 15]\
1807	-column 1 -row 0
1808	set entrybox(frac$i) $framePF.ent
1809	}
1810	set entrycmd(frac$i) "hapinfo $hist $i frac"
1811	set entryvar(frac$i) [hapinfo $hist $i frac]
1812	grid [label $framePF.l2 -text " Refine"] \
1813	-column 2 -row 0 -sticky nws
1814	grid [checkbutton $framePF.cb -variable entryvar(frref$i)] \
1815	-column 3 -row 0 -sticky nws
1816	set entrycmd(frref$i) "hapinfo $hist $i frref"
1817	set entryvar(frref$i) [hapinfo $hist $i frref]
1818	grid [label $framePF.l3 -text " Damping"] \
1819	-column 4 -row 0 -sticky nws
1820	tk_optionMenu $framePF.tkOptDamp entryvar(frdamp$i) \
1821	0 1 2 3 4 5 6 7 8 9
1822	set entrycmd(frdamp$i) "hapinfo $hist $i frdamp"
1823	set entryvar(frdamp$i) [hapinfo $hist $i frdamp]
1824	grid $framePF.tkOptDamp -row 0 -sticky nsw -column 5
1825	}
1826	# resize the scroll window to match the actual
1827	update idletasks
1828	$expgui(FracBox) config -scrollregion [grid bbox $expgui(FracBox).f]
1829	$expgui(FracBox) config -width [lindex [grid bbox $expgui(FracBox).f] 2]
1830	update idletasks
1831	# enable traces on entryvar now
1832	set entrycmd(trace) 1
1833	}
1834
1835	#-----------------------------------------------------------------------
1836	# display the profile page
1837	#-----------------------------------------------------------------------
1838	proc DisplayProfile {} {
1839	global expgui entrycmd entryvar entrybox expmap
1840
1841	# trap if more than one histogram is selected unless global mode
1842	if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
1843	set expgui(curhist) [lindex $expgui(curhist) 0]
1844	}
1845	# display the selected histograms
1846	$expgui(profFrame).hs.lbox selection clear 0 end
1847	foreach h $expgui(curhist) {
1848	$expgui(profFrame).hs.lbox selection set $h
1849	}
1850
1851	# destroy the contents of the frame
1852	eval destroy [winfo children $expgui(ProfileBox).f]
1853
1854	if {$expgui(globalmode) == 0} {
1855	# must have at least one histogram selected here
1856	if {[llength $expgui(curhist)] == 0} return
1857	# disable traces on entryvar for right now
1858	set entrycmd(trace) 0
1859	set hist [lindex $expmap(powderlist) $expgui(curhist)]
1860	# no defined histograms?
1861	if {$hist == ""} return
1862	# Create one frame for each Phase.
1863	set ind -1
1864	set htype [string range $expmap(htype_$hist) 2 2]
1865	foreach i $expmap(phaselist_$hist) {
1866	incr ind
1867	# Label Heading for each phase.
1868	set ptype [string trim [hapinfo $hist $i proftype]]
1869	if {$expgui(haveBW)} {
1870	grid [TitleFrame $expgui(ProfileBox).f.$i \
1871	-text "Hist $hist -- Phase $i (type $ptype)" \
1872	-relief groove -bd 2] \
1873	-column 0 -row $ind -sticky ew
1874	set ProfileFrame [$expgui(ProfileBox).f.$i getframe]
1875	grid [frame $ProfileFrame.1] \
1876	-column 0 -row 0 -columnspan 10
1877	pack [label $ProfileFrame.1.l \
1878	-text Damping]\
1879	-side left
1880	} else {
1881	grid [frame $expgui(ProfileBox).f.$i -relief groove -bd 4] \
1882	-column 0 -row $ind -sticky ew
1883	set ProfileFrame $expgui(ProfileBox).f.$i
1884	grid [frame $ProfileFrame.1] \
1885	-column 0 -row 0 -columnspan 10 -sticky ew
1886	pack [label $ProfileFrame.1.l \
1887	-text "Phase $i (type $ptype) Damping"]\
1888	-side left
1889	}
1890	tk_optionMenu $ProfileFrame.1.tkOptDamp entryvar(pdamp_$i) \
1891	0 1 2 3 4 5 6 7 8 9
1892	set entrycmd(pdamp_$i) "hapinfo $hist $i pdamp"
1893	set entryvar(pdamp_$i) [hapinfo $hist $i pdamp]
1894	pack $ProfileFrame.1.tkOptDamp -side left
1895	pack [label $ProfileFrame.1.l1 \
1896	-text " Peak cutoff"]\
1897	-side left
1898	pack [entry $ProfileFrame.1.e1 \
1899	-width 10 -textvariable entryvar(pcut_$i)]\
1900	-side left
1901	set entrybox(pcut_$i) $ProfileFrame.1.e1
1902	set entrycmd(pcut_$i) "hapinfo $hist $i pcut"
1903	set entryvar(pcut_$i) [hapinfo $hist $i pcut]
1904
1905	pack [button $ProfileFrame.1.b1 \
1906	-text "Change Type" \
1907	-command "ChangeProfileType $hist $i"]\
1908	-side left
1909
1910	set col -1
1911	set row 1
1912	set nterms [hapinfo $hist $i profterms]
1913	set lbls "dummy [GetProfileTerms $i $hist $ptype]"
1914	for { set num 1 } { $num <= $nterms } { incr num } {
1915	set term {}
1916	catch {set term [lindex $lbls $num]}
1917	if {$term == ""} {set term $num}
1918	incr col
1919	grid [label $ProfileFrame.l${num}_${i} -text "$term"] \
1920	-row $row -column $col
1921	incr col
1922	grid [checkbutton $ProfileFrame.ref${num}_${i} \
1923	-variable entryvar(pref${num}_$i)] -row $row -column $col
1924	set entrycmd(pref${num}_$i) "hapinfo $hist $i pref$num"
1925	set entryvar(pref${num}_$i) [hapinfo $hist $i pref$num]
1926	incr col
1927	grid [entry $ProfileFrame.ent${num}_${i} \
1928	-textvariable entryvar(pterm${num}_$i)\
1929	-width 12] -row $row -column $col
1930	set entrybox(pterm${num}_$i) $ProfileFrame.ent${num}_${i}
1931	set entrycmd(pterm${num}_$i) "hapinfo $hist $i pterm$num"
1932	set entryvar(pterm${num}_$i) [hapinfo $hist $i pterm$num]
1933	if {$col > 6} {set col -1; incr row}
1934	}
1935	}
1936	grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
1937	} else {
1938	# get histogram list
1939	set histlist {}
1940	foreach item $expgui(curhist) {
1941	lappend histlist [lindex $expmap(powderlist) $item]
1942	}
1943	# must have at least one histogram selected here
1944	if {[llength $histlist] == 0} return
1945	# disable traces on entryvar for right now
1946	set entrycmd(trace) 0
1947	# loop through histograms & phases, set up an array by phase & profile type
1948	catch {unset prtyparray histarray phasearray}
1949	foreach hist $histlist {
1950	foreach phase $expmap(phaselist_$hist) {
1951	set prtyp [string trim [hapinfo $hist $phase proftype]]
1952	set key ${prtyp}_$phase
1953	lappend prtyparray($key) $hist
1954	lappend histarray($key) $hist
1955	lappend phasearray($key) $phase
1956	}
1957	}
1958
1959	set ptype ""
1960	set i -1
1961	# loop over all combined phases and profile types, sorted 1st by profile number
1962	foreach key [lsort [array names prtyparray]] {
1963	# split key
1964	scan $key %d_%d prftyp p
1965
1966	if {$ptype != $prftyp \|\| !$expgui(globalphasemode)} {
1967	set ptype $prftyp
1968	set curhistlist $histarray($key)
1969	set curphaslist $phasearray($key)
1970
1971	set hist1 [lindex $curhistlist 0]
1972	set phase1 [lindex $curphaslist 0]
1973	set nterms [hapinfo $hist1 $phase1 profterms]
1974	set htype [string range $expmap(htype_$hist1) 2 2]
1975	set lbls "dummy [GetProfileTerms $phase1 $hist1 $ptype]"
1976	# Create a frame for this type
1977	incr i
1978	set boxtitle "Phase $p, hist [CompressList $histarray($key)]"
1979	if {$expgui(haveBW)} {
1980	grid [TitleFrame $expgui(ProfileBox).f.$i \
1981	-text "(type $ptype)" \
1982	-relief groove -bd 2] \
1983	-column 0 -row $i -sticky ew
1984	set ProfileFrame [$expgui(ProfileBox).f.$i getframe]
1985	grid [frame $ProfileFrame.0] \
1986	-column 0 -row 0 -columnspan 20 -sticky ew
1987	} else {
1988	grid [frame $expgui(ProfileBox).f.$i \
1989	-relief groove -bd 4] \
1990	-column 0 -row $i -sticky ew
1991	set ProfileFrame $expgui(ProfileBox).f.$i
1992	grid [frame $ProfileFrame.0] \
1993	-column 0 -row 0 -columnspan 20 -sticky ew
1994	grid [label $ProfileFrame.0.0 \
1995	-text "Profile Type $ptype "] -row 0 -column 0
1996	}
1997	grid [label $ProfileFrame.0.1 \
1998	-anchor w] -row 0 -column 1
1999	grid [frame $ProfileFrame.1] \
2000	-column 0 -row 1 -columnspan 20 -sticky ew
2001	grid [label $ProfileFrame.1.2 \
2002	-text "Damping"] -row 0 -column 2
2003	tk_optionMenu $ProfileFrame.1.tkOptDamp \
2004	entryvar(pdamp_$i) 0 1 2 3 4 5 6 7 8 9
2005	grid $ProfileFrame.1.tkOptDamp -row 0 -column 3
2006	grid [button $ProfileFrame.1.edit \
2007	-text "Global Edit"] -row 0 -column 4 -sticky w
2008	set entryvar(pdamp_$i) [hapinfo $hist $phase pdamp]
2009	grid [button $ProfileFrame.1.b1 -text "Change Type"] \
2010	-row 0 -column 5 -sticky w
2011	set col -1
2012	set row 2
2013	for { set num 1 } { $num <= $nterms } { incr num } {
2014	set term {}
2015	catch {set term [lindex $lbls $num]}
2016	if {$term == ""} {set term $num}
2017	incr col
2018	grid [label $ProfileFrame.l${num}_${i} \
2019	-text "$term"] -row $row -column $col
2020	incr col
2021	grid [checkbutton $ProfileFrame.ref${num}_${i} \
2022	-variable entryvar(pref${num}_$i)] \
2023	-row $row -column $col
2024	set entryvar(pref${num}_$i) [hapinfo $hist $phase pref$num]
2025	if {$col > 10} {set col -1; incr row}
2026	}
2027	grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
2028	} else {
2029	# add to the current entry
2030	eval lappend curhistlist $histarray($key)
2031	eval lappend curphaslist $phasearray($key)
2032	append boxtitle "\nPhase $p, hist [CompressList $histarray($key)]"
2033	}
2034	$ProfileFrame.0.1 config -text $boxtitle
2035	$ProfileFrame.1.edit config -command "\
2036	EditProfile \"\n$boxtitle\" \
2037	[list $curhistlist] \
2038	[list $curphaslist]"
2039	$ProfileFrame.1.b1 config -command "ChangeProfileType \
2040	[list $curhistlist] [list $curphaslist]"
2041	set entrycmd(pdamp_$i) "hapinfo \
2042	[list $curhistlist] \
2043	[list $curphaslist] pdamp"
2044	for { set num 1 } { $num <= $nterms } { incr num } {
2045	set entrycmd(pref${num}_$i) "hapinfo \
2046	[list $curhistlist] \
2047	[list $curphaslist] pref$num"
2048	}
2049	}
2050	}
2051
2052	# resize the scroll window to match the actual
2053	update idletasks
2054	$expgui(ProfileBox) config -scrollregion [grid bbox $expgui(ProfileBox).f]
2055	$expgui(ProfileBox) config -width [lindex [grid bbox $expgui(ProfileBox).f] 2]
2056	update idletasks
2057	ResizeNotebook
2058	# enable traces on entryvar now
2059	set entrycmd(trace) 1
2060	}
2061
2062	# process the bit settings in the print options
2063	# bitnum -- the number of the bit to be tested/set starting at 0 for the LSBit
2064	proc printsetting {bitnum "action get" "value {}"} {
2065	global entryvar expgui
2066	if {$action == "get"} {
2067	return [expr ([expinfo print] & int(pow(2,$bitnum))) != 0]
2068	} elseif $value {
2069	set newval [expr ([expinfo print] \| int(pow(2,$bitnum)))]
2070	} else {
2071	set newval [expr ([expinfo print] & ~int(pow(2,$bitnum)))]
2072	}
2073	expinfo print set $newval
2074	set expgui(printopt) "Print Options ([expinfo print])"
2075	}
2076
2077	# need to respond to mouse presses -- control variable associated with extract Fobs
2078	# and set the LeBail extraction flags
2079	proc SetupExtractHist {} {
2080	global expgui entrycmd entryvar expmap
2081
2082	# display the selected histograms
2083	$expgui(lsFrame).hs.lbox selection clear 0 end
2084	foreach h $expgui(curhist) {
2085	$expgui(lsFrame).hs.lbox selection set $h
2086	}
2087
2088	# get histogram list
2089	set histlist {}
2090	foreach item $expgui(curhist) {
2091	set hist [lindex $expmap(powderlist) $item]
2092	if {$hist != ""} {lappend histlist $hist}
2093	}
2094	set entrycmd(fobsextract) "histinfo [list $histlist] foextract"
2095	if {[llength $histlist] == 0 \|\| [string trim $histlist] == ""} {
2096	foreach phase {1 2 3 4 5 6 7 8 9} {
2097	$expgui(FobsExtractFrame).l$phase config -fg grey
2098	set expgui(Fextract$phase) {}
2099	foreach item $expgui(ExtractSettingsRadiobuttons) {
2100	${item}$phase config -state disabled -bd 1
2101	}
2102	}
2103	} elseif {[llength $histlist] == 1} {
2104	# disable traces on entryvar
2105	set entrycmd(trace) 0
2106	set entryvar(fobsextract) [histinfo $histlist foextract]
2107	foreach phase {1 2 3 4 5 6 7 8 9} {
2108	# is the phase present?
2109	if {[lsearch -exact $expmap(phaselist_$histlist) $phase] == -1} {
2110	$expgui(FobsExtractFrame).l$phase config -fg grey
2111	set expgui(Fextract$phase) {}
2112	foreach item $expgui(ExtractSettingsRadiobuttons) {
2113	${item}$phase config -state disabled -bd 1
2114	}
2115	} else {
2116	$expgui(FobsExtractFrame).l$phase config -fg black
2117	foreach item $expgui(ExtractSettingsRadiobuttons) {
2118	${item}$phase config -state normal -bd 2
2119	}
2120	set expgui(Fextract$phase) [hapinfo $histlist $phase extmeth]
2121	}
2122	}
2123	} elseif {[llength $histlist] > 1} {
2124	# disable traces on entryvar
2125	set entrycmd(trace) 0
2126	# multiple histograms need phases in any histogram
2127	foreach phase {1 2 3 4 5 6 7 8 9} {
2128	set gotphase($phase) 0
2129	}
2130	foreach hist $histlist {
2131	foreach phase $expmap(phaselist_$hist) {
2132	set gotphase($phase) 1
2133	}
2134	}
2135	foreach phase {1 2 3 4 5 6 7 8 9} {
2136	set expgui(Fextract$phase) {}
2137	if $gotphase($phase) {
2138	$expgui(FobsExtractFrame).l$phase config -fg black
2139	foreach item $expgui(ExtractSettingsRadiobuttons) {
2140	${item}$phase config -state normal -bd 2
2141	}
2142	} else {
2143	$expgui(FobsExtractFrame).l$phase config -fg grey
2144	foreach item $expgui(ExtractSettingsRadiobuttons) {
2145	${item}$phase config -state disabled -bd 1
2146	}
2147	}
2148	}
2149	}
2150	# reenable traces
2151	set entrycmd(trace) 1
2152	}
2153	# respond to a change in the fobs extraction method for a phase
2154	# force the main extraction flag on, if fobs extraction is selected for any phase
2155	proc HistExtractSet {phase} {
2156	global expgui entryvar expmap
2157	foreach item $expgui(curhist) {
2158	lappend histlist [lindex $expmap(powderlist) $item]
2159	}
2160	hapinfo $histlist $phase extmeth set $expgui(Fextract$phase)
2161	incr expgui(changed)
2162	if {$expgui(Fextract$phase) != 0} {set entryvar(fobsextract) 1}
2163	}
2164	#---------------------------- Global Edit Functions ------------------------
2165	proc editbackground {} {
2166	global expgui expmap entrycmd
2167	set histlist {}
2168	foreach n $expgui(curhist) {
2169	lappend histlist [lindex $expmap(powderlist) $n]
2170	}
2171	if {[llength $histlist] == 0} return
2172
2173	set w .back
2174	catch {destroy $w}
2175	toplevel $w -bg beige
2176	if {$expgui(globalmode) != 0} {
2177	wm title $w "Global Edit Background"
2178	} else {
2179	wm title $w "Edit Background"
2180	}
2181
2182	pack [frame $w.0 -bd 6 -relief groove -bg beige \
2183	] -side top -expand yes -fill both
2184	if {[llength $histlist] > 1} {
2185	grid [label $w.0.a \
2186	-text "Setting background terms for histograms [CompressList $histlist]" \
2187	-bg beige] -row 0 -column 0 -columnspan 10
2188	} else {
2189	grid [label $w.0.a \
2190	-text "Setting background terms for histogram $histlist" \
2191	-bg beige] -row 0 -column 0 -columnspan 10
2192	}
2193	set hist [lindex $histlist 0]
2194	grid [label $w.0.b -text "Function type" -bg beige] -row 1 -column 0
2195
2196	# disable traces on expgui(backtype) & expgui(backterms) now
2197	set entrycmd(trace) 0
2198
2199	# number of terms
2200	set expgui(backtype) [histinfo $hist backtype]
2201	set expgui(orig_backtype) $expgui(backtype)
2202	set expgui(prev_backtype) $expgui(backtype)
2203	set typemenu [tk_optionMenu $w.0.type expgui(backtype) null]
2204	$typemenu delete 0 end
2205	foreach item {
2206	"1 - Shifted Chebyshev"
2207	"2 - Cosine Fourier series"
2208	"3 - Radial distribution peaks"
2209	"4 - Power series in Q**2n/n!"
2210	"5 - Power series in n!/Q**2n"
2211	"6 - Power series in Q2n/n! and n!/Q2n"
2212	"7 - Linear interpolation function"
2213	"8 - Reciprocal interpolation function"
2214	} {
2215	set val [lindex $item 0]
2216	$typemenu insert end radiobutton -variable expgui(backtype) \
2217	-label $item -value $val
2218	}
2219
2220	grid $w.0.type -row 1 -column 1
2221	grid [label $w.0.c -text " Number of terms" -bg beige] -row 1 -column 2
2222
2223	# function type
2224	set expgui(backterms) [histinfo $hist backterms]
2225	set expgui(orig_backterms) $expgui(backterms)
2226	set list {}; for {set i 1} {$i <= 36} {incr i} {lappend list $i}
2227	eval tk_optionMenu $w.0.terms expgui(backterms) $list
2228	grid $w.0.terms -row 1 -column 3
2229	# enable traces on expgui(backtype) & expgui(backterms) now
2230	set entrycmd(trace) 1
2231
2232	#set background terms
2233	for {set num 1 } { $num <= 36 } { incr num } {
2234	set var "bterm$num"
2235	set expgui($var) {}
2236	set expgui(orig_$var) {}
2237	}
2238	if {[llength $histlist] == 1} {
2239	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2240	set var "bterm$num"
2241	set expgui($var) [histinfo $histlist $var]
2242	set expgui(orig_$var) $expgui($var)
2243	}
2244	}
2245
2246	pack [frame $w.1 -bd 6 -relief groove -bg beige] -side top \
2247	-expand yes -fill both
2248	ShowBackTerms $w.1
2249
2250	set expgui(temp) {}
2251	pack [frame $w.b] -side top
2252	pack [button $w.b.2 -text Set -command "destroy $w"] -side left
2253	pack [button $w.b.3 -text Quit \
2254	-command "QuitEditBackground $w"] -side left
2255	bind $w <Return> "destroy $w"
2256
2257	# force the window to stay on top
2258	putontop $w
2259
2260	focus $w.b.2
2261	tkwait window $w
2262	afterputontop
2263
2264	if {$expgui(temp) != ""} return
2265
2266	if {$expgui(orig_backtype) != $expgui(backtype)} {
2267	histinfo $histlist backtype set $expgui(backtype)
2268	incr expgui(changed)
2269	}
2270	if {$expgui(orig_backterms) != $expgui(backterms)} {
2271	histinfo $histlist backterms set $expgui(backterms)
2272	incr expgui(changed)
2273	}
2274	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2275	set var "bterm$num"
2276	if {$expgui(orig_$var) != $expgui($var)} {
2277	histinfo $histlist $var set $expgui($var)
2278	incr expgui(changed)
2279	}
2280	}
2281
2282	if {$expgui(globalmode) == 0} {
2283	set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
2284	set expgui(backtermlbl) "([histinfo $hist backterms] terms)"
2285	}
2286	}
2287
2288	trace variable expgui(backterms) w ChangeBackTerms
2289	proc ChangeBackTerms {a b c} {
2290	global entrycmd expgui
2291	if !$entrycmd(trace) return
2292	ShowBackTerms .back.1
2293	}
2294
2295	trace variable expgui(backtype) w ChangeBackType
2296	# reset the terms to 1, 0, 0... when the number of terms increase
2297	proc ChangeBackType {a b c} {
2298	global entrycmd expgui
2299	if !$entrycmd(trace) return
2300	if {$expgui(prev_backtype) == $expgui(backtype)} return
2301	set expgui(prev_backtype) $expgui(backtype)
2302	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2303	set var "bterm$num"
2304	if {$num == 1} {
2305	set expgui($var) 1.0
2306	} else {
2307	set expgui($var) 0.0
2308	}
2309	}
2310	}
2311
2312	proc ShowBackTerms {w } {
2313	global expgui expmap
2314	# destroy the contents of the frame
2315	eval destroy [winfo children $w]
2316	set histlist {}
2317	foreach n $expgui(curhist) {
2318	lappend histlist [lindex $expmap(powderlist) $n]
2319	}
2320	set widgetsPerRow 4
2321	for {set rows 2; set num 1 } { $num <= $expgui(backterms) } { incr rows } {
2322	for {set cols 0} { (2*$widgetsPerRow > $cols) && ($num <= $expgui(backterms)) } { incr num } {
2323	set var "bterm$num"
2324	grid [label $w.l$num -text $num -bg beige] \
2325	-row $rows -column $cols -sticky nes
2326	incr cols
2327	grid [entry $w.e$num -width 15 -textvariable expgui($var) \
2328	] -row $rows -column $cols -sticky news
2329	incr cols
2330	}
2331	}
2332	}
2333
2334	proc QuitEditBackground {w} {
2335	global expgui
2336	# lets find out if anything changed
2337	set changed 0
2338	if {$expgui(orig_backtype) != $expgui(backtype)} {
2339	set changed 1
2340	}
2341	if {$expgui(orig_backterms) != $expgui(backterms)} {
2342	set changed 1
2343	}
2344	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2345	set var "bterm$num"
2346	if {$expgui(orig_$var) != $expgui($var)} {
2347	set changed 1
2348	break
2349	}
2350	}
2351	if $changed {
2352	set decision [tk_dialog .changes "Abandon Changes" \
2353	"You have made changes to the background. Ok to abandon changes?" \
2354	warning 0 Abandon Keep]
2355	if !$decision {
2356	set expgui(temp) "Quit"
2357	destroy $w
2358	}
2359	} else {
2360	set expgui(temp) "Quit"
2361	destroy $w
2362	}
2363	}
2364
2365	# this probably needs work
2366	proc editglobalparm {cmd variable title "histlist {}" "phase {}"} {
2367	global expgui expmap
2368	set w .global
2369	catch {destroy $w}
2370	toplevel $w -bg beige
2371	wm title $w "Edit Global Parameter"
2372	set expgui(temp) {}
2373	if {[llength $histlist] == 0} {
2374	set hist {}
2375	foreach n $expgui(curhist) {
2376	lappend hist [lindex $expmap(powderlist) $n]
2377	}
2378	} else {
2379	set hist $histlist
2380	}
2381	pack [frame $w.0 -bd 6 -relief groove -bg beige] \
2382	-side top -expand yes -fill both
2383	grid [label $w.0.a -text "Setting $title for histograms [CompressList $hist]"\
2384	-bg beige] \
2385	-row 0 -column 0 -columnspan 10
2386	grid [entry $w.0.b -textvariable expgui(temp)] \
2387	-row 1 -column 0
2388
2389
2390	pack [frame $w.b] -side top
2391	pack [button $w.b.2 -text Set -command "destroy $w"] -side left
2392	pack [button $w.b.3 -text Quit -command "set expgui(temp) {}; destroy $w"] -side left
2393	bind $w <Return> "destroy $w"
2394
2395	# force the window to stay on top
2396	putontop $w
2397	focus $w.b.2
2398	tkwait window $w
2399	afterputontop
2400
2401	if {$expgui(temp) != ""} {
2402	foreach h $hist {
2403	if {$cmd == "histinfo"} {
2404	histinfo $h $variable set $expgui(temp)
2405	incr expgui(changed)
2406	if $expgui(debug) {
2407	puts "histinfo $h $variable set $expgui(temp)"
2408	}
2409	} elseif {$cmd == "hapinfo"} {
2410	hapinfo $h $phase $variable set $expgui(temp)
2411	incr expgui(changed)
2412	if $expgui(debug) {
2413	puts "hapinfo $phase $h $variable set $expgui(temp)"
2414	}
2415	} else {
2416	error "$cmd unimplemented"
2417	}
2418	}
2419	}
2420	}
2421
2422	proc EditProfile {title histlist phaselist} {
2423	global expgui expmap entrycmd
2424	set w .back
2425	catch {destroy $w}
2426	toplevel $w -bg beige
2427	wm title $w "Global Edit Profile"
2428	set hist [lindex $histlist 0]
2429	set phase [lindex $phaselist 0]
2430	set ptype [string trim [hapinfo $hist $phase proftype]]
2431	set htype [string range $expmap(htype_$hist) 2 2]
2432	set nterms [hapinfo $hist $phase profterms]
2433
2434	pack [frame $w.0 -bd 6 -relief groove -bg beige \
2435	] -side top -expand yes -fill both
2436	grid [label $w.0.a \
2437	-text "Setting profile terms: $title" \
2438	-bg beige] -row 0 -column 0 -columnspan 10
2439	grid [label $w.0.b -text "Function type $ptype" -bg beige] -row 1 -column 0
2440	grid [label $w.0.c -text " Peak cutoff" -bg beige] -row 1 -column 3
2441	grid [entry $w.0.d -width 10 ] -row 1 -column 4
2442	set entrylist {}
2443	lappend entrylist "pcut $w.0.d"
2444
2445	set col -1
2446	set row 1
2447	set lbls "dummy [GetProfileTerms $phase $hist $ptype]"
2448	pack [frame $w.1 -bd 6 -relief groove -bg beige \
2449	] -side top -expand yes -fill both
2450	for { set num 1 } { $num <= $nterms } { incr num } {
2451	set term {}
2452	catch {set term [lindex $lbls $num]}
2453	if {$term == ""} {set term $num}
2454	incr col
2455	grid [label $w.1.l${num} -text "$term" -bg beige] \
2456	-row $row -column $col
2457	incr col
2458	grid [entry $w.1.ent${num} \
2459	-width 14] -row $row -column $col
2460	lappend entrylist "pterm$num $w.1.ent${num}"
2461	if {$col > 6} {set col -1; incr row}
2462	}
2463	pack [frame $w.b] -side top
2464	pack [button $w.b.2 -text Set \
2465	-command "SetEditProfile [list $entrylist] [list $phaselist] \
2466	[list $histlist] $w"] -side left
2467	pack [button $w.b.3 -text Quit \
2468	-command "QuitEditProfile $w [list $entrylist]"] -side left
2469	bind $w <Return> "destroy $w"
2470
2471	# force the window to stay on top
2472	putontop $w
2473	focus $w.b.2
2474	tkwait window $w
2475	afterputontop
2476	}
2477
2478	proc SetEditProfile {entrylist phaselist histlist w} {
2479	global expgui
2480	foreach item $entrylist {
2481	set value [ [lindex $item 1] get ]
2482	if {$value != ""} {
2483	hapinfo $histlist $phaselist [lindex $item 0] set $value
2484	incr expgui(changed)
2485	if $expgui(debug) {
2486	puts "hapinfo [list $phaselist] [list $histlist] [lindex $item 0] set $value"
2487	}
2488	}
2489	}
2490	destroy $w
2491	}
2492
2493	proc QuitEditProfile {w entrylist} {
2494	global expgui
2495	# lets find out if anything changed
2496	set changed 0
2497	foreach item $entrylist {
2498	if {[ [lindex $item 1] get ] != ""} {set changed 1; break}
2499	}
2500	if $changed {
2501	set decision [tk_dialog .changes "Abandon Changes" \
2502	"You have made changes to the Profile. Ok to abandon changes?" \
2503	warning 0 Abandon Keep]
2504	if !$decision {destroy $w}
2505	} else {
2506	destroy $w
2507	}
2508	}
2509
2510	##############################################################################
2511	## #############################################
2512	## END OF THE PROCEDURES SECTION #############################################
2513	## #############################################
2514	##############################################################################
2515
2516	# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
2517	# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< <<<<<<<<<<<<<<<<<<<
2518	# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< BEGIN: GUI SECTION >>>>>>>>>>>>>>>>>>>
2519	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>
2520	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
2521	# A frame for menu items at top of display
2522	set expgui(fm) [frame .fm -relief raised -borderwidth 2 -width 150 -height 40]
2523	# Pack the menu frame.
2524	pack $expgui(fm) -fill x -side top -anchor n
2525
2526	# create a button bar
2527	pack [frame .bar -relief raised -bd 2 -bg beige] -fill x -side top -anchor n
2528
2529	# Creating the notebook with 5 panes: Phase, Histogram, Scaling, Profile
2530	# & LS controls
2531	# 0 name,
2532	# 1 title
2533	# 2 create command
2534	# 3 raise command
2535	# 4 disable page in global mode (0/1)
2536
2537	if $expgui(haveBW) {
2538	pack [NoteBook .n -bd 2] -expand yes -fill both
2539	# create an array element describing each notebook page
2540	# element 0 -- pane name
2541	# 1 -- Label on frame
2542	# 2 -- initialization command
2543	# 3 -- update command
2544	# 4 -- 0/1 Use 1 if pane should be disabled in when all histograms
2545	# are selected in global mode, 0 otherwise
2546	set expgui(notebookpagelist) {
2547	{lsFrame "LS Controls" \
2548	"" \
2549	SetupExtractHist \
2550	0}
2551	{phaseFrame Phase \
2552	"" \
2553	"SelectOnePhase \$expgui(curPhase); DisplayAllAtoms noreset" \
2554	0}
2555	{histFrame Histogram \
2556	MakeHistPane \
2557	DisplayHistogram \
2558	1}
2559	{fracFrame Scaling \
2560	MakeScalingPane \
2561	DisplayFrac \
2562	0}
2563	{profFrame Profile \
2564	MakeProfilePane \
2565	DisplayProfile \
2566	1}
2567	{consFrame Constraints \
2568	"source [file join $expgui(scriptdir) atomcons.tcl]; MakeConstraintsPane" \
2569	DisplayConstraintsPane \
2570	0}
2571	{orientFrame "MD Pref Orient" \
2572	MakeOrientPane \
2573	DisplayOrient \
2574	0}
2575	{odfFrame "SH Pref Orient" \
2576	"source [file join $expgui(scriptdir) odf.tcl]; MakeODFPane" \
2577	DisplayODFPane \
2578	0}
2579	}
2580	foreach item $expgui(notebookpagelist) {
2581	set frm [lindex $item 0]
2582	set expgui($frm) [\
2583	.n insert end $frm -text [lindex $item 1] \
2584	-createcmd [lindex $item 2] \
2585	-raisecmd "set expgui(pagenow) $frm; [lindex $item 3]"]
2586
2587	# at this time expgui(frameactionlist) is generated
2588	# from expgui(notebookpagelist), but in the future it might
2589	# make sense to use expgui(notebookpagelist) directly
2590	lappend expgui(frameactionlist) "$frm [list [lindex $item 3]]"
2591
2592	# panes to disable in global "all" mode
2593	if {[lindex $item 4]} {
2594	lappend expgui(GlobalModeAllDisable) \
2595	"$frm \{.n itemconfigure $frm\}"
2596	}
2597	}
2598	} else {
2599	Notebook:create .n \
2600	-pages {lsFrame phaseFrame histFrame fracFrame profFrame}
2601	pack .n -anchor w -fill both -expand yes
2602	foreach item {lsFrame phaseFrame histFrame fracFrame profFrame \
2603	orientFrame} \
2604	page {"LS Controls" Phase Histogram Scaling Profile \
2605	"MD Pref Orient"} {
2606	set expgui($item) [Notebook:frame .n $item]
2607	Notebook:pageconfig .n $item -command "InitPage $item" -title $page
2608	}
2609	lappend expgui(frameactionlist) "lsFrame SetupExtractHist"
2610	lappend expgui(frameactionlist) "phaseFrame {DisplayAllAtoms noreset}"
2611	lappend expgui(frameactionlist) "histFrame DisplayHistogram"
2612	lappend expgui(frameactionlist) "fracFrame DisplayFrac"
2613	lappend expgui(frameactionlist) "profFrame DisplayProfile"
2614	lappend expgui(frameactionlist) "orientFrame DisplayOrient"
2615	set expgui(GlobalModeAllDisable) {}
2616	lappend expgui(GlobalModeAllDisable) "histFrame {Notebook:pageconfig .n histFrame}"
2617	lappend expgui(GlobalModeAllDisable) "profFrame {Notebook:pageconfig .n profFrame}"
2618	}
2619
2620	# this is used to bring up the selected frame
2621	proc RaisePage {nextpage} {
2622	global expgui
2623	if $expgui(haveBW) {
2624	.n see $nextpage
2625	.n raise $nextpage
2626	set expgui(pagenow) $nextpage
2627	} else {
2628	Notebook:raise .n $nextpage
2629	InitPage $nextpage
2630	}
2631	}
2632	# this is only called when BWidget is not in use
2633	proc InitPage {nextpage} {
2634	global expgui
2635	set expgui(pagenow) $nextpage
2636	UpdateCurrentPage
2637	}
2638	# resize the notebook to fit all the tabs and the largest page
2639	proc ResizeNotebook {} {
2640	global expgui
2641	if {$expgui(haveBW)} {
2642	.n compute_size
2643	} else {
2644	Notebook:resize .n
2645	}
2646	}
2647
2648	#----------------------------------------------------------------------------
2649	proc MakePhasePane {} {
2650	#\/ \/ \/ \/ \/ \/ \/ BEGINNING OF PHASE PANE CODE \/ \/ \/ \/ \/ \/ \/
2651	global expgui entryvar entrybox entrycmd
2652	frame $expgui(phaseFrame).top
2653	set frameLatt [frame $expgui(phaseFrame).frameLatt]
2654	# This is a big frame in the Phase notebook pane to hold atomic data.
2655	set fbig [frame $expgui(phaseFrame).fbig -width 180 \
2656	-relief raised -borderwidth 4]
2657	# This is a frame just below the big frame: for edits
2658	set frame3 [frame $expgui(phaseFrame).frame3 -width 100 \
2659	-relief raised -borderwidth 4 -bg $expgui(bkgcolor1)]
2660
2661	grid $expgui(phaseFrame).top -sticky news -row 0 -column 0
2662	grid $frameLatt -sticky news -row 2 -column 0
2663	grid $fbig -sticky news -row 3 -column 0
2664	# give extra space to the atoms box
2665	grid columnconfigure $expgui(phaseFrame) 0 -weight 1
2666	grid rowconfigure $expgui(phaseFrame) 3 -weight 1
2667	grid $frame3 -sticky news -row 4 -column 0
2668	grid columnconfigure $expgui(phaseFrame) 0 -weight 1
2669	grid rowconfigure $expgui(phaseFrame) 3 -weight 1
2670	grid [frame $expgui(phaseFrame).top.ps] -column 0 -row 0 -sticky w
2671	# this is where the buttons will go
2672	pack [label $expgui(phaseFrame).top.ps.0 -text "No Phases"] -side left
2673
2674	grid [label $expgui(phaseFrame).top.lA -text title: \
2675	-fg blue ] -column 1 -row 0 -sticky e
2676	grid [entry $expgui(phaseFrame).top.lB -textvariable entryvar(phasename) \
2677	-fg blue -width 45] -column 2 -row 0 -sticky e
2678	grid columnconfigure $expgui(phaseFrame).top 1 -weight 1
2679	# ------------- Lattice Parameter Box ------------------
2680	set row 0
2681	foreach col {2 4 6} var {a b c} lbl {a b c} {
2682	grid [label $frameLatt.l$var -text $lbl] \
2683	-column $col -row $row -padx 5 -sticky e
2684	incr col
2685	grid [entry $frameLatt.e$var -textvariable entryvar($var) -width 10] \
2686	-column $col -row $row -padx 5
2687	set entrybox($var) $frameLatt.e$var
2688	}
2689	incr row
2690	foreach col {2 4 6} var {alpha beta gamma} lbl {a b g} {
2691	grid [label $frameLatt.l$var -text $lbl -font symbol] \
2692	-column $col -row $row -padx 5 -sticky e
2693	incr col
2694	grid [entry $frameLatt.e$var -textvariable entryvar($var) -width 10] \
2695	-column $col -row $row -padx 5
2696	set entrybox($var) $frameLatt.e$var
2697	}
2698
2699	grid [label $frameLatt.lr -text "Refine Cell"] -column 8 -row 0 -padx 5 -sticky e
2700	grid [label $frameLatt.ld -text "Cell damping"] -column 8 -row 1 -padx 5 -sticky e
2701	set cFlag [checkbutton $frameLatt.c -text "" -variable entryvar(cellref)]
2702	grid $cFlag -column 9 -row 0 -padx 5 -sticky e
2703	tk_optionMenu $frameLatt.om entryvar(celldamp) 0 1 2 3 4 5 6 7 8 9
2704	grid $frameLatt.om -column 9 -row 1 -padx 5 -sticky e
2705	grid [label $frameLatt.phasetype -textvariable expgui(phasetype) -fg blue] \
2706	-column 1 -row 0 -rowspan 2
2707	if [file executable $expgui(exptool)] {
2708	grid [button $frameLatt.newp -text Replace\nPhase \
2709	-command MakeReplacePhaseBox] \
2710	-column 0 -row 0 -rowspan 2 -sticky w
2711	}
2712	grid columnconfig $frameLatt 1 -weight 1
2713	grid columnconfig $frameLatt 0 -weight 1
2714	#-------------- Begin Atom Coordinates Box ------------------------------
2715	grid [listbox $fbig.title -height 1 -relief flat \
2716	-exportselection 0 -bg lightgrey -fg black \
2717	-selectforeground black -selectbackground lightgrey] \
2718	-row 0 -column 0 -sticky ew
2719	set expgui(atomtitle) $fbig.title
2720	bind $expgui(atomtitle) <Button-1> {
2721	set i [lsearch {number type mult x y z occupancy} $expgui(asorttype)]
2722	incr i
2723	set expgui(asorttype) [lindex {number type mult x y z occupancy number} $i]
2724	DisplayAllAtoms
2725	}
2726	bind $expgui(atomtitle) <Button-3> {set expgui(asorttype) number; DisplayAllAtoms}
2727
2728	$expgui(atomtitle) configure -font $expgui(coordfont) -selectmode extended
2729	grid [listbox $fbig.lbox -height 10 \
2730	-exportselection 0 \
2731	-xscrollcommand " $fbig.bscr set"\
2732	-yscrollcommand " $fbig.rscr set"\
2733	] -row 1 -column 0 -sticky news
2734	set expgui(atomlistbox) $fbig.lbox
2735	$expgui(atomlistbox) configure -font $expgui(coordfont) -selectmode extended
2736	grid [scrollbar $fbig.bscr -orient horizontal \
2737	-command "move2boxes \" $fbig.title $fbig.lbox \" " \
2738	] -row 2 -column 0 -sticky ew
2739	grid [scrollbar $fbig.rscr -command "$fbig.lbox yview" \
2740	] -row 1 -column 1 -sticky ns
2741	# give extra space to the atoms box
2742	grid columnconfigure $fbig 0 -weight 1
2743	grid rowconfigure $fbig 1 -weight 1
2744
2745	# BIND mouse in editbox
2746	bind $expgui(atomlistbox) <ButtonRelease-1> editRecord
2747	bind $expgui(atomlistbox) <Button-3> SelectAllAtoms
2748
2749	#-------------- End Atoms Section ---------------------------------
2750
2751	# --------------------------- Begin Edit Box ------------------------
2752	grid [set expgui(EditingAtoms) [label $frame3.top -bg $expgui(bkgcolor1) -fg blue]] \
2753	-column 0 -row 0 -padx 2 -pady 3 -columnspan 10 -sticky w
2754	if [file executable $expgui(exptool)] {
2755	button $frame3.newa -text "Add New Atoms" \
2756	-bg $expgui(bkgcolor1) -highlightthickness 0 \
2757	-command {MakeAddAtomsBox $expgui(curPhase)}
2758	grid $frame3.newa -column 11 -row 0
2759	}
2760	button [set expgui(atomxform) $frame3.xa] \
2761	-bg $expgui(bkgcolor1) -highlightthickness 0 \
2762	-command {MakeXformAtomsBox $expgui(curPhase)}
2763	grid $expgui(atomxform) -column 11 -row 1 -sticky ew
2764
2765	set f3l1 [label $frame3.l1 -text "Refinement Flags:" -bg $expgui(bkgcolor1)]
2766	grid $f3l1 -column 0 -row 1 -padx 2 -sticky nsw -pady 3
2767	foreach lbl {X U F} var {xref uref fref} col {1 2 3} {
2768	grid [checkbutton $frame3.cf$col \
2769	-text $lbl -variable entryvar($var) \
2770	-bg $expgui(bkgcolor1) -highlightthickness 0 \
2771	-activebackground $expgui(bkgcolor1)] \
2772	-column $col -row 1 -padx 4 -pady 3 -sticky w
2773	}
2774	set f3l4 [label $frame3.l4 -text " Damping:" -bg $expgui(bkgcolor1)]
2775	grid $f3l4 -column 4 -row 1 -padx 2 -sticky nsw -pady 3
2776
2777	set col 4
2778	foreach var {xdamp udamp fdamp} num {2 3 4} lbl {X U F} {
2779	grid [label $frame3.lom$num -text $lbl \
2780	-bg $expgui(bkgcolor1)] \
2781	-column [incr col] -row 1 -padx 2 -pady 3 -sticky w
2782	tk_optionMenu $frame3.om$num entryvar($var) 0 1 2 3 4 5 6 7 8 9
2783	$frame3.om$num config -highlightthickness 0
2784	grid $frame3.om$num -column [incr col] -row 1 -padx 2 -pady 3 -sticky w
2785	}
2786	set expgui(atomreflbl) "$frame3.l1 $frame3.l4 $frame3.lom2 $frame3.lom3 $frame3.lom4 "
2787	set expgui(atomref) "$frame3.cf1 $frame3.cf2 $frame3.cf3 $frame3.om2 $frame3.om3 $frame3.om4"
2788
2789	set coords [frame $frame3.coords -width 100 -borderwidth 0 -bg $expgui(bkgcolor1)]
2790	grid $coords -column 0 -row 6 -columnspan 12 -sticky nsew
2791
2792	set f3l1 [label $frame3.coords.l1 -text "Label" -bg $expgui(bkgcolor1)]
2793	grid $f3l1 -column 0 -row 4 -padx 2 -sticky nsw -pady 3
2794	set expgui(atomlabels) $f3l1
2795
2796	set f3e1 [entry $frame3.coords.e1 -textvariable entryvar(label) -width 6]
2797	grid $f3e1 -column 1 -row 4 -padx 2 -sticky nsw -pady 3
2798	set expgui(atomentry) $f3e1
2799
2800	set f3l8 [label $frame3.coords.l8 -text "Coordinates" -bg $expgui(bkgcolor1)]
2801	grid $f3l8 -column 2 -row 4 -padx 2 -sticky nsw -pady 3
2802	lappend expgui(atomlabels) $f3l8
2803	set f3l11 [label $frame3.coords.l11 -text "Occupancy" -bg $expgui(bkgcolor1)]
2804	grid $f3l11 -column 6 -row 4 -padx 2 -sticky nsw -pady 3
2805	lappend expgui(atomlabels) $f3l11
2806
2807	foreach var {x y z frac} col {3 4 5 7} {
2808	set entrybox($var) [entry $frame3.coords.e$var \
2809	-textvariable entryvar($var) -width 10]
2810	grid $entrybox($var) -column $col -row 4 -padx 2 -sticky nsw -pady 3
2811	lappend expgui(atomentry) $entrybox($var)
2812	}
2813
2814
2815	set f3f31 [frame $frame3.f3f31 -width 100 -borderwidth 0 -bg $expgui(bkgcolor1)]
2816	grid $f3f31 -column 0 -row 7 -columnspan 12
2817	set expgui(anisolabels) {}
2818	foreach lbl {13 14 15 16 17 18} txt {Uiso U22 U33 U12 U13 U23} {
2819	lappend expgui(anisolabels) [\
2820	label $f3f31.l$lbl -text $txt -bg $expgui(bkgcolor1)
2821	]
2822	}
2823	set expgui(anisoentry) {}
2824	foreach i {e13 e14 e15 e16 e17 e18} var {U11 U22 U33 U12 U13 U23} {
2825	lappend expgui(anisoentry) [\
2826	entry $f3f31.$i -textvariable entryvar($var) \
2827	-width 10]
2828	set entrybox($var) $f3f31.$i
2829	}
2830
2831	set col 0
2832	foreach item1 $expgui(anisolabels) item2 $expgui(anisoentry) {
2833	grid $item1 -column $col -row 0 -sticky nsw -pady 3
2834	incr col
2835	grid $item2 -column $col -row 0 -sticky nsw -pady 3
2836	incr col
2837	}
2838	# --------------------------- End Edit Box -------------------------
2839
2840	#/\ /\ /\ /\ /\ /\ /\ END OF PHASE PANE CODE /\ /\ /\ /\ /\ /\ /\ /\ /
2841	# resize in case the pane needs more space
2842	ResizeNotebook
2843	}
2844
2845	proc move2boxes {boxlist args} {
2846	foreach listbox $boxlist {
2847	eval $listbox xview $args
2848	}
2849	}
2850	#-----------------------------------------------------------------------------
2851	proc MakeHistPane {} {
2852	#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
2853	global expgui
2854
2855	grid columnconfigure $expgui(histFrame) 0 -weight 1
2856	grid rowconfigure $expgui(histFrame) 1 -weight 1
2857	grid rowconfigure $expgui(histFrame) 2 -weight 1
2858	grid rowconfigure $expgui(histFrame) 3 -weight 1
2859
2860	grid [frame $expgui(histFrame).hs] \
2861	-column 0 -row 0 -rowspan 10 -sticky nsew
2862	MakeHistBox $expgui(histFrame).hs
2863	bind $expgui(histFrame).hs.lbox <ButtonRelease-1> {
2864	set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
2865	DisplayHistogram
2866	}
2867	bind $expgui(histFrame).hs.lbox <Button-3> {
2868	if $expgui(globalmode) {
2869	$expgui(histFrame).hs.lbox selection set 0 end
2870	set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
2871	DisplayHistogram
2872	}
2873	}
2874
2875	frame $expgui(histFrame).top -borderwidth 4 -relief groove
2876	grid [label $expgui(histFrame).top.txt] -row 0 -column 0
2877	if $expgui(haveBW) {
2878	foreach item {backBox diffBox} num {2 3} \
2879	title {Background "Diffractometer Constants"} {
2880	TitleFrame $expgui(histFrame).$item \
2881	-borderwidth 4 -side left -relief groove -text $title
2882	set expgui($item) [$expgui(histFrame).$item getframe]
2883	grid $expgui(histFrame).$item -column 1 -row $num -sticky nsew
2884	grid rowconfigure $expgui(histFrame) $num -minsize 100
2885	}
2886	} else {
2887	foreach item {backBox diffBox} num {1 2} \
2888	title {Background "Diffractometer Constants"} {
2889	frame $expgui(histFrame).$item -borderwidth 4 -relief groove
2890	grid $expgui(histFrame).$item -column 1 -row $num -sticky nsew
2891	set expgui($item) $expgui(histFrame).$item
2892	grid [label $expgui(histFrame).$item.title -text $title] \
2893	-row 0 -column 0 -columnspan 10 -sticky nw
2894	}
2895	}
2896	if [file executable $expgui(exptool)] {
2897	button $expgui(histFrame).newh -text "Add New Histogram" -command MakeAddHistBox
2898	grid $expgui(histFrame).newh -column 1 -row 6
2899	}
2900
2901	# BACKGROUND information.
2902	# <<<<<<<<<<<<<<<<<<<<<<<<< BACKGROUND <<<<<<<<<<<<<<<<<<<<<
2903	grid [frame $expgui(backBox).frm1 ] -row 0 -column 0 -columnspan 11
2904	grid [label $expgui(backBox).frm1.lBGType \
2905	-textvariable expgui(backtypelbl)] \
2906	-row 1 -column 0 -sticky nws -padx 2 -pady 3
2907	grid [label $expgui(backBox).frm1.lBGTerms \
2908	-textvariable expgui(backtermlbl)] \
2909	-row 1 -column 1 -sticky nws -padx 2 -pady 3
2910	grid [button $expgui(backBox).frm1.edit -textvariable expgui(bkglbl) \
2911	-command editbackground] \
2912	-row 1 -column 2 -columnspan 3 -sticky w -padx 2 -pady 3
2913	grid [frame $expgui(backBox).frm2 ] \
2914	-row 1 -column 0 -columnspan 11 -sticky e
2915	grid [label $expgui(backBox).frm2.lfBG -text " Refine background" ] \
2916	-row 2 -column 1 -sticky news -padx 4 -pady 3
2917	grid [checkbutton $expgui(backBox).frm2.rfBG -text "" \
2918	-variable entryvar(bref) ] \
2919	-row 2 -column 2 -sticky news -padx 4 -pady 3
2920	grid [label $expgui(backBox).frm2.lBGDamp -text Damping ] \
2921	-row 2 -column 3 -sticky w -padx 2 -pady 3
2922	tk_optionMenu $expgui(backBox).frm2.om entryvar(bdamp) 0 1 2 3 4 5 6 7 8 9
2923	grid $expgui(backBox).frm2.om \
2924	-row 2 -column 4 -sticky news -padx 4 -pady 3 -sticky e
2925	#^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^END OF HISTOGRAM PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
2926	# insert the histograms & resize in case the pane needs more space
2927	sethistlist
2928	ResizeNotebook
2929	}
2930	###############################################################################
2931	proc MakeScalingPane {} {
2932	#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
2933	global expgui entryvar entrybox
2934
2935	pack [frame $expgui(fracFrame).hs] -side left -expand y -fill both
2936	MakeHistBox $expgui(fracFrame).hs
2937	bind $expgui(fracFrame).hs.lbox <ButtonRelease-1> {
2938	set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
2939	DisplayFrac
2940	}
2941	bind $expgui(fracFrame).hs.lbox <Button-3> {
2942	if $expgui(globalmode) {
2943	$expgui(fracFrame).hs.lbox selection set 0 end
2944	set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
2945	DisplayFrac
2946	}
2947	}
2948
2949	pack [frame $expgui(fracFrame).f1] -fill both -expand true
2950	# Create a large canvas area containing a frame for each phase in the data set.
2951	# The canvas and vertical scrollbar are inside a frame called f1
2952	if $expgui(haveBW) {
2953	TitleFrame $expgui(fracFrame).f1.scaleBox \
2954	-borderwidth 4 -text "Scale Factor"
2955	# -borderwidth 4 -width 600 -height 100 -label "Scale Factor"
2956	grid $expgui(fracFrame).f1.scaleBox -column 0 -row 0 -sticky nsew -columnspan 2
2957	set expgui(scaleBox) [$expgui(fracFrame).f1.scaleBox getframe]
2958	grid [label $expgui(scaleBox).histSFLabel -text Scale] \
2959	-row 1 -column 0 -sticky nws -padx 2 -pady 3
2960	} else {
2961	frame $expgui(fracFrame).f1.scaleBox -borderwidth 4 -relief groove
2962	grid $expgui(fracFrame).f1.scaleBox -column 0 -row 0 -sticky nsew -columnspan 2
2963	set expgui(scaleBox) $expgui(fracFrame).f1.scaleBox
2964	grid [label $expgui(scaleBox).histSFLabel -text "Scale Factor"] \
2965	-row 1 -column 0 -sticky nws -padx 2 -pady 3
2966	}
2967	grid [entry $expgui(scaleBox).ent1 -textvariable entryvar(scale) -width 15] \
2968	-row 1 -column 1 -sticky ew -padx 4 -pady 3
2969	set entrybox(scale) $expgui(scaleBox).ent1
2970
2971	button $expgui(scaleBox).but1 -text "Set Globally" \
2972	-command "editglobalparm histinfo scale {Scale Factor}"
2973
2974	grid [label $expgui(scaleBox).histSFRLabel -text " Refine"] \
2975	-row 1 -column 2 -sticky nws -padx 2 -pady 3
2976	grid [checkbutton $expgui(scaleBox).rf -variable entryvar(sref)] \
2977	-row 1 -column 3 -sticky news -padx 4 -pady 3
2978	grid [label $expgui(scaleBox).lD1 -text "Damping"] \
2979	-row 1 -column 4 -sticky w -padx 2 -pady 3
2980	tk_optionMenu $expgui(scaleBox).om entryvar(sdamp) 0 1 2 3 4 5 6 7 8 9
2981	grid $expgui(scaleBox).om \
2982	-row 1 -column 5 -sticky news -padx 4 -pady 3
2983	grid columnconfigure $expgui(scaleBox) 6 -weight 1
2984
2985	if $expgui(haveBW) {
2986	grid [TitleFrame $expgui(fracFrame).f1.phaseFrac -bd 4 \
2987	-text "Phase Fractions" -relief groove] \
2988	-sticky news -row 1 -column 0 -columnspan 2
2989	set PhaseFractBox [$expgui(fracFrame).f1.phaseFrac getframe]
2990	} else {
2991	set PhaseFractBox $expgui(fracFrame).f1
2992	}
2993	grid columnconfigure $expgui(fracFrame).f1 0 -weight 1
2994	grid rowconfigure $expgui(fracFrame).f1 1 -weight 1
2995
2996	grid [set expgui(FracBox) [canvas $PhaseFractBox.fracBox \
2997	-scrollregion {0 0 5000 500} \
2998	-yscrollcommand "$PhaseFractBox.yscroll set" \
2999	-width 500 -height 350 -bg lightgrey]] \
3000	-sticky news -row 1 -column 0
3001	grid [scrollbar $PhaseFractBox.yscroll \
3002	-command "$expgui(FracBox) yview" \
3003	-orient vertical] \
3004	-sticky ns -row 1 -column 1
3005	frame $expgui(FracBox).f -bd 0
3006	$expgui(FracBox) create window 0 0 -anchor nw -window $expgui(FracBox).f
3007
3008	# the rest of the page is created in DisplayFrac
3009
3010	# insert the histograms & resize in case the pane needs more space
3011	sethistlist
3012	ResizeNotebook
3013	# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF SCALING PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3014	}
3015	###############################################################################
3016	proc MakeProfilePane {} {
3017	global expgui
3018	# 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
3019	pack [frame $expgui(profFrame).hs] -side left -expand y -fill both
3020	MakeHistBox $expgui(profFrame).hs
3021	bind $expgui(profFrame).hs.lbox <ButtonRelease-1> {
3022	set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
3023	DisplayProfile
3024	}
3025	bind $expgui(profFrame).hs.lbox <Button-3> {
3026	if $expgui(globalmode) {
3027	$expgui(profFrame).hs.lbox selection set 0 end
3028	set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
3029	DisplayProfile
3030	}
3031	}
3032
3033	# Create a large canvas area containing a frame for each phase in the data set.
3034	# The canvas and vertical scrollbar are inside a frame called f1
3035	pack [frame $expgui(profFrame).f1] -fill both -expand true
3036	grid [set expgui(ProfileBox) [canvas $expgui(profFrame).f1.profileBox \
3037	-scrollregion {0 0 5000 500} -width 500 -height 350 -bg lightgrey]] \
3038	-sticky news -row 0 -column 0
3039	grid [scrollbar $expgui(profFrame).f1.yscroll -orient vertical] \
3040	-sticky ns -row 0 -column 1
3041
3042	$expgui(ProfileBox) config -yscrollcommand "$expgui(profFrame).f1.yscroll set"
3043	$expgui(profFrame).f1.yscroll config -command { $expgui(ProfileBox) yview }
3044
3045	grid columnconfigure $expgui(profFrame).f1 1 -weight 1
3046	grid rowconfigure $expgui(profFrame).f1 0 -weight 1
3047	frame $expgui(ProfileBox).f -bd 0
3048	$expgui(ProfileBox) create window 0 0 -anchor nw -window $expgui(ProfileBox).f
3049
3050	# insert the histograms & resize in case the pane needs more space
3051	sethistlist
3052	ResizeNotebook
3053	# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF PROFILE PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3054	}
3055
3056	##############################################################################
3057	# 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
3058	array set printopts {
3059	0 "Print the reciprocal metric tensor changes"
3060	1 "Print the correlation matrix"
3061	2 "Print the Least-Squares matrices and vectors"
3062	4 "Print the linear constraint matrices"
3063	5 "Print the applied shifts and shift factors"
3064	6 "Print the reciprocal metric tensor Var-Covar terms"
3065	7 "Print all parameters for each cycle"
3066	8 "Print summary shift/esd data after last cycle"
3067	9 "Print zero/unit pole figure constraint terms"
3068	}
3069	pack [frame $expgui(lsFrame).hs] -side left -expand y -fill both
3070	MakeHistBox $expgui(lsFrame).hs
3071	bind $expgui(lsFrame).hs.lbox <ButtonRelease-1> {
3072	set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
3073	SetupExtractHist
3074	}
3075	bind $expgui(lsFrame).hs.lbox <Button-3> {
3076	if $expgui(globalmode) {
3077	$expgui(lsFrame).hs.lbox selection set 0 end
3078	set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
3079	SetupExtractHist
3080	}
3081	}
3082
3083	pack [frame $expgui(lsFrame).f1] -fill both -expand true
3084	grid rowconfigure $expgui(lsFrame).f1 4 -weight 1
3085	set row 0
3086	grid [label $expgui(lsFrame).f1.his1 -pady 6 -text "Last History:"] -row $row -column 0
3087	grid [label $expgui(lsFrame).f1.his2 -relief raised -bd 2 -pady 6 \
3088	-textvariable expgui(last_History)] \
3089	-row $row -column 1 -columnspan 5 -sticky w
3090	incr row
3091	grid [label $expgui(lsFrame).f1.tit1 -pady 6 -text "Title:"] -row $row -column 0
3092	grid [entry $expgui(lsFrame).f1.tit2 \
3093	-textvariable entryvar(title) -width 48] \
3094	-row $row -column 1 -columnspan 5 -sticky w
3095	set entrycmd(title) "expinfo title"
3096
3097	incr row
3098	grid [frame $expgui(lsFrame).f1.b -bd 4 -relief groove] \
3099	-row $row -column 0 -columnspan 2 -pady 3
3100	grid [label $expgui(lsFrame).f1.b.lcyc -text "Number of Cycles"] -row 0 -column 0
3101	grid [entry $expgui(lsFrame).f1.b.ecyc -width 3 \
3102	-textvariable entryvar(cycles)] -row 0 -column 1
3103	set entrybox(cycles) $expgui(lsFrame).f1.b.ecyc
3104	grid [menubutton $expgui(lsFrame).f1.lprint -textvariable expgui(printopt) \
3105	-menu $expgui(lsFrame).f1.lprint.menu -bd 4 -relief raised \
3106	] -row $row -column 2
3107	menu $expgui(lsFrame).f1.lprint.menu
3108	foreach num [lsort [array names printopts]] {
3109	$expgui(lsFrame).f1.lprint.menu add checkbutton \
3110	-label "$printopts($num) ([expr int(pow(2,$num))])"\
3111	-variable entryvar(printopt$num)
3112	}
3113	#grid [frame $expgui(lsFrame).f1.c -bd 4 -relief groove] -row $row -column 3
3114	#grid [label $expgui(lsFrame).f1.c.fol -text "Extract Fobs"] -row 0 -column 2
3115	#grid [checkbutton $expgui(lsFrame).f1.c.foc -variable entryvar(fobsextract)] -row 0 -column 3
3116	incr row
3117	if {$expgui(haveBW)} {
3118	grid [TitleFrame $expgui(lsFrame).f1.a -bd 4 -relief groove \
3119	-text "Reflection Intensity Extraction" \
3120	] -row $row -column 0 -columnspan 6
3121	set expgui(FobsExtractFrame) [$expgui(lsFrame).f1.a getframe]
3122	} else {
3123	grid [frame $expgui(lsFrame).f1.a -bd 4 -relief groove \
3124	] -row $row -column 0 -columnspan 6
3125	set expgui(FobsExtractFrame) $expgui(lsFrame).f1.a
3126	}
3127	grid rowconfigure $expgui(lsFrame).f1 $row -pad 16
3128	grid [frame $expgui(FobsExtractFrame).c -bd 4 -relief groove] \
3129	-row 0 -column 8 -columnspan 3 -sticky e
3130	grid [label $expgui(FobsExtractFrame).c.fol -text "Extract Fobs"] \
3131	-row 0 -column 2
3132	grid [checkbutton $expgui(FobsExtractFrame).c.foc \
3133	-variable entryvar(fobsextract)] -row 0 -column 3
3134	foreach num {1 2 3 4 5 6 7 8 9} {
3135	grid [label $expgui(FobsExtractFrame).l$num -text $num] -row 1 -column $num
3136	grid [radiobutton $expgui(FobsExtractFrame).cc$num \
3137	-command "HistExtractSet $num" \
3138	-variable expgui(Fextract$num) -value 0] \
3139	-row 2 -column $num
3140	grid [radiobutton $expgui(FobsExtractFrame).ca$num \
3141	-command "HistExtractSet $num" \
3142	-variable expgui(Fextract$num) -value 1] \
3143	-row 3 -column $num
3144	grid [radiobutton $expgui(FobsExtractFrame).cb$num \
3145	-command "HistExtractSet $num" \
3146	-variable expgui(Fextract$num) -value 2] \
3147	-row 4 -column $num
3148	}
3149	set expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).cc
3150	lappend expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).ca
3151	lappend expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).cb
3152
3153	grid [label $expgui(FobsExtractFrame).t \
3154	-text "Extraction\nMethod" -anchor c] \
3155	-column 0 -row 0 -rowspan 2 -sticky s
3156	grid [label $expgui(FobsExtractFrame).t0 -text "Phase #" -anchor sw] \
3157	-column 1 -row 0 -columnspan 7 -sticky sw
3158	grid [label $expgui(FobsExtractFrame).t1 -text "Rietveld" -anchor c] -column 0 -row 2
3159	grid [label $expgui(FobsExtractFrame).t2 -text "F(calc) Weighted" -anchor c] -column 0 -row 3
3160	grid [label $expgui(FobsExtractFrame).t3 -text "Equally Weighted" -anchor c] -column 0 -row 4
3161	grid [label $expgui(FobsExtractFrame).t2a -text "(Model biased)" -anchor c] -column 10 -row 3
3162	grid [label $expgui(FobsExtractFrame).t3a -text "(Le Bail method)" -anchor c] -column 10 -row 4
3163	# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF LS PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3164	#-------------------------------------------------------------------------
3165	#-------------------------------------------------------------------------
3166	#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv THE MENU BAR vvvvvvvvvvvvvvvvvvvvvv
3167
3168	#---- file menu button
3169	menubutton $expgui(fm).file -text File -menu $expgui(fm).file.menu
3170	menu $expgui(fm).file.menu
3171	if $expgui(debug) {
3172	$expgui(fm).file.menu add command -label "Reset" -command "reset"
3173	}
3174	if {$expgui(shell)} {
3175	$expgui(fm).file.menu add command -label "expnam" -command readnewexp
3176	}
3177	$expgui(fm).file.menu add command -label "Save" -underline 0 \
3178	-command savearchiveexp
3179	foreach c {s S} {bind . <Alt-$c> [list savearchiveexp]}
3180	$expgui(fm).file.menu add command -label "Save As" \
3181	-command "SaveAsFile"
3182	$expgui(fm).file.menu add command -label "Reread .EXP file" \
3183	-command {rereadexp $expgui(expfile)}
3184
3185	#---- help menu button
3186	menubutton $expgui(fm).help -text Help -menu $expgui(fm).help.menu
3187	menu $expgui(fm).help.menu
3188	$expgui(fm).help.menu add command -command showhelp -underline 0 \
3189	-label "Help on Command"
3190	foreach c {h H} {bind . <Alt-$c> [list showhelp]}
3191	$expgui(fm).help.menu add command -label "About..." -command About
3192
3193	#---- options menu button
3194	menubutton $expgui(fm).option -text Options \
3195	-menu $expgui(fm).option.menu
3196	menu $expgui(fm).option.menu
3197
3198	if {$expgui(shell)} {
3199	$expgui(fm).option.menu add checkbutton -label "Archive EXP" \
3200	-variable expgui(archive)
3201	$expgui(fm).option.menu add checkbutton -label "Use DISAGL window" \
3202	-variable expgui(disaglSeparateBox)
3203	}
3204	$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.asort \
3205	-label "Sort atoms by"
3206
3207	set expgui(asorttype) number
3208	menu $expgui(fm).option.menu.asort
3209	foreach opt {number type mult x y z occupancy} {
3210	$expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
3211	-label $opt -value $opt -variable expgui(asorttype)
3212	}
3213
3214	$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.hsort \
3215	-label "Sort histograms by"
3216
3217	set expgui(hsorttype) number
3218	menu $expgui(fm).option.menu.hsort
3219	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
3220	-label number -value number -variable expgui(hsorttype)
3221	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
3222	-label "Histogram type" -value type -variable expgui(hsorttype)
3223	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
3224	-label "Bank #" -value bank -variable expgui(hsorttype)
3225	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
3226	-label "Angle/Wavelength" -value angle -variable expgui(hsorttype)
3227
3228	#---- Global mode menu button
3229	$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.editmode \
3230	-label "Multiple hist. selection"
3231	menu $expgui(fm).option.menu.editmode
3232	$expgui(fm).option.menu.editmode add radiobutton -label "Off" \
3233	-variable expgui(globalmode) -value 0 \
3234	-command sethistlist
3235	$expgui(fm).option.menu.editmode add radiobutton -label "All" \
3236	-variable expgui(globalmode) -value 6 \
3237	-command sethistlist
3238	$expgui(fm).option.menu.editmode add radiobutton -label "TOF" \
3239	-variable expgui(globalmode) -value 1 \
3240	-command sethistlist
3241	$expgui(fm).option.menu.editmode add radiobutton -label "CW Neutron" \
3242	-variable expgui(globalmode) -value 2 \
3243	-command sethistlist
3244	$expgui(fm).option.menu.editmode add radiobutton -label "Alpha12 Xray" \
3245	-variable expgui(globalmode) -value 3 \
3246	-command sethistlist
3247	$expgui(fm).option.menu.editmode add radiobutton -label "Monochromatic Xray" \
3248	-variable expgui(globalmode) -value 4 \
3249	-command sethistlist
3250	$expgui(fm).option.menu.editmode add radiobutton -label "Energy Disp Xray" \
3251	-variable expgui(globalmode) -value 5 \
3252	-command sethistlist
3253	$expgui(fm).option.menu.editmode add separator
3254	$expgui(fm).option.menu.editmode add checkbutton \
3255	-label "Group phases together" \
3256	-variable expgui(globalphasemode) \
3257	-command sethistlist
3258
3259	set expgui(globalmode) 0
3260	set expgui(globalphasemode) 1
3261
3262	if {$tcl_platform(platform) == "unix"} {
3263	$expgui(fm).option.menu add checkbutton -label "Override backspace" \
3264	-variable env(GSASBACKSPACE)
3265	if {$expgui(shell)} {
3266	$expgui(fm).option.menu add checkbutton -label "Autoload EXP" \
3267	-variable expgui(autoexpload)
3268	}
3269	}
3270
3271	$expgui(fm).option.menu add command -label "Save Options" \
3272	-command "SaveOptions"
3273
3274	pack $expgui(fm).file $expgui(fm).option -side left -in $expgui(fm)
3275
3276	if {$expgui(shell)} {
3277	foreach menu $expgui(menunames) {
3278	set m [string tolower $menu]
3279	pack [menubutton $expgui(fm).$m -text $menu \
3280	-menu $expgui(fm).$m.menu] -side left
3281	menu $expgui(fm).$m.menu
3282	}
3283	}
3284	pack $expgui(fm).help -side right -in $expgui(fm)
3285
3286	if {$expgui(shell)} {
3287	# add the commands in expgui_menulist
3288	foreach menu [array names expgui_menulist ] {
3289	foreach cmd $expgui_menulist($menu) {
3290	set action {}
3291	set opt {}
3292	catch {set action [lindex $expgui_cmdlist($cmd) 0]}
3293	catch {set opt [lindex $expgui_cmdlist($cmd) 2]}
3294	if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
3295	if {$action != "" && $action != "-"} {
3296	eval $expgui(fm).$menu.menu add command \
3297	-label $cmd $opt -command [list [subst $action]]
3298	if {[lindex $opt 0] == "-underline"} {
3299	catch {
3300	set num [lindex $opt 1]
3301	set key [string range $cmd $num $num]
3302	bind . <Alt-[string tolower $key]> [subst $action]
3303	bind . <Alt-[string toupper $key]> [subst $action]
3304	}
3305	}
3306	}
3307	}
3308	}
3309	}
3310	# setup command help
3311	foreach cmd [array names expgui_cmdlist] {
3312	set help {}
3313	catch {set help [lindex $expgui_cmdlist($cmd) 1]}
3314	if {$help == ""} {
3315	if {$expgui(debug)} {puts "no help for $cmd"}
3316	} else {
3317	# remove
3318	regsub -all \x09 $help " " help
3319	# preserve blank lines
3320	regsub -all \x0A\x0A $help "AAA1234567890AAA" help
3321	regsub -all \x0A $help " " help
3322	regsub -all "AAA1234567890AAA" $help \x0A\x0A help
3323	regsub -all " +" $help " " help
3324	set expgui_helplist($cmd) [string trim $help]
3325	}
3326	}
3327	if {$expgui(shell)} {
3328	# set up button bar
3329	foreach cmd $expgui(buttonlist) {
3330	set action {}
3331	catch {set action [lindex $expgui_cmdlist($cmd) 0]}
3332	if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
3333	if {$action != ""} {
3334	pack [eval button .bar.$cmd -bg beige -activebackground yellow \
3335	-text $cmd -command [list [subst $action]]] -side left
3336	}
3337	}
3338	}
3339
3340	$expgui(fm).file.menu add command -label "Exit" -underline 1 -command catchQuit
3341	foreach c {X x} {bind . <Alt-$c> [list catchQuit]}
3342	#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF MENU DEFINITION ^^^^^^^^^^^^^^^^^^^
3343
3344	# make the phase pane
3345	MakePhasePane
3346	# and the rest of the windows w/o BWidget
3347	if !$expgui(haveBW) {
3348	MakeHistPane
3349	MakeScalingPane
3350	MakeProfilePane
3351	}
3352
3353	# handle indirect exits
3354	wm protocol . WM_DELETE_WINDOW catchQuit
3355	bind . <Control-c> catchQuit
3356
3357	set expgui(curPhase) ""
3358	set expgui(pagenow) ""
3359	set expgui(curhist) {}
3360	set expgui(selectedatomlist) {}
3361
3362	loadexp $expgui(expfile)
3363
3364	# select the 1st phase
3365	SelectOnePhase [lindex $expmap(phaselist) 0]
3366	# select the first histogram in the list by default (if there are any)
3367	if {[llength $expmap(histlistboxcontents)] > 0} {
3368	set expgui(curhist) 0
3369	} else {
3370	set expgui(curhist) {}
3371	}
3372
3373	# execute any local commands for final initialization
3374	eval $expgui(initstring)
3375
3376	# resize the notebook to fit all the tabs and the largest page
3377	ResizeNotebook
3378
3379	RaisePage lsFrame
3380	if {[CountHistory] > 100} {
3381	DeleteHistoryRecords "This .EXP file has [CountHistory] history records\nErasing most will speed EXPGUI"
3382	}

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

Download in other formats:

Original Format