'From Squeak3.7 of ''4 September 2004'' [latest update: #5989] on 9 December 2008 at 5:09:49 pm'!

!AbstractFont methodsFor: 'measuring' stamp: 'jmv 12/8/2008 15:26'!
approxWidthOfText: aText
"Return the width of aText -- quickly, and a little bit dirty. Used by lists morphs containing Text objects to get a quick, fairly accurate measure of the width of a list item."

    | w |
    
    (aText isNil or: [aText size = 0 ])
        ifTrue:[^0].
       
    w _ self
        widthOfString: aText asString
        from: 1
        to: aText size.

     "If the text has no emphasis, just return the string size.  If it is empasized, 
    just approximate the width by adding about 20% to the width"   
    (((aText runLengthFor: 1) = aText size)
        and: [(aText emphasisAt: 1) = 0 ])
            ifTrue:[^w]
            ifFalse:[ ^w * 6 // 5 ]. ! !


!Behavior methodsFor: 'accessing method dictionary' stamp: 'jmv 12/8/2008 15:27'!
firstCommentAt:  selector
	"Answer a string representing the first comment in the method associated with selector.  Return an empty string if the relevant source file is not available, or if the method's source code does not contain a comment.  Not smart enough to bypass quotes in string constants, but does map doubled quote into a single quote."

	| sourceString commentStart  pos nextQuotePos |

	sourceString _ (self sourceCodeAt: selector) asString.
	sourceString size = 0 ifTrue: [^ ''].
	commentStart _ sourceString findString: '"' startingAt: 1.
	commentStart = 0 ifTrue: [^ ''].
	pos _ commentStart + 1.
	[(nextQuotePos _ sourceString findString: '"' startingAt: pos) = (sourceString findString: '""' startingAt: pos)]
		whileTrue:
			[pos _ nextQuotePos + 2].
	
	commentStart = nextQuotePos ifTrue: [^ ''].  "Must have been a quote in string literal"

	^ (sourceString copyFrom: commentStart + 1 to: nextQuotePos - 1) copyReplaceAll: '""' with: '"'


"Behavior firstCommentAt: #firstCommentAt:"! !

!Behavior methodsFor: 'accessing instances and variables' stamp: 'jmv 12/8/2008 15:27'!
inspectAllInstances 
	"Inpsect all instances of the receiver.  1/26/96 sw"

	| all allSize prefix |
	all _ self allInstances.
	(allSize _ all size) = 0 ifTrue: [^ self inform: 'There are no 
instances of ', self name].
	prefix _ allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name)! !

!Behavior methodsFor: 'accessing instances and variables' stamp: 'jmv 12/8/2008 15:27'!
inspectSubInstances 
	"Inspect all instances of the receiver and all its subclasses.  CAUTION - don't do this for something as generic as Object!!  1/26/96 sw"

	| all allSize prefix |
	all _ self allSubInstances.
	(allSize _ all size) = 0 ifTrue: [^ self inform: 'There are no 
instances of ', self name, '
or any of its subclasses'].
	prefix _ allSize = 1
		ifTrue: 	['The lone instance']
		ifFalse:	['The ', allSize printString, ' instances'].
	
	all asArray inspectWithLabel: (prefix, ' of ', self name, ' & its subclasses')! !


!BitBltSimulation methodsFor: 'inner loop' stamp: 'jmv 12/8/2008 16:03'!
copyLoop
	"This version of the inner loop assumes noSource = false."
	| prevWord thisWord skewWord halftoneWord mergeWord hInc y unskew skewMask notSkewMask mergeFnwith destWord skewLocal sourceIndexLocal destIndexLocal vDirLocal hDirLocal nWordsMinusOne |
	self inline: false.
	self var: #mergeFnwith declareC: 'int (*mergeFnwith)(int, int)'.
	mergeFnwith _ self
				cCoerce: (opTable at: combinationRule + 1)
				to: 'int (*)(int, int)'.
	mergeFnwith.
	"null ref for compiler"
	hInc _ hDir * 4.
	skewLocal _ skew.
	sourceIndexLocal _ sourceIndex.
	destIndexLocal _ destIndex.
	vDirLocal _ vDir.
	hDirLocal _ hDir.
	nWordsMinusOne _ nWords - 1.
	"Byte delta"
	"degenerate skew fixed for Sparc. 10/20/96 ikp"
	skewLocal = -32
		ifTrue: [skewLocal _ unskew _ skewMask _ 0]
		ifFalse: [skewLocal < 0
				ifTrue: [unskew _ skewLocal + 32.
					skewMask _ AllOnes << (0 - skewLocal)]
				ifFalse: [skewLocal = 0
						ifTrue: [unskew _ 0.
							skewMask _ AllOnes]
						ifFalse: [unskew _ skewLocal - 32.
							skewMask _ AllOnes >> skewLocal]]].
	notSkewMask _ skewMask bitInvert32.
	noHalftone
		ifTrue: [halftoneWord _ AllOnes.
			halftoneHeight _ 0]
		ifFalse: [halftoneWord _ self halftoneAt: 0].
	y _ dy.
	1
		to: bbH
		do: [:i | 
			"here is the vertical loop"
			halftoneHeight > 1
				ifTrue: ["Otherwise, its always the same"
					halftoneWord _ self halftoneAt: y.
					y _ y + vDirLocal].
			preload
				ifTrue: ["load the 64-bit shifter"
					prevWord _ self srcLongAt: sourceIndexLocal.
					sourceIndexLocal _ sourceIndexLocal + hInc]
				ifFalse: [prevWord _ 0].
			"Note: the horizontal loop has been expanded into three parts for 
			speed:"
			"This first section requires masking of the destination store..."
			destMask _ mask1.
			thisWord _ self srcLongAt: sourceIndexLocal.
			"pick up next word"
			sourceIndexLocal _ sourceIndexLocal + hInc.
			skewWord _ ((prevWord bitAnd: notSkewMask)
						bitShift: unskew)
						bitOr: ((thisWord bitAnd: skewMask)
								bitShift: skewLocal).
			"32-bit rotate"
			prevWord _ thisWord.
			destWord _ self dstLongAt: destIndexLocal.
			mergeWord _ self
						mergeFn: (skewWord bitAnd: halftoneWord)
						with: destWord.
			destWord _ (destMask bitAnd: mergeWord)
						bitOr: (destWord bitAnd: destMask bitInvert32).
			self dstLongAt: destIndexLocal put: destWord.
			destIndexLocal _ destIndexLocal + hInc.
			"This central horizontal loop requires no store masking"
			destMask _ AllOnes.
			combinationRule = 3
				ifTrue: [skewLocal = 0 & (halftoneWord = AllOnes)
						ifTrue: ["Very special inner loop for STORE mode with no 
							skew -- just move words"
							hDirLocal = -1
								ifTrue: ["Woeful patch: revert to older code for  
									hDir = -1"
									2
										to: nWordsMinusOne
										do: [:word | 
											thisWord _ self srcLongAt: sourceIndexLocal.
											sourceIndexLocal _ sourceIndexLocal + hInc.
											self dstLongAt: destIndexLocal put: thisWord.
											destIndexLocal _ destIndexLocal + hInc]]
								ifFalse: [2
										to: nWordsMinusOne
										do: [:word | 
											"Note loop starts with prevWord  
											loaded (due to preload)"
											self dstLongAt: destIndexLocal put: prevWord.
											destIndexLocal _ destIndexLocal + hInc.
											prevWord _ self srcLongAt: sourceIndexLocal.
											sourceIndexLocal _ sourceIndexLocal + hInc]]]
						ifFalse: ["Special inner loop for STORE mode -- no need to 
							call merge"
							2
								to: nWordsMinusOne
								do: [:word | 
									thisWord _ self srcLongAt: sourceIndexLocal.
									sourceIndexLocal _ sourceIndexLocal + hInc.
									skewWord _ ((prevWord bitAnd: notSkewMask)
												bitShift: unskew)
												bitOr: ((thisWord bitAnd: skewMask)
														bitShift: skewLocal).
									"32-bit rotate"
									prevWord _ thisWord.
									self
										dstLongAt: destIndexLocal
										put: (skewWord bitAnd: halftoneWord).
									destIndexLocal _ destIndexLocal + hInc]]]
				ifFalse: [2
						to: nWordsMinusOne
						do: [:word | 
							"Normal inner loop does merge:"
							thisWord _ self srcLongAt: sourceIndexLocal.
							"pick up next word"
							sourceIndexLocal _ sourceIndexLocal + hInc.
							skewWord _ ((prevWord bitAnd: notSkewMask)
										bitShift: unskew)
										bitOr: ((thisWord bitAnd: skewMask)
												bitShift: skewLocal).
							"32-bit rotate"
							prevWord _ thisWord.
							mergeWord _ self
										mergeFn: (skewWord bitAnd: halftoneWord)
										with: (self dstLongAt: destIndexLocal).
							self dstLongAt: destIndexLocal put: mergeWord.
							destIndexLocal _ destIndexLocal + hInc]].
			"This last section, if used, requires masking of the destination  
			store..."
			nWords > 1
				ifTrue: [destMask _ mask2.
					thisWord _ self srcLongAt: sourceIndexLocal.
					"pick up next word"
					sourceIndexLocal _ sourceIndexLocal + hInc.
					skewWord _ ((prevWord bitAnd: notSkewMask)
								bitShift: unskew)
								bitOr: ((thisWord bitAnd: skewMask)
										bitShift: skewLocal).
					"32-bit rotate"
					destWord _ self dstLongAt: destIndexLocal.
					mergeWord _ self
								mergeFn: (skewWord bitAnd: halftoneWord)
								with: destWord.
					destWord _ (destMask bitAnd: mergeWord)
								bitOr: (destWord bitAnd: destMask bitInvert32).
					self dstLongAt: destIndexLocal put: destWord.
					destIndexLocal _ destIndexLocal + hInc].
			sourceIndexLocal _ sourceIndexLocal + sourceDelta.
			destIndexLocal _ destIndexLocal + destDelta]! !

!BitBltSimulation methodsFor: 'surface support' stamp: 'jmv 12/8/2008 15:37'!
lockSurfaces
	"Get a pointer to the bits of any OS surfaces."
	"Notes: 
	* For equal source/dest handles only one locking operation is performed.
	This is to prevent locking of overlapping areas which does not work with
	certain APIs (as an example, DirectDraw prevents locking of overlapping areas). 
	A special case for non-overlapping but equal source/dest handle would 
	be possible but we would have to transfer this information over to 
	unlockSurfaces somehow (currently, only one unlock operation is 
	performed for equal source and dest handles). Also, this would require
	a change in the notion of ioLockSurface() which is right now interpreted
	as a hint and not as a requirement to lock only the specific portion of
	the surface.

	* The arguments in ioLockSurface() provide the implementation with
	an explicit hint what area is affected. It can be very useful to
	know the max. affected area beforehand if getting the bits requires expensive
	copy operations (e.g., like a roundtrip to the X server or a glReadPixel op).
	However, the returned pointer *MUST* point to the virtual origin of the surface
	and not to the beginning of the rectangle. The promise made by BitBlt
	is to never access data outside the given rectangle (aligned to 4byte boundaries!!)
	so it is okay to return a pointer to the virtual origin that is actually outside
	the valid memory area.

	* The area provided in ioLockSurface() is already clipped (e.g., it will always
	be inside the source and dest boundingBox) but it is not aligned to word boundaries
	yet. It is up to the support code to compute accurate alignment if necessary.

	* Warping always requires the entire source surface to be locked because
	there is no beforehand knowledge about what area will actually be traversed.

	"
	| sourceHandle destHandle l r t b fn |
	self inline: true. "If the CCodeGen learns how to inline #cCode: methods"
	self var: #fn declareC:'int (*fn)(int, int*, int, int, int, int)'.
	hasSurfaceLock _ false.
	destBits = 0 ifTrue:["Blitting *to* OS surface"
		lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
		fn _ self cCoerce: lockSurfaceFn to: 'int (*)(int, int*, int, int, int, int)'.
		destHandle _ interpreterProxy fetchInteger: FormBitsIndex ofObject: destForm.
		(sourceBits = 0 and:[noSource not]) ifTrue:[
			sourceHandle _ interpreterProxy fetchInteger: FormBitsIndex ofObject: sourceForm.
			"Handle the special case of equal source and dest handles"
			(sourceHandle = destHandle) ifTrue:[
				"If we have overlapping source/dest we lock the entire area
				so that there is only one area transmitted"
				isWarping ifFalse:[
					"When warping we always need the entire surface for the source"
					sourceBits _ self cCode:'fn(sourceHandle, &sourcePitch, 0,0, sourceWidth, sourceHeight)'.
				] ifTrue:[
					"Otherwise use overlapping area"
					l _ sx min: dx. r _ (sx max: dx) + bbW.
					t _ sy min: dy. b _ (sy max: sy) + bbH.
					sourceBits _ self cCode:'fn(sourceHandle, &sourcePitch, l, t, r-l, b-t)'.
				].
				destBits _ sourceBits.
				destPitch _ sourcePitch.
				hasSurfaceLock _ true.
				^destBits ~= 0
			].
			"Fall through - if not equal it'll be handled below"
		].
		destBits _ self cCode:'fn(destHandle, &destPitch, dx, dy, bbW, bbH)'.
		hasSurfaceLock _ true.
	].
	(sourceBits = 0 and:[noSource not]) ifTrue:["Blitting *from* OS surface"
		sourceHandle _ interpreterProxy fetchInteger: FormBitsIndex ofObject: sourceForm.
		lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
		fn _ self cCoerce: lockSurfaceFn to: 'int (*)(int, int*, int, int, int, int)'.
		"Warping requiring the entire surface"
		isWarping ifTrue:[
			sourceBits _ self cCode:'fn(sourceHandle, &sourcePitch, 0, 0, sourceWidth, sourceHeight)'.
		] ifFalse:[
			sourceBits _ self cCode:'fn(sourceHandle, &sourcePitch, sx, sy, bbW, bbH)'.
		].
		hasSurfaceLock _ true.
	].
	^destBits ~= 0 and:[sourceBits ~= 0 or:[noSource]].! !


!ChangeSet methodsFor: 'fileIn/Out' stamp: 'jmv 12/8/2008 15:32'!
lookForSlips
	"Scan the receiver for changes that the user may regard as slips to be remedied"

	| slips nameLine msg |
	nameLine _ '
"', self name, '"
'.
	(slips _ self checkForSlips) size = 0 ifTrue:
		[^ self inform: 'No slips detected in change set', nameLine].

	msg _ slips size = 1
		ifTrue:
			[ 'One method in change set', nameLine, 
'has a halt, reference to the Transcript,
and/or some other ''slip'' in it.
Would you like to browse it? ?']
		ifFalse:
			[ slips size printString,
' methods in change set', nameLine, 'have halts or references to the
Transcript or other ''slips'' in them.
Would you like to browse them?'].

	(PopUpMenu withCaption: msg chooseFrom: 'Ignore\Browse slips') = 2
		ifTrue: [Smalltalk browseMessageList: slips
							name: 'Possible slips in ', name]! !


!ChangeSetCategory methodsFor: 'queries' stamp: 'jmv 12/8/2008 15:32'!
changeSetList
	"Answer the list of change-set names in the category"

	| aChangeSet |
	self reconstituteList.
	keysInOrder size = 0 ifTrue:
		["don't tolerate emptiness, because ChangeSorters gag when they have no change-set selected"
		aChangeSet _ ChangeSorter assuredChangeSetNamed: 'New Changes'.
		self elementAt: aChangeSet name put: aChangeSet].
	^ keysInOrder reversed! !

!ChangeSetCategory methodsFor: 'services' stamp: 'jmv 12/8/2008 15:32'!
fileOutAllChangeSets
	"File out all the nonempty change sets in the current category, suppressing the checks for slips that might otherwise ensue.  Obtain user confirmation before undertaking this possibly prodigious task."

	| aList |
	aList _ self elementsInOrder select:
		[:aChangeSet  | aChangeSet isEmpty not].
	aList size = 0 ifTrue: [^ self inform: 'sorry, all the change sets in this category are empty'].
	(self confirm: 'This will result in filing out ', aList size printString, ' change set(s)
Are you certain you want to do this?') ifFalse: [^ self].

	Preferences setFlag: #checkForSlips toValue: false during: 
		[ChangeSorter fileOutChangeSetsNamed: (aList collect: [:m | m name]) asSortedArray]! !


!CharacterScanner methodsFor: 'scanning' stamp: 'jmv 12/8/2008 16:08'!
plainTab
	"This is the basic method of adjusting destX for a tab."
	destX _ (alignment = Justified and: [self leadingTab not])
		ifTrue:		"embedded tabs in justified text are weird"
			[destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
		ifFalse: 
			[textStyle nextTabXFrom: destX
				leftMargin: leftMargin
				rightMargin: rightMargin]! !


!CharacterBlockScanner methodsFor: 'stop conditions' stamp: 'jmv 12/8/2008 16:08'!
tab
	| currentX |
	currentX _ (alignment = Justified and: [self leadingTab not])
		ifTrue:		"imbedded tabs in justified text are weird"
			[destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
		ifFalse:
			[textStyle
				nextTabXFrom: destX
				leftMargin: leftMargin
				rightMargin: rightMargin].
	lastSpaceOrTabExtent _ lastCharacterExtent copy.
	self lastSpaceOrTabExtentSetX: (currentX - destX max: 0).
	currentX >= characterPoint x
		ifTrue: 
			[lastCharacterExtent _ lastSpaceOrTabExtent copy.
			^ self crossedX].
	destX _ currentX.
	lastIndex _ lastIndex + 1.
	^false! !


!ClassDescription methodsFor: 'fileIn/Out' stamp: 'jmv 12/8/2008 15:34'!
putClassCommentToCondensedChangesFile: aFileStream
	"Called when condensing changes.  If the receiver has a class comment, and if that class comment does not reside in the .sources file, then write it to the given filestream, with the resulting RemoteString being reachable from the source file #2.  Note that any existing backpointer into the .sources file is lost by this process -- a situation that maybe should be fixed someday."

	| header aStamp aCommentRemoteStr |
	self isMeta ifTrue: [^ self].  "bulletproofing only"
	((aCommentRemoteStr _ self organization commentRemoteStr) isNil or:
		[aCommentRemoteStr sourceFileNumber = 1]) ifTrue: [^ self].

	aFileStream cr; nextPut: $!!.
	header _ String streamContents: [:strm | strm nextPutAll: self name;
		nextPutAll: ' commentStamp: '.
		(aStamp _ self organization commentStamp ifNil: ['<historical>']) storeOn: strm.
		strm nextPutAll: ' prior: 0'].
	aFileStream nextChunkPut: header.
	aFileStream cr.
	self organization classComment: (RemoteString newString: self organization classComment onFileNumber: 2 toFile: aFileStream) stamp: aStamp! !

!ClassDescription methodsFor: '*system-support' stamp: 'jmv 12/8/2008 15:33'!
allUnreferencedClassVariables
	"Answer a list of the names of all the receiver's unreferenced class vars, including those defined in superclasses"

	|  aList |
	aList _ OrderedCollection new.
	self withAllSuperclasses reverseDo:
		[:aClass |
		aClass classVarNames do:
			[:var |
				(Smalltalk allCallsOn: (aClass classPool associationAt: var))
					size = 0 ifTrue:
						[aList add: var]]].
	^ aList! !


!Color methodsFor: 'conversions' stamp: 'jmv 12/8/2008 16:11'!
balancedPatternForDepth: depth
	"A generalization of bitPatternForDepth: as it exists.  Generates a 2x2 stipple of color.
	The topLeft and bottomRight pixel are closest approx to this color"
	| pv1 pv2 mask1 mask2 pv3 c |
	(depth = cachedDepth and:[cachedBitPattern size = 2]) ifTrue: [^ cachedBitPattern].
	(depth between: 4 and: 16) ifFalse: [^ self bitPatternForDepth: depth].
	cachedDepth _ depth.
	pv1 _ self pixelValueForDepth: depth.
"
	Subtract error due to pv1 to get pv2.
	pv2 _ (self - (err1 _ (Color colorFromPixelValue: pv1 depth: depth) - self))
						pixelValueForDepth: depth.
	Subtract error due to 2 pv1's and pv2 to get pv3.
	pv3 _ (self - err1 - err1 - ((Color colorFromPixelValue: pv2 depth: depth) - self))
						pixelValueForDepth: depth.
"
	"Above two statements computed faster by the following..."
	pv2 _ (c _ self - ((Color colorFromPixelValue: pv1 depth: depth) - self))
						pixelValueForDepth: depth.
	pv3 _ (c + (c - (Color colorFromPixelValue: pv2 depth: depth)))
						pixelValueForDepth: depth.

	"Return to a 2-word bitmap that encodes a 2x2 stipple of the given pixelValues."
	mask1 _ (#(- - -	
			16r01010101 - - -			"replicates every other 4 bits"
			16r00010001 - - - - - - -	"replicates every other 8 bits"
			16r00000001) at: depth).	"replicates every other 16 bits"
	mask2 _ (#(- - -	
			16r10101010 - - -			"replicates the other 4 bits"
			16r01000100 - - - - - - -	"replicates the other 8 bits"
			16r00010000) at: depth).	"replicates the other 16 bits"
	^ cachedBitPattern _ Bitmap with: (mask1*pv1) + (mask2*pv2) with: (mask1*pv3) + (mask2*pv1)! !

!Color methodsFor: 'conversions' stamp: 'jmv 12/8/2008 16:12'!
bitPatternForDepth: depth
	"Return a Bitmap, possibly containing a stipple pattern, that best represents this color at the given depth. BitBlt calls this method to convert colors into Bitmaps. The resulting Bitmap may be multiple words to represent a stipple pattern of several lines.  "
	"See also:	pixelValueAtDepth:	-- value for single pixel
				pixelWordAtDepth:	-- a 32-bit word filled with the pixel value"
	"Details: The pattern for the most recently requested depth is cached."
	"Note for depths > 2, there are stippled and non-stippled versions (generated with #balancedPatternForDepth: and #bitPatternForDepth:, respectively). The stippled versions don't work with the window bit caching of StandardSystemView, so we make sure that for these depths, only unstippled patterns are returned"

	(depth = cachedDepth and: [depth <= 2 or: [cachedBitPattern size = 1]]) ifTrue: [^ cachedBitPattern].
	cachedDepth _ depth.

	depth > 2 ifTrue: [^ cachedBitPattern _ Bitmap with: (self pixelWordForDepth: depth)].
	depth = 1 ifTrue: [^ cachedBitPattern _ self halfTonePattern1].
	depth = 2 ifTrue: [^ cachedBitPattern _ self halfTonePattern2].
! !


!Color class methodsFor: 'instance creation' stamp: 'jmv 12/8/2008 15:35'!
fromArray: colorDef
	colorDef size = 3
			ifTrue: [^self r: (colorDef at: 1) g: (colorDef at: 2) b: (colorDef at: 3)].
	colorDef size = 0
			ifTrue: [^Color transparent].
	colorDef size = 4
			ifTrue: [^(TranslucentColor r: (colorDef at: 1) g: (colorDef at: 2) b: (colorDef at: 3)) alpha: (colorDef at: 4)].
	self error: 'Undefined color definition'! !


!CustomMenu methodsFor: 'invocation' stamp: 'jmv 12/8/2008 15:35'!
invokeOn: targetObject orSendTo: anObject
	"Pop up this menu and return the result of sending to the target object the selector corresponding to the menu item selected by the user. Return  nil if no item is selected.  If the chosen selector has arguments, obtain appropriately.  If the recipient does not respond to the resulting message, send it to the alternate object provided"

	| aSelector anIndex recipient |
	^ (aSelector _ self startUp) ifNotNil:
		[anIndex _ self selection.
		recipient _ ((targets _ self targets) isEmptyOrNil or: [anIndex > targets size])
			ifTrue:
				[targetObject]
			ifFalse:
				[targets at: anIndex].
		aSelector numArgs = 0
			ifTrue:
				[recipient perform: aSelector orSendTo: anObject]
			ifFalse:
				[recipient perform: aSelector withArguments: (self arguments at: anIndex)]]! !


!DataStream methodsFor: 'write and read' stamp: 'jmv 12/8/2008 15:35'!
next
	"Answer the next object in the stream."
	| type selector anObject isARefType pos internalObject |

	type _ byteStream next.
	type ifNil: [pos _ byteStream position.	"absolute!!!!"
		byteStream close.	"clean up"
		byteStream position = 0 
			ifTrue: [self error: 'The file did not exist in this directory'] 
			ifFalse: [self error: 'Unexpected end of object file'].
		pos.	"so can see it in debugger"
		^ nil].
	type = 0 ifTrue: [pos _ byteStream position.	"absolute!!!!"
		byteStream close.	"clean up"
		self error: 'Expected start of object, but found 0'.
		^ nil].
	isARefType _ self noteCurrentReference: type.
	selector _ #(readNil readTrue readFalse readInteger	"<-4"
			readStringOld readSymbol readByteArray		"<-7"
			readArray readInstance readReference readBitmap	"<-11"
			readClass readUser readFloat readRectangle readShortInst 	"<-16"
			readString readWordArray readWordArrayForSegment 	"<-19"
			readWordLike readMethod "<-21") at: type.
	selector = 0 ifTrue: [pos _ byteStream position.	"absolute!!!!"
			byteStream close. 
			self error: 'file is more recent than this system'. ^ nil].
	anObject _ self perform: selector. "A method that recursively
		calls next (readArray, readInstance, objectAt:) must save &
		restore the current reference position."
	isARefType ifTrue: [self beginReference: anObject].

		"After reading the externalObject, internalize it.
		 #readReference is a special case. Either:
		   (1) We actually have to read the object, recursively calling
			   next, which internalizes the object.
		   (2) We just read a reference to an object already read and
			   thus already interalized.
		 Either way, we must not re-internalize the object here."
	selector == #readReference ifTrue: [^ anObject].
	internalObject _ anObject comeFullyUpOnReload: self.
	^ self maybeBeginReference: internalObject! !


!DisplayScreen methodsFor: 'private' stamp: 'jmv 12/8/2008 16:15'!
setExtent: aPoint depth: bitsPerPixel  "DisplayScreen startUp"
	"This method is critical.  If the setExtent fails, there will be no
	proper display on which to show the error condition..."
	"ar 5/1/1999: ... and that is exactly why we check for the available display depths first."

	"RAA 27 Nov 99 - if depth and extent are the same and acceptable, why go through this.
	also - record when we change so worlds can tell if it is time to repaint"

	(depth = bitsPerPixel and: [aPoint = self extent and: 
					[self supportsDisplayDepth: bitsPerPixel]]) ifFalse: [
		bits _ nil.  "Free up old bitmap in case space is low"
		DisplayChangeSignature _ (DisplayChangeSignature ifNil: [0]) + 1.
		(self supportsDisplayDepth: bitsPerPixel)
			ifTrue:[super setExtent: aPoint depth: bitsPerPixel]
			ifFalse:[(self supportsDisplayDepth: bitsPerPixel negated)
				ifTrue:[super setExtent: aPoint depth: bitsPerPixel negated]
				ifFalse:["Search for a suitable depth"
					super setExtent: aPoint depth: self findAnyDisplayDepth]].
	].
	clippingBox _ super boundingBox! !


!ExternalDropHandler methodsFor: 'accessing' stamp: 'jmv 12/8/2008 15:36'!
handle: dropStream in: pasteUp dropEvent: anEvent
	| numArgs |
	numArgs _ action numArgs.
	numArgs = 1
		ifTrue: [^action value: dropStream].
	numArgs = 2
		ifTrue: [^action value: dropStream value: pasteUp].
	numArgs = 3
		ifTrue: [^action value: dropStream value: pasteUp value: anEvent].
	self error: 'Wrong number of args for dop action.'! !


!InstructionStream methodsFor: 'testing' stamp: 'jmv 12/8/2008 16:19'!
willReallySend
	"Answer whether the next bytecode is a real message-send,
	not blockCopy:."

	| byte |
	byte _ self method at: pc.
	byte < 128 ifTrue: [^false].
	byte = 200 ifTrue: [^false].
	byte >= 176 ifTrue: [^true].	"special send or short send"
	^byte between: 131 and: 134	"long sends"! !


!Decompiler methodsFor: 'public access' stamp: 'jmv 12/8/2008 15:53'!
decompileBlock: aBlock 
	"Original version timestamp: sn 1/26/98 18:27
	(Don't know who's sn?) "
	"Decompile aBlock, returning the result as a BlockNode.  
	Show temp names from source if available."
	"Decompiler new decompileBlock: [3 + 4]"
	| startpc end homeClass blockNode tempNames home source |
	(home _ aBlock home) ifNil: [^ nil].
	method _ home method.
	(homeClass _ home who first) == #unknown ifTrue: [^ nil].
	constructor _ DecompilerConstructor new.
	method fileIndex ~= 0
		ifTrue: ["got any source code?"
			source _ [method getSourceFromFile]
						on: Error
						do: [:ex | ^ nil].
			tempNames _ ([homeClass compilerClass new
						parse: source
						in: homeClass
						notifying: nil]
						on: (Smalltalk classNamed: 'SyntaxErrorNotification')
						do: [:ex | ^ nil]) tempNames.
			self withTempNames: tempNames].
	self initSymbols: homeClass.
	startpc _ aBlock startpc.
	end _ (method at: startpc - 2)
				\\ 16 - 4 * 256
				+ (method at: startpc - 1) + startpc - 1.
	stack _ OrderedCollection new: method frameSize.
	statements _ OrderedCollection new: 20.
	super method: method pc: startpc - 5.
	blockNode _ self blockTo: end.
	stack isEmpty ifFalse: [self error: 'stack not empty'].
	^ blockNode statements first! !


!Matrix methodsFor: 'misc' stamp: 'jmv 12/8/2008 16:21'!
storeHouseholderTransformOn: aMatrix column: j forQR: forQR
	"Modifies entries on aMatrix to make it the Householder transforms
	that puts zeroes at column i of the receiver. If forQR is false, the
	product of aMatrix * self is Hessemberg superior, otherways its a
	triangular matrix. "

	| x xNorm2Squared v vNorm2Squared element i |
	i _ j - (forQR ifTrue: [ 1 ] ifFalse: [ 0 ]).
	x _ self appropriateResultClass newVectorSize: self height-i.
	xNorm2Squared _ 0.
	1 to: x height do: [ :ii |
		element _ self i: ii+i j: j.
		xNorm2Squared _ xNorm2Squared + element squared.
		x i: ii j: 1 put: element ].
	v _ x.
	"If column already has zeros, do nothing"
	xNorm2Squared = 0.0 ifTrue: [ ^false ].
	"If column already has zeros, do nothing. If forQR = false, then the first element in x
	could not be zero, and anyway there's nothing to do"
	(forQR not and: [ xNorm2Squared = (x i: 1 j: 1) squared ]) ifTrue: [ ^false ].

	v i: 1 j: 1 put: (v i: 1 j: 1) + xNorm2Squared sqrt.
	vNorm2Squared _ v norm2Squared.

	1 to: i do: [ :ii |
		aMatrix i: ii j: ii put: 1.
		ii+1 to: aMatrix width do: [ :jj |
			aMatrix i: ii j: jj put: 0.
			aMatrix i: jj j: ii put: 0 ] ].
	1 to: x height do: [ :ii |
		1 to: x height do: [ :jj |
			aMatrix i: ii+i j: jj+i put: 
				(ii=jj ifTrue:[1] ifFalse:[0]) - 
				(2.0 / vNorm2Squared * (v i: ii j: 1) * (v i: jj j: 1) ) ] ].
	^true! !


!Model methodsFor: 'keyboard' stamp: 'jmv 12/8/2008 15:40'!
arrowKey: aChar from: view
	"Process the up and down arrows in a list pane.  Note that the listView tells us what index variable, how to get the list, and how to move the index.  Derived from a Martin Pammer submission, 02/98"

     | keyEvent oldSelection nextSelection max min howMany |

     keyEvent _ aChar asciiValue.

     oldSelection := view getCurrentSelectionIndex.
     nextSelection := oldSelection.
     max := view maximumSelection.
     min := view minimumSelection.
     howMany := view numSelectionsInView.	"get this exactly??"

     keyEvent = 31 ifTrue:
		["down-arrow; move down one, wrapping to top if needed"
		nextSelection := oldSelection + 1.
		nextSelection > max ifTrue: [nextSelection _ 1]].

     keyEvent = 30 ifTrue:
		["up arrow; move up one, wrapping to bottom if needed"
		nextSelection := oldSelection - 1.
		nextSelection < 1 ifTrue: [nextSelection _ max]].

     keyEvent = 1  ifTrue: [nextSelection := 1].  "home"
     keyEvent = 4  ifTrue: [nextSelection := max].   "end"
     keyEvent = 11 ifTrue: [nextSelection := min max: (oldSelection - howMany)].  "page up"
     keyEvent = 12  ifTrue: [nextSelection := (oldSelection + howMany) min: max].  "page down"
     nextSelection = oldSelection  ifFalse:
		[self okToChange
			ifTrue:
				[view changeModelSelection: nextSelection.
				"view controller moveMarker"]]
			! !


!OldMorph methodsFor: 'menus' stamp: 'jmv 12/8/2008 15:41'!
addStandardHaloMenuItemsTo: aMenu hand: aHandMorph
	"Add standard halo items to the menu"

	| unlockables |

	self isWorldMorph ifTrue:
		[^ self addWorldHaloMenuItemsTo: aMenu hand: aHandMorph].

	aMenu add: 'send to back' translated action: #goBehind.
	aMenu add: 'bring to front' translated action: #comeToFront.
	self addEmbeddingMenuItemsTo: aMenu hand: aHandMorph.
	aMenu addLine.

	self addFillStyleMenuItems: aMenu hand: aHandMorph.
	self addBorderStyleMenuItems: aMenu hand: aHandMorph.
	self addLayoutMenuItems: aMenu hand: aHandMorph.
	self addHaloActionsTo: aMenu.
	owner isTextMorph ifTrue:[self addTextAnchorMenuItems: aMenu hand: aHandMorph].
	aMenu addLine.
	self addToggleItemsToHaloMenu: aMenu.
	aMenu addLine.
	self addCopyItemsTo: aMenu.
	self addExportMenuItems: aMenu hand: aHandMorph.
	Preferences noviceMode ifFalse:
		[self addDebuggingItemsTo: aMenu hand: aHandMorph].

	aMenu addLine.
	aMenu defaultTarget: self.

	aMenu addLine.

	unlockables _ self submorphs select:
		[:m | m isLocked].
	unlockables size = 1 ifTrue:
		[aMenu
			add: ('unlock "{1}"' translated format: unlockables first externalName)
			action: #unlockContents].
	unlockables size > 1 ifTrue:
		[aMenu add: 'unlock all contents' translated action: #unlockContents.
		aMenu add: 'unlock...' translated action: #unlockOneSubpart].

	aMenu defaultTarget: aHandMorph.
! !


!OldBorderedMorph methodsFor: 'geometry' stamp: 'jmv 12/8/2008 15:41'!
acquireBorderWidth: aBorderWidth
	"Gracefully acquire the new border width, keeping the interior area intact and not seeming to shift"

	| delta |
	(delta _ aBorderWidth- self borderWidth) = 0 ifTrue: [^ self].
	self bounds: ((self bounds origin - (delta @ delta)) corner: (self bounds corner + (delta @ delta))).
	self borderWidth: aBorderWidth.
	self layoutChanged! !


!OldGraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'jmv 12/8/2008 16:25'!
findAgain
	"Look for the next occurrence of the search string"

	| toFind searchIndex |
	lastSearchString ifNil: [lastSearchString _ 'controls'].
	searchIndex _ currentIndex + 1.
	toFind _ '*', lastSearchString, '*'.
	[toFind match: (entryNames at: searchIndex) asString]
		whileFalse:
			[searchIndex _ (searchIndex \\ entryNames size) + 1.
			searchIndex = currentIndex ifTrue:
				[^ (toFind match: (entryNames at: searchIndex) asString)
					ifFalse:
						[self inform: 'not found']
					ifTrue:
						[self flash]]].

	currentIndex _ searchIndex.
	self updateThumbnail! !

!OldGraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'jmv 12/8/2008 16:25'!
findEntry
	"Prompt the user for a search string and find the next match for it"

	| toFind searchIndex |
	lastSearchString ifNil: [lastSearchString _ 'controls'].
	toFind _ FillInTheBlank request: 'Type name or fragment: ' initialAnswer: lastSearchString.
	toFind isEmptyOrNil ifTrue: [^ self].
	lastSearchString _ toFind asLowercase.
	searchIndex _ currentIndex + 1.
	toFind _ '*', lastSearchString, '*'.
	[toFind match: (entryNames at: searchIndex) asString]
		whileFalse:
			[searchIndex _ (searchIndex \\ entryNames size) + 1.
			searchIndex = currentIndex ifTrue: [^ self inform: 'not found']].

	currentIndex _ searchIndex.
	self updateThumbnail! !


!OldImageMorph methodsFor: 'accessing' stamp: 'jmv 12/8/2008 15:41'!
color: aColor
        super color: aColor.
        (image depth = 1 and: [aColor isColor]) ifTrue: [
                image colors: {Color transparent. aColor}.
                self changed]! !


!OldMenuMorph methodsFor: 'control' stamp: 'jmv 12/8/2008 15:41'!
wantsToBeDroppedInto: aMorph
	"Return true if it's okay to drop the receiver into aMorph.  A single-item MenuMorph is in effect a button rather than a menu, and as such should not be reluctant to be dropped into another object."

	^ (aMorph isWorldMorph or: [submorphs size = 1]) or:
		[Preferences systemWindowEmbedOK]! !


!OldPasteUpMorph methodsFor: 'menu & halo' stamp: 'jmv 12/8/2008 15:41'!
addWorldHaloMenuItemsTo: aMenu hand: aHandMorph
	"Add standard halo items to the menu, given that the receiver is a World"

	| unlockables |
	self addFillStyleMenuItems: aMenu hand: aHandMorph.
	self addLayoutMenuItems: aMenu hand: aHandMorph.

	aMenu addLine.
	self addWorldToggleItemsToHaloMenu: aMenu.
	aMenu addLine.
	self addCopyItemsTo: aMenu.
	self addExportMenuItems: aMenu hand: aHandMorph.

	Preferences noviceMode ifFalse:
		[self addDebuggingItemsTo: aMenu hand: aHandMorph].

	aMenu addLine.
	aMenu defaultTarget: self.

	aMenu addLine.

	unlockables _ self submorphs select:
		[:m | m isLocked].
	unlockables size = 1 ifTrue:
		[aMenu add: ('unlock "{1}"' translated format:{unlockables first externalName})action: #unlockContents].
	unlockables size > 1 ifTrue:
		[aMenu add: 'unlock all contents' translated action: #unlockContents.
		aMenu add: 'unlock...' translated action: #unlockOneSubpart].

	aMenu defaultTarget: aHandMorph.
! !


!OldPluggableButtonMorph methodsFor: 'accessing' stamp: 'jmv 12/8/2008 15:41'!
performAction
	"Inform the model that this button has been pressed. Sent by the controller when this button is pressed. If the button's actionSelector takes any arguments, they are obtained dynamically by sending the argumentSelector to the argumentsProvider"

	askBeforeChanging ifTrue: [model okToChange ifFalse: [^ self]].
	actionSelector ifNotNil:
		[actionSelector numArgs = 0
			ifTrue:
				[model perform: actionSelector]
			ifFalse:
				[argumentsProvider ifNotNil:
					[arguments _ argumentsProvider perform: argumentsSelector].
					model perform: actionSelector withArguments: arguments]]! !


!OldScrollPane methodsFor: 'geometry' stamp: 'jmv 12/8/2008 15:56'!
extent: newExtent
	
	| oldW oldH wasHShowing wasVShowing noVPlease noHPlease minH minW |
	
	oldW _ self width.
	oldH _ self height.
	wasHShowing _ self hIsScrollbarShowing.
	wasVShowing _ self vIsScrollbarShowing.

	"Figure out the minimum width and height for this pane so that scrollbars will appear"
	noVPlease _ self valueOfProperty: #noVScrollBarPlease ifAbsent: [false]. 
	noHPlease _ self valueOfProperty: #noHScrollBarPlease ifAbsent: [false]. 
	minH _ self scrollBarThickness + 16.
	minW _ self scrollBarThickness + 20.
	noVPlease ifTrue:[ 
		noHPlease
			ifTrue:[minH _ 1. minW _ 1 ]
			ifFalse:[minH _ self scrollBarThickness ].
	] ifFalse:[
		noHPlease
			ifTrue:[minH _ self scrollBarThickness + 5].
	].
	super extent: (newExtent max: (minW@minH)).

	"Now reset widget sizes"
	self resizeScrollBars; resizeScroller; hideOrShowScrollBars.
	
	"Now resetScrollDeltas where appropriate, first the vScrollBar..."
	((self height ~= oldH) or: [ wasHShowing ~~ self hIsScrollbarShowing]) ifTrue:
		[(retractableScrollBar or: [ self vIsScrollbarShowing ]) ifTrue:
			[ self vSetScrollDelta ]].
			
	"...then the hScrollBar"
	((self width ~= oldW) or: [wasVShowing ~~ self vIsScrollbarShowing]) ifTrue:
		[(retractableScrollBar or: [ self hIsScrollbarShowing ]) ifTrue:
			[ self hSetScrollDelta ]].

! !

!OldScrollPane methodsFor: 'scrolling' stamp: 'jmv 12/8/2008 15:41'!
hideOrShowScrollBars

	| wasHShowing wasVShowing |

	wasVShowing _ self vIsScrollbarShowing.
	wasHShowing _ self hIsScrollbarShowing.

	self 
		vHideOrShowScrollBar; 
		hHideOrShowScrollBar; 
		resizeScrollBars.

	(wasVShowing and: [self vIsScrollbarShowing not]) ifTrue:
		["Make sure the delta is 0"
		(scroller offset y = 0) 
				ifFalse:[ scroller offset: (scroller offset x@0) ]].
			
	(wasHShowing and: [self hIsScrollbarShowing not]) ifTrue:
		[(scroller offset x <= 0)
				ifFalse:[ scroller offset: (self hMargin negated@scroller offset y)]].
! !


!OldPluggableListMorph methodsFor: 'events' stamp: 'jmv 12/8/2008 15:41'!
mouseUp: event
	"The mouse came up within the list; take appropriate action"

	| row |
	row _ self rowAtLocation: event position.
	"aMorph ifNotNil: [aMorph highlightForMouseDown: false]."
	model okToChange ifFalse:
		[^ self].
	(autoDeselect == false and: [row = 0]) ifTrue: [^ self].  "work-around the no-mans-land bug"
	"No change if model is locked"
	((autoDeselect == nil or: [autoDeselect]) and: [row == self selectionIndex])
		ifTrue: [self changeModelSelection: 0]
		ifFalse: [self changeModelSelection: row].
	Cursor normal show.
! !


!OldSimpleHierarchicalListMorph methodsFor: 'keyboard navigation' stamp: 'jmv 12/8/2008 15:42'!
arrowKey: aChar
	"Handle a keyboard navigation character. Answer true if handled, false if not."
	| keyEvent |
	keyEvent := aChar asciiValue.
     keyEvent = 31 ifTrue:["down"
		self setSelectionIndex: self getSelectionIndex+1.
		^true].
     keyEvent = 30 ifTrue:["up"
		self setSelectionIndex: (self getSelectionIndex-1 max: 1).
		^true].
     keyEvent = 1  ifTrue: ["home"
		self setSelectionIndex: 1.
		^true].
     keyEvent = 4  ifTrue: ["end"
		self setSelectionIndex: scroller submorphs size.
		^true].
      keyEvent = 11 ifTrue: ["page up"
		self setSelectionIndex: (self getSelectionIndex - self numSelectionsInView max: 1).
		^true].
     keyEvent = 12  ifTrue: ["page down"
		self setSelectionIndex: self getSelectionIndex + self numSelectionsInView.
		^true].
	keyEvent = 29 ifTrue:["right"
		selectedMorph ifNotNil:[
			(selectedMorph canExpand and:[selectedMorph isExpanded not])
				ifTrue:[self toggleExpandedState: selectedMorph]
				ifFalse:[self setSelectionIndex: self getSelectionIndex+1].
		].
		^true].
	keyEvent = 28 ifTrue:["left"
		selectedMorph ifNotNil:[
			(selectedMorph isExpanded)
				ifTrue:[self toggleExpandedState: selectedMorph]
				ifFalse:[self setSelectionIndex: (self getSelectionIndex-1 max: 1)].
		].
		^true].
	^false! !


!OldSystemWindow methodsFor: 'panes' stamp: 'jmv 12/8/2008 15:42'!
holdsTranscript
	"ugh"

	| plug |
	^paneMorphs size = 1 and: 
			[((plug := paneMorphs first) isKindOf: OldPluggableTextMorph) 
				and: [plug model isKindOf: TranscriptStream]]! !

!OldSystemWindow methodsFor: 'panes' stamp: 'jmv 12/8/2008 15:57'!
titleAndPaneText
	"If the receiver represents a workspace, return an Association between the title and that text, else return nil"

	(paneMorphs size ~= 1 
		or: [(paneMorphs first isKindOf: OldPluggableTextMorph) not]) 
			ifTrue: [^nil].
	^labelString -> paneMorphs first text! !


!OldUpdatingMenuItemMorph methodsFor: 'world' stamp: 'jmv 12/8/2008 15:42'!
updateContents
	"Update the receiver's contents"

	| newString enablement nArgs |
	((wordingProvider isNil) or: [wordingSelector isNil]) ifTrue: [^ self].
	nArgs _ wordingSelector numArgs.
	newString _ nArgs = 0
		ifTrue:
			[wordingProvider perform: wordingSelector]
		ifFalse:
			[(nArgs = 1 and: [wordingArgument notNil])
				ifTrue:
					[wordingProvider perform: wordingSelector with: wordingArgument]
				ifFalse:
					[nArgs = arguments size ifTrue:
						[wordingProvider perform: wordingSelector withArguments: arguments]]].
	newString = (self contentString ifNil: [ contents ])
		ifFalse: [self contents: newString.
			MenuIcons decorateMenu: owner ].
	enablementSelector ifNotNil:
		[(enablement _ self enablement) == isEnabled 
			ifFalse:	[self isEnabled: enablement]]! !


!Quadrangle methodsFor: 'displaying-generic' stamp: 'jmv 12/8/2008 15:57'!
displayOn: aDisplayMedium
	"Display the border and insideRegion of the receiver."

	borderWidth ~= 0
		ifTrue:	[aDisplayMedium
				border: self region
				widthRectangle: borderWidth
				rule: Form over
				fillColor: borderColor].
	insideColor ~~ nil
		ifTrue:	[aDisplayMedium fill: self inside fillColor: insideColor]! !

!Quadrangle methodsFor: 'displaying-generic' stamp: 'jmv 12/8/2008 15:58'!
displayOn: aDisplayMedium transformation: aWindowingTransformation clippingBox: aRectangle
	"Display the border and region of the receiver so that it is scaled and 
	translated with respect to aWindowingTransformation. The displayed 
	information should be clipped so that only information with the area 
	determined by aRectangle is displayed."

	| screenRectangle |
	screenRectangle _ 
		(aWindowingTransformation applyTo: self) intersect: aRectangle.
	borderWidth ~= 0 & (insideColor ~~ nil)
		ifTrue: 
			[aDisplayMedium fill: screenRectangle fillColor: Color black "borderColor".
			aDisplayMedium
				fill: (screenRectangle insetBy: borderWidth)
				fillColor: insideColor]! !


!ReferenceStream methodsFor: 'writing' stamp: 'jmv 12/8/2008 15:42'!
isAReferenceType: typeID
	"Return true iff typeID is one of the classes that can be written as a reference to an instance elsewhere in the stream."

	"too bad we can't put Booleans in an Array literal"
	^ (RefTypes at: typeID) = 1
		"NOTE: If you get a bounds error here, the file probably has bad bits in it.  The most common cause is a file unpacking program that puts linefeeds after carriage returns."! !


!SelectionMenu class methodsFor: 'instance creation' stamp: 'jmv 12/8/2008 15:42'!
fromArray: anArray
	"Construct a menu from anArray.  The elements of anArray must be either:
	*  A pair of the form: <label> <selector>
or	*  The 'dash' (or 'minus sign') symbol

	Refer to the example at the bottom of the method"

	| labelList lines selections anIndex |
	labelList _ OrderedCollection new.
	lines _ OrderedCollection new.
	selections _ OrderedCollection new.
	anIndex _ 0.
	anArray do:
		[:anElement |
			anElement size = 1
				ifTrue:
					[(anElement == #-) ifFalse: [self error: 'badly-formed menu constructor'].
					lines add: anIndex]
				ifFalse:
					[anElement size = 2 ifFalse: [self error: 'badly-formed menu constructor'].
					anIndex _ anIndex + 1.
					labelList add: anElement first.
					selections add: anElement second]].
	^ self labelList: labelList lines: lines selections: selections

"(SelectionMenu fromArray:
	#(	('first label'		moja)
		('second label'	mbili)
		-
		('third label' 	tatu)
		-
		('fourth label'	nne)
		('fifth label'	tano))) startUp"! !


!SequenceableCollection methodsFor: 'accessing' stamp: 'jmv 12/8/2008 15:42'!
after: target ifNone: exceptionBlock
	"Answer the element after target.  Answer the result of evaluating
	the exceptionBlock if there are no elements after it."

	| index |
	index _ self indexOf: target.
	^ index = 0
		ifTrue: [self errorNotFound: target]
		ifFalse: [index = self size 
			ifTrue: [exceptionBlock value]
			ifFalse: [self at: index + 1]]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'jmv 12/8/2008 15:43'!
before: target ifNone: exceptionBlock
	"Answer the receiver's element immediately before target. Answer
	the result of evaluating the exceptionBlock if there are no elements before it."

	| index |
	index _ self indexOf: target.
	^ index = 0
		ifTrue: [self errorNotFound: target]
		ifFalse: [index = 1 
			ifTrue: [exceptionBlock value]
			ifFalse: [self at: index - 1]]! !


!CompiledMethod methodsFor: 'printing' stamp: 'jmv 12/8/2008 15:35'!
timeStamp
	"Answer the authoring time-stamp for the given method, retrieved from the sources or changes file. Answer the empty string if no time stamp is available."

	"(CompiledMethod compiledMethodAt: #timeStamp) timeStamp"

	| position file preamble stamp tokens tokenCount |
	self fileIndex = 0 ifTrue: [^ String new].  "no source pointer for this method"
	position _ self filePosition.
	file _ SourceFiles at: self fileIndex.
	file ifNil: [^ String new].  "sources file not available"
	"file does not exist happens in secure mode"
	file _ [file readOnlyCopy] on: FileDoesNotExistException do:[:ex| nil].
	file ifNil: [^ String new].
	file position: (0 max: position - 150).  "Skip back to before the preamble"
		[file position < (position - 1)]  "then pick it up from the front"
			whileTrue: [preamble _ file nextChunk].
		stamp _ String new.
		tokens _ (preamble findString: 'methodsFor:' startingAt: 1) > 0
			ifTrue: [Scanner new scanTokens: preamble]
			ifFalse: [Array new  "ie cant be back ref"].
		(((tokenCount _ tokens size) between: 7 and: 8) and: [(tokens at: tokenCount - 5) = #methodsFor:])
			ifTrue:
				[(tokens at: tokenCount - 3) = #stamp:
					ifTrue: ["New format gives change stamp and unified prior pointer"
							stamp _ tokens at: tokenCount - 2]].
		((tokenCount between: 5 and: 6) and: [(tokens at: tokenCount - 3) = #methodsFor:])
			ifTrue:
				[(tokens at: tokenCount  - 1) = #stamp:
					ifTrue: ["New format gives change stamp and unified prior pointer"
						stamp _ tokens at: tokenCount]].
	file close.
	^ stamp
! !

!CompiledMethod methodsFor: 'code analysis' stamp: 'jmv 12/8/2008 15:51'!
scanForEqSmallConstant

    "Answer whether the receiver contains the pattern <expression> == <constant>,

    where constant is -1, 0, 1, or 2..."



    | scanner |

    scanner _ InstructionStream on: self.

    ^ scanner scanFor: [:instr | (instr between: 116 and: 119) and: [scanner followingByte = 198]]



"

Smalltalk browseAllSelect: [:m | m scanForEqSmallConstant]

"! !


!SmallInteger methodsFor: 'arithmetic' stamp: 'jmv 12/8/2008 15:43'!
quo: aNumber 
	"Primitive. Divide the receiver by the argument and answer with the 
	result. Round the result down towards zero to make it a whole integer. 
	Fail if the argument is 0 or is not a SmallInteger. Optional. See Object 
	documentation whatIsAPrimitive."
	<primitive: 13>
	aNumber = 0 ifTrue: [^ (ZeroDivide dividend: self) signal].
	(aNumber isMemberOf: SmallInteger)
		ifFalse: [^ super quo: aNumber].
	(aNumber = -1 and: [self = self class minVal])
		ifTrue: ["result is aLargeInteger" ^ self negated].
	self primitiveFailed! !


!SmartSyntaxPluginTMethod methodsFor: 'specifying primitives' stamp: 'jmv 12/8/2008 16:38'!
primitive: aString parameters: anArray receiver: aClassSymbol

	fullSelector _ selector.
	selector _ aString asSymbol.
	anArray size = args size ifFalse: 
		[^self error: selector, ': incorrect number of parameter specifications'].
	parmSpecs _ anArray collect:
		[:each | Smalltalk at: each ifAbsent:
			[^self error: selector, ': parameter spec must be a Behavior']].
	parmSpecs do: [:each | each isBehavior ifFalse:
		[^self error: selector, ': parameter spec must be a Behavior']].
	rcvrSpec _ Smalltalk at: aClassSymbol asSymbol ifAbsent:
		[^self error: selector, ': receiver spec must be a Behavior'].
	rcvrSpec isBehavior ifFalse:
		[^self error: selector, ': receiver spec must be a Behavior'].
	^true! !


!Socket methodsFor: 'connection open/close' stamp: 'jmv 12/8/2008 16:39'!
connectNonBlockingTo: hostAddress port: port
	"Initiate a connection to the given port at the given host address. This operation will return immediately; follow it with waitForConnectionUntil: to wait until the connection is established."

	| status |
	self initializeNetwork.
	status _ self primSocketConnectionStatus: socketHandle.
	(status = Unconnected)
		ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before opening a new connection'].

	self primSocket: socketHandle connectTo: hostAddress port: port.
! !

!Socket methodsFor: 'connection open/close' stamp: 'jmv 12/8/2008 16:39'!
listenOn: port
	"Listen for a connection on the given port. This operation will return immediately; follow it with waitForConnectionUntil: to wait until a connection is established."

	| status |
	status _ self primSocketConnectionStatus: socketHandle.
	(status = Unconnected)
		ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before listening for a new connection'].

	self primSocket: socketHandle listenOn: port.
! !

!Socket methodsFor: 'connection open/close' stamp: 'jmv 12/8/2008 16:39'!
listenOn: portNumber backlogSize: backlog
	"Listen for a connection on the given port.
	If this method succeeds, #accept may be used to establish a new connection"
	| status |
	status _ self primSocketConnectionStatus: socketHandle.
	(status = Unconnected)
		ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before listening for a new connection'].
	self primSocket: socketHandle listenOn: portNumber backlogSize: backlog.
! !

!Socket methodsFor: 'connection open/close' stamp: 'jmv 12/8/2008 16:39'!
listenOn: portNumber backlogSize: backlog interface: ifAddr
	"Listen for a connection on the given port.
	If this method succeeds, #accept may be used to establish a new connection"
	| status |
	status _ self primSocketConnectionStatus: socketHandle.
	(status = Unconnected)
		ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before listening for a new connection'].
	self primSocket: socketHandle listenOn: portNumber backlogSize: backlog interface: ifAddr.
! !

!Socket methodsFor: 'receiving' stamp: 'jmv 12/8/2008 15:43'!
receiveDataInto: aStringOrByteArray startingAt: aNumber
	"Receive data into the given buffer and return the number of bytes received. 
	Note the given buffer may be only partially filled by the received data.
	Waits for data once.  The answer may be zero (indicating that no data was 
	available before the socket closed)."

	| bytesRead closed |
	bytesRead := 0.
	closed := false.
	[closed not and: [bytesRead = 0]]
		whileTrue: [
			self waitForDataIfClosed: [closed := true].
			bytesRead := self primSocket: socketHandle
				receiveDataInto: aStringOrByteArray
				startingAt: aNumber
				count: aStringOrByteArray size-aNumber+1].
	^bytesRead
! !


!String methodsFor: 'accessing' stamp: 'jmv 12/8/2008 15:44'!
lineNumber: anIndex
	"Answer a string containing the characters in the given line number.  5/10/96 sw"

	| crString pos finalPos |
	crString _ String with: Character cr.
	pos _ 0.
	1 to: anIndex - 1 do:
		[:i | pos _ self findString: crString startingAt: pos + 1.
			pos = 0 ifTrue: [^ nil]].
	finalPos _ self findString: crString startingAt: pos + 1.
	finalPos = 0 ifTrue: [finalPos _ self size + 1].
	^ self copyFrom: pos + 1 to: finalPos - 1

"
'Fred
the
Bear' lineNumber: 3
"! !

!String methodsFor: 'converting' stamp: 'jmv 12/8/2008 15:43'!
asIdentifier: shouldBeCapitalized
	"Return a legal identifier, with first character in upper case if shouldBeCapitalized is true, else lower case.  This will always return a legal identifier, even for an empty string"

	| aString firstChar firstLetterPosition |
	aString _ self select: [:el | el isAlphaNumeric].
	firstLetterPosition _ aString findFirst: [:ch | ch isLetter].
	aString _ firstLetterPosition = 0
		ifFalse:
			[aString copyFrom: firstLetterPosition to: aString size]
		ifTrue:
			['a', aString].
	firstChar _ shouldBeCapitalized ifTrue: [aString first asUppercase] ifFalse: [aString first asLowercase].

	^ firstChar asString, (aString copyFrom: 2 to: aString size)
"
'234Fred987' asIdentifier: false
'235Fred987' asIdentifier: true
'' asIdentifier: true
'()87234' asIdentifier: false
'())z>=PPve889  U >' asIdentifier: false

"! !

!String methodsFor: 'converting' stamp: 'jmv 12/8/2008 15:43'!
asInteger 
	"Answer the Integer created by interpreting the receiver as the string representation of an integer.  Answer nil if no digits, else find the first digit and then all consecutive digits after that"

	| startPosition tail endPosition |
	startPosition _ self findFirst: [:ch | ch isDigit].
	startPosition = 0 ifTrue: [^ nil].
	tail _ self copyFrom: startPosition to: self size.
	endPosition _ tail findFirst: [:ch | ch isDigit not].
	endPosition = 0 ifTrue: [endPosition _ tail size + 1].
	^ Number readFromString: (tail copyFrom: 1 to: endPosition - 1)

"
'1796exportFixes-tkMX' asInteger
'1848recentLogFile-sw'  asInteger
'donald' asInteger
'abc234def567' asInteger
"! !

!String methodsFor: 'converting' stamp: 'jmv 12/8/2008 15:43'!
asLegalSelector
	| toUse |
	toUse _ ''.
	self do:
		[:char | char isAlphaNumeric ifTrue: [toUse _ toUse copyWith: char]].
	(self size = 0 or: [self first isLetter not])
		ifTrue:		[toUse _ 'v', toUse].

	^ toUse withFirstCharacterDownshifted

"'234znak 43 ) 2' asLegalSelector"! !

!String methodsFor: 'converting' stamp: 'jmv 12/8/2008 15:44'!
asSignedInteger
	"Answer the Integer created by interpreting the receiver as the string representation of an integer, possibly with a leading minus sign.  Answer nil if no digits, else find the first digit and then all consecutive digits after that"

	| startPosition tail endPosition |
	startPosition _ self findFirst: [:ch | ch isDigit or: [ch == $-]].
	startPosition = 0 ifTrue: [^ nil].
	tail _ self copyFrom: startPosition to: self size.
	endPosition _ tail findFirst: [:ch | ch isDigit not and: [ch ~~ $-]].
	endPosition = 0 ifTrue: [endPosition _ tail size + 1].
	^ Number readFromString: (tail copyFrom: 1 to: endPosition - 1)

"
'znak -58 to wit' asSignedInteger
"! !

!String methodsFor: 'converting' stamp: 'jmv 12/8/2008 15:44'!
initialIntegerOrNil
	"Answer the integer represented by the leading digits of the receiver, or nil if the receiver does not begin with a digit"
	| firstNonDigit |
	(self size = 0 or: [self first isDigit not]) ifTrue: [^ nil].
	firstNonDigit _ (self findFirst: [:m | m isDigit not]).
	firstNonDigit = 0 ifTrue: [firstNonDigit _ self size + 1].
	^ (self copyFrom: 1  to: (firstNonDigit - 1)) asNumber
"
'234Whoopie' initialIntegerOrNil
'wimpy' initialIntegerOrNil
'234' initialIntegerOrNil
'2N' initialIntegerOrNil
'2' initialIntegerOrNil
'  89Ten ' initialIntegerOrNil
'78 92' initialIntegerOrNil
"
! !

!String methodsFor: 'converting' stamp: 'jmv 12/8/2008 15:44'!
sansPeriodSuffix
	"Return a copy of the receiver up to, but not including, the first period.  If the receiver's *first* character is a period, then just return the entire receiver. "

	| likely |
	likely _ self copyUpToLast: $..
	^ likely size = 0
		ifTrue:	[self]
		ifFalse:	[likely]! !

!String methodsFor: 'converting' stamp: 'jmv 12/8/2008 15:44'!
splitInteger
	"Answer an array that is a splitting of self into a string and an integer.
	'43Sam' ==> #(43 'Sam').  'Try90' ==> #('Try' 90)
	BUT NOTE: 'Sam' ==> #('Sam' 0), and '90' ==> #('' 90)  ie, (<string> <integer>)."

	| pos |
	(pos _ self findFirst: [:d | d isDigit not]) = 0 ifTrue: [^ Array with: '' with: self asNumber].
	self first isDigit ifTrue: [
		^ Array with: (self copyFrom: 1 to: pos - 1) asNumber 
				with: (self copyFrom: pos to: self size)].
	(pos _ self findFirst: [:d | d isDigit]) = 0 ifTrue: [^ Array with: self with: 0].
	^ Array with: (self copyFrom: 1 to: pos - 1)
			with: (self copyFrom: pos to: self size) asNumber! !

!String methodsFor: 'converting' stamp: 'jmv 12/8/2008 16:40'!
withNoLineLongerThan: aNumber
	"Answer a string with the same content as receiver, but rewrapped so that no line has more characters than the given number"
	| listOfLines currentLast currentStart resultString putativeLast putativeLine crPosition |
	aNumber isNumber not | (aNumber < 1) ifTrue: [self error: 'too narrow'].
	listOfLines _ OrderedCollection new.
	currentLast _ 0.
	[currentLast < self size] whileTrue:
		[currentStart _ currentLast + 1.
		putativeLast _ (currentStart + aNumber - 1) min: self size.
		putativeLine _ self copyFrom: currentStart to: putativeLast.
		(crPosition _ putativeLine indexOf: Character cr) > 0 ifTrue:
			[putativeLast _ currentStart + crPosition - 1.
			putativeLine _ self copyFrom: currentStart to: putativeLast].
		currentLast _ putativeLast = self size
			ifTrue:
				[putativeLast]
			ifFalse:
				[currentStart + putativeLine lastSpacePosition - 1].
		currentLast <= currentStart ifTrue:
			["line has NO spaces; baleout!!"
			currentLast _ putativeLast].
		listOfLines add: (self copyFrom: currentStart to: currentLast) withBlanksTrimmed].

	listOfLines size > 0 ifFalse: [^ ''].
	resultString _ listOfLines first.
	2 to: listOfLines size do:
		[:i | resultString _ resultString, String cr, (listOfLines at: i)].
	^ resultString

"#(5 7 20) collect:
	[:i | 'Fred the bear went down to the brook to read his book in silence' withNoLineLongerThan: i]"! !

!String methodsFor: 'internet' stamp: 'jmv 12/8/2008 16:40'!
utf8ToIso
	"Only UTF-8 characters that maps to 8-bit ISO-8559-1 values are converted. Others raises an error"
	| s i c v c2 v2 |
	s _ WriteStream on: (String new: self size).
	
	i _ 1.
	[i <= self size] whileTrue: [
		c _ self at: i. i_i+1.
		v _ c asciiValue.
		(v > 128)
			ifFalse: [ s nextPut: c ]
			ifTrue: [((v bitAnd: 252) = 192)
				ifFalse: [self error: 'illegal UTF-8 ISO character']
				ifTrue: [
					(i > self size) ifTrue: [ self error: 'illegal end-of-string, expected 2nd byte of UTF-8'].
					c2 _ self at: i. i_i+1.
					v2 _ c2 asciiValue.
					((v2 bitAnd: 192) = 128) ifFalse: [self error: 'illegal 2nd UTF-8 char']. 
					s nextPut: ((v2 bitAnd: 63) bitOr: ((v << 6) bitAnd: 192)) asCharacter]]].
	^s contents. 
! !


!StringHolder methodsFor: 'message list menu' stamp: 'jmv 12/8/2008 15:44'!
messageListSelectorTitle
	| aSize |

	^(self selectedMessageName)
		ifNil:[
			aSize _ self messageList size.
			(aSize = 0 ifTrue: ['no'] ifFalse: [aSize printString]), ' message', (aSize = 1 ifTrue: [''] ifFalse: ['s'])]
		ifNotNil:
			[nil]! !

!StringHolder methodsFor: 'message list menu' stamp: 'jmv 12/8/2008 15:44'!
selectMessageAndEvaluate: aBlock
	"Allow the user to choose one selector, chosen from the currently selected message's selector, as well as those of all messages sent by it, and evaluate aBlock on behalf of chosen selector.  If there is only one possible choice, simply make it; if there are multiple choices, put up a menu, and evaluate aBlock on behalf of the the chosen selector, doing nothing if the user declines to choose any"

	| selector method messages |
	(selector _ self selectedMessageName) ifNil: [^ self].
	method _ (self selectedClassOrMetaClass ifNil: [^ self])
		compiledMethodAt: selector
		ifAbsent: [].
	(method isNil or: [(messages _ method messages) size = 0])
		 ifTrue: [^ aBlock value: selector].
	(messages size = 1 and: [messages includes: selector])
		ifTrue:
			[^ aBlock value: selector].  "If only one item, there is no choice"

	Smalltalk
		showMenuOf: messages
		withFirstItem: selector
		ifChosenDo: [:sel | aBlock value: sel]! !


!CodeHolder methodsFor: 'annotation' stamp: 'jmv 12/8/2008 15:34'!
addPriorVersionsCountForSelector: aSelector ofClass: aClass to: aStream
	"add an annotation detailing the prior versions count"
	| versionsCount |

	versionsCount _ VersionsBrowser versionCountForSelector: aSelector class: aClass.
	aStream nextPutAll: 
				((versionsCount > 1
					ifTrue:
						[versionsCount = 2 ifTrue:
							['1 prior version']
							ifFalse:
								[versionsCount printString, ' prior versions']]
					ifFalse:
						['no prior versions']), self annotationSeparator)! !

!CodeHolder methodsFor: 'annotation' stamp: 'jmv 12/8/2008 15:34'!
annotationForSelector: aSelector ofClass: aClass 
	"Provide a line of content for an annotation pane, representing  
	information about the given selector and class"
	| stamp sendersCount implementorsCount aCategory separator aString aList aComment aStream requestList |
	aSelector == #Comment
		ifTrue: [^ self annotationForClassCommentFor: aClass].
	aSelector == #Definition
		ifTrue: [^ self annotationForClassDefinitionFor: aClass].
	aSelector == #Hierarchy
		ifTrue: [^ self annotationForHierarchyFor: aClass].
	aStream _ ReadWriteStream on: ''.
	requestList _ self annotationRequests.
	separator _ requestList size > 1
				ifTrue: [self annotationSeparator]
				ifFalse: [''].
	requestList
		do: [:aRequest | 
			aRequest == #firstComment
				ifTrue: [aComment _ aClass firstCommentAt: aSelector.
					aComment isEmptyOrNil
						ifFalse: [aStream nextPutAll: aComment , separator]].
			aRequest == #masterComment
				ifTrue: [aComment _ aClass supermostPrecodeCommentFor: aSelector.
					aComment isEmptyOrNil
						ifFalse: [aStream nextPutAll: aComment , separator]].
			aRequest == #documentation
				ifTrue: [aComment _ aClass precodeCommentOrInheritedCommentFor: aSelector.
					aComment isEmptyOrNil
						ifFalse: [aStream nextPutAll: aComment , separator]].
			aRequest == #timeStamp
				ifTrue: [stamp _ self timeStamp.
					aStream
						nextPutAll: (stamp size > 0
								ifTrue: [stamp , separator]
								ifFalse: ['no timeStamp' , separator])].
			aRequest == #messageCategory
				ifTrue: [aCategory _ aClass organization categoryOfElement: aSelector.
					aCategory
						ifNotNil: ["woud be nil for a method no longer present,  
							e.g. in a recent-submissions browser"
							aStream nextPutAll: aCategory , separator]].
			aRequest == #sendersCount
				ifTrue: [sendersCount _ (Smalltalk allCallsOn: aSelector) size.
					sendersCount _ sendersCount = 1
								ifTrue: ['1 sender']
								ifFalse: [sendersCount printString , ' senders'].
					aStream nextPutAll: sendersCount , separator].
			aRequest == #implementorsCount
				ifTrue: [implementorsCount _ Smalltalk numberOfImplementorsOf: aSelector.
					implementorsCount _ implementorsCount = 1
								ifTrue: ['1 implementor']
								ifFalse: [implementorsCount printString , ' implementors'].
					aStream nextPutAll: implementorsCount , separator].
			aRequest == #priorVersionsCount
				ifTrue: [self
						addPriorVersionsCountForSelector: aSelector
						ofClass: aClass
						to: aStream].
			aRequest == #priorTimeStamp
				ifTrue: [stamp _ VersionsBrowser
								timeStampFor: aSelector
								class: aClass
								reverseOrdinal: 2.
					stamp
						ifNotNil: [aStream nextPutAll: 'prior time stamp: ' , stamp , separator]].
			aRequest == #recentChangeSet
				ifTrue: [aString _ ChangeSorter mostRecentChangeSetWithChangeForClass: aClass selector: aSelector.
					aString size > 0
						ifTrue: [aStream nextPutAll: aString , separator]].
			aRequest == #allChangeSets
				ifTrue: [aList _ ChangeSorter allChangeSetsWithClass: aClass selector: aSelector.
					aList size > 0
						ifTrue: [aList size = 1
								ifTrue: [aStream nextPutAll: 'only in change set ']
								ifFalse: [aStream nextPutAll: 'in change sets: '].
							aList
								do: [:aChangeSet | aStream nextPutAll: aChangeSet name , ' ']]
						ifFalse: [aStream nextPutAll: 'in no change set'].
					aStream nextPutAll: separator]].
	^ aStream contents! !

!CodeHolder methodsFor: 'commands' stamp: 'jmv 12/8/2008 15:34'!
showUnreferencedClassVars
	"Search for all class variables known to the selected class, and put up a 
	list of those that have no references anywhere in the system. The 
	search includes superclasses, so that you don't need to navigate your 
	way to the class that defines each class variable in order to determine 
	whether it is unreferenced"
	| cls aList aReport |
	(cls _ self selectedClass)
		ifNil: [^ self].
	aList _ cls allUnreferencedClassVariables.
	aList size = 0
		ifTrue: [^ self inform: 'There are no unreferenced
class variables in
' , cls name].
	aReport _ String
				streamContents: [:aStream | 
					aStream nextPutAll: 'Unreferenced class variable(s) in ' , cls name;
						 cr.
					aList
						do: [:el | aStream tab; nextPutAll: el; cr]].
	Transcript cr; show: aReport.
	(SelectionMenu labels: aList selections: aList)
		startUpWithCaption: 'Unreferenced
class variables in 
' , cls name! !

!CodeHolder methodsFor: 'commands' stamp: 'jmv 12/8/2008 15:34'!
showUnreferencedInstVars
	"Search for all instance variables known to the selected class, and put up a list of those that have no references anywhere in the system.  The search includes superclasses, so that you don't need to navigate your way to the class that defines each inst variable in order to determine whether it is unreferenced"

	| cls aList aReport |
	(cls _ self selectedClassOrMetaClass) ifNil: [^ self].
	aList _ cls allUnreferencedInstanceVariables.
	aList size = 0 ifTrue: [^ self inform: 'There are no unreferenced
instance variables in
', cls name].
	aReport _ String streamContents:
		[:aStream |
			aStream nextPutAll: 'Unreferenced instance variable(s) in ', cls name; cr.
			aList do: [:el | aStream tab; nextPutAll: el; cr]].
	Transcript cr; show: aReport.
	(SelectionMenu labels: aList selections: aList) startUpWithCaption: 'Unreferenced
instance variables in 
', cls name! !


!Browser methodsFor: 'class list' stamp: 'jmv 12/8/2008 15:30'!
classListIndex: anInteger 
	"Set anInteger to be the index of the current class selection."

	| className |

	classListIndex _ anInteger.
	self setClassOrganizer.
	messageCategoryListIndex _ 0.
	messageListIndex _ 0.
	self classCommentIndicated
		ifTrue: []
		ifFalse: [self editSelection: (anInteger = 0
					ifTrue: [metaClassIndicated | (systemCategoryListIndex = 0)
						ifTrue: [#none]
						ifFalse: [#newClass]]
					ifFalse: [#editClass])].
	contents _ nil.
	self selectedClass isNil
		ifFalse: [className _ self selectedClass name.
					(RecentClasses includes: className)
				ifTrue: [RecentClasses remove: className].
			RecentClasses addFirst: className.
			RecentClasses size > 16
				ifTrue: [RecentClasses removeLast]].
	self changed: #classSelectionChanged.
	self changed: #classCommentText.
	self changed: #classListIndex.	"update my selection"
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #relabel.
	self contentsChanged! !

!Browser methodsFor: 'class list' stamp: 'jmv 12/8/2008 15:31'!
recent
	"Let the user select from a list of recently visited classes.  11/96 stp.
	 12/96 di:  use class name, not classes themselves.
	 : dont fall into debugger in empty case"

	| className class recentList |
	recentList _ RecentClasses select: [:n | Smalltalk includesKey: n].
	recentList size = 0 ifTrue: [^ Beeper beep].
	className := (SelectionMenu selections: recentList) startUp.
	className == nil ifTrue: [^ self].
	class := Smalltalk at: className.
	self selectCategoryForClass: class.
	self classListIndex: (self classList indexOf: class name)! !

!Browser methodsFor: 'message functions' stamp: 'jmv 12/8/2008 15:31'!
removeMessage
	"If a message is selected, create a Confirmer so the user can verify that  
	the currently selected message should be removed from the system. If 
	so,  
	remove it. If the Preference 'confirmMethodRemoves' is set to false, the 
	confirmer is bypassed."
	| messageName confirmation |
	messageListIndex = 0
		ifTrue: [^ self].
	self okToChange
		ifFalse: [^ self].
	messageName _ self selectedMessageName.
	confirmation _ Smalltalk confirmRemovalOf: messageName on: self selectedClassOrMetaClass.
	confirmation = 3
		ifTrue: [^ self].
	self selectedClassOrMetaClass removeSelector: self selectedMessageName.
	self messageListIndex: 0.
	self changed: #messageList.
	self setClassOrganizer.
	"In case organization not cached"
	confirmation = 2
		ifTrue: [Smalltalk browseAllCallsOn: messageName]! !


!ChangeList methodsFor: 'menu actions' stamp: 'jmv 12/8/2008 15:31'!
browseAllVersionsOfSelections
	"Opens a Versions browser on all the currently selected methods, showing each alongside all of their historical versions."
	|  oldSelection aList |
	oldSelection _ self listIndex.
	aList _ OrderedCollection new.
	Cursor read showWhile: [
		1 to: changeList size do: [:i |
			(listSelections at: i) ifTrue: [
				listIndex _ i.
				self browseVersions.
				aList add: i.
				]]].
	listIndex _ oldSelection.

	aList size = 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts'].
! !

!ChangeList methodsFor: 'menu actions' stamp: 'jmv 12/8/2008 15:31'!
browseCurrentVersionsOfSelections
	"Opens a message-list browser on the current in-memory versions of all methods that are currently seleted"
	|  aClass aChange aList |

	aList _ OrderedCollection new.
	Cursor read showWhile: [
		1 to: changeList size do: [:i |
			(listSelections at: i) ifTrue: [
				aChange _ changeList at: i.
				(aChange type = #method
					and: [(aClass _ aChange methodClass) notNil
					and: [aClass includesSelector: aChange methodSelector]])
						ifTrue: [
							aList add: (
								MethodReference new
									setStandardClass: aClass  
									methodSymbol: aChange methodSelector
							)
						]]]].

	aList size = 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts'].
	MessageSet 
		openMessageList: aList 
		name: 'Current versions of selected methods in ', file localName! !

!ChangeList methodsFor: 'menu actions' stamp: 'jmv 12/8/2008 15:32'!
removeNonSelections
	"Remove the unselected items from the receiver."

	| newChangeList newList |

	newChangeList _ OrderedCollection new.
	newList _ OrderedCollection new.

	1 to: changeList size do:
		[:i | (listSelections at: i) ifTrue:
			[newChangeList add: (changeList at: i).
			newList add: (list at: i)]].
	newChangeList size = 0 ifTrue:
		[^ self inform: 'That would remove everything.
Why would you want to do that?'].

	newChangeList size < changeList size
		ifTrue:
			[changeList _ newChangeList.
			list _ newList.
			listIndex _ 0.
			listSelections _ Array new: list size withAll: false].
	self changed: #list

	! !

!ChangeList methodsFor: 'viewing access' stamp: 'jmv 12/8/2008 16:05'!
diffedVersionContents
	"Answer diffed version contents, maybe pretty maybe not"

	| change class earlier later |
	(listIndex = 0
			or: [changeList size < listIndex])
		ifTrue: [^ ''].
	change _ changeList at: listIndex.
	later _ change text.
	class _ change methodClass.
	(listIndex = changeList size or: [class == nil])
		ifTrue: [^ later].

	earlier _ (changeList at: listIndex + 1) text.

	^ TextDiffBuilder buildDisplayPatchFrom: earlier to: later inClass: class prettyDiffs: self showingPrettyDiffs! !


!ChangeList class methodsFor: 'public access' stamp: 'jmv 12/8/2008 15:31'!
browseRecentLogOn: origChangesFile startingFrom: initialPos 
	"Prompt with a menu of how far back to go when browsing a changes file."

	| end banners positions pos chunk i changesFile |
	changesFile _ origChangesFile readOnlyCopy.
	banners _ OrderedCollection new.
	positions _ OrderedCollection new.
	end _ changesFile size.
	pos _ initialPos.
	[pos = 0
		or: [banners size > 20]]
		whileFalse: [changesFile position: pos.
			chunk _ changesFile nextChunk.
			i _ chunk indexOfSubCollection: 'priorSource: ' startingAt: 1.
			i > 0
				ifTrue: [positions addLast: pos.
					banners
						addLast: (chunk copyFrom: 5 to: i - 2).
					pos _ Number
								readFrom: (chunk copyFrom: i + 13 to: chunk size)]
				ifFalse: [pos _ 0]].
	changesFile close.
	banners size = 0 ifTrue: [^ self inform: 
'this image has never been saved
since changes were compressed'].
	pos _ (SelectionMenu labelList: banners selections: positions)
				startUpWithCaption: 'Browse as far back as...'.
	pos == nil
		ifTrue: [^ self].
	self browseRecent: end - pos on: origChangesFile! !


!ChangeSorter methodsFor: 'changeSet menu' stamp: 'jmv 12/8/2008 15:33'!
rename
	"Store a new name string into the selected ChangeSet.  reject duplicate name; allow user to back out"

	| newName |
	newName _ FillInTheBlank request: 'New name for this change set'
						initialAnswer: myChangeSet name.
	(newName = myChangeSet name or: [newName size = 0]) ifTrue:
			[^ Beeper beep].

	(self class changeSetNamed: newName) ifNotNil:
			[^ Utilities inform: 'Sorry that name is already used'].

	myChangeSet name: newName.
	self update.
	self changed: #mainButtonName.
	self changed: #relabel.! !

!ChangeSorter methodsFor: 'message list' stamp: 'jmv 12/8/2008 15:33'!
removeMessage
	"Remove the selected msg from the system. Real work done by the 
	parent, a ChangeSorter"
	| confirmation sel |
	self okToChange
		ifFalse: [^ self].
	currentSelector
		ifNotNil: [confirmation _ Smalltalk confirmRemovalOf: (sel _ self selectedMessageName) on: self selectedClassOrMetaClass.
			confirmation = 3
				ifTrue: [^ self].
			self selectedClassOrMetaClass removeSelector: sel.
			self update.
			confirmation = 2
				ifTrue: [Smalltalk browseAllCallsOn: sel]]! !

!ChangeSorter methodsFor: 'code pane' stamp: 'jmv 12/8/2008 15:32'!
contents: aString notifying: aController 
	"Compile the code in aString. Notify aController of any syntax errors. 
	Create an error if the category of the selected message is unknown. 
	Answer false if the compilation fails. Otherwise, if the compilation 
	created a new method, deselect the current selection. Then answer true."
	| category selector class oldSelector |

	(class _ self selectedClassOrMetaClass) ifNil:
		[(myChangeSet preambleString == nil or: [aString size = 0]) ifTrue: [ ^ false].
		(aString count: [:char | char == $"]) odd 
			ifTrue: [self inform: 'unmatched double quotes in preamble']
			ifFalse: [(Scanner new scanTokens: aString) size > 0 ifTrue: [
				self inform: 'Part of the preamble is not within double-quotes.
To put a double-quote inside a comment, type two double-quotes in a row.
(Ignore this warning if you are including a doIt in the preamble.)']].
		myChangeSet preambleString: aString.
		self currentSelector: nil.  "forces update with no 'unsubmitted chgs' feedback"
		^ true].
	oldSelector _ self selectedMessageName.
	category _ class organization categoryOfElement: oldSelector.
	selector _ class compile: aString
				classified: category
				notifying: aController.
	selector ifNil: [^ false].
	(self messageList includes: selector)
		ifTrue: [self currentSelector: selector]
		ifFalse: [self currentSelector: oldSelector].
	self update.
	^ true! !


!ChangeSorter class methodsFor: 'services' stamp: 'jmv 12/8/2008 15:32'!
browseChangeSetsWithClass: class selector: selector
	"Put up a menu comprising a list of change sets that hold changes for the given class and selector.  If the user selects one, open a single change-sorter onto it"

	| hits index |
	hits _ self allChangeSets select: 
		[:cs | (cs atSelector: selector class: class) ~~ #none].
	hits isEmpty ifTrue: [^ self inform: class name, '.', selector , '
is not in any change set'].
	index _ hits size = 1
		ifTrue:	[1]
		ifFalse:	[(PopUpMenu labelArray: (hits collect: [:cs | cs name])
					lines: #()) startUp].
	index = 0 ifTrue: [^ self].
	(ChangeSorter new myChangeSet: (hits at: index)) open.
! !

!ChangeSorter class methodsFor: 'services' stamp: 'jmv 12/8/2008 15:32'!
browseChangeSetsWithSelector: aSelector
	"Put up a list of all change sets that contain an addition, deletion, or change of any method with the given selector"

	| hits index |
	hits _ self allChangeSets select: 
		[:cs | cs hasAnyChangeForSelector: aSelector].
	hits isEmpty ifTrue: [^ self inform: aSelector , '
is not in any change set'].
	index _ hits size = 1
		ifTrue:	[1]
		ifFalse:	[(PopUpMenu labelArray: (hits collect: [:cs | cs name])
					lines: #()) startUp].
	index = 0 ifTrue: [^ self].
	(ChangeSetBrowser new myChangeSet: (hits at: index)) open

"ChangeSorter browseChangeSetsWithSelector: #clearPenTrails"
! !


!FileContentsBrowser methodsFor: 'class list' stamp: 'jmv 12/8/2008 15:36'!
findClass
	| pattern foundClass classNames index foundPackage |
	self okToChange ifFalse: [^ self classNotFound].
	pattern _ (FillInTheBlank request: 'Class Name?') asLowercase.
	pattern isEmpty ifTrue: [^ self].
	classNames := Set new.
	self packages do:[:p| classNames addAll: p classes keys].
	classNames := classNames asArray select: 
		[:n | (n asLowercase indexOfSubCollection: pattern startingAt: 1) > 0].
	classNames isEmpty ifTrue: [^ self].
	index _ classNames size = 1
				ifTrue:	[1]
				ifFalse:	[(PopUpMenu labelArray: classNames lines: #()) startUp].
	index = 0 ifTrue: [^ self].
	foundPackage := nil.
	foundClass := nil.
	self packages do:[:p| 
		(p classes includesKey: (classNames at: index)) ifTrue:[
			foundClass := p classes at: (classNames at: index).
			foundPackage := p]].
	foundClass isNil ifTrue:[^self].
 	self systemCategoryListIndex: (self systemCategoryList indexOf: foundPackage packageName asSymbol).
	self classListIndex: (self classList indexOf: foundClass name). ! !


!Inspector methodsFor: 'menu commands' stamp: 'jmv 12/8/2008 15:39'!
chasePointers
	| saved |
	self selectionIndex = 0 ifTrue: [^ self changed: #flash].
	saved _ self object.
	[self object: nil.
	(Smalltalk includesKey: #PointerFinder)
		ifTrue: [PointerFinder on: saved]
		ifFalse: [self objectReferencesToSelection]]
		ensure: [self object: saved]! !

!Inspector methodsFor: 'menu commands' stamp: 'jmv 12/8/2008 15:39'!
inspectElement
	"Create and schedule an Inspector on an element of the receiver's model's currently selected collection."

	| sel selSize countString count nameStrs |
	self selectionIndex = 0 ifTrue: [^self changed: #flash].
	((sel := self selection) isKindOf: SequenceableCollection) 
		ifFalse: 
			[(sel isKindOf: OldMorphExtension) ifTrue: [^sel inspectElement].
			^sel inspect].
	(selSize := sel size) = 1 ifTrue: [^sel first inspect].
	selSize <= 20 
		ifTrue: 
			[nameStrs := (1 to: selSize) asArray collect: 
							[:ii | 
							ii printString , '   ' 
								, (((sel at: ii) printStringLimitedTo: 25) replaceAll: Character cr
										with: Character space)].
			count := PopUpMenu withCaption: 'which element?' chooseFrom: nameStrs.
			count = 0 ifTrue: [^self].
			^(sel at: count) inspect].
	countString := FillInTheBlank 
				request: 'Which element? (1 to ' , selSize printString , ')'
				initialAnswer: '1'.
	countString isEmptyOrNil ifTrue: [^self].
	count := Integer readFrom: (ReadStream on: countString).
	(count > 0 and: [count <= selSize]) 
		ifTrue: [(sel at: count) inspect]
		ifFalse: [Beeper beep]! !

!Inspector methodsFor: 'menu commands' stamp: 'jmv 12/8/2008 15:39'!
objectReferencesToSelection
	"Open a list inspector on all the objects that point to the value of the selected instance variable, if any.  "

	self selectionIndex = 0 ifTrue: [^ self changed: #flash].
	Smalltalk
		browseAllObjectReferencesTo: self selection
		except: (Array with: self object)
		ifNone: [:obj | self changed: #flash].
! !

!Inspector methodsFor: 'menu commands' stamp: 'jmv 12/8/2008 15:39'!
spawnFullProtocol
	"Spawn a window showing full protocol for the receiver's selection"

	| objectToRepresent |
	objectToRepresent _ self selectionIndex = 0 ifTrue: [object] ifFalse: [self selection].
	ProtocolBrowser openFullProtocolForClass: objectToRepresent class! !

!Inspector methodsFor: 'menu commands' stamp: 'jmv 12/8/2008 15:39'!
spawnProtocol
	"Spawn a protocol on browser on the receiver's selection"

	| objectToRepresent |
	objectToRepresent _ self selectionIndex = 0 ifTrue: [object] ifFalse: [self selection].
	ProtocolBrowser openSubProtocolForClass: objectToRepresent class! !


!MessageSet methodsFor: 'message functions' stamp: 'jmv 12/8/2008 15:40'!
removeMessage
	"Remove the selected message from the system. 1/15/96 sw"
	| messageName confirmation |
	messageListIndex = 0
		ifTrue: [^ self].
	self okToChange
		ifFalse: [^ self].
	messageName _ self selectedMessageName.
	confirmation _ Smalltalk confirmRemovalOf: messageName on: self selectedClassOrMetaClass.
	confirmation = 3
		ifTrue: [^ self].
	self selectedClassOrMetaClass removeSelector: messageName.
	self deleteFromMessageList: self selection.
	self reformulateList.
	confirmation = 2
		ifTrue: [Smalltalk browseAllCallsOn: messageName]! !

!MessageSet methodsFor: 'private' stamp: 'jmv 12/8/2008 15:40'!
setFilteredList: newList
	"Establish newList as the new list if appropriate, and adjust the window title accordingly; if the new list is of the same size as the old, warn and do nothing"

	newList size = 0
		ifTrue:
			[^ self inform: 'Nothing would be left in the list if you did that'].
	newList size = messageList size
		ifTrue:
			[^ self inform: 'That leaves the list unchanged'].
	self initializeMessageList: newList.
	self adjustWindowTitleAfterFiltering! !

!MessageSet methodsFor: 'filtering' stamp: 'jmv 12/8/2008 15:55'!
filterToMessagesInChangesFile
	"Filter down only to messages whose source code risides in the Changes file.  This allows one to ignore long-standing methods that live in the .sources file."

	| cm |
	self filterFrom:
		[:aClass :aSelector |
			aClass notNil and: [aSelector notNil and:
				[(self class isPseudoSelector: aSelector) not and:
					[(cm _ aClass compiledMethodAt: aSelector ifAbsent: [nil]) notNil and:
					[cm fileIndex ~= 1]]]]]! !

!MessageSet methodsFor: 'filtering' stamp: 'jmv 12/8/2008 15:40'!
filterToMessagesInSourcesFile
	"Filter down only to messages whose source code resides in the .sources file."

	| cm |
	self filterFrom: [:aClass :aSelector |
		(aClass notNil and: [aSelector notNil]) and:
			[(self class isPseudoSelector: aSelector) not and:
				[(cm _ aClass compiledMethodAt: aSelector ifAbsent: [nil]) notNil and:
					[cm fileIndex = 1]]]]! !


!MessageNames methodsFor: 'selector list' stamp: 'jmv 12/8/2008 15:40'!
messageList
	"Answer the receiver's message list, computing it if necessary. The way 
	to force a recomputation is to set the messageList to nil"
	messageList
		ifNil: [messageList _ selectorListIndex = 0
						ifTrue: [#()]
						ifFalse: [Smalltalk
								allImplementorsOf: (selectorList at: selectorListIndex)].
			self
				messageListIndex: (messageList size > 0
						ifTrue: [1]
						ifFalse: [0])].
	^ messageList! !


!Symbol methodsFor: 'testing' stamp: 'jmv 12/8/2008 15:45'!
isInfix
	"Answer whether the receiver is an infix message selector."

	^ self precedence = 2! !

!Symbol methodsFor: 'testing' stamp: 'jmv 12/8/2008 15:45'!
isUnary
	"Answer whether the receiver is an unary message selector."

	^ self precedence = 1! !


!Symbol class methodsFor: 'access' stamp: 'jmv 12/8/2008 15:45'!
selectorsContaining: aString
	"Answer a list of selectors that contain aString within them. Case-insensitive.  Does return symbols that begin with a capital letter."

	| size selectorList ascii |

	selectorList _ OrderedCollection new.
	(size _ aString size) = 0 ifTrue: [^selectorList].

	aString size = 1 ifTrue:
		[
			ascii _ aString first asciiValue.
			ascii < 128 ifTrue: [selectorList add: (OneCharacterSymbols at: ascii+1)]
		].

	aString first isLetter ifFalse:
		[
			aString size = 2 ifTrue: 
				[Symbol hasInterned: aString ifTrue:
					[:s | selectorList add: s]].
			^selectorList
		].

	selectorList _ selectorList copyFrom: 2 to: selectorList size.

	self allSymbolTablesDo: [:each |
		each size >= size ifTrue:
			[(each findSubstring: aString in: each startingAt: 1 
				matchTable: CaseInsensitiveOrder) > 0
						ifTrue: [selectorList add: each]]].

	^selectorList reject: [:each | "reject non-selectors, but keep ones that begin with an uppercase"
		each numArgs < 0 and: [each asString withFirstCharacterDownshifted numArgs < 0]].

"Symbol selectorsContaining: 'scon'"! !


!SystemDictionary methodsFor: 'ui' stamp: 'jmv 12/8/2008 15:49'!
confirmRemovalOf: aSelector on: aClass 
	"Determine if it is okay to remove the given selector. Answer 1 if it  
	should be removed, 2 if it should be removed followed by a senders  
	browse, and 3 if it should not be removed."
	| count aMenu answer caption allCalls |
	allCalls _ self allCallsOn: aSelector.
	(count _ allCalls size) = 0
		ifTrue: [^ 1].
	"no senders -- let the removal happen without warning"
	count = 1
		ifTrue: [(allCalls first actualClass == aClass
					and: [allCalls first methodSymbol == aSelector])
				ifTrue: [^ 1]].
	"only sender is itself"
	aMenu _ PopUpMenu labels: 'Remove it
Remove, then browse senders
Don''t remove, but show me those senders
Forget it -- do nothing -- sorry I asked'.
	caption _ 'This message has ' , count printString , ' sender'.
	count > 1
		ifTrue: [caption _ caption copyWith: $s].
	answer _ aMenu startUpWithCaption: caption.
	answer = 3
		ifTrue: [self
				browseMessageList: allCalls
				name: 'Senders of ' , aSelector
				autoSelect: aSelector keywords first].
	answer = 0
		ifTrue: [answer _ 3].
	"If user didn't answer, treat it as cancel"
	^ answer min: 3! !


!TextEditor methodsFor: 'editing keys' stamp: 'jmv 12/8/2008 15:46'!
swapChars: characterStream 
	"Triggered byCmd-Y;.  Swap two characters, either those straddling the insertion point, or the two that comprise the selection.  Suggested by Ted Kaehler.  "

	| currentSelection aString chars |
	sensor keyboard.		"flush the triggering cmd-key character"
	(chars _ self selection) size = 0
		ifTrue:
			[currentSelection _ self pointIndex.
			self selectMark: currentSelection - 1 point: currentSelection]
		ifFalse:
			[chars size = 2
				ifFalse:
					[morph flash. ^ true]
				ifTrue:
					[currentSelection _ self pointIndex - 1]].
	aString _ self selection string.
	self replaceSelectionWith: (Text string: aString reversed emphasis: emphasisHere).
	self selectAt: currentSelection + 1.
	^ true! !

!TextEditor methodsFor: 'menu messages' stamp: 'jmv 12/8/2008 15:45'!
find
	"Prompt the user for a string to search for, and search the receiver from the current selection onward for it.  1/26/96 sw"

	| reply |
	reply _ FillInTheBlank request: 'Find what? ' initialAnswer: ''.
	reply size = 0 ifTrue: [
		^ self].
	self setSearch: reply.
	ChangeText _ FindText.  "Implies no replacement to againOnce: method"
	self againOrSame: true.

	morph installEditorToReplace: self! !

!TextEditor methodsFor: 'menu messages' stamp: 'jmv 12/8/2008 15:45'!
saveContentsInFile
	"Save the receiver's contents string to a file, prompting the user for a file-name.  Suggest a reasonable file-name."

	| fileName stringToSave parentWindow labelToUse suggestedName lastIndex |
	stringToSave := paragraph text string.
	stringToSave size = 0 ifTrue: [^self inform: 'nothing to save.'].
	parentWindow := self model dependents 
				detect: [:dep | dep isKindOf: OldSystemWindow]
				ifNone: [nil].
	labelToUse := parentWindow ifNil: ['Untitled']
				ifNotNil: [parentWindow label].
	suggestedName := nil.
	#(#('Decompressed contents of: ' '.gz')) do: 
			[:leaderTrailer | 
			"can add more here..."

			(labelToUse beginsWith: leaderTrailer first) 
				ifTrue: 
					[suggestedName := labelToUse copyFrom: leaderTrailer first size + 1
								to: labelToUse size.
					(labelToUse endsWith: leaderTrailer last) 
						ifTrue: 
							[suggestedName := suggestedName copyFrom: 1
										to: suggestedName size - leaderTrailer last size]
						ifFalse: 
							[lastIndex := suggestedName lastIndexOf: $. ifAbsent: [0].
							(lastIndex = 0 or: [lastIndex = 1]) 
								ifFalse: [suggestedName := suggestedName copyFrom: 1 to: lastIndex - 1]]]].
	suggestedName ifNil: [suggestedName := labelToUse , '.text'].
	fileName := FillInTheBlank request: 'File name?'
				initialAnswer: suggestedName.
	fileName isEmptyOrNil 
		ifFalse: 
			[(FileStream newFileNamed: fileName)
				nextPutAll: stringToSave;
				close]! !

!TextEditor methodsFor: 'menu messages' stamp: 'jmv 12/8/2008 15:45'!
selectedSymbol
	"Return the currently selected symbol, or nil if none.  Spaces, tabs and returns are ignored"

	| aString |
	self hasCaret ifTrue: [^ nil].
	aString _ self selection string copyWithoutAll:
		{Character space.  Character cr.  Character tab}.
	aString size = 0 ifTrue: [^ nil].
	Symbol hasInterned: aString  ifTrue: [:sym | ^ sym].

	^ nil! !

!TextEditor methodsFor: 'nonediting/nontyping keys' stamp: 'jmv 12/8/2008 15:45'!
setSearchString: characterStream
	"Establish the current selection as the current search string."

	| aString |
	self closeTypeIn: characterStream.
	sensor keyboard.
	self lineSelectAndEmptyCheck: [^ true].
	aString _  self selection string.
	aString size = 0
		ifTrue:
			[self flash]
		ifFalse:
			[self setSearch: aString].
	^ true! !

!TextEditor methodsFor: 'private' stamp: 'jmv 12/8/2008 16:45'!
sameColumn: start newLine: lineBlock forward: isForward
	"Private - Compute the index in my text
	with the line number derived from lineBlock,"
	" a one argument block accepting the old line number.
	The position inside the line will be preserved as good as possible"
	"The boolean isForward is used in the border case to determine if
	we should move to the beginning or the end of the line."
	| wordStyle column currentLine offsetAtTargetLine targetEOL lines numberOfLines currentLineNumber targetLineNumber |
	wordStyle _ Preferences wordStyleCursorMovement.
	wordStyle
		ifTrue: [
			lines _ paragraph lines.
			numberOfLines := paragraph numberOfLines.
			currentLineNumber  _ paragraph lineIndexOfCharacterIndex: start.
			currentLine _ lines at: currentLineNumber]
		ifFalse: [
			lines _ self lines.
			numberOfLines := lines size.
			currentLine _ lines
				detect:[:lineInterval | lineInterval last >= start]
				ifNone:[lines last].
			currentLineNumber _ currentLine second].
	column _ start - currentLine first.
	targetLineNumber _ ((lineBlock value: currentLineNumber) max: 1) min: numberOfLines.
	offsetAtTargetLine _ (lines at: targetLineNumber) first.
	targetEOL _ (lines at: targetLineNumber) last + (targetLineNumber = numberOfLines ifTrue:[1]ifFalse:[0]).
	targetLineNumber = currentLineNumber
	"No movement or movement failed. Move to beginning or end of line."
		ifTrue:[^isForward
			ifTrue:[targetEOL]
			ifFalse:[offsetAtTargetLine]].
	^offsetAtTargetLine + column min: targetEOL.! !


!Utilities class methodsFor: 'common requests' stamp: 'jmv 12/8/2008 15:48'!
offerCommonRequestsInMorphic
	"Offer up the common-requests menu.  If the user chooses one, then evaluate it, and -- provided the value is a number or string -- show it in the Transcript."

	"Utilities offerCommonRequests"

	| aMenu strings |
	(CommonRequestStrings == nil or: [CommonRequestStrings isKindOf: Array]) 
		ifTrue: [self initializeCommonRequestStrings].
	strings := CommonRequestStrings contents.
	aMenu := OldMenuMorph new.
	aMenu title: 'Common Requests' translated.
	aMenu addStayUpItem.
	strings asString linesDo: 
			[:aString | 
			aString = '-' 
				ifTrue: [aMenu addLine]
				ifFalse: 
					[aString size = 0 ifTrue: [aString := ' '].
					aMenu 
						add: aString
						target: self
						selector: #eval:
						argument: aString]].
	aMenu addLine.
	aMenu 
		add: 'edit this list' translated
		target: self
		action: #editCommonRequestStrings.
	aMenu popUpInWorld: self currentWorld! !

!Utilities class methodsFor: 'fetching updates' stamp: 'jmv 12/8/2008 15:48'!
applyUpdatesFromDiskToUpdateNumber: lastUpdateNumber stopIfGap: stopIfGapFlag 
	"To use this mechanism, be sure all updates you want to have considered 
	are in a folder named 'updates' which resides in the same directory as  
	your image. Having done that, simply evaluate:  
	 
	Utilities applyUpdatesFromDiskToUpdateNumber: 1234 stopIfGap: false  
	 
	and all numbered updates <= lastUpdateNumber not yet in the image will 
	be loaded in numerical order."
	| previousHighest currentUpdateNumber done fileNames aMessage updateDirectory loaded |
	updateDirectory _ self getUpdateDirectoryOrNil.
	updateDirectory ifNil: [^ self].
	previousHighest _ SystemVersion current highestUpdate.
	currentUpdateNumber _ previousHighest.
	done _ false.
	loaded _ 0.
	[done]
		whileFalse: [currentUpdateNumber _ currentUpdateNumber + 1.
			currentUpdateNumber > lastUpdateNumber
				ifTrue: [done _ true]
				ifFalse: [fileNames _ updateDirectory fileNamesMatching: currentUpdateNumber printString , '*'.
					fileNames size > 1
						ifTrue: [^ self inform: 'ambiguity -- two files both start with ' , currentUpdateNumber printString , '
(at this point it is probably best to remedy
the situation on disk, then try again.)'].
					fileNames size = 0
						ifTrue: [Transcript cr; show: 'gap in updates from disk for update number '; print: currentUpdateNumber; show: ' found...'.
							done _ stopIfGapFlag]
						ifFalse: [ChangeSorter
								newChangesFromStream: (updateDirectory readOnlyFileNamed: fileNames first)
								named: fileNames first.
							SystemVersion current registerUpdate: currentUpdateNumber.
							loaded _ loaded + 1]]].
	aMessage _ loaded = 0
				ifTrue: ['No new updates found.']
				ifFalse: [loaded printString , ' update(s) loaded.'].
	self inform: aMessage , '
Highest numbered update is now ' , (currentUpdateNumber - 1) printString , '.'! !

!Utilities class methodsFor: 'miscellaneous' stamp: 'jmv 12/8/2008 16:46'!
instanceComparisonsBetween: fileName1 and: fileName2
	"For differential results, run printSpaceAnalysis twice with different fileNames,
	then run this method...
		Smalltalk printSpaceAnalysis: 0 on: 'STspace.text1'.
			--- do something that uses space here ---
		Smalltalk printSpaceAnalysis: 0 on: 'STspace.text2'.
		Smalltalk instanceComparisonsBetween: 'STspace.text1' and 'STspace.text2'"

	| instCountDict report f aString items className newInstCount oldInstCount newSpace oldPair oldSpace |
	instCountDict _ Dictionary new.
	report _ ReadWriteStream on: ''.
	f _ FileStream readOnlyFileNamed: fileName1.
	[f atEnd] whileFalse:
		[aString _ f upTo: Character cr.
		items _ aString findTokens: ' '.
		(items size = 4 or: [items size = 5]) ifTrue:
			[instCountDict at: items first put: (Array with: items third asNumber with: items fourth asNumber)]].
	f close.

	f _ FileStream readOnlyFileNamed: fileName2.
	[f atEnd] whileFalse:
		[aString _ f upTo: Character cr.
		items _ aString findTokens: ' '.
		(items size = 4 or: [items size = 5]) ifTrue:
			[className _ items first.
			newInstCount _ items third asNumber.
			newSpace _ items fourth asNumber.
			oldPair _ instCountDict at: className ifAbsent: [nil].
			oldInstCount _ oldPair ifNil: [0] ifNotNil: [oldPair first].
			oldSpace _ oldPair ifNil: [0] ifNotNil: [oldPair second].
			oldInstCount ~= newInstCount ifTrue:
				[report nextPutAll: (newInstCount - oldInstCount) printString; tab; nextPutAll: (newSpace - oldSpace) printString; tab; nextPutAll: className asString; cr]]].
	f close.

	(StringHolder new contents: report contents)
		openLabel: 'Instance count differentials between ', fileName1, ' and ', fileName2! !

!Utilities class methodsFor: 'recent method submissions' stamp: 'jmv 12/8/2008 15:48'!
browseRecentSubmissions
	"Open up a browser on the most recent methods submitted in the image.  5/96 sw."

	"Utilities browseRecentSubmissions"

	| recentMessages |

	self recentMethodSubmissions size = 0 ifTrue:
		[^ self inform: 'There are no recent submissions'].
	
	recentMessages _ RecentSubmissions copy reversed.
	RecentMessageSet 
		openMessageList: recentMessages 
		name: 'Recent submissions -- youngest first ' 
		autoSelect: nil! !

!Utilities class methodsFor: 'recent method submissions' stamp: 'jmv 12/8/2008 15:48'!
revertLastMethodSubmission
	| changeRecords lastSubmission theClass theSelector |
	"If the most recent method submission was a method change, revert
	that change, and if it was a submission of a brand-new method, 
	remove that method."

	RecentSubmissions isEmptyOrNil ifTrue: [^ self beep].
	lastSubmission _ RecentSubmissions last.
	theClass _ lastSubmission actualClass ifNil: [^ self beep].
	theSelector _ lastSubmission methodSymbol.
	changeRecords _ theClass changeRecordsAt: theSelector.
	changeRecords isEmptyOrNil ifTrue: [^ self beep].
	changeRecords size = 1
		ifTrue:
			["method has no prior version, so reverting in this case means removing"
			theClass removeSelector: theSelector]
		ifFalse:
			[changeRecords second fileIn].

"Utilities revertLastMethodSubmission"! !

!Utilities class methodsFor: 'summer97 additions' stamp: 'jmv 12/8/2008 15:49'!
wellFormedInstanceVariableNameFrom: aString
	"Answer a legal instance variable name, derived from aString"

	| cleansedString |
	cleansedString _ aString select: [:ch | ch isDigit or: [ch isLetter]].
	(cleansedString size = 0 or: [cleansedString first isDigit])
		ifTrue: [cleansedString _ 'a', cleansedString]
		ifFalse:	[cleansedString _ cleansedString withFirstCharacterDownshifted].

	[self isLegalInstVarName: cleansedString] whileFalse:
		[cleansedString _ cleansedString, 'x'].
	^ cleansedString

"Utilities wellFormedInstanceVariableNameFrom:  '234 xx\ Uml /ler42342380-4'"! !

!Utilities class methodsFor: 'tailoring system' stamp: 'jmv 12/8/2008 15:48'!
stripMethods: tripletList messageCode: messageString
	"Used to 'cap' methods that need to be protected for proprietary reasons, etc.; call this with a list of triplets of symbols of the form  (<class name>  <#instance or #class> <selector name>), and with a string to be produced as part of the error msg if any of the methods affected is reached"

	| aClass sel keywords codeString |
	tripletList do:
		[:triplet |  
			(aClass _ (Smalltalk at: triplet first ifAbsent: [nil])) notNil ifTrue:
				[triplet second == #class ifTrue:
					[aClass _ aClass class].
				sel _ triplet third.
				keywords _ sel keywords.
				(keywords size = 1 and: [keywords first asSymbol isKeyword not])
					ifTrue:
						[codeString _ keywords first asString]
					ifFalse:
						[codeString _ ''.
						keywords withIndexDo:
							[:kwd :index |
								codeString _ codeString, ' ', (keywords at: index), ' ',
									'arg', index printString]].
				codeString _ codeString, '
	self codeStrippedOut: ', (messageString surroundedBySingleQuotes).

				aClass compile: codeString classified: 'stripped']]! !


!VersionsBrowser methodsFor: 'init & update' stamp: 'jmv 12/8/2008 15:49'!
scanVersionsOf: method class: class meta: meta category: category selector: selector
	| position prevPos prevFileIndex preamble tokens sourceFilesCopy stamp |
	selectorOfMethod _ selector.
	currentCompiledMethod _ method.
	classOfMethod _ meta ifTrue: [class class] ifFalse: [class].
	changeList _ OrderedCollection new.
	list _ OrderedCollection new.
	self addedChangeRecord ifNotNilDo: [ :change |
		self addItem: change text: ('{1} (in {2})' translated format: { change stamp. change fileName }) ].
	listIndex _ 0.
	position _ method filePosition.
	sourceFilesCopy _ SourceFiles collect:
		[:x | x isNil ifTrue: [ nil ]
				ifFalse: [x readOnlyCopy]].
	method fileIndex = 0 ifTrue: [^ nil].
	file _ sourceFilesCopy at: method fileIndex.
	[position notNil & file notNil]
		whileTrue:
		[file position: (0 max: position-150).  "Skip back to before the preamble"
		[file position < (position-1)]  "then pick it up from the front"
			whileTrue: [preamble _ file nextChunk].

		"Preamble is likely a linked method preamble, if we're in
			a changes file (not the sources file).  Try to parse it
			for prior source position and file index"
		prevPos _ nil.
		stamp _ ''.
		(preamble findString: 'methodsFor:' startingAt: 1) > 0
			ifTrue: [tokens _ Scanner new scanTokens: preamble]
			ifFalse: [tokens _ Array new  "ie cant be back ref"].
		((tokens size between: 7 and: 8)
			and: [(tokens at: tokens size-5) = #methodsFor:])
			ifTrue:
				[(tokens at: tokens size-3) = #stamp:
				ifTrue: ["New format gives change stamp and unified prior pointer"
						stamp _ tokens at: tokens size-2.
						prevPos _ tokens last.
						prevFileIndex _ sourceFilesCopy fileIndexFromSourcePointer: prevPos.
						prevPos _ sourceFilesCopy filePositionFromSourcePointer: prevPos]
				ifFalse: ["Old format gives no stamp; prior pointer in two parts"
						prevPos _ tokens at: tokens size-2.
						prevFileIndex _ tokens last].
				(prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos _ nil]].
		((tokens size between: 5 and: 6)
			and: [(tokens at: tokens size-3) = #methodsFor:])
			ifTrue:
				[(tokens at: tokens size-1) = #stamp:
				ifTrue: ["New format gives change stamp and unified prior pointer"
						stamp _ tokens at: tokens size]].
 		self addItem:
				(ChangeRecord new file: file position: position type: #method
						class: class name category: category meta: meta stamp: stamp)
			text: stamp , ' ' , class name , (meta ifTrue: [' class '] ifFalse: [' ']) , selector.
		position _ prevPos.
		prevPos notNil ifTrue:
			[file _ sourceFilesCopy at: prevFileIndex]].
	sourceFilesCopy do: [:x | x notNil ifTrue: [x close]].
	listSelections _ Array new: list size withAll: false! !

!VersionsBrowser methodsFor: 'misc' stamp: 'jmv 12/8/2008 15:49'!
addPriorVersionsCountForSelector: aSelector ofClass: aClass to: aStream
	"Add an annotation detailing the prior versions count.  Specially handled here for the case of a selector no longer in the system, whose prior versions are seen in a versions browser -- in this case, the inherited version of this method will not work."

	(aClass includesSelector: aSelector) ifTrue:
		[^ super addPriorVersionsCountForSelector: aSelector ofClass: aClass to: aStream].

	aStream nextPutAll: 
		((changeList size > 0
			ifTrue:
				[changeList size = 1
					ifTrue:
						['Deleted - one prior version']
					ifFalse:
						['Deleted - ', changeList size printString, ' prior versions']]
			ifFalse:
				['surprisingly, no prior versions']), self annotationSeparator)! !


!ClassCommentVersionsBrowser methodsFor: 'basic function' stamp: 'jmv 12/8/2008 16:09'!
diffedVersionContents
	"Answer diffed version contents, maybe pretty maybe not"

	| change class earlier later |
	(listIndex = 0
			or: [changeList size < listIndex])
		ifTrue: [^ ''].
	change _ changeList at: listIndex.
	later _ change text.
	class _ self selectedClass.
	(listIndex = changeList size or: [class == nil])
		ifTrue: [^ later].

	earlier _ (changeList at: listIndex + 1) text.

	^ TextDiffBuilder buildDisplayPatchFrom: earlier to: later inClass: class prettyDiffs: self showingPrettyDiffs! !

