2011-08-27 [Lorance] - I made some changes to [Yet another Tcl debugger] and put it up on https://github.com/LStinson/TagmaDebug%|%GitHub%|%.

There is a manpage, README (same content) and a Make file to install with. I eliminated the bug that caused variable tracing to enter the debugger code. I also made it a bit less user-hostile.

Let me know if you find any bugs or want specific changes. It is obviously a work in progress..


----
tagmadebug.tcl

======
#!/usr/bin/env tclsh
# tagmadebug.tcl --
# Last Modified: 2011-08-27
#
# Implements simple debugging for TCL.
# By Lorance Stinson AT Gmail.....
# The name was selected to, hopefully, not clash with anything existing.
# Based on "TclDebugger by S.Arnold. v0.1 2007-09-09" - http://wiki.tcl.tk/19872

namespace eval ::TagmaDebug:: {
    variable argv $::argv
    variable argv0 $::argv0
    variable break ""
    variable log ""
    variable enter ""
    variable leave ""
    variable step ""
    variable prompt "Tagma> "
    variable description "TagmaDebug by Lorance Stinson AT Gmail..."
    variable verbose 0
    variable entercontinues 1
}

# ::TagmaDebug::var --
#   Returns a variable or an index into a hash.
#
# Arguments:
#   name        Variable or hash.
#   key         Optional key in the hasn.
#
# Result:
#   The appropriate value.
#
# Side effect:
#   None
proc ::TagmaDebug::var {name key} {
    if {$key eq ""} {return $name}
    return $name\($key\)
}

# ::TagmaDebug::Break --
#   Callback for breaking on variables.
#
# Arguments:
#   From the trace command.
#
# Result:
#   None
#
# Side effect:
#   Prints the information for the variable.
#   Enters the debugger prompt.
#   Disables logging if the variable was unset.
#   Re-enables tracing on __TagmaDebugMain if it should be on.
proc ::TagmaDebug::Break {name1 name2 op} {
    switch -- $op {
        read - write {
            eputs "$op [var $name1 $name2] = [uplevel 1 set [var $name1 $name2]]"
        }
        unset {
            eputs "unset [var $name1 $name2]"
            # Stop tracing this variable if it is unset.
            if {[Unbreak [var $name1 $name2]] < 0} {
                Unbreak $name1
            }
        }
        default {
            error "Break: Unknown OP '$op' for '$name1' - '$name2'."
        }
    }
    uplevel 1 ::TagmaDebug::debug

    # Turn tracing back on for ::TagmaDebug::__TagmaDebugMain, if it previously was.
    variable step
    if {[lsearch -exact $step "::TagmaDebug::__TagmaDebugMain"] >= 0} {
        trace add execution ::TagmaDebug::__TagmaDebugMain enterstep ::TagmaDebug::Step
    }
}

# ::TagmaDebug::Unbreak --
#   Removes the break trace from a variable.
#
# Arguments:
#   name        The name of the variable.
#
# Result:
#   -1 if the variable is not found break list.
#
# Side effect:
#   Tracing is disabled on the variable.
#   The variable name is removed from the break list.
proc ::TagmaDebug::Unbreak {name} {
    variable break
    set i [lsearch -exact $break $name]
    if {$i < 0} {return -1}
    set break [lreplace $break $i $i]
    catch {
        trace remove variable $name {read write unset} ::TagmaDebug::Break
    }
    return 0
}

# ::TagmaDebug::Log --
#   Callback for logging variables.
#
# Arguments:
#   From the trace command.
#
# Result:
#
# Side effect:
#   Prints the information for the variable.
#   Disables logging if the variable was unset.
#   Re-enables tracing on __TagmaDebugMain if it should be on.
proc ::TagmaDebug::Log {name1 name2 op} {
    switch -- $op {
        read - write {
            eputs "$op [var $name1 $name2] = [uplevel 1 set [var $name1 $name2]]"
        }
        unset {
            eputs "unset [var $name1 $name2]"
            # Stop tracing this variable if it is unset.
            if {[Unlog [var $name1 $name2]] < 0} {
                Unlog $name1
            }
        }
        default {
            error "Log: Unknown OP '$op' for '$name1' - '$name2'."
        }
    }

    # Turn tracing back on for ::TagmaDebug::__TagmaDebugMain, if it previously was.
    variable step
    if {[lsearch -exact $step "::TagmaDebug::__TagmaDebugMain"] >= 0} {
        trace add execution ::TagmaDebug::__TagmaDebugMain enterstep ::TagmaDebug::Step
    }
}

