Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: data/media/tcl8.4/word.tcl @ 5506

Last change on this file since 5506 was 5167, checked in by rgrieder, 16 years ago

added svn property svn:eol-style native to all tcl files

  • Property svn:eol-style set to native
File size: 4.2 KB
Line 
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}
Note: See TracBrowser for help on using the repository browser.