# ===========================================================================
# File: utils.tcl
#                        Created: 2010-09-08 07:27:55
#              Last modification: 2015-12-29 11:44:22
# Author: Bernard Desgraupes
# e-mail: <bdesgraupes@users.sourceforge.net>
# Copyright (c) 2010-2015 Bernard Desgraupes
# All rights reserved.
# Description: default Aida settings
# ===========================================================================

namespace eval aida {
	variable ref_count 0
	variable ref_marks
	
	variable section_count 0 
	variable section_marks
	variable section_level
	variable section_file

	variable index_count 0 
	variable index_marks
	variable index_file

	# Initialize the section numbers array
	variable section_num
	for {set i 1} {$i <= 6} {incr i} {
		set section_num($i) 0
	}
}



## 
 # ------------------------------------------------------------------------
 # 
 # "aida::getAttr" --
 # 
 # Get the attributes passed with a tag. Return a Tcl dict of key/value
 # pairs.
 # 
 # Default values for this dictionary can be set in the aida_attr dict
 # defined in the global or the target specific default.tcl file.
 # Attributes passed with the tag override values set in the default.tcl
 # files.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getAttr {tag attr} {
	global aida_attr
	
	set attrDict $attr
	# Merge with defaults
	if {[dict exists $aida_attr $tag]} {
		set attrDict [dict merge [dict get $aida_attr $tag] $attr]
	} 
	
	return $attrDict
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::getParam" --
 # 
 # Get the value of a parameter. If a target specific setting exists, return
 # its value, otherwise try to get a global setting. 
 # 
 # The 'target' argument is optional: if it is not specified, the current
 # target is assumed and, if a target specific setting does not exist, try
 # to get a global setting instead. If it is set to the empty string, only
 # global settings are looked for. If it is explicitely set to a target,
 # only settings for this target are looked for.
 # 
 # Examples:
 #    aida::getParam foo        -> look for target-specific foo or global foo
 #    aida::getParam foo  ""    -> look only for global foo
 #    aida::getParam foo  html  -> look only for html-specific foo
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getParam {key {target 0}} {
	global aida_target
	
	if {$target == 0} {
		set trgt $aida_target
	} else {
		set trgt $target
	}
	set errMsg "can't find value for key '$key'"

	if {$trgt ne ""} {
		if {[info exists ::${trgt}::aida_head($key)]} {
			return [set ::${trgt}::aida_head($key)]
		} elseif {$target != 0} {
			aida::verbose 3 "$errMsg in ${trgt} namespace"
			error $errMsg
		} 
	} 
	
	if {$trgt eq "" || $target == 0} {
		global aida_head
		if {[info exists aida_head($key)]} {
			return [set aida_head($key)]
		} else {
			aida::verbose 3 "$errMsg in global scope"
			error $errMsg
		}
	} 
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::setParam" --
 # 
 # Set the value of a parameter.
 # 
 # The 'target' argument is optional: if it is not specified, the current
 # target is assumed. If it is set to the empty string, only global
 # settings are looked for.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::setParam {key val {target 0}} {
	global aida_target
	
	if {$target == 0} {
		set target $aida_target
	} 
	if {$target ne ""} {
		set ::${target}::aida_head($key) $val
		aida::verbose 3 "setting $target specific param '$key' to value '$val'"
	} else {
		global aida_head
		set aida_head($key) $val
		aida::verbose 3 "setting global param '$key' to value '$val'"
	} 
	return
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::appendParam" --
 # 
 # Append the value of a parameter.
 # 
 # The 'target' argument is optional: if it is not specified, the current
 # target is assumed. If it is set to the empty string, only global
 # settings are looked for.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::appendParam {key val {target 0}} {
	global aida_target
	
	if {$target == 0} {
		set target $aida_target
	} 
	if {$target ne ""} {
		lappend ::${target}::aida_head($key) $val
		aida::verbose 3 "setting $target specific param '$key' to value '$val'"
	} else {
		global aida_head
		lappend aida_head($key) $val
		aida::verbose 3 "setting global param '$key' to value '$val'"
	} 
	return
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::wrapText" --
 # 
 # Split a chunk of text in several paragraphs and reformat them wrt the
 # page width.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::wrapText {txt {indent ""} {target 0}} {
	return [aida::_processParagraphs "wrap" $txt $indent $target]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::unwrapText" --
 # 
 # Split a chunk of text in several paragraphs and reformat them on a
 # single line.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::unwrapText {txt {indent ""} {target 0}} {
	return [aida::_processParagraphs "unwrap" $txt $indent $target]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::_processParagraphs" --
 # 
 # Split a chunk of text in several paragraphs and apply an action to each
 # of them. A paragraph is delimited by a double end of line.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::_processParagraphs {action txt {indent ""} {target 0}} {
	# Find limits of paragraphs
	set lims [regexp -all -indices -inline {[\n\r]{2,}} $txt]
	set nbPar [llength $lims]
	if {$nbPar == 0} {
		return [aida::_${action}OneParagraph $txt $indent $target]
	} else {
		for {set i 0} {$i <= $nbPar} {incr i} {
			if {$i == 0} {
				set start 0 
				set end [lindex $lims 0 0]
			} elseif {$i == $nbPar} {
				set start [lindex $lims [expr $i-1] 1]
				set end [string length $txt]
			} else {
				set start [lindex $lims [expr $i-1] 1]
				set end [lindex $lims $i 0]
			}
			lappend result [aida::_${action}OneParagraph [string range $txt $start $end] $indent $target]
		}
	}
	
	return [join $result "\n\n"]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::_wrapOneParagraph" --
 # 
 # Reformat a paragraph so that the length of each line does not exceed the
 # page width (specified via the PageWidth header parameter). If a very
 # long word is longer than the page width, it will occupy a line on its
 # own.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::_wrapOneParagraph {txt {indent ""} {target 0}} {
	global aida_head aida_target
	
	set pgwd [aida::getParam PageWidth $target]
	regsub -all {[\n\r]} $txt " " txt
	regsub -all "  +" $txt " " txt
	set txt [string trim $txt]
	set txt [split $txt " "]
	set len [llength $txt]
	set indlen [string length $indent]
	set result [list]
	set idx 0
	set line $indent

	while {$idx < $len} {
		set word [lindex $txt $idx]
		set wordlen [string length $word]
		set linelen [string length $line]
		if {$line eq $indent && $wordlen >= $pgwd} {
			lappend result $word
		} elseif {[expr {$linelen + $wordlen}] < $pgwd} {
			append line "$word "
		} else {
			lappend result $line
			set line "$indent$word "
		} 
		incr idx
	}
	if {$line ne ""} {
		lappend result $line
	} 
	
	return [join $result "\n"]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::_unwrapOneParagraph" --
 # 
 # Reformat a paragraph on a single line
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::_unwrapOneParagraph {txt {indent ""} {target 0}} {	
	regsub -all {[\n\r\t]} $txt " " txt
	regsub -all "  +" $txt " " txt
	return [string trim $txt]
}


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

proc aida::alignString {str width where} {
	switch -- $where {
		"l" {
			set res [format "%-${width}s" $str]	
		}
		"r" {
			set res [format "%+${width}s" $str]	
		}
		"c" {
			set len [string length $str]
			set lsp [expr {($width - $len)/2}]
			set res [format "%-${width}s" "[string repeat " " $lsp]$str"]
		}
		default {
			error "unknown position specification '$where'"
		}
	}

	return $res
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::dictToAttrString" --
 # 
 # Rebuild an attributes string from the attr dictionary.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::dictToAttrString {attr} {
	set result ""
	foreach k [dict keys $attr] {
		set val [dict get $attr $k]
		if {![regexp {[\"'\s]} $val]} {
			set delim ""
		} elseif {[regexp {'} $val]} {
			set delim "\""
		} else  {
			set delim "'"
		} 
		append result " $k=$delim[dict get $attr $k]$delim"
	} 

	return $result
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::_sectionNumbers" --
 # 
 # Take care of maintaining the hierarchical sections numbering. Return a
 # list of elements to build the current number at the specified level.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::_sectionNumbers {level} {
	variable section_num

	incr section_num($level)
	for {set i [expr {$level + 1}]} {$i <= 6} {incr i} {
		set section_num($i) 0
	}
	set result [list "$section_num(1)"]
	for {set i 2} {$i <= $level} {incr i} {
		lappend result "$section_num($i)"
	}
	
	return $result
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::newSectionNumber" --
 # 
 # Return the numbering of a new section.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::newSectionNumber {level {target 0}} {
	set numsecs [aida::getParam NumberSections $target]
	if {$numsecs == 0} {
		return ""
	} 
	
	set secdepth [aida::getParam SectionDepth $target]
	if {$level > $secdepth} {
		return ""
	} else {
		set nums [aida::_sectionNumbers $level]
		return "[join $nums "."] "
	}
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::getRefMark" --
 # 
 # Numbering of references and anchors is controlled via the NumberRefs
 # parameter: if it is set to 0, the labels are not converted to numbers.
 # Otherwise, convert a reference label to a unique number and return the
 # number. It is called by both [anchorProc] and [refProc]. When the mark
 # number does not exist yet, it is created, otherwise just return its
 # value.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getRefMark {label} {
	variable ref_count
	variable ref_marks
	
	set label [string trim $label " '\""]
	set numref [aida::getParam NumberRefs]
	if {$numref} {
		if {![info exists ref_marks($label)]} {
			set ref_marks($label) [incr ref_count]
		} 
		return $ref_marks($label)
	} else {
		return $label
	} 
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::setSectionMark" --
 # 
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::setSectionMark {level file title} {
	variable section_count
	variable section_marks
	variable section_level
	variable section_file

	set sc $section_count
	incr section_count
	set section_level($sc) $level
	set section_file($sc) $file
	set section_marks($sc) $title
	
	return $sc
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::getSectionMark" --
 # 
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getSectionMark {index} {
	variable section_marks
	variable section_level
	variable section_file

	return [list $section_level($index) $section_file($index) $section_marks($index)]
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::countSectionMarks" --
 # 
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::countSectionMarks {} {
	variable section_count
	return $section_count
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::setIndexMark" --
 # 
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::setIndexMark {file str} {
	variable index_count
	variable index_marks
	variable index_file

	set str [string trim $str]
	regsub -all {\s+} $str " " str 
	set idx $index_count
	incr index_count
	set index_file($idx) $file
	set index_marks($idx) $str
	
	return $idx
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::getIndexMark" --
 # 
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getIndexMark {index} {
	variable index_marks
	variable index_file

	return [list $index_file($index) $index_marks($index)]
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::countIndexMarks" --
 # 
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::countIndexMarks {} {
	variable index_count
	return $index_count
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::applyCharMapping" --
 # 
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::applyCharMapping {str} {
	global aida_map
	set result $str
	if {[info exists aida_map]} {
		set result [string map [array get aida_map] $str]
	} 
	return $result
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::resolvePath" --
 # 
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::resolvePath {name} {
	if {[file pathtype $name] eq "absolute"} {
		set path $name
	} else {
		set base [aida::getDirname]
		set path [file normalize [file join $base $name]]
	}
	return $path
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::getFileContents" --
 # 
 # Read the contents of a file in the input encoding.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getFileContents {name} {
	set result ""
	set path [aida::resolvePath $name]
	if {[file exists $path]} {
		set ienc [aida::inputEncoding]
		set fid [open $path "r"]
		fconfigure $fid -encoding $ienc
		set result [read $fid]
		close $fid
	} else {
		error "can't find file $path"
	}
	
	return $result
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::getTargetDirs" --
 # 
 # Get a list of the target directories found on the aida_path.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getTargetDirs {} {
	global aida_path
	
	set dirList [list]

	foreach subdir $aida_path {
		aida::verbose 3 "looking for targets in $subdir"
		set dirList [concat $dirList [glob -nocomplain -type d -dir $subdir *]]
	} 	
	
	return $dirList
}


##
 # ------------------------------------------------------------------------
 # 
 # "aida::addPreamble" --
 # 
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::addPreamble {{target ""}} {
	global aida_target
	
	if {$target eq ""} {
		set trgt $aida_target
	} else {
		set trgt $target
	}
	set result [list]
	# Look for a Preamble parameter
	if {![catch {aida::getParam Preamble $trgt} preamFile]} {
		lappend result [aida::getFileContents $preamFile]
	} 
	# Look for AddHeader parameters
	if {![catch {aida::getParam AddHeader} addL]} {
		set result [concat $result $addL]
	}
	# Look for a <target>::addHeader proc
	if {[namespace eval ::${trgt} [list namespace which addHeader]] ne ""} {
		set result [concat $result [namespace eval ::${trgt} [list addHeader]]]
	} 
	return $result
}

