Context Navigation

source: trunk/gsascmds.tcl @ 322

Last change on this file since 322 was 322, checked in by toby, 11 years ago
# on 2000/10/12 21:36:23, toby did: Add www help support improve formatting of help box at catch statements to focus and grab calls save grab in pleasewait and restore in donewait Add link arg in ShowBigMessage? & -helplink to MyMessageBox?
Property rcs:author set to `toby` Property rcs:date set to `2000/10/12 21:36:23` Property rcs:lines set to `+231 -80` Property rcs:rev set to `1.24` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 71.1 KB

Rev	Line
[83]	1	# $Id: gsascmds.tcl 322 2009-12-04 23:04:07Z 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
[249]	16	if {$tcl_platform(os) == "Windows 95"} {
[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
[322]	120	# get a value in a modal dialog
[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
[322]	126	bind $w <Key-F1> "MakeWWWHelp expguierr.html Input[lindex $what 0]"
[17]	127	wm title $w "Input $what"
	128	set expgui(temp) {}
	129	pack [frame $w.0 -bd 6 -relief groove -bg beige] \
	130	-side top -expand yes -fill both
	131	grid [label $w.0.a -text "Input a value for the $what" \
	132	-bg beige] \
	133	-row 0 -column 0 -columnspan 10
	134	grid [entry $w.0.b -textvariable expgui(temp) -width $chars] \
	135	-row 1 -column 0
	136
	137	set expgui(temp) $initvalue
[322]	138	pack [frame $w.b -bg beige] -side top -fill x -expand yes
[17]	139	pack [button $w.b.2 -text Set -command "destroy $w"] -side left
	140	if $quit {
	141	pack [button $w.b.3 -text Quit \
	142	-command "set expgui(temp) {}; destroy $w"] -side left
	143	}
[91]	144	bind $w <Return> "destroy $w"
[322]	145	pack [button $w.b.help -text Help -bg yellow \
	146	-command "MakeWWWHelp expguierr.html Input[lindex $what 0]"] \
	147	-side right
[91]	148
[17]	149	# force the window to stay on top
[91]	150	putontop $w
[17]	151
	152	focus $w.b.2
	153	tkwait window $w
[91]	154	afterputontop
	155
[17]	156	return $expgui(temp)
	157	}
	158
[29]	159	# run a GSAS program that does not require an experiment file
[17]	160	proc runGSASprog {proglist} {
	161	global expgui tcl_platform
	162	set cmd {}
	163	foreach prog $proglist {
	164	if {$tcl_platform(platform) == "windows"} {
	165	append cmd " \"$expgui(gsasexe)/${prog}.exe \" "
	166	} else {
	167	if {$cmd != ""} {append cmd "\;"}
	168	append cmd "[file join $expgui(gsasexe) $prog]"
	169	}
	170	}
	171	forknewterm $prog $cmd 0 1 1
	172	}
	173
[29]	174	# run a GSAS program that requires an experiment file for input/output
[182]	175	proc runGSASwEXP {proglist "concurrent 0"} {
[17]	176	global expgui tcl_platform
	177	# Save the current exp file
	178	savearchiveexp
[91]	179	# load the changed .EXP file automatically?
	180	if {$expgui(autoexpload)} {
	181	# disable the file changed monitor
	182	set expgui(expModifiedLast) 0
	183	}
[17]	184	set cmd {}
	185	set expnam [file root [file tail $expgui(expfile)]]
	186	foreach prog $proglist {
	187	if {$prog == "expedt" && $expgui(archive)} archiveexp
	188	if {$tcl_platform(platform) == "windows"} {
	189	append cmd " \"$expgui(gsasexe)/${prog}.exe $expnam \" "
	190	} else {
	191	if {$cmd != ""} {append cmd "\;"}
	192	append cmd "[file join $expgui(gsasexe) $prog] $expnam"
	193	}
	194	}
[182]	195	forknewterm "$prog -- $expnam" $cmd $concurrent 1 1
[91]	196	# load the changed .EXP file automatically?
	197	if {$expgui(autoexpload)} {
	198	# load the revised exp file
	199	loadexp $expgui(expfile)
	200	}
[17]	201	}
	202
[29]	203	# run liveplot
[17]	204	proc liveplot {} {
	205	global expgui liveplot wishshell
	206	set expnam [file root [file tail $expgui(expfile)]]
	207	exec $wishshell [file join $expgui(scriptdir) liveplot] \
[29]	208	$expnam $liveplot(hst) $liveplot(legend) &
[17]	209	}
	210
[29]	211	# run lstview
[17]	212	proc lstview {} {
	213	global expgui wishshell
	214	set expnam [file root [file tail $expgui(expfile)]]
	215	exec $wishshell [file join $expgui(scriptdir) lstview] $expnam &
	216	}
	217
[29]	218	# run widplt
[17]	219	proc widplt {} {
	220	global expgui wishshell
[29]	221	exec $wishshell [file join $expgui(scriptdir) widplt] \
	222	$expgui(expfile) &
[17]	223	}
	224
[29]	225	# show help information
[17]	226	proc showhelp {} {
	227	global expgui_helplist helpmsg
	228	set helpmsg {}
	229	set frm .help
	230	catch {destroy $frm}
	231	toplevel $frm
[322]	232	wm title $frm "Help Summary"
	233	grid [label $frm.0 -text \
	234	"Click on an entry below to see information on the EXPGUI/GSAS topic" ] \
	235	-column 0 -columnspan 4 -row 0
	236	# grid [message $frm.help -textvariable helpmsg -relief groove] \
	237	# -column 0 -columnspan 4 -row 2 -sticky nsew
	238	grid [text $frm.help -relief groove -bg beige -width 0\
	239	-height 0 -wrap word -yscrollcommand "$frm.escroll set"] \
	240	-column 0 -columnspan 3 -row 2 -sticky nsew
	241	grid [scrollbar $frm.escroll -command "$frm.help yview"] \
	242	-column 4 -row 2 -sticky nsew
	243	grid rowconfig $frm 1 -weight 1 -minsize 50
	244	grid rowconfig $frm 2 -weight 2 -pad 20 -minsize 150
	245	grid columnconfig $frm 0 -weight 1
	246	grid columnconfig $frm 2 -weight 1
[17]	247	set lst [array names expgui_helplist]
[322]	248	grid [listbox $frm.cmds -relief raised -bd 2 \
	249	-yscrollcommand "$frm.scroll set" \
	250	-height 8 -width 0 -exportselection 0 ] \
	251	-column 0 -row 1 -sticky nse
	252	grid [scrollbar $frm.scroll -command "$frm.cmds yview"] \
	253	-column 1 -row 1 -sticky nsew
	254	foreach item [lsort -dictionary $lst] {
	255	$frm.cmds insert end $item
[17]	256	}
[322]	257	if {[$frm.cmds curselection] == ""} {$frm.cmds selection set 0}
	258	grid [button $frm.done -text Done -command "destroy $frm"] \
	259	-column 2 -row 1
	260	# bind $frm.cmds <ButtonRelease-1> \
	261	# "+set helpmsg \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\])"
	262	bind $frm.cmds <ButtonRelease-1> \
	263	"+$frm.help config -state normal; $frm.help delete 0.0 end; \
	264	$frm.help insert end \$expgui_helplist(\[$frm.cmds get \[$frm.cmds curselection\]\]); \
	265	$frm.help config -state disabled"
	266
[17]	267	# get the size of the window and expand the message boxes to match
[322]	268	# update
	269	# $frm.help config -width [winfo width $frm.help ]
[17]	270	}
	271
[322]	272	# compute the composition for each phase and display in a dialog
[59]	273	proc composition {} {
	274	global expmap expgui
	275	set Z 1
[130]	276	foreach phase $expmap(phaselist) type $expmap(phasetype) {
	277	if {$type > 2} continue
[59]	278	catch {unset total}
	279	foreach atom $expmap(atomlist_$phase) {
	280	set type [atominfo $phase $atom type]
	281	set mult [atominfo $phase $atom mult]
	282	if [catch {set total($type)}] {
	283	set total($type) [expr \
	284	$mult * [atominfo $phase $atom frac]]
	285	} else {
	286	set total($type) [expr $total($type) + \
	287	$mult * [atominfo $phase $atom frac]]
	288	}
	289	if {$mult > $Z} {set Z $mult}
	290	}
[119]	291	append text "\nPhase $phase\n"
	292	append text " Unit cell contents\n"
[59]	293	foreach type [lsort [array names total]] {
	294	append text " $type[format %8.3f $total($type)]"
	295	}
[119]	296	append text "\n\n"
[130]	297
[119]	298	append text " Asymmetric Unit contents (Z=$Z)\n"
[59]	299	foreach type [lsort [array names total]] {
	300	append text " $type[format %8.3f [expr $total($type)/$Z]]"
	301	}
	302	append text "\n"
	303	}
	304
	305	catch {destroy .comp}
	306	toplevel .comp
[322]	307	bind .comp <Key-F1> "MakeWWWHelp expguierr.html Composition"
[59]	308	wm title .comp Composition
	309	pack [label .comp.results -text $text \
	310	-font $expgui(coordfont) -justify left] -side top
[322]	311	pack [frame .comp.box] -side top -expand y -fill x
[59]	312	pack [button .comp.box.1 -text Close -command "destroy .comp"] -side left
[322]	313
[59]	314	set lstnam [string toupper [file tail [file rootname $expgui(expfile)].LST]]
	315	pack [button .comp.box.2 -text "Save to $lstnam file" \
	316	-command "writelst [list $text] ; destroy .comp"] -side left
[322]	317	pack [button .comp.box.help -text Help -bg yellow \
	318	-command "MakeWWWHelp expguierr.html Composition"] \
	319	-side right
[59]	320	}
	321
	322	# write text to the .LST file
	323	proc writelst {text} {
	324	global expgui
	325	set lstnam [file rootname $expgui(expfile)].LST
	326	set fp [open $lstnam a]
	327	puts $fp "\n-----------------------------------------------------------------"
	328	puts $fp $text
	329	puts $fp "-----------------------------------------------------------------\n"
	330	close $fp
	331	}
	332
	333	# save coordinates in an MSI .xtl file
	334	proc exp2xtl {} {
	335	global expmap expgui
	336	catch {destroy .export}
	337	toplevel .export
	338	wm title .export "Export coordinates"
[322]	339	bind .export <Key-F1> "MakeWWWHelp expguierr.html ExportMSI"
[59]	340	pack [label .export.lbl -text "Export coordinates in MSI .xtl format"\
	341	] -side top -anchor center
	342	pack [frame .export.ps] -side top -anchor w
	343	pack [label .export.ps.lbl -text "Select phase: "] -side left
[130]	344	foreach num $expmap(phaselist) type $expmap(phasetype) {
[59]	345	pack [button .export.ps.$num -text $num \
[130]	346	-command "SetExportPhase $num"] -side left
	347	if {$type == 4} {
	348	.export.ps.$num config -state disabled
	349	}
[59]	350	}
	351	pack [frame .export.sg] -side top
	352	pack [label .export.sg.1 -text "Space Group: "] -side left
	353	pack [entry .export.sg.2 -textvariable expgui(export_sg) -width 8] -side left
	354	pack [checkbutton .export.sg.3 -variable expgui(export_orig) -text "Origin 2"] -side left
[322]	355	pack [frame .export.but] -side top -fill x -expand yes
[59]	356	if {[llength $expmap(phaselist)] > 0} {
	357	pack [button .export.but.1 -text Write -command writextl] -side left
	358	SetExportPhase [lindex $expmap(phaselist) 0]
	359	}
	360	pack [button .export.but.2 -text Quit -command "destroy .export"] -side left
[322]	361	pack [button .export.but.help -text Help -bg yellow \
	362	-command "MakeWWWHelp expguierr.html ExportMSI"] \
	363	-side right
	364	# force the window to stay on top
	365	putontop .export
	366	afterputontop
[59]	367	}
	368
	369	proc SetExportPhase {phase} {
	370	global expmap expgui
[130]	371	foreach n $expmap(phaselist) type $expmap(phasetype) {
	372	if {$n == $phase && $type != 4} {
[59]	373	.export.ps.$n config -relief sunken
[130]	374	set expgui(export_phase) $phase
	375	# remove spaces from space group
	376	set spacegroup [phaseinfo $phase spacegroup]
	377	if {[string toupper [string range $spacegroup end end]] == "R"} {
	378	set spacegroup [string range $spacegroup 0 \
	379	[expr [string length $spacegroup]-2]]
	380	}
	381	regsub -all " " $spacegroup "" expgui(export_sg)
[59]	382	} else {
	383	.export.ps.$n config -relief raised
	384	}
	385	}
	386	}
	387
	388
	389	proc writextl {} {
	390	global expgui expmap
	391	if ![catch {
	392	set phase $expgui(export_phase)
	393	set origin $expgui(export_orig)
	394	set spsymbol $expgui(export_sg)
	395	} errmsg] {
	396	set errmsg {}
	397	if {$phase == ""} {
	398	set errmsg "Error: invalid phase number $phase"
	399	} elseif {$spsymbol == ""} {
	400	set errmsg "Error: invalid Space Group: $spsymbol"
	401	}
	402	}
	403	if {$errmsg != ""} {
	404	tk_dialog .errorMsg "Export error" $errmsg warning 0 "OK"
	405	return
	406	}
	407
	408	if [catch {
	409	set filnam [file rootname $expgui(expfile)]_${phase}.xtl
	410	set spacegroup [phaseinfo $phase spacegroup]
	411	set fp [open $filnam w]
	412	puts $fp "TITLE from $expgui(expfile)"
	413	puts $fp "TITLE history [string trim [lindex [exphistory last] 1]]"
	414	puts $fp "TITLE phase [phaseinfo $phase name]"
	415	puts $fp "CELL"
	416	puts $fp " [phaseinfo $phase a] [phaseinfo $phase b] [phaseinfo $phase c] [phaseinfo $phase alpha] [phaseinfo $phase beta] [phaseinfo $phase gamma]"
	417
	418	puts $fp "Symmetry Label $spsymbol"
	419	set rhomb 0
	420	if {[string toupper [string range $spacegroup end end]] == "R"} {
	421	set rhomb 1
	422	}
	423	if $origin {
	424	puts $fp "Symmetry Qualifier origin_2"
	425	}
	426	if $rhomb {
	427	puts $fp "Symmetry Qualifier rhombohedral"
	428	}
	429
[227]	430	puts $fp "ATOMS"
	431	puts $fp "NAME X Y Z UISO OCCUP"
[59]	432	foreach atom $expmap(atomlist_$phase) {
[227]	433	set label [atominfo $phase $atom label]
	434	# remove () characters
	435	regsub -all "\[()\]" $label "" label
	436	# are there anisotropic atoms?
	437	if {[atominfo $phase $atom temptype] == "A"} {
	438	set uiso [expr \
	439	([atominfo $phase $atom U11] + \
	440	[atominfo $phase $atom U22] + \
	441	[atominfo $phase $atom U33]) / 3.]
	442	} else {
	443	set uiso [atominfo $phase $atom Uiso]
[59]	444	}
[227]	445	puts $fp "$label [atominfo $phase $atom x] \
[59]	446	[atominfo $phase $atom y] [atominfo $phase $atom z] \
[227]	447	$uiso [atominfo $phase $atom frac]"
[59]	448	}
	449	} errmsg] {
	450	catch {close $fp}
	451	tk_dialog .errorMsg "Export error" $errmsg warning 0 "OK"
	452	} else {
	453	catch {close $fp}
	454	tk_dialog .ok "Done" \
	455	"File [file tail $filnam] written in directory [file dirname $filnam]" \
	456	warning 0 "OK"
	457	}
	458	if {[llength $expmap(phaselist)] == 1} {destroy .export}
	459	}
	460
	461
[29]	462	# convert a file
[17]	463	proc convfile {} {
	464	global tcl_platform
	465	if {$tcl_platform(platform) == "windows"} {
	466	convwin
	467	} else {
	468	convunix
	469	}
	470	}
	471
	472	# file conversions for UNIX (convstod convdtos)
	473	proc convunix {} {
	474	global expgui infile outfile
	475	set frm .file
	476	catch {destroy $frm}
	477	toplevel $frm
	478	wm title $frm "Convert File"
[322]	479	bind $frm <Key-F1> "MakeWWWHelp expguierr.html ConvertUnix"
[17]	480
[59]	481	pack [frame [set frm0 $frm.0] -bd 2 -relief groove] \
	482	-padx 3 -pady 3 -side top -fill x
	483	pack [frame $frm.mid] -side top
	484	pack [frame [set frmA $frm.mid.1] -bd 2 -relief groove] \
	485	-padx 3 -pady 3 -side left
[17]	486	pack [label $frmA.0 -text "Select an input file"] -side top -anchor center
[59]	487	pack [frame [set frmB $frm.mid.2] -bd 2 -relief groove] \
	488	-padx 3 -pady 3 -side left
[17]	489	pack [label $frmB.0 -text "Enter an output file"] -side top -anchor center
[322]	490	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side top -fill x -expand y
[59]	491
	492	pack [label $frm0.1 -text "Convert to:"] -side top -anchor center
	493	pack [frame $frm0.2] -side top -anchor center
	494	pack [radiobutton $frm0.2.d -text "direct access" -value convstod \
[17]	495	-command setoutfile \
[59]	496	-variable outfile(type)] -side left -anchor center
	497	pack [radiobutton $frm0.2.s -text "sequential" -value convdtos \
[17]	498	-command setoutfile \
[59]	499	-variable outfile(type)] -side right -anchor center
[17]	500	set outfile(type) ""
[59]	501
	502	pack [button $frmC.b -text Convert -command "valid_conv_unix"] -side left
	503	pack [button $frmC.q -text Quit -command "set infile(done) 1"] -side left
[322]	504	pack [button $frmC.help -text Help -bg yellow \
	505	-command "MakeWWWHelp expguierr.html ConvertUnix"] \
	506	-side right
[59]	507
	508	unixcnvbox $frmA infile 1
	509	unixcnvbox $frmB outfile 0
[17]	510	set infile(done) 0
[91]	511	bind $frm <Return> "valid_conv_unix"
[17]	512	# force the window to stay on top
[91]	513	putontop $frm
[17]	514	focus $frmC.q
	515	update
	516	tkwait variable infile(done)
	517	destroy $frm
[91]	518	afterputontop
[17]	519	}
	520
[59]	521	# validate the files and make the conversion -- unix
	522	proc valid_conv_unix {} {
[17]	523	global infile outfile expgui
[59]	524	set error {}
[17]	525	if {$outfile(type) == "convstod" \|\| $outfile(type) == "convdtos"} {
	526	set convtype $outfile(type)
	527	} else {
[59]	528	append error "You must specify a conversion method: to direct access or to sequential.\n"
	529	}
	530	if {$infile(name) == ""} {
	531	append error "You must specify an input file to convert.\n"
	532	}
	533	if {$outfile(name) == ""} {
	534	append error "You must specify an output file name for the converted file.\n"
	535	}
	536	if {$error != ""} {
	537	tk_dialog .warn Notify $error warning 0 OK
[17]	538	return
	539	}
[59]	540
[17]	541	if {$infile(name) == $outfile(name)} {
	542	tk_dialog .warn Notify "Sorry, filenames must differ" warning 0 OK
	543	return
	544	}
	545	if ![file exists [file join $infile(dir) $infile(name)]] {
	546	tk_dialog .warn Notify \
	547	"Sorry, file $infile(name) not found in $infile(dir)" warning 0 OK
	548	return
	549	}
	550	if [file exists [file join $outfile(dir) $outfile(name)]] {
	551	if [tk_dialog .warn Notify \
	552	"Warning: file $outfile(name) exists in $outfile(dir). OK to overwrite?" \
	553	warning 0 OK No] return
	554	}
	555	if [catch {
	556	exec [file join $expgui(gsasexe) $convtype] < \
	557	[file join $infile(dir) $infile(name)] > \
	558	[file join $outfile(dir) $outfile(name)]
	559	} errmsg] {
	560	tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
	561	} else {
	562	if [tk_dialog .converted Notify \
	563	"File converted. Convert more files?" \
	564	"" 0 Yes No] {set infile(done) 1}
	565	}
	566	}
	567
[59]	568	# create a file box for UNIX conversions
	569	proc unixcnvbox {bx filvar diropt} {
	570	global ${filvar} expgui
	571	pack [frame $bx.top] -side top
	572	pack [label $bx.top.a -text "Directory" ] -side left
	573	set ${filvar}(FileDirButtonMenu) [tk_optionMenu $bx.top.d ${filvar}(dir) [pwd] ]
	574	pack $bx.top.d -side left
	575	set ${filvar}(dir) [pwd]
	576
	577	# pack [label $bx.d -textvariable ${filvar}(dir) -bd 2 -relief raised ] -side top
	578	# set ${filvar}(dir) [pwd]
	579
	580	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
	581	listbox $bx.a.files -relief raised -bd 2 -yscrollcommand "$bx.a.scroll set" \
	582	-height 15 -width 0
	583	scrollbar $bx.a.scroll -command "$bx.a.files yview"
	584	unixFilChoose $bx $bx.a.files $filvar $diropt
	585	if {$filvar == "infile"} {
	586	bind $bx.a.files <ButtonRelease-1> \
	587	"unixFilChoose $bx $bx.a.files $filvar $diropt; setoutfile"
	588	} else {
	589	bind $bx.a.files <ButtonRelease-1> \
	590	"unixFilChoose $bx $bx.a.files $filvar $diropt"
	591	}
	592	pack $bx.a.scroll -side left -fill y
	593	pack $bx.a.files -side left -fill both -expand yes
	594	pack [entry $bx.c -textvariable ${filvar}(name)] -side top
	595	}
	596
	597	# select a file or directory, also called when box is created to fill it
	598	proc unixFilChoose {frm box filvar {dironly 1}} {
	599	global $filvar
	600	set select [$box curselection]
	601	if {$select == ""} {
	602	set file .
	603	} else {
	604	set file [string trim [$box get $select]]
	605	}
	606	if [file isdirectory [file join [set ${filvar}(dir)] $file]] {
	607	if {$file == ".."} {
	608	set ${filvar}(dir) [file dirname [set ${filvar}(dir)] ]
	609	} elseif {$file != "."} {
	610	set ${filvar}(dir) [file join [set ${filvar}(dir)] $file]
	611	}
	612	[set ${filvar}(FileDirButtonMenu)] delete 0 end
	613	set list ""
	614	set dir ""
	615	foreach subdir [file split [set ${filvar}(dir)]] {
	616	set dir [file join $dir $subdir]
	617	lappend list $dir
	618	}
	619	foreach path $list {
	620	[set ${filvar}(FileDirButtonMenu)] add command -label $path \
	621	-command "[list set ${filvar}(dir) $path]; \
	622	unixFilChoose $frm $box $filvar $dironly"
	623	}
	624	set ${filvar}(name) {}
	625	$box delete 0 end
	626	$box insert end {.. }
	627	foreach file [lsort [glob -nocomplain \
	628	[file join [set ${filvar}(dir)] *] ] ] {
	629	if {[file isdirectory $file]} {
	630	# is this / needed here? Does it cause a problem in MacGSAS?
	631	$box insert end [file tail $file]/
	632	} elseif {$dironly == 1} {
	633	$box insert end [file tail $file]
	634	} elseif {$dironly == 2 && [file extension $file] == ".EXP"} {
	635	$box insert end [file tail $file]
	636	}
	637	}
	638	return
	639	}
	640	set ${filvar}(name) [file tail $file]
	641	}
	642
	643	# set new file name from old -- used for convunix
	644	proc setoutfile {} {
	645	global infile outfile
	646	if {$outfile(type) == "convstod"} {
	647	set lfile [string toupper $infile(name)]
	648	} elseif {$outfile(type) == "convdtos"} {
	649	set lfile [string tolower $infile(name)]
	650	} else {
	651	set lfile ""
	652	}
	653	if {$infile(name) == $lfile} {
	654	set outfile(name) {}
	655	} else {
	656	set outfile(name) $lfile
	657	}
	658	}
	659
	660	#------------------------------------------------------------------------------
[17]	661	# file conversions for Windows
[59]	662	#------------------------------------------------------------------------------
[17]	663	proc convwin {} {
[59]	664	global expgui
[17]	665	set frm .file
	666	catch {destroy $frm}
	667	toplevel $frm
	668	wm title $frm "Convert File"
[322]	669	bind $frm <Key-F1> "MakeWWWHelp expguierr.html ConvertWin"
[17]	670	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
[322]	671	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 \
	672	-side left -fill y -expand yes
	673	pack [button $frmC.help -text Help -bg yellow \
	674	-command "MakeWWWHelp expguierr.html ConvertWin"] -side top
	675	pack [button $frmC.q -text Quit -command "destroy $frm"] -side bottom
[72]	676	pack [button $frmC.b -text Convert -command "ValidWinCnv $frm"] \
[322]	677	-side bottom
[17]	678	pack [label $frmA.0 -text "Select a file to convert"] -side top -anchor center
[72]	679	winfilebox $frm
	680	bind $frm <Return> "ValidWinCnv $frm"
[17]	681
[91]	682	# force the window to stay on top
	683	putontop $frm
[17]	684	focus $frmC.q
[59]	685	tkwait window $frm
[91]	686	afterputontop
[17]	687	}
	688
	689	# validate the files and make the conversion
[72]	690	proc ValidWinCnv {frm} {
[59]	691	global expgui
[72]	692	# change backslashes to something sensible
	693	regsub -all {\\} $expgui(FileMenuCnvName) / expgui(FileMenuCnvName)
	694	# allow entry of D: for D:/ and D:TEST for d:/TEST
	695	if {[string first : $expgui(FileMenuCnvName)] != -1 && \
	696	[string first :/ $expgui(FileMenuCnvName)] == -1} {
	697	regsub : $expgui(FileMenuCnvName) :/ expgui(FileMenuCnvName)
	698	}
[59]	699	if {$expgui(FileMenuCnvName) == "<Parent>"} {
	700	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
[72]	701	ChooseWinCnv $frm
[17]	702	return
[59]	703	} elseif [file isdirectory \
	704	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]] {
	705	if {$expgui(FileMenuCnvName) != "."} {
	706	set expgui(FileMenuDir) \
	707	[file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
	708	}
[72]	709	ChooseWinCnv $frm
[59]	710	return
[17]	711	}
[59]	712
	713	set file [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
	714	if ![file exists $file] {
	715	tk_dialog .warn "Convert Error" \
	716	"File $file does not exist" question 0 "OK"
	717	return
	718	}
	719
	720	set tmpname "[file join [file dirname $file] tempfile.xxx]"
	721	set oldname "[file rootname $file].org"
	722	if [file exists $oldname] {
	723	set ans [tk_dialog .warn "OK to overwrite?" \
	724	"File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" question 0 \
	725	"Yes" "No"]
	726	if $ans return
	727	catch {file delete $oldname}
	728	}
	729
[17]	730	if [catch {
[59]	731	set in [open $file r]
	732	set out [open $tmpname w]
[17]	733	set len [gets $in line]
	734	if {$len > 160} {
	735	# this is a UNIX file. Hope there are no control characters
	736	set i 0
	737	set j 79
	738	while {$j < $len} {
	739	puts $out [string range $line $i $j]
	740	incr i 80
	741	incr j 80
	742	}
	743	} else {
	744	while {$len >= 0} {
	745	append line " "
	746	append line " "
	747	set line [string range $line 0 79]
	748	puts $out $line
	749	set len [gets $in line]
	750	}
	751	}
	752	close $in
	753	close $out
[138]	754	file rename -force $file $oldname
	755	file rename -force $tmpname $file
[17]	756	} errmsg] {
	757	tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
	758	} else {
	759	if [tk_dialog .converted Notify \
[59]	760	"File [file tail $file] converted. (Original saved as [file tail $oldname]).\n\n Convert more files?" \
	761	"" 0 Yes No] {destroy $frm}
[17]	762	}
	763	}
	764
[59]	765	# create a file box
[72]	766	proc winfilebox {frm} {
[59]	767	global expgui
[72]	768	set bx $frm.1
[59]	769	pack [frame $bx.top] -side top
	770	pack [label $bx.top.a -text "Directory" ] -side left
	771	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
	772	pack $bx.top.d -side left
	773	set expgui(FileMenuDir) [pwd]
	774	# the icon below is from tk8.0/tkfbox.tcl
	775	set upfolder [image create bitmap -data {
	776	#define updir_width 28
	777	#define updir_height 16
	778	static char updir_bits[] = {
	779	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
	780	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
	781	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
	782	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
	783	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
	784	0xf0, 0xff, 0xff, 0x01};}]
	785
	786	pack [button $bx.top.b -image $upfolder \
[72]	787	-command "updir; ChooseWinCnv $frm" ]
[17]	788	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
[59]	789	listbox $bx.a.files -relief raised -bd 2 \
	790	-yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
[17]	791	-height 15 -width 0
[59]	792	listbox $bx.a.dates -relief raised -bd 2 \
	793	-yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
	794	-height 15 -width 0 -takefocus 0
	795	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
[72]	796	ChooseWinCnv $frm
	797	bind $bx.a.files <ButtonRelease-1> "ReleaseWinCnv $frm"
	798	bind $bx.a.dates <ButtonRelease-1> "ReleaseWinCnv $frm"
	799	bind $bx.a.files <Double-1> "SelectWinCnv $frm"
	800	bind $bx.a.dates <Double-1> "SelectWinCnv $frm"
[17]	801	pack $bx.a.scroll -side left -fill y
[59]	802	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
	803	pack [entry $bx.c -textvariable expgui(FileMenuCnvName)] -side top
[17]	804	}
	805
[59]	806	# set the box or file in the selection window
[72]	807	proc ReleaseWinCnv {frm} {
[59]	808	global expgui
[72]	809	set files $frm.1.a.files
	810	set dates $frm.1.a.dates
[59]	811	set select [$files curselection]
[17]	812	if {$select == ""} {
[59]	813	set select [$dates curselection]
	814	}
	815	if {$select == ""} {
	816	set expgui(FileMenuCnvName) ""
[17]	817	} else {
[59]	818	set expgui(FileMenuCnvName) [string trim [$files get $select]]
[17]	819	}
[59]	820	if {$expgui(FileMenuCnvName) == "<Parent>"} {
	821	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
[72]	822	ChooseWinCnv $frm
[59]	823	} elseif [file isdirectory \
	824	[file join [set expgui(FileMenuDir)] $expgui(FileMenuCnvName)]] {
	825	if {$expgui(FileMenuCnvName) != "."} {
	826	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuCnvName)]
[72]	827	ChooseWinCnv $frm
[17]	828	}
	829	}
[59]	830	return
[17]	831	}
	832
[59]	833	# select a file or directory -- called on double click
[72]	834	proc SelectWinCnv {frm} {
[59]	835	global expgui
[72]	836	set files $frm.1.a.files
	837	set dates $frm.1.a.dates
[59]	838	set select [$files curselection]
	839	if {$select == ""} {
	840	set select [$dates curselection]
	841	}
	842	if {$select == ""} {
	843	set file .
[17]	844	} else {
[59]	845	set file [string trim [$files get $select]]
[17]	846	}
[59]	847	if {$file == "<Parent>"} {
	848	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
[72]	849	ChooseWinCnv $frm
[59]	850	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
	851	if {$file != "."} {
	852	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
[72]	853	ChooseWinCnv $frm
[59]	854	}
[17]	855	} else {
[59]	856	set expgui(FileMenuCnvName) [file tail $file]
[72]	857	ValidWinCnv $frm
[17]	858	}
	859	}
	860
[59]	861	# fill the files & dates & Directory selection box with current directory,
	862	# also called when box is created to fill it
[72]	863	proc ChooseWinCnv {frm} {
[59]	864	global expgui
[72]	865	set files $frm.1.a.files
	866	set dates $frm.1.a.dates
[59]	867	set expgui(FileMenuCnvName) {}
	868	$files delete 0 end
	869	$dates delete 0 end
	870	$files insert end {<Parent>}
	871	$dates insert end {(Directory)}
	872	set filelist [glob -nocomplain \
	873	[file join [set expgui(FileMenuDir)] *] ]
[91]	874	foreach file [lsort -dictionary $filelist] {
[59]	875	if {[file isdirectory $file]} {
	876	$files insert end [file tail $file]
	877	$dates insert end {(Directory)}
	878	}
	879	}
[91]	880	foreach file [lsort -dictionary $filelist] {
[72]	881	if {![file isdirectory $file]} {
	882	set modified [clock format [file mtime $file] -format "%T %D"]
	883	$files insert end [file tail $file]
	884	$dates insert end $modified
	885	}
[59]	886	}
	887	$expgui(FileDirButtonMenu) delete 0 end
	888	set list ""
	889	set dir ""
	890	foreach subdir [file split [set expgui(FileMenuDir)]] {
	891	set dir [file join $dir $subdir]
	892	lappend list $dir
	893	}
	894	foreach path $list {
	895	$expgui(FileDirButtonMenu) add command -label $path \
	896	-command "[list set expgui(FileMenuDir) $path]; \
[72]	897	ChooseWinCnv $frm"
[59]	898	}
	899	return
	900	}
	901
	902	#------------------------------------------------------------------------------
[29]	903	# set options for liveplot
[17]	904	proc liveplotopt {} {
[83]	905	global liveplot expmap
[17]	906	set frm .file
	907	catch {destroy $frm}
	908	toplevel $frm
	909	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
[83]	910	set last [lindex [lsort -integer $expmap(powderlist)] end]
	911	if {$last == ""} {set last 1}
	912	pack [scale $frmA.1 -label "Histogram number" -from 1 -to $last \
[17]	913	-length 150 -orient horizontal -variable liveplot(hst)] -side top
	914	pack [checkbutton $frmA.2 -text {include plot legend}\
	915	-variable liveplot(legend)] -side top
	916	pack [button $frm.2 -text OK \
	917	-command {if ![catch {expr $liveplot(hst)}] "destroy .file"} \
	918	] -side top
	919	bind $frm <Return> {if ![catch {expr $liveplot(hst)}] "destroy .file"}
[91]	920
[17]	921	# force the window to stay on top
[91]	922	putontop $frm
[17]	923	focus $frm.2
	924	tkwait window $frm
[91]	925	afterputontop
[17]	926	}
[29]	927
	928	#------------------------------------------------------------------------------
	929	# get an experiment file name
	930	#------------------------------------------------------------------------------
	931	proc getExpFileName {mode} {
	932	global expgui
	933	set frm .file
	934	catch {destroy $frm}
	935	toplevel $frm
[59]	936	wm title $frm "Experiment file"
[29]	937	pack [frame [set frmA $frm.1] -bd 2 -relief groove] -padx 3 -pady 3 -side left
	938	pack [frame [set frmC $frm.3] ] -padx 3 -pady 3 -side left
	939	pack [label $frmC.2 -text "Sort .EXP files by" ] -side top
	940	pack [radiobutton $frmC.1 -text "File Name" -value 1 \
	941	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
	942	pack [radiobutton $frmC.0 -text "Mod. Date" -value 0 \
	943	-variable expgui(filesort) -command "ChooseExpFil $frmA"] -side top
[32]	944	pack [button $frmC.b -text Read \
[29]	945	-command "valid_exp_file $frmA $mode"] -side top
[32]	946	if {$mode == "new"} {
	947	$frmC.b config -text Save
	948	}
[29]	949	pack [button $frmC.q -text Quit \
	950	-command "set expgui(FileMenuEXPNAM) {}; destroy $frm"] -side top
	951	bind $frm <Return> "$frmC.b invoke"
	952
[32]	953	if {$mode == "new"} {
	954	pack [label $frmA.0 -text "Enter an experiment file to create"] \
	955	-side top -anchor center
	956	} else {
	957	pack [label $frmA.0 -text "Select an experiment file to read"] \
	958	-side top -anchor center
	959	}
[29]	960	expfilebox $frmA $mode
	961	# force the window to stay on top
[91]	962	putontop $frm
[29]	963	focus $frmC.b
	964	tkwait window $frm
[91]	965	afterputontop
[29]	966	if {$expgui(FileMenuEXPNAM) == ""} return
	967	return [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	968	}
	969
	970	# validation routine
	971	proc valid_exp_file {frm mode} {
[72]	972	global expgui tcl_platform
	973	# windows fixes
	974	if {$tcl_platform(platform) == "windows"} {
	975	# change backslashes to something sensible
	976	regsub -all {\\} $expgui(FileMenuEXPNAM) / expgui(FileMenuEXPNAM)
	977	# allow entry of D: for D:/ and D:TEST for d:/TEST
	978	if {[string first : $expgui(FileMenuEXPNAM)] != -1 && \
	979	[string first :/ $expgui(FileMenuEXPNAM)] == -1} {
	980	regsub : $expgui(FileMenuEXPNAM) :/ expgui(FileMenuEXPNAM)
	981	}
	982	}
[29]	983	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
	984	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
	985	ChooseExpFil $frm
	986	return
	987	} elseif [file isdirectory \
	988	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]] {
	989	if {$expgui(FileMenuEXPNAM) != "."} {
	990	set expgui(FileMenuDir) \
	991	[file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	992	}
	993	ChooseExpFil $frm
	994	return
	995	}
[182]	996	# append a .EXP if not present
[29]	997	if {[file extension $expgui(FileMenuEXPNAM)] == ""} {
	998	append expgui(FileMenuEXPNAM) ".EXP"
	999	}
[182]	1000	# flag files that end in something other than .EXP .exp or .Exp...
[130]	1001	if {[string toupper [file extension $expgui(FileMenuEXPNAM)]] != ".EXP"} {
[29]	1002	tk_dialog .expFileErrorMsg "File Open Error" \
[62]	1003	"File [file tail $expgui(FileMenuEXPNAM)] is not a valid name. Experiment files must end in \".EXP\"" \
[29]	1004	error 0 OK
	1005	return
	1006	}
[182]	1007	# check on the file status
[29]	1008	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	1009	if {$mode == "new" && [file exists $file]} {
	1010	set ans [tk_dialog .expFileErrorMsg "File Open Error" \
[62]	1011	"File [file tail $file] already exists in [file dirname $file]. OK to overwrite?" question 0 \
[29]	1012	"Select other name" "Overwrite"]
	1013	if $ans {destroy .file}
	1014	return
	1015	}
[182]	1016	# if file does not exist in case provided, set the name to all
	1017	# upper case letters, since that is the best choice.
	1018	# if it does exist, read from it as is. For UNIX we will force uppercase later.
	1019	if {![file exists $file]} {
	1020	set expgui(FileMenuEXPNAM) [string toupper $expgui(FileMenuEXPNAM)]
	1021	set file [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	1022	}
[29]	1023	if {$mode == "old" && ![file exists $file]} {
	1024	set ans [tk_dialog .expFileErrorMsg "File Open Error" \
[62]	1025	"File [file tail $file] does not exist in [file dirname $file]. OK to create?" question 0 \
[29]	1026	"Select other name" "Create"]
	1027	if $ans {destroy .file}
	1028	return
	1029	}
	1030	destroy .file
	1031	}
	1032
	1033	proc updir {} {
	1034	global expgui
	1035	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)]]
	1036	}
	1037
	1038	# create a file box
	1039	proc expfilebox {bx mode} {
	1040	global expgui
	1041	pack [frame $bx.top] -side top
	1042	pack [label $bx.top.a -text "Directory" ] -side left
	1043	set expgui(FileDirButtonMenu) [tk_optionMenu $bx.top.d expgui(FileMenuDir) [pwd] ]
	1044	pack $bx.top.d -side left
	1045	set expgui(FileMenuDir) [pwd]
	1046	# the icon below is from tk8.0/tkfbox.tcl
	1047	set upfolder [image create bitmap -data {
	1048	#define updir_width 28
	1049	#define updir_height 16
	1050	static char updir_bits[] = {
	1051	0x00, 0x00, 0x00, 0x00, 0x80, 0x1f, 0x00, 0x00, 0x40, 0x20, 0x00, 0x00,
	1052	0x20, 0x40, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x01, 0x10, 0x00, 0x00, 0x01,
	1053	0x10, 0x02, 0x00, 0x01, 0x10, 0x07, 0x00, 0x01, 0x90, 0x0f, 0x00, 0x01,
	1054	0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
	1055	0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
	1056	0xf0, 0xff, 0xff, 0x01};}]
	1057
	1058	pack [button $bx.top.b -image $upfolder \
	1059	-command "updir; ChooseExpFil $bx" ]
	1060	pack [frame $bx.a -width 200 -height 75] -side top -expand yes -fill both
	1061	listbox $bx.a.files -relief raised -bd 2 \
	1062	-yscrollcommand "sync2boxes $bx.a.files $bx.a.dates $bx.a.scroll" \
	1063	-height 15 -width 0
	1064	listbox $bx.a.dates -relief raised -bd 2 \
	1065	-yscrollcommand "sync2boxes $bx.a.dates $bx.a.files $bx.a.scroll" \
	1066	-height 15 -width 0 -takefocus 0
	1067	scrollbar $bx.a.scroll -command "move2boxesY \" $bx.a.files $bx.a.dates \" "
	1068	ChooseExpFil $bx
	1069	bind $bx.a.files <ButtonRelease-1> "ReleaseExpFil $bx"
	1070	bind $bx.a.dates <ButtonRelease-1> "ReleaseExpFil $bx"
	1071	bind $bx.a.files <Double-1> "SelectExpFil $bx $mode"
	1072	bind $bx.a.dates <Double-1> "SelectExpFil $bx $mode"
	1073	pack $bx.a.scroll -side left -fill y
	1074	pack $bx.a.files $bx.a.dates -side left -fill both -expand yes
	1075	pack [entry $bx.c -textvariable expgui(FileMenuEXPNAM)] -side top
	1076	}
	1077	proc sync2boxes {master slave scroll args} {
	1078	$slave yview moveto [lindex [$master yview] 0]
	1079	eval $scroll set $args
	1080	}
	1081	proc move2boxesY {boxlist args} {
	1082	foreach listbox $boxlist {
	1083	eval $listbox yview $args
	1084	}
	1085	}
	1086
	1087	# set the box or file in the selection window
	1088	proc ReleaseExpFil {frm} {
	1089	global expgui
	1090	set files $frm.a.files
	1091	set dates $frm.a.dates
	1092	set select [$files curselection]
	1093	if {$select == ""} {
	1094	set select [$dates curselection]
	1095	}
	1096	if {$select == ""} {
	1097	set expgui(FileMenuEXPNAM) ""
	1098	} else {
	1099	set expgui(FileMenuEXPNAM) [string trim [$files get $select]]
	1100	}
[59]	1101	if {$expgui(FileMenuEXPNAM) == "<Parent>"} {
	1102	set expgui(FileMenuDir) [file dirname $expgui(FileMenuDir)]
	1103	ChooseExpFil $frm
	1104	} elseif [file isdirectory \
	1105	[file join [set expgui(FileMenuDir)] $expgui(FileMenuEXPNAM)]] {
	1106	if {$expgui(FileMenuEXPNAM) != "."} {
	1107	set expgui(FileMenuDir) [file join $expgui(FileMenuDir) $expgui(FileMenuEXPNAM)]
	1108	ChooseExpFil $frm
	1109	}
	1110	}
[29]	1111	return
	1112	}
	1113
	1114	# select a file or directory -- called on double click
	1115	proc SelectExpFil {frm mode} {
	1116	global expgui
	1117	set files $frm.a.files
	1118	set dates $frm.a.dates
	1119	set select [$files curselection]
	1120	if {$select == ""} {
	1121	set select [$dates curselection]
	1122	}
	1123	if {$select == ""} {
	1124	set file .
	1125	} else {
	1126	set file [string trim [$files get $select]]
	1127	}
	1128	if {$file == "<Parent>"} {
	1129	set expgui(FileMenuDir) [file dirname [set expgui(FileMenuDir)] ]
	1130	ChooseExpFil $frm
	1131	} elseif [file isdirectory [file join [set expgui(FileMenuDir)] $file]] {
	1132	if {$file != "."} {
	1133	set expgui(FileMenuDir) [file join [set expgui(FileMenuDir)] $file]
	1134	ChooseExpFil $frm
	1135	}
	1136	} else {
	1137	set expgui(FileMenuEXPNAM) [file tail $file]
	1138	valid_exp_file $frm $mode
	1139	}
	1140	}
	1141
	1142	# fill the files & dates & Directory selection box with current directory,
	1143	# also called when box is created to fill it
	1144	proc ChooseExpFil {frm} {
	1145	global expgui
	1146	set files $frm.a.files
	1147	set dates $frm.a.dates
	1148	set expgui(FileMenuEXPNAM) {}
	1149	$files delete 0 end
	1150	$dates delete 0 end
	1151	$files insert end {<Parent>}
	1152	$dates insert end {(Directory)}
	1153	set filelist [glob -nocomplain \
	1154	[file join [set expgui(FileMenuDir)] *] ]
[91]	1155	foreach file [lsort -dictionary $filelist] {
[29]	1156	if {[file isdirectory $file]} {
	1157	$files insert end [file tail $file]
	1158	$dates insert end {(Directory)}
	1159	}
	1160	}
	1161	set pairlist {}
[91]	1162	foreach file [lsort -dictionary $filelist] {
[29]	1163	if {![file isdirectory $file] && \
[47]	1164	[string toupper [file extension $file]] == ".EXP"} {
[29]	1165	set modified [file mtime $file]
[72]	1166	lappend pairlist [list $file $modified]
[29]	1167	}
	1168	}
	1169	if {$expgui(filesort) == 0} {
	1170	foreach pair [lsort -index 1 -integer $pairlist] {
	1171	set file [lindex $pair 0]
	1172	set modified [clock format [lindex $pair 1] -format "%T %D"]
	1173	$files insert end [file tail $file]
	1174	$dates insert end $modified
	1175	}
	1176	} else {
[130]	1177	foreach pair [lsort -dictionary -index 0 $pairlist] {
[29]	1178	set file [lindex $pair 0]
	1179	set modified [clock format [lindex $pair 1] -format "%T %D"]
	1180	$files insert end [file tail $file]
	1181	$dates insert end $modified
	1182	}
	1183	}
	1184	$expgui(FileDirButtonMenu) delete 0 end
	1185	set list ""
	1186	set dir ""
	1187	foreach subdir [file split [set expgui(FileMenuDir)]] {
	1188	set dir [file join $dir $subdir]
	1189	lappend list $dir
	1190	}
	1191	foreach path $list {
	1192	$expgui(FileDirButtonMenu) add command -label $path \
	1193	-command "[list set expgui(FileMenuDir) $path]; \
	1194	ChooseExpFil $frm"
	1195	}
	1196	# highlight the current experiment -- if present
	1197	for {set i 0} {$i < [$files size]} {incr i} {
	1198	set file [$files get $i]
	1199	if {$expgui(expfile) == [file join $expgui(FileMenuDir) $file]} {
	1200	$files selection set $i
	1201	}
	1202	}
	1203	return
	1204	}
