Context Navigation

source: trunk/gsascmds.tcl @ 992

Last change on this file since 992 was 992, checked in by toby, 15 years ago
changes for POWGEN: profile #<0; use data limits from prm file for TOF
Property svn:keywords set to `Author Date Revision Id`
File size: 113.6 KB

Rev	Line
[83]	1	# $Id: gsascmds.tcl 992 2010-07-29 15:07:52Z toby $
[328]	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 "" "" ""}
[17]	37	}
[328]	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"
[201]	43	}
[328]	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	}
[201]	51
[328]	52	if {![winfo exists $data(-parent)]} {
	53	error "bad window path name \"$data(-parent)\""
	54	}
[17]	55
[328]	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}
[17]	62	}
	63	}
[328]	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	}
[17]	104
[328]	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
[17]	111	}
	112	}
[328]	113	if {!$valid} {
	114	error "invalid default button \"$data(-default)\""
	115	}
[17]	116	}
[328]	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
[325]	125	}
[17]	126
[328]	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 { }
[783]	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	}
[328]	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
[380]	168	option add *Dialog.msg.wrapLength 6i widgetDefault
[328]	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
[17]	173	} else {
[328]	174	option add *Dialog.msg.t.font {Times 18} widgetDefault
[17]	175	}
[328]	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
[17]	190	} else {
[328]	191	option add *Dialog.msg.font {Times 18} widgetDefault
[17]	192	}
[328]	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
[17]	222	#
[328]	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]
[17]	228	}
[328]	229	incr i
[17]	230	}
[328]	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) ""]} {
[749]	236	bind $w <Return> [list $w.[string tolower $data(-default)] invoke]
[328]	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)
[17]	291	}
	292
[328]	293	# tell'em what is happening
[665]	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 ""}} {
[328]	300	catch {destroy .msg}
	301	toplevel .msg
	302	wm transient .msg [winfo toplevel .]
[665]	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	}
[328]	312	wm withdraw .msg
	313	update idletasks
[665]	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]]
[328]	317	if {$x < 0} {set x 0}
[665]	318	set y [expr [winfo y $parent] + [winfo height $parent]/2 - \
	319	[winfo reqheight .msg]/2 - [winfo vrooty $parent]]
[328]	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
[772]	350	proc putontop {w "center 0"} {
[328]	351	# center window $w above its parent and make it stay on top
[783]	352	set wpt [winfo toplevel [set wp [winfo parent $w]]]
	353	if {[winfo viewable $wpt]} {
	354	wm transient $w $wpt
	355	}
[328]	356	wm withdraw $w
	357	update idletasks
[772]	358	if {$center} {
	359	set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
[783]	360	- [winfo vrootx $wpt]}]
[772]	361	set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
[783]	362	- [winfo vrooty $wpt]}]
[772]	363	} else {
	364	# center the new window in the middle of the parent
[783]	365	set x [expr [winfo x $wpt] + [winfo width $wpt]/2 - \
	366	[winfo reqwidth $w]/2 - [winfo vrootx $wpt]]
[772]	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	}
[783]	373	set y [expr [winfo y $wpt] + [winfo height $wpt]/2 - \
	374	[winfo reqheight $w]/2 - [winfo vrooty $wpt]]
[772]	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	}
[328]	381	}
[772]	382	wm geometry $w +$x+$y
[328]	383	wm deiconify $w
	384
	385	global makenew
[783]	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	}
[328]	398	}
	399
[783]	400	# restore focus after putontop has completed
[328]	401	proc afterputontop {} {
	402	global makenew
[783]	403	# reset focus & grab; use new approach for 8.3 & later
	404	if {[info proc ::tk::SetFocusGrab] == ""} {
[328]	405	if {$makenew(OldFocus) != ""} {
[783]	406	catch {focus $makenew(OldFocus)}
[328]	407	}
	408	if {$makenew(OldGrab) != ""} {
[783]	409	catch {grab $makenew(OldGrab)}
[328]	410	}
[783]	411	} else {
	412	catch {::tk::RestoreFocusGrab $makenew(OldGrab) $makenew(OldFocus)}
[328]	413	}
	414	}
	415
[450]	416	proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}" "err 0"} {
[328]	417	catch {destroy $win}
	418	toplevel $win
	419
	420	pack [label $win.l1 -text $labeltext] -side top
[450]	421	if {$err} {$win.l1 config -fg red}
[328]	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
[935]	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
[322]	515	# get a value in a modal dialog
[17]	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
[322]	521	bind $w <Key-F1> "MakeWWWHelp expguierr.html Input[lindex $what 0]"
[17]	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
[322]	533	pack [frame $w.b -bg beige] -side top -fill x -expand yes
[924]	534	pack [button $w.b.2 -text Continue -command "destroy $w"] -side left
[17]	535	if $quit {
[929]	536	pack [button $w.b.3 -text Cancel \
[17]	537	-command "set expgui(temp) {}; destroy $w"] -side left
	538	}
[91]	539	bind $w <Return> "destroy $w"
[322]	540	pack [button $w.b.help -text Help -bg yellow \
	541	-command "MakeWWWHelp expguierr.html Input[lindex $what 0]"] \
	542	-side right
[91]	543
[17]	544	# force the window to stay on top
[91]	545	putontop $w
[17]	546
	547	focus $w.b.2
	548	tkwait window $w
[91]	549	afterputontop
	550
[17]	551	return $expgui(temp)
	552	}
	553
[328]	554	#------------------------------------------------------------------------------
	555	# profile/symmetry routines
	556	#------------------------------------------------------------------------------
	557	# profile terms
	558	array set expgui {
[876]	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	}
[328]	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}
[841]	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 }
[876]	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	}
[328]	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}
[841]	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 }
[876]	586	prof-E-names {Gaussian "Otto pseudo-Voigt"}
[328]	587	prof-E-1 {A B C ds cds}
[841]	588	prof-E-2 {A B C ds cds LX LY ptec stec}
[328]	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} {
[841]	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)
[328]	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"}
[841]	632	4/m {return "S400 S004 S220 S202 S310"}
[328]	633	4/mmm {return "S400 S004 S220 S202"}
[841]	634	3barR {return "S400 S220 S310 S301 S211"}
[328]	635	"3bar mR" {return "S400 S220 S310 S211"}
[841]	636	3bar {return "S400 S004 S202 S310 S211"}
	637	3barm1 {return "S400 S004 S202 S301"}
[328]	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 {
[17]	657	if {$tcl_platform(platform) == "windows"} {
[328]	658	exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
[17]	659	} else {
[328]	660	exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
[17]	661	}
	662	}
[328]	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"
[17]	678	}
	679
[328]	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
[91]	700	}
[328]	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
[17]	713	}
[328]	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	}
[17]	725	}
[328]	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
[929]	749	pack [button $w.d.2 -text Continue \
[841]	750	-command "SaveChangeProfileType $w.c [list $histlist] [list $phaselist]; destroy $w"\
[328]	751	] -side left
[929]	752	pack [button $w.d.3 -text Cancel \
[328]	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
[992]	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]"
[91]	774	}
[328]	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
[17]	784	}
	785
[328]	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)
[910]	791	RecordMacroEntry "hapinfo $hist $phase proftype set $expgui(newpeaktype)" 0
[328]	792	hapinfo $hist $phase profterms set $expgui(newProfileTerms)
[910]	793	RecordMacroEntry "hapinfo $hist $phase profterms set $expgui(newProfileTerms)" 0
[328]	794	for {set i 1} {$i <= $expgui(newProfileTerms)} {incr i} {
	795	hapinfo $hist $phase pterm$i set [$w.ent${i} get]
[910]	796	RecordMacroEntry "hapinfo $hist $phase pterm$i set [$w.ent${i} get]" 0
[328]	797	hapinfo $hist $phase pref$i set $expgui(ProfRef$i)
[910]	798	RecordMacroEntry "hapinfo $hist $phase pref$i set $expgui(ProfRef$i)" 0
[328]	799	}
	800	set i [expr 1+$expgui(newProfileTerms)]
	801	hapinfo $hist $phase pcut set [$w.ent$i get]
[910]	802	RecordMacroEntry "hapinfo $hist $phase pcut set [$w.ent$i get]" 0
[328]	803	incr expgui(changed) [expr 3 + $expgui(newProfileTerms)]
[910]	804	RecordMacroEntry "incr expgui(changed)" 0
[328]	805	}
[17]	806	}
	807
[328]	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	}
[783]	951	if {$::tcl_platform(os) == "Darwin"} {
	952	# on OS X force a window resize
	953	wm geometry [winfo toplevel $w] {}
	954	}
[17]	955	}
	956
[328]	957	#------------------------------------------------------------------------------
	958	# WWW/help routines
	959	#------------------------------------------------------------------------------
	960	# browse a WWW page with URL. The URL may contain a #anchor
[742]	961	# On UNIX assume netscape or mozilla is in the path or env(BROWSER) is loaded.
[328]	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
[749]	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
[328]	974	}
[749]	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)}]} {
[328]	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	}
[749]	997	return
[328]	998	}
[749]	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 ""]
[328]	1015
[749]	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)\"
[328]	1037	open url \"$url\"
	1038	end tell
	1039	"} emsg]
[749]	1040	} then {
	1041	error "Error displaying $url in browser\n$emsg"
	1042	}
[328]	1043	}
[17]	1044	}
	1045
[328]	1046	proc NetHelp {file anchor localloc netloc} {
[749]	1047	# use the file on-line, if it exists
[328]	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)} {
[393]	1068	NetHelp [lindex $item 5] [lindex $item 6] $expgui(docdir) $expgui(website)
[328]	1069	return
	1070	}
	1071	}
	1072	# this should not happen
[393]	1073	NetHelp expgui.html "" $expgui(docdir) $expgui(website)
[328]	1074	} elseif {$topic == "menu"} {
[393]	1075	NetHelp expguic.html "" $expgui(docdir) $expgui(website)
[328]	1076	} else {
[393]	1077	NetHelp $topic $anchor $expgui(docdir) $expgui(website)
[328]	1078	}
	1079	}
	1080
[29]	1081	# show help information
[17]	1082	proc showhelp {} {
	1083	global expgui_helplist helpmsg
	1084	set helpmsg {}
	1085	set frm .help
	1086	catch {destroy $frm}
	1087	toplevel $frm
[322]	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
[17]	1103	set lst [array names expgui_helplist]
[322]	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
[17]	1112	}
[322]	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
[17]	1123	# get the size of the window and expand the message boxes to match
[322]	1124	# update
	1125	# $frm.help config -width [winfo width $frm.help ]
[17]	1126	}
	1127
[328]	1128
	1129	#------------------------------------------------------------------------------
	1130	# utilities
	1131	#------------------------------------------------------------------------------
	1132	# run liveplot
	1133	proc liveplot {} {
[392]	1134	global expgui liveplot wishshell expmap
[328]	1135	set expnam [file root [file tail $expgui(expfile)]]
[392]	1136	# which histograms are ready for use?
	1137	set validlist {}
	1138	foreach ihist $expmap(powderlist) {
[450]	1139	if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" \|\| \
	1140	[string range $expmap(htype_$ihist) 3 3] == "D"} {
[392]	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	}
[328]	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
[542]	1168	proc widplt {"prog widplt"} {
[328]	1169	global expgui wishshell
[542]	1170	exec $wishshell [file join $expgui(scriptdir) $prog] \
[328]	1171	$expgui(expfile) &
	1172	}
	1173
[398]	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) {
[450]	1182	if {[string trim [string range $expmap(htype_$ihist) 3 3]] == "" \|\| \
[398]	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	}
[791]	1200	# Save the current exp file
	1201	savearchiveexp
[910]	1202	CantRecordMacroEntry "bkgedit"
[791]	1203	# disable the file change monitor if we will reload the .EXP file automatically
	1204	if {$expgui(autoexpload)} {set expgui(expModifiedLast) 0}
[398]	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 .}
[791]	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	}
[398]	1217	}
	1218
[431]	1219	# run excledt
[479]	1220	proc excledit {} {
[910]	1221	global expgui liveplot expmap
[431]	1222	set expnam [file root [file tail $expgui(expfile)]]
[479]	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
[431]	1230	}
	1231	}
[479]	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	}
[633]	1238	#if {$expgui(autoiconify)} {wm iconify .}
[479]	1239	StartExcl
[633]	1240	#if {$expgui(autoiconify)} {wm deiconify .}
[431]	1241	}
	1242
