I wanted to see if I could match ()s, []s, and {}'s in files I load into a text widget. The following code will when the insertion cursor is placed next to ( my mouse or keyboard action ) or typing any []{}() character highlight the matching character. The code is generic enough for you to specify your own text tags for each match and your own begin/end characters to match. If no match is found or if any part of document is un balanced that will also be highlighted. I have used this in a ctext widget without problems.
[https://herewiki.tcl-lang.omrg/page/Brace+Parenthoesis+and+Bracketo.g+matchif|png|jpg+in+a+text+window]
======
namespace eval TextUtils {
# return -1 if idx1 if before idx2
# return 1 if idx1 is after idx2
# return 0 if idx1 is same as idx2
proc idxCompare { idx1 idx2 } {
if { "$idx1" eq "$idx2" } { return 0 }
lassign [split $idx1 . ] r1 col1
lassign [split $idx2 . ] r2 col2
if { $r1 < $r2 } { return -1; }
if { $r1 > $r2 } { return 1; }
if { $col1 < $col2 } { return -1; }
return 1;
}
proc markUnBalanced { w char matchChar tag2apply } {
set matched {}
set unmatched {}
set unmatchedEnd {}
$w tag remove $tag2apply 1.0 end
set tempCharIndexs [ $w search -forward -all "\\$char" 1.0 ]
set tempMatchIndexs [ $w search -forward -all "\\$matchChar" 1.0]
set charIndexs [ $w search -forward -all $char 1.0 ]
set matchIndexs [ $w search -forward -all $matchChar 1.0 ]
foreach idx $tempCharIndexs {
set rIdx [ lsearch $charIndexs [ $w index $idx+1c ] ]
if { $rIdx >= 0 } {
set charIndexs [lreplace $charIndexs $rIdx $rIdx ]
}
}
foreach idx $tempMatchIndexs {
set rIdx [ lsearch $matchIndexs [ $w index $idx+1c ] ]
if { $rIdx >= 0 } {
set matchIndexs [lreplace $matchIndexs $rIdx $rIdx ]
}
}
if { [llength $charIndexs ] == 0 } {
set unmatchedEnd $matchIndexs
} elseif { [llength $matchIndexs ] == 0 } {
set unmatched $charIndexs
} elseif { [llength $charIndexs ] == 1 && [llength $matchIndexs ] == 0 } {
if { [idxCompare [lindex $charIndexs 0 ] [lindex $matchIndexs0 ] ] > 0 } {
set matchedEnd [lindex $matchIndexs0 ]
set unmatched [lindex $charIndexs 0 ]
}
} else {
foreach endIdx $matchIndexs {
set c 0
while { $c < [llength $charIndexs ] && [idxCompare [lindex $charIndexs $c ] $endIdx ] < 0 } {
incr c ;
}
incr c -1;
if { $c >= [llength $charIndexs ] || $c < 0 } {
lappend unmatchedEnd $endIdx
} else {
lappend matched [list [lindex $charIndexs $c ] $endIdx ]
set charIndexs [lreplace $charIndexs $c $c ]
}
}
set unmatched $charIndexs
}
if { [llength $unmatched ] } {
foreach idx $unmatched {
$w tag add $tag2apply $idx $idx+1c
}
}
if { [llength $unmatchedEnd ] } {
foreach idx $unmatchedEnd {
$w tag add $tag2apply $idx $idx+1c
}
}
return $matched
}
proc genericHandler { w inputChar char matchChar matchtag unmatchtag } {
set matched [ TextUtils::markUnBalanced $w $char $matchChar $unmatchtag ]
set idx ""
if { "$inputChar" eq $matchChar || [$w get insert-1c insert ] eq $matchChar } {
set idx [$w index insert-1c ]
} elseif { [$w get insert insert+1c] eq $matchChar } {
set idx [$w index insert ]
}
if { $idx ne "" } {
set matchpair [ lsearch -inline -index 1 $matched $idx ]
if { [llength $matchpair ] } {
$w tag add $matchtag {*}$matchpair+1c
after 1000 [list $w tag remove $matchtag {*}$matchpair+1c ]
}
}
if { "$inputChar" eq $char || [$w get insert-1c insert ] eq $char } {
set idx [$w index insert-1c ]
} elseif { [$w get insert insert+1c] eq $char } {
set idx [$w index insert ]
}
if { $idx ne "" } {
set matchpair [ lsearch -inline -index 0 $matched $idx ]
if { [llength $matchpair ] } {
$w tag add $matchtag {*}$matchpair+1c
after 1000 [list $w tag remove $matchtag {*}$matchpair+1c ]
}
}
}
proc handleBracket { w input matchtag unmatchtag } {
genericHandler $w $input "\[" "\]" $matchtag $unmatchtag
}
proc handleParenthesis { w input matchtag unmatchtag } {
genericHandler $w $input "\(" "\)" $matchtag $unmatchtag
}
proc handleBrace { w input matchtag unmatchtag } {
genericHandler $w $input "\{" "\}" $matchtag $unmatchtag
}
}
package provide TextUtils 1.0
if { 1 } {
text .text -font { Helvetica 16 bold } -tabs { 20 left }
pack .text -expand 1 -fill both -anchor center
.text tag configure matchingBracket -background #ccffdd
.text tag configure unmatchingBracket -background #ff704d
.text tag configure matchingBrace -background #ffccff
.text tag configure unmatchingBrace -background #ff704d
.text tag configure matchingParen -background #b3ccff
.text tag configure unmatchingParen -background #ff704d
bind .text <KeyRelease> {
TextUtils::handleBracket %W %A matchingBracket unmatchingBracket
TextUtils::handleBrace %W %A matchingBrace unmatchingBrace
TextUtils::handleParenthesis %W %A matchingParen unmatchingParen
}
bind .text <ButtonRelease> {
TextUtils::handleBracket %W %A matchingBracket unmatchingBracket
TextUtils::handleBrace %W %A matchingBrace unmatchingBrace
TextUtils::handleParenthesis %W %A matchingParen unmatchingParen
}
}
======