'From Croquet1.0beta of 11 April 2006 [latest update: #1] on 6 August 2008 at 12:53:08 pm'!
"Change Set:		BrowsingPatches
Date:			6 May 2008
Author:			Eliot Miranda

Make most query methods on SystemNavigation answer sets of MethodReference.  Modify MessageSet to use the stringVersion of supplied MethodReferences rather than minting new ones.

Make browser's senders button et al provide all selector literals if thoroughSenders preference set."!


!CompiledMethod methodsFor: 'literals' stamp: 'eem 5/6/2008 11:28'!
allLiterals
	^self literals! !


!InstructionPrinter methodsFor: 'initialize-release' stamp: 'eem 8/4/2008 16:26'!
printInstructionsOn: aStream do: aBlock
	"Append to the stream, aStream, a description of each bytecode in the
	 instruction stream. Evaluate aBlock with the receiver, the scanner and
	 the stream after each instruction."

	| end |
	stream := aStream.
	scanner := InstructionStream on: method.
	end := method endPC.
	oldPC := scanner pc.
	innerIndents := Array new: end withAll: 0.
	[scanner pc <= end] whileTrue:
		[scanner interpretNextInstructionFor: self.
		 aBlock value: self value: scanner value: stream]! !


!SimpleHierarchicalListMorph methodsFor: 'accessing' stamp: 'dgd 9/26/2004 18:23'!
roots
	"Answer the receiver's roots"
	^ scroller submorphs
		select: [:each | each indentLevel isZero]! !

!SimpleHierarchicalListMorph methodsFor: 'events' stamp: 'dgd 9/26/2004 18:24'!
expandRoots
	"Expand all the receiver's roots"
	self roots
		do: [:each |
			(each canExpand and: [each isExpanded not])
				ifTrue: [each toggleExpandedState]].
	self adjustSubmorphPositions! !


!CompiledMethod methodsFor: 'printing' stamp: 'eem 5/29/2008 13:59'!
symbolicLinesDo: aBlock
	"Evaluate aBlock with each of the lines in the symbolic output."

	| aStream pc |
	aStream := ReadWriteStream on: (String new: 64).
	self isQuick ifTrue:
		[self longPrintOn: aStream.
		 aBlock value: 0 value: aStream contents.
		 ^self].

	self primitive ~= 0 ifTrue:
		[self printPrimitiveOn: aStream.
		 aBlock value: 1 value: aStream contents.
		 aStream resetContents].

	pc := self initialPC.
	(InstructionPrinter on: self)
		indent: 0;
		printPC: false; "explorer provides pc anyway"
		printInstructionsOn: aStream
		do:	[:printer :scanner :stream| | line index |
			line := stream contents allButLast.
			(line includes: Character cr) ifTrue:
				[line := (line copyUpTo: Character cr), '...'' (continues)'].
			(index := line indexOf: $>) > 0 ifTrue:
				[[(line at: index + 1) isSeparator] whileTrue: [index := index + 1].
				 line := ((line copyFrom: 1 to: index) copyReplaceAll: (String with: Character tab) with: (String new: 8 withAll: Character space)),
						(line copyFrom: index + 1 to: line size)].
			aBlock value: pc value: line.
			pc := scanner pc.
			stream resetContents]! !

!CompiledMethod methodsFor: '*Tools-Inspector' stamp: 'eem 5/15/2008 13:14'!
explorerContents
	"(CompiledMethod compiledMethodAt: #explorerContents) explore"
	
	^Array streamContents:
		[:s| | tokens |
		tokens := Scanner new scanTokens: (self headerDescription readStream skipTo: $"; upTo: $").
		s nextPut: (ObjectExplorerWrapper
						with: ((0 to: tokens size by: 2) collect:
								[:i| i = 0 ifTrue: [self header] ifFalse: [{tokens at: i - 1. tokens at: i}]])
						name: 'header'
						model: self).
		(1 to: self numLiterals) do:
			[:key|
			s nextPut: (ObjectExplorerWrapper
							with: (self literalAt: key)
							name: ('literal', key printString contractTo: 32)
							model: self)].
		self isQuick
			ifTrue: [s nextPut: (ObjectExplorerWrapper
									with: self symbolic
									name: #symbolic
									model: self)]
			ifFalse:
				[self symbolicLinesDo:
					[:pc :line|
					pc <= 1
						ifTrue:
							[s nextPut: (ObjectExplorerWrapper
											with: line
											name: 'pragma'
											model: self)]
						ifFalse:
							[s nextPut: (ObjectExplorerWrapper
											with: line
											name: pc printString
											model: self)]]].
				"should be self numLiterals + 1 * Smalltalk wordSize + 1"
		self endPC + 1
			to: self basicSize
			do: [:key|
				s nextPut: (ObjectExplorerWrapper
								with: (self basicAt: key)
								name: key printString
								model: self)]]! !


!ObjectExplorer methodsFor: 'user interface' stamp: 'eem 5/7/2008 11:17'!
openExplorerFor: anObject
"
ObjectExplorer new openExplorerFor: Smalltalk
"

	| win |
	win := (self explorerFor: anObject) openInWorld.
	Cursor wait showWhile:
		[win submorphs do:
			[:sm|
			(sm respondsTo: #expandRoots) ifTrue:
				[sm expandRoots]]].
	^self
! !