Summary  edit

Show Actual Arguments to a Command Invocation  edit

puts [info level 0]

Interactive mode  edit

set errorInfo

info body _the_name_of_the_procedure_

interp alias {} ? {} set errorInfo

interp alias {} ? {} tkcon error

In-Code Messages  edit

proc dputs args {puts stderr $args} ;# on
proc dputs args {}                  ;# off (RS)

proc dputs args {
    set res [list]
    foreach i $args {
        if [uplevel info exists $i] {
            lappend res "$i=[uplevel set $i]"
        } else {
            lappend res $i
        }
    }
    puts stderr $res
}

hello world, what is {this=C:/WINNT/Profiles/suchenwirth/Eigene Dateien/sep/sep17.tcl}

proc dputs {msg} {
    global debugMode
    if { $debugMode } { puts $msg }
}

proc !# {args} {
    global DEBUG
    if {$DEBUG == 1 || $DEBUG == TRUE || $DEBUG == true || $DEBUG == yes || $DEBUG == on || $DEBUG == ON} {
        set res [list]
        foreach i $args {
             if [uplevel info exists $i] {
                 lappend res "$i=[uplevel set $i]"
             } else {
                 lappend res $i
             }
        }
        puts stderr $res
    }
}

set DEBUG 1

puts "Enter X value: "
gets stdin x
puts "Enter Y value: "
gets stdin y
puts "The sum is: [expr $x+$y]"
!# x y

$ tclsh test.tcl
Enter X value:
2
Enter Y value:
3
The sum is: 5
x=2 y=3

set DEBUG 0

puts "Enter X value: "
gets stdin x
puts "Enter Y value: "
gets stdin y
puts "The sum is: [expr $x+$y]"
!# x y

$ tclsh test.tcl
Enter X value:
2
Enter Y value:
3
The sum is: 5

Verbose Evaluation  edit

proc verbose_eval {script} {
    set cmd ""
    foreach line [split $script \n] {
        if {$line eq ""} {continue}
        append cmd $line\n
        if { [info complete $cmd] } {
            puts -nonewline $cmd
            puts -nonewline [uplevel 1 $cmd]
            set cmd ""
        }
    }
}

set script {
    puts hello
    expr 2.2*3
}
verbose_eval $script

proc debugMe {{args {}}} {
    global debug

    if { [info exists debug] && $debug} {
        set level1 [expr {[info level] - 1}]
        set level2 [expr {[info level] - 2}]
        if { $level1 > 0 } {
            set name1 [lindex [info level $level1] 0]
            if { $level2 > 0 } {
                set name2 [lindex [info level $level2] 0]
            } else {
                set name2 Startup
            }
        } else {
            set name1 Startup
            set name2 User
        }
        puts "Proc: $name1; Called by $name2; [info cmdcount] commands at [clock format [clock seconds]]"
        if { $args != {} } { puts "$args" }
    }
}

set code ""
set infile [open [lindex $argv 0]]
set argv [lrange $argv 1 end]
while {[gets $infile line] >= 0} {
    puts $line
    if { [info complete $line] } {
        puts [eval $line]
    } else {
        append code "$line\n"
        if { [info complete $code] } {
            puts [eval $code]
            set code ""
        }
    }
}
close $infile

tclsh trace.tcl myscript.tcl ...

Wrapping Proc  edit

if {$debug} {
    rename proc _proc
    _proc proc {name arglist body} {
        _proc $name $arglist [concat "proc_start;" $body ";proc_end"]
    }
    _proc proc_start {} {
        puts stderr ">>> ENTER PROC [lindex [info level -1] 0]"
        for {set level [expr [info level] -1]} {$level > 0} {incr level -1} {
            puts stderr "  LEVEL $level: [info level $level]"
        }
        puts stderr ""
    }
    _proc proc_end {} {
        puts stderr ">>> LEAVE PROC [lindex [info level -1] 0]\n"
    }
}

XoTcl Interceptors  edit

className instproc someFilter args {
    #### pre-part
    set r [next]
    ### post-part
    return $r
}

filter

Trace  edit

rename proc _proc
_proc proc {name arglist body} {
    uplevel 1 [list _proc $name $arglist $body]
    uplevel 1 [list trace add execution $name enterstep [list ::proc_start $name]]
}
_proc proc_start {name command op} {
    puts "$name >> $command"
}

trace all command calls into a single file  edit

# overwrite at each invocatoion of this script
set __XXXfd [open c:/WINDOWS/Temp/tcltrace.tmp w]
proc __XXXtrace {cmd type} {
    puts $::__XXXfd $cmd
}

