Context Navigation

source: trunk/expgui @ 234

Last change on this file since 234 was 234, checked in by toby, 13 years ago
# on 2000/07/06 22:43:40, toby did: Change profile term labeling to use GetProfileTerms? use file copy for archive (unix) put site multiplity on atoms page implement MakeHistBox? for histogram selection boxes Add a heading for global mode to the histogram selection box Implement changing profile type add binding to select all atoms click on atom box title rotates through atom sorting modes new atom sort mode: mult
Property rcs:author set to `toby` Property rcs:date set to `2000/07/06 22:43:40` Property rcs:lines set to `+118 -158` Property rcs:rev set to `1.28` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 114.6 KB

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

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

Download in other formats:

Original Format