SGI/util/SGI/lib/tcl8.0/word.tcl

   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 #
   9 # See the file "license.terms" for information on usage and redistribution
  10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11 #
  12 # SCCS: @(#) word.tcl 1.2 96/11/20 14:07:22
  13 #
  14 # See the file "license.terms" for information on usage and redistribution
  15 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  16 #
  17
  18 # The following variables are used to determine which characters are
  19 # interpreted as white space.
  20
  21 if {$tcl_platform(platform) == "windows"} {
  22     # Windows style - any but space, tab, or newline
  23     set tcl_wordchars "\[^ \t\n\]"
  24     set tcl_nonwordchars "\[ \t\n\]"
  25 } else {
  26     # Motif style - any number, letter, or underscore
  27     set tcl_wordchars {[a-zA-Z0-9_]}
  28     set tcl_nonwordchars {[^a-zA-Z0-9_]}
  29 }
  30
  31 # tcl_wordBreakAfter --
  32 #
  33 # This procedure returns the index of the first word boundary
  34 # after the starting point in the given string, or -1 if there
  35 # are no more boundaries in the given string.  The index returned refers
  36 # to the first character of the pair that comprises a boundary.
  37 #
  38 # Arguments:
  39 # str -         String to search.
  40 # start -       Index into string specifying starting point.
  41
  42 proc tcl_wordBreakAfter {str start} {
  43     global tcl_nonwordchars tcl_wordchars
  44     set str [string range $str $start end]
  45     if [regexp -indices "$tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars" $str result] {
  46         return [expr [lindex $result 1] + $start]
  47     }
  48     return -1
  49 }
  50
  51 # tcl_wordBreakBefore --
  52 #
  53 # This procedure returns the index of the first word boundary
  54 # before the starting point in the given string, or -1 if there
  55 # are no more boundaries in the given string.  The index returned
  56 # refers to the second character of the pair that comprises a boundary.
  57 #
  58 # Arguments:
  59 # str -         String to search.
  60 # start -       Index into string specifying starting point.
  61
  62 proc tcl_wordBreakBefore {str start} {
  63     global tcl_nonwordchars tcl_wordchars
  64     if {[string compare $start end] == 0} {
  65         set start [string length $str]
  66     }
  67     if [regexp -indices "^.*($tcl_wordchars$tcl_nonwordchars|$tcl_nonwordchars$tcl_wordchars)" [string range $str 0 $start] result] {
  68         return [lindex $result 1]
  69     }
  70     return -1
  71 }
  72
  73 # tcl_endOfWord --
  74 #
  75 # This procedure returns the index of the first end-of-word location
  76 # after a starting index in the given string.  An end-of-word location
  77 # is defined to be the first whitespace character following the first
  78 # non-whitespace character after the starting point.  Returns -1 if
  79 # there are no more words after the starting point.
  80 #
  81 # Arguments:
  82 # str -         String to search.
  83 # start -       Index into string specifying starting point.
  84
  85 proc tcl_endOfWord {str start} {
  86     global tcl_nonwordchars tcl_wordchars
  87     if [regexp -indices "$tcl_nonwordchars*$tcl_wordchars+$tcl_nonwordchars" \
  88             [string range $str $start end] result] {
  89         return [expr [lindex $result 1] + $start]
  90     }
  91     return -1
  92 }
  93
  94 # tcl_startOfNextWord --
  95 #
  96 # This procedure returns the index of the first start-of-word location
  97 # after a starting index in the given string.  A start-of-word
  98 # location is defined to be a non-whitespace character following a
  99 # whitespace character.  Returns -1 if there are no more start-of-word
 100 # locations after the starting point.
 101 #
 102 # Arguments:
 103 # str -         String to search.
 104 # start -       Index into string specifying starting point.
 105
 106 proc tcl_startOfNextWord {str start} {
 107     global tcl_nonwordchars tcl_wordchars
 108     if [regexp -indices "$tcl_wordchars*$tcl_nonwordchars+$tcl_wordchars" \
 109             [string range $str $start end] result] {
 110         return [expr [lindex $result 1] + $start]
 111     }
 112     return -1
 113 }
 114
 115 # tcl_startOfPreviousWord --
 116 #
 117 # This procedure returns the index of the first start-of-word location
 118 # before a starting index in the given string.
 119 #
 120 # Arguments:
 121 # str -         String to search.
 122 # start -       Index into string specifying starting point.
 123
 124 proc tcl_startOfPreviousWord {str start} {
 125     global tcl_nonwordchars tcl_wordchars
 126     if {[string compare $start end] == 0} {
 127         set start [string length $str]
 128     }
 129     if [regexp -indices \
 130             "$tcl_nonwordchars*($tcl_wordchars+)$tcl_nonwordchars*\$" \
 131             [string range $str 0 [expr $start - 1]] result word] {
 132         return [lindex $word 0]
 133     }
 134     return -1
 135 }