namespace eval ::tis {

namespace eval tcl {

---

Proc procPuts.

Echoes info about a proc in the screen.

Arguments:

• procName - The name of the proc whose info is to be echoed.

Returns:

• Empty.

Side effects:

• Prints to screen.
• Throws a Tcl error if procName does not correspond to an existing proc.
  • E.g.: "xxx isn't a procedure".

proc procPuts {procName} {
    puts PROC($procName)ARGS([
        procSignature $procName
    ])BODY([info body $procName])
    return
}

---

Proc procsPuts.

Puts info about a set of procs given by a pattern. If pattern is not provided, will give info about all procs in ::tis.

Arguments:

• pattern - Pattern that will be used to determine proc names.
  • Default value "".

Returns:

• Empty.

Side effects:

• Prints to screen.

proc procsPuts {{pattern ""}} {
    if {$pattern eq ""} {
        set pattern *
    }
    foreach procName [lsort [info procs $pattern]] {
        procPuts $procName
    }
    return
}

---

Proc procExists.

Gives info about the existence of a proc given its name.

Arguments:

• procName - Name of the proc whose existence is checked.

Returns:

• A boolean indicating whether the proc exists or not.

Side effects:

• None.

proc procExists {procName} {
    return [expr {[info procs $procName] ne {}}]
}

---

Proc procSignature.

Get the signature associated to a procedure.

Arguments:

• procName - Name of the proc whose signature is requested.

Returns:

• The signature, e.g.: "foo {bar wea} args".

Side effects:

• None.

Notes:

• A signature is a list.

proc procSignature {procName} {
    if {![procExists $procName]} {
        error "proc $procName does not exist"
    }
    set signature ""
    foreach arg [info args $procName] {
        if {[info default $procName $arg def]} {
            lappend signature [list $arg $def]
        } else {
            lappend signature $arg
        }
    }
    return $signature
}

---

Proc procSignatureCheck.

Check that a list forms a valid signature.

Arguments:

• args - These form the signature to be checked.

Returns:

• The index of last non default sign.
  • Example: for "foo bar {wea grill} args", it will return "1".

Side effects:

• Throws an error if the signature is not correct.

  • Error "bad arg ".

    • This is raised when user tries to insert a bad arg like "{a b c}".

  • Error "bad arg after arg with default".

    • This is raised when user tries to insert a bad arg after an arg with default has been identified.

  • Error "bad arg after args".

    • This is raised when user tries to insert more args after args.

Notes:

• args is a list.

proc procSignatureCheck {args} {
    set mode singleArg
    set result -1
    foreach arg $args {
        switch $mode {
            singleArg {
                if {[llength $arg] == 1} {
                    if {$arg eq "args"} {
                        set mode args
                    } else {
                        incr result
                    }
                } elseif {[llength $arg] == 2} {
                    set mode argWithDef
                } else {
                    error "bad arg $arg"
                }
            }
            argWithDef {
                if {[llength $arg] == 1} {
                    if {$arg eq "args"} {
                        set mode args
                    } else {
                        error "bad arg $arg after arg with default"
                    }
                } elseif {[llength $arg] == 2} {
                    # Do nothing.
                } else {
                    error "bad arg $arg after arg with default"
                }
            }
            args {
                error "bad arg $arg after args"
            }
        }
    }
    return $result
}

---

Proc procSignatureMapCall.

Map a signature to a call.

Arguments:

• signature - The signature to match the call against.
• call - The call to be matched against the signature.

Returns:

• A string that can be used with string map.
  • Example:
    • signature - "foo bar {wea grill} args".
    • call - "a b".
    • map - "foo a bar b wea grill args {}".

Side effects:

• Throws an error if the signature is not correct.
  • See bad signature.
• Throws an error if the call does not match the signature.
  • Error "callIndex out of range ".
    • This is raised when user is giving more inputs that signature allows for.

proc procSignatureMapCall {signature call} {
    set mode singleArg
    set map {}
    set callIndex 0
    set callLen [llength $call]
    foreach arg $signature {
        switch $mode {
            singleArg {
                if {[llength $arg] == 1} {
                    if {$arg eq "args"} {
                        set mode args
                        if {$callIndex < $callLen} {
                            lappend map $arg [
                                lrange $call $callIndex end
                            ]
                        } elseif {$callIndex == $callLen} {
                            lappend map $arg {}
                        } else {
                            error \
                            "callIndex $callIndex out of range $callLen"
                        }
                    } else {
                        if {$callIndex < $callLen} {
                            lappend map $arg [lindex $call $callIndex]
                            incr callIndex
                        } else {
                            error \
                            "callIndex $callIndex out of range $callLen"
                        }
                    }
                } elseif {[llength $arg] == 2} {
                    set mode argWithDef
                    if {$callIndex < $callLen} {
                        lappend map [lindex $arg 0] [
                            lindex $call $callIndex
                        ]
                        incr callIndex
                    } elseif {$callIndex == $callLen} {
                        lappend map [lindex $arg 0] [lindex $arg 1]
                    } else {
                        error \
                            "callIndex $callIndex out of range $callLen"
                    }
                } else {
                    error "bad arg $arg"
                }
            }
            argWithDef {
                if {[llength $arg] == 1} {
                    if {$arg eq "args"} {
                        set mode args
                        if {$callIndex < $callLen} {
                            lappend map $arg [
                                lrange $call $callIndex end
                            ]
                        } elseif {$callIndex == $callLen} {
                            lappend map $arg {}
                        } else {
                            error \
                            "callIndex $callIndex out of range $callLen"
                        }
                    } else {
                        error "bad arg $arg after arg with default"
                    }
                } elseif {[llength $arg] == 2} {
                    if {$callIndex < $callLen} {
                        lappend map [lindex $arg 0] [
                            lindex $call $callIndex
                        ]
                        incr callIndex
                    } elseif {$callIndex == $callLen} {
                        lappend map [lindex $arg 0] [lindex $arg 1]
                    } else {
                        error \
                            "callIndex $callIndex out of range $callLen"
                    }
                } else {
                    error "bad arg $arg after arg with default"
                }
            }
            args {
                error "bad arg $arg after args"
            }
        }
    }
    return $map
}

---

}

}