# -*- tcl -*-
# $Id: script,v 1.5 1998/11/11 15:06:02 tobotras Exp $

# Extracts references to DIVs into TOC.
#

require TEItools.tcl
require Simple.tcl
TEItoolsSetup "toc"
require TEItoolsHTML.tcl
package require http

global divDepth 0

specification translate {
    {element "TEI.2"} {
	prefix	"[HtmlHeader]</HEAD><BODY>"
	suffix	[HtmlFooter]
    }
    {element HEAD in DIV} {
	cdataFilter	textCdataFilter
	sdataFilter	textSdataFilter
	suffix		[divTail]
	prefix		[divHead]
    }
    {element HEAD in DIV0} {
	suffix		[divTail]
	cdataFilter	textCdataFilter
	sdataFilter	textSdataFilter
	prefix		[divHead]
    }
    {element HEAD in DIV1} {
	suffix		[divTail]
	cdataFilter	textCdataFilter
	sdataFilter	textSdataFilter
	prefix		[divHead]
    }
    {element HEAD in DIV2} {
	suffix		[divTail]
	prefix		[divHead]
	cdataFilter	textCdataFilter
	sdataFilter	textSdataFilter
    }
    {element HEAD in DIV3} {
	suffix		[divTail]
	prefix		[divHead]
	cdataFilter	textCdataFilter
	sdataFilter	textSdataFilter
    }
    {element HEAD in DIV4} {
	cdataFilter	textCdataFilter
	suffix		[divTail]
	sdataFilter	textSdataFilter
	prefix		[divHead]
    }
    {element HEAD in DIV5} {
	prefix		[divHead]
	cdataFilter	textCdataFilter
	suffix		[divTail]
	sdataFilter	textSdataFilter
    }
    {element HEAD in DIV6} {
	prefix		[divHead]
	cdataFilter	textCdataFilter
	suffix		[divTail]
	sdataFilter	textSdataFilter
    }
    {element HEAD in DIV7} {
	prefix		[divHead]
	cdataFilter	textCdataFilter
	sdataFilter	textSdataFilter
	suffix		[divTail]
    }
    {element Q in HEAD} {
	prefix		[leftQuote]
	suffix		[rightQuote]
	cdataFilter	textCdataFilter
	sdataFilter	textSdataFilter
    }
    {el} {
	cdataFilter	null
	sdataFilter	null
    }
}

proc divHead {} {
    global env
    set id {}
    withNode parent hasatt ID {
	set id [attVal ID]
    }
    if { "$id" != "" } {
	set xptr "ID ($id)"
    } else {
	withNode parent {
	    set xptr [buildXPointer]
	}
    }
    return "[divIndent]<A HREF='/cgi-bin/tei2div.cgi?[::http::formatQuery \
		file $env(QUERY_STRING) \
		XPTR $xptr]'>"
}

proc divTail {} {
    return "</A><BR>\n"
}

proc divIndent {} {
    set depth 0
    foreachNode ancestor {
	if { [string match "DIV*" [string toupper [query gi]]] } {
	    incr depth 3
	}
    }
    set ret {}
    while { $depth > 0 } {
	append ret "&nbsp;"
	incr depth -1
    }
    return $ret
}

proc buildXPointer {} {

    debug "buildXPointer"
    
    withNode doctree child el {
	set root [query address]
	debug "> root is $root"
    }
    
    set addr [query address]
    if { $addr == $root } {
	debug "> in root"
	return "ROOT"
    }

    withNode parent {
	debug "> in parent, <[query gi]>@[query address]"
	set pathToElement [buildXPointer]
	debug "< in parent, $pathToElement built."
    }

    set childNo 1
    foreachNode prev {
	incr childNo
    }
    
    set ret "CHILD ($childNo)"
    debug "< returning $pathToElement $ret"
    return "$pathToElement $ret"
}
