Debugging.ns

Newspeak3
'Root'
class Debugging usingPlatform: platform ide: ide = (
	(* 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 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 SlotSubject = ide browsing SlotSubject.
    private ObjectSubject = ide browsing ObjectSubject.
    private Utilities = ide browsing Utilities.

	ide = ide.

    private styleButtonSize <Float> = 30.
	|
) (
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.
)
computeSlotPresenters = (
	^subject slots collect:
		[:slot <LocalSubject> | slot presenter].
)
public definition ^ <Fragment> = (
	^collapsed: [definitionForHeader] expanded: [column: {
		definitionForHeader.
		definitionForControls.
		(row: {
			definitionForSource width: 0 elasticity: 1.6 asFloat.
			smallBlank.
			definitionForState width: 0 elasticity: 1.
		}) crossAxisAlignToStart.
	}]
)
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.
	}
)
definitionForSource = (
	editor:: codeMirror: subject source.
	editor acceptResponse: acceptResponse; changeResponse: changeResponse.
	highlightSourceRange.
	^editor
)
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.
)
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]}.
			 }] ifFalse: [{}]
           )] ifFalse: [{}])
)
definitionForState = (
	^column: {
		subject evaluator presenter.
        link: 'self' action: [enterSubject: subject receiver].
		slots:: column: computeSlotPresenters.
	}
)
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
)
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. [browseSelector: selector]}]].
	^items
)
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: {
    	image: (iconForAccessModifier: subject activationMirror method accessModifier) size: styleButtonSize.
		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.
		dropDownMenu: [actionsMenu].
	}
)
respondToSourceAccept: editor <CodeMirrorFragment> = (
	subject
		installNewSource: editor textBeingAccepted
		ifSuccess: [editor leaveEditState]
		ifFailure: [:msg | editor showMessage: msg].
)
) : (
)
class ActivationSubject onModel: m <ActivationMirror> in: t <ThreadSubject> = Subject onModel: m (
|
	protected threadSubject <ThreadSubject> = t.
	public evaluator <EvaluationViewState> = EvaluatorSubject onModel: (EvaluationViewState onModel: activationMirror).
    slotMap <Map[Symbol, SlotSubject]> ::= 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 slots = (
  | 
  newMap <Map[Symbol, SlotSubject]> = Map new.
  slotList<List[SlotSubject]> =   activationMirror slots collect: [:slot <LocalSlotMirror> |  
	newMap at: slot name put: (slotSubjectFor: slot)
	].
  |
  slotMap:: newMap.
  ^slotList
)
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, ' = ()( )'
)
slotSubjectFor: slot <LocalSlotMirror> ^ <SlotSubject> = (
  | 
  val <ObjectMirror> = slot value.
  entry <SlotSubject> ::= slotMap at: slot name ifAbsent: [
    SlotSubject name: slot name value: val
    ].
  |
  val = entry objectMirror ifFalse: [
    entry:: SlotSubject name: slot name value: val
    ].
  ^entry
)
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
)
) : (
)
class ThreadPresenter onSubject: s <ThreadSubject> = ProgrammingPresenter onSubject: s (
	|
	activations <PresenterList>
	|
) (
actionsMenu = (
	^menuWithLabelsAndActions: {
		{'Inspect Mirror'. [respondToInspectMirror]}.
		{'Inspect Presenter'. [respondToInspectPresenter]}.
	}
)
definition = (
	^column: {
		definitionForHeading.
		smallBlank.
		definitionForResult.
		definitionForActivations.
	}
)
definitionForActivations = (
	subject canResume ifFalse: [^nothing].
	^column: {
		minorHeadingBlock: (row: {
			label: 'Activations'.
			filler.
			expandButtonWithAction: [respondToExpandAll].
			blank: 3.
			collapseButtonWithAction: [respondToCollapseAll].
		}).
		smallBlank.
		definitionForActivationsList.
		largeBlank.
	}
)
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)
)
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.
		}.
	})
)
definitionForActivationsList = (
	activations:: toggleList: (subject refreshActivationChain collect: [:s | s presenter]).
    activations childrenDo: [:first | first isExpanded: true.  ^activations].
    ^activations
)
definitionForResult ^ <SlotPresenter | BlankFragment> = (
	| result <SlotSubject | Nil> = subject resultAsSlot. |
	nil = result ifTrue: [^nothing].
	^result presenter
)
) : (
)
public class ThreadSubject onModel: m <ThreadMirror> = Subject onModel: m (
	|
	protected storedActivations <List[ActivationSubject]> ::= List new.
    resultSlot
	|
) (
public = other <Object> ^<Boolean> = (
	other isKindOfThreadSubject ifFalse: [^false].
	^model = other model
)
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
)
public resultAsSlot ^ <SlotSubject | Nil> = (
	| r <ObjectMirror> = model result. |
	nil = r ifTrue: [resultSlot:: nil. ^nil].
    (resultSlot isNil or: [r ~= resultSlot objectMirror])
    	ifTrue: [resultSlot:: SlotSubject name: 'result' value: r].
	^resultSlot
)
) : (
)
) : (
)