# -*- tcl -*-
#
# $Id: script,v 1.100 2003/08/22 10:58:59 tobotras Exp $
#

require TEItools.tcl
require TEItoolsEPN.tcl
require Simple.tcl
TEItoolsSetup "rtf"

require RTF.spec
require TEItoolsRTF.tcl

set rtf_fp [open ${argv}.rtf w]

puts stderr "Transforming SGML ..."

proc main {} {

    rtf:start

    withNode doctree element EDITIONSTMT {
	rtf:startSection style_VersionSheet
	rtf:startPara style_VersionText
	rtf:text [filteredContent]
	rtf:endPara
	rtf:endSection
    }
    
    EnumerateThings
    
    rtf:startSection style_Body

    pageStyle

    #FIXME
    foreachNode subtree elements "FRONT BODY BACK" { 
	rtf:convert translate
    }
    rtf:end
    rtf:write "\n"
}

proc EnumerateThings {} {
    global tableCounter pictureCounter
    set tableCounter 1
    set pictureCounter 1
    foreachNode docroot descendant element TABLE {
	debug "Table $tableCounter found"
	setprop tableNo $tableCounter
	incr tableCounter
    }
    foreachNode docroot descendant element FIGURE {
	debug "Picture $pictureCounter found"
	setprop pictureNo $pictureCounter
	incr pictureCounter
    }
}

proc pageFooter {} {
    rtf:write "- "
    #      rtf:insertField {\page \* PAGE} {???}
          rtf:insertField {PAGE} {???}
#    rtf:insertField "{PAGE}" "???"
    rtf:write " -"
}

proc pageHeader {} {
    withNode doctree element TITLEPAGE descendant element TITLEPART {
	rtf:convert headerTranslate
    }
}

proc div_nest_level {} {
    set level 1
    foreachNode ancestor {
	if { "[query gi]" == "DIV" } {
	    incr level
	} else {
	    return $level
	}
    }
}

# Every known element should redefine prefix!

