set sb(key,*) "state multiple modifiers in this order: S, C, M, A"


set sb(key,C-x) exchangepointandmark
set sb(key,C-space) setmark
set sb(key,-Delete) pageup
set sb(key,C-h) pageup
set sb(key,M-v) pageup
set sb(key,-BackSpace) pageup
set sb(key,-space) pagedown
set sb(key,C-v) pagedown
set sb(key,-Escape) searchkill
set sb(key,C-g) searchkill
set sb(key,C-n) nextline
set sb(key,C-p) prevline
set sb(key,-Up) prevline
set sb(key,-Down) nextline
#set sb(key,-Left) prevline
#set sb(key,-Right) nextline
set sb(key,C-s) incrsearch
set sb(key,C-r) revincrsearch
set sb(key,M-question) help
set sb(key,-Help) help
set sb(key,C-l) clearscreen



set sb(key,C-f) pagedown
set sb(key,C-b) pageup



set sb(key,-F27) pagestart
set sb(key,-F29) pageup
set sb(key,-F35) pagedown
set sb(key,-R13) pageend
set sb(key,-F33) pageend


set sbx(wrap-msg) "No more matches; try again to wrap around"


set sb(key,-Prior) pageup
set sb(key,-Next) pagedown
set sb(key,-Home) pagestart
set sb(key,-End) pageend
set sb(key,M-less) pagestart
set sb(key,M-greater) pageend

foreach e [array names sb] {
set sbdef($e) $sb($e)
}


if {[info tclversion]<7.4 || $tk_version<4.0} {
puts stderr "Tcl 7.4/Tk 4.0 minimum versions required"
puts stderr "You have Tcl [info tclversion]/Tk $tk_version"
exit 1
}





proc searchboxSearch {pat regexp casesen tag t {wmsg ""} {wcnt ""} args} {
global sbx

if {$args=="{}"} {set args ""}

if {$casesen==-1} {set casesen [expr {[string tolower $pat]!=$pat}]}
set caseopt [expr !$casesen?"-nocase":""]
if {$regexp} {set type "regexp"} {set type "exact"}

if {$pat==""} {
winerrout $wmsg "Nothing to search for!  Type in a [expr $regexp?{regular expression}:{string}]."
return 0
}


if {![string match "TAG:*" $pat] && $type=="regexp" && [catch {regexp $pat bozomaniac}]} {
winerrout $wmsg "Malformed regular expression."
return 0
}

$t tag remove $tag 1.0 end

set cnt 0


if {[regexp "^TAG:(.*)" $pat all ptag]} {
$t tag remove $tag 1.0 end
set cnt 0
foreach wtag [$t tag names] {
if {[string match $ptag $wtag]} {
foreach {s e} [$t tag ranges $wtag] {$t tag add $tag $s $e; incr cnt}
}
}

} else {
set index 1.0
set len 0
while {[set index [eval "$t search -forwards -$type $caseopt $args -count len -- {$pat} {$index+$len chars} end"]]!=""} {
$t tag add $tag $index "$index + $len chars"
incr cnt
}
}


if {$cnt==0} {set txt "no matches"} else {set txt "$cnt matches"}
if {$wcnt!=""} {$wcnt configure -text $txt}

set sbx(ratend$t) 0; set sbx(ratstart$t) 0
return $cnt
}




proc searchboxNext {tag t {wmsg ""} {yoff ""}} {
global sbx

if {[$t tag ranges $tag]==""} { winerrout $wmsg "No matches!"; return }

if {$yoff==""} {
set yoff [winfo height $t]; set start [$t index @0,$yoff]
if {[set prev [$t tag prevrange search @0,$yoff @0,0]]!=""} {set start [$t index [lsecond $prev]+1c]}
} else { set start [$t index @0,$yoff] }
set hit [$t tag nextrange $tag $start]
if {$hit==""} {
if {$sbx(ratend$t)} {
set hit [$t tag nextrange $tag 1.0]
set sbx(ratend$t) 0
} else {
set sbx(ratend$t) 1
if {[$t bbox 1.0]==""} {winerrout $wmsg $sbx(wrap-msg)} {searchboxNext $tag $t $wmsg $yoff}
}
}
if {$hit!=""} {
$t mark set hit [lindex $hit 0]
$t see hit
}
}

proc searchboxPrev {tag t {wmsg ""}} {
global sbx

if {[$t tag ranges $tag]==""} { winerrout $wmsg "No matches!"; return }

set hit [$t tag prevrange $tag [$t index @0,0]]
if {$hit==""} {
if {$sbx(ratstart$t)} {
set hit [$t tag prevrange $tag end]
set sbx(ratstart$t) 0
} else {
set sbx(ratstart$t) 1
if {[$t bbox end-1c]==""} {winerrout $wmsg $sbx(wrap-msg)} {searchboxPrev $tag $t $wmsg}
}
}

if {$hit!=""} {
$t mark set hit [lindex $hit 0]
$t see hit
}
}



proc searchboxKeyNav {m k casesen t {wmsg ""} {firstmode 0} args} {
global sb sbx

if {$args=="{}"} {set args ""}

if {[regexp {(Shift|Control|Meta|Alt|NunLock)_.} $k]} {return 0}
if {![info exists sbx(try$t)]} {
set sbx(try$t) 0
set sbx(vect$t) 1
set sbx(lastkeys$t) ""
set sbx(iatstart$t) 0; set sbx(iatend$t) 0
if ![info exists sbx(lastkeys-old$t)] {set sbx(lastkeys-old$t) ""}
}


if {!$firstmode && ($sbx(try$t) || $sbx(lastkeys$t)!="")} {
switch -exact -- $k {
space {set k " "}
BackSpace -
Delete {
set k ""
set last [expr [string length $sbx(lastkeys$t)]-2]
set sbx(lastkeys$t) [string range $sbx(lastkeys$t) 0 $last]
set sbx(try$t) 1
}
default { if {$m==""||$m=="S"} {set k [name2char $k]} }
}
}


set m [string trimright $m "S"]; # strip shift as a modifier
set mk $m-$k
if {$m=="literal"} {set op $k} \
elseif {[info exists sb(key,$mk)]} {set op $sb(key,$mk)} \
elseif {$m=="" && [string length $k]<=1} {set op default} \
else {return 0}

switch -exact -- $op {
exchangepointandmark {
set tmp [$t index @0,0]
$t yview xmark
update
$t mark set xmark $tmp
}
setmark {$t mark set xmark [$t index @0,0]}
pageup {$t yview scroll -1 pages}
pagedown {$t yview scroll 1 pages}
pagestart {$t yview moveto 0}
pageend {$t yview moveto 1}
searchkill {
if {$sbx(lastkeys$t)!=""} {set sbx(lastkeys-old$t) $sbx(lastkeys$t)}
set sbx(lastkeys$t) ""; set sbx(try$t) 0
winstdout $wmsg ""
}
clearscreen {winstdout $wmsg ""}
nextline {$t yview scroll 1 units}
prevline {$t yview scroll -1 units}
default {
if {$op=="incrsearch"} {
if {$sbx(try$t)&&$sbx(lastkeys$t)==""} {set sbx(lastkeys$t) $sbx(lastkeys-old$t)}
set sbx(vect$t) 1; set sbx(try$t) 1
} elseif {$op=="revincrsearch"} {
if {$sbx(try$t)&&$sbx(lastkeys$t)==""} {set sbx(lastkeys$t) $sbx(lastkeys-old$t)}
set sbx(vect$t) -1; set sbx(try$t) 1
} elseif {$firstmode} {
set sbx(lastkeys$t) $k
set sbx(try$t) 1
} elseif {$sbx(try$t)} {
append sbx(lastkeys$t) $k
}

set keys $sbx(lastkeys$t)
if {$casesen==-1} {set casesen [expr {[string tolower $keys]!=$keys}]}
set caseopt [expr !$casesen?"-nocase":""]
if {$sbx(try$t)==0 && $keys==""} {return 0}
winstdout $wmsg "Searching for \"$keys\" ..."


if {$firstmode} {
set start 1.0; set end end
} elseif {[set ranges [$t tag ranges isearch]]!=""} {
set start [lindex $ranges 0]; set end 1.0
if {$op=="incrsearch"} {set start [$t index "$start+1c"]}
if {$sbx(vect$t)==1} {set end "end"}
} else {
if {$sbx(vect$t)==1} {
set start [$t index @0,0]; set end "end"
} else {
set start [$t index @0,[winfo height $t]]; set end "1.0"
}
}

set dir [expr {$sbx(vect$t)==1?"-forwards":"-backwards"}]
set type [expr $firstmode?"-regexp":"-exact"]
set pfx [expr $firstmode?"^":""]
set search "$t search $dir $type $caseopt -count klen $args -- {$pfx$keys} $start"
set found [eval "$search $end"]
set anywhere [eval $search]

if {$anywhere!=""} {
if {$found!=""} {
$t tag remove isearch 1.0 end
$t tag add isearch $found "$found + $klen c"
$t mark set hit $found
$t see hit
set sbx(iatstart$t) 0; set sbx(iatend$t) 0
} else {
if {$sbx(vect$t)==1} {
if {$sbx(iatstart$t)} {
$t yview moveto 0; $t tag remove isearch 1.0 end
return [searchboxKeyNav $m $k $casesen $t $wmsg $firstmode]
} else {
winerrout $wmsg $sbx(wrap-msg)
set sbx(iatstart$t) 1
}
} else {
if {$sbx(iatend$t)} {
$t yview moveto 1; $t tag remove isearch 1.0 end
return [searchboxKeyNav $m $k $casesen $t $wmsg $firstmode]
} else {
winerrout $wmsg $sbx(wrap-msg)
set sbx(iatend$t) 1
}
}
}
} else {
$t tag remove isearch 1.0 end
winerrout $wmsg "\"$keys\" not found"
set sbx(try$t) 0
}
}
}

return 1
}




