1: ### 2: ## lmatch ?-exact|-glob|-regexp? <list> <pattern> 3: ## 4: ## Look for elements in <list> that match <pattern>. This command emulates 5: ## the TclX lmatch command, but if TclX isn't available, it's a decent 6: ## substitute. 7: ### 8: 9: proc lmatch {args} { 10: set modes(-exact) 0 11: set modes(-glob) 1 12: set modes(-regexp) 2 13: 14: if {[llength $args] == 3} { 15: lassign $args mode list pattern 16: } elseif {[llength $args] == 2} { 17: set mode -glob 18: lassign $args list pattern 19: } else { 20: return -code error \ 21: {wrong # args: should be "lmatch ?mode? list pattern"} 22: } 23: 24: if {![info exists modes($mode)]} { 25: return -code error \ 26: "bad search mode \"$mode\": must be -exact, -glob, or -regexp" 27: } 28: set mode $modes($mode) 29: 30: set return {} 31: foreach elem $list { 32: if {$mode == 0} { 33: if {[string compare $elem $pattern] == 0} { lappend return $elem } 34: } 35: if {$mode == 1} { 36: if {[string match $pattern $elem]} { lappend return $elem } 37: } 38: if {$mode == 2} { 39: if {[regexp $pattern $elem]} { lappend return $elem } 40: } 41: } 42: return $return 43: } |