2007-09-08 [Sarnold]: I felt the need of a command-line debugger for some console scripts I wrote on Linux.
Visiting the wiki brought me a sort of challenge: create a debugger in pure-Tcl, which, I would like to, would be easy to use, ideally: 
 tcldebug myapp.tcl args...
where myapp.tcl is an unmodified Tcl application.

Well, I could not win the challenge, and myapp.tcl has to be modified (just adding one line) to be inspected for.
Indeed, my debugger tries to put traces on procs and variables, and just as any debugger, these procs and variables need to have been created ''before'' the user put traces.

Now, let the code speak...

----
Instead of the classical
 tclsh myapp.tcl ?args...?
just type:
 tclsh tcldebug myapp.tcl ?args...?
And insert in myapp.tcl: 
 catch {tcldebug::debug}
after all your procs definitions.

----
2008-06-28 [Sarnold]: Let us revitalize this project. The debugger can now debug dynamically unmodified code, including toplevel execution.
To disable toplevel stepping, just invoke the debugger command "cmd clear *".
Have fun!

Does anybody want multi-thread aware debugging ? Integration with Eclipse DLTK? Please post here and I will try to improve tcldebug.
----
'''tcldebug'''
======
#!/usr/bin/env tclsh
proc __debug {} {
 namespace eval ::tcldebug {
    variable break ""
    variable log ""
    variable enter ""
    variable step ""
    variable argv
    variable argv0

    set argv $::argv
    set argv0 $::argv0

    proc var {name key} {
                if {$key eq ""} {return $name}
                return $name\($key\)
    }

    proc 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]"
                                if {[Unlog [var $name1 $name2]]<0} {
                                        Unlog $name1
                                }
                        }
                    default {error "unknown $op"}
                }
    }

    proc 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} ::tcldebug::Log
                }
                return 0
        }

    proc Store {list elt} {
                if {[lsearch -exact $list $elt]>=0} {return $list}
                lappend list $elt
                return $list
    }

    proc Break {name1 name2 op} {
                switch -- $op {
                        read - write {
                                eputs "$op [var $name1 $name2]=[uplevel 1 set [var $name1 $name2]]"
                                uplevel 1 ::tcldebug::debug
                        }
                        unset {
                                eputs "unset [var $name1 $name2]"
                                if {[Unbreak [var $name1 $name2]]<0} {
                                        Unbreak $name1
                                }
                        }
                        default {error "unknown $op"}
                }
    }

    proc 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} ::tcldebug::Break
                }
                return 0
        }

    proc Enter {cmdstring op} {
                switch -- $op {
                        enter {
                                eputs "entering [lindex $cmdstring 0]"
                                uplevel 1 ::tcldebug::debug [list $cmdstring]
                        }
                        default {error "unknown $op"}
                }
    }

    proc 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 ::tcldebug::Enter
                }
                return 0
    }

    proc Step {cmdstring op} {
                switch -- $op {
                        enterstep {
                                eputs $cmdstring
                                uplevel 1 ::tcldebug::debug [list $cmdstring]
                        }
                        default {error "unknown $op"}
                }
        }

    proc 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 ::tcldebug::Step
                }
                return 0
        }

    proc assert {expr {message ""}} {
                if {[uplevel 1 expr $expr]} {return}
                if {$message eq ""} {set message "assertion failed: $expr"}
                error $message
    }
        
                        

    proc p {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"
                }
    }

    proc Prompt {} {
                return {TclDebugger by S.Arnold. v0.1 2007-09-09}
    }

    proc eputs {str} {puts stderr $str}

    proc Interact {{cmdstring ""}} {
                debug $cmdstring
        }

    proc debug {{cmdstring ""}} {
                set help {Commands are:
    h or ?        prints this message
    a or >        prints the command being executed
        p                prints the current level proc
    e or !        evals a 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
            step    steps through the command
            clear   clear break points (using glob patterns)
    c            continue execution
    r            restarts the program
    x or q  exit the debugger}
                set help [Prompt]\n$help
                while 1 {
                        puts -nonewline stderr "dbg> "
                        flush stderr
                        gets stdin line
                        switch -- [lindex $line 0] {
                                h - ? {eputs $help}
                                e - ! {
                                        if {[catch {eputs [uplevel 1 [lrange $line 1 end]]} msg]} {
                                        eputs "error: $msg"
                                        }
                                }
                                a - > {eputs $cmdstring}
                                p {
                                        eputs [uplevel 1 info level 0]
                                }
                                = {
                                        foreach var [lrange $line 1 end] {uplevel 1 ::tcldebug::p $var}
                                }
                                var {
                                        assert {[llength $line]<=3} "bad syntax, $line has more than 3 tokens"
                                        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} ::tcldebug::Log]
                                                } 
                                                break {
                                                        variable break
                                                        set break [Store $break $value]
                                                        uplevel 1 [list trace add variable $value {read write unset} ::tcldebug::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
                                                                                ::tcldebug::$cmd $i
                                                                        }
                                                                }
                                                        }
                                                }
                                                default {
                                                        error "no such subcommand: $subcmd"
                                                }
                                        }
                                }
                                cmd {
                                        assert {[llength $line]<=3} "bad syntax, $line has more than 3 tokens"
                                foreach {subcmd value} [lrange $line 1 end] {break}
                                        switch -- $subcmd {
                                                enter {
                                                        variable enter
                                                        set enter [Store $enter $value]
                                                        trace add execution $value enter ::tcldebug::Enter
                                                }
                                                step {
                                                        variable step
                                                        set step [Store $step $value]
                                                        trace add execution $value enterstep ::tcldebug::Step
                                                }
                                                info {
                                                        foreach {n t} {enter Enters step Stepping} {
                                                                variable $n
                                                                eputs "=== $t: ==="
                                                                eputs [set $n]
                                                                eputs "----"
                                                        }
                                                }
                                                clear {
                                                        foreach {v t cmd} {enter Enters Unenter step Stepping Unstep} {
                                                                eputs "clearing $t..."
                                                                variable $v
                                                                foreach i [set $v] {
                                                                        if {[string match $value $i]} {
                                                                                eputs $i
                                                                                # 'unenters' or 'unstep' the command
                                                                                ::tcldebug::$cmd $i
                                                                        }
                                                                }
                                                        }
                                                }
                                                default {
                                                        error "no such subcommand: $subcmd"
                                                }
                                        }
                                }
                                c {
                                        return
                                }
                                r {
                                        variable argv0
                                        variable argv
                                        eval exec [list [info nameofexecutable] $argv0] $argv
                                        exit
                                }
                                x - q {
                                        exit
                                }
                        }
                }
        }
        proc prepare {} {
                global argv argv0
                # Start the program!
                set argv0 [lindex $argv 0]
                set argv [lrange $argv 1 end]
                # Prompts
                puts stderr [tcldebug::Prompt]
                puts stderr "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 ::tcldebug::main]
                trace add execution ::tcldebug::main enterstep ::tcldebug::Step
        }        
        proc main {} {
                uplevel 1 [list source $::argv0]
        }
 }
}
__debug
tcldebug::prepare
tcldebug::main
======
----
'''Known bugs'''

   * When you put "var break" traces, you have to disable "cmd step" traces, or this would lead to stepping into tcldebug internals.
----
[[ [Category Debugging] ]]
----
'''[vai] - 2011-02-07 00:27:27'''

Hello Sir,

I want to know the usage of command line tcl debugger created by you.
Will you please put more details of how to use it?
How to use all the functions of debugger?

Thanks
----
'''[Lorance] - 2011-08-27 20:31:47'''

I made a few changes to your script. It is up at https://github.com/LStinson/TagmaDebug%|%GitHub%|% and I call [Tagma Debugger]. I made quite a few changes, added a manpage and fixed the but above with stepping into the debugger. (I disable the trace until after Log or Break have finished.)