specification translate {
    {elements "FRONT BACK FIGDESC"} {
	cdataFilter	null
	sdataFilter	null
	prefix		{}
    }
    {element Q in HEAD in FIGURE} {
	prefix	"[oqIfNotBlock]"
	suffix	"[cqIfNotBlock]"
	cdataFilter textCdataFilter
	sdataFilter textSdataFilter
    }
    {element Q in HEAD} {
	cdataFilter	null
	sdataFilter	null
	prefix		{}
	suffix		{}
	startAction	{}
	endAction	{}
    }
    {element TITLEPAGE} {
	startAction {
	    rtf:startSection style_Front
	}
    }
    {element DOCTITLE in TITLEPAGE} {
	rtf		para
	paraStyle	style_DocTitle
	prefix		{}
    }
    {element TITLEPART in DOCTITLE in TITLEPAGE} {
	prefix		{}
	suffix		$rtfSpecial(LineBreak)
    }
    {element DOCAUTHOR in TITLEPAGE} {
	rtf		para
	paraStyle	style_DocAuthor
	prefix		{}
	suffix		$rtfSpecial(LineBreak)
    }
    {element DOCIMPRINT in TITLEPAGE} {
	rtf		para
	paraStyle	style_DocImprint
	prefix		{}
    }
    {element DOCDATE in TITLEPAGE} {
	rtf		para
	paraStyle	style_DocDate
	prefix		{}
    }
    {element DIVGEN} {
	rtf		special
	startAction 	doDivGen
	prefix		{}
    }
    {elements "DIV DIV1 DIV2 DIV3 DIV4 DIV5 DIV6 DIV7"} {
	rtf	special
	startAction {
	    puts stderr . nonewline
	    checkDivType
	}
	prefix		[pageBreakBeforeDivision]
	suffix		[pageBreakAfterDivision]
    }
    {elements "SEG ANCHOR MENTIONED"} {
	prefix		{}
    }
    {element HEAD withattval TYPE SHORT} {
	rtf		none
	startAction	{}
	endAction	{}
	prefix		""
	suffix		""
	cdataFilter	null
	sdataFilter	null
    }
    {element HEAD in DIV} {
	rtf		special
	startAction {
	    rtf:startPara style_Heading_[div_nest_level]
	    openHeadMark
	}
	prefix		"[DivHeadPrefix]"
	endAction {
	    closeHeadMark
	    rtf:endPara
	}
    }
    {element MILESTONE} {
	rtf		para
	paraStyle	style_Milestone
	prefix		"*$rtfSpecial(EmSpace)*$rtfSpecial(EmSpace)*"
    }
    {element HEAD in DIV1} {
	rtf		para
	paraStyle	style_Heading_1
	prefix		"[DivHeadPrefix]"
	startAction	openHeadMark
	endAction	closeHeadMark
    }
    {element HEAD in DIV2} {
	rtf		para
	paraStyle	style_Heading_2
	prefix		"[DivHeadPrefix]"
	startAction	openHeadMark
	endAction	closeHeadMark
    }
    {element HEAD in DIV3} {
	rtf		para
	paraStyle	style_Heading_3
	prefix		"[DivHeadPrefix]"
	startAction	openHeadMark
	endAction	closeHeadMark
    }
    {element HEAD in DIV4} {
	rtf		para
	paraStyle	style_Heading_4
	prefix		"[DivHeadPrefix]"
	startAction	openHeadMark
	endAction	closeHeadMark
    }
    {element HEAD in DIV5} {
	rtf		para
	paraStyle	style_Heading_5
	prefix		"[DivHeadPrefix]"
	startAction	openHeadMark
	endAction	closeHeadMark
    }
    {element HEAD in DIV6} {
	rtf		para
	paraStyle	style_Heading_6
	prefix		"[DivHeadPrefix]"
	startAction	openHeadMark
	endAction	closeHeadMark
    }
    {element HEAD in DIV7} {
	rtf		para
	paraStyle	style_Heading_7
	prefix		"[DivHeadPrefix]"
	startAction	openHeadMark
	endAction	closeHeadMark
    }
    {element P within EPIGRAPH} {
	rtf		para
	paraStyle	style_Epigraph
    }
    {element BIBL within EPIGRAPH} {
	rtf		para
	paraStyle	style_Epigraph_Author
    }
    {element P within SP} {
	rtf		special
	prefix		{}
    }
    {element P in DIV withattval TYPE ABSTRACT} {
	rtf		para
	prefix		{}
	paraStyle	style_Abstract
    }
    {element P in DIV withattval TYPE COLOPHON} {
	rtf		para
	prefix		{}
	paraStyle	style_Colophon
    }
    {element P} {
	rtf		para
	prefix		"[openPara]"
	paraStyle	"[openRend style_Default]"
    }
    {elements CODE} {
	rtf		special
	prefix		{}
	startAction {
	    if { [blockRend] } {
		rtf:startPara style_Para_Code
	    }
	    rtf:startPhrase "[openRend style_Phrase_Code]"
	}
	endAction {
	    rtf:endPhrase
	    if { [blockRend] } {
		rtf:endPara
	    }
	}
    }
    {element FOREIGN} {
	prefix		{}
    }
    {element KW} {
	rtf		phrase
	prefix		{}
	charStyle	"[openRend style_Keyword]"
    }
    {element NOTE withattval PLACE INLINE} {
	rtf		phrase
	charStyle	"[openRend style_Phrase_Note]"
	before		{}
	after		{}
	prefix		{}
	startAction	{}
	endAction	{}
	cdataFilter	inlineNoteFilter
    }
    {element NOTE withattval PLACE INTERLINE} {
	rtf		para
	paraStyle       style_Para_Note
	before		{}
	prefix		{}
	after		{}
	startAction	{}
	endAction	{}
    }
    {element NOTE withattval PLACE INTERLINEAR} {
	rtf		para
	paraStyle       style_Para_Note
	before		{}
	prefix		{}
	after		{}
	startAction	{}
	endAction	{}
    }
    {element NOTE} {
	rtf 		special
	startAction {
	    rtf:special FootnoteNumber
	    rtf:divert Footnote
	    rtf:startPhrase style_FootnoteNumber
	    rtf:special FootnoteNumber
	    rtf:endPhrase
	    rtf:startPhrase style_Footnote
	}
	endAction {
	    rtf:endPhrase
	    rtf:undivert
	}
	prefix		{}
    }
    {element ADDRESS} {
	rtf		para
	paraStyle	style_Address
    }
    {element XPTR} {
	rtf             phrase
	charStyle       "[openRend style_Title]"
	prefix          "[doXptr NodeReferenceName]"
    }
    {element Q in P} {
	rtf		special
	startAction {
	    if { [blockRend] } {	
		rtf:startPara style_Para_Quote
	    }
	    rtf:startPhrase "[openRend style_Phrase_Quote]"
	}
	endAction {
	    rtf:endPhrase	
	    if { [blockRend] } {
		rtf:endPara
	    }
	}
    }
    {element Q} {
	rtf		special
	startAction	{}
	endAction	{}
	prefix	"[oqIfNotBlock]"
	suffix	"[cqIfNotBlock]"
    }
    {element LG} {
	rtf		special
	startAction {
	    rtf:startPara style_Para_Quote
	}
	endAction {
	    rtf:endPara
	}
	prefix	{}
    }
    {element PB} {
	rtf		special
	prefix		{}
	startAction {
	    rtf:special PageBreak
	}
    }
    {elements "L LB ADDRLINE"} {
	rtf		special
	prefix		{}
	startAction {
	    rtf:special LineBreak
	}
    }
    {element INDEX} {
	rtf		special
	prefix		{}
	startAction     markIndexPoint
    }
    {element HEAD in FIGURE} {
	rtf		para
	paraStyle	style_Picture_Title
	prefix		"[figTitle [query parent propval pictureNo]]$rtfSpecial(EnSpace)"
    }
    {element TITLE hasatt LEVEL in BIBL} {
	rtf		phrase
	charStyle	"[openRend style_Bold]"
	prefix		{}
    }
    {element TITLE in BIBL} {
	rtf		phrase
	charStyle	"[openRend style_Title]"
	prefix		{}
    }
    {element AUTHOR in BIBL} {
	prefix		{}
	suffix		"."
    }
    {element PUBLISHER in BIBL} {
	prefix		"[localize rtfMdash]"
    }
    {element DATE in BIBL} {
	prefix		", "
    }
    {element BIBLSCOPE in BIBL} {
	prefix		", "
    }
    {element LISTBIBL} {
	rtf		para
	paraStyle	style_Heading_1
	prefix		"[localize thebibliography]\n"
    }
    {element BIBL in LISTBIBL} {
	rtf		para
	paraStyle	style_Default
	prefix		"[bibItem][rtf:special EnSpace]"
	suffix		"\n"
    }
    {element EPIGRAPH} {
	rtf		special
	prefix		{}
    }
    {element TITLE within P} {
	rtf		phrase
	charStyle	"[openRend style_Title]"
	prefix		{}
    }
    {element HEAD within P} {
	rtf		phrase
	charStyle	"[openRend style_Title]"
	prefix		{}
    }
    {element NAME within STAGE} {
	rtf		phrase
	charStyle	"[openRend style_Bold]"
	prefix		{}
    }
    {element STAGE within SP} {
	rtf		phrase
	charStyle	style_StageInText
	prefix		{}
    }
    {element STAGE} {
	rtf		para
	paraStyle	style_Stage
	prefix		{}
    }
    {element SP} {
	startAction {
	    rtf:startPara style_Default
	    rtf:startPhrase style_Speaker
	    rtf:text [speaker]
	    rtf:endPhrase
	}
	endAction {
	    rtf:endPara
	}
	prefix	{}
	rtf	special
    }
    {element SPEAKER} {
	rtf		phrase
	charStyle	style_Speaker
	prefix		{}
	suffix		". "
    }
    {element NAME} {
	rtf		phrase
	charStyle	"[openRend style_Plain]"
	prefix		{}
    }
    {elements "TITLE HEAD"} {
	rtf		para
	paraStyle	style_Display_Title
	prefix		{}
    }
    {element XREF} {
	rtf		phrase
	charStyle	"[openRend style_Xref]"
	prefix		{}
    }
    {element GI} {
	rtf		phrase
	charStyle	"[openRend style_Gi]"
	prefix		"<"
	suffix		">"
    }
    {element BODY} {
	rtf		special
	prefix		""
    }
    {element IDENT} {
	rtf		phrase
	charStyle	"[openRend style_Ident]"
	prefix		{}
    }
    {element TERM} {
	rtf		phrase
	charStyle	"[openRend style_Term]"
	prefix		{}
    }
    {element SOCALLED} {
	rtf		phrase
	charStyle	"[openRend style_Italic]"
	prefix		"``"
	suffix		"''"
    }
    {element ITEM in LIST withattval TYPE gloss} {
	rtf		special
	startAction {
	    rtf:startPhrase	"[openRend style_Plain]"
	}
	endAction {
	    rtf:endPhrase
	    rtf:endPara
	}
	prefix		{}
    }
    {element ITEM in LIST withattval TYPE simple} {
	prefix		"$rtfSpecial(Bullet)$rtfSpecial(EmSpace)"
    }
    {element ITEM in LIST withattval TYPE bulleted} {
	prefix		"$rtfSpecial(Bullet)$rtfSpecial(EmSpace)"
    }
    {element ITEM in LIST withattval TYPE bullets} {
	prefix		"$rtfSpecial(Bullet)$rtfSpecial(EmSpace)"
    }
    {element ITEM in LIST withattval TYPE ordered} {
	prefix		"[listItemLabel].$rtfSpecial(EmSpace)"
    }
    {element ITEM in LIST} {
	rtf		para
	paraStyle	style_List_Item_[countListNest]
	prefix		{}
    }
    {element LIST} {
	prefix		{}
    }
    {element LABEL in LIST} {
	rtf		special
	startAction {
	    rtf:startPara style_List_Label_[countListNest]
	}
	cdataFilter textCdataFilter
	suffix "$rtfSpecial(EmSpace)"
	prefix		{}
    }
    {element EG} {
# 	rtf		special
# 	startAction {
# 	    rtf:startPara style_Verbatim
# 	    rtf:write	[rtf:EscapeLineSpecific [filteredContent]]
# 	    rtf:endPara
# 	}
# 	prefix		{}
# 	cdataFilter	null
# 	sdataFilter	null
	rtf		linespecific 
	paraStyle	style_Verbatim
	prefix		{}
    }
    {element HI within DIV withattval TYPE ABSTRACT} {
	rtf		phrase
	charStyle	"[openRend style_Plain]"
	prefix		{}
    }
    {element EMPH within DIV withattval TYPE ABSTRACT} {
	rtf		phrase
	charStyle	"[openRend style_Plain]"
	prefix		{}
    }
    {elements "HI EMPH"} {
	rtf		phrase
	charStyle	"[openRend style_Italic]"
	prefix		{}
    }
    {element TABLE} {
	rtf		special
	startAction {
	    set cols [query attval COLS]
	    if { $cols == "" } {
		set cols [countColsInFirstRow]
	    }
	    if { "[attVal N]" == "landscape" } {
		rtf:startSection style_Landscape
	    }
	    TableHeader
	    eval rtf:startTable -numcols $cols -colsep rule_Table_Col_Sep \
		 -rowsep rule_Table_Frame [tableFrame] -headingrow 1
	}
	endAction {
	    rtf:endTable
	    if { "[attVal N]" == "landscape" } {
		rtf:endSection
		rtf:startSection style_Body
	    }
	}
	prefix		{}
    }
    {element ROW in TABLE} {
	rtf		special
	startAction {
	    rtf:startRow -colspans [colSpans] -rowspans [rowSpans]
	}
	endAction {
	    rtf:endRow
	}
	prefix		{}
    }
    {element CELL in ROW in TABLE} {
	rtf	special
	startAction {
	    DumpStubCells
	    rtf:startCell style_Table_Cell_[openCellAlign]
	    set role [attVal ROLE]
	    withNode parent {
		set rowRole [attVal ROLE]
	    }
	    if { $role == "label" || $rowRole == "label" } {
		rtf:startPhrase style_Bold
	    } else {
		rtf:startPhrase style_Plain
	    }
	} 
	endAction {
	    rtf:endPhrase
	    rtf:endCell
	}
	prefix		{}
    }
    {element HEAD in TABLE} {
	rtf \#IMPLIED
	cdataFilter null
	sdataFilter null
	prefix		{}
    }
    {element PTR hasatt TARGET} {
	rtf special
	startAction 	doPointer
	prefix		{}
    }
    {element ABBR} {
	rtf \#IMPLIED
	cdataFilter toUpper
	prefix		{}
    }
    {element FIGURE} {
	rtf special
	startAction {
	    rtf:startPara style_Picture
	    doFigure
	    rtf:endPara
	}
	prefix	{}
    }
    {elements "HEAD REF"} {
	rtf none
	prefix		{}
    }
    {within TEIHEADER} {
	cdataFilter	null
	sdataFilter	null
	prefix		{}
    }
    {element DEL} {
	prefix		{}
	cdataFilter	null
	sdataFilter	null
    }
    {el} {
	rtf none
	prefix [openUnknown]
	cdataFilter textCdataFilter
	sdataFilter textSdataFilter
    }
}

