proc comment args {}

switch $tcl_platform(platform) {
    unix {
	event add <<Cut>> <Shift-Delete>
	event add <<Copy>> <Control-Insert>
	event add <<Paste>> <Shift-Insert>

	event delete <<Paste>> <Control-Key-y>
	event add <<Redo>> <Control-Key-y>

	# correct some strange failures in key bindings

	bind Text <Control-v> {event generate %W <<Paste>>}
	bind Text <Control-y> {event generate %W <<Redo>>}
    }
}

option add *Menu.tearOffCommand		fixTornOffMenu
option add *Canvas.highlightThickness	0
option add *Label.borderWidth		1
option add *Entry.borderWidth		1
option add *Spinbox.borderWidth		1
option add *Button.borderWidth		1
option add *Menubutton.borderWidth	1
option add *Scrollbar.borderWidth	1

option add *Entry.font			{Helvetica 9}
option add *Label.font			{Helvetica 9}
option add *Button.font			{Helvetica 9}
option add *Menubutton.font		{Helvetica 9}
option add *Checkbutton.font		{Helvetica 9}
option add *Labelframe.font		{Helvetica 9}
option add *Text.font			{Helvetica 9} 

option add *Menu.background		\#c0c0c0
option add *Menu.borderWidth		1
option add *Menu.activeBorderWidth		1

option add *Radiobutton.font		{Helvetica 9}
option add *Radiobutton.justify		left
option add *Radiobutton.wrapLength	300

option add *Checkbutton.justify		left
option add *Checkbutton.wrapLength	300


option add *Entry.background		white
option add *Entry.highlightThickness	0

option add *Text.background		white
option add *Text.relief			sunken 
option add *Text.borderWidth		1
option add *Text.insertOffTime		0
option add *Text.highlightThickness	0

option add *Text.undo			1

option add *Menu.background		\#c0c0c0
option add *Menu.borderwidth		0

proc fixTornOffMenu {menu toplevel} {
    # make tear-off transient to parent window.
    set parent [winfo parent $toplevel]
    wm transient $toplevel $parent
    if {$::tcl_platform(platform) ne "unix"} {
	set px [winfo pointerx $parent]
	set py [winfo pointery $parent]
	set x [expr {$px - 30}]
	set y [expr {$py - 10}]
	wm geometry $toplevel +$x+$y
    }
    wm resizable $toplevel no no
}

proc setVscrollbarIn {toplevel a b} {
    # set vertical scrollbar in $toplevel (managed by grid)
    if {$toplevel eq "."} {
	set scrollbar .vscroll
    } else {
	set scrollbar $toplevel.vscroll
    }
    if {($a == 0.0) && ($b == 1.0)} {
	set code "catch {grid forget $scrollbar}"
	after cancel $code
	after 100 $code
    } else {
	grid configure $scrollbar -row 0 -column 1 -sticky news
	set code [list $scrollbar set $a $b]
	after cancel $code
	after idle $code
    }
}

proc setHscrollbarIn {toplevel a b} {
    # set horizontal scrollbar in $toplevel (managed by grid)
    if {$toplevel eq "."} {
	set scrollbar .hscroll
    } else {
	set scrollbar $toplevel.hscroll
    }
    if {($a == 0.0) && ($b == 1.0)} {
	set code "catch {grid forget $scrollbar}"
	after cancel $code
	after 100 $code
    } else {
	grid configure $scrollbar -row 1 -column 0 -sticky news
	set code [list $scrollbar set $a $b]
	after cancel $code
	after idle $code
    }
}


namespace eval dummy {}

proc scrolledtext {f args} {
    frame $f -class Scrolledtext
    text $f.text
    grid $f.text\
	[scrollbar $f.vscroll\
	     -command [list $f.text yview]]\
	-sticky news
    grid [scrollbar $f.hscroll\
	      -orient horizontal\
	      -command [list $f.text xview]]\
	-sticky news
    grid rowconfigure $f 0 -weight 1
    grid columnconfigure $f 0 -weight 1
    $f.text configure\
	-xscrollcommand [list setHscrollbarIn $f]\
	-yscrollcommand [list setVscrollbarIn $f]\
	-wrap word
    rename $f ::dummy::$f
    proc $f {args} [subst {
	eval $f.text \$args
    }]
    eval $f.text configure $args
    set f
}

proc scrolledrichtext {f args} {
    frame $f -class Scrolledrichtext
    richtext $f.text
    grid $f.text\
	[scrollbar $f.vscroll\
	     -command [list $f.text yview]]\
	-sticky news
    grid [scrollbar $f.hscroll\
	      -orient horizontal\
	      -command [list $f.text xview]]\
	-sticky news
    grid rowconfigure $f 0 -weight 1
    grid columnconfigure $f 0 -weight 1
    $f.text configure\
	-xscrollcommand [list setHscrollbarIn $f]\
	-yscrollcommand [list setVscrollbarIn $f]\
	-wrap word
    rename $f ::dummy::$f
    proc $f {args} [subst {
	eval $f.text \$args
    }]
    eval $f.text configure $args
    set f
}

namespace eval Lambda {
    variable counter 0
    array set function {}
    namespace eval Function {}
    namespace export lambda
}

proc ::Lambda::nextName {} {
    variable counter
    return [namespace current]::Function::[incr counter]
}

proc ::Lambda::lambda {arglist body} {
    # return quasi-anonymous lambda term
    # (i. e. build a procedure bound to some name, and return that name).
    variable function
    set formals [list $arglist $body]
    if {![info exists function($formals)]} {
	set name [nextName]
	uplevel 1 [list proc $name $arglist $body]
	set function($formals) $name
    }
    return $function($formals)
}

namespace import -force ::Lambda::lambda

proc unicode2texNormal {unicode} {
    variable char2texTable
    set string [string trim $unicode]
    set texChars [string map $char2texTable $string]
    set lineFeedMap [list \n \\\\\n]
    set texLines [string map $lineFeedMap $texChars]
    set parPattern {(\s*\\\\\n){2,}}
    set texLines [regsub -all $parPattern $texLines "\n\n"]
    string map [list\
		    ... [globalSetting ...]\
		    {\pagebreak{}\\} {\pagebreak{}}
		   ] $texLines
}

#
proc subSubjectIndices {src} {
    set indices\
 	[regexp -all -inline -indices {(?:^|\n+)([*/_])[^\n]*?\1} $src]
    set result {}
    foreach {match sign} $indices {
	let {from to} $match
	lappend result $from
	set foundRange [string range $src $from $to]
	set char\
	    [string index [string trim $foundRange] 0]
	set pat \\$char.*?\\$char
	if {[regexp -indices $pat $foundRange match1]} {
	    let {from1 to1} $match1
	    set len [expr {$to1-$from1}]
	    lappend result\
		[expr {$from + $len + [string first $char $foundRange]}]
	} else {
	    lappend result $to
	}
    }
    set result
}

proc textSubSubjectFragments {src} {
    set indices -1
    set subSubjects {}
    foreach {from to} [subSubjectIndices $src] {
	lappend subSubjects [string range $src $from $to]
	lappend indices [expr {$from - 1}] [expr {$to + 1}]
    }
    lappend indices [string length $src]
    set textList {}
    foreach {from to} $indices {
	lappend textList [string range $src $from $to]
    }
    # list subSubjectes $subSubjects textList $textList
    set result [lrange $textList -1 0]
    foreach subSubject $subSubjects text [lrange $textList 1 end] {
	lappend result $subSubject $text
    }
    set result
}

proc unicode2tex {src} {
    set frags [textSubSubjectFragments $src]
    set result [unicode2texNormal [lindex $frags 0]]
    array set meaning {
	* \\bf
	/ \\it
	_ \\underline
    }
    foreach {sub txt} [lrange $frags 1 end] {
	regexp -indices {[*/_]} $sub indices
	let {from to} $indices
	set subChar [string range $sub $from $to]
	set subText [string range $sub [expr {$to+1}] end-1]
	set splitRange [regexp -inline ^\\s* $txt]
	append result \n\n\{\
	    $meaning($subChar) \
	    \{ [unicode2texNormal $subText] \}\
	    \}\
	    $splitRange\
	    [unicode2texNormal $txt]
    }
    string trim $result
}

#

proc charVal {char} {
    scan $char %c
}

proc hex {number} {
    format %x $number
}

proc echo {args} {
    uplevel [list puts $args]
}

#
# return string with non-ascii chars encoded as in ö = \u00f6 etc.
#
proc unicode2asciiEncoded {rawString} {
    set string [string map {\\ \\\\} $rawString]
    while {[regexp {[^[:ascii:]]} $string nonAsciiChar]} {
	set nonAsciiVal [charVal $nonAsciiChar]
	set hexVal [hex $nonAsciiVal]
	while {[string length $hexVal] < 4} {
	    set hexVal 0$hexVal
	}
	set hexVal \\u$hexVal
	set string [string map [list $nonAsciiChar $hexVal] $string]
    }
    set string
}

proc saveString {string file} {
    set port [open $file w]
    puts -nonewline $port $string
    close $port	
}

proc cat file {
    set port [open $file]
    set contents [read $port]
    close $port
    return $contents
}

proc let {args} {
    uplevel 1 foreach $args {break}
}

proc range {num args} {
    switch [llength $args] {
	0 {
	    set from 0
	    set to $num
	    set step 1
	}
	1 {
	    set from $num
	    set to $args
	    set step 1
	}
	2 {
	    set from $num
	    let {to step} $args
	}
    }
    set result [list ]
    for {set i $from} {$i < $to} {set i [expr {$i + $step}]} {
	lappend result $i
    }
    return $result
}

proc map {func list} {
    set result [list ]
    foreach el $list {
	lappend result [uplevel [list $func $el]]
    }
    return $result
}

proc llindex {l args} {
    # return nested list index, e.g. llindex $nestedList 4 2
    if {[llength $args] == 0} {
	return $l
    } else {
	eval llindex [list [lindex $l [lindex $args 0]]] [lrange $args 1 end]
    }
}

namespace eval Stack {
    variable stack {}
    namespace export push pop tos
}

proc Stack::pop {{s ::Stack::stack}} {
    upvar $s stack
    set result [lindex $stack end]
    set stack [lrange $stack 0 end-1]
    return $result
}

proc Stack::push {val {s ::Stack::stack}} {
    upvar $s stack
    lappend stack $val
}

proc Stack::tos {{s ::Stack::stack}} {
    upvar $s stack
    lindex $stack end
}

namespace import -force ::Stack::push
namespace import -force ::Stack::pop
namespace import -force ::Stack::tos

proc map {func list} {
    set result [list ]
    foreach el $list {
	lappend result [uplevel [list $func $el]]
    }
    return $result
}

proc shift {listVar} {
    upvar $listVar list
    set result [lindex $list 0]
    set list [lrange $list 1 end]
    set result
}

proc unshift {el listVar} {
    upvar $listVar list
    set list [concat $el $list]
}

namespace eval Sleep {
    namespace export sleep
    variable count 0
}

proc ::Sleep::newVar {} {
    variable count
    return var[incr count]
}

proc ::Sleep::sleep {num} {
    set var [newVar]
    uplevel 1 set ::Sleep::$var 1
    after $num [list set ::Sleep::$var 0]
    vwait ::Sleep::$var
    unset ::Sleep::$var
}

namespace import -force ::Sleep::sleep

proc lreverse {l} {
    set i [llength $l]
    set result {}
    while {$i} {
	lappend result [lindex $l [incr i -1]]
    }
    # return this value
    set result
}

proc relPathFromTo {fromDir toDir} {
    # return path string relative from $fromDir to $toDir.
    # $fromDir is assumed to be a directory (not a file).
    set from [file normalize $fromDir]
    set to [file normalize $toDir]
    if {$::tcl_platform(platform) eq "windows"} {
	set driveMap {
	    a: A: b: B: c: C: d: D: e: E: f: F: g: 
	    G: h: H: i: I: j: J: k: K: l: L: m: M:
	    n: N: o: O: p: P: q: Q: r: R: s: S: t:
	    T: u: U: v: V: w: W: x: X: y: Y: z: Z:
	}
	regexp {^[a-zA-Z]:} [pwd] drive
	if {![regexp {^[a-zA-Z]:} $from]} {
	    set from $drive$from
	}
	set from [string map $driveMap $from]
	if {![regexp {^[a-zA-Z]:} $to]} {
	    set to $drive$to
	}
	set to [string map $driveMap $to]
    }
    set fromList [file split $from]
    set fromLength [llength $fromList]
    set toList [file split $to]
    set toLength [llength $toList]
    set commonList {}
    foreach path1 $fromList path2 $toList {
	if {$path1 ne $path2} {
	    break
	} else {
	    lappend commonList $path1
	}
    }
    set commonLength [llength $commonList]
    set fromList1 [lrange $fromList $commonLength end]
    set toList1 [lrange $toList $commonLength end]
    set resultList {}
    foreach i $fromList1 {
	lappend resultList ..
    }
    eval lappend resultList $toList1
    if {$resultList ne {}} {
	eval file join $resultList
    }
}