Context Navigation

source: trunk/gsascmds.tcl @ 201

Last change on this file since 201 was 201, checked in by toby, 11 years ago
# on 2000/06/09 03:52:16, toby did: Add warning when PGPLOT font file is not found
Property rcs:author set to `toby` Property rcs:date set to `2000/06/09 03:52:16` Property rcs:lines set to `+7 -1` Property rcs:rev set to `1.19` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 55.6 KB

Rev	Line
[83]	1	# $Id: gsascmds.tcl 201 2009-12-04 23:02:05Z toby $
[17]	2	# platform-specific code
	3	if {$tcl_platform(platform) == "windows"} {
	4	if [catch {package require winexec}] {
	5	tk_dialog .err "WINEXEC Error" \
	6	"Error -- Unable to load the WINEXEC package. This is needed in Win95 machines" \
	7	error 0 Quit
	8	destroy .
	9	}
[201]	10	if ![file exists [file join $expgui(gsasdir) fonts grfont.dat]] {
	11	tk_dialog .err "PGPLOT Error" \
	12	"Warning -- Unable to find file GRFONT.DAT. GSAS graphics will not work. Is GSAS correctly installed?" \
	13	warning 0 "Limp Ahead"
	14	}
	15
[17]	16	if {$tcl_platform(os) == "Windows 95" \|\| $tcl_platform(os) == "Windows 98" } {
[29]	17	# this creates a DOS box to run a program in
[17]	18	proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
[22]	19	global env expgui
	20	# Windows environment variables
	21	# -95 does not seem to be able to use these
[29]	22	set env(GSAS) [file nativename $expgui(gsasdir)]
[22]	23	# PGPLOT_FONT is needed by PGPLOT
	24	set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]]
	25	# this is the number of lines/page in the .LST (etc.) file
	26	set env(LENPAGE) 60
[17]	27	set pwd [file nativename [pwd]]
	28
	29	# check the path -- can DOS use it?
	30	if {[string first // [pwd]] != -1} {
	31	tk_dialog .braindead "Invalid Path" \
	32	{Error -- Use "Map network drive" to access this directory with a letter (e.g. F:) \
	33	Win-95 can't directly access a network drive in DOS} error 0 OK
	34	return
	35	}
	36	# all winexec commands are background commands
	37	# if $background
	38
	39	# pause is hard coded in the .BAT file
	40	#if $wait {
	41	# append command " pause"
	42	#}
	43
	44	# replace the forward slashes with backward
	45	regsub -all / $command \\ command
	46	# Win95 does not seem to inherit the environment from Tcl env vars
	47	# so define it in the .BAT file
	48	winexec -d [file nativename [pwd]] \
	49	[file join $expgui(scriptdir) gsastcl.bat] \
	50	"[file nativename $expgui(gsasdir)] $command"
	51	}
	52	} else {
	53	# now for - brain-dead Windows-NT
[29]	54	# this creates a DOS box to run a program in
[17]	55	proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
[22]	56	global env expgui
	57	# Windows environment variables
[29]	58	set env(GSAS) [file nativename $expgui(gsasdir)]
[22]	59	# PGPLOT_FONT is needed by PGPLOT
	60	set env(PGPLOT_FONT) [file nativename [file join $expgui(gsasdir) fonts grfont.dat]]
	61	# this is the number of lines/page in the .LST (etc.) file
	62	set env(LENPAGE) 60
	63	# all winexec commands are background commands -- ignore background arg
[17]	64	# can't get pause to work! -- ignore wait
	65
	66	set prevcmd {}
	67	foreach cmd $command {
	68	if {$prevcmd != ""} {
	69	tk_dialog .done_yet Confirm "Press OK to start command $cmd" "" 0 OK
	70	}
	71	# replace the forward slashes with backward
	72	regsub -all / $cmd \\ cmd
	73	# cmd.exe must be in the path -- lets hope that at least works!
	74	winexec -d [file nativename [pwd]] cmd.exe "/c $cmd"
	75	set prevcmd $cmd
	76	}
	77	}
	78	}
	79	} else {
	80	if [catch {set env(GSASBACKSPACE)}] {set env(GSASBACKSPACE) 1}
	81
[29]	82	# this creates a xterm window to run a program in
[17]	83	proc forknewterm {title command "background 0" "scrollbar 1" "wait 1"} {
[22]	84	global env expgui
	85	# UNIX environment variables
	86	set env(GSASEXE) $expgui(gsasexe)
	87	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
	88	set env(ATMXSECT) [file join $expgui(gsasdir) data atmxsect.dat]
	89	# PGPLOT_DIR is needed by PGPLOT
	90	set env(PGPLOT_DIR) [file join $expgui(gsasdir) pgl]
	91	# this is the number of lines/page in the .LST (etc.) file
	92	set env(LENPAGE) 60
[17]	93	set termopts {}
	94	if $env(GSASBACKSPACE) {
	95	append termopts \
	96	{-xrm "xterm*VT100.Translations: #override\\n <KeyPress>BackSpace: string(\\177)"}
	97	}
	98	if $scrollbar {
	99	append termopts " -sb"
	100	} else {
	101	append termopts " +sb"
	102	}
	103	if $background {
	104	set suffix {&}
	105	} else {
	106	set suffix {}
	107	}
	108	#
	109	if $wait {
	110	append command "\; echo -n Press Enter to continue \; read x"
	111	}
	112	if !$background {wm iconify .}
[22]	113	catch {eval exec xterm $termopts -title [list $title] \
	114	-e /bin/sh -c [list $command] $suffix} errmsg
	115	if $expgui(debug) {puts "xterm result = $errmsg"}
[17]	116	if !$background {wm deiconify .}
	117	}
	118	}
	119
[29]	120	# get a value in a modal toplevel
[17]	121	proc getstring {what "chars 40" "quit 1" "initvalue {}"} {
	122	global expgui expmap
	123	set w .global
	124	catch {destroy $w}
	125	toplevel $w -bg beige
	126	wm title $w "Input $what"
	127	set expgui(temp) {}
	128	pack [frame $w.0 -bd 6 -relief groove -bg beige] \
	129	-side top -expand yes -fill both
	130	grid [label $w.0.a -text "Input a value for the $what" \
	131	-bg beige] \
	132	-row 0 -column 0 -columnspan 10
	133	grid [entry $w.0.b -textvariable expgui(temp) -width $chars] \
	134	-row 1 -column 0
	135
	136	set expgui(temp) $initvalue
	137	pack [frame $w.b] -side top
	138	pack [button $w.b.2 -text Set -command "destroy $w"] -side left
	139	if $quit {
	140	pack [button $w.b.3 -text Quit \
	141	-command "set expgui(temp) {}; destroy $w"] -side left
	142	}
[91]	143	bind $w <Return> "destroy $w"
	144
[17]	145	# force the window to stay on top
[91]	146	putontop $w
[17]	147
	148	focus $w.b.2
	149	tkwait window $w
[91]	150	afterputontop
	151
[17]	152	return $expgui(temp)
	153	}
	154
[29]	155	# run a GSAS program that does not require an experiment file
[17]	156	proc runGSASprog {proglist} {
	157	global expgui tcl_platform
	158	set cmd {}
	159	foreach prog $proglist {
	160	if {$tcl_platform(platform) == "windows"} {
	161	append cmd " \"$expgui(gsasexe)/${prog}.exe \" "
	162	} else {
	163	if {$cmd != ""} {append cmd "\;"}
	164	append cmd "[file join $expgui(gsasexe) $prog]"
	165	}
	166	}
	167	forknewterm $prog $cmd 0 1 1
	168	}
	169
[29]	170	# run a GSAS program that requires an experiment file for input/output
[182]	171	proc runGSASwEXP {proglist "concurrent 0"} {
[17]	172	global expgui tcl_platform
	173	# Save the current exp file
	174	savearchiveexp
[91]	175	# load the changed .EXP file automatically?
	176	if {$expgui(autoexpload)} {
	177	# disable the file changed monitor
	178	set expgui(expModifiedLast) 0
	179	}
[17]	180	set cmd {}
	181	set expnam [file root [file tail $expgui(expfile)]]
	182	foreach prog $proglist {
	183	if {$prog == "expedt" && $expgui(archive)} archiveexp
	184	if {$tcl_platform(platform) == "windows"} {
	185	append cmd " \"$expgui(gsasexe)/${prog}.exe $expnam \" "
	186	} else {
	187	if {$cmd != ""} {append cmd "\;"}
	188	append cmd "[file join $expgui(gsasexe) $prog] $expnam"
	189	}
	190	}
[182]	191	forknewterm "$prog -- $expnam" $cmd $concurrent 1 1
[91]	192	# load the changed .EXP file automatically?
	193	if {$expgui(autoexpload)} {
	194	# load the revised exp file
	195	loadexp $expgui(expfile)
	196	}
[17]	197	}
	198
