1# -*- tcl -*- 2# ### ### ### ######### ######### ######### 3## Terminal packages - string -> action mappings 4## (bind objects). For use with 'receive listen'. 5## In essence a DFA with tree structure. 6 7# ### ### ### ######### ######### ######### 8## Requirements 9 10package require snit 11package require term::receive 12namespace eval ::term::receive::bind {} 13 14# ### ### ### ######### ######### ######### 15 16snit::type ::term::receive::bind { 17 18 constructor {{dict {}}} { 19 foreach {str cmd} $dict {Register $str $cmd} 20 return 21 } 22 23 method map {str cmd} { 24 Register $str $cmd 25 return 26 } 27 28 method default {cmd} { 29 set default $cmd 30 return 31 } 32 33 # ### ### ### ######### ######### ######### 34 ## 35 36 method listen {{chan stdin}} { 37 #parray dfa 38 ::term::receive::listen $self $chan 39 return 40 } 41 42 method unlisten {{chan stdin}} { 43 ::term::receive::unlisten $chan 44 return 45 } 46 47 # ### ### ### ######### ######### ######### 48 ## 49 50 variable default {} 51 variable state {} 52 53 method reset {} { 54 set state {} 55 return 56 } 57 58 method next {c} {Next $c ; return} 59 method process {str} { 60 foreach c [split $str {}] {Next $c} 61 return 62 } 63 64 method eof {} {Eof ; return} 65 66 proc Next {c} { 67 upvar 1 dfa dfa state state default default 68 set key [list $state $c] 69 70 #puts -nonewline stderr "('$state' x '$c')" 71 72 if {![info exists dfa($key)]} { 73 # Unknown sequence. Reset. Restart. 74 # Run it through the default action. 75 76 if {$default ne ""} { 77 uplevel #0 [linsert $default end $state$c] 78 } 79 80 #puts stderr =\ RESET 81 set state {} 82 } else { 83 foreach {what detail} $dfa($key) break 84 #puts -nonewline stderr "= $what '$detail'" 85 if {$what eq "t"} { 86 # Incomplete sequence. Next state. 87 set state $detail 88 #puts stderr " goto ('$state')" 89 } elseif {$what eq "a"} { 90 # Action, then reset. 91 set state {} 92 #puts stderr " run ($detail)" 93 uplevel #0 [linsert $detail end $state$c] 94 } else { 95 return -code error \ 96 "Internal error. Bad DFA." 97 } 98 } 99 return 100 } 101 102 proc Eof {} {} 103 104 # ### ### ### ######### ######### ######### 105 ## 106 107 proc Register {str cmd} { 108 upvar 1 dfa dfa 109 set prefix {} 110 set last {{} {}} 111 foreach c [split $str {}] { 112 set key [list $prefix $c] 113 set next $prefix$c 114 set dfa($key) [list t $next] 115 set last $key 116 set prefix $next 117 } 118 set dfa($last) [list a $cmd] 119 } 120 variable dfa -array {} 121 122 ## 123 # ### ### ### ######### ######### ######### 124} 125 126# ### ### ### ######### ######### ######### 127## Ready 128 129package provide term::receive::bind 0.1 130 131## 132# ### ### ### ######### ######### ######### 133