#!tclsh 
##################
# latex2tkhlp - 1.0
# (C) 1994 Jun Luo
# junluo@cs.wisc.edu
#
# Permission to use, copy, modify, and distribute this software
# and its documentation for any purpose and without fee is granted
# provided that the above copyright notice appears in all copies.
# It s provided "as is" without express or implied waraty.
#
# It uses the help template from tkHTML 1.0, hence it observes the
# following copyright notice:
#
##################
# tkHTML-2.0
# (C) 1994 Liem Bahneman
#
# Permission to use, copy, modify, and distribute this software
# and its documentation for any purpose and without fee is granted
# provided that the above copyright notice appears in all copies.
# It s provided "as is" without express or implied waraty.


#
# $Id: latex2tkhlp,v 1.1 1994/11/07 16:47:39 clolson Exp $
#

#
# latex to hypertext tk help
#


#
# Procedure: insertWithTags
# taken from tkHTML
#
proc genInsert {ofp} {
    puts $ofp {
	proc insertWithTags { w text args} {
	    set start [$w index insert]
	    $w insert insert $text
	    foreach tag [$w tag names $start] {
		$w tag remove $tag $start insert
	    }
	    foreach i $args {
		$w tag add $i $start insert
	    }
	}
    }
}

#
# skip to the line matching the pattern
# return the matching line
#
proc skip {ifp end_pat} {
    set line {}
    while  {[gets $ifp line] != -1} {
	if [regexp $end_pat $line] {
	    return $line
	}
    }
    return {}
}

set __stk__ {}

#
# a simple stack
#
proc push {i} {
    global __stk__
    lappend __stk__ $i
}

proc pop {i} {
    global __stk__
    upvar $i top
    set ntop [llength $__stk__]
    incr ntop -1
    set top [lindex $__stk__ $ntop]
    incr ntop -1
    set __stk__ [lrange $__stk__ 0 $ntop]
}
    
#
# args may contain extra tags
#
proc genLine {ofp line mode args} {		
    global tag lbrk_cnt indent

    regsub -all "\{" $line "\\{" line
    regsub -all "\}" $line "\\}" line    
    if {[string trim $line] == ""} {
	incr lbrk_cnt
	if {($lbrk_cnt == 1 || $mode == "verbatim") } {
	    puts -nonewline  $ofp {insertWithTags $w }
	    if { $mode == "itemize" || $mode == "desc" } {
		puts $ofp "\"\\n\" normal"
	    } else {
		puts $ofp  "\"\\n\\n\" normal"
	    }
	}
    } {
	set lbrk_cnt 0
	if {$mode == "item_header" || $mode == "desc_header"} {
	    puts $ofp "insertWithTags \$w \"$indent\" normal"
	}
	puts -nonewline  $ofp {insertWithTags $w }
	puts $ofp "\{$line \} $tag($mode) $args"
	if {$mode == "verbatim"} {
	    puts $ofp {insertWithTags $w "\n" normal}
	}
    }
}

proc incr_indent {} {
    global indent
    append indent "\t"
}

proc decr_indent {} {
    global indent
    set indent [string range $indent 1 end]
}

proc xt_desc_header {item} {
    set l1 [string last "\[" $item]
    incr l1
    set l2 [string last "\]" $item]
    incr l2 -1
    return [string range $item $l1 $l2]
}

proc count_subs {str} {
    set i 0
    while {[regsub sub $str {} str] == 1} {
	incr i
    }
    return $i
}
#
# opt can also be last
#
proc str_chop {str1 str2 {opt first}} {
    set tail [string $opt $str1 $str2]
    incr tail -1
    return [string range $str2 0 $tail]
}

# obtain parent section id
proc get_psid {secid} {
    set psid [str_chop "." $secid last]
    if {$psid == ""} {
	return 0
    } else {
	return $psid
    }
}

proc get_sid {slevel} {
    global secnum 
    set sid ""
    if {$slevel == 0} {
	return 0
    }
    
    for {set i 1} {$i <= $slevel} {incr i} {
	append sid $secnum($i)
	if {$i < $slevel} {
	    append sid "."
	}
    }
    return $sid
}

proc gen_sid {slevel snum} {
    global secnum 
    set sid ""
    for {set i 1} {$i < $slevel} {incr i} {
	append sid $secnum($i) "."
    }
    append sid $snum
    return $sid
}