[29]	199	# run liveplot
[17]	200	proc liveplot {} {
	201	global expgui liveplot wishshell
	202	set expnam [file root [file tail $expgui(expfile)]]
	203	exec $wishshell [file join $expgui(scriptdir) liveplot] \
[29]	204	$expnam $liveplot(hst) $liveplot(legend) &
[17]	205	}
	206
[29]	207	# run lstview
[17]	208	proc lstview {} {
	209	global expgui wishshell
	210	set expnam [file root [file tail $expgui(expfile)]]
	211	exec $wishshell [file join $expgui(scriptdir) lstview] $expnam &
	212	}
	213
[29]	214	# run widplt
[17]	215	proc widplt {} {
	216	global expgui wishshell
[29]	217	exec $wishshell [file join $expgui(scriptdir) widplt] \
	218	$expgui(expfile) &
[17]	219	}
	220
[29]	221	# show help information
[17]	222	proc showhelp {} {
	223	global expgui_helplist helpmsg
	224	set helpmsg {}
	225	set frm .help
	226	catch {destroy $frm}
	227	toplevel $frm
	228	wm title $frm "Command Help"
	229	pack [message $frm.0 -text \
	230	"Click on an entry below to see help on a GSAS command" ] \
	231	-side top
	232	pack [frame $frm.a -width 20 -height 15] \
	233	-side top -expand yes -fill both
	234	pack [message $frm.help -textvariable helpmsg -relief groove] \
	235	-side left -fill both -expand yes
	236	set lst [array names expgui_helplist]
	237	listbox $frm.a.cmds -relief raised -bd 2 -yscrollcommand \
	238	"$frm.a.scroll set" -height 15 -width 0
	239	scrollbar $frm.a.scroll -command "$frm.a.cmds yview"
	240	foreach item [lsort $lst] {
	241	$frm.a.cmds insert end $item
	242	}
	243	if {[$frm.a.cmds curselection] == ""} {$frm.a.cmds selection set 0}
	244	button $frm.a.done -text Done -command "destroy $frm"
	245	bind $frm.a.cmds <ButtonRelease-1> \
	246	"+set helpmsg \$expgui_helplist(\[$frm.a.cmds get \[$frm.a.cmds curselection\]\])"
	247	pack $frm.a.scroll -side left -fill y
	248	pack $frm.a.cmds -side left -expand yes -anchor w
	249	pack $frm.a.done -side right -expand no
	250	# get the size of the window and expand the message boxes to match
	251	update
	252	set width [lindex [split [wm geometry $frm] x+] 0]
	253	$frm.0 config -width $width
	254	$frm.help config -width $width
	255	# waitdone $frm
	256	}
	257
[59]	258	# compute the composition for each phase and display in a toplevel
	259	proc composition {} {
	260	global expmap expgui
	261	set Z 1
[130]	262	foreach phase $expmap(phaselist) type $expmap(phasetype) {
	263	if {$type > 2} continue
[59]	264	catch {unset total}
	265	foreach atom $expmap(atomlist_$phase) {
	266	set type [atominfo $phase $atom type]
	267	set mult [atominfo $phase $atom mult]
	268	if [catch {set total($type)}] {
	269	set total($type) [expr \
	270	$mult * [atominfo $phase $atom frac]]
	271	} else {
	272	set total($type) [expr $total($type) + \
	273	$mult * [atominfo $phase $atom frac]]
	274	}
	275	if {$mult > $Z} {set Z $mult}
	276	}
[119]	277	append text "\nPhase $phase\n"
	278	append text " Unit cell contents\n"
[59]	279	foreach type [lsort [array names total]] {
	280	append text " $type[format %8.3f $total($type)]"
	281	}
[119]	282	append text "\n\n"
[130]	283
[119]	284	append text " Asymmetric Unit contents (Z=$Z)\n"
[59]	285	foreach type [lsort [array names total]] {
	286	append text " $type[format %8.3f [expr $total($type)/$Z]]"
	287	}
	288	append text "\n"
	289	}
	290
	291	catch {destroy .comp}
	292	toplevel .comp
	293	wm title .comp Composition
	294	pack [label .comp.results -text $text \
	295	-font $expgui(coordfont) -justify left] -side top
	296	pack [frame .comp.box] -side top
	297	pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
	298	set lstnam [string toupper [file tail [file rootname $expgui(expfile)].LST]]
	299	pack [button .comp.box.2 -text "Save to $lstnam file" \
	300	-command "writelst [list $text] ; destroy .comp"] -side left
	301	}
	302
	303	# write text to the .LST file
	304	proc writelst {text} {
	305	global expgui
	306	set lstnam [file rootname $expgui(expfile)].LST
	307	set fp [open $lstnam a]
	308	puts $fp "\n-----------------------------------------------------------------"
	309	puts $fp $text
	310	puts $fp "-----------------------------------------------------------------\n"
	311	close $fp
	312	}
	313
	314	# save coordinates in an MSI .xtl file
	315	proc exp2xtl {} {
	316	global expmap expgui
	317	catch {destroy .export}
	318	toplevel .export
	319	wm title .export "Export coordinates"
	320	pack [label .export.lbl -text "Export coordinates in MSI .xtl format"\
	321	] -side top -anchor center
	322	pack [frame .export.ps] -side top -anchor w
	323	pack [label .export.ps.lbl -text "Select phase: "] -side left
[130]	324	foreach num $expmap(phaselist) type $expmap(phasetype) {
[59]	325	pack [button .export.ps.$num -text $num \
[130]	326	-command "SetExportPhase $num"] -side left
	327	if {$type == 4} {
	328	.export.ps.$num config -state disabled
	329	}
[59]	330	}
	331	pack [frame .export.sg] -side top
	332	pack [label .export.sg.1 -text "Space Group: "] -side left
	333	pack [entry .export.sg.2 -textvariable expgui(export_sg) -width 8] -side left
	334	pack [checkbutton .export.sg.3 -variable expgui(export_orig) -text "Origin 2"] -side left
	335	pack [frame .export.but] -side top
	336	if {[llength $expmap(phaselist)] > 0} {
	337	pack [button .export.but.1 -text Write -command writextl] -side left
	338	SetExportPhase [lindex $expmap(phaselist) 0]
	339	}
	340	pack [button .export.but.2 -text Quit -command "destroy .export"] -side left
	341	}
	342
	343	proc SetExportPhase {phase} {
	344	global expmap expgui
[130]	345	foreach n $expmap(phaselist) type $expmap(phasetype) {
	346	if {$n == $phase && $type != 4} {
[59]	347	.export.ps.$n config -relief sunken
[130]	348	set expgui(export_phase) $phase
	349	# remove spaces from space group
	350	set spacegroup [phaseinfo $phase spacegroup]
	351	if {[string toupper [string range $spacegroup end end]] == "R"} {
	352	set spacegroup [string range $spacegroup 0 \
	353	[expr [string length $spacegroup]-2]]
	354	}
	355	regsub -all " " $spacegroup "" expgui(export_sg)
[59]	356	} else {
	357	.export.ps.$n config -relief raised
	358	}
	359	}
	360	}
	361
	362
	363	proc writextl {} {
	364	global expgui expmap
	365	if ![catch {
	366	set phase $expgui(export_phase)
	367	set origin $expgui(export_orig)
	368	set spsymbol $expgui(export_sg)
	369	} errmsg] {
	370	set errmsg {}
	371	if {$phase == ""} {
	372	set errmsg "Error: invalid phase number $phase"
	373	} elseif {$spsymbol == ""} {
	374	set errmsg "Error: invalid Space Group: $spsymbol"
	375	}
	376	}
	377	if {$errmsg != ""} {
	378	tk_dialog .errorMsg "Export error" $errmsg warning 0 "OK"
	379	return
	380	}
	381
	382	if [catch {
	383	set filnam [file rootname $expgui(expfile)]_${phase}.xtl
	384	set spacegroup [phaseinfo $phase spacegroup]
	385	set fp [open $filnam w]
	386	puts $fp "TITLE from $expgui(expfile)"
	387	puts $fp "TITLE history [string trim [lindex [exphistory last] 1]]"
	388	puts $fp "TITLE phase [phaseinfo $phase name]"
	389	puts $fp "CELL"
	390	puts $fp " [phaseinfo $phase a] [phaseinfo $phase b] [phaseinfo $phase c] [phaseinfo $phase alpha] [phaseinfo $phase beta] [phaseinfo $phase gamma]"
	391
	392	puts $fp "Symmetry Label $spsymbol"
	393	set rhomb 0
	394	if {[string toupper [string range $spacegroup end end]] == "R"} {
	395	set rhomb 1
	396	}
	397	if $origin {
	398	puts $fp "Symmetry Qualifier origin_2"
	399	}
	400	if $rhomb {
	401	puts $fp "Symmetry Qualifier rhombohedral"
	402	}
	403
	404	# are there anisotropic atoms?
	405	set aniso 0
	406	foreach atom $expmap(atomlist_$phase) {
	407	if {[atominfo $phase $atom temptype] == "A"} {set aniso 1}
	408	}
	409	puts $fp "ATOMS"
	410	if $aniso {
	411	puts $fp "NAME X Y Z OCCUP U11 U22 U33 U12 U13 U23"
	412	foreach atom $expmap(atomlist_$phase) {
	413	set label [atominfo $phase $atom label]
	414	# remove () characters
	415	if {[atominfo $phase $atom temptype] == "A"} {
	416	puts $fp "$label [atominfo $phase $atom x] \
	417	[atominfo $phase $atom y] [atominfo $phase $atom z] \
	418	[atominfo $phase $atom frac] \
	419	[atominfo $phase $atom U11] \
	420	[atominfo $phase $atom U22] \
	421	[atominfo $phase $atom U33] \
	422	[atominfo $phase $atom U12] \
	423	[atominfo $phase $atom U13] \
	424	[atominfo $phase $atom U23]"
	425	} else {
	426	puts $fp "$label [atominfo $phase $atom x] \
	427	[atominfo $phase $atom y] [atominfo $phase $atom z] \
	428	[atominfo $phase $atom frac] \
	429	[atominfo $phase $atom Uiso] \
	430	[atominfo $phase $atom Uiso] \
	431	[atominfo $phase $atom Uiso] \
	432	0 0 0 "
	433	}
	434	}
	435	} else {
	436	puts $fp "NAME X Y Z UISO OCCUP"
	437	foreach atom $expmap(atomlist_$phase) {
	438	set label [atominfo $phase $atom label]
	439	# remove () characters
	440	regsub -all "\[()\]" $label "" label
	441	puts $fp "$label [atominfo $phase $atom x] \
	442	[atominfo $phase $atom y] [atominfo $phase $atom z] \
	443	[atominfo $phase $atom Uiso] [atominfo $phase $atom frac]"
	444	}
	445	}
	446	} errmsg] {
	447	catch {close $fp}
	448	tk_dialog .errorMsg "Export error" $errmsg warning 0 "OK"
	449	} else {
	450	catch {close $fp}
	451	tk_dialog .ok "Done" \
	452	"File [file tail $filnam] written in directory [file dirname $filnam]" \
	453	warning 0 "OK"
	454	}
	455	if {[llength $expmap(phaselist)] == 1} {destroy .export}
	456	}
	457
	458