# ::TagmaDebug::Unlog --
#   Removes the logging trace from a variable.
#
# Arguments:
#   name        The name of the variable.
#
# Result:
#   -1 if the variable is not found in the log list.
#
# Side effect:
#   Tracing is disabled on the variable.
#   The variable name is removed from the log list.
proc ::TagmaDebug::Unlog {name} {
    variable log
    set i [lsearch -exact $log $name]
    if {$i < 0} {return -1}
    set log [lreplace $log $i $i]
    catch {
        trace remove variable $name {read write unset} ::TagmaDebug::Log
    }
    return 0
}

# ::TagmaDebug::Store --
#   Stores a value in a list if it is not already present.
#
# Arguments:
#   list        The list to modify.
#   elt         The value to store.
#
# Result:
#   The modified, or original, list.
#
# Side effect:
#   None
proc ::TagmaDebug::Store {list elt} {
    if {[lsearch -exact $list $elt] >= 0} {return $list}
    lappend list $elt
    return $list
}

# ::TagmaDebug::Enter --
#   Callback for command entry.
#
# Arguments:
#   From the trace command.
#
# Result:
#   None
#
# Side effect:
#   prints when the command is entered.
#   Enters the debugger prompt.
proc ::TagmaDebug::Enter {cmdstring op} {
    switch -- $op {
        enter {
            eputs "Entering: [lindex $cmdstring 0]"
            variable verbose
            if {$verbose} {
                eputs "Args: [list [lrange $cmdstring 1 end]]"
            }
        }
        default {
            error "Enter: Unknown OP '$op' for '$cmdstring'."
        }
    }
    uplevel 1 ::TagmaDebug::debug [list $cmdstring]
}

# ::TagmaDebug::Unenter --
#   Removes the enter trace from a command.
#
# Arguments:
#   name        The command name.
#
# Result:
#   -1 if the command is not found in the enter list.
#
# Side effect:
#   Tracing is disabled on the command.
#   The variable name is removed from the enter list.
proc ::TagmaDebug::Unenter {name} {
    variable enter
    set i [lsearch -exact $enter $name]
    if {$i < 0} {return -1}
    set enter [lreplace $enter $i $i]
    catch {
        trace remove execution $name enter ::TagmaDebug::Enter
    }
    return 0
}

# ::TagmaDebug::Leave --
#   Callback for command leave.
#
# Arguments:
#   From the trace command.
#
# Result:
#   None
#
# Side effect:
#   prints when the command is left.
#   Enters the debugger prompt.
proc ::TagmaDebug::Leave {cmdstring code result op} {
    switch -- $op {
        leave {
            eputs "Leaving: [lindex $cmdstring 0]"
            variable verbose
            if {$verbose} {
                eputs "Result Code: $code"
                eputs "Result: [list $result]"
            }
        }
        default {
            error "Leave: Unknown OP '$op' for '$cmdstring'."
        }
    }
    uplevel 1 ::TagmaDebug::debug [list $cmdstring]
}

# ::TagmaDebug::Unleave --
#   Removes the leave trace from a command.
#
# Arguments:
#   name        The command name.
#
# Result:
#   -1 if the command is not found in the leave list.
#
# Side effect:
#   Tracing is disabled on the command.
#   The variable name is removed from the leave list.
proc ::TagmaDebug::Unleave {name} {
    variable leave
    set i [lsearch -exact $leave $name]
    if {$i < 0} {return -1}
    set leave [lreplace $leave $i $i]
    catch {
        trace remove execution $name leave ::TagmaDebug::Leave
    }
    return 0
}