[322]	1243	# compute the composition for each phase and display in a dialog
[59]	1244	proc composition {} {
	1245	global expmap expgui
	1246	set Z 1
[130]	1247	foreach phase $expmap(phaselist) type $expmap(phasetype) {
[867]	1248	if {$type == 4} continue
[870]	1249	ResetMultiplicities $phase {}
[59]	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	}
[119]	1263	append text "\nPhase $phase\n"
	1264	append text " Unit cell contents\n"
[59]	1265	foreach type [lsort [array names total]] {
	1266	append text " $type[format %8.3f $total($type)]"
	1267	}
[119]	1268	append text "\n\n"
[130]	1269
[119]	1270	append text " Asymmetric Unit contents (Z=$Z)\n"
[59]	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}
[421]	1278	toplevel .comp -class MonoSpc
[325]	1279	bind .comp <Key-F1> "MakeWWWHelp expgui.html Composition"
[59]	1280	wm title .comp Composition
	1281	pack [label .comp.results -text $text \
[421]	1282	-justify left] -side top
[322]	1283	pack [frame .comp.box] -side top -expand y -fill x
[59]	1284	pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
[322]	1285
[59]	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
[322]	1289	pack [button .comp.box.help -text Help -bg yellow \
[325]	1290	-command "MakeWWWHelp expgui.html Composition"] \
[322]	1291	-side right
[59]	1292	}
	1293
[328]	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
[929]	1316	pack [button $frm.2.4 -text Cancel \
[328]	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	}
[59]	1334
[470]	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
[479]	1341	set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
[470]	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
[701]	1355	file copy -force $expgui(expfile) $file
[485]	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
[470]	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
[742]	1377	exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds] -format {%D %T}]"
[470]	1378	# now save the file
	1379	expwrite $expgui(expfile)
[775]	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	}
[470]	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
[328]	1394	#------------------------------------------------------------------------------
	1395	# GSAS interface routines
	1396	#------------------------------------------------------------------------------
	1397	# run a GSAS program that does not require an experiment file
[360]	1398	proc runGSASprog {proglist "concurrent 1"} {
[910]	1399	# save call to Macro file
	1400	RecordMacroEntry "runGSASprog [list $proglist] $concurrent" 0
[360]	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.
[328]	1403	global expgui tcl_platform
	1404	set cmd {}
	1405	foreach prog $proglist {
[673]	1406	StartGRWND $prog
[328]	1407	if {$tcl_platform(platform) == "windows"} {
	1408	append cmd " \"$expgui(gsasexe)/${prog}.exe \" "
	1409	} else {
	1410	if {$cmd != ""} {append cmd "\;"}
	1411	append cmd "[file join $expgui(gsasexe) $prog]"
	1412	}
	1413	}
[360]	1414	forknewterm $prog $cmd [expr !$concurrent] 1
[328]	1415	}
	1416
[673]	1417	# dummy routine, overridden if needed
	1418	proc StartGRWND {prog} {
	1419	}
	1420
[328]	1421	# run a GSAS program that requires an experiment file for input/output
	1422	proc runGSASwEXP {proglist "concurrent 0"} {
[910]	1423	# save call to Macro file
	1424	RecordMacroEntry "runGSASwEXP [list $proglist] $concurrent" 0
[360]	1425	# most programs that require the .EXP file change it and
	1426	# cannot be run concurrently
[328]	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 {
[673]	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 " \"$expgui(gsasexe)/powpref.exe $expnam \" "
	1451	} else {
	1452	if {$cmd != ""} {append cmd "\;"}
	1453	append cmd "[file join $expgui(gsasexe) powpref] $expnam"
	1454	}
	1455	}
	1456	}
	1457	StartGRWND $prog
[328]	1458	if {$tcl_platform(platform) == "windows"} {
	1459	append cmd " \"$expgui(gsasexe)/${prog}.exe $expnam \" "
[910]	1460	} elseif {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
	1461	append cmd " \" [file join $expgui(gsasexe) $prog] $expnam \" "
[328]	1462	} else {
	1463	if {$cmd != ""} {append cmd "\;"}
	1464	append cmd "[file join $expgui(gsasexe) $prog] $expnam"
	1465	}
	1466	}
[910]	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	}
[328]	1473	# load the changed .EXP file automatically?
	1474	if {$expgui(autoexpload)} {
	1475	# load the revised exp file
	1476	loadexp $expgui(expfile)
	1477	}
[910]	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	}
[328]	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
[485]	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
[701]	1507	if {[catch {
	1508	file rename -force $current $newfile
	1509	}]} {
	1510	file copy -force $current $newfile
	1511	file delete -force $current
	1512	}
[485]	1513	if {$window != ""} {destroy $window}
	1514	}
	1515
[328]	1516	# optionally run disagl as a windowless process, w/results in a separate window
	1517	proc rundisagl {} {
	1518	global expgui txtvw tcl_version tcl_platform
	1519	if {$expgui(disaglSeparateBox)} {
	1520	set root [file root $expgui(expfile)]
	1521	catch {file delete -force $root.tmp}
[701]	1522	if {[catch {file rename -force $root.LST $root.OLS}]} {
	1523	file copy -force $root.LST $root.OLS
	1524	file delete -force $root.OLS
	1525	}
[328]	1526	# PSW reports this does not happen right away on windows
	1527	set i 0
[370]	1528	while {$i < 10 && [file exists $root.LST]} {
[328]	1529	# debug code
[370]	1530	#catch {console show}
	1531	#puts "try $i"
[328]	1532	# end debug code
	1533	after 100
	1534	incr i
	1535	}
[370]	1536	if {[file exists $root.LST]} {
	1537	# it was not possible to rename the file
	1538	MyMessageBox -parent . -title "Rename Problem" \
	1539	-message "Unable to rename $root.LST. Please close LSTVIEW and try again" \
	1540	-icon warning -helplink "expguierr.html NoRename"
	1541	return
	1542	}
	1543
[328]	1544	#run the program
	1545	pleasewait "Running DISAGL"
	1546	# create an empty input file
	1547	close [open disagl.inp w]
	1548	catch {exec [file join $expgui(gsasexe) disagl] \
	1549	[file tail $root] < disagl.inp > disagl.out}
[701]	1550	if {[catch {file rename -force $root.LST $root.tmp}]} {
	1551	file copy -force $root.LST $root.tmp
	1552	file delete -force $root.LST
	1553	}
[328]	1554	catch {file delete -force disagl.inp disagl.out}
[701]	1555	if {[catch {file rename -force $root.OLS $root.LST}]} {
	1556	file copy -force $root.OLS $root.LST
	1557	file delete -force $root.OLS
	1558	}
[328]	1559	donewait
	1560	# open a new window
	1561	catch {toplevel .disagl}
[924]	1562	eval destroy [winfo child .disagl]
	1563	set txt .disagl.txt
[328]	1564	catch {eval grid forget [grid slaves .disagl]}
[924]	1565	text $txt -width 100 -wrap none \
[328]	1566	-yscrollcommand ".disagl.yscroll set" \
	1567	-xscrollcommand ".disagl.xscroll set"
[924]	1568	scrollbar .disagl.yscroll -command "$txt yview"
	1569	scrollbar .disagl.xscroll -command "$txt xview" -orient horizontal
[328]	1570	grid .disagl.xscroll -column 0 -row 2 -sticky ew
[924]	1571	grid $txt -column 0 -row 1 -sticky nsew
[328]	1572	grid .disagl.yscroll -column 1 -row 1 -sticky ns
	1573	grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
	1574	grid columnconfig .disagl.f 2 -weight 1
	1575	grid [button .disagl.f.close -text "Close & Delete" \
	1576	-command "destroy .disagl; file delete $root.tmp"] \
	1577	-column 3 -row 0 -sticky e
[485]	1578	grid [button .disagl.f.rename \
	1579	-command "RenameAsFile $root.tmp $root.DIS .disagl" \
	1580	-text "Close & Save as..."] \
[328]	1581	-column 4 -row 0 -sticky e
	1582	# allow font changes on the fly
	1583	if {$tcl_version >= 8.0} {
[924]	1584	$txt config -font $txtvw(font)
[328]	1585	set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
	1586	grid .disagl.f.font -column 1 -row 0 -sticky w
	1587	grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
	1588	$fontbut delete 0 end
	1589	foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
	1590	$fontbut add command -label "Courier $f" -font "Courier $f"\
	1591	-command "set txtvw(font) \"Courier $f\"; \
[924]	1592	$txt config -font \$txtvw(font)"
[328]	1593	}
	1594	}
	1595
	1596	grid columnconfigure .disagl 0 -weight 1
	1597	grid rowconfigure .disagl 1 -weight 1
	1598	wm title .disagl "DISAGL results $expgui(expfile)"
	1599	wm iconname .disagl "DISAGL $root"
	1600	set in [open $root.tmp r]
[924]	1601	$txt insert end [read $in]
[328]	1602	close $in
	1603	bind all {destroy .disagl}
[924]	1604	bind .disagl "$txt yview scroll -1 page"
	1605	bind .disagl "$txt yview scroll 1 page"
	1606	bind .disagl "$txt xview scroll 1 unit"
	1607	bind .disagl "$txt xview scroll -1 unit"
	1608	bind .disagl "$txt yview scroll -1 unit"
	1609	bind .disagl "$txt yview scroll 1 unit"
	1610	bind .disagl "$txt yview 0"
	1611	bind .disagl "$txt yview end"
[328]	1612	# don't disable in Win as this prevents the highlighting of selected text
	1613	if {$tcl_platform(platform) != "windows"} {
[924]	1614	$txt config -state disabled
[328]	1615	}
[924]	1616	# find the beginning of the disagl text
	1617
	1618	set pos 1.0
	1619	set nph 0
	1620	while {[set loc [$txt search "Program DISAGL Version" $pos end]] != ""} {
	1621	set pos [expr {$loc + 1}]
	1622	incr nph
	1623	}
	1624	#puts "Found $nph DISAGL run(s)"
	1625	# count phases
	1626	set l {}
	1627	while {[set loc [$txt search "Lattice constants are" $pos end]] != ""} {
	1628	lappend l $loc
	1629	set pos [expr {$loc + 1}]
	1630	}
	1631	catch {unset phaseloc}
	1632
	1633	set j 0
	1634	foreach pos $l {
	1635	if {$j == 0} {
	1636	set prev $pos
	1637	incr j
	1638	continue
	1639	}
	1640	set phaseloc($j) [list $prev $pos]
	1641	incr j
	1642	}
	1643	set phaseloc($j) [list $pos end]
	1644	if {$nph >= 1 && $j >= 2} {
	1645	grid [menubutton .disagl.f.copy \
	1646	-menu .disagl.f.copy.menu \
	1647	-text "Copy phase..." -bd 2 -relief raised] \
	1648	-column 2 -row 0 -sticky nse
	1649	menu .disagl.f.copy.menu
	1650	for {set i 1} {$i <= $j} {incr i} {
	1651	.disagl.f.copy.menu add command \
	1652	-command "seldisaglphase $txt [list $phaseloc($i)]" \
	1653	-label "Copy phase $i to clipboard"
	1654	}
	1655	} elseif {$nph >= 1} {
	1656	grid [button .disagl.f.copy \
	1657	-command "seldisaglphase $txt [list $phaseloc($j)]" \
	1658	-text "Copy phase $j to clipboard"] \
	1659	-column 2 -row 0 -sticky e
	1660	}
[328]	1661	} else {
	1662	runGSASwEXP disagl
	1663	}
	1664	}
	1665
[924]	1666	proc seldisaglphase {txt phaselist} {
	1667	# clear selection
	1668	$txt tag remove sel 1.1 end
	1669	eval $txt tag add sel $phaselist
	1670	clipboard clear
	1671	clipboard append " \| Program DISAGL Version MacOSX \|\n"
	1672	clipboard append [eval $txt get [$txt tag ranges sel]]
	1673	}
[328]	1674	#------------------------------------------------------------------------------
[384]	1675	# file conversions
[328]	1676	#------------------------------------------------------------------------------
[17]	1677	proc convfile {} {
[59]	1678	global expgui
[17]	1679	set frm .file
	1680	catch {destroy $frm}
	1681	toplevel $frm
	1682	wm title $frm "Convert File"
[325]	1683	bind $frm <Key-F1> "MakeWWWHelp expgui.html ConvertWin"
[17]	1684	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
[322]	1685	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 \
	1686	-side left -fill y -expand yes
	1687	pack [button $frmC.help -text Help -bg yellow \
[325]	1688	-command "MakeWWWHelp expgui.html ConvertWin"] -side top
[929]	1689	pack [button $frmC.q -text Cancel -command "destroy $frm"] -side bottom
[72]	1690	pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
[322]	1691	-side bottom
[17]	1692	pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
[72]	1693	winfilebox $frm
	1694	bind $frm <Return> "ValidWinCnv $frm"
[17]	1695
[91]	1696	# force the window to stay on top
	1697	putontop $frm
[17]	1698	focus $frmC.q
[59]	1699	tkwait window $frm
[91]	1700	afterputontop
[17]	1701	}
	1702
	1703	# validate the files and make the conversion
