doubleclick

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
 }