snit2.tcl

来自「Linux下的MSN聊天程序源码」· TCL 代码 · 共 2,009 行 · 第 1/5 页

        Comp.statement.typevariable $component ""

        # Add a write trace to do the component thing.
        Mappend compile(typevars) {
            trace add variable %COMP% write \
                [list ::snit::RT.TypecomponentTrace [list %TYPE%] %COMP%]
        } %TYPE% $compile(type) %COMP% $component
    }
} 

# Defines a component, and handles component options.
#
# component     The logical name of the delegate
# args          options.
#
# TBD: Ideally, it should be possible to call this statement multiple
# times, possibly changing the option values.  To do that, I'd need
# to cache the option values and not act on them until *after* I'd
# read the entire type definition.

proc ::snit::Comp.statement.component {component args} {
    variable compile

    set errRoot "Error in \"component $component...\""

    # FIRST, define the component
    Comp.DefineComponent $component $errRoot

    # NEXT, handle the options.
    set publicMethod ""
    set inheritFlag 0

    foreach {opt val} $args {
        switch -exact -- $opt {
            -public {
                set publicMethod $val
            }
            -inherit {
                set inheritFlag $val
                if {![string is boolean $inheritFlag]} {
    error "component $component -inherit: expected boolean value, got \"$val\""
                }
            }
            default {
                error "component $component: Invalid option \"$opt\""
            }
        }
    }

    # NEXT, if -public specified, define the method.  
    if {$publicMethod ne ""} {
        Comp.statement.delegate method [list $publicMethod *] to $component
    }

    # NEXT, if -inherit is specified, delegate method/option * to 
    # this component.
    if {$inheritFlag} {
        Comp.statement.delegate method "*" to $component
        Comp.statement.delegate option "*" to $component
    }
}


# Defines a name to be a component
# 
# The name becomes an instance variable; in addition, it gets a 
# write trace so that when it is set, all of the component mechanisms
# get updated.
#
# component     The component name

proc ::snit::Comp.DefineComponent {component {errRoot "Error"}} {
    variable compile

    if {[lsearch -exact $compile(typevarnames) $component] != -1} {
        error "$errRoot, \"$component\" is already a typevariable"
    }

    if {[lsearch -exact $compile(components) $component] == -1} {
        # Remember we've done this.
        lappend compile(components) $component

        # Make it an instance variable with no initial value
        Comp.statement.variable $component ""

        # Add a write trace to do the component thing.
        Mappend compile(instancevars) {
            trace add variable ${selfns}::%COMP% write \
                [list ::snit::RT.ComponentTrace [list %TYPE%] $selfns %COMP%]
        } %TYPE% $compile(type) %COMP% $component
    }
} 

# Creates a delegated method, typemethod, or option.
proc ::snit::Comp.statement.delegate {what name args} {
    # FIRST, dispatch to correct handler.
    switch $what {
        typemethod { Comp.DelegatedTypemethod $name $args }
        method     { Comp.DelegatedMethod     $name $args }
        option     { Comp.DelegatedOption     $name $args }
        default {
            error "Error in \"delegate $what $name...\", \"$what\"?"
        }
    }

    if {([llength $args] % 2) != 0} {
        error "Error in \"delegate $what $name...\", invalid syntax"
    }
}

# Creates a delegated typemethod delegating it to a particular
# typecomponent or an arbitrary command.
#
# method    The name of the method
# arglist       Delegation options

proc ::snit::Comp.DelegatedTypemethod {method arglist} {
    variable compile
    variable typemethodInfo

    set errRoot "Error in \"delegate typemethod [list $method]...\""

    # Next, parse the delegation options.
    set component ""
    set target ""
    set exceptions {}
    set pattern ""
    set methodTail [lindex $method end]

    foreach {opt value} $arglist {
        switch -exact $opt {
            to     { set component $value  }
            as     { set target $value     }
            except { set exceptions $value }
            using  { set pattern $value    }
            default {
                error "$errRoot, unknown delegation option \"$opt\""
            }
        }
    }

    if {$component eq "" && $pattern eq ""} {
        error "$errRoot, missing \"to\""
    }

    if {$methodTail eq "*" && $target ne ""} {
        error "$errRoot, cannot specify \"as\" with \"*\""
    }

    if {$methodTail ne "*" && $exceptions ne ""} {
        error "$errRoot, can only specify \"except\" with \"*\"" 
    }

    if {$pattern ne "" && $target ne ""} {
        error "$errRoot, cannot specify both \"as\" and \"using\""
    }

    foreach token [lrange $method 1 end-1] {
        if {$token eq "*"} {
            error "$errRoot, \"*\" must be the last token."
        }
    }

    # NEXT, define the component
    if {$component ne ""} {
        Comp.DefineTypecomponent $component $errRoot
    }

    # NEXT, define the pattern.
    if {$pattern eq ""} {
        if {$methodTail eq "*"} {
            set pattern "%c %m"
        } elseif {$target ne ""} {
            set pattern "%c $target"
        } else {
            set pattern "%c %m"
        }
    }

    # Make sure the pattern is a valid list.
    if {[catch {lindex $pattern 0} result]} {
        error "$errRoot, the using pattern, \"$pattern\", is not a valid list"
    }

    # NEXT, check the method name against previously defined 
    # methods.
    Comp.CheckMethodName $method 1 ::snit::typemethodInfo $errRoot

    set typemethodInfo($method) [list 0 $pattern $component]

    if {[string equal $methodTail "*"]} {
        Mappend compile(defs) {
            set %TYPE%::Snit_info(excepttypemethods) %EXCEPT%
        } %EXCEPT% [list $exceptions]
    }
}


# Creates a delegated method delegating it to a particular
# component or command.
#
# method        The name of the method
# arglist       Delegation options.

