"======================================================================
|
|   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.
! !