# ::TagmaDebug::Step --
#   Callback for command step.
#
# Arguments:
#   From the trace command.
#
# Result:
#   None
#
# Side effect:
#   Disables the step trace on __TagmaDebugMain if entering Log or Break.
#   (This is to not step into the debugger.)
#   Prints the command that is about to be executed
#   Enters the debugger prompt.
proc ::TagmaDebug::Step {cmdstring op} {
    if {[string range $cmdstring 0 14] eq "::TagmaDebug::Log" ||
        [string range $cmdstring 0 18] eq "::TagmaDebug::Break"} {
        # Disable tracing on ::TagmaDebug::__TagmaDebugMain.
        # Don't want to trace variable breakpoints...
        trace remove execution ::TagmaDebug::__TagmaDebugMain enterstep ::TagmaDebug::Step
        return
    }

    switch -- $op {
        enterstep {
            eputs $cmdstring
        }
        default {
            error "Step: Unknown OP '$op' for '$cmdstring'."
        }
    }
    uplevel 1 ::TagmaDebug::debug [list $cmdstring]
}

# ::TagmaDebug::Unstep --
#   Removes the enter trace from a command.
#
# Arguments:
#   name        The command name.
#
# Result:
#   -1 if the command is not found in the step list.
#
# Side effect:
#   Tracing is disabled on the command.
#   The variable name is removed from the step list.
proc ::TagmaDebug::Unstep {name} {
    variable step
    set i [lsearch -exact $step $name]
    if {$i < 0} {return -1}
    set step [lreplace $step $i $i]
    catch {
        trace remove execution $name enterstep ::TagmaDebug::Step
    }
    return 0
}

# ::TagmaDebug::eputs --
#   Prints a string to STDERR
#
# Arguments:
#   string      The string to print
#
# Result:
#   None
#
# Side effect:
#   The string is printed to STDERR.
proc ::TagmaDebug::eputs {string} {
    puts stderr $string
}

# ::TagmaDebug::PrintVariable --
#   Prints a variable and its value.
#
# Arguments:
#   varname     The name of the variable to print.
#
# Result:
#   None
#
# Side effect:
#   The variable and value are printed.
proc ::TagmaDebug::PrintVariable {varname} {
    if {[uplevel 1 array exists $varname]} {
        uplevel 1 parray $varname
        return
    }
    if {[uplevel 1 info exists $varname]} {
        eputs "$varname = [uplevel 1 set $varname]"
    } else {
        eputs "variable $varname does not exist"
    }
}

# ::TagmaDebug::CheckCommand --
#   Checks if a command exists.
#
# Arguments:
#   command     The name of the command to check.
#
# Result:
#   0 if the command does not exist.
#   1 if the command is a procedure, command or function.
#
# Side effect:
#   None
proc ::TagmaDebug::CheckCommand {command} {
    if {[uplevel 1 info procs $command] ne "" ||
        [uplevel 1 info commands $command] ne "" ||
        [uplevel 1 info functions $command] ne ""} {
        return 1
    }
    return 0
}

# ::TagmaDebug::PrintHelp --
#   Prints the help text.
#
# Arguments:
#   ARG         ARG Description
#
# Result:
#   None
#
# Side effect:
#   Prints the help text.
proc ::TagmaDebug::PrintHelp {} {
    variable description
    eputs description
    eputs [join {
        "Commands are:"
        "    h or ?      Prints this message."
        "    a or >      Prints the command being executed."
        "    p           Prints the current level & procedure."
        "    e or \[..\]   Evaluates a command."
        "    !           Execute a shell command."
        "    =           Prints the content of each variable name."
        "    var         Watchs the modifications of some variables."
        "        log     Logs all modifications to stderr."
        "        break   Adds breakpoint for writes."
        "        info    Prints all variables being watched for."
        "        clear   Clears logging and breaks."
        "    cmd"
        "        enter   Set a break point for the entering of a command."
        "        leave   Set a break point for the leaving of a command."
        "        info    Prints all commands being watched.."
        "        step    Steps through the command."
        "        clear   Clear break points (using glob patterns)."
        "    c or Enter  Continue execution."
        "    r           Restarts the program."
        "    v           Toggle verbosity. (Print extra info, when available.)"
        "    x or q      Exit the debugger."
        "Based on TclDebugger by S.Arnold. v0.1 2007-09-09 http://wiki.tcl.tk/19872"
        } "\n"]
}

