Mercurial > repos > rliterman > csp2

annotate CSP2/CSP2_env/env-d9b9114564458d9d-741b3de822f2aaca6c6caa4325c4afce/lib/tcl8.6/word.tcl @ 68:5028fdace37b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload commit 2e9511a184a1ca667c7be0c6321a36dc4e3d116d
author jpayne
date Tue, 18 Mar 2025 16:23:26 -0400
parents
children
rev   line source
jpayne@68 1 # word.tcl --
jpayne@68 2 #
jpayne@68 3 # This file defines various procedures for computing word boundaries in
jpayne@68 4 # strings. This file is primarily needed so Tk text and entry widgets behave
jpayne@68 5 # properly for different platforms.
jpayne@68 6 #
jpayne@68 7 # Copyright (c) 1996 Sun Microsystems, Inc.
jpayne@68 8 # Copyright (c) 1998 Scritpics Corporation.
jpayne@68 9 #
jpayne@68 10 # See the file "license.terms" for information on usage and redistribution
jpayne@68 11 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
jpayne@68 12
jpayne@68 13 # The following variables are used to determine which characters are
jpayne@68 14 # interpreted as white space.
jpayne@68 15
jpayne@68 16 if {$::tcl_platform(platform) eq "windows"} {
jpayne@68 17 # Windows style - any but a unicode space char
jpayne@68 18 if {![info exists ::tcl_wordchars]} {
jpayne@68 19 set ::tcl_wordchars {\S}
jpayne@68 20 }
jpayne@68 21 if {![info exists ::tcl_nonwordchars]} {
jpayne@68 22 set ::tcl_nonwordchars {\s}
jpayne@68 23 }
jpayne@68 24 } else {
jpayne@68 25 # Motif style - any unicode word char (number, letter, or underscore)
jpayne@68 26 if {![info exists ::tcl_wordchars]} {
jpayne@68 27 set ::tcl_wordchars {\w}
jpayne@68 28 }
jpayne@68 29 if {![info exists ::tcl_nonwordchars]} {
jpayne@68 30 set ::tcl_nonwordchars {\W}
jpayne@68 31 }
jpayne@68 32 }
jpayne@68 33
jpayne@68 34 # Arrange for caches of the real matcher REs to be kept, which enables the REs
jpayne@68 35 # themselves to be cached for greater performance (and somewhat greater
jpayne@68 36 # clarity too).
jpayne@68 37
jpayne@68 38 namespace eval ::tcl {
jpayne@68 39 variable WordBreakRE
jpayne@68 40 array set WordBreakRE {}
jpayne@68 41
jpayne@68 42 proc UpdateWordBreakREs args {
jpayne@68 43 # Ignores the arguments
jpayne@68 44 global tcl_wordchars tcl_nonwordchars
jpayne@68 45 variable WordBreakRE
jpayne@68 46
jpayne@68 47 # To keep the RE strings short...
jpayne@68 48 set letter $tcl_wordchars
jpayne@68 49 set space $tcl_nonwordchars
jpayne@68 50
jpayne@68 51 set WordBreakRE(after) "$letter$space|$space$letter"
jpayne@68 52 set WordBreakRE(before) "^.*($letter$space|$space$letter)"
jpayne@68 53 set WordBreakRE(end) "$space*$letter+$space"
jpayne@68 54 set WordBreakRE(next) "$letter*$space+$letter"
jpayne@68 55 set WordBreakRE(previous) "$space*($letter+)$space*\$"
jpayne@68 56 }
jpayne@68 57
jpayne@68 58 # Initialize the cache
jpayne@68 59 UpdateWordBreakREs
jpayne@68 60 trace add variable ::tcl_wordchars write ::tcl::UpdateWordBreakREs
jpayne@68 61 trace add variable ::tcl_nonwordchars write ::tcl::UpdateWordBreakREs
jpayne@68 62 }
jpayne@68 63
jpayne@68 64 # tcl_wordBreakAfter --
jpayne@68 65 #
jpayne@68 66 # This procedure returns the index of the first word boundary after the
jpayne@68 67 # starting point in the given string, or -1 if there are no more boundaries in
jpayne@68 68 # the given string. The index returned refers to the first character of the
jpayne@68 69 # pair that comprises a boundary.
jpayne@68 70 #
jpayne@68 71 # Arguments:
jpayne@68 72 # str - String to search.
jpayne@68 73 # start - Index into string specifying starting point.
jpayne@68 74
jpayne@68 75 proc tcl_wordBreakAfter {str start} {
jpayne@68 76 variable ::tcl::WordBreakRE
jpayne@68 77 set result {-1 -1}
jpayne@68 78 regexp -indices -start $start -- $WordBreakRE(after) $str result
jpayne@68 79 return [lindex $result 1]
jpayne@68 80 }
jpayne@68 81
jpayne@68 82 # tcl_wordBreakBefore --
jpayne@68 83 #
jpayne@68 84 # This procedure returns the index of the first word boundary before the
jpayne@68 85 # starting point in the given string, or -1 if there are no more boundaries in
jpayne@68 86 # the given string. The index returned refers to the second character of the
jpayne@68 87 # pair that comprises a boundary.
jpayne@68 88 #
jpayne@68 89 # Arguments:
jpayne@68 90 # str - String to search.
jpayne@68 91 # start - Index into string specifying starting point.
jpayne@68 92
jpayne@68 93 proc tcl_wordBreakBefore {str start} {
jpayne@68 94 variable ::tcl::WordBreakRE
jpayne@68 95 set result {-1 -1}
jpayne@68 96 regexp -indices -- $WordBreakRE(before) [string range $str 0 $start] result
jpayne@68 97 return [lindex $result 1]
jpayne@68 98 }
jpayne@68 99
jpayne@68 100 # tcl_endOfWord --
jpayne@68 101 #
jpayne@68 102 # This procedure returns the index of the first end-of-word location after a
jpayne@68 103 # starting index in the given string. An end-of-word location is defined to be
jpayne@68 104 # the first whitespace character following the first non-whitespace character
jpayne@68 105 # after the starting point. Returns -1 if there are no more words after the
jpayne@68 106 # starting point.
jpayne@68 107 #
jpayne@68 108 # Arguments:
jpayne@68 109 # str - String to search.
jpayne@68 110 # start - Index into string specifying starting point.
jpayne@68 111
jpayne@68 112 proc tcl_endOfWord {str start} {
jpayne@68 113 variable ::tcl::WordBreakRE
jpayne@68 114 set result {-1 -1}
jpayne@68 115 regexp -indices -start $start -- $WordBreakRE(end) $str result
jpayne@68 116 return [lindex $result 1]
jpayne@68 117 }
jpayne@68 118
jpayne@68 119 # tcl_startOfNextWord --
jpayne@68 120 #
jpayne@68 121 # This procedure returns the index of the first start-of-word location after a
jpayne@68 122 # starting index in the given string. A start-of-word location is defined to
jpayne@68 123 # be a non-whitespace character following a whitespace character. Returns -1
jpayne@68 124 # if there are no more start-of-word locations after the starting point.
jpayne@68 125 #
jpayne@68 126 # Arguments:
jpayne@68 127 # str - String to search.
jpayne@68 128 # start - Index into string specifying starting point.
jpayne@68 129
jpayne@68 130 proc tcl_startOfNextWord {str start} {
jpayne@68 131 variable ::tcl::WordBreakRE
jpayne@68 132 set result {-1 -1}
jpayne@68 133 regexp -indices -start $start -- $WordBreakRE(next) $str result
jpayne@68 134 return [lindex $result 1]
jpayne@68 135 }
jpayne@68 136
jpayne@68 137 # tcl_startOfPreviousWord --
jpayne@68 138 #
jpayne@68 139 # This procedure returns the index of the first start-of-word location before
jpayne@68 140 # a starting index in the given string.
jpayne@68 141 #
jpayne@68 142 # Arguments:
jpayne@68 143 # str - String to search.
jpayne@68 144 # start - Index into string specifying starting point.
jpayne@68 145
jpayne@68 146 proc tcl_startOfPreviousWord {str start} {
jpayne@68 147 variable ::tcl::WordBreakRE
jpayne@68 148 set word {-1 -1}
jpayne@68 149 if {$start > 0} {
jpayne@68 150 regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \
jpayne@68 151 result word
jpayne@68 152 }
jpayne@68 153 return [lindex $word 0]
jpayne@68 154 }