wdb When double-clicking on an opening paren in Emacs, the whole expression is selected. This feature is which I like mostly at Emacs, and which I miss mostly on almost all other program editors.
So I have written a little package which changes the core bindings of Tk's text widget. If you source it, double-clicking on opening paren, brace, bracket, or quote searches the closing counterpart and extends the selection to that point.
So, you can write an own IDE in Tcl/Tk, or extend an existing one.
#
# package doubleclick
#
# (c) Wolf-Dieter Busch
#
# license: OLL (One Line Licence):
# Use it, change it, but do not blame me.
#
# changes behaviour of mouse <Double-1> as follows:
# <Double-1> on word char selects word characters only
# <Double-1> on other char selects non-space characters
# <Double-1> on opening brace selects to matching counterpart
# <Double-1> on opening paren or brace or double quote does the same
#
# changed binding on tag Text and event <Double-1>
# changed procedure: ::tk::TextSelectTo
# changed procedure: ::tk::TextNextPos
# new procedure: ::tk::TextCharAtXYescaped
# new procedure: tcl_findClosingBrace
#
# contents of pkgIndex:tcl:
# package ifneeded doubleclick 0.4 [list source [file join $dir doubleclick.tcl]]
#
package require Tk
package provide doubleclick 0.4
bind Text <Double-1> {
if {[regexp \\w [%W get @%x,%y]]} then {
set tcl_wordchars \\w
set tcl_nonwordchars \\W
} else {
set tcl_wordchars \\s
set tcl_nonwordchars \\S
}
set tk::Priv(selectMode) word
tk::TextSelectTo %W %x %y
catch {%W mark set insert sel.last}
}
proc tcl_findClosingBrace {str start} {
# if letter at $start is \{ or \[ or \" or \(
# then return index of closing counterpart -- if any
# else return [tcl_wordBreakAfter $str $start]
set brace [string index $str $start]
array set close [list \{ \} \[ \] \" \"]
switch $brace {
\( {
tcl_findClosingBrace [string map [list \( \{ \) \}] $str] $start
}
\{ - \[ - \" {
set end [expr {$start + 1}]
set let $close($brace)
while true {
set end [string first $let $str $end]
if {$end < 0} then {
return [tcl_wordBreakAfter $str $start]
} elseif {[info complete [string range $str $start $end]]} then {
return [expr {$end + 1}]
} else {
incr end
}
}
}
default {
tcl_wordBreakAfter $str $start
}
}
}
proc ::tk::TextCharAtXYescaped {w x y} {
# return true if char at x, y is backslash (\) escaped
set index [$w index @$x,$y]
set str [$w get "$index linestart" $index]
set index [string length $str]
set i 0
while {[string index $str [incr index -1]] eq "\\"} {
incr i
}
expr {$i % 2 == 1 ? yes : no}
}
proc ::tk::TextSelectTo {w x y {extend 0}} {
global tcl_platform
variable ::tk::Priv
set cur [TextClosestGap $w $x $y]
if {[catch {$w index anchor}]} {
$w mark set anchor $cur
}
set anchor [$w index anchor]
if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
set Priv(mouseMoved) 1
}
switch $Priv(selectMode) {
char {
if {[$w compare $cur < anchor]} {
set first $cur
set last anchor
} else {
set first anchor
set last $cur
}
}
word {
if {[$w compare $cur < anchor]} {
set first [TextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
if { !$extend } {
set last [TextNextPos $w "anchor" tcl_wordBreakAfter]
} else {
set last anchor
}
} else {
if {[TextCharAtXYescaped $w $x $y]} then {
set last [TextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
} else {
set last [TextNextPos $w "$cur - 1c" tcl_findClosingBrace]
}
set last [TextNextPos $w "$cur - 1c" tcl_findClosingBrace]
if { !$extend } {
set first [TextPrevPos $w anchor tcl_wordBreakBefore]
} else {
set first anchor
}
}
}
line {
if {[$w compare $cur < anchor]} {
set first [$w index "$cur linestart"]
set last [$w index "anchor - 1c lineend + 1c"]
} else {
set first [$w index "anchor linestart"]
set last [$w index "$cur lineend + 1c"]
}
}
}
if {$Priv(mouseMoved) || $Priv(selectMode) ne "char"} {
$w tag remove sel 0.0 end
$w mark set insert $cur
$w tag add sel $first $last
$w tag remove sel $last end
update idletasks
}
}
proc ::tk::TextNextPos {w start op} {
set text ""
set cur $start
while {[$w compare $cur < end]} {
if {$op eq "tcl_findClosingBrace"} then {
# here you can adjust how many lines are checked
set cur1 [$w index "$cur lineend +1c + 500l"]
# set cur1 [$w index end]
} else {
set cur1 [$w index "$cur lineend +1c"]
}
set text $text[$w get $cur $cur1]
set pos [$op $text 0]
if {$pos >= 0} {
## Adjust for embedded windows and images
## dump gives us 3 items per window/image
set dump [$w dump -image -window $start "$start + $pos c"]
if {[llength $dump]} {
set pos [expr {$pos + ([llength $dump]/3)}]
}
return [$w index "$start + $pos c"]
}
set cur [$w index $cur1]
}
return end
}