#!/usr/bin/tclsh

package require htmlparse

set htmlparse::namedEntities(Dstrok) "\xd0"
proc processNode {depth name tag} {
	global tree maxdepth
	if {$depth < $maxdepth} {
		closeNode $depth
	} elseif {$depth > $maxdepth+1} {
		for {set i [expr $maxdepth+1]} {$i<$depth} {incr i} {
			processNode $i "_" ""
		}
	}
	lappend tree($depth) [list $name $tag]
	set maxdepth $depth
}	
proc closeNode {depth} {
	global tree maxdepth
		for {set i $maxdepth} {$i>$depth} {incr i -1} {
			set parent [expr $i-1];
			lset tree($parent) end [concat [lindex $tree($parent) end] $tree($i)] 
			unset tree($i)
		}
}	

proc processImage {arglist} {
	puts $arglist
	global images
	global parsedTopic
	foreach {match name value}  [ regexp -all -inline -- {([[:alpha:]]+)="([^"]+)"} $arglist] {
		if {[string toupper $name] eq "SRC"} {
			if {![file exists $value]} {
				puts stderr "Image $value, referenced by $parsedTopic doesn't exists"
				exit 1
			}	
			puts stderr "Found image $value"
			set images($value) 1
		}
	}	
}

proc topicTag {tag slash arglist text} {
	set tag [string toupper $tag]
	if {$tag eq "IMG" && ![string length $slash]} {
		processImage  $arglist
	}
}

proc printEvent {tag slash arglist text} {
	global depth leveltags children inObjectDepth
	set tag [string toupper $tag]
	global object
	if {[string length $slash]} {
		if {[lsearch $leveltags $tag] !=-1} {
			if {[info exists object(name)]} {
						processNode [expr $depth+$inObjectDepth] $object(name) $object(local)
			}
			array unset object
			incr depth -1
		}
	} else {
		if {[lsearch $leveltags $tag]!=-1}  {
			incr depth 
		}
		#puts -nonewline "Opening $tag "
		foreach {match name value}  [ regexp -all -inline -- {([[:alpha:]]+)="([^"]+)"} $arglist] {
					set unescaped [::htmlparse::mapEscapes $value]
					if {$value ne "$unescaped"} { 
						set value [encoding convertfrom cp1251 $unescaped]
						regsub ".strok;" $value "" value
					}	
					set attrs([string tolower $name]) $value
		}
		if {$tag eq "OBJECT"} {
			set inObjectDepth 0
		}	
		if {$tag eq "PARAM"} {
			#puts [array get attrs]
			if {[string tolower $attrs(name)] eq "name"} {
				if {[info exists object(name)]} {
						processNode [expr $depth+$inObjectDepth] $object(name) $object(local)
						set inObjectDepth 1
				}
				set object(name) $attrs(value)
				set object(local) ""
			} else {
				set object([string tolower $attrs(name)]) $attrs(value)
			}	
		} else {	
			#puts ""
		}
	}	
}

set leveltags {UL OL DL OBJECT}

proc makeIndexFile {fromfile tofile} {
	global depth maxdepth tree 
	set depth 0
	set maxdepth 0
	catch {unset tree}
	set f [open $fromfile] 
	processNode 1  ""
	::htmlparse::parse -cmd printEvent [read $f]
	closeNode 1
	close $f
	set f [open $tofile w]
	puts $f [lrange [lindex $tree(1) 0] 2 end]
	close $f
}


proc scanTopic {file} {
	set f [open $file]
	global parsedTopic
	set parsedTopic $file
	::htmlparse::parse -cmd topicTag [read $f]
	close $f
}
if {$argc != 2} {
	puts "Tk Html Help compiler. Usage $argv0 filename.hhp resultfile"
	exit 1
}	

array set images {}

set f [open [lindex $argv 0]]
set section ""
while {[gets $f line]>=0} {
	if {![string length $line]} continue
	if {[regexp -nocase {\[(.*)\]} $line m section]} {
		set section [string tolower $section]
		continue
	}
	if {$section eq "options"} {
		if {![regexp {([^=]+)=(.*)$} $line match option value]} {
			puts stderr "Invalid line \"$line\" in options section"
			exit 1
		}
		set options([string tolower $option]) $value
	} elseif {$section eq "files"} {
		if {![file exists $line]} {
			puts stderr "File \"$line\" listed in the files section doesn't exists"
			exit 1
		}
		if {[string match *.htm* $line]} {
			scanTopic $line
		}	
		lappend filelist $line
	}
}

close $f
if {![info exists options(default\ topic)]} {
	puts stderr "Default topic is not specified"
	exit 1
}	
if {[lsearch -exact $filelist "$options(default topic)"]==-1} {
	puts stderr "Default topic [set "options(default topic)"] is not mentioned in the files section"
	exit 1
}	
if {![info exists "options(contents file)"]} {
	puts stderr "Help projects without contents file are not supported"
	exit 1
}	
makeIndexFile [set "options(contents file)"] contents.lst
if {![info exists "options(index file)"]} {
	puts stderr "Help projects without index file are not supported"
	exit 1
}	
makeIndexFile $options(index\ file) index.lst

set f [open "meta.lst" w]
foreach file $filelist {
	set page [open $file]
	if {[regexp -nocase {<meta +name="ms-haid" +content="([^"]+)">} [read $page] meta label]} {
		puts $f [list $label $file]
	}
	close $page
}
close $f
set f [open "props.txt" w] 
puts $f "encoding [encoding system]"
puts $f "starttopic $options(default\ topic)"
if {[info exists options(title)]} {
	puts $f [list title $options(title)]
}	
close $f
eval exec zip [list [lindex $argv 1] meta.lst props.txt index.lst contents.lst] $filelist [array names images]

