wdb the primary package (see below) lacked to work properly with newer Tk versions because of assumptions of source code for
Text widget. So, tonight, I made a simpler version.
Benefits: only one procedure, tk::selectToClosingChar, which does both: extend selection to matching close character, and return true on success, otherwise false; a second procedure binds an individual window to the new behaviour. Short source.
Update see final version in my homepage [
1]!
License:
OLL. Have fun!
package require Tk
# pack [text .t -wrap word] -expand yes -fill both
# .t insert 1.0 {abc "eins zwo drei" {a b c} links zwo drei (am arsch klavier) <wie lang> ist die chaussee }
proc ::tk::selectToClosingChar {w x y} {
set i0 [$w index @$x,$y]
lappend transList \u007b \u007d\
\" \" ' ' „ “ ‚ ‘ “ ” ‘ ’\
\u00bb \u00ab \u00ab \u00bb \u203a \u2039 \u2039 \u203a\
\[ \] < > \u0028 \u0029
set c0 [$w get $i0]
if {![dict exists $transList $c0]} then {
return false
}
set c1 [dict get $transList $c0]
if {$c0 ne "\{" && $c0 ne {"}} then {
set i1 [$w search $c1 $i0+1chars end]
if {$i1 eq ""} then {
return false
}
$w tag add sel $i0 $i1+1chars
$w mark set insert $i0
return true
} else {
set i1 $i0
while true {
set i1 [$w search $c1 $i1+1chars end]
if {$i1 eq ""} then {
return false
}
if {[info complete [$w get $i0 $i1+1chars]]} then {
$w tag add sel $i0 $i1+1chars
$w mark set insert $i0
return true
}
}
}
}
proc doubleClick win {
bind $win <Double-1> {
if {[tk::selectToClosingChar %W %x %y]} then break
}
}(Below outdated version)
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 and published under
oll. 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
}
