# ===========================================================================
# File: core.tcl
#                        Created: 2010-08-29 09:51:41
#              Last modification: 2015-12-29 11:44:36
# 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 {
	# This variable is queried by the core function aida_checkRequired()
	variable DefaultTarget "html"
	
	# List of known single byte encodings. Encodings not in this list will
	# require transcoding to UTF-8.
	variable singleByteEnc [list ascii cp1250 cp1251 cp1252 cp1253 cp1254 \
	  cp1255 cp1256 cp1257 cp1258 cp437 cp737 cp775 cp850 cp852 cp855 cp857 \
	  cp860 cp861 cp862 cp863 cp864 cp865 cp866 cp869 cp874 dingbats gb1988 \
	  iso8859-1 iso8859-10 iso8859-13 iso8859-14 iso8859-15 iso8859-16 \
	  iso8859-2 iso8859-3 iso8859-4 iso8859-5 iso8859-6 iso8859-7 iso8859-8 \
	  iso8859-9 jis0201 koi8-r koi8-u macCentEuro macCroatian macCyrillic \
	  macDingbats macGreek macIceland macRoman macRomania macThai macTurkish \
	  macUkraine symbol tis-620 utf-8 utf8 \
	  ]
	
	# List of reserved header parameters.
	variable basicParams [list AddHeader DestDir NavBar NavExtension \
	  NavNext NavPrev NavTop NumberIndices NumberRefs NumberSections \
	  PageWidth Preamble SectionDepth Source TclCmd Title TocDepth \
	  ]
	
	variable printOutputDir 1
}


# proc aidaTrace {name1 name2 op} {
# 	global aida_head
# 	puts ">>>>>>>>>>> aida_head(Project) is now /$aida_head(Project)/"
# }
# trace add variable aida_head(Project) write aidaTrace


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::getTargets" --
 # 
 # Return the list of targets
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getTargets {} {
	set targList [list]
	set dirList [aida::getTargetDirs]
	
	foreach d $dirList {
		if {[file tail $d] eq "base"} {
			continue
		} 
		if {[file exists [file join $d convert.tcl]]} {
			aida::verbose 3 "found file convert.tcl in $d"
			lappend targList [file tail $d]
		} 
	} 
	return [lsort -dict $targList];
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::buildHeaderInfo" --
 # 
 # Return the list of keys defined in the aida_head arrays (global and
 # target specific). If the 'showVal' arg is on, also display the value for
 # each key.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::buildHeaderInfo { {showVal 1} {target ""}} {
	global aida_verbosity
	variable basicParams
	
	set result [list]
	if {$target eq ""} {
		set dirList [aida::getTargetDirs]
	} else {
		set dirList [aida::findTargetDir $target]
	} 
	
	foreach d $dirList {
		set targ [file tail $d]
		if {$targ eq "base"} {
			global aida_head
			
			# Caveat: don't source base/default.tcl again, it has already
			# been sourced from the core
			
			if {$aida_verbosity > 0} {
				lappend result "global parameters"				
			} 
			
			set parmList [concat $basicParams [array names aida_head]]
			
			foreach k [lsort -unique $parmList] {
				set parm "\t:$k:"
				if {$showVal} {
					if {[info exists aida_head($k)]} {
						append parm "    [set aida_head($k)]"
					} else {
						append parm "    n/a"
					}
				} 
				lappend result $parm 
			} 
		} else {
			aida::verbose 3 "looking for default.tcl in $d"
			if {[file exists [file join $d default.tcl]]} {
				uplevel #0 [list source [file join $d default.tcl]]
			} 
			if {[array size ::${targ}::aida_head] > 0} {
				if {$aida_verbosity > 0} {
					lappend result "$targ parameters"
				} 
				foreach k [lsort [array names ::${targ}::aida_head]] {
					set parm "\t:${k}:${targ}:"
					if {$showVal} {
						append parm "    [set ::${targ}::aida_head($k)]"
					} 
					lappend result $parm
				} 				
			} 
		}
	} 
	return $result
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::getHeaderKeys" --
 # 
 # Implement the [aida help header] command.
 # 
 # Return the list of keys defined in the aida_head arrays
 # (global and target specific).
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getHeaderKeys {} {
	global aida_verbosity
	
	set result [aida::buildHeaderInfo 0]
	if {$aida_verbosity > 0} {
		lappend result "\nHeader parameters must be at the beginning of a line."
		lappend result "Global header parameters have the form:"
		lappend result "    :<name>:           <value>"
		lappend result "Target specific header parameters have the form:"
		lappend result "    :<name>:<target>:  <value>"
		lappend result "Examples:"
		lappend result ":DestDir:       ../output"
		lappend result ":DestDir:html:  ../output/htdocs"
	} 

	return [join $result "\n"]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::getHeaderValues" --
 # 
 # Implement the [aida info parameters] command.
 # 
 # Return the list of key/value pairs defined in the aida_head arrays
 # (global and target specific).
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getHeaderValues {args} {
	if {[llength $args] > 0} {
		set targ [lindex $args 0]	
	} else {
		set targ ""
	} 
	set result [aida::buildHeaderInfo 1 $targ]

	return [join $result "\n"]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::printLicenseInfo" --
 # 
 # Return the contents of the license.txt file.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::printLicenseInfo {} {
	global aida_library aida_version

	set path [file join $aida_library license.txt]
	if {[file exists $path]} {
		set fid [open $path]
		puts [read $fid]
		close $fid
	} else {
		aida::verbose 0 "aida (version $aida_version) is distributed under a BSD License:" 
		aida::verbose 0 "see the Open Source Initiative site at" 
		aida::verbose 0 "<http://www.opensource.org/licenses/bsd-license>." 
	} 
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::getMappingValues" --
 # 
 # Return the list of key/value pairs defined in the aida_map arrays
 # (global and target specific).
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getMappingValues { {target ""} } {
	global aida_verbosity aida_map
	variable basicParams
	
	set result [list]
	if {$target eq ""} {
		set dirList [aida::getTargetDirs]
	} else {
		set dirList [aida::findTargetDir $target]
	} 

	foreach d $dirList {
		set targ [file tail $d]
		unset -nocomplain aida_map
		
		if {$targ eq "base"} {
			
			# Caveat: don't source base/default.tcl again, it has already
			# been sourced from the core
			
			if {[info exists aida_map]} {
				if {$aida_verbosity > 0} {
					lappend result "global mapping"				
				} 
				foreach k [lsort [array names aida_map]] {
					if {$aida_verbosity > 0} {
						lappend result "\t${k}  ->  $aida_map($k)" 
					} else {
						lappend result "global: ${k}  ->  $aida_map($k)" 
					} 
				} 
			} 
		} else {
			aida::verbose 3 "looking for default.tcl in $d"
			if {[file exists [file join $d default.tcl]]} {
				uplevel #0 [list source [file join $d default.tcl]]
			} 
			if {[info exists aida_map]} {
				if {$aida_verbosity > 0} {
					lappend result "$targ mapping"
				} 
				foreach k [lsort [array names aida_map]] {
					if {$aida_verbosity > 0} {
						lappend result "\t${k}  ->  $aida_map($k)"
					} else {
						lappend result "$targ: ${k}  ->  $aida_map($k)"
					} 
				} 				
			} 
		}
	} 
	
	return [join $result "\n"]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::listAttributes" --
 # 
 # Return the list of tag attributes defined in the aida_attr dictionary
 # (global and target specific). The output is slightly different depending
 # on the verbosity level: for instance
 # - If verbosity = 0:
 # html ol type: 1
 # html ol start: 1
 # 
 # - If verbosity > 0:
 # html settings
 #    ol type: 1
 #    ol start: 1
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::listAttributes { {target ""} } {
	global aida_verbosity aida_attr
	
	set result [list]
	if {$target eq ""} {
		set dirList [aida::getTargetDirs]
	} else {
		set dirList [aida::findTargetDir $target]
	} 
	
	foreach d $dirList {
		aida::verbose 3 "looking for default.tcl in $d"
		if {[file exists [file join $d default.tcl]]} {
			uplevel #0 [list source [file join $d default.tcl]]
			
			set targ [file tail $d]
			if {$aida_verbosity > 0} {
				lappend result "$targ settings"
				set prfx "\t"
			} else {
				set prfx "$targ: "
			}
			set keysList [lsort [dict keys $aida_attr]]
			foreach k $keysList {
				set attrList [dict keys [dict get $aida_attr $k]]
				foreach a $attrList {
					lappend result "$prfx$k $a: [dict get $aida_attr $k $a]"
				} 
			} 
		} 
	} 
	
	return [join $result "\n"]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::configFiles" --
 # 
 # Return the list of the configuration files know to Aida. This includes
 # the files config.tcl and default.tcl found in the configuration
 # directories (user and system wide).
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::configFiles {} {
	global env 
	
	set result [list]
	set dirs [list]
	set userDir [file join [file normalize ~] ".aidarc"]
	if {[file exists $userDir]} {
		lappend dirs $userDir
	} 
	if {[info exists env(AIDA_SITE_CONFIG)]} {
		lappend dirs $env(AIDA_SITE_CONFIG)
	} 
	
	foreach d $dirs {
		foreach name [list config default] {
			set cfgFile [file join $d "$name.tcl"]
			if {[file exists $cfgFile]} {
				lappend result $cfgFile
			} 
		} 
	} 
	
	return [join $result "\n"]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::getEncodings" --
 # 
 # Return a sorted list of supported encodings. 
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getEncodings {} {
	global aida_verbosity
	aida::verbose 1 "Default input encoding: [aida::inputEncoding]"
	aida::verbose 1 "Default output encoding: [aida::outputEncoding]"
	aida::verbose 1 "Supported encodings:"
	set encList [encoding names]
	
	if {$aida_verbosity > 0} {
		set result "\t[join [lsort $encList] "\n\t"]"
	} else {
		set result [lsort $encList]
	}
	
	return $result
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::singleEncoding" --
 # 
 # Return a boolean telling if the encoding is a known single-byte
 # encoding. If it is not, it is considered multi-byte and translation to
 # Utf-8 will be required.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::singleEncoding {enc} {
	variable singleByteEnc
	return [expr {$enc in $singleByteEnc}]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::getExtensions" --
 # 
 # Return a list of the default file extensions used by the various targets. 
 # It accepts an optional argument to designate a specific target.
 # 
 # If no argument is specified, return a list of the form
 # 		html    	.html
 # 		hyperref	.tex 
 # 		latex   	.tex 
 # 		man     	.man 
 # 
 # Otherwise, just return the extension corresponding to the specified
 # target.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::getExtensions {args} {
	set result [list]

	if {[llength $args] > 0} {
		set targ [lindex $args 0]
		return [aida::findExtensionForTarget $targ]
	} else {
		set dirList [aida::getTargetDirs]
		foreach d $dirList {
			aida::verbose 3 "looking for convert.tcl in $d"
			set targ [file tail $d]
			if {![catch {aida::findExtensionForTarget $targ} ext]} {
				# If extension empty, return "" explicitely so that it works
				# with array set:
				# array set foo [exec aida info extensions]
				if {$ext eq ""} {
					set ext "\"\""
				} 
				lappend result "[format %-12s $targ]$ext"
			} 
		} 
	} 	
	
	return [join $result "\n"]
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::findExtensionForTarget" --
 # 
 # Return the default file extension for a given target (without fallback). 
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::findExtensionForTarget {targ} {
	set ext ".$targ"
	if {![catch {aida::loadTarget $targ convert}]} {
		catch {aida::loadTarget $targ default}
		if {![catch ${targ}::defaultExtension res]} {
			aida::verbose 3 "found extension with ${targ}::defaultExtension"
			set ext $res
		} 
	} else {
		error "unknown target '$targ'."
	}

	return $ext
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::registerParam" --
 # 
 # Called from the core to declare a header parameter. The key can take two
 # forms:
 #    <parm> 
 #    <parm>:<target>
 # 
 # If a target is specified, the param is registered only if it is the
 # current target.
 # If the target is specified with an asterisk, it designates the current
 # target whatever (introduced in aida 1.2).
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::registerParam {key val} {
	global aida_target

	set idx [string first ":" $key]
	if {$idx >= 0} {
		set parm [string range $key 0 [expr {$idx-1}]]
		set ns [string range $key [expr {$idx+1}] end]
		set scope $ns
	} else {
		set parm $key
		set ns $aida_target
		set scope ""
	} 
	
	# (aida 1.2) If the namespace is specified as "*", the corresponding
	# header parameter will be target-specific for any target
	if {$ns eq "*"} {
		set ns $aida_target
	} 
	
	# Skip the parameter if it is target-specific and this is not the
	# current target
	if {$scope ne "" && $ns ne $aida_target} {
		aida::verbose 3 "ignored header param '$key'"
		return
	} 
	
	if {$parm eq "Source"} {
		set msg "sourcing file '$val' "
		# Resolve the path of the file
		set srcFile [aida::resolvePath $val]
		# Source the file
		if {$scope eq ""} {
			append msg "in global scope"
			uplevel #0 [list source $srcFile]
		} else {
			append msg "in namespace $ns"
			namespace eval ::$ns [list source $srcFile]
		} 
		aida::verbose 3 $msg
	} elseif {$parm eq "TclCmd"} {
		set msg "evaluating command '$val' "
		if {$scope eq ""} {
			append msg "in global scope"
			uplevel #0 $val
		} else {
			append msg "in namespace $ns"
			namespace eval ::$ns $val
		} 
		aida::verbose 3 $msg
	} elseif {$parm eq "AddHeader"} {
		aida::appendParam $parm $val $ns
	} else {
		aida::setParam $parm $val $ns
	} 
	return
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::findTargetDir" --
 # 
 # Walk along the aida_path and find the first location of the directory
 # containing the implementation of the specified target.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::findTargetDir {target} {
	global aida_path 

	aida::verbose 3 "looking for $target target dir"

	foreach subdir $aida_path {
		aida::verbose 3 "looking for targets in $subdir"
		set dirList [glob -nocomplain -type d -tail -dir $subdir *]
		if {[lsearch $dirList $target] != -1} {
			set targDir [file join $subdir $target]
			aida::verbose 3 "found $targDir"
			break
		} 
	} 
	if {[info exists targDir]} {
		return $targDir
	} else {
		error "can't find dir for $target target\n"
	} 
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::loadTarget" --
 # 
 # Load the Tcl code corresponding to the given target.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::loadTarget {target {files ""}} {
	aida::verbose 3 "loading $target target Tcl procs"
	set targDir [aida::findTargetDir $target]
	
	if {$files eq ""} {
		set files [list default convert]
	} 
	foreach f $files {
		aida::verbose 3 "loading file [file join $targDir $f.tcl]"
		uplevel #0 [list source [file join $targDir $f.tcl]]
	} 
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::renameOutputFile" --
 # 
 # If an -output option is specified, build the full path of the output
 # file based on the DestDir parameter. If the output dir does not exist,
 # create it. Then rename the temporary file.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::renameOutputFile {tempName outName} {
	variable printOutputDir

	# Build the path of the output file
	set path $outName
	if {[file pathtype $outName] ne "absolute"} {
		aida::verbose 3 "building output file path"
		set path [file normalize [file join [aida::buildDestDir] $outName]]
	} 

	# Create the dir containing the output file if necessary
	set outdir [file dir $path]
	if {![file exists $outdir]} {
		aida::verbose 3 "creating directory $outdir"
		file mkdir $outdir
	} 
	
	# Rename the temporary file
	aida::verbose 3 "renaming temp output file from $tempName to $path"
	if {[catch {file rename -force -- $tempName $path} res]} {
		puts stderr "failed to rename temporary file."
		puts stderr "the output has been left in '$tempName'"
		error $res
	} 
	
	# Print the output dir path only once
	if {[aida::splitting] && $printOutputDir} {
		aida::verbose 1 "output in [file dir $path]"	
		set printOutputDir 0
	} 
	
	return
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::buildDestDir" --
 # 
 # Build the path of the destination dir. The result is not normalized, it
 # is up to the caller to do it.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::buildDestDir {} {
	aida::verbose 3 "building DestDir path"

	set destDir ""
	if {![catch {aida::getParam DestDir} res]} {
		set destDir $res
		# Perform substitution on the DestDir string (aida 1.1)
		set destDir [uplevel #0 [list subst $destDir]]
	}
	# NB: if $destDir is an absolute path, the following command yields the
	# path itself
	set path [file join [aida::getDirname] $destDir]
	aida::verbose 3 "DestDir path: $path"
	
	return $path
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::makeOutputName" --
 # 
 # If the -output option is specified as an empty string, this proc builds
 # a default name. The proc first looks for an :Output: header parameter.
 # If none is declared, it uses the name of the input file or the value
 # defined by the aida_output variable if the input comes from stdin.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::makeOutputName {} {
	global aida_name aida_target
	set base ""
	if {![catch {aida::getParam Output} res]} {
		set base [string trim [file root $res]]
		set ext [string trim [file ext $res]]
	} else {
		set ext [aida::defaultExtension $aida_target]
		if {[info exists aida_name]} {
			set base [file root [file tail $aida_name]]
		} 
	}
	
	if {$base eq ""} {
		if {[aida::splitting]} {
			set base "aida_split"
		} else {
			set base "aida_out"
		} 
	} 
	
	if {[aida::splitting]} {
		append base "_%d"
	} 
	
	return "$base$ext"
}


# Namespace dispatching
# =====================
# 

## 
 # ------------------------------------------------------------------------
 # 
 # "aida::namespaceCallback" --
 # 
 # Try to find a target specific proc or, if not found, a global proc to
 # execute. In case no proc was found, raise an error if 'fatal' is set to
 # 1, otherwise just ignore.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::namespaceCallback {name target fatal args} {
	if {[namespace eval ::$target [list namespace which $name]] ne ""} {
		return [namespace eval ::$target [list $name {*}$args]]
	} else {
		set msg "no ${name} proc found\n"
		if {$fatal} {
			error $msg
		} else {
			aida::verbose 2 $msg
		} 
	} 
	return
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::evalCallback" --
 # 
 # Evaluate a target-specific or global proc if it exists. 
 # Just warn if no proc was found.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::evalCallback {name target args} {
	aida::namespaceCallback $name $target 0 {*}$args
}


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::execCallback" --
 # 
 # Evaluate a target-specific or global proc. If it does not exist, raise
 # an error.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::execCallback {name target args} {
	aida::namespaceCallback $name $target 1 {*}$args
}



# Hooks
# =====


## 
 # ------------------------------------------------------------------------
 # 
 # "aida::preConvertHook" --
 # "aida::postConvertHook" --
 # "aida::splitHook" --
 # 
 # Default definitions for hook procs. They redirect to a target-specific
 # definition if any or to the global one.
 # 
 # ------------------------------------------------------------------------
 ##
proc aida::preConvertHook {target} {
	aida::evalCallback preConvertHook $target
}

proc aida::postConvertHook {target} {
	aida::evalCallback postConvertHook $target
}

proc aida::splitHook {target file} {
	aida::evalCallback splitHook $target $file
}





# Source the other library files

foreach f [list debug utils callbacks] {
	set path [file join $aida_library $f.tcl]
	if {[file exists $path]} {
		if {[catch {uplevel #0 {source $path}} res]} {
			error "can't source library file $f.tcl: $res"
		} 
	} else {
		error "can't find library file $f.tcl"
	}
} 
unset -nocomplain f