# ::TagmaDebug::debug --
#   The interactive part of the debugger.
#
# Arguments:
#   cmdstring   The optional command that is about to be executed.
#
# Result:
#   None
#
# Side effect:
#   Manipulates tracing and the lists.
proc ::TagmaDebug::debug {{cmdstring ""}} {
    while 1 {
        variable entercontinues
        variable prompt
        variable verbose

        # Prompt and wait for input.
        set flag [expr {$verbose ? "{V}" : ""}]
        puts -nonewline stderr "$flag$prompt"
        flush stderr

        if {[gets stdin line] < 0} {
            puts ""
            exit
        } elseif {$line eq ""} {
            if {$entercontinues} {
                return
            } else {
                continue
            }
        }

        # Special case, execute anything embedded in '[...]'.
        if {[string index $line 0] eq "\["} {
            if {[catch {eputs [uplevel 1 [string range $line 1 end-1]]} msg]} {
                eputs "Error: $msg"
            }
            continue
        }

        set command [lindex $line 0]
        switch -- $command {
            h - ?   {
                PrintHelp
            }
            e       {
                if {[catch {eputs [uplevel 1 [lrange $line 1 end]]} msg]} {
                    eputs "Error: $msg"
                }
            }
            ! {
                if {[catch {eputs [exec -ignorestderr -- [lrange $line 1 end]]} msg]} {
                    eputs "Error: $msg"
                }
            }
            a - >   {
                eputs $cmdstring
            }
            p       {
                set command "::"
                set level [uplevel 1 info level]
                if {$level > 0} {
                    set command [uplevel 1 info level 0]
                }
                eputs "($level) $command"
            }
            =       {
                foreach var [lrange $line 1 end] {uplevel 1 ::TagmaDebug::PrintVariable $var}
            }
            var     {
                if {[llength $line] < 2 || [llength $line] > 3} {
                    eputs "Bad Syntax! $command requires 1 or 2 arguments."
                    continue
                }
                foreach {subcmd value} [lrange $line 1 end] {break}
                switch -- $subcmd {
                    log     {
                        variable log
                        set log [Store $log $value]
                        uplevel 1 [list trace add variable $value {read write unset} ::TagmaDebug::Log]
                    }
                    break   {
                        variable break
                        set break [Store $break $value]
                        uplevel 1 [list trace add variable $value {read write unset} ::TagmaDebug::Break]
                    }
                    info    {
                        foreach {n t} {log Logged break "Breaks at"} {
                            variable $n
                            eputs "=== $t: ==="
                            eputs [set $n]
                            eputs "----"
                        }
                    }
                    clear   {
                        foreach {v t cmd} {log Logged Unlog break "Breaks at" Unbreak} {
                            eputs "clearing $t..."
                            variable $v
                            foreach i [set $v] {
                                if {[string match $value $i]]} {
                                    eputs $i
                                    # unlogs or unbreaks the variable
                                    ::TagmaDebug::$cmd $i
                                }
                            }
                        }
                    }
                    default { eputs "no such subcommand: $subcmd" }
                }
            }
            cmd     {
                if {[llength $line] < 2 || [llength $line] > 3} {
                    eputs "Bad Syntax! $command requires 1 or 2 arguments."
                    continue
                }
                foreach {subcmd value} [lrange $line 1 end] {break}
                switch -- $subcmd {
                    enter   {
                        if {![CheckCommand $value]} {
                            eputs "The command '$value' does not currently exist."
                            eputs "Can not set a break point for a non-existant command."
                            continue
                        }
                        variable enter
                        set enter [Store $enter $value]
                        trace add execution $value enter ::TagmaDebug::Enter
                    }
                    leave   {
                        if {![CheckCommand $value]} {
                            eputs "The command '$value' does not currently exist."
                            eputs "Can not set a break point for a non-existant command."
                            continue
                        }
                        variable leave
                        set leave [Store $leave $value]
                        trace add execution $value leave ::TagmaDebug::Leave
                    }
                    step    {
                        if {![CheckCommand $value]} {
                            eputs "The command '$value' does not currently exist."
                            eputs "Can not set a break point for a non-existant command."
                            continue
                        }
                        variable step
                        set step [Store $step $value]
                        trace add execution $value enterstep ::TagmaDebug::Step
                    }
                    info    {
                        foreach {n t} {enter Enters leave Leaves step Stepping} {
                            variable $n
                            eputs "=== $t: ==="
                            eputs [set $n]
                            eputs "----"
                        }
                    }
                    clear   {
                        foreach {v t cmd} {enter Enters Unenter leave Leaves Unleave step Stepping Unstep} {
                            eputs "clearing $t..."
                            variable $v
                            foreach i [set $v] {
                                if {[string match $value $i]} {
                                    eputs $i
                                    # 'unenters', 'unleaves' or 'unstep' the command
                                    ::TagmaDebug::$cmd $i
                                }
                            }
                        }
                    }
                    default { eputs "no such subcommand: $subcmd" }
                }
            }
            c       {
                return
            }
            r       {
                variable argv0
                variable argv
                eval exec [list [info nameofexecutable] $argv0] $argv
                exit
            }
            v       {
                set verbose [expr {!$verbose}] }
            x - q   {
                exit
            }
            default {
                eputs "no such command: $command"
            }
        }
    }
}

