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.

'''tcldebug'''

 #!/usr/bin/env tclsh

 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-08}
    }

    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]
		}
	}	
 }
 tcldebug::prepare
 source $argv0




----

''Example usage'':

 # example.tcl
 # let us define all procs
 proc add {a b} {expr {$a+$b}}

 proc main {} {
    set a 1
    set b 2
    puts [add $a $b]
 }
 # this line allows the use of a debugger
 catch {tcldebug::debug}
 main


''Note:'' : as Tcl's [trace]s work on procedures, global-level code is out of the debugging area.
This is common to most Tcl debuggers, and the workaround as usual is to put most if all of your code into procs.
----
'''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] ]]