[29]	459	# convert a file
[17]	460	proc convfile {} {
	461	global tcl_platform
	462	if {$tcl_platform(platform) == "windows"} {
	463	convwin
	464	} else {
	465	convunix
	466	}
	467	}
	468
	469	# file conversions for UNIX (convstod convdtos)
	470	proc convunix {} {
	471	global expgui infile outfile
	472	set frm .file
	473	catch {destroy $frm}
	474	toplevel $frm
	475	wm title $frm "Convert File"
	476
[59]	477	pack [frame [set frm0 $frm.0] -bd 2 -relief groove] \
	478	-padx 3 -pady 3 -side top -fill x
	479	pack [frame $frm.mid] -side top
	480	pack [frame [set frmA $frm.mid.1] -bd 2 -relief groove] \
	481	-padx 3 -pady 3 -side left
[17]	482	pack [label $frmA.0 -text "Select an input file"] -side top -anchor center
[59]	483	pack [frame [set frmB $frm.mid.2] -bd 2 -relief groove] \
	484	-padx 3 -pady 3 -side left
[17]	485	pack [label $frmB.0 -text "Enter an output file"] -side top -anchor center
[59]	486	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side top
	487
	488	pack [label $frm0.1 -text "Convert to:"] -side top -anchor center
	489	pack [frame $frm0.2] -side top -anchor center
	490	pack [radiobutton $frm0.2.d -text "direct access" -value convstod \
[17]	491	-command setoutfile \
[59]	492	-variable outfile(type)] -side left -anchor center
	493	pack [radiobutton $frm0.2.s -text "sequential" -value convdtos \
[17]	494	-command setoutfile \
[59]	495	-variable outfile(type)] -side right -anchor center
[17]	496	set outfile(type) ""
[59]	497
	498	pack [button $frmC.b -text Convert -command "valid_conv_unix"] -side left
	499	pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side left
	500
	501
	502	unixcnvbox $frmA infile 1
	503	unixcnvbox $frmB outfile 0
[17]	504	set infile(done) 0
[91]	505	bind $frm <Return> "valid_conv_unix"
[17]	506	# force the window to stay on top
[91]	507	putontop $frm
[17]	508	focus $frmC.q
	509	update
	510	tkwait variable infile(done)
	511	destroy $frm
[91]	512	afterputontop
[17]	513	}
	514
[59]	515	# validate the files and make the conversion -- unix
	516	proc valid_conv_unix {} {
[17]	517	global infile outfile expgui
[59]	518	set error {}
[17]	519	if {$outfile(type) == "convstod" \|\| $outfile(type) == "convdtos"} {
	520	set convtype $outfile(type)
	521	} else {
[59]	522	append error "You must specify a conversion method: to direct access or to sequential.\n"
	523	}
	524	if {$infile(name) == ""} {
	525	append error "You must specify an input file to convert.\n"
	526	}
	527	if {$outfile(name) == ""} {
	528	append error "You must specify an output file name for the converted file.\n"
	529	}
	530	if {$error != ""} {
	531	tk_dialog .warn Notify $error warning 0 OK
[17]	532	return
	533	}
[59]	534
[17]	535	if {$infile(name) == $outfile(name)} {
	536	tk_dialog .warn Notify "Sorry, filenames must differ" warning 0 OK
	537	return
	538	}
	539	if ![file exists [file join $infile(dir) $infile(name)]] {
	540	tk_dialog .warn Notify \
	541	"Sorry, file $infile(name) not found in $infile(dir)" warning 0 OK
	542	return
	543	}
	544	if [file exists [file join $outfile(dir) $outfile(name)]] {
	545	if [tk_dialog .warn Notify \
	546	"Warning: file $outfile(name) exists in $outfile(dir). OK to overwrite?" \
	547	warning 0 OK No] return
	548	}
	549	if [catch {
	550	exec [file join $expgui(gsasexe) $convtype] < \
	551	[file join $infile(dir) $infile(name)] > \
	552	[file join $outfile(dir) $outfile(name)]
	553	} errmsg] {
	554	tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
	555	} else {
	556	if [tk_dialog .converted Notify \
	557	"File converted. Convert more files?" \
	558	"" 0 Yes No] {set infile(done) 1}
	559	}
	560	}
	561
