[5180] | 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 | |
---|
| 18 | if {$::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 | |
---|
| 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 {$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 | |
---|
| 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 {$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 | } |
---|