Context Navigation

gsascmds.tcl @ 998

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

Many revisions for handling file names with spaces using new SetEXPfile proc.
Use of directories with spaces for data files is probably not a problem, since we cd there, but EXP file names and install locations can be messy. Convert names on windows, where possible, and warn for now.

fix DISAGL window buttons for files with spaces.

cleanup MakeScrollTable?

allow ~/.gsas_config on Windows.

for use update.bat instead of building file as needed;

Property svn:keywords set to Author Date Revision Id

File size: 119.9 KB

Line
1	# $Id: gsascmds.tcl 996 2010-08-28 04:14:50Z 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	# place a window on a selected part of the screen
469	# xfrac specifies the hozontal position with 0 to the left and 100 to the right
470	# yfrac specifies the vertical position with 0 to the top and 100 to the bottom
471	# loc chooses the part of the window to place at that location: N: upper, S: lower, W: left, E: right
472	# use NSEW for center
473	proc LocateWindow {win {xfrac 50} {yfrac 50} {loc c}} {
474	wm withdraw $win
475	set maxx [winfo screenwidth $win]
476	set maxy [winfo screenheight $win]
477	set reqx [winfo reqwidth $win]
478	set reqy [winfo reqheight $win]
479	set x [expr {$maxx*$xfrac/100.}]
480	set y [expr {$maxy*$yfrac/100.}]
481	if {[string match -nocase "e" $loc] && [string match -nocase "w" $loc]} {
482	# EW: center
483	set x [expr {$x - $reqx/2. }]
484	} elseif {[string match -nocase "e" $loc]} {
485	# right corner
486	set x [expr {$x - $reqx}]
487	} elseif {[string match -nocase "w" $loc]} {
488	# left corner -- do nothing
489	} else {
490	# center
491	set x [expr {$x - $reqx/2. }]
492	}
493	if {[string match -nocase "n" $loc] && [string match -nocase "s" $loc]} {
494	# NS: center
495	set y [expr {$y - $reqy/2 }]
496	} elseif {[string match -nocase "n" $loc]} {
497	# upper corner -- do nothing
498	} elseif {[string match -nocase "s" $loc]} {
499	# lower corner
500	set y [expr {$y - $reqy}]
501	} else {
502	# center
503	set y [expr {$y - $reqy/2 }]
504	}
505	set x [expr {int($x + 0.5)}]
506	set y [expr {int($y + 0.5)}]
507	if {$x < 0} {set x 0}
508	if {$x > $maxx-$reqx} {set x [expr {$maxx-$reqx}]}
509	if {$y < 0} {set y 0}
510	if {$y > $maxy-$reqy} {set y [expr {$maxy-$reqy}]}
511	wm geom $win +$x+$y
512	wm deiconify $win
513	}
514
515	# get a value in a modal dialog
516	proc getstring {what "chars 40" "quit 1" "initvalue {}"} {
517	global expgui expmap
518	set w .global
519	catch {destroy $w}
520	toplevel $w -bg beige
521	bind $w <Key-F1> "MakeWWWHelp expguierr.html Input[lindex $what 0]"
522	wm title $w "Input $what"
523	set expgui(temp) {}
524	pack [frame $w.0 -bd 6 -relief groove -bg beige] \
525	-side top -expand yes -fill both
526	grid [label $w.0.a -text "Input a value for the $what" \
527	-bg beige] \
528	-row 0 -column 0 -columnspan 10
529	grid [entry $w.0.b -textvariable expgui(temp) -width $chars] \
530	-row 1 -column 0
531
532	set expgui(temp) $initvalue
533	pack [frame $w.b -bg beige] -side top -fill x -expand yes
534	pack [button $w.b.2 -text Continue -command "destroy $w"] -side left
535	if $quit {
536	pack [button $w.b.3 -text Cancel \
537	-command "set expgui(temp) {}; destroy $w"] -side left
538	}
539	bind $w <Return> "destroy $w"
540	pack [button $w.b.help -text Help -bg yellow \
541	-command "MakeWWWHelp expguierr.html Input[lindex $what 0]"] \
542	-side right
543
544	# force the window to stay on top
545	putontop $w
546
547	focus $w.b.2
548	tkwait window $w
549	afterputontop
550
551	return $expgui(temp)
552	}
553
554	#------------------------------------------------------------------------------
555	# profile/symmetry routines
556	#------------------------------------------------------------------------------
557	# profile terms
558	array set expgui {
559	prof-T-names {"Von Dreele-Jorgensen-Windsor" \
560	"David-Ikeda-Carpenter" "Exponential pseudo-Voigt" \
561	"Exponential p-V+Stephens aniso strain" \
562	"Exponential p-V+macro strain"
563	}
564	prof-T-1 {alp-0 alp-1 bet-0 bet-1 sig-0 sig-1 sig-2 rstr rsta \
565	rsca s1ec s2ec }
566	prof-T-2 {alp-0 alp-1 beta switch sig-0 sig-1 sig-2 gam-0 gam-1 \
567	gam-2 ptec stec difc difa zero }
568	prof-T-3 {alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
569	gam-2 gsf g1ec g2ec rstr rsta rsca L11 L22 L33 L12 L13 L23 }
570	prof-T-4 {alp bet-0 bet-1 sig-1 sig-2 gam-2 g2ec gsf \
571	rstr rsta rsca eta}
572	prof-T-5 {alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
573	gam-2 gsf g1ec g2ec rstr rsta rsca D1 D2 D3 D4 D5 D6 }
574	prof-C-names {"Gaussian only" "Pseudo-Voigt" \
575	"pseudo-Voigt/FCJ Asym" "p-V/FCJ+Stephens aniso strain" \
576	"p-V/FCJ+macro strain"
577	}
578	prof-C-1 {GU GV GW asym F1 F2 }
579	prof-C-2 {GU GV GW LX LY trns asym shft GP stec ptec sfec \
580	L11 L22 L33 L12 L13 L23 }
581	prof-C-3 {GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
582	L11 L22 L33 L12 L13 L23 }
583	prof-C-4 {GU GV GW GP LX ptec trns shft sfec S/L H/L eta}
584	prof-C-5 {GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
585	D1 D2 D3 D4 D5 D6 }
586	prof-E-names {Gaussian "Otto pseudo-Voigt"}
587	prof-E-1 {A B C ds cds}
588	prof-E-2 {A B C ds cds LX LY ptec stec}
589	}
590
591	# number of profile terms depends on the histogram type
592	# the LAUE symmetry and the profile number
593	proc GetProfileTerms {phase hist ptype} {
594	global expmap expgui
595	if {$hist == "C" \|\| $hist == "T" \|\| $hist == "E"} {
596	set htype $hist
597	} else {
598	set htype [string range $expmap(htype_$hist) 2 2]
599	}
600	# get the cached copy of the profile term labels, when possible
601	set lbls {}
602	catch {
603	set lbls $expmap(ProfileTerms${phase}_${ptype}_${htype})
604	}
605	if {$lbls != ""} {return $lbls}
606
607	catch {set lbls $expgui(prof-$htype-$ptype)}
608	if {$lbls == ""} {return}
609	# add terms based on the Laue symmetry
610	if {($htype == "C" \|\| $htype == "T") && $ptype == 4} {
611	set laueaxis [GetLaue [phaseinfo $phase spacegroup]]
612	eval lappend lbls [Profile4Terms $laueaxis]
613	}
614	set expmap(ProfileTerms${phase}_${ptype}_${htype}) $lbls
615	return $lbls
616	}
617
618	proc Profile4Terms {laueaxis} {
619	# GSAS Laue classes by number vs spacegrp labeling
620	# 1 2 3 4 5 6 7 8 9 10 11 12 13 14
621	# 1bar, 2/m, mmm, 4/m, 4/mmm, 3bar, 3bar m, 3bar, 3barm1, 3bar1m, 6/m, 6/mmm, m 3, m3m
622	# R R H H H
623	# (R=Rhombohedral setting; H=Hexagonal setting)
624	switch -exact $laueaxis {
625	1bar {return \
626	"S400 S040 S004 S220 S202 S022 S310 S103 S031 \
627	S130 S301 S013 S211 S121 S112"}
628	2/ma {return "S400 S040 S004 S220 S202 S022 S013 S031 S211"}
629	2/mb {return "S400 S040 S004 S220 S202 S022 S301 S103 S121"}
630	2/mc {return "S400 S040 S004 S220 S202 S022 S130 S310 S112"}
631	mmm {return "S400 S040 S004 S220 S202 S022"}
632	4/m {return "S400 S004 S220 S202 S310"}
633	4/mmm {return "S400 S004 S220 S202"}
634	3barR {return "S400 S220 S310 S301 S211"}
635	"3bar mR" {return "S400 S220 S310 S211"}
636	3bar {return "S400 S004 S202 S310 S211"}
637	3barm1 {return "S400 S004 S202 S301"}
638	3bar1m {return "S400 S004 S202 S211"}
639	6/m {return "S400 S004 S202"}
640	6/mmm {return "S400 S004 S202"}
641	"m 3" {return "S400 S220"}
642	m3m {return "S400 S220"}
643	default {return ""}
644	}
645	}
646
647	proc GetLaue {spg} {
648	global tcl_platform expgui
649	# check the space group
650	set fp [open spg.in w]
651	puts $fp "N"
652	puts $fp "N"
653	puts $fp $spg
654	puts $fp "Q"
655	close $fp
656	catch {
657	if {$tcl_platform(platform) == "windows"} {
658	exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
659	} else {
660	exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
661	}
662	}
663	set fp [open spg.out r]
664	set laue {}
665	set uniqueaxis {}
666	while {[gets $fp line] >= 0} {
667	regexp {Laue symmetry (.*)} $line junk laue
668	regexp {The unique axis is (.*)} $line junk uniqueaxis
669	}
670	close $fp
671	catch {file delete -force spg.in spg.out}
672	set laue [string trim $laue]
673	# add a R suffix for rhombohedral settings
674	if {[string range [string trim $spg] end end] == "R"} {
675	return "${laue}${uniqueaxis}R"
676	}
677	return "${laue}$uniqueaxis"
678	}
679
680	# set up to change the profile type for a series of histogram/phase entries
681	# (histlist & phaselist should be lists of the same length)
682	#
683	proc ChangeProfileType {histlist phaselist} {
684	global expgui expmap
685	set w .profile
686	catch {destroy $w}
687	toplevel $w -bg beige
688	wm title $w "Change Profile Function"
689
690	# all histogram/phases better be the same type, so we can just use the 1st
691	set hist [lindex $histlist 0]
692	set phase [lindex $phaselist 0]
693	set ptype [string trim [hapinfo $hist $phase proftype]]
694
695	# get list of allowed profile terms for the current histogram type
696	set i 1
697	while {[set lbls [GetProfileTerms $phase $hist $i]] != ""} {
698	lappend lbllist $lbls
699	incr i
700	}
701	# labels for the current type
702	set i $ptype
703	set oldlbls [lindex $lbllist [incr i -1]]
704
705	if {[llength $histlist] == 1} {
706	pack [label $w.a -bg beige \
707	-text "Change profile function for Histogram #$hist Phase #$phase" \
708	] -side top
709	} else {
710	# make a list of histograms by phase
711	foreach h $histlist p $phaselist {
712	lappend phlist($p) $h
713	}
714	set num 0
715	pack [frame $w.a -bg beige] -side top
716	pack [label $w.a.$num -bg beige \
717	-text "Change profile function for:" \
718	] -side top -anchor w
719	foreach i [lsort [array names phlist]] {
720	incr num
721	pack [label $w.a.$num -bg beige -text \
722	"\tPhase #$i, Histograms [CompressList $phlist($i)]" \
723	] -side top -anchor w
724	}
725	}
726	pack [label $w.e1 \
727	-text "Current function is type $ptype." \
728	-bg beige] -side top -anchor w
729	pack [frame $w.e -bg beige] -side top -expand yes -fill both
730	pack [label $w.e.1 \
731	-text "Set function to type" \
732	-bg beige] -side left
733	set menu [tk_optionMenu $w.e.2 expgui(newpeaktype) junk]
734	pack $w.e.2 -side left -anchor w
735
736	pack [radiobutton $w.e.4 -bg beige -variable expgui(DefaultPeakType) \
737	-command "set expgui(newpeaktype) $ptype; \
738	FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
739	-value 1 -text "Current value overrides"] -side right
740	pack [radiobutton $w.e.3 -bg beige -variable expgui(DefaultPeakType) \
741	-command \
742	"set expgui(newpeaktype) $ptype; \
743	FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
744	-value 0 -text "Default value overrides"] -side right
745
746	$w.e.2 config -bg beige
747	pack [frame $w.c -bg beige] -side top -expand yes -fill both
748	pack [frame $w.d -bg beige] -side top -expand yes -fill both
749	pack [button $w.d.2 -text Continue \
750	-command "SaveChangeProfileType $w.c [list $histlist] [list $phaselist]; destroy $w"\
751	] -side left
752	pack [button $w.d.3 -text Cancel \
753	-command "destroy $w"] -side left
754	pack [button $w.d.help -text Help -bg yellow \
755	-command "MakeWWWHelp expgui5.html ChangeType"] \
756	-side right
757	bind $w <Key-F1> "MakeWWWHelp expgui5.html ChangeType"
758	bind $w <Return> "destroy $w"
759
760	$menu delete 0 end
761	set i 0
762	foreach lbls $lbllist {
763	incr i
764	set j $i
765	# determine if negative profiles are allowed
766	if {[string range $expmap(htype_$hist) 2 2] == "T"} {
767	if {[histinfo $hist proftbl] > 0 && $i > 2} {
768	set j -$i
769	}
770	}
771	$menu add command -label $j -command \
772	"set expgui(newpeaktype) $j; \
773	FillChangeProfileType $w.c $hist $phase $j [list $lbls] [list $oldlbls]"
774	}
775	set expgui(newpeaktype) $ptype
776	FillChangeProfileType $w.c $hist $phase $ptype $oldlbls $oldlbls
777
778	# force the window to stay on top
779	putontop $w
780	focus $w.e.2
781	tkwait window $w
782	afterputontop
783	sethistlist
784	}
785
786	# save the changes to the profile
787	proc SaveChangeProfileType {w histlist phaselist} {
788	global expgui
789	foreach phase $phaselist hist $histlist {
790	hapinfo $hist $phase proftype set $expgui(newpeaktype)
791	RecordMacroEntry "hapinfo $hist $phase proftype set $expgui(newpeaktype)" 0
792	hapinfo $hist $phase profterms set $expgui(newProfileTerms)
793	RecordMacroEntry "hapinfo $hist $phase profterms set $expgui(newProfileTerms)" 0
794	for {set i 1} {$i <= $expgui(newProfileTerms)} {incr i} {
795	hapinfo $hist $phase pterm$i set [$w.ent${i} get]
796	RecordMacroEntry "hapinfo $hist $phase pterm$i set [$w.ent${i} get]" 0
797	hapinfo $hist $phase pref$i set $expgui(ProfRef$i)
798	RecordMacroEntry "hapinfo $hist $phase pref$i set $expgui(ProfRef$i)" 0
799	}
800	set i [expr 1+$expgui(newProfileTerms)]
801	hapinfo $hist $phase pcut set [$w.ent$i get]
802	RecordMacroEntry "hapinfo $hist $phase pcut set [$w.ent$i get]" 0
803	incr expgui(changed) [expr 3 + $expgui(newProfileTerms)]
804	RecordMacroEntry "incr expgui(changed)" 0
805	}
806	}
807
808	# file the contents of the "Change Profile Type" Menu
809	proc FillChangeProfileType {w hist phase newtype lbls oldlbls} {
810	global expgui expmap
811	set ptype [string trim [hapinfo $hist $phase proftype]]
812	catch {unset oldval}
813	# loop through the old terms and set up an array of starting values
814	set num 0
815	foreach term $oldlbls {
816	incr num
817	set oldval($term) [hapinfo $hist $phase pterm$num]
818	}
819	set oldval(Peak\nCutoff) [hapinfo $hist $phase pcut]
820
821	# is the new type the same as the current?
822	if {$ptype == $newtype} {
823	set nterms [hapinfo $hist $phase profterms]
824	} else {
825	set nterms [llength $lbls]
826	}
827	set expgui(newProfileTerms) $nterms
828	set expgui(CurrentProfileTerms) $nterms
829	# which default profile set matches the new type
830	set setnum {}
831	foreach j {" " 1 2 3 4 5 6 7 8 9} {
832	set i [profdefinfo $hist $j proftype]
833	if {$i == ""} continue
834	if {$i == $newtype} {
835	set setnum $j
836	break
837	}
838	}
839
840	eval destroy [winfo children $w]
841
842	set colstr 0
843	set row 2
844	set maxrow [expr $row + $nterms/2]
845	for { set num 1 } { $num <= $nterms + 1} { incr num } {
846	# get the default value (originally from the in .INS file)
847	set val {}
848	if {$setnum != ""} {
849	set val 0.0
850	catch {
851	set val [profdefinfo $hist $setnum pterm$num]
852	# pretty up the number
853	if {$val == 0.0} {
854	set val 0.0
855	} elseif {abs($val) < 1e-2 \|\| abs($val) > 1e6} {
856	set val [format %.3e $val]
857	} elseif {abs($val) > 1e-2 && abs($val) < 10} {
858	set val [format %.5f $val]
859	} elseif {abs($val) < 9999} {
860	set val [format %.2f $val]
861	} elseif {abs($val) < 1e6} {
862	set val [format %.0f $val]
863	}
864	}
865	}
866	# heading
867	if {$row == 2} {
868	set col $colstr
869	grid [label $w.h0${num} -text "lbl" -bg beige] \
870	-row $row -column $col
871	grid [label $w.h2${num} -text "ref" -bg beige] \
872	-row $row -column [incr col]
873	grid [label $w.h3${num} -text "next value" -bg beige] \
874	-row $row -column [incr col]
875	grid [label $w.h4${num} -text "default" -bg beige] \
876	-row $row -column [incr col]
877	grid [label $w.h5${num} -text "current" -bg beige] \
878	-row $row -column [incr col]
879	}
880	set col $colstr
881	incr row
882	set term {}
883	catch {set term [lindex $lbls [expr $num-1]]}
884	if {$term == ""} {set term $num}
885	if {$num == $nterms + 1} {
886	set term "Peak\nCutoff"
887	set val {}
888	if {$setnum != ""} {
889	set val 0.0
890	catch {set val [profdefinfo $hist $setnum pcut]}
891	}
892	}
893
894	grid [label $w.l${num} -text "$term" -bg beige] \
895	-row $row -column $col
896	grid [checkbutton $w.chk${num} -variable expgui(ProfRef$num) \
897	-bg beige -activebackground beige] -row $row -column [incr col]
898	grid [entry $w.ent${num} \
899	-width 12] -row $row -column [incr col]
900	if {$val != ""} {
901	grid [button $w.def${num} -text $val -command \
902	"$w.ent${num} delete 0 end; $w.ent${num} insert end $val" \
903	] -row $row -column [incr col] -sticky ew
904	} else {
905	grid [label $w.def${num} -text (none) \
906	] -row $row -column [incr col]
907	}
908	set curval {}
909	catch {
910	set curval [expr $oldval($term)]
911	# pretty up the number
912	if {$curval == 0.0} {
913	set curval 0.0
914	} elseif {abs($curval) < 1e-2 \|\| abs($curval) > 1e6} {
915	set curval [format %.3e $curval]
916	} elseif {abs($curval) > 1e-2 && abs($curval) < 10} {
917	set curval [format %.5f $curval]
918	} elseif {abs($curval) < 9999} {
919	set curval [format %.2f $curval]
920	} elseif {abs($curval) < 1e6} {
921	set curval [format %.0f $curval]
922	}
923	grid [button $w.cur${num} -text $curval -command \
924	"$w.ent${num} delete 0 end; $w.ent${num} insert end $curval" \
925	] -row $row -column [incr col] -sticky ew
926	}
927	# set default values for flag and value
928	set ref 0
929	if {$setnum != ""} {
930	catch {
931	if {[profdefinfo $hist $setnum pref$num] == "Y"} {set ref 1}
932	}
933	}
934	set expgui(ProfRef$num) $ref
935
936	$w.ent${num} delete 0 end
937	if {!$expgui(DefaultPeakType) && $val != ""} {
938	$w.ent${num} insert end $val
939	} elseif {$curval != ""} {
940	$w.ent${num} insert end $curval
941	} elseif {$val != ""} {
942	$w.ent${num} insert end $val
943	} else {
944	$w.ent${num} insert end 0.0
945	}
946	if {$row > $maxrow} {
947	set row 2
948	incr colstr 5
949	}
950	}
951	if {$::tcl_platform(os) == "Darwin"} {
952	# on OS X force a window resize
953	wm geometry [winfo toplevel $w] {}
954	}
955	}
956
957	#------------------------------------------------------------------------------
958	# WWW/help routines
959	#------------------------------------------------------------------------------
960	# browse a WWW page with URL. The URL may contain a #anchor
961	# On UNIX assume netscape or mozilla is in the path or env(BROWSER) is loaded.
962	# On Windows search the registry for a browser. Mac branch not tested.
963	# This is taken from http://mini.net/cgi-bin/wikit/557.html with many thanks
964	# to the contributers
965	proc urlOpen {url} {
966	global env tcl_platform
967	if {$tcl_platform(os) == "Darwin"} {
968	# if this is an external URL or does not contain an anchor, take the
969	# easy approach
970	if {[string range $url 0 4] == "http:" \|\| \
971	[string first "#" $url] == -1} {
972	if {![catch {exec open $url}]} {
973	return
974	}
975	}
976	# so sorry, have to use Internet Explorer
977	set url [file nativename $url]; # replace ~/ if present
978	if {[file pathtype $url] == "relative"} {
979	set url [file join [pwd] $url]
980	}
981	exec osascript -e "tell application \"Internet Explorer\"\rGetURL \"file://$url\"\rend tell"
982	} elseif {$tcl_platform(platform) == "unix"} {
983	set browserlist {}
984	if {[info exists env(BROWSER)]} {
985	set browserlist $env(BROWSER)
986	}
987	lappend browserlist netscape mozilla
988	foreach p $browserlist {
989	set progs [auto_execok $p]
990	if {[llength $progs]} {
991	if {[catch {exec $progs -remote openURL($url)}]} {
992	# perhaps browser doesn't understand -remote flag
993	if {[catch {exec $env(BROWSER) $url &} emsg]} {
994	error "Error displaying $url in browser\n$emsg"
995	}
996	}
997	return
998	}
999	}
1000	MyMessageBox -parent . -title "No Browser" \
1001	-message "Could not find a browser. Netscape & Mozilla not found. Define environment variable BROWSER to be full path name of browser." \
1002	-icon warning
1003	} elseif {$tcl_platform(platform) == "windows"} {
1004	package require registry
1005	# Look for the application under
1006	# HKEY_CLASSES_ROOT
1007	set root HKEY_CLASSES_ROOT
1008
1009	# Get the application key for HTML files
1010	set appKey [registry get $root\\.html ""]
1011
1012	# Get the command for opening HTML files
1013	set appCmd [registry get \
1014	$root\\$appKey\\shell\\open\\command ""]
1015
1016	# Substitute the HTML filename into the command for %1
1017	# or stick it on the end
1018	if {[string first %1 $appCmd] != -1} {
1019	regsub %1 $appCmd $url appCmd
1020	} else {
1021	append appCmd " " $url
1022	}
1023
1024	# Double up the backslashes for eval (below)
1025	regsub -all {\\} $appCmd {\\\\} appCmd
1026
1027	# Invoke the command
1028	eval exec $appCmd &
1029	} elseif {$tcl_platform(platform) == "macintosh"} {
1030	# preOSX -- this is not used
1031	if {0 == [info exists env(BROWSER)]} {
1032	set env(BROWSER) "Browse the Internet"
1033	}
1034	if {[catch {
1035	AppleScript execute\
1036	"tell application \"$env(BROWSER)\"
1037	open url \"$url\"
1038	end tell
1039	"} emsg]
1040	} then {
1041	error "Error displaying $url in browser\n$emsg"
1042	}
1043	}
1044	}
1045
1046	proc NetHelp {file anchor localloc netloc} {
1047	# use the file on-line, if it exists
1048	if {[file exists [file join $localloc $file]]} {
1049	set url "[file join $localloc $file]"
1050	} else {
1051	set url "http://$netloc/$file"
1052	}
1053	catch {
1054	pleasewait "Starting web browser..."
1055	after 2000 donewait
1056	}
1057	if {$anchor != ""} {
1058	append url # $anchor
1059	}
1060	urlOpen $url
1061	}
1062
1063	proc MakeWWWHelp {"topic {}" "anchor {}"} {
1064	global expgui
1065	if {$topic == ""} {
1066	foreach item $expgui(notebookpagelist) {
1067	if {[lindex $item 0] == $expgui(pagenow)} {
1068	NetHelp [lindex $item 5] [lindex $item 6] $expgui(docdir) $expgui(website)
1069	return
1070	}
1071	}
1072	# this should not happen
1073	NetHelp expgui.html "" $expgui(docdir) $expgui(website)
1074	} elseif {$topic == "menu"} {
1075	NetHelp expguic.html "" $expgui(docdir) $expgui(website)
1076	} else {
1077	NetHelp $topic $anchor $expgui(docdir) $expgui(website)
1078	}
1079	}
1080
1081	# show help information
1082	proc showhelp {} {
1083	global expgui_helplist helpmsg
1084	set helpmsg {}
1085	set frm .help
1086	catch {destroy $frm}
1087	toplevel $frm
1088	wm title $frm "Help Summary"
1089	grid [label $frm.0 -text \
1090	"Click on an entry below to see information on the EXPGUI/GSAS topic" ] \
1091	-column 0 -columnspan 4 -row 0
1092	# grid [message $frm.help -textvariable helpmsg -relief groove] \
1093	# -column 0 -columnspan 4 -row 2 -sticky nsew
1094	grid [text $frm.help -relief groove -bg beige -width 0\
1095	-height 0 -wrap word -yscrollcommand "$frm.escroll set"] \
1096	-column 0 -columnspan 3 -row 2 -sticky nsew
1097	grid [scrollbar $frm.escroll -command "$frm.help yview"] \
1098	-column 4 -row 2 -sticky nsew
1099	grid rowconfig $frm 1 -weight 1 -minsize 50
1100	grid rowconfig $frm 2 -weight 2 -pad 20 -minsize 150
1101	grid columnconfig $frm 0 -weight 1
1102	grid columnconfig $frm 2 -weight 1
1103	set lst [array names expgui_helplist]
1104	grid [listbox $frm.cmds -relief raised -bd 2 \
1105	-yscrollcommand "$frm.scroll set" \
1106	-height 8 -width 0 -exportselection 0 ] \
1107	-column 0 -row 1 -sticky nse
1108	grid [scrollbar $frm.scroll -command "$frm.cmds yview"] \
1109	-column 1 -row 1 -sticky nsew
1110	foreach item [lsort -dictionary $lst] {
1111	$frm.cmds insert end $item
1112	}
1113	if {[$frm.cmds curselection] == ""} {$frm.cmds selection set 0}
1114	grid [button $frm.done -text Done -command "destroy $frm"] \
1115	-column 2 -row 1
1116	# bind $frm.cmds <ButtonRelease-1> \
1117	# "+set helpmsg \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\])"
1118	bind $frm.cmds <ButtonRelease-1> \
1119	"+$frm.help config -state normal; $frm.help delete 0.0 end; \
1120	$frm.help insert end \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\]); \
1121	$frm.help config -state disabled"
1122
1123	# get the size of the window and expand the message boxes to match
1124	# update
1125	# $frm.help config -width [winfo width $frm.help ]
1126	}
1127
1128
1129	#------------------------------------------------------------------------------
1130	# utilities
1131	#------------------------------------------------------------------------------
1132	# run liveplot
1133	proc liveplot {} {
1134	global expgui liveplot wishshell expmap
1135	set expnam [file root [file tail $expgui(expfile)]]
1136	# which histograms are ready for use?
1137	set validlist {}
1138	foreach ihist $expmap(powderlist) {
1139	if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" \|\| \
1140	[string range $expmap(htype_$ihist) 3 3] == "D"} {
1141	lappend validlist $ihist
1142	}
1143	}
1144	if {[llength $validlist] == 0} {
1145	MyMessageBox -parent . -title "No Valid Histograms" \
1146	-message "No histograms are ready to plot. Run GENLES and try again" \
1147	-icon warning -helplink "expguierr.html NoValidHist"
1148	return
1149	}
1150	# use $liveplot(hst) if valid, the 1st entry otherwise
1151	if {[lsearch $validlist $liveplot(hst)] != -1} {
1152	exec $wishshell [file join $expgui(scriptdir) liveplot] \
1153	$expnam $liveplot(hst) $liveplot(legend) &
1154	} else {
1155	exec $wishshell [file join $expgui(scriptdir) liveplot] \
1156	$expnam [lindex $validlist 0] $liveplot(legend) &
1157	}
1158	}
1159
1160	# run lstview
1161	proc lstview {} {
1162	global expgui wishshell
1163	set expnam [file root [file tail $expgui(expfile)]]
1164	exec $wishshell [file join $expgui(scriptdir) lstview] $expnam &
1165	}
1166
1167	# run widplt
1168	proc widplt {"prog widplt"} {
1169	global expgui wishshell
1170	exec $wishshell [file join $expgui(scriptdir) $prog] \
1171	$expgui(expfile) &
1172	}
1173
1174	# run bkgedit
1175	proc bkgedit {"hst {}"} {
1176	global expgui liveplot wishshell expmap
1177	set expnam [file root [file tail $expgui(expfile)]]
1178	if {$hst == ""} {
1179	# which histograms are ready for use?
1180	set validlist {}
1181	foreach ihist $expmap(powderlist) {
1182	if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" \|\| \
1183	[string range $expmap(htype_$ihist) 3 3] == "*"} {
1184	lappend validlist $ihist
1185	}
1186	}
1187	if {[llength $validlist] == 0} {
1188	MyMessageBox -parent . -title "No Valid Histograms" \
1189	-message "No histograms are ready to plot. Run POWPREF and try again" \
1190	-icon warning -helplink "expguierr.html NoValidHist"
1191	return
1192	}
1193	# use $liveplot(hst) if valid, the 1st entry otherwise
1194	if {[lsearch $validlist $liveplot(hst)] != -1} {
1195	set hst $liveplot(hst)
1196	} else {
1197	set hst [lindex $validlist 0]
1198	}
1199	}
1200	# Save the current exp file
1201	savearchiveexp
1202	CantRecordMacroEntry "bkgedit"
1203	# disable the file change monitor if we will reload the .EXP file automatically
1204	if {$expgui(autoexpload)} {set expgui(expModifiedLast) 0}
1205	if {$expgui(autoiconify)} {wm iconify .}
1206	exec $wishshell [file join $expgui(scriptdir) bkgedit] \
1207	$expnam $hst $liveplot(legend)
1208	if {$expgui(autoiconify)} {wm deiconify .}
1209	# load the changed .EXP file automatically?
1210	if {$expgui(autoexpload)} {
1211	# load the revised exp file
1212	loadexp $expgui(expfile)
1213	} else {
1214	# check for changes in the .EXP file immediately
1215	whenidle
1216	}
1217	}
1218
1219	# run excledt
1220	proc excledit {} {
1221	global expgui liveplot expmap
1222	set expnam [file root [file tail $expgui(expfile)]]
1223	# which histograms are ready for use?
1224	set validlist {}
1225	foreach ihist $expmap(powderlist) {
1226	if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" \|\| \
1227	[string range $expmap(htype_$ihist) 3 3] == "*" \|\| \
1228	[string range $expmap(htype_$ihist) 3 3] == "D"} {
1229	lappend validlist $ihist
1230	}
1231	}
1232	if {[llength $validlist] == 0} {
1233	MyMessageBox -parent . -title "No Valid Histograms" \
1234	-message "No histograms are ready to plot. Run POWPREF and try again" \
1235	-icon warning -helplink "expguierr.html NoValidHist"
1236	return
1237	}
1238	#if {$expgui(autoiconify)} {wm iconify .}
1239	StartExcl
1240	#if {$expgui(autoiconify)} {wm deiconify .}
1241	}
1242
1243	# compute the composition for each phase and display in a dialog
1244	proc composition {} {
1245	global expmap expgui
1246	set Z 1
1247	foreach phase $expmap(phaselist) type $expmap(phasetype) {
1248	if {$type == 4} continue
1249	ResetMultiplicities $phase {}
1250	catch {unset total}
1251	foreach atom $expmap(atomlist_$phase) {
1252	set type [atominfo $phase $atom type]
1253	set mult [atominfo $phase $atom mult]
1254	if [catch {set total($type)}] {
1255	set total($type) [expr \
1256	$mult * [atominfo $phase $atom frac]]
1257	} else {
1258	set total($type) [expr $total($type) + \
1259	$mult * [atominfo $phase $atom frac]]
1260	}
1261	if {$mult > $Z} {set Z $mult}
1262	}
1263	append text "\nPhase $phase\n"
1264	append text " Unit cell contents\n"
1265	foreach type [lsort [array names total]] {
1266	append text " $type[format %8.3f $total($type)]"
1267	}
1268	append text "\n\n"
1269
1270	append text " Asymmetric Unit contents (Z=$Z)\n"
1271	foreach type [lsort [array names total]] {
1272	append text " $type[format %8.3f [expr $total($type)/$Z]]"
1273	}
1274	append text "\n"
1275	}
1276
1277	catch {destroy .comp}
1278	toplevel .comp -class MonoSpc
1279	bind .comp <Key-F1> "MakeWWWHelp expgui.html Composition"
1280	wm title .comp Composition
1281	pack [label .comp.results -text $text \
1282	-justify left] -side top
1283	pack [frame .comp.box] -side top -expand y -fill x
1284	pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
1285
1286	set lstnam [string toupper [file tail [file rootname $expgui(expfile)].LST]]
1287	pack [button .comp.box.2 -text "Save to $lstnam file" \
1288	-command "writelst [list $text] ; destroy .comp"] -side left
1289	pack [button .comp.box.help -text Help -bg yellow \
1290	-command "MakeWWWHelp expgui.html Composition"] \
1291	-side right
1292	}
1293
1294	# Delete History Records
1295	proc DeleteHistoryRecords {{msg ""}} {
1296	global expgui
1297	set frm .history
1298	catch {destroy $frm}
1299	toplevel $frm
1300	bind $frm <Key-F1> "MakeWWWHelp expgui.html DeleteHistoryRecords"
1301	if {[string trim $msg] == ""} {
1302	set msg "There are [CountHistory] history records"
1303	}
1304	pack [frame $frm.1 -bd 2 -relief groove] -padx 3 -pady 3 -side left
1305	pack [label $frm.1.0 -text $msg] -side top
1306	pack [frame $frm.1.1] -side top
1307	pack [label $frm.1.1.1 -text "Number of entries to keep"] -side left
1308	pack [entry $frm.1.1.2 -width 3 -textvariable expgui(historyKeep)\
1309	] -side left
1310	set expgui(historyKeep) 10
1311	pack [checkbutton $frm.1.2 -text renumber -variable expgui(renumber)] -side top
1312	set expgui(renumber) 1
1313	pack [frame $frm.2] -padx 3 -pady 3 -side left -fill both -expand yes
1314	pack [button $frm.2.help -text Help -bg yellow \
1315	-command "MakeWWWHelp expgui.html DeleteHistoryRecords"] -side top
1316	pack [button $frm.2.4 -text Cancel \
1317	-command {destroy .history}] -side bottom
1318	pack [button $frm.2.3 -text OK \
1319	-command {
1320	if ![catch {expr $expgui(historyKeep)}] {
1321	DeleteHistory $expgui(historyKeep) $expgui(renumber)
1322	set expgui(changed) 1
1323	destroy .history
1324	}
1325	}] -side bottom
1326	bind $frm <Return> "$frm.2.3 invoke"
1327
1328	# force the window to stay on top
1329	putontop $frm
1330	focus $frm.2.3
1331	tkwait window $frm
1332	afterputontop
1333	}
1334
1335	proc archiveexp {} {
1336	global expgui tcl_platform
1337	# is there a file to archive?
1338	if {![file exists $expgui(expfile)]} return
1339	set expnam [file rootname $expgui(expfile)]
1340	# get the last archived version
1341	set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
1342	if {$lastf == ""} {
1343	set num 01
1344	} else {
1345	regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
1346	scan $num %x num
1347	if {$num >= 255} {
1348	set num FF
1349	} else {
1350	set num [string toupper [format %.2x [incr num]]]
1351	}
1352	}
1353	catch {
1354	set file $expnam.O$num
1355	file copy -force $expgui(expfile) $file
1356	set fp [open $expnam.LST a+]
1357	puts $fp "\n----------------------------------------------"
1358	puts $fp " Archiving [file tail $expnam.EXP] as [file tail $file]"
1359	puts $fp "----------------------------------------------\n"
1360	close $fp
1361	} errmsg
1362	if {$errmsg != ""} {
1363	tk_dialog .warn Confirm "Error archiving the current .EXP file: $errmsg" warning 0 OK
1364	}
1365	}
1366
1367	# save and optionally archive the expfile
1368	proc savearchiveexp {} {
1369	global expgui expmap
1370	if {$expgui(expfile) == ""} {
1371	SaveAsFile
1372	return
1373	}
1374	if !$expgui(changed) return
1375	if {$expgui(archive)} archiveexp
1376	# add a history record
1377	exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds] -format {%D %T}]"
1378	# now save the file
1379	expwrite $expgui(expfile)
1380	# change the icon and assign an app to this .EXP file
1381	global tcl_platform
1382	if {$tcl_platform(os) == "Darwin" && $expgui(MacAssignApp)} {
1383	MacSetResourceFork $expgui(expfile)
1384	}
1385	set expgui(changed) 0
1386	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
1387	set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
1388	wm title . $expgui(expfile)
1389	set expgui(titleunchanged) 1
1390	# set convergence criterion
1391	InitLSvars
1392	}
1393
1394	#------------------------------------------------------------------------------
1395	# GSAS interface routines
1396	#------------------------------------------------------------------------------
1397	# run a GSAS program that does not require an experiment file
1398	proc runGSASprog {proglist "concurrent 1"} {
1399	# save call to Macro file
1400	RecordMacroEntry "runGSASprog [list $proglist] $concurrent" 0
1401	# if concurrent is 0, EXPGUI runs the GSAS program in background
1402	# -- this is not currently needed anywhere where the .EXP file is not.
1403	global expgui tcl_platform
1404	set cmd {}
1405	foreach prog $proglist {
1406	StartGRWND $prog
1407	if {$tcl_platform(platform) == "windows"} {
1408	append cmd " \"[file attributes $expgui(gsasexe)/${prog}.exe -shortname]\" "
1409	} else {
1410	if {$cmd != ""} {append cmd "\;"}
1411	append cmd "[file join $expgui(gsasexe) $prog]"
1412	}
1413	}
1414	forknewterm $prog $cmd [expr !$concurrent] 1
1415	}
1416
1417	# dummy routine, overridden if needed
1418	proc StartGRWND {prog} {
1419	}
1420
1421	# run a GSAS program that requires an experiment file for input/output
1422	proc runGSASwEXP {proglist "concurrent 0"} {
1423	# save call to Macro file
1424	RecordMacroEntry "runGSASwEXP [list $proglist] $concurrent" 0
1425	# most programs that require the .EXP file change it and
1426	# cannot be run concurrently
1427	global expgui tcl_platform
1428	# Save the current exp file
1429	savearchiveexp
1430	# load the changed .EXP file automatically?
1431	if {$expgui(autoexpload)} {
1432	# disable the file changed monitor
1433	set expgui(expModifiedLast) 0
1434	}
1435	set cmd {}
1436	set expnam [file root [file tail $expgui(expfile)]]
1437	foreach prog $proglist {
1438	if {$prog == "powpref"} {
1439	set expgui(needpowpref) 0
1440	set expgui(needpowpref_why) ""
1441	} elseif {$prog == "genles" && $expgui(needpowpref) != 0} {
1442	set msg "You are attempting to run GENLES, after making changes that require POWPREF:\n\n$expgui(needpowpref_why) \nRun POWPREF first?"
1443	set ans [MyMessageBox -parent . -title "Run POWPREF" \
1444	-message $msg -icon warning -type "Yes No" -default yes \
1445	-helplink "expguierr.html RunPowpref"]
1446	if {$ans == "yes"} {
1447	set expgui(needpowpref) 0
1448	set expgui(needpowpref_why) ""
1449	if {$tcl_platform(platform) == "windows"} {
1450	append cmd " \"[file attributes $expgui(gsasexe)/powpref.exe -shortname] $expnam \" "
1451	} else {
1452	if {$cmd != ""} {append cmd "\;"}
1453	append cmd "[file join $expgui(gsasexe) powpref] $expnam"
1454	}
1455	}
1456	}
1457	StartGRWND $prog
1458	if {$tcl_platform(platform) == "windows"} {
1459	append cmd " \"[file attributes $expgui(gsasexe)/${prog}.exe -shortname] $expnam \" "
1460	} elseif {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
1461	append cmd " \" [file join $expgui(gsasexe) $prog] $expnam \" "
1462	} else {
1463	if {$cmd != ""} {append cmd "\;"}
1464	append cmd "[file join $expgui(gsasexe) $prog] $expnam"
1465	}
1466	}
1467	if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
1468	set outfile ${expnam}_macout.LST
1469	runnoterm $cmd $outfile
1470	} else {
1471	forknewterm "$prog -- $expnam" $cmd [expr !$concurrent] 1
1472	}
1473	# load the changed .EXP file automatically?
1474	if {$expgui(autoexpload)} {
1475	# load the revised exp file
1476	loadexp $expgui(expfile)
1477	}
1478	if {$expgui(MacroRunning)} {
1479	if {[file exists abort_${expnam}_macro.flag]} {
1480	file delete abort_${expnam}_macro.flag
1481	error "User requested to abort the macro"
1482	}
1483	update idletasks
1484	}
1485	}
1486
1487	# write text to the .LST file
1488	proc writelst {text} {
1489	global expgui
1490	set lstnam [file rootname $expgui(expfile)].LST
1491	set fp [open $lstnam a]
1492	puts $fp "\n-----------------------------------------------------------------"
1493	puts $fp $text
1494	puts $fp "-----------------------------------------------------------------\n"
1495	close $fp
1496	}
1497
1498
1499	# rename file current to suggested,
1500	# delete window if supplied
1501	# use parent, if supplied or .
1502	proc RenameAsFile {current suggested "window {}" "parent {}"} {
1503	if {$parent == "" && $window != ""} {set parent $window}
1504	if {$parent == ""} {set parent .}
1505	set newfile [tk_getSaveFile -initialfile $suggested -parent $parent]
1506	if {$newfile == ""} return
1507	if {[catch {
1508	file rename -force $current $newfile
1509	}]} {
1510	file copy -force $current $newfile
1511	file delete -force $current
1512	}
1513	if {$window != ""} {destroy $window}
1514	}
1515
1516	# optionally run disagl as a windowless process, w/results in a separate window
1517	proc rundisagl {} {
1518	global expgui txtvw tcl_version tcl_platform
1519	if {$expgui(disaglSeparateBox)} {
1520	set root [file root $expgui(expfile)]
1521	catch {file delete -force $root.tmp}
1522	if {[catch {file rename -force $root.LST $root.OLS}]} {
1523	file copy -force $root.LST $root.OLS
1524	file delete -force $root.OLS
1525	}
1526	# PSW reports this does not happen right away on windows
1527	set i 0
1528	while {$i < 10 && [file exists $root.LST]} {
1529	# debug code
1530	#catch {console show}
1531	#puts "try $i"
1532	# end debug code
1533	after 100
1534	incr i
1535	}
1536	if {[file exists $root.LST]} {
1537	# it was not possible to rename the file
1538	MyMessageBox -parent . -title "Rename Problem" \
1539	-message "Unable to rename $root.LST. Please close LSTVIEW and try again" \
1540	-icon warning -helplink "expguierr.html NoRename"
1541	return
1542	}
1543
1544	#run the program
1545	pleasewait "Running DISAGL"
1546	# create an empty input file
1547	close [open disagl.inp w]
1548	catch {exec [file join $expgui(gsasexe) disagl] \
1549	[file tail $root] < disagl.inp > disagl.out}
1550	if {[catch {file rename -force $root.LST $root.tmp}]} {
1551	file copy -force $root.LST $root.tmp
1552	file delete -force $root.LST
1553	}
1554	catch {file delete -force disagl.inp disagl.out}
1555	if {[catch {file rename -force $root.OLS $root.LST}]} {
1556	file copy -force $root.OLS $root.LST
1557	file delete -force $root.OLS
1558	}
1559	donewait
1560	# open a new window
1561	catch {toplevel .disagl}
1562	eval destroy [winfo child .disagl]
1563	set txt .disagl.txt
1564	catch {eval grid forget [grid slaves .disagl]}
1565	text $txt -width 100 -wrap none \
1566	-yscrollcommand ".disagl.yscroll set" \
1567	-xscrollcommand ".disagl.xscroll set"
1568	scrollbar .disagl.yscroll -command "$txt yview"
1569	scrollbar .disagl.xscroll -command "$txt xview" -orient horizontal
1570	grid .disagl.xscroll -column 0 -row 2 -sticky ew
1571	grid $txt -column 0 -row 1 -sticky nsew
1572	grid .disagl.yscroll -column 1 -row 1 -sticky ns
1573	grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
1574	grid columnconfig .disagl.f 2 -weight 1
1575	grid [button .disagl.f.close -text "Close & Delete" \
1576	-command "destroy .disagl; file delete \[list $root.tmp\]"] \
1577	-column 3 -row 0 -sticky e
1578	grid [button .disagl.f.rename \
1579	-command "RenameAsFile \[list $root.tmp\] \[list $root.DIS\] .disagl" \
1580	-text "Close & Save as..."] \
1581	-column 4 -row 0 -sticky e
1582	# allow font changes on the fly
1583	if {$tcl_version >= 8.0} {
1584	$txt config -font $txtvw(font)
1585	set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
1586	grid .disagl.f.font -column 1 -row 0 -sticky w
1587	grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
1588	$fontbut delete 0 end
1589	foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
1590	$fontbut add command -label "Courier $f" -font "Courier $f"\
1591	-command "set txtvw(font) \"Courier $f\"; \
1592	$txt config -font \$txtvw(font)"
1593	}
1594	}
1595
1596	grid columnconfigure .disagl 0 -weight 1
1597	grid rowconfigure .disagl 1 -weight 1
1598	wm title .disagl "DISAGL results $expgui(expfile)"
1599	wm iconname .disagl "DISAGL $root"
1600	set in [open $root.tmp r]
1601	$txt insert end [read $in]
1602	close $in
1603	bind all {destroy .disagl}
1604	bind .disagl "$txt yview scroll -1 page"
1605	bind .disagl "$txt yview scroll 1 page"
1606	bind .disagl "$txt xview scroll 1 unit"
1607	bind .disagl "$txt xview scroll -1 unit"
1608	bind .disagl "$txt yview scroll -1 unit"
1609	bind .disagl "$txt yview scroll 1 unit"
1610	bind .disagl "$txt yview 0"
1611	bind .disagl "$txt yview end"
1612	# don't disable in Win as this prevents the highlighting of selected text
1613	if {$tcl_platform(platform) != "windows"} {
1614	$txt config -state disabled
1615	}
1616	# find the beginning of the disagl text
1617
1618	set pos 1.0
1619	set nph 0
1620	while {[set loc [$txt search "Program DISAGL Version" $pos end]] != ""} {
1621	set pos [expr {$loc + 1}]
1622	incr nph
1623	}
1624	#puts "Found $nph DISAGL run(s)"
1625	# count phases
1626	set l {}
1627	while {[set loc [$txt search "Lattice constants are" $pos end]] != ""} {
1628	lappend l $loc
1629	set pos [expr {$loc + 1}]
1630	}
1631	catch {unset phaseloc}
1632
1633	set j 0
1634	foreach pos $l {
1635	if {$j == 0} {
1636	set prev $pos
1637	incr j
1638	continue
1639	}
1640	set phaseloc($j) [list $prev $pos]
1641	incr j
1642	}
1643	set phaseloc($j) [list $pos end]
1644	if {$nph >= 1 && $j >= 2} {
1645	grid [menubutton .disagl.f.copy \
1646	-menu .disagl.f.copy.menu \
1647	-text "Copy phase..." -bd 2 -relief raised] \
1648	-column 2 -row 0 -sticky nse
1649	menu .disagl.f.copy.menu
1650	for {set i 1} {$i <= $j} {incr i} {
1651	.disagl.f.copy.menu add command \
1652	-command "seldisaglphase $txt [list $phaseloc($i)]" \
1653	-label "Copy phase $i to clipboard"
1654	}
1655	} elseif {$nph >= 1} {
1656	grid [button .disagl.f.copy \
1657	-command "seldisaglphase $txt [list $phaseloc($j)]" \
1658	-text "Copy phase $j to clipboard"] \
1659	-column 2 -row 0 -sticky e
1660	}
1661	} else {
1662	runGSASwEXP disagl
1663	}
1664	}
1665
1666	proc seldisaglphase {txt phaselist} {
1667	# clear selection
1668	$txt tag remove sel 1.1 end
1669	eval $txt tag add sel $phaselist
1670	clipboard clear
1671	clipboard append " \| Program DISAGL Version MacOSX \|\n"
1672	clipboard append [eval $txt get [$txt tag ranges sel]]
1673	}
1674	#------------------------------------------------------------------------------
1675	# file conversions
1676	#------------------------------------------------------------------------------
1677	proc convfile {} {
1678	global expgui
1679	set frm .file
1680	catch {destroy $frm}
1681	toplevel $frm
1682	wm title $frm "Convert File"
1683	bind $frm <Key-F1> "MakeWWWHelp expgui.html ConvertWin"
1684	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1685	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 \
1686	-side left -fill y -expand yes
1687	pack [button $frmC.help -text Help -bg yellow \
1688	-command "MakeWWWHelp expgui.html ConvertWin"] -side top
1689	pack [button $frmC.q -text Cancel -command "destroy $frm"] -side bottom
1690	pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
1691	-side bottom
1692	pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
1693	winfilebox $frm
1694	bind $frm <Return> "ValidWinCnv $frm"
1695
1696	# force the window to stay on top
1697	putontop $frm
1698	focus $frmC.q
1699	tkwait window $frm
1700	afterputontop
1701	}
1702
1703	# validate the files and make the conversion
1704	proc ValidWinCnv {frm} {
1705	global expgui
1706	# change backslashes to something sensible
1707	regsub -all {\\} $expgui(FileMenuCnvName) / expgui(FileMenuCnvName)
1708	# allow entry of D: for D:/ and D:TEST for d:/TEST
1709	if {[string first : $expgui(FileMenuCnvName)] != -1 && \
1710	[string first :/ $expgui(FileMenuCnvName)] == -1} {
1711	regsub : $expgui(FileMenuCnvName) :/ expgui(FileMenuCnvName)
1712	}
1713	if {$expgui(FileMenuCnvName) == "<Parent>"} {
1714	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1715	ChooseWinCnv $frm
1716	return
1717	} elseif [file isdirectory \
1718	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
1719	if {$expgui(FileMenuCnvName) != "."} {
1720	set expgui(FileMenuDir) \
1721	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1722	}
1723	ChooseWinCnv $frm
1724	return
1725	}
1726
1727	set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1728	if ![file exists $file] {
1729	MyMessageBox -parent $frm -title "Convert Error" \
1730	-message "File $file does not exist" -icon error
1731	return
1732	}
1733
1734	set tmpname "[file join [file dirname $file] tempfile.xxx]"
1735	set oldname "[file rootname $file].org"
1736	if [file exists $oldname] {
1737	set ans [MyMessageBox -parent . -title "Overwrite?" \
1738	-message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
1739	-icon warning -type {Overwrite Cancel} -default Overwrite \
1740	-helplink "expguierr.html OverwriteCnv"]
1741	if {[string tolower $ans] == "cancel"} return
1742	catch {file delete $oldname}
1743	}
1744
1745	if [catch {
1746	set in [open $file r]
1747	set out [open $tmpname w]
1748	fconfigure $out -translation crlf -encoding ascii
1749	set len [gets $in line]
1750	if {$len > 160} {
1751	# this is a UNIX file. Hope there are no control characters
1752	set i 0
1753	set j 79
1754	while {$j < $len} {
1755	puts $out [string range $line $i $j]
1756	incr i 80
1757	incr j 80
1758	}
1759	} else {
1760	while {$len >= 0} {
1761	append line " "
1762	append line " "
1763	set line [string range $line 0 79]
1764	puts $out $line
1765	set len [gets $in line]
1766	}
1767	}
1768	close $in
1769	close $out
1770	file rename -force $file $oldname
1771	file rename -force $tmpname $file
1772	} errmsg] {
1773	MyMessageBox -parent $frm -title "Conversion error" \
1774	-message "Error in conversion:\n$errmsg" -icon warning
1775	} else {
1776	set ans [MyMessageBox -parent $frm -title "More?" \
1777	-message "File [file tail $file] converted.\n(Original saved as [file tail $oldname]).\n\n Convert more files?" \
1778	-type yesno -default no]
1779	if {$ans == "no"} {destroy $frm}
1780	}
1781	}
1782
1783	# create a file box
1784	proc winfilebox {frm} {
1785	global expgui
1786	set bx $frm.1
1787	pack [frame $bx.top] -side top
1788	pack [label $bx.top.a -text "Directory" ] -side left
1789	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
1790	pack $bx.top.d -side left
1791	set expgui(FileMenuDir) [pwd]
1792	# the icon below is from tk8.0/tkfbox.tcl
1793	set upfolder [image create bitmap -data {
1794	#define updir_width 28
1795	#define updir_height 16
1796	static char updir_bits[] = {
1797	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
1798	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
1799	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
1800	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
1801	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
1802	0xf0, 0xff, 0xff, 0x01};}]
1803
1804	pack [button $bx.top.b -image $upfolder \
1805	-command "updir; ChooseWinCnv $frm" ]
1806	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
1807	listbox $bx.a.files -relief raised -bd 2 \
1808	-yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
1809	-height 15 -width 0 -exportselection 0
1810	listbox $bx.a.dates -relief raised -bd 2 \
1811	-yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
1812	-height 15 -width 0 -takefocus 0 -exportselection 0
1813	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
1814	ChooseWinCnv $frm
1815	bind $bx.a.files <ButtonRelease-1> "ReleaseWinCnv $frm"
1816	bind $bx.a.dates <ButtonRelease-1> "ReleaseWinCnv $frm"
1817	bind $bx.a.files <Double-1> "SelectWinCnv $frm"
1818	bind $bx.a.dates <Double-1> "SelectWinCnv $frm"
1819	pack $bx.a.scroll -side left -fill y
1820	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
1821	pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
1822	}
1823
1824	# set the box or file in the selection window
1825	proc ReleaseWinCnv {frm} {
1826	global expgui
1827	set files $frm.1.a.files
1828	set dates $frm.1.a.dates
1829	set select [$files curselection]
1830	if {$select == ""} {
1831	set select [$dates curselection]
1832	}
1833	if {$select == ""} {
1834	set expgui(FileMenuCnvName) ""
1835	} else {
1836	set expgui(FileMenuCnvName) [string trim [$files get $select]]
1837	}
1838	if {$expgui(FileMenuCnvName) == "<Parent>"} {
1839	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
1840	ChooseWinCnv $frm
1841	} elseif [file isdirectory \
1842	[file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
1843	if {$expgui(FileMenuCnvName) != "."} {
1844	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
1845	ChooseWinCnv $frm
1846	}
1847	}
1848	return
1849	}
1850
1851	# select a file or directory -- called on double click
1852	proc SelectWinCnv {frm} {
1853	global expgui
1854	set files $frm.1.a.files
1855	set dates $frm.1.a.dates
1856	set select [$files curselection]
1857	if {$select == ""} {
1858	set select [$dates curselection]
1859	}
1860	if {$select == ""} {
1861	set file .
1862	} else {
1863	set file [string trim [$files get $select]]
1864	}
1865	if {$file == "<Parent>"} {
1866	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
1867	ChooseWinCnv $frm
1868	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
1869	if {$file != "."} {
1870	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
1871	ChooseWinCnv $frm
1872	}
1873	} else {
1874	set expgui(FileMenuCnvName) [file tail $file]
1875	ValidWinCnv $frm
1876	}
1877	}
1878
1879	# fill the files & dates & Directory selection box with current directory,
1880	# also called when box is created to fill it
1881	proc ChooseWinCnv {frm} {
1882	global expgui
1883	set files $frm.1.a.files
1884	set dates $frm.1.a.dates
1885	set expgui(FileMenuCnvName) {}
1886	$files delete 0 end
1887	$dates delete 0 end
1888	$files insert end {<Parent>}
1889	$dates insert end {(Directory)}
1890	set filelist [glob -nocomplain \
1891	[file join [set expgui(FileMenuDir)] *] ]
1892	foreach file [lsort -dictionary $filelist] {
1893	if {[file isdirectory $file]} {
1894	$files insert end [file tail $file]
1895	$dates insert end {(Directory)}
1896	}
1897	}
1898	foreach file [lsort -dictionary $filelist] {
1899	if {![file isdirectory $file]} {
1900	set modified [clock format [file mtime $file] -format "%T %D"]
1901	$files insert end [file tail $file]
1902	$dates insert end $modified
1903	}
1904	}
1905	$expgui(FileDirButtonMenu) delete 0 end
1906	set list ""
1907	global tcl_version
1908	if {$tcl_version > 8.0} {
1909	catch {set list [string tolower [file volume]]}
1910	}
1911	set dir ""
1912	foreach subdir [file split [set expgui(FileMenuDir)]] {
1913	set dir [string tolower [file join $dir $subdir]]
1914	if {[lsearch $list $dir] == -1} {lappend list $dir}
1915	}
1916	foreach path $list {
1917	$expgui(FileDirButtonMenu) add command -label $path \
1918	-command "[list set expgui(FileMenuDir) $path]; \
1919	ChooseWinCnv $frm"
1920	}
1921	return
1922	}
1923
1924	#------------------------------------------------------------------------------
1925	# set options for liveplot
1926	proc liveplotopt {} {
1927	global liveplot expmap
1928	set frm .file
1929	catch {destroy $frm}
1930	toplevel $frm
1931	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
1932	set last [lindex [lsort -integer $expmap(powderlist)] end]
1933	if {$last == ""} {set last 1}
1934	pack [scale $frmA.1 -label "Histogram number" -from 1 -to $last \
1935	-length 150 -orient horizontal -variable liveplot(hst)] -side top
1936	pack [checkbutton $frmA.2 -text {include plot legend}\
1937	-variable liveplot(legend)] -side top
1938	pack [button $frm.2 -text OK \
1939	-command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
1940	] -side top
1941	bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
1942
1943	# force the window to stay on top
1944	putontop $frm
1945	focus $frm.2
1946	tkwait window $frm
1947	afterputontop
1948	}
1949
1950	#------------------------------------------------------------------------------
1951	# get/validate an experiment file name
1952	#------------------------------------------------------------------------------
1953	# validate and store the EXP file name. Create a new .EXP file if it does not
1954	# exist and set the wd to the location of the .EXP file.
1955	proc SetEXPfile {expfile} {
1956	global expgui tcl_platform
1957	set expgui(expfile) {}
1958	if {[string trim $expfile] == ""} return
1959
1960	# break up the file name and directory
1961	set dirname [file dirname $expfile]
1962	set expname [string toupper [file tail $expfile]]
1963
1964	# check the directory exists
1965	if {(! [file exists $dirname]) \|\| (! [file isdir $dirname])} {
1966	update
1967	MyMessageBox -parent . -title "Directory not found" \
1968	-message "Experiment file location \"$dirname\" is invalid -- no such directory exists" \
1969	-icon warning -type Continue -default continue
1970	set expgui(resize) 1
1971	return
1972	}
1973
1974	# is there a space in the directory name? On windows, try to fix it
1975	set origdir $dirname
1976	if {[string first " " $dirname] != -1} {
1977	set warn 1
1978	catch {set warn $expgui(warnonspaceonce)}
1979	if {$tcl_platform(platform) == "windows"} {
1980	set dirname [file attributes $dirname -shortname]
1981	# was the fix successful?
1982	if {[string first " " $dirname] == -1} {
1983	if {$warn} {
1984	update
1985	MyMessageBox -parent . -title "Still debugging..." \
1986	-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." \
1987	-icon warning -type Continue -default continue
1988	set expgui(resize) 1
1989	}
1990	} else {
1991	if {$warn} {
1992	update
1993	MyMessageBox -parent . -title "Can't fix dir" \
1994	-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." \
1995	-icon warning -type Continue -default continue
1996	set expgui(resize) 1
1997	}
1998	}
1999	} elseif {$warn} {
2000	if {$warn} {
2001	update
2002	MyMessageBox -parent . -title "Still debugging..." \
2003	-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." \
2004	-icon warning -type Continue -default continue
2005	set expgui(resize) 1
2006	}
2007	}
2008	set expgui(warnonspaceonce) 0
2009	}
2010
2011	# force exp files to be upper case, set to force save if name changes
2012	set origexp $expname
2013	if {$expname != [string toupper $expfile]} {
2014	set expname [string toupper [file tail $expfile]]
2015	if {$tcl_platform(platform) != "windows"} {set expgui(changed) 1}
2016	}
2017	if {[file extension $expname] != ".EXP"} {
2018	append expname ".EXP"
2019	}
2020	if {$dirname == "."} {
2021	set newexpfile $expname
2022	} else {
2023	set newexpfile [file join $dirname $expname]
2024	}
2025	# is there a space in the EXP name?
2026	if {[string first " " $expname] != -1} {
2027	# If the file exists in windows, see if there is an equivalent name available.
2028	# if not, we could try to create it and then see, but that is too much
2029	# work.
2030	if {$tcl_platform(platform) == "windows"} {
2031	if {[file exists $newexpfile]} {
2032	# try to translate it, if possible
2033	set expname [file tail [file attributes $newexpfile -shortname]]
2034	set newexpfile [file join $dirname $expname]
2035	# fixed?
2036	if {[string first " " $expname] == -1} {
2037	set warn 1
2038	catch {set warn $expgui(warnonexpspaceonce)}
2039	if {$warn} {
2040	update
2041	MyMessageBox -parent . -title "Still debugging..." \
2042	-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." \
2043	-icon warning -type Continue -default continue
2044	set expgui(resize) 1
2045	}
2046	set expgui(warnonexpspaceonce) 0
2047	}
2048	}
2049	if {[string first " " $expname] != -1} {
2050	# not fixed (file does not exist or shortname not supported)
2051	update
2052	MyMessageBox -parent . -title "Can't fix name" \
2053	-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." \
2054	-icon warning -type Continue -default continue
2055	set expgui(resize) 1
2056	return
2057	}
2058	} else {
2059	update
2060	MyMessageBox -parent . -title "Space in name" \
2061	-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." \
2062	-icon warning -type Continue -default continue
2063	set expgui(resize) 1
2064	return
2065	}
2066	}
2067
2068	if {! [file exists $newexpfile]} {
2069	update
2070	set ans [
2071	MyMessageBox -parent . -title "File Open Error" \
2072	-message "File $expname does not exist in ${dirname}. OK to create?" \
2073	-icon question -type {"Select other" "Create"} -default "select other" \
2074	-helplink "expguierr.html OpenErr"
2075	]
2076	set expgui(resize) 1
2077	if {[string tolower $ans] == "create"} {
2078	# you've been warned this .EXP does not exist!
2079	# create an "empty" exp file
2080	createexp $newexpfile \
2081	[getstring "title for experiment $expname" 60 0]
2082	if {! [file exists [file join $dirname $expname]]} {
2083	update
2084	MyMessageBox -parent . -title "File Creation Error" \
2085	-message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \
2086	-icon warning -type Continue -default continue
2087	set expgui(resize) 1
2088	return
2089	}
2090	} else {
2091	return
2092	}
2093	}
2094	set expgui(expfile) $newexpfile
2095	catch {cd [string trim [file dirname $expgui(expfile)]]}
2096	}
2097
2098	proc getExpFileName {mode} {
2099	global expgui tcl_platform
2100	set frm .file
2101	catch {destroy $frm}
2102	toplevel $frm
2103	wm title $frm "Experiment file"
2104	bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
2105	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
2106	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
2107	-fill y -expand yes
2108	pack [button $frmC.help -text Help -bg yellow \
2109	-command "MakeWWWHelp expguierr.html open"] \
2110	-side top -anchor e
2111	pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
2112	pack [radiobutton $frmC.1 -text "File Name" -value 1 \
2113	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
2114	pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
2115	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
2116
2117	set expgui(includearchived) 0
2118	set expgui(FileInfoBox) $frmC.info
2119	if {$mode == "old"} {
2120	pack [checkbutton $frmC.ar -text "Include Archived Files" \
2121	-variable expgui(includearchived) \
2122	-command "ChooseExpFil $frmA"] -side top -pady 10
2123	pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
2124	-class SmallFont] \
2125	-side top -fill both -expand yes -pady 5
2126	} elseif {$mode != "new"} {
2127	# for initial read, don't access archived files
2128	pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
2129	-class SmallFont] \
2130	-side top -fill both -expand yes -pady 5
2131	set mode "old"
2132	}
2133	pack [button $frmC.b -text Read \
2134	-command "valid_exp_file $frmA $mode"] -side bottom
2135	if {$mode == "new"} {
2136	$frmC.b config -text Save
2137	}
2138	pack [button $frmC.q -text Cancel \
2139	-command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
2140	bind $frm <Return> "$frmC.b invoke"
2141
2142	if {$mode == "new"} {
2143	pack [label $frmA.0 -text "Enter an experiment file to create"] \
2144	-side top -anchor center
2145	} else {
2146	pack [label $frmA.0 -text "Select an experiment file to read"] \
2147	-side top -anchor center
2148	}
2149	expfilebox $frmA $mode
2150	# force the window to stay on top
2151	putontop $frm
2152	focus $frmC.b
2153	tkwait window $frm
2154	afterputontop
2155	if {$expgui(FileMenuEXPNAM) == ""} return
2156	# is there a space in the EXP name?
2157	# if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} {
2158	# update
2159	# MyMessageBox -parent . -title "File Name Error" \
2160	# -message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI can#not process experiment files with spaces in the name" \
2161	# -icon warning -type Continue -default continue
2162	# -helplink "expguierr.html OpenErr"
2163	# return
2164	# }
2165	# if {[string first " " $expgui(FileMenuDir)] != -1} {
2166	# set warn 1
2167	# catch {set warn $expgui(warnonexpdirspace)}
2168	# if $warn {
2169	# update
2170	# MyMessageBox -parent . -title "Good luck..." \
2171	# -message "You are using a directory with a space in the name ($expgui(FileMenuDir)) -- You may encounter bugs in EXPGUI. Please e-mail them to Brian.Toby@ANL.gov so they can be fixed." \
2172	# -icon warning -type Continue -default continue
2173	# # -helplink "expguierr.html OpenErr"
2174	# set expgui(warnonexpdirspace) 0
2175	# }
2176	# }
2177	return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2178	}
2179
2180	# validation routine
2181	proc valid_exp_file {frm mode} {
2182	global expgui tcl_platform
2183	# windows fixes
2184	if {$tcl_platform(platform) == "windows"} {
2185	# change backslashes to something sensible
2186	regsub -all {\\} $expgui(FileMenuEXPNAM) / expgui(FileMenuEXPNAM)
2187	# allow entry of D: for D:/ and D:TEST for d:/TEST
2188	if {[string first : $expgui(FileMenuEXPNAM)] != -1 && \
2189	[string first :/ $expgui(FileMenuEXPNAM)] == -1} {
2190	regsub : $expgui(FileMenuEXPNAM) :/ expgui(FileMenuEXPNAM)
2191	}
2192	}
2193	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
2194	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
2195	ChooseExpFil $frm
2196	return
2197	} elseif [file isdirectory \
2198	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
2199	if {$expgui(FileMenuEXPNAM) != "."} {
2200	set expgui(FileMenuDir) \
2201	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2202	}
2203	ChooseExpFil $frm
2204	return
2205	}
2206	# append a .EXP if not present
2207	if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
2208	append expgui(FileMenuEXPNAM) ".EXP"
2209	}
2210	# is there a space in the name?
2211	# if {[string first " " $expgui(FileMenuEXPNAM)] != -1} {
2212	# MyMessageBox -parent . -title "File Name Error" \
2213	# -message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
2214	# -icon warning -type Continue -default continue
2215	# -helplink "expguierr.html OpenErr"
2216	# return
2217	# }
2218	# check for archive files
2219	if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \
2220	$mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
2221	destroy .file
2222	return
2223	} elseif {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
2224	# check for files that end in something other than .EXP .exp or .Exp...
2225	MyMessageBox -parent . -title "File Open Error" \
2226	-message "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
2227	-icon error
2228	return
2229	}
2230	# check on the file status
2231	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2232	if {$mode == "new" && [file exists $file]} {
2233	set ans [
2234	MyMessageBox -parent . -title "File Open Error" \
2235	-message "File [file tail $file] already exists in [file dirname $file]. OK to overwrite?" \
2236	-icon question -type {"Select other" "Overwrite"} -default "select other" \
2237	-helplink "expguierr.html OverwriteErr"
2238	]
2239	if {[string tolower $ans] == "overwrite"} {destroy .file}
2240	return
2241	}
2242	# if file does not exist in case provided, set the name to all
2243	# upper case letters, since that is the best choice.
2244	# if it does exist, read from it as is. For UNIX we will force uppercase later.
2245	if {![file exists $file]} {
2246	set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
2247	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2248	}
2249	if {$mode == "old" && ![file exists $file]} {
2250	set ans [
2251	MyMessageBox -parent . -title "File Open Error" \
2252	-message "File [file tail $file] does not exist in [file dirname $file]. OK to create?" \
2253	-icon question -type {"Select other" "Create"} -default "select other" \
2254	-helplink "expguierr.html OpenErr"
2255	]
2256	if {[string tolower $ans] == "create"} {destroy .file}
2257	return
2258	}
2259	destroy .file
2260	}
2261
2262	proc updir {} {
2263	global expgui
2264	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
2265	}
2266
2267	# create a file box
2268	proc expfilebox {bx mode} {
2269	global expgui
2270	pack [frame $bx.top] -side top
2271	pack [label $bx.top.a -text "Directory" ] -side left
2272	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
2273	pack $bx.top.d -side left
2274	set expgui(FileMenuDir) [pwd]
2275	# the icon below is from tk8.0/tkfbox.tcl
2276	set upfolder [image create bitmap -data {
2277	#define updir_width 28
2278	#define updir_height 16
2279	static char updir_bits[] = {
2280	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
2281	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
2282	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
2283	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
2284	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
2285	0xf0, 0xff, 0xff, 0x01};}]
2286
2287	pack [button $bx.top.b -image $upfolder \
2288	-command "updir; ChooseExpFil $bx" ]
2289	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
2290	listbox $bx.a.files -relief raised -bd 2 \
2291	-yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
2292	-height 15 -width 0 -exportselection 0
2293	listbox $bx.a.dates -relief raised -bd 2 \
2294	-yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
2295	-height 15 -width 0 -takefocus 0 -exportselection 0
2296	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
2297	ChooseExpFil $bx
2298	bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
2299	bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
2300	bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
2301	bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
2302	pack $bx.a.scroll -side left -fill y
2303	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
2304	pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
2305	}
2306	proc sync2boxesY {master slave scroll args} {
2307	$slave yview moveto [lindex [$master yview] 0]
2308	eval $scroll set $args
2309	}
2310	proc move2boxesY {boxlist args} {
2311	foreach listbox $boxlist {
2312	eval $listbox yview $args
2313	}
2314	}
2315
2316	# creates a table that is scrollable in both x and y, use ResizeScrollTable
2317	# to set sizes after gridding the widgets
2318	proc MakeScrollTable {box} {
2319	proc sync2boxes {cmd master slave scroll args} {
2320	$slave $cmd moveto [lindex [$master $cmd] 0]
2321	eval $scroll set $args
2322	}
2323	proc move2boxes {cmd box1 box2 args} {
2324	eval $box1 $cmd $args
2325	eval $box2 $cmd $args
2326	}
2327	grid [label $box.0] -column 0 -row 0
2328	grid [canvas $box.top -scrollregion {0 0 10 10} \
2329	-xscrollcommand "sync2boxes xview $box.top $box.can $box.scroll" \
2330	-width 10 -height 10] -sticky sew -row 0 -column 1
2331	grid [canvas $box.side -scrollregion {0 0 10 10} \
2332	-yscrollcommand "sync2boxes yview $box.side $box.can $box.yscroll" \
2333	-width 10 -height 10] -sticky nes -row 1 -column 0
2334	grid [canvas $box.can -scrollregion {0 0 10 10} \
2335	-yscrollcommand "sync2boxes yview $box.can $box.side $box.yscroll" \
2336	-xscrollcommand "sync2boxes xview $box.can $box.top $box.scroll" \
2337	-width 200 -height 200 -bg lightgrey] -sticky news -row 1 -column 1
2338	grid [set sxbox [scrollbar $box.scroll -orient horizontal \
2339	-command "move2boxes xview $box.can $box.top"]] \
2340	-sticky ew -row 2 -column 1
2341	grid [set sybox [scrollbar $box.yscroll \
2342	-command "move2boxes yview $box.can $box.side"]] \
2343	-sticky ns -row 1 -column 2
2344
2345	$box.top create window 0 0 -anchor nw -window [frame $box.top.f -bd 0]
2346	$box.can create window 0 0 -anchor nw -window [frame $box.can.f -bd 2]
2347	$box.side create window 0 0 -anchor nw -window [frame $box.side.f -bd 2]
2348
2349	grid columnconfig $box 1 -weight 1
2350	grid rowconfig $box 1 -weight 1
2351	return [list $box.top.f $box.can.f $box.side.f $box.0]
2352	}
2353
2354	proc ResizeScrollTable {box} {
2355	update idletasks
2356	for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} {
2357	set x1 [lindex [grid bbox $box.can.f $i 0] 2]
2358	set x2 [lindex [grid bbox $box.top.f $i 0] 2]
2359	if {$x2 > $x1} {set x1 $x2}
2360	grid columnconfigure $box.top.f $i -minsize $x1
2361	grid columnconfigure $box.can.f $i -minsize $x1
2362	}
2363	for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} {
2364	set x1 [lindex [grid bbox $box.can.f 0 $i] 3]
2365	set x2 [lindex [grid bbox $box.side.f 0 $i] 3]
2366	if {$x2 > $x1} {set x1 $x2}
2367	grid rowconfigure $box.can.f $i -minsize $x1
2368	grid rowconfigure $box.side.f $i -minsize $x1
2369	}
2370	update idletasks
2371	set sizes [grid bbox $box.can.f]
2372	$box.can config -scrollregion $sizes
2373	$box.side config -scrollregion $sizes
2374	$box.top config -scrollregion $sizes
2375	$box.side config -width [lindex [grid bbox $box.side.f] 2]
2376	$box.top config -height [lindex [grid bbox $box.top.f] 3]
2377	# remove the scroll when not needed
2378	if {[lindex $sizes 3] > [winfo height $box.can]} {
2379	grid $box.yscroll -sticky ns -column 2 -row 1
2380	} else {
2381	grid forget $box.yscroll
2382	}
2383	if {[lindex $sizes 2] > [winfo width $box.can]} {
2384	grid $box.scroll -sticky ew -column 1 -row 2
2385	} else {
2386	grid forget $box.scroll
2387	}
2388	}
2389
2390	# this is used in cifselect -- not sure why anymore
2391	proc ExpandScrollTable {box} {
2392	# set height & width of central box
2393	$box.can config -width \
2394	[expr [winfo width [winfo toplevel $box]] \
2395	- [winfo width $box.side] - [winfo width $box.yscroll]-20]
2396	$box.can config -height \
2397	[expr [winfo height [winfo toplevel $box]] \
2398	- [winfo height $box.top] - [winfo height $box.scroll]-25]
2399	}
2400
2401
2402	# support routine for SetHistUseFlags
2403	proc InitHistUseFlags {} {
2404	global expmap expgui
2405	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2406	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
2407	set expgui(useflag_$i) [histinfo $i use]
2408	# }
2409	}
2410	}
2411
2412	# show all Powder histograms; set use/do not use flags
2413	proc SetHistUseFlags {} {
2414	set box .test
2415	catch {toplevel $box}
2416	eval destroy [winfo children $box]
2417	grid [label $box.0 -text "Set histogram \"Use/Do Not Use\" flags" -bg white] -row 0 -column 0 -columnspan 2
2418	grid [frame $box.a] -row 1 -column 0 -columnspan 2
2419	grid [button $box.b -text Save -command "destroy $box"] -row 2 -column 0 -sticky e
2420	grid [button $box.c -text Cancel -command "InitHistUseFlags;destroy $box"] -row 2 -column 1 -sticky w
2421	grid columnconfig $box 0 -weight 1
2422	grid columnconfig $box 1 -weight 1
2423	foreach a [MakeScrollTable $box.a] b {tbox bbox sbox cbox} {set $b $a}
2424	$cbox config -text "Use\nFlag"
2425	[winfo parent $bbox] config -height 250 -width 400
2426	global expmap expgui
2427	set px 5
2428	set row -1
2429	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2430	if {[string range $expmap(htype_$i) 2 2] == "T"} {
2431	set det [format %8.2f [histinfo $i tofangle]]
2432	} elseif {[string range $expmap(htype_$i) 2 2] == "C"} {
2433	set det [format %8.5f [histinfo $i lam1]]
2434	} elseif {[string range $expmap(htype_$i) 2 2] == "E"} {
2435	set det [format %8.2f [histinfo $i lam1]]
2436	} else {
2437	set det {}
2438	}
2439	incr row
2440	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
2441	grid [checkbutton $sbox.$i -text $i -variable expgui(useflag_$i)] -row $row -column 0
2442	set expgui(useflag_$i) [histinfo $i use]
2443	# }
2444	grid [label $bbox.0$i \
2445	-text [string range $expmap(htype_$i) 0 3] \
2446	] -row $row -column 0 -padx $px
2447	grid [label $bbox.1$i -text [histinfo $i bank] \
2448	] -row $row -column 1 -padx $px
2449	grid [label $bbox.2$i -text $det] -row $row -column 2 -padx $px
2450	grid [label $bbox.3$i -text [string range [histinfo $i title] 0 66] \
2451	] -row $row -column 3 -padx $px -sticky ew
2452	}
2453	grid [label $tbox.0 -text type -bd 2 -relief raised] -row 0 -column 0 -padx $px
2454	grid [label $tbox.1 -text bank -bd 2 -relief raised] -row 0 -column 1 -padx $px
2455	grid [label $tbox.2 -text "ang/wave" -bd 2 -relief raised] -row 0 -column 2 -padx $px
2456	grid [label $tbox.3 -text "histogram title" -bd 2 -relief raised] -row 0 -column 3 -sticky w -padx $px
2457	ResizeScrollTable $box.a
2458	InitHistUseFlags
2459	putontop $box
2460	tkwait window $box
2461	afterputontop
2462	set prevchages $expgui(changed)
2463	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
2464	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
2465	if {$expgui(useflag_$i) != [histinfo $i use]} {
2466	histinfo $i use set $expgui(useflag_$i)
2467	RecordMacroEntry "histinfo $i use set $expgui(useflag_$i)" 0
2468	incr expgui(changed)
2469	RecordMacroEntry "incr expgui(changed)" 0
2470	}
2471	# }
2472	}
2473	if {$prevchages != $expgui(changed)} {
2474	set msg "You have changed [expr $expgui(changed)-$prevchages] "
2475	append msg "histogram flag(s). You must run POWPREF "
2476	append msg "to include/remove these histograms. Do you want to "
2477	append msg "run POWPREF?"
2478	set ans [MyMessageBox -parent . -message $msg \
2479	-title "Process changes?"\
2480	-helplink "expguierr.html ProcessUse" \
2481	-default {Run POWPREF} \
2482	-type {{Run POWPREF} Skip}]
2483
2484	if {$ans == "skip"} {
2485	# save and reload the experiment file
2486	savearchiveexp
2487	loadexp $expgui(expfile)
2488	} else {
2489	# run powpref and force a reload
2490	set saveautoload $expgui(autoexpload)
2491	set expgui(autoexpload) 1
2492	runGSASwEXP powpref
2493	set expgui(autoexpload) $saveautoload
2494	}
2495	}
2496	}
2497
2498	# set the box or file in the selection window
2499	proc ReleaseExpFil {frm} {
2500	global expgui
2501	set files $frm.a.files
2502	set dates $frm.a.dates
2503	set select [$files curselection]
2504	if {$select == ""} {
2505	set select [$dates curselection]
2506	}
2507	if {$select == ""} {
2508	set expgui(FileMenuEXPNAM) ""
2509	} else {
2510	set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
2511	after idle UpdateInfoBox
2512	}
2513	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
2514	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
2515	ChooseExpFil $frm
2516	} elseif [file isdirectory \
2517	[file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
2518	if {$expgui(FileMenuEXPNAM) != "."} {
2519	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
2520	ChooseExpFil $frm
2521	}
2522	}
2523	return
2524	}
2525	proc UpdateInfoBox {} {
2526	global expgui
2527	if {![winfo exists $expgui(FileInfoBox)]} return
2528	eval destroy [winfo children $expgui(FileInfoBox)]
2529	set file [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]
2530	if [file isdirectory $file] return
2531	if [file exists $file] {
2532	pack [label $expgui(FileInfoBox).1 -text $expgui(FileMenuEXPNAM)] \
2533	-side top
2534	catch {
2535	set fp [open $file r]
2536	global testline
2537	set testline [read $fp]
2538	close $fp
2539	update
2540	regexp {GNLS RUN on (.) +Total.run *([0-9]+) } \
2541	$testline a last cycles
2542	pack [label $expgui(FileInfoBox).2 -justify left \
2543	-text "last GENLES run:\n $last\n total cycles: $cycles"] \
2544	-side top -anchor w
2545	regexp {REFN GDNFT.= ([0-9]\.[0-9]) +for *([0-9]+) variables} \
2546	$testline a chi2 vars
2547	pack [frame $expgui(FileInfoBox).3 -class SmallFont] \
2548	-side top -anchor w
2549	pack [label $expgui(FileInfoBox).3.a -justify left \
2550	-text "c" -font symbol] \
2551	-side left -anchor w
2552	pack [label $expgui(FileInfoBox).3.b -justify left \
2553	-text "2: $chi2, $vars vars"] \
2554	-side top -anchor w
2555	# check first 9 histograms
2556	set lbl "h Rwp R(F2)"
2557	set n 0
2558	foreach k {1 2 3 4 5 6 7 8 9} {
2559	set key "HST $k"
2560	append key { RPOWD +([0-9]\.[0-9]) }
2561	set i [regexp $key $testline a Rwp]
2562	set key "HST $k"
2563	append key { R-FAC +[0-9]+ +([0-9]\.[0-9]) }
2564	set j [regexp $key $testline a Rb]
2565	if {$i \|\| $j} {
2566	incr n
2567	append lbl "\n$k "
2568	if {$i} {
2569	append lbl [string range $Rwp 0 5]
2570	} else {
2571	append lbl " "
2572	}
2573	}
2574	if {$j} {
2575	append lbl " [string range $Rb 0 5]"
2576	}
2577	# stick 1st 3 entries in box
2578	if {$n >= 3} break
2579	}
2580	pack [label $expgui(FileInfoBox).4 -justify left \
2581	-text $lbl] \
2582	-side top -anchor w
2583	}
2584	}
2585	}
2586
2587	# select a file or directory -- called on double click
2588	proc SelectExpFil {frm mode} {
2589	global expgui
2590	set files $frm.a.files
2591	set dates $frm.a.dates
2592	set select [$files curselection]
2593	if {$select == ""} {
2594	set select [$dates curselection]
2595	}
2596	if {$select == ""} {
2597	set file .
2598	} else {
2599	set file [string trim [$files get $select]]
2600	}
2601	if {$file == "<Parent>"} {
2602	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
2603	ChooseExpFil $frm
2604	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
2605	if {$file != "."} {
2606	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
2607	ChooseExpFil $frm
2608	}
2609	} else {
2610	set expgui(FileMenuEXPNAM) [file tail $file]
2611	valid_exp_file $frm $mode
2612	}
2613	}
2614
2615	# fill the files & dates & Directory selection box with current directory,
2616	# also called when box is created to fill it
2617	proc ChooseExpFil {frm} {
2618	global expgui
2619	set files $frm.a.files
2620	set dates $frm.a.dates
2621	set expgui(FileMenuEXPNAM) {}
2622	$files delete 0 end
2623	$dates delete 0 end
2624	$files insert end {<Parent>}
2625	$dates insert end {(Directory)}
2626	set filelist [glob -nocomplain \
2627	[file join [set expgui(FileMenuDir)] *] ]
2628	foreach file [lsort -dictionary $filelist] {
2629	if {[file isdirectory $file]} {
2630	$files insert end [file tail $file]
2631	$dates insert end {(Directory)}
2632	}
2633	}
2634	set pairlist {}
2635	foreach file [lsort -dictionary $filelist] {
2636	if {![file isdirectory $file] && \
2637	[string toupper [file extension $file]] == ".EXP"} {
2638	set modified [file mtime $file]
2639	lappend pairlist [list $file $modified]
2640	} elseif {![file isdirectory $file] && $expgui(includearchived) && \
2641	[string match {*.O[0-9A-F][0-9A-F]} $file]} {
2642	set modified [file mtime $file]
2643	lappend pairlist [list $file $modified]
2644	}
2645	}
2646	if {$expgui(filesort) == 0} {
2647	foreach pair [lsort -index 1 -integer -decreasing $pairlist] {
2648	set file [lindex $pair 0]
2649	set modified [clock format [lindex $pair 1] -format "%T %D"]
2650	$files insert end [file tail $file]
2651	$dates insert end $modified
2652	}
2653	} else {
2654	foreach pair [lsort -dictionary -index 0 $pairlist] {
2655	set file [lindex $pair 0]
2656	set modified [clock format [lindex $pair 1] -format "%T %D"]
2657	$files insert end [file tail $file]
2658	$dates insert end $modified
2659	}
2660	}
2661	$expgui(FileDirButtonMenu) delete 0 end
2662	set list ""
2663	global tcl_platform tcl_version
2664	if {$tcl_platform(platform) == "windows" && $tcl_version > 8.0} {
2665	catch {set list [string tolower [file volume]]}
2666	}
2667	set dir ""
2668	foreach subdir [file split [set expgui(FileMenuDir)]] {
2669	set dir [file join $dir $subdir]
2670	if {$tcl_platform(platform) == "windows"} {
2671	set dir [string tolower $dir]
2672	if {[lsearch $list $dir] == -1} {lappend list $dir}
2673	} else {
2674	lappend list $dir
2675	}
2676	}
2677	foreach path $list {
2678	$expgui(FileDirButtonMenu) add command -label $path \
2679	-command "[list set expgui(FileMenuDir) $path]; \
2680	ChooseExpFil $frm"
2681	}
2682	# highlight the current experiment -- if present
2683	for {set i 0} {$i < [$files size]} {incr i} {
2684	set file [$files get $i]
2685	if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
2686	$files selection set $i
2687	}
2688	}
2689	return
2690	}
2691
2692
2693	#------------------------------------------------------------------------------
2694	# platform-specific definitions
2695	if {$tcl_platform(platform) == "windows" && $tcl_platform(os) == "Windows 95"} {
2696	# windows-95, -98 and presumably -me do not allow Tcl/Tk to run the
2697	# DOS box synchronously, so we create a "lock" file that is deleted
2698	# at the end of the DOS run so we can tell when the run is done.
2699	# We create a window to force the deleting of the file so that if
2700	# the DOS process crashes, the user can continue anyway.
2701	#
2702	# procedure to check if the lock file is still there (Win-9x/me only)
2703	proc checklockfile {file window} {
2704	if [file exists $file] {
2705	after 500 checklockfile $file $window
2706	} else {
2707	catch {destroy $window}
2708	}
2709	}
2710	# this procedure starts the GRWND program, if needed for program $prog
2711	proc StartGRWND {prog} {
2712	global expgui
2713	if {!$expgui(autoGRWND)} return
2714	# at some point we might want to have a real list
2715	if {$prog != "genles" && $prog != "powpref"} {
2716	# get a list of running jobs
2717	exec [file join $expgui(scriptdir) win9xbin tlist.exe] > tlist.tlist
2718	set fp [open tlist.tlist r]
2719	set text [read $fp]
2720	close $fp
2721	file delete -force tlist.tlist
2722	# if GRWND.EXE is not currently running, start it
2723	if {[lsearch [string toupper $text] GRWND.EXE] == -1} {
2724	exec [file join $expgui(gsasexe) grwnd.exe] &
2725	# give grwnd a 1 second head start
2726	after 1000
2727	}
2728	}
2729	}
2730	# this creates a DOS box to run a program in
2731	proc forknewterm {title command "wait 1" "scrollbar 1"} {
2732	global env expgui
2733	# Windows environment variables
2734	set env(GSAS) [file nativename $expgui(gsasdir)]
2735	# PGPLOT_FONT is needed by PGPLOT
2736	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
2737	# this is the number of lines/page in the .LST (etc.) file
2738	set env(LENPAGE) 60
2739	set pwd [file nativename [pwd]]
2740
2741	# check the .EXP path -- can DOS use it?
2742	if {[string first // [pwd]] != -1} {
2743	MyMessageBox -parent . -title "Invalid Path" \
2744	-message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
2745	-icon error -type ok -default ok \
2746	-helplink "expgui_Win_readme.html NetPath"
2747	return
2748	}
2749	if {[info command winutils::shell] == "" && \
2750	[info command winexec] == ""} {
2751	MyMessageBox -parent . -title "Setup error" \
2752	-message {Error -- Use "Neither WINEXEC not WINTILS were found. Can't do anything!"} \
2753	-icon error -type darn -default darn \
2754	-helplink "expgui_Win_readme.html Winexec"
2755	return
2756	}
2757	# loop over multiple commands
2758	foreach cmd $command {
2759	# simulate the wait with a lock file
2760	if {$wait} {
2761	if {$expgui(autoiconify)} {wm iconify .}
2762	# create a blank lock file and a message window
2763	close [open expgui.lck w]
2764	toplevel .lock
2765	grid [button .lock.0 -text Help -bg yellow \
2766	-command "MakeWWWHelp expguierr.html lock"] \
2767	-column 1 -row 0
2768	grid [label .lock.1 \
2769	-text "Please wait while the GSAS program finishes."] \
2770	-column 0 -row 0
2771	grid [label .lock.2 -text \
2772	"In case a problem occurs, close the DOS box"] \
2773	-column 0 -columnspan 2 -row 1
2774	grid [label .lock.3 -text \
2775	"and press the \"Continue\" button (below)"] \
2776	-column 0 -columnspan 2 -row 2
2777	grid [button .lock.b -text "Continue" \
2778	-command "destroy .lock; wm deiconify ."] \
2779	-column 0 -columnspan 2 -row 3
2780	putontop .lock
2781	update
2782	checklockfile expgui.lck .lock
2783	}
2784
2785	# pause is hard coded in the GSASTCL.BAT file
2786	if {$expgui(execprompt)} {
2787	set script gsastcl.bat
2788	} else {
2789	set script gsasnowt.bat
2790	}
2791
2792	# replace the forward slashes with backward
2793	regsub -all / $cmd \\ cmd
2794	if {[info command winutils::shell] != ""} {
2795	winutils::shell [file join $expgui(scriptdir) $script] $cmd
2796	} else {
2797	winexec -d [file nativename [pwd]] \
2798	[file join $expgui(scriptdir) $script] $cmd
2799	}
2800	if {$expgui(MacroRunning)} {
2801	update
2802	update idletasks
2803	}
2804	if {$wait} {
2805	tkwait window .lock
2806	file delete -force expgui.lck
2807	}
2808	}
2809	if {$expgui(autoiconify) && $wait} {wm deiconify .}
2810	# check for changes in the .EXP file immediately
2811	whenidle
2812	}
2813	} elseif {$tcl_platform(platform) == "windows"} {
2814	# now for Windows-NT, where we can run synchronously
2815	#
2816	# this creates a DOS box to run a program in
2817	proc forknewterm {title command "wait 1" "scrollbar 1"} {
2818	global env expgui
2819	# Windows environment variables
2820	set env(GSAS) [file nativename $expgui(gsasdir)]
2821	# PGPLOT_FONT is needed by PGPLOT
2822	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
2823	set env(PGPLOT_DIR) $expgui(pgplotdir)
2824	# this is the number of lines/page in the .LST (etc.) file
2825	set env(LENPAGE) 60
2826	set pwd [file nativename [pwd]]
2827	# check the path -- can DOS use it?
2828	if {[string first // [pwd]] != -1} {
2829	MyMessageBox -parent . -title "Invalid Path" \
2830	-message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
2831	-icon error -type ok -default ok \
2832	-helplink "expgui_Win_readme.html NetPath"
2833	return
2834	}
2835	# pause is hard coded in the .BAT file
2836	if {$expgui(execprompt)} {
2837	set script gsastcl.bat
2838	} else {
2839	set script gsasnowt.bat
2840	}
2841
2842	if {$wait} {
2843	if {$expgui(autoiconify)} {wm iconify .}
2844	# create a blank lock file (keep liveplot from running)
2845	close [open expgui.lck w]
2846	# loop over commands
2847	foreach cmd $command {
2848	# replace the forward slashes with backward
2849	regsub -all / $cmd \\ cmd
2850	# use of file attributes -shortname & normalize and nativename
2851	# might help here
2852	exec $env(COMSPEC) /c \
2853	"start [file attributes [file join $expgui(scriptdir) $script] -shortname] $cmd"
2854	}
2855	file delete -force expgui.lck
2856	if {$expgui(autoiconify)} {wm deiconify .}
2857	# check for changes in the .EXP file immediately
2858	whenidle
2859	} else {
2860	# loop over commands
2861	foreach cmd $command {
2862	# replace the forward slashes with backward
2863	regsub -all / $cmd \\ cmd
2864	# run in background
2865	exec $env(COMSPEC) /c \
2866	"start [file attributes [file join $expgui(scriptdir) $script] -shortname] $cmd"
2867	if {$expgui(MacroRunning)} {
2868	update
2869	update idletasks
2870	}
2871	}
2872	}
2873	}
2874	} else {
2875	# UNIX-based machines
2876	if {[auto_execok xterm] != ""} {
2877	# this creates a xterm window for running programs inside
2878	proc forknewterm {title command "wait 1" "scrollbar 1"} {
2879	global env expgui
2880	# UNIX environment variables
2881	set env(GSAS) [file nativename $expgui(gsasdir)]
2882	set env(gsas) [file nativename $expgui(gsasdir)]
2883	set env(GSASEXE) $expgui(gsasexe)
2884	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
2885	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
2886	# PGPLOT_DIR is needed by PGPLOT
2887	set env(PGPLOT_DIR) $expgui(pgplotdir)
2888	# this is the number of lines/page in the .LST (etc.) file
2889	set env(LENPAGE) 60
2890	set termopts {}
2891	if $env(GSASBACKSPACE) {
2892	append termopts \
2893	{-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"}
2894	}
2895	if $scrollbar {
2896	append termopts " -sb"
2897	} else {
2898	append termopts " +sb"
2899	}
2900	if {$wait} {
2901	set suffix {}
2902	} else {
2903	set suffix {&}
2904	}
2905
2906	# hold window open after commands finish
2907	if {$expgui(execprompt)} {
2908	append command "\; echo -n Press Enter to continue \; read x"
2909	}
2910	if {$wait && $expgui(autoiconify)} {wm iconify .}
2911	catch {eval exec xterm $termopts -title [list $title] \
2912	-e /bin/sh -c [list $command] $suffix} errmsg
2913	if $expgui(debug) {puts "xterm result = $errmsg"}
2914	if {$expgui(MacroRunning)} {
2915	update
2916	update idletasks
2917	}
2918	if {$wait} {
2919	if {$expgui(autoiconify)} {wm deiconify .}
2920	# check for changes in the .EXP file immediately
2921	whenidle
2922	}
2923	}
2924	} elseif {[auto_execok gnome-terminal] != ""} {
2925	# this creates a xterm window for running programs inside
2926	proc forknewterm {title command "wait 1" "scrollbar 1"} {
2927	global env expgui
2928	# UNIX environment variables
2929	set env(GSAS) [file nativename $expgui(gsasdir)]
2930	set env(gsas) [file nativename $expgui(gsasdir)]
2931	set env(GSASEXE) $expgui(gsasexe)
2932	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
2933	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
2934	# PGPLOT_DIR is needed by PGPLOT
2935	set env(PGPLOT_DIR) $expgui(pgplotdir)
2936	# this is the number of lines/page in the .LST (etc.) file
2937	set env(LENPAGE) 60
2938	if {$wait} {
2939	set suffix {}
2940	} else {
2941	set suffix {&}
2942	}
2943
2944	# hold window open after commands finish
2945	if {$expgui(execprompt)} {
2946	append command "\; echo -n Press Enter to continue \; read x"
2947	}
2948	if {$wait && $expgui(autoiconify)} {wm iconify .}
2949	catch {exec gnome-terminal --title $title \
2950	-e " /bin/sh -c \" $command \" " $suffix} errmsg
2951	if $expgui(debug) {puts "gnome-terminal result = $errmsg"}
2952	if {$expgui(MacroRunning)} {
2953	update
2954	update idletasks
2955	}
2956	if {$wait} {
2957	if {$expgui(autoiconify)} {wm deiconify .}
2958	# check for changes in the .EXP file immediately
2959	whenidle
2960	}
2961	}
2962	} else {
2963	MyMessageBox -parent . -title "Error: no terminal program" \
2964	-message "Error, the xterm or gnome-terminal utility programs could not be found. It is not possible to run the GSAS programs without this." \
2965	-icon error -type NOT-OK -default not-ok
2966	}
2967	}
2968
2969	# run commands without a terminal window
2970	proc runnoterm {command outfile} {
2971	global env expgui tcl_platform
2972	if {$tcl_platform(platform) == "windows"} {
2973	# Windows environment variables
2974	set env(GSAS) [file nativename $expgui(gsasdir)]
2975	# PGPLOT_FONT is needed by PGPLOT
2976	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
2977	# this is the number of lines/page in the .LST (etc.) file
2978	set env(LENPAGE) 60
2979	set pwd [file nativename [pwd]]
2980	# loop over multiple commands
2981	foreach cmd $command {
2982	# replace the forward slashes with backward
2983	regsub -all / $cmd \\ cmd
2984	exec $cmd >>& $outfile
2985	update
2986	update idletasks
2987	}
2988	} else {
2989	# UNIX environment variables
2990	set env(GSAS) [file nativename $expgui(gsasdir)]
2991	set env(gsas) [file nativename $expgui(gsasdir)]
2992	set env(GSASEXE) $expgui(gsasexe)
2993	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
2994	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
2995	# PGPLOT_DIR is needed by PGPLOT
2996	set env(PGPLOT_DIR) $expgui(pgplotdir)
2997	# this is the number of lines/page in the .LST (etc.) file
2998	set env(LENPAGE) 60
2999	foreach cmd $command {
3000	catch {eval exec $cmd >>& $outfile} errmsg
3001	}
3002	update
3003	update idletasks
3004	}
3005	# check for changes in the .EXP file immediately
3006	#whenidle
3007	}
3008
3009	proc MacMakeResource {file app} {
3010	# make a resource file. Note that OS X has gotten picky about the length of this
3011	set l [string length $app]
3012	if $::expgui(debug) {puts "$l bytes"}
3013	incr l
3014	if $::expgui(debug) {puts "$l bytes after incr"}
3015	set str "data 'usro' (0) {\n"
3016	append str " $\""
3017	append str [format %.8X $l]
3018	set bytes 4
3019	foreach char [split $app {}] {
3020	append str [format %.2X [scan $char %c]]
3021	}
3022	incr bytes $l
3023	set newline 1
3024	for {set i 0} {$i < [expr 1028-$bytes]} {incr i} {
3025	if $newline {
3026	append str "\" \n"
3027	append str " $\""
3028	set newline 0
3029	set j 0
3030	}
3031	append str {0000 }
3032	incr bytes
3033	incr j 2
3034	if {$j > 15} {set newline 1}
3035	}
3036	if {$l % 2} {
3037	append str "\"\n "
3038	} else {
3039	# even lengths need one more byte
3040	append str "00\"\n "
3041	}
3042	append str "/* $app */\n};\n"
3043	set fp [open $file w]
3044	puts $fp $str
3045	close $fp
3046	}
3047
3048	# modify resource fork info for a .EXP file on the Mac
3049	proc MacSetResourceFork {expfile} {
3050	global expgui tcl_platform
3051	if {$tcl_platform(os) != "Darwin"} {return}
3052	set expnative [file nativename $expfile]
3053	#
3054	# assign an app to the data file, if the app and the
3055	# required tool (Rez) are installed
3056	set app [file nativename [file join $expgui(gsasdir) expgui.app]]
3057	set RezApp {}
3058	foreach pth "/usr/bin /Developer/Tools $expgui(gsasexe)" {
3059	if [file exists [set tst [file join $pth Rez]]] {
3060	set RezApp $tst
3061	break
3062	}
3063	}
3064	set SetFileApp {}
3065	foreach pth "/usr/bin /Developer/Tools $expgui(gsasexe)" {
3066	if [file exists [set tst [file join $pth SetFile]]] {
3067	set SetFileApp $tst
3068	break
3069	}
3070	}
3071	if $::expgui(debug) {puts "found app=$app Rez=$RezApp and SetFile=$SetFileApp"}
3072	if {[file exists $app] && $RezApp != ""} {
3073	# make resource file
3074	MacMakeResource setapp.r $app
3075	if $::expgui(debug) {puts "$RezApp setapp.r -o $expnative -a"}
3076	exec $RezApp setapp.r -o $expnative -a
3077	if {! $::expgui(debug)} {
3078	file delete -force setapp.r
3079	}
3080	}
3081
3082	# assign an icon to the data file, if it and the required tools exist
3083	set icon [file join $expgui(gsasexe) gsasicon.r]
3084	if {[file exists $icon] && $RezApp != "" && $SetFileApp != ""} {
3085	exec $RezApp [file nativename $icon] -o $expnative -a
3086	exec $SetFileApp -a C $expnative
3087	if {$::expgui(debug)} {
3088	puts "$RezApp [file nativename $icon] -o $expnative -a"
3089	puts "$SetFileApp -a C $expnative"
3090	}
3091	} elseif {$::expgui(debug)} {
3092	puts "icon=$icon missing?"
3093	}
3094	}
3095
3096	#-------------------------------------------------------------------------------
3097	# Macro Recording
3098	#-------------------------------------------------------------------------------
3099	set expgui(MacroBufferedCommand) ""
3100	set expgui(fpMacroFile) ""
3101	set expgui(MacroFile) ""
3102	# Turn on/off mode to save commands in MacroFile
3103	proc SetRecordMacroOnOff {args} {
3104	global expgui
3105	if {$expgui(RecordMacro)} {
3106	set expgui(fpMacroFile) ""
3107	set expgui(MacroBufferedCommand) ""
3108	while {$expgui(fpMacroFile) == ""} {
3109	set expgui(MacroFile) [tk_getSaveFile -initialdir [pwd] \
3110	-parent . \
3111	-filetypes {{"EXPGUI Macro file" .expmac}} \
3112	-defaultextension .expmac \
3113	-initialfile EXPGUI.expmac \
3114	-title "Choose location to save macro"]
3115	if {$expgui(MacroFile) == ""} {
3116	# respond to cancel
3117	set expgui(fpMacroFile) ""
3118	set expgui(MacroFile) ""
3119	set expgui(RecordMacro) 0
3120	return
3121	}
3122	if {[catch {
3123	set expgui(fpMacroFile) [open $expgui(MacroFile) w]
3124	puts $expgui(fpMacroFile) "# [clock format [clock seconds] -format %Y-%m-%dT%T]"
3125	} errmsg]} {
3126	MyMessageBox -parent . -title "Error opening selected file" \
3127	-message "Error opening macro file:\n$errmsg" \
3128	-icon warning -type TryAgain -default tryagain
3129	catch {close $expgui(fpMacroFile)}
3130	set expgui(fpMacroFile) ""
3131	set expgui(MacroFile) ""
3132	set expgui(RecordMacro) 0
3133	}
3134	}
3135	} else {
3136	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
3137	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3138	}
3139	catch {close $expgui(fpMacroFile)}
3140	set expgui(fpMacroFile) ""
3141	set expgui(MacroFile) ""
3142	set expgui(MacroBufferedCommand) ""
3143	}
3144	}
3145
3146	# record a command in the Macro File
3147	proc RecordMacroEntry {command buffer} {
3148	global expgui
3149	if {! $expgui(RecordMacro)} return
3150	# in buffered mode: hold the last command in memory and compare to the
3151	# next. If two commands differ only in the final argument, then the
3152	# second command makes the previous redundant so only the latter version
3153	# is retained (This will happen when a user types a string into a box).
3154	# When the commands differ, then the previous is written to file
3155	# and the next is retained in memory.
3156	if {$buffer} {
3157	if {[string trim $expgui(MacroBufferedCommand)] == ""} {
3158	set expgui(MacroBufferedCommand) $command
3159	return
3160	}
3161	set diff 0
3162	# is command a repeat of previous?
3163	foreach a $command b $expgui(MacroBufferedCommand) {
3164	if {$diff} {
3165	# found a difference, other than in the last arg
3166	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3167	break
3168	}
3169	if {$a != $b} {set diff 1}
3170	}
3171	set expgui(MacroBufferedCommand) $command
3172	} else {
3173	# no buffering on current command; write the old and new to file.
3174	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
3175	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3176	}
3177	puts $expgui(fpMacroFile) $command
3178	set expgui(MacroBufferedCommand) ""
3179	}
3180	}
3181
3182	proc CantRecordMacroEntry {comment} {
3183	global expgui
3184	if {! $expgui(RecordMacro)} return
3185
3186	# no buffering on current command; write the old and new to file.
3187	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
3188	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
3189	}
3190	puts $expgui(fpMacroFile) "# unrecorded: $comment"
3191	set expgui(MacroBufferedCommand) ""
3192	MyMessageBox -parent . -title "No command record" \
3193	-message "EXPGUI is not able to record this action in the macro file: $comment" \
3194	-icon warning
3195	}
3196
3197
3198	# Play back commands in Macro File
3199	proc ReplayMacroFile {"lineatatime 0"} {
3200	global expgui
3201	set expnam [file root [file tail $expgui(expfile)]]
3202	file delete abort_${expnam}_macro.flag
3203	set expgui(MacroRunning) 0
3204	set MacroFile [tk_getOpenFile -initialdir [pwd] \
3205	-parent . \
3206	-filetypes {{"EXPGUI Macro file" .expmac} {Everything .*}} \
3207	-defaultextension .expmac \
3208	-title "Choose location to read macro"]
3209	if {$MacroFile == ""} return
3210	set expgui(MacroRunning) 1
3211	if {$lineatatime} {
3212	set expgui(MacroChanged) 0
3213	set top1 .macro
3214	catch {destroy $top1}
3215	toplevel $top1
3216	set txt $top1.t
3217	grid [text $txt -width 30 -height 20 -yscrollcommand "$top1.s set"] \
3218	-column 0 -row 0 -sticky news
3219	wm title $top1 "File $MacroFile"
3220	grid [scrollbar $top1.s -command "$txt yview"] \
3221	-column 1 -row 0 -sticky ns
3222	grid [frame $top1.b] -column 0 -columnspan 2 -row 1 -sticky ew
3223	grid columnconfig $top1 0 -weight 1
3224	grid rowconfig $top1 0 -weight 1
3225	grid [button $top1.b.e -text "Execute line" \
3226	-command "MacroExecuteCurrentLine $txt"] \
3227	-column 0 -row 0 -sticky w
3228	grid columnconfig $top1.b 1 -weight 1
3229	grid [button $top1.b.s -text "Save As" -state disabled \
3230	-command "MacroResave $txt"] -column 1 -row 0
3231	set expgui(MacroSaveButton) $top1.b.s
3232	grid [button $top1.b.c -text "Close " \
3233	-command "MacroCloseWindow $txt"] -column 2 -row 0
3234	$txt delete 0.0 end
3235	set fp [open $MacroFile r]
3236	$txt insert 0.0 [read $fp]
3237	close $fp
3238	MacroHighlightText $txt 1
3239	# deal with editing in the box
3240	$txt configure -undo 1
3241	$txt edit modified 0
3242	bind $txt <<Modified>> {
3243	$expgui(MacroSaveButton) configure -state normal
3244	set expgui(MacroChanged) 1
3245	}
3246	} else {
3247	close [open running_${expnam}_macro.flag w]
3248	set saveprompt $expgui(execprompt)
3249	set saveautold $expgui(autoexpload)
3250	set expgui(execprompt) 0
3251	set expgui(autoexpload) 1
3252	set expnam [file root [file tail $expgui(expfile)]]
3253	if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
3254	set outfile ${expnam}_macout.LST
3255	# create an empty file
3256	catch {file delete $outfile}
3257	close [open $outfile w]
3258	# view it with LSTVIEW
3259	set outfile ${expnam}_macout
3260	exec $::wishshell [file join $expgui(scriptdir) lstview] $outfile &
3261	} else {
3262	# show status, offer abort with MACROMON
3263	exec $::wishshell [file join $expgui(scriptdir) macromon] $expnam &
3264	}
3265
3266	set expgui(MacroStatus) "starting script"
3267	pleasewait "\nrunning macro\n\nStatus:" expgui(MacroStatus)
3268
3269	if {[catch {
3270	source $MacroFile
3271	} errmsg]} {
3272	set txt $::errorInfo
3273	catch {
3274	set fp [open error.txt a]
3275	puts $fp "# [clock format [clock seconds] -format %Y-%m-%dT%T]"
3276	puts $fp $txt
3277	close $fp
3278	}
3279	donewait
3280	MyMessageBox -parent . -title "Error running Macro file" \
3281	-message "Error running macro file:\n$errmsg\n(details in file error.txt)" \
3282	-icon error -type OK -default ok
3283	} else {
3284	donewait
3285	}
3286	file delete running_${expnam}_macro.flag
3287	set expgui(execprompt) $saveprompt
3288	set expgui(autoexpload) $saveautold
3289	set expgui(MacroRunning) 0
3290	# show changes
3291	PaintEXPGUIpages
3292	# put comment in output file
3293	if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
3294	set outfile ${expnam}_macout.LST
3295	set fp [open $outfile a]
3296	puts $fp "\n** Macro ended **"
3297	close $fp
3298	}
3299	}
3300	}
3301
3302	# highlight a line in the Macro file display
3303	proc MacroHighlightText {txt line} {
3304	$txt tag delete next
3305	$txt tag add next $line.0 $line.end
3306	$txt see $line.0
3307	$txt tag configure next -background yellow
3308	# tag all text
3309	$txt tag delete all
3310	$txt tag add all 0.0 end
3311	# double-click moves the current line
3312	$txt tag bind all <Double-1> "after idle [list MacroDoubleClick $txt]"
3313	}
3314
3315	# respond to a double click by moving the next line to be executed to
3316	# the line where the double click occurred
3317	proc MacroDoubleClick {txt} {
3318	set line [lindex [split [$txt tag ranges sel] "."] 0]
3319	MacroHighlightText $txt $line
3320	}
3321
3322	# respond to Execute button: execute the current line
3323	# close window after last command
3324	proc MacroExecuteCurrentLine {txt} {
3325	global expgui
3326	set linenum [lindex [split [$txt tag ranges next] "."] 0]
3327	if {$linenum == ""} {return}
3328	set line [$txt get $linenum.0 $linenum.end]
3329	# is this continued (ends with \)?
3330	while {[string range $line end end] == "\\" } {
3331	incr linenum
3332	# get rid of trailing backslash
3333	set line [string range $line 0 end-1]
3334	#append next line
3335	append line [$txt get $linenum.0 $linenum.end]
3336	}
3337	if {[catch $line errmsg]} {
3338	MyMessageBox -parent $txt -title "Error on line" \
3339	-message "Error on line $linenum:\n$errmsg" \
3340	-icon warning -type Continue -default continue
3341	}
3342	# show changes
3343	PaintEXPGUIpages
3344	# move forward in macrofile
3345	incr linenum
3346	MacroHighlightText $txt $linenum
3347	set linenum [lindex [split [$txt tag ranges next] "."] 0]
3348	# at end?
3349	if {$linenum == ""} {MacroCloseWindow $txt}
3350	}
3351
3352	# Save a modified macro file
3353	proc MacroResave {txt} {
3354	global expgui
3355	set MacroFile [tk_getSaveFile -initialdir [pwd] \
3356	-parent $txt \
3357	-filetypes {{"EXPGUI Macro file" .expmac}} \
3358	-defaultextension .expmac \
3359	-initialfile $expgui(MacroFile) \
3360	-title "Choose location to save macro"]
3361	if {[string trim $MacroFile] == ""} {return}
3362	if {[catch {
3363	set fp [open $MacroFile w]
3364	puts $fp [string trim [$txt get 0.0 end]]
3365	close $fp
3366	} errmsg]} {
3367	MyMessageBox -parent $txt -title "Error writing to file" \
3368	-message "Error writing macro file:\n$errmsg" \
3369	-icon warning -type TryAgain -default tryagain
3370	return
3371	}
3372	set expgui(MacroChanged) 0
3373	# gray out the button
3374	$expgui(MacroSaveButton) configure -state disabled
3375	}
3376
3377	# close the window, but provide a chance to save the file first, if modified
3378	proc MacroCloseWindow {txt} {
3379	global expgui
3380	if {$expgui(MacroChanged)} {
3381	set ans [MyMessageBox -parent $txt -title "Save macro file?" \
3382	-message "Macro file has been changed, do you want to save it?" \
3383	-icon warning -type "Yes No" -default no]
3384	if {$ans != "no"} {MacroResave $txt}
3385	}
3386	set expgui(MacroRunning) 0
3387	destroy [winfo toplevel $txt]
3388	}
3389
3390	# Add a comment to a macro file
3391	proc AddCommentMacroFile {} {
3392	global expgui
3393	if {! $expgui(RecordMacro)} return
3394	RecordMacroEntry "# [getstring "comment for macro file"]" 0
3395	}
3396
3397	#------------------------------------------------------------------------------
3398	# Subversion support routines
3399	#------------------------------------------------------------------------------
3400	# is there a subversion stub and can we find the svn program
3401	proc CheckUpdateImplemented {scriptdir} {
3402	#is there a svn directory in the source?
3403	if {! [file exists [file join $scriptdir .svn]]} {return 0}
3404	# can we find svn in the path?
3405	if {[auto_execok svn] != ""} {return 1}
3406	# add a locally supplied svn version, if not in the path already
3407	set pathlist [list [file join $scriptdir svn bin]]
3408	lappend pathlist "/sw/bin/"
3409	lappend pathlist "/opt/local/bin/"
3410	catch {lappend pathlist $::expgui(pathlist)}
3411	foreach localsvn $pathlist {
3412	if {[file exists $localsvn]} {
3413	if {$::tcl_platform(platform) == "windows"} {
3414	set localsvn [file nativename $localsvn]
3415	set sep {;}
3416	} else {
3417	set sep {:}
3418	}
3419	if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} {
3420	append ::env(PATH) $sep $localsvn
3421	auto_reset
3422	if {[auto_execok svn] != ""} {return 1}
3423	}
3424	}
3425	}
3426	return 0
3427	}
3428
3429	proc GetSVNVersion {scriptdir} {
3430	if {$::tcl_platform(platform) == "windows"} {
3431	set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
3432	} else {
3433	set SVN [auto_execok svn]
3434	}
3435	if {$SVN != ""} {
3436	if {! [catch {set res [exec $SVN info $scriptdir]} err]} {
3437	set infolist [split $res]
3438	set pos [lsearch $infolist "Revision:"]
3439	return "EXPGUI SVN version [lindex $infolist [incr pos]]"
3440	}
3441	}
3442	return "EXPGUI version: $::expgui(Revision)"
3443	}
3444
3445	proc GetSVNrepository {scriptdir} {
3446	if {$::tcl_platform(platform) == "windows"} {
3447	set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
3448	} else {
3449	set SVN [auto_execok svn]
3450	}
3451	if {$SVN != ""} {
3452	if {! [catch {set res [exec $SVN info $scriptdir]} err]} {
3453	set infolist [split $res]
3454	set pos [lsearch $infolist "URL:"]
3455	return [lindex $infolist [incr pos]]
3456	}
3457	}
3458	return {}
3459	}
3460
3461	proc SetSVNbranch {branch} {
3462	# reset the track label
3463	set ::command(SVNversion) [lindex [split [GetSVNrepository $::expgui(scriptdir)] '/'] end]
3464	if {$::tcl_platform(platform) == "windows"} {
3465	set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
3466	} else {
3467	set SVN [auto_execok svn]
3468	}
3469	if {$SVN == ""} {
3470	return 0
3471	}
3472	set curURL [GetSVNrepository $expgui(scriptdir)]
3473	set curbranch [lindex [split $curURL '/'] end]
3474	if {$curbranch == $branch} {return 0}
3475	if {$branch == "trunk"} {
3476	set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/trunk"
3477	set lbl development
3478	} elseif {$branch == "stable"} {
3479	set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/tags/stable"
3480	set lbl standard
3481	} else {
3482	MyMessageBox -parent . -title "Internal error" \
3483	-message "No $branch track." -icon error
3484	return 0
3485	}
3486	set msg {Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.}
3487	if {[MyMessageBox -parent . -title "Ready to switch" \
3488	-message "Ready to update to the $lbl track.\n\n$msg" \
3489	-type {Cancel "Update & Restart"} -default cancel -icon warning
3490	] == "cancel"} {return}
3491	if {[confirmBeforeSave] == "Cancel"} return
3492
3493	# do a quiet cleanup. Sometimes needed after install, and never hurts
3494	if [catch {set res [exec $SVN cleanup $::expgui(scriptdir)]} err] {
3495	MyMessageBox -parent . -title "Error in cleanup" \
3496	-message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
3497	-icon error
3498	}
3499
3500	# switch the source
3501	set cmd1 "$SVN switch $newURL $scriptdir"
3502	if [catch {set res1 [exec $SVN switch $newURL $::expgui(scriptdir)]} err] {
3503	MyMessageBox -parent . -title "Error updating" \
3504	-message "Error performing update:\n$err" \
3505	-icon error
3506	return 0
3507	}
3508	set msg "Results from update:\n$cmd1\n$res1"
3509	# update done, now need to "reboot"
3510	MyMessageBox -parent . -title "Updating done" -icon info \
3511	-message "Update Complete\nPress OK to restart EXPGUI\n\n$msg"
3512	exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &
3513	exit
3514	}
3515
3516	proc CheckAndDoUpdate { } {
3517	if {$::tcl_platform(platform) == "windows"} {
3518	set SVN [file attributes [lindex [auto_execok svn] 0] -shortname]
3519	} else {
3520	set SVN [auto_execok svn]
3521	}
3522	if {$SVN == ""} {
3523	tk_dialog .msg "Error: no svn" \
3524	"Error: SVN not found. Should not happen." \
3525	error 0 OK
3526	return
3527	}
3528	#set wish "[info nameofexecutable]"
3529	# check for updates
3530	if [catch {
3531	set res [exec $SVN status [file normalize $::expgui(gsasdir)] -u]
3532	} err] {
3533	set ans [MyMessageBox -parent . -title "Error checking status" \
3534	-message "Error checking for updates: $err\n\nTry to update manually?" \
3535	-icon error -type "Yes No" -default yes]
3536	if {$ans != "no"} {
3537	forknewterm "manually update in subversion" \
3538	"$SVN update [file normalize $::expgui(gsasdir)]"
3539	}
3540	return
3541	} else {
3542	if {[string first "*" $res] == -1} {
3543	MyMessageBox -parent . -title "No updates" \
3544	-message "GSAS/EXPGUI appears up-to-date" \
3545	-icon info
3546	return
3547	}
3548	}
3549	if {[MyMessageBox -parent . -title "Ready to Update" \
3550	-message {
3551	Updates to GSAS/EXPGUI found.
3552
3553	Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.} \
3554	-type {Cancel "Update & Restart"} -default cancel -icon warning
3555	] == "cancel"} {return}
3556
3557	if {[confirmBeforeSave] == "Cancel"} return
3558
3559	# special upgrade for windows, where the wish exec blocks upgrade of the exe directory
3560	if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {
3561	# split the directory and EXP file and get rid os spaces in the directory name
3562	set exp [file normalize $::expgui(expfile)]
3563	set dir [file attributes [file dirname $exp] -shortname]
3564	cd $::expgui(gsasdir)
3565	#run the batch file
3566	exec $::env(COMSPEC) /c {start .\update.bat [file join $dir [file tail $exp]]} &
3567	exit
3568	}
3569
3570	# do a quiet cleanup. Sometimes needed after install, and never hurts
3571	if [catch {set res [exec $SVN cleanup $::expgui(gsasdir)]} err] {
3572	MyMessageBox -parent . -title "Error in cleanup" \
3573	-message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
3574	-icon error
3575	}
3576	if [catch {set res [exec $SVN up $::expgui(gsasdir)]} err] {
3577	MyMessageBox -parent . -title "Error updating" \
3578	-message "Error performing update:\n$err" \
3579	-icon error
3580	return
3581	} else {
3582	MyMessageBox -parent . -title "Updating done" \
3583	-message "Results from update:\n$res\n\nPress OK to restart EXPGUI" \
3584	-icon info
3585	}
3586	exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &
3587	exit
3588	}

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

Context Navigation

source: branches/sandbox/gsascmds.tcl @ 998

Download in other formats: