# ===========================================================================
# File: convert.tcl
# Target: html
#                        Created: 2010-08-29 09:51:41
#              Last modification: 2016-10-04 18:50:27
# Author: Bernard Desgraupes
# e-mail: <bdesgraupes@users.sourceforge.net>
# Copyright (c) 2010-2016 Bernard Desgraupes
# All rights reserved.
# Description: Aida callbacks for target html
# ===========================================================================


namespace eval html {
	variable toc_levels
	variable toc_curr

	# Ensure fallback on base commands
	namespace path ::base
	
}


# Hooks
# -----

proc html::preConvertHook {} {}

proc html::postConvertHook {} {}

proc html::splitHook {file} {}


# Callbacks
# ---------

##
 # ------------------------------------------------------------------------
 # 
 # "html::anchorProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::anchorProc {label} {
	set label [string trim $label "\"' "]
	return "<A NAME=\"$label\"/>"
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::commentProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::commentProc {str} {
	return "<!-- $str -->"
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::horizRuleProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::horizRuleProc {} {
	return "<HR/>"
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::imageProc" --
 # 
 # Build an <IMG> tag for the image.
 # 
 # ------------------------------------------------------------------------
 ##
proc html::imageProc {str attr} {
	set attrDict [aida::getAttr img $attr]
	set str [string trim $str "\"' "]
	return "<IMG SRC=\"[string trim $str]\"[aida::dictToAttrString $attrDict]/>"
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::linkProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::linkProc {str url} {
	set url [string trim $url "\"' "]
	set str [string trim $str]
	if {$str eq ""} {
		set str $url
	} 
	return "<A HREF=\"$url\">[string trim $str]</A>"
}


## 
 # ------------------------------------------------------------------------
 # 
 # "html::listProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::listProc {kind depth attr itemList} {
	set attrDict [aida::getAttr $kind $attr]
	set tag [string toupper $kind]
	set block [list]
	lappend block "<$tag[aida::dictToAttrString $attrDict]>"

	foreach itm $itemList {
		if {$kind eq "dl"} {
			lappend block "\t<DT>[lindex $itm 0]</DT>\n\t<DD>[lindex $itm 1]</DD>"
		} else {
			lappend block "\t<LI>$itm</LI>"
		} 		
	} 
	lappend block "</$tag>"
	
	return [join $block "\n"]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "html::navBarProc" --
 # 
 # The name of the navigation links is parameterizable via the NavTop,
 # NavPrev, and NavNext header parameters.
 # 
 # ------------------------------------------------------------------------
 ##
proc html::navBarProc {curr prev next top} {
	if {[aida::getParam NavBar]} {
		set result [list]
		if {$curr ne $top} {
			lappend result "<A href=\"$top\">[aida::getParam NavTop]</A>"		
		} 
		if {$prev ne ""} {
			lappend result "<A href=\"$prev\">[aida::getParam NavPrev]</A>"
		} 
		if {$next ne ""} {
			lappend result "<A href=\"$next\">[aida::getParam NavNext]</A>"
		} 

		return "[join $result "&nbsp;|&nbsp;"]<BR/>"		
	} else {
		return ""
	} 
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::newLineProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::newLineProc {} {
	return "<BR/>"
}


## 
 # ------------------------------------------------------------------------
 # 
 # "html::postambleProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::postambleProc {} {
	set str "\n</BODY>\n</HTML>\n"
	return $str
}


## 
 # ------------------------------------------------------------------------
 # 
 # "html::preambleProc" --
 # 
 # This proc looks for additional contents (like meta tags, etc.) to insert
 # the header. This can be done via
 #    * a user-defined proc named [html::addHeader] 
 #    * a AddHeader parameter whose value is a string
 #    * a Preamble parameter whose value is a file
 # 
 # ------------------------------------------------------------------------
 ##
proc html::preambleProc {} {
	set result "<HTML>\n<HEAD>"
	if {![catch {aida::getParam Title} title]} {
		lappend result "<TITLE>$title</TITLE>"
	} 
	# Create a charset META tag
	if {[catch {aida::getParam Charset html} cset]} {
		set cset [aida::outputEncoding]
	} 
	lappend result "<META HTTP-EQUIV=\"content-type\" CONTENT=\"text/html;charset=$cset\">"
	
	# Finally look for preamble data
	set result [concat $result [aida::addPreamble]] 
	
	lappend result "</HEAD>\n<BODY>\n"
	return [join $result "\n"]
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::printIndexProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::printIndexProc {} {
	variable aida_head
	
	set result [list "<UL>"]
	for {set idx 0} {$idx < [aida::countIndexMarks]} {incr idx} {
		lassign [aida::getIndexMark $idx] fl str
		incr countArr($str)
		
		set tag "<A href=\"$fl#[aida::getParam IndexMark]${idx}\">$countArr($str)</A>"
		lappend indexArr($str) $tag			
	} 
	if {[info exists indexArr]} {
		foreach word [lsort -dict [array names indexArr]] {
			lappend result "<LI>$word\t[join $indexArr($word) ", "]</LI>"
		} 
	} 
	lappend result "</UL>"
	return [join $result "\n"]
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::refProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::refProc {str label {file ""}} {
	set label [string trim $label "\"'"]
	return "<A HREF=\"${file}#${label}\">[string trim $str]</A>"
}


## 
 # ------------------------------------------------------------------------
 # 
 # "html::sectionProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::sectionProc {str level {file ""}} {
	variable aida_head

	set title [aida::newSectionNumber $level]
	append title [string trim $str]
	set sc [aida::setSectionMark $level $file $title]
	set mark "<A NAME=\"[aida::getParam SectionMark]$sc\"/>"
	
	return "<H$level>$mark$title</H$level>"
}


## 
 # ------------------------------------------------------------------------
 # 
 # "html::setIndexProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::setIndexProc {str {file ""}} {
	variable aida_head
	
	set idx [aida::setIndexMark $file $str]
	set mark "<A NAME=\"[aida::getParam IndexMark]$idx\"/>"
	return $mark
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::styleProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::styleProc {style begin} {
	if {$style eq "y"} {
		set style "tt"
	} 
	set tag [string toupper $style]
	if {$begin} {
		return "<$tag>"
	} else {
		return "</$tag>"
	} 
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::tableProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::tableProc {attr rowList} {
	set attrDict [aida::getAttr table $attr]

	if {[catch {dict get $attrDict format} frmt]} {
		set frmt "" 
	} else {
		set attrDict [dict remove $attrDict format]
	}
	
	regsub -all {\|} $frmt "" posList
	set posList [split $posList ""]

	set tbl [list]
	lappend tbl "<TABLE[aida::dictToAttrString $attrDict]>"
	foreach row $rowList {
		set row [split $row "\t"]
		set line "<TR>"
		set cnt 0
		foreach cell $row {
			set pos [lindex $posList $cnt]
			switch -- $pos {
				"l" {
					 set otag "TD align=left"
				}
				"r" {
					 set otag "TD align=right"
				}
				"c" {
					set otag "TD align=center"
				}
				default {
					set otag "TD"
				}
			}
			append line "<$otag>$cell</TD>"
			incr cnt
		} 
		append line "</TR>"
		lappend tbl $line
	} 
	lappend tbl "</TABLE>"

	return [join $tbl "\n"]
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::tocProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::tocProc {} {
	variable aida_head
	variable toc_levels
	variable toc_curr

	set toc_levels [list]
	set toc_curr 0
	set result [list]
	set depth [aida::getParam TocDepth]
	
	for {set sc 0} {$sc < [aida::countSectionMarks]} {incr sc} {
		lassign [aida::getSectionMark $sc] lv fl title
		if {$lv <= $depth} {
			lappend result [html::_changeTocLevel $lv]
			lappend result "<A href=\"$fl#[aida::getParam SectionMark]$sc\">$title</A>"
		} 
	} 
	lappend result [html::_changeTocLevel 0]
	return [join $result "\n"]
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::verbProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::verbProc {str} {
	return "<CODE>$str</CODE>"
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::verbatimProc" --
 # 
 # (vs 1.4.2) Convert opening "<" to avoid interpretation of html tags by
 # browsers in PRE blocks. This is controlled by the :EscapeVerbatim:
 # header parameter . The default value is 1. To turn this off, include the
 # following in the preamble of the aida file:
 #     :EscapeVerbatim:html:     0
 # 
 # ------------------------------------------------------------------------
 ##
proc html::verbatimProc {str} {
	variable aida_head
	if {$aida_head(EscapeVerbatim)} {
		regsub -all "<" $str "\\&lt;" str
	} 
	return "<PRE>$str</PRE>"
}


# Target specific utility procs
# =============================

##
 # ------------------------------------------------------------------------
 # 
 # "html::defaultExtension" --
 # 
 # ------------------------------------------------------------------------
 ##
proc html::defaultExtension {} {
	if {[catch {aida::getParam Extension html} result]} {
		set result ".html"
	} 
	return $result
}


##
 # ------------------------------------------------------------------------
 # 
 # "html::_changeTocLevel" --
 # 
 # This proc maintains a global list $toc_levels of previous inferior
 # levels which increases when a deeper element is inserted and decreases
 # as the level becomes smaller. The $toc_curr variable keeps track of the
 # last visited level before switching to $new.
 # 
 # ------------------------------------------------------------------------
 ##
proc html::_changeTocLevel {new} {
	variable toc_levels
	variable toc_curr
	
	# Get the current inferior
	set inf [lindex $toc_levels end]

	if {$new > $toc_curr} {
		set result "[string repeat "<UL>" [expr {$new - $toc_curr}]]<LI>"
		if {$toc_curr > $inf} {
			lappend toc_levels $toc_curr
		} 
	} elseif {$new < $toc_curr} {
		if {$new > $inf} {
			set result "</LI>[string repeat "</UL>" [expr {$toc_curr - $inf}]]"
			append result "[string repeat "<UL>" [expr {$new - $inf}]]<LI>"
		} elseif {$new == $inf} {
			set result "</LI>[string repeat "</UL>" [expr {$toc_curr - $new}]]"
			if {$inf > 0} {
				append result "</LI><LI>"
			} else {
				set toc_levels [lreplace $toc_levels end end]
			}
		} else {
			set result "</LI>[string repeat "</UL>" [expr {$toc_curr - $inf}]]"
			append result "[string repeat "</LI></UL>" [expr {$inf - $new}]]"
			if {$new > 0} {
				append result "</LI><LI>"
			} 
			# Reduce the stack of inferiors
			while {$inf >= $new} {
				set toc_levels [lreplace $toc_levels end end]
				set inf [lindex $toc_levels end]
			}
		} 
	} else {
		set result "</LI><LI>"
	} 
	set toc_curr $new

	return $result
}



