#!/afs/ece/usr/tcl/bin/wish -f
# The next line is executed by most shells, but not Tcl \
wish $0 $*


# 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 elsbeth and a list of fonts to look at.

# File with list of fonts in format "[red][green][blue]	[name]"
set Font_File "|xlsfonts"
# Location of Elsbeth source directory.
set Elsbeth_Dir [file dirname [file dirname [info script]]]
# Text that gets shown in fonts.
set Font_Text "\tABC_abc_123"

# Takes [-o starting_font] and [-a] as an optional argument. Any other arguments
# get passed to Elsbeth. If no starting font is given, defaults to first one in
# file. Tkfonts fonts each line with its own font, until the end of the page.
# Scrolling the text re-does the fonting, so the screen is always full of fonts.
# (this prevents the program from running out of fonts.
#
# if [-a] is called, then only els is invoked, not elsbeth.


if {[set index [lsearch $argv -o]] != -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 ""}

if {[set index [lsearch $argv -a]] >= 0} {
  lappend argv $Font_File ; incr argc
  set TH(Modified,.syme1.t) 1
  source $Elsbeth_Dir/bin/els
  tkwait variable TH(Modified,.syme1.t)
} else {
  lappend argv -a $Font_File
  incr argc 2
  source $Elsbeth_Dir/bin/elsbeth
  th_toggle_scrollbar .syme1.t x bottom
}

wm title .syme1 "THFonts"
wm iconname .syme1 "THF"
set Text .syme1.t

# Indent everything so things can be put in fonts.
scan [$Text index end] "%d,%d" line dummy
for {set i 1} {$i < $line} {incr i} {$Text insert "$i.0 lineend" $Font_Text }
update

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

proc allocate_fonts {w} {
  scan [$w index @0,[winfo height $w]] "%d.%d" endline dummy
  set line [$w index "@0,0 linestart"]
  set limit [expr $endline - $line]
# this is as good a number as any.
  for {set c 0} {$c <= $limit} {incr c} {
    set fontstart "$line lineend -1c wordstart"
    set fontend "$line lineend"
    set font [$w get $line $fontstart-1c]
    $w tag add tag$c $fontstart $fontend
    $w tag add Font $fontstart $fontend
    $w tag configure tag$c -font $font
    set line [$w index "$line +1 line"]
}}

proc deallocate_fonts {w} {
  set font_tags ""
  scan [$w index @0,[winfo height $w]] "%d.%d" endline dummy
  set line [$w index "@0,0 linestart"]
  set limit [expr $endline - $line]
# this is as good a number as any.
  for {set c 0} {$c <= $limit} {incr c} {
    lappend font_tags tag$c
  }
  eval $w tag delete $font_tags
}

proc redo_fonts_and_scroll {args} {
  global Text top_line frame
  if {[winfo exists .syme1.s]} {eval .syme1.s set $args}
  if {$top_line != [$Text index @0,0]} {
    set top_line [$Text index @0,0]
    deallocate_fonts $Text
    allocate_fonts $Text
}}


if {[set ycmd [$Text cget -yscrollcommand]] == ""} {set ycmd "# "} else {
  bind Text <Meta-q> {els_destroy_text %W}
}
$Text configure -yscrollcommand "redo_fonts_and_scroll ; $ycmd"
allocate_fonts $Text