# ::TagmaDebug::prepare --
#   Prepares for debugging.
#
# Arguments:
#   None
#
# Result:
#   None
#
# Side effect:
#   Enables tracing on __TagmaDebugMain.
#   Enables tracing on __TagmaDebugComplete, but does not store it in a list.
#   Informs the user debugging is starting.
proc ::TagmaDebug::prepare {} {
    global argv argv0
    variable description

    # Make sure there is something to debug.
    if {[llength $argv] == 0} {
        puts "Usage: $argv0 Script.tcl ..."
        puts ""
        puts "A script to debug is required."
        puts "All command line options are passed to the script."
        exit
    }

    # Start the program!
    set argv0 [lindex $argv 0]
    set argv [lrange $argv 1 end]

    # Prompts
    eputs $description
    eputs "Type h to the prompt to get help."
    if {![file exists $argv0]} {
        set argv0 [auto_execok $argv0]
    }

    # steps toplevel execution
    variable step
    set step [Store $step __TagmaDebugMain]
    trace add execution __TagmaDebugMain enterstep ::TagmaDebug::Step

    # Always catch at the end of the program.
    trace add execution __TagmaDebugComplete enter ::TagmaDebug::Enter

    eputs ""
    eputs "Debugging starts here:"
}

# __TagmaDebugMain --
#   The main entry point for debugging.
#   All activity from this procedure on is stepped over.
#   Calling the script from here insures it is debugged.
#
# Arguments:
#   None
#
# Result:
#   None
#
# Side effect:
#   The passed script is run.
proc __TagmaDebugMain {} {
    uplevel 1 "source $::argv0"
}

# __TagmaDebugComplete --
#   Marks the end of debugging.
#   Triggers the debugger even when all commands are cleared.
#   Gives the user a chance to further debug after their script exits.
#
# Arguments:
#   None
#
# Result:
#   None
#
# Side effect:
#   Causes the debugger to be entered.
proc __TagmaDebugComplete {} {
}

# Prepare and go!
::TagmaDebug::prepare
__TagmaDebugMain
__TagmaDebugComplete
======


<<categories>>Debugging