proc ::snit::Comp.DelegatedMethod {method arglist} {
    variable compile
    variable methodInfo

    set errRoot "Error in \"delegate method [list $method]...\""

    # Next, parse the delegation options.
    set component ""
    set target ""
    set exceptions {}
    set pattern ""
    set methodTail [lindex $method end]

    foreach {opt value} $arglist {
        switch -exact $opt {
            to     { set component $value  }
            as     { set target $value     }
            except { set exceptions $value }
            using  { set pattern $value    }
            default {
                error "$errRoot, unknown delegation option \"$opt\""
            }
        }
    }

    if {$component eq "" && $pattern eq ""} {
        error "$errRoot, missing \"to\""
    }

    if {$methodTail eq "*" && $target ne ""} {
        error "$errRoot, cannot specify \"as\" with \"*\""
    }

    if {$methodTail ne "*" && $exceptions ne ""} {
        error "$errRoot, can only specify \"except\" with \"*\"" 
    }

    if {$pattern ne "" && $target ne ""} {
        error "$errRoot, cannot specify both \"as\" and \"using\""
    }

    foreach token [lrange $method 1 end-1] {
        if {$token eq "*"} {
            error "$errRoot, \"*\" must be the last token."
        }
    }

    # NEXT, we delegate some methods
    set compile(delegatesmethods) yes

    # NEXT, define the component.  Allow typecomponents.
    if {$component ne ""} {
        if {[lsearch -exact $compile(typecomponents) $component] == -1} {
            Comp.DefineComponent $component $errRoot
        }
    }

    # NEXT, define the pattern.
    if {$pattern eq ""} {
        if {$methodTail eq "*"} {
            set pattern "%c %m"
        } elseif {$target ne ""} {
            set pattern "%c $target"
        } else {
            set pattern "%c %m"
        }
    }

    # Make sure the pattern is a valid list.
    if {[catch {lindex $pattern 0} result]} {
        error "$errRoot, the using pattern, \"$pattern\", is not a valid list"
    }

    # NEXT, check the method name against previously defined 
    # methods.
    Comp.CheckMethodName $method 1 ::snit::methodInfo $errRoot

    # NEXT, save the method info.
    set methodInfo($method) [list 0 $pattern $component]

    if {[string equal $methodTail "*"]} {
        Mappend compile(defs) {
            set %TYPE%::Snit_info(exceptmethods) %EXCEPT%
        } %EXCEPT% [list $exceptions]
    }
} 

# Creates a delegated option, delegating it to a particular
# component and, optionally, to a particular option of that
# component.
#
# optionDef     The option definition
# args          definition arguments.

proc ::snit::Comp.DelegatedOption {optionDef arglist} {
    variable compile

    # First, get the three option names.
    set option [lindex $optionDef 0]
    set resourceName [lindex $optionDef 1]
    set className [lindex $optionDef 2]

    set errRoot "Error in \"delegate option [list $optionDef]...\""

    # Next, parse the delegation options.
    set component ""
    set target ""
    set exceptions {}

    foreach {opt value} $arglist {
        switch -exact $opt {
            to     { set component $value  }
            as     { set target $value     }
            except { set exceptions $value }
            default {
                error "$errRoot, unknown delegation option \"$opt\""
            }
        }
    }

    if {$component eq ""} {
        error "$errRoot, missing \"to\""
    }

    if {$option eq "*" && $target ne ""} {
        error "$errRoot, cannot specify \"as\" with \"delegate option *\""
    }

    if {$option ne "*" && $exceptions ne ""} {
        error "$errRoot, can only specify \"except\" with \"delegate option *\"" 
    }

    # Next, validate the option name

    if {"*" != $option} {
        if {![Comp.OptionNameIsValid $option]} {
            error "$errRoot, badly named option \"$option\""
        }
    }

    if {$option in $compile(localoptions)} {
        error "$errRoot, \"$option\" has been defined locally"
    }

    if {$option in $compile(delegatedoptions)} {
        error "$errRoot, \"$option\" is multiply delegated"
    }

    # NEXT, define the component
    Comp.DefineComponent $component $errRoot

    # Next, define the target option, if not specified.
    if {![string equal $option "*"] &&
        [string equal $target ""]} {
        set target $option
    }

    # NEXT, save the delegation data.
    set compile(hasoptions) yes

    if {![string equal $option "*"]} {
        lappend compile(delegatedoptions) $option

        # Next, compute the resource and class names, if they aren't
        # already defined.

        if {"" == $resourceName} {
            set resourceName [string range $option 1 end]
        }

        if {"" == $className} {
            set className [Capitalize $resourceName]
        }

        Mappend  compile(defs) {
            set %TYPE%::Snit_optionInfo(islocal-%OPTION%) 0
            set %TYPE%::Snit_optionInfo(resource-%OPTION%) %RES%
            set %TYPE%::Snit_optionInfo(class-%OPTION%) %CLASS%
            lappend %TYPE%::Snit_optionInfo(delegated) %OPTION%
            set %TYPE%::Snit_optionInfo(target-%OPTION%) [list %COMP% %TARGET%]
            lappend %TYPE%::Snit_optionInfo(delegated-%COMP%) %OPTION%
        }   %OPTION% $option \
            %COMP% $component \
            %TARGET% $target \
            %RES% $resourceName \
            %CLASS% $className 
    } else {
        Mappend  compile(defs) {
            set %TYPE%::Snit_optionInfo(starcomp) %COMP%
            set %TYPE%::Snit_optionInfo(except) %EXCEPT%
        } %COMP% $component %EXCEPT% [list $exceptions]
    }
} 

# Exposes a component, effectively making the component's command an
# instance method.
#
# component     The logical name of the delegate