# ===========================================================================
# File: convert.tcl
# Target: man
#                        Created: 2010-08-29 09:51:41
#              Last modification: 2012-04-11 19:55:05
# Author: Bernard Desgraupes
# e-mail: <bdesgraupes@users.sourceforge.net>
# (c) Copyright: Bernard Desgraupes 2010-2012
# All rights reserved.
# Description: Aida callbacks for target man
# ===========================================================================


namespace eval man {

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


# Hooks
# -----

proc man::preConvertHook {} {}
proc man::splitHook {file} {}


## 
 # ------------------------------------------------------------------------
 # 
 # "man::postConvertHook" --
 # 
 # Eliminate the empty lines from the output file
 # 
 # ------------------------------------------------------------------------
 ##
proc man::postConvertHook {} {
	global aida_temp aida_output

	if {![aida::splitting] } {
		if {$aida_output ne ""} {
			set outname $aida_output
		} else {
			set outname [aida::makeOutputName]
		} 
		
		set destDir [aida::buildDestDir]	
		set outfile [file normalize [file join $destDir $outname]]
		set tempfile [file join $aida_temp aidatemp_man]
		if {[file exists $outfile]} {
			set iid [open $outfile]
			set oid [open $tempfile w+]
			fconfigure $iid -encoding binary
			fconfigure $oid -encoding binary
			while {![eof $iid]} {
				if {[gets $iid line] > 0 || [regexp {^ +$} $line]} {
					puts $oid $line
				} 
			}
			close $oid
			close $iid
			file copy -force $tempfile $outfile
		} 		
	} 
	return
}


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

## 
 # ------------------------------------------------------------------------
 # 
 # "man::anchorProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::anchorProc {label} {
	return "\n.Bq Li [aida::getRefMark $label]\n"
}


## 
 # ------------------------------------------------------------------------
 # 
 # "man::commentProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::commentProc {str} {
	return ".\\\" $str"
}


## 
 # ------------------------------------------------------------------------
 # 
 # "man::horizRuleProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::horizRuleProc {} {
	return ".Pp\n\\l'70\\(ul'\n.Pp"
}


##
 # ------------------------------------------------------------------------
 # 
 # "man::imageProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::imageProc {str attr} {
	set attrDict [aida::getAttr img $attr]
	if {[catch {dict get $attrDict alt} txt]} {
		set txt "image: $str" 
	} 
	return "\n.Bq [aida::unwrapText [string trim $txt]]"
}


##
 # ------------------------------------------------------------------------
 # 
 # "man::linkProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::linkProc {str url} {
	return "[string trim $str]\n.Aq Pa $url\n"
}


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

	if {[catch {dict get $attrDict start} cnt]} {
		set cnt 1
	} 
	if {[catch {dict get $attrDict type} tp]} {
		set tp "1"
	} 

	switch -- $kind {
		"ol" {
			if {$cnt == 1} {
				set autonum 1
				set opt "-enum"
			} else {
				set autonum 0
				set opt "-item"
			} 
		}
		"ul" {
			if {$tp eq "disc"} {
				set opt "-bullet"
			} elseif {$tp eq ""} {
				set opt "-item"
			} else  {
				# circle and square turn out as dashes
				set opt "-dash"
			} 
		}
		"dl" {
			set opt "-ohang"
		}
	}

	lappend block ".Bl $opt -compact"
	foreach itm $itemList {
		if {$kind eq "dl"} {
			# Fix warning from mdoc: 
			#    ".It macros in lists of type 'ohang-list' require
			#    arguments"
			regsub -all {[\n\r]} [lindex $itm 0] " " entry
			regsub -all {(\.Bf|\.Ef)} $entry "" entry
			lappend block ".It $entry\n[man::_trimText [lindex $itm 1]]\n.Pp"
		} elseif {$kind eq "ol"} {
			if {$autonum} {
				lappend block ".It\n[man::_trimText $itm]"
			} else {
				lappend block ".It\n$cnt. [man::_trimText $itm]"
				incr cnt
			} 
		} else {
			lappend block ".It\n[man::_trimText $itm]"
		} 
	} 
	lappend block ".El"
	
	set result [join $block "\n"]

	return $result
}


## 
 # ------------------------------------------------------------------------
 # 
 # "man::navBarProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::navBarProc {curr prev next top} {
	return ""
}


## 
 # ------------------------------------------------------------------------
 # 
 # "man::newLineProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::newLineProc {} {
	return ".Pp\n"
}


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


## 
 # ------------------------------------------------------------------------
 # 
 # "man::preambleProc" --
 # 
 # The first items in the template are the commands `.Dd', `.Os', and
 # `.Dt'; the document date, the operating system the man page or subject
 # source is developed or modified for, and the man page title (in upper
 # case) along with the section of the manual the page belongs in. These
 # commands identify the page and are discussed below in TITLE MACROS.
 #
 #     .Dd [<month> <day>, <year>]
 #     .Dt [<document title>] [<section number>] [<volume>]
 #     .Os [<operating system>] [<release>]
 # 
 # ------------------------------------------------------------------------
 ##
