Subversion Repositories or1k

# 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.

#

# 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.1.1.1 2002-01-16 10:25:30 markom Exp $

# 

# See the file "license.terms" for information on usage and redistribution

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#

# The following variables are used to determine which characters are

# interpreted as white space.  

# CYGNUS local: Always use Motif-style selection

#if {$tcl_platform(platform) == "windows"} {

    # Windows style - any but space, tab, or newline

#    set tcl_wordchars "\[^ \t\n\]"

#    set tcl_nonwordchars "\[ \t\n\]"

#} else {

    # Motif style - any number, letter, or underscore

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

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

#}

# 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 {[string compare $start end] == 0} {

        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 {[string compare $start end] == 0} {

        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

}