proc searchboxSaveConfig {fid} {
global sb sbx sbdef

puts $fid "#\n# SearchBox\n#\n"
foreach i [lsort [array names sb]] {
set co ""
if {[info exists sbdef($i)] && $sbdef($i)==$sb($i)} {set co "#"}
puts $fid "${co}set sb($i) [list $sb($i)]"
}
puts $fid "\n"
}



if {[info procs winstdout]==""} {

proc winerrout {w msg {type "bell & flash"}} {
if {![winfo exists $w]} return
set bell [string match "*bell*" $type]
set flash [string match "*flash*" $type]

set fg [$w cget -foreground]; set bg [$w cget -background]

set msgout [string range $msg 0 500]
if {[string length $msg]>500} {
append msgout " ... (truncated; full message sent to stdout)"
puts stderr $msg
}
winstdout $w $msgout
if {$flash} {$w configure -foreground $bg -background $fg}
if {$bell} bell
if {$flash} {
update idletasks; after 500
$w configure -foreground $fg -background $bg
}
}

proc winstdout {w {msg AnUnLiKeMeSsAgE} {update 0}} {
if {![winfo exists $w]} return
if {$msg!="AnUnLiKeMeSsAgE"} {
$w configure -text $msg
if {$update} { update idletasks }
}
return [$w cget -text]
}

}





set findx(matches) {}
set findx(expr) {}
set findx(rexpr) {}
set findx(seen) 0
proc findfile {dir filepattern} {
find $dir [subst -nocommands {[string match $filepattern \$file]}]
}
proc find {dir expr {rexpr 1}} {
global findx
set olddir [pwd]

set findx(matches) {}
set findx(expr) $expr
set findx(rexpr) $rexpr
set findx(seen) 0
find1 $dir 0 $olddir

return $findx(matches)
}

proc find1 {dir depth updir} {
global findx

if ![expr $findx(rexpr)] return
if [catch {cd $dir}] return
set f(dir) $dir
foreach file [glob -nocomplain *] {
incr findx(seen)
if [catch {file lstat $file f}] continue
set subupdir ..; if {$f(type)=="link" && [file isdirectory $file]} {set f(type) "directory"; set subupdir [pwd]}
set f(tail) $file
set relpath [file join $dir $file]
if {[expr $findx(expr)]} {lappend findx(matches) $relpath}

if {[file isdirectory $relpath]} {
foreach match [find1 $relpath [expr $depth+1] $subupdir] {lappend findx(matches) $match}
}
}
cd $updir
}


proc pipeexp {p} {
set p [string trim $p]

set expp ""
foreach i $p {
if {[regexp {^[.~/$]} $i]} {lappend expp [fileexp $i]} \
else {lappend expp $i}
}
return $expp
}

proc assert {bool msg {boom 0}} {
if {!$bool} {
puts stderr $msg
if $boom {exit 1}
}
}

proc fileexp {f} {
global env

set f [string trim $f]
set l [string length $f]
set expf ""

set dir [pwd]
foreach i [split $f "/"] {
switch -glob $i {
"" {set dir ""}
~  {set dir $env(HOME)}
$* {set val $env([string trim [string range $i 1 end] ()])
if {[string match /* $val]} {set dir $val} {append expf /$val)}}
.  {set dir $dir}
.. {set dir [file dirname $dir]}
default {append expf /$i}
}
}

return $dir$expf
}



proc filetail {f} {
set tail [file tail $f]
if [string match */ $f] {set tail ""}
return $tail
}
proc filedirname {f} {
set dirname [file dirname $f]
if [string match ?*/ $f] {set dirname [string range $f 0 [expr [string length $f]-2]]}
return $dirname
}

proc filecomplete {f} {
set expf [fileexp [filedirname $f]]/[filetail $f]
set posn [string last [filetail $f] $f]; if [string match */ $f] { set posn [string length $f] }
set l [glob -nocomplain $expf*]
set ll [llength $l]

if {!$ll} {
set tail ""
} elseif {$ll==1} {
set tail [file tail $l]
if {[file isdirectory $l]} {append tail /}
} else {
set lf [lfirst $l]; set lfl [string length $lf]
set last $lfl
set ni [expr [string last / $lf]+1]
foreach i $l {
set il [string length $i]
for {set j $ni} {$j<=$last} {incr j} {
if {[string range $lf $j $j]!=[string range $i $j $j]} break
}
set last [min $last [expr $j-1]]
}
set tail [filetail [string range [lfirst $l] 0 $last]]
}

if {$posn>0 && $ll} {
set tail [string range $f 0 [expr $posn-1]]$tail
}

if {$ll<2} {return $tail} {return "$tail $l"}
}



proc isalpha {c} {return [regexp -nocase {[a-z]} $c]}
proc isnum {c} {return [expr [string first $c "123456790"]!=-1]}
proc isalphanum {c} {return [expr [isalpha $c]||[isnum $c]]}

proc stringicap {s} {return [string toupper [string range $s 0 0]][string range $s 1 end]}

proc tr {s c1 c2} {
regsub -all "\[$c1\]" $s $c2 s2
return $s2
}

proc bolg {f {l ""}} {
if {$l==""} {global file; set l $file(globList)}

foreach i $l {
if [regsub ([glob -nocomplain $i])(.*) $f "$i\\2" short] {return $short}
}
return $f
}


proc setinsert {l i e} {
return [linsert [lfilter $e $l] $i $e]
}


proc unsplit {l c} {
foreach i $l {
append l2 $i $c
}
return [string range $l2 0 [expr [string length $l2]-2]]
}

proc bytes2prefix {x} {
set pfx {bytes KB MB GB TB QB}
set k 1024.0
set sz $k

if {$x<$k} {return "$x bytes"}

set y BIG
for {set i 0} {$i<[llength $pfx]} {incr i} {
if {$x<$sz} {
return [format " %0.1f [lindex $pfx $i]" [expr $x/($sz/$k)]]
}
set sz [expr $sz*$k]
}
}




proc quote {x} {return $x}

proc uniqlist {l} {
set e ""
set l2 ""
foreach i $l {
if {$e!=$i} {
lappend l2 $i
set e $i
}
}
return $l2
}


