Debugging.ns

Newspeak3
'Root'
class Debugging usingPlatform: platform ide: ide (* :exemplar: ide debugging *) = (
	(* UI for the Web debugger. *)
	|
	private List = platform collections List.
	private Map = platform collections Map.
	
	private JSObject = platform js global at: 'Object'.

	private Color = platform graphics Color.

    private ActivationMirror = platform mirrors ActivationMirror.
	private ObjectMirror = platform mirrors ObjectMirror.

	private Gradient = platform hopscotch Gradient.
	private Subject = platform hopscotch Subject.
	private TextEditorFragment = platform hopscotch TextEditorFragment.

	private EvaluationViewState = ide browsing EvaluationViewState.
	private ProgrammingPresenter = ide browsing ProgrammingPresenter.
    private EvaluatorSubject = ide browsing EvaluatorSubject.
	private SlotPresenter = ide browsing SlotPresenter.
	private SlotSubject = ide browsing SlotSubject.
    private ObjectSubject = ide browsing ObjectSubject.
    private Utilities = ide browsing Utilities.

	ide = ide.

    private styleButtonSize <Float> = 30.
    private actors = platform actors.
	|
    (* Set the system's exception handler of last resort to open the debugger. We set this up here, because this the earliest point where the debugger is ready to use. *)
   actors ultimateExceptionHandler: [:e :signaler |
        | thread = ActivationMirror threadForBrokenActivation: signaler reason: e. 
        ts = ThreadSubject onModel: thread.
        |
          Utilities enterSubject: ts.
  ].
) (
class ActivationPresenter onSubject: s <ActivationSubject> = ProgrammingPresenter onSubject: s (
	|
	slots <PresenterList>
	editor <CodeMirrorFragment>
    mustBeExpanded ::= false. (*  See isExpanded for a discussion of this slot's purpose *)
	|
) (
acceptResponse ^ <[:CodeMirrorFragment :Event]> = (
	^ [:ed <CodeMirrorFragment> :event <Event> |
		updateGUI: [respondToSourceAccept: ed].
		ed editor focus.
		]
)
changeResponse ^ <[:CodeMirrorFragment :Event]> = (
	^[:ed <CodeMirrorFragment> :event <Event> | | cp <Integer> |
		ed updateEditState.
	 ]
)
public collapse = (
	substance collapse.
)
definitionForControls = (
	^row: {
		button: 'into' action: [respondToStepInto].
		smallBlank.
		button: 'into closure' action: [respondToStepIntoClosure].
		smallBlank.
		button: 'over' action: [respondToStepOver].
		smallBlank.
		button: 'out' action: [respondToStepOut].
		smallBlank.
		button: '^self' action: [respondToReturnSelf].
		smallBlank.
		button: '^nil' action: [respondToReturnNil].
		smallBlank.
		button: '^false' action: [respondToReturnFalse].
		smallBlank.
		button: '^true' action: [respondToReturnTrue].
		filler.
		button: 'restart' action: [respondToRestart].
		smallBlank.
	}
)
public expand = (
	substance expand.
)
messagesMenu = (
	| messagesAndActions messageItems classItems |
	messagesAndActions:: List new.
	messagesAndActions add:
		{subject name. [browseSelector: subject name]}.
	messageItems:: referencesMenuMessageItems.
	messageItems isEmpty not ifTrue:
		[messagesAndActions
			add: #separator;
			addAll: messageItems].
	^menuWithLabelsAndActions: messagesAndActions
)
highlightSourceRange = (
	| source range style |
	source:: subject source.
	nil = source ifTrue: [editor text: '<no source>'. ^self].
	editor text: source.	
	range:: subject sourceRange.
	nil = range ifTrue: [^self].
	style:: JSObject new.
	style at: 'css' put: 'color:blue; font-weight:bold; text-decoration: underline'.
	editor style: style from: range start to: range stop.
)
public isKindOfActivationPresenter ^ <Boolean> = (
  ^true
)
isMyKind: f <Fragment> ^ <Boolean> = (
  ^f isKindOfActivationPresenter
)
public refresh = (
	nil = slots ifFalse:
		[slots setPresenters: computeSlotPresenters].
	nil = editor ifFalse:
		[highlightSourceRange].
)
refreshThreadPresenter = (
	| ancestor ::= parent. |
	[nil = ancestor] whileFalse:
		[ancestor isKindOfThreadPresenter ifTrue:
			[^ancestor refresh].
		 ancestor:: ancestor parent].
)
respondToInspectMirror = (
	inspectObject: subject activationMirror.
)
respondToRestart = (
	updateGUI: [subject restart].
)
respondToReturnFalse = (
	updateGUI: [subject returnFalse].
)
respondToReturnNil = (
	updateGUI: [subject returnNil].
)
respondToReturnSelf = (
	updateGUI: [subject returnSelf].
)
respondToReturnTrue = (
	updateGUI: [subject returnTrue].
)
respondToStepInto = (
	updateGUI: [subject stepInto].
)
respondToStepIntoClosure = (
	updateGUI: [subject stepThrough].
)
respondToStepOut = (
	updateGUI: [subject stepOut].
)
respondToStepOver = (
	updateGUI: [subject stepOver].
)
public tag ^ <String> = (
  ^subject title
)
public isExpanded: b <Boolean>  = (
(* Called by the thread presenter to indicate this activation should be expanded.
Calling expand is inappropriate, because at the time the thread presenter definition is
computed, no visual has been computed yet. Instead, this method is used to indicate
that the substance should be expanded when it has a visual. See also the comment in
#updateVisualsFromSameKind:.
*)
    mustBeExpanded: true.
	substance isExpanded: b.
)
updateVisualsFromSameKind: oldPresenter <Self> ^ <Alien[Element]> = (
(* We override this method because we need to ensure that the topmost activation on the stack 
     is open, even if it was closed before.  ThreadPresenter tells the topmost activation to be open.
     However, the process of updating the visuals to reflect the state of the frames may close the frame
     again (for example, when returning from an activation, if the calling frame was closed prior to
     returning).  Also see the comment in #isExpanded:.
*)
   super updateVisualsFromSameKind: oldPresenter. 
   mustBeExpanded ifTrue: [substance expand].
   ^substance visual
)
respondToCreateMissingSlot = (
	| receiverClass = subject activationMirror receiver getClass reflectee. |
	browseClass: receiverClass.
)
respondToCreateMissingMethod = (
	| 
    receiverClassMirror <ClassMirror> = subject activationMirror receiver getClass. 
    receiverClass <Class> = receiverClassMirror reflectee. 
    targetPresenter <MethodGroupPresenter>
    |
	browseClass: receiverClass.
    targetPresenter::  receiverClassMirror isMeta
      ifFalse: [shell currentPresenter instanceMethodsPresenter]
      ifTrue: [shell currentPresenter classMethodsPresenter].
    targetPresenter addNewItemTemplate: subject proposedMissingMessageSource.
)
respondToCreateMissingClass = (
	| receiverClass = subject  activationMirror receiver getClass reflectee. |
	browseClass: receiverClass.
    shell currentPresenter nestedClassesPresenter addNewItemTemplate: subject proposedMissingClassSource
)
respondToSourceAccept: editor <CodeMirrorFragment> = (
	subject
		installNewSource: editor textBeingAccepted
		ifSuccess: [editor leaveEditState]
		ifFailure: [:msg | editor showMessage: msg].
)
definitionForSource = (
	editor:: codeMirror: subject source.
	editor acceptResponse: acceptResponse; changeResponse: changeResponse; evaluateResponse: evaluateResponse.
	highlightSourceRange.
	^editor
)
actionsMenu = (
	^menuWithLabelsAndActions: {
		{'Inspect Mirror'. [respondToInspectMirror]}.
		{'Inspect Presenter'. [respondToInspectPresenter]}.
        },
        (subject isMessageNotUnderstood ifTrue: [
			{{'Create missing method ', subject notUnderstoodMessage selector. [respondToCreateMissingMethod].}},
			((subject notUnderstoodMessage arguments isEmpty and: [subject  activationMirror receiver getClass isMeta not]) ifTrue: [
			  {{ 'Create missing class ', subject notUnderstoodMessage selector. [respondToCreateMissingClass]}.
			  {'Create missing slot ', subject notUnderstoodMessage selector. [respondToCreateMissingSlot]}.
			  {'Create missing lazy slot ', subject notUnderstoodMessage selector. [respondToCreateMissingLazySlot]}.
			 }] ifFalse: [{}]
           )] ifFalse: [{}])
)
respondToCreateMissingLazySlot = (
	| 
    receiverClassMirror <ClassMirror> = subject activationMirror receiver getClass. 
    receiverClass <Class> = receiverClassMirror reflectee. 
    |
	browseClass: receiverClass.
    shell currentPresenter lazySlotsPresenter addNewItemTemplate: subject proposedMissingLazySlotSource.
)
referencesMenuMessageItems = (
	| items sortedMessages|
	items:: List new.
	sortedMessages:: subject messages sort: [:m1 :m2 | 
       Utilities lexicallyLessOrEqual: m1 than: m2
     ].
	sortedMessages do:
		[:selector |
		selector == subject name ifFalse:
			[items add:
				{selector copyFrom: 1 to: (64 min: selector size). [browseSelector: selector]}]].
	^items
)
stepIntoButton = (
  ^button: 'into' action: [respondToStepInto]
)
returnSelfButton ^ <ButtonFragment> = (
  ^button: '^self' action: [respondToReturnSelf]
)
public definition ^ <Fragment> = (
	^collapsed: [column: {helpSection. definitionForHeader}] expanded: [column: {
        helpSection.
		definitionForHeader.
		definitionForControls.
		(row: {
			definitionForSource width: 0 elasticity: 1.6 asFloat.
			smallBlank.
			definitionForState width: 0 elasticity: 1.
		}) crossAxisAlignToStart.
	}]
)
definitionForHeader = (
	| qualification |
	qualification:: subject receiverMixin = subject methodMixin
		ifTrue:
			[{}]
		ifFalse:
			[{
				(label: ' ( ')
					color: tertiaryTextColor.
				(link: subject methodMixin name action: [browseMixinMirror: subject methodMixin])
					color: secondaryTextColor.
				(label: ' )')
					color: tertiaryTextColor.
			}].

	^row: {
    	accessIndicator.
		blank: 3.
		(link: subject name action: [substance toggle])
			color: actionLinkColor.
		(label: ' in ')
			color: tertiaryTextColor.
		(link: subject receiverMixin name action: [browseMixinMirror: subject receiverMixin])
			color: secondaryTextColor.
	} , qualification , {
		filler.
		dropDownMenu: [messagesMenu] image: ide images itemReferencesImage.
        helpButton.
		dropDownMenu: [actionsMenu].
	}
)
stepIntoClosureButton = (
  ^button: 'into closure' action: [respondToStepClosure]
)
returnFalseButton ^ <ButtonFragment> = (
  ^button: '^false' action: [respondToReturnFalse]
)
returnNilButton ^ <ButtonFragment> = (
  ^button: '^nil' action: [respondToReturnNil]
)
returnTrueButton ^ <ButtonFragment> = (
  ^button: '^true' action: [respondToReturnTrue]
)
stepOutButton = (
  ^button: 'out' action: [respondToStepOut]
)
stepOverButton = (
  ^button: 'over' action: [respondToStepOver]
)
restartButton ^ <ButtonFragment> = (
  ^button: 'restart' action: [respondToRestart]
)
helpText = (
  | 
  mapping = Map new. 
  menuImage = Utilities uriForIconNamed: #hsDropdownImage. 
  referenceImage = Utilities uriForIconNamed: #itemReferencesImage.
  menuDescription = 
    subject isMessageNotUnderstood 
      ifTrue: ['inspecting this presenter or a mirror on the activation''s method, or creating a new slot (lazy or not), class or method in response to a message that was not understood.'] ifFalse: ['inspecting this presenter or a mirror on the activation''s method.'].
  |
  mapping 
    at: #debuggerStepIntoButton put: stepIntoButton;
	at: #debuggerStepIntoClosureButton put: stepIntoClosureButton;
	at: #debuggerStepOverButton put: stepOverButton;
	at: #debuggerStepOutButton put: stepOutButton;
	at: #debuggerReturnSelfButton put: returnSelfButton;
	at: #debuggerReturnNilButton put: returnNilButton;
	at: #debuggerReturnFalseButton put: returnFalseButton;
	at: #debuggerReturnTrueButton put: returnTrueButton;
	at: #debuggerRestartButton put: restartButton;
    at: #hopscotchAccessIndicator put: accessIndicator;  
    at: #hopscotchMethodReferencesButton put: (dropDownMenu: [messagesMenu] image: ide images itemReferencesImage);
    at: #hopscotchHelpButton put: helpButton;
    at: #hopscotchActivationMenuButton put: (dropDownMenu: [actionsMenu]).
    
  ^ampleforth: 'This is an activation presenter. An activation presenter can be either expanded or collapsed. In the collapsed state, only the activation''s method header and set of activation control buttons are shown. 
  <br><br>From left to right, the method header displays: 
  <ul>
  <li><div class="hopscotchAccessIndicator"></div> The method''s access modifier. The color of the access modifier indicates whether the method is public (green), protected (yellow) or private (red).</li>
  <li>The method selector</li> 
  <li><div class="hopscotchMethodReferencesButton"> </div> Allows you to find senders and implementors of the method''s selector and of any messages sent within it.</li>
  <li><div class="hopscotchHelpButton"> </div> Shows this help message.</li>
  <li><div class="hopscotchActivationMenuButton"> </div> Opens a menu of additional operations, such as </li>', menuDescription, '
  </ul>
  Below the header is a row of buttons that control the activation''s behavior in the debugger. These are:
  <ul>
    <li><div class = "debuggerStepIntoButton"></div>  Step into the next method.</li>
    <li><div class = "debuggerStepIntoClosureButton"></div>  Step into the next closure or method.</li>
    <li><div class = "debuggerStepOverButton"></div>  Step over the next method.</li>
    <li><div class = "debuggerStepOutButton"></div>  Step out of the current method.</li>
    <li><div class = "debuggerReturnSelfButton"></div>  Return <b>self</b> from the current method.</li>
    <li><div class = "debuggerReturnNilButton"></div>  Return <b>nil</b> from the current method.</li>
    <li><div class = "debuggerReturnFalseButton"></div>  Return <b>false</b> from the current method.</li>
    <li><div class = "debuggerReturnTrueButton"></div>  Return <b>true</b> from the current method.</li>
    <li><div class = "debuggerRestartButton"></div>  Restart the current method.</li>
 </ul>
  When the method presenter is expanded, an editor pane containing the method source is displayed underneath the control buttons. You can edit the method. Once the code is changed, indicators appear at the top right corner of the editor pane. You can accept the changes by pressing, or revert back to the original by pressing . You can also accept changes by pressing Cmd-return (on mac) or Ctl-return (on Linux or Windows). You can evaluate code in the editor pane by selecting it and pressing Shift-Return. The results are displayed in the result list of evaluator to the right. For more about evaluators, see the evaluator''s own help section.
  <br><br>
  Underneath the evaluator is a link to the receiver, <b>self</b> and under that are toggled links to values of all the slots in the activation, including its formal parameters and its local slots (aka local variables). You can open the toggle or follow the link; in either case, you get an object presenter on the slot''s contents.
  '
  mapping: mapping
)
evaluateResponse ^ <[:CodeMirrorFragment]> = (
    ^[:ed <CodeMirrorFragment>  | 
        | src <String> ::=  ed editor getSelection. |
        src isEmpty ifTrue: [
            src:: ed currentLine.
        ].
        src isEmpty ifFalse: [
            updateGUI: [ 
                subject evaluator evaluate: src withoutNbsp.                 
            ].
            ed editor focus.
        ].
    ].
)
computeSlotPresenters = (
	^subject slots collect:
		[:slot <LocalSubject> |  slot presenter].
)
definitionForState = (
	^column: {
		subject evaluator presenter.
        link: 'self' action: [enterSubject: subject receiver].
		slots:: column: computeSlotPresenters.
	}
)
) : (
)
class ActivationSubject onModel: m <ActivationMirror> in: t <ThreadSubject> = Subject onModel: m (
|
	protected threadSubject <ThreadSubject> = t.
	public evaluator <EvaluationSubject> = EvaluatorSubject onModel: (EvaluationViewState onModel: activationMirror).
    slotMap <Map[Symbol, ActivationSlotSubject]> ::= Map new.
|
) (
public = other <Object> ^<Boolean> = (
(* no need for hash - superclass version is fine *)
	other isKindOfActivationSubject ifFalse: [^false].
	^activationMirror = other activationMirror
)
public activationMirror ^<ActivationMirror> = (
	^model
)
public className = (
	^nil
)
public createPresenter = (
	^ActivationPresenter onSubject: self
)
public evaluate: expression <String> ^<ThreadMirror> = (
	^activationMirror evaluate: expression
)
public homeMirror ^<ActivationMirror> = (
	| result ::= activationMirror. |
	[nil = result closure] whileFalse: [result:: result enclosingActivation].
	^result
)
public isKindOfActivationSubject ^<Boolean> = (
	^true
)
isMyKind: s <Subject> ^ <Boolean> = (
  ^s isKindOfActivationSubject
)
public messages ^ <List[Symbol]> = (
  ^activationMirror method selectors
)
public methodMixin ^<MixinMirror> = (
	^activationMirror method definingMixin
)
public name ^<String> = (
	| n enclosing |
	n:: activationMirror method name.
	enclosing:: activationMirror enclosingActivation.
	[nil = enclosing] whileFalse:
		[n:: '[] in ', n.
		 enclosing:: enclosing enclosingActivation].
	^n
)
public receiverMixin ^<MixinMirror> = (
	^activationMirror receiver getClass mixin
)
public restart = (
	activationMirror restart.
)
public returnFalse = (
	activationMirror return: (ObjectMirror reflecting: false).
)
public returnNil = (
	activationMirror return: (ObjectMirror reflecting: nil).
)
public returnSelf = (
	activationMirror return: model receiver.
)
public returnTrue = (
	activationMirror return: (ObjectMirror reflecting: true).
)
public source ^<String> = (
	| s = activationMirror method source. |
	nil = s ifTrue: [^'<source unavailable>'].
	^s
)
public sourceRange ^<Interval> = (
	^activationMirror sourceRange
)
public stepInto = (
	activationMirror stepInto.
)
public stepOut = (
	activationMirror stepOut.
)
public stepOver = (
	activationMirror stepOver.
)
public stepThrough = (
	activationMirror stepThrough.
)
public title ^<String> = (
	^name , ' in ' , receiverMixin name , '(', methodMixin name , ')'.
)
public receiver ^ <ObjectSubject> = (
  ^ObjectSubject onModel: activationMirror receiver
)
public isMessageNotUnderstood ^ <Boolean> = (
	^selector = #doesNotUnderstand:
)
public selector = (
	^activationMirror method name
)
public notUnderstoodMessage ^ <Message> = (
   isMessageNotUnderstood ifFalse: [^halt].
  ^threadSubject threadMirror result reflectee message
)
public proposedMissingMessageSource ^ <String> = (
 ^messageHeaderSource, ' = (
   
 )'
)
messageHeaderSource ^ <String> = (
	| message |
	isMessageNotUnderstood ifFalse: [^''].
	message:: notUnderstoodMessage.
    message arguments isEmpty ifTrue: [^message selector].
    message arguments size = 1 ifTrue: [^message selector, 'arg' ].
    
)
public proposedMissingClassSource ^ <String> = (
	| message |
	isMessageNotUnderstood ifFalse: [^''].
	message:: notUnderstoodMessage.
	assert: [message arguments isEmpty] message: 'Cannot define non-unary class accessor'.
	^'class ', messageHeaderSource, ' = ()( )'
)
public installNewSource: newSource <String> ifSuccess: onSuccess <[]> ifFailure: onFailure <[:String]> = (
	| home builder newMethod |
	(threadSubject includesActivation: activationMirror) ifFalse:
		[^onFailure value: 'Activation is not in thread'].
	home:: homeMirror.
	(threadSubject includesActivation: home) ifFalse:
		[^onFailure value: 'Closure''s method is not in thread'].
	builder:: activationMirror method definingMixin asBuilder.
	[newMethod:: builder methods addFromSource: newSource]
		on: Exception
		do: [:compileError | ^onFailure value: compileError printString].
	newMethod name = activationMirror method name ifFalse:
		[^onFailure value: 'Selector changed'].
	ide installFromBuilders: {builder declaration}.
	[home restartWithLookup]
		on: Exception
		do: [:restartError | ^onFailure value: restartError printString].
	^onSuccess value
)
public accessModifier = (
  ^activationMirror method accessModifier
)
public proposedMissingLazySlotSource ^ <String> = (
 ^'lazy ', messageHeaderSource, ' = expression.'
)
slotSubjectFor: slot <LocalSlotMirror> ^ <ActivationSlotSubject> = (
  | 
  val <ObjectMirror> = slot value.
  entry <ActivationSlotSubject> ::= slotMap at: slot name ifAbsent: [
    ActivationSlotSubject name: slot name ofActivation: activationMirror value: slot value
    ].
  |
  (* If the value in the slot has changed, compute a new slot subject. This should probably be handled differently *)
  val = entry slotValueMirror ifFalse: [ (* shouldn't we update the slotMap? *)
    entry:: ActivationSlotSubject name: slot name ofActivation: activationMirror value: slot value
    ].
  ^entry
)
public slots = (
  | 
  newMap <Map[Symbol, ActivationSlotSubject]> = Map new.
  slotList<List[ActivationSlotSubject]> =   activationMirror slots collect: [:slot <LocalSlotMirror> |  
	newMap at: slot name put: (slotSubjectFor: slot)
	].
  |
  slotMap:: newMap.
  ^slotList
)
) : (
)
class ThreadPresenter onSubject: s <ThreadSubject> = ProgrammingPresenter onSubject: s (
	|
	activations <PresenterList>
	|
) (
actionsMenu = (
	^menuWithLabelsAndActions: {
		{'Inspect Mirror'. [respondToInspectMirror]}.
		{'Inspect Presenter'. [respondToInspectPresenter]}.
	}
)
failureHeadingColor = (
	^Gradient from: (Color h: 0 s: 0.5 v: 0.8) to: (Color h: 0 s: 0.5 v: 0.6)
)
public isKindOfThreadPresenter ^<Boolean> = (
	^true
)
isMyKind: f <Fragment> ^ <Boolean> = (
  ^f isKindOfThreadPresenter
)
mainHeadingBlock: body = (
	^(padded: body with: {10. 10. 0. 10.})
		color: (subject isFulfilled ifTrue: [successHeadingColor] ifFalse: [failureHeadingColor])
)
respondToCollapseAll = (
	activations childrenDo: [:activation <ActivationPresenter> | activation collapse].
)
respondToContinue = (
	updateGUI: [subject resume].
	(*refresh.*)
)
respondToExpandAll = (
	activations childrenDo: [:activation <ActivationPresenter> | activation expand].
)
respondToInspectMirror = (
	inspectObject: subject threadMirror.
)
respondToTerminate = (
	updateGUI: [subject terminate].
	(* refresh *)
)
successHeadingColor = (
	^Gradient from: (Color h: 120 s: 0.5 v: 0.7) to: (Color h: 120 s: 0.5 v: 0.5)
)
definition = (
	^column: {
        helpSection.
		definitionForHeading.
		smallBlank.
		definitionForResult.
		definitionForActivations.
	}
)
helpText = (
  | mapping = Map new. |
  mapping 
    at: #debuggerMenu put: (dropDownMenu: [actionsMenu]);
    at: #hopscotchHelpButton put: helpButton;
    at: #debuggerContinueButton put: ((button: 'Continue' action: [respondToContinue]) enabled: subject canResume);
    at: #debuggerTerminateButton put: ((button: 'Terminate' action: [respondToTerminate]) enabled: subject canResume).
  
  ^ampleforth: 'This is a thread presenter.  At the top you''ll see a description of the state of the thread.  When the thread is broken the description shows a dark red background. If the thread is fulfilled, it has a green background. At the far right is a menu
  <div class = "debuggerMenu"></div> with options to inspect this presenter or a mirror on the thread.
 Below are some buttons:
  <ul>
  <li><div class = "debuggerContinueButton"></div>Resumes the thread</li>.
  <li><div class = "debuggerTerminateButton"></div>Terminates the thread.</li>.
  <li><div class = "hopscotchHelpButton"></div>Shows this help message.</li>
  </ul>
  Further below is a toggled displays the thread''s result value. Expanding it shows an object presenter on the result. See the object presenter''s help for more information.
  <br><br>
  Underneath that is the call stack. When the debugger opens up, the topmost activation is expanded, and the rest of the stack activations are collapsed. Each activation frame has a toggle on its left, which can expand to show the method in question and the state of the frame. See the help section for activations for details.
' mapping: mapping
)
definitionForResult ^ <SlotPresenter | BlankFragment> = (
	| result <SlotSubject | Nil> = subject resultAsSlot. |
	nil = result ifTrue: [^nothing].
	^result presenter
)
definitionForActivationsList = (
	activations:: taggedColumn: (subject refreshActivationChain collect: [:s | s presenter]).
    activations childrenDo: [:first | first isExpanded: true. ^activations].
    ^activations
)
definitionForActivations = (
	subject canResume ifFalse: [^nothing].
	^column: {
		minorHeadingBlock: (row: {
			label: 'Activations'.
			filler.
			expandButtonWithAction: [respondToExpandAll].
			blank: 3.
			collapseButtonWithAction: [respondToCollapseAll].
		}).
		smallBlank.
		definitionForActivationsList.
		largeBlank.
	}
)
definitionForHeading = (
	^mainHeadingBlock: (column: {
		row: {
			(label: 'Thread: ', subject stateName) color: Color white.
			filler.
			dropDownMenu: [actionsMenu].
		}.
		mediumBlank.
		row: {
			filler.
			(button: 'Continue' action: [respondToContinue]) enabled: subject canResume.
			largeBlank.
			(button: 'Terminate' action: [respondToTerminate]) enabled: subject canResume.
			filler.
            helpButton.
		}.
	})
)
) : (
)
public class ThreadSubject onModel: m <ThreadMirror> = Subject onModel: m (
	|
	protected storedActivations <List[ActivationSubject]> ::= List new.
    resultSlot
	|
) (
public canResume = (
	^(nil = model suspendedActivation) not
)
public createPresenter = (
	^ThreadPresenter onSubject: self
)
public includesActivation: activation <ActivationMirror> = (
	| a |
	a:: threadMirror suspendedActivation.
	[nil = a] whileFalse:
		[a = activation ifTrue: [^true].
		 a:: a sender].
	^false
)
public isFulfilled = (
	^model isFulfilled
)
public isKindOfThreadSubject ^<Boolean> = (
	^true
)
isMyKind: s <Subject> ^ <Boolean> = (
  ^s isKindOfThreadSubject
)
public refreshActivationChain ^<List[ActivationSubject]> = (
	| oldActivations newActivations activation overlapSize |

	oldActivations:: storedActivations.
	newActivations:: List new.
	activation:: model suspendedActivation.
	[nil = activation] whileFalse:
		[newActivations add: (ActivationSubject onModel: activation in: self).
		 activation:: activation sender].

	replaceCommonSuffixFrom: oldActivations to: newActivations.

	^storedActivations:: newActivations.
)
replaceCommonSuffixFrom: oldList to: newList = (
	0 to: (newList size min: oldList size) - 1 do: [:offset |
		|
		newIndex = newList size - offset.
		oldIndex = oldList size - offset.
		|
		(oldList at: oldIndex) = (newList at: newIndex)
			ifTrue: [newList at: newIndex put: (oldList at: oldIndex)]
			ifFalse: [^self]].
)
public resume = (
	model resume.
)
public stateName ^<String> = (
	model isFulfilled ifTrue: [^'Fulfilled'].
	model isBroken ifTrue: [^'Broken'].
	model isSuspended ifTrue: [^'Suspended'].
	model isTerminated ifTrue: [^'Terminated'].
	^'Unknown'
)
public terminate = (
	model terminate.
)
public threadMirror ^<ThreadMirror> = (
	^model
)
adjustActivationsForLazySlots: activations <List[ActivationSubject]> = (
  model suspendedActivation isLazySlotActivation ifFalse: [^self].
  (* Is it a setter,? If so return.
      figure out what lazy slot this is.
       Are we in the init method?
         If so, return, we are debugging it.
         Otherwise, we are in the getter.
         Pop activations (what ever happens, we won't stay in this activation)
         See if the slot is not nil?
            Are we about to test (i.e., at the start of the getter?).
              If so we need to push past the test. 
              If not, we've already set the slot (we returned form the init method)
         Return in the execution.
       Otherwise, slot is nil. We need to step into the init method, and then add the extra activation on top of activations
  *)
)
public resultAsSlot ^ <SlotSubject | Nil> = (
	| r <ObjectMirror> = model result. |
	nil = r ifTrue: [resultSlot:: nil. ^nil].
    (resultSlot isNil or: [r ~= resultSlot slotValueMirror])
    	ifTrue: [resultSlot:: ThreadResultSubject onObject: model].
	^resultSlot
)
) : (
)
public class ActivationSlotSubject name: n <String> ofActivation: am <ActivationMirror> value: v = SlotSubject name: n ofObject: am  (
  | public slotValueMirror = v. |
) (
public isKindOfActivationSlotSubject ^ <Boolean> = (
  ^true
)
isMyKind: other = (
  ^other isKindOfActivationSlotSubject
)
public setValue: expression <String> ifCompilerError: compileFailBlock<[:Error]>  ifError: failBlock <[:ThreadMirror]> = (
	| 
    evalThread <ThreadMirror>
    |
	evalThread::
		[activationMirror evaluate: name, ': ', expression]
          on: Error do: [:ce | compileFailBlock value: ce printString].
              
	evalThread  isBroken (* so for runtime errors, the block should take a thread so it can open a debugger on it *)
       ifTrue: [failBlock value: evalThread] 
)
public activationMirror ^ <ActivationMirror> = (
  ^activation
)
public activation ^ <ActivationMirror>  = (
  ^model objectMirror
)
) : (
)
class ThreadResultSubject onObject: o = SlotSubject  name: #result ofObject: o (
(*
This class is used to represent the result of a thread. The thread result is considered to be a  "virtual slot".
*)
) (
createPresenter = (
  ^ThreadResultPresenter onSubject: self
)
public isKindOfThreadResultSubject ^ <Boolean> = (
  ^true
)
isMyKind: other = (
  ^other isKindOfThreadResultSubject
)
public slotValueMirror ^<ObjectMirror> = (
	^model objectMirror result
)
) : (
)
class ThreadResultPresenter onSubject: s = SlotPresenter onSubject: s (
) (
expandedDefinition ^ <Fragment> = (
  ^details
)
public isKindOfThreadResultPresenter ^ <Boolean> = (
  ^true
)
isMyKind: other = (
  ^other isKindOfThreadResultPresenter
)
) : (
)
) : (
)