[72]	1704	proc ValidWinCnv {frm} {
[59]	1705	global expgui
[72]	1706	# change backslashes to something sensible
	1707	regsub -all {\\} $expgui(FileMenuCnvName) / expgui(FileMenuCnvName)
	1708	# allow entry of D: for D:/ and D:TEST for d:/TEST
	1709	if {[string first : $expgui(FileMenuCnvName)] != -1 && \
	1710	[string first :/ $expgui(FileMenuCnvName)] == -1} {
	1711	regsub : $expgui(FileMenuCnvName) :/ expgui(FileMenuCnvName)
	1712	}
[59]	1713	if {$expgui(FileMenuCnvName) == "<Parent>"} {
	1714	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
[72]	1715	ChooseWinCnv $frm
[17]	1716	return
[59]	1717	} elseif [file isdirectory \
	1718	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
	1719	if {$expgui(FileMenuCnvName) != "."} {
	1720	set expgui(FileMenuDir) \
	1721	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
	1722	}
[72]	1723	ChooseWinCnv $frm
[59]	1724	return
[17]	1725	}
[59]	1726
	1727	set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
	1728	if ![file exists $file] {
[384]	1729	MyMessageBox -parent $frm -title "Convert Error" \
	1730	-message "File $file does not exist" -icon error
[59]	1731	return
	1732	}
	1733
	1734	set tmpname "[file join [file dirname $file] tempfile.xxx]"
	1735	set oldname "[file rootname $file].org"
	1736	if [file exists $oldname] {
[325]	1737	set ans [MyMessageBox -parent . -title "Overwrite?" \
	1738	-message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
	1739	-icon warning -type {Overwrite Cancel} -default Overwrite \
	1740	-helplink "expguierr.html OverwriteCnv"]
	1741	if {[string tolower $ans] == "cancel"} return
[59]	1742	catch {file delete $oldname}
	1743	}
	1744
[17]	1745	if [catch {
[59]	1746	set in [open $file r]
	1747	set out [open $tmpname w]
[805]	1748	fconfigure $out -translation crlf -encoding ascii
[17]	1749	set len [gets $in line]
	1750	if {$len > 160} {
	1751	# this is a UNIX file. Hope there are no control characters
	1752	set i 0
	1753	set j 79
	1754	while {$j < $len} {
	1755	puts $out [string range $line $i $j]
	1756	incr i 80
	1757	incr j 80
	1758	}
	1759	} else {
	1760	while {$len >= 0} {
	1761	append line " "
	1762	append line " "
	1763	set line [string range $line 0 79]
	1764	puts $out $line
	1765	set len [gets $in line]
	1766	}
	1767	}
	1768	close $in
	1769	close $out
[138]	1770	file rename -force $file $oldname
	1771	file rename -force $tmpname $file
[17]	1772	} errmsg] {
[384]	1773	MyMessageBox -parent $frm -title "Conversion error" \
	1774	-message "Error in conversion:\n$errmsg" -icon warning
[17]	1775	} else {
[384]	1776	set ans [MyMessageBox -parent $frm -title "More?" \
	1777	-message "File [file tail $file] converted.\n(Original saved as [file tail $oldname]).\n\n Convert more files?" \
	1778	-type yesno -default no]
	1779	if {$ans == "no"} {destroy $frm}
[17]	1780	}
	1781	}
	1782
[59]	1783	# create a file box
[72]	1784	proc winfilebox {frm} {
[59]	1785	global expgui
[72]	1786	set bx $frm.1
[59]	1787	pack [frame $bx.top] -side top
	1788	pack [label $bx.top.a -text "Directory" ] -side left
	1789	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
	1790	pack $bx.top.d -side left
	1791	set expgui(FileMenuDir) [pwd]
	1792	# the icon below is from tk8.0/tkfbox.tcl
	1793	set upfolder [image create bitmap -data {
	1794	#define updir_width 28
	1795	#define updir_height 16
	1796	static char updir_bits[] = {
	1797	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
	1798	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
	1799	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
	1800	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
	1801	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
	1802	0xf0, 0xff, 0xff, 0x01};}]
	1803
	1804	pack [button $bx.top.b -image $upfolder \
[72]	1805	-command "updir; ChooseWinCnv $frm" ]
[17]	1806	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
[328]	1807	listbox $bx.a.files -relief raised -bd 2 \
[450]	1808	-yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
[328]	1809	-height 15 -width 0 -exportselection 0
	1810	listbox $bx.a.dates -relief raised -bd 2 \
[450]	1811	-yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
[328]	1812	-height 15 -width 0 -takefocus 0 -exportselection 0
[59]	1813	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
[72]	1814	ChooseWinCnv $frm
	1815	bind $bx.a.files <ButtonRelease-1> "ReleaseWinCnv $frm"
	1816	bind $bx.a.dates <ButtonRelease-1> "ReleaseWinCnv $frm"
	1817	bind $bx.a.files <Double-1> "SelectWinCnv $frm"
	1818	bind $bx.a.dates <Double-1> "SelectWinCnv $frm"
[17]	1819	pack $bx.a.scroll -side left -fill y
[59]	1820	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
	1821	pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
[17]	1822	}
	1823
[59]	1824	# set the box or file in the selection window
[72]	1825	proc ReleaseWinCnv {frm} {
[59]	1826	global expgui
[72]	1827	set files $frm.1.a.files
	1828	set dates $frm.1.a.dates
[59]	1829	set select [$files curselection]
[17]	1830	if {$select == ""} {
[59]	1831	set select [$dates curselection]
	1832	}
	1833	if {$select == ""} {
	1834	set expgui(FileMenuCnvName) ""
[17]	1835	} else {
[59]	1836	set expgui(FileMenuCnvName) [string trim [$files get $select]]
[17]	1837	}
[59]	1838	if {$expgui(FileMenuCnvName) == "<Parent>"} {
	1839	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
[72]	1840	ChooseWinCnv $frm
[59]	1841	} elseif [file isdirectory \
	1842	[file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
	1843	if {$expgui(FileMenuCnvName) != "."} {
	1844	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
[72]	1845	ChooseWinCnv $frm
[17]	1846	}
	1847	}
[59]	1848	return
[17]	1849	}
	1850
[59]	1851	# select a file or directory -- called on double click
[72]	1852	proc SelectWinCnv {frm} {
[59]	1853	global expgui
[72]	1854	set files $frm.1.a.files
	1855	set dates $frm.1.a.dates
[59]	1856	set select [$files curselection]
	1857	if {$select == ""} {
	1858	set select [$dates curselection]
	1859	}
	1860	if {$select == ""} {
	1861	set file .
[17]	1862	} else {
[59]	1863	set file [string trim [$files get $select]]
[17]	1864	}
[59]	1865	if {$file == "<Parent>"} {
	1866	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
[72]	1867	ChooseWinCnv $frm
[59]	1868	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
	1869	if {$file != "."} {
	1870	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
[72]	1871	ChooseWinCnv $frm
[59]	1872	}
[17]	1873	} else {
[59]	1874	set expgui(FileMenuCnvName) [file tail $file]
[72]	1875	ValidWinCnv $frm
[17]	1876	}
	1877	}
	1878
[59]	1879	# fill the files & dates & Directory selection box with current directory,
	1880	# also called when box is created to fill it
[72]	1881	proc ChooseWinCnv {frm} {
[59]	1882	global expgui
[72]	1883	set files $frm.1.a.files
	1884	set dates $frm.1.a.dates
[59]	1885	set expgui(FileMenuCnvName) {}
	1886	$files delete 0 end
	1887	$dates delete 0 end
	1888	$files insert end {<Parent>}
	1889	$dates insert end {(Directory)}
	1890	set filelist [glob -nocomplain \
	1891	[file join [set expgui(FileMenuDir)] *] ]
[91]	1892	foreach file [lsort -dictionary $filelist] {
[59]	1893	if {[file isdirectory $file]} {
	1894	$files insert end [file tail $file]
	1895	$dates insert end {(Directory)}
	1896	}
	1897	}
[91]	1898	foreach file [lsort -dictionary $filelist] {
[72]	1899	if {![file isdirectory $file]} {
	1900	set modified [clock format [file mtime $file] -format "%T %D"]
	1901	$files insert end [file tail $file]
	1902	$dates insert end $modified
	1903	}
[59]	1904	}
	1905	$expgui(FileDirButtonMenu) delete 0 end
	1906	set list ""
[328]	1907	global tcl_version
	1908	if {$tcl_version > 8.0} {
	1909	catch {set list [string tolower [file volume]]}
	1910	}
[59]	1911	set dir ""
	1912	foreach subdir [file split [set expgui(FileMenuDir)]] {
[328]	1913	set dir [string tolower [file join $dir $subdir]]
	1914	if {[lsearch $list $dir] == -1} {lappend list $dir}
[59]	1915	}
	1916	foreach path $list {
	1917	$expgui(FileDirButtonMenu) add command -label $path \
	1918	-command "[list set expgui(FileMenuDir) $path]; \
[72]	1919	ChooseWinCnv $frm"
[59]	1920	}
	1921	return
	1922	}
	1923
	1924	#------------------------------------------------------------------------------
[29]	1925	# set options for liveplot
[17]	1926	proc liveplotopt {} {
[83]	1927	global liveplot expmap
[17]	1928	set frm .file
	1929	catch {destroy $frm}
	1930	toplevel $frm
	1931	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
[83]	1932	set last [lindex [lsort -integer $expmap(powderlist)] end]
	1933	if {$last == ""} {set last 1}
	1934	pack [scale $frmA.1 -label "Histogram number" -from 1 -to $last \
[17]	1935	-length 150 -orient horizontal -variable liveplot(hst)] -side top
	1936	pack [checkbutton $frmA.2 -text {include plot legend}\
	1937	-variable liveplot(legend)] -side top
	1938	pack [button $frm.2 -text OK \
	1939	-command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
	1940	] -side top
	1941	bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
[91]	1942
[17]	1943	# force the window to stay on top
[91]	1944	putontop $frm
[17]	1945	focus $frm.2
	1946	tkwait window $frm
[91]	1947	afterputontop
[17]	1948	}
[29]	1949
	1950	#------------------------------------------------------------------------------
	1951	# get an experiment file name
	1952	#------------------------------------------------------------------------------
	1953	proc getExpFileName {mode} {
[388]	1954	global expgui tcl_platform
[29]	1955	set frm .file
	1956	catch {destroy $frm}
	1957	toplevel $frm
[59]	1958	wm title $frm "Experiment file"
[325]	1959	bind $frm <Key-F1> "MakeWWWHelp expguierr.html open"
[29]	1960	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
[325]	1961	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left \
	1962	-fill y -expand yes
	1963	pack [button $frmC.help -text Help -bg yellow \
	1964	-command "MakeWWWHelp expguierr.html open"] \
	1965	-side top -anchor e
[29]	1966	pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
	1967	pack [radiobutton $frmC.1 -text "File Name" -value 1 \
	1968	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
	1969	pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
	1970	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
[388]	1971
	1972	set expgui(includearchived) 0
[491]	1973	set expgui(FileInfoBox) $frmC.info
[470]	1974	if {$mode == "old"} {
[388]	1975	pack [checkbutton $frmC.ar -text "Include Archived Files" \
	1976	-variable expgui(includearchived) \
	1977	-command "ChooseExpFil $frmA"] -side top -pady 10
[490]	1978	pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
	1979	-class SmallFont] \
	1980	-side top -fill both -expand yes -pady 5
[749]	1981	} elseif {$mode != "new"} {
	1982	# for initial read, don't access archived files
	1983	pack [frame $expgui(FileInfoBox) -bd 4 -relief groove \
	1984	-class SmallFont] \
	1985	-side top -fill both -expand yes -pady 5
	1986	set mode "old"
[388]	1987	}
[32]	1988	pack [button $frmC.b -text Read \
[325]	1989	-command "valid_exp_file $frmA $mode"] -side bottom
[32]	1990	if {$mode == "new"} {
	1991	$frmC.b config -text Save
	1992	}
[929]	1993	pack [button $frmC.q -text Cancel \
[325]	1994	-command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side bottom
[29]	1995	bind $frm <Return> "$frmC.b invoke"
	1996
[32]	1997	if {$mode == "new"} {
	1998	pack [label $frmA.0 -text "Enter an experiment file to create"] \
	1999	-side top -anchor center
	2000	} else {
	2001	pack [label $frmA.0 -text "Select an experiment file to read"] \
	2002	-side top -anchor center
	2003	}
[29]	2004	expfilebox $frmA $mode
	2005	# force the window to stay on top
[91]	2006	putontop $frm
[29]	2007	focus $frmC.b
	2008	tkwait window $frm
[91]	2009	afterputontop
[29]	2010	if {$expgui(FileMenuEXPNAM) == ""} return
[673]	2011	# is there a space in the EXP name?
	2012	if {[string first " " [file tail $expgui(FileMenuEXPNAM)]] != -1} {
	2013	update
	2014	MyMessageBox -parent . -title "File Name Error" \
	2015	-message "File name \"$expgui(FileMenuEXPNAM)\" is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
	2016	-icon warning -type Continue -default continue
	2017	# -helplink "expguierr.html OpenErr"
	2018	return
	2019	}
	2020	if {[string first " " $expgui(FileMenuDir)] != -1} {
	2021	update
	2022	MyMessageBox -parent . -title "Good luck..." \
[953]	2023	-message "You are using a directory with a space in the name ([file dirname $expgui(FileMenuDir)]) -- You may encounter bugs in EXPGUI. Please e-mail them to Brian.Toby@ANL.gov so they can be fixed." \
[673]	2024	-icon warning -type Continue -default continue
	2025	# -helplink "expguierr.html OpenErr"
	2026	}
[29]	2027	return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	2028	}
	2029
	2030	# validation routine
	2031	proc valid_exp_file {frm mode} {
[72]	2032	global expgui tcl_platform
	2033	# windows fixes
	2034	if {$tcl_platform(platform) == "windows"} {
	2035	# change backslashes to something sensible
	2036	regsub -all {\\} $expgui(FileMenuEXPNAM) / expgui(FileMenuEXPNAM)
	2037	# allow entry of D: for D:/ and D:TEST for d:/TEST
	2038	if {[string first : $expgui(FileMenuEXPNAM)] != -1 && \
	2039	[string first :/ $expgui(FileMenuEXPNAM)] == -1} {
	2040	regsub : $expgui(FileMenuEXPNAM) :/ expgui(FileMenuEXPNAM)
	2041	}
	2042	}
[29]	2043	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
	2044	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
	2045	ChooseExpFil $frm
	2046	return
	2047	} elseif [file isdirectory \
	2048	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
	2049	if {$expgui(FileMenuEXPNAM) != "."} {
	2050	set expgui(FileMenuDir) \
	2051	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	2052	}
	2053	ChooseExpFil $frm
	2054	return
	2055	}
[182]	2056	# append a .EXP if not present
[29]	2057	if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
	2058	append expgui(FileMenuEXPNAM) ".EXP"
	2059	}
[606]	2060	# is there a space in the name?
	2061	if {[string first " " $expgui(FileMenuEXPNAM)] != -1} {
	2062	MyMessageBox -parent . -title "File Name Error" \
	2063	-message "File name $expgui(FileMenuEXPNAM) is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
	2064	-icon warning -type Continue -default continue
	2065	# -helplink "expguierr.html OpenErr"
	2066	return
	2067	}
[388]	2068	# check for archive files
[470]	2069	if {[string match {*.O[0-9A-F][0-9A-F]} $expgui(FileMenuEXPNAM)] && \
[388]	2070	$mode == "old" && [file exists $expgui(FileMenuEXPNAM)]} {
	2071	destroy .file
	2072	return
	2073	} elseif {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
	2074	# check for files that end in something other than .EXP .exp or .Exp...
[384]	2075	MyMessageBox -parent . -title "File Open Error" \
	2076	-message "File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
	2077	-icon error
[29]	2078	return
	2079	}
[182]	2080	# check on the file status
[29]	2081	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	2082	if {$mode == "new" && [file exists $file]} {
[325]	2083	set ans [
	2084	MyMessageBox -parent . -title "File Open Error" \
	2085	-message "File [file tail $file] already exists in [file dirname $file]. OK to overwrite?" \
	2086	-icon question -type {"Select other" "Overwrite"} -default "select other" \
	2087	-helplink "expguierr.html OverwriteErr"
	2088	]
	2089	if {[string tolower $ans] == "overwrite"} {destroy .file}
[29]	2090	return
	2091	}
[182]	2092	# if file does not exist in case provided, set the name to all
	2093	# upper case letters, since that is the best choice.
	2094	# if it does exist, read from it as is. For UNIX we will force uppercase later.
	2095	if {![file exists $file]} {
	2096	set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
	2097	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	2098	}
[29]	2099	if {$mode == "old" && ![file exists $file]} {
[325]	2100	set ans [
	2101	MyMessageBox -parent . -title "File Open Error" \
	2102	-message "File [file tail $file] does not exist in [file dirname $file]. OK to create?" \
	2103	-icon question -type {"Select other" "Create"} -default "select other" \
	2104	-helplink "expguierr.html OpenErr"
	2105	]
	2106	if {[string tolower $ans] == "create"} {destroy .file}
[29]	2107	return
	2108	}
	2109	destroy .file
	2110	}
	2111
	2112	proc updir {} {
	2113	global expgui
	2114	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
	2115	}
	2116
	2117	# create a file box
	2118	proc expfilebox {bx mode} {
	2119	global expgui
	2120	pack [frame $bx.top] -side top
	2121	pack [label $bx.top.a -text "Directory" ] -side left
	2122	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
	2123	pack $bx.top.d -side left
	2124	set expgui(FileMenuDir) [pwd]
	2125	# the icon below is from tk8.0/tkfbox.tcl
	2126	set upfolder [image create bitmap -data {
	2127	#define updir_width 28
	2128	#define updir_height 16
	2129	static char updir_bits[] = {
	2130	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
	2131	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
	2132	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
	2133	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
	2134	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
	2135	0xf0, 0xff, 0xff, 0x01};}]
	2136
	2137	pack [button $bx.top.b -image $upfolder \
	2138	-command "updir; ChooseExpFil $bx" ]
	2139	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
	2140	listbox $bx.a.files -relief raised -bd 2 \
[450]	2141	-yscrollcommand "sync2boxesY $bx.a.files $bx.a.dates $bx.a.scroll" \
[328]	2142	-height 15 -width 0 -exportselection 0
[29]	2143	listbox $bx.a.dates -relief raised -bd 2 \
[450]	2144	-yscrollcommand "sync2boxesY $bx.a.dates $bx.a.files $bx.a.scroll" \
[328]	2145	-height 15 -width 0 -takefocus 0 -exportselection 0
[29]	2146	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
	2147	ChooseExpFil $bx
	2148	bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
	2149	bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
	2150	bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
	2151	bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
	2152	pack $bx.a.scroll -side left -fill y
	2153	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
	2154	pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
	2155	}
