HP/util/HP/lib/tcl8.3/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 # 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.6 2000/01/21 02:25:38 hobbs 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 }