Commit | Line | Data |
---|---|---|
86530b38 AT |
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 2002/11/01 00:28:51 andreas_kupries Exp $ | |
14 | ||
15 | # The following variables are used to determine which characters are | |
16 | # interpreted as white space. | |
17 | ||
18 | if {[string equal $::tcl_platform(platform) "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 | ||
39 | proc 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 | ||
59 | proc tcl_wordBreakBefore {str start} { | |
60 | global tcl_nonwordchars tcl_wordchars | |
61 | if {[string equal $start 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 | ||
82 | proc 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 | ||
103 | proc 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 | ||
121 | proc tcl_startOfPreviousWord {str start} { | |
122 | global tcl_nonwordchars tcl_wordchars | |
123 | if {[string equal $start 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 | } |