[59]	562	# create a file box for UNIX conversions
	563	proc unixcnvbox {bx filvar diropt} {
	564	global ${filvar} expgui
	565	pack [frame $bx.top] -side top
	566	pack [label $bx.top.a -text "Directory" ] -side left
	567	set ${filvar}(FileDirButtonMenu) [tk_optionMenu $bx.top.d ${filvar}(dir) [pwd] ]
	568	pack $bx.top.d -side left
	569	set ${filvar}(dir) [pwd]
	570
	571	# pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top
	572	# set ${filvar}(dir) [pwd]
	573
	574	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
	575	listbox $bx.a.files -relief raised -bd 2 -yscrollcommand "$bx.a.scroll set" \
	576	-height 15 -width 0
	577	scrollbar $bx.a.scroll -command "$bx.a.files yview"
	578	unixFilChoose $bx $bx.a.files $filvar $diropt
	579	if {$filvar == "infile"} {
	580	bind $bx.a.files <ButtonRelease-1> \
	581	"unixFilChoose $bx $bx.a.files $filvar $diropt; setoutfile"
	582	} else {
	583	bind $bx.a.files <ButtonRelease-1> \
	584	"unixFilChoose $bx $bx.a.files $filvar $diropt"
	585	}
	586	pack $bx.a.scroll -side left -fill y
	587	pack $bx.a.files -side left -fill both -expand yes
	588	pack [entry $bx.c -textvariable ${filvar}(name)] -side top
	589	}
	590
	591	# select a file or directory, also called when box is created to fill it
	592	proc unixFilChoose {frm box filvar {dironly 1}} {
	593	global $filvar
	594	set select [$box curselection]
	595	if {$select == ""} {
	596	set file .
	597	} else {
	598	set file [string trim [$box get $select]]
	599	}
	600	if [file isdirectory [file join [set ${filvar}(dir)] $file]] {
	601	if {$file == ".."} {
	602	set ${filvar}(dir) [file dirname [set ${filvar}(dir)] ]
	603	} elseif {$file != "."} {
	604	set ${filvar}(dir) [file join [set ${filvar}(dir)] $file]
	605	}
	606	[set ${filvar}(FileDirButtonMenu)] delete 0 end
	607	set list ""
	608	set dir ""
	609	foreach subdir [file split [set ${filvar}(dir)]] {
	610	set dir [file join $dir $subdir]
	611	lappend list $dir
	612	}
	613	foreach path $list {
	614	[set ${filvar}(FileDirButtonMenu)] add command -label $path \
	615	-command "[list set ${filvar}(dir) $path]; \
	616	unixFilChoose $frm $box $filvar $dironly"
	617	}
	618	set ${filvar}(name) {}
	619	$box delete 0 end
	620	$box insert end {.. }
	621	foreach file [lsort [glob -nocomplain \
	622	[file join [set ${filvar}(dir)] *] ] ] {
	623	if {[file isdirectory $file]} {
	624	# is this / needed here? Does it cause a problem in MacGSAS?
	625	$box insert end [file tail $file]/
	626	} elseif {$dironly == 1} {
	627	$box insert end [file tail $file]
	628	} elseif {$dironly == 2 && [file extension $file] == ".EXP"} {
	629	$box insert end [file tail $file]
	630	}
	631	}
	632	return
	633	}
	634	set ${filvar}(name) [file tail $file]
	635	}
	636
	637	# set new file name from old -- used for convunix
	638	proc setoutfile {} {
	639	global infile outfile
	640	if {$outfile(type) == "convstod"} {
	641	set lfile [string toupper $infile(name)]
	642	} elseif {$outfile(type) == "convdtos"} {
	643	set lfile [string tolower $infile(name)]
	644	} else {
	645	set lfile ""
	646	}
	647	if {$infile(name) == $lfile} {
	648	set outfile(name) {}
	649	} else {
	650	set outfile(name) $lfile
	651	}
	652	}
	653
	654	#------------------------------------------------------------------------------
[17]	655	# file conversions for Windows
[59]	656	#------------------------------------------------------------------------------
[17]	657	proc convwin {} {
[59]	658	global expgui
[17]	659	set frm .file
	660	catch {destroy $frm}
	661	toplevel $frm
	662	wm title $frm "Convert File"
	663	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
	664	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
[72]	665	pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
[59]	666	-side top
	667	pack [button $frmC.q -text Quit -command "destroy $frm"] -side top
[17]	668	pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
[72]	669	winfilebox $frm
	670	bind $frm <Return> "ValidWinCnv $frm"
[17]	671
[91]	672	# force the window to stay on top
	673	putontop $frm
[17]	674	focus $frmC.q
[59]	675	tkwait window $frm
[91]	676	afterputontop
[17]	677	}
	678
	679	# validate the files and make the conversion
[72]	680	proc ValidWinCnv {frm} {
[59]	681	global expgui
[72]	682	# change backslashes to something sensible
	683	regsub -all {\\} $expgui(FileMenuCnvName) / expgui(FileMenuCnvName)
	684	# allow entry of D: for D:/ and D:TEST for d:/TEST
	685	if {[string first : $expgui(FileMenuCnvName)] != -1 && \
	686	[string first :/ $expgui(FileMenuCnvName)] == -1} {
	687	regsub : $expgui(FileMenuCnvName) :/ expgui(FileMenuCnvName)
	688	}
[59]	689	if {$expgui(FileMenuCnvName) == "<Parent>"} {
	690	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
[72]	691	ChooseWinCnv $frm
[17]	692	return
[59]	693	} elseif [file isdirectory \
	694	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
	695	if {$expgui(FileMenuCnvName) != "."} {
	696	set expgui(FileMenuDir) \
	697	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
	698	}
[72]	699	ChooseWinCnv $frm
[59]	700	return
[17]	701	}
[59]	702
	703	set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
	704	if ![file exists $file] {
	705	tk_dialog .warn "Convert Error" \
	706	"File $file does not exist" question 0 "OK"
	707	return
	708	}
	709
	710	set tmpname "[file join [file dirname $file] tempfile.xxx]"
	711	set oldname "[file rootname $file].org"
	712	if [file exists $oldname] {
	713	set ans [tk_dialog .warn "OK to overwrite?" \
	714	"File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" question 0 \
	715	"Yes" "No"]
	716	if $ans return
	717	catch {file delete $oldname}
	718	}
	719
[17]	720	if [catch {
[59]	721	set in [open $file r]
	722	set out [open $tmpname w]
[17]	723	set len [gets $in line]
	724	if {$len > 160} {
	725	# this is a UNIX file. Hope there are no control characters
	726	set i 0
	727	set j 79
	728	while {$j < $len} {
	729	puts $out [string range $line $i $j]
	730	incr i 80
	731	incr j 80
	732	}
	733	} else {
	734	while {$len >= 0} {
	735	append line " "
	736	append line " "
	737	set line [string range $line 0 79]
	738	puts $out $line
	739	set len [gets $in line]
	740	}
	741	}
	742	close $in
	743	close $out
[138]	744	file rename -force $file $oldname
	745	file rename -force $tmpname $file
[17]	746	} errmsg] {
	747	tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
	748	} else {
	749	if [tk_dialog .converted Notify \
[59]	750	"File [file tail $file] converted. (Original saved as [file tail $oldname]).\n\n Convert more files?" \
	751	"" 0 Yes No] {destroy $frm}
[17]	752	}
	753	}
	754
[59]	755	# create a file box
[72]	756	proc winfilebox {frm} {
[59]	757	global expgui
[72]	758	set bx $frm.1
[59]	759	pack [frame $bx.top] -side top
	760	pack [label $bx.top.a -text "Directory" ] -side left
	761	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
	762	pack $bx.top.d -side left
	763	set expgui(FileMenuDir) [pwd]
	764	# the icon below is from tk8.0/tkfbox.tcl
	765	set upfolder [image create bitmap -data {
	766	#define updir_width 28
	767	#define updir_height 16
	768	static char updir_bits[] = {
	769	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
	770	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
	771	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
	772	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
	773	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
	774	0xf0, 0xff, 0xff, 0x01};}]
	775
	776	pack [button $bx.top.b -image $upfolder \
[72]	777	-command "updir; ChooseWinCnv $frm" ]
[17]	778	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
[59]	779	listbox $bx.a.files -relief raised -bd 2 \
	780	-yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
[17]	781	-height 15 -width 0
[59]	782	listbox $bx.a.dates -relief raised -bd 2 \
	783	-yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
	784	-height 15 -width 0 -takefocus 0
	785	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
[72]	786	ChooseWinCnv $frm
	787	bind $bx.a.files <ButtonRelease-1> "ReleaseWinCnv $frm"
	788	bind $bx.a.dates <ButtonRelease-1> "ReleaseWinCnv $frm"
	789	bind $bx.a.files <Double-1> "SelectWinCnv $frm"
	790	bind $bx.a.dates <Double-1> "SelectWinCnv $frm"
[17]	791	pack $bx.a.scroll -side left -fill y
[59]	792	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
	793	pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
[17]	794	}
	795
