# ===========================================================================
# File: convert.tcl
# Target: pmwiki
#                        Created: 2010-08-29 09:51:41
#              Last modification: 2013-12-23 17:34:51
# Author: Bernard Desgraupes
# e-mail: <bdesgraupes@users.sourceforge.net>
# (c) Copyright: Bernard Desgraupes 2010-2013
# All rights reserved.
# Description: Aida callbacks for target pmwiki
# ===========================================================================


namespace eval pmwiki {
	variable styleDepth 0

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


# Hooks
# -----

proc pmwiki::preConvertHook {} {}
proc pmwiki::postConvertHook {} {}

proc pmwiki::splitHook {file} {}


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


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::anchorProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::anchorProc {label} {
	set label [string trim $label "\"' "]
	return "\[\[#$label\]\]"
}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::commentProc" --
 # 
 # ------------------------------------------------------------------------
 ##

proc pmwiki::commentProc {str} {
	return "(:comment $str:)"
}



## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::horizRuleProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::horizRuleProc {} {
	return "----"
}


##
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::imageProc" --
 # 
 # See http://www.pmwiki.org/wiki/PmWiki/Images
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::imageProc {str attr} {
	set attrDict [aida::getAttr img $attr]
	set result ""
	set attributes [list]
	if {![catch {dict get $attrDict height} ht]} {
		lappend attributes "height=$ht"
	} 
	if {![catch {dict get $attrDict width} wd]} {
		lappend attributes "width=$wd"
	} 
	if {[llength $attributes]} {
		append result "%%[join $attributes " "]%%"
	} 
	append result [string trim $str]
	if {![catch {dict get $attrDict alt} txt]} {
		append result "\"$txt\""
	} 
	return $result
}


##
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::linkProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::linkProc {str url} {
	set str [string trim $str]
	if {$str eq ""} {
		return $url
	} else {
		return "\[\[$url| $str\]\]"
	} 
}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::listProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::listProc {kind depth attr itemList} {
	set attrDict [aida::getAttr $kind $attr]
	set block [list]

	set opt ""
	set marker "<@p@m@w@>"

	if {$kind eq "ol"} {
		if {![catch {dict get $attrDict type} tp]} {
			switch -- $tp {
				"a" {
					append opt "%alpha%"
				}
				"A" {
					append opt "%ALPHA%"
				}
				"i" {
					append opt "%roman%"
				}
				"I" {
					append opt "%ROMAN%"
				}
			}
		} 
		if {![catch {dict get $attrDict start} cnt]} {
			append opt "%item value=$cnt%"
		} 
	} 

	switch -- $kind {
		"ol" {
			set head "[string repeat "#" $depth] "
 
		}
		"ul" {
			set head "[string repeat "*" $depth] "
		}
		"dl" {
			if {$depth == 1} {
				set head " "
			} else {
				set head "[string repeat " " $depth] "
			} 
		}
	}

	for {set i 0} {$i < [llength $itemList]} {incr i} {
		set itm [lindex $itemList $i]
		if {$kind eq "dl"} {
			lappend block "$marker[string range $head 0 end-1]:[lindex $itm 0]:[pmwiki::_wrapListItem [string trimleft [lindex $itm 1]] $marker $i $opt $head]"
		} else {
			lappend block "[pmwiki::_wrapListItem $itm $marker $i $opt $head]"
		} 
	}
	
	set result [join $block "\n"]
	if {$depth == 1} {
		regsub -all "$marker" $result "" result
	} 
	return $result
}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::navBarProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::navBarProc {curr prev next top} {
	if {[aida::getParam NavBar]} {
		set result [list]
		
		if {$curr ne $top} {
			set top "[pmwiki::_pageName $top]"
			lappend result "\[\[$top| [aida::getParam NavTop]\]\]"		
		} 
		if {$prev ne ""} {
			set prev "[pmwiki::_pageName $prev]"
			lappend result "\[\[$prev| [aida::getParam NavPrev]\]\]"
		} 
		if {$next ne ""} {
			set next "[pmwiki::_pageName $next]"
			lappend result "\[\[$next| [aida::getParam NavNext]\]\]"
		} 

		return "[join $result " | "]\\\\\n\n"
	} else {
		return ""
	} 
}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::newLineProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::newLineProc {} {
	return "\n\n"
}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::postambleProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::postambleProc {} {}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::preambleProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::preambleProc {} {
	return [aida::addPreamble]
}


##
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::printIndexProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::printIndexProc {} {
	variable aida_head
	
	for {set idx 0} {$idx < [aida::countIndexMarks]} {incr idx} {
		lassign [aida::getIndexMark $idx] fl str
		incr countArr($str)
		set tag "\[\[${fl}#[aida::getParam IndexMark]${idx}| $countArr($str)\]\]"
		lappend indexArr($str) $tag			
	} 
	if {[info exists indexArr]} {
		foreach word [lsort -dict [array names indexArr]] {
			lappend result "* $word\t[join $indexArr($word) ", "]"
		} 
	} 

	return [join $result "\n"]
}