[450]	2156	proc sync2boxesX {master slave scroll args} {
	2157	$slave xview moveto [lindex [$master xview] 0]
	2158	eval $scroll set $args
	2159	}
	2160	proc move2boxesX {boxlist args} {
	2161	foreach listbox $boxlist {
	2162	eval $listbox xview $args
	2163	}
	2164	}
	2165	proc sync2boxesY {master slave scroll args} {
[29]	2166	$slave yview moveto [lindex [$master yview] 0]
	2167	eval $scroll set $args
	2168	}
	2169	proc move2boxesY {boxlist args} {
	2170	foreach listbox $boxlist {
	2171	eval $listbox yview $args
	2172	}
	2173	}
	2174
[450]	2175	# creates a table that is scrollable in both x and y, use ResizeScrollTable
	2176	# to set sizes after gridding the boxes
	2177	proc MakeScrollTable {box} {
[731]	2178	grid [label $box.0] -column 0 -row 0
[450]	2179	grid [set tbox [canvas $box.top \
	2180	-scrollregion {0 0 10 10} \
	2181	-xscrollcommand "sync2boxesX $box.top $box.can $box.scroll" \
	2182	-width 10 -height 10]] \
	2183	-sticky sew -row 0 -column 1
	2184	grid [set sbox [canvas $box.side \
	2185	-scrollregion {0 0 10 10} \
	2186	-yscrollcommand "sync2boxesY $box.side $box.can $box.yscroll" \
	2187	-width 10 -height 10]] \
	2188	-sticky nes -row 1 -column 0
	2189	grid [set bbox [canvas $box.can \
	2190	-scrollregion {0 0 10 10} \
	2191	-yscrollcommand "sync2boxesY $box.can $box.side $box.yscroll" \
	2192	-xscrollcommand "sync2boxesX $box.can $box.top $box.scroll" \
	2193	-width 200 -height 200 -bg lightgrey]] \
	2194	-sticky news -row 1 -column 1
	2195	grid [set sxbox [scrollbar $box.scroll -orient horizontal \
	2196	-command "move2boxesX \" $box.can $box.top \" "]] \
	2197	-sticky ew -row 2 -column 1
	2198	grid [set sybox [scrollbar $box.yscroll \
	2199	-command "move2boxesY \" $box.can $box.side \" "]] \
	2200	-sticky ns -row 1 -column 2
	2201	frame $tbox.f -bd 0
	2202	$tbox create window 0 0 -anchor nw -window $tbox.f
	2203	frame $bbox.f -bd 2
	2204	$bbox create window 0 0 -anchor nw -window $bbox.f
	2205	frame $sbox.f -bd 2 -relief raised
	2206	$sbox create window 0 0 -anchor nw -window $sbox.f
	2207	grid columnconfig $box 1 -weight 1
	2208	grid rowconfig $box 1 -weight 1
	2209	return [list $tbox.f $bbox.f $sbox.f $box.0]
	2210	}
	2211
	2212	proc ResizeScrollTable {box} {
	2213	update idletasks
	2214	for {set i 0} {$i < [lindex [grid size $box.can.f] 0]} {incr i} {
[637]	2215	set x1 [lindex [grid bbox $box.can.f $i 0] 2]
	2216	set x2 [lindex [grid bbox $box.top.f $i 0] 2]
[450]	2217	if {$x2 > $x1} {set x1 $x2}
[637]	2218	grid columnconfigure $box.top.f $i -minsize $x1
	2219	grid columnconfigure $box.can.f $i -minsize $x1
[450]	2220	}
	2221	for {set i 0} {$i < [lindex [grid size $box.can.f] 1]} {incr i} {
	2222	set x1 [lindex [grid bbox $box.can.f 0 $i] 3]
	2223	set x2 [lindex [grid bbox $box.side.f 0 $i] 3]
	2224	if {$x2 > $x1} {set x1 $x2}
	2225	grid rowconfigure $box.can.f $i -minsize $x1
	2226	grid rowconfigure $box.side.f $i -minsize $x1
	2227	}
	2228	update idletasks
	2229	set sizes [grid bbox $box.can.f]
	2230	$box.can config -scrollregion $sizes
	2231	$box.side config -scrollregion $sizes
	2232	$box.top config -scrollregion $sizes
	2233	$box.top config -height [lindex [grid bbox $box.top.f] 3]
	2234	$box.side config -width [lindex [grid bbox $box.side.f] 2]
	2235	}
[637]	2236	proc ExpandScrollTable {box} {
	2237	# set height & width of central box
	2238	$box.can config -width \
	2239	[expr [winfo width [winfo toplevel $box]] \
	2240	- [winfo width $box.side] - [winfo width $box.yscroll]-20]
	2241	$box.can config -height \
	2242	[expr [winfo height [winfo toplevel $box]] \
	2243	- [winfo height $box.top] - [winfo height $box.scroll]-25]
	2244	}
