#! /bin/env tclsh

namespace import ::tcl::mathfunc::max
namespace import ::tcl::mathfunc::min
namespace import ::tcl::mathop::+
namespace import ::tcl::mathop::-
namespace import ::tcl::mathop::/
namespace import ::tcl::mathop::<<



package require {ycl proc}
namespace import [yclprefix]::proc::checkargs
package require {ycl list}
interp alias {} [namespace current]::all {} [yclprefix] list all
variable ldedent [yclprefix]::list::dedent

namespace eval doc {}

    if {![catch {expr {abs($value)}}]} {
        return 1
    }
    return 0
}

proc iter value {
	package require {ycl coro call}
	namespace import [yclprefix]::coro::call::bye
	namespace import [yclprefix]::coro::call::reply
	proc iter value {
		set name [namespace current]::[info cmdcount]
		set res [coroutine $name ::apply [list value {
			set length [string length $value]
			reply
			for {set i 0} {$i < $length} {incr i} {
				reply [string index $value $i]
			}
			bye
		} [namespace current]] $value]
		return $name
	}
	tailcall iter $value
}

variable doc::pstring {
	description {
		convert non-printing characters in $string into their \x or \u escaped
		form 
	}

	set text [split $text \n]
	set text [$ldedent $text]
	set text [join $text[set text [list]] \n]
	return $text
}

variable doc::template {
	synopsis {
		template  ?varspec ...?  string
	}
	description {
		A concise way to invoke [string map] . All mapped values are quoted
		with [list] . Each $varspec is the name of a variable , optionally
		preceded by a delimiter that ends with a character that isn't valid in
		a variable name , and optionally followed by a delimiter that begins
		with a character which isn't valid in a variable name .

		If $varspec is "#" , it signifies that the subsequent $varspec is not to
		be quoted with [list] .

		If $varspec is "=" , it signifies that the subsequent $varspec is list
		containing the $odelim and optionally the $cdelim for the $varspec that
		follows it . If only $odelim is provided , $cdelim shares its value .

		A $varspec value of  "!" is like "=", but its effects remain in place
		for the all the following $varspec values.

	}
}
proc template args [string map [list @varchars@ {a-zA-z0-9_}] {
	if {![llength $args]} {
		error [list {wrong # args} [llength $args]]
	}
	set string [lindex $args end]
	set args [lrange $args[set args {}] 0 end-1]
	set script {::string map [list } 
	set state {}
	set changedefaultdelim 0
	set changedelim 0
	set list 1
	set odefault @
	set cdefault @
	set mode varspec
	foreach arg $args {
		switch $state {
			{} {
				switch $arg {
					= {
						set state changedelim
						set mode varname
						continue
					}
					! {
						set state changedefaultdelim
						set mode varspec
						continue
					}
					\# {
						set list 0
						continue
					}
				}
			}
			changedelim {
				set arg [lassign $arg[set arg {}] odelim]
				if {[llength $arg]} {
					lassign $arg cdelim
				}
				set changedelim 1
				set state {}
				continue
			}
			changedefaultdelim {
				set arg [lassign $arg[set arg {}] odefault]
				if {[llength $arg]} {
					lassign $arg cdefault
				} else {
					set cdefault $odefault
				}
				set changedefaultdelim 0
				set state {}
				continue
			}
			default {
				error [list {unknown state} $state]
			}
		}

		if {!$changedelim} {
			set odelim $odefault 
			set cdelim $cdefault
		}
		if {$mode eq {varspec}} {
			if {![regexp "^(.*\[^@varchars@])?(\[@varchars@]+|\[@varchars@]*\\(\[^\\)]*\\))(\[^a-zA-z0-9_].*)?$" \
				$arg -> odelim1 varname cdelim1]} {

				error [list {bad varspec} $arg]
			}
			if {$odelim1 ne {}} {
				set odelim $odelim1
			}
			if {$cdelim1 ne {}} {
				set cdelim $cdelim1
			}
		} else {
			set varname $arg
		}
		if {$list} {
			set qvarname "\[list \$$varname]"
	 	} else {
			set qvarname \$$varname
		}
		append script "$odelim$varname$cdelim $qvarname "
		set list 1
		set changedefaultdelim 0
		set changedelim 0
		set mode varspec
	}
	append script {] } [list $string]
	uplevel 1 $script 
}]

proc COUNT {} {return count}
proc INDEXES {} {return indexes}
proc INFO {} {return info}
proc STRINGS {} {return strings}

	namespace import [yclprefix]::test::cleanup1
	package require {ycl test data}
	namespace import [yclprefix]::test::data
	package require {ycl string}
	namespace import [yclprefix]::string::cmp
	namespace import [yclprefix]::string::shortmatch
	namespace import [yclprefix]::string::delimit
	namespace import [yclprefix]::string::template

	test cmp1 {} -body {
		cmp hello hello
	} -result -1

	test cmp2 {} -body {
		cmp hello heplo

	test iter {} -body {
		set string banana
		set iter [ycl string iter $string]
		while 1 {
			lappend res [call $iter]
		}

		return $res
	} -cleanup [cleanup1] -result [sl {
		b a n a n a
	}]

	test shortmatch_one_match {} -body {
		shortmatch *t* t

	test delimit_count {} -body {
		delimit $quote1 string {d } format count
	} -result {2}

	test delimit_count_zero {} -body {
		delimit $quote1 string {xzd } format count
	} -result {0}

	test template {} -body {
		set a 5
		set b 7
		set expr {[set b]}
		::apply [list {} [template a b # expr {
			set a @a@
			set b @b@
			expr {$a + @expr@}
		}]]
	} -result 12

	test template_customdelim {} -body {
		set a 5
		set b 7
		set c 3
		set d 2
		set e 1
		set expr {[set b]}
		::apply [list {} [template a !b* # &expr> c ! {` )} d e {
			set a @a@
			set b !b*
			set c @c@
			set d `d)
			expr {$a + &expr> + $c + $d + `e)}
		}]]
	} -result 18 

	cleanupTests
}

variable cleanup1 {
	apply {{} {
		foreach name {res} {
			catch {unset $name}
		}
	}}
}