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