1# File: errorInfo.tcl 2 3# Purpose: errorInfo display for debugging 4 5# 6# Copyright (c) 1997-2001 Tim Baker 7# 8# This software may be copied and distributed for educational, research, and 9# not for profit purposes provided that this copyright and statement are 10# included in all such copies. 11# 12 13proc tracecmd {text name1 name2 op} { 14 15 global traceId 16 global errorInfo 17 global traceInfo 18 global traceText 19 20 set errorString $errorInfo 21 if {![winfo exists $text]} { 22 trace vdelete errorInfo w "tracecmd $text" 23 return 24 } 25 26 # Hack - ignore the warnings about not finding the 27 # file tclIndex.tcl They are harmless. 28 if [string match "*tclIndex*" $errorString] { 29 return 30 } 31 32 set length [string length $traceInfo] 33 set string [string range $errorString 0 [expr {$length - 1}]] 34 set newline 1 35 if {[string equal $traceInfo $string]} { 36 set errorString [string range $errorString $length end] 37 set newline 0 38 } 39 if {[string equal $errorString $traceInfo]} return 40 set traceInfo $errorString 41 42 if {$newline} { 43 append traceText "\n\n$errorString" 44 } else { 45 append traceText $errorString 46 } 47 if {![string length $traceId]} { 48 set traceId [after idle traceflush $text] 49 } 50 51 return 52} 53 54proc traceflush {text} { 55 56 global traceId 57 global traceText 58 global ErrorText 59 60 append ErrorText $traceText 61 62 $text insert end $traceText 63 scan [$text index end] %d.%d line char 64 if {$line > 1000} { 65 $text delete 1.0 [expr {$line - 1000}].0 66 } 67 $text see "end linestart" 68 69 set traceId "" 70 set traceText "" 71 72 return 73} 74 75proc tracewindow {} { 76 77 set win .errors 78 toplevel $win 79 wm title $win errorInfo 80 81 frame $win.textFrame \ 82 -relief sunken -borderwidth 1 83 84 scrollbar $win.yscroll \ 85 -orient vertical -command [list $win.text yview] \ 86 -takefocus 1 87 88 scrollbar $win.xscroll \ 89 -orient horizontal -command [list $win.text xview] \ 90 -takefocus 1 91 92 if {[Platform unix]} { 93 set font {Courier 12} 94 } 95 if {[Platform windows]} { 96 set font {Courier 9} 97 } 98 99 text $win.text \ 100 -yscrollcommand [list $win.yscroll set] -wrap none \ 101 -xscrollcommand [list $win.xscroll set] \ 102 -width 82 -height 30 -font $font -borderwidth 0 \ 103 -setgrid no -highlightthickness 0 -padx 4 -pady 2 \ 104 -background Black -foreground White 105 106 pack $win.textFrame \ 107 -expand yes -fill both 108 109 110 grid rowconfig $win.textFrame 0 -weight 1 -minsize 0 111 grid columnconfig $win.textFrame 0 -weight 1 -minsize 0 112 113 grid $win.text -in $win.textFrame \ 114 -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news 115 grid $win.yscroll -in $win.textFrame \ 116 -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news 117 grid $win.xscroll -in $win.textFrame \ 118 -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news 119 120 return 121} 122 123proc tracesetup {} { 124 125 global traceId 126 global errorInfo 127 global traceInfo 128 global traceText 129 global ErrorText 130 131 tracewindow 132 133 set win .errors 134 set text $win.text 135 136 trace variable errorInfo w "tracecmd $text" 137 set traceId "" 138 set traceInfo "" 139 set traceText "" 140 set ErrorText "" 141 142 $text insert end "# Error Messages:\n\n" 143 144 return 145} 146 147proc Debug {what} { 148 149 if {![winfo exists .errors]} return 150 151 if {![string equal [.errors.text get "end - 2 chars"] "\n"]} { 152 .errors.text insert end \n 153 } 154 .errors.text insert end $what\n 155 .errors.text see end 156 157 return 158} 159 160tracesetup 161 162wm iconify .errors 163