mingw/lib/tcl8.5/word.tcl

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