proc speaker {} {
    withNode child element SPEAKER {
	return
    }
    set who [attVal WHO]
    if { "$who" == "" } {
	Error "Don't know who speaks"
	return
    }
    withNode docroot descendant element NAME withattval ID $who {
	return "[content]. "
    }
    Error "No <NAME ID='$who'>"
}

proc closeRend {} {
    return
}

proc openQuote {} {
    return [openRend style_Phrase_Quote]
}

proc listItemLabel {} {
    set n [attVal N]

    if { "$n" == "" } {
	return "[childNumber]"
    }

    return $n
}

proc doDivGen {} {
    set genProcedure "generate[typeVal]"
    if { "[info proc $genProcedure]" != "$genProcedure" } {
        Error "Unknown divGen type: [typeVal]"
    } else {
	return [eval $genProcedure]
    }
}

proc generatetoc {} {
    #FIXME!!
    #toc_depth should be obeyed
    
    global splitNames
     rtf:startPara style_Heading_1
      rtf:text [localize contents]
     rtf:endPara
    
    foreachNode doctree elements "DIV DIV0 DIV1" {
	if { "[query gi]" == "DIV1" \
		 || "[query gi]" == "DIV" && \
		 [lsearch $splitNames(1) [typeVal]] != -1 } {
	    TOCentry style_TOC_0
	    foreachNode subtree elements "DIV2" {
		TOCentry style_TOC_1
	    }
	}
    }

    rtf:special PageBreak
}