proc man::preambleProc {} {
	global aida_name
	
	set result [list]
	
	set sec [aida::getParam ManSection]
	set title [aida::getParam Title man]
	if {$title eq ""} {
		set title [file root [file tail $aida_name]]
	} 
	set title [string toupper $title]
	set system [aida::getParam ManSystem]
	set volume [aida::getParam ManVolume]
	if {$system eq ""} {
		set system $title
	} 
	set date [clock format [clock seconds] -format "%b %d, %Y"]

	lappend result ".de uline"
	lappend result "\\Z'\\\\\$1'\\v'.25m'\\D'l \\w'\\\\\$1'u 0'\\v'-.25m'\n.."
	lappend result ".Dd $date"
	lappend result ".Dt $title \\&$sec \"$volume\""
	lappend result ".Os \"$system\"\n"
	
	# Finally look for preamble data
	set result [concat $result [aida::addPreamble]] 

	return [join $result "\n"]
}


##
 # ------------------------------------------------------------------------
 # 
 # "man::printIndexProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::printIndexProc {} {
	
	set numidx [aida::getParam NumberIndices]
	set result [list] 
	set wd 0
	lappend result ".Sh Index"
	for {set idx 0} {$idx < [aida::countIndexMarks]} {incr idx} {
		lassign [aida::getIndexMark $idx] fl str
		if {$wd < [string length $str]} {
			set wd [string length $str]
		} 
		if {[info exist indexArr($str)]} {
			if {$numidx} {
				lappend indexArr($str) "($idx)"
			} 
		} else {
			set indexArr($str) "($idx)"
		} 
	} 
	if {[info exists indexArr]} {
		lappend result ".Bl -column [string repeat X $wd] -compact"
		foreach idx [lsort -dict [array names indexArr]] {
			if {$numidx} {
				lappend result ".It $idx Ta [join $indexArr($idx) ", "]"
			} else {
				lappend result ".It $idx"
			} 
		} 
		lappend result ".El"
	} 
	return [join $result "\n"]
}


##
 # ------------------------------------------------------------------------
 # 
 # "man::refProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::refProc {str label {file ""}} {
	if {$file eq ""} {
		return "[string trim $str]\n.Bq Li [aida::getRefMark $label]\n"
	} else {
		return "[string trim $str]\n.Bq Li [aida::getRefMark $label]\n([file root $file])\n"
	} 
}


## 
 # ------------------------------------------------------------------------
 # 
 # "man::sectionProc" --
 # 
 # A man page has only two section levels. The proc maps level one to the
 # .Sh macro and the others to the .Ss macro.
 # 
 # ------------------------------------------------------------------------
 ##
proc man::sectionProc {str level {file ""}} {
	set title [aida::newSectionNumber $level]
	append title [aida::unwrapText [string trim $str]]
	aida::setSectionMark $level $file $title
	

	if {$level == 1} {
		set result ".Sh $title"
	} else {
		set result ".Ss $title"
	} 
	return $result
}


## 
 # ------------------------------------------------------------------------
 # 
 # "man::setIndexProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::setIndexProc {str {file ""}} {
	set str [string trim $str]
	set idx [aida::setIndexMark $file $str]
	if {[aida::getParam NumberIndices]} {
		set mark "($idx)"
	} else {
		set mark ""
	} 		
	return $mark
}


## 
 # ------------------------------------------------------------------------
 # 
 # "man::styleProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::styleProc {style begin} {
	set macro ""
	set fntstyle 0
	if {[catch {aida::getParam FontStyle man} res]} {
		set fntstyle $res
	}
	
	if {$fntstyle} {
		if {$begin} {
			switch -- $style {
				"i" - "u" {
					set macro "\n.Bf Em\n"
				}
				"b" {
					set macro "\n.Bf Sy\n"
				}
				"y" {
					set macro "\n.Bf Li\n"
				}
			}
		} else {
			set macro "\n.Ef\n"
		}
	} else {
		return [base::styleProc $style $begin]
	} 
		
	return $macro
}


## 
 # ------------------------------------------------------------------------
 # 
 # "man::tableProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::tableProc {attr rowList} {
	set result [list]
	
	set attrDict [aida::getAttr table $attr]
	if {[catch {dict get $attrDict align} dir]} {
		set dir "left"
	}
	lappend result ".Bd -literal -offset $dir -compact"
	lappend result [join [base::_buildTableRows $attr $rowList] "\n"]
	lappend result ".Ed\n"
	return [join $result "\n"]
}


##
 # ------------------------------------------------------------------------
 # 
 # "man::tocProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::tocProc {} {

	set result [list]
	set depth [aida::getParam TocDepth]
	
	lappend result ".Bl -column XXXX -compact"
	for {set sc 0} {$sc < [aida::countSectionMarks]} {incr sc} {
		lassign [aida::getSectionMark $sc] lv fl title
		if {$lv <= $depth} {
			lappend result ".It \"[string repeat "  " $lv]$title"
		} 
	} 
	lappend result ".El"
	return [join $result "\n"]
}


##
 # ------------------------------------------------------------------------
 # 
 # "man::verbProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::verbProc {str} {
	return "`$str'"
}


## 
 # ------------------------------------------------------------------------
 # 
 # "man::verbatimProc" --
 # 
 # ------------------------------------------------------------------------
 ##
proc man::verbatimProc {str} {
	set result [list]
	lappend result ".Bd -literal -offset indent -compact"
	lappend result $str
	lappend result ".Ed"
	return [join $result "\n"]
}



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


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


##
 # ------------------------------------------------------------------------
 # 
 # "man::_trimText" --
 # 
 # This proc trims any spaces at the beginning of a line in order to align
 # the text on the left margin.
 # 
 # ------------------------------------------------------------------------
 ##
proc man::_trimText {txt} {
	regsub -all {[\n\r][ \t]+} $txt "\n" txt
	return $txt
}