#
# processing the input and generating output
#
proc filter {ifp ofp {first_line {}}} {
    global secid secnum tag refs level item_cntr indent

    set tag(section) normal
    set tag(verbatim) code
    set tag(link) "normalbi blue underline link"
    set tag(itemize) "normal"
    set tag(item_header) "normalb red"    
    set tag(desc) "normal"
    set tag(desc_header) "normalb red"
    set tag(null) ""
    
    set mode section
    set prev_mode section

    # section number start from 1 instead of zero
    # to be more civilized
    set level(itemize) 0
    set level(section) 1
    set level(desc) 0
    
    set item_cntr(0) 0
    set sec_cntr(1) 0
    
    set line $first_line
    set not_eof 1
    while  {$not_eof != -1} {
	switch -regexp $line {
	    \\begin{figure}  {
		skip $ifp "\\end{figure}"
	    }
	    ^.(sub)*section {
		set mode section
		begin_sec $ofp $line 
	    }
	    \\begin{itemize} {
		push $mode
		set mode "itemize"
		incr level(itemize)
		set item_cntr($level(itemize)) 0
		puts $ofp {insertWithTags $w "\n" normal}
		incr_indent 
	    }
	    \\end{itemize} {
		incr level(itemize) -1
		decr_indent
		pop mode
	    }
	    ^.item {
		if {$mode == "itemize"} {
		    if $item_cntr($level(itemize)) {
			# end previous item
			# puts $ofp {insertWithTags $w "\n" normal}
		    }
		    incr item_cntr($level(itemize))
		    genLine $ofp "$item_cntr($level(itemize)).  " item_header 
		} else {
		    puts $ofp {insertWithTags $w "\n" normal}
		    set header [xt_desc_header $line]
		    genLine $ofp "$header --- " desc_header
		}
	    }
	    \\begin{description} {
		push $mode
		set mode "desc"
		incr level(desc)
		puts $ofp {insertWithTags $w "\n" normal}
		incr_indent
	    }
	    \\end{description} {
		pop mode
		incr level(desc) -1
		decr_indent
	    }
	    \\begin{verbatim} {
		push $mode
		set mode verbatim
		puts $ofp {$w configure -wrap char}
		puts $ofp {insertWithTags $w "\n" normal}
	    }
	    \\end{verbatim} {
		pop mode
		# puts $ofp {insertWithTags $w "\n" normal}
		puts $ofp {$w configure -wrap word}
	    }
	    (``)|('')  {
		# replace latex quotes
		regsub -all (``)|('') $line {"} line
		genLine $ofp $line $mode
	    }
	    \\_ {
		regsub -all {\\_} $line _ line
		genLine $ofp $line $mode
	    }
	    \\$.*\\$ {
		if [regexp {(\$)([^$]+)(\$)} "$line" str str1 str2] {
		    regsub -all {(\$)([^$]+)(\$)} $line $str2 line
		}
		genLine $ofp $line $mode
	    }
	    \\label{.*} {
		# extract labels
		set endlbl [string first "\}" $line]
		set lstr [xt_arg [string range $line 0 $endlbl]]
		set refs($lstr) [get_sid $level($mode)]
		incr endlbl
		set rest [string range  $line $endlbl end]
		if {$rest != ""} {genLine $ofp $rest $mode}
	    }
	    ~.ref{.*} {
		set l1 [string first {~\ref} $line]
		set rest [string range $line $l1 end]
		set l2 [string first "\}" $rest]
		set l2 [expr $l2 + $l1]
		set ref_pat [string range $line $l1 $l2]
		incr l2 
		incr l1 -1
		set str1 [string range $line 0 $l1 ]
		set str2 [string range $line $l2 end]
		if {$str1 != ""} {genLine $ofp $str1 $mode}
		genLine $ofp $ref_pat null 
		if {$str2 != ""} {genLine $ofp $str2 $mode}
	    }
	    ^% {
		# ignore comments, except when in verbatim mode
		flush stdout
		if {$mode == "verbatim"} {
		    genLine $ofp $line $mode
		}
	    }
	    \\begin{thebibliography} {
		skip $ifp "\\end{document}"
	    }
	    [a-zA-Z]+{.+} {
		if [regsub -all {(\\)([a-zA-Z]+)(\{)([^\}]+)(\})} \
			$line {} line] {
		}
		genLine $ofp $line $mode
	    }
	    default {
		genLine $ofp $line $mode
	    }
	}
	set not_eof [gets $ifp line]
    }
}