[91]	1205
	1206	proc putontop {w} {
	1207	# center window $w above its parent and make it stay on top
	1208	set wp [winfo parent $w]
	1209	wm transient $w [winfo toplevel $wp]
	1210	wm withdraw $w
	1211	update idletasks
	1212	# center the new window in the middle of the parent
	1213	set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
	1214	[winfo reqwidth $w]/2 - [winfo vrootx $wp]]
	1215	if {$x < 0} {set x 0}
	1216	set xborder 10
	1217	if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
	1218	incr x [expr \
	1219	[winfo screenwidth $w] - ($x+[winfo reqwidth $w] + $xborder)]
	1220	}
	1221	set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
	1222	[winfo reqheight $w]/2 - [winfo vrooty $wp]]
	1223	if {$y < 0} {set y 0}
	1224	set yborder 25
	1225	if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
	1226	incr y [expr \
	1227	[winfo screenheight $w] - ($y+[winfo reqheight $w] + $yborder)]
	1228	}
	1229	wm geom $w +$x+$y
	1230	wm deiconify $w
	1231
	1232	global makenew
[322]	1233	set makenew(OldGrab) ""
	1234	catch {set makenew(OldFocus) [focus]}
	1235	catch {set makenew(OldGrab) [grab current $w]}
	1236	catch {grab $w}