##
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::refProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::refProc {str label {file ""}} {
	set label [string trim $label "\"'"]
	set str [aida::unwrapText $str]
	set page [pmwiki::_pageName $file]
	return "\[\[$page#$label |[string trim $str]\]\]"
}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::sectionProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::sectionProc {str level {file ""}} {
	variable aida_head
	
	set prfx [string repeat "!" $level]
	set title [aida::newSectionNumber $level]
	append title [aida::unwrapText [string trim $str]]
	set sc [aida::setSectionMark $level [pmwiki::_pageName $file] $title]
	set label "\[\[#[aida::getParam SectionMark]$sc\]\]"

	return "$label\n$prfx $title"
}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::setIndexProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::setIndexProc {str {file ""}} {
	variable aida_head
	
	set idx [aida::setIndexMark [pmwiki::_pageName $file] $str]
	set mark "\[\[#[aida::getParam IndexMark]$idx\]\]"
	
	return $mark
}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::styleProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::styleProc {style begin} {
	global aida_unwrap
	variable styleDepth
	
	if {$begin} {
		incr styleDepth
	} else {
		incr styleDepth -1
	}
	# Pmwiki does not support style tags across lines, so temporarily turn
	# on line unwrapping: it has the effect of transforming the end-of-line
	# symbols to a space
	set aida_unwrap [expr {$styleDepth > 0}]

	switch -- $style {
		"i" {
			set macro "''"
		}
		"b" {
			set macro "'''"
		}
		"u" {
			if {$begin} {
				set macro "\{+"
			} else {
				set macro "+\}"
			} 
		}
		"y" {
			set macro "@@"
		}
	}
	return $macro
}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::tableProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::tableProc {attr rowList} {
	set tbl [list]
	set hsep "||"

	# Retrieve the attributes
	set attrDict [aida::getAttr table $attr]
	if {[dict size $attrDict] > 0} {
		lappend tbl "|| [aida::dictToAttrString $attrDict]"
	} 
	# Calc the max number of columns
	set ncol 0
	foreach row $rowList {
		set row [split $row "\t"]
		set len [llength $row]
		if {$len > $ncol} {
			set ncol $len 
		} 
	} 

	# Build the format list
	if {[catch {dict get $attrDict format} frmt]} {
		set frmt [string repeat "l" $ncol]
	} 
	regsub -all {\|} $frmt "" frmt
	set posList [split $frmt ""]
	
	# Build the table
	foreach row $rowList {
		set cidx 0
		set line "$hsep"
		foreach cell [split $row "\t"] {
			set cell [string trim $cell]
			set pos [lindex $posList $cidx]
			if {$pos eq ""} {set pos "c"} 
			append line "[pmwiki::_alignString $cell $pos]$hsep"
			incr cidx
		} 
		# Complete too short rows
		for {set i $cidx} {$i < $ncol} {incr i} {
			set cell ""
			set pos [lindex $posList $i]
			if {$pos eq ""} {set pos "c"} 
			append line "[pmwiki::_alignString $cell $pos]$hsep"
		}
		lappend tbl $line
	} 
	return [join $tbl "\n"]
}


##
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::tocProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::tocProc {} {
	variable aida_head

	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 "[string repeat "*" $lv] \[\[${fl}#[aida::getParam SectionMark]$sc| $title\]\]"
		} 
	} 
	return [join $result "\n"]
}


##
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::verbProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::verbProc {str} {
	return "\[@[aida::unwrapText $str]@\]"
}


##
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::verbatimProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::verbatimProc {str} {
	set txt [split $str "\r\n"]
	set result [list " \[="]
	foreach line $txt {
		lappend result " $line" 
	} 
	lappend result "=\]"
	return [join $result "\n"]
}



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


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::_alignString" --
 # 
 # Format a string within a cell. The 'where' argument can be: "l", "r",
 # "c" for left, right or center resp.
 # 
 # Examples:
 # pmwiki::alignString foobar l	-->	/foobar /
 # pmwiki::alignString foobar r	-->	/ foobar/
 # pmwiki::alignString foobar c	-->	/ foobar /
 # 
 # ------------------------------------------------------------------------
 ##

proc pmwiki::_alignString {str where} {
	switch -- $where {
		"l" {
			set res "$str "
		}
		"r" {
			set res " $str"
		}
		"c" {
			set res " $str "
		}
		default {
			error "unknown position specification '$where'"
		}
	}

	return $res
}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::_wrapListItem" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::_wrapListItem {item marker num {opt ""} {head ""}} {
	set result [list]
	set lines [split $item "\n"]
	set first [lindex $lines 0]
	if {$num == 0} {
		lappend result "$marker$head$opt$first"
	} else {
		lappend result "$marker$head$first"
	} 
	
	for {set i 1} {$i < [llength $lines]} {incr i} {
		set next [lindex $lines $i]
		if {![regexp "^$marker" $next]} {
			regsub {^[ \t]*} $next "$marker[string repeat " " [string length $head]]" next
		} 
		lappend result $next
	}
	
	return [join $result "\n"]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "pmwiki::_pageName" --
 # 
 # ------------------------------------------------------------------------
 ##
proc pmwiki::_pageName {file} {
	set ext [aida::getParam NavExtension]
	set result "[file root $file]$ext"
	
	return $result
}