[450]	2245
	2246
	2247	# support routine for SetHistUseFlags
	2248	proc InitHistUseFlags {} {
	2249	global expmap expgui
	2250	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
[485]	2251	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
[450]	2252	set expgui(useflag_$i) [histinfo $i use]
[485]	2253	# }
[450]	2254	}
	2255	}
	2256
	2257	# show all Powder histograms; set use/do not use flags
	2258	proc SetHistUseFlags {} {
	2259	set box .test
	2260	catch {toplevel $box}
	2261	eval destroy [winfo children $box]
	2262	grid [label $box.0 -text "Set histogram \"Use/Do Not Use\" flags" -bg white] -row 0 -column 0 -columnspan 2
	2263	grid [frame $box.a] -row 1 -column 0 -columnspan 2
	2264	grid [button $box.b -text Save -command "destroy $box"] -row 2 -column 0 -sticky e
	2265	grid [button $box.c -text Cancel -command "InitHistUseFlags;destroy $box"] -row 2 -column 1 -sticky w
	2266	grid columnconfig $box 0 -weight 1
	2267	grid columnconfig $box 1 -weight 1
	2268	foreach a [MakeScrollTable $box.a] b {tbox bbox sbox cbox} {set $b $a}
	2269	$cbox config -text "Use\nFlag"
	2270	[winfo parent $bbox] config -height 250 -width 400
	2271	global expmap expgui
	2272	set px 5
	2273	set row -1
	2274	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
	2275	if {[string range $expmap(htype_$i) 2 2] == "T"} {
	2276	set det [format %8.2f [histinfo $i tofangle]]
	2277	} elseif {[string range $expmap(htype_$i) 2 2] == "C"} {
	2278	set det [format %8.5f [histinfo $i lam1]]
	2279	} elseif {[string range $expmap(htype_$i) 2 2] == "E"} {
	2280	set det [format %8.2f [histinfo $i lam1]]
	2281	} else {
	2282	set det {}
	2283	}
	2284	incr row
[485]	2285	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
[731]	2286	grid [checkbutton $sbox.$i -text $i -variable expgui(useflag_$i)] -row $row -column 0
[450]	2287	set expgui(useflag_$i) [histinfo $i use]
[485]	2288	# }
[450]	2289	grid [label $bbox.0$i \
[485]	2290	-text [string range $expmap(htype_$i) 0 3] \
[731]	2291	] -row $row -column 0 -padx $px
[450]	2292	grid [label $bbox.1$i -text [histinfo $i bank] \
[731]	2293	] -row $row -column 1 -padx $px
	2294	grid [label $bbox.2$i -text $det] -row $row -column 2 -padx $px
[450]	2295	grid [label $bbox.3$i -text [string range [histinfo $i title] 0 66] \
[731]	2296	] -row $row -column 3 -padx $px -sticky ew
[450]	2297	}
[731]	2298	grid [label $tbox.0 -text type -bd 2 -relief raised] -row 0 -column 0 -padx $px
	2299	grid [label $tbox.1 -text bank -bd 2 -relief raised] -row 0 -column 1 -padx $px
	2300	grid [label $tbox.2 -text "ang/wave" -bd 2 -relief raised] -row 0 -column 2 -padx $px
	2301	grid [label $tbox.3 -text "histogram title" -bd 2 -relief raised] -row 0 -column 3 -sticky w -padx $px
[450]	2302	ResizeScrollTable $box.a
	2303	InitHistUseFlags
	2304	putontop $box
	2305	tkwait window $box
	2306	afterputontop
	2307	set prevchages $expgui(changed)
	2308	for {set i 1} {$i <= $expmap(nhst)} {incr i} {
[485]	2309	# if {[string range $expmap(htype_$i) 0 0] == "P"} {
[450]	2310	if {$expgui(useflag_$i) != [histinfo $i use]} {
	2311	histinfo $i use set $expgui(useflag_$i)
[910]	2312	RecordMacroEntry "histinfo $i use set $expgui(useflag_$i)" 0
[450]	2313	incr expgui(changed)
[910]	2314	RecordMacroEntry "incr expgui(changed)" 0
[450]	2315	}
[485]	2316	# }
[450]	2317	}
	2318	if {$prevchages != $expgui(changed)} {
	2319	set msg "You have changed [expr $expgui(changed)-$prevchages] "
	2320	append msg "histogram flag(s). You must run POWPREF "
	2321	append msg "to include/remove these histograms. Do you want to "
	2322	append msg "run POWPREF?"
	2323	set ans [MyMessageBox -parent . -message $msg \
	2324	-title "Process changes?"\
	2325	-helplink "expguierr.html ProcessUse" \
	2326	-default {Run POWPREF} \
	2327	-type {{Run POWPREF} Skip}]
	2328
	2329	if {$ans == "skip"} {
	2330	# save and reload the experiment file
	2331	savearchiveexp
	2332	loadexp $expgui(expfile)
	2333	} else {
	2334	# run powpref and force a reload
	2335	set saveautoload $expgui(autoexpload)
	2336	set expgui(autoexpload) 1
	2337	runGSASwEXP powpref
	2338	set expgui(autoexpload) $saveautoload
	2339	}
	2340	}
	2341	}
	2342
[29]	2343	# set the box or file in the selection window
	2344	proc ReleaseExpFil {frm} {
	2345	global expgui
	2346	set files $frm.a.files
	2347	set dates $frm.a.dates
	2348	set select [$files curselection]
	2349	if {$select == ""} {
	2350	set select [$dates curselection]
	2351	}
	2352	if {$select == ""} {
	2353	set expgui(FileMenuEXPNAM) ""
	2354	} else {
	2355	set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
[490]	2356	after idle UpdateInfoBox
[29]	2357	}
[59]	2358	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
	2359	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
	2360	ChooseExpFil $frm
	2361	} elseif [file isdirectory \
	2362	[file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
	2363	if {$expgui(FileMenuEXPNAM) != "."} {
	2364	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	2365	ChooseExpFil $frm
	2366	}
	2367	}
[29]	2368	return
	2369	}
[490]	2370	proc UpdateInfoBox {} {
	2371	global expgui
	2372	if {![winfo exists $expgui(FileInfoBox)]} return
	2373	eval destroy [winfo children $expgui(FileInfoBox)]
	2374	set file [file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]
	2375	if [file isdirectory $file] return
	2376	if [file exists $file] {
	2377	pack [label $expgui(FileInfoBox).1 -text $expgui(FileMenuEXPNAM)] \
	2378	-side top
	2379	catch {
	2380	set fp [open $file r]
	2381	global testline
	2382	set testline [read $fp]
	2383	close $fp
	2384	update
[749]	2385	regexp {GNLS RUN on (.) +Total.run *([0-9]+) } \
[490]	2386	$testline a last cycles
	2387	pack [label $expgui(FileInfoBox).2 -justify left \
	2388	-text "last GENLES run:\n $last\n total cycles: $cycles"] \
	2389	-side top -anchor w
	2390	regexp {REFN GDNFT.= ([0-9]\.[0-9]) +for *([0-9]+) variables} \
	2391	$testline a chi2 vars
	2392	pack [frame $expgui(FileInfoBox).3 -class SmallFont] \
	2393	-side top -anchor w
	2394	pack [label $expgui(FileInfoBox).3.a -justify left \
	2395	-text "c" -font symbol] \
	2396	-side left -anchor w
	2397	pack [label $expgui(FileInfoBox).3.b -justify left \
	2398	-text "2: $chi2, $vars vars"] \
	2399	-side top -anchor w
	2400	# check first 9 histograms
	2401	set lbl "h Rwp R(F2)"
	2402	set n 0
	2403	foreach k {1 2 3 4 5 6 7 8 9} {
	2404	set key "HST $k"
	2405	append key { RPOWD +([0-9]\.[0-9]) }
	2406	set i [regexp $key $testline a Rwp]
	2407	set key "HST $k"
	2408	append key { R-FAC +[0-9]+ +([0-9]\.[0-9]) }
	2409	set j [regexp $key $testline a Rb]
	2410	if {$i \|\| $j} {
	2411	incr n
	2412	append lbl "\n$k "
	2413	if {$i} {
	2414	append lbl [string range $Rwp 0 5]
	2415	} else {
	2416	append lbl " "
	2417	}
	2418	}
	2419	if {$j} {
	2420	append lbl " [string range $Rb 0 5]"
	2421	}
	2422	# stick 1st 3 entries in box
	2423	if {$n >= 3} break
	2424	}
	2425	pack [label $expgui(FileInfoBox).4 -justify left \
	2426	-text $lbl] \
	2427	-side top -anchor w
	2428	}
	2429	}
	2430	}
[29]	2431
	2432	# select a file or directory -- called on double click
	2433	proc SelectExpFil {frm mode} {
	2434	global expgui
	2435	set files $frm.a.files
	2436	set dates $frm.a.dates
	2437	set select [$files curselection]
	2438	if {$select == ""} {
	2439	set select [$dates curselection]
	2440	}
	2441	if {$select == ""} {
	2442	set file .
	2443	} else {
	2444	set file [string trim [$files get $select]]
	2445	}
	2446	if {$file == "<Parent>"} {
	2447	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
	2448	ChooseExpFil $frm
	2449	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
	2450	if {$file != "."} {
	2451	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
	2452	ChooseExpFil $frm
	2453	}
	2454	} else {
	2455	set expgui(FileMenuEXPNAM) [file tail $file]
	2456	valid_exp_file $frm $mode
	2457	}
	2458	}
	2459
	2460	# fill the files & dates & Directory selection box with current directory,
	2461	# also called when box is created to fill it
	2462	proc ChooseExpFil {frm} {
[328]	2463	global expgui
[29]	2464	set files $frm.a.files
	2465	set dates $frm.a.dates
	2466	set expgui(FileMenuEXPNAM) {}
	2467	$files delete 0 end
	2468	$dates delete 0 end
	2469	$files insert end {<Parent>}
	2470	$dates insert end {(Directory)}
	2471	set filelist [glob -nocomplain \
	2472	[file join [set expgui(FileMenuDir)] *] ]
[91]	2473	foreach file [lsort -dictionary $filelist] {
[29]	2474	if {[file isdirectory $file]} {
	2475	$files insert end [file tail $file]
	2476	$dates insert end {(Directory)}
	2477	}
	2478	}
	2479	set pairlist {}
[91]	2480	foreach file [lsort -dictionary $filelist] {
[29]	2481	if {![file isdirectory $file] && \
[47]	2482	[string toupper [file extension $file]] == ".EXP"} {
[29]	2483	set modified [file mtime $file]
[72]	2484	lappend pairlist [list $file $modified]
[388]	2485	} elseif {![file isdirectory $file] && $expgui(includearchived) && \
[470]	2486	[string match {*.O[0-9A-F][0-9A-F]} $file]} {
[388]	2487	set modified [file mtime $file]
	2488	lappend pairlist [list $file $modified]
[29]	2489	}
	2490	}
	2491	if {$expgui(filesort) == 0} {
[542]	2492	foreach pair [lsort -index 1 -integer -decreasing $pairlist] {
[29]	2493	set file [lindex $pair 0]
	2494	set modified [clock format [lindex $pair 1] -format "%T %D"]
	2495	$files insert end [file tail $file]
	2496	$dates insert end $modified
	2497	}
	2498	} else {
[130]	2499	foreach pair [lsort -dictionary -index 0 $pairlist] {
[29]	2500	set file [lindex $pair 0]
	2501	set modified [clock format [lindex $pair 1] -format "%T %D"]
	2502	$files insert end [file tail $file]
	2503	$dates insert end $modified
	2504	}
	2505	}
	2506	$expgui(FileDirButtonMenu) delete 0 end
	2507	set list ""
[328]	2508	global tcl_platform tcl_version
	2509	if {$tcl_platform(platform) == "windows" && $tcl_version > 8.0} {
	2510	catch {set list [string tolower [file volume]]}
[325]	2511	}
[29]	2512	set dir ""
	2513	foreach subdir [file split [set expgui(FileMenuDir)]] {
	2514	set dir [file join $dir $subdir]
[328]	2515	if {$tcl_platform(platform) == "windows"} {
	2516	set dir [string tolower $dir]
	2517	if {[lsearch $list $dir] == -1} {lappend list $dir}
	2518	} else {
	2519	lappend list $dir
	2520	}
[29]	2521	}
	2522	foreach path $list {
	2523	$expgui(FileDirButtonMenu) add command -label $path \
	2524	-command "[list set expgui(FileMenuDir) $path]; \
	2525	ChooseExpFil $frm"
	2526	}
	2527	# highlight the current experiment -- if present
	2528	for {set i 0} {$i < [$files size]} {incr i} {
	2529	set file [$files get $i]
	2530	if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
	2531	$files selection set $i
	2532	}
	2533	}
	2534	return
	2535	}
[91]	2536
	2537
