# 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

}