proc TOCentry { style } {
    rtf:startPara $style
    set id [uniqueID]
    withNode subtree element "HEAD" {
	#	rtf:write [DivHeadPrefix][filteredContent]
#	rtf:write [DivHeadPrefix]
	rtf:convert headerTranslate
	rtf:tab
	PageRef $id
    }
    rtf:endPara
}

proc markIndexPoint {} {
    set id [uniqueID]
    rtf:startBookmark $id
    rtf:endBookmark $id
}

proc generateindex {} {
    rtf:startSection style_Index
    rtf:startPara style_Heading_1
    rtf:write [localize index]
    rtf:endPara
    rtf:startPara style_Default
    processIndex
    rtf:endPara
    rtf:endSection
}

proc processIndex {} {
    rtf:write "Here will be index."
}

proc doDivRef {} {
    rtf:insertField "{REF [uniqueID] \\n}" "[currentDivNo]"
}

proc doFigRef {} {
    rtf:write [query propval pictureNo]
#    rtf:insertField "{REF [uniqueID] \\n}" "[query propval pictureNo]"
}

proc doTableRef {} {
    rtf:text "[query propval tableNo]"
}

proc doItemRef {} {
    rtf:text [listItemLabel]
}

proc doFigure {} {
    set entName [query attval ENTITY]
    if { $entName == "" } {
	Error "figure without ENTITY to include!"
	return
    }
    withNode entity $entName {
	set fileName [query sysid]

	# rtfdata file should contain {\pict .... } group.
	# Might be generated by xpm2rtf.
	# We can use 'image photo' here, but then we're forced to use
	# costwish instead of costsh... Hm...

	if { ![insertRTFpicture $fileName] } {
	        Error "can't insert $fileName picture"
	
	        withNode child element FIGDESC {
		rtf:startPara style_Picture_Title
	        rtf:startPhrase style_Plain
		rtf:text [filteredContent]
	        rtf:endPhrase
	        rtf:endPara
	    }
	}
    }

    set picNo [query propval pictureNo]

#    withNode child element HEAD {
#	rtf:startPara style_Picture_Title
#	openHeadMark
#	 rtf:startPhrase style_Plain
#	  rtf:text [figTitle $picNo]
#	 rtf:special EnSpace
#	 rtf:endPhrase
#         rtf:startPhrase [openRend style_Table_Head_Phrase]
#      	  rtf:write [filteredContent]
#	 rtf:endPhrase
#	closeHeadMark
#	rtf:endPara
#    }
}

