Context Navigation

source: trunk/gsascmds.tcl @ 1102

Last change on this file since 1102 was 1034, checked in by toby, 15 years ago
return required exiled code (2 box x scroll)
Property svn:keywords set to `Author Date Revision Id`
File size: 122.9 KB

Rev	Line
[1025]	1	# $Id: gsascmds.tcl 1034 2010-10-31 14:54:34Z 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	# call up new DISAGL parm edit box
	1520	if {[DA_Control_Panel 1]} {return}
	1521	# Save the current exp file if needed
	1522	savearchiveexp
	1523	if {$expgui(disaglSeparateBox)} {
	1524	set root [file root $expgui(expfile)]
	1525	catch {file delete -force $root.tmp}
	1526	if {[catch {file rename -force $root.LST $root.OLS}]} {
	1527	file copy -force $root.LST $root.OLS
	1528	file delete -force $root.OLS
	1529	}
	1530	# PSW reports this does not happen right away on windows
	1531	set i 0
	1532	while {$i < 10 && [file exists $root.LST]} {
	1533	# debug code
	1534	#catch {console show}
	1535	#puts "try $i"
	1536	# end debug code
	1537	after 100
	1538	incr i
	1539	}
	1540	if {[file exists $root.LST]} {
	1541	# it was not possible to rename the file
	1542	MyMessageBox -parent . -title "Rename Problem" \
	1543	-message "Unable to rename $root.LST. Please close LSTVIEW and try again" \
	1544	-icon warning -helplink "expguierr.html NoRename"
	1545	return
	1546	}
	1547
	1548	#run the program
	1549	pleasewait "Running DISAGL"
	1550	# create an empty input file
	1551	close [open disagl.inp w]
	1552	catch {exec [file join $expgui(gsasexe) disagl] \
	1553	[file tail $root] < disagl.inp > disagl.out}
	1554	if {[catch {file rename -force $root.LST $root.tmp}]} {
	1555	file copy -force $root.LST $root.tmp
	1556	file delete -force $root.LST
	1557	}
	1558	catch {file delete -force disagl.inp disagl.out}
	1559	if {[catch {file rename -force $root.OLS $root.LST}]} {
	1560	file copy -force $root.OLS $root.LST
	1561	file delete -force $root.OLS
	1562	}
	1563	donewait
	1564	# open a new window
	1565	catch {toplevel .disagl}
	1566	eval destroy [winfo child .disagl]
	1567	set txt .disagl.txt
	1568	catch {eval grid forget [grid slaves .disagl]}
	1569	text $txt -width 100 -wrap none \
	1570	-yscrollcommand ".disagl.yscroll set" \
	1571	-xscrollcommand ".disagl.xscroll set"
	1572	scrollbar .disagl.yscroll -command "$txt yview"
	1573	scrollbar .disagl.xscroll -command "$txt xview" -orient horizontal
	1574	grid .disagl.xscroll -column 0 -row 2 -sticky ew
	1575	grid $txt -column 0 -row 1 -sticky nsew
	1576	grid .disagl.yscroll -column 1 -row 1 -sticky ns
	1577	grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
	1578	grid columnconfig .disagl.f 2 -weight 1
	1579	grid [button .disagl.f.close -text "Close & Delete" \
	1580	-command "destroy .disagl; file delete \[list $root.tmp\]"] \
	1581	-column 3 -row 0 -sticky e
	1582	grid [button .disagl.f.rename \
	1583	-command "RenameAsFile \[list $root.tmp\] \[list $root.DIS\] .disagl" \
	1584	-text "Close & Save as..."] \
	1585	-column 4 -row 0 -sticky e
	1586	# allow font changes on the fly
	1587	if {$tcl_version >= 8.0} {
	1588	$txt config -font $txtvw(font)
	1589	set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
	1590	grid .disagl.f.font -column 1 -row 0 -sticky w
	1591	grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
	1592	$fontbut delete 0 end
	1593	foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
	1594	$fontbut add command -label "Courier $f" -font "Courier $f"\
	1595	-command "set txtvw(font) \"Courier $f\"; \
	1596	$txt config -font \$txtvw(font)"
	1597	}
	1598	}
	1599
	1600	grid columnconfigure .disagl 0 -weight 1
	1601	grid rowconfigure .disagl 1 -weight 1
	1602	wm title .disagl "DISAGL results $expgui(expfile)"
	1603	wm iconname .disagl "DISAGL $root"
	1604	set in [open $root.tmp r]
	1605	$txt insert end [read $in]
	1606	close $in
	1607	bind all {destroy .disagl}
	1608	bind .disagl "$txt yview scroll -1 page"
	1609	bind .disagl "$txt yview scroll 1 page"
	1610	bind .disagl "$txt xview scroll 1 unit"
	1611	bind .disagl "$txt xview scroll -1 unit"
	1612	bind .disagl "$txt yview scroll -1 unit"
	1613	bind .disagl "$txt yview scroll 1 unit"
	1614	bind .disagl "$txt yview 0"
	1615	bind .disagl "$txt yview end"
	1616	# don't disable in Win as this prevents the highlighting of selected text
	1617	if {$tcl_platform(platform) != "windows"} {
	1618	$txt config -state disabled
	1619	}
	1620	# find the beginning of the disagl text
	1621
	1622	set pos 1.0
	1623	set nph 0
	1624	while {[set loc [$txt search "Program DISAGL Version" $pos end]] != ""} {
	1625	set pos [expr {$loc + 1}]
	1626	incr nph
	1627	}
	1628	#puts "Found $nph DISAGL run(s)"
	1629	# count phases
	1630	set l {}
	1631	while {[set loc [$txt search "Lattice constants are" $pos end]] != ""} {
	1632	lappend l $loc
	1633	set pos [expr {$loc + 1}]
	1634	}
	1635	catch {unset phaseloc}
	1636
	1637	set j 0
	1638	foreach pos $l {
	1639	if {$j == 0} {
	1640	set prev $pos
	1641	incr j
	1642	continue
	1643	}
	1644	set phaseloc($j) [list $prev $pos]
	1645	incr j
	1646	}
	1647	set phaseloc($j) [list $pos end]
	1648	if {$nph >= 1 && $j >= 2} {
	1649	grid [menubutton .disagl.f.copy \
	1650	-menu .disagl.f.copy.menu \
	1651	-text "Copy phase..." -bd 2 -relief raised] \
	1652	-column 2 -row 0 -sticky nse
	1653	menu .disagl.f.copy.menu
	1654	for {set i 1} {$i <= $j} {incr i} {
	1655	.disagl.f.copy.menu add command \
	1656	-command "seldisaglphase $txt [list $phaseloc($i)]" \
	1657	-label "Copy phase $i to clipboard"
	1658	}
	1659	} elseif {$nph >= 1} {
	1660	grid [button .disagl.f.copy \
	1661	-command "seldisaglphase $txt [list $phaseloc($j)]" \
	1662	-text "Copy phase $j to clipboard"] \
	1663	-column 2 -row 0 -sticky e
	1664	}
	1665	} else {
	1666	runGSASwEXP disagl
	1667	}
	1668	}
	1669
	1670	proc seldisaglphase {txt phaselist} {
	1671	# clear selection
	1672	$txt tag remove sel 1.1 end
	1673	eval $txt tag add sel $phaselist
	1674	clipboard clear
	1675	clipboard append " \| Program DISAGL Version MacOSX \|\n"
	1676	clipboard append [eval $txt get [$txt tag ranges sel]]
	1677	}
	1678	#------------------------------------------------------------------------------
	1679	# file conversions
	1680	#------------------------------------------------------------------------------
	1681	proc convfile {} {
	1682	global expgui
	1683	set frm .file
	1684	catch {destroy $frm}
	1685	toplevel $frm
	1686	wm title $frm "Convert File"
	1687	bind $frm <Key-F1> "MakeWWWHelp expgui.html ConvertWin"
	1688	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
	1689	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 \
	1690	-side left -fill y -expand yes
	1691	pack [button $frmC.help -text Help -bg yellow \
	1692	-command "MakeWWWHelp expgui.html ConvertWin"] -side top
	1693	pack [button $frmC.q -text Cancel -command "destroy $frm"] -side bottom
	1694	pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
	1695	-side bottom
	1696	pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
	1697	winfilebox $frm
	1698	bind $frm <Return> "ValidWinCnv $frm"
	1699
	1700	# force the window to stay on top
	1701	putontop $frm
	1702	focus $frmC.q
	1703	tkwait window $frm
	1704	afterputontop
	1705	}
	1706
	1707	# validate the files and make the conversion
	1708	proc ValidWinCnv {frm} {
	1709	global expgui
	1710	# change backslashes to something sensible
	1711	regsub -all {\\} $expgui(FileMenuCnvName) / expgui(FileMenuCnvName)
	1712	# allow entry of D: for D:/ and D:TEST for d:/TEST
	1713	if {[string first : $expgui(FileMenuCnvName)] != -1 && \
	1714	[string first :/ $expgui(FileMenuCnvName)] == -1} {
	1715	regsub : $expgui(FileMenuCnvName) :/ expgui(FileMenuCnvName)
	1716	}
	1717	if {$expgui(FileMenuCnvName) == "<Parent>"} {
	1718	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
	1719	ChooseWinCnv $frm
	1720	return
	1721	} elseif [file isdirectory \
	1722	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
	1723	if {$expgui(FileMenuCnvName) != "."} {
	1724	set expgui(FileMenuDir) \
	1725	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
	1726	}
	1727	ChooseWinCnv $frm
	1728	return
	1729	}
	1730
	1731	set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
	1732	if ![file exists $file] {
	1733	MyMessageBox -parent $frm -title "Convert Error" \
	1734	-message "File $file does not exist" -icon error
	1735	return
	1736	}
	1737
	1738	set tmpname "[file join [file dirname $file] tempfile.xxx]"
	1739	set oldname "[file rootname $file].org"
	1740	if [file exists $oldname] {
	1741	set ans [MyMessageBox -parent . -title "Overwrite?" \
	1742	-message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
	1743	-icon warning -type {Overwrite Cancel} -default Overwrite \
	1744	-helplink "expguierr.html OverwriteCnv"]
	1745	if {[string tolower $ans] == "cancel"} return
	1746	catch {file delete $oldname}
	1747	}
	1748
	1749	if [catch {
	1750	set in [open $file r]
	1751	set out [open $tmpname w]
	1752	fconfigure $out -translation crlf -encoding ascii
	1753	set len [gets $in line]
	1754	if {$len > 160} {
	1755	# this is a UNIX file. Hope there are no control characters
	1756	set i 0
	1757	set j 79
	1758	while {$j < $len} {
	1759	puts $out [string range $line $i $j]
	1760	incr i 80
	1761	incr j 80
	1762	}
	1763	} else {
	1764	while {$len >= 0} {
	1765	append line " "
	1766	append line " "
	1767	set line [string range $line 0 79]
	1768	puts $out $line
	1769	set len [gets $in line]
	1770	}
	1771	}
	1772	close $in
	1773	close $out
	1774	file rename -force $file $oldname
	1775	file rename -force $tmpname $file
	1776	} errmsg] {
	1777	MyMessageBox -parent $frm -title "Conversion error" \
	1778	-message "Error in conversion:\n$errmsg" -icon warning
	1779	} else {
	1780	set ans [MyMessageBox -parent $frm -title "More?" \
	1781	-message "File [file tail $file] converted.\n(Original saved as [file tail $oldname]).\n\n Convert more files?" \
	1782	-type yesno -default no]
	1783	if {$ans == "no"} {destroy $frm}
	1784	}
	1785	}
	1786
	1787	# create a file box
	1788	proc winfilebox {frm} {
	1789	global expgui
	1790	set bx $frm.1
	1791	pack [frame $bx.top] -side top
	1792	pack [label $bx.top.a -text "Directory" ] -side left
	1793	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
	1794	pack $bx.top.d -side left
	1795	set expgui(FileMenuDir) [pwd]
	1796	# the icon below is from tk8.0/tkfbox.tcl
	1797	set upfolder [image create bitmap -data {
	1798	#define updir_width 28
	1799	#define updir_height 16
	1800	static char updir_bits[] = {
	1801	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
	1802	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
	1803	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
	1804	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
	1805	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
	1806	0xf0, 0xff, 0xff, 0x01};}]
	1807
	1808	pack [button $bx.top.b -image $upfolder \
	1809	-command "updir; ChooseWinCnv $frm" ]
	1810	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
	1811	listbox $bx.a.files -relief raised -bd 2 \
	1812	-yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
	1813	-height 15 -width 0 -exportselection 0
	1814	listbox $bx.a.dates -relief raised -bd 2 \
	1815	-yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
	1816	-height 15 -width 0 -takefocus 0 -exportselection 0
	1817	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
	1818	ChooseWinCnv $frm
	1819	bind $bx.a.files <ButtonRelease-1> "ReleaseWinCnv $frm"
	1820	bind $bx.a.dates <ButtonRelease-1> "ReleaseWinCnv $frm"
	1821	bind $bx.a.files <Double-1> "SelectWinCnv $frm"
	1822	bind $bx.a.dates <Double-1> "SelectWinCnv $frm"
	1823	pack $bx.a.scroll -side left -fill y
	1824	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
	1825	pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
	1826	}
	1827
	1828	# set the box or file in the selection window
	1829	proc ReleaseWinCnv {frm} {
	1830	global expgui
	1831	set files $frm.1.a.files
	1832	set dates $frm.1.a.dates
	1833	set select [$files curselection]
	1834	if {$select == ""} {
	1835	set select [$dates curselection]
	1836	}
	1837	if {$select == ""} {
	1838	set expgui(FileMenuCnvName) ""
	1839	} else {
	1840	set expgui(FileMenuCnvName) [string trim [$files get $select]]
	1841	}
	1842	if {$expgui(FileMenuCnvName) == "<Parent>"} {
	1843	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
	1844	ChooseWinCnv $frm
	1845	} elseif [file isdirectory \
	1846	[file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
	1847	if {$expgui(FileMenuCnvName) != "."} {
	1848	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
	1849	ChooseWinCnv $frm
	1850	}
	1851	}
	1852	return
	1853	}
	1854
	1855	# select a file or directory -- called on double click
	1856	proc SelectWinCnv {frm} {
	1857	global expgui
	1858	set files $frm.1.a.files
	1859	set dates $frm.1.a.dates
	1860	set select [$files curselection]
	1861	if {$select == ""} {
	1862	set select [$dates curselection]
	1863	}
	1864	if {$select == ""} {
	1865	set file .
	1866	} else {
	1867	set file [string trim [$files get $select]]
	1868	}
	1869	if {$file == "<Parent>"} {
	1870	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
	1871	ChooseWinCnv $frm
	1872	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
	1873	if {$file != "."} {
	1874	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
	1875	ChooseWinCnv $frm
	1876	}
	1877	} else {
	1878	set expgui(FileMenuCnvName) [file tail $file]
	1879	ValidWinCnv $frm
	1880	}
	1881	}
	1882
	1883	# fill the files & dates & Directory selection box with current directory,
	1884	# also called when box is created to fill it
	1885	proc ChooseWinCnv {frm} {
	1886	global expgui
	1887	set files $frm.1.a.files
	1888	set dates $frm.1.a.dates
	1889	set expgui(FileMenuCnvName) {}
	1890	$files delete 0 end
	1891	$dates delete 0 end
	1892	$files insert end {<Parent>}
	1893	$dates insert end {(Directory)}
	1894	set filelist [glob -nocomplain \
	1895	[file join [set expgui(FileMenuDir)] *] ]
	1896	foreach file [lsort -dictionary $filelist] {
	1897	if {[file isdirectory $file]} {
	1898	$files insert end [file tail $file]
	1899	$dates insert end {(Directory)}
	1900	}
	1901	}
	1902	foreach file [lsort -dictionary $filelist] {
	1903	if {![file isdirectory $file]} {
	1904	set modified [clock format [file mtime $file] -format "%T %D"]
	1905	$files insert end [file tail $file]
	1906	$dates insert end $modified
	1907	}
	1908	}
	1909	$expgui(FileDirButtonMenu) delete 0 end
	1910	set list ""
	1911	global tcl_version
	1912	if {$tcl_version > 8.0} {
	1913	catch {set list [string tolower [file volume]]}
	1914	}
	1915	set dir ""
	1916	foreach subdir [file split [set expgui(FileMenuDir)]] {
	1917	set dir [string tolower [file join $dir $subdir]]
	1918	if {[lsearch $list $dir] == -1} {lappend list $dir}
	1919	}
	1920	foreach path $list {
	1921	$expgui(FileDirButtonMenu) add command -label $path \
	1922	-command "[list set expgui(FileMenuDir) $path]; \
	1923	ChooseWinCnv $frm"
	1924	}
	1925	return
	1926	}
	1927
	1928	#------------------------------------------------------------------------------
	1929	# set options for liveplot
	1930	proc liveplotopt {} {
	1931	global liveplot expmap
	1932	set frm .file
	1933	catch {destroy $frm}
	1934	toplevel $frm
	1935	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
	1936	set last [lindex [lsort -integer $expmap(powderlist)] end]
	1937	if {$last == ""} {set last 1}
	1938	pack [scale $frmA.1 -label "Histogram number" -from 1 -to $last \
	1939	-length 150 -orient horizontal -variable liveplot(hst)] -side top
	1940	pack [checkbutton $frmA.2 -text {include plot legend}\
	1941	-variable liveplot(legend)] -side top
	1942	pack [button $frm.2 -text OK \
	1943	-command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
	1944	] -side top
	1945	bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
	1946
	1947	# force the window to stay on top
	1948	putontop $frm
	1949	focus $frm.2
	1950	tkwait window $frm
	1951	afterputontop
	1952	}
	1953
	1954	#------------------------------------------------------------------------------
	1955	# get/validate an experiment file name
	1956	#------------------------------------------------------------------------------
	1957	# validate and store the EXP file name. Create a new .EXP file if it does not
	1958	# exist and set the wd to the location of the .EXP file.
	1959	proc SetEXPfile {expfile "newOK 0"} {
	1960	global expgui tcl_platform
	1961	set expgui(expfile) {}
	1962	if {[string trim $expfile] == ""} return
	1963
	1964	# break up the file name and directory
	1965	set dirname [file dirname $expfile]
	1966	set expname [string toupper [file tail $expfile]]
	1967
	1968	# check the directory exists
	1969	if {(! [file exists $dirname]) \|\| (! [file isdir $dirname])} {
	1970	update
	1971	MyMessageBox -parent . -title "Directory not found" \
	1972	-message "Experiment file location \"$dirname\" is invalid -- no such directory exists" \
	1973	-icon warning -type Continue -default continue
	1974	set expgui(resize) 1
	1975	return
	1976	}
	1977
	1978	# is there a space in the directory name? On windows, try to fix it
	1979	set origdir $dirname
	1980	if {[string first " " $dirname] != -1} {
	1981	set warn 1
	1982	catch {set warn $expgui(warnonspaceonce)}
	1983	if {$tcl_platform(platform) == "windows"} {
	1984	set dirname [file attributes $dirname -shortname]
	1985	# was the fix successful?
	1986	if {[string first " " $dirname] == -1} {
	1987	if {$warn} {
	1988	update
	1989	MyMessageBox -parent . -title "Still debugging..." \
	1990	-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." \
	1991	-icon warning -type Continue -default continue
	1992	set expgui(resize) 1
	1993	}
	1994	} else {
	1995	if {$warn} {
	1996	update
	1997	MyMessageBox -parent . -title "Can't fix dir" \
	1998	-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." \
	1999	-icon warning -type Continue -default continue
	2000	set expgui(resize) 1
	2001	}
	2002	}
	2003	} elseif {$warn} {
	2004	if {$warn} {
	2005	update
	2006	MyMessageBox -parent . -title "Still debugging..." \
	2007	-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." \
	2008	-icon warning -type Continue -default continue
	2009	set expgui(resize) 1
	2010	}
	2011	}
	2012	set expgui(warnonspaceonce) 0
	2013	}
	2014
	2015	# force exp files to be upper case, set to force save if name changes
	2016	set origexp $expname
	2017	if {$expname != [string toupper $expfile]} {
	2018	set expname [string toupper [file tail $expfile]]
	2019	if {$tcl_platform(platform) != "windows"} {set expgui(changed) 1}
	2020	}
	2021	if {[file extension $expname] != ".EXP"} {
	2022	append expname ".EXP"
	2023	}
	2024	if {$dirname == "."} {
	2025	set newexpfile $expname
	2026	} else {
	2027	set newexpfile [file join $dirname $expname]
	2028	}
	2029	# is there a space in the EXP name?
	2030	if {[string first " " $expname] != -1} {
	2031	# If the file exists in windows, see if there is an equivalent name available.
	2032	# if not, we could try to create it and then see, but that is too much
	2033	# work.
	2034	if {$tcl_platform(platform) == "windows"} {
	2035	if {[file exists $newexpfile]} {
	2036	# try to translate it, if possible
	2037	set expname [file tail [file attributes $newexpfile -shortname]]
	2038	set newexpfile [file join $dirname $expname]
	2039	# fixed?
	2040	if {[string first " " $expname] == -1} {
	2041	set warn 1
	2042	catch {set warn $expgui(warnonexpspaceonce)}
	2043	if {$warn} {
	2044	update
	2045	MyMessageBox -parent . -title "Still debugging..." \
	2046	-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." \
	2047	-icon warning -type Continue -default continue
	2048	set expgui(resize) 1
	2049	}
	2050	set expgui(warnonexpspaceonce) 0
	2051	}
	2052	}
	2053	if {[string first " " $expname] != -1} {
	2054	# not fixed (file does not exist or shortname not supported)
	2055	update
	2056	MyMessageBox -parent . -title "Can't fix name" \
	2057	-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." \
	2058	-icon warning -type Continue -default continue
	2059	set expgui(resize) 1
	2060	return
	2061	}
	2062	} else {
	2063	update
	2064	MyMessageBox -parent . -title "Space in name" \
	2065	-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." \
	2066	-icon warning -type Continue -default continue
	2067	set expgui(resize) 1
	2068	return
	2069	}
	2070	}
	2071
	2072	if {(! $newOK) && (! [file exists $newexpfile])} {
	2073	update
	2074	set ans [
	2075	MyMessageBox -parent . -title "File Open Error" \
	2076	-message "File $expname does not exist in ${dirname}. OK to create?" \
	2077	-icon question -type {"Select other" "Create"} -default "select other" \
	2078	-helplink "expguierr.html OpenErr"
	2079	]
	2080	set expgui(resize) 1
	2081	if {[string tolower $ans] == "create"} {
	2082	# you've been warned this .EXP does not exist!
	2083	# create an "empty" exp file
	2084	createexp $newexpfile \
	2085	[getstring "title for experiment $expname" 60 0]
	2086	if {! [file exists [file join $dirname $expname]]} {
	2087	update
	2088	MyMessageBox -parent . -title "File Creation Error" \
	2089	-message "Experiment file name \"$expname\" was not created -- This is unexpected, please try a different name" \
	2090	-icon warning -type Continue -default continue
	2091	set expgui(resize) 1
	2092	return
	2093	}
	2094	} else {
	2095	return
	2096	}
	2097	}
	2098	set expgui(expfile) $newexpfile
	2099	catch {cd [string trim [file dirname $expgui(expfile)]]}
	2100	}
	2101
	2102	proc getExpFileName {mode} {
	2103	global expgui tcl_platform
	2104	set frm .file
	2105	catch {destroy $frm}
	2106	toplevel $frm
	2107	wm title $frm "Experiment file"
	2108	bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
	2109	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
	2110	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
	2111	-fill y -expand yes
	2112	pack [button $frmC.help -text Help -bg yellow \
	2113	-command "MakeWWWHelp expguierr.html open"] \
	2114	-side top -anchor e
	2115	pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
	2116	pack [radiobutton $frmC.1 -text "File Name" -value 1 \
	2117	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
	2118	pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
	2119	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
	2120
	2121	set expgui(includearchived) 0
	2122	set expgui(FileInfoBox) $frmC.info
	2123	if {$mode == "old"} {
	2124	pack [checkbutton $frmC.ar -text "Include Archived Files" \
	2125	-variable expgui(includearchived) \
	2126	-command "ChooseExpFil $frmA"] -side top -pady 10
	2127	pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
	2128	-class SmallFont] \
	2129	-side top -fill both -expand yes -pady 5
	2130	} elseif {$mode != "new"} {
	2131	# for initial read, don't access archived files
	2132	pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
	2133	-class SmallFont] \
	2134	-side top -fill both -expand yes -pady 5
	2135	set mode "old"
	2136	}
	2137	pack [button $frmC.b -text Read \
	2138	-command "valid_exp_file $frmA $mode"] -side bottom
	2139	if {$mode == "new"} {
	2140	$frmC.b config -text Save
	2141	}
	2142	pack [button $frmC.q -text Cancel \
	2143	-command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
	2144	bind $frm <Return> "$frmC.b invoke"
	2145
	2146	if {$mode == "new"} {
	2147	pack [label $frmA.0 -text "Enter an experiment file to create"] \
	2148	-side top -anchor center
	2149	} else {
	2150	pack [label $frmA.0 -text "Select an experiment file to read"] \
	2151	-side top -anchor center
	2152	}
	2153	expfilebox $frmA $mode
	2154	# force the window to stay on top
	2155	putontop $frm
	2156	focus $frmC.b
	2157	tkwait window $frm
	2158	afterputontop
	2159	if {$expgui(FileMenuEXPNAM) == ""} return
	2160	# is there a space in the EXP name?
	2161	# if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} {
	2162	# update
	2163	# MyMessageBox -parent . -title "File Name Error" \
	2164	# -message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI can#not process experiment files with spaces in the name" \
	2165	# -icon warning -type Continue -default continue
	2166	# -helplink "expguierr.html OpenErr"
	2167	# return
	2168	# }
	2169	# if {[string first " " $expgui(FileMenuDir)] != -1} {
	2170	# set warn 1
	2171	# catch {set warn $expgui(warnonexpdirspace)}
	2172	# if $warn {
	2173	# update
	2174	# MyMessageBox -parent . -title "Good luck..." \
	2175	# -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." \
	2176	# -icon warning -type Continue -default continue
	2177	# # -helplink "expguierr.html OpenErr"
	2178	# set expgui(warnonexpdirspace) 0
	2179	# }
	2180	# }
	2181	return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	2182	}
	2183
	2184	# validation routine
	2185	proc valid_exp_file {frm mode} {
	2186	global expgui tcl_platform
	2187	# windows fixes
	2188	if {$tcl_platform(platform) == "windows"} {
	2189	# change backslashes to something sensible
	2190	regsub -all {\\} $expgui(FileMenuEXPNAM) / expgui(FileMenuEXPNAM)
	2191	# allow entry of D: for D:/ and D:TEST for d:/TEST
	2192	if {[string first : $expgui(FileMenuEXPNAM)] != -1 && \
	2193	[string first :/ $expgui(FileMenuEXPNAM)] == -1} {
	2194	regsub : $expgui(FileMenuEXPNAM) :/ expgui(FileMenuEXPNAM)
	2195	}
	2196	}
	2197	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
	2198	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
	2199	ChooseExpFil $frm
	2200	return
	2201	} elseif [file isdirectory \
	2202	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
	2203	if {$expgui(FileMenuEXPNAM) != "."} {
	2204	set expgui(FileMenuDir) \
	2205	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	2206	}
	2207	ChooseExpFil $frm
	2208	return
	2209	}
	2210	# append a .EXP if not present
	2211	if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
	2212	append expgui(FileMenuEXPNAM) ".EXP"
	2213	}
	2214	# is there a space in the name?
	2215	# if {[string first " " $expgui(FileMenuEXPNAM)] != -1} {
	2216	# MyMessageBox -parent . -title "File Name Error" \
	2217	# -message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
	2218	# -icon warning -type Continue -default continue
	2219	# -helplink "expguierr.html OpenErr"
	2220	# return
	2221	# }
	2222	# check for archive files
	2223	if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \
	2224	$mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
	2225	destroy .file
	2226	return
	2227	} elseif {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
	2228	# check for files that end in something other than .EXP .exp or .Exp...
	2229	MyMessageBox -parent . -title "File Open Error" \
	2230	-message "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
	2231	-icon error
	2232	return
	2233	}
	2234	# check on the file status
	2235	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	2236	if {$mode == "new" && [file exists $file]} {
	2237	set ans [
	2238	MyMessageBox -parent . -title "File Open Error" \
	2239	-message "File [file tail $file] already exists in [file dirname $file]. OK to overwrite?" \
	2240	-icon question -type {"Select other" "Overwrite"} -default "select other" \
	2241	-helplink "expguierr.html OverwriteErr"
	2242	]
	2243	if {[string tolower $ans] == "overwrite"} {destroy .file}
	2244	return
	2245	}
	2246	# if file does not exist in case provided, set the name to all
	2247	# upper case letters, since that is the best choice.
	2248	# if it does exist, read from it as is. For UNIX we will force uppercase later.
	2249	if {![file exists $file]} {
	2250	set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
	2251	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	2252	}
	2253	if {$mode == "old" && ![file exists $file]} {
	2254	set ans [
	2255	MyMessageBox -parent . -title "File Open Error" \
	2256	-message "File [file tail $file] does not exist in [file dirname $file]. OK to create?" \
	2257	-icon question -type {"Select other" "Create"} -default "select other" \
	2258	-helplink "expguierr.html OpenErr"
	2259	]
	2260	if {[string tolower $ans] == "create"} {destroy .file}
	2261	return
	2262	}
	2263	destroy .file
	2264	}
	2265
	2266	proc updir {} {
	2267	global expgui
	2268	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
	2269	}
	2270
	2271	# create a file box
	2272	proc expfilebox {bx mode} {
	2273	global expgui
	2274	pack [frame $bx.top] -side top
	2275	pack [label $bx.top.a -text "Directory" ] -side left
	2276	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
	2277	pack $bx.top.d -side left
	2278	set expgui(FileMenuDir) [pwd]
	2279	# the icon below is from tk8.0/tkfbox.tcl
	2280	set upfolder [image create bitmap -data {
	2281	#define updir_width 28
	2282	#define updir_height 16
	2283	static char updir_bits[] = {
	2284	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
	2285	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
	2286	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
	2287	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
	2288	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
	2289	0xf0, 0xff, 0xff, 0x01};}]
	2290
	2291	pack [button $bx.top.b -image $upfolder \
	2292	-command "updir; ChooseExpFil $bx" ]
	2293	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
	2294	listbox $bx.a.files -relief raised -bd 2 \
	2295	-yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
	2296	-height 15 -width 0 -exportselection 0
	2297	listbox $bx.a.dates -relief raised -bd 2 \
	2298	-yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
	2299	-height 15 -width 0 -takefocus 0 -exportselection 0
	2300	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
	2301	ChooseExpFil $bx
	2302	bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
	2303	bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
	2304	bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
	2305	bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
	2306	pack $bx.a.scroll -side left -fill y
	2307	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
	2308	pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
	2309	}