############################################################
#
# Templates
#
############################################################
#
# generate the main body
#
proc genMain {ofp} {
    
    puts $ofp {
	proc DoHelp {{type HelpMain}} {

	    global w
	    global helpprev
	    global helpnext
	    global xpos
	    global ypos

	    #######
	    # next and previous help pages
	    set helpprev "HelpMain"
	    set helpnext "HelpSec1"
	    set w ".help.mf.vs.text"
	    #######
	    # Configure and create the actual dialog

	    if [winfo exists .help] {
		# I have no good way of raising the window
		# except this dumb trick
		wm withdraw .help
		wm deiconify .help
		$type
		return
	    } 
	    toplevel .help

	    set tmpx 500
	    set tmpy 60

	    wm geometry .help +$tmpx+$tmpy

	    wm title .help "Help Browser"

	    frame .help.mf -relief raised -borderwidth 2 

	    pack .help.mf -fill both -expand true

	    frame .help.mf.vs -relief flat -borderwidth 2 

	    frame .help.mf.bb -relief flat -borderwidth 2 

	    pack .help.mf.vs -side top -fill both -expand true
	    pack .help.mf.bb -side bottom -fill both -expand true

	    button .help.mf.bb.quit -text "Quit Help" \
		    -command "catch {wm withdraw .help}"
	    button .help.mf.bb.main -text "Main Menu" \
		    -command HelpMain
	    button .help.mf.bb.next -text "Next Topic" \
		    -command $helpnext
	    button .help.mf.bb.previous -text "Previous Topic" \
		    -command $helpprev

	    pack .help.mf.bb.quit .help.mf.bb.main .help.mf.bb.next \
		    .help.mf.bb.previous -side left -fill both -expand true -padx 2 -pady 2

	    scrollbar .help.mf.vs.scroll -relief sunken \
		    -command {.help.mf.vs.text yview} 
	    pack .help.mf.vs.scroll -side left -fill both -expand true

	    text .help.mf.vs.text -relief sunken -borderwidth 1 \
		    -background #bfbfbfbfbfbf \
		    -yscrollcommand {.help.mf.vs.scroll set} \
		    -wrap word -width 68 -height 40
	    pack .help.mf.vs.text -side right -padx 5

	    ConfigFonts $w
	    ConfigTags $w
	    
	    #######
	    # when called, we go to the procedure for the selected help function

	    $type
	}
    }

    puts $ofp {
	proc ConfigFonts {w} {
	    #######
	    #now, lets define colors and fonts
	    $w tag configure 100L -font -b&h-lucida-medium-r-*-*-12-*-*-*-*-*-*-*
	    $w tag configure 140H -font -adobe-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
	    $w tag configure 180H -font -adobe-helvetica-bold-r-normal-*-18-*-*-*-*-*-*-*
	    $w tag configure 180L -font -b&h-lucida-bold-r-normal-*-18-*-*-*-*-*-*-*
	    $w tag configure 240H -font -adobe-helvetica-bold-r-normal-*-24-*-*-*-*-*-*-*
	    $w tag configure normal -font -adobe-helvetica-medium-r-*-*-14-*-*-*-*-*-*-*
	    $w tag configure normalb -font -adobe-helvetica-bold-r-*-*-14-*-*-*-*-*-*-*
	    $w tag configure normalbi -font -adobe-helvetica-bold-o-*-*-14-*-*-*-*-*-*-*	    
	    $w tag configure normali -font -adobe-helvetica-medium-o-normal-*-14-*-*-*-*-*-*-*
	    $w tag configure code -font -adobe-courier-medium-r-normal-*-14-*-*-*-*-*-*-*

	    #######
	    # these are the hyperlink configurations

	    $w tag configure blue -foreground blue
	    $w tag configure red -foreground red
	    $w tag configure underline -underline yes
	    $w tag bind link <Enter> {+link_cursor 1 $w}
	    $w tag bind link <Leave> {+link_cursor 0 $w}

	}

	proc link_cursor {stat w} {
	    if $stat {
		$w config -cursor hand2
	    } {
		$w config -cursor {}
	    }
	}
	
    }
}


proc closeSec {ofp} {
    puts $ofp {
	# disable editting
	$w config -state disabled
    }
    puts $ofp "\}"
}

#
# extract latex command argument
# 
proc xt_arg {line} {
    set start [string first "{" $line]
    set tail [string first "}" $line]
    incr start
    incr tail -1
    return [string range $line $start $tail]  
}

proc begin_sec {ofp line} {
    global sec_title_list level secnum
     
    # find the new level
    set nlevel [count_subs [str_chop "\{" $line]]

    # make sure level starts at 1
    incr nlevel

    if {$nlevel > $level(section)} {
	indent_sec $ofp $line  $nlevel
    } else {
	if {$nlevel == $level(section)} {
	    same_level_sec $ofp $line
	} else {
	    dedent_sec $ofp $line $nlevel
	}
    }
}