proc insertRTFpicture { fileName } {
    
    if { ![ file readable $fileName] } {
	append fileName ".rtfdata"
    }

    if { ![ file readable $fileName] } {
	Error "No such file: $fileName"
	return 0
    }

    set fd [open "${fileName}" "r"]
    puts stderr "\[${fileName}" nonewline
    while { ![eof $fd] } {
	rtf:write [read $fd 1000]
    }
    puts stderr "\]" nonewline
    close $fd
    return 1
}

proc Dump { var bytes } {
    while { $bytes > 0 } {
	rtf:write [format "%02x" [expr $var & 255]]
	set var [expr $var >> 8]
	incr bytes -1
    }
}

proc DivHeadPrefix {} {
    # We're in <DIV#><HEAD>
    withNode parent {
	switch -regexp [typeVal] {
	    "appendix" {
		# Insert <DIV>'s number in parent, mapped to letter
		set N 1
		foreachNode prev withattval TYPE APPENDIX {
		    incr N
		}
		return "[appendixPrefix $N] "
	    }
	    "(act)|(scene)|(stub)" {
		return
	    }
	    default {
		return "[currentDivNo]. "
	    }
	}
    }
}

proc doPointer {} {
    set target [query attval TARGET]

    withNode doctree withattval ID $target {

	debug "Pointer to [query gi]"
	
	switch -regexp [query gi] {
	    "ITEM" {
		doItemRef
	    }
	    "(DIV)|(DIV.)" {
		doDivRef
	    }
	    "FIGURE" {
		doFigRef
	    }
	    "TABLE" {
		doTableRef
	    }
	    "P" {
		set n [paragraphNumber]
		if { "$n" != "" } {
		    rtf:text $n
		} else {
		    error "***ERROR: reference to unnumbered paragraph"
		}
	    }
	    "LABEL" {
		rtf:text [filteredContent]
	    }
	    "BIBL" {
		rtf:write [bibItem]
	    }
	    default {
		Warning "references to [query gi] are not implemented"
		rtf:text " \[Please, mail me that you need pointers to [query gi] -- Boris\] "
	    }
	}
	return
    }
    rtf:text "\[No element with ID=$target\]"
}

