Posted to tcl by kostix at Sun Jan 06 23:42:13 GMT 2008view raw

  1. ##########################################################################
  2. # Search in text widget
  3.  
  4. proc search::glob2regexp {pattern} {
  5. string map {\\* \\*
  6. \\? \\?
  7. \\[ \\[
  8. * .*
  9. ? .
  10. [^] \\^
  11. [^ [\\^
  12. [! [^
  13. | \\|
  14. + \\+
  15. ( \\(
  16. ) \\)
  17. $ \\$
  18. . \\.
  19. \" \\"} $pattern
  20. }
  21.  
  22. proc search::do_text_search {txt pattern dir} {
  23. variable options
  24.  
  25. if {![string length $pattern]} {
  26. return 0
  27. }
  28.  
  29. if {$dir == "up"} {
  30. set search_from sel_start
  31. set search_to 0.0
  32. set search_dir -backwards
  33. } else {
  34. set search_from "sel_start +1char"
  35. set search_to end
  36. set search_dir -forwards
  37. }
  38.  
  39. if {$options(case)} {
  40. set case ""
  41. } else {
  42. set case -nocase
  43. }
  44.  
  45. switch -- $options(mode) {
  46. regexp {
  47. set exact -regexp
  48. }
  49. glob {
  50. set exact -regexp
  51. set pattern [glob2regexp $pattern]
  52. }
  53. default {
  54. set exact -exact
  55. }
  56. }
  57.  
  58. if {[catch { eval [list $txt] search $search_dir $case $exact -- \
  59. [list $pattern $search_from] } index]} {
  60. set index {}
  61. }
  62.  
  63. if {![string length $index]} {
  64. return 0
  65. } else {
  66. $txt tag remove search_highlight 0.0 end
  67. if {$exact == "-regexp"} {
  68. set line [$txt get $index "$index lineend"]
  69. eval regexp $case -- [list $pattern $line] match
  70. $txt tag add search_highlight $index "$index + [string length $match] chars"
  71. if {[string length $match] == 0} {
  72. set nohighlight 1
  73. } else {
  74. set nohighlight 0
  75. }
  76. } else {
  77. $txt tag add search_highlight $index "$index + [string length $pattern] chars"
  78. if {[string length $pattern] == 0} {
  79. set nohighlight 1
  80. } else {
  81. set nohighlight 0
  82. }
  83. }
  84. if {!$nohighlight} {
  85. $txt tag configure search_highlight -background \
  86. [option get $txt highlightSearchBackground Text]
  87. $txt mark set sel_start search_highlight.first
  88. $txt mark set sel_end search_highlight.last
  89. $txt see $index
  90. return 1
  91. }
  92. }
  93. }
  94.