proc same_level_sec {ofp line} {
    global sec_title_list secnum level 
    global debugMode
        
    # don't need to worry about generating index
    # for previous section, because it won't
    # have any index, also we don't need to close
    # previous section because there is none if
    # section number is 0
    if {$secnum($level(section)) > 0} {
	# note that the only exception for this case
	# is the first section at level 1
	closeSec $ofp
    }
    set prev "HelpSec[get_sid $level(section)]"
    incr secnum($level(section))
    set next "HelpSec[gen_sid $level(section) \
	    [expr $secnum($level(section)) + 1]]"

    # each level of sections has a title list
    # containing <id, title> list of pairs
    set sec_title [xt_arg $line]
    set sid [get_sid $level(section)]
    set psid [get_psid $sid]
    lappend sec_title_list($psid) [list $sid $sec_title]

    if $debugMode {
	puts "$sid -> $psid"
    }

    gen_sec_header $ofp $sec_title $sid $prev $next
}

proc indent_sec {ofp line nlevel} {
    global sec_title_list secnum level
    global debugMode
    
    set psecid [get_sid $level(section)]
    close_parent_sec $ofp $psecid
    
    set prev "HelpSec[get_sid $level(section)]"
    set secnum($nlevel) 1
    set next "HelpSec[gen_sid $nlevel [expr $secnum($nlevel) + 1]]"
    
    # each level of sections has a title list
    # containing <id, title> list of pairs
    set sec_title [xt_arg $line]
    set sid [get_sid $nlevel]
    lappend sec_title_list($psecid) [list $sid $sec_title]
    set level(section) $nlevel
    
    if $debugMode {
	puts "$sid -> $psecid"
    }

    gen_sec_header $ofp $sec_title $sid $prev $next
}

proc dedent_sec {ofp line nlevel} {
    global sec_title_list secnum level
    global debugMode
    
    set curl $level(section)
    
    # close inner-most section which does not have index
    closeSec $ofp

    # generate index for all nesting sections
    # excluding the innermost one we just closed
    for {set i $nlevel} {$i < $curl} {incr i} {
	gen_sec_index $ofp $i
    }

    set prev "HelpSec[get_sid $nlevel]"
    incr secnum($nlevel)
    set next "HelpSec[gen_sid $nlevel [expr $secnum($nlevel) + 1]]"
    
    # each level of sections has a title list
    # containing <id, title> list of pairs
    set sec_title [xt_arg $line]
    set sid [get_sid $nlevel]
    set psid [get_psid $sid]
    lappend sec_title_list($psid) [list $sid $sec_title]
    set level(section) $nlevel

    if $debugMode {
	puts "$sid -> $psid"
    }

    
    gen_sec_header $ofp $sec_title $sid $prev $next
}

#
# this really generates the index for current section of
# slevel, not for all sections in slevel, sorry about the
# mess
#
proc gen_sec_index {ofp slevel} {
    global secnum sec_title_list debugMode tag

    # find the section id of the current section in slevel 
    set sid [get_sid $slevel]
    
    if $debugMode {
	puts "gen_sec_index $ofp $slevel HelpIndex$sid"
    }
    
    if {$slevel == 0} {
	#
	# generate guard sections
	#
	puts $ofp ""
	puts $ofp "proc HelpSec[expr $secnum(1) + 1] {} \{"
	puts $ofp "\tHelpMain"
	puts $ofp "\}"
	puts $ofp ""

	puts $ofp ""
	puts $ofp "proc HelpSec0 {} \{"
	puts $ofp "\tHelpMain"
	puts $ofp "\}"
	puts $ofp ""
    }

    # the titles are indexed by the sid of current section
    if {$sec_title_list($sid) == {}} {
	puts "rats!  gen_sec_title called with on subsections"
	return
    }
    puts $ofp "proc HelpIndex$sid \{\} \{"
    puts $ofp "\tglobal w"
    foreach ti $sec_title_list($sid) {
	set sname [lindex $ti 1]
	set sid [lindex $ti 0]
	puts -nonewline $ofp {insertWithTags $w }
	puts $ofp "\"$sid  $sname\\n\" h$sid $tag(link)"
    }

    closeSec $ofp
    
    # generate a guard subsection for this section
    set sublevel [expr $slevel + 1]
    set snum [expr $secnum($sublevel) + 1]
    set subid [gen_sid $sublevel $snum]
    set nextsid [get_sid $slevel]
    
    puts $ofp "proc HelpSec$subid \{\} \{"
    puts $ofp "\tglobal w"
    puts $ofp "HelpSec$nextsid"
    
    closeSec $ofp
}