proc openAlign {} {
    set rendVal [attVal REND]
    foreach re [split $rendVal " ,"] {
	switch $re \
	    "left"  { return Left } \
	    "right" { return Right } \
	    "center" { return Center } \
	    "justify" { return Justify }
    }
    return
}

proc openParaAlign {} {
    set align [openAlign]
    if { $align == "" } {
	return
    }
    return "_${align}"
}

proc openCellAlign {} {
    set rendVal [openAlign]
    if { $rendVal != "" } {
	return $rendVal
    }
    withNode ancestor element TABLE {
	set rendVal [attVal REND]
    }

    set colNo [expr [childNumber] - 1]
    foreachNode prev {
       set span [attVal COLS]
	if { $span != "" && $span > 1 } {
           set colNo [expr $colNo + $span - 1]
       }
    }

    if { [isdigit [string index $rendVal 0]] } {
       set rend [split $rendVal " ,"]
       if { [llength $rend] < [expr $colNo + 1] \
                || [regexp "(\[0-9\]+)(\[lrcj\]?)" $rend dummy width align] == 0 } {
           return Left
       } else {
           return [letterAlign $align]
       }
    } else {
       if { [string length $rendVal] < [expr $colNo + 1] } {
           return Left
       } else {
           return [letterAlign [string index $rendVal $colNo]]
       }
    }
}

