home *** CD-ROM | disk | FTP | other *** search
/ PC World 1998 October / PCWorld_1998-10_cd.bin / software / prehled / komix / DATA.Z / searchgrou.tcl < prev    next >
Text File  |  1996-09-12  |  3KB  |  141 lines
  1. #---------------------------------------------------------------------------
  2. #
  3. #      (c)     Westmount Technology    1994
  4. #
  5. #      File:           @(#)searchgrou.tcl    /main/titanic/1
  6. #      Author:         <generated>
  7. #      Description:
  8. #---------------------------------------------------------------------------
  9. # SccsId = @(#)searchgrou.tcl    /main/titanic/1   12 Sep 1996 Copyright 1994 Westmount Technology
  10.  
  11. # Start user added include file section
  12. # End user added include file section
  13.  
  14.  
  15. Class SearchGroup : {DlgColumn} {
  16.     constructor
  17.     method destructor
  18.     method entrySet
  19.     method selected
  20.     method selectedIndex
  21.     method textLabel
  22.     method listLabel
  23.     method listSelectionChanged
  24.     method textValueChanged
  25.     method handleActivated
  26.     attribute _entrySet
  27.     attribute activated
  28. }
  29.  
  30. constructor SearchGroup {class this name} {
  31.     set this [DlgColumn::constructor $class $this $name]
  32.     # Start constructor user section
  33.  
  34.     Label new $this.textLabel -text \
  35.         "Type the first few characters of the word:"
  36.     SingleLineText new $this.text -textModified "$this textValueChanged"
  37.  
  38.     Label new $this.listLabel -text "Choose the word:"
  39.     TextList new $this.list \
  40.         -rowCount 16 \
  41.         -selectionChanged "$this listSelectionChanged" \
  42.         -activated "$this handleActivated"
  43.  
  44.     # End constructor user section
  45.     return $this
  46. }
  47.  
  48. method SearchGroup::destructor {this} {
  49.     # Start destructor user section
  50.     # End destructor user section
  51. }
  52.  
  53. method SearchGroup::entrySet {this {set -}} {
  54.     if {$set == "-"} {
  55.         return [$this _entrySet]
  56.     }
  57.     set displaySet ""
  58.     foreach entry $set {
  59.         regsub -all {[^,][^,]*,[ ]*} $entry "  " entry
  60.         lappend displaySet $entry
  61.     }
  62.     $this.list entrySet $displaySet
  63.     $this.text text ""
  64.     $this _entrySet $set
  65. }
  66.  
  67. method SearchGroup::selected {this {entry -}} {
  68.     if {$entry == "-"} {
  69.         set idx [$this.list selectedIndexSet]
  70.         if {$idx == ""} {
  71.             return ""
  72.         }
  73.         return [lindex [$this _entrySet] $idx]
  74.     } else {
  75.         set idx [lsearch -exact [$this _entrySet] $entry]
  76.         if {$idx != -1} {
  77.             $this.list selectedIndexSet $idx
  78.             $this.text text $entry
  79.         }
  80.     }
  81. }
  82.  
  83. method SearchGroup::selectedIndex {this {index -}} {
  84.     if {$index == "-"} {
  85.         return [$this.list selectedIndexSet]
  86.     }
  87.     $this.list selectedIndexSet $index
  88. }
  89.  
  90. method SearchGroup::textLabel {this {label -}} {
  91.     if {$label == "-"} {
  92.         return [$this.textLabel text]
  93.     }
  94.     $this.textLabel text $label
  95. }
  96.  
  97. method SearchGroup::listLabel {this {label -}} {
  98.     if {$label == "-"} {
  99.         return [$this.listLabel text]
  100.     }
  101.     $this.textLabel text $label
  102. }
  103.  
  104. method SearchGroup::listSelectionChanged {this} {
  105.     set idx [$this.list selectedIndexSet]
  106.     if {$idx == ""} {
  107.         $this.text text ""
  108.     } else {
  109.         $this.text text [lindex [$this _entrySet] $idx]
  110.     }
  111. }
  112.  
  113. method SearchGroup::textValueChanged {this} {
  114.      set idx [SearchGroup::search [$this _entrySet] [$this.text text]]
  115.      if {$idx != -1} {
  116.         $this.list selectedIndexSet $idx
  117.         $this.list setTopIndex $idx
  118.      }
  119. }
  120.  
  121. method SearchGroup::handleActivated {this} {
  122.     regsub -all %this [$this activated] $this result
  123.     uplevel #0 $result
  124. }
  125.  
  126. proc SearchGroup::search {list entry} {
  127.     set i 0
  128.     # Escape special characters in entry
  129.     regsub -all {[]|*+?\().-^$[]} $entry {\\&} entry
  130.     foreach elem $list {
  131.         if [regexp -nocase ^$entry $elem] {
  132.             return $i
  133.         }
  134.         incr i
  135.     }
  136.     return -1
  137. }
  138.  
  139. # Do not delete this line -- regeneration end marker
  140.  
  141.