"====================================================================== | | Smalltalk GUI notifier window | | $Revision: 1.7.5$ | $Date: 2000/05/28 16:56:52$ | $Author: pb$ | ======================================================================" "====================================================================== | | Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc. | Written by Brad Diller. | | This file is part of GNU Smalltalk. | | GNU Smalltalk is free software; you can redistribute it and/or modify it | under the terms of the GNU General Public License as published by the Free | Software Foundation; either version 2, or (at your option) any later version. | | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS | FOR A PARTICULAR PURPOSE. See the GNU General Public License for more | details. | | You should have received a copy of the GNU General Public License along with | GNU Smalltalk; see the file COPYING. If not, write to the Free Software | Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | ====================================================================== " GuiData subclass: #Notifier instanceVariableNames: 'callstackList stacktrace currentSelection numContexts errMessage' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Browser' ! !Notifier class methodsFor: 'instance creation'! new: message names: contextStrings contexts: contexts ^self new init: message names: contextStrings contexts: contexts ! ! !Notifier methodsFor: 'accessing'! currentContext currentSelection isNil ifTrue: [ ^nil ]. ^callstackList at: currentSelection ! next currentSelection isNil ifTrue: [ ^nil ]. currentSelection := currentSelection + 1 min: numContexts. "Should change the currently selected list item" ! previous currentSelection isNil ifTrue: [ ^nil ]. currentSelection := currentSelection - 1 max: 1. "Should change the currently selected list item" ! ! !Notifier methodsFor: 'private'! init: message names: nameList contexts: contexts | topLevel topView listView| stacktrace := nameList. numContexts := contexts size. errMessage := message. topView := ((BrowserShell new: message ) data: self). topLevel := topView blox. topLevel width: 300; height: 100. topView addChildView: ((listView := PList new: 'MethodSet' in: topView) initialize; data: self; listMsg: #stacktrace; handleUserChange: #contextSelectedFrom:; menuInit: ((PopupMenu new: listView label: '') selectors: #(('Proceed') ('Inspect' inspectContext) () ('Trace dump' traceDump)) receiver: self argument: listView; selectors: #(() ('Close' close)) receiver: listView argument: nil; yourself); yourself). callstackList := listView blox. callstackList contents: nameList elements: contexts. topView display. ! close: aView | tv | tv := aView rootView blox. aView rootView close ifTrue: [tv destroy]. ! ! !Notifier methodsFor: 'callback'! traceDump | aFile | aFile := FileStream open: 'TraceDump' mode: 'a'. aFile nextPutAll: errMessage; nl. 0 to: callstackList numberOfStrings - 1 do: [ :i | aFile nextPutAll: (callstackList labelAt: i) asString; nl]. aFile nl. aFile close ! stacktrace ^stacktrace ! inspectContext ContextInspector new: self. ! contextSelectedFrom: assoc currentSelection := assoc key - 1. ! ! (Object includesSelector: #primError: ) ifFalse: [ Object addSelector: #primError: withMethod: (Object compiledMethodAt: #error:) ]! (Object includesSelector: #originalPrimError: ) ifFalse: [ Object addSelector: #originalPrimError: withMethod: (Object compiledMethodAt: #primError:) ]! !Object methodsFor: 'overriding'! primError: message | context lastContext names contexts | "Check for blox init being called already!" (BrowserMain handleErrorsWithGui) ifFalse: [ self originalPrimError: message ]. Transcript initialize. names := OrderedCollection new. contexts := OrderedCollection new. context := thisContext. lastContext := thisContext environment. BrowserMain handleErrorsWithGui: false. [ context == lastContext ] whileFalse: [ names add: context printString. contexts add: context. context := context parentContext. ]. Notifier new: self class printString, ' error: ', message names: names contexts: contexts. BrowserMain handleErrorsWithGui: true. ContextPart unwind. ! !