Pattern regexp search (Tcl/Tk ) code

引用网址：http://hi.baidu.com/yy73/blog/item/96b005fab52e329159ee9012.html

 

 

  if {1} {
        set wsrh [frame $wf.srh -bd 0 -bg $backColor]
        pack $wsrh -side top -fill x -expand false -pady 0 -padx 0
        tixComboBox $wsrh.ins -label " Search in" -dropdown true -relief raised /
                            -editable true -variable kindOfProbe -selectmode browse /
                            -disablecallback true -browsecmd "kindOfProbeFromCombo"
      [$wsrh.ins subwidget entry] config -width 10 -font $fontMenu -takefocus 0 /
                   -fg red -selectforeground red -bg black -selectbackground black
      [$wsrh.ins subwidget listbox] config -font $fontMenu -height 6 -width 10 /
                      -selectforeground red -highlightthickness 1 -bg black -fg green
      set lst { instance net input output inout}
     foreach i $lst {
             $wsrh.ins insert end $i
      }
    set kindOfProbe [lindex $lst 0]

    frame $wsrh.pat -bd 0 -bg $backColor
     uiProbeNetPatternSearch "Pattern" $wsrh.pat "xyz"
     pack $wsrh.ins $wsrh.pat -side left -padx .1c -pady 0
    }

 

proc uiPatternPressKey {entryW k} {
    global patternList patternCurrentIdx
    switch $k {
"Up" {
     set patternCurrentIdx [expr $patternCurrentIdx - 1]
     if {$patternCurrentIdx eq -1} {
   set patternCurrentIdx [expr [llength $patternList] - 1]
     }
     $entryW delete 0 [string length [$entryW get]]
     $entryW insert 0 [lindex $patternList $patternCurrentIdx]
}
"Down" {
     incr patternCurrentIdx
     if {$patternCurrentIdx >= [llength $patternList]} {
   set patternCurrentIdx 0
     }
     $entryW delete 0 [string length [$entryW get]]
     $entryW insert 0 [lindex $patternList $patternCurrentIdx]
}
"Escape" {
     $entryW delete 0 [string length [$entryW get]]
}
default {}
    }
}

proc kindOfProbeFromCombo {sel} {
    global kindOfProbe
    set kindOfProbe $sel
}

proc uiFindProbePatternSignal {pattern} {
    global uiTopDispModuleInfoW kindOfProbe patternList patternCurrentIdx
    if {$pattern != "" && [lsearch -exact $patternList $pattern] eq -1} {
        lappend patternList $pattern
        incr patternCurrentIdx
    }
    if {[winfo exists $uiTopDispModuleInfoW($kindOfProbe)]} {
        set hlist $uiTopDispModuleInfoW($kindOfProbe)
        set data [$hlist info children]
for {set i 0} {$i < [llength $data]} {incr i} {
     set signalstr [$hlist item cget [lindex $data $i] 0 -text]
     if {[string match -nocase $pattern $signalstr]==0} {
   $hlist hide entry [lindex $data $i]
   # $hlist yview $i
     } else {
   $hlist show entry [lindex $data $i]
     }
}
    }
}

proc uiProbeNetPatternSearch {label w pattern} {
    global patternList patternCurrentIdx
    set patternList {}
    set patternCurrentIdx -1

    set len [string length $label]
    uiLabEntry $w.search $label $len 24 $pattern
    [$w.search subwidget entry] config -bg black -fg green -insertbackground green
    uiButton $w.filt Filter "uiFindProbePatternSignal $$pattern"
    $w.filt configure -width 4

    bind [$w.search subwidget entry] <Return> "uiFindProbePatternSignal $$pattern"
    bind <Key> "uiPatternPressKey %W %K"
    pack $w.search -side left -expand 0 -padx 1m -pady 0
    pack $w.filt -side left -padx 1m -pady 0
}