proc letterAlign { c } {
    switch -- $c {
	"r" { return Right }
	"c" { return Center }
        "j" { return Justify }
	default { return Left }
    }
}

proc tableFrame {} {
    if { [string match "*notlined*" [attVal N]] } {
	return
    } else {
	return "-frame rule_Table_Frame"
    }
}

proc TableHeader {} {
    set tableNo [query propval tableNo]
    withNode child element HEAD {
	rtf:startPara style_Table_Head_Para
	 rtf:startPhrase style_Plain
	 rtf:text [tabTitle $tableNo]
	rtf:special EnSpace
	 rtf:endPhrase
	rtf:startPhrase [openRend style_Table_Head_Phrase]
	rtf:write [filteredContent]
	rtf:endPhrase
	# no endPara here!
    }
}

proc colSpans {} {
    set spans {}
    foreachNode child element CELL {
	set colspan [query attval COLS]
	if { $colspan == "" } {
	    set colspan 1
	}
	append spans " ${colspan}"
    }
    return $spans
}

proc DumpStubCells {} {
    return
}

proc rowSpans {} {
    set merges ""
    foreachNode child element CELL {
	set rowspan [query attval ROWS]
	if { $rowspan == "" } {
	    set rowspan 1
	}
	if { $rowspan > 1 } {
	    append merges " First"
	} else {
	    if { "[query propval merge]" != "" } {
		append merges " Merge"
	    } else {
		append merges " Normal"
	    }
	}
    }
    return $merges
}

proc countColsInFirstRow {} {
    withNode child element row {
	set N 0
	foreachNode child element cell {
	    set colSpan [query attval COLS]
	    if { $colSpan == "" } {
		set colSpan 1
	    }
	    incr N $colSpan	
	}
	return $N
    }
    Error "What? Table without rows?? Hm..."
    return 0
}

proc oqIfNotBlock {} {
    if { [blockRend] } {
	return
    } else {
	#	global rtfSpecial
	#	return "$rtfSpecial(LDQuote)"
	return [rtf:special LDQuote]
    }
    return
}

proc cqIfNotBlock {} {
    if { [blockRend] } {
	return
    } else {
	global rtfSpecial
	return $rtfSpecial(RDQuote)
    }
}

proc blockRend {} {
    if { [hasRend "block"] || [hasRend "display"] } {
	return 1
    } else {
	return 0
    }
}