[328]	2538	#------------------------------------------------------------------------------
	2539	# platform-specific definitions
	2540	if {$tcl_platform(platform) == "windows" && $tcl_platform(os) == "Windows 95"} {
[360]	2541	# windows-95, -98 and presumably -me do not allow Tcl/Tk to run the
	2542	# DOS box synchronously, so we create a "lock" file that is deleted
	2543	# at the end of the DOS run so we can tell when the run is done.
	2544	# We create a window to force the deleting of the file so that if
	2545	# the DOS process crashes, the user can continue anyway.
	2546	#
	2547	# procedure to check if the lock file is still there (Win-9x/me only)
	2548	proc checklockfile {file window} {
	2549	if [file exists $file] {
	2550	after 500 checklockfile $file $window
	2551	} else {
	2552	catch {destroy $window}
	2553	}
	2554	}
[673]	2555	# this procedure starts the GRWND program, if needed for program $prog
	2556	proc StartGRWND {prog} {
	2557	global expgui
	2558	if {!$expgui(autoGRWND)} return
	2559	# at some point we might want to have a real list
	2560	if {$prog != "genles" && $prog != "powpref"} {
	2561	# get a list of running jobs
	2562	exec [file join $expgui(scriptdir) win9xbin tlist.exe] > tlist.tlist
	2563	set fp [open tlist.tlist r]
	2564	set text [read $fp]
	2565	close $fp
	2566	file delete -force tlist.tlist
	2567	# if GRWND.EXE is not currently running, start it
	2568	if {[lsearch [string toupper $text] GRWND.EXE] == -1} {
	2569	exec [file join $expgui(gsasexe) grwnd.exe] &
	2570	# give grwnd a 1 second head start
	2571	after 1000
	2572	}
	2573	}
	2574	}
[328]	2575	# this creates a DOS box to run a program in
[360]	2576	proc forknewterm {title command "wait 1" "scrollbar 1"} {
[328]	2577	global env expgui
	2578	# Windows environment variables
	2579	set env(GSAS) [file nativename $expgui(gsasdir)]
	2580	# PGPLOT_FONT is needed by PGPLOT
[935]	2581	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
[328]	2582	# this is the number of lines/page in the .LST (etc.) file
	2583	set env(LENPAGE) 60
	2584	set pwd [file nativename [pwd]]
	2585
[360]	2586	# check the .EXP path -- can DOS use it?
[328]	2587	if {[string first // [pwd]] != -1} {
	2588	MyMessageBox -parent . -title "Invalid Path" \
	2589	-message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
	2590	-icon error -type ok -default ok \
	2591	-helplink "expgui_Win_readme.html NetPath"
	2592	return
[322]	2593	}
[810]	2594	if {[info command winutils::shell] == "" && \
	2595	[info command winexec] == ""} {
	2596	MyMessageBox -parent . -title "Setup error" \
	2597	-message {Error -- Use "Neither WINEXEC not WINTILS were found. Can't do anything!"} \
	2598	-icon error -type darn -default darn \
	2599	-helplink "expgui_Win_readme.html Winexec"
	2600	return
	2601	}
[360]	2602	# loop over multiple commands
	2603	foreach cmd $command {
	2604	# simulate the wait with a lock file
	2605	if {$wait} {
	2606	if {$expgui(autoiconify)} {wm iconify .}
	2607	# create a blank lock file and a message window
	2608	close [open expgui.lck w]
	2609	toplevel .lock
	2610	grid [button .lock.0 -text Help -bg yellow \
	2611	-command "MakeWWWHelp expguierr.html lock"] \
	2612	-column 1 -row 0
	2613	grid [label .lock.1 \
	2614	-text "Please wait while the GSAS program finishes."] \
	2615	-column 0 -row 0
	2616	grid [label .lock.2 -text \
	2617	"In case a problem occurs, close the DOS box"] \
	2618	-column 0 -columnspan 2 -row 1
	2619	grid [label .lock.3 -text \
	2620	"and press the \"Continue\" button (below)"] \
	2621	-column 0 -columnspan 2 -row 2
	2622	grid [button .lock.b -text "Continue" \
	2623	-command "destroy .lock; wm deiconify ."] \
	2624	-column 0 -columnspan 2 -row 3
	2625	putontop .lock
	2626	update
	2627	checklockfile expgui.lck .lock
	2628	}
[910]	2629
	2630	# pause is hard coded in the GSASTCL.BAT file
	2631	if {$expgui(execprompt)} {
	2632	set script gsastcl.bat
	2633	} else {
	2634	set script gsasnowt.bat
	2635	}
	2636
[360]	2637	# replace the forward slashes with backward
	2638	regsub -all / $cmd \\ cmd
[810]	2639	if {[info command winutils::shell] != ""} {
[910]	2640	winutils::shell [file join $expgui(scriptdir) $script] $cmd
[810]	2641	} else {
	2642	winexec -d [file nativename [pwd]] \
[910]	2643	[file join $expgui(scriptdir) $script] $cmd
[810]	2644	}
[910]	2645	if {$expgui(MacroRunning)} {
	2646	update
	2647	update idletasks
	2648	}
[360]	2649	if {$wait} {
	2650	tkwait window .lock
	2651	file delete -force expgui.lck
	2652	}
	2653	}
	2654	if {$expgui(autoiconify) && $wait} {wm deiconify .}
	2655	# check for changes in the .EXP file immediately
	2656	whenidle
[91]	2657	}
[328]	2658	} elseif {$tcl_platform(platform) == "windows"} {
[360]	2659	# now for Windows-NT, where we can run synchronously
	2660	#
[328]	2661	# this creates a DOS box to run a program in
[360]	2662	proc forknewterm {title command "wait 1" "scrollbar 1"} {
[328]	2663	global env expgui
	2664	# Windows environment variables
	2665	set env(GSAS) [file nativename $expgui(gsasdir)]
	2666	# PGPLOT_FONT is needed by PGPLOT
[935]	2667	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
[953]	2668	set env(PGPLOT_DIR) $expgui(pgplotdir)
[328]	2669	# this is the number of lines/page in the .LST (etc.) file
	2670	set env(LENPAGE) 60
[360]	2671	set pwd [file nativename [pwd]]
	2672	# check the path -- can DOS use it?
	2673	if {[string first // [pwd]] != -1} {
	2674	MyMessageBox -parent . -title "Invalid Path" \
	2675	-message {Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) GSAS can't directly access a network drive} \
	2676	-icon error -type ok -default ok \
	2677	-helplink "expgui_Win_readme.html NetPath"
	2678	return
	2679	}
	2680	# pause is hard coded in the .BAT file
[910]	2681	if {$expgui(execprompt)} {
	2682	set script gsastcl.bat
	2683	} else {
	2684	set script gsasnowt.bat
	2685	}
[360]	2686
	2687	if {$wait} {
	2688	if {$expgui(autoiconify)} {wm iconify .}
	2689	# create a blank lock file (keep liveplot from running)
	2690	close [open expgui.lck w]
	2691	# loop over commands
	2692	foreach cmd $command {
	2693	# replace the forward slashes with backward
	2694	regsub -all / $cmd \\ cmd
[935]	2695	# use of file attributes -shortname & normalize and nativename
	2696	# might help here
[360]	2697	exec $env(COMSPEC) /c \
[910]	2698	"start [file join $expgui(scriptdir) $script] $cmd"
[130]	2699	}
[360]	2700	file delete -force expgui.lck
	2701	if {$expgui(autoiconify)} {wm deiconify .}
	2702	# check for changes in the .EXP file immediately
	2703	whenidle
	2704	} else {
	2705	# loop over commands
	2706	foreach cmd $command {
	2707	# replace the forward slashes with backward
	2708	regsub -all / $cmd \\ cmd
	2709	# run in background
	2710	exec $env(COMSPEC) /c \
[910]	2711	"start [file join $expgui(scriptdir) $script] $cmd" &
	2712	if {$expgui(MacroRunning)} {
	2713	update
	2714	update idletasks
	2715	}
[360]	2716	}
[130]	2717	}
	2718	}
[328]	2719	} else {
[986]	2720	# UNIX-based machines
	2721	if {[auto_execok xterm] != ""} {
	2722	# this creates a xterm window for running programs inside
	2723	proc forknewterm {title command "wait 1" "scrollbar 1"} {
	2724	global env expgui
	2725	# UNIX environment variables
	2726	set env(GSAS) [file nativename $expgui(gsasdir)]
	2727	set env(gsas) [file nativename $expgui(gsasdir)]
	2728	set env(GSASEXE) $expgui(gsasexe)
	2729	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
	2730	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
	2731	# PGPLOT_DIR is needed by PGPLOT
	2732	set env(PGPLOT_DIR) $expgui(pgplotdir)
	2733	# this is the number of lines/page in the .LST (etc.) file
	2734	set env(LENPAGE) 60
	2735	set termopts {}
	2736	if $env(GSASBACKSPACE) {
	2737	append termopts \
[328]	2738	{-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"}
[986]	2739	}
	2740	if $scrollbar {
	2741	append termopts " -sb"
	2742	} else {
	2743	append termopts " +sb"
	2744	}
	2745	if {$wait} {
	2746	set suffix {}
	2747	} else {
	2748	set suffix {&}
	2749	}
	2750
	2751	# hold window open after commands finish
	2752	if {$expgui(execprompt)} {
	2753	append command "\; echo -n Press Enter to continue \; read x"
	2754	}
	2755	if {$wait && $expgui(autoiconify)} {wm iconify .}
	2756	catch {eval exec xterm $termopts -title [list $title] \
	2757	-e /bin/sh -c [list $command] $suffix} errmsg
	2758	if $expgui(debug) {puts "xterm result = $errmsg"}
	2759	if {$expgui(MacroRunning)} {
	2760	update
	2761	update idletasks
	2762	}
	2763	if {$wait} {
	2764	if {$expgui(autoiconify)} {wm deiconify .}
	2765	# check for changes in the .EXP file immediately
	2766	whenidle
	2767	}
[130]	2768	}
[986]	2769	} elseif {[auto_execok gnome-terminal] != ""} {
	2770	# this creates a xterm window for running programs inside
	2771	proc forknewterm {title command "wait 1" "scrollbar 1"} {
	2772	global env expgui
	2773	# UNIX environment variables
	2774	set env(GSAS) [file nativename $expgui(gsasdir)]
	2775	set env(gsas) [file nativename $expgui(gsasdir)]
	2776	set env(GSASEXE) $expgui(gsasexe)
	2777	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
	2778	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
	2779	# PGPLOT_DIR is needed by PGPLOT
	2780	set env(PGPLOT_DIR) $expgui(pgplotdir)
	2781	# this is the number of lines/page in the .LST (etc.) file
	2782	set env(LENPAGE) 60
	2783	if {$wait} {
	2784	set suffix {}
	2785	} else {
	2786	set suffix {&}
	2787	}
	2788
	2789	# hold window open after commands finish
	2790	if {$expgui(execprompt)} {
	2791	append command "\; echo -n Press Enter to continue \; read x"
	2792	}
	2793	if {$wait && $expgui(autoiconify)} {wm iconify .}
	2794	catch {exec gnome-terminal --title $title \
	2795	-e " /bin/sh -c \" $command \" " $suffix} errmsg
	2796	if $expgui(debug) {puts "gnome-terminal result = $errmsg"}
	2797	if {$expgui(MacroRunning)} {
	2798	update
	2799	update idletasks
	2800	}
	2801	if {$wait} {
	2802	if {$expgui(autoiconify)} {wm deiconify .}
	2803	# check for changes in the .EXP file immediately
	2804	whenidle
	2805	}
[130]	2806	}
[986]	2807	} else {
	2808	MyMessageBox -parent . -title "Error: no terminal program" \
	2809	-message "Error, the xterm or gnome-terminal utility programs could not be found. It is not possible to run the GSAS programs without this." \
	2810	-icon error -type NOT-OK -default not-ok
[130]	2811	}
	2812	}
[775]	2813
[910]	2814	# run commands without a terminal window
	2815	proc runnoterm {command outfile} {
	2816	global env expgui tcl_platform
	2817	if {$tcl_platform(platform) == "windows"} {
	2818	# Windows environment variables
	2819	set env(GSAS) [file nativename $expgui(gsasdir)]
	2820	# PGPLOT_FONT is needed by PGPLOT
[935]	2821	set env(PGPLOT_FONT) [file nativename [file join $expgui(pgplotdir) grfont.dat]]
[910]	2822	# this is the number of lines/page in the .LST (etc.) file
	2823	set env(LENPAGE) 60
	2824	set pwd [file nativename [pwd]]
	2825	# loop over multiple commands
	2826	foreach cmd $command {
	2827	# replace the forward slashes with backward
	2828	regsub -all / $cmd \\ cmd
	2829	exec $cmd >>& $outfile
	2830	update
	2831	update idletasks
	2832	}
	2833	} else {
	2834	# UNIX environment variables
	2835	set env(GSAS) [file nativename $expgui(gsasdir)]
	2836	set env(gsas) [file nativename $expgui(gsasdir)]
	2837	set env(GSASEXE) $expgui(gsasexe)
	2838	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
	2839	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
	2840	# PGPLOT_DIR is needed by PGPLOT
[935]	2841	set env(PGPLOT_DIR) $expgui(pgplotdir)
[910]	2842	# this is the number of lines/page in the .LST (etc.) file
	2843	set env(LENPAGE) 60
	2844	foreach cmd $command {
	2845	catch {eval exec $cmd >>& $outfile} errmsg
	2846	}
	2847	update
	2848	update idletasks
	2849	}
	2850	# check for changes in the .EXP file immediately
	2851	#whenidle
	2852	}
	2853
[983]	2854	proc MacMakeResource {file app} {
	2855	# make a resource file. Note that OS X has gotten picky about the length of this
	2856	set l [string length $app]
	2857	if $::expgui(debug) {puts "$l bytes"}
	2858	incr l
	2859	if $::expgui(debug) {puts "$l bytes after incr"}
	2860	set str "data 'usro' (0) {\n"
	2861	append str " $\""
	2862	append str [format %.8X $l]
	2863	set bytes 4
	2864	foreach char [split $app {}] {
	2865	append str [format %.2X [scan $char %c]]
	2866	}
	2867	incr bytes $l
	2868	set newline 1
	2869	for {set i 0} {$i < [expr 1028-$bytes]} {incr i} {
	2870	if $newline {
	2871	append str "\" \n"
	2872	append str " $\""
	2873	set newline 0
	2874	set j 0
	2875	}
	2876	append str {0000 }
	2877	incr bytes
	2878	incr j 2
	2879	if {$j > 15} {set newline 1}
	2880	}
	2881	if {$l % 2} {
	2882	append str "\"\n "
	2883	} else {
	2884	# even lengths need one more byte
	2885	append str "00\"\n "
	2886	}
	2887	append str "/* $app */\n};\n"
	2888	set fp [open $file w]
	2889	puts $fp $str
	2890	close $fp
	2891	}
	2892
[775]	2893	# modify resource fork info for a .EXP file on the Mac
	2894	proc MacSetResourceFork {expfile} {
	2895	global expgui tcl_platform
	2896	if {$tcl_platform(os) != "Darwin"} {return}
	2897	set expnative [file nativename $expfile]
	2898	#
	2899	# assign an app to the data file, if the app and the
	2900	# required tool (Rez) are installed
[982]	2901	set app [file nativename [file join $expgui(gsasdir) expgui.app]]
	2902	set RezApp {}
[983]	2903	foreach pth "/usr/bin /Developer/Tools $expgui(gsasexe)" {
[982]	2904	if [file exists [set tst [file join $pth Rez]]] {
	2905	set RezApp $tst
	2906	break
	2907	}
[810]	2908	}
[982]	2909	set SetFileApp {}
[983]	2910	foreach pth "/usr/bin /Developer/Tools $expgui(gsasexe)" {
[982]	2911	if [file exists [set tst [file join $pth SetFile]]] {
	2912	set SetFileApp $tst
	2913	break
	2914	}
[810]	2915	}
[982]	2916	if $::expgui(debug) {puts "found app=$app Rez=$RezApp and SetFile=$SetFileApp"}
[810]	2917	if {[file exists $app] && $RezApp != ""} {
[983]	2918	# make resource file
	2919	MacMakeResource setapp.r $app
[982]	2920	if $::expgui(debug) {puts "$RezApp setapp.r -o $expnative -a"}
[810]	2921	exec $RezApp setapp.r -o $expnative -a
[982]	2922	if {! $::expgui(debug)} {
	2923	file delete -force setapp.r
	2924	}
[775]	2925	}
	2926
	2927	# assign an icon to the data file, if it and the required tools exist
[976]	2928	set icon [file join $expgui(gsasexe) gsasicon.r]
[810]	2929	if {[file exists $icon] && $RezApp != "" && $SetFileApp != ""} {
	2930	exec $RezApp [file nativename $icon] -o $expnative -a
	2931	exec $SetFileApp -a C $expnative
[982]	2932	if {$::expgui(debug)} {
	2933	puts "$RezApp [file nativename $icon] -o $expnative -a"
	2934	puts "$SetFileApp -a C $expnative"
	2935	}
	2936	} elseif {$::expgui(debug)} {
	2937	puts "icon=$icon missing?"
[775]	2938	}
	2939	}
[910]	2940
	2941	#-------------------------------------------------------------------------------
	2942	# Macro Recording
	2943	#-------------------------------------------------------------------------------
	2944	set expgui(MacroBufferedCommand) ""
	2945	set expgui(fpMacroFile) ""
	2946	set expgui(MacroFile) ""
	2947	# Turn on/off mode to save commands in MacroFile
	2948	proc SetRecordMacroOnOff {args} {
	2949	global expgui
	2950	if {$expgui(RecordMacro)} {
	2951	set expgui(fpMacroFile) ""
	2952	set expgui(MacroBufferedCommand) ""
	2953	while {$expgui(fpMacroFile) == ""} {
	2954	set expgui(MacroFile) [tk_getSaveFile -initialdir [pwd] \
	2955	-parent . \
	2956	-filetypes {{"EXPGUI Macro file" .expmac}} \
	2957	-defaultextension .expmac \
	2958	-initialfile EXPGUI.expmac \
	2959	-title "Choose location to save macro"]
	2960	if {$expgui(MacroFile) == ""} {
	2961	# respond to cancel
	2962	set expgui(fpMacroFile) ""
	2963	set expgui(MacroFile) ""
	2964	set expgui(RecordMacro) 0
	2965	return
	2966	}
	2967	if {[catch {
	2968	set expgui(fpMacroFile) [open $expgui(MacroFile) w]
	2969	puts $expgui(fpMacroFile) "# [clock format [clock seconds] -format %Y-%m-%dT%T]"
	2970	} errmsg]} {
	2971	MyMessageBox -parent . -title "Error opening selected file" \
	2972	-message "Error opening macro file:\n$errmsg" \
	2973	-icon warning -type TryAgain -default tryagain
	2974	catch {close $expgui(fpMacroFile)}
	2975	set expgui(fpMacroFile) ""
	2976	set expgui(MacroFile) ""
	2977	set expgui(RecordMacro) 0
	2978	}
	2979	}
	2980	} else {
	2981	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
	2982	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
	2983	}
	2984	catch {close $expgui(fpMacroFile)}
	2985	set expgui(fpMacroFile) ""
	2986	set expgui(MacroFile) ""
	2987	set expgui(MacroBufferedCommand) ""
	2988	}
	2989	}
	2990
	2991	# record a command in the Macro File
	2992	proc RecordMacroEntry {command buffer} {
	2993	global expgui
	2994	if {! $expgui(RecordMacro)} return
	2995	# in buffered mode: hold the last command in memory and compare to the
	2996	# next. If two commands differ only in the final argument, then the
	2997	# second command makes the previous redundant so only the latter version
	2998	# is retained (This will happen when a user types a string into a box).
	2999	# When the commands differ, then the previous is written to file
	3000	# and the next is retained in memory.
	3001	if {$buffer} {
	3002	if {[string trim $expgui(MacroBufferedCommand)] == ""} {
	3003	set expgui(MacroBufferedCommand) $command
	3004	return
	3005	}
	3006	set diff 0
	3007	# is command a repeat of previous?
	3008	foreach a $command b $expgui(MacroBufferedCommand) {
	3009	if {$diff} {
	3010	# found a difference, other than in the last arg
	3011	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
	3012	break
	3013	}
	3014	if {$a != $b} {set diff 1}
	3015	}
	3016	set expgui(MacroBufferedCommand) $command
	3017	} else {
	3018	# no buffering on current command; write the old and new to file.
	3019	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
	3020	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
	3021	}
	3022	puts $expgui(fpMacroFile) $command
	3023	set expgui(MacroBufferedCommand) ""
	3024	}
	3025	}
	3026
	3027	proc CantRecordMacroEntry {comment} {
	3028	global expgui
	3029	if {! $expgui(RecordMacro)} return
	3030
	3031	# no buffering on current command; write the old and new to file.
	3032	if {[string trim $expgui(MacroBufferedCommand)] != ""} {
	3033	puts $expgui(fpMacroFile) $expgui(MacroBufferedCommand)
	3034	}
	3035	puts $expgui(fpMacroFile) "# unrecorded: $comment"
	3036	set expgui(MacroBufferedCommand) ""
	3037	MyMessageBox -parent . -title "No command record" \
	3038	-message "EXPGUI is not able to record this action in the macro file: $comment" \
	3039	-icon warning
	3040	}
	3041
	3042
	3043	# Play back commands in Macro File
	3044	proc ReplayMacroFile {"lineatatime 0"} {
	3045	global expgui
	3046	set expnam [file root [file tail $expgui(expfile)]]
	3047	file delete abort_${expnam}_macro.flag
	3048	set expgui(MacroRunning) 0
	3049	set MacroFile [tk_getOpenFile -initialdir [pwd] \
	3050	-parent . \
	3051	-filetypes {{"EXPGUI Macro file" .expmac} {Everything .*}} \
	3052	-defaultextension .expmac \
	3053	-title "Choose location to read macro"]
	3054	if {$MacroFile == ""} return
	3055	set expgui(MacroRunning) 1
	3056	if {$lineatatime} {
	3057	set expgui(MacroChanged) 0
	3058	set top1 .macro
	3059	catch {destroy $top1}
	3060	toplevel $top1
	3061	set txt $top1.t
	3062	grid [text $txt -width 30 -height 20 -yscrollcommand "$top1.s set"] \
	3063	-column 0 -row 0 -sticky news
	3064	wm title $top1 "File $MacroFile"
	3065	grid [scrollbar $top1.s -command "$txt yview"] \
	3066	-column 1 -row 0 -sticky ns
	3067	grid [frame $top1.b] -column 0 -columnspan 2 -row 1 -sticky ew
	3068	grid columnconfig $top1 0 -weight 1
	3069	grid rowconfig $top1 0 -weight 1
	3070	grid [button $top1.b.e -text "Execute line" \
	3071	-command "MacroExecuteCurrentLine $txt"] \
	3072	-column 0 -row 0 -sticky w
	3073	grid columnconfig $top1.b 1 -weight 1
	3074	grid [button $top1.b.s -text "Save As" -state disabled \
	3075	-command "MacroResave $txt"] -column 1 -row 0
	3076	set expgui(MacroSaveButton) $top1.b.s
	3077	grid [button $top1.b.c -text "Close " \
	3078	-command "MacroCloseWindow $txt"] -column 2 -row 0
	3079	$txt delete 0.0 end
	3080	set fp [open $MacroFile r]
	3081	$txt insert 0.0 [read $fp]
	3082	close $fp
	3083	MacroHighlightText $txt 1
	3084	# deal with editing in the box
	3085	$txt configure -undo 1
	3086	$txt edit modified 0
	3087	bind $txt <<Modified>> {
	3088	$expgui(MacroSaveButton) configure -state normal
	3089	set expgui(MacroChanged) 1
	3090	}
	3091	} else {
	3092	close [open running_${expnam}_macro.flag w]
	3093	set saveprompt $expgui(execprompt)
	3094	set saveautold $expgui(autoexpload)
	3095	set expgui(execprompt) 0
	3096	set expgui(autoexpload) 1
	3097	set expnam [file root [file tail $expgui(expfile)]]
	3098	if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
	3099	set outfile ${expnam}_macout.LST
	3100	# create an empty file
	3101	catch {file delete $outfile}
	3102	close [open $outfile w]
	3103	# view it with LSTVIEW
	3104	set outfile ${expnam}_macout
	3105	exec $::wishshell [file join $expgui(scriptdir) lstview] $outfile &
	3106	} else {
	3107	# show status, offer abort with MACROMON
	3108	exec $::wishshell [file join $expgui(scriptdir) macromon] $expnam &
	3109	}
	3110
	3111	set expgui(MacroStatus) "starting script"
	3112	pleasewait "\nrunning macro\n\nStatus:" expgui(MacroStatus)
	3113
	3114	if {[catch {
	3115	source $MacroFile
	3116	} errmsg]} {
	3117	set txt $::errorInfo
	3118	catch {
	3119	set fp [open error.txt a]
	3120	puts $fp "# [clock format [clock seconds] -format %Y-%m-%dT%T]"
	3121	puts $fp $txt
	3122	close $fp
	3123	}
	3124	donewait
	3125	MyMessageBox -parent . -title "Error running Macro file" \
	3126	-message "Error running macro file:\n$errmsg\n(details in file error.txt)" \
	3127	-icon error -type OK -default ok
	3128	} else {
	3129	donewait
	3130	}
	3131	file delete running_${expnam}_macro.flag
	3132	set expgui(execprompt) $saveprompt
	3133	set expgui(autoexpload) $saveautold
	3134	set expgui(MacroRunning) 0
	3135	# show changes
	3136	PaintEXPGUIpages
	3137	# put comment in output file
	3138	if {$expgui(MacroRunning) && !$expgui(ShowGENLES)} {
	3139	set outfile ${expnam}_macout.LST
	3140	set fp [open $outfile a]
	3141	puts $fp "\n** Macro ended **"
	3142	close $fp
	3143	}
	3144	}
	3145	}
	3146
	3147	# highlight a line in the Macro file display
	3148	proc MacroHighlightText {txt line} {
	3149	$txt tag delete next
	3150	$txt tag add next $line.0 $line.end
	3151	$txt see $line.0
	3152	$txt tag configure next -background yellow
	3153	# tag all text
	3154	$txt tag delete all
	3155	$txt tag add all 0.0 end
	3156	# double-click moves the current line
	3157	$txt tag bind all <Double-1> "after idle [list MacroDoubleClick $txt]"
	3158	}
	3159
	3160	# respond to a double click by moving the next line to be executed to
	3161	# the line where the double click occurred
	3162	proc MacroDoubleClick {txt} {
	3163	set line [lindex [split [$txt tag ranges sel] "."] 0]
	3164	MacroHighlightText $txt $line
	3165	}
	3166
	3167	# respond to Execute button: execute the current line
	3168	# close window after last command
	3169	proc MacroExecuteCurrentLine {txt} {
	3170	global expgui
	3171	set linenum [lindex [split [$txt tag ranges next] "."] 0]
	3172	if {$linenum == ""} {return}
	3173	set line [$txt get $linenum.0 $linenum.end]
	3174	# is this continued (ends with \)?
	3175	while {[string range $line end end] == "\\" } {
	3176	incr linenum
	3177	# get rid of trailing backslash
	3178	set line [string range $line 0 end-1]
	3179	#append next line
	3180	append line [$txt get $linenum.0 $linenum.end]
	3181	}
	3182	if {[catch $line errmsg]} {
	3183	MyMessageBox -parent $txt -title "Error on line" \
	3184	-message "Error on line $linenum:\n$errmsg" \
	3185	-icon warning -type Continue -default continue
	3186	}
	3187	# show changes
	3188	PaintEXPGUIpages
	3189	# move forward in macrofile
	3190	incr linenum
	3191	MacroHighlightText $txt $linenum
	3192	set linenum [lindex [split [$txt tag ranges next] "."] 0]
	3193	# at end?
	3194	if {$linenum == ""} {MacroCloseWindow $txt}
	3195	}
	3196
	3197	# Save a modified macro file
	3198	proc MacroResave {txt} {
	3199	global expgui
	3200	set MacroFile [tk_getSaveFile -initialdir [pwd] \
	3201	-parent $txt \
	3202	-filetypes {{"EXPGUI Macro file" .expmac}} \
	3203	-defaultextension .expmac \
	3204	-initialfile $expgui(MacroFile) \
	3205	-title "Choose location to save macro"]
	3206	if {[string trim $MacroFile] == ""} {return}
	3207	if {[catch {
	3208	set fp [open $MacroFile w]
	3209	puts $fp [string trim [$txt get 0.0 end]]
	3210	close $fp
	3211	} errmsg]} {
	3212	MyMessageBox -parent $txt -title "Error writing to file" \
	3213	-message "Error writing macro file:\n$errmsg" \
	3214	-icon warning -type TryAgain -default tryagain
	3215	return
	3216	}
	3217	set expgui(MacroChanged) 0
	3218	# gray out the button
	3219	$expgui(MacroSaveButton) configure -state disabled
	3220	}
	3221
	3222	# close the window, but provide a chance to save the file first, if modified
	3223	proc MacroCloseWindow {txt} {
	3224	global expgui
	3225	if {$expgui(MacroChanged)} {
	3226	set ans [MyMessageBox -parent $txt -title "Save macro file?" \
	3227	-message "Macro file has been changed, do you want to save it?" \
	3228	-icon warning -type "Yes No" -default no]
	3229	if {$ans != "no"} {MacroResave $txt}
	3230	}
	3231	set expgui(MacroRunning) 0
	3232	destroy [winfo toplevel $txt]
	3233	}
	3234
	3235	# Add a comment to a macro file
	3236	proc AddCommentMacroFile {} {
	3237	global expgui
	3238	if {! $expgui(RecordMacro)} return
	3239	RecordMacroEntry "# [getstring "comment for macro file"]" 0
[949]	3240	}
	3241
	3242	#------------------------------------------------------------------------------
	3243	# Subversion support routines
	3244	#------------------------------------------------------------------------------
	3245	# is there a subversion stub and can we find the svn program
	3246	proc CheckUpdateImplemented {scriptdir} {
	3247	#is there a svn directory in the source?
	3248	if {! [file exists [file join $scriptdir .svn]]} {return 0}
	3249	# can we find svn in the path?
	3250	if {[auto_execok svn] != ""} {return 1}
	3251	# add a locally supplied svn version, if not in the path already
[985]	3252	set pathlist "[file join $scriptdir svn bin]"
	3253	lappend pathlist "/sw/bin/"
	3254	lappend pathlist "/opt/local/bin/"
	3255	catch {lappend pathlist $::expgui(pathlist)}
	3256	foreach localsvn $pathlist {
	3257	if {[file exists $localsvn]} {
	3258	if {$::tcl_platform(platform) == "windows"} {
	3259	set localsvn [file nativename $localsvn]
	3260	set sep {;}
	3261	} else {
	3262	set sep {:}
	3263	}
	3264	if {[lsearch [split $::env(PATH) $sep] $localsvn] == -1} {
	3265	append ::env(PATH) $sep $localsvn
	3266	auto_reset
	3267	if {[auto_execok svn] != ""} {return 1}
	3268	}
[949]	3269	}
	3270	}
	3271	return 0
	3272	}
	3273
	3274	proc GetSVNVersion {scriptdir} {
	3275	set SVN [auto_execok svn]
	3276	if {$SVN != ""} {
	3277	if {! [catch {set res [exec $SVN info $scriptdir]} err]} {
	3278	set infolist [split $res]
	3279	set pos [lsearch $infolist "Revision:"]
	3280	return "EXPGUI SVN version [lindex $infolist [incr pos]]"
	3281	}
	3282	}
	3283	return "EXPGUI version: $::expgui(Revision)"
	3284	}
	3285
	3286	proc GetSVNrepository {scriptdir} {
	3287	set SVN [auto_execok svn]
	3288	if {$SVN != ""} {
	3289	if {! [catch {set res [exec $SVN info $scriptdir]} err]} {
	3290	set infolist [split $res]
	3291	set pos [lsearch $infolist "URL:"]
	3292	return [lindex $infolist [incr pos]]
	3293	}
	3294	}
	3295	return {}
	3296	}
	3297
	3298	proc SetSVNbranch {branch} {
	3299	# reset the track label
	3300	set ::command(SVNversion) [lindex [split [GetSVNrepository $::expgui(scriptdir)] '/'] end]
	3301	set SVN [auto_execok svn]
	3302	if {$SVN == ""} {
	3303	return 0
	3304	}
	3305	set curURL [GetSVNrepository $expgui(scriptdir)]
	3306	set curbranch [lindex [split $curURL '/'] end]
	3307	if {$curbranch == $branch} {return 0}
	3308	if {$branch == "trunk"} {
	3309	set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/trunk"
	3310	set lbl development
	3311	} elseif {$branch == "stable"} {
	3312	set newURL "https://subversion.xor.aps.anl.gov/EXPGUI/tags/stable"
	3313	set lbl standard
	3314	} else {
	3315	MyMessageBox -parent . -title "Internal error" \
	3316	-message "No $branch track." -icon error
	3317	return 0
	3318	}
	3319	set msg {Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.}
	3320	if {[MyMessageBox -parent . -title "Ready to switch" \
	3321	-message "Ready to update to the $lbl track.\n\n$msg" \
	3322	-type {Cancel "Update & Restart"} -default cancel -icon warning
	3323	] == "cancel"} {return}
	3324	if {[confirmBeforeSave] == "Cancel"} return
	3325
	3326	# do a quiet cleanup. Sometimes needed after install, and never hurts
	3327	if [catch {set res [exec $SVN cleanup $::expgui(scriptdir)]} err] {
	3328	MyMessageBox -parent . -title "Error in cleanup" \
	3329	-message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
	3330	-icon error
	3331	}
	3332
	3333	# switch the source
	3334	set cmd1 "$SVN switch $newURL $scriptdir"
	3335	if [catch {set res1 [exec $SVN switch $newURL $::expgui(scriptdir)]} err] {
	3336	MyMessageBox -parent . -title "Error updating" \
	3337	-message "Error performing update:\n$err" \
	3338	-icon error
	3339	return 0
	3340	}
	3341	set msg "Results from update:\n$cmd1\n$res1"
	3342	# update done, now need to "reboot"
	3343	MyMessageBox -parent . -title "Updating done" -icon info \
	3344	-message "Update Complete\nPress OK to restart EXPGUI\n\n$msg"
	3345	exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &
	3346	exit
	3347	}
	3348
	3349	proc CheckAndDoUpdate { } {
	3350	set SVN [auto_execok svn]
	3351	if {$SVN == ""} {
	3352	tk_dialog .msg "Error: no svn" \
	3353	"Error: SVN not found. Should not happen." \
	3354	error 0 OK
	3355	return
	3356	}
	3357	#set wish "[info nameofexecutable]"
	3358	# check for updates
[988]	3359	if [catch {
[989]	3360	set res [exec $SVN status [file normalize $::expgui(gsasdir)] -u]
[988]	3361	} err] {
[989]	3362	set ans [MyMessageBox -parent . -title "Error checking status" \
	3363	-message "Error checking for updates: $err\n\nTry to update manually?" \
	3364	-icon error -type "Yes No" -default yes]
	3365	if {$ans != "no"} {
	3366	forknewterm "manually update in subversion" \
	3367	"$SVN update [file normalize $::expgui(gsasdir)]"
	3368	}
[949]	3369	return
	3370	} else {
	3371	if {[string first "*" $res] == -1} {
	3372	MyMessageBox -parent . -title "No updates" \
	3373	-message "GSAS/EXPGUI appears up-to-date" \
	3374	-icon info
	3375	return
	3376	}
	3377	}
	3378	if {[MyMessageBox -parent . -title "Ready to Update" \
	3379	-message {
	3380	Updates to GSAS/EXPGUI found.
	3381
	3382	Press the "Update & Restart" button to begin the update process. After the update completes, EXPGUI will be restarted.} \
	3383	-type {Cancel "Update & Restart"} -default cancel -icon warning
	3384	] == "cancel"} {return}
	3385
	3386	if {[confirmBeforeSave] == "Cancel"} return
	3387
	3388	# special upgrade for windows, where the wish exec blocks upgrade of the exe directory
	3389	if {$::tcl_platform(platform) == "windows" && $::tcl_platform(os) != "Windows 95"} {
	3390	# create a batch file
	3391	set out [file normalize ~/expgui_update.bat]
	3392	set fp [open [file normalize ~/expgui_update.bat] w]
	3393	puts $fp "@echo *"
	3394	puts $fp "@echo ******************************************************************"
[955]	3395	puts $fp "@echo Preparing to start upgrade of EXPGUI."
[949]	3396	puts $fp "@pause"
[956]	3397	puts $fp "$SVN cleanup $::expgui(gsasdir)"
	3398	puts $fp "$SVN up $::expgui(gsasdir)"
[949]	3399	puts $fp "@echo *"
	3400	puts $fp "@echo ******************************************************************"
	3401	puts $fp "@echo Upgrade is complete. This window will close and EXPGUI will restart."
	3402	puts $fp "@pause"
[955]	3403	puts $fp "$::env(COMSPEC) /c \"start [info nameofexecutable] \
[958]	3404	[file attributes [file normalize $::expgui(script)] -shortname] \
[955]	3405	[file attributes [file normalize $::expgui(expfile)] -shortname] \""
[949]	3406	puts $fp "exit"
	3407	close $fp
	3408	#run the batch file
	3409	exec $::env(COMSPEC) /c "start [file nativename [file attributes $out -shortname]]" &
	3410	exit
	3411	}
	3412
	3413	# do a quiet cleanup. Sometimes needed after install, and never hurts
[956]	3414	if [catch {set res [exec $SVN cleanup $::expgui(gsasdir)]} err] {
[949]	3415	MyMessageBox -parent . -title "Error in cleanup" \
	3416	-message "Error performing cleanup. Will try to continue anyway. Error:\n$err" \
	3417	-icon error
	3418	}
[956]	3419	if [catch {set res [exec $SVN up $::expgui(gsasdir)]} err] {
[949]	3420	MyMessageBox -parent . -title "Error updating" \
	3421	-message "Error performing update:\n$err" \
	3422	-icon error
	3423	return
	3424	} else {
	3425	MyMessageBox -parent . -title "Updating done" \
	3426	-message "Results from update:\n$res\n\nPress OK to restart EXPGUI" \
	3427	-icon info
	3428	}
	3429	exec [info nameofexecutable] [file normalize $::expgui(script)] [file normalize $::expgui(expfile)] &
	3430	exit
	3431	}

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

Download in other formats: