# -*- tcl -*-
#
# $Id: script,v 1.8 2003/02/28 12:33:52 tobotras Exp $

require TEItools.tcl
TEItoolsSetup "rtf"
require RTF.spec
set rtf_fp $outFile

require TEItoolsRTF.tcl

array set backTableHeads {
    1 " "
    2 ""
    3 ", , "
    4 ""
    5 ""
}

specification translate {
    {elements "TZ MIDDLENAME FIRSTNAME LASTNAME DAY MONTH TITLE STAGES STAGECONTENT STAGEDOCUMENTS"} {
	#Do nothing
	prefix	""
    }
    {elements "BODY BACK VERSIONINFO"} {
	rtf special
	prefix {}
	startAction {
	    rtf:startSection	style_[toLower [query gi]]
	}
	endAction {
	    rtf:endSection
	}
    }
    {elements "ABSTRACT COMMONINFO GOAL CHARACTERISTICS REQUIREMENTS CONTENTS FINISHINGREQUIREMENTS DOCUMENTATIONREQUIREMENTS PREPARATION SOURCES RESUME APPENDIX"} {
	prefix $rtfSpecial(PageBreak)
	rtf special
    }
    {element TITLEPAGE} {
	rtf special
	prefix {}
	startAction {
	    rtf:startSection	style_titlepage
	}
	endAction {
	    rtf:endSection
	    rtf:startSection	style_contents
	    TableOfContents
	    rtf:endSection
	}
    }
    {element "TITLEHEAD"} {
	rtf para
	prefix {}
	paraStyle style_TitleHead
    }
    {element "TITLEPART"} {
	rtf para
	prefix {}
	paraStyle style_TitlePart
    }
    {element "STARTDATE"} {
	rtf special
	startAction {
	    rtf:startPara style_TZ
	    rtf:text " "
	    rtf:endPara
	    rtf:startPara style_StartDate
	}
	prefix	"  "
	endAction {
	    rtf:endPara
	}
    }
    {element HEAD in ITEM1} {
	paraStyle style_Head1
    }
    {element HEAD in STAGES} {
	paraStyle style_Head1
    }
    {element HEAD in STAGECONTENT} {
	paraStyle style_Head1
    }
    {element HEAD in STAGEDOCUMENTS} {
	paraStyle style_Head1
    }
    {element HEAD in ITEM2} {
	paraStyle style_Head2
    }
    {element HEAD in ITEM3} {
	paraStyle style_Head3
    }
    {element HEAD in ITEM4} {
	paraStyle style_Head4
    }
    {element HEAD in TABLE} {
	paraStyle style_TableHead
	prefix	"$rtfSpecial(EnSpace)[query parent propval N].$rtfSpecial(EnSpace)"
	endAction {
	    withNode parent RtfStartTable
	}
    }
    {element HEAD} {
	rtf para
	paraStyle style_Head0
	prefix "[query parent propval N].$rtfSpecial(EnSpace)"
	startAction openHeadMark
	endAction closeHead
    }
    {elements "ITEM1 ITEM2 ITEM3 ITEM4"} {
	rtf special
	prefix {}
	startAction openItem
	endAction   closeItem
    }
    {elements "LIST ORDEREDLIST"} {
	rtf none
	prefix {}
    }
    {element LISTITEM in ORDEREDLIST} {
	prefix	"[expr 1 + [countq prev element LISTITEM]].$rtfSpecial(EnSpace)"
    }
    {element LISTITEM} {
	rtf para
	paraStyle style_List_Item[countListNest]
	prefix		"$rtfSpecial(Bullet)$rtfSpecial(EnSpace)"
    }
    {element QUOTE} {
	rtf special
	prefix $rtfSpecial(LDQuote)
	suffix $rtfSpecial(RDQuote)
    }
    {element PTR} {
	rtf special
	prefix	[doPointer]
    }
    {elements "COMPOSEPERSONS CONCORDANCEPERSONS"} {
	rtf special
	prefix {}
	startAction {
	    rtf:startPara style_backTitle
	    rtf:text [backTitle]
	    rtf:endPara
	    rtf:startTable -numcols 5 -colsep rule_Table_Col_Sep \
		-rowsep rule_Table_Row_Sep -frame rule_Table_Frame -headingrow 1
	    rtf:startRow
	    foreach col {1 2 3 4 5} {
		rtf:startCell style_Table_Cell
		rtf:startPhrase style_backTableHead
		global backTableHeads
		rtf:text $backTableHeads($col)
		rtf:endPhrase
		rtf:endCell
	    }
	    rtf:endRow
	}
	endAction rtf:endTable
    }
    {element PERSON} {
	rtf	special
	startAction rtf:startRow
	endAction {
	    # Two empty cells for signature and date
	    rtf:startCell style_Table_Cell
	    rtf:endCell
	    rtf:startCell style_Table_Cell
	    rtf:endCell
	    rtf:endRow
	}
	prefix	{}
    }	
    {elements "COMPANY TITLE"} {
	rtf	special
	startAction {
	    rtf:startCell style_Table_Cell
	    rtf:startPhrase style_Plain
	}
	endAction {
	    rtf:endPhrase
	    rtf:endCell
	}
	prefix		{}
    }
    {element LASTNAME} {
	rtf special
	startAction {
	    rtf:startCell style_Table_Cell
	    rtf:startPhrase style_Plain
	}
	suffix	" "
	prefix {}
    }
    {element FIRSTNAME} {
	rtf special
	suffix	" "
	prefix {}
    }
    {element MIDDLENAME} {
	rtf special
	endAction {
	    rtf:endPhrase
	    rtf:endCell
	}
	prefix {}
    }
    {element TABLE} {
	rtf	special
	startAction startTable
	endAction {
	    rtf:endTable
	}
	prefix	{}
    }
    {element ROW in TABLE} {
	rtf	special
	startAction rtf:startRow
	endAction rtf:endRow
	prefix	{}
    }
    {element CELL in ROW in TABLE} {
	rtf	special
	startAction {
	    rtf:startCell style_Table_Cell
	    rtf:startPhrase style_Plain
	}
	endAction {
	    rtf:endPhrase
	    rtf:endCell
	}
	prefix		{}
    }
    {element PARABREAK} {
	rtf		special
	prefix		{}
	before		"[rtf:special LineBreak]"
    }
    {el} {
	rtf none
	prefix	[openUnknown]
	cdataFilter textCdataFilter
	sdataFilter textSdataFilter
    }
}

proc startTable {} {
    withNode child element HEAD {
	return
    }
    RtfStartTable
}

proc RtfStartTable {} {
    rtf:startTable -numcols [countColumns] -colsep rule_Table_Col_Sep \
	-rowsep rule_Table_Frame -headingrow 1
}

proc countColumns {} {
    withNode child element ROW {
	return [countq child element CELL]
    }
    return 1
}

proc doPointer {} {
    set target [query attval TARGET]
    withNode doctree element TABLE withattval ID $target {
	return [query propval N]
    }
    
    withNode doctree withattval ID $target {
	return [query parent propval N]
    }
    
    Error "<PTR ID='${target}> points to nowhere!"
    return "?????"
}

proc main {} {
    rtf:start

    withNode docroot child el {
	CountThings
    }
    
    #FIXME
    withNode docroot child el {
	rtf:convert translate
    }
    rtf:end
    rtf:write "\n"
}

proc pageFooter {} {
    
}

proc pageHeader {} {
}

proc openItem {} {
    withNode child element HEAD {
	return
    }
    rtf:startPara style_[toLower [query gi]]
    global rtfSpecial
    rtf:write "[query propval N].$rtfSpecial(EnSpace)"
}

proc closeItem {} {
    withNode child element HEAD {
	return
    }
    
#    rtf:endPara
}

