Viewing file:  word.tcl (4.23 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
# word.tcl --
#
# This file defines various procedures for computing word boundaries
# in strings. This file is primarily needed so Tk text and entry
# widgets behave properly for different platforms.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1998 by Scritpics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: word.tcl,v 1.7.2.1 2005/07/22 21:59:41 dgp Exp $
# The following variables are used to determine which characters are
# interpreted as white space.
if {$::tcl_platform(platform) eq "windows"} {
# Windows style - any but a unicode space char
set tcl_wordchars "\\S"
set tcl_nonwordchars "\\s"
} else {
# Motif style - any unicode word char (number, letter, or underscore)
set tcl_wordchars "\\w"
set tcl_nonwordchars "\\W"
}
# tcl_wordBreakAfter --
#
# This procedure returns the index of the first word boundary
# after the starting point in the given string, or -1 if there
# are no more boundaries in the given string. The index returned refers
# to the first character of the pair that comprises a boundary.
#
# Arguments:
# str - String to search.
# start - Index into string specifying starting point.
proc tcl_wordBreakAfter {str start} {
global tcl_nonwordchars tcl_wordchars
set str [string range $str $start end]
if {[regexp -indices "$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars" $str result]} {
return [expr {[lindex $result 1] + $start}]
}
return -1
}
# tcl_wordBreakBefore --
#
# This procedure returns the index of the first word boundary
# before the starting point in the given string, or -1 if there
# are no more boundaries in the given string. The index returned
# refers to the second character of the pair that comprises a boundary.
#
# Arguments:
# str - String to search.
# start - Index into string specifying starting point.
proc tcl_wordBreakBefore {str start} {
global tcl_nonwordchars tcl_wordchars
if {$start eq "end"} {
set start [string length $str]
}
if {[regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result]} {
return [lindex $result 1]
}
return -1
}
# tcl_endOfWord --
#
# This procedure returns the index of the first end-of-word location
# after a starting index in the given string. An end-of-word location
# is defined to be the first whitespace character following the first
# non-whitespace character after the starting point. Returns -1 if
# there are no more words after the starting point.
#
# Arguments:
# str - String to search.
# start - Index into string specifying starting point.
proc tcl_endOfWord {str start} {
global tcl_nonwordchars tcl_wordchars
if {[regexp -indices "$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars" \
[string range $str $start end] result]} {
return [expr {[lindex $result 1] + $start}]
}
return -1
}
# tcl_startOfNextWord --
#
# This procedure returns the index of the first start-of-word location
# after a starting index in the given string. A start-of-word
# location is defined to be a non-whitespace character following a
# whitespace character. Returns -1 if there are no more start-of-word
# locations after the starting point.
#
# Arguments:
# str - String to search.
# start - Index into string specifying starting point.
proc tcl_startOfNextWord {str start} {
global tcl_nonwordchars tcl_wordchars
if {[regexp -indices "$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars" \
[string range $str $start end] result]} {
return [expr {[lindex $result 1] + $start}]
}
return -1
}
# tcl_startOfPreviousWord --
#
# This procedure returns the index of the first start-of-word location
# before a starting index in the given string.
#
# Arguments:
# str - String to search.
# start - Index into string specifying starting point.
proc tcl_startOfPreviousWord {str start} {
global tcl_nonwordchars tcl_wordchars
if {$start eq "end"} {
set start [string length $str]
}
if {[regexp -indices \
"$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\$" \
[string range $str 0 [expr {$start - 1}]] result word]} {
return [lindex $word 0]
}
return -1
}
|