[59]	796	# set the box or file in the selection window
[72]	797	proc ReleaseWinCnv {frm} {
[59]	798	global expgui
[72]	799	set files $frm.1.a.files
	800	set dates $frm.1.a.dates
[59]	801	set select [$files curselection]
[17]	802	if {$select == ""} {
[59]	803	set select [$dates curselection]
	804	}
	805	if {$select == ""} {
	806	set expgui(FileMenuCnvName) ""
[17]	807	} else {
[59]	808	set expgui(FileMenuCnvName) [string trim [$files get $select]]
[17]	809	}
[59]	810	if {$expgui(FileMenuCnvName) == "<Parent>"} {
	811	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
[72]	812	ChooseWinCnv $frm
[59]	813	} elseif [file isdirectory \
	814	[file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
	815	if {$expgui(FileMenuCnvName) != "."} {
	816	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
[72]	817	ChooseWinCnv $frm
[17]	818	}
	819	}
[59]	820	return
[17]	821	}
	822
[59]	823	# select a file or directory -- called on double click
[72]	824	proc SelectWinCnv {frm} {
[59]	825	global expgui
[72]	826	set files $frm.1.a.files
	827	set dates $frm.1.a.dates
[59]	828	set select [$files curselection]
	829	if {$select == ""} {
	830	set select [$dates curselection]
	831	}
	832	if {$select == ""} {
	833	set file .
[17]	834	} else {
[59]	835	set file [string trim [$files get $select]]
[17]	836	}
[59]	837	if {$file == "<Parent>"} {
	838	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
[72]	839	ChooseWinCnv $frm
[59]	840	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
	841	if {$file != "."} {
	842	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
[72]	843	ChooseWinCnv $frm
[59]	844	}
[17]	845	} else {
[59]	846	set expgui(FileMenuCnvName) [file tail $file]
[72]	847	ValidWinCnv $frm
[17]	848	}
	849	}
	850
[59]	851	# fill the files & dates & Directory selection box with current directory,
	852	# also called when box is created to fill it
[72]	853	proc ChooseWinCnv {frm} {
[59]	854	global expgui
[72]	855	set files $frm.1.a.files
	856	set dates $frm.1.a.dates
[59]	857	set expgui(FileMenuCnvName) {}
	858	$files delete 0 end
	859	$dates delete 0 end
	860	$files insert end {<Parent>}
	861	$dates insert end {(Directory)}
	862	set filelist [glob -nocomplain \
	863	[file join [set expgui(FileMenuDir)] *] ]
[91]	864	foreach file [lsort -dictionary $filelist] {
[59]	865	if {[file isdirectory $file]} {
	866	$files insert end [file tail $file]
	867	$dates insert end {(Directory)}
	868	}
	869	}
[91]	870	foreach file [lsort -dictionary $filelist] {
[72]	871	if {![file isdirectory $file]} {
	872	set modified [clock format [file mtime $file] -format "%T %D"]
	873	$files insert end [file tail $file]
	874	$dates insert end $modified
	875	}
[59]	876	}
	877	$expgui(FileDirButtonMenu) delete 0 end
	878	set list ""
	879	set dir ""
	880	foreach subdir [file split [set expgui(FileMenuDir)]] {
	881	set dir [file join $dir $subdir]
	882	lappend list $dir
	883	}
	884	foreach path $list {
	885	$expgui(FileDirButtonMenu) add command -label $path \
	886	-command "[list set expgui(FileMenuDir) $path]; \
[72]	887	ChooseWinCnv $frm"
[59]	888	}
	889	return
	890	}
	891
	892	#------------------------------------------------------------------------------
[29]	893	# set options for liveplot
[17]	894	proc liveplotopt {} {
[83]	895	global liveplot expmap
[17]	896	set frm .file
	897	catch {destroy $frm}
	898	toplevel $frm
	899	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
[83]	900	set last [lindex [lsort -integer $expmap(powderlist)] end]
	901	if {$last == ""} {set last 1}
	902	pack [scale $frmA.1 -label "Histogram number" -from 1 -to $last \
[17]	903	-length 150 -orient horizontal -variable liveplot(hst)] -side top
	904	pack [checkbutton $frmA.2 -text {include plot legend}\
	905	-variable liveplot(legend)] -side top
	906	pack [button $frm.2 -text OK \
	907	-command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
	908	] -side top
	909	bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
[91]	910
[17]	911	# force the window to stay on top
[91]	912	putontop $frm
[17]	913	focus $frm.2
	914	tkwait window $frm
[91]	915	afterputontop
[17]	916	}
[29]	917
	918	#------------------------------------------------------------------------------
	919	# get an experiment file name
	920	#------------------------------------------------------------------------------
	921	proc getExpFileName {mode} {
	922	global expgui
	923	set frm .file
	924	catch {destroy $frm}
	925	toplevel $frm
[59]	926	wm title $frm "Experiment file"
[29]	927	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
	928	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
	929	pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
	930	pack [radiobutton $frmC.1 -text "File Name" -value 1 \
	931	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
	932	pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
	933	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
[32]	934	pack [button $frmC.b -text Read \
[29]	935	-command "valid_exp_file $frmA $mode"] -side top
[32]	936	if {$mode == "new"} {
	937	$frmC.b config -text Save
	938	}
[29]	939	pack [button $frmC.q -text Quit \
	940	-command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side top
	941	bind $frm <Return> "$frmC.b invoke"
	942
[32]	943	if {$mode == "new"} {
	944	pack [label $frmA.0 -text "Enter an experiment file to create"] \
	945	-side top -anchor center
	946	} else {
	947	pack [label $frmA.0 -text "Select an experiment file to read"] \
	948	-side top -anchor center
	949	}
[29]	950	expfilebox $frmA $mode
	951	# force the window to stay on top
[91]	952	putontop $frm
[29]	953	focus $frmC.b
	954	tkwait window $frm
[91]	955	afterputontop
[29]	956	if {$expgui(FileMenuEXPNAM) == ""} return
	957	return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	958	}
	959
	960	# validation routine
	961	proc valid_exp_file {frm mode} {
[72]	962	global expgui tcl_platform
	963	# windows fixes
	964	if {$tcl_platform(platform) == "windows"} {
	965	# change backslashes to something sensible
	966	regsub -all {\\} $expgui(FileMenuEXPNAM) / expgui(FileMenuEXPNAM)
	967	# allow entry of D: for D:/ and D:TEST for d:/TEST
	968	if {[string first : $expgui(FileMenuEXPNAM)] != -1 && \
	969	[string first :/ $expgui(FileMenuEXPNAM)] == -1} {
	970	regsub : $expgui(FileMenuEXPNAM) :/ expgui(FileMenuEXPNAM)
	971	}
	972	}
[29]	973	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
	974	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
	975	ChooseExpFil $frm
	976	return
	977	} elseif [file isdirectory \
	978	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
	979	if {$expgui(FileMenuEXPNAM) != "."} {
	980	set expgui(FileMenuDir) \
	981	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	982	}
	983	ChooseExpFil $frm
	984	return
	985	}
[182]	986	# append a .EXP if not present
[29]	987	if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
	988	append expgui(FileMenuEXPNAM) ".EXP"
	989	}
[182]	990	# flag files that end in something other than .EXP .exp or .Exp...
[130]	991	if {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
[29]	992	tk_dialog .expFileErrorMsg "File Open Error" \
[62]	993	"File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
[29]	994	error 0 OK
	995	return
	996	}
[182]	997	# check on the file status
[29]	998	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	999	if {$mode == "new" && [file exists $file]} {
	1000	set ans [tk_dialog .expFileErrorMsg "File Open Error" \
[62]	1001	"File [file tail $file] already exists in [file dirname $file]. OK to overwrite?" question 0 \
[29]	1002	"Select other name" "Overwrite"]
	1003	if $ans {destroy .file}
	1004	return
	1005	}
[182]	1006	# if file does not exist in case provided, set the name to all
	1007	# upper case letters, since that is the best choice.
	1008	# if it does exist, read from it as is. For UNIX we will force uppercase later.
	1009	if {![file exists $file]} {
	1010	set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
	1011	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	1012	}
[29]	1013	if {$mode == "old" && ![file exists $file]} {
	1014	set ans [tk_dialog .expFileErrorMsg "File Open Error" \
[62]	1015	"File [file tail $file] does not exist in [file dirname $file]. OK to create?" question 0 \
[29]	1016	"Select other name" "Create"]
	1017	if $ans {destroy .file}
	1018	return
	1019	}
	1020	destroy .file
	1021	}
	1022
	1023	proc updir {} {
	1024	global expgui
	1025	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
	1026	}
	1027
	1028	# create a file box
	1029	proc expfilebox {bx mode} {
	1030	global expgui
	1031	pack [frame $bx.top] -side top
	1032	pack [label $bx.top.a -text "Directory" ] -side left
	1033	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
	1034	pack $bx.top.d -side left
	1035	set expgui(FileMenuDir) [pwd]
	1036	# the icon below is from tk8.0/tkfbox.tcl
	1037	set upfolder [image create bitmap -data {
	1038	#define updir_width 28
	1039	#define updir_height 16
	1040	static char updir_bits[] = {
	1041	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
	1042	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
	1043	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
	1044	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
	1045	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
	1046	0xf0, 0xff, 0xff, 0x01};}]
	1047
	1048	pack [button $bx.top.b -image $upfolder \
	1049	-command "updir; ChooseExpFil $bx" ]
	1050	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
	1051	listbox $bx.a.files -relief raised -bd 2 \
	1052	-yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
	1053	-height 15 -width 0
	1054	listbox $bx.a.dates -relief raised -bd 2 \
	1055	-yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
	1056	-height 15 -width 0 -takefocus 0
	1057	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
	1058	ChooseExpFil $bx
	1059	bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
	1060	bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
	1061	bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
	1062	bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
	1063	pack $bx.a.scroll -side left -fill y
	1064	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
	1065	pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
	1066	}
	1067	proc sync2boxes {master slave scroll args} {
	1068	$slave yview moveto [lindex [$master yview] 0]
	1069	eval $scroll set $args
	1070	}
	1071	proc move2boxesY {boxlist args} {
	1072	foreach listbox $boxlist {
	1073	eval $listbox yview $args
	1074	}
	1075	}
	1076
	1077	# set the box or file in the selection window
	1078	proc ReleaseExpFil {frm} {
	1079	global expgui
	1080	set files $frm.a.files
	1081	set dates $frm.a.dates
	1082	set select [$files curselection]
	1083	if {$select == ""} {
	1084	set select [$dates curselection]
	1085	}
	1086	if {$select == ""} {
	1087	set expgui(FileMenuEXPNAM) ""
	1088	} else {
	1089	set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
	1090	}
[59]	1091	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
	1092	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
	1093	ChooseExpFil $frm
	1094	} elseif [file isdirectory \
	1095	[file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
	1096	if {$expgui(FileMenuEXPNAM) != "."} {
	1097	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	1098	ChooseExpFil $frm
	1099	}
	1100	}
[29]	1101	return
	1102	}
	1103
	1104	# select a file or directory -- called on double click
	1105	proc SelectExpFil {frm mode} {
	1106	global expgui
	1107	set files $frm.a.files
	1108	set dates $frm.a.dates
	1109	set select [$files curselection]
	1110	if {$select == ""} {
	1111	set select [$dates curselection]
	1112	}
	1113	if {$select == ""} {
	1114	set file .
	1115	} else {
	1116	set file [string trim [$files get $select]]
	1117	}
	1118	if {$file == "<Parent>"} {
	1119	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
	1120	ChooseExpFil $frm
	1121	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
	1122	if {$file != "."} {
	1123	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
	1124	ChooseExpFil $frm
	1125	}
	1126	} else {
	1127	set expgui(FileMenuEXPNAM) [file tail $file]
	1128	valid_exp_file $frm $mode
	1129	}
	1130	}
	1131
	1132	# fill the files & dates & Directory selection box with current directory,
	1133	# also called when box is created to fill it
	1134	proc ChooseExpFil {frm} {
	1135	global expgui
	1136	set files $frm.a.files
	1137	set dates $frm.a.dates
	1138	set expgui(FileMenuEXPNAM) {}
	1139	$files delete 0 end
	1140	$dates delete 0 end
	1141	$files insert end {<Parent>}
	1142	$dates insert end {(Directory)}
	1143	set filelist [glob -nocomplain \
	1144	[file join [set expgui(FileMenuDir)] *] ]
[91]	1145	foreach file [lsort -dictionary $filelist] {
[29]	1146	if {[file isdirectory $file]} {
	1147	$files insert end [file tail $file]
	1148	$dates insert end {(Directory)}
	1149	}
	1150	}
	1151	set pairlist {}
[91]	1152	foreach file [lsort -dictionary $filelist] {
[29]	1153	if {![file isdirectory $file] && \
[47]	1154	[string toupper [file extension $file]] == ".EXP"} {
[29]	1155	set modified [file mtime $file]
[72]	1156	lappend pairlist [list $file $modified]
[29]	1157	}
	1158	}
	1159	if {$expgui(filesort) == 0} {
	1160	foreach pair [lsort -index 1 -integer $pairlist] {
	1161	set file [lindex $pair 0]
	1162	set modified [clock format [lindex $pair 1] -format "%T %D"]
	1163	$files insert end [file tail $file]
	1164	$dates insert end $modified
	1165	}
	1166	} else {
[130]	1167	foreach pair [lsort -dictionary -index 0 $pairlist] {
[29]	1168	set file [lindex $pair 0]
	1169	set modified [clock format [lindex $pair 1] -format "%T %D"]
	1170	$files insert end [file tail $file]
	1171	$dates insert end $modified
	1172	}
	1173	}
	1174	$expgui(FileDirButtonMenu) delete 0 end
	1175	set list ""
	1176	set dir ""
	1177	foreach subdir [file split [set expgui(FileMenuDir)]] {
	1178	set dir [file join $dir $subdir]
	1179	lappend list $dir
	1180	}
	1181	foreach path $list {
	1182	$expgui(FileDirButtonMenu) add command -label $path \
	1183	-command "[list set expgui(FileMenuDir) $path]; \
	1184	ChooseExpFil $frm"
	1185	}
	1186	# highlight the current experiment -- if present
	1187	for {set i 0} {$i < [$files size]} {incr i} {
	1188	set file [$files get $i]
	1189	if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
	1190	$files selection set $i
	1191	}
	1192	}
	1193	return
	1194	}
