Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

source: trunk/gsascmds.tcl

Last change on this file was 1251, checked in by toby, 10 years ago
use svn ps svn:eol-style "native" * to change line ends
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Revision Id`
File size: 139.3 KB

Line
1	# $Id: gsascmds.tcl 1251 2014-03-10 22:17:29Z toby $
2	#------------------------------------------------------------------------------
3	# display routines
4	#------------------------------------------------------------------------------
5	# Message box code that centers the message box over the parent.
6	# or along the edge, if too close,
7	# but leave a border along +x & +y for reasons I don't remember
8	# It also allows the button names to be defined using
9	# -type $list -- where $list has a list of button names
10	# larger messages are placed in a scrolled text widget
11	# capitalization is now ignored for -default
12	# The command returns the name button in all lower case letters
13	# otherwise see tk_messageBox for a description
14	#
15	# This is a modification of tkMessageBox (msgbox.tcl v1.5)
16	#
17	proc MyMessageBox {args} {
18	global tkPriv tcl_platform
19
20	set w tkPrivMsgBox
21	upvar #0 $w data
22
23	#
24	# The default value of the title is space (" ") not the empty string
25	# because for some window managers, a
26	# wm title .foo ""
27	# causes the window title to be "foo" instead of the empty string.
28	#
29	set specs {
30	{-default "" "" ""}
31	{-icon "" "" "info"}
32	{-message "" "" ""}
33	{-parent "" "" .}
34	{-title "" "" " "}
35	{-type "" "" "ok"}
36	{-helplink "" "" ""}
37	}
38
39	tclParseConfigSpec $w $specs "" $args
40
41	if {[lsearch {info warning error question} $data(-icon)] == -1} {
42	error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
43	}
44	if {![string compare $tcl_platform(platform) "macintosh"]} {
45	switch -- $data(-icon) {
46	"error" {set data(-icon) "stop"}
47	"warning" {set data(-icon) "caution"}
48	"info" {set data(-icon) "note"}
49	}
50	}
51
52	if {![winfo exists $data(-parent)]} {
53	error "bad window path name \"$data(-parent)\""
54	}
55
56	switch -- $data(-type) {
57	abortretryignore {
58	set buttons {
59	{abort -width 6 -text Abort -under 0}
60	{retry -width 6 -text Retry -under 0}
61	{ignore -width 6 -text Ignore -under 0}
62	}
63	}
64	ok {
65	set buttons {
66	{ok -width 6 -text OK -under 0}
67	}
68	if {![string compare $data(-default) ""]} {
69	set data(-default) "ok"
70	}
71	}
72	okcancel {
73	set buttons {
74	{ok -width 6 -text OK -under 0}
75	{cancel -width 6 -text Cancel -under 0}
76	}
77	}
78	retrycancel {
79	set buttons {
80	{retry -width 6 -text Retry -under 0}
81	{cancel -width 6 -text Cancel -under 0}
82	}
83	}
84	yesno {
85	set buttons {
86	{yes -width 6 -text Yes -under 0}
87	{no -width 6 -text No -under 0}
88	}
89	}
90	yesnocancel {
91	set buttons {
92	{yes -width 6 -text Yes -under 0}
93	{no -width 6 -text No -under 0}
94	{cancel -width 6 -text Cancel -under 0}
95	}
96	}
97	default {
98	# error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel"
99	foreach item $data(-type) {
100	lappend buttons [list [string tolower $item] -text $item -under 0]
101	}
102	}
103	}
104
105	if {[string compare $data(-default) ""]} {
106	set valid 0
107	foreach btn $buttons {
108	if {![string compare [lindex $btn 0] [string tolower $data(-default)]]} {
109	set valid 1
110	break
111	}
112	}
113	if {!$valid} {
114	error "invalid default button \"$data(-default)\""
115	}
116	}
117
118	# 2. Set the dialog to be a child window of $parent
119	#
120	#
121	if {[string compare $data(-parent) .]} {
122	set w $data(-parent).__tk__messagebox
123	} else {
124	set w .__tk__messagebox
125	}
126
127	# 3. Create the top-level window and divide it into top
128	# and bottom parts.
129
130	catch {destroy $w}
131	toplevel $w -class Dialog
132	wm title $w $data(-title)
133	wm iconname $w Dialog
134	wm protocol $w WM_DELETE_WINDOW { }
135	# Make the message box transient if the parent is viewable.
136	if {[winfo viewable [winfo toplevel $data(-parent)]] } {
137	wm transient $w $data(-parent)
138	}
139
140	catch {
141	if {[string equal [tk windowingsystem] "classic"]
142	\|\| [string equal [tk windowingsystem] "aqua"]} {
143	unsupported::MacWindowStyle style $w dBoxProc
144	}
145	}
146
147	frame $w.bot
148	pack $w.bot -side bottom -fill both
149	frame $w.top
150	pack $w.top -side top -fill both -expand 1
151	if {$data(-helplink) != ""} {
152	# frame $w.help
153	# pack $w.help -side top -fill both
154	pack [button $w.top.1 -text Help -bg yellow \
155	-command "MakeWWWHelp $data(-helplink)"] \
156	-side right -anchor ne
157	bind $w <Key-F1> "MakeWWWHelp $data(-helplink)"
158	}
159	if {[string compare $tcl_platform(platform) "macintosh"]} {
160	$w.bot configure -relief raised -bd 1
161	$w.top configure -relief raised -bd 1
162	}
163
164	# 4. Fill the top part with bitmap and message (use the option
165	# database for -wraplength and -font so that they can be
166	# overridden by the caller).
167
168	option add *Dialog.msg.wrapLength 6i widgetDefault
169
170	if {[string length $data(-message)] > 300} {
171	if {![string compare $tcl_platform(platform) "macintosh"]} {
172	option add *Dialog.msg.t.font system widgetDefault
173	} else {
174	option add *Dialog.msg.t.font {Times 18} widgetDefault
175	}
176	frame $w.msg
177	grid [text $w.msg.t \
178	-height 20 -width 55 -relief flat -wrap word \
179	-yscrollcommand "$w.msg.rscr set" \
180	] -row 1 -column 0 -sticky news
181	grid [scrollbar $w.msg.rscr -command "$w.msg.t yview" \
182	] -row 1 -column 1 -sticky ns
183	# give extra space to the text box
184	grid columnconfigure $w.msg 0 -weight 1
185	grid rowconfigure $w.msg 1 -weight 1
186	$w.msg.t insert end $data(-message)
187	} else {
188	if {![string compare $tcl_platform(platform) "macintosh"]} {
189	option add *Dialog.msg.font system widgetDefault
190	} else {
191	option add *Dialog.msg.font {Times 18} widgetDefault
192	}
193	label $w.msg -justify left -text $data(-message)
194	}
195	pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
196	if {[string compare $data(-icon) ""]} {
197	label $w.bitmap -bitmap $data(-icon)
198	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
199	}
200
201	# 5. Create a row of buttons at the bottom of the dialog.
202
203	set i 0
204	foreach but $buttons {
205	set name [lindex $but 0]
206	set opts [lrange $but 1 end]
207	if {![llength $opts]} {
208	# Capitalize the first letter of $name
209	set capName [string toupper \
210	[string index $name 0]][string range $name 1 end]
211	set opts [list -text $capName]
212	}
213
214	eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]
215
216	if {![string compare $name [string tolower $data(-default)]]} {
217	$w.$name configure -default active
218	}
219	pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
220
221	# create the binding for the key accelerator, based on the underline
222	#
223	set underIdx [$w.$name cget -under]
224	if {$underIdx >= 0} {
225	set key [string index [$w.$name cget -text] $underIdx]
226	bind $w <Alt-[string tolower $key]> [list $w.$name invoke]
227	bind $w <Alt-[string toupper $key]> [list $w.$name invoke]
228	}
229	incr i
230	}
231
232	# 6. Create a binding for <Return> on the dialog if there is a
233	# default button.
234
235	if {[string compare $data(-default) ""]} {
236	bind $w <Return> [list $w.[string tolower $data(-default)] invoke]
237	}
238
239	# 7. Withdraw the window, then update all the geometry information
240	# so we know how big it wants to be, then center the window in the
241	# display and de-iconify it.
242
243	wm withdraw $w
244	update idletasks
245	set wp $data(-parent)
246	# center the new window in the middle of the parent
247	set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
248	[winfo reqwidth $w]/2 - [winfo vrootx $wp]]
249	set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
250	[winfo reqheight $w]/2 - [winfo vrooty $wp]]
251	# make sure that we can see the entire window
252	set xborder 10
253	set yborder 25
254	if {$x < 0} {set x 0}
255	if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
256	incr x [expr \
257	[winfo screenwidth $w] - ($x+[winfo reqwidth $w] + $xborder)]
258	}
259	if {$y < 0} {set y 0}
260	if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
261	incr y [expr \
262	[winfo screenheight $w] - ($y+[winfo reqheight $w] + $yborder)]
263	}
264	wm geom $w +$x+$y
265	wm deiconify $w
266
267	# 8. Set a grab and claim the focus too.
268
269	catch {set oldFocus [focus]}
270	catch {set oldGrab [grab current $w]}
271	catch {
272	grab $w
273	if {[string compare $data(-default) ""]} {
274	focus $w.[string tolower $data(-default)]
275	} else {
276	focus $w
277	}
278	}
279
280	# 9. Wait for the user to respond, then restore the focus and
281	# return the index of the selected button. Restore the focus
282	# before deleting the window, since otherwise the window manager
283	# may take the focus away so we can't redirect it. Finally,
284	# restore any grab that was in effect.
285
286	tkwait variable tkPriv(button)
287	catch {focus $oldFocus}
288	destroy $w
289	catch {grab $oldGrab}
290	return $tkPriv(button)
291	}
292
293	# tell'em what is happening
294	# message is a text message to display
295	# statusvar is a variable name containing a message that gets updated
296	# parent is the name of the parent window
297	# button defines a button for the window. Element 0 in $button is the
298	# text for the button and Element 1 is the command to execute.
299	proc pleasewait {{message {}} {statusvar {}} {parent .} {button ""}} {
300	catch {destroy .msg}
301	toplevel .msg
302	wm transient .msg [winfo toplevel .]
303	pack [frame .msg.f -bd 4 -relief groove] -padx 5 -pady 5
304	pack [message .msg.f.m -text "Please wait $message"] -side top
305	if {$statusvar != ""} {
306	pack [label .msg.f.status -textvariable $statusvar] -side top
307	}
308	if {$button != ""} {
309	pack [button .msg.f.button -text [lindex $button 0] \
310	-command [lindex $button 1]] -side top
311	}
312	wm withdraw .msg
313	update idletasks
314	# place the message on top of the parent window
315	set x [expr [winfo x $parent] + [winfo width $parent]/2 - \
316	[winfo reqwidth .msg]/2 - [winfo vrootx $parent]]
317	if {$x < 0} {set x 0}
318	set y [expr [winfo y $parent] + [winfo height $parent]/2 - \
319	[winfo reqheight .msg]/2 - [winfo vrooty $parent]]
320	if {$y < 0} {set y 0}
321	wm geom .msg +$x+$y
322	wm deiconify .msg
323	global makenew
324	set makenew(OldGrab) ""
325	set makenew(OldFocus) ""
326	# save focus & grab
327	catch {set makenew(OldFocus) [focus]}
328	catch {set makenew(OldGrab) [grab current .msg]}
329	catch {grab .msg}
330	update
331	}
332
333	# clear the message
334	proc donewait {} {
335	global makenew
336	catch {destroy .msg}
337	# reset focus & grab
338	catch {
339	if {$makenew(OldFocus) != ""} {
340	focus $makenew(OldFocus)
341	}
342	}
343	catch {
344	if {$makenew(OldGrab) != ""} {
345	grab $makenew(OldGrab)
346	}
347	}
348	}
349
350	proc putontop {w "center 0"} {
351	# center window $w above its parent and make it stay on top
352	set wpt [winfo toplevel [set wp [winfo parent $w]]]
353	if {[winfo viewable $wpt]} {
354	wm transient $w $wpt
355	}
356	wm withdraw $w
357	update idletasks
358	if {$center} {
359	set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
360	- [winfo vrootx $wpt]}]
361	set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
362	- [winfo vrooty $wpt]}]
363	} else {
364	# center the new window in the middle of the parent
365	set x [expr [winfo x $wpt] + [winfo width $wpt]/2 - \
366	[winfo reqwidth $w]/2 - [winfo vrootx $wpt]]
367	if {$x < 0} {set x 0}
368	set xborder 10
369	if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
370	incr x [expr [winfo screenwidth $w] - \
371	($x+[winfo reqwidth $w] + $xborder)]
372	}
373	set y [expr [winfo y $wpt] + [winfo height $wpt]/2 - \
374	[winfo reqheight $w]/2 - [winfo vrooty $wpt]]
375	if {$y < 0} {set y 0}
376	set yborder 25
377	if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
378	incr y [expr [winfo screenheight $w] - \
379	($y+[winfo reqheight $w] + $yborder)]
380	}
381	}
382	wm geometry $w +$x+$y
383	wm deiconify $w
384
385	global makenew
386	# set grab & focus; use new approach for 8.3 & later
387	if {[info proc ::tk::SetFocusGrab] == ""} {
388	set makenew(OldGrab) ""
389	set makenew(OldFocus) ""
390	catch {set makenew(OldFocus) [focus]}
391	catch {set makenew(OldGrab) [grab current $w]}
392	catch {grab $w}
393	} else {
394	set makenew(OldGrab) $w
395	set makenew(OldFocus) $w
396	::tk::SetFocusGrab $w $w
397	}
398	}
399
400	# restore focus after putontop has completed
401	proc afterputontop {} {
402	global makenew
403	# reset focus & grab; use new approach for 8.3 & later
404	if {[info proc ::tk::SetFocusGrab] == ""} {
405	if {$makenew(OldFocus) != ""} {
406	catch {focus $makenew(OldFocus)}
407	}
408	if {$makenew(OldGrab) != ""} {
409	catch {grab $makenew(OldGrab)}
410	}
411	} else {
412	catch {::tk::RestoreFocusGrab $makenew(OldGrab) $makenew(OldFocus)}
413	}
414	}
415
416	proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}" "err 0"} {
417	catch {destroy $win}
418	toplevel $win
419
420	pack [label $win.l1 -text $labeltext] -side top
421	if {$err} {$win.l1 config -fg red}
422	pack [frame $win.f1] -side top -expand yes -fill both
423	grid [text $win.f1.t \
424	-height 20 -width 55 -wrap none -font Courier \
425	-xscrollcommand "$win.f1.bscr set" \
426	-yscrollcommand "$win.f1.rscr set" \
427	] -row 1 -column 0 -sticky news
428	grid [scrollbar $win.f1.bscr -orient horizontal \
429	-command "$win.f1.t xview" \
430	] -row 2 -column 0 -sticky ew
431	grid [scrollbar $win.f1.rscr -command "$win.f1.t yview" \
432	] -row 1 -column 1 -sticky ns
433	# give extra space to the text box
434	grid columnconfigure $win.f1 0 -weight 1
435	grid rowconfigure $win.f1 1 -weight 1
436	$win.f1.t insert end $msg
437
438	global makenew
439	set makenew(result) 0
440	bind $win <Return> "destroy $win"
441	bind $win <KeyPress-Prior> "$win.f1.t yview scroll -1 page"
442	bind $win <KeyPress-Next> "$win.f1.t yview scroll 1 page"
443	bind $win <KeyPress-Right> "$win.f1.t xview scroll 1 unit"
444	bind $win <KeyPress-Left> "$win.f1.t xview scroll -1 unit"
445	bind $win <KeyPress-Up> "$win.f1.t yview scroll -1 unit"
446	bind $win <KeyPress-Down> "$win.f1.t yview scroll 1 unit"
447	bind $win <KeyPress-Home> "$win.f1.t yview 0"
448	bind $win <KeyPress-End> "$win.f1.t yview end"
449	set i 0
450	foreach item $optionlist {
451	pack [button $win.q[incr i] \
452	-command "set makenew(result) $i; destroy $win" -text $item] -side left
453	}
454	if {$link != ""} {
455	pack [button $win.help -text Help -bg yellow \
456	-command "MakeWWWHelp $link"] \
457	-side right
458	bind $win <Key-F1> "MakeWWWHelp $link"
459	}
460	putontop $win
461	tkwait window $win
462
463	# fix grab...
464	afterputontop
465	return $makenew(result)
466	}
467
468	# format numbers & errors in crystallographic notation
469	proc formatSU {num err} {
470	# errors less or equal to t are expressed as 2 digits
471	set T 19
472	set lnT [expr { log10($T) }]
473	# error is zero
474	if {$err == 0} {
475	# is this an integer?
476	if {int($num) == $num} {
477	return [format %d [expr int($num)]]
478	}
479	# allow six sig figs with a zero error (except for 0.0)
480	set dec [expr int(5.999999-log10( abs($num) ))]
481	if {$dec < -2 \|\| $dec > 9} {
482	return [format %.5E $num]
483	} elseif {$dec <= 0} {
484	return [format %d [expr int($num)]]
485	} else {
486	return [format %.${dec}f $num]
487	}
488	} else {
489	#set sigfigs [expr log10( abs(10) / abs(.012/$T) ) + 1]
490	# should the number be expressed in scientific notation?
491	if {$err > $T \|\| abs($num) < 0.0001} {
492	# get the exponent
493	set exp [lindex [split [format %E $num] E] end]
494	# strip leading zeros
495	regsub {([-\+])0+} $exp {\1} exp
496	# number of decimals in exponetial notation
497	set dec [expr int($lnT - log10( abs($err) ) + $exp)]
498	# should the error be displayed?
499	if {$err < 0} {
500	return [format "%.${dec}E" $num]
501	} else {
502	# scale the error into a decimal number
503	set serr [expr int(0.5 + $err * pow(10,$dec-$exp))]
504	return [format "%.${dec}E(%d)" $num $serr]
505	}
506	} else {
507	# number of digits
508	set dec [expr int($lnT - log10( abs($err) ))]
509	# should the error be displayed?
510	if {$err < 0} {
511	return [format "%.${dec}f" $num]
512	} else {
513	set serr [expr int(0.5 + $err * pow(10,$dec))]
514	return [format "%.${dec}f(%d)" $num $serr]
515	}
516	}
517	}
518	}
519
520	# place a window on a selected part of the screen
521	# xfrac specifies the hozontal position with 0 to the left and 100 to the right
522	# yfrac specifies the vertical position with 0 to the top and 100 to the bottom
523	# loc chooses the part of the window to place at that location: N: upper, S: lower, W: left, E: right
524	# use NSEW for center
525	proc LocateWindow {win {xfrac 50} {yfrac 50} {loc c}} {
526	wm withdraw $win
527	set maxx [winfo screenwidth $win]
528	set maxy [winfo screenheight $win]
529	set reqx [winfo reqwidth $win]
530	set reqy [winfo reqheight $win]
531	set x [expr {$maxx*$xfrac/100.}]
532	set y [expr {$maxy*$yfrac/100.}]
533	if {[string match -nocase "e" $loc] && [string match -nocase "w" $loc]} {
534	# EW: center
535	set x [expr {$x - $reqx/2. }]
536	} elseif {[string match -nocase "e" $loc]} {
537	# right corner
538	set x [expr {$x - $reqx}]
539	} elseif {[string match -nocase "w" $loc]} {
540	# left corner -- do nothing
541	} else {
542	# center
543	set x [expr {$x - $reqx/2. }]
544	}
545	if {[string match -nocase "n" $loc] && [string match -nocase "s" $loc]} {
546	# NS: center
547	set y [expr {$y - $reqy/2 }]
548	} elseif {[string match -nocase "n" $loc]} {
549	# upper corner -- do nothing
550	} elseif {[string match -nocase "s" $loc]} {
551	# lower corner
552	set y [expr {$y - $reqy}]
553	} else {
554	# center
555	set y [expr {$y - $reqy/2 }]
556	}
557	set x [expr {int($x + 0.5)}]
558	set y [expr {int($y + 0.5)}]
559	if {$x < 0} {set x 0}
560	if {$x > $maxx-$reqx} {set x [expr {$maxx-$reqx}]}
561	if {$y < 0} {set y 0}
562	if {$y > $maxy-$reqy} {set y [expr {$maxy-$reqy}]}
563	wm geom $win +$x+$y
564	wm deiconify $win
565	}
566
567	# get a value in a modal dialog
568	proc getstring {what "chars 40" "quit 1" "initvalue {}"} {
569	global expgui expmap
570	set w .global
571	catch {destroy $w}
572	toplevel $w -bg beige
573	bind $w <Key-F1> "MakeWWWHelp expguierr.html Input[lindex $what 0]"
574	wm title $w "Input $what"
575	set expgui(temp) {}
576	pack [frame $w.0 -bd 6 -relief groove -bg beige] \
577	-side top -expand yes -fill both
578	grid [label $w.0.a -text "Input a value for the $what" \
579	-bg beige] \
580	-row 0 -column 0 -columnspan 10
581	grid [entry $w.0.b -textvariable expgui(temp) -width $chars] \
582	-row 1 -column 0
583
584	set expgui(temp) $initvalue
585	pack [frame $w.b -bg beige] -side top -fill x -expand yes
586	pack [button $w.b.2 -text Continue -command "destroy $w"] -side left
587	if $quit {
588	pack [button $w.b.3 -text Cancel \
589	-command "set expgui(temp) {}; destroy $w"] -side left
590	}
591	bind $w <Return> "destroy $w"
592	pack [button $w.b.help -text Help -bg yellow \
593	-command "MakeWWWHelp expguierr.html Input[lindex $what 0]"] \
594	-side right
595
596	# force the window to stay on top
597	putontop $w
598
599	focus $w.b.2
600	tkwait window $w
601	afterputontop
602
603	return $expgui(temp)
604	}
605
606	# for use in debugging -- how did I get here!
607	proc ShowCallStack {} {
608	puts "\n================== ShowCallStack ==============="
609	set n [info level]
610	incr n -1
611	while {$n > 0} {
612	puts "level $n: [info level $n]"
613	incr n -1
614	}
615	}
616	#------------------------------------------------------------------------------
617	# profile/symmetry routines
618	#------------------------------------------------------------------------------
619	# profile terms
620	array set expgui {
621	prof-T-names {"Von Dreele-Jorgensen-Windsor" \
622	"David-Ikeda-Carpenter" "Exponential pseudo-Voigt" \
623	"Exponential p-V+Stephens aniso strain" \
624	"Exponential p-V+macro strain"
625	}
626	prof-T-1 {alp-0 alp-1 bet-0 bet-1 sig-0 sig-1 sig-2 rstr rsta \
627	rsca s1ec s2ec }
628	prof-T-2 {alp-0 alp-1 beta switch sig-0 sig-1 sig-2 gam-0 gam-1 \
629	gam-2 ptec stec difc difa zero }
630	prof-T-3 {alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
631	gam-2 gsf g1ec g2ec rstr rsta rsca L11 L22 L33 L12 L13 L23 }
632	prof-T-4 {alp bet-0 bet-1 sig-1 sig-2 gam-2 g2ec gsf \
633	rstr rsta rsca eta}
634	prof-T-5 {alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
635	gam-2 gsf g1ec g2ec rstr rsta rsca D1 D2 D3 D4 D5 D6 }
636	prof-C-names {"Gaussian only" "Pseudo-Voigt" \
637	"pseudo-Voigt/FCJ Asym" "p-V/FCJ+Stephens aniso strain" \
638	"p-V/FCJ+macro strain"
639	}
640	prof-C-1 {GU GV GW asym F1 F2 }
641	prof-C-2 {GU GV GW LX LY trns asym shft GP stec ptec sfec \
642	L11 L22 L33 L12 L13 L23 }
643	prof-C-3 {GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
644	L11 L22 L33 L12 L13 L23 }
645	prof-C-4 {GU GV GW GP LX ptec trns shft sfec S/L H/L eta}
646	prof-C-5 {GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
647	D1 D2 D3 D4 D5 D6 }
648	prof-E-names {Gaussian "Otto pseudo-Voigt"}
649	prof-E-1 {A B C ds cds}
650	prof-E-2 {A B C ds cds LX LY ptec stec}
651	}
652
653	# number of profile terms depends on the histogram type
654	# the LAUE symmetry and the profile number
655	proc GetProfileTerms {phase hist ptype} {
656	global expmap expgui
657	if {$hist == "C" \|\| $hist == "T" \|\| $hist == "E"} {
658	set htype $hist
659	} else {
660	set htype [string range $expmap(htype_$hist) 2 2]
661	}
662	# get the cached copy of the profile term labels, when possible
663	set lbls {}
664	catch {
665	set lbls $expmap(ProfileTerms${phase}_${ptype}_${htype})
666	}
667	if {$lbls != ""} {return $lbls}
668
669	catch {set lbls $expgui(prof-$htype-$ptype)}
670	if {$lbls == ""} {return}
671	# add terms based on the Laue symmetry
672	if {($htype == "C" \|\| $htype == "T") && $ptype == 4} {
673	set laueaxis [GetLaue [phaseinfo $phase spacegroup]]
674	eval lappend lbls [Profile4Terms $laueaxis]
675	}
676	set expmap(ProfileTerms${phase}_${ptype}_${htype}) $lbls
677	return $lbls
678	}
679
680	proc Profile4Terms {laueaxis} {
681	# GSAS Laue classes by number vs spacegrp labeling
682	# 1 2 3 4 5 6 7 8 9 10 11 12 13 14
683	# 1bar, 2/m, mmm, 4/m, 4/mmm, 3bar, 3bar m, 3bar, 3barm1, 3bar1m, 6/m, 6/mmm, m 3, m3m
684	# R R H H H
685	# (R=Rhombohedral setting; H=Hexagonal setting)
686	switch -exact $laueaxis {
687	1bar {return \
688	"S400 S040 S004 S220 S202 S022 S310 S103 S031 \
689	S130 S301 S013 S211 S121 S112"}
690	2/ma {return "S400 S040 S004 S220 S202 S022 S013 S031 S211"}
691	2/mb {return "S400 S040 S004 S220 S202 S022 S301 S103 S121"}
692	2/mc {return "S400 S040 S004 S220 S202 S022 S130 S310 S112"}
693	mmm {return "S400 S040 S004 S220 S202 S022"}
694	4/m {return "S400 S004 S220 S202 S310"}
695	4/mmm {return "S400 S004 S220 S202"}
696	3barR {return "S400 S220 S310 S301 S211"}
697	"3bar mR" {return "S400 S220 S310 S211"}
698	3bar {return "S400 S004 S202 S310 S211"}
699	3barm1 {return "S400 S004 S202 S301"}
700	3bar1m {return "S400 S004 S202 S211"}
701	6/m {return "S400 S004 S202"}
702	6/mmm {return "S400 S004 S202"}
703	"m 3" {return "S400 S220"}
704	m3m {return "S400 S220"}
705	default {return ""}
706	}
707	}
708
709	proc GetLaue {spg} {
710	global tcl_platform expgui
711	# check the space group
712	set fp [open spg.in w]
713	puts $fp "N"
714	puts $fp "N"
715	puts $fp $spg
716	puts $fp "Q"
717	close $fp
718	catch {
719	if {$tcl_platform(platform) == "windows"} {
720	exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
721	} else {
722	exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
723	}
724	}
725	set fp [open spg.out r]
726	set laue {}
727	set uniqueaxis {}
728	while {[gets $fp line] >= 0} {
729	regexp {Laue symmetry (.*)} $line junk laue
730	regexp {The unique axis is (.*)} $line junk uniqueaxis
731	}
732	close $fp
733	catch {file delete -force spg.in spg.out}
734	set laue [string trim $laue]
735	# add a R suffix for rhombohedral settings
736	if {[string range [string trim $spg] end end] == "R"} {
737	return "${laue}${uniqueaxis}R"
738	}
739	return "${laue}$uniqueaxis"
740	}
741
742	# set up to change the profile type for a series of histogram/phase entries
743	# (histlist & phaselist should be lists of the same length)
744	#
745	proc ChangeProfileType {histlist phaselist} {
746	global expgui expmap
747	set w .profile
748	catch {destroy $w}
749	toplevel $w -bg beige
750	wm title $w "Change Profile Function"
751
752	# all histogram/phases better be the same type, so we can just use the 1st
753	set hist [lindex $histlist 0]
754	set phase [lindex $phaselist 0]
755	set ptype [string trim [hapinfo $hist $phase proftype]]
756
757	# get list of allowed profile terms for the current histogram type
758	set i 1
759	while {[set lbls [GetProfileTerms $phase $hist $i]] != ""} {
760	lappend lbllist $lbls
761	incr i
762	}
763	# labels for the current type
764	set i $ptype
765	set oldlbls [lindex $lbllist [incr i -1]]
766
767	if {[llength $histlist] == 1} {
768	pack [label $w.a -bg beige \
769	-text "Change profile function for Histogram #$hist Phase #$phase" \
770	] -side top
771	} else {
772	# make a list of histograms by phase
773	foreach h $histlist p $phaselist {
774	lappend phlist($p) $h
775	}
776	set num 0
777	pack [frame $w.a -bg beige] -side top
778	pack [label $w.a.$num -bg beige \
779	-text "Change profile function for:" \
780	] -side top -anchor w
781	foreach i [lsort [array names phlist]] {
782	incr num
783	pack [label $w.a.$num -bg beige -text \
784	"\tPhase #$i, Histograms [CompressList $phlist($i)]" \
785	] -side top -anchor w
786	}
787	}
788	pack [label $w.e1 \
789	-text "Current function is type $ptype." \
790	-bg beige] -side top -anchor w
791	pack [frame $w.e -bg beige] -side top -expand yes -fill both
792	pack [label $w.e.1 \
793	-text "Set function to type" \
794	-bg beige] -side left
795	set menu [tk_optionMenu $w.e.2 expgui(newpeaktype) junk]
796	pack $w.e.2 -side left -anchor w
797
798	pack [radiobutton $w.e.4 -bg beige -variable expgui(DefaultPeakType) \
799	-command "set expgui(newpeaktype) $ptype; \
800	FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
801	-value 1 -text "Current value overrides"] -side right
802	pack [radiobutton $w.e.3 -bg beige -variable expgui(DefaultPeakType) \
803	-command \
804	"set expgui(newpeaktype) $ptype; \
805	FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
806	-value 0 -text "Default value overrides"] -side right
807
808	$w.e.2 config -bg beige
809	pack [frame $w.c -bg beige] -side top -expand yes -fill both
810	pack [frame $w.d -bg beige] -side top -expand yes -fill both
811	pack [button $w.d.2 -text Continue \
812	-command "SaveChangeProfileType $w.c [list $histlist] [list $phaselist]; destroy $w"\
813	] -side left
814	pack [button $w.d.3 -text Cancel \
815	-command "destroy $w"] -side left
816	pack [button $w.d.help -text Help -bg yellow \
817	-command "MakeWWWHelp expgui5.html ChangeType"] \
818	-side right
819	bind $w <Key-F1> "MakeWWWHelp expgui5.html ChangeType"
820	bind $w <Return> "destroy $w"
821
822	$menu delete 0 end
823	set i 0
824	foreach lbls $lbllist {
825	incr i
826	set j $i
827	# determine if negative profiles are allowed
828	if {[string range $expmap(htype_$hist) 2 2] == "T"} {
829	if {[histinfo $hist proftbl] > 0 && $i > 2} {
830	set j -$i
831	}
832	}
833	$menu add command -label $j -command \
834	"set expgui(newpeaktype) $j; \
835	FillChangeProfileType $w.c $hist $phase $j [list $lbls] [list $oldlbls]"
836	}
837	set expgui(newpeaktype) $ptype
838	FillChangeProfileType $w.c $hist $phase $ptype $oldlbls $oldlbls
839
840	# force the window to stay on top
841	putontop $w
842	focus $w.e.2
843	tkwait window $w
844	afterputontop
845	sethistlist
846	}
847
848	# save the changes to the profile
849	proc SaveChangeProfileType {w histlist phaselist} {
850	global expgui
851	foreach phase $phaselist hist $histlist {
852	hapinfo $hist $phase proftype set $expgui(newpeaktype)
853	RecordMacroEntry "hapinfo $hist $phase proftype set $expgui(newpeaktype)" 0
854	hapinfo $hist $phase profterms set $expgui(newProfileTerms)
855	RecordMacroEntry "hapinfo $hist $phase profterms set $expgui(newProfileTerms)" 0
856	for {set i 1} {$i <= $expgui(newProfileTerms)} {incr i} {
857	hapinfo $hist $phase pterm$i set [$w.ent${i} get]
858	RecordMacroEntry "hapinfo $hist $phase pterm$i set [$w.ent${i} get]" 0
859	hapinfo $hist $phase pref$i set $expgui(ProfRef$i)
860	RecordMacroEntry "hapinfo $hist $phase pref$i set $expgui(ProfRef$i)" 0
861	}
862	set i [expr 1+$expgui(newProfileTerms)]
863	hapinfo $hist $phase pcut set [$w.ent$i get]
864	RecordMacroEntry "hapinfo $hist $phase pcut set [$w.ent$i get]" 0
865	incr expgui(changed) [expr 3 + $expgui(newProfileTerms)]
866	RecordMacroEntry "incr expgui(changed)" 0
867	}
868	}
869
870	# file the contents of the "Change Profile Type" Menu
871	proc FillChangeProfileType {w hist phase newtype lbls oldlbls} {
872	global expgui expmap
873	set ptype [string trim [hapinfo $hist $phase proftype]]
874	catch {unset oldval}
875	# loop through the old terms and set up an array of starting values
876	set num 0
877	foreach term $oldlbls {
878	incr num
879	set oldval($term) [hapinfo $hist $phase pterm$num]
880	}
881	set oldval(Peak\nCutoff) [hapinfo $hist $phase pcut]
882
883	# is the new type the same as the current?
884	if {$ptype == $newtype} {
885	set nterms [hapinfo $hist $phase profterms]
886	} else {
887	set nterms [llength $lbls]
888	}
889	set expgui(newProfileTerms) $nterms
890	set expgui(CurrentProfileTerms) $nterms
891	# which default profile set matches the new type
892	set setnum {}
893	foreach j {" " 1 2 3 4 5 6 7 8 9} {
894	set i [profdefinfo $hist $j proftype]
895	if {$i == ""} continue
896	if {$i == $newtype} {
897	set setnum $j
898	break
899	}
900	}
901
902	eval destroy [winfo children $w]
903
904	set colstr 0
905	set row 2
906	set maxrow [expr $row + $nterms/2]
907	for { set num 1 } { $num <= $nterms + 1} { incr num } {
908	# get the default value (originally from the in .INS file)
909	set val {}
910	if {$setnum != ""} {
911	set val 0.0
912	catch {
913	set val [profdefinfo $hist $setnum pterm$num]
914	# pretty up the number
915	if {$val == 0.0} {
916	set val 0.0
917	} elseif {abs($val) < 1e-2 \|\| abs($val) > 1e6} {
918	set val [format %.3e $val]
919	} elseif {abs($val) > 1e-2 && abs($val) < 10} {
920	set val [format %.5f $val]
921	} elseif {abs($val) < 9999} {
922	set val [format %.2f $val]
923	} elseif {abs($val) < 1e6} {
924	set val [format %.0f $val]
925	}
926	}
927	}
928	# heading
929	if {$row == 2} {
930	set col $colstr
931	grid [label $w.h0${num} -text "lbl" -bg beige] \
932	-row $row -column $col
933	grid [label $w.h2${num} -text "ref" -bg beige] \
934	-row $row -column [incr col]
935	grid [label $w.h3${num} -text "next value" -bg beige] \
936	-row $row -column [incr col]
937	grid [label $w.h4${num} -text "default" -bg beige] \
938	-row $row -column [incr col]
939	grid [label $w.h5${num} -text "current" -bg beige] \
940	-row $row -column [incr col]
941	}
942	set col $colstr
943	incr row
944	set term {}
945	catch {set term [lindex $lbls [expr $num-1]]}
946	if {$term == ""} {set term $num}
947	if {$num == $nterms + 1} {
948	set term "Peak\nCutoff"
949	set val {}
950	if {$setnum != ""} {
951	set val 0.0
952	catch {set val [profdefinfo $hist $setnum pcut]}
953	}
954	}
955
956	grid [label $w.l${num} -text "$term" -bg beige] \
957	-row $row -column $col
958	grid [checkbutton $w.chk${num} -variable expgui(ProfRef$num) \
959	-bg beige -activebackground beige] -row $row -column [incr col]
960	grid [entry $w.ent${num} \
961	-width 12] -row $row -column [incr col]
962	if {$val != ""} {
963	grid [button $w.def${num} -text $val -command \
964	"$w.ent${num} delete 0 end; $w.ent${num} insert end $val" \
965	] -row $row -column [incr col] -sticky ew
966	} else {
967	grid [label $w.def${num} -text (none) \
968	] -row $row -column [incr col]
969	}
970	set curval {}
971	catch {
972	set curval [expr $oldval($term)]
973	# pretty up the number
974	if {$curval == 0.0} {
975	set curval 0.0
976	} elseif {abs($curval) < 1e-2 \|\| abs($curval) > 1e6} {
977	set curval [format %.3e $curval]
978	} elseif {abs($curval) > 1e-2 && abs($curval) < 10} {
979	set curval [format %.5f $curval]
980	} elseif {abs($curval) < 9999} {
981	set curval [format %.2f $curval]
982	} elseif {abs($curval) < 1e6} {
983	set curval [format %.0f $curval]
984	}
985	grid [button $w.cur${num} -text $curval -command \
986	"$w.ent${num} delete 0 end; $w.ent${num} insert end $curval" \
987	] -row $row -column [incr col] -sticky ew
988	}
989	# set default values for flag and value
990	set ref 0
991	if {$setnum != ""} {
992	catch {
993	if {[profdefinfo $hist $setnum pref$num] == "Y"} {set ref 1}
994	}
995	}
996	set expgui(ProfRef$num) $ref
997
998	$w.ent${num} delete 0 end
999	if {!$expgui(DefaultPeakType) && $val != ""} {
1000	$w.ent${num} insert end $val
1001	} elseif {$curval != ""} {
1002	$w.ent${num} insert end $curval
1003	} elseif {$val != ""} {
1004	$w.ent${num} insert end $val
1005	} else {
1006	$w.ent${num} insert end 0.0
1007	}
1008	if {$row > $maxrow} {
1009	set row 2
1010	incr colstr 5
1011	}
1012	}
1013	if {$::tcl_platform(os) == "Darwin"} {
1014	# on OS X force a window resize
1015	wm geometry [winfo toplevel $w] {}
1016	}
1017	}
1018
1019	#------------------------------------------------------------------------------
1020	# WWW/help routines
1021	#------------------------------------------------------------------------------
1022	# browse a WWW page with URL. The URL may contain a #anchor
1023	# On UNIX assume netscape or mozilla is in the path or env(BROWSER) is loaded.
1024	# On Windows search the registry for a browser. Mac branch not tested.
1025	# This is taken from http://mini.net/cgi-bin/wikit/557.html with many thanks
1026	# to the contributers
1027	proc urlOpen {url} {
1028	global env tcl_platform
1029	if {$tcl_platform(os) == "Darwin"} {
1030	# if this is an external URL or does not contain an anchor, take the
1031	# easy approach
1032	if {[string range $url 0 4] == "http:" \|\| \
1033	[string first "#" $url] == -1} {
1034	if {![catch {exec open $url}]} {
1035	return
1036	}
1037	}
1038	# so sorry, have to use Safari, even if not default
1039	set url [file nativename $url]; # replace ~/ if present
1040	if {[file pathtype $url] == "relative"} {
1041	set url [file join [pwd] $url]
1042	}
1043	exec osascript -e "tell application \"Safari\" to open location \"file://$url\""
1044	} elseif {$tcl_platform(platform) == "unix"} {
1045	set browserlist {}
1046	if {[info exists env(BROWSER)]} {
1047	set browserlist $env(BROWSER)
1048	}
1049	lappend browserlist netscape mozilla
1050	foreach p $browserlist {
1051	set progs [auto_execok $p]
1052	if {[llength $progs]} {
1053	if {[catch {exec $progs -remote openURL($url)}]} {
1054	# perhaps browser doesn't understand -remote flag
1055	if {[catch {exec $env(BROWSER) $url &} emsg]} {
1056	error "Error displaying $url in browser\n$emsg"
1057	}
1058	}
1059	return
1060	}
1061	}
1062	MyMessageBox -parent . -title "No Browser" \
1063	-message "Could not find a browser. Netscape & Mozilla not found. Define environment variable BROWSER to be full path name of browser." \
1064	-icon warning
1065	} elseif {$tcl_platform(platform) == "windows"} {
1066	package require registry
1067	# Look for the application under
1068	# HKEY_CLASSES_ROOT
1069	set root HKEY_CLASSES_ROOT
1070
1071	# Get the application key for HTML files
1072	set appKey [registry get $root\\.html ""]
1073
1074	# Get the command for opening HTML files
1075	set appCmd [registry get \
1076	$root\\$appKey\\shell\\open\\command ""]
1077
1078	# Substitute the HTML filename into the command for %1
1079	# or stick it on the end
1080	if {[string first %1 $appCmd] != -1} {
1081	regsub %1 $appCmd $url appCmd
1082	} else {
1083	append appCmd " " $url
1084	}
1085
1086	# Double up the backslashes for eval (below)
1087	regsub -all {\\} $appCmd {\\\\} appCmd
1088
1089	# Invoke the command
1090	eval exec $appCmd &
1091	} elseif {$tcl_platform(platform) == "macintosh"} {
1092	# preOSX -- this is not used
1093	if {0 == [info exists env(BROWSER)]} {
1094	set env(BROWSER) "Browse the Internet"
1095	}
1096	if {[catch {
1097	AppleScript execute\
1098	"tell application \"$env(BROWSER)\"
1099	open url \"$url\"
1100	end tell
1101	"} emsg]
1102	} then {
1103	error "Error displaying $url in browser\n$emsg"
1104	}
1105	}
1106	}
1107
1108	proc NetHelp {file anchor localloc netloc} {
1109	# use the file on-line, if it exists
1110	if {[file exists [file join $localloc $file]]} {
1111	set url "[file join $localloc $file]"
1112	} else {
1113	set url "http://$netloc/$file"
1114	}
1115	catch {
1116	pleasewait "Starting web browser..."
1117	after 2000 donewait
1118	}
1119	if {$anchor != ""} {
1120	append url # $anchor
1121	}
1122	urlOpen $url
1123	}
1124
1125	proc MakeWWWHelp {"topic {}" "anchor {}"} {
1126	global expgui
1127	if {$topic == ""} {
1128	foreach item $expgui(notebookpagelist) {
1129	if {[lindex $item 0] == $expgui(pagenow)} {
1130	NetHelp [lindex $item 5] [lindex $item 6] $expgui(docdir) $expgui(website)
1131	return
1132	}
1133	}
1134	# this should not happen
1135	NetHelp expgui.html "" $expgui(docdir) $expgui(website)
1136	} elseif {$topic == "menu"} {
1137	NetHelp expguic.html "" $expgui(docdir) $expgui(website)
1138	} else {
1139	NetHelp $topic $anchor $expgui(docdir) $expgui(website)
1140	}
1141	}
1142
1143	# show help information
1144	proc showhelp {} {
1145	global expgui_helplist helpmsg
1146	set helpmsg {}
1147	set frm .help
1148	catch {destroy $frm}
1149	toplevel $frm
1150	wm title $frm "Help Summary"
1151	grid [label $frm.0 -text \
1152	"Click on an entry below to see information on the EXPGUI/GSAS topic" ] \
1153	-column 0 -columnspan 4 -row 0
1154	# grid [message $frm.help -textvariable helpmsg -relief groove] \
1155	# -column 0 -columnspan 4 -row 2 -sticky nsew
1156	grid [text $frm.help -relief groove -bg beige -width 0\
1157	-height 0 -wrap word -yscrollcommand "$frm.escroll set"] \
1158	-column 0 -columnspan 3 -row 2 -sticky nsew
1159	grid [scrollbar $frm.escroll -command "$frm.help yview"] \
1160	-column 4 -row 2 -sticky nsew
1161	grid rowconfig $frm 1 -weight 1 -minsize 50
1162	grid rowconfig $frm 2 -weight 2 -pad 20 -minsize 150
1163	grid columnconfig $frm 0 -weight 1
1164	grid columnconfig $frm 2 -weight 1
1165	set lst [array names expgui_helplist]
1166	grid [listbox $frm.cmds -relief raised -bd 2 \
1167	-yscrollcommand "$frm.scroll set" \
1168	-height 8 -width 0 -exportselection 0 ] \
1169	-column 0 -row 1 -sticky nse
1170	grid [scrollbar $frm.scroll -command "$frm.cmds yview"] \
1171	-column 1 -row 1 -sticky nsew
1172	foreach item [lsort -dictionary $lst] {
1173	$frm.cmds insert end $item
1174	}
1175	if {[$frm.cmds curselection] == ""} {$frm.cmds selection set 0}
1176	grid [button $frm.done -text Done -command "destroy $frm"] \
1177	-column 2 -row 1
1178	# bind $frm.cmds <ButtonRelease-1> \
1179	# "+set helpmsg \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\])"
1180	bind $frm.cmds <ButtonRelease-1> \
1181	"+$frm.help config -state normal; $frm.help delete 0.0 end; \
1182	$frm.help insert end \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\]); \
1183	$frm.help config -state disabled"
1184
1185	# get the size of the window and expand the message boxes to match
1186	# update
1187	# $frm.help config -width [winfo width $frm.help ]
1188	}
1189
1190
1191	#------------------------------------------------------------------------------
1192	# utilities
1193	#------------------------------------------------------------------------------
1194	# run liveplot
1195	proc liveplot {} {
1196	global expgui liveplot wishshell expmap
1197	set expnam [file root [file tail $expgui(expfile)]]
1198	# which histograms are ready for use?
1199	set validlist {}
1200	foreach ihist $expmap(powderlist) {
1201	if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" \|\| \
1202	[string range $expmap(htype_$ihist) 3 3] == "D"} {
1203	lappend validlist $ihist
1204	}
1205	}
1206	if {[llength $validlist] == 0} {
1207	MyMessageBox -parent . -title "No Valid Histograms" \
1208	-message "No histograms are ready to plot. Run GENLES and try again" \
1209	-icon warning -helplink "expguierr.html NoValidHist"
1210	return
1211	}
1212	# use $liveplot(hst) if valid, the 1st entry otherwise
1213	if {[lsearch $validlist $liveplot(hst)] != -1} {
1214	exec $wishshell [file join $expgui(scriptdir) liveplot] \
1215	$expnam $liveplot(hst) $liveplot(legend) &
1216	} else {
1217	exec $wishshell [file join $expgui(scriptdir) liveplot] \
1218	$expnam [lindex $validlist 0] $liveplot(legend) &
1219	}
1220	}
1221
1222	# run lstview
1223	proc lstview {} {
1224	global expgui wishshell
1225	set expnam [file root [file tail $expgui(expfile)]]
1226	exec $wishshell [file join $expgui(scriptdir) lstview] $expnam &
1227	}
1228
1229	# run widplt
1230	proc widplt {"prog widplt"} {
1231	global expgui wishshell
1232	exec $wishshell [file join $expgui(scriptdir) $prog] \
1233	$expgui(expfile) &
1234	}
1235
1236	# run bkgedit
1237	proc bkgedit {"hst {}"} {
1238	global expgui liveplot wishshell expmap
1239	set expnam [file root [file tail $expgui(expfile)]]
1240	if {$hst == ""} {
1241	# which histograms are ready for use?
1242	set validlist {}
1243	foreach ihist $expmap(powderlist) {
1244	if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" \|\| \
1245	[string range $expmap(htype_$ihist) 3 3] == "*"} {
1246	lappend validlist $ihist
1247	}
1248	}
1249	if {[llength $validlist] == 0} {
1250	MyMessageBox -parent . -title "No Valid Histograms" \
1251	-message "No histograms are ready to plot. Run POWPREF and try again" \
1252	-icon warning -helplink "expguierr.html NoValidHist"
1253	return
1254	}
1255	# use $liveplot(hst) if valid, the 1st entry otherwise
1256	if {[lsearch $validlist $liveplot(hst)] != -1} {
1257	set hst $liveplot(hst)
1258	} else {
1259	set hst [lindex $validlist 0]
1260	}
1261	}
1262	# Save the current exp file
1263	savearchiveexp
1264	CantRecordMacroEntry "bkgedit"
1265	# disable the file change monitor if we will reload the .EXP file automatically
1266	if {$expgui(autoexpload)} {set expgui(expModifiedLast) 0}
1267	if {$expgui(autoiconify)} {wm iconify .}
1268	exec $wishshell [file join $expgui(scriptdir) bkgedit] \
1269	$expnam $hst $liveplot(legend)
1270	if {$expgui(autoiconify)} {wm deiconify .}
1271	# load the changed .EXP file automatically?
1272	if {$expgui(autoexpload)} {
1273	# load the revised exp file
1274	loadexp $expgui(expfile)
1275	} else {
1276	# check for changes in the .EXP file immediately
1277	whenidle
1278	}
1279	}
1280
1281	# run excledt
1282	proc excledit {} {
1283	global expgui liveplot expmap
1284	set expnam [file root [file tail $expgui(expfile)]]
1285	# which histograms are ready for use?
1286	set validlist {}
1287	foreach ihist $expmap(powderlist) {
1288	if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" \|\| \
1289	[string range $expmap(htype_$ihist) 3 3] == "*" \|\| \
1290	[string range $expmap(htype_$ihist) 3 3] == "D"} {
1291	lappend validlist $ihist
1292	}
1293	}
1294	if {[llength $validlist] == 0} {
1295	MyMessageBox -parent . -title "No Valid Histograms" \
1296	-message "No histograms are ready to plot. Run POWPREF and try again" \
1297	-icon warning -helplink "expguierr.html NoValidHist"
1298	return
1299	}
1300	#if {$expgui(autoiconify)} {wm iconify .}
1301	StartExcl
1302	#if {$expgui(autoiconify)} {wm deiconify .}
1303	}
1304
1305	# compute the composition for each phase and display in a dialog
1306	proc composition {} {
1307	global expmap expgui
1308	set Z 1
1309	foreach phase $expmap(phaselist) type $expmap(phasetype) {
1310	if {$type == 4} continue
1311	ResetMultiplicities $phase {}
1312	catch {unset total}
1313	foreach atom $expmap(atomlist_$phase) {
1314	set type [atominfo $phase $atom type]
1315	set mult [atominfo $phase $atom mult]
1316	if [catch {set total($type)}] {
1317	set total($type) [expr \
1318	$mult * [atominfo $phase $atom frac]]
1319	} else {
1320	set total($type) [expr $total($type) + \
1321	$mult * [atominfo $phase $atom frac]]
1322	}
1323	if {$mult > $Z} {set Z $mult}
1324	}
1325	append text "\nPhase $phase\n"
1326	append text " Unit cell contents\n"
1327	foreach type [lsort [array names total]] {
1328	append text " $type[format %8.3f $total($type)]"
1329	}
1330	append text "\n\n"
1331
1332	append text " Asymmetric Unit contents (Z=$Z)\n"
1333	foreach type [lsort [array names total]] {
1334	append text " $type[format %8.3f [expr $total($type)/$Z]]"
1335	}
1336	append text "\n"
1337	}
1338
1339	catch {destroy .comp}
1340	toplevel .comp -class MonoSpc
1341	bind .comp <Key-F1> "MakeWWWHelp expgui.html Composition"
1342	wm title .comp Composition
1343	pack [label .comp.results -text $text \
1344	-justify left] -side top
1345	pack [frame .comp.box] -side top -expand y -fill x
1346	pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
1347
1348	set lstnam [string toupper [file tail [file rootname $expgui(expfile)].LST]]
1349	pack [button .comp.box.2 -text "Save to $lstnam file" \
1350	-command "writelst [list $text] ; destroy .comp"] -side left
1351	pack [button .comp.box.help -text Help -bg yellow \
1352	-command "MakeWWWHelp expgui.html Composition"] \
1353	-side right
1354	}
1355
1356	# Delete History Records
1357	proc DeleteHistoryRecords {{msg ""}} {
1358	global expgui
1359	set frm .history
1360	catch {destroy $frm}
1361	toplevel $frm
1362	bind $frm <Key-F1> "MakeWWWHelp expgui.html DeleteHistoryRecords"
1363	if {[string trim $msg] == ""} {
1364	set msg "There are [CountHistory] history records"
1365	}
1366	pack [frame $frm.1 -bd 2 -relief groove] -padx 3 -pady 3 -side left
1367	pack [label $frm.1.0 -text $msg] -side top
1368	pack [frame $frm.1.1] -side top
1369	pack [label $frm.1.1.1 -text "Number of entries to keep"] -side left
1370	pack [entry $frm.1.1.2 -width 3 -textvariable expgui(historyKeep)\
1371	] -side left
1372	set expgui(historyKeep) 10
1373	pack [checkbutton $frm.1.2 -text renumber -variable expgui(renumber)] -side top
1374	set expgui(renumber) 1
1375	pack [frame $frm.2] -padx 3 -pady 3 -side left -fill both -expand yes
1376	pack [button $frm.2.help -text Help -bg yellow \
1377	-command "MakeWWWHelp expgui.html DeleteHistoryRecords"] -side top
1378	pack [button $frm.2.4 -text Cancel \
1379	-command {destroy .history}] -side bottom
1380	pack [button $frm.2.3 -text OK \
1381	-command {
1382	if ![catch {expr $expgui(historyKeep)}] {
1383	DeleteHistory $expgui(historyKeep) $expgui(renumber)
1384	set expgui(changed) 1
1385	destroy .history
1386	}
1387	}] -side bottom
1388	bind $frm <Return> "$frm.2.3 invoke"
1389
1390	# force the window to stay on top
1391	putontop $frm
1392	focus $frm.2.3
1393	tkwait window $frm
1394	afterputontop
1395	}
1396
1397	proc archiveexp {} {
1398	global expgui tcl_platform
1399	# is there a file to archive?
1400	if {![file exists $expgui(expfile)]} return
1401	set expnam [file rootname $expgui(expfile)]
1402	# get the last archived version
1403	set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
1404	if {$lastf == ""} {
1405	set num 01
1406	} else {
1407	regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
1408	scan $num %x num
1409	if {$num >= 255} {
1410	set num FF
1411	} else {
1412	set num [string toupper [format %.2x [incr num]]]
1413	}
1414	}
1415	catch {
1416	set file $expnam.O$num
1417	file copy -force $expgui(expfile) $file
1418	set fp [open $expnam.LST a+]
1419	puts $fp "\n----------------------------------------------"
1420	puts $fp " Archiving [file tail $expnam.EXP] as [file tail $file]"
1421	puts $fp "----------------------------------------------\n"
1422	close $fp
1423	} errmsg
1424	if {$errmsg != ""} {
1425	tk_dialog .warn Confirm "Error archiving the current .EXP file: $errmsg" warning 0 OK
1426	}
1427	}
1428
1429	# save and optionally archive the expfile
1430	proc savearchiveexp {} {
1431	global expgui expmap
1432	if {$expgui(expfile) == ""} {
1433	SaveAsFile
1434	return
1435	}
1436	if !$expgui(changed) return
1437	if {$expgui(archive)} archiveexp
1438	# add a history record
1439	exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds] -format {%D %T}]"
1440	# now save the file
1441	expwrite $expgui(expfile)
1442	# change the icon and assign an app to this .EXP file
1443	global tcl_platform
1444	if {$tcl_platform(os) == "Darwin" && $expgui(MacAssignApp)} {
1445	catch {MacSetResourceFork $expgui(expfile)}
1446	}
1447	set expgui(changed) 0
1448	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
1449	set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
1450	wm title . $expgui(expfile)
1451	set expgui(titleunchanged) 1
1452	# set convergence criterion
1453	InitLSvars
1454	}
1455
1456	#------------------------------------------------------------------------------
1457	# GSAS interface routines
1458	#------------------------------------------------------------------------------
1459	# run a GSAS program that does not require an experiment file
1460	proc runGSASprog {proglist "concurrent 1"} {
1461	# save call to Macro file
1462	RecordMacroEntry "runGSASprog [list $proglist] $concurrent" 0
1463	# if concurrent is 0, EXPGUI runs the GSAS program in background
1464	# -- this is not currently needed anywhere where the .EXP file is not.
1465	global expgui tcl_platform
1466	set cmd {}
1467	foreach prog $proglist {
1468	StartGRWND $prog
1469	if {$tcl_platform(platform) == "windows"} {
1470	append cmd " \"[file attributes $expgui(gsasexe)/${prog}.exe -shortname]\" "
1471	} else {
1472	if {$cmd != ""} {append cmd "\;"}
1473	append cmd "[file join $expgui(gsasexe) $prog]"
1474	}
1475	}
1476	forknewterm $prog $cmd [expr !$concurrent] 1
1477	}
1478
1479	# dummy routine, overridden if needed
1480	proc StartGRWND {prog} {
1481	}
1482
1483	# run a GSAS program that requires an experiment file for input/output
1484	proc runGSASwEXP {proglist "concurrent 0"} {
1485	# save call to Macro file
1486	RecordMacroEntry "runGSASwEXP [list $proglist] $concurrent" 0
1487	# most programs that require the .EXP file change it and
1488	# cannot be run concurrently
1489	global expgui tcl_platform
1490	# Save the current exp file
1491	savearchiveexp
1492	# load the changed .EXP file automatically?
1493	if {$expgui(autoexpload)} {
1494	# disable the file changed monitor
1495	set expgui(expModifiedLast) 0
1496	}
1497	set cmd {}
1498	set expnam [file root [file tail $expgui(expfile)]]
1499	foreach prog $proglist {
1500	if {$prog == "powpref"} {
1501	set expgui(needpowpref) 0
1502	set expgui(needpowpref_why) ""
1503	} elseif {$prog == "genles" && $expgui(needpowpref) != 0} {
1504	set msg "You are attempting to run GENLES, after making changes that require POWPREF:\n\n$expgui(needpowpref_why) \nRun POWPREF first?"
1505	set ans [MyMessageBox -parent . -title "Run POWPREF" \
1506	-message $msg -icon warning -type "Yes No" -default yes \
1507	-helplink "expguierr.html RunPowpref"]
1508	if {$ans == "yes"} {
1509	set expgui(needpowpref) 0
1510	set expgui(needpowpref_why) ""
1511	if {$tcl_platform(platform) == "windows"} {
1512	append cmd " \"[file attributes $expgui(gsasexe)/powpref.exe -shortname] $expnam \" "
1513	} else {
1514	if {$cmd != ""} {append cmd "\;"}
1515	append cmd "[file join $expgui(gsasexe) powpref] $expnam"
1516	}
1517	}
1518	}
1519	StartGRWND $prog
1520	if {$tcl_platform(platform) == "windows"} {
1521	append cmd " \"[file attributes $expgui(gsasexe)/${prog}.exe -shortname] $expnam \" "
1522	} elseif {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
1523	append cmd " \" [file join $expgui(gsasexe) $prog] $expnam \" "
1524	} else {
1525	if {$cmd != ""} {append cmd "\;"}
1526	append cmd "[file join $expgui(gsasexe) $prog] $expnam"
1527	}
1528	}
1529	if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
1530	set outfile ${expnam}_macout.LST
1531	runnoterm $cmd $outfile
1532	} else {
1533	forknewterm "$prog -- $expnam" $cmd [expr !$concurrent] 1
1534	}
1535	# load the changed .EXP file automatically?
1536	if {$expgui(autoexpload)} {
1537	# load the revised exp file
1538	loadexp $expgui(expfile)
1539	}
1540	if {$expgui(MacroRunning)} {
1541	if {[file exists abort_${expnam}_macro.flag]} {
1542	file delete abort_${expnam}_macro.flag
1543	error "User requested to abort the macro"
1544	}
1545	update idletasks
1546	}
1547	}
1548
1549	# write text to the .LST file
1550	proc writelst {text} {
1551	global expgui
1552	set lstnam [file rootname $expgui(expfile)].LST
1553	set fp [open $lstnam a]
1554	puts $fp "\n-----------------------------------------------------------------"
1555	puts $fp $text
1556	puts $fp "-----------------------------------------------------------------\n"
1557	close $fp
1558	}
1559
1560
1561	# rename file current to suggested,
1562	# delete window if supplied
1563	# use parent, if supplied or .
1564	proc RenameAsFile {current suggested "window {}" "parent {}"} {
1565	if {$parent == "" && $window != ""} {set parent $window}
1566	if {$parent == ""} {set parent .}
1567	set newfile [tk_getSaveFile -initialfile $suggested -parent $parent]
1568	if {$newfile == ""} return
1569	if {[catch {
1570	file rename -force $current $newfile
1571	}]} {
1572	file copy -force $current $newfile
1573	file delete -force $current
1574	}
1575	if {$window != ""} {destroy $window}
1576	}
1577
1578	# optionally run disagl as a windowless process, w/results in a separate window
1579	proc rundisagl {} {
1580	global expgui txtvw tcl_version tcl_platform
1581	# call up new DISAGL parm edit box
1582	if {[DA_Control_Panel 1]} {return}
1583	# Save the current exp file if needed
1584	savearchiveexp
1585	if {$expgui(disaglSeparateBox)} {
1586	set root [file root $expgui(expfile)]
1587	catch {file delete -force $root.tmp}
1588	if {[catch {file rename -force $root.LST $root.OLS}]} {
1589	file copy -force $root.LST $root.OLS
1590	file delete -force $root.OLS
1591	}
1592	# PSW reports this does not happen right away on windows
1593	set i 0
1594	while {$i < 10 && [file exists $root.LST]} {
1595	# debug code
1596	#catch {console show}
1597	#puts "try $i"
1598	# end debug code
1599	after 100
1600	incr i
1601	}
1602	if {[file exists $root.LST]} {
1603	# it was not possible to rename the file
1604	MyMessageBox -parent . -title "Rename Problem" \
1605	-message "Unable to rename $root.LST. Please close LSTVIEW and try again" \
1606	-icon warning -helplink "expguierr.html NoRename"
1607	return
1608	}
1609
1610	#run the program
1611	pleasewait "Running DISAGL"
1612	# create an empty input file
1613	close [open disagl.inp w]
1614	catch {exec [file join $expgui(gsasexe) disagl] \
1615	[file tail $root] < disagl.inp > disagl.out}
1616	if {[catch {file rename -force $root.LST $root.tmp}]} {
1617	file copy -force $root.LST $root.tmp
1618	file delete -force $root.LST
1619	}
1620	catch {file delete -force disagl.inp disagl.out}
1621	if {[catch {file rename -force $root.OLS $root.LST}]} {
1622	file copy -force $root.OLS $root.LST
1623	file delete -force $root.OLS
1624	}
1625	donewait
1626	# open a new window
1627	catch {toplevel .disagl}
1628	eval destroy [winfo child .disagl]
1629	set txt .disagl.txt
1630	catch {eval grid forget [grid slaves .disagl]}
1631	text $txt -width 100 -wrap none \
1632	-yscrollcommand ".disagl.yscroll set" \
1633	-xscrollcommand ".disagl.xscroll set"
1634	scrollbar .disagl.yscroll -command "$txt yview"
1635	scrollbar .disagl.xscroll -command "$txt xview" -orient horizontal
1636	grid .disagl.xscroll -column 0 -row 2 -sticky ew
1637	grid $txt -column 0 -row 1 -sticky nsew
1638	grid .disagl.yscroll -column 1 -row 1 -sticky ns
1639	grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
1640	grid columnconfig .disagl.f 2 -weight 1
1641	grid [button .disagl.f.close -text "Close & Delete" \
1642	-command "destroy .disagl; file delete \[list $root.tmp\]"] \
1643	-column 3 -row 0 -sticky e
1644	grid [button .disagl.f.rename \
1645	-command "RenameAsFile \[list $root.tmp\] \[list $root.DIS\] .disagl" \
1646	-text "Close & Save as..."] \
1647	-column 4 -row 0 -sticky e
1648	# allow font changes on the fly
1649	if {$tcl_version >= 8.0} {
1650	$txt config -font $txtvw(font)
1651	set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
1652	grid .disagl.f.font -column 1 -row 0 -sticky w
1653	grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
1654	$fontbut delete 0 end
1655	foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
1656	$fontbut add command -label "Courier $f" -font "Courier $f"\
1657	-command "set txtvw(font) \"Courier $f\"; \
1658	$txt config -font \$txtvw(font)"
1659	}
1660	}
1661
1662	grid columnconfigure .disagl 0 -weight 1
1663	grid rowconfigure .disagl 1 -weight 1
1664	wm title .disagl "DISAGL results $expgui(expfile)"
1665	wm iconname .disagl "DISAGL $root"
1666	set in [open $root.tmp r]
1667	$txt insert end [read $in]
1668	close $in
1669	bind all {destroy .disagl}
1670	bind .disagl "$txt yview scroll -1 page"
1671	bind .disagl "$txt yview scroll 1 page"
1672	bind .disagl "$txt xview scroll 1 unit"
1673	bind .disagl "$txt xview scroll -1 unit"
1674	bind .disagl "$txt yview scroll -1 unit"
1675	bind .disagl "$txt yview scroll 1 unit"
1676	bind .disagl "$txt yview 0"
1677	bind .disagl "$txt yview end"
1678	# don't disable in Win as this prevents the highlighting of selected text
1679	if {$tcl_platform(platform) != "windows"} {
1680	$txt config -state disabled
1681	}
1682	# find the beginning of the disagl text
1683
1684	set pos 1.0
1685	set nph 0
1686	while {[set loc [$txt search "Program DISAGL Version" $pos end]] != ""} {
1687	set pos [expr {$loc + 1}]
1688	incr nph
1689	}
1690	#puts "Found $nph DISAGL run(s)"
1691	# count phases
1692	set l {}
1693	while {[set loc [$txt search "Lattice constants are" $pos end]] != ""} {
1694	lappend l $loc
1695	set pos [expr {$loc + 1}]
1696	}
1697	catch {unset phaseloc}
1698
1699	set j 0
1700	foreach pos $l {
1701	if {$j == 0} {
1702	set prev $pos
1703	incr j
1704	continue
1705	}
1706	set phaseloc($j) [list $prev $pos]
1707	incr j
1708	}
1709	set phaseloc($j) [list $pos end]
1710	if {$nph >= 1 && $j >= 2} {
1711	grid [menubutton .disagl.f.copy \
1712	-menu .disagl.f.copy.menu \
1713	-text "Copy phase..." -bd 2 -relief raised] \
1714	-column 2 -row 0 -sticky nse
1715	menu .disagl.f.copy.menu
1716	for {set i 1} {$i <= $j} {incr i} {
1717	.disagl.f.copy.menu add command \
1718	-command "seldisaglphase $txt [list $phaseloc($i)]" \
1719	-label "Copy phase $i to clipboard"
1720	}
1721	} elseif {$nph >= 1} {
1722	grid [button .disagl.f.copy \
1723	-command "seldisaglphase $txt [list $phaseloc($j)]" \
1724	-text "Copy phase $j to clipboard"] \
1725	-column 2 -row 0 -sticky e
1726	}
1727	} else {
1728	runGSASwEXP disagl
1729	}
1730	}
1731
1732	proc seldisaglphase {txt phaselist} {
1733	# clear selection
1734	$txt tag remove sel 1.1 end
1735	eval $txt tag add sel $phaselist
1736	clipboard clear
1737	clipboard append " \| Program DISAGL Version MacOSX \|\n"
1738	clipboard append [eval $txt get [$txt tag ranges sel]]
1739	}
1740	#------------------------------------------------------------------------------
1741	# file conversions
1742	#------------------------------------------------------------------------------
1743	proc convfile {} {
1744	global expgui
1745	set frm .file
1746	catch {destroy $frm}
1747	toplevel $frm
1748	wm title $frm "Convert File"
1749	bind $frm <Key-F1> "MakeWWWHelp expgui.html ConvertWin"
1750	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1751	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 \
1752	-side left -fill y -expand yes
1753	pack [button $frmC.help -text Help -bg yellow \
1754	-command "MakeWWWHelp expgui.html ConvertWin"] -side top
1755	pack [button $frmC.q -text Cancel -command "destroy $frm"] -side bottom
1756	pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
1757	-side bottom
1758	pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
1759	winfilebox $frm
1760	bind $frm <Return> "ValidWinCnv $frm"
1761
1762	# force the window to stay on top
1763	putontop $frm
1764	focus $frmC.q
1765	tkwait window $frm
1766	afterputontop
1767	}
1768
1769	# validate the files and make the conversion
1770	proc ValidWinCnv {frm} {
1771	global expgui
1772	# change backslashes to something sensible
1773	regsub -all {\\} $expgui(FileMenuCnvName) / expgui(FileMenuCnvName)
1774	# allow entry of D: for D:/ and D:TEST for d:/TEST
1775	if {[string first : $expgui(FileMenuCnvName)] != -1 && \
1776	[string first :/ $expgui(FileMenuCnvName)] == -1} {
1777	regsub : $expgui(FileMenuCnvName) :/ expgui(FileMenuCnvName)
1778	}
1779	if {$expgui(FileMenuCnvName) == "<Parent>"} {
1780	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1781	ChooseWinCnv $frm
1782	return
1783	} elseif [file isdirectory \
1784	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
1785	if {$expgui(FileMenuCnvName) != "."} {
1786	set expgui(FileMenuDir) \
1787	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1788	}
1789	ChooseWinCnv $frm
1790	return
1791	}
1792
1793	set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1794	if ![file exists $file] {
1795	MyMessageBox -parent $frm -title "Convert Error" \
1796	-message "File $file does not exist" -icon error
1797	return
1798	}
1799
1800	set tmpname "[file join [file dirname $file] tempfile.xxx]"
1801	set oldname "[file rootname $file].org"
1802	if [file exists $oldname] {
1803	set ans [MyMessageBox -parent . -title "Overwrite?" \
1804	-message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
1805	-icon warning -type {Overwrite Cancel} -default Overwrite \
1806	-helplink "expguierr.html OverwriteCnv"]
1807	if {[string tolower $ans] == "cancel"} return
1808	catch {file delete $oldname}
1809	}
1810
1811	if [catch {
1812	set in [open $file r]
1813	set out [open $tmpname w]
1814	fconfigure $out -translation crlf -encoding ascii
1815	set len [gets $in line]
1816	if {$len > 160} {
1817	# this is a UNIX file. Hope there are no control characters
1818	set i 0
1819	set j 79
1820	while {$j < $len} {
1821	puts $out [string range $line $i $j]
1822	incr i 80
1823	incr j 80
1824	}
1825	} else {
1826	while {$len >= 0} {
1827	append line " "
1828	append line " "
1829	set line [string range $line 0 79]
1830	puts $out $line
1831	set len [gets $in line]
1832	}
1833	}
1834	close $in
1835	close $out
1836	file rename -force $file $oldname
1837	file rename -force $tmpname $file
1838	} errmsg] {
1839	MyMessageBox -parent $frm -title "Conversion error" \
1840	-message "Error in conversion:\n$errmsg" -icon warning
1841	} else {
1842	set ans [MyMessageBox -parent $frm -title "More?" \
1843	-message "File [file tail $file] converted.\n(Original saved as [file tail $oldname]).\n\n Convert more files?" \
1844	-type yesno -default no]
1845	if {$ans == "no"} {destroy $frm}
1846	}
1847	}
1848
1849	# create a file box
1850	proc winfilebox {frm} {
1851	global expgui
1852	set bx $frm.1
1853	pack [frame $bx.top] -side top
1854	pack [label $bx.top.a -text "Directory" ] -side left
1855	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
1856	pack $bx.top.d -side left
1857	set expgui(FileMenuDir) [pwd]
1858	# the icon below is from tk8.0/tkfbox.tcl
1859	set upfolder [image create bitmap -data {
1860	#define updir_width 28
1861	#define updir_height 16
1862	static char updir_bits[] = {
1863	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1864	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1865	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1866	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1867	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1868	0xf0, 0xff, 0xff, 0x01};}]
1869
1870	pack [button $bx.top.b -image $upfolder \
1871	-command "updir; ChooseWinCnv $frm" ]
1872	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
1873	listbox $bx.a.files -relief raised -bd 2 \
1874	-yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
1875	-height 15 -width 0 -exportselection 0
1876	listbox $bx.a.dates -relief raised -bd 2 \
1877	-yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
1878	-height 15 -width 0 -takefocus 0 -exportselection 0
1879	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
1880	ChooseWinCnv $frm
1881	bind $bx.a.files <ButtonRelease-1> "ReleaseWinCnv $frm"
1882	bind $bx.a.dates <ButtonRelease-1> "ReleaseWinCnv $frm"
1883	bind $bx.a.files <Double-1> "SelectWinCnv $frm"
1884	bind $bx.a.dates <Double-1> "SelectWinCnv $frm"
1885	pack $bx.a.scroll -side left -fill y
1886	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
1887	pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
1888	}
1889
1890	# set the box or file in the selection window
1891	proc ReleaseWinCnv {frm} {
1892	global expgui
1893	set files $frm.1.a.files
1894	set dates $frm.1.a.dates
1895	set select [$files curselection]
1896	if {$select == ""} {
1897	set select [$dates curselection]
1898	}
1899	if {$select == ""} {
1900	set expgui(FileMenuCnvName) ""
1901	} else {
1902	set expgui(FileMenuCnvName) [string trim [$files get $select]]
1903	}
1904	if {$expgui(FileMenuCnvName) == "<Parent>"} {
1905	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
1906	ChooseWinCnv $frm
1907	} elseif [file isdirectory \
1908	[file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
1909	if {$expgui(FileMenuCnvName) != "."} {
1910	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1911	ChooseWinCnv $frm
1912	}
1913	}
1914	return
1915	}
1916
1917	# select a file or directory -- called on double click
1918	proc SelectWinCnv {frm} {
1919	global expgui
1920	set files $frm.1.a.files
1921	set dates $frm.1.a.dates
1922	set select [$files curselection]
1923	if {$select == ""} {
1924	set select [$dates curselection]
1925	}
1926	if {$select == ""} {
1927	set file .
1928	} else {
1929	set file [string trim [$files get $select]]
1930	}
1931	if {$file == "<Parent>"} {
1932	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1933	ChooseWinCnv $frm
1934	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
1935	if {$file != "."} {
1936	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
1937	ChooseWinCnv $frm
1938	}
1939	} else {
1940	set expgui(FileMenuCnvName) [file tail $file]
1941	ValidWinCnv $frm
1942	}
1943	}
1944
1945	# fill the files & dates & Directory selection box with current directory,
1946	# also called when box is created to fill it
1947	proc ChooseWinCnv {frm} {
1948	global expgui
1949	set files $frm.1.a.files
1950	set dates $frm.1.a.dates
1951	set expgui(FileMenuCnvName) {}
1952	$files delete 0 end
1953	$dates delete 0 end
1954	$files insert end {<Parent>}
1955	$dates insert end {(Directory)}
1956	set filelist [glob -nocomplain \
1957	[file join [set expgui(FileMenuDir)] *] ]
1958	foreach file [lsort -dictionary $filelist] {
1959	if {[file isdirectory $file]} {
1960	$files insert end [file tail $file]
1961	$dates insert end {(Directory)}
1962	}
1963	}
1964	foreach file [lsort -dictionary $filelist] {
1965	if {![file isdirectory $file]} {
1966	set modified [clock format [file mtime $file] -format "%T %D"]
1967	$files insert end [file tail $file]
1968	$dates insert end $modified
1969	}
1970	}
1971	$expgui(FileDirButtonMenu) delete 0 end
1972	set list ""
1973	global tcl_version
1974	if {$tcl_version > 8.0} {
1975	catch {set list [string tolower [file volume]]}
1976	}
1977	set dir ""
1978	foreach subdir [file split [set expgui(FileMenuDir)]] {
1979	set dir [string tolower [file join $dir $subdir]]
1980	if {[lsearch $list $dir] == -1} {lappend list $dir}
1981	}
1982	foreach path $list {
1983	$expgui(FileDirButtonMenu) add command -label $path \
1984	-command "[list set expgui(FileMenuDir) $path]; \
1985	ChooseWinCnv $frm"
1986	}
1987	return
1988	}
1989
1990	#------------------------------------------------------------------------------
1991	# set options for liveplot
1992	proc liveplotopt {} {
1993	global liveplot expmap
1994	set frm .file
1995	catch {destroy $frm}
1996	toplevel $frm
1997	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1998	set last [lindex [lsort -integer $expmap(powderlist)] end]
1999	if {$last == ""} {set last 1}
2000	pack [scale $frmA.1 -label "Histogram number" -from 1 -to $last \
2001	-length 150 -orient horizontal -variable liveplot(hst)] -side top
2002	pack [checkbutton $frmA.2 -text {include plot legend}\
2003	-variable liveplot(legend)] -side top
2004	pack [button $frm.2 -text OK \
2005	-command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
2006	] -side top
2007	bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
2008
2009	# force the window to stay on top
2010	putontop $frm
2011	focus $frm.2
2012	tkwait window $frm
2013	afterputontop
2014	}
2015
2016	#------------------------------------------------------------------------------
2017	# get/validate an experiment file name
2018	#------------------------------------------------------------------------------
2019	# validate and store the EXP file name. Create a new .EXP file if it does not
2020	# exist and set the wd to the location of the .EXP file.
2021	proc SetEXPfile {expfile "newOK 0"} {
2022	global expgui tcl_platform
2023	if {[string trim $expfile] == ""} return
2024
2025	# break up the file name and directory
2026	set dirname [file dirname $expfile]
2027	set expname [string toupper [file tail $expfile]]
2028
2029	# check the directory exists
2030	if {(! [file exists $dirname]) \|\| (! [file isdir $dirname])} {
2031	update
2032	MyMessageBox -parent . -title "Directory not found" \
2033	-message "Experiment file location \"$dirname\" is invalid -- no such directory exists" \
2034	-icon warning -type Continue -default continue
2035	set expgui(resize) 1
2036	return
2037	}
2038
2039	# is there a space in the directory name? On windows, try to fix it
2040	set origdir $dirname
2041	if {[string first " " $dirname] != -1} {
2042	set warn 1
2043	catch {set warn $expgui(warnonspaceonce)}
2044	if {$tcl_platform(platform) == "windows"} {
2045	set dirname [file attributes $dirname -shortname]
2046	# was the fix successful?
2047	if {[string first " " $dirname] == -1} {
2048	if {$warn} {
2049	update
2050	MyMessageBox -parent . -title "Still debugging..." \
2051	-message "You are using a directory with a space in the name ($origdir) that will be translated for Windows (to $dirname) -- This should obliviate bugs in EXPGUI, but if still you encounter any please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
2052	-icon warning -type Continue -default continue
2053	set expgui(resize) 1
2054	}
2055	} else {
2056	if {$warn} {
2057	update
2058	MyMessageBox -parent . -title "Can't fix dir" \
2059	-message "You are using a directory with a space in the name ($origdir) in Windows that cannot be translated to a name without spaces (is this a network drive?) -- this could cause problems in EXPGUI. Please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
2060	-icon warning -type Continue -default continue
2061	set expgui(resize) 1
2062	}
2063	}
2064	} elseif {$warn} {
2065	if {$warn} {
2066	update
2067	MyMessageBox -parent . -title "Still debugging..." \
2068	-message "You are using a directory with a space in the name ($origdir). This is not perhaps a wise idea, but I am trying to catch any bugs this causes in EXPGUI. If you encounter any, please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
2069	-icon warning -type Continue -default continue
2070	set expgui(resize) 1
2071	}
2072	}
2073	set expgui(warnonspaceonce) 0
2074	}
2075
2076	# force exp files to be upper case, set to force save if name changes
2077	set origexp $expname
2078	if {$expname != [file tail $expfile] && $tcl_platform(platform) != "windows"} {
2079	set expgui(changed) 1
2080	}
2081	#puts $expgui(expfile)
2082	if {[string match {.O[0-9A-F][0-9A-F]} [file extension $expname]]} {
2083	set expname [ArchiveChoice $expname]
2084	set dirname ""
2085	if {$expname == ""} return
2086	} elseif {[file extension $expname] != ".EXP"} {
2087	append expname ".EXP"
2088	}
2089	if {$dirname == "." \|\| $dirname == ""} {
2090	set newexpfile $expname
2091	} else {
2092	set newexpfile [file join $dirname $expname]
2093	}
2094	# is there a space in the EXP name?
2095	if {[string first " " $expname] != -1} {
2096	# If the file exists in windows, see if there is an equivalent name available.
2097	# if not, we could try to create it and then see, but that is too much
2098	# work.
2099	if {$tcl_platform(platform) == "windows"} {
2100	if {[file exists $newexpfile]} {
2101	# try to translate it, if possible
2102	set expname [file tail [file attributes $newexpfile -shortname]]
2103	set newexpfile [file join $dirname $expname]
2104	# fixed?
2105	if {[string first " " $expname] == -1} {
2106	set warn 1
2107	catch {set warn $expgui(warnonexpspaceonce)}
2108	if {$warn} {
2109	update
2110	MyMessageBox -parent . -title "Still debugging..." \
2111	-message "You are using an EXP file name with a space in the name ($origexp) that will be translated for Windows (to $expname) -- This should obliviate bugs in EXPGUI, but if you still do encounter any please e-mail bug details to Brian.Toby@ANL.gov so they can be fixed." \
2112	-icon warning -type Continue -default continue
2113	set expgui(resize) 1
2114	}
2115	set expgui(warnonexpspaceonce) 0
2116	}
2117	}
2118	if {[string first " " $expname] != -1} {
2119	# not fixed (file does not exist or shortname not supported)
2120	update
2121	MyMessageBox -parent . -title "Can't fix name" \
2122	-message "You are using an EXP file name with a space in the name ($origexp) in Windows that cannot be translated without spaces (is this a network drive?) -- this will cause problems in EXPGUI. Sorry." \
2123	-icon warning -type Continue -default continue
2124	set expgui(resize) 1
2125	return
2126	}
2127	} else {
2128	update
2129	MyMessageBox -parent . -title "Space in name" \
2130	-message "You are using an EXP file name with a space in the name ($origexp). This is likely to cause problems. Please rename the file or create one with another name. Sorry." \
2131	-icon warning -type Continue -default continue
2132	set expgui(resize) 1
2133	return
2134	}
2135	}
2136
2137	if {(! $newOK) && (! [file exists $newexpfile])} {
2138	update
2139	set ans [
2140	MyMessageBox -parent . -title "File Open Error" \
2141	-message "File $expname does not exist in ${dirname}. OK to create?" \
2142	-icon question -type {"Select other" "Create"} -default "select other" \
2143	-helplink "expguierr.html OpenErr"
2144	]
2145	set expgui(resize) 1
2146	if {[string tolower $ans] == "create"} {
2147	# you've been warned this .EXP does not exist!
2148	if [CreateMTexpfile $newexpfile] return
2149	} else {
2150	return
2151	}
2152	}
2153	catch {cd [string trim [file dirname $newexpfile]]}
2154	return $newexpfile
2155	}
2156
2157	proc ArchiveChoice {expfile} {
2158	set expnam [file rootname $expfile]
2159	set ans [MyMessageBox -parent . -title "Load Archived File" \
2160	-message "Loading archived version of $expnam. Do you want to continue using the same experiment name or work with the archived version under a new name?" \
2161	-icon question -type "{Use New Name} {Continue with current}" \
2162	-default {Use New Name} \
2163	-helplink "expguierr.html LoadArchived"
2164	]
2165	# archive the current .EXP file
2166	if {$ans != "use new name" && [file exists $expfile]} {
2167	# get the last archived version
2168	set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
2169	if {$lastf == ""} {
2170	set num 01
2171	} else {
2172	regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
2173	scan $num %x num
2174	if {$num >= 255} {
2175	set num FF
2176	} else {
2177	set num [string toupper [format %.2x [incr num]]]
2178	}
2179	}
2180	catch {
2181	set newfile $expnam.O$num
2182	file rename -force $expnam.EXP $newfile
2183	set fp [open $expnam.LST a+]
2184	puts $fp "\n----------------------------------------------"
2185	puts $fp " Regressing to archive file [file tail $expfile]"
2186	puts $fp " but first archiving [file tail $expnam.EXP] as [file tail $newfile]"
2187	puts $fp "----------------------------------------------\n"
2188	close $fp
2189	}
2190	file copy -force $expfile $expnam.EXP
2191	set expfile $expnam.EXP
2192	}
2193	if {$ans == "use new name"} {
2194	set newexpfile [getExpFileName new]
2195	if {$newexpfile == ""} {
2196	set expgui(FileMenuEXPNAM) ""
2197	return
2198	}
2199	file copy -force $expfile $newexpfile
2200	set expgui(needpowpref) 2
2201	set expgui(needpowpref_why) "\tA new .EXP file was created\n"
2202	return $newexpfile
2203	} else {
2204	return $expfile
2205	}
2206	}
2207
2208	# create an "empty" exp file
2209	proc CreateMTexpfile {newexpfile} {
2210	set expname [file tail $newexpfile]
2211	createexp $newexpfile \
2212	[getstring "title for experiment $expname" 60 0]
2213	if {! [file exists $newexpfile]} {
2214	update
2215	MyMessageBox -parent . -title "File Creation Error" \
2216	-message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \
2217	-icon warning -type Continue -default continue
2218	set ::expgui(resize) 1
2219	return 1
2220	}
2221	return 0
2222	}
2223
2224	proc getExpFileName {mode} {
2225	global expgui tcl_platform
2226	set frm .file
2227	catch {destroy $frm}
2228	toplevel $frm
2229	wm title $frm "Experiment file"
2230	bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
2231	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
2232	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
2233	-fill y -expand yes
2234	pack [button $frmC.help -text Help -bg yellow \
2235	-command "MakeWWWHelp expguierr.html open"] \
2236	-side top -anchor e
2237	pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
2238	pack [radiobutton $frmC.1 -text "File Name" -value 1 \
2239	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
2240	pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
2241	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
2242
2243	set expgui(includearchived) 0
2244	set expgui(FileInfoBox) $frmC.info
2245	if {$mode == "old"} {
2246	pack [checkbutton $frmC.ar -text "Include Archived Files" \
2247	-variable expgui(includearchived) \
2248	-command "ChooseExpFil $frmA"] -side top -pady 10
2249	pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
2250	-class SmallFont] \
2251	-side top -fill both -expand yes -pady 5
2252	} elseif {$mode != "new"} {
2253	# for initial read, don't offer access to archived files
2254	pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
2255	-class SmallFont] \
2256	-side top -fill both -expand yes -pady 5
2257	set mode "old"
2258	}
2259	pack [button $frmC.b -text Read \
2260	-command "valid_exp_file $frmA $mode"] -side bottom
2261	if {$mode == "new"} {
2262	$frmC.b config -text Save
2263	}
2264	pack [button $frmC.q -text Cancel \
2265	-command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
2266	bind $frm <Return> "$frmC.b invoke"
2267
2268	if {$mode == "new"} {
2269	pack [label $frmA.0 -text "Enter an experiment file to create"] \
2270	-side top -anchor center
2271	} else {
2272	pack [label $frmA.0 -text "Select an experiment file to read"] \
2273	-side top -anchor center
2274	}
2275	expfilebox $frmA $mode
2276	# force the window to stay on top
2277	putontop $frm
2278	focus $frmC.b
2279	tkwait window $frm
2280	afterputontop
2281	if {$expgui(FileMenuEXPNAM) == ""} return
2282	#puts "end getexp $expgui(expfile)"
2283	return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2284	}
2285
2286	# validation routine
2287	# called from getExpFileName, either from Read button or from SelectExpFil (see expfilebox)
2288	proc valid_exp_file {frm mode} {
2289	global expgui tcl_platform
2290	# windows fixes
2291	if {$tcl_platform(platform) == "windows"} {
2292	# change backslashes to something sensible
2293	regsub -all {\\} $expgui(FileMenuEXPNAM) / expgui(FileMenuEXPNAM)
2294	# allow entry of D: for D:/ and D:TEST for d:/TEST
2295	if {[string first : $expgui(FileMenuEXPNAM)] != -1 && \
2296	[string first :/ $expgui(FileMenuEXPNAM)] == -1} {
2297	regsub : $expgui(FileMenuEXPNAM) :/ expgui(FileMenuEXPNAM)
2298	}
2299	}
2300	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
2301	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
2302	ChooseExpFil $frm
2303	return
2304	} elseif [file isdirectory \
2305	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
2306	if {$expgui(FileMenuEXPNAM) != "."} {
2307	set expgui(FileMenuDir) \
2308	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2309	}
2310	ChooseExpFil $frm
2311	return
2312	}
2313	set ext [string toupper [file extension $expgui(FileMenuEXPNAM)]]
2314	if {$ext == ""} {
2315	# append a .EXP if not present
2316	append expgui(FileMenuEXPNAM) ".EXP"
2317	} elseif {[string match {*.O[0-9A-F][0-9A-F]} $ext] && \
2318	$mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
2319	# check for archive files
2320	destroy .file
2321	return
2322	} elseif {$ext != ".EXP"} {
2323	# check for files that end in something other than .EXP .exp or .Exp...
2324	MyMessageBox -parent . -title "File Open Error" \
2325	-message "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
2326	-icon error
2327	return
2328	}
2329	# check on the file status
2330	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2331	if {$mode == "new" && [file exists $file]} {
2332	set ans [
2333	MyMessageBox -parent . -title "File Open Error" \
2334	-message "File [file tail $file] already exists in [file dirname $file]. OK to overwrite?" \
2335	-icon question -type {"Select other" "Overwrite"} -default "select other" \
2336	-helplink "expguierr.html OverwriteErr"
2337	]
2338	if {[string tolower $ans] == "overwrite"} {destroy .file}
2339	return
2340	}
2341	# if file does not exist in case provided, set the name to all
2342	# upper case letters, since that is the best choice.
2343	# if it does exist, read from it as is. For UNIX we will force uppercase later.
2344	if {![file exists $file]} {
2345	set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
2346	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2347	}
2348	if {$mode == "old" && ![file exists $file]} {
2349	set ans [
2350	MyMessageBox -parent . -title "File Open Error" \
2351	-message "File [file tail $file] does not exist in [file dirname $file]. OK to create?" \
2352	-icon question -type {"Select other" "Create"} -default "select other" \
2353	-helplink "expguierr.html OpenErr"
2354	]
2355	if {[string tolower $ans] == "create"} {
2356	if [CreateMTexpfile $file] return
2357	destroy .file
2358	}
2359	return
2360	}
2361	destroy .file
2362	}
2363
2364	proc updir {} {
2365	global expgui
2366	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
2367	}
2368
2369	# create a file box
2370	proc expfilebox {bx mode} {
2371	global expgui
2372	pack [frame $bx.top] -side top
2373	pack [label $bx.top.a -text "Directory" ] -side left
2374	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
2375	pack $bx.top.d -side left
2376	set expgui(FileMenuDir) [pwd]
2377	# the icon below is from tk8.0/tkfbox.tcl
2378	set upfolder [image create bitmap -data {
2379	#define updir_width 28
2380	#define updir_height 16
2381	static char updir_bits[] = {
2382	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
2383	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
2384	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
2385	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
2386	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
2387	0xf0, 0xff, 0xff, 0x01};}]
2388
2389	pack [button $bx.top.b -image $upfolder \
2390	-command "updir; ChooseExpFil $bx" ]
2391	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
2392	listbox $bx.a.files -relief raised -bd 2 \
2393	-yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
2394	-height 15 -width 0 -exportselection 0
2395	listbox $bx.a.dates -relief raised -bd 2 \
2396	-yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
2397	-height 15 -width 0 -takefocus 0 -exportselection 0
2398	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
2399	ChooseExpFil $bx
2400	bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
2401	bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
2402	bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
2403	bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
2404	pack $bx.a.scroll -side left -fill y
2405	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
2406	pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
2407	}
2408	proc sync2boxesX {master slave scroll args} {
2409	$slave xview moveto [lindex [$master xview] 0]
2410	eval $scroll set $args
2411	}
2412	proc move2boxesX {boxlist args} {
2413	foreach listbox $boxlist {
2414	eval $listbox xview $args
2415	}
2416	}
2417	proc sync2boxesY {master slave scroll args} {
2418	$slave yview moveto [lindex [$master yview] 0]
2419	eval $scroll set $args
2420	}
2421	proc move2boxesY {boxlist args} {
2422	foreach listbox $boxlist {
2423	eval $listbox yview $args
2424	}
2425	}
2426
2427	# creates a table that is scrollable in both x and y, use ResizeScrollTable
2428	# to set sizes after gridding the widgets
2429	proc MakeScrollTable {box {width 200} {height 200}} {
2430	proc sync2boxes {cmd master slave scroll args} {
2431	$slave $cmd moveto [lindex [$master $cmd] 0]
2432	eval $scroll set $args
2433	}
2434	proc move2boxes {cmd box1 box2 args} {
2435	eval $box1 $cmd $args
2436	eval $box2 $cmd $args
2437	}
2438	grid [label $box.0] -column 0 -row 0
2439	grid [canvas $box.top -scrollregion {0 0 10 10} \
2440	-xscrollcommand "sync2boxes xview $box.top $box.can $box.scroll" \
2441	-width 10 -height 10] -sticky sew -row 0 -column 1
2442	grid [canvas $box.side -scrollregion {0 0 10 10} \
2443	-yscrollcommand "sync2boxes yview $box.side $box.can $box.yscroll" \
2444	-width 10 -height 10] -sticky nes -row 1 -column 0
2445	grid [canvas $box.can -scrollregion {0 0 10 10} \
2446	-yscrollcommand "sync2boxes yview $box.can $box.side $box.yscroll" \
2447	-xscrollcommand "sync2boxes xview $box.can $box.top $box.scroll" \
2448	-width $width -height $height -bg lightgrey] -sticky news -row 1 -column 1
2449	grid [set sxbox [scrollbar $box.scroll -orient horizontal \
2450	-command "move2boxes xview $box.can $box.top"]] \
2451	-sticky ew -row 2 -column 1
2452	grid [set sybox [scrollbar $box.yscroll \
2453	-command "move2boxes yview $box.can $box.side"]] \
2454	-sticky ns -row 1 -column 2
2455
2456	$box.top create window 0 0 -anchor nw -window [frame $box.top.f -bd 0]
2457	$box.can create window 0 0 -anchor nw -window [frame $box.can.f -bd 2]
2458	$box.side create window 0 0 -anchor nw -window [frame $box.side.f -bd 2]
2459	grid columnconfig $box 1 -weight 1
2460	grid rowconfig $box 1 -weight 1
2461	return [list $box.top.f $box.can.f $box.side.f $box.0]
2462	}
2463
2464	proc ResizeScrollTable {box} {
2465	update idletasks
2466	for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} {
2467	set x1 [lindex [grid bbox $box.can.f $i 0] 2]
2468	set x2 [lindex [grid bbox $box.top.f $i 0] 2]
2469	if {$x2 > $x1} {set x1 $x2}
2470	grid columnconfigure $box.top.f $i -minsize $x1
2471	grid columnconfigure $box.can.f $i -minsize $x1
2472	}
2473	for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} {
2474	set x1 [lindex [grid bbox $box.can.f 0 $i] 3]
2475	set x2 [lindex [grid bbox $box.side.f 0 $i] 3]
2476	if {$x2 > $x1} {set x1 $x2}
2477	grid rowconfigure $box.can.f $i -minsize $x1
2478	grid rowconfigure $box.side.f $i -minsize $x1
2479	}
2480	update idletasks
2481	set sizes [grid bbox $box.can.f]
2482	$box.can config -scrollregion $sizes
2483	$box.side config -scrollregion $sizes
2484	$box.top config -scrollregion $sizes
2485	$box.side config -width [lindex [grid bbox $box.side.f] 2]
2486	$box.top config -height [lindex [grid bbox $box.top.f] 3]
2487	# remove the scroll when not needed
2488	if {[lindex $sizes 3] > [winfo height $box.can]} {
2489	grid $box.yscroll -sticky ns -column 2 -row 1
2490	} else {
2491	grid forget $box.yscroll
2492	}
2493	if {[lindex $sizes 2] > [winfo width $box.can]} {
2494	grid $box.scroll -sticky ew -column 1 -row 2
2495	} else {
2496	grid forget $box.scroll
2497	}
2498	}
2499
2500	proc MouseWheelScrollTable {box} {
2501	# causes mouse wheel to operate scroll for main canvas in ScrollTable
2502	# mousewheel can be operated anywhere in parent window
2503	bind [winfo toplevel $box] <MouseWheel> "$box.can yview scroll \[expr {-abs(%D)/%D}\] unit"
2504	}
2505
2506
2507	# this is used in cifselect -- not sure why anymore
2508	proc ExpandScrollTable {box} {
2509	# set height & width of central box
2510	$box.can config -width \
2511	[expr [winfo width [winfo toplevel $box]] \
2512	- [winfo width $box.side] - [winfo width $box.yscroll]-20]
2513	$box.can config -height \
2514	[expr [winfo height [winfo toplevel $box]] \
2515	- [winfo height $box.top] - [winfo height $box.scroll]-25]
2516	}
2517	proc RevertExpFile {} {
2518	global expgui tcl_platform
2519	set frm .file
2520	catch {destroy $frm}
2521	toplevel $frm
2522	wm title $frm "Experiment file"
2523	bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
2524	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
2525	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
2526	-fill y -expand yes
2527	pack [button $frmC.help -text Help -bg yellow \
2528	-command "MakeWWWHelp expguierr.html open"] \
2529	-side top -anchor e
2530	set expgui(filesort) 0
2531	set expgui(includearchived) 1
2532	set expgui(FileInfoBox) $frmC.info
2533	pack [label $frmC.ar -text "(Showing Archived Files Only)"] -side top -pady 10
2534	pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
2535	-class SmallFont] \
2536	-side top -fill both -expand yes -pady 5
2537
2538	pack [button $frmC.b -text Read \
2539	-command "valid_exp_file $frmA old"] -side bottom
2540	pack [button $frmC.q -text Cancel \
2541	-command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
2542	bind $frm <Return> "$frmC.b invoke"
2543
2544	pack [label $frmA.0 -text "Select an archived experiment file to read"] \
2545	-side top -anchor center
2546	set bx $frmA
2547	pack [frame $bx.top] -side top
2548	#pack [label $bx.top.a -text "Directory" ] -side left
2549	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
2550	#pack $bx.top.d -side left
2551	#set expgui(FileMenuDir) [pwd]
2552	# the icon below is from tk8.0/tkfbox.tcl
2553	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
2554	listbox $bx.a.files -relief raised -bd 2 \
2555	-yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
2556	-height 15 -width 0 -exportselection 0
2557	listbox $bx.a.dates -relief raised -bd 2 \
2558	-yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
2559	-height 15 -width 0 -takefocus 0 -exportselection 0
2560	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
2561	ChooseExpFil $bx 1
2562	if {[llength [$bx.a.files get 0 end]] == 0} {
2563	destroy $frm
2564	MyMessageBox -parent . -title "No Archives" \
2565	-message "Sorry no archived versions of $::expgui(expfile) are present" \
2566	-icon warning -type ok -default ok
2567	return
2568	}
2569	bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
2570	bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
2571	bind $bx.a.files <Double-1> "SelectExpFil $bx old"
2572	bind $bx.a.dates <Double-1> "SelectExpFil $bx old"
2573	pack $bx.a.scroll -side left -fill y
2574	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
2575	pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
2576	# force the window to stay on top
2577	putontop $frm
2578	focus $frmC.b
2579	tkwait window $frm
2580	afterputontop
2581	if {$expgui(FileMenuEXPNAM) == ""} return
2582	return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2583	}
2584
2585	# support routine for SetHistUseFlags
2586	proc InitHistUseFlags {} {
2587	global expmap expgui
2588	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2589	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
2590	set expgui(useflag_$i) [histinfo $i use]
2591	# }
2592	}
2593	}
2594
2595	# show all Powder histograms; set use/do not use flags
2596	proc SetHistUseFlags {} {
2597	set box .test
2598	catch {toplevel $box}
2599	eval destroy [winfo children $box]
2600	grid [label $box.0 -text "Set histogram \"Use/Do Not Use\" flags" -bg white] -row 0 -column 0 -columnspan 2
2601	grid [frame $box.a] -row 1 -column 0 -columnspan 2
2602	grid [button $box.b -text Save -command "destroy $box"] -row 2 -column 0 -sticky e
2603	grid [button $box.c -text Cancel -command "InitHistUseFlags;destroy $box"] -row 2 -column 1 -sticky w
2604	grid columnconfig $box 0 -weight 1
2605	grid columnconfig $box 1 -weight 1
2606	foreach a [MakeScrollTable $box.a] b {tbox bbox sbox cbox} {set $b $a}
2607	$cbox config -text "Use\nFlag"
2608	[winfo parent $bbox] config -height 250 -width 400
2609	global expmap expgui
2610	set px 5
2611	set row -1
2612	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2613	if {[string range $expmap(htype_$i) 2 2] == "T"} {
2614	set det [format %8.2f [histinfo $i tofangle]]
2615	} elseif {[string range $expmap(htype_$i) 2 2] == "C"} {
2616	set det [format %8.5f [histinfo $i lam1]]
2617	} elseif {[string range $expmap(htype_$i) 2 2] == "E"} {
2618	set det [format %8.2f [histinfo $i lam1]]
2619	} else {
2620	set det {}
2621	}
2622	incr row
2623	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
2624	grid [checkbutton $sbox.$i -text $i -variable expgui(useflag_$i)] -row $row -column 0
2625	set expgui(useflag_$i) [histinfo $i use]
2626	# }
2627	grid [label $bbox.0$i \
2628	-text [string range $expmap(htype_$i) 0 3] \
2629	] -row $row -column 0 -padx $px
2630	grid [label $bbox.1$i -text [histinfo $i bank] \
2631	] -row $row -column 1 -padx $px
2632	grid [label $bbox.2$i -text $det] -row $row -column 2 -padx $px
2633	grid [label $bbox.3$i -text [string range [histinfo $i title] 0 66] \
2634	] -row $row -column 3 -padx $px -sticky ew
2635	}
2636	grid [label $tbox.0 -text type -bd 2 -relief raised] -row 0 -column 0 -padx $px
2637	grid [label $tbox.1 -text bank -bd 2 -relief raised] -row 0 -column 1 -padx $px
2638	grid [label $tbox.2 -text "ang/wave" -bd 2 -relief raised] -row 0 -column 2 -padx $px
2639	grid [label $tbox.3 -text "histogram title" -bd 2 -relief raised] -row 0 -column 3 -sticky w -padx $px
2640	ResizeScrollTable $box.a
2641	InitHistUseFlags
2642	putontop $box
2643	tkwait window $box
2644	afterputontop
2645	set prevchages $expgui(changed)
2646	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2647	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
2648	if {$expgui(useflag_$i) != [histinfo $i use]} {
2649	histinfo $i use set $expgui(useflag_$i)
2650	RecordMacroEntry "histinfo $i use set $expgui(useflag_$i)" 0
2651	incr expgui(changed)
2652	RecordMacroEntry "incr expgui(changed)" 0
2653	}
2654	# }
2655	}
2656	if {$prevchages != $expgui(changed)} {
2657	set msg "You have changed [expr $expgui(changed)-$prevchages] "
2658	append msg "histogram flag(s). You must run POWPREF "
2659	append msg "to include/remove these histograms. Do you want to "
2660	append msg "run POWPREF?"
2661	set ans [MyMessageBox -parent . -message $msg \
2662	-title "Process changes?"\
2663	-helplink "expguierr.html ProcessUse" \
2664	-default {Run POWPREF} \
2665	-type {{Run POWPREF} Skip}]
2666
2667	if {$ans == "skip"} {
2668	# save and reload the experiment file
2669	savearchiveexp
2670	loadexp $expgui(expfile)
2671	} else {
2672	# run powpref and force a reload
2673	set saveautoload $expgui(autoexpload)
2674	set expgui(autoexpload) 1
2675	runGSASwEXP powpref
2676	set expgui(autoexpload) $saveautoload
2677	}
2678	}
2679	}
2680
2681	# set the box or file in the selection window
2682	proc ReleaseExpFil {frm} {
2683	global expgui
2684	set files $frm.a.files
2685	set dates $frm.a.dates
2686	set select [$files curselection]
2687	if {$select == ""} {
2688	set select [$dates curselection]
2689	}
2690	if {$select == ""} {
2691	set expgui(FileMenuEXPNAM) ""
2692	} else {
2693	set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
2694	after idle UpdateInfoBox
2695	}
2696	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
2697	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
2698	ChooseExpFil $frm
2699	} elseif [file isdirectory \
2700	[file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
2701	if {$expgui(FileMenuEXPNAM) != "."} {
2702	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2703	ChooseExpFil $frm
2704	}
2705	}
2706	return
2707	}
2708
2709	proc ScanEXPforError {"ns {}"} {
2710	# record types to ignore
2711	set ignorelist {DESCR HSTRY PNAM HNAM "REFN STATS"}
2712	set warn {}
2713	set badkeylist {}
2714	# scan file for warnings
2715	foreach key [array names ${ns}::exparray] {
2716	if {[string first "***" [set ${ns}::exparray($key)]] != -1 \|\|
2717	[string first "#IN" [set ${ns}::exparray($key)]] != -1 \|\|
2718	[string first "nan" [set ${ns}::exparray($key)]] != -1 \|\|
2719	[string first "NAN" [set ${ns}::exparray($key)]] != -1
2720	} {
2721	#puts [set ${ns}::exparray($key)]
2722	set OK 0
2723	foreach i $ignorelist {
2724	if {[string first $i $key] != -1} {
2725	set OK 1
2726	break
2727	}
2728	}
2729	# ignore atom name section of Atom records
2730	if {(! $OK) && [string match "CRSATA" $key]} {
2731	foreach str [list [string range [set ${ns}::exparray($key)] 0 49]
2732	[string range [set ${ns}::exparray($key)] 58 end]] {
2733	if {[string first "***" $str] \|\|
2734	[string first "#INF" $str] \|\|
2735	[string first "nan" $str] \|\|
2736	[string first "NAN" $str]} {
2737	append warn " Record \"$key\": [set ${ns}::exparray($key)]\n"
2738	lappend badkeylist $key
2739	break
2740	}
2741	}
2742	continue
2743	}
2744	if {! $OK} {
2745	append warn " Record \"$key\": [set ${ns}::exparray($key)]\n"
2746	lappend badkeylist $key
2747	}
2748	}
2749	}
2750	if {$warn == ""} return
2751	set hint ""
2752	set unknown ""
2753	foreach key $badkeylist {
2754	if {[string match "CRSAT" $key]} {
2755	if {[string first "atomic parameter" $hint] == -1} {
2756	append hint "\t* An atomic parameter (coordinate, occupancy or U) appears out of range\n"
2757	}
2758	} elseif {[string match "CRSABC" $key] \|\|
2759	[string match "CRSANGLES" $key] \|\|
2760	[string match "CRSCELVOL" $key]} {
2761	if {[string first "cell parameter" $hint] == -1} {
2762	append hint "\t* A unit cell parameter appears out of range\n"
2763	}
2764	} elseif {[string match "CRSODF" $key]} {
2765	if {[string first "spherical harmonic" $hint] == -1} {
2766	append hint "\t* A spherical harmonic (ODF) parameter appears out of range\n"
2767	}
2768	} elseif {[string match "HST*ICONS" $key]} {
2769	if {[string first "diffractometer constant" $hint] == -1} {
2770	append hint "\t* A diffractometer constant (wave, DIFC,...) appears out of range\n"
2771	}
2772	} elseif {[string match "HST*TRNGE" $key]} {
2773	if {[string first "histogram data range" $hint] == -1} {
2774	append hint "\t* A histogram data range value appears out of range\n"
2775	}
2776	} elseif {[string match "GNLS RUN" $key] \|\|
2777	[string match "*GNLS SHFTS" $key] \|\|
2778	[string match "HST*RPOWD" $key] \|\|
2779	[string match " REFN RPOWD " $key] \|\|
2780	[string match " REFN GDNFT " $key]
2781	} {
2782	if {[string first "refinement statistics" $hint] == -1} {
2783	append hint "\t* The refinement statistics imply the last refinement diverged\n"
2784	}
2785	} else {
2786	lappend unknown $key
2787	}
2788	}
2789	if {$unknown != ""} {
2790	append hint "\t* The following less common problem record(s) appear out of range:\n\t\t"
2791	foreach key $unknown {
2792	append hint "\"" [string trim $key] "\" "
2793	}
2794	}
2795	return "Likely error(s) noted:\n$hint\nDetails of problem(s):\n$warn"
2796	}
2797
2798	proc ExplainEXPerror {parent message file} {
2799	#ShowCallStack
2800	if {$parent == "."} {
2801	set w .experr
2802	} else {
2803	set w $parent.experr
2804	}
2805	catch {destroy $w}
2806	toplevel $w -class Dialog
2807	wm title $w "Corrupt .EXP file"
2808	wm iconname $w Dialog
2809	wm protocol $w WM_DELETE_WINDOW { }
2810	# Make the message box transient if the parent is viewable.
2811	if {[winfo viewable [winfo toplevel $parent]] } {
2812	wm transient $w $parent
2813	}
2814	frame $w.bot
2815	pack $w.bot -side bottom -fill both
2816	frame $w.top
2817	pack $w.top -side top -fill both -expand 1
2818	frame $w.msg
2819	pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
2820	set txt {Likely errors were noted when reading this file}
2821	append txt " ([file tail $file]). "
2822	append txt "These problems probably\narose from the last refinement, "
2823	append txt "based on settings applied in the previous saved file.\n"
2824	append txt "It is probably not possible to continue with this file.\n"
2825	append txt "You likely need to revert at least two archived versions back."
2826	grid [label $w.msg.s -text $txt -justify left] -row 0 -column 0 -sticky nws
2827	grid [button $w.msg.1 -text Help -bg yellow \
2828	-command "MakeWWWHelp expgui.html badexp"] -row 0 -column 1 -columnspan 2 -sticky ne
2829	bind $w <Key-F1> "MakeWWWHelp expgui.html badexp"
2830	set filelist [lsort -dictionary -decreasing \
2831	[glob -nocomplain \
2832	[file root $file.O* ]]]
2833	grid [text $w.msg.t -font {Times 12} \
2834	-height 10 -width 90 -relief flat -wrap word \
2835	-yscrollcommand "$w.msg.rscr set" \
2836	] -row 1 -column 0 -columnspan 2 -sticky news
2837	grid [scrollbar $w.msg.rscr -command "$w.msg.t yview" \
2838	] -row 1 -column 2 -sticky ns
2839	# give extra space to the text box
2840	grid columnconfigure $w.msg 0 -weight 1
2841	grid rowconfigure $w.msg 1 -weight 1
2842	$w.msg.t insert end $message
2843	button $w.ok -command [list destroy $w] -text OK -default active
2844	pack $w.ok -in $w.bot -side left -expand 1 -padx 3m -pady 2m
2845	putontop $w
2846	tkwait window $w
2847	afterputontop
2848	}
2849
2850	proc UpdateInfoBox {} {
2851	global expgui
2852	if {![winfo exists $expgui(FileInfoBox)]} return
2853	eval destroy [winfo children $expgui(FileInfoBox)]
2854	set file [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]
2855	if [file isdirectory $file] return
2856	if [file exists $file] {
2857	pack [label $expgui(FileInfoBox).1 -text $expgui(FileMenuEXPNAM)] \
2858	-side top
2859	catch {
2860	# load the EXP file into a namespace & scan for errors
2861	expload $file scan
2862	set warnings [ScanEXPforError scan]
2863	if {$warnings != ""} {
2864	pack [frame $expgui(FileInfoBox).1a -bg yellow -padx 4 -pady 4] -side top
2865	pack [label $expgui(FileInfoBox).1a.err -justify left \
2866	-text "WARNING: Likely corrupt" -bg yellow] \
2867	-side left -anchor w -fill both
2868	pack [button $expgui(FileInfoBox).1a.show \
2869	-text "More..." -padx 0 \
2870	-command "ExplainEXPerror $expgui(FileInfoBox) [list $warnings] $file"\
2871	] -side right -anchor w
2872	}
2873	set fp [open $file r]
2874	global testline
2875	set testline [read $fp]
2876	close $fp
2877	update
2878	regexp -linestop {GNLS RUN on (.) +Total.run *([0-9]+) } \
2879	$testline a last cycles
2880	pack [label $expgui(FileInfoBox).2 -justify left \
2881	-text "last GENLES run:\n $last\n total cycles: $cycles"] \
2882	-side top -anchor w
2883	set chi2 ?
2884	set vars ?
2885	regexp {REFN GDNFT.= ([0-9]\.[0-9]) +for *([0-9]+) variables} \
2886	$testline a chi2 vars
2887	pack [frame $expgui(FileInfoBox).3 -class SmallFont] \
2888	-side top -anchor w
2889	pack [label $expgui(FileInfoBox).3.a -justify left \
2890	-text "c" -font symbol] \
2891	-side left -anchor w
2892	pack [label $expgui(FileInfoBox).3.b -justify left \
2893	-text "2: $chi2, $vars vars"] \
2894	-side top -anchor w
2895	# check first 9 histograms
2896	set lbl "h Rwp R(F2)"
2897	set n 0
2898	foreach k {1 2 3 4 5 6 7 8 9} {
2899	set key "HST $k"
2900	append key { RPOWD +([0-9]\.[0-9]) }
2901	set i [regexp $key $testline a Rwp]
2902	set key "HST $k"
2903	append key { R-FAC +[0-9]+ +([0-9]\.[0-9]) }
2904	set j [regexp $key $testline a Rb]
2905	if {$i \|\| $j} {
2906	incr n
2907	append lbl "\n$k "
2908	if {$i} {
2909	append lbl [string range $Rwp 0 5]
2910	} else {
2911	append lbl " "
2912	}
2913	}
2914	if {$j} {
2915	append lbl " [string range $Rb 0 5]"
2916	}
2917	# stick 1st 3 entries in box
2918	if {$n >= 3} break
2919	}
2920	pack [label $expgui(FileInfoBox).4 -justify left \
2921	-text $lbl] \
2922	-side top -anchor w
2923	} err
2924	}
2925	}
2926
2927	# select a file or directory -- called on double click
2928	proc SelectExpFil {frm mode} {
2929	global expgui
2930	set files $frm.a.files
2931	set dates $frm.a.dates
2932	set select [$files curselection]
2933	if {$select == ""} {
2934	set select [$dates curselection]
2935	}
2936	if {$select == ""} {
2937	set file .
2938	} else {
2939	set file [string trim [$files get $select]]
2940	}
2941	if {$file == "<Parent>"} {
2942	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
2943	ChooseExpFil $frm
2944	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
2945	if {$file != "."} {
2946	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
2947	ChooseExpFil $frm
2948	}
2949	} else {
2950	set expgui(FileMenuEXPNAM) [file tail $file]
2951	valid_exp_file $frm $mode
2952	}
2953	}
2954
2955	# fill the files & dates & Directory selection box with current directory,
2956	# also called when box is created to fill it
2957	proc ChooseExpFil {frm "archiveonly 0"} {
2958	global expgui
2959	set files $frm.a.files
2960	set dates $frm.a.dates
2961	set expgui(FileMenuEXPNAM) {}
2962	$files delete 0 end
2963	$dates delete 0 end
2964	if {$archiveonly == 0} {
2965	$files insert end {<Parent>}
2966	$dates insert end {(Directory)}
2967	set filelist [glob -nocomplain \
2968	[file join [set expgui(FileMenuDir)] *] ]
2969	foreach file [lsort -dictionary $filelist] {
2970	if {[file isdirectory $file]} {
2971	$files insert end [file tail $file]
2972	$dates insert end {(Directory)}
2973	}
2974	}
2975	} else {
2976	set filelist [glob -nocomplain \
2977	[file root $expgui(expfile)].O* ]
2978	}
2979	set pairlist {}
2980	foreach file [lsort -dictionary $filelist] {
2981	if {![file isdirectory $file] && \
2982	[string toupper [file extension $file]] == ".EXP" \
2983	&& $archiveonly == 0} {
2984	set modified [file mtime $file]
2985	lappend pairlist [list $file $modified]
2986	} elseif {![file isdirectory $file] && $expgui(includearchived) && \
2987	[string match {*.O[0-9A-F][0-9A-F]} $file]} {
2988	set modified [file mtime $file]
2989	lappend pairlist [list $file $modified]
2990	}
2991	}
2992	if {$expgui(filesort) == 0} {
2993	foreach pair [lsort -index 1 -integer -decreasing $pairlist] {
2994	set file [lindex $pair 0]
2995	set modified [clock format [lindex $pair 1] -format "%T %D"]
2996	$files insert end [file tail $file]
2997	$dates insert end $modified
2998	}
2999	} else {
3000	foreach pair [lsort -dictionary -index 0 $pairlist] {
3001	set file [lindex $pair 0]
3002	set modified [clock format [lindex $pair 1] -format "%T %D"]
3003	$files insert end [file tail $file]
3004	$dates insert end $modified
3005	}
3006	}
3007	$expgui(FileDirButtonMenu) delete 0 end
3008	set list ""
3009	global tcl_platform tcl_version
3010	if {$tcl_platform(platform) == "windows" && $tcl_version > 8.0} {
3011	catch {set list [string tolower [file volume]]}
3012	}
3013	set dir ""
3014	foreach subdir [file split [set expgui(FileMenuDir)]] {
3015	set dir [file join $dir $subdir]
3016	if {$tcl_platform(platform) == "windows"} {
3017	set dir [string tolower $dir]
3018	if {[lsearch $list $dir] == -1} {lappend list $dir}
3019	} else {
3020	lappend list $dir
3021	}
3022	}
3023	foreach path $list {
3024	$expgui(FileDirButtonMenu) add command -label $path \
3025	-command "[list set expgui(FileMenuDir) $path]; \
3026	ChooseExpFil $frm"
3027	}
3028	# highlight the current experiment -- if present
3029	for {set i 0} {$i < [$files size]} {incr i} {
3030	set file [$files get $i]
3031	if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
3032	$files selection set $i
3033	set expgui(FileMenuEXPNAM) $file
3034	UpdateInfoBox
3035	}
3036	}
3037	return
3038	}
3039
3040
3041	#------------------------------------------------------------------------------
3042	# platform-specific definitions
3043	if {$tcl_platform(platform) == "windows" && $tcl_platform(os) == "Windows 95"} {
3044	# windows-95, -98 and presumably -me do not allow Tcl/Tk to run the
3045	# DOS box synchronously, so we create a "lock" file that is deleted
3046	# at the end of the DOS run so we can tell when the run is done.
3047	# We create a window to force the deleting of the file so that if
3048	# the DOS process crashes, the user can continue anyway.
3049	#
3050	# procedure to check if the lock file is still there (Win-9x/me only)
3051	proc checklockfile {file window} {
3052	if [file exists $file] {
3053	after 500 checklockfile $file $window
3054	} else {
3055	catch {destroy $window}
3056	}
3057	}
3058	# this procedure starts the GRWND program, if needed for program $prog
3059	proc StartGRWND {prog} {
3060	global expgui
3061	if {!$expgui(autoGRWND)} return
3062	# at some point we might want to have a real list
3063	if {$prog != "genles" && $prog != "powpref"} {
3064	# get a list of running jobs
3065	exec [file join $expgui(scriptdir) win9xbin tlist.exe] > tlist.tlist
3066	set fp [open tlist.tlist r]
3067	set text [read $fp]
3068	close $fp
3069	file delete -force tlist.tlist
3070	# if GRWND.EXE is not currently running, start it
3071	if {[lsearch [string toupper $text] GRWND.EXE] == -1} {
3072	exec [file join $expgui(gsasexe) grwnd.exe] &
3073	# give grwnd a 1 second head start
3074	after 1000
3075	}
3076	}
3077	}
3078	# this creates a DOS box to run a program in
3079	proc forknewterm {title command "wait 1" "scrollbar 1"} {
3080	global env expgui
3081	# Windows environment variables
3082	set env(GSAS) [file nativename $expgui(gsasdir)]
3083	# PGPLOT_FONT is needed by PGPLOT
3084	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
3085	# this is the number of lines/page in the .LST (etc.) file
3086	set env(LENPAGE) 60
3087	set pwd [file nativename [pwd]]
3088
3089	# check the .EXP path -- can DOS use it?
3090	if {[string first // [pwd]] != -1} {
3091	MyMessageBox -parent . -title "Invalid Path" \
3092	-message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
3093	-icon error -type ok -default ok \
3094	-helplink "expgui_Win_readme.html NetPath"
3095	return
3096	}
3097	if {[info command winutils::shell] == "" && \
3098	[info command winexec] == ""} {
3099	MyMessageBox -parent . -title "Setup error" \
3100	-message {Error -- Use "Neither WINEXEC not WINTILS were found. Can't do anything!"} \
3101	-icon error -type darn -default darn \
3102	-helplink "expgui_Win_readme.html Winexec"
3103	return
3104	}
3105	# loop over multiple commands
3106	foreach cmd $command {
3107	# simulate the wait with a lock file
3108	if {$wait} {
3109	if {$expgui(autoiconify)} {wm iconify .}
3110	# create a blank lock file and a message window
3111	close [open expgui.lck w]
3112	toplevel .lock
3113	grid [button .lock.0 -text Help -bg yellow \
3114	-command "MakeWWWHelp expguierr.html lock"] \
3115	-column 1 -row 0
3116	grid [label .lock.1 \
3117	-text "Please wait while the GSAS program finishes."] \
3118	-column 0 -row 0
3119	grid [label .lock.2 -text \
3120	"In case a problem occurs, close the DOS box"] \
3121	-column 0 -columnspan 2 -row 1
3122	grid [label .lock.3 -text \
3123	"and press the \"Continue\" button (below)"] \
3124	-column 0 -columnspan 2 -row 2
3125	grid [button .lock.b -text "Continue" \
3126	-command "destroy .lock; wm deiconify ."] \
3127	-column 0 -columnspan 2 -row 3
3128	putontop .lock
3129	update
3130	checklockfile expgui.lck .lock
3131	}
3132
3133	# pause is hard coded in the GSASTCL.BAT file
3134	if {$expgui(execprompt)} {
3135	set script gsastcl.bat
3136	} else {
3137	set script gsasnowt.bat
3138	}
3139
3140	# replace the forward slashes with backward
3141	regsub -all / $cmd \\ cmd
3142	if {[info command winutils::shell] != ""} {
3143	winutils::shell [file join $expgui(scriptdir) $script] $cmd
3144	} else {
3145	winexec -d [file nativename [pwd]] \
3146	[file join $expgui(scriptdir) $script] $cmd
3147	}
3148	if {$expgui(MacroRunning)} {
3149	update
3150	update idletasks
3151	}
3152	if {$wait} {
3153	tkwait window .lock
3154	file delete -force expgui.lck
3155	}
3156	}
3157	if {$expgui(autoiconify) && $wait} {wm deiconify .}
3158	# check for changes in the .EXP file immediately
3159	whenidle
3160	}
3161	} elseif {$tcl_platform(platform) == "windows"} {
3162	# now for Windows-NT, where we can run synchronously
3163	#
3164	# this creates a DOS box to run a program in
3165	proc forknewterm {title command "wait 1" "scrollbar 1"} {
3166	global env expgui
3167	# Windows environment variables
3168	set env(GSAS) [file nativename $expgui(gsasdir)]
3169	# PGPLOT_FONT is needed by PGPLOT
3170	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
3171	set env(PGPLOT_DIR) $expgui(pgplotdir)
3172	# this is the number of lines/page in the .LST (etc.) file
3173	set env(LENPAGE) 60
3174	set pwd [file nativename [pwd]]
3175	# check the path -- can DOS use it?
3176	if {[string first // [pwd]] != -1} {
3177	MyMessageBox -parent . -title "Invalid Path" \
3178	-message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
3179	-icon error -type ok -default ok \
3180	-helplink "expgui_Win_readme.html NetPath"
3181	return
3182	}
3183	# pause is hard coded in the .BAT file
3184	if {$expgui(execprompt)} {
3185	set script gsastcl.bat
3186	} else {
3187	set script gsasnowt.bat
3188	}
3189
3190	if {$wait} {
3191	if {$expgui(autoiconify)} {wm iconify .}
3192	# create a blank lock file (keep liveplot from running)
3193	close [open expgui.lck w]
3194	# loop over commands
3195	foreach cmd $command {
3196	# replace the forward slashes with backward
3197	regsub -all / $cmd \\ cmd
3198	# use of file attributes -shortname & normalize and nativename
3199	# might help here
3200	exec $env(COMSPEC) /c \
3201	"start [file attributes [file join $expgui(scriptdir) $script] -shortname] $cmd"
3202	}
3203	file delete -force expgui.lck
3204	if {$expgui(autoiconify)} {wm deiconify .}
3205	# check for changes in the .EXP file immediately
3206	whenidle
3207	} else {
3208	# loop over commands
3209	foreach cmd $command {
3210	# replace the forward slashes with backward
3211	regsub -all / $cmd \\ cmd
3212	# run in background
3213	exec $env(COMSPEC) /c \
3214	"start [file attributes [file join $expgui(scriptdir) $script] -shortname] $cmd"
3215	if {$expgui(MacroRunning)} {
3216	update
3217	update idletasks
3218	}
3219	}
3220	}
3221	}
3222	} else {
3223	# UNIX-based machines
3224	if {[auto_execok xterm] != ""} {
3225	# this creates a xterm window for running programs inside
3226	proc forknewterm {title command "wait 1" "scrollbar 1"} {
3227	global env expgui
3228	# UNIX environment variables
3229	set env(GSAS) [file nativename $expgui(gsasdir)]
3230	set env(gsas) [file nativename $expgui(gsasdir)]
3231	set env(GSASEXE) $expgui(gsasexe)
3232	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
3233	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
3234	# PGPLOT_DIR is needed by PGPLOT
3235	set env(PGPLOT_DIR) $expgui(pgplotdir)
3236	# this is the number of lines/page in the .LST (etc.) file
3237	set env(LENPAGE) 60
3238	set termopts {}
3239	if $env(GSASBACKSPACE) {
3240	append termopts \
3241	{-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"}
3242	}
3243	if $scrollbar {
3244	append termopts " -sb"
3245	} else {
3246	append termopts " +sb"
3247	}
3248	if {$wait} {
3249	set suffix {}
3250	} else {
3251	set suffix {&}
3252	}
3253
3254	# hold window open after commands finish
3255	if {$expgui(execprompt)} {
3256	append command "\; echo -n Press Enter to continue \; read x"
3257	}
3258	if {$wait && $expgui(autoiconify)} {wm iconify .}
3259	catch {eval exec xterm $termopts -title [list $title] \
3260	-e /bin/sh -c [list $command] $suffix} errmsg
3261	if $expgui(debug) {puts "xterm result = $errmsg"}
3262	if {$expgui(MacroRunning)} {
3263	update
3264	update idletasks
3265	}
3266	if {$wait} {
3267	if {$expgui(autoiconify)} {wm deiconify .}
3268	# check for changes in the .EXP file immediately
3269	whenidle
3270	}
3271	}
3272	} elseif {[auto_execok gnome-terminal] != ""} {
3273	# this creates a xterm window for running programs inside
3274	proc forknewterm {title command "wait 1" "scrollbar 1"} {
3275	global env expgui
3276	# UNIX environment variables
3277	set env(GSAS) [file nativename $expgui(gsasdir)]
3278	set env(gsas) [file nativename $expgui(gsasdir)]
3279	set env(GSASEXE) $expgui(gsasexe)
3280	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
3281	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
3282	# PGPLOT_DIR is needed by PGPLOT
3283	set env(PGPLOT_DIR) $expgui(pgplotdir)
3284	# this is the number of lines/page in the .LST (etc.) file
3285	set env(LENPAGE) 60
3286	if {$wait} {
3287	set suffix {}
3288	} else {
3289	set suffix {&}
3290	}
3291
3292	# hold window open after commands finish
3293	if {$expgui(execprompt)} {
3294	append command "\; echo -n Press Enter to continue \; read x"
3295	}
3296	if {$wait && $expgui(autoiconify)} {wm iconify .}
3297	catch {exec gnome-terminal --title $title \
3298	-e " /bin/sh -c \" $command \" " $suffix} errmsg
3299	if $expgui(debug) {puts "gnome-terminal result = $errmsg"}
3300	if {$expgui(MacroRunning)} {
3301	update
3302	update idletasks
3303	}
3304	if {$wait} {
3305	if {$expgui(autoiconify)} {wm deiconify .}
3306	# check for changes in the .EXP file immediately
3307	whenidle
3308	}
3309	}
3310	} else {
3311	MyMessageBox -parent . -title "Error: no terminal program" \
3312	-message "Error, the xterm or gnome-terminal utility programs could not be found. It is not possible to run the GSAS programs without this." \
3313	-icon error -type NOT-OK -default not-ok
3314	}
3315	}
3316
3317	# run commands without a terminal window
3318	proc runnoterm {command outfile} {
3319	global env expgui tcl_platform
3320	if {$tcl_platform(platform) == "windows"} {
3321	# Windows environment variables
3322	set env(GSAS) [file nativename $expgui(gsasdir)]
3323	# PGPLOT_FONT is needed by PGPLOT
3324	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
3325	# this is the number of lines/page in the .LST (etc.) file
3326	set env(LENPAGE) 60
3327	set pwd [file nativename [pwd]]
3328	# loop over multiple commands
3329	foreach cmd $command {
3330	# replace the forward slashes with backward
3331	regsub -all / $cmd \\ cmd
3332	exec $cmd >>& $outfile
3333	update
3334	update idletasks
3335	}
3336	} else {
3337	# UNIX environment variables
3338	set env(GSAS) [file nativename $expgui(gsasdir)]
3339	set env(gsas) [file nativename $expgui(gsasdir)]
3340	set env(GSASEXE) $expgui(gsasexe)
3341	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
3342	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
3343	# PGPLOT_DIR is needed by PGPLOT
3344	set env(PGPLOT_DIR) $expgui(pgplotdir)
3345	# this is the number of lines/page in the .LST (etc.) file
3346	set env(LENPAGE) 60
3347	foreach cmd $command {
3348	catch {eval exec $cmd >>& $outfile} errmsg
3349	}
3350	update
3351	update idletasks
3352	}
3353	# check for changes in the .EXP file immediately
3354	#whenidle
3355	}
3356
3357	proc MacMakeResource {file app} {
3358	# make a resource file. Note that OS X has gotten picky about the length of this
3359	set l [string length $app]
3360	if $::expgui(debug) {puts "$l bytes"}
3361	incr l
3362	if $::expgui(debug) {puts "$l bytes after incr"}
3363	set str "data 'usro' (0) {\n"
3364	append str " $\""
3365	append str [format %.8X $l]
3366	set bytes 4
3367	foreach char [split $app {}] {
3368	append str [format %.2X [scan $char %c]]
3369	}
3370	incr bytes $l
3371	set newline 1
3372	for {set i 0} {$i < [expr 1028-$bytes]} {incr i} {
3373	if $newline {
3374	append str "\" \n"
3375	append str " $\""
3376	set newline 0
3377	set j 0
3378	}
3379	append str {0000 }
3380	incr bytes
3381	incr j 2
3382	if {$j > 15} {set newline 1}
3383	}
3384	if {$l % 2} {
3385	append str "\"\n "
3386	} else {
3387	# even lengths need one more byte
3388	append str "00\"\n "
3389	}
3390	append str "/* $app */\n};\n"
3391	set fp [open $file w]
3392	puts $fp $str
3393	close $fp
3394	}
3395
3396	# modify resource fork info for a .EXP file on the Mac
3397	proc MacSetResourceFork {expfile} {
3398	global expgui tcl_platform
3399	if {$tcl_platform(os) != "Darwin"} {return}
3400	set expnative [file nativename $expfile]
3401	#
3402	# assign an app to the data file, if the app and the
3403	# required tool (Rez) are installed
3404	set app [file nativename [file join $expgui(gsasdir) expgui.app]]
3405	set RezApp {}
3406	foreach pth "/usr/bin /Developer/Tools $expgui(gsasexe)" {
3407	if [file exists [set tst [file join $pth Rez]]] {
3408	set RezApp $tst
3409	break
3410	}
3411	}
3412	set SetFileApp {}
3413	foreach pth "/usr/bin /Developer/Tools $expgui(gsasexe)" {
3414	if [file exists [set tst [file join $pth SetFile]]] {
3415	set SetFileApp $tst
3416	break
3417	}
3418	}
3419	if $::expgui(debug) {puts "found app=$app Rez=$RezApp and SetFile=$SetFileApp"}
3420	if {[file exists $app] && $RezApp != ""} {
3421	# make resource file
3422	MacMakeResource setapp.r $app
3423	if $::expgui(debug) {puts "$RezApp setapp.r -o $expnative -a"}
3424	exec $RezApp setapp.r -o $expnative -a
3425	if {! $::expgui(debug)} {
3426	file delete -force setapp.r
3427	}
3428	}
3429
3430	# assign an icon to the data file, if it and the required tools exist
3431	set icon [file join $expgui(gsasexe) gsasicon.r]
3432	if {[file exists $icon] && $RezApp != "" && $SetFileApp != ""} {
3433	exec $RezApp [file nativename $icon] -o $expnative -a
3434	exec $SetFileApp -a C $expnative
3435	if {$::expgui(debug)} {
3436	puts "$RezApp [file nativename $icon] -o $expnative -a"
3437	puts "$SetFileApp -a C $expnative"
3438	}
3439	} elseif {$::expgui(debug)} {
3440	puts "icon=$icon missing?"
3441	}
3442	}
3443
3444	#-------------------------------------------------------------------------------
3445	# Macro Recording
3446	#-------------------------------------------------------------------------------
3447	set expgui(MacroBufferedCommand) ""
3448	set expgui(fpMacroFile) ""
3449	set expgui(MacroFile) ""
3450	# Turn on/off mode to save commands in MacroFile
3451	proc SetRecordMacroOnOff {args} {
3452	global expgui
3453	if {$expgui(RecordMacro)} {
3454	set expgui(fpMacroFile) ""
3455	set expgui(MacroBufferedCommand) ""
3456	while {$expgui(fpMacroFile) == ""} {
3457	set expgui(MacroFile) [tk_getSaveFile -initialdir [pwd] \
3458	-parent . \
3459	-filetypes {{"EXPGUI Macro file" .expmac}} \
3460	-defaultextension .expmac \
3461	-initialfile EXPGUI.expmac \
3462	-title "Choose location to save macro"]
3463	if {$expgui(MacroFile) == ""} {
3464	# respond to cancel
3465	set expgui(fpMacroFile) ""
3466	set expgui(MacroFile) ""
3467	set expgui(RecordMacro) 0
3468	return
3469	}
3470	if {[catch {
3471	set expgui(fpMacroFile) [open $expgui(MacroFile) w]
3472	puts $expgui(fpMacroFile) "# [clock format [clock seconds] -format %Y-%m-%dT%T]"
3473	} errmsg]} {
3474	MyMessageBox -parent . -title "Error opening selected file" \
3475	-message "Error opening macro file:\n$errmsg" \
3476	-icon warning -type TryAgain -default tryagain
3477	catch {close $expgui(fpMacroFile)}
3478	set expgui(fpMacroFile) ""
3479	set expgui(MacroFile) ""
3480	set expgui(RecordMacro) 0
3481	}
3482	}
3483	} else {
3484	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
3485	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3486	}
3487	catch {close $expgui(fpMacroFile)}
3488	set expgui(fpMacroFile) ""
3489	set expgui(MacroFile) ""
3490	set expgui(MacroBufferedCommand) ""
3491	}
3492	}
3493
3494	# record a command in the Macro File
3495	proc RecordMacroEntry {command buffer} {
3496	global expgui
3497	if {! $expgui(RecordMacro)} return
3498	# in buffered mode: hold the last command in memory and compare to the
3499	# next. If two commands differ only in the final argument, then the
3500	# second command makes the previous redundant so only the latter version
3501	# is retained (This will happen when a user types a string into a box).
3502	# When the commands differ, then the previous is written to file
3503	# and the next is retained in memory.
3504	if {$buffer} {
3505	if {[string trim $expgui(MacroBufferedCommand)] == ""} {
3506	set expgui(MacroBufferedCommand) $command
3507	return
3508	}
3509	set diff 0
3510	# is command a repeat of previous?
3511	foreach a $command b $expgui(MacroBufferedCommand) {
3512	if {$diff} {
3513	# found a difference, other than in the last arg
3514	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3515	break
3516	}
3517	if {$a != $b} {set diff 1}
3518	}
3519	set expgui(MacroBufferedCommand) $command
3520	} else {
3521	# no buffering on current command; write the old and new to file.
3522	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
3523	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3524	}
3525	puts $expgui(fpMacroFile) $command
3526	set expgui(MacroBufferedCommand) ""
3527	}
3528	}
3529
3530	proc CantRecordMacroEntry {comment} {
3531	global expgui
3532	if {! $expgui(RecordMacro)} return
3533
3534	# no buffering on current command; write the old and new to file.
3535	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
3536	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3537	}
3538	puts $expgui(fpMacroFile) "# unrecorded: $comment"
3539	set expgui(MacroBufferedCommand) ""
3540	MyMessageBox -parent . -title "No command record" \
3541	-message "EXPGUI is not able to record this action in the macro file: $comment" \
3542	-icon warning
3543	}
3544
3545
3546	# Play back commands in Macro File
3547	proc ReplayMacroFile {"lineatatime 0"} {
3548	global expgui
3549	set expnam [file root [file tail $expgui(expfile)]]
3550	file delete abort_${expnam}_macro.flag
3551	set expgui(MacroRunning) 0
3552	set MacroFile [tk_getOpenFile -initialdir [pwd] \
3553	-parent . \
3554	-filetypes {{"EXPGUI Macro file" .expmac} {Everything .*}} \
3555	-defaultextension .expmac \
3556	-title "Choose location to read macro"]
3557	if {$MacroFile == ""} return
3558	set expgui(MacroRunning) 1
3559	if {$lineatatime} {
3560	set expgui(MacroChanged) 0
3561	set top1 .macro
3562	catch {destroy $top1}
3563	toplevel $top1
3564	set txt $top1.t
3565	grid [text $txt -width 30 -height 20 -yscrollcommand "$top1.s set"] \
3566	-column 0 -row 0 -sticky news
3567	wm title $top1 "File $MacroFile"
3568	grid [scrollbar $top1.s -command "$txt yview"] \
3569	-column 1 -row 0 -sticky ns
3570	grid [frame $top1.b] -column 0 -columnspan 2 -row 1 -sticky ew
3571	grid columnconfig $top1 0 -weight 1
3572	grid rowconfig $top1 0 -weight 1
3573	grid [button $top1.b.e -text "Execute line" \
3574	-command "MacroExecuteCurrentLine $txt"] \
3575	-column 0 -row 0 -sticky w
3576	grid columnconfig $top1.b 1 -weight 1
3577	grid [button $top1.b.s -text "Save As" -state disabled \
3578	-command "MacroResave $txt"] -column 1 -row 0
3579	set expgui(MacroSaveButton) $top1.b.s
3580	grid [button $top1.b.c -text "Close " \
3581	-command "MacroCloseWindow $txt"] -column 2 -row 0
3582	$txt delete 0.0 end
3583	set fp [open $MacroFile r]
3584	$txt insert 0.0 [read $fp]
3585	close $fp
3586	MacroHighlightText $txt 1
3587	# deal with editing in the box
3588	$txt configure -undo 1
3589	$txt edit modified 0
3590	bind $txt <<Modified>> {
3591	$expgui(MacroSaveButton) configure -state normal
3592	set expgui(MacroChanged) 1
3593	}
3594	} else {
3595	close [open running_${expnam}_macro.flag w]
3596	set saveprompt $expgui(execprompt)
3597	set saveautold $expgui(autoexpload)
3598	set expgui(execprompt) 0
3599	set expgui(autoexpload) 1
3600	set expnam [file root [file tail $expgui(expfile)]]
3601	if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
3602	set outfile ${expnam}_macout.LST
3603	# create an empty file
3604	catch {file delete $outfile}
3605	close [open $outfile w]
3606	# view it with LSTVIEW
3607	set outfile ${expnam}_macout
3608	exec $::wishshell [file join $expgui(scriptdir) lstview] $outfile &
3609	} else {
3610	# show status, offer abort with MACROMON
3611	exec $::wishshell [file join $expgui(scriptdir) macromon] $expnam &
3612	}
3613
3614	set expgui(MacroStatus) "starting script"
3615	pleasewait "\nrunning macro\n\nStatus:" expgui(MacroStatus)
3616
3617	if {[catch {
3618	source $MacroFile
3619	} errmsg]} {
3620	set txt $::errorInfo
3621	catch {
3622	set fp [open error.txt a]
3623	puts $fp "# [clock format [clock seconds] -format %Y-%m-%dT%T]"
3624	puts $fp $txt
3625	close $fp
3626	}
3627	donewait
3628	MyMessageBox -parent . -title "Error running Macro file" \
3629	-message "Error running macro file:\n$errmsg\n(details in file error.txt)" \
3630	-icon error -type OK -default ok
3631	} else {
3632	donewait
3633	}
3634	file delete running_${expnam}_macro.flag
3635	set expgui(execprompt) $saveprompt
3636	set expgui(autoexpload) $saveautold
3637	set expgui(MacroRunning) 0
3638	# show changes
3639	PaintEXPGUIpages
3640	# put comment in output file
3641	if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
3642	set outfile ${expnam}_macout.LST
3643	set fp [open $outfile a]
3644	puts $fp "\n** Macro ended **"
3645	close $fp
3646	}
3647	}
3648	}
3649
3650	# highlight a line in the Macro file display
3651	proc MacroHighlightText {txt line} {
3652	$txt tag delete next
3653	$txt tag add next $line.0 $line.end
3654	$txt see $line.0
3655	$txt tag configure next -background yellow
3656	# tag all text
3657	$txt tag delete all
3658	$txt tag add all 0.0 end
3659	# double-click moves the current line
3660	$txt tag bind all <Double-1> "after idle [list MacroDoubleClick $txt]"
3661	}
3662
3663	# respond to a double click by moving the next line to be executed to
3664	# the line where the double click occurred
3665	proc MacroDoubleClick {txt} {
3666	set line [lindex [split [$txt tag ranges sel] "."] 0]
3667	MacroHighlightText $txt $line
3668	}
3669
3670	# respond to Execute button: execute the current line
3671	# close window after last command
3672	proc MacroExecuteCurrentLine {txt} {
3673	global expgui
3674	set linenum [lindex [split [$txt tag ranges next] "."] 0]
3675	if {$linenum == ""} {return}
3676	set line [$txt get $linenum.0 $linenum.end]
3677	# is this continued (ends with \)?
3678	while {[string range $line end end] == "\\" } {
3679	incr linenum
3680	# get rid of trailing backslash
3681	set line [string range $line 0 end-1]
3682	#append next line
3683	append line [$txt get $linenum.0 $linenum.end]
3684	}
3685	if {[catch $line errmsg]} {
3686	MyMessageBox -parent $txt -title "Error on line" \
3687	-message "Error on line $linenum:\n$errmsg" \
3688	-icon warning -type Continue -default continue
3689	}
3690	# show changes
3691	PaintEXPGUIpages
3692	# move forward in macrofile
3693	incr linenum
3694	MacroHighlightText $txt $linenum
3695	set linenum [lindex [split [$txt tag ranges next] "."] 0]
3696	# at end?
3697	if {$linenum == ""} {MacroCloseWindow $txt}
3698	}
3699
3700	# Save a modified macro file
3701	proc MacroResave {txt} {
3702	global expgui
3703	set MacroFile [tk_getSaveFile -initialdir [pwd] \
3704	-parent $txt \
3705	-filetypes {{"EXPGUI Macro file" .expmac}} \
3706	-defaultextension .expmac \
3707	-initialfile $expgui(MacroFile) \
3708	-title "Choose location to save macro"]
3709	if {[string trim $MacroFile] == ""} {return}
3710	if {[catch {
3711	set fp [open $MacroFile w]
3712	puts $fp [string trim [$txt get 0.0 end]]
3713	close $fp
3714	} errmsg]} {
3715	MyMessageBox -parent $txt -title "Error writing to file" \
3716	-message "Error writing macro file:\n$errmsg" \
3717	-icon warning -type TryAgain -default tryagain
3718	return
3719	}
3720	set expgui(MacroChanged) 0
3721	# gray out the button
3722	$expgui(MacroSaveButton) configure -state disabled
3723	}
3724
3725	# close the window, but provide a chance to save the file first, if modified
3726	proc MacroCloseWindow {txt} {
3727	global expgui
3728	if {$expgui(MacroChanged)} {
3729	set ans [MyMessageBox -parent $txt -title "Save macro file?" \
3730	-message "Macro file has been changed, do you want to save it?" \
3731	-icon warning -type "Yes No" -default no]
3732	if {$ans != "no"} {MacroResave $txt}
3733	}
3734	set expgui(MacroRunning) 0
3735	destroy [winfo toplevel $txt]
3736	}
3737
3738	# Add a comment to a macro file
3739	proc AddCommentMacroFile {} {
3740	global expgui
3741	if {! $expgui(RecordMacro)} return
3742	RecordMacroEntry "# [getstring "comment for macro file"]" 0
3743	}
3744
3745	#------------------------------------------------------------------------------
3746	# Subversion support routines
3747	#------------------------------------------------------------------------------
3748
3749	proc GetSVNVersion {scriptdir} {
3750	if {[CheckSVNinstalled]} {
3751	set SVN [auto_execok svn]
3752	if {! [catch {set res [eval exec $SVN info [list $scriptdir]]} err]} {
3753	set infolist [split $res]
3754	set pos [lsearch $infolist "Revision:"]
3755	return "GSAS/EXPGUI SVN version [lindex $infolist [incr pos]]"
3756	}
3757	}
3758	return "EXPGUI version: [lindex $::expgui(Revision) 1] ([lindex $::expgui(Revision) 4])"
3759	}
3760
3761	# can we find the svn program?
3762	proc CheckSVNinstalled {} {
3763	# can we find svn in the path?
3764	if {[auto_execok svn] != ""} {return 1}
3765	# add a locally supplied svn version and add to path
3766	if {$::tcl_platform(platform) == "windows"} {
3767	set s [file attributes $::expgui(gsasdir) -shortname]
3768	} else {
3769	set s $::expgui(gsasdir)
3770	}
3771	# look for svn
3772	set localsvn [file join $s svn bin]
3773	if {[file exists $localsvn]} {
3774	if {$::tcl_platform(platform) == "windows"} {
3775	set localsvn [file nativename $localsvn]
3776	set sep {;}
3777	} else {
3778	set sep {:}
3779	}
3780	if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} {
3781	append ::env(PATH) $sep $localsvn
3782	# note that auto_reset breaks the tkcon package in Windows -- not sure why
3783	auto_reset
3784	}
3785	}
3786	if {[auto_execok svn] != ""} {return 1}
3787	return 0
3788	}
3789	proc ChangeSVNserver {} {
3790	if [file exists [file join $::expgui(gsasdir) proxyinfo.txt]] {
3791	set fp [open [file join $::expgui(gsasdir) proxyinfo.txt]]
3792	gets $fp proxaddr
3793	gets $fp proxport
3794	set proxy "--config-option servers:global:http-proxy-host=$proxaddr"
3795	set proxp "--config-option servers:global:http-proxy-port=$proxport"
3796	close $fp
3797	} else {
3798	set proxy {}
3799	set proxp {}
3800	}
3801	set SVN [auto_execok svn]
3802	set res {}
3803	catch {set res \
3804	[eval exec $SVN info $::expgui(gsasdir)] \
3805	} err
3806	if {[string first .xor.aps $res] != -1} {
3807	puts "Switching to .xray.aps"
3808	eval exec $SVN switch \
3809	[list "--relocate" \
3810	"https://subversion.xor.aps.anl.gov/EXPGUI" \
3811	"https://subversion.xray.aps.anl.gov/EXPGUI" \
3812	$::expgui(gsasdir) ] $proxy $proxp
3813	}
3814	}
3815
3816
3817	proc CheckAndDoUpdate { } {
3818	if [file exists [file join $::expgui(gsasdir) proxyinfo.txt]] {
3819	set fp [open [file join $::expgui(gsasdir) proxyinfo.txt]]
3820	gets $fp proxaddr
3821	gets $fp proxport
3822	set proxy "--config-option servers:global:http-proxy-host=$proxaddr"
3823	set proxp "--config-option servers:global:http-proxy-port=$proxport"
3824	close $fp
3825	} else {
3826	set proxy {}
3827	set proxp {}
3828	}
3829	pleasewait "... Checking with software repository..."
3830	if {! [CheckSVNinstalled]} {
3831	donewait
3832	MyMessageBox -parent . -title "SVN not found" \
3833	-message "Unable to upgrade: Could not locate a copy of the subversion program. It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \
3834	-icon error
3835	return
3836	}
3837	#is there a svn directory in the source?
3838	if {! [file exists [file join $::expgui(gsasdir) .svn]]} {
3839	donewait
3840	MyMessageBox -parent . -title "No .svn directory" \
3841	-message "Unable to upgrade: It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \
3842	-icon error
3843	return
3844	}
3845	# migrate to new server, if needed
3846	ChangeSVNserver
3847	# check for updates
3848	set SVN [auto_execok svn]
3849	if [catch {set res \
3850	[eval exec $SVN status [list $::expgui(gsasdir)] -u $proxy $proxp] \
3851	} err] {
3852	donewait
3853	set ans [MyMessageBox -parent . -title "Error checking status" \
3854	-message "Error checking for updates: $err\n\nTry to update manually?" \
3855	-icon error -type "Yes No" -default yes]
3856	if {$ans != "no"} {
3857	forknewterm "manually update in subversion" \
3858	" \"$SVN update [file normalize $::expgui(gsasdir)] $proxy $proxp\""
3859	forknewterm "manually update in subversion" \
3860	" \"$SVN update [file normalize $::expgui(scriptdir)] $proxy $proxp\""
3861	}
3862	return
3863	} else {
3864	if {[string first "*" $res] == -1} {
3865	catch {set res \
3866	[eval exec $SVN status [list $::expgui(scriptdir)] -u $proxy $proxp]\
3867	} err
3868	}
3869	if {[string first "*" $res] == -1} {
3870	donewait
3871	MyMessageBox -parent . -title "No updates" \
3872	-message "GSAS & EXPGUI appear up-to-date" \
3873	-icon info
3874	return
3875	}
3876	}
3877	set msg {
3878	Updates to GSAS/EXPGUI found on server.
3879
3880	Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.}
3881	if {$proxy != "" \|\| $proxp != ""} {
3882	append msg "\nUsing proxy settings \"$proxy\" and \"$proxp\""
3883	}
3884	donewait
3885	if {[MyMessageBox -parent . -title "Ready to Update" \
3886	-message $msg \
3887	-type {Cancel "Update & Restart"} -default cancel -icon warning
3888	] == "cancel"} {return}
3889
3890	if {[confirmBeforeSave] == "Cancel"} return
3891
3892	# special upgrade for windows, where the wish exec blocks upgrade of the exe directory
3893	if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {
3894	set fp [open [file join $::expgui(gsasdir) selfupdate.bat] w]
3895	puts $fp {@REM this script must be run from the GSAS installation directory
3896	@REM This is run to update the installation, the name of the EXP file is
3897	@REM expected as an argument
3898	@echo ****************************
3899	@echo Press return to start update
3900	@echo ****************************
3901	@pause
3902	.\svn\bin\svn cleanup .
3903	}
3904	puts $fp ".\\svn\\bin\\svn update . $proxy $proxp"
3905	puts $fp ".\\svn\\bin\\svn cleanup $::expgui(scriptdir)"
3906	puts $fp ".\\svn\\bin\\svn update $::expgui(scriptdir) $proxy $proxp"
3907	puts $fp {@if (%1)==() goto Install2
3908	@echo ****************************************************
3909	@echo Update has completed. Press return to restart EXPGUI
3910	@echo ****************************************************
3911	@pause
3912	%COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui %1"
3913	exit
3914	:Install2
3915	@echo ****************************************************
3916	@echo Update has completed. EXPGUI starting w/o .EXP file
3917	@echo ****************************************************
3918	@pause
3919	%COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui"
3920	exit
3921	}
3922	close $fp
3923	# split the directory and EXP file and get rid os spaces in the directory name
3924	set exp [file normalize $::expgui(expfile)]
3925	set dir [file attributes [file dirname $exp] -shortname]
3926	cd $::expgui(gsasdir)
3927	#run the batch file
3928	exec $::env(COMSPEC) /c "start .\\selfupdate.bat [file join $dir [file tail $exp]]" &
3929	exit
3930	}
3931
3932	# do a quiet cleanup. Sometimes needed after install, and never hurts
3933	if [catch {set res [eval exec $SVN cleanup [list $::expgui(gsasdir)]]} err] {
3934	MyMessageBox -parent . -title "Error in cleanup" \
3935	-message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
3936	-icon error
3937	}
3938	# do a quiet cleanup. Sometimes needed after install, and never hurts
3939	if [catch {set res [eval exec $SVN cleanup [list $::expgui(scriptdir)]]} err] {
3940	MyMessageBox -parent . -title "Error in cleanup" \
3941	-message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
3942	-icon error
3943	}
3944	if [catch {set res [exec $SVN up $::expgui(gsasdir) $proxy $proxp]} err] {
3945	MyMessageBox -parent . -title "Error updating" \
3946	-message "Error performing update:\n$err" \
3947	-icon error
3948	return
3949	} elseif [catch {set res [exec $SVN up $::expgui(scriptdir) $proxy $proxp]} err] {
3950	MyMessageBox -parent . -title "Error updating" \
3951	-message "Error performing scriptdir update:\n$err" \
3952	-icon error
3953	return
3954	} else {
3955	MyMessageBox -parent . -title "Updating done" \
3956	-message "Results from update:\n$res\n\nPress OK to restart EXPGUI" \
3957	-icon info
3958	}
3959	exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &
3960	exit
3961	}
3962
3963	# Fourier routines
3964	proc EditFourier {phase} {
3965	#is this a valid phase #?
3966	if {[lsearch $::expmap(phaselist) $phase] == -1} return
3967	# check that all Fourier records are set to the current phase
3968	set msg ""
3969	foreach i [listFourier] {
3970	set ph [Fourierinfo $i phase]
3971	if {$ph != $phase} {
3972	#Fourierinfo $i phase set $phase
3973	set msg "Reset previous Fourier map(s) for phase $ph?"
3974	}
3975	}
3976	if {$msg != ""} {
3977	set ans [MyMessageBox -parent . -title "Reset Fourier?" \
3978	-message $msg -icon warning -type okcancel]
3979	if {$ans == "ok"} {
3980	delFourier
3981	} else {
3982	return
3983	}
3984	}
3985	# for now we will not offer access to section, (dmin, dmax not supported)
3986	set typelist {}
3987	foreach i [listFourier] {
3988	lappend typelist [Fourierinfo $i type]
3989	}
3990	set histlist [FourierHists $phase]
3991	set limits [getFourierLimits $phase]
3992	if {[winfo exists .export]} {
3993	set box .export.fourier
3994	} else {
3995	set box .fourier
3996	}
3997	catch {destroy $box}
3998	toplevel $box
3999	wm title $box "Set Fourier Options, phase $phase"
4000	grid [frame $box.1] -row 1 -column 1 -rowspan 10
4001	grid [frame $box.2] -row 1 -column 2 -rowspan 10
4002	grid [frame $box.b] -sticky news -row 11 -column 1 -columnspan 2
4003	grid columnconfigure $box.b 0 -weight 1
4004	grid columnconfigure $box.b 3 -weight 1
4005	grid [button $box.b.1 -text Continue \
4006	-command "set ::DXTL(quit) 0; destroy $box" \
4007	] -row 1 -column 1
4008	grid [button $box.b.2 -text Quit \
4009	-command "set ::DXTL(quit) 1; destroy $box" \
4010	] -row 1 -column 2
4011
4012	# map type selection
4013	set row 0
4014	grid [label $box.1.$row -text "Select map type(s)"] -column 1 -row $row
4015	foreach typ {DELF FCLC FOBS 2FDF 3FDF 4FDF PTSN DPTS} lbl {
4016	"Difference Fourier" "Fcalc Fourier" "Fobs Fourier"
4017	"2Fo-Fc Fourier" "3Fo-2Fc Fourier" "4Fo-3*Fc Fourier" "Patterson map" "Delta-F Patterson"\
4018	} {
4019	incr row
4020	grid [ \
4021	checkbutton $box.1.$row -variable ::DXTL($typ) \
4022	-text "$lbl ($typ)" \
4023	] -column 1 -row $row -sticky w
4024	if {[lsearch $typelist $typ] == -1} {
4025	set ::DXTL($typ) 0
4026	} else {
4027	set ::DXTL($typ) 1
4028	}
4029	}
4030	grid [label $box.2.a1 -text "Histogram(s) to be used:\n(last superceeds)"] -column 1 -row 1
4031	grid [label $box.2.a2 -textvariable ::DXTL(histlist) -width 20] -column 2 -row 1 -columnspan 2
4032	grid [button $box.2.a3 -text Set \
4033	-command "SetFourierHists $box"] -column 5 -row 1
4034	set ::DXTL(histlist) {}
4035	foreach i $histlist {
4036	if {$::DXTL(histlist) != ""} {append ::DXTL(histlist) ", "}
4037	append ::DXTL(histlist) $i
4038	}
4039	# if we don't have any histograms, set either set the only choice or
4040	# warn the user
4041	if {$::DXTL(histlist) == ""} {
4042	if {[llength $::expmap(powderlist)] == 1} {
4043	AddFourierHist $::expmap(powderlist)
4044	set ::DXTL(histlist) $::expmap(powderlist)
4045	} else {
4046	set ::DXTL(histlist) "<None: must be set>"
4047	}
4048	}
4049	grid [label $box.2.m1 -text min] -column 2 -row 2
4050	grid [label $box.2.m2 -text max] -column 3 -row 2
4051	grid [label $box.2.m3 -text "map step\n(A)"] -column 4 -row 2
4052	set row 3
4053	foreach axis {X Y Z} lim [lrange $limits 1 end] step [lindex $limits 0] {
4054	incr row
4055	grid [label $box.2.0$axis -text "$axis limits"] -column 1 -row $row -sticky e
4056	grid [entry $box.2.min$axis -width 10 -textvariable ::DXTL(min$axis)] -column 2 -row $row
4057	grid [entry $box.2.max$axis -width 10 -textvariable ::DXTL(max$axis)] -column 3 -row $row
4058	grid [entry $box.2.step$axis -width 10 -textvariable ::DXTL(step$axis)] -column 4 -row $row
4059	set ::DXTL(min$axis) [lindex $lim 0]
4060	set ::DXTL(max$axis) [lindex $lim 1]
4061	set ::DXTL(step$axis) [format "%.4f" [expr {$step + 0.0001}]]
4062	}
4063	putontop $box
4064	tkwait window $box
4065	afterputontop
4066	if $::DXTL(quit) return
4067	delFourier
4068	foreach typ {DELF FCLC FOBS 2FDF 3FDF 4FDF PTSN DPTS} {
4069	if {$::DXTL($typ)} {
4070	addFourier $phase $typ
4071	}
4072	}
4073	if {$::DXTL(histlist) != "<none>"} {
4074	FourierHists $phase set [regsub -all "," $::DXTL(histlist) " "]
4075	}
4076	setFourierLimits $phase \
4077	[list $::DXTL(stepX) $::DXTL(stepY) $::DXTL(stepZ)] \
4078	[list $::DXTL(minX) $::DXTL(maxX)] \
4079	[list $::DXTL(minY) $::DXTL(maxY)] \
4080	[list $::DXTL(minZ) $::DXTL(maxZ)]
4081	incr ::expgui(changed)
4082	}
4083
4084	proc SetFourierHists {top} {
4085	set box $top.hstsel
4086	set ::DXTL(histbox) $box
4087	catch {destroy $box}
4088	toplevel $box
4089	wm title $box "Select Histograms"
4090	grid [frame $box.1 -class HistList] -column 1 -row 1 -sticky news
4091	grid columnconfigure $box 1 -weight 1
4092	grid [frame $box.2] -column 2 -row 1
4093	grid [label $box.2.a -text {Select a histogram from the box
4094	to the left to add it to the
4095	histogram list below
4096
4097	(note that reflection intensities
4098	from the last histograms in list
4099	override earlier ones)
4100
4101	Histogram List:}] \
4102	-column 1 -row 1
4103	grid [label $box.2.b -textvariable ::DXTL(histlist)] -column 1 -row 2
4104	grid [button $box.2.c -text Clear -command ClearFourierHist] \
4105	-column 1 -row 3
4106	grid [button $box.3 -text Close -command "destroy $box"] \
4107	-column 1 -row 3 -columnspan 2
4108	MakeHistBox $box.1
4109	bind $box.1.lbox <ButtonRelease-1> {
4110	set selhist [$::DXTL(histbox).1.lbox curselection]
4111	if {[llength $selhist] != 1} return
4112	AddFourierHist [lindex $::expmap(powderlist) $selhist]
4113	lappend ::DXTL(histlist)
4114	set hist [lindex $::expmap(powderlist) $selhist]
4115	$::DXTL(histbox).2.b config -text $hist
4116	}
4117	sethistlist
4118	putontop $box
4119	tkwait window $box
4120	afterputontop
4121	}
4122
4123	proc AddFourierHist {num} {
4124	if {$::DXTL(histlist) == "<none>"} {
4125	set ::DXTL(histlist) {}
4126	}
4127	if {$::DXTL(histlist) != ""} {append ::DXTL(histlist) ", "}
4128	append ::DXTL(histlist) $num
4129	}
4130
4131	proc ClearFourierHist {} {
4132	set ::DXTL(histlist) "<none>"
4133	}

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

Context Navigation

source: trunk/gsascmds.tcl

Download in other formats: