home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / comanche.exe / lib / tcl8.0 / word.tcl < prev   
Text File  |  1999-02-24  |  4KB  |  136 lines
  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. # RCS: @(#) $Id: word.tcl,v 1.3 1998/09/14 18:40:03 stanton Exp $
  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. }
  136.