1"======================================================================
2|
3|   Smalltalk GUI notifier window
4|
5|
6 ======================================================================"
7
8"======================================================================
9|
10| Copyright 1992,94,95,99,2000,2001,2002 Free Software Foundation, Inc.
11| Written by Brad Diller and Paolo Bonzini.
12|
13| This file is part of GNU Smalltalk.
14|
15| GNU Smalltalk is free software; you can redistribute it and/or modify it
16| under the terms of the GNU General Public License as published by the Free
17| Software Foundation; either version 2, or (at your option) any later version.
18|
19| GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
20| ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
21| FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
22| details.
23|
24| You should have received a copy of the GNU General Public License along with
25| GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
26| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
27|
28 ======================================================================
29"
30
31
32
33GuiData subclass: Notifier [
34    | callstackList debugger stacktrace currentSelection errMessage topView listView |
35
36    <comment: nil>
37    <category: 'Graphics-Browser'>
38
39    Notifier class >> debuggerClass [
40	<category: 'debugging attributes'>
41	^nil
42    ]
43
44    Notifier class >> debuggingPriority [
45	<category: 'debugging attributes'>
46	^1
47    ]
48
49    Notifier class >> openOn: aProcess message: message [
50	<category: 'instance creation'>
51	self new init: message debugger: (Smalltalk.Debugger on: aProcess)
52    ]
53
54    Notifier class >> open [
55	<category: 'instance creation'>
56	self open: 'Notifier on %1' % {Processor activeProcess}
57    ]
58
59    Notifier class >> open: message [
60	<category: 'instance creation'>
61	| handleErrorsWithGui |
62	handleErrorsWithGui := BLOX.BLOXBrowser.BrowserMain handleErrorsWithGui.
63	BLOX.BLOXBrowser.BrowserMain handleErrorsWithGui: false.
64
65	[:debugger |
66	Processor activeProcess name: 'Notifier/Debugger'.
67	self new init: message debugger: debugger.
68	BLOX.BLOXBrowser.BrowserMain handleErrorsWithGui: handleErrorsWithGui]
69		forkDebugger
70    ]
71
72    currentContext [
73	<category: 'accessing'>
74	currentSelection isNil ifTrue: [currentSelection := 1].
75	^callstackList at: currentSelection
76    ]
77
78    process [
79	<category: 'callback'>
80	^debugger process
81    ]
82
83    debugger [
84	<category: 'callback'>
85	^debugger
86    ]
87
88    contextSelectedFrom: assoc [
89	<category: 'callback'>
90	currentSelection := assoc key
91    ]
92
93    debug [
94	<category: 'callback'>
95	Debugger new: self
96    ]
97
98    stacktrace [
99	<category: 'callback'>
100	^stacktrace
101    ]
102
103    close: aView [
104	<category: 'private'>
105	| tv |
106	tv := aView rootView blox.
107	aView rootView close ifTrue: [tv destroy]
108    ]
109
110    init: aString debugger: aDebugger [
111	<category: 'private'>
112	| context lastContext contexts |
113	errMessage := aString.
114	debugger := aDebugger.
115	context := debugger suspendedContext.
116	lastContext := context environment.
117	stacktrace := OrderedCollection new.
118	contexts := OrderedCollection new.
119
120	"Skip top contexts that are internal to the exception-handling
121	 system."
122	[context ~~ lastContext and: [context isInternalExceptionHandlingContext]]
123	    whileTrue: [context := context parentContext].
124	[context == lastContext] whileFalse:
125		[context isDisabled
126		    ifFalse:
127			[stacktrace add: context printString.
128			contexts add: context].
129		context := context parentContext].
130	self createWindow.
131	callstackList contents: stacktrace elements: contexts.
132	topView display.
133	listView update.
134	listView select: 1
135    ]
136
137    createWindow [
138	<category: 'private'>
139	| topLevel |
140	topView := (BrowserShell new: errMessage) data: self.
141	topLevel := topView blox.
142	topLevel
143	    x: 20
144	    y: 50
145	    width: 300
146	    height: 100.
147	topView addChildView: ((listView := PList new: 'MethodSet' in: topView)
148		    initialize;
149		    data: self;
150		    listMsg: #stacktrace;
151		    handleUserChange: #contextSelectedFrom:;
152		    menuInit: ((PopupMenu new: listView label: 'Context')
153				selectors: #(#('Debug' #debug))
154				    receiver: self
155				    argument: listView;
156				selectors: #(#() #('Copy Trace' #copyAll) #('Copy Selection' #copySelection))
157				    receiver: listView
158				    argument: nil;
159				selectors: #(#() #('Close' #close))
160				    receiver: listView
161				    argument: nil;
162				yourself);
163		    yourself).
164	callstackList := listView blox
165    ]
166]
167
168
169
170Behavior extend [
171
172    debuggerClass [
173	<category: 'overriding'>
174	^BLOX.BLOXBrowser.BrowserMain handleErrorsWithGui
175	    ifTrue: [BLOX.BLOXBrowser.Notifier]
176	    ifFalse: [nil]
177    ]
178
179]
180
181