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