1# word.tcl -- 2# 3# This file defines various procedures for computing word boundaries 4# in strings. This file is primarily needed so Tk text and entry 5# widgets behave properly for different platforms. 6# 7# Copyright (c) 1996 by Sun Microsystems, Inc. 8# Copyright (c) 1998 by Scritpics Corporation. 9# 10# See the file "license.terms" for information on usage and redistribution 11# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 12# 13# RCS: @(#) $Id: word.tcl,v 1.7.2.1 2005/07/22 21:59:41 dgp Exp $ 14 15# The following variables are used to determine which characters are 16# interpreted as white space. 17 18if {$::tcl_platform(platform) eq "windows"} { 19 # Windows style - any but a unicode space char 20 set tcl_wordchars "\\S" 21 set tcl_nonwordchars "\\s" 22} else { 23 # Motif style - any unicode word char (number, letter, or underscore) 24 set tcl_wordchars "\\w" 25 set tcl_nonwordchars "\\W" 26} 27 28# tcl_wordBreakAfter -- 29# 30# This procedure returns the index of the first word boundary 31# after the starting point in the given string, or -1 if there 32# are no more boundaries in the given string. The index returned refers 33# to the first character of the pair that comprises a boundary. 34# 35# Arguments: 36# str - String to search. 37# start - Index into string specifying starting point. 38 39proc tcl_wordBreakAfter {str start} { 40 global tcl_nonwordchars tcl_wordchars 41 set str [string range $str $start end] 42 if {[regexp -indices "$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars" $str result]} { 43 return [expr {[lindex $result 1] + $start}] 44 } 45 return -1 46} 47 48# tcl_wordBreakBefore -- 49# 50# This procedure returns the index of the first word boundary 51# before the starting point in the given string, or -1 if there 52# are no more boundaries in the given string. The index returned 53# refers to the second character of the pair that comprises a boundary. 54# 55# Arguments: 56# str - String to search. 57# start - Index into string specifying starting point. 58 59proc tcl_wordBreakBefore {str start} { 60 global tcl_nonwordchars tcl_wordchars 61 if {$start eq "end"} { 62 set start [string length $str] 63 } 64 if {[regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result]} { 65 return [lindex $result 1] 66 } 67 return -1 68} 69 70# tcl_endOfWord -- 71# 72# This procedure returns the index of the first end-of-word location 73# after a starting index in the given string. An end-of-word location 74# is defined to be the first whitespace character following the first 75# non-whitespace character after the starting point. Returns -1 if 76# there are no more words after the starting point. 77# 78# Arguments: 79# str - String to search. 80# start - Index into string specifying starting point. 81 82proc tcl_endOfWord {str start} { 83 global tcl_nonwordchars tcl_wordchars 84 if {[regexp -indices "$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars" \ 85 [string range $str $start end] result]} { 86 return [expr {[lindex $result 1] + $start}] 87 } 88 return -1 89} 90 91# tcl_startOfNextWord -- 92# 93# This procedure returns the index of the first start-of-word location 94# after a starting index in the given string. A start-of-word 95# location is defined to be a non-whitespace character following a 96# whitespace character. Returns -1 if there are no more start-of-word 97# locations after the starting point. 98# 99# Arguments: 100# str - String to search. 101# start - Index into string specifying starting point. 102 103proc tcl_startOfNextWord {str start} { 104 global tcl_nonwordchars tcl_wordchars 105 if {[regexp -indices "$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars" \ 106 [string range $str $start end] result]} { 107 return [expr {[lindex $result 1] + $start}] 108 } 109 return -1 110} 111 112# tcl_startOfPreviousWord -- 113# 114# This procedure returns the index of the first start-of-word location 115# before a starting index in the given string. 116# 117# Arguments: 118# str - String to search. 119# start - Index into string specifying starting point. 120 121proc tcl_startOfPreviousWord {str start} { 122 global tcl_nonwordchars tcl_wordchars 123 if {$start eq "end"} { 124 set start [string length $str] 125 } 126 if {[regexp -indices \ 127 "$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\$" \ 128 [string range $str 0 [expr {$start - 1}]] result word]} { 129 return [lindex $word 0] 130 } 131 return -1 132} 133