proc countListNest {} {
    set level 0
    foreachNode ancestor {
	set gi [query gi]
	foreach container {LIST ORDEREDLIST ITEM1 ITEM2 ITEM3 ITEM4 STAGES
	    STAGEDOCUMENTS STAGECONTENT ABSTRACT COMMONINFO GOAL CHARACTERISTICS
	    REQUIREMENTS CONTENTS FINISHINGREQUIREMENTS PREPARATION
	    DOCUMENTATIONREQUIREMENTS SOURCES RESUME APPENDIX} {
	    if { "$gi" == "$container" } {
		incr level
	    }
	}
    }
    return $level
}

proc TableOfContents {} {
    withNode docroot {
	rtf:convert generatetoc
    }
}

specification generatetoc {
    {element BODY} {
	rtf special
	startAction {
	    rtf:startPara style_Head1
	    rtf:write ""
	    rtf:endPara
	}
    }
    {element HEAD in COMMONINFO} {
	paraStyle style_TOC_1
    }
    {element HEAD in GOAL} {
	paraStyle style_TOC_1
    }
    {element HEAD in CHARACTERISTICS} {
	paraStyle style_TOC_1
    }
    {element HEAD in PREPARATION} {
	paraStyle style_TOC_1
    }
    {element HEAD in REQUIREMENTS} {
	paraStyle style_TOC_1
    }
    {element HEAD in CONTENTS} {
	paraStyle style_TOC_1
    }
    {element HEAD in FINISHINGREQUIREMENTS} {
	paraStyle style_TOC_1
    }
    {element HEAD in DOCUMENTATIONREQUIREMENTS} {
	paraStyle style_TOC_1
    }
    {element HEAD in SOURCES} {
	paraStyle style_TOC_1
    }
    {element HEAD in RESUME} {
	paraStyle style_TOC_1
    }
    {element HEAD in APPENDIX} {
	paraStyle style_TOC_1
    }
    {element HEAD in ITEM1} {
	paraStyle style_TOC_2
    }
    {element HEAD in ITEM2} {
	paraStyle style_TOC_3
    }
    {element HEAD in STAGES} {
	paraStyle style_TOC_2
    }
    {element HEAD in STAGECONTENT} {
	paraStyle style_TOC_2
    }
    {element HEAD in STAGEDOCUMENTS} {
	paraStyle style_TOC_2
    }
    {element HEAD in TABLE} {
	rtf special
	prefix	{}
	suffix	{}
	before {}
	after {}
	endAction {}
	cdataFilter null
	sdataFilter null
    }
    {element HEAD in ITEM3} {
	prefix	{}
	rtf special
	suffix	{}
	cdataFilter null
	sdataFilter null
	startAction {}
	endAction {}
	before {}
	after {}
    }
    {element HEAD in ITEM4} {
	prefix	{}
	rtf special
	suffix	{}
	cdataFilter null
	sdataFilter null
	startAction {}
	endAction {}
	before {}
	after {}
    }
    {element HEAD} {
	rtf para
	prefix [TOClinePrefix]
	cdataFilter textCdataFilter
	sdataFilter textSdataFilter
	endAction {
	    rtf:tab
	    withNode parent {
		PageRef [uniqueID]
	    }
	}
    }
    {el} {
	rtf none
	cdataFilter	null
	sdataFilter	null
	RE {}
	before {}
	after {}
	startAction {}
	endAction {}
    }
}

proc TOClinePrefix {} {
    set prefix [query parent propval N]
    if { "$prefix" == "" } {
	set prefix [expr 1 + [countq parent prev]]
    }
    global rtfSpecial
    return "${prefix}.$rtfSpecial(EnSpace)"
}

proc CountThings {} {
    if [string compare [query nodetype] "EL"] return
    global rtfSpecial
    switch -regexp [query gi] {
	"ITEM1" {
	    setprop N "[expr 1 + [countq parent prev]].[expr 1 + [countq prev element ITEM1]]"
	}
	"ITEM2" {
	    if { ![string compare [query parent gi] "ITEM1"] } {
		setprop N "[expr 1 + [countq parent parent prev]].[expr 1 + [countq parent prev element ITEM1]].[expr 1 + [countq prev element ITEM2]]"
	    } else {
		#  stages, stagedocuments, stagecontent  vvvvvvvvvvvvvvvvvvvv
		setprop N "[expr 1 + [countq parent parent prev]].[countq parent prev].[expr 1 + [countq prev element ITEM2]]"
	    }
	}
	"ITEM3" {
	    if { ![string compare [query parent parent gi] "ITEM1"] } {
		setprop N "[expr 1 + [countq parent parent parent prev]].[expr 1 + [countq parent parent prev element ITEM1]].[expr 1 + [countq parent prev element ITEM2]].[expr 1 + [countq prev element ITEM3]]"
	    } else {
	    #  stages, stagedocuments, stagecontent         vvvvvvvvvvvvvvvvvvvvvvvvvvv
		setprop N "[expr 1 + [countq parent parent parent prev]].[countq parent parent prev].[expr 1 + [countq parent prev element ITEM2]].[expr 1 + [countq parent prev element ITEM3]]"
	    }
	}
	"ITEM4" {
	    if { ![string compare [query parent parent parent gi] "ITEM1"] } {
		setprop N "[expr 1 + [countq parent parent parent parent prev]].[expr 1 + [countq parent parent parent prev element ITEM1]].[expr 1 + [countq parent parent prev element ITEM2]].[expr 1 + [countq parent prev element ITEM3]].[expr 1 + [countq prev element ITEM4]]"
	    } else {
	    #  stages, stagedocuments, stagecontent         vvvvvvvvvvvvvvvvvvvvvvvvvvv
		setprop N "[expr 1 + [countq parent parent parent parent prev]].[expr 1 + [countq parent parent parent prev]].[countq parent parent prev].[expr 1 + [countq parent prev element ITEM2]].[expr 1 + [countq parent prev element ITEM3]].[expr 1 + [countq parent prev element ITEM4]]"
	    }
	}
	"STAGES" {
	    setprop N "[expr 1 + [countq parent prev]].1"
	}
	"STAGECONTENT" {
	    setprop N "[expr 1 + [countq parent prev]].2"
	}
	"STAGEDOCUMENTS" {
	    setprop N "[expr 1 + [countq parent prev]].3"
	}
	"(ABSTRACT)|(COMMONINFO)|(GOAL)|(CHARACTERISTICS)|(REQUIREMENTS)|(CONTENTS)|(FINISHINGREQUIREMENTS)|(PREPARATION)|(DOCUMENTATIONREQUIREMENTS)|(SOURCES)|(RESUME)|(APPENDIX)" {
	    setprop N "[expr 1 + [countq prev]]"
	}
	"TABLE" {
	    global tableCounter
	    if { ![info exists tableCounter] } {
		set tableCounter 0
	    }
	    setprop N [incr tableCounter]
	}
    }
    foreachNode child el {
	CountThings
    }
}

rename textCdataFilter {}

proc textCdataFilter { text } {
    regsub -all -- "\[ \n\t\]+" $text " " text
    if [regexp "^\[ \n\t]+$" $text] {
	return
    } else {
	return $text
    }
}

proc closeHead {} {
    closeHeadMark

    #       ... -- BT.
    #    if { "[query next nodetype]" != "EL" } {
    #	rtf:startPara style_[toLower [query parent gi]]
    #    }
}

proc backTitle {} {
    switch -exact [query gi] {
	"COMPOSEPERSONS" {
	    return ""
	}
	"CONCORDANCEPERSONS" {
	    return ""
	}
	default {
	    Error "Bad gi for backTitle: [query gi]"
	    return "????????????????"
	}
    }
}