[91]	1195
	1196	proc putontop {w} {
	1197	# center window $w above its parent and make it stay on top
	1198	set wp [winfo parent $w]
	1199	wm transient $w [winfo toplevel $wp]
	1200	wm withdraw $w
	1201	update idletasks
	1202	# center the new window in the middle of the parent
	1203	set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
	1204	[winfo reqwidth $w]/2 - [winfo vrootx $wp]]
	1205	if {$x < 0} {set x 0}
	1206	set xborder 10
	1207	if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
	1208	incr x [expr \
	1209	[winfo screenwidth $w] - ($x+[winfo reqwidth $w] + $xborder)]
	1210	}
	1211	set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
	1212	[winfo reqheight $w]/2 - [winfo vrooty $wp]]
	1213	if {$y < 0} {set y 0}
	1214	set yborder 25
	1215	if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
	1216	incr y [expr \
	1217	[winfo screenheight $w] - ($y+[winfo reqheight $w] + $yborder)]
	1218	}
	1219	wm geom $w +$x+$y
	1220	wm deiconify $w
	1221
	1222	global makenew
	1223	set makenew(OldFocus) [focus]
[102]	1224	catch {
	1225	set makenew(OldGrab) [grab current $w]
	1226	if {$makenew(OldGrab) != ""} {
	1227	set makenew(GrabStatus) [grab status $makenew(OldGrab)]
	1228	}
	1229	grab $w
[91]	1230	}
	1231	}
	1232
	1233	proc afterputontop {} {
	1234	# restore focus
	1235	global makenew
	1236	catch {focus $makenew(OldFocus)}
	1237	if {$makenew(OldGrab) != ""} {
[102]	1238	catch {
	1239	if {$makenew(GrabStatus) == "global"} {
	1240	grab -global $makenew(OldGrab)
	1241	} else {
	1242	grab $makenew(OldGrab)
	1243	}
[91]	1244	}
	1245	}
	1246	}
	1247
	1248	proc ShowBigMessage {win labeltext msg "optionlist OK"} {
	1249	catch {destroy $win}
	1250	toplevel $win
	1251
	1252	# grab focus, etc.
	1253	pack [label $win.l1 -text $labeltext] -side top
[98]	1254	pack [frame $win.f1] -side top -expand yes -fill both
[91]	1255	grid [text $win.f1.t \
	1256	-height 20 -width 55 -wrap none -font Courier \
	1257	-xscrollcommand "$win.f1.bscr set" \
	1258	-yscrollcommand "$win.f1.rscr set" \
	1259	] -row 1 -column 0 -sticky news
	1260	grid [scrollbar $win.f1.bscr -orient horizontal \
	1261	-command "$win.f1.t xview" \
	1262	] -row 2 -column 0 -sticky ew
	1263	grid [scrollbar $win.f1.rscr -command "$win.f1.t yview" \
	1264	] -row 1 -column 1 -sticky ns
	1265	# give extra space to the text box
	1266	grid columnconfigure $win.f1 0 -weight 1
	1267	grid rowconfigure $win.f1 1 -weight 1
	1268	$win.f1.t insert end $msg
	1269
	1270	global makenew
	1271	set makenew(result) 0
	1272	bind $win <Return> "destroy $win"
	1273	bind $win <KeyPress-Prior> "$win.f1.t yview scroll -1 page"
	1274	bind $win <KeyPress-Next> "$win.f1.t yview scroll 1 page"
	1275	bind $win <KeyPress-Right> "$win.f1.t xview scroll 1 unit"
	1276	bind $win <KeyPress-Left> "$win.f1.t xview scroll -1 unit"
	1277	bind $win <KeyPress-Up> "$win.f1.t yview scroll -1 unit"
	1278	bind $win <KeyPress-Down> "$win.f1.t yview scroll 1 unit"
	1279	bind $win <KeyPress-Home> "$win.f1.t yview 0"
	1280	bind $win <KeyPress-End> "$win.f1.t yview end"
	1281	set i 0
	1282	foreach item $optionlist {
	1283	pack [button $win.q[incr i] \
	1284	-command "set makenew(result) $i; destroy $win" -text $item] -side left
	1285	}
	1286	putontop $win
	1287	tkwait window $win
	1288
	1289	# fix focus...
	1290	afterputontop
	1291	return $makenew(result)
	1292	}