rename proc _proc
_proc proc {name arglist body} {
    uplevel [list _proc $name $arglist $body]
    uplevel trace add execution $name enter __XXXtrace
}

Global variable watch & control  edit

proc varwindow {w args} {
    catch {destroy $w}
    toplevel $w
    set n 0
    foreach i $args {
        label $w.l$n -text $i -anchor w
        entry $w.e$n -textvariable $i -bg white
        grid $w.l$n $w.e$n
        incr n
    }
} ;#RS
#usage example:
varwindow .vw foo bar baz

Wrapping Set  edit

rename set _set
proc set {var args} {
    puts [list set $var $args]
    uplevel _set $var $args
} ;#RS

Minimal Stepper  edit

puts -nonewline >;flush stdout;update;gets stdin ;#RS

    # PROCEDURE:    Pause
    #
    # DESCRIPTION:  Allows for the pausing of a test at a specific location during execution
    #
    # PARAMETERS:   nothing
    #
    # RETURNS:      nothing

    proc Pause {} {
        puts "\n<W> Paused"
        puts -nonewline "> "
        flush stdout
        gets stdin
        puts "\n"
    }; # End of Pause

Expect  edit

expect -D 1 script.tcl

Finding Source Code  edit

#!/usr/bin/env tclsh
package require Tk
foreach item [info loaded] {
    foreach {lib pkg} $item break
    puts "lib = $lib"
    puts "pkg = $pkg"
    exec ldd $lib
}
exit

tcllib's profiler  edit

• Putting "DEBUG msg" will open a message box (OK, this is pretty basic, but handy)
• Pressing control-p will show selected profiling info (exclusive runtime by proc as a % of total)
• Pressing control-h will show a list of opened file channels (the "h" is for "handle")
• Pressing control-l will show a list of windows, with the window class and, for text widgets, a list of tags

set DEVEL_VER true

proc DEBUG {msg} {
    global DEVEL_VER
 
    if {$DEVEL_VER} {
        tk_messageBox -icon info -message "Debugging information:\n\n$msg"
    }
}

proc LONGDEBUG {msg} {
    # This gives a scrollable window for a long message
    set tlvl_num [clock seconds]
    while [winfo exists .debug_$tlvl_num] {
        incr tlvl_num
    }
    
    set tlvl ".debug_$tlvl_num"
    toplevel $tlvl
    
    ScrolledWindow $tlvl.sw
    
    text $tlvl.sw.t -font "Courier 8"
    
    $tlvl.sw setwidget $tlvl.sw.t
    
    $tlvl.sw.t insert end $msg
    $tlvl.sw.t config -state disabled
    
    pack $tlvl.sw -fill both -expand yes
}

proc GET_PROFINFO {} {
    set procinfo [::profiler::sortFunctions exclusiveRuntime]
    set numprocs [llength $procinfo]
    set tottime 0
    set pnames {}
    set ptimes {}
    for {set i [expr $numprocs - 1]} {$i >= 0} {incr i -1} {
        set item [lindex $procinfo $i]
        set ptime [lindex $item 1]
        incr tottime $ptime
        lappend pnames [lindex $item 0]
        lappend ptimes $ptime
    }
    set msg {}
    foreach pname $pnames ptime $ptimes {
        if {$ptime == 0} {break}
        set frac [expr (100 * $ptime) / $tottime]
        if {$frac == 0} {set frac "< 1"}
        lappend msg "$frac%\t$pname"
    }
    return [join $msg "\n"]
}

proc GET_WINDOWS_recurse {window listvar} {
    upvar $listvar wlist
  
    set class [winfo class $window]
    set item "$window ($class)"
    if {$class eq "Text"} {
        set item "$item\n\t[join [$window tag names] \n\t]"
    }
    lappend wlist $item
    foreach child [winfo children $window] {
       GET_WINDOWS_recurse $child wlist
    }
}

proc GET_WINDOWS {} {
    set wlist {}
    GET_WINDOWS_recurse . wlist
    return [join $wlist "\n"]
}

if {$DEVEL_VER} {
    package require profiler
    ::profiler::init
    bind . <Control-p> {LONGDEBUG [GET_PROFINFO]}
    bind . <Control-l> {LONGDEBUG [GET_WINDOWS]}
    bind . <Control-h> {LONGDEBUG [join [file channels] "\n"]}
}

PED  edit

Misc  edit

http://wiki.tcl.tk/3875#pagetoc9ec85e31

http://wiki.tcl.tk/8637

Tkcon has a command called [idebug] which you can insert into your code to create breakpoints and stack dumps. http://wiki.tcl.tk/1878

GUI Tool edit

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References