#---------------
# 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
break
}
}
demoMG: 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 likeset 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!
