Wordselect -Modifying the Text Widget Binding to Select Words Without any Surrounding Punctuation.

WJG 2006-06-23: The default bindings of the text widget does allow for word selections: a Double-Button-1 event will place the selection tag around a word. In this case a word is any group of printable characters surrounded by whitespace. This is a valid "progammer's" definition of a word but not for those working with natural languages. The following simple proceedure will create a selection without any punctuation.

# wordselect.tcl
# William J Giddings, 2006
# Notes:
# -----
# The default <Double-Button-1> binding in the text widget
# creates a selection around a word delimited by whitspace.
# In practice however, a word is also delimted by punctuation marks.
# This package provides a simple way of selecting the literal word alone 
# rather than any surrounding punctuation.
# Args:
# ----
# w   the text widget with active focus
# Comments:
# --------
# none

# adjust selection to remove any leading/trailing punctuation
proc select {w} {

 # cut away the extras
 set str [$w get "insert wordstart" "insert wordend"]
 if { $str == {} } {return}
 set str2 {_<>,.!\/£$%^&*-+=~@?;:'(){}[]\"}  
 set str [string trimright $str $str2]
 set str [string trimleft $str $str2]
 # reset selection range, search within selection
 set a [$w search -forwards $str "insert wordstart" "insert wordend"]
 set b [split $a .]
 # reposition the tag
 $w tag remove sel 1.0 end
 $w tag add sel $a [lindex $b 0].[expr [lindex $b 1] + [string length $str]]


# the ubiquitous demo
proc demo {} {

 console show
 pack [text .t1 -font {Times 12} -height 7] -fill both -expand 1
 pack [text .t2 -font {Times 12} -height 7 -bg #ffffdd] -fill both -expand 1

 set tmp {An umberella lay alongside the door.\n"Who's is that?" Said Ellie, suprised by it all.\n"Whose what?" Snapped George.\n"No, 'who's'! You deaf old fool!"}

 .t1 insert end $tmp
 .t2 insert end $tmp

 # modify the bindings for the top widget only  
 bind .t1 <Double-Button-1> { 
   select %W
   # prevent default binding selecting to the whitespace



MG: You can also achieve the same effect by setting $tcl_wordchars and $tcl_nonwordchars:

catch {tcl_endOfWord} ; # make sure Tcl already has the vars set
set tcl_wordchars {\w}
set tcl_nonwordchars {\W}

(In this case, I believe \w matches a-z, A-Z and _ (underscore). You can also set more explicit ranges of characters with something like

set tcl_wordchars    {[a-zA-Z0-9_'-]}
set tcl_nonwordchars {[^a-zA-Z0-9_'-]}

, which will include apostrophes and hyphens.

LV: See $tcl_wordchars and $tcl_nonwordchars for a description of what goes into the variable.

WJG: MG, thanks for pointing that out. As you can tell, I seldom read the manual and never read the small print!