#
# called when we see subsections, we need to add ref to
# index for the subsections and then close parent
#
proc close_parent_sec {ofp psecid} {
    global level secnum tag 
    puts $ofp "HelpIndex$psecid"
    closeSec $ofp
}

proc gen_sec_header {ofp title secid prev_ref next_ref} {
    global sec_names

    set sec_names($secid) $title
    
    puts $ofp "proc HelpSec$secid {} \{"
    puts $ofp {
	global w
	global helpnext
	global helpprev

	# set previous/next documents
    }
    puts $ofp "set helpnext $next_ref"
    puts $ofp "set helpprev $prev_ref"
    
    puts $ofp {
	.help.mf.bb.next config -command $helpnext
	.help.mf.bb.previous config -command $helpprev
	# enable and clear help window

	$w config -state normal
	$w mark set insert 0.0
	$w delete insert end
    }
    puts $ofp "wm title .help \"Help Browser - $title\""
    puts -nonewline $ofp {insertWithTags $w }
    puts $ofp "\"$secid $title\\n\\n\" 240H"
}

proc genHelpMain {ofp} {

    puts $ofp "proc HelpMain {} \{"
    puts $ofp {
	global w
	global helpprev
	global helpnext

	# enable and clear help window
	$w config -state normal
	$w mark set insert 0.0
	$w delete insert end

	# set previous/next documents
	set helpnext "HelpSec1"
	set helpprev "HelpMain"
	.help.mf.bb.next config -command $helpnext
	.help.mf.bb.previous config -command $helpprev
    }
    puts $ofp "wm title .help \"Help Browser - Main Index\""
    puts $ofp {insertWithTags $w "HELP MAIN MENU\n\n" 240H}

    # 
    # put abstract here if any
    #

    # this is the contents generated by gen_sec_index
    # for toplevel
    puts $ofp {HelpIndex0}

    puts $ofp "\}"
}

proc genConfigTag {ofp} {
    global sec_names

    puts $ofp "proc ConfigTags {w} \{"
    foreach sid [array names sec_names] {
	puts -nonewline $ofp {$w tag bind }
	puts $ofp "h$sid <1> \{HelpSec$sid\}"
    }
    foreach sid [array names sec_names] {
	puts -nonewline $ofp {$w tag bind }
	puts $ofp "h$sid"
    }
    puts $ofp "\}"
}

####
# Main
#

puts "latex2tkhlp Version 1.0,  By Jun Luo"

# get file name off command line
if {[llength $argv] != 2} {
    puts "Usage: latex2tkhlp input output"
    exit
}

# the first section is numbered 1, so use
# 0 as the guard
# BTW, secnum is indexed by level
# 
set secnum(1) 0
set sec_title_list(1) {}
set sec_title_list(0) {}

# names of all sections indexed by section id
# this is a little different from sec_title_list
# which is a list of subsections of a section sid
# indexed by sid
set sec_names(0) "INDEX"

set debugMode 0

# global secid
set secid 1
set has_sub(1) 0

set lbrk_cnt 0
set indent ""
set ifn [lindex $argv 0]
set ifp [open $ifn r]
set ofn [lindex $argv 1]
set auxf "$ofn.aux"
set ofp [open $auxf w]

genInsert $ofp
genMain $ofp

filter $ifp $ofp [skip $ifp "\\section"]

if {$secnum(1) > 0} {
    # close last section
    closeSec $ofp

    set curl $level(section)

    # generate index for all nesting sections
    # excluding the innermost one we just closed
    for {set i 0} {$i < $curl} {incr i} {
	gen_sec_index $ofp $i
    }
}

# generate the contents (main help)
genHelpMain $ofp

genConfigTag $ofp

close $ifp
close $ofp

if $debugMode {
    puts "done"

    puts "---Cross Refrences---"

    foreach ref [array name refs] {
	puts -nonewline "$ref - $refs($ref) - "
	puts $sec_names($refs($ref))
    }
}

#
# open the aux file to resolve the cross refs
#
set ifp [open $auxf r]
set ofp [open $ofn w]
while {[gets $ifp line] != -1} {
    if [regexp {(~.ref\\\{)([^\\\}]*)(\\\})} $line dummy dummy1 ref dummy2] {
	set rc [catch {set ref_num $refs($ref)} err]

	# ignore unknow references
	if {$rc == 0} {
	    if $debugMode {
		puts "$ref - $err"
	    }
	    set rpstr " $sec_names($err) "
	    regsub -all {(~.ref\\\{)([^\}]*)(\\\})} $line $rpstr line
	    append line "h$refs($ref) $tag(link)"
	} 
    }
    puts $ofp $line
}

close $ifp
close $ofp

exec rm -f $auxf
exit