[119]	1293
[130]	1294	# Message box code that centers the message box over the parent.
	1295	# or along the edge, if too close,
	1296	# but leave a border along +x & +y for reasons I don't remember
	1297	# It also allows the button names to be defined using
	1298	# -type $list -- where $list has a list of button names
	1299	# larger messages are placed in a scrolled text widget
	1300	# capitalization is now ignored for -default
	1301	# The command returns the name button in all lower case letters
	1302	# otherwise see tk_messageBox for a description
	1303	#
	1304	# This is a modification of tkMessageBox (msgbox.tcl v1.5)
	1305	#
	1306	proc MyMessageBox {args} {
	1307	global tkPriv tcl_platform
	1308
	1309	set w tkPrivMsgBox
	1310	upvar #0 $w data
	1311
	1312	#
	1313	# The default value of the title is space (" ") not the empty string
	1314	# because for some window managers, a
	1315	# wm title .foo ""
	1316	# causes the window title to be "foo" instead of the empty string.
	1317	#
	1318	set specs {
	1319	{-default "" "" ""}
	1320	{-icon "" "" "info"}
	1321	{-message "" "" ""}
	1322	{-parent "" "" .}
	1323	{-title "" "" " "}
	1324	{-type "" "" "ok"}
	1325	}
	1326
	1327	tclParseConfigSpec $w $specs "" $args
	1328
	1329	if {[lsearch {info warning error question} $data(-icon)] == -1} {
	1330	error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
	1331	}
	1332	if {![string compare $tcl_platform(platform) "macintosh"]} {
	1333	switch -- $data(-icon) {
	1334	"error" {set data(-icon) "stop"}
	1335	"warning" {set data(-icon) "caution"}
	1336	"info" {set data(-icon) "note"}
	1337	}
	1338	}
	1339
	1340	if {![winfo exists $data(-parent)]} {
	1341	error "bad window path name \"$data(-parent)\""
	1342	}
	1343
	1344	switch -- $data(-type) {
	1345	abortretryignore {
	1346	set buttons {
	1347	{abort -width 6 -text Abort -under 0}
	1348	{retry -width 6 -text Retry -under 0}
	1349	{ignore -width 6 -text Ignore -under 0}
	1350	}
	1351	}
	1352	ok {
	1353	set buttons {
	1354	{ok -width 6 -text OK -under 0}
	1355	}
	1356	if {![string compare $data(-default) ""]} {
	1357	set data(-default) "ok"
	1358	}
	1359	}
	1360	okcancel {
	1361	set buttons {
	1362	{ok -width 6 -text OK -under 0}
	1363	{cancel -width 6 -text Cancel -under 0}
	1364	}
	1365	}
	1366	retrycancel {
	1367	set buttons {
	1368	{retry -width 6 -text Retry -under 0}
	1369	{cancel -width 6 -text Cancel -under 0}
	1370	}
	1371	}
	1372	yesno {
	1373	set buttons {
	1374	{yes -width 6 -text Yes -under 0}
	1375	{no -width 6 -text No -under 0}
	1376	}
	1377	}
	1378	yesnocancel {
	1379	set buttons {
	1380	{yes -width 6 -text Yes -under 0}
	1381	{no -width 6 -text No -under 0}
	1382	{cancel -width 6 -text Cancel -under 0}
	1383	}
	1384	}
	1385	default {
	1386	# error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel"
	1387	foreach item $data(-type) {
	1388	lappend buttons [list [string tolower $item] -text $item -under 0]
	1389	}
	1390	}
	1391	}
	1392
	1393	if {[string compare $data(-default) ""]} {
	1394	set valid 0
	1395	foreach btn $buttons {
	1396	if {![string compare [lindex $btn 0] [string tolower $data(-default)]]} {
	1397	set valid 1
	1398	break
	1399	}
	1400	}
	1401	if {!$valid} {
	1402	error "invalid default button \"$data(-default)\""
	1403	}
	1404	}
	1405
	1406	# 2. Set the dialog to be a child window of $parent
	1407	#
	1408	#
	1409	if {[string compare $data(-parent) .]} {
	1410	set w $data(-parent).__tk__messagebox
	1411	} else {
	1412	set w .__tk__messagebox
	1413	}
	1414
	1415	# 3. Create the top-level window and divide it into top
	1416	# and bottom parts.
	1417
	1418	catch {destroy $w}
	1419	toplevel $w -class Dialog
	1420	wm title $w $data(-title)
	1421	wm iconname $w Dialog
	1422	wm protocol $w WM_DELETE_WINDOW { }
	1423	wm transient $w $data(-parent)
	1424	if {![string compare $tcl_platform(platform) "macintosh"]} {
	1425	unsupported1 style $w dBoxProc
	1426	}
	1427
	1428	frame $w.bot
	1429	pack $w.bot -side bottom -fill both
	1430	frame $w.top
	1431	pack $w.top -side top -fill both -expand 1
	1432	if {[string compare $tcl_platform(platform) "macintosh"]} {
	1433	$w.bot configure -relief raised -bd 1
	1434	$w.top configure -relief raised -bd 1
	1435	}
	1436
	1437	# 4. Fill the top part with bitmap and message (use the option
	1438	# database for -wraplength and -font so that they can be
	1439	# overridden by the caller).
	1440
	1441	option add *Dialog.msg.wrapLength 3i widgetDefault
	1442
	1443	if {[string length $data(-message)] > 300} {
	1444	if {![string compare $tcl_platform(platform) "macintosh"]} {
	1445	option add *Dialog.msg.t.font system widgetDefault
	1446	} else {
	1447	option add *Dialog.msg.t.font {Times 18} widgetDefault
	1448	}
	1449	frame $w.msg
	1450	grid [text $w.msg.t \
	1451	-height 20 -width 55 -relief flat -wrap word \
	1452	-yscrollcommand "$w.msg.rscr set" \
	1453	] -row 1 -column 0 -sticky news
	1454	grid [scrollbar $w.msg.rscr -command "$w.msg.t yview" \
	1455	] -row 1 -column 1 -sticky ns
	1456	# give extra space to the text box
	1457	grid columnconfigure $w.msg 0 -weight 1
	1458	grid rowconfigure $w.msg 1 -weight 1
	1459	$w.msg.t insert end $data(-message)
	1460	} else {
	1461	if {![string compare $tcl_platform(platform) "macintosh"]} {
	1462	option add *Dialog.msg.font system widgetDefault
	1463	} else {
	1464	option add *Dialog.msg.font {Times 18} widgetDefault
	1465	}
	1466	label $w.msg -justify left -text $data(-message)
	1467	}
	1468	pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
	1469	if {[string compare $data(-icon) ""]} {
	1470	label $w.bitmap -bitmap $data(-icon)
	1471	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
	1472	}
	1473
	1474	# 5. Create a row of buttons at the bottom of the dialog.
	1475
	1476	set i 0
	1477	foreach but $buttons {
	1478	set name [lindex $but 0]
	1479	set opts [lrange $but 1 end]
	1480	if {![llength $opts]} {
	1481	# Capitalize the first letter of $name
	1482	set capName [string toupper \
	1483	[string index $name 0]][string range $name 1 end]
	1484	set opts [list -text $capName]
	1485	}
	1486
	1487	eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]
	1488
	1489	if {![string compare $name $data(-default)]} {
	1490	$w.$name configure -default active
	1491	}
	1492	pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
	1493
	1494	# create the binding for the key accelerator, based on the underline
	1495	#
	1496	set underIdx [$w.$name cget -under]
	1497	if {$underIdx >= 0} {
	1498	set key [string index [$w.$name cget -text] $underIdx]
	1499	bind $w <Alt-[string tolower $key]> [list $w.$name invoke]
	1500	bind $w <Alt-[string toupper $key]> [list $w.$name invoke]
	1501	}
	1502	incr i
	1503	}
	1504
	1505	# 6. Create a binding for <Return> on the dialog if there is a
	1506	# default button.
	1507
	1508	if {[string compare $data(-default) ""]} {
	1509	bind $w <Return> [list tkButtonInvoke $w.$data(-default)]
	1510	}
	1511
	1512	# 7. Withdraw the window, then update all the geometry information
	1513	# so we know how big it wants to be, then center the window in the
	1514	# display and de-iconify it.
	1515
	1516	wm withdraw $w
	1517	update idletasks
	1518	set wp $data(-parent)
	1519	# center the new window in the middle of the parent
	1520	set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
	1521	[winfo reqwidth $w]/2 - [winfo vrootx $wp]]
	1522	set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
	1523	[winfo reqheight $w]/2 - [winfo vrooty $wp]]
	1524	# make sure that we can see the entire window
	1525	set xborder 10
	1526	set yborder 25
	1527	if {$x < 0} {set x 0}
	1528	if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
	1529	incr x [expr \
	1530	[winfo screenwidth $w] - ($x+[winfo reqwidth $w] + $xborder)]
	1531	}
	1532	if {$y < 0} {set y 0}
	1533	if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
	1534	incr y [expr \
	1535	[winfo screenheight $w] - ($y+[winfo reqheight $w] + $yborder)]
	1536	}
	1537	wm geom $w +$x+$y
	1538	wm deiconify $w
	1539
	1540	# 8. Set a grab and claim the focus too.
	1541
	1542	set oldFocus [focus]
	1543	set oldGrab [grab current $w]
	1544	if {[string compare $oldGrab ""]} {
	1545	set grabStatus [grab status $oldGrab]
	1546	}
	1547	grab $w
	1548	if {[string compare $data(-default) ""]} {
	1549	focus $w.$data(-default)
	1550	} else {
	1551	focus $w
	1552	}
	1553
	1554	# 9. Wait for the user to respond, then restore the focus and
	1555	# return the index of the selected button. Restore the focus
	1556	# before deleting the window, since otherwise the window manager
	1557	# may take the focus away so we can't redirect it. Finally,
	1558	# restore any grab that was in effect.
	1559
	1560	tkwait variable tkPriv(button)
	1561	catch {focus $oldFocus}
	1562	destroy $w
	1563	if {[string compare $oldGrab ""]} {
	1564	if {![string compare $grabStatus "global"]} {
	1565	grab -global $oldGrab
	1566	} else {
	1567	grab $oldGrab
	1568	}
	1569	}
	1570	return $tkPriv(button)
	1571	}
	1572