proc hasRend { item } {
    foreach rend [split [attVal REND] " ,"] {
	if { $rend == [string tolower $item] } {
	    return 1
	}
    }
    return 0
}

proc countListNest {} {
    set level 0
    foreachNode ancestor {
	if {[string tolower [query gi]] == "list"} {
	    incr level
	}
    }
    return $level
}

proc openPara {} {
    set n [paragraphNumber]
    if { "$n" == "" } return
    global rtfSpecial
    return "${n}$rtfSpecial(EnSpace)"
}

proc openRend { defaultRend } {

    set style $defaultRend
    set bold 0

    # "block" and "inline" are intentionally ignored

    foreach re [split [attVal REND] " ,"] {
	switch -regexp -- $re {
	    "underline" {
		set style style_Underline
	    }
	    "(superscript)|(super)" {
		set style style_Superscript
	    }
	    "(subscript)|(sub)" {
		set style style_Subscript
	    }
	    "smallcap" {
		set style style_Smallcaps
	    }
	    "bold" {
		set bold 1
	    }
	    "small" {
		set style style_Small
	    }
	    "large" {
		set style style_Large
	    }
	    "normal" {
		set style style_Plain
	    }
	    "italic" {
		set style style_Italic
	    }
	    "slanted" {
		set style style_Slanted
	    }
	    "typewriter" {
		set style style_Typewriter
	    }
	    "sans" {
		set style style_Sans
	    }
	    default {
		global rtf_styleSheet
		set rend [string tolower $re]
		set style "style_${re}_"
		if { ![info exists rtf_styleSheet($style,DEF)] } {
		    Error "Unknown style: $re"
		    set style "style_Unknown"
		}
	    }
	}
    }
    if { $bold == 1 } {
	append style _Bold
    }
    if { "[query gi]" == "P" } {
	append style [openParaAlign]
    }
    
    return $style
}

rename filteredContent {}

set contentStackLevel 0

proc filteredContent {} {
    global contentStackLevel
    if { $contentStackLevel == 0 } {
	rename rtf:write output_filtered
    }
    incr contentStackLevel
    global filteredContentText
    set filteredContentText ""
    proc rtf:write { text } {
	global filteredContentText
	append filteredContentText $text
    }
    rtf:convert headerTranslate
    incr contentStackLevel -1
    if { $contentStackLevel == 0 } {
	rename rtf:write {}
	rename output_filtered rtf:write
    }
    return $filteredContentText
}

specification headerTranslate {
    {within TEIHEADER} {
	rtf		special
	cdataFilter	null
	sdataFilter	null
    }
    {element Q} {
	prefix	"[oqIfNotBlock]"
	suffix  "[cqIfNotBlock]"
	rtf		special
	startAction	{}
	endAction	{}
    }
    {element HEAD} {
	prefix	""
    }
    {el} {
	rtf none
	prefix [openUnknown]
	cdataFilter textCdataFilter
	sdataFilter textSdataFilter2
    }
}

proc textSdataFilter2 { text } {
    return [textSdataFilter $text]
}

proc pageBreakBeforeDivision {} {
    global TEItools_openpage_value
    if { [info exists TEItools_openpage_value] } {
	if { "[toLower [query gi]]" == [toLower $TEItools_openpage_value] } {
	    withNode prev {
		if { "[query gi]" == "DIVGEN" } {
		    # PageBreak already done by ToC & Co
		    return
		}
	    }
	    if { "[query prev gi]" == "" } {
		# There is no prev DIV1, so pagebreak isn't needed, right?
		return
	    } else {
		global rtfSpecial
		return $rtfSpecial(PageBreak)
	    }
	}
    }
    return 
}

proc pageBreakAfterDivision {} {
    if { "[attVal TYPE]" == "abstract" } {
	global rtfSpecial
	return $rtfSpecial(PageBreak)
    }
    return
}

proc bibItem {} {
    return "\[[expr 1 + [countq prev element BIBL]]\]"
}

#Local variables:
#tcl-tab-always-indent: nil
#End:
