home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / tcl / tcl_1 / !Tcl_library_debug < prev    next >
Encoding:
Text File  |  1996-03-25  |  2.2 KB  |  84 lines
  1. # provides an error catching system for the wimp
  2.  
  3. set w_debug debug_proc
  4.  
  5. w_text debug_window create  -width 6i -close {set debug_window_open 0;join 2}
  6.  
  7. set debug_window_open 0
  8. set debug_box_open    0
  9.  
  10. w_box debug_box create "Debug"\
  11.  { vlist { write Command debug_command}
  12.         { hlist
  13.           {action Variables {debug_showvars;return show}}
  14.           {action Arrays {debug_showarrays;return show}}
  15.         }
  16.         { hlist
  17.           {action Continue {set debug_box_open 0}}
  18.           {action Quit exit}
  19.           {default Execute {debug_action;return show}}
  20.         }
  21.  }
  22.  
  23. proc debug_action {}\
  24.  { global debug_command debug_window
  25.    w_text debug_window print <$debug_command
  26.    set x [catch {uplevel $debug_command} res]
  27.    if {$x==0}\
  28.    { w_text debug_window write >$res
  29.    } \
  30.    else\
  31.    { w_text debug_window options -pon
  32.      w_text debug_window write |c255:0:0|Error:|c0:0:0|$res
  33.      w_text debug_window options -poff
  34.    }
  35.    join 1
  36.  }
  37.  
  38. proc debug_proc {}\
  39.  { global errorInfo debug_window debug_box debug_window_open debug_box_open
  40.    global w_where
  41.    set elist [split $errorInfo "\n" ]
  42.    w_text debug_window options -pon -C
  43.    w_text debug_window print |c255:0:0| "Error in $w_where" 
  44.    w_text debug_window options -poff -L
  45.    foreach line $elist {w_text debug_window write $line}
  46.    if {!$debug_window_open}\
  47.       { w_text debug_window open
  48.         set debug_window_open 1
  49.       }
  50.    if {!$debug_box_open}\
  51.       { w_box  debug_box open
  52.         set debug_box_open 1
  53.       }
  54.  }
  55.  
  56. proc debug_showvars {}\
  57.  { set glist [info globals]
  58.    w_text debug_window options -pon -C
  59.    w_text debug_window print "|c0:0:255|Global Variables"
  60.    w_text debug_window options -poff -L
  61.    foreach v $glist\
  62.    { 
  63.      catch {uplevel "w_text debug_window print $v = \[set $v\]"}
  64.    }
  65.  }
  66.  
  67. proc debug_showarrays {}\
  68.  { set glist [info globals]
  69.    w_text debug_window options -pon -C
  70.    w_text debug_window print "|c0:0:255|Global Arrays"
  71.    w_text debug_window options -poff -L
  72.    foreach v $glist\
  73.    { catch\
  74.      { set elist [uplevel "array names $v"]
  75.        w_text debug_window print $v
  76.        w_text debug_window options -l.5i
  77.        foreach e $elist\
  78.        { uplevel "w_text debug_window print ${v}($e) = \[set ${v}($e)\]" 
  79.        }
  80.        w_text debug_window options -l0
  81.      }
  82.    }
  83.  }
  84.