[91]	1237	}
	1238
	1239	proc afterputontop {} {
	1240	# restore focus
	1241	global makenew
	1242	catch {focus $makenew(OldFocus)}
[322]	1243	catch {
	1244	if {$makenew(OldGrab) != ""} {
	1245	grab $makenew(OldGrab)
	1246	}
[91]	1247	}
	1248	}
	1249
[322]	1250	proc ShowBigMessage {win labeltext msg "optionlist OK" "link {}"} {
[91]	1251	catch {destroy $win}
	1252	toplevel $win
	1253
	1254	pack [label $win.l1 -text $labeltext] -side top
[98]	1255	pack [frame $win.f1] -side top -expand yes -fill both
[91]	1256	grid [text $win.f1.t \
	1257	-height 20 -width 55 -wrap none -font Courier \
	1258	-xscrollcommand "$win.f1.bscr set" \
	1259	-yscrollcommand "$win.f1.rscr set" \
	1260	] -row 1 -column 0 -sticky news
	1261	grid [scrollbar $win.f1.bscr -orient horizontal \
	1262	-command "$win.f1.t xview" \
	1263	] -row 2 -column 0 -sticky ew
	1264	grid [scrollbar $win.f1.rscr -command "$win.f1.t yview" \
	1265	] -row 1 -column 1 -sticky ns
	1266	# give extra space to the text box
	1267	grid columnconfigure $win.f1 0 -weight 1
	1268	grid rowconfigure $win.f1 1 -weight 1
	1269	$win.f1.t insert end $msg
	1270
	1271	global makenew
	1272	set makenew(result) 0
	1273	bind $win <Return> "destroy $win"
	1274	bind $win <KeyPress-Prior> "$win.f1.t yview scroll -1 page"
	1275	bind $win <KeyPress-Next> "$win.f1.t yview scroll 1 page"
	1276	bind $win <KeyPress-Right> "$win.f1.t xview scroll 1 unit"
	1277	bind $win <KeyPress-Left> "$win.f1.t xview scroll -1 unit"
	1278	bind $win <KeyPress-Up> "$win.f1.t yview scroll -1 unit"
	1279	bind $win <KeyPress-Down> "$win.f1.t yview scroll 1 unit"
	1280	bind $win <KeyPress-Home> "$win.f1.t yview 0"
	1281	bind $win <KeyPress-End> "$win.f1.t yview end"
	1282	set i 0
	1283	foreach item $optionlist {
	1284	pack [button $win.q[incr i] \
	1285	-command "set makenew(result) $i; destroy $win" -text $item] -side left
	1286	}
[322]	1287	if {$link != ""} {
	1288	pack [button $win.help -text Help -bg yellow \
	1289	-command "MakeWWWHelp $link"] \
	1290	-side right
	1291	bind $win <Key-F1> "MakeWWWHelp $link"
	1292	}
[91]	1293	putontop $win
	1294	tkwait window $win
	1295
	1296	# fix focus...
	1297	afterputontop
	1298	return $makenew(result)
	1299	}
