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