[119]	1573	#------------------------------------------------------------------------------
	1574	# Delete History Records
	1575	proc DeleteHistoryRecords {{msg ""}} {
	1576	global expgui
	1577	set frm .history
	1578	catch {destroy $frm}
	1579	toplevel $frm
	1580	if {[string trim $msg] == ""} {
	1581	set msg "There are [CountHistory] history records"
	1582	}
	1583	pack [frame $frm.1 -bd 2 -relief groove] -padx 3 -pady 3 -side left
	1584	pack [label $frm.1.0 -text $msg] -side top
	1585	pack [frame $frm.1.1] -side top
	1586	pack [label $frm.1.1.1 -text "Number of entries to keep"] -side left
	1587	pack [entry $frm.1.1.2 -width 3 -textvariable expgui(historyKeep)\
	1588	] -side left
	1589	set expgui(historyKeep) 10
	1590	pack [checkbutton $frm.1.2 -text renumber -variable expgui(renumber)] -side top
	1591	set expgui(renumber) 1
	1592	pack [frame $frm.2] -padx 3 -pady 3 -side left
	1593	pack [button $frm.2.3 -text OK \
	1594	-command {
	1595	if ![catch {expr $expgui(historyKeep)}] {
	1596	DeleteHistory $expgui(historyKeep) $expgui(renumber)
	1597	set expgui(changed) 1
	1598	destroy .history
	1599	}
	1600	}] -side top
	1601	pack [button $frm.2.4 -text Quit \
	1602	-command {destroy .history}] -side top
	1603	bind $frm <Return> "$frm.2.3 invoke"
	1604
	1605	# force the window to stay on top
	1606	putontop $frm
	1607	focus $frm.2.3
	1608	tkwait window $frm
	1609	afterputontop
	1610	}
[138]	1611
	1612	# optionally run disagl as a windowless process, w/results in a separate window
	1613	proc rundisagl {} {
	1614	global expgui txtvw tcl_version tcl_platform
	1615	if {$expgui(disaglSeparateBox)} {
	1616	set root [file root $expgui(expfile)]
	1617	catch {file delete -force $root.tmp}
	1618	catch {file rename -force $root.LST $root.OLS}
	1619	# PSW reports this does not happen right away on windows
	1620	set i 0
	1621	while {$i < 5 && [file exists $root.LST]} {
	1622	# debug code
	1623	catch {console show}
	1624	puts "try $i"
	1625	# end debug code
	1626	after 100
	1627	incr i
	1628	}
	1629	#run the program
	1630	pleasewait "Running DISAGL"
	1631	# create an empty input file
	1632	close [open disagl.inp w]
	1633	catch {exec [file join $expgui(gsasexe) disagl] \
	1634	[file tail $root] < disagl.inp > disagl.out}
	1635	catch {file rename -force $root.LST $root.tmp}
	1636	catch {file delete -force disagl.inp disagl.out}
	1637	catch {file rename -force $root.OLS $root.LST}
	1638	donewait
	1639	# open a new window
	1640	catch {toplevel .disagl}
	1641	catch {eval grid forget [grid slaves .disagl]}
	1642	text .disagl.txt -width 100 -wrap none \
	1643	-yscrollcommand ".disagl.yscroll set" \
	1644	-xscrollcommand ".disagl.xscroll set"
	1645	scrollbar .disagl.yscroll -command ".disagl.txt yview"
	1646	scrollbar .disagl.xscroll -command ".disagl.txt xview" -orient horizontal
	1647	grid .disagl.xscroll -column 0 -row 2 -sticky ew
	1648	grid .disagl.txt -column 0 -row 1 -sticky nsew
	1649	grid .disagl.yscroll -column 1 -row 1 -sticky ns
	1650	grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
	1651	grid columnconfig .disagl.f 2 -weight 1
	1652	grid [button .disagl.f.close -text "Close & Delete" \
	1653	-command "destroy .disagl; file delete $root.tmp"] \
	1654	-column 3 -row 0 -sticky e
	1655	grid [button .disagl.f.rename -text "Close & Save as .DIS" \
	1656	-command "destroy .disagl; file rename -force $root.tmp $root.DIS"] \
	1657	-column 4 -row 0 -sticky e
	1658	# allow font changes on the fly
	1659	if {$tcl_version >= 8.0} {
	1660	.disagl.txt config -font $txtvw(font)
	1661	set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
	1662	grid .disagl.f.font -column 1 -row 0 -sticky w
	1663	grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
	1664	$fontbut delete 0 end
	1665	foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
	1666	$fontbut add command -label "Courier $f" -font "Courier $f"\
	1667	-command "set txtvw(font) \"Courier $f\"; \
	1668	.disagl.txt config -font \$txtvw(font)"
	1669	}
	1670	}
	1671
[182]	1672	grid columnconfigure .disagl 0 -weight 1
[138]	1673	grid rowconfigure .disagl 1 -weight 1
	1674	wm title .disagl "DISAGL results $expgui(expfile)"
	1675	wm iconname .disagl "DISAGL $root"
	1676	set in [open $root.tmp r]
	1677	.disagl.txt insert end [read $in]
	1678	close $in
	1679	bind all {destroy .disagl}
	1680	bind .disagl ".disagl.txt yview scroll -1 page"
	1681	bind .disagl ".disagl.txt yview scroll 1 page"
	1682	bind .disagl ".disagl.txt xview scroll 1 unit"
	1683	bind .disagl ".disagl.txt xview scroll -1 unit"
	1684	bind .disagl ".disagl.txt yview scroll -1 unit"
	1685	bind .disagl ".disagl.txt yview scroll 1 unit"
	1686	bind .disagl ".disagl.txt yview 0"
	1687	bind .disagl ".disagl.txt yview end"
	1688	# don't disable in Win as this prevents the highlighting of selected text
	1689	if {$tcl_platform(platform) != "windows"} {
	1690	.disagl.txt config -state disabled
	1691	}
	1692	} else {
	1693	runGSASwEXP disagl
	1694	}
	1695	}
	1696	# tell'em what is happening
	1697	proc pleasewait {{message {}}} {
	1698	catch {destroy .msg}
	1699	toplevel .msg
	1700	wm transient .msg [winfo toplevel .]
	1701	pack [frame .msg.f -bd 4 -relief groove]
	1702	pack [message .msg.f.m -text "Please wait $message"]
	1703	wm withdraw .msg
	1704	update idletasks
	1705	# place the message on top of the main window
	1706	set x [expr [winfo x .] + [winfo width .]/2 - \
	1707	[winfo reqwidth .msg]/2 - [winfo vrootx .]]
	1708	if {$x < 0} {set x 0}
	1709	set y [expr [winfo y .] + [winfo height .]/2 - \
	1710	[winfo reqheight .msg]/2 - [winfo vrooty .]]
	1711	if {$y < 0} {set y 0}
	1712	wm geom .msg +$x+$y
	1713	wm deiconify .msg
	1714	focus .msg
	1715	grab .msg
	1716	update
	1717	}
	1718	# clear the message
	1719	proc donewait {} {
	1720	catch {destroy .msg}
	1721	}

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

Download in other formats: