Tk Text Window Brace Parenthesis, and Bracket Matching

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.

[L1 ]

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
        }
}

Discussion

DDG - 2023-08-30: Really nice code! I took it and made it usable as a text widget Mixin out of it using oowidgets. The code is added to the example mixins here. https://github.com/mittelmark/oowidgets/blob/main/paul/txmixins.tcl %|%txmixins.tcl%|%

Here is some example code to use this mixin:

package require paul
set txt [tkoo::text .txtm -background salmon -font "Courier 18"]
$txt insert  end "Start typing some text containing\n" 
$txt insert end "* parenthesis ( and )\n"
$txt insert end "* brackets    \[ and \]\n"
$txt insert end "* braces      { and }\n\n"
oo::objdefine $txt mixin paul::txmatching
$txt matchbrace
$txt matchparen
$txt matchbracket
pack $txt -side top -fill both -expand yes
### adding your own additional bindings is still possible
bind $txt <KeyRelease> +[list puts "now pressed %K"]