[119]	1300
[130]	1301	# Message box code that centers the message box over the parent.
	1302	# or along the edge, if too close,
	1303	# but leave a border along +x & +y for reasons I don't remember
	1304	# It also allows the button names to be defined using
	1305	# -type $list -- where $list has a list of button names
	1306	# larger messages are placed in a scrolled text widget
	1307	# capitalization is now ignored for -default
	1308	# The command returns the name button in all lower case letters
	1309	# otherwise see tk_messageBox for a description
	1310	#
	1311	# This is a modification of tkMessageBox (msgbox.tcl v1.5)
	1312	#
	1313	proc MyMessageBox {args} {
	1314	global tkPriv tcl_platform
	1315
	1316	set w tkPrivMsgBox
	1317	upvar #0 $w data
	1318
	1319	#
	1320	# The default value of the title is space (" ") not the empty string
	1321	# because for some window managers, a
	1322	# wm title .foo ""
	1323	# causes the window title to be "foo" instead of the empty string.
	1324	#
	1325	set specs {
	1326	{-default "" "" ""}
	1327	{-icon "" "" "info"}
	1328	{-message "" "" ""}
	1329	{-parent "" "" .}
	1330	{-title "" "" " "}
	1331	{-type "" "" "ok"}
[322]	1332	{-helplink "" "" ""}
[130]	1333	}
	1334
	1335	tclParseConfigSpec $w $specs "" $args
	1336
	1337	if {[lsearch {info warning error question} $data(-icon)] == -1} {
	1338	error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
	1339	}
	1340	if {![string compare $tcl_platform(platform) "macintosh"]} {
	1341	switch -- $data(-icon) {
	1342	"error" {set data(-icon) "stop"}
	1343	"warning" {set data(-icon) "caution"}
	1344	"info" {set data(-icon) "note"}
	1345	}
	1346	}
	1347
	1348	if {![winfo exists $data(-parent)]} {
	1349	error "bad window path name \"$data(-parent)\""
	1350	}
	1351
	1352	switch -- $data(-type) {
	1353	abortretryignore {
	1354	set buttons {
	1355	{abort -width 6 -text Abort -under 0}
	1356	{retry -width 6 -text Retry -under 0}
	1357	{ignore -width 6 -text Ignore -under 0}
	1358	}
	1359	}
	1360	ok {
	1361	set buttons {
	1362	{ok -width 6 -text OK -under 0}
	1363	}
	1364	if {![string compare $data(-default) ""]} {
	1365	set data(-default) "ok"
	1366	}
	1367	}
	1368	okcancel {
	1369	set buttons {
	1370	{ok -width 6 -text OK -under 0}
	1371	{cancel -width 6 -text Cancel -under 0}
	1372	}
	1373	}
	1374	retrycancel {
	1375	set buttons {
	1376	{retry -width 6 -text Retry -under 0}
	1377	{cancel -width 6 -text Cancel -under 0}
	1378	}
	1379	}
	1380	yesno {
	1381	set buttons {
	1382	{yes -width 6 -text Yes -under 0}
	1383	{no -width 6 -text No -under 0}
	1384	}
	1385	}
	1386	yesnocancel {
	1387	set buttons {
	1388	{yes -width 6 -text Yes -under 0}
	1389	{no -width 6 -text No -under 0}
	1390	{cancel -width 6 -text Cancel -under 0}
	1391	}
	1392	}
	1393	default {
	1394	# error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel"
	1395	foreach item $data(-type) {
	1396	lappend buttons [list [string tolower $item] -text $item -under 0]
	1397	}
	1398	}
	1399	}
	1400
	1401	if {[string compare $data(-default) ""]} {
	1402	set valid 0
	1403	foreach btn $buttons {
	1404	if {![string compare [lindex $btn 0] [string tolower $data(-default)]]} {
	1405	set valid 1
	1406	break
	1407	}
	1408	}
	1409	if {!$valid} {
	1410	error "invalid default button \"$data(-default)\""
	1411	}
	1412	}
	1413
	1414	# 2. Set the dialog to be a child window of $parent
	1415	#
	1416	#
	1417	if {[string compare $data(-parent) .]} {
	1418	set w $data(-parent).__tk__messagebox
	1419	} else {
	1420	set w .__tk__messagebox
	1421	}
	1422
	1423	# 3. Create the top-level window and divide it into top
	1424	# and bottom parts.
	1425
	1426	catch {destroy $w}
	1427	toplevel $w -class Dialog
	1428	wm title $w $data(-title)
	1429	wm iconname $w Dialog
	1430	wm protocol $w WM_DELETE_WINDOW { }
	1431	wm transient $w $data(-parent)
	1432	if {![string compare $tcl_platform(platform) "macintosh"]} {
	1433	unsupported1 style $w dBoxProc
	1434	}
	1435
	1436	frame $w.bot
	1437	pack $w.bot -side bottom -fill both
	1438	frame $w.top
	1439	pack $w.top -side top -fill both -expand 1
[322]	1440	if {$data(-helplink) != ""} {
	1441	# frame $w.help
	1442	# pack $w.help -side top -fill both
	1443	pack [button $w.top.1 -text Help -bg yellow \
	1444	-command "MakeWWWHelp $data(-helplink)"] \
	1445	-side right -anchor ne
	1446	bind $w <Key-F1> "MakeWWWHelp $data(-helplink)"
	1447	}
[130]	1448	if {[string compare $tcl_platform(platform) "macintosh"]} {
	1449	$w.bot configure -relief raised -bd 1
	1450	$w.top configure -relief raised -bd 1
	1451	}
	1452
	1453	# 4. Fill the top part with bitmap and message (use the option
	1454	# database for -wraplength and -font so that they can be
	1455	# overridden by the caller).
	1456
	1457	option add *Dialog.msg.wrapLength 3i widgetDefault
	1458
	1459	if {[string length $data(-message)] > 300} {
	1460	if {![string compare $tcl_platform(platform) "macintosh"]} {
	1461	option add *Dialog.msg.t.font system widgetDefault
	1462	} else {
	1463	option add *Dialog.msg.t.font {Times 18} widgetDefault
	1464	}
	1465	frame $w.msg
	1466	grid [text $w.msg.t \
	1467	-height 20 -width 55 -relief flat -wrap word \
	1468	-yscrollcommand "$w.msg.rscr set" \
	1469	] -row 1 -column 0 -sticky news
	1470	grid [scrollbar $w.msg.rscr -command "$w.msg.t yview" \
	1471	] -row 1 -column 1 -sticky ns
	1472	# give extra space to the text box
	1473	grid columnconfigure $w.msg 0 -weight 1
	1474	grid rowconfigure $w.msg 1 -weight 1
	1475	$w.msg.t insert end $data(-message)
	1476	} else {
	1477	if {![string compare $tcl_platform(platform) "macintosh"]} {
	1478	option add *Dialog.msg.font system widgetDefault
	1479	} else {
	1480	option add *Dialog.msg.font {Times 18} widgetDefault
	1481	}
	1482	label $w.msg -justify left -text $data(-message)
	1483	}
	1484	pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
	1485	if {[string compare $data(-icon) ""]} {
	1486	label $w.bitmap -bitmap $data(-icon)
	1487	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
	1488	}
	1489
	1490	# 5. Create a row of buttons at the bottom of the dialog.
	1491
	1492	set i 0
	1493	foreach but $buttons {
	1494	set name [lindex $but 0]
	1495	set opts [lrange $but 1 end]
	1496	if {![llength $opts]} {
	1497	# Capitalize the first letter of $name
	1498	set capName [string toupper \
	1499	[string index $name 0]][string range $name 1 end]
	1500	set opts [list -text $capName]
	1501	}
	1502
	1503	eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]]
	1504
	1505	if {![string compare $name $data(-default)]} {
	1506	$w.$name configure -default active
	1507	}
	1508	pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m
	1509
	1510	# create the binding for the key accelerator, based on the underline
	1511	#
	1512	set underIdx [$w.$name cget -under]
	1513	if {$underIdx >= 0} {
	1514	set key [string index [$w.$name cget -text] $underIdx]
	1515	bind $w <Alt-[string tolower $key]> [list $w.$name invoke]
	1516	bind $w <Alt-[string toupper $key]> [list $w.$name invoke]
	1517	}
	1518	incr i
	1519	}
	1520
	1521	# 6. Create a binding for <Return> on the dialog if there is a
	1522	# default button.
	1523
	1524	if {[string compare $data(-default) ""]} {
	1525	bind $w <Return> [list tkButtonInvoke $w.$data(-default)]
	1526	}
	1527
	1528	# 7. Withdraw the window, then update all the geometry information
	1529	# so we know how big it wants to be, then center the window in the
	1530	# display and de-iconify it.
	1531
	1532	wm withdraw $w
	1533	update idletasks
	1534	set wp $data(-parent)
	1535	# center the new window in the middle of the parent
	1536	set x [expr [winfo x $wp] + [winfo width $wp]/2 - \
	1537	[winfo reqwidth $w]/2 - [winfo vrootx $wp]]
	1538	set y [expr [winfo y $wp] + [winfo height $wp]/2 - \
	1539	[winfo reqheight $w]/2 - [winfo vrooty $wp]]
	1540	# make sure that we can see the entire window
	1541	set xborder 10
	1542	set yborder 25
	1543	if {$x < 0} {set x 0}
	1544	if {$x+[winfo reqwidth $w] +$xborder > [winfo screenwidth $w]} {
	1545	incr x [expr \
	1546	[winfo screenwidth $w] - ($x+[winfo reqwidth $w] + $xborder)]
	1547	}
	1548	if {$y < 0} {set y 0}
	1549	if {$y+[winfo reqheight $w] +$yborder > [winfo screenheight $w]} {
	1550	incr y [expr \
	1551	[winfo screenheight $w] - ($y+[winfo reqheight $w] + $yborder)]
	1552	}
	1553	wm geom $w +$x+$y
	1554	wm deiconify $w
	1555
	1556	# 8. Set a grab and claim the focus too.
	1557
[322]	1558	catch {set oldFocus [focus]}
	1559	catch {set oldGrab [grab current $w]}
	1560	catch {
	1561	grab $w
	1562	if {[string compare $data(-default) ""]} {
	1563	focus $w.$data(-default)
	1564	} else {
	1565	focus $w
	1566	}
[130]	1567	}
	1568
	1569	# 9. Wait for the user to respond, then restore the focus and
	1570	# return the index of the selected button. Restore the focus
	1571	# before deleting the window, since otherwise the window manager
	1572	# may take the focus away so we can't redirect it. Finally,
	1573	# restore any grab that was in effect.
	1574
	1575	tkwait variable tkPriv(button)
	1576	catch {focus $oldFocus}
	1577	destroy $w
[322]	1578	catch {grab $oldGrab}
[130]	1579	return $tkPriv(button)
	1580	}
	1581
[119]	1582	#------------------------------------------------------------------------------
	1583	# Delete History Records
	1584	proc DeleteHistoryRecords {{msg ""}} {
	1585	global expgui
	1586	set frm .history
	1587	catch {destroy $frm}
	1588	toplevel $frm
[322]	1589	bind $frm <Key-F1> "MakeWWWHelp expguierr.html DeleteHistoryRecords"
[119]	1590	if {[string trim $msg] == ""} {
	1591	set msg "There are [CountHistory] history records"
	1592	}
	1593	pack [frame $frm.1 -bd 2 -relief groove] -padx 3 -pady 3 -side left
	1594	pack [label $frm.1.0 -text $msg] -side top
	1595	pack [frame $frm.1.1] -side top
	1596	pack [label $frm.1.1.1 -text "Number of entries to keep"] -side left
	1597	pack [entry $frm.1.1.2 -width 3 -textvariable expgui(historyKeep)\
	1598	] -side left
	1599	set expgui(historyKeep) 10
	1600	pack [checkbutton $frm.1.2 -text renumber -variable expgui(renumber)] -side top
	1601	set expgui(renumber) 1
[322]	1602	pack [frame $frm.2] -padx 3 -pady 3 -side left -fill both -expand yes
	1603	pack [button $frm.2.help -text Help -bg yellow \
	1604	-command "MakeWWWHelp expguierr.html DeleteHistoryRecords"] -side top
	1605	pack [button $frm.2.4 -text Quit \
	1606	-command {destroy .history}] -side bottom
[119]	1607	pack [button $frm.2.3 -text OK \
	1608	-command {
	1609	if ![catch {expr $expgui(historyKeep)}] {
	1610	DeleteHistory $expgui(historyKeep) $expgui(renumber)
	1611	set expgui(changed) 1
	1612	destroy .history
	1613	}
[322]	1614	}] -side bottom
[119]	1615	bind $frm <Return> "$frm.2.3 invoke"
	1616
	1617	# force the window to stay on top
	1618	putontop $frm
	1619	focus $frm.2.3
	1620	tkwait window $frm
	1621	afterputontop
	1622	}
[138]	1623
	1624	# optionally run disagl as a windowless process, w/results in a separate window
	1625	proc rundisagl {} {
	1626	global expgui txtvw tcl_version tcl_platform
	1627	if {$expgui(disaglSeparateBox)} {
	1628	set root [file root $expgui(expfile)]
	1629	catch {file delete -force $root.tmp}
	1630	catch {file rename -force $root.LST $root.OLS}
	1631	# PSW reports this does not happen right away on windows
	1632	set i 0
	1633	while {$i < 5 && [file exists $root.LST]} {
	1634	# debug code
	1635	catch {console show}
	1636	puts "try $i"
	1637	# end debug code
	1638	after 100
	1639	incr i
	1640	}
	1641	#run the program
	1642	pleasewait "Running DISAGL"
	1643	# create an empty input file
	1644	close [open disagl.inp w]
	1645	catch {exec [file join $expgui(gsasexe) disagl] \
	1646	[file tail $root] < disagl.inp > disagl.out}
	1647	catch {file rename -force $root.LST $root.tmp}
	1648	catch {file delete -force disagl.inp disagl.out}
	1649	catch {file rename -force $root.OLS $root.LST}
	1650	donewait
	1651	# open a new window
	1652	catch {toplevel .disagl}
	1653	catch {eval grid forget [grid slaves .disagl]}
	1654	text .disagl.txt -width 100 -wrap none \
	1655	-yscrollcommand ".disagl.yscroll set" \
	1656	-xscrollcommand ".disagl.xscroll set"
	1657	scrollbar .disagl.yscroll -command ".disagl.txt yview"
	1658	scrollbar .disagl.xscroll -command ".disagl.txt xview" -orient horizontal
	1659	grid .disagl.xscroll -column 0 -row 2 -sticky ew
	1660	grid .disagl.txt -column 0 -row 1 -sticky nsew
	1661	grid .disagl.yscroll -column 1 -row 1 -sticky ns
	1662	grid [frame .disagl.f] -column 0 -columnspan 2 -row 3 -sticky ew
	1663	grid columnconfig .disagl.f 2 -weight 1
	1664	grid [button .disagl.f.close -text "Close & Delete" \
	1665	-command "destroy .disagl; file delete $root.tmp"] \
	1666	-column 3 -row 0 -sticky e
	1667	grid [button .disagl.f.rename -text "Close & Save as .DIS" \
	1668	-command "destroy .disagl; file rename -force $root.tmp $root.DIS"] \
	1669	-column 4 -row 0 -sticky e
	1670	# allow font changes on the fly
	1671	if {$tcl_version >= 8.0} {
	1672	.disagl.txt config -font $txtvw(font)
	1673	set fontbut [tk_optionMenu .disagl.f.font txtvw(font) ""]
	1674	grid .disagl.f.font -column 1 -row 0 -sticky w
	1675	grid [label .disagl.f.t -text font:] -column 0 -row 0 -sticky w
	1676	$fontbut delete 0 end
	1677	foreach f {5 6 7 8 9 10 11 12 13 14 15 16} {
	1678	$fontbut add command -label "Courier $f" -font "Courier $f"\
	1679	-command "set txtvw(font) \"Courier $f\"; \
	1680	.disagl.txt config -font \$txtvw(font)"
	1681	}
	1682	}
	1683
[182]	1684	grid columnconfigure .disagl 0 -weight 1
[138]	1685	grid rowconfigure .disagl 1 -weight 1
	1686	wm title .disagl "DISAGL results $expgui(expfile)"
	1687	wm iconname .disagl "DISAGL $root"
	1688	set in [open $root.tmp r]
	1689	.disagl.txt insert end [read $in]
	1690	close $in
	1691	bind all {destroy .disagl}
	1692	bind .disagl ".disagl.txt yview scroll -1 page"
	1693	bind .disagl ".disagl.txt yview scroll 1 page"
	1694	bind .disagl ".disagl.txt xview scroll 1 unit"
	1695	bind .disagl ".disagl.txt xview scroll -1 unit"
	1696	bind .disagl ".disagl.txt yview scroll -1 unit"
	1697	bind .disagl ".disagl.txt yview scroll 1 unit"
	1698	bind .disagl ".disagl.txt yview 0"
	1699	bind .disagl ".disagl.txt yview end"
	1700	# don't disable in Win as this prevents the highlighting of selected text
	1701	if {$tcl_platform(platform) != "windows"} {
	1702	.disagl.txt config -state disabled
	1703	}
	1704	} else {
	1705	runGSASwEXP disagl
	1706	}
	1707	}
	1708	# tell'em what is happening
	1709	proc pleasewait {{message {}}} {
	1710	catch {destroy .msg}
	1711	toplevel .msg
	1712	wm transient .msg [winfo toplevel .]
	1713	pack [frame .msg.f -bd 4 -relief groove]
	1714	pack [message .msg.f.m -text "Please wait $message"]
	1715	wm withdraw .msg
	1716	update idletasks
	1717	# place the message on top of the main window
	1718	set x [expr [winfo x .] + [winfo width .]/2 - \
	1719	[winfo reqwidth .msg]/2 - [winfo vrootx .]]
	1720	if {$x < 0} {set x 0}
	1721	set y [expr [winfo y .] + [winfo height .]/2 - \
	1722	[winfo reqheight .msg]/2 - [winfo vrooty .]]
	1723	if {$y < 0} {set y 0}
	1724	wm geom .msg +$x+$y
	1725	wm deiconify .msg
[322]	1726	global makenew
	1727	set makenew(OldGrab) ""
	1728	#catch {set makenew(OldFocus) [focus]}
	1729	catch {set makenew(OldGrab) [grab current .msg]}
	1730	catch {grab .msg}
	1731	catch {focus .msg}
[138]	1732	update
	1733	}
	1734	# clear the message
	1735	proc donewait {} {
[322]	1736	global makenew
	1737	catch {focus $makenew(OldFocus)}
[138]	1738	catch {destroy .msg}
[322]	1739	catch {
	1740	if {$makenew(OldGrab) != ""} {
	1741	grab $makenew(OldGrab)
	1742	}
	1743	}
[138]	1744	}
[231]	1745
	1746
	1747	# profile terms
	1748	array set expgui {
	1749	prof-T-1 {alp-0 alp-1 bet-0 bet-1 sig-0 sig-1 sig-2 rstr rsta \
	1750	rsca s1ec s2ec }
	1751	prof-T-2 {alp-0 alp-1 beta switch sig-0 sig-1 sig-2 gam-0 gam-1 \
	1752	gam-2 ptec stec difc difa zero }
	1753	prof-T-3 {alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
	1754	gam-2 gsf g1ec g2ec rstr rsta rsca L11 L22 L33 L12 L13 L23 }
	1755	prof-T-4 {alp bet-0 bet-1 sig-1 sig-2 gam-2 g2ec gsf \
	1756	rstr rsta rsca eta}
	1757	prof-C-1 {GU GV GW asym F1 F2 }
	1758	prof-C-2 {GU GV GW LX LY trns asym shft GP stec ptec sfec \
	1759	L11 L22 L33 L12 L13 L23 }
	1760	prof-C-3 {GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
	1761	L11 L22 L33 L12 L13 L23 }
	1762	prof-C-4 {GU GV GW GP LX ptec trns shft sfec S/L H/L eta}
	1763	prof-E-1 {A B C ds cds}
	1764	}
	1765
	1766	# number of profile terms depends on the histogram type
	1767	# the LAUE symmetry and the profile number
	1768	proc GetProfileTerms {phase hist ptype} {
	1769	global expmap expgui
	1770	if {$hist == "C" \|\| $hist == "T" \|\| $hist == "E"} {
	1771	set htype $hist
	1772	} else {
	1773	set htype [string range $expmap(htype_$hist) 2 2]
	1774	}
	1775	# get the cached copy of the profile term labels, when possible
	1776	catch {
	1777	set lbls $expmap(ProfileTerms${phase}_${ptype}_${htype})
	1778	return
	1779	}
	1780	set lbls {}
	1781	catch {set lbls $expgui(prof-$htype-$ptype)}
	1782	if {$lbls == ""} {return}
	1783	# add terms based on the Laue symmetry
	1784	if {($htype == "C" \|\| $htype == "T") && $ptype == 4} {
	1785	set laueaxis [GetLaue [phaseinfo $phase spacegroup]]
	1786	eval lappend lbls [Profile4Terms $laueaxis]
	1787	}
	1788	set expmap(ProfileTerms${phase}_${ptype}_${htype}) $lbls
	1789	return $lbls
	1790	}
	1791
	1792	proc Profile4Terms {laueaxis} {
	1793	switch -exact $laueaxis {
	1794	1bar {return \
	1795	"S400 S040 S004 S220 S202 S022 S310 S103 S031 \
	1796	S130 S301 S013 S211 S121 S112"}
	1797	2/ma {return "S400 S040 S004 S220 S202 S022 S013 S031 S211"}
	1798	2/mb {return "S400 S040 S004 S220 S202 S022 S301 S103 S121"}
	1799	2/mc {return "S400 S040 S004 S220 S202 S022 S130 S310 S112"}
	1800	mmm {return "S400 S040 S004 S220 S202 S022"}
	1801	4/m {return "S400 S004 S220 S202"}
	1802	4/mmm {return "S400 S004 S220 S202"}
[239]	1803	3barR {return "S400 S220 S310 S211"}
	1804	"3bar mR" {return "S400 S220 S310 S211"}
[231]	1805	3bar {return "S400 S004 S202 S211"}
	1806	3barm1 {return "S400 S004 S202"}
	1807	3bar1m {return "S400 S004 S202 S211"}
	1808	6/m {return "S400 S004 S202"}
	1809	6/mmm {return "S400 S004 S202"}
	1810	"m 3" {return "S400 S220"}
	1811	m3m {return "S400 S220"}
	1812	default {return ""}
	1813	}
	1814	}
	1815
	1816	proc GetLaue {spg} {
	1817	global tcl_platform expgui
	1818	# check the space group
	1819	set fp [open spg.in w]
	1820	puts $fp "N"
	1821	puts $fp "N"
	1822	puts $fp $spg
	1823	puts $fp "Q"
	1824	close $fp
	1825	catch {
	1826	if {$tcl_platform(platform) == "windows"} {
	1827	exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
	1828	} else {
	1829	exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
	1830	}
	1831	}
	1832	set fp [open spg.out r]
	1833	set laue {}
	1834	set uniqueaxis {}
	1835	while {[gets $fp line] >= 0} {
	1836	regexp {Laue symmetry (.*)} $line junk laue
	1837	regexp {The unique axis is (.*)} $line junk uniqueaxis
	1838	}
	1839	close $fp
	1840	catch {file delete -force spg.in spg.out}
	1841	set laue [string trim $laue]
[239]	1842	# add a R suffix for rhombohedral settings
	1843	if {[string range [string trim $spg] end end] == "R"} {
	1844	return "${laue}${uniqueaxis}R"
	1845	}
[231]	1846	return "${laue}$uniqueaxis"
	1847	}
	1848
	1849
	1850	# set up to change the profile type for a series of histogram/phase entries
	1851	# (histlist & phaselist should be lists of the same length)
	1852	#
	1853	proc ChangeProfileType {histlist phaselist} {
	1854	global expgui expmap
	1855	set w .profile
	1856	catch {destroy $w}
	1857	toplevel $w -bg beige
	1858	wm title $w "Change Profile Function"
	1859
	1860	# all histogram/phases better be the same type, so we can just use the 1st
	1861	set hist [lindex $histlist 0]
	1862	set phase [lindex $phaselist 0]
	1863	set ptype [string trim [hapinfo $hist $phase proftype]]
	1864
	1865	# get list of allowed profile terms for the current histogram type
	1866	set i 1
	1867	while {[set lbls [GetProfileTerms $phase $hist $i]] != ""} {
	1868	lappend lbllist $lbls
	1869	incr i
	1870	}
	1871	# labels for the current type
	1872	set i $ptype
	1873	set oldlbls [lindex $lbllist [incr i -1]]
	1874
	1875	if {[llength $histlist] == 1} {
	1876	pack [label $w.a -bg beige \
	1877	-text "Change profile function for Histogram #$hist Phase #$phase" \
	1878	] -side top
	1879	} else {
	1880	# make a list of histograms by phase
	1881	foreach h $histlist p $phaselist {
	1882	lappend phlist($p) $h
	1883	}
	1884	set num 0
	1885	pack [frame $w.a -bg beige] -side top
	1886	pack [label $w.a.$num -bg beige \
	1887	-text "Change profile function for:" \
	1888	] -side top -anchor w
	1889	foreach i [lsort [array names phlist]] {
	1890	incr num
	1891	pack [label $w.a.$num -bg beige -text \
	1892	"\tPhase #$i, Histograms [CompressList $phlist($i)]" \
	1893	] -side top -anchor w
	1894	}
	1895	}
	1896	pack [label $w.e1 \
	1897	-text "Current function is type $ptype." \
	1898	-bg beige] -side top -anchor w
	1899	pack [frame $w.e -bg beige] -side top -expand yes -fill both
	1900	pack [label $w.e.1 \
	1901	-text "Set function to type" \
	1902	-bg beige] -side left
	1903	set menu [tk_optionMenu $w.e.2 expgui(newpeaktype) junk]
	1904	pack $w.e.2 -side left -anchor w
	1905
	1906	pack [radiobutton $w.e.4 -bg beige -variable expgui(DefaultPeakType) \
	1907	-command "set expgui(newpeaktype) $ptype; \
	1908	FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
	1909	-value 1 -text "Current value overrides"] -side right
	1910	pack [radiobutton $w.e.3 -bg beige -variable expgui(DefaultPeakType) \
	1911	-command \
	1912	"set expgui(newpeaktype) $ptype; \
	1913	FillChangeProfileType $w.c $hist $phase $ptype [list $oldlbls] [list $oldlbls]" \
	1914	-value 0 -text "Default value overrides"] -side right
	1915
	1916	$w.e.2 config -bg beige
	1917	pack [frame $w.c -bg beige] -side top -expand yes -fill both
	1918	pack [frame $w.d -bg beige] -side top -expand yes -fill both
[322]	1919	pack [button $w.d.2 -text Set \
[231]	1920	-command "SaveChangeProfileType $w.c $histlist $phaselist; destroy $w"\
	1921	] -side left
[322]	1922	pack [button $w.d.3 -text Quit \
[231]	1923	-command "destroy $w"] -side left
[322]	1924	pack [button $w.d.help -text Help -bg yellow \
	1925	-command "MakeWWWHelp expgui5.html ChangeType"] \
	1926	-side right
	1927	bind $w <Key-F1> "MakeWWWHelp expgui5.html ChangeType"
[231]	1928	bind $w <Return> "destroy $w"
	1929
	1930	$menu delete 0 end
	1931	set i 0
	1932	foreach lbls $lbllist {
	1933	incr i
	1934	$menu add command -label $i -command \
	1935	"set expgui(newpeaktype) $i; \
	1936	FillChangeProfileType $w.c $hist $phase $i [list $lbls] [list $oldlbls]"
	1937	}
	1938	set expgui(newpeaktype) $ptype
	1939	FillChangeProfileType $w.c $hist $phase $ptype $oldlbls $oldlbls
	1940
	1941	# force the window to stay on top
	1942	putontop $w
	1943	focus $w.e.2
	1944	tkwait window $w
	1945	afterputontop
	1946	sethistlist
	1947	}
	1948
	1949	# save the changes to the profile
	1950	proc SaveChangeProfileType {w histlist phaselist} {
	1951	global expgui
	1952	foreach phase $phaselist hist $histlist {
	1953	hapinfo $hist $phase proftype set $expgui(newpeaktype)
	1954	hapinfo $hist $phase profterms set $expgui(newProfileTerms)
	1955	for {set i 1} {$i <= $expgui(newProfileTerms)} {incr i} {
	1956	hapinfo $hist $phase pterm$i set [$w.ent${i} get]
	1957	hapinfo $hist $phase pref$i set $expgui(ProfRef$i)
	1958	}
	1959	set i [expr 1+$expgui(newProfileTerms)]
	1960	hapinfo $hist $phase pcut set [$w.ent$i get]
	1961	incr expgui(changed) [expr 3 + $expgui(newProfileTerms)]
	1962	}
	1963	}
	1964
	1965	# file the contents of the "Change Profile Type" Menu
	1966	proc FillChangeProfileType {w hist phase newtype lbls oldlbls} {
	1967	global expgui expmap
	1968	set ptype [string trim [hapinfo $hist $phase proftype]]
	1969	catch {unset oldval}
	1970	# loop through the old terms and set up an array of starting values
	1971	set num 0
	1972	foreach term $oldlbls {
	1973	incr num
	1974	set oldval($term) [hapinfo $hist $phase pterm$num]
	1975	}
	1976	set oldval(Peak\nCutoff) [hapinfo $hist $phase pcut]
	1977
	1978	# is the new type the same as the current?
	1979	if {$ptype == $newtype} {
	1980	set nterms [hapinfo $hist $phase profterms]
	1981	} else {
	1982	set nterms [llength $lbls]
	1983	}
	1984	set expgui(newProfileTerms) $nterms
	1985	set expgui(CurrentProfileTerms) $nterms
	1986	# which default profile set matches the new type
	1987	set setnum {}
	1988	foreach j {" " 1 2 3 4 5 6 7 8 9} {
	1989	set i [profdefinfo $hist $j proftype]
	1990	if {$i == ""} continue
	1991	if {$i == $newtype} {
	1992	set setnum $j
	1993	break
	1994	}
	1995	}
	1996
	1997	eval destroy [winfo children $w]
	1998
	1999	set colstr 0
	2000	set row 2
	2001	set maxrow [expr $row + $nterms/2]
	2002	for { set num 1 } { $num <= $nterms + 1} { incr num } {
	2003	# get the default value (originally from the in .INS file)
	2004	set val {}
	2005	if {$setnum != ""} {
	2006	set val 0.0
	2007	catch {
	2008	set val [profdefinfo $hist $setnum pterm$num]
	2009	# pretty up the number
	2010	if {$val == 0.0} {
	2011	set val 0.0
	2012	} elseif {abs($val) < 1e-2 \|\| abs($val) > 1e6} {
	2013	set val [format %.3e $val]
	2014	} elseif {abs($val) > 1e-2 && abs($val) < 10} {
	2015	set val [format %.5f $val]
	2016	} elseif {abs($val) < 9999} {
	2017	set val [format %.2f $val]
	2018	} elseif {abs($val) < 1e6} {
	2019	set val [format %.0f $val]
	2020	}
	2021	}
	2022	}
	2023	# heading
	2024	if {$row == 2} {
	2025	set col $colstr
	2026	grid [label $w.h0${num} -text "lbl" -bg beige] \
	2027	-row $row -column $col
	2028	grid [label $w.h2${num} -text "ref" -bg beige] \
	2029	-row $row -column [incr col]
	2030	grid [label $w.h3${num} -text "next value" -bg beige] \
	2031	-row $row -column [incr col]
	2032	grid [label $w.h4${num} -text "default" -bg beige] \
	2033	-row $row -column [incr col]
	2034	grid [label $w.h5${num} -text "current" -bg beige] \
	2035	-row $row -column [incr col]
	2036	}
	2037	set col $colstr
	2038	incr row
	2039	set term {}
	2040	catch {set term [lindex $lbls [expr $num-1]]}
	2041	if {$term == ""} {set term $num}
	2042	if {$num == $nterms + 1} {
	2043	set term "Peak\nCutoff"
	2044	set val {}
	2045	if {$setnum != ""} {
	2046	set val 0.0
	2047	catch {set val [profdefinfo $hist $setnum pcut]}
	2048	}
	2049	}
	2050
	2051	grid [label $w.l${num} -text "$term" -bg beige] \
	2052	-row $row -column $col
	2053	grid [checkbutton $w.chk${num} -variable expgui(ProfRef$num) \
	2054	-bg beige -activebackground beige] -row $row -column [incr col]
	2055	grid [entry $w.ent${num} \
	2056	-width 12] -row $row -column [incr col]
	2057	if {$val != ""} {
	2058	grid [button $w.def${num} -text $val -command \
	2059	"$w.ent${num} delete 0 end; $w.ent${num} insert end $val" \
	2060	] -row $row -column [incr col] -sticky ew
	2061	} else {
	2062	grid [label $w.def${num} -text (none) \
	2063	] -row $row -column [incr col]
	2064	}
	2065	set curval {}
	2066	catch {
	2067	set curval [expr $oldval($term)]
	2068	# pretty up the number
	2069	if {$curval == 0.0} {
	2070	set curval 0.0
	2071	} elseif {abs($curval) < 1e-2 \|\| abs($curval) > 1e6} {
	2072	set curval [format %.3e $curval]
	2073	} elseif {abs($curval) > 1e-2 && abs($curval) < 10} {
	2074	set curval [format %.5f $curval]
	2075	} elseif {abs($curval) < 9999} {
	2076	set curval [format %.2f $curval]
	2077	} elseif {abs($curval) < 1e6} {
	2078	set curval [format %.0f $curval]
	2079	}
	2080	grid [button $w.cur${num} -text $curval -command \
	2081	"$w.ent${num} delete 0 end; $w.ent${num} insert end $curval" \
	2082	] -row $row -column [incr col] -sticky ew
	2083	}
	2084	# set default values for flag and value
	2085	set ref 0
	2086	if {$setnum != ""} {
	2087	catch {
	2088	if {[profdefinfo $hist $setnum pref$num] == "Y"} {set ref 1}
	2089	}
	2090	}
	2091	set expgui(ProfRef$num) $ref
	2092
	2093	$w.ent${num} delete 0 end
	2094	if {!$expgui(DefaultPeakType) && $val != ""} {
	2095	$w.ent${num} insert end $val
	2096	} elseif {$curval != ""} {
	2097	$w.ent${num} insert end $curval
	2098	} elseif {$val != ""} {
	2099	$w.ent${num} insert end $val
	2100	} else {
	2101	$w.ent${num} insert end 0.0
	2102	}
	2103	if {$row > $maxrow} {
	2104	set row 2
	2105	incr colstr 5
	2106	}
	2107	}
	2108	}
[322]	2109
	2110	# browse a WWW page with URL. The URL may contain a #anchor
	2111	# On UNIX assume netscape is in the path or env(BROWSER) is loaded.
	2112	# On Windows search the registry for a browser. Mac branch not tested.
	2113	# This is taken from http://mini.net/cgi-bin/wikit/557.html with many thanks
	2114	# to the contributers
	2115	proc urlOpen {url} {
	2116	global env tcl_platform
	2117	switch $tcl_platform(platform) {
	2118	"unix" {
	2119	if {![info exists env(BROWSER)]} {
	2120	set progs [auto_execok netscape]
	2121	if {[llength $progs]} {
	2122	set env(BROWSER) [list $progs]
	2123	}
	2124	}
	2125	if {[info exists env(BROWSER)]} {
	2126	if {[catch {exec $env(BROWSER) -remote openURL($url)}]} {
	2127	# perhaps browser doesn't understand -remote flag
	2128	if {[catch {exec $env(BROWSER) $url &} emsg]} {
	2129	error "Error displaying $url in browser\n$emsg"
	2130	}
	2131	}
	2132	} else {
	2133	tk_dialog .warn "No Browser" \
	2134	"Could not find a browser. Netscape is not in path. Define environment variable BROWSER to be full path name of browser." \
	2135	warn 0 OK
	2136	}
	2137	}
	2138	"windows" {
	2139	package require registry
	2140	# Look for the application under
	2141	# HKEY_CLASSES_ROOT
	2142	set root HKEY_CLASSES_ROOT
	2143
	2144	# Get the application key for HTML files
	2145	set appKey [registry get $root\\.html ""]
	2146
	2147	# Get the command for opening HTML files
	2148	set appCmd [registry get \
	2149	$root\\$appKey\\shell\\open\\command ""]
	2150
	2151	# Substitute the HTML filename into the command for %1
	2152	regsub %1 $appCmd $htmlFile appCmd
	2153
	2154	# Double up the backslashes for eval (below)
	2155	regsub -all {\\} $appCmd {\\\\} appCmd
	2156
	2157	# Invoke the command
	2158	eval exec $appCmd &
	2159	}
	2160	"macintosh" {
	2161	if {0 == [info exists env(BROWSER)]} {
	2162	set env(BROWSER) "Browse the Internet"
	2163	}
	2164	if {[catch {
	2165	AppleScript execute\
	2166	"tell application \"$env(BROWSER)\"
	2167	open url \"$url\"
	2168	end tell
	2169	"} emsg]
	2170	} then {
	2171	error "Error displaying $url in browser\n$emsg"
	2172	}
	2173	}
	2174	}
	2175	}
	2176
	2177	proc NetHelp {file anchor localloc netloc} {
	2178	if {[file exists [file join $localloc $file]]} {
	2179	set url "file:[file join $localloc $file]"
	2180	} else {
	2181	set url "http://$netloc/$file"
	2182	}
	2183	catch {
	2184	pleasewait "Starting web browser..."
	2185	after 2000 donewait
	2186	}
	2187	if {$anchor != ""} {
	2188	append url # $anchor
	2189	}
	2190	urlOpen $url
	2191	}
	2192
	2193	proc MakeWWWHelp {"topic {}" "anchor {}"} {
	2194	global expgui
	2195	if {$topic == ""} {
	2196	foreach item $expgui(notebookpagelist) {
	2197	if {[lindex $item 0] == $expgui(pagenow)} {
	2198	NetHelp [lindex $item 5] [lindex $item 6] $expgui(docdir) ""
	2199	return
	2200	}
	2201	}
	2202	# this should not happen
	2203	NetHelp expgui.html "" $expgui(docdir) ""
	2204	} elseif {$topic == "menu"} {
	2205	NetHelp expguic.html "" $expgui(docdir) ""
	2206	} else {
	2207	NetHelp $topic $anchor $expgui(docdir) ""
	2208	}
	2209	}

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

Download in other formats: