Inspecting.ns

Newspeak3
'HopscotchIDE'
class Inspecting usingPlatform: platform ide: ide = (
(* Presenters for inspecting objects.

   Copyright 2008, 2012 Cadence Design Systems, Inc.

   Licensed under the Apache License, Version 2.0 (the ''License'');
   you may not use this file except in compliance with the License.
   You may obtain a copy of the License at

	http://www.apache.org/licenses/LICENSE-2.0

   Unless required by applicable law or agreed to in writing, software
   distributed under the License is distributed on an ''AS IS'' BASIS,
   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
   See the License for the specific language governing permissions and
   limitations under the License.
*)
||
	private List = platform collections List.
	private Color = platform graphics Color.
	private ObjectMirror = platform mirrors ObjectMirror.
	private Subject = platform hopscotch core Subject.
	private BlankFragment = platform hopscotch fragments BlankFragment.
	private TextEditorFragment = platform hopscotch fragments TextEditorFragment.

	private ProgrammingPresenter = ide tools ProgrammingPresenter.
	private OneLineDefinitionTemplate = ide tools OneLineDefinitionTemplate.
	private workspaceManager = ide theWorkspaceManager.
	private finalizer = ide finalizer.

	private ToolSet = platform squeak ToolSet.
	private PointerFinder = platform squeak PointerFinder.

	private primitives = platform squeak VMMirror new. (* BOGUS. Should express reverse objects with mirrors somehow. *)

	(* My slots *)
	detailAreaRatio = 1.6.
	captionColor = Color h: 240 s: 0.05 v: 0.9.
||
) (
class BrazilVisualTreePresenter onSubject: theSubject <BrazilVisualTreeSubject> = ProgrammingPresenter onSubject: theSubject () (
captionLine = (
	| thumb |
	thumb:: subject visual agent inspectorIconOfSize: 20.
^
	row: {
		thumb ifNil: [nothing] ifNotNil: [linkImage: thumb action: []].
		mediumBlank.
		label: subject title.
		largeBlank.
		(link: 'flash' action: [subject visual flash]) tinyFont.
		mediumBlank.
		(link: 'explore' action: [subject visual explore]) tinyFont.
		filler.
		elastic:: inspectorToggle.
	}
)
captionLineWithToggleAction: aBlock = (
	| thumb |
	thumb:: subject visual agent inspectorIconOfSize: 20.
^
	row: {
		thumb ifNil: [nothing] ifNotNil: [linkImage: thumb action: aBlock].
		mediumBlank.
		link: subject title action: aBlock.
		largeBlank.
		(link: 'flash' action: [subject visual flash]) tinyFont.
		mediumBlank.
		(link: 'explore' action: [subject visual explore]) tinyFont.
		filler.
		elastic:: inspectorToggle.
	}
)
childColumn = (
^
	column:
		(subject children collect:
			[:each |
			(BrazilVisualTreeSubject onModel: each) presenter])
)
definition = (
^
	subject hasChildren
		ifTrue: [expandableView]
		ifFalse: [captionLine]
)
expandableView = (
	| toggle |
	toggle::
		heading: (captionLineWithToggleAction: [toggle toggle])
		details: [childColumn].
	^toggle
)
inspectorToggle = (
^
	collapsed: [label: 'Inspect']
	expanded: [(ObjectSubject onModel: (ObjectMirror reflecting: subject visual)) presenter]
)
) : (
)
public class BrazilVisualTreeSubject onModel: theModel <Visual> = Subject onModel: theModel (
(* Part of the ''Meta'' window menu item implementation. The model is a Brazil visual. *)
) (
public children = (
	^model children
)
public createPresenter = (
	^BrazilVisualTreePresenter onSubject: self
)
public hasChildren = (
	^model hasChildren
)
public title = (
	^model printString
)
public visual = (
	^model
)
) : (
)
public class EvaluatorPresenter onSubject: theSubject <ObjectSubject> = ProgrammingPresenter onSubject: theSubject (|
	editor
	results
|) (
addDiscardIfNeeded = (
	results presenters isEmpty ifTrue:
	[results add: discardResultsDefinition].
)
addExceptionalResultPresenterFor: exception <Exception> in: thread <NewspeakDebugging ThreadSubject> = (
	addDiscardIfNeeded.
	results addFirst: (
		row: {
			elastic::
				collapsed: [ExceptionalResultPresenter on: exception in: thread]
				expanded: [buildExceptionDetails: exception in: thread].
		}
	)
)
addResultPresenterOn: result <ObjectMirror> = (
	addDiscardIfNeeded.
	results addFirst: (resultFragmentOn: (ObjectSubject onModel: result))
)
buildExceptionDetails: exception <Exception> in: thread <NewspeakDebugging ThreadSubject> = (
	^column: {
		elastic:: row: {filler. (link: 'debug' action: [enterSubject: thread]) tinyFont}.
		elastic:: (ObjectSubject onModel: (ObjectMirror reflecting: exception)) presenter.
	}
)
clearResults = (
	results presenters: {}
)
createEditor = (
	editor:: TextEditorFragment new.
	editor
		changeResponse: [];
		acceptResponse: [respondToEvaluate];
		enterKeyResponse: [respondToEvaluate];
		escapeKeyResponse: [sendUp deliveryOptional hideEvaluator].		
	^editor
)
definition = (
	results:: list: {}.
	^(column: {
		smallBlank.
		row: {
			smallBlank.
			elastic:: column: {filler. createEditor. filler}.
			smallBlank.
			button: 'Evaluate' action: [respondToEvaluate].
			smallBlank.
		}.
		smallBlank.
		row: {
			elastic:: results
		}
	}) color: captionColor
)
discardResultsDefinition = (
	^row: {
		filler.
		(link: 'discard results' action: [clearResults]) tinyFont.
	}
)
respondToEvaluate = (
	editor removeMessages.
	addResultPresenterOn:: subject
		evaluate: editor maybeSelectCurrentLine
		ifCompilerError:
			[:message |
			^editor addMessage: message]
		ifError:
			[:thread :exception |
			^addExceptionalResultPresenterFor: exception in: thread].
	sendUp deliveryOptional noticeEvaluationBy: self
)
resultFragmentOn: result <ObjectSubject> ^ <Fragment> = (
	| heading |
	heading:: link: result title action: [enterSubject: result refreshmentSubject].
	sendUp
		deliveryOptional;
		additionalResultFragment:
			[:extra <Fragment> |
			heading:: row: {
				heading.
				filler.
				extra.
			}] for: result objectMirror.
	^collapsed: [heading]
		expanded: [result presenter]
)
) : (
)
public class ExceptionalResultPresenter on: ex <Exception> in: theSubject <NewspeakDebugging ThreadSubject> = ProgrammingPresenter onSubject: theSubject (|
	exception = ex.
|) (
buildInspectException = (
	| message |
	message:: exception messageText ifNotNil: [:it | it withBlanksTrimmed].
	^message isEmptyOrNil
		ifTrue: [(link: 'inspect' action: [inspect: exception]) tinyFont]
		ifFalse: [link: message action: [inspect: exception]]
)
definition = (
	^row: {
		(link: (exception isNil
			ifTrue: ['Error: ', subject title]
			ifFalse: [exception description])
		action: [respondToDebug]) color: Color red
	}
)
respondToDebug = (
	enterSubject: self subject
)
) : (
)
class ObjectIndexedSlotSubject on: mirror <ObjectMirror> slotIndex: i <Integer> = ObjectSlotSubject onModel: mirror (
(* Represents an indexed slot of an object, accessed using a vm mirror. For a subject to represent a value accessible by sending the public #at: message, see ObjectValueAtKeySubject. *)
|
	public slotIdentifier = i.
|) (
public value = (
	^objectMirror indexedSlotAt: slotIdentifier
)
public value: newValue = (
	 objectMirror indexedSlotAt: slotIdentifier put: newValue.
	^newValue
)
) : (
)
class ObjectLiteralSubject on: theMirror key: theKey = ObjectValueAtKeySubject on: theMirror key: theKey (
) (
public value = (
	^ObjectMirror reflecting: (model reflectee literalAt: key)
)
) : (
)
class ObjectNamedSlotSubject on: mirror <ObjectMirror> slotName: slotName <String> = ObjectSlotSubject onModel: mirror (
(* Represents a named slot of the model, to be accessed using a vm mirror. *)
|
	public slotIdentifier = slotName.
|) (
public objectMirror = (
	^model
)
public value = (
	^objectMirror getSlot: slotIdentifier
)
public value: newValue <ObjectMirror> = (
	objectMirror setSlot: slotIdentifier to: newValue reflectee.
	^newValue
)
) : (
)
class ObjectPresenter onSubject: subj <ObjectSubject> = ProgrammingPresenter onSubject: subj (
(* The outer shell of an inspector: shows the caption bar with an evaluator opening link. Also contains and manages (switches) presenters for the different views onto the object contents. *)
|
	public selfCaption ::= 'self'.
	public objectDetailsHolder
|) (
actionsMenu = (
	^menuWithLabelsAndActions: {
		'Inspect in Squeak' -> [respondToInspectInSqueak].
		#separator.
		'References to this Object' -> [respondToIncomingReferences].
		'Retaining path for this Object' -> [respondToRetainingPath].
		#separator.
		'Inspect Class' -> [inspect: subject modelClass].
		'Inspect Presenter' -> [respondToInspectPresenter].
	}
)
availableObjectViews ^<Collection[ObjectViewDescription]> = (
	^Array streamContents:
		[:s |
		(subject reflecteePerform: #isForm) ifTrue:
			[s nextPut:
				(ObjectViewDescription
					title: 'Form'
					presenterCreator: [ObjectPresenterFormView onSubject: subject])].
		((subject reflecteePerform: #isString) or: [subject reflecteePerform: #isText]) ifTrue:
			[s nextPut:
				(ObjectViewDescription
					title: 'Text'
					presenterCreator: [ObjectPresenterAsStringView onSubject: subject])].
		(subject reflecteePerform: #isInteger) ifTrue:
			[s nextPut:
				(ObjectViewDescription
					title: 'Radix'
					presenterCreator: [ObjectPresenterAsIntegerView onSubject: subject])].
		(subject reflecteePerform: #isCompiledMethod) ifTrue:
			[s nextPut:
				(ObjectViewDescription
					title: 'Method'
					presenterCreator: [ObjectPresenterMethodView onSubject: subject])].
		(subject reflecteePerform: #isClosure) ifTrue:
			[s nextPut:
				(ObjectViewDescription
					title: 'Block'
					presenterCreator: [ObjectPresenterBlockView onSubject: subject])].
		(subject reflecteePerform: #isDictionary) ifTrue:
			[s nextPut:
				(ObjectViewDescription
					title: 'Dictionary'
					presenterCreator: [ObjectPresenterDictionaryView onSubject: subject])].
		(subject reflecteePerform: #isCollection) ifTrue: [
			(subject reflecteePerform: #isSequenceable) ifTrue: [
				s nextPut:
				(ObjectViewDescription
					title: 'Sequence'
					presenterCreator: [ObjectPresenterSequenceView onSubject: subject])]].
		s nextPut:
			(ObjectViewDescription
				title: 'Basic'
				presenterCreator: [ObjectPresenterBasicView onSubject: subject]).
		]
)
captionBar: body = (
	^(column: {
		smallBlank.
		row: {
			mediumBlank.
			elastic: body.
			smallBlank
			}.
	})
		color: captionColor
)
classInfoLine = (
	^row: {
		(label: 'class') width: 0 elasticity: 1.
		(row: {
			link: subject className action: [browseClass: subject modelClass].
		}) width: 0 elasticity: detailAreaRatio.
	}
)
coloredBarWidth: pixels = (
	^((row: {}) color: captionColor) width: pixels
)
definition = (
	| views |
	views:: availableObjectViews.
	objectDetailsHolder:: holder: views first presenter.
	^(column: {
		headerDefinition.
		evaluatorPresenter.
		detailsSwitcherBarWith: views.
		row: {
			coloredBarWidth: 1.
			blank: 3.
			elastic:: objectDetailsHolder.
			blank: 2.
			coloredBarWidth: 1.
		}.
		coloredBarWidth: 1.
	}) color: Color white
)
detailsSwitcherBarWith: details = (
	^details size < 2
		ifTrue: [nothing]
		ifFalse:
			[(row:
				{ mediumBlank },
				(switcherLinksWith: details)
			) color: captionColor]
)
enclosingInfoLine = (
	^row: {
		(label: 'enclosingObject') width: 0 elasticity: 1.
		(row: {
			link: subject enclosingObjectName action: [inspect: subject classMirror enclosingObject reflectee].
		}) width: 0 elasticity: detailAreaRatio.
	}
)
evaluatorPresenter ^ <EvaluatorPresenter> = (
	^EvaluatorPresenter onSubject: subject
)
goToSelf = (
	enterSubject: (ObjectSubject onModel: subject objectMirror)
)
headerDefinition = (
	^captionBar:
		(column: {
			selfInfoLine.
			enclosingInfoLine.
			classInfoLine.
			}).
)
respondToIncomingReferences = (
	enterSubject:: subject reverseSubject.
)
respondToInspectInSqueak = (
	subject inspectInSqueak
)
respondToRetainingPath = (
	inspect: subject retainingPath.
)
selfInfoLine = (
	^row: {
		(label: selfCaption asText allBold) width: 0 elasticity: 1.
		(row: {
			(link: subject title action: [goToSelf]) compressibility: 1.
			filler compressibility: 0.
			mediumBlank.
			dropDownMenu: [actionsMenu]
		}) width: 0 elasticity: detailAreaRatio.
	}
)
switchDetailsTo: aPresenter = (
	objectDetailsHolder content: aPresenter
)
switcherLinksWith: details = (
^
	Array streamContents:
		[:elements |
		details
			do:
				[:each <ObjectDetailsView> |
				elements nextPut:
					(link: each title action: [switchDetailsTo: each presenter])]
			separatedBy:
				[elements nextPut: smallBlank]]
)
public title = (
	^'Inspector on ', subject title
)
) : (
)
class ObjectPresenterAsIntegerView onSubject: subj <ObjectSubject> = ProgrammingPresenter onSubject: subj (
) (
definition = (
	| radixList = list. |
	{2. 8. 10. 16} with: {'binary'. 'octal'. 'decimal'. 'hex'} do:
		[:radix :label | | radixString = printStringOf: subject objectMirror reflectee withRadix: radix. |
		radixList add: (row: {(label: label) width: 80. label: radixString})].
	^column: {
		radixList
	}
)
printStringOf: integer withRadix: radix = (
	^String streamContents: [:stream | integer printOn: stream base: radix showRadix: false]
)
) : (
)
class ObjectPresenterAsStringView onSubject: subj <ObjectSubject> = ProgrammingPresenter onSubject: subj (
(* Presents an object that can be coerced to a String by sending #asString, by displaying the string it coerces to as a text block. *)
) (
copyText = (
	copyToClipboard: subject objectMirror reflectee
)
definition = (
	| editor |
	editor:: TextEditorFragment new.
	editor text: textToDisplay.
	^column: {
		row: {
			filler.
			(link: '[copy]' action: [copyText]) tinyFont.
		}.
		editor.
	}
)
textToDisplay = (
	^subject objectMirror reflectee
)
) : (
)
class ObjectPresenterBasicView onSubject: subj = ProgrammingPresenter onSubject: subj (
(* Presents an object (the model of its subject) as a collection of its named and indexed slots. *)
) (
definition = (
	^list: slotPresenters
)
slotPresenters = (
	^Array streamContents:
		[:presenters |
		subject namedSlotNames do:
			[:each |
			presenters nextPut:
				(ObjectSlotPresenter onSubject:
					(ObjectNamedSlotSubject on: subject objectMirror slotName: each))].
		subject hasIndexedSlots ifTrue:
			[subject indexedSlotRange do:
				[:index |
				presenters nextPut:
					(ObjectSlotPresenter onSubject:
						(ObjectIndexedSlotSubject on: subject objectMirror slotIndex: index))]].

		subject transientSlotNames do:
			[:each |
			presenters nextPut:
				(ObjectSlotPresenter onSubject:
					(ObjectTransientSlotSubject on: subject objectMirror slotName: each))].


		].
)
) : (
)
class ObjectPresenterBlockView onSubject: subj <ObjectSubject> = ProgrammingPresenter onSubject: subj () (
definition = (
	^column: {
		smallBlank.
		minorHeadingBlock: (label: 'Source').
		indentedBlock: (textDisplay: 'TODO: method presenter with closure highlighted and links to defining class').
		minorHeadingBlock: (label: 'Free Variables').
		indentedBlock: (textDisplay: 'TODO: list of names and values').
	}
)
) : (
)
class ObjectPresenterDictionaryView onSubject: subj = ProgrammingPresenter onSubject: subj (
(* Presents an object that understands #keys and #at:, i.e. something dictionary-like, by going through the keys and displaying an entry for each of them, with the value obtained by sending #at:. *)
) (
definition = (
	^list: entryPresenters
)
entryPresenters = (
	| presenters |
	presenters:: List new.
	subject objectMirror reflectee keys do:
		[:each |
		presenters add: (newObjectValueAtKeySubjectForKey: each) presenter].
	^presenters
)
newObjectValueAtKeySubjectForKey: key = (
	^ObjectValueAtKeySubject on: subject objectMirror key: key
)
) : (
)
class ObjectPresenterFormView onSubject: s <ObjectSubect> = ProgrammingPresenter onSubject: s (
) (
definition = (
	^padded: (image: subject objectMirror reflectee) with: {10. 10. 10. 10}
)
) : (
)
class ObjectPresenterMethodView onSubject: subj <ObjectSubject> = ProgrammingPresenter onSubject: subj (
(* Presents a compiled method by showing its decompiled source and a disassembly of its bytecodes. *)
) (
bytecodeString = (
	^[method reflectee symbolic]
		on: Error
		do: [:ex | ex return: '<error retrieving the method''s bytecodes>']
)
decompiledString = (
	^[method reflectee decompileString]
		on: Error
		do: [:ex | ex return: '<error decompiling the method>']
)
definition = (
^
	column: {
		smallBlank.
		minorHeadingBlock: (label: 'Decompiled').
		indentedBlock: (textDisplay: decompiledString).
		minorHeadingBlock: (label: 'Header').
		indentedBlock: (textDisplay: headerDescription withBlanksTrimmed).
		minorHeadingBlock: (label: 'Literals').
		indentedBlock: (literalPresenters).
		minorHeadingBlock: (label: 'Bytecodes').
		indentedBlock: (textDisplay: bytecodeString).
		}
)
headerDescription = (
	^[method reflectee headerDescription]
		on: Error
		do: [:ex | ex return: '<error retrieving the method''s headerDescription>']
)
literalPresenters = (
	| presenters |
	presenters:: List new.
	1 to: (method reflectee numLiterals) do:
		[:index |
		presenters add:
			(ObjectLiteralSubject on: subject objectMirror key: index) presenter].
	^list: presenters
)
method = (
	^subject objectMirror
)
) : (
)
class ObjectPresenterSequenceView onSubject: subj = ProgrammingPresenter onSubject: subj (
(* Presents objects that understand #size and #at:, most likely SequenceableCollections by stringing ObjectValueAtKeySubjects for indicex from 1 to <size>. *)
) (
definition = (
	^list: elementPresenters
)
elementPresenters = (
	^subject objectMirror reflectee size <= 200
		ifTrue: [elementPresentersAll]
		ifFalse: [elementPresentersSome]
)
elementPresentersAll = (
	| presenters |
	presenters:: List new.
	1 to: subject objectMirror reflectee size do:
		[:index |
		presenters add: (newObjectValueAtKeySubjectForIndex: index) presenter].
	^presenters
)
elementPresentersSome = (
	| presenters collectionSize |
	presenters:: List new.
	collectionSize:: subject objectMirror reflectee size.
	1 to: 100 do:
		[:index |
		presenters add: (newObjectValueAtKeySubjectForIndex: index) presenter].
	presenters add:
		(column: {
			largeBlank.
			row: {
				blank: 40.
				label: 'Skipping ', (collectionSize - 120 - 1) printString, ' elements...'.
			}.
			largeBlank.
		}).
	collectionSize - 20 to: collectionSize do:
		[:index |
		presenters add: (newObjectValueAtKeySubjectForIndex: index) presenter].
	^presenters
)
newObjectValueAtKeySubjectForIndex: index <Number> ^<ObjectValueAtKeySubject> = (
	^ObjectValueAtKeySubject on: subject objectMirror key: index
)
) : (
)
class ObjectSlotPresenter onSubject: subj = ProgrammingPresenter onSubject: subj (
(* This presenter is used for most of object detail views, such as the list of object slots, collection elements, or dictionary entries. Thus the actual interpretation of what ''slot'' means is a responsibility of the subject. The subject is something like ObjectIndexedSlotSubject, ObjectNamedSlotSubject, or ObjectValueAtKeySubject. This presenter displays the subject as a row with the caption of the subject, followed by the value string provided the subject. *)
| editorFragment inspectorHolder |) (
public caption = (
	^row: {
		(link: subject caption action: [expand])
			width: 0 elasticity: 1;
			color: actionLinkColor.
		(link: [subject briefValuePrintString] (* updated on each #noticeImminentExposure *)
		 action: [respondToValueClick])
			width: 0 elasticity: detailAreaRatio.
	}
)
definition = (
	^collapsed: caption expanded: [expandedDefinition]
)
editor = (
	^editorFragment editor
)
public expand = (
	substance expand
)
expandedDefinition = (
	editorFragment:: OneLineDefinitionTemplate new
		initialText: 'new value for ', subject slotIdentifier;
		acceptResponse: [:t | setValue: t text asString];
		cancelResponse: [:t | t editor defaultCancelResponse];
		initiallyInEditState: false.
	^column: {
		editorFragment.
		inspectorHolder:: holder: [subjectOnValue presenter].
	}
)
public noticeImminentExposure = (
	(* Refresh to update the slot value (the link label).  *)
	refresh.
)
respondToValueClick = (
	enterSubject: subjectOnValue
)
setValue: expression <String> = (
	subject
		setValue: expression
		ifCompilerError: [:msg | ^editor showMessage: msg]
		ifError: [:msg | ^editor showMessage: msg].
	editor leaveEditState.
	refresh.
)
public setValue: expression <String> ifFail: failBlock = (
	subject setValue: expression ifCompilerError: failBlock ifError: failBlock value.
	refresh.
)
subjectOnValue = (
	| valueSubject |
	valueSubject:: ObjectSubject onModel: subject value.
	valueSubject presenter selfCaption: subject caption.
	^valueSubject
)
) : (
)
class ObjectSlotSubject onModel: mirror <ObjectMirror> = Subject onModel: mirror () (
public = another = (
	^self class = another class and:
		[self objectMirror = another objectMirror and:
			[self slotIdentifier = another slotIdentifier]]
)
public briefValuePrintString = (
	^value safePrintStringLimitedTo: 200
)
public caption ^<String> = (
	(* The short string a presenter could use to identify the slot. *)
	^slotIdentifier asString
)
public createPresenter = (
	^ObjectSlotPresenter onSubject: self
)
public hash = (
	^(self class hash bitXor: objectMirror hash) bitXor: slotIdentifier hash
)
public objectMirror = (
	^self model
)
setValue: t = (
	objectMirror setSlot: slotIdentifier to: t
)
public setValue: expression <String> ifCompilerError: compileFailBlock ifError: failBlock = (
	| newValue |
	newValue::
		objectMirror evaluate: expression
		      with: workspaceManager workspaceScope
		      ifCompilerError: compileFailBlock
			ifError: failBlock.
	value: newValue
)
public setValue: expression <String> ifFail: failBlock = (
	setValue: expression ifCompilerError: failBlock  ifError: failBlock
)
public slotIdentifier = (
	subclassResponsibility
)
) : (
)
public class ObjectSubject onModel: mirror <ObjectMirror> = Subject onModel: mirror (
(* Part of inspector functionality. The model is a mirror on the object being inspected. *)
) (
public = another <Object> ^<Boolean> = (
	^self class = another class and:
		[objectMirror = another objectMirror]
)
public classMirror ^<ClassMirror> = (
	^model getClass
)
public className ^<String> = (
	^classMirror simpleName
)
public createPresenter = (
	^ObjectPresenter onSubject: self
)
public enclosingObjectName ^<String> = (
	^classMirror enclosingObject safePrintStringLimitedTo: 200
)
public evaluate: expression <String>
ifCompilerError: onCompilerError <[:String]>
ifError: onError <[:NewspeakDebugging ThreadSubject :Exception]> ^<ObjectMirror> = (
	| scope thread exception process |
	
	scope:: workspaceManager workspaceScope.
	[thread:: objectMirror evaluate: expression with: scope]
		on: Error
		do: [:ex | ^onCompilerError value: ex description].

	thread isFulfilled ifTrue: [^thread result].
	
	exception:: thread result reflectee.
	process:: thread process.
	^onError value: (finalizer subjectFor: exception in: process) value: exception
)
public hasIndexedSlots ^<Boolean> = (
	^classMirror reflectee isVariable
)
public hash ^<Integer> = (
	^self class hash bitXor: objectMirror hash
)
public incomingPointers = (
	^objectMirror reflectee inboundPointersExcluding: {objectMirror}
)
public indexedSlotRange = (
	^1 to: objectMirror indexedSlotSize
)
public inspectInSqueak = (
	ToolSet inspect: objectMirror reflectee
)
public modelClass = (
	^classMirror reflectee
)
public namedSlotNames ^<Collection[String]> = (
	^objectMirror getClass slots collect: [:ea | ea name]
)
public objectMirror ^<ObjectMIrror> = (
	^model
)
public printOn: s <WriteStream> = (
	s
		nextPutAll: self class simpleName;
		nextPut: ":".
	objectMirror reflecteePrintOn: s
)
public reflecteePerform: selector <Symbol> = (
	^(objectMirror perform: selector with: {} ifFail: [halt]) reflectee.
)
public retainingPath = (
	#BOGUS. (* Implement in Newspeak. Use the specialObjectsArray as the root. *)
	^PointerFinder new goal: objectMirror reflectee; search; instVarNamed: #objectList
)
public reverseSubject = (
	^ReverseObjectSubject onModel: model
)
public title = (
	^objectMirror safePrintStringLimitedTo: 200
)
public transientSlotNames ^<Collection[String]> = (
	^objectMirror getClass transientSlots collect: [:ea | ea name]
)
) : (
)
class ObjectTransientSlotSubject on: mirror <ObjectMirror> slotName: slotName <String> = ObjectSlotSubject onModel: mirror (
(* Represents a named slot of the model, to be accessed using a vm mirror. *)
|
	public slotIdentifier = slotName.
|) (
public objectMirror = (
	^model
)
public value = (
	^objectMirror getTransientSlot: slotIdentifier.
)
public value: newValue <ObjectMirror> = (
	objectMirror setTransientSlot: slotIdentifier to: newValue reflectee.
	^newValue
)
) : (
)
class ObjectValueAtKeySubject on: theMirror key: theKey = Subject onModel: theMirror (|
	public key = theKey.
|) (
public = another <Object> ^<Boolean> = (
	^self class = another class and:
		[self model == another objectMirror and:
			[self key = another key]]
)
public briefValuePrintString = (
	^[value safePrintStringLimitedTo: 200]
		on: Error
		do: [:ex | ex return: '<error printing the value>']
)
public caption = (
	^[key printString]
		on: Error
		do: [:ex | ex return: '<error>']
)
public createPresenter = (
	^ObjectSlotPresenter onSubject: self
)
public hash ^<Integer> = (
	^model identityHash bitXor: key hash
)
public objectMirror = (
	^model
)
public slotIdentifier = (
	^'at: ', key printString
)
public value = (
	^model perform: #at: with: {key} ifFail: [halt]
)
) : (
)
class ObjectViewDescription title: theTitle <String> presenterCreator: theCreator <Block> = (
(* A collection of these is held onto by ObjectPresenter as a list of views available for the object being presented. If more that one view is available, the object presenter typically displays some selection widgets to allow switching between the views. An instance of this is responsible for lazily instantiating its presenter when asked for the presenter. *)
|
	public title = theTitle.
	presenterCreator = theCreator.
	private presenterX
|) (
public presenter = (
	^presenterX ifNil:
		[presenterX:: presenterCreator value.
		presenterX]
)
) : (
)
class ReverseObjectPresenter onSubject: s = ProgrammingPresenter onSubject: s (|
	public selfCaption ::= 'references to'.
|) (
captionBar: body = (
	^(column: {
		smallBlank.
		row: {
			mediumBlank.
			elastic: body.
			smallBlank
			}.
	})
		color: captionColor
)
coloredBarWidth: pixels = (
	^((row: {}) color: captionColor) width: pixels
)
definition = (
	^(column: {
		headerDefinition.
		row: {
			coloredBarWidth: 1.
			blank: 3.
			elastic:: detailsDefinition.
			blank: 2.
			coloredBarWidth: 1.
		}.
		coloredBarWidth: 1.
	}) color: Color white
)
definitionForEdgeFrom: source named: slotname = (
	|
	sourceSubject = ObjectSubject onModel: (ObjectMirror reflecting: source).
	sourceRSubject = ReverseObjectSubject onModel: (ObjectMirror reflecting: source).
	toggle
	|
	toggle::
		collapsed:
			[row: {
				(link: slotname action: [toggle expand])
					width: 0 elasticity: 1;
					color: actionLinkColor.
				(link: [sourceSubject title] action: [enterSubject: sourceSubject])
					width: 0 elasticity: detailAreaRatio.
			}]
		expanded:
			[(ReverseObjectPresenter onSubject: sourceRSubject) selfCaption: slotname].
	^toggle
)
detailsDefinition = (
	^list: (subject incomingPointers collect:
		[:ea | definitionForEdgeFrom: ea named: (subject nameForEdgeFrom: ea)])
)
goToSelf = (
	enterSubject: subject forwardSubject
)
headerDefinition = (
	^captionBar:
		(column: {
			selfInfoLine.
			smallBlank.
		}).
)
selfInfoLine = (
	^row: {
		(label: selfCaption asText allBold) width: 0 elasticity: 1.
		(row: {
			(link: subject title action: [goToSelf]) compressibility: 1.
		}) width: 0 elasticity: detailAreaRatio.
	}
)
public title = (
	^'References to ', subject title
)
) : (
)
class ReverseObjectSubject onModel: mirror <ObjectMirror> = ObjectSubject onModel: mirror () (
public createPresenter = (
	^ReverseObjectPresenter onSubject: self
)
public forwardSubject = (
	^ObjectSubject onModel: model
)
public nameForEdgeFrom: source = (
	(* BOGUS: Should not send any messages to source or sourceClass. *)
	|
	sourceClass = primitives classOf: source.
	destination = model reflectee.
	|
	sourceClass == destination ifTrue: [^'<class>'].
	1 to: sourceClass instSize do:
		[:i | (source instVarAt: i) == destination
			ifTrue: [^sourceClass allInstVarNames at: i]].
	source isCompiledMethod ifTrue:
		[1 to: source numLiterals do:
			[:i | (source literalAt: i) == destination ifTrue: [^'literalAt: ', i printString]].
		^'<unknown slot>'].
	1 to: source basicSize do:
		[:i | (source basicAt: i) == destination ifTrue: [^'at: ', i printString]].
	^'<unknown slot>'
)
) : (
)
) : (
)