#!/afs/ece/usr/tcl/bin/wish -f

# To run this program, you should make sure the top line reflects the location
# of wish on your system, and the following variables represent the locations
# of beth and a fontlist to look at.

# File with list of fonts.
set font_file "| xlsfonts"
# Location of Beth source directory.
set beth_dir "/afs/ece/usr/svoboda/src/beth"

# This program can take a starting font as an argument. If none is given, it
# defaults to the first one in the file, Each line is printed in its own font.

set index [lsearch $argv -o]
if {$index != -1} {
	set sc [expr $index + 1]
	set font_start [lindex $argv $sc]
	set argv [lreplace $argv $index $sc]
	incr argc -2
} else {set font_start ""}
set option $font_file

set argc 0
set option $font_file
set configs "-b $argv"
set embedded 1
set dont_change_title 1
wm title . "TK Fonts"
wm iconname . "TK Fonts"
source $beth_dir/beth.tcl

# Wait until file starts coming in...
while {[string length [$text get 1.0 end]] == 0} {
	after 100
	update ; update idletasks
}

# Go to font specified by argv
if {($font_start != "")} {
	set char [string first "\n$font_start\n" [$text get 1.0 end]]
	scan [$text index "1.0 +$char chars +1 chars"] "%d" font_line
} else {set font_line 1}
$text mark set insert $font_line.0	; $text yview insert
set top_line $font_line.0

proc allocate_fonts {t} {
	for {set line 1} {[$t compare $line.0 < end]} {incr line} {
		set font [$t get $line.0 "$line.0 lineend"]
		$t tag add tag$line $line.0 "$line.0 lineend"
		$t tag configure tag$line -font $font
}}

beth_busy $text allocate_fonts $text