[1034]	2310	proc sync2boxesX {master slave scroll args} {
	2311	$slave xview moveto [lindex [$master xview] 0]
	2312	eval $scroll set $args
	2313	}
	2314	proc move2boxesX {boxlist args} {
	2315	foreach listbox $boxlist {
	2316	eval $listbox xview $args
	2317	}
	2318	}
[1025]	2319	proc sync2boxesY {master slave scroll args} {
	2320	$slave yview moveto [lindex [$master yview] 0]
	2321	eval $scroll set $args
	2322	}
	2323	proc move2boxesY {boxlist args} {
	2324	foreach listbox $boxlist {
	2325	eval $listbox yview $args
	2326	}
	2327	}
	2328
	2329	# creates a table that is scrollable in both x and y, use ResizeScrollTable
	2330	# to set sizes after gridding the widgets
	2331	proc MakeScrollTable {box} {
	2332	proc sync2boxes {cmd master slave scroll args} {
	2333	$slave $cmd moveto [lindex [$master $cmd] 0]
	2334	eval $scroll set $args
	2335	}
	2336	proc move2boxes {cmd box1 box2 args} {
	2337	eval $box1 $cmd $args
	2338	eval $box2 $cmd $args
	2339	}
	2340	grid [label $box.0] -column 0 -row 0
	2341	grid [canvas $box.top -scrollregion {0 0 10 10} \
	2342	-xscrollcommand "sync2boxes xview $box.top $box.can $box.scroll" \
	2343	-width 10 -height 10] -sticky sew -row 0 -column 1
	2344	grid [canvas $box.side -scrollregion {0 0 10 10} \
	2345	-yscrollcommand "sync2boxes yview $box.side $box.can $box.yscroll" \
	2346	-width 10 -height 10] -sticky nes -row 1 -column 0
	2347	grid [canvas $box.can -scrollregion {0 0 10 10} \
	2348	-yscrollcommand "sync2boxes yview $box.can $box.side $box.yscroll" \
	2349	-xscrollcommand "sync2boxes xview $box.can $box.top $box.scroll" \
	2350	-width 200 -height 200 -bg lightgrey] -sticky news -row 1 -column 1
	2351	grid [set sxbox [scrollbar $box.scroll -orient horizontal \
	2352	-command "move2boxes xview $box.can $box.top"]] \
	2353	-sticky ew -row 2 -column 1
	2354	grid [set sybox [scrollbar $box.yscroll \
	2355	-command "move2boxes yview $box.can $box.side"]] \
	2356	-sticky ns -row 1 -column 2
	2357
	2358	$box.top create window 0 0 -anchor nw -window [frame $box.top.f -bd 0]
	2359	$box.can create window 0 0 -anchor nw -window [frame $box.can.f -bd 2]
	2360	$box.side create window 0 0 -anchor nw -window [frame $box.side.f -bd 2]
	2361	grid columnconfig $box 1 -weight 1
	2362	grid rowconfig $box 1 -weight 1
	2363	return [list $box.top.f $box.can.f $box.side.f $box.0]
	2364	}
	2365
	2366	proc ResizeScrollTable {box} {
	2367	update idletasks
	2368	for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} {
	2369	set x1 [lindex [grid bbox $box.can.f $i 0] 2]
	2370	set x2 [lindex [grid bbox $box.top.f $i 0] 2]
	2371	if {$x2 > $x1} {set x1 $x2}
	2372	grid columnconfigure $box.top.f $i -minsize $x1
	2373	grid columnconfigure $box.can.f $i -minsize $x1
	2374	}
	2375	for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} {
	2376	set x1 [lindex [grid bbox $box.can.f 0 $i] 3]
	2377	set x2 [lindex [grid bbox $box.side.f 0 $i] 3]
	2378	if {$x2 > $x1} {set x1 $x2}
	2379	grid rowconfigure $box.can.f $i -minsize $x1
	2380	grid rowconfigure $box.side.f $i -minsize $x1
	2381	}
	2382	update idletasks
	2383	set sizes [grid bbox $box.can.f]
	2384	$box.can config -scrollregion $sizes
	2385	$box.side config -scrollregion $sizes
	2386	$box.top config -scrollregion $sizes
	2387	$box.side config -width [lindex [grid bbox $box.side.f] 2]
	2388	$box.top config -height [lindex [grid bbox $box.top.f] 3]
	2389	# remove the scroll when not needed
	2390	if {[lindex $sizes 3] > [winfo height $box.can]} {
	2391	grid $box.yscroll -sticky ns -column 2 -row 1
	2392	} else {
	2393	grid forget $box.yscroll
	2394	}
	2395	if {[lindex $sizes 2] > [winfo width $box.can]} {
	2396	grid $box.scroll -sticky ew -column 1 -row 2
	2397	} else {
	2398	grid forget $box.scroll
	2399	}
	2400	}
	2401
	2402	proc MouseWheelScrollTable {box} {
	2403	# causes mouse wheel to operate scroll for main canvas in ScrollTable
	2404	# mousewheel can be operated anywhere in parent window
	2405	bind [winfo toplevel $box] <MouseWheel> "$box.can yview scroll \[expr {-abs(%D)/%D}\] unit"
	2406	}
	2407
	2408
	2409	# this is used in cifselect -- not sure why anymore
	2410	proc ExpandScrollTable {box} {
	2411	# set height & width of central box
	2412	$box.can config -width \
	2413	[expr [winfo width [winfo toplevel $box]] \
	2414	- [winfo width $box.side] - [winfo width $box.yscroll]-20]
	2415	$box.can config -height \
	2416	[expr [winfo height [winfo toplevel $box]] \
	2417	- [winfo height $box.top] - [winfo height $box.scroll]-25]
	2418	}
	2419
	2420
	2421	# support routine for SetHistUseFlags
	2422	proc InitHistUseFlags {} {
	2423	global expmap expgui
	2424	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
	2425	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
	2426	set expgui(useflag_$i) [histinfo $i use]
	2427	# }
	2428	}
	2429	}
	2430
	2431	# show all Powder histograms; set use/do not use flags
	2432	proc SetHistUseFlags {} {
	2433	set box .test
	2434	catch {toplevel $box}
	2435	eval destroy [winfo children $box]
	2436	grid [label $box.0 -text "Set histogram \"Use/Do Not Use\" flags" -bg white] -row 0 -column 0 -columnspan 2
	2437	grid [frame $box.a] -row 1 -column 0 -columnspan 2
	2438	grid [button $box.b -text Save -command "destroy $box"] -row 2 -column 0 -sticky e
	2439	grid [button $box.c -text Cancel -command "InitHistUseFlags;destroy $box"] -row 2 -column 1 -sticky w
	2440	grid columnconfig $box 0 -weight 1
	2441	grid columnconfig $box 1 -weight 1
	2442	foreach a [MakeScrollTable $box.a] b {tbox bbox sbox cbox} {set $b $a}
	2443	$cbox config -text "Use\nFlag"
	2444	[winfo parent $bbox] config -height 250 -width 400
	2445	global expmap expgui
	2446	set px 5
	2447	set row -1
	2448	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
	2449	if {[string range $expmap(htype_$i) 2 2] == "T"} {
	2450	set det [format %8.2f [histinfo $i tofangle]]
	2451	} elseif {[string range $expmap(htype_$i) 2 2] == "C"} {
	2452	set det [format %8.5f [histinfo $i lam1]]
	2453	} elseif {[string range $expmap(htype_$i) 2 2] == "E"} {
	2454	set det [format %8.2f [histinfo $i lam1]]
	2455	} else {
	2456	set det {}
	2457	}
	2458	incr row
	2459	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
	2460	grid [checkbutton $sbox.$i -text $i -variable expgui(useflag_$i)] -row $row -column 0
	2461	set expgui(useflag_$i) [histinfo $i use]
	2462	# }
	2463	grid [label $bbox.0$i \
	2464	-text [string range $expmap(htype_$i) 0 3] \
	2465	] -row $row -column 0 -padx $px
	2466	grid [label $bbox.1$i -text [histinfo $i bank] \
	2467	] -row $row -column 1 -padx $px
	2468	grid [label $bbox.2$i -text $det] -row $row -column 2 -padx $px
	2469	grid [label $bbox.3$i -text [string range [histinfo $i title] 0 66] \
	2470	] -row $row -column 3 -padx $px -sticky ew
	2471	}
	2472	grid [label $tbox.0 -text type -bd 2 -relief raised] -row 0 -column 0 -padx $px
	2473	grid [label $tbox.1 -text bank -bd 2 -relief raised] -row 0 -column 1 -padx $px
	2474	grid [label $tbox.2 -text "ang/wave" -bd 2 -relief raised] -row 0 -column 2 -padx $px
	2475	grid [label $tbox.3 -text "histogram title" -bd 2 -relief raised] -row 0 -column 3 -sticky w -padx $px
	2476	ResizeScrollTable $box.a
	2477	InitHistUseFlags
	2478	putontop $box
	2479	tkwait window $box
	2480	afterputontop
	2481	set prevchages $expgui(changed)
	2482	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
	2483	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
	2484	if {$expgui(useflag_$i) != [histinfo $i use]} {
	2485	histinfo $i use set $expgui(useflag_$i)
	2486	RecordMacroEntry "histinfo $i use set $expgui(useflag_$i)" 0
	2487	incr expgui(changed)
	2488	RecordMacroEntry "incr expgui(changed)" 0
	2489	}
	2490	# }
	2491	}
	2492	if {$prevchages != $expgui(changed)} {
	2493	set msg "You have changed [expr $expgui(changed)-$prevchages] "
	2494	append msg "histogram flag(s). You must run POWPREF "
	2495	append msg "to include/remove these histograms. Do you want to "
	2496	append msg "run POWPREF?"
	2497	set ans [MyMessageBox -parent . -message $msg \
	2498	-title "Process changes?"\
	2499	-helplink "expguierr.html ProcessUse" \
	2500	-default {Run POWPREF} \
	2501	-type {{Run POWPREF} Skip}]
	2502
	2503	if {$ans == "skip"} {
	2504	# save and reload the experiment file
	2505	savearchiveexp
	2506	loadexp $expgui(expfile)
	2507	} else {
	2508	# run powpref and force a reload
	2509	set saveautoload $expgui(autoexpload)
	2510	set expgui(autoexpload) 1
	2511	runGSASwEXP powpref
	2512	set expgui(autoexpload) $saveautoload
	2513	}
	2514	}
	2515	}
	2516
	2517	# set the box or file in the selection window
	2518	proc ReleaseExpFil {frm} {
	2519	global expgui
	2520	set files $frm.a.files
	2521	set dates $frm.a.dates
	2522	set select [$files curselection]
	2523	if {$select == ""} {
	2524	set select [$dates curselection]
	2525	}
	2526	if {$select == ""} {
	2527	set expgui(FileMenuEXPNAM) ""
	2528	} else {
	2529	set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
	2530	after idle UpdateInfoBox
	2531	}
	2532	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
	2533	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
	2534	ChooseExpFil $frm
	2535	} elseif [file isdirectory \
	2536	[file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
	2537	if {$expgui(FileMenuEXPNAM) != "."} {
	2538	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	2539	ChooseExpFil $frm
	2540	}
	2541	}
	2542	return
	2543	}
	2544	proc UpdateInfoBox {} {
	2545	global expgui
	2546	if {![winfo exists $expgui(FileInfoBox)]} return
	2547	eval destroy [winfo children $expgui(FileInfoBox)]
	2548	set file [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]
	2549	if [file isdirectory $file] return
	2550	if [file exists $file] {
	2551	pack [label $expgui(FileInfoBox).1 -text $expgui(FileMenuEXPNAM)] \
	2552	-side top
	2553	catch {
	2554	set fp [open $file r]
	2555	global testline
	2556	set testline [read $fp]
	2557	close $fp
	2558	update
	2559	regexp {GNLS RUN on (.) +Total.run *([0-9]+) } \
	2560	$testline a last cycles
	2561	pack [label $expgui(FileInfoBox).2 -justify left \
	2562	-text "last GENLES run:\n $last\n total cycles: $cycles"] \
	2563	-side top -anchor w
	2564	regexp {REFN GDNFT.= ([0-9]\.[0-9]) +for *([0-9]+) variables} \
	2565	$testline a chi2 vars
	2566	pack [frame $expgui(FileInfoBox).3 -class SmallFont] \
	2567	-side top -anchor w
	2568	pack [label $expgui(FileInfoBox).3.a -justify left \
	2569	-text "c" -font symbol] \
	2570	-side left -anchor w
	2571	pack [label $expgui(FileInfoBox).3.b -justify left \
	2572	-text "2: $chi2, $vars vars"] \
	2573	-side top -anchor w
	2574	# check first 9 histograms
	2575	set lbl "h Rwp R(F2)"
	2576	set n 0
	2577	foreach k {1 2 3 4 5 6 7 8 9} {
	2578	set key "HST $k"
	2579	append key { RPOWD +([0-9]\.[0-9]) }
	2580	set i [regexp $key $testline a Rwp]
	2581	set key "HST $k"
	2582	append key { R-FAC +[0-9]+ +([0-9]\.[0-9]) }
	2583	set j [regexp $key $testline a Rb]
	2584	if {$i \|\| $j} {
	2585	incr n
	2586	append lbl "\n$k "
	2587	if {$i} {
	2588	append lbl [string range $Rwp 0 5]
	2589	} else {
	2590	append lbl " "
	2591	}
	2592	}
	2593	if {$j} {
	2594	append lbl " [string range $Rb 0 5]"
	2595	}
	2596	# stick 1st 3 entries in box
	2597	if {$n >= 3} break
	2598	}
	2599	pack [label $expgui(FileInfoBox).4 -justify left \
	2600	-text $lbl] \
	2601	-side top -anchor w
	2602	}
	2603	}
	2604	}
	2605
	2606	# select a file or directory -- called on double click
	2607	proc SelectExpFil {frm mode} {
	2608	global expgui
	2609	set files $frm.a.files
	2610	set dates $frm.a.dates
	2611	set select [$files curselection]
	2612	if {$select == ""} {
	2613	set select [$dates curselection]
	2614	}
	2615	if {$select == ""} {
	2616	set file .
	2617	} else {
	2618	set file [string trim [$files get $select]]
	2619	}
	2620	if {$file == "<Parent>"} {
	2621	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
	2622	ChooseExpFil $frm
	2623	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
	2624	if {$file != "."} {
	2625	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
	2626	ChooseExpFil $frm
	2627	}
	2628	} else {
	2629	set expgui(FileMenuEXPNAM) [file tail $file]
	2630	valid_exp_file $frm $mode
	2631	}
	2632	}
	2633
	2634	# fill the files & dates & Directory selection box with current directory,
	2635	# also called when box is created to fill it
	2636	proc ChooseExpFil {frm} {
	2637	global expgui
	2638	set files $frm.a.files
	2639	set dates $frm.a.dates
	2640	set expgui(FileMenuEXPNAM) {}
	2641	$files delete 0 end
	2642	$dates delete 0 end
	2643	$files insert end {<Parent>}
	2644	$dates insert end {(Directory)}
	2645	set filelist [glob -nocomplain \
	2646	[file join [set expgui(FileMenuDir)] *] ]
	2647	foreach file [lsort -dictionary $filelist] {
	2648	if {[file isdirectory $file]} {
	2649	$files insert end [file tail $file]
	2650	$dates insert end {(Directory)}
	2651	}
	2652	}
	2653	set pairlist {}
	2654	foreach file [lsort -dictionary $filelist] {
	2655	if {![file isdirectory $file] && \
	2656	[string toupper [file extension $file]] == ".EXP"} {
	2657	set modified [file mtime $file]
	2658	lappend pairlist [list $file $modified]
	2659	} elseif {![file isdirectory $file] && $expgui(includearchived) && \
	2660	[string match {*.O[0-9A-F][0-9A-F]} $file]} {
	2661	set modified [file mtime $file]
	2662	lappend pairlist [list $file $modified]
	2663	}
	2664	}
	2665	if {$expgui(filesort) == 0} {
	2666	foreach pair [lsort -index 1 -integer -decreasing $pairlist] {
	2667	set file [lindex $pair 0]
	2668	set modified [clock format [lindex $pair 1] -format "%T %D"]
	2669	$files insert end [file tail $file]
	2670	$dates insert end $modified
	2671	}
	2672	} else {
	2673	foreach pair [lsort -dictionary -index 0 $pairlist] {
	2674	set file [lindex $pair 0]
	2675	set modified [clock format [lindex $pair 1] -format "%T %D"]
	2676	$files insert end [file tail $file]
	2677	$dates insert end $modified
	2678	}
	2679	}
	2680	$expgui(FileDirButtonMenu) delete 0 end
	2681	set list ""
	2682	global tcl_platform tcl_version
	2683	if {$tcl_platform(platform) == "windows" && $tcl_version > 8.0} {
	2684	catch {set list [string tolower [file volume]]}
	2685	}
	2686	set dir ""
	2687	foreach subdir [file split [set expgui(FileMenuDir)]] {
	2688	set dir [file join $dir $subdir]
	2689	if {$tcl_platform(platform) == "windows"} {
	2690	set dir [string tolower $dir]
	2691	if {[lsearch $list $dir] == -1} {lappend list $dir}
	2692	} else {
	2693	lappend list $dir
	2694	}
	2695	}
	2696	foreach path $list {
	2697	$expgui(FileDirButtonMenu) add command -label $path \
	2698	-command "[list set expgui(FileMenuDir) $path]; \
	2699	ChooseExpFil $frm"
	2700	}
	2701	# highlight the current experiment -- if present
	2702	for {set i 0} {$i < [$files size]} {incr i} {
	2703	set file [$files get $i]
	2704	if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
	2705	$files selection set $i
	2706	}
	2707	}
	2708	return
	2709	}
	2710
	2711
	2712	#------------------------------------------------------------------------------
	2713	# platform-specific definitions
	2714	if {$tcl_platform(platform) == "windows" && $tcl_platform(os) == "Windows 95"} {
	2715	# windows-95, -98 and presumably -me do not allow Tcl/Tk to run the
	2716	# DOS box synchronously, so we create a "lock" file that is deleted
	2717	# at the end of the DOS run so we can tell when the run is done.
	2718	# We create a window to force the deleting of the file so that if
	2719	# the DOS process crashes, the user can continue anyway.
	2720	#
	2721	# procedure to check if the lock file is still there (Win-9x/me only)
	2722	proc checklockfile {file window} {
	2723	if [file exists $file] {
	2724	after 500 checklockfile $file $window
	2725	} else {
	2726	catch {destroy $window}
	2727	}
	2728	}
	2729	# this procedure starts the GRWND program, if needed for program $prog
	2730	proc StartGRWND {prog} {
	2731	global expgui
	2732	if {!$expgui(autoGRWND)} return
	2733	# at some point we might want to have a real list
	2734	if {$prog != "genles" && $prog != "powpref"} {
	2735	# get a list of running jobs
	2736	exec [file join $expgui(scriptdir) win9xbin tlist.exe] > tlist.tlist
	2737	set fp [open tlist.tlist r]
	2738	set text [read $fp]
	2739	close $fp
	2740	file delete -force tlist.tlist
	2741	# if GRWND.EXE is not currently running, start it
	2742	if {[lsearch [string toupper $text] GRWND.EXE] == -1} {
	2743	exec [file join $expgui(gsasexe) grwnd.exe] &
	2744	# give grwnd a 1 second head start
	2745	after 1000
	2746	}
	2747	}
	2748	}
	2749	# this creates a DOS box to run a program in
	2750	proc forknewterm {title command "wait 1" "scrollbar 1"} {
	2751	global env expgui
	2752	# Windows environment variables
	2753	set env(GSAS) [file nativename $expgui(gsasdir)]
	2754	# PGPLOT_FONT is needed by PGPLOT
	2755	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
	2756	# this is the number of lines/page in the .LST (etc.) file
	2757	set env(LENPAGE) 60
	2758	set pwd [file nativename [pwd]]
	2759
	2760	# check the .EXP path -- can DOS use it?
	2761	if {[string first // [pwd]] != -1} {
	2762	MyMessageBox -parent . -title "Invalid Path" \
	2763	-message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
	2764	-icon error -type ok -default ok \
	2765	-helplink "expgui_Win_readme.html NetPath"
	2766	return
	2767	}
	2768	if {[info command winutils::shell] == "" && \
	2769	[info command winexec] == ""} {
	2770	MyMessageBox -parent . -title "Setup error" \
	2771	-message {Error -- Use "Neither WINEXEC not WINTILS were found. Can't do anything!"} \
	2772	-icon error -type darn -default darn \
	2773	-helplink "expgui_Win_readme.html Winexec"
	2774	return
	2775	}
	2776	# loop over multiple commands
	2777	foreach cmd $command {
	2778	# simulate the wait with a lock file
	2779	if {$wait} {
	2780	if {$expgui(autoiconify)} {wm iconify .}
	2781	# create a blank lock file and a message window
	2782	close [open expgui.lck w]
	2783	toplevel .lock
	2784	grid [button .lock.0 -text Help -bg yellow \
	2785	-command "MakeWWWHelp expguierr.html lock"] \
	2786	-column 1 -row 0
	2787	grid [label .lock.1 \
	2788	-text "Please wait while the GSAS program finishes."] \
	2789	-column 0 -row 0
	2790	grid [label .lock.2 -text \
	2791	"In case a problem occurs, close the DOS box"] \
	2792	-column 0 -columnspan 2 -row 1
	2793	grid [label .lock.3 -text \
	2794	"and press the \"Continue\" button (below)"] \
	2795	-column 0 -columnspan 2 -row 2
	2796	grid [button .lock.b -text "Continue" \
	2797	-command "destroy .lock; wm deiconify ."] \
	2798	-column 0 -columnspan 2 -row 3
	2799	putontop .lock
	2800	update
	2801	checklockfile expgui.lck .lock
	2802	}
	2803
	2804	# pause is hard coded in the GSASTCL.BAT file
	2805	if {$expgui(execprompt)} {
	2806	set script gsastcl.bat
	2807	} else {
	2808	set script gsasnowt.bat
	2809	}
	2810
	2811	# replace the forward slashes with backward
	2812	regsub -all / $cmd \\ cmd
	2813	if {[info command winutils::shell] != ""} {
	2814	winutils::shell [file join $expgui(scriptdir) $script] $cmd
	2815	} else {
	2816	winexec -d [file nativename [pwd]] \
	2817	[file join $expgui(scriptdir) $script] $cmd
	2818	}
	2819	if {$expgui(MacroRunning)} {
	2820	update
	2821	update idletasks
	2822	}
	2823	if {$wait} {
	2824	tkwait window .lock
	2825	file delete -force expgui.lck
	2826	}
	2827	}
	2828	if {$expgui(autoiconify) && $wait} {wm deiconify .}
	2829	# check for changes in the .EXP file immediately
	2830	whenidle
	2831	}
	2832	} elseif {$tcl_platform(platform) == "windows"} {
	2833	# now for Windows-NT, where we can run synchronously
	2834	#
	2835	# this creates a DOS box to run a program in
	2836	proc forknewterm {title command "wait 1" "scrollbar 1"} {
	2837	global env expgui
	2838	# Windows environment variables
	2839	set env(GSAS) [file nativename $expgui(gsasdir)]
	2840	# PGPLOT_FONT is needed by PGPLOT
	2841	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
	2842	set env(PGPLOT_DIR) $expgui(pgplotdir)
	2843	# this is the number of lines/page in the .LST (etc.) file
	2844	set env(LENPAGE) 60
	2845	set pwd [file nativename [pwd]]
	2846	# check the path -- can DOS use it?
	2847	if {[string first // [pwd]] != -1} {
	2848	MyMessageBox -parent . -title "Invalid Path" \
	2849	-message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
	2850	-icon error -type ok -default ok \
	2851	-helplink "expgui_Win_readme.html NetPath"
	2852	return
	2853	}
	2854	# pause is hard coded in the .BAT file
	2855	if {$expgui(execprompt)} {
	2856	set script gsastcl.bat
	2857	} else {
	2858	set script gsasnowt.bat
	2859	}
	2860
	2861	if {$wait} {
	2862	if {$expgui(autoiconify)} {wm iconify .}
	2863	# create a blank lock file (keep liveplot from running)
	2864	close [open expgui.lck w]
	2865	# loop over commands
	2866	foreach cmd $command {
	2867	# replace the forward slashes with backward
	2868	regsub -all / $cmd \\ cmd
	2869	# use of file attributes -shortname & normalize and nativename
	2870	# might help here
	2871	exec $env(COMSPEC) /c \
	2872	"start [file attributes [file join $expgui(scriptdir) $script] -shortname] $cmd"
	2873	}
	2874	file delete -force expgui.lck
	2875	if {$expgui(autoiconify)} {wm deiconify .}
	2876	# check for changes in the .EXP file immediately
	2877	whenidle
	2878	} else {
	2879	# loop over commands
	2880	foreach cmd $command {
	2881	# replace the forward slashes with backward
	2882	regsub -all / $cmd \\ cmd
	2883	# run in background
	2884	exec $env(COMSPEC) /c \
	2885	"start [file attributes [file join $expgui(scriptdir) $script] -shortname] $cmd"
	2886	if {$expgui(MacroRunning)} {
	2887	update
	2888	update idletasks
	2889	}
	2890	}
	2891	}
	2892	}
	2893	} else {
	2894	# UNIX-based machines
	2895	if {[auto_execok xterm] != ""} {
	2896	# this creates a xterm window for running programs inside
	2897	proc forknewterm {title command "wait 1" "scrollbar 1"} {
	2898	global env expgui
	2899	# UNIX environment variables
	2900	set env(GSAS) [file nativename $expgui(gsasdir)]
	2901	set env(gsas) [file nativename $expgui(gsasdir)]
	2902	set env(GSASEXE) $expgui(gsasexe)
	2903	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
	2904	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
	2905	# PGPLOT_DIR is needed by PGPLOT
	2906	set env(PGPLOT_DIR) $expgui(pgplotdir)
	2907	# this is the number of lines/page in the .LST (etc.) file
	2908	set env(LENPAGE) 60
	2909	set termopts {}
	2910	if $env(GSASBACKSPACE) {
	2911	append termopts \
	2912	{-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"}
	2913	}
	2914	if $scrollbar {
	2915	append termopts " -sb"
	2916	} else {
	2917	append termopts " +sb"
	2918	}
	2919	if {$wait} {
	2920	set suffix {}
	2921	} else {
	2922	set suffix {&}
	2923	}
	2924
	2925	# hold window open after commands finish
	2926	if {$expgui(execprompt)} {
	2927	append command "\; echo -n Press Enter to continue \; read x"
	2928	}
	2929	if {$wait && $expgui(autoiconify)} {wm iconify .}
	2930	catch {eval exec xterm $termopts -title [list $title] \
	2931	-e /bin/sh -c [list $command] $suffix} errmsg
	2932	if $expgui(debug) {puts "xterm result = $errmsg"}
	2933	if {$expgui(MacroRunning)} {
	2934	update
	2935	update idletasks
	2936	}
	2937	if {$wait} {
	2938	if {$expgui(autoiconify)} {wm deiconify .}
	2939	# check for changes in the .EXP file immediately
	2940	whenidle
	2941	}
	2942	}
	2943	} elseif {[auto_execok gnome-terminal] != ""} {
	2944	# this creates a xterm window for running programs inside
	2945	proc forknewterm {title command "wait 1" "scrollbar 1"} {
	2946	global env expgui
	2947	# UNIX environment variables
	2948	set env(GSAS) [file nativename $expgui(gsasdir)]
	2949	set env(gsas) [file nativename $expgui(gsasdir)]
	2950	set env(GSASEXE) $expgui(gsasexe)
	2951	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
	2952	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
	2953	# PGPLOT_DIR is needed by PGPLOT
	2954	set env(PGPLOT_DIR) $expgui(pgplotdir)
	2955	# this is the number of lines/page in the .LST (etc.) file
	2956	set env(LENPAGE) 60
	2957	if {$wait} {
	2958	set suffix {}
	2959	} else {
	2960	set suffix {&}
	2961	}
	2962
	2963	# hold window open after commands finish
	2964	if {$expgui(execprompt)} {
	2965	append command "\; echo -n Press Enter to continue \; read x"
	2966	}
	2967	if {$wait && $expgui(autoiconify)} {wm iconify .}
	2968	catch {exec gnome-terminal --title $title \
	2969	-e " /bin/sh -c \" $command \" " $suffix} errmsg
	2970	if $expgui(debug) {puts "gnome-terminal result = $errmsg"}
	2971	if {$expgui(MacroRunning)} {
	2972	update
	2973	update idletasks
	2974	}
	2975	if {$wait} {
	2976	if {$expgui(autoiconify)} {wm deiconify .}
	2977	# check for changes in the .EXP file immediately
	2978	whenidle
	2979	}
	2980	}
	2981	} else {
	2982	MyMessageBox -parent . -title "Error: no terminal program" \
	2983	-message "Error, the xterm or gnome-terminal utility programs could not be found. It is not possible to run the GSAS programs without this." \
	2984	-icon error -type NOT-OK -default not-ok
	2985	}
	2986	}
	2987
	2988	# run commands without a terminal window
	2989	proc runnoterm {command outfile} {
	2990	global env expgui tcl_platform
	2991	if {$tcl_platform(platform) == "windows"} {
	2992	# Windows environment variables
	2993	set env(GSAS) [file nativename $expgui(gsasdir)]
	2994	# PGPLOT_FONT is needed by PGPLOT
	2995	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
	2996	# this is the number of lines/page in the .LST (etc.) file
	2997	set env(LENPAGE) 60
	2998	set pwd [file nativename [pwd]]
	2999	# loop over multiple commands
	3000	foreach cmd $command {
	3001	# replace the forward slashes with backward
	3002	regsub -all / $cmd \\ cmd
	3003	exec $cmd >>& $outfile
	3004	update
	3005	update idletasks
	3006	}
	3007	} else {
	3008	# UNIX environment variables
	3009	set env(GSAS) [file nativename $expgui(gsasdir)]
	3010	set env(gsas) [file nativename $expgui(gsasdir)]
	3011	set env(GSASEXE) $expgui(gsasexe)
	3012	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
	3013	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
	3014	# PGPLOT_DIR is needed by PGPLOT
	3015	set env(PGPLOT_DIR) $expgui(pgplotdir)
	3016	# this is the number of lines/page in the .LST (etc.) file
	3017	set env(LENPAGE) 60
	3018	foreach cmd $command {
	3019	catch {eval exec $cmd >>& $outfile} errmsg
	3020	}
	3021	update
	3022	update idletasks
	3023	}
	3024	# check for changes in the .EXP file immediately
	3025	#whenidle
	3026	}
	3027
	3028	proc MacMakeResource {file app} {
	3029	# make a resource file. Note that OS X has gotten picky about the length of this
	3030	set l [string length $app]
	3031	if $::expgui(debug) {puts "$l bytes"}
	3032	incr l
	3033	if $::expgui(debug) {puts "$l bytes after incr"}
	3034	set str "data 'usro' (0) {\n"
	3035	append str " $\""
	3036	append str [format %.8X $l]
	3037	set bytes 4
	3038	foreach char [split $app {}] {
	3039	append str [format %.2X [scan $char %c]]
	3040	}
	3041	incr bytes $l
	3042	set newline 1
	3043	for {set i 0} {$i < [expr 1028-$bytes]} {incr i} {
	3044	if $newline {
	3045	append str "\" \n"
	3046	append str " $\""
	3047	set newline 0
	3048	set j 0
	3049	}
	3050	append str {0000 }
	3051	incr bytes
	3052	incr j 2
	3053	if {$j > 15} {set newline 1}
	3054	}
	3055	if {$l % 2} {
	3056	append str "\"\n "
	3057	} else {
	3058	# even lengths need one more byte
	3059	append str "00\"\n "
	3060	}
	3061	append str "/* $app */\n};\n"
	3062	set fp [open $file w]
	3063	puts $fp $str
	3064	close $fp
	3065	}
	3066
	3067	# modify resource fork info for a .EXP file on the Mac
	3068	proc MacSetResourceFork {expfile} {
	3069	global expgui tcl_platform
	3070	if {$tcl_platform(os) != "Darwin"} {return}
	3071	set expnative [file nativename $expfile]
	3072	#
	3073	# assign an app to the data file, if the app and the
	3074	# required tool (Rez) are installed
	3075	set app [file nativename [file join $expgui(gsasdir) expgui.app]]
	3076	set RezApp {}
	3077	foreach pth "/usr/bin /Developer/Tools $expgui(gsasexe)" {
	3078	if [file exists [set tst [file join $pth Rez]]] {
	3079	set RezApp $tst
	3080	break
	3081	}
	3082	}
	3083	set SetFileApp {}
	3084	foreach pth "/usr/bin /Developer/Tools $expgui(gsasexe)" {
	3085	if [file exists [set tst [file join $pth SetFile]]] {
	3086	set SetFileApp $tst
	3087	break
	3088	}
	3089	}
	3090	if $::expgui(debug) {puts "found app=$app Rez=$RezApp and SetFile=$SetFileApp"}
	3091	if {[file exists $app] && $RezApp != ""} {
	3092	# make resource file
	3093	MacMakeResource setapp.r $app
	3094	if $::expgui(debug) {puts "$RezApp setapp.r -o $expnative -a"}
	3095	exec $RezApp setapp.r -o $expnative -a
	3096	if {! $::expgui(debug)} {
	3097	file delete -force setapp.r
	3098	}
	3099	}
	3100
	3101	# assign an icon to the data file, if it and the required tools exist
	3102	set icon [file join $expgui(gsasexe) gsasicon.r]
	3103	if {[file exists $icon] && $RezApp != "" && $SetFileApp != ""} {
	3104	exec $RezApp [file nativename $icon] -o $expnative -a
	3105	exec $SetFileApp -a C $expnative
	3106	if {$::expgui(debug)} {
	3107	puts "$RezApp [file nativename $icon] -o $expnative -a"
	3108	puts "$SetFileApp -a C $expnative"
	3109	}
	3110	} elseif {$::expgui(debug)} {
	3111	puts "icon=$icon missing?"
	3112	}
	3113	}
	3114
	3115	#-------------------------------------------------------------------------------
	3116	# Macro Recording
	3117	#-------------------------------------------------------------------------------
	3118	set expgui(MacroBufferedCommand) ""
	3119	set expgui(fpMacroFile) ""
	3120	set expgui(MacroFile) ""
	3121	# Turn on/off mode to save commands in MacroFile
	3122	proc SetRecordMacroOnOff {args} {
	3123	global expgui
	3124	if {$expgui(RecordMacro)} {
	3125	set expgui(fpMacroFile) ""
	3126	set expgui(MacroBufferedCommand) ""
	3127	while {$expgui(fpMacroFile) == ""} {
	3128	set expgui(MacroFile) [tk_getSaveFile -initialdir [pwd] \
	3129	-parent . \
	3130	-filetypes {{"EXPGUI Macro file" .expmac}} \
	3131	-defaultextension .expmac \
	3132	-initialfile EXPGUI.expmac \
	3133	-title "Choose location to save macro"]
	3134	if {$expgui(MacroFile) == ""} {
	3135	# respond to cancel
	3136	set expgui(fpMacroFile) ""
	3137	set expgui(MacroFile) ""
	3138	set expgui(RecordMacro) 0
	3139	return
	3140	}
	3141	if {[catch {
	3142	set expgui(fpMacroFile) [open $expgui(MacroFile) w]
	3143	puts $expgui(fpMacroFile) "# [clock format [clock seconds] -format %Y-%m-%dT%T]"
	3144	} errmsg]} {
	3145	MyMessageBox -parent . -title "Error opening selected file" \
	3146	-message "Error opening macro file:\n$errmsg" \
	3147	-icon warning -type TryAgain -default tryagain
	3148	catch {close $expgui(fpMacroFile)}
	3149	set expgui(fpMacroFile) ""
	3150	set expgui(MacroFile) ""
	3151	set expgui(RecordMacro) 0
	3152	}
	3153	}
	3154	} else {
	3155	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
	3156	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
	3157	}
	3158	catch {close $expgui(fpMacroFile)}
	3159	set expgui(fpMacroFile) ""
	3160	set expgui(MacroFile) ""
	3161	set expgui(MacroBufferedCommand) ""
	3162	}
	3163	}
	3164
	3165	# record a command in the Macro File
	3166	proc RecordMacroEntry {command buffer} {
	3167	global expgui
	3168	if {! $expgui(RecordMacro)} return
	3169	# in buffered mode: hold the last command in memory and compare to the
	3170	# next. If two commands differ only in the final argument, then the
	3171	# second command makes the previous redundant so only the latter version
	3172	# is retained (This will happen when a user types a string into a box).
	3173	# When the commands differ, then the previous is written to file
	3174	# and the next is retained in memory.
	3175	if {$buffer} {
	3176	if {[string trim $expgui(MacroBufferedCommand)] == ""} {
	3177	set expgui(MacroBufferedCommand) $command
	3178	return
	3179	}
	3180	set diff 0
	3181	# is command a repeat of previous?
	3182	foreach a $command b $expgui(MacroBufferedCommand) {
	3183	if {$diff} {
	3184	# found a difference, other than in the last arg
	3185	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
	3186	break
	3187	}
	3188	if {$a != $b} {set diff 1}
	3189	}
	3190	set expgui(MacroBufferedCommand) $command
	3191	} else {
	3192	# no buffering on current command; write the old and new to file.
	3193	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
	3194	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
	3195	}
	3196	puts $expgui(fpMacroFile) $command
	3197	set expgui(MacroBufferedCommand) ""
	3198	}
	3199	}
	3200
	3201	proc CantRecordMacroEntry {comment} {
	3202	global expgui
	3203	if {! $expgui(RecordMacro)} return
	3204
	3205	# no buffering on current command; write the old and new to file.
	3206	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
	3207	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
	3208	}
	3209	puts $expgui(fpMacroFile) "# unrecorded: $comment"
	3210	set expgui(MacroBufferedCommand) ""
	3211	MyMessageBox -parent . -title "No command record" \
	3212	-message "EXPGUI is not able to record this action in the macro file: $comment" \
	3213	-icon warning
	3214	}
	3215
	3216
	3217	# Play back commands in Macro File
	3218	proc ReplayMacroFile {"lineatatime 0"} {
	3219	global expgui
	3220	set expnam [file root [file tail $expgui(expfile)]]
	3221	file delete abort_${expnam}_macro.flag
	3222	set expgui(MacroRunning) 0
	3223	set MacroFile [tk_getOpenFile -initialdir [pwd] \
	3224	-parent . \
	3225	-filetypes {{"EXPGUI Macro file" .expmac} {Everything .*}} \
	3226	-defaultextension .expmac \
	3227	-title "Choose location to read macro"]
	3228	if {$MacroFile == ""} return
	3229	set expgui(MacroRunning) 1
	3230	if {$lineatatime} {
	3231	set expgui(MacroChanged) 0
	3232	set top1 .macro
	3233	catch {destroy $top1}
	3234	toplevel $top1
	3235	set txt $top1.t
	3236	grid [text $txt -width 30 -height 20 -yscrollcommand "$top1.s set"] \
	3237	-column 0 -row 0 -sticky news
	3238	wm title $top1 "File $MacroFile"
	3239	grid [scrollbar $top1.s -command "$txt yview"] \
	3240	-column 1 -row 0 -sticky ns
	3241	grid [frame $top1.b] -column 0 -columnspan 2 -row 1 -sticky ew
	3242	grid columnconfig $top1 0 -weight 1
	3243	grid rowconfig $top1 0 -weight 1
	3244	grid [button $top1.b.e -text "Execute line" \
	3245	-command "MacroExecuteCurrentLine $txt"] \
	3246	-column 0 -row 0 -sticky w
	3247	grid columnconfig $top1.b 1 -weight 1
	3248	grid [button $top1.b.s -text "Save As" -state disabled \
	3249	-command "MacroResave $txt"] -column 1 -row 0
	3250	set expgui(MacroSaveButton) $top1.b.s
	3251	grid [button $top1.b.c -text "Close " \
	3252	-command "MacroCloseWindow $txt"] -column 2 -row 0
	3253	$txt delete 0.0 end
	3254	set fp [open $MacroFile r]
	3255	$txt insert 0.0 [read $fp]
	3256	close $fp
	3257	MacroHighlightText $txt 1
	3258	# deal with editing in the box
	3259	$txt configure -undo 1
	3260	$txt edit modified 0
	3261	bind $txt <<Modified>> {
	3262	$expgui(MacroSaveButton) configure -state normal
	3263	set expgui(MacroChanged) 1
	3264	}
	3265	} else {
	3266	close [open running_${expnam}_macro.flag w]
	3267	set saveprompt $expgui(execprompt)
	3268	set saveautold $expgui(autoexpload)
	3269	set expgui(execprompt) 0
	3270	set expgui(autoexpload) 1
	3271	set expnam [file root [file tail $expgui(expfile)]]
	3272	if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
	3273	set outfile ${expnam}_macout.LST
	3274	# create an empty file
	3275	catch {file delete $outfile}
	3276	close [open $outfile w]
	3277	# view it with LSTVIEW
	3278	set outfile ${expnam}_macout
	3279	exec $::wishshell [file join $expgui(scriptdir) lstview] $outfile &
	3280	} else {
	3281	# show status, offer abort with MACROMON
	3282	exec $::wishshell [file join $expgui(scriptdir) macromon] $expnam &
	3283	}
	3284
	3285	set expgui(MacroStatus) "starting script"
	3286	pleasewait "\nrunning macro\n\nStatus:" expgui(MacroStatus)
	3287
	3288	if {[catch {
	3289	source $MacroFile
	3290	} errmsg]} {
	3291	set txt $::errorInfo
	3292	catch {
	3293	set fp [open error.txt a]
	3294	puts $fp "# [clock format [clock seconds] -format %Y-%m-%dT%T]"
	3295	puts $fp $txt
	3296	close $fp
	3297	}
	3298	donewait
	3299	MyMessageBox -parent . -title "Error running Macro file" \
	3300	-message "Error running macro file:\n$errmsg\n(details in file error.txt)" \
	3301	-icon error -type OK -default ok
	3302	} else {
	3303	donewait
	3304	}
	3305	file delete running_${expnam}_macro.flag
	3306	set expgui(execprompt) $saveprompt
	3307	set expgui(autoexpload) $saveautold
	3308	set expgui(MacroRunning) 0
	3309	# show changes
	3310	PaintEXPGUIpages
	3311	# put comment in output file
	3312	if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
	3313	set outfile ${expnam}_macout.LST
	3314	set fp [open $outfile a]
	3315	puts $fp "\n** Macro ended **"
	3316	close $fp
	3317	}
	3318	}
	3319	}
	3320
	3321	# highlight a line in the Macro file display
	3322	proc MacroHighlightText {txt line} {
	3323	$txt tag delete next
	3324	$txt tag add next $line.0 $line.end
	3325	$txt see $line.0
	3326	$txt tag configure next -background yellow
	3327	# tag all text
	3328	$txt tag delete all
	3329	$txt tag add all 0.0 end
	3330	# double-click moves the current line
	3331	$txt tag bind all <Double-1> "after idle [list MacroDoubleClick $txt]"
	3332	}
	3333
	3334	# respond to a double click by moving the next line to be executed to
	3335	# the line where the double click occurred
	3336	proc MacroDoubleClick {txt} {
	3337	set line [lindex [split [$txt tag ranges sel] "."] 0]
	3338	MacroHighlightText $txt $line
	3339	}
	3340
	3341	# respond to Execute button: execute the current line
	3342	# close window after last command
	3343	proc MacroExecuteCurrentLine {txt} {
	3344	global expgui
	3345	set linenum [lindex [split [$txt tag ranges next] "."] 0]
	3346	if {$linenum == ""} {return}
	3347	set line [$txt get $linenum.0 $linenum.end]
	3348	# is this continued (ends with \)?
	3349	while {[string range $line end end] == "\\" } {
	3350	incr linenum
	3351	# get rid of trailing backslash
	3352	set line [string range $line 0 end-1]
	3353	#append next line
	3354	append line [$txt get $linenum.0 $linenum.end]
	3355	}
	3356	if {[catch $line errmsg]} {
	3357	MyMessageBox -parent $txt -title "Error on line" \
	3358	-message "Error on line $linenum:\n$errmsg" \
	3359	-icon warning -type Continue -default continue
	3360	}
	3361	# show changes
	3362	PaintEXPGUIpages
	3363	# move forward in macrofile
	3364	incr linenum
	3365	MacroHighlightText $txt $linenum
	3366	set linenum [lindex [split [$txt tag ranges next] "."] 0]
	3367	# at end?
	3368	if {$linenum == ""} {MacroCloseWindow $txt}
	3369	}
	3370
	3371	# Save a modified macro file
	3372	proc MacroResave {txt} {
	3373	global expgui
	3374	set MacroFile [tk_getSaveFile -initialdir [pwd] \
	3375	-parent $txt \
	3376	-filetypes {{"EXPGUI Macro file" .expmac}} \
	3377	-defaultextension .expmac \
	3378	-initialfile $expgui(MacroFile) \
	3379	-title "Choose location to save macro"]
	3380	if {[string trim $MacroFile] == ""} {return}
	3381	if {[catch {
	3382	set fp [open $MacroFile w]
	3383	puts $fp [string trim [$txt get 0.0 end]]
	3384	close $fp
	3385	} errmsg]} {
	3386	MyMessageBox -parent $txt -title "Error writing to file" \
	3387	-message "Error writing macro file:\n$errmsg" \
	3388	-icon warning -type TryAgain -default tryagain
	3389	return
	3390	}
	3391	set expgui(MacroChanged) 0
	3392	# gray out the button
	3393	$expgui(MacroSaveButton) configure -state disabled
	3394	}
	3395
	3396	# close the window, but provide a chance to save the file first, if modified
	3397	proc MacroCloseWindow {txt} {
	3398	global expgui
	3399	if {$expgui(MacroChanged)} {
	3400	set ans [MyMessageBox -parent $txt -title "Save macro file?" \
	3401	-message "Macro file has been changed, do you want to save it?" \
	3402	-icon warning -type "Yes No" -default no]
	3403	if {$ans != "no"} {MacroResave $txt}
	3404	}
	3405	set expgui(MacroRunning) 0
	3406	destroy [winfo toplevel $txt]
	3407	}
	3408
	3409	# Add a comment to a macro file
	3410	proc AddCommentMacroFile {} {
	3411	global expgui
	3412	if {! $expgui(RecordMacro)} return
	3413	RecordMacroEntry "# [getstring "comment for macro file"]" 0
	3414	}
	3415
	3416	#------------------------------------------------------------------------------
	3417	# Subversion support routines
	3418	#------------------------------------------------------------------------------
	3419
	3420	proc GetSVNVersion {scriptdir} {
	3421	if {[CheckSVNinstalled]} {
	3422	set SVN [auto_execok svn]
	3423	if {! [catch {set res [eval exec $SVN info [list $scriptdir]]} err]} {
	3424	set infolist [split $res]
	3425	set pos [lsearch $infolist "Revision:"]
	3426	return "GSAS/EXPGUI SVN version [lindex $infolist [incr pos]]"
	3427	}
	3428	}
	3429	return "EXPGUI version: [lindex $::expgui(Revision) 1] ([lindex $::expgui(Revision) 4])"
	3430	}
	3431
	3432	# can we find the svn program?
	3433	proc CheckSVNinstalled {} {
	3434	# can we find svn in the path?
	3435	if {[auto_execok svn] != ""} {return 1}
	3436	# add a locally supplied svn version and add to path
	3437	if {$::tcl_platform(platform) == "windows"} {
	3438	set s [file attributes $::expgui(gsasdir) -shortname]
	3439	} else {
	3440	set s $::expgui(gsasdir)
	3441	}
	3442	# look for svn
	3443	set localsvn [file join $s svn bin]
	3444	if {[file exists $localsvn]} {
	3445	if {$::tcl_platform(platform) == "windows"} {
	3446	set localsvn [file nativename $localsvn]
	3447	set sep {;}
	3448	} else {
	3449	set sep {:}
	3450	}
	3451	if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} {
	3452	append ::env(PATH) $sep $localsvn
	3453	# note that auto_reset breaks the tkcon package in Windows -- not sure why
	3454	auto_reset
	3455	}
	3456	}
	3457	if {[auto_execok svn] != ""} {return 1}
	3458	return 0
	3459	}
	3460
	3461	proc CheckAndDoUpdate { } {
	3462	if {! [CheckSVNinstalled]} {
	3463	MyMessageBox -parent . -title "SVN not found" \
	3464	-message "Unable to upgrade: Could not locate a copy of the subversion program. It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \
	3465	-icon error
	3466	return
	3467	}
	3468	#is there a svn directory in the source?
	3469	if {! [file exists [file join $::expgui(gsasdir) .svn]]} {
	3470	MyMessageBox -parent . -title "No .svn directory" \
	3471	-message "Unable to upgrade: It does not appear that one of self-updating GSAS/EXPGUI releases was installed" \
	3472	-icon error
	3473	return
	3474	}
	3475	# check for updates
	3476	set SVN [auto_execok svn]
	3477	if [catch {set res [eval exec $SVN status [list $::expgui(gsasdir)] -u]} err] {
	3478	set ans [MyMessageBox -parent . -title "Error checking status" \
	3479	-message "Error checking for updates: $err\n\nTry to update manually?" \
	3480	-icon error -type "Yes No" -default yes]
	3481	if {$ans != "no"} {
	3482	forknewterm "manually update in subversion" \
	3483	"$SVN update [file normalize $::expgui(gsasdir)]"
	3484	}
	3485	return
	3486	} else {
	3487	if {[string first "*" $res] == -1} {
	3488	MyMessageBox -parent . -title "No updates" \
	3489	-message "GSAS & EXPGUI appear up-to-date" \
	3490	-icon info
	3491	return
	3492	}
	3493	}
	3494
	3495	if {[MyMessageBox -parent . -title "Ready to Update" \
	3496	-message {
	3497	Updates to GSAS/EXPGUI found on server.
	3498
	3499	Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.} \
	3500	-type {Cancel "Update & Restart"} -default cancel -icon warning
	3501	] == "cancel"} {return}
	3502
	3503	if {[confirmBeforeSave] == "Cancel"} return
	3504
	3505	# special upgrade for windows, where the wish exec blocks upgrade of the exe directory
	3506	if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {
	3507	if {![file exists [file join $::expgui(gsasdir) update.bat]]} {
	3508	MyMessageBox -parent . -title "No update.bat" \
	3509	-message "File update.bat was not found. This should not happen. Will try to create it now."
	3510	set fp [open [file join $::expgui(gsasdir) update.bat] w]
	3511	puts $fp {@REM this script must be run from the GSAS installation directory
	3512	@REM This is run to update the installation, the name of the EXP file is
	3513	@REM expected as an argument
	3514	@echo ****************************
	3515	@echo Press return to start update
	3516	@echo ****************************
	3517	@pause
	3518	.\svn\bin\svn cleanup .
	3519	.\svn\bin\svn update .
	3520	@if (%1)==() goto Install2
	3521	@echo ****************************************************
	3522	@echo Update has completed. Press return to restart EXPGUI
	3523	@echo ****************************************************
	3524	@pause
	3525	%COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui %1"
	3526	exit
	3527	:Install2
	3528	@echo ****************************************************
	3529	@echo Update has completed. EXPGUI starting w/o .EXP file
	3530	@echo ****************************************************
	3531	@pause
	3532	%COMSPEC% /c "start exe\ncnrpack.exe expgui\expgui"
	3533	exit
	3534	}
	3535	close $fp
	3536	}
	3537	# split the directory and EXP file and get rid os spaces in the directory name
	3538	set exp [file normalize $::expgui(expfile)]
	3539	set dir [file attributes [file dirname $exp] -shortname]
	3540	cd $::expgui(gsasdir)
	3541	#run the batch file
	3542	exec $::env(COMSPEC) /c {start .\update.bat [file join $dir [file tail $exp]]} &
	3543	exit
	3544	}
	3545
	3546	# do a quiet cleanup. Sometimes needed after install, and never hurts
	3547	if [catch {set res [eval exec $SVN cleanup [list $::expgui(gsasdir)]]} err] {
	3548	MyMessageBox -parent . -title "Error in cleanup" \
	3549	-message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
	3550	-icon error
	3551	}
	3552	if [catch {set res [exec $SVN up $::expgui(gsasdir)]} err] {
	3553	MyMessageBox -parent . -title "Error updating" \
	3554	-message "Error performing update:\n$err" \
	3555	-icon error
	3556	return
	3557	} else {
	3558	MyMessageBox -parent . -title "Updating done" \
	3559	-message "Results from update:\n$res\n\nPress OK to restart EXPGUI" \
	3560	-icon info
	3561	}
	3562	exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &
	3563	exit
	3564	}

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

Download in other formats: