bind.tcl

Go to the documentation of this file.

/*  -*- 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 ::term::receive::bind {}

/*  ### ### ### ######### ######### #########*/

snit::type ::term::receive::bind {

    constructor {{dict {}}} {
    foreach {str cmd} $dict {Register $str $cmd}
    return
    }

    ret  map (type str , type cmd) {
    Register $str $cmd
    return
    }

    ret  default (type cmd) {
    set default $cmd
    return
    }

    /*  ### ### ### ######### ######### #########*/
    /** 
 */

    ret  listen (optional chan =stdin) {
    #parray dfa
    ::term::receive::listen $self $chan
    return
    }

    ret  unlisten (optional chan =stdin) {
    ::term::receive::unlisten $chan
    return
    }

    /*  ### ### ### ######### ######### #########*/
    /** 
 */

    variable default {}
    variable state   {}

    ret  reset () {
    set state {}
    return
    }

    ret  next (type c) {Next $c ; return}
    ret  process (type str) {
    foreach c [split $str {}] {Next $c}
    return
    }

    ret  eof () {Eof ; return}

    ret  Next (type 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
    }

    ret  Eof () {}

    /*  ### ### ### ######### ######### #########*/
    /** 
 */

    ret  Register (type str , type 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

/** 